import integer.definition natural.addition tactic.nth_rewrite natural.equality

namespace Z

def sub_helper : N -> N -> Z
| 0 0                   := 0
| 0 (N.succ a)          := neg_succ a
| a 0                   := pos a
| (N.succ a) (N.succ b) := sub_helper a b

def add : Z -> Z -> Z
| (pos a) (pos b)           := pos (a + b)
| (pos a) (neg_succ b)      := sub_helper a (b + 1)
| (neg_succ a) (pos b)      := sub_helper b (a + 1)
| (neg_succ a) (neg_succ b) := neg_succ (a + b + 1)

def sub : Z -> Z -> Z
| (pos a) (pos b)           := sub_helper a b
| (pos a) (neg_succ b)      := pos (a + b + 1)
| (neg_succ a) (pos b)      := neg_succ (a + b)
| (neg_succ a) (neg_succ b) := sub_helper b a

def neg : Z -> Z
| (pos 0)          := pos 0
| (pos (N.succ a)) := neg_succ a
| (neg_succ a)     := pos (a + 1)

instance : has_add Z := ⟨ Z.add ⟩
instance : has_sub Z := ⟨ Z.sub ⟩
instance : has_neg Z := ⟨ Z.neg ⟩

def two := pos (N.succ 1)
theorem two_eq_two : two = 2 := rfl

lemma pos_add_pos (a b : N) : (pos a) + (pos b) = pos (a + b) := rfl
lemma pos_add_neg (a b : N) : (pos a) + (neg_succ b) = sub_helper a (b + 1) := rfl
lemma neg_add_pos (a b : N) : (neg_succ a) + (pos b) = sub_helper b (a + 1) := rfl
lemma neg_add_neg (a b : N) : (neg_succ a) + (neg_succ b) = neg_succ (a + b + 1) := rfl

lemma zero_sub_helper_zero : sub_helper 0 0 = 0 := rfl
lemma zero_sub_helper_succ (a : N) : sub_helper 0 (N.succ a) = neg_succ a := rfl
lemma succ_sub_helper_zero (a : N) : sub_helper (N.succ a) 0 = pos (N.succ a) := rfl
lemma succ_sub_helper_succ (a b : N) : sub_helper (N.succ a) (N.succ b) = sub_helper a b := rfl

lemma pos_sub_pos (a b : N) : (pos a) - (pos b) = sub_helper a b := rfl
lemma pos_sub_neg (a b : N) : (pos a) - (neg_succ b) = pos (a + b + 1) := rfl
lemma neg_sub_pos (a b : N) : (neg_succ a) - (pos b) = neg_succ (a + b) := rfl
lemma neg_sub_neg (a b : N) : (neg_succ a) - (neg_succ b) = sub_helper b a := rfl

lemma neg_zero : neg 0 = 0 := rfl
lemma neg_pos_succ (a : N) : neg (pos (N.succ a)) = neg_succ a := rfl
lemma neg_neg_succ (a : N) : neg (neg_succ a) = pos (a + 1) := rfl

lemma zero_sub (a : Z) : 0 - a = neg a :=
begin
  rw ← zero_eq_zero,
  cases a,
  rw pos_sub_pos,
  rw N.zero_eq_zero,
  cases a,
  rw N.zero_eq_zero,
  rw zero_sub_helper_zero,
  rw ← N.zero_eq_zero,
  rw zero_eq_zero,
  rw neg_zero,
  rw zero_sub_helper_succ,
  rw neg_pos_succ,
  rw pos_sub_neg,
  rw neg_neg_succ,
  rw N.zero_eq_zero,
  rw N.zero_add,
end

lemma sub_helper_eq (a : N) : sub_helper a a = 0 :=
begin
  induction a,
  rw N.zero_eq_zero,
  rw zero_sub_helper_zero,
  rw succ_sub_helper_succ,
  exact a_ih,
end

lemma sub_eq (a : Z) : a - a = 0 :=
begin
  cases a,
  rw pos_sub_pos,
  rw sub_helper_eq,
  rw neg_sub_neg,
  rw sub_helper_eq,
end

lemma sub_helper_zero (a : N) : sub_helper a 0 = pos a :=
begin
  cases a,
  rw N.zero_eq_zero,
  rw zero_sub_helper_zero,
  rw ← zero_eq_zero,
  rw N.zero_eq_zero,
  rw succ_sub_helper_zero,
end

lemma zero_sub_helper_eq_r (a : N) : (sub_helper 0 a = 0) -> (a = 0) :=
begin
  intro h,
  cases a,
  rw N.zero_eq_zero,
  exfalso,
  rw zero_sub_helper_succ at h,
  cases h,
end

lemma zero_sub_helper_eq_l (a : N) : (sub_helper a 0 = 0) -> (a = 0) :=
begin
  intro h,
  cases a,
  rw N.zero_eq_zero,
  exfalso,
  rw succ_sub_helper_zero at h,
  cases h,
end

lemma zero_sub_helper_eq : ∀ a b : N, (sub_helper a b = 0) -> (a = b)
| 0 0 :=
begin
  intro h,
  refl,
end
| 0 (N.succ a) :=
begin
  intro h,
  exfalso,
  have s := zero_sub_helper_eq_r (N.succ a) h,
  cases h,
end
| (N.succ a) 0 :=
begin
  intro h,
  exfalso,
  have s := zero_sub_helper_eq_l (N.succ a) h,
  cases h,
end
| (N.succ a) (N.succ b) :=
begin
  intro h,
  rw succ_sub_helper_succ at h,
  have q := zero_sub_helper_eq a b h,
  exact (N.eq_succ a b q),
end

lemma pos_eq_pos (a b : N) : (pos a = pos b) -> a = b :=
begin
  intro h,
  have s := sub_eq (pos a),
  nth_rewrite 1 h at s,
  rw pos_sub_pos at s,
  exact (zero_sub_helper_eq a b s),
end

lemma neg_eq_neg (a b : N) : (neg_succ a = neg_succ b) -> (a = b) :=
begin
  intro h,
  have s := sub_eq (neg_succ a),
  nth_rewrite 1 h at s,
  rw neg_sub_neg at s,
  have t := zero_sub_helper_eq b a s,
  rw t,
end

lemma neg_succ_sub (a b : N) : (neg_succ a) - (pos b) = neg_succ (a + b) :=
begin
  rw neg_sub_pos,
end

lemma neg_succ_eq_neg_succ (a : N) : neg_succ a = neg (pos a)-1 :=
begin
  cases a,
  rw zero_eq_zero,
  rw neg_zero,
  rw zero_sub,
  rw ← one_eq_one,
  rw one,
  rw neg_pos_succ,
  rw N.zero_eq_zero,
  rw neg_pos_succ,
  rw ← one_eq_one,
  rw one,
  rw neg_succ_sub,
  rw N.add_succ,
  rw N.add_zero,
end

lemma zero_add (a : Z) : 0 + a = a :=
begin
  rw ← zero_eq_zero,
  cases a,
  rw pos_add_pos,
  rw N.zero_eq_zero,
  rw N.zero_add,
  rw pos_add_neg,
  rw ← N.one_eq_one,
  rw N.one,
  rw N.add_succ,
  rw N.add_zero,
  rw N.zero_eq_zero,
  rw zero_sub_helper_succ,
end

lemma add_zero (a : Z) : a + 0 = a :=
begin
  rw ← zero_eq_zero,
  cases a,
  rw pos_add_pos,
  rw N.zero_eq_zero,
  rw N.add_zero,
  rw neg_add_pos,
  rw ← N.one_eq_one, rw N.one,
  rw N.add_succ,
  rw N.add_zero,
  rw N.zero_eq_zero,
  rw zero_sub_helper_succ,
end

lemma sub_zero (a : Z) : a - 0 = a :=
begin
  rw ← zero_eq_zero,
  cases a,
  rw pos_sub_pos,
  rw N.zero_eq_zero,
  rw sub_helper_zero,
  rw neg_sub_pos,
  rw N.zero_eq_zero,
  rw N.add_zero,
end

theorem sub_eq_neg_add (a b : Z) : a - b = a + (neg b) :=
begin
  cases b,
  cases b,
  rw zero_eq_zero,
  rw neg_zero,
  rw add_zero,
  rw sub_zero,
  rw neg_pos_succ,
  cases a,
  rw pos_sub_pos,
  rw pos_add_neg,
  rw N.succ_eq_inc,
  rw neg_sub_pos,
  rw neg_add_neg,
  rw N.succ_eq_inc,
  rw N.add_assoc,
  rw neg_neg_succ,
  cases a,
  rw pos_sub_neg,
  rw pos_add_pos,
  rw N.add_assoc,
  rw neg_sub_neg,
  rw neg_add_pos,
  repeat {rw ← N.succ_eq_inc},
  rw succ_sub_helper_succ,
end

def neg_succ_Z (a : Z) := -a-1

lemma neg_succ_Z_eq_neg_succ (a : Z) : neg_succ_Z a = (neg a) - 1 := rfl

theorem double_neg_succ_is_eq (a : Z) : neg_succ_Z (neg_succ_Z a) = a :=
begin
  rw neg_succ_Z_eq_neg_succ,
  rw neg_succ_Z_eq_neg_succ,
  cases a,
  cases a,
  rw zero_eq_zero,
  rw neg_zero,
  rw zero_sub,
  rw ← one_eq_one,
  rw one,
  rw neg_pos_succ,
  rw neg_neg_succ,
  rw N.zero_add,
  rw ← N.one_eq_one,
  rw N.one,
  rw sub_eq,
  rw neg_pos_succ,
  rw ← one_eq_one,
  rw one,
  rw neg_succ_sub,
  rw neg_neg_succ,
  rw pos_sub_pos,
  rw N.add_succ,
  rw N.succ_add,
  rw succ_sub_helper_succ,
  rw N.add_zero,
  rw ← N.one_eq_one,
  rw N.one,
  rw N.add_succ,
  rw succ_sub_helper_zero,
  rw N.add_zero,
  rw neg_neg_succ,
  rw ← one_eq_one,
  rw one,
  rw pos_sub_pos,
  rw ← N.one_eq_one,
  rw N.one,
  rw N.add_succ,
  rw succ_sub_helper_succ,
  rw N.add_zero,
  cases a,
  rw N.zero_eq_zero,
  rw zero_sub_helper_zero,
  rw neg_zero,
  rw zero_sub,
  rw neg_pos_succ,
  rw succ_sub_helper_zero,
  rw neg_pos_succ,
  rw neg_sub_pos,
  rw N.add_succ,
  rw N.add_zero,
end

lemma succ_eq_inc (a : N) : pos (N.succ a) = pos a + 1 := begin
  rw ← one_eq_one,
  rw one,
  rw pos_add_pos,
  rw N.add_succ,
  rw N.add_zero,
end

lemma succ_eq_inc_l (a : N) : pos (N.succ a) = 1 + pos a :=
begin
  rw ← one_eq_one,
  rw one,
  rw pos_add_pos,
  rw N.succ_add,
  rw N.zero_add,
end

lemma left_add_one_eq (a b : Z) : (1 + a = 1 + b) -> (a = b) :=
begin
  intro h,
  cases a,
  cases b,
  rw ← one_eq_one at h,
  rw one at h,
  repeat {rw pos_add_pos at h},
  have q := pos_eq_pos (N.succ 0 + a) (N.succ 0 + b) h,
  have t := N.add_eq a b (N.succ 0) q,
  exact (eq_pos_eq a b t),
  rw ← one_eq_one at h, rw one at h,
  rw pos_add_pos at h,
  rw N.succ_add at h,
  rw N.zero_add at h,
  rw pos_add_neg at h,
  rw ← N.one_eq_one at h, rw N.one at h,
  rw N.add_succ at h,
  rw N.add_zero at h,
  rw succ_sub_helper_succ at h,
  cases b,
  rw N.zero_eq_zero at h,
  rw zero_sub_helper_zero at h,
  rw ← zero_eq_zero at h,
  have q := pos_eq_pos (N.succ a) (N.zero) h,
  exfalso,
  rw N.zero_eq_zero at q,
  have t := N.eq_comm (N.succ a) 0 q,
  exact (N.zero_neq_succ a t),
  rw zero_sub_helper_succ at h,
  exfalso,
  exact (pos_neq_neg (N.succ a) b h),
  cases b,
  rw ← one_eq_one at h, rw one at h,
  rw pos_add_pos at h,
  rw N.succ_add at h,
  rw N.zero_add at h,
  rw pos_add_neg at h,
  rw ← N.one_eq_one at h, rw N.one at h,
  rw N.add_succ at h,
  rw N.add_zero at h,
  rw succ_sub_helper_succ at h,
  cases a,
  rw N.zero_eq_zero at h,
  rw zero_sub_helper_zero at h,
  rw ← zero_eq_zero at h,
  rw N.zero_eq_zero at h,
  have q := pos_eq_pos 0 (N.succ b) h,
  exfalso,
  exact (N.zero_neq_succ b q),
  rw zero_sub_helper_succ at h,
  exfalso,
  exact (neg_neq_pos a (N.succ b) h),
  rw ← one_eq_one at h, rw one at h,
  repeat {rw pos_add_neg at h},
  rw ← N.one_eq_one at h, rw N.one at h,
  repeat {rw N.add_succ at h,rw N.add_zero at h},
  repeat {rw succ_sub_helper_succ at h},
  cases a,
  rw N.zero_eq_zero at h,
  rw zero_sub_helper_zero at h,
  cases b,
  refl,
  rw zero_sub_helper_succ at h,
  exfalso,
  exact (pos_neq_neg 0 b h),
  rw zero_sub_helper_succ at h,
  cases b,
  rw N.zero_eq_zero at h,
  rw zero_sub_helper_zero at h,
  exfalso,
  exact (neg_neq_pos a 0 h),
  rw zero_sub_helper_succ at h,
  have t := neg_eq_neg a b h,
  exact (eq_neg_eq (N.succ a) (N.succ b) (N.eq_succ a b t)),
end

lemma one_add_comm (a : Z) : 1 + a = a + 1 :=
begin
  rw ← one_eq_one, rw one,
  cases a,
  repeat {rw pos_add_pos},
  rw N.succ_add,
  rw N.zero_add,
  rw N.add_succ,
  rw N.add_zero,
  rw pos_add_neg,
  rw neg_add_pos,
end

lemma one_sub_comm (a : Z) : neg 1 + a = a - 1 :=
begin
  rw ← one_eq_one, rw one,
  rw neg_pos_succ,
  cases a,
  rw neg_add_pos,
  rw pos_sub_pos,
  rw N.succ_eq_inc,
  rw neg_add_neg,
  rw neg_sub_pos,
  rw ← N.one, rw N.one_eq_one,
  rw N.zero_add,
end

lemma right_add_one_eq (a b : Z) : (a + 1 = b + 1) -> (a = b) :=
begin
  intro h,
  repeat {rw ← one_add_comm at h},
  exact (left_add_one_eq a b h),
end

lemma add_one_assoc (a b : Z) : (a + 1) + b = a + (1 + b) :=
begin
  cases a,
  cases b,
  rw ← one_eq_one, rw one,
  repeat {rw pos_add_pos},
  rw N.add_assoc,
  rw ← one_eq_one, rw one,
  rw pos_add_pos,
  rw pos_add_neg,
  rw pos_add_neg,
  rw ← N.one_eq_one, rw N.one,
  repeat {rw N.add_succ, rw N.add_zero},
  repeat {rw succ_sub_helper_succ},
  cases b,
  cases a,
  rw N.zero_eq_zero,
  rw zero_sub_helper_zero,
  rw ← zero_eq_zero,
  rw pos_add_pos,
  rw N.zero_add,
  rw N.zero_eq_zero,
  rw succ_sub_helper_zero,
  rw zero_sub_helper_zero,
  rw add_zero,
  cases a,
  rw N.zero_eq_zero,
  rw zero_sub_helper_succ,
  rw pos_add_neg,
  have t := zero_sub (pos (b + 1)),
  rw ← zero_eq_zero at t,
  rw pos_sub_pos at t,
  rw N.zero_eq_zero at t,
  rw t,
  rw ← N.one_eq_one, rw N.one,
  rw N.add_succ,
  rw N.add_zero,
  rw neg_pos_succ,
  rw zero_sub_helper_succ,
  rw pos_add_neg,
  rw ← N.succ_eq_inc,
  cases b,
  rw ← one_eq_one, rw one,
  rw pos_add_pos,
  repeat {rw neg_add_pos},
  rw ← N.succ_eq_inc,
  rw succ_sub_helper_succ,
  rw N.succ_add,
  rw N.zero_add,
  rw succ_sub_helper_succ,
  cases a,
  rw N.zero_eq_zero,
  rw zero_sub_helper_zero,
  rw sub_helper_zero,
  rw zero_add,
  rw zero_sub_helper_succ,
  rw neg_add_pos,
  rw N.succ_eq_inc,
  rw ← one_eq_one, rw one,
  rw neg_add_pos,
  rw ← N.succ_eq_inc,
  rw succ_sub_helper_succ,
  rw pos_add_neg,
  rw ← N.succ_eq_inc,
  rw succ_sub_helper_succ,
  cases a,
  rw N.zero_eq_zero,
  rw zero_sub_helper_zero,
  rw zero_add,
  cases b,
  rw N.zero_eq_zero,
  rw zero_sub_helper_zero,
  rw add_zero,
  rw zero_sub_helper_succ,
  rw neg_add_neg,
  rw N.zero_add,
  rw ← N.succ_eq_inc,
  rw zero_sub_helper_succ,
  rw neg_add_neg,
  cases b,
  rw N.zero_eq_zero,
  rw zero_sub_helper_zero,
  rw add_zero,
  rw N.add_zero,
  rw ← N.succ_eq_inc,
  rw zero_sub_helper_succ,
  rw neg_add_neg,
  repeat {rw N.succ_eq_inc},
  rw N.add_comm b 1,
  repeat {rw N.add_assoc},
end

lemma fir_arg_sub_helper_inc : ∀ (a b : N), sub_helper (a + 1) b = (sub_helper a b) + 1
| 0 0 :=
begin
  rw ← N.succ_eq_inc,
  rw succ_sub_helper_zero,
  rw zero_sub_helper_zero,
  rw ← zero_eq_zero,
  rw ← one_eq_one, rw one,
  rw pos_add_pos,
  rw N.zero_eq_zero,
  rw N.zero_add,
end
| 0 (N.succ b) :=
begin
  rw ← N.succ_eq_inc,
  rw succ_sub_helper_succ,
  cases b,
  rw N.zero_eq_zero,
  rw zero_sub_helper_zero,
  rw zero_sub_helper_succ,
  rw ← one_eq_one, rw one,
  rw neg_add_pos,
  rw ← N.succ_eq_inc,
  rw succ_sub_helper_succ,
  rw zero_sub_helper_zero,
  repeat {rw zero_sub_helper_succ},
  rw ← one_eq_one, rw one,
  rw neg_add_pos,
  rw ← N.succ_eq_inc,
  rw succ_sub_helper_succ,
  rw zero_sub_helper_succ,
end
| (N.succ a) 0 :=
begin
  repeat {rw sub_helper_zero},
  rw ← one_eq_one, rw one,
  rw pos_add_pos,
  rw ← N.one_eq_one, rw N.one,
end
| (N.succ a) (N.succ b) :=
begin
  rw ← N.succ_eq_inc,
  repeat {rw succ_sub_helper_succ},
  exact (fir_arg_sub_helper_inc a b),
end

lemma sec_arg_sub_helper_inc : ∀ (a b : N), sub_helper a (b + 1) = (sub_helper a b) - 1
| 0 0 :=
begin
  rw ← N.succ_eq_inc,
  rw zero_sub_helper_succ,
  rw zero_sub_helper_zero,
  rw ← zero_eq_zero,
  rw ← one_eq_one, rw one,
  rw pos_sub_pos,
  rw N.zero_eq_zero,
  rw zero_sub_helper_succ,
end
| 0 (N.succ b) :=
begin
  rw ← N.succ_eq_inc,
  repeat {rw zero_sub_helper_succ},
  rw ← one_eq_one, rw one,
  rw neg_sub_pos,
  rw N.add_succ,
  rw N.add_zero,
end
| (N.succ a) 0 :=
begin
  rw ← N.succ_eq_inc,
  rw succ_sub_helper_succ,
  rw succ_sub_helper_zero,
  rw sub_helper_zero,
  rw ← one_eq_one, rw one,
  rw pos_sub_pos,
  rw succ_sub_helper_succ,
  rw sub_helper_zero,
end
| (N.succ a) (N.succ b) :=
begin
  rw ← N.succ_eq_inc,
  rw succ_sub_helper_succ,
  rw succ_sub_helper_succ,
  exact (sec_arg_sub_helper_inc a b),
end

lemma infix_inc_eq (a b c d : Z) : (a + 1 + b = c + 1 + d) -> (a + b = c + d) :=
begin
  intro h,
  cases a,
  cases b,
  cases c,
  cases d,
  rw ← one_eq_one at h, rw one at h,
  repeat {rw pos_add_pos},
  repeat {rw pos_add_pos at h},
  have s := pos_eq_pos _ _ h,
  rw N.add_comm a _ at s,
  rw N.add_comm c _ at s,
  repeat {rw N.add_assoc at s},
  have t := N.add_eq _ _ _ s,
  rw t,
  rw ← one_eq_one at h, rw one at h,
  repeat {rw pos_add_pos at h},
  rw pos_add_neg at h,
  rw ← N.one at h, rw N.one_eq_one at h,
  repeat {rw ← N.succ_eq_inc at h},
  rw succ_sub_helper_succ at h,
  rw pos_add_neg,
  have s := sub_helper c d,
  rw sec_arg_sub_helper_inc,
  cases (sub_helper c d),
  rw ← h,
  rw ← one_eq_one, rw one,
  rw pos_sub_pos,
  rw N.succ_add,
  rw succ_sub_helper_succ,
  rw sub_helper_zero,
  rw ← h,
  rw ← one_eq_one, rw one,
  rw pos_sub_pos,
  rw N.succ_add,
  rw succ_sub_helper_succ,
  rw sub_helper_zero,
  cases d,
  repeat {rw add_one_assoc at h},
  rw ← one_eq_one at h, rw one at h,
  repeat {rw pos_add_pos at h},
  rw neg_add_pos at h,
  rw neg_add_pos,
  rw ← N.one at h, rw N.one_eq_one at h,
  rw N.add_comm 1 d at h,
  rw fir_arg_sub_helper_inc _ _ at h,
  rw N.add_comm 1 b at h,
  rw ← N.add_assoc at h,
  rw ← pos_add_pos at h,
  rw ← N.one_eq_one at h, rw N.one at h,
  rw ← one at h, rw one_eq_one at h,
  exact (right_add_one_eq _ _ h),
  rw ← one_eq_one at h, rw one at h,
  repeat {rw pos_add_pos at h},
  rw pos_add_neg at h,
  exfalso,
  rw ← N.succ_eq_inc at h,
  rw succ_sub_helper_succ at h,
  cases d,
  rw N.zero_eq_zero at h,
  rw zero_sub_helper_zero at h,
  rw add_zero at h,
  cases h,
  rw zero_sub_helper_succ at h,
  rw neg_add_neg at h,
  cases h,
  rw ← one_eq_one at h, rw one at h,
  rw pos_add_neg at h,
  rw ← N.succ_eq_inc at h,
  rw succ_sub_helper_succ at h,
  cases d,
  rw pos_add_pos at h,
  cases c,
  rw pos_add_pos,
  rw pos_add_pos at h,
  cases b,
  rw N.zero_eq_zero at h,
  rw zero_sub_helper_zero at h,
  rw add_zero at h,
  rw h,
  rw pos_add_neg,
  rw ← N.succ_eq_inc,
  rw N.succ_add,
  rw N.add_succ,
  rw succ_sub_helper_succ,
  rw N.zero_eq_zero,
  rw sub_helper_zero,
  rw N.zero_add,
  rw zero_sub_helper_succ at h,
  rw pos_add_neg,
  rw sec_arg_sub_helper_inc,
  rw pos_add_neg at h,
  rw N.succ_eq_inc,
  rw h,
  rw ← one_eq_one, rw one,
  rw pos_sub_pos,
  rw N.succ_add,
  rw N.add_succ,
  rw succ_sub_helper_succ,
  rw sub_helper_zero,
  rw N.zero_add,
  cases b,
  rw N.zero_eq_zero at h,
  rw zero_sub_helper_zero at h,
  rw add_zero at h,
  rw h,
  rw neg_add_pos,
  rw N.succ_add,
  rw N.zero_add,
  rw neg_add_pos,
  rw N.succ_eq_inc,
  rw fir_arg_sub_helper_inc,
  rw add_one_assoc,
  rw ← one_eq_one, rw one,
  rw pos_add_neg,
  rw ← N.succ_eq_inc N.zero,
  rw succ_sub_helper_succ,
  rw N.zero_eq_zero,
  rw zero_sub_helper_zero,
  rw add_zero,
  rw zero_sub_helper_succ at h,
  rw pos_add_neg,
  rw sec_arg_sub_helper_inc,
  rw N.succ_eq_inc,
  rw ← pos_add_neg,
  rw h,
  rw N.add_comm,
  rw neg_add_pos,
  rw ← N.one, rw N.one_eq_one,
  rw fir_arg_sub_helper_inc,
  rw sub_eq_neg_add,
  rw add_one_assoc,
  rw ← sub_eq_neg_add,
  rw sub_eq,
  rw add_zero,rw neg_add_pos,
  cases b,
  rw N.zero_eq_zero at h,
  rw zero_sub_helper_zero at h,
  rw add_zero at h,
  rw h,
  rw pos_add_neg,
  rw ← N.succ_eq_inc,
  rw succ_sub_helper_succ,
  cases d,
  rw N.zero_eq_zero,
  rw zero_sub_helper_zero,
  rw add_zero,
  rw zero_sub_helper_succ,
  cases c,
  repeat {rw pos_add_neg},
  nth_rewrite 1 sec_arg_sub_helper_inc,
  rw N.succ_eq_inc,
  rw sub_eq_neg_add,
  rw ← one_eq_one, rw one,
  rw neg_pos_succ,
  rw N.zero_eq_zero,
  repeat {rw neg_add_neg},
  rw N.succ_eq_inc,
  rw N.zero_eq_zero,
  rw N.add_zero,
  repeat {rw N.add_assoc},
  rw zero_sub_helper_succ at h,
  rw pos_add_neg at h,
  rw sec_arg_sub_helper_inc,
  rw N.succ_eq_inc,
  rw h,
  rw pos_add_neg,
  rw ← N.succ_eq_inc,
  rw succ_sub_helper_succ,
  cases d,
  rw N.zero_eq_zero,
  rw zero_sub_helper_zero,
  rw add_zero,
  rw sub_eq_neg_add,
  rw ← one_eq_one, rw one,
  rw neg_pos_succ,
  rw zero_sub_helper_succ,
  cases c,
  repeat {rw pos_add_neg},
  nth_rewrite 1 sec_arg_sub_helper_inc,
  rw N.succ_eq_inc,
  repeat {rw neg_add_neg},
  rw ← one_eq_one, rw one,
  rw neg_sub_pos,
  rw N.succ_eq_inc d,
  repeat {rw N.add_assoc},
  rw ← N.one, rw N.one_eq_one,
  cases b,
  rw ← one_eq_one at h, rw one at h,
  rw pos_add_pos at h,
  rw neg_add_pos at h,
  rw ← N.succ_eq_inc at h,
  rw N.succ_add at h,
  rw N.zero_add at h,
  rw succ_sub_helper_succ at h,
  rw neg_add_pos,
  rw sec_arg_sub_helper_inc,
  rw h,
  cases d,
  rw pos_add_pos,
  cases c,
  rw pos_add_pos,
  rw ← one_eq_one, rw one,
  rw pos_sub_pos,
  rw N.succ_add,
  rw N.zero_add,
  rw N.add_succ,
  rw succ_sub_helper_succ,
  rw sub_helper_zero,
  rw pos_add_pos,
  rw neg_add_pos,
  rw ← sec_arg_sub_helper_inc,
  rw ← N.one_eq_one, rw N.one,
  rw N.succ_add,
  rw N.zero_add,
  repeat {rw N.add_succ, rw N.add_zero},
  rw succ_sub_helper_succ,
  rw neg_add_pos,
  rw N.succ_eq_inc,
  rw pos_add_neg,
  rw ← N.succ_eq_inc,
  rw succ_sub_helper_succ,
  cases d,
  rw N.zero_eq_zero,
  rw zero_sub_helper_zero,
  rw add_zero,
  rw ← one_eq_one, rw one,
  rw sub_eq_neg_add,
  rw neg_pos_succ,
  rw zero_sub_helper_succ,
  cases c,
  rw pos_add_neg,
  rw ← sec_arg_sub_helper_inc,
  rw ← pos_add_neg,
  rw N.succ_eq_inc,
  repeat {rw neg_add_neg},
  rw ← one_eq_one, rw one,
  rw neg_sub_pos,
  rw ← N.one, rw N.one_eq_one,
  rw N.succ_eq_inc,
  repeat {rw N.add_assoc},
  rw ← one_eq_one at h, rw one at h,
  rw pos_add_neg at h,
  rw ← N.succ_eq_inc at h,
  rw succ_sub_helper_succ at h,
  cases b,
  rw N.zero_eq_zero at h,
  rw zero_sub_helper_zero at h,
  rw add_zero at h,
  rw N.zero_eq_zero,
  rw ← N.add_assoc,
  rw ← neg_add_neg,
  rw h,
  cases d,
  rw pos_add_pos,
  cases c,
  rw pos_add_pos,
  rw pos_add_neg,
  rw ← N.succ_eq_inc,
  rw N.succ_add,
  rw N.zero_add,
  rw N.add_succ,
  rw succ_sub_helper_succ,
  rw sub_helper_zero,
  rw pos_add_pos,
  rw neg_add_pos,
  rw ← neg_pos_succ,
  rw ← sub_eq_neg_add,
  rw ← one, rw one_eq_one,
  rw ← sec_arg_sub_helper_inc,
  nth_rewrite 0 ← N.one_eq_one, rw N.one,
  rw N.add_succ,
  repeat {rw N.succ_add},
  rw succ_sub_helper_succ,
  rw N.add_zero,
  rw neg_add_pos,
  rw N.zero_add,
  rw pos_add_neg,
  rw ← N.succ_eq_inc,
  rw succ_sub_helper_succ,
  cases d,
  rw N.zero_eq_zero,
  rw zero_sub_helper_zero,
  rw add_zero,
  rw zero_sub_helper_succ,
  cases c,
  rw pos_add_neg,
  rw ← neg_pos_succ,
  rw ← sub_eq_neg_add,
  rw ← one, rw one_eq_one,
  rw ← sec_arg_sub_helper_inc,
  rw ← pos_add_neg,
  rw N.succ_eq_inc,
  repeat {rw neg_add_neg},
  rw N.add_zero,
  rw N.succ_eq_inc,
  repeat {rw N.add_assoc},
  rw zero_sub_helper_succ at h,
  rw neg_add_neg at h,
  rw N.succ_eq_inc,
  rw ← N.add_assoc,
  nth_rewrite 1 ← N.one_eq_one, rw N.one,
  rw N.succ_eq_inc,
  repeat {rw ← N.add_assoc},
  rw ← neg_add_neg,
  rw h,
  cases d,
  rw pos_add_pos,
  rw N.succ_add,
  rw N.zero_add,
  cases c,
  repeat {rw pos_add_pos},
  rw pos_add_neg,
  rw ← N.succ_eq_inc,
  rw N.add_succ,
  rw succ_sub_helper_succ,
  rw sub_helper_zero,
  rw neg_add_pos,
  rw ← neg_pos_succ,
  rw ← sub_eq_neg_add,
  rw ← one, rw one_eq_one,
  rw ← N.succ_eq_inc,
  rw ← sec_arg_sub_helper_inc,
  rw N.succ_add,
  rw succ_sub_helper_succ,
  rw ← neg_add_pos,
  rw pos_add_neg,
  rw ← N.succ_eq_inc,
  rw succ_sub_helper_succ,
  cases d,
  rw N.zero_eq_zero,
  rw zero_sub_helper_zero,
  rw add_zero,
  rw zero_sub_helper_succ,
  cases c,
  rw pos_add_neg,
  rw ← N.one_eq_one, rw N.one,
  rw ← neg_pos_succ,
  rw ← sub_eq_neg_add,
  rw ← one, rw one_eq_one,
  rw ← sec_arg_sub_helper_inc,
  rw ← pos_add_neg,
  rw N.add_succ,
  rw N.add_zero,
  repeat {rw neg_add_neg},
  rw N.add_zero,
  rw N.succ_eq_inc,
  repeat {rw N.add_assoc},
end

lemma neg_eq (a b : Z) : (a = b) -> (neg a = neg b) :=
begin
  intro h,
  rw h,
end

lemma neg_sub_helper : ∀ (a b : N), neg (sub_helper a b) = sub_helper b a
| 0 0 :=
begin
  rw zero_sub_helper_zero,
  rw neg_zero,
end
| 0 (N.succ b) :=
begin
  rw succ_sub_helper_zero,
  rw zero_sub_helper_succ,
  rw neg_neg_succ,
  rw N.succ_eq_inc,
end
| (N.succ a) 0 :=
begin
  rw succ_sub_helper_zero,
  rw zero_sub_helper_succ,
  rw neg_pos_succ,
end
| (N.succ a) (N.succ b) :=
begin
  repeat {rw succ_sub_helper_succ},
  exact (neg_sub_helper a b),
end

lemma neg_add (a b : Z) : neg (a + b) = neg a + neg b :=
begin
  cases a,
  cases a,
  rw zero_eq_zero,
  rw neg_zero,
  repeat {rw zero_add},
  rw neg_pos_succ,
  cases b,
  cases b,
  rw zero_eq_zero,
  rw neg_zero,
  repeat {rw add_zero},
  rw neg_pos_succ,
  rw pos_add_pos,
  rw N.add_succ,
  rw neg_pos_succ,
  rw neg_pos_succ,
  rw neg_add_neg,
  rw N.succ_add,
  rw ← N.succ_eq_inc,
  rw neg_neg_succ,
  rw pos_add_neg,
  rw neg_sub_helper,
  rw neg_add_pos,
  rw N.succ_eq_inc,
  rw neg_neg_succ,
  cases b,
  rw neg_add_pos,
  rw neg_sub_helper,
  cases b,
  rw N.zero_eq_zero,
  rw ← N.zero_eq_zero,
  rw zero_eq_zero,
  rw neg_zero,
  rw add_zero,
  rw N.zero_eq_zero,
  rw sub_helper_zero,
  rw neg_pos_succ,
  rw pos_add_neg,
  rw N.succ_eq_inc,
  rw neg_add_neg,
  repeat {rw neg_neg_succ},
  rw pos_add_pos,
  rw ← N.add_assoc,
  rw N.add_assoc a 1 b,
  rw N.add_comm 1 b,
  rw ← N.add_assoc,
end

lemma neg_Z_eq_neg_Z (a b : Z) : (neg a = neg b) -> (a = b) :=
begin
  intro h,
  cases a,
  cases a,
  rw zero_eq_zero at h,
  rw neg_zero at h,
  rw zero_eq_zero,
  cases b,
  cases b,
  rw zero_eq_zero,
  exfalso,
  rw neg_pos_succ at h,
  cases h,
  exfalso,
  rw neg_neg_succ at h,
  rw ← zero_eq_zero at h,
  have t := pos_eq_pos _ _ h,
  exact N.zero_neq_succ _ t,
  rw neg_pos_succ at h,
  cases b,
  cases b,
  exfalso,
  rw zero_eq_zero at h,
  rw neg_zero at h,
  cases h,
  rw neg_pos_succ at h,
  have t := neg_eq_neg _ _ h,
  rw t,
  rw neg_neg_succ at h,
  exfalso,
  cases h,
  rw neg_neg_succ at h,
  cases b,
  cases b,
  rw zero_eq_zero at h,
  rw neg_zero at h,
  exfalso,
  rw ← N.succ_eq_inc at h,
  rw ← zero_eq_zero at h,
  have t := pos_eq_pos _ _ h,
  exact (N.succ_neq_zero _ t),
  rw neg_pos_succ at h,
  exfalso,
  cases h,
  rw neg_neg_succ at h,
  have t := pos_eq_pos _ _ h,
  repeat {rw ← N.succ_eq_inc at t},
  have q := N.succ_eq _ _ t,
  rw q,
end

lemma add_eq_pos (a b: Z) (d: N): ((pos d) + a = (pos d) + b) -> (a = b) :=
begin
  intro h,
  induction d,
  rw zero_eq_zero at h,
  rw zero_add at h,
  rw zero_add at h,
  exact h,
  rw succ_eq_inc at h,
  have t := infix_inc_eq _ _ _ _ h,
  exact (d_ih t),
end

lemma add_eq_neg (a b: Z) (d: N): ((neg_succ d) + a = (neg_succ d) + b) -> (a = b) :=
begin
  intro h,
  have t := neg_eq _ _ h,
  repeat {rw neg_add at t},
  repeat {rw neg_neg_succ at t},
  have q := add_eq_pos _ _ _ t,
  exact (neg_Z_eq_neg_Z _ _ q),
end

theorem add_eq (a b d : Z): (d + a = d + b) -> (a = b) :=
begin
  intro h,
  cases d,
  exact add_eq_pos _ _ _ h,
  exact add_eq_neg _ _ _ h,
end

lemma sub_helper_add_pos (a b c : N) : sub_helper a b + pos c = sub_helper (a + c) b :=
begin
  induction c,
  rw zero_eq_zero,
  rw add_zero,
  rw N.zero_eq_zero,
  rw N.add_zero,
  rw N.succ_eq_inc,
  rw ← N.add_assoc,
  rw fir_arg_sub_helper_inc,
  rw ← c_ih,
  cases sub_helper a b,
  rw ← one_eq_one, rw one,
  repeat {rw pos_add_pos},
  rw ← N.one, rw N.one_eq_one,
  rw N.add_assoc,
  repeat {rw neg_add_pos},
  rw ← fir_arg_sub_helper_inc,
end

lemma pos_add_sub_helper (a b c : N) : pos a + sub_helper b c = sub_helper (a + b) c :=
begin
  induction a,
  rw zero_eq_zero,
  rw zero_add,
  rw N.zero_eq_zero,
  rw N.zero_add,
  rw N.succ_add,
  rw N.succ_eq_inc (a_n + b),
  rw fir_arg_sub_helper_inc,
  rw ← a_ih,
  cases sub_helper b c,
  rw ← one_eq_one, rw one,
  repeat {rw pos_add_pos},
  rw N.succ_add,
  rw N.add_succ,
  rw N.add_zero,
  repeat {rw pos_add_neg},
  rw ← fir_arg_sub_helper_inc,
  rw N.succ_eq_inc,
end

lemma sub_helper_add_neg (a b c : N) : sub_helper a b + neg_succ c = sub_helper a (b + c + 1) :=
begin
  induction c,
  rw N.zero_eq_zero,
  rw N.add_zero,
  rw ← neg_pos_succ,
  rw ← sub_eq_neg_add,
  rw ← one, rw one_eq_one,
  rw sec_arg_sub_helper_inc,
  rw N.add_succ,
  rw N.succ_add,
  rw N.succ_eq_inc (b + c_n + 1),
  rw sec_arg_sub_helper_inc,
  rw ← c_ih,
  cases sub_helper a b,
  repeat {rw pos_add_neg},
  rw ← sec_arg_sub_helper_inc,
  rw N.succ_eq_inc,
  rw sub_eq_neg_add,
  rw ← one_eq_one, rw one,
  rw neg_pos_succ,
  repeat {rw neg_add_neg},
  rw N.succ_eq_inc,
  rw N.add_zero,
  repeat {rw N.add_assoc},
end

lemma neg_add_sub_helper (a b c : N) : neg_succ a + sub_helper b c = sub_helper b (a + c + 1) :=
begin
  induction a,
  rw N.zero_eq_zero,
  rw N.zero_add,
  rw ← neg_pos_succ,
  rw ← one, rw one_eq_one,
  rw one_sub_comm,
  rw sec_arg_sub_helper_inc,
  repeat {rw N.succ_add},
  rw N.succ_eq_inc (a_n + c + 1),
  rw sec_arg_sub_helper_inc,
  rw ← a_ih,
  cases sub_helper b c,
  repeat {rw neg_add_pos},
  rw ← sec_arg_sub_helper_inc,
  rw N.succ_eq_inc,
  repeat {rw neg_add_neg},
  rw ← one_eq_one, rw one,
  rw neg_sub_pos,
  repeat {rw N.succ_add},
  rw N.add_succ,
  rw N.add_zero,
end

theorem add_assoc (a b c : Z) : a + b + c = a + (b + c) :=
begin
  cases a,
  induction a,
  rw zero_eq_zero,
  rw zero_add,
  rw zero_add,
  cases b,
  rw pos_add_pos,
  rw pos_add_pos at a_ih,
  cases c,
  repeat {rw pos_add_pos},
  repeat {rw N.add_assoc},
  repeat {rw pos_add_neg},
  repeat {rw pos_add_neg at a_ih},
  rw N.succ_add,
  rw N.succ_eq_inc,
  rw fir_arg_sub_helper_inc,
  rw a_ih,
  cases sub_helper b (c + 1),
  rw ← one_eq_one, rw one,
  repeat {rw pos_add_pos},
  rw N.succ_add,
  rw N.add_succ,
  rw N.add_zero,
  repeat {rw pos_add_neg},
  rw ← fir_arg_sub_helper_inc,
  rw N.succ_eq_inc,
  cases c,
  rw sub_helper_add_pos,
  rw neg_add_pos,
  rw pos_add_sub_helper,
  rw neg_add_neg,
  rw pos_add_neg,
  rw sub_helper_add_neg,
  rw N.add_assoc b 1 c,
  rw N.add_comm 1 c,
  rw ← N.add_assoc,
  cases b,
  rw neg_add_pos,
  cases c,
  rw pos_add_pos,
  rw neg_add_pos,
  rw sub_helper_add_pos,
  rw sub_helper_add_neg,
  rw pos_add_neg,
  rw neg_add_sub_helper,
  rw N.add_comm c 1,
  repeat {rw N.add_assoc},
  rw neg_add_neg,
  cases c,
  repeat {rw neg_add_pos},
  rw neg_add_sub_helper,
  repeat {rw N.add_assoc},
  repeat {rw neg_add_neg},
  rw ← N.one_eq_one, rw N.one,
  repeat {rw N.add_succ},
  repeat {rw N.add_zero},
  rw N.succ_add,
  rw N.add_assoc,
end

theorem add_comm (a b : Z): a + b = b + a :=
begin
  cases a,
  cases b,
  repeat {rw pos_add_pos},
  rw N.add_comm,
  rw pos_add_neg,
  rw neg_add_pos,
  cases b,
  rw neg_add_pos,
  rw pos_add_neg,
  repeat {rw neg_add_neg},
  rw N.add_comm a b,
end

end Z


import prelim.embed prelim.minmax set_tactic.solver
import matroid.rankfun matroid.dual

open_locale classical
noncomputable theory

universes u v w

open matroid set list

variables {α : Type*} [fintype α] {N M : matroid α}

section weak_image
/- M is a weak image N if the rank in N is upper-bounded by the rank in M -/
def is_weak_image (N M : matroid α) :=
  ∀ X, N.r X ≤ M.r X

instance weak_image_le : has_le (matroid α) :=
⟨λ N M, is_weak_image N M⟩

lemma weak_image_r_set (h : N ≤ M) (X : set α) :
  N.r X ≤ M.r X :=
h X

lemma weak_image_iff_indep:
  N ≤ M ↔ ∀ X, N.is_indep X → M.is_indep X :=
begin
  simp_rw indep_iff_r,
  refine ⟨λ h, λ X hX, le_antisymm (M.rank_le_size _) _, λ h, λ Y, _⟩,
  {  rw ←hX, apply h},
  rcases exists_basis_of N Y with ⟨BN,⟨hN1, ⟨hN2, hN3⟩⟩⟩,
  exact le_trans (by rw [h _ hN2, ←hN3, hN2]) (M.rank_mono hN1),
end

lemma indep_of_weak_image_indep (h : N ≤ M){I : set α} (hI : N.is_indep I) :
  M.is_indep I :=
weak_image_iff_indep.mp h I hI

lemma weak_image_iff_dep:
  N ≤ M ↔ ∀ X, M.is_dep X → N.is_dep X :=
by simp_rw [weak_image_iff_indep, indep_iff_not_dep, not_imp_not]

lemma weak_image_iff_cct:
  N ≤ M ↔ ∀ C, M.is_circuit C → ∃ C', N.is_circuit C' ∧ C' ⊆ C :=
begin
  simp_rw [weak_image_iff_dep, dep_iff_contains_circuit],
  refine ⟨λ h, λ C hC, _, λ h, λ X hX, _⟩,
  {  apply h, exact ⟨C,hC,subset_refl _⟩,},
  rcases hX with ⟨C, ⟨h', h''⟩⟩,
  rcases h C h' with ⟨C',h1,h2⟩,
  exact ⟨C', h1, subset.trans h2 h''⟩,
end

lemma weak_image_tfae:
  tfae
[ N ≤ M,
  ∀ X, N.r X ≤ M.r X,
  ∀ X, N.is_indep X → M.is_indep X,
  ∀ X, M.is_dep X → N.is_dep X,
  ∀ C, M.is_circuit C → ∃ C', N.is_circuit C' ∧ C' ⊆ C] :=
begin
  tfae_have : 1 ↔ 2, unfold has_le.le is_weak_image,
  tfae_have : 1 ↔ 3, apply weak_image_iff_indep,
  tfae_have : 1 ↔ 4, apply weak_image_iff_dep,
  tfae_have : 1 ↔ 5, apply weak_image_iff_cct,
  tfae_finish,
end
/- that was fun! -/

lemma weak_image_rank_zero_of_rank_zero (h : N ≤ M){X : set α} (hX : M.r X = 0) :
  N.r X = 0 :=
by {apply rank_eq_zero_of_le_zero, rw ←hX, apply h}

lemma weak_image_loop_of_loop (h : N ≤ M){e : α} (he : M.is_loop e) :
  N.is_loop e :=
weak_image_rank_zero_of_rank_zero h he

lemma nonloop_of_weak_image_nonloop (h : N ≤ M){e : α} (he : N.is_nonloop e) :
  M.is_nonloop e :=
by {rw is_nonloop at *, linarith [rank_single_ub M e, h {e}], }

lemma loops_weak_image (h : N ≤ M) :
  loops M ⊆ loops N :=
by {intro e, simp only [←loop_iff_mem_loops], apply weak_image_loop_of_loop h }

end weak_image

section quotient
/-- a quotient of M is a matroid N for which rank differences of nested pairs in N are at most
the corresponding rank differences in M. This is equivalent to the existence of a matroid P for
which M is a deletion of P and N is a contraction of P, but we do not show this equivalence here.-/
def is_quotient (N M : matroid α) :=
  ∀ X Y, X ⊆ Y → N.r Y - N.r X ≤ M.r Y - M.r X

reserve infixl ` ≼ `:75
infix ` ≼ ` :=  is_quotient

lemma quotient_iff_r :
  N ≼ M ↔ ∀ X Y, X ⊆ Y → N.r Y - N.r X ≤ M.r Y - M.r X :=
by rw is_quotient

lemma rank_diff_of_quotient (hNM : N ≼ M) {X Y : set α} (h : X ⊆ Y) :
  N.r Y - N.r X ≤ M.r Y - M.r X :=
hNM _ _ h

lemma weak_image_of_quotient (h : N ≼ M) :
   N ≤ M :=
λ X, by {convert h ∅ X (empty_subset _); simp, }

lemma quotient_of_cl (h : ∀ X, M.cl X ⊆ N.cl X) :
   N ≼ M :=
begin
  set P : set α × set α → Prop :=
  (λ p, p.1 ⊆ p.2 → N.r p.2 - N.r p.1 ≤ M.r p.2 - M.r p.1 ) with hP,
  suffices : ∀ p, P p, exact λ X Y, this ⟨X,Y⟩,
  apply nonneg_int_strong_induction_param P (λ p, size (p.2 \ p.1)),
  { rintros ⟨X,Y⟩, apply size_nonneg},
  { rintros ⟨X,Y⟩ hs hXY, dsimp only at *,
    rw [size_zero_iff_empty, diff_empty_iff_subset] at hs,
    rw [subset.antisymm hXY hs, sub_self, sub_self],  },
  rintros ⟨X,Y⟩ h_size h' hXY, dsimp only at *,
  cases exists_mem_of_size_pos h_size with e he,
  specialize h' ⟨X, Y \ {e}⟩ _ _,
  { dsimp only, rw [diff_right_comm, size_remove_mem he], linarith},
  { dsimp only, apply subset_of_remove_mem_diff; assumption,},
  dsimp only at h',
  suffices : N.r Y - N.r (Y \ {e}) ≤ M.r Y - M.r (Y \ {e}), by linarith,
  by_cases hY : M.r Y = M.r (Y \ {e}), swap,
  { rw [rank_eq_sub_one_of_ne_remove _ _ _ hY], linarith [rank_remove_single_lb N Y e]  },
  rw [hY, sub_self],
  rw [eq_comm, rank_removal_iff_closure _ _ he.1]  at hY,
  have hN := mem_of_subset (h _) hY, rw [←rank_removal_iff_closure _ _ he.1] at hN,
  linarith,
end

lemma quotient_iff_dual_quotient :
  N ≼ M ↔ M.dual ≼ N.dual :=
begin
  suffices h' : ∀ (N M : matroid α), N ≼ M → M.dual ≼ N.dual,
  exact ⟨λ h, h' _ _ h, λ h, by {convert h' _ _ h; rw dual_dual, }⟩,
  intros N M h X Y hXY,
  simp_rw [dual_r],
  rw compl_subset_compl.symm at hXY,
  linarith [h _ _ hXY],
end

lemma quotient_tfae :
  tfae
[N ≼ M,
 ∀ F, N.is_flat F → M.is_flat F,
 ∀ X Y, X ⊆ Y → N.r Y - N.r X ≤ M.r Y - M.r X,
 ∀ X, M.cl X ⊆ N.cl X,
 M.dual ≼ N.dual] :=
begin
  tfae_have : 1 ↔ 3, unfold is_quotient,
  tfae_have : 3 → 2,
  {exact λ h, λ F hF Y hFY, by linarith [hF _ hFY, h _ _ hFY.1],},
  tfae_have : 2 → 4,
  {exact λ h X, subset_flat X _ (subset_cl N X) (h _ (N.cl_is_flat X))},
  tfae_have: 4 → 1, apply quotient_of_cl,
  tfae_have : 1 ↔ 5, apply quotient_iff_dual_quotient,
  tfae_finish,
end

lemma quotient_iff_flat :
  N ≼ M ↔ ∀ F, N.is_flat F → M.is_flat F :=
by apply @tfae.out _ quotient_tfae 0 1

lemma flat_of_quotient_flat (h : N ≼ M){F : set α} (hF : N.is_flat F) :
  M.is_flat F :=
(quotient_iff_flat.mp h) F hF

lemma indep_of_quotient_indep (h : N ≼ M){I : set α} (hI : N.is_indep I) :
  M.is_indep I :=
indep_of_weak_image_indep (weak_image_of_quotient h) hI

lemma quotient_iff_cl :
  N ≼ M ↔ ∀ X, M.cl X ⊆ N.cl X :=
by apply @tfae.out _ quotient_tfae 0 3

lemma quotient_rank_zero_of_rank_zero (h : N ≼ M){X : set α} (hX : M.r X = 0) :
  N.r X = 0 :=
weak_image_rank_zero_of_rank_zero (weak_image_of_quotient h) hX

lemma quotient_loop_of_loop (h : N ≼ M){e : α} (he : M.is_loop e) :
  N.is_loop e :=
weak_image_loop_of_loop (weak_image_of_quotient h) he

lemma nonloop_of_quotient_nonloop (h : N ≼ M){e : α} (he : N.is_nonloop e) :
  M.is_nonloop e :=
nonloop_of_weak_image_nonloop (weak_image_of_quotient h) he

lemma loops_quotient (h : N ≼ M) :
  loops M ⊆ loops N :=
loops_weak_image (weak_image_of_quotient h)

lemma eq_of_eq_rank_quotient (h : N ≼ M) (hr : N.r univ = M.r univ) :
  N = M :=
begin
  ext X, by_contra hn,
  /- take a maximal set on which the ranks of N and M differ. -/
  rcases maximal_example_aug (λ X, ¬N.r X = M.r X) hn with ⟨Y, hXY, h',h''⟩,
  dsimp only at h'', simp_rw [not_not] at h'', clear hXY hn X,
  have hY : Y ≠ univ := λ hY, by {rw ←hY at hr, exact h' hr },
  cases ne_univ_iff_has_nonmem.mp hY with e heY,
  specialize h'' e heY,
  have hle := weak_image_of_quotient h,
  rw quotient_iff_cl at h,
  by_cases hM : e ∈ M.cl Y,
  { rw [(mem_cl_iff_r.mp hM)] at h'',
    rw [←h'', eq_comm, ←mem_cl_iff_r] at h',
    exact h' (mem_of_mem_of_subset hM (h _))},
  rw nonmem_cl_iff_r at hM,
  linarith [int.le_sub_one_of_le_of_ne (hle _) h', rank_augment_single_ub N Y e],
end

end quotient


/-
Copyright (c) 2020 Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sébastien Gouëzel, Yury Kudryashov
-/
import analysis.calculus.deriv
import measure_theory.constructions.borel_space
import measure_theory.function.strongly_measurable
import tactic.ring_exp

/-!
# Derivative is measurable

In this file we prove that the derivative of any function with complete codomain is a measurable
function. Namely, we prove:

* `measurable_set_of_differentiable_at`: the set `{x | differentiable_at 𝕜 f x}` is measurable;
* `measurable_fderiv`: the function `fderiv 𝕜 f` is measurable;
* `measurable_fderiv_apply_const`: for a fixed vector `y`, the function `λ x, fderiv 𝕜 f x y`
  is measurable;
* `measurable_deriv`: the function `deriv f` is measurable (for `f : 𝕜 → F`).

We also show the same results for the right derivative on the real line
(see `measurable_deriv_within_Ici` and ``measurable_deriv_within_Ioi`), following the same
proof strategy.

## Implementation

We give a proof that avoids second-countability issues, by expressing the differentiability set
as a function of open sets in the following way. Define `A (L, r, ε)` to be the set of points
where, on a ball of radius roughly `r` around `x`, the function is uniformly approximated by the
linear map `L`, up to `ε r`. It is an open set.
Let also `B (L, r, s, ε) = A (L, r, ε) ∩ A (L, s, ε)`: we require that at two possibly different
scales `r` and `s`, the function is well approximated by the linear map `L`. It is also open.

We claim that the differentiability set of `f` is exactly
`D = ⋂ ε > 0, ⋃ δ > 0, ⋂ r, s < δ, ⋃ L, B (L, r, s, ε)`.
In other words, for any `ε > 0`, we require that there is a size `δ` such that, for any two scales
below this size, the function is well approximated by a linear map, common to the two scales.

The set `⋃ L, B (L, r, s, ε)` is open, as a union of open sets. Converting the intersections and
unions to countable ones (using real numbers of the form `2 ^ (-n)`), it follows that the
differentiability set is measurable.

To prove the claim, there are two inclusions. One is trivial: if the function is differentiable
at `x`, then `x` belongs to `D` (just take `L` to be the derivative, and use that the
differentiability exactly says that the map is well approximated by `L`). This is proved in
`mem_A_of_differentiable` and `differentiable_set_subset_D`.

For the other direction, the difficulty is that `L` in the union may depend on `ε, r, s`. The key
point is that, in fact, it doesn't depend too much on them. First, if `x` belongs both to
`A (L, r, ε)` and `A (L', r, ε)`, then `L` and `L'` have to be close on a shell, and thus
`∥L - L'∥` is bounded by `ε` (see `norm_sub_le_of_mem_A`). Assume now `x ∈ D`. If one has two maps
`L` and `L'` such that `x` belongs to `A (L, r, ε)` and to `A (L', r', ε')`, one deduces that `L` is
close to `L'` by arguing as follows. Consider another scale `s` smaller than `r` and `r'`. Take a
linear map `L₁` that approximates `f` around `x` both at scales `r` and `s` w.r.t. `ε` (it exists as
`x` belongs to `D`). Take also `L₂` that approximates `f` around `x` both at scales `r'` and `s`
w.r.t. `ε'`. Then `L₁` is close to `L` (as they are close on a shell of radius `r`), and `L₂` is
close to `L₁` (as they are close on a shell of radius `s`), and `L'` is close to `L₂` (as they are
close on a shell of radius `r'`). It follows that `L` is close to `L'`, as we claimed.

It follows that the different approximating linear maps that show up form a Cauchy sequence when
`ε` tends to `0`. When the target space is complete, this sequence converges, to a limit `f'`.
With the same kind of arguments, one checks that `f` is differentiable with derivative `f'`.

To show that the derivative itself is measurable, add in the definition of `B` and `D` a set
`K` of continuous linear maps to which `L` should belong. Then, when `K` is complete, the set `D K`
is exactly the set of points where `f` is differentiable with a derivative in `K`.

## Tags

derivative, measurable function, Borel σ-algebra
-/

noncomputable theory

open set metric asymptotics filter continuous_linear_map
open topological_space (second_countable_topology) measure_theory
open_locale topological_space

namespace continuous_linear_map

variables {𝕜 E F : Type*} [nondiscrete_normed_field 𝕜]
  [normed_group E] [normed_space 𝕜 E] [normed_group F] [normed_space 𝕜 F]

lemma measurable_apply₂ [measurable_space E] [opens_measurable_space E]
  [second_countable_topology E] [second_countable_topology (E →L[𝕜] F)]
  [measurable_space F] [borel_space F] :
  measurable (λ p : (E →L[𝕜] F) × E, p.1 p.2) :=
is_bounded_bilinear_map_apply.continuous.measurable

end continuous_linear_map

section fderiv

variables {𝕜 : Type*} [nondiscrete_normed_field 𝕜]
variables {E : Type*} [normed_group E] [normed_space 𝕜 E]
variables {F : Type*} [normed_group F] [normed_space 𝕜 F]
variables {f : E → F} (K : set (E →L[𝕜] F))

namespace fderiv_measurable_aux

/-- The set `A f L r ε` is the set of points `x` around which the function `f` is well approximated
at scale `r` by the linear map `L`, up to an error `ε`. We tweak the definition to make sure that
this is an open set.-/
def A (f : E → F) (L : E →L[𝕜] F) (r ε : ℝ) : set E :=
{x | ∃ r' ∈ Ioc (r/2) r, ∀ y z ∈ ball x r', ∥f z - f y - L (z-y)∥ ≤ ε * r}

/-- The set `B f K r s ε` is the set of points `x` around which there exists a continuous linear map
`L` belonging to `K` (a given set of continuous linear maps) that approximates well the
function `f` (up to an error `ε`), simultaneously at scales `r` and `s`. -/
def B (f : E → F) (K : set (E →L[𝕜] F)) (r s ε : ℝ) : set E :=
⋃ (L ∈ K), (A f L r ε) ∩ (A f L s ε)

/-- The set `D f K` is a complicated set constructed using countable intersections and unions. Its
main use is that, when `K` is complete, it is exactly the set of points where `f` is differentiable,
with a derivative in `K`. -/
def D (f : E → F) (K : set (E →L[𝕜] F)) : set E :=
⋂ (e : ℕ), ⋃ (n : ℕ), ⋂ (p ≥ n) (q ≥ n), B f K ((1/2) ^ p) ((1/2) ^ q) ((1/2) ^ e)

lemma is_open_A (L : E →L[𝕜] F) (r ε : ℝ) : is_open (A f L r ε) :=
begin
  rw metric.is_open_iff,
  rintros x ⟨r', r'_mem, hr'⟩,
  obtain ⟨s, s_gt, s_lt⟩ : ∃ (s : ℝ), r / 2 < s ∧ s < r' := exists_between r'_mem.1,
  have : s ∈ Ioc (r/2) r := ⟨s_gt, le_of_lt (s_lt.trans_le r'_mem.2)⟩,
  refine ⟨r' - s, by linarith, λ x' hx', ⟨s, this, _⟩⟩,
  have B : ball x' s ⊆ ball x r' := ball_subset (le_of_lt hx'),
  assume y hy z hz,
  exact hr' y (B hy) z (B hz)
end

lemma is_open_B {K : set (E →L[𝕜] F)} {r s ε : ℝ} : is_open (B f K r s ε) :=
by simp [B, is_open_Union, is_open.inter, is_open_A]

lemma A_mono (L : E →L[𝕜] F) (r : ℝ) {ε δ : ℝ} (h : ε ≤ δ) :
  A f L r ε ⊆ A f L r δ :=
begin
  rintros x ⟨r', r'r, hr'⟩,
  refine ⟨r', r'r, λ y hy z hz, (hr' y hy z hz).trans (mul_le_mul_of_nonneg_right h _)⟩,
  linarith [mem_ball.1 hy, r'r.2, @dist_nonneg _ _ y x],
end

lemma mem_A_of_differentiable {ε : ℝ} (hε : 0 < ε) {x : E} (hx : differentiable_at 𝕜 f x) :
  ∃ R > 0, ∀ r ∈ Ioo (0 : ℝ) R, x ∈ A f (fderiv 𝕜 f x) r ε :=
begin
  have := hx.has_fderiv_at,
  simp only [has_fderiv_at, has_fderiv_at_filter, is_o_iff] at this,
  rcases eventually_nhds_iff_ball.1 (this (half_pos hε)) with ⟨R, R_pos, hR⟩,
  refine ⟨R, R_pos, λ r hr, _⟩,
  have : r ∈ Ioc (r/2) r := ⟨half_lt_self hr.1, le_rfl⟩,
  refine ⟨r, this, λ y hy z hz, _⟩,
  calc  ∥f z - f y - (fderiv 𝕜 f x) (z - y)∥
      = ∥(f z - f x - (fderiv 𝕜 f x) (z - x)) - (f y - f x - (fderiv 𝕜 f x) (y - x))∥ :
    by { congr' 1, simp only [continuous_linear_map.map_sub], abel }
  ... ≤ ∥(f z - f x - (fderiv 𝕜 f x) (z - x))∥ + ∥f y - f x - (fderiv 𝕜 f x) (y - x)∥ :
    norm_sub_le _ _
  ... ≤ ε / 2 * ∥z - x∥ + ε / 2 * ∥y - x∥ :
    add_le_add (hR _ (lt_trans (mem_ball.1 hz) hr.2)) (hR _ (lt_trans (mem_ball.1 hy) hr.2))
  ... ≤ ε / 2 * r + ε / 2 * r :
    add_le_add
      (mul_le_mul_of_nonneg_left (le_of_lt (mem_ball_iff_norm.1 hz)) (le_of_lt (half_pos hε)))
      (mul_le_mul_of_nonneg_left (le_of_lt (mem_ball_iff_norm.1 hy)) (le_of_lt (half_pos hε)))
  ... = ε * r : by ring
end

lemma norm_sub_le_of_mem_A {c : 𝕜} (hc : 1 < ∥c∥)
  {r ε : ℝ} (hε : 0 < ε) (hr : 0 < r) {x : E} {L₁ L₂ : E →L[𝕜] F}
  (h₁ : x ∈ A f L₁ r ε) (h₂ : x ∈ A f L₂ r ε) : ∥L₁ - L₂∥ ≤ 4 * ∥c∥ * ε :=
begin
  have : 0 ≤ 4 * ∥c∥ * ε :=
    mul_nonneg (mul_nonneg (by norm_num : (0 : ℝ) ≤ 4) (norm_nonneg _)) hε.le,
  refine op_norm_le_of_shell (half_pos hr) this hc _,
  assume y ley ylt,
  rw [div_div,
      div_le_iff' (mul_pos (by norm_num : (0 : ℝ) < 2) (zero_lt_one.trans hc))] at ley,
  calc ∥(L₁ - L₂) y∥
        = ∥(f (x + y) - f x - L₂ ((x + y) - x)) - (f (x + y) - f x - L₁ ((x + y) - x))∥ : by simp
    ... ≤ ∥(f (x + y) - f x - L₂ ((x + y) - x))∥ + ∥(f (x + y) - f x - L₁ ((x + y) - x))∥ :
      norm_sub_le _ _
    ... ≤ ε * r + ε * r :
      begin
        apply add_le_add,
        { apply le_of_mem_A h₂,
          { simp only [le_of_lt (half_pos hr), mem_closed_ball, dist_self] },
          { simp only [dist_eq_norm, add_sub_cancel', mem_closed_ball, ylt.le], } },
        { apply le_of_mem_A h₁,
          { simp only [le_of_lt (half_pos hr), mem_closed_ball, dist_self] },
          { simp only [dist_eq_norm, add_sub_cancel', mem_closed_ball, ylt.le] } },
      end
    ... = 2 * ε * r : by ring
    ... ≤ 2 * ε * (2 * ∥c∥ * ∥y∥) : mul_le_mul_of_nonneg_left ley (mul_nonneg (by norm_num) hε.le)
    ... = 4 * ∥c∥ * ε * ∥y∥ : by ring
end

/-- Easy inclusion: a differentiability point with derivative in `K` belongs to `D f K`. -/
lemma differentiable_set_subset_D : {x | differentiable_at 𝕜 f x ∧ fderiv 𝕜 f x ∈ K} ⊆ D f K :=
begin
  assume x hx,
  rw [D, mem_Inter],
  assume e,
  have : (0 : ℝ) < (1/2) ^ e := pow_pos (by norm_num) _,
  rcases mem_A_of_differentiable this hx.1 with ⟨R, R_pos, hR⟩,
  obtain ⟨n, hn⟩ : ∃ (n : ℕ), (1/2) ^ n < R :=
    exists_pow_lt_of_lt_one R_pos (by norm_num : (1 : ℝ)/2 < 1),
  simp only [mem_Union, mem_Inter, B, mem_inter_eq],
  refine ⟨n, λ p hp q hq, ⟨fderiv 𝕜 f x, hx.2, ⟨_, _⟩⟩⟩;
  { refine hR _ ⟨pow_pos (by norm_num) _, lt_of_le_of_lt _ hn⟩,
    exact pow_le_pow_of_le_one (by norm_num) (by norm_num) (by assumption) }
end

/-- Harder inclusion: at a point in `D f K`, the function `f` has a derivative, in `K`. -/
lemma D_subset_differentiable_set {K : set (E →L[𝕜] F)} (hK : is_complete K) :
  D f K ⊆ {x | differentiable_at 𝕜 f x ∧ fderiv 𝕜 f x ∈ K} :=
begin
  have P : ∀ {n : ℕ}, (0 : ℝ) < (1/2) ^ n := pow_pos (by norm_num),
  rcases normed_field.exists_one_lt_norm 𝕜 with ⟨c, hc⟩,
  have cpos : 0 < ∥c∥ := lt_trans zero_lt_one hc,
  assume x hx,
  have : ∀ (e : ℕ), ∃ (n : ℕ), ∀ p q, n ≤ p → n ≤ q → ∃ L ∈ K,
    x ∈ A f L ((1/2) ^ p) ((1/2) ^ e) ∩ A f L ((1/2) ^ q) ((1/2) ^ e),
  { assume e,
    have := mem_Inter.1 hx e,
    rcases mem_Union.1 this with ⟨n, hn⟩,
    refine ⟨n, λ p q hp hq, _⟩,
    simp only [mem_Inter, ge_iff_le] at hn,
    rcases mem_Union.1 (hn p hp q hq) with ⟨L, hL⟩,
    exact ⟨L, mem_Union.1 hL⟩, },
  /- Recast the assumptions: for each `e`, there exist `n e` and linear maps `L e p q` in `K`
  such that, for `p, q ≥ n e`, then `f` is well approximated by `L e p q` at scale `2 ^ (-p)` and
  `2 ^ (-q)`, with an error `2 ^ (-e)`. -/
  choose! n L hn using this,
  /- All the operators `L e p q` that show up are close to each other. To prove this, we argue
    that `L e p q` is close to `L e p r` (where `r` is large enough), as both approximate `f` at
    scale `2 ^(- p)`. And `L e p r` is close to `L e' p' r` as both approximate `f` at scale
    `2 ^ (- r)`. And `L e' p' r` is close to `L e' p' q'` as both approximate `f` at scale
    `2 ^ (- p')`. -/
  have M : ∀ e p q e' p' q', n e ≤ p → n e ≤ q → n e' ≤ p' → n e' ≤ q' → e ≤ e' →
    ∥L e p q - L e' p' q'∥ ≤ 12 * ∥c∥ * (1/2) ^ e,
  { assume e p q e' p' q' hp hq hp' hq' he',
    let r := max (n e) (n e'),
    have I : ((1:ℝ)/2)^e' ≤ (1/2)^e := pow_le_pow_of_le_one (by norm_num) (by norm_num) he',
    have J1 : ∥L e p q - L e p r∥ ≤ 4 * ∥c∥ * (1/2)^e,
    { have I1 : x ∈ A f (L e p q) ((1 / 2) ^ p) ((1/2)^e) :=
        (hn e p q hp hq).2.1,
      have I2 : x ∈ A f (L e p r) ((1 / 2) ^ p) ((1/2)^e) :=
        (hn e p r hp (le_max_left _ _)).2.1,
      exact norm_sub_le_of_mem_A hc P P I1 I2 },
    have J2 : ∥L e p r - L e' p' r∥ ≤ 4 * ∥c∥ * (1/2)^e,
    { have I1 : x ∈ A f (L e p r) ((1 / 2) ^ r) ((1/2)^e) :=
        (hn e p r hp (le_max_left _ _)).2.2,
      have I2 : x ∈ A f (L e' p' r) ((1 / 2) ^ r) ((1/2)^e') :=
        (hn e' p' r hp' (le_max_right _ _)).2.2,
      exact norm_sub_le_of_mem_A hc P P I1 (A_mono _ _ I I2) },
    have J3 : ∥L e' p' r - L e' p' q'∥ ≤ 4 * ∥c∥ * (1/2)^e,
    { have I1 : x ∈ A f (L e' p' r) ((1 / 2) ^ p') ((1/2)^e') :=
        (hn e' p' r hp' (le_max_right _ _)).2.1,
      have I2 : x ∈ A f (L e' p' q') ((1 / 2) ^ p') ((1/2)^e') :=
        (hn e' p' q' hp' hq').2.1,
      exact norm_sub_le_of_mem_A hc P P (A_mono _ _ I I1) (A_mono _ _ I I2) },
    calc ∥L e p q - L e' p' q'∥
          = ∥(L e p q - L e p r) + (L e p r - L e' p' r) + (L e' p' r - L e' p' q')∥ :
        by { congr' 1, abel }
      ... ≤ ∥L e p q - L e p r∥ + ∥L e p r - L e' p' r∥ + ∥L e' p' r - L e' p' q'∥ :
        le_trans (norm_add_le _ _) (add_le_add_right (norm_add_le _ _) _)
      ... ≤ 4 * ∥c∥ * (1/2)^e + 4 * ∥c∥ * (1/2)^e + 4 * ∥c∥ * (1/2)^e :
        by apply_rules [add_le_add]
      ... = 12 * ∥c∥ * (1/2)^e : by ring },
  /- For definiteness, use `L0 e = L e (n e) (n e)`, to have a single sequence. We claim that this
  is a Cauchy sequence. -/
  let L0 : ℕ → (E →L[𝕜] F) := λ e, L e (n e) (n e),
  have : cauchy_seq L0,
  { rw metric.cauchy_seq_iff',
    assume ε εpos,
    obtain ⟨e, he⟩ : ∃ (e : ℕ), (1/2) ^ e < ε / (12 * ∥c∥) :=
      exists_pow_lt_of_lt_one (div_pos εpos (mul_pos (by norm_num) cpos)) (by norm_num),
    refine ⟨e, λ e' he', _⟩,
    rw [dist_comm, dist_eq_norm],
    calc ∥L0 e - L0 e'∥
          ≤ 12 * ∥c∥ * (1/2)^e : M _ _ _ _ _ _ le_rfl le_rfl le_rfl le_rfl he'
      ... < 12 * ∥c∥ * (ε / (12 * ∥c∥)) :
        mul_lt_mul' le_rfl he (le_of_lt P) (mul_pos (by norm_num) cpos)
      ... = ε : by { field_simp [(by norm_num : (12 : ℝ) ≠ 0), ne_of_gt cpos], ring } },
  /- As it is Cauchy, the sequence `L0` converges, to a limit `f'` in `K`.-/
  obtain ⟨f', f'K, hf'⟩ : ∃ f' ∈ K, tendsto L0 at_top (𝓝 f') :=
    cauchy_seq_tendsto_of_is_complete hK (λ e, (hn e (n e) (n e) le_rfl le_rfl).1) this,
  have Lf' : ∀ e p, n e ≤ p → ∥L e (n e) p - f'∥ ≤ 12 * ∥c∥ * (1/2)^e,
  { assume e p hp,
    apply le_of_tendsto (tendsto_const_nhds.sub hf').norm,
    rw eventually_at_top,
    exact ⟨e, λ e' he', M _ _ _ _ _ _ le_rfl hp le_rfl le_rfl he'⟩ },
  /- Let us show that `f` has derivative `f'` at `x`. -/
  have : has_fderiv_at f f' x,
  { simp only [has_fderiv_at_iff_is_o_nhds_zero, is_o_iff],
    /- to get an approximation with a precision `ε`, we will replace `f` with `L e (n e) m` for
    some large enough `e` (yielding a small error by uniform approximation). As one can vary `m`,
    this makes it possible to cover all scales, and thus to obtain a good linear approximation in
    the whole ball of radius `(1/2)^(n e)`. -/
    assume ε εpos,
    have pos : 0 < 4 + 12 * ∥c∥ :=
      add_pos_of_pos_of_nonneg (by norm_num) (mul_nonneg (by norm_num) (norm_nonneg _)),
    obtain ⟨e, he⟩ : ∃ (e : ℕ), (1 / 2) ^ e < ε / (4 + 12 * ∥c∥) :=
      exists_pow_lt_of_lt_one (div_pos εpos pos) (by norm_num),
    rw eventually_nhds_iff_ball,
    refine ⟨(1/2) ^ (n e + 1), P, λ y hy, _⟩,
    -- We need to show that `f (x + y) - f x - f' y` is small. For this, we will work at scale
    -- `k` where `k` is chosen with `∥y∥ ∼ 2 ^ (-k)`.
    by_cases y_pos : y = 0, {simp [y_pos] },
    have yzero : 0 < ∥y∥ := norm_pos_iff.mpr y_pos,
    have y_lt : ∥y∥ < (1/2) ^ (n e + 1), by simpa using mem_ball_iff_norm.1 hy,
    have yone : ∥y∥ ≤ 1 :=
      le_trans (y_lt.le) (pow_le_one _ (by norm_num) (by norm_num)),
    -- define the scale `k`.
    obtain ⟨k, hk, h'k⟩ : ∃ (k : ℕ), (1/2) ^ (k + 1) < ∥y∥ ∧ ∥y∥ ≤ (1/2) ^ k :=
      exists_nat_pow_near_of_lt_one yzero yone (by norm_num : (0 : ℝ) < 1/2)
      (by norm_num : (1 : ℝ)/2 < 1),
    -- the scale is large enough (as `y` is small enough)
    have k_gt : n e < k,
    { have : ((1:ℝ)/2) ^ (k + 1) < (1/2) ^ (n e + 1) := lt_trans hk y_lt,
      rw pow_lt_pow_iff_of_lt_one (by norm_num : (0 : ℝ) < 1/2) (by norm_num) at this,
      linarith },
    set m := k - 1 with hl,
    have m_ge : n e ≤ m := nat.le_pred_of_lt k_gt,
    have km : k = m + 1 := (nat.succ_pred_eq_of_pos (lt_of_le_of_lt (zero_le _) k_gt)).symm,
    rw km at hk h'k,
    -- `f` is well approximated by `L e (n e) k` at the relevant scale
    -- (in fact, we use `m = k - 1` instead of `k` because of the precise definition of `A`).
    have J1 : ∥f (x + y) - f x - L e (n e) m ((x + y) - x)∥ ≤ (1/2) ^ e * (1/2) ^ m,
    { apply le_of_mem_A (hn e (n e) m le_rfl m_ge).2.2,
      { simp only [mem_closed_ball, dist_self],
        exact div_nonneg (le_of_lt P) (zero_le_two) },
      { simpa only [dist_eq_norm, add_sub_cancel', mem_closed_ball, pow_succ', mul_one_div]
          using h'k } },
    have J2 : ∥f (x + y) - f x - L e (n e) m y∥ ≤ 4 * (1/2) ^ e * ∥y∥ := calc
      ∥f (x + y) - f x - L e (n e) m y∥ ≤ (1/2) ^ e * (1/2) ^ m :
        by simpa only [add_sub_cancel'] using J1
      ... = 4 * (1/2) ^ e * (1/2) ^ (m + 2) : by { field_simp, ring_exp }
      ... ≤ 4 * (1/2) ^ e * ∥y∥ :
        mul_le_mul_of_nonneg_left (le_of_lt hk) (mul_nonneg (by norm_num) (le_of_lt P)),
    -- use the previous estimates to see that `f (x + y) - f x - f' y` is small.
    calc ∥f (x + y) - f x - f' y∥
        = ∥(f (x + y) - f x - L e (n e) m y) + (L e (n e) m - f') y∥ :
      congr_arg _ (by simp)
    ... ≤ 4 * (1/2) ^ e * ∥y∥ + 12 * ∥c∥ * (1/2) ^ e * ∥y∥ :
      norm_add_le_of_le J2
        ((le_op_norm _ _).trans (mul_le_mul_of_nonneg_right (Lf' _ _ m_ge) (norm_nonneg _)))
    ... = (4 + 12 * ∥c∥) * ∥y∥ * (1/2) ^ e : by ring
    ... ≤ (4 + 12 * ∥c∥) * ∥y∥ * (ε / (4 + 12 * ∥c∥)) :
      mul_le_mul_of_nonneg_left he.le
        (mul_nonneg (add_nonneg (by norm_num) (mul_nonneg (by norm_num) (norm_nonneg _)))
          (norm_nonneg _))
    ... = ε * ∥y∥ : by { field_simp [ne_of_gt pos], ring } },
  rw ← this.fderiv at f'K,
  exact ⟨this.differentiable_at, f'K⟩
end

theorem differentiable_set_eq_D (hK : is_complete K) :
  {x | differentiable_at 𝕜 f x ∧ fderiv 𝕜 f x ∈ K} = D f K :=
subset.antisymm (differentiable_set_subset_D _) (D_subset_differentiable_set hK)

end fderiv_measurable_aux

open fderiv_measurable_aux

variables [measurable_space E] [opens_measurable_space E]
variables (𝕜 f)

/-- The set of differentiability points of a function, with derivative in a given complete set,
is Borel-measurable. -/
theorem measurable_set_of_differentiable_at_of_is_complete
  {K : set (E →L[𝕜] F)} (hK : is_complete K) :
  measurable_set {x | differentiable_at 𝕜 f x ∧ fderiv 𝕜 f x ∈ K} :=
by simp [differentiable_set_eq_D K hK, D, is_open_B.measurable_set, measurable_set.Inter_Prop,
         measurable_set.Inter, measurable_set.Union]

variable [complete_space F]

/-- The set of differentiability points of a function taking values in a complete space is
Borel-measurable. -/
theorem measurable_set_of_differentiable_at :
  measurable_set {x | differentiable_at 𝕜 f x} :=
begin
  have : is_complete (univ : set (E →L[𝕜] F)) := complete_univ,
  convert measurable_set_of_differentiable_at_of_is_complete 𝕜 f this,
  simp
end

@[measurability] lemma measurable_fderiv : measurable (fderiv 𝕜 f) :=
begin
  refine measurable_of_is_closed (λ s hs, _),
  have : fderiv 𝕜 f ⁻¹' s = {x | differentiable_at 𝕜 f x ∧ fderiv 𝕜 f x ∈ s} ∪
    ({x | ¬differentiable_at 𝕜 f x} ∩ {x | (0 : E →L[𝕜] F) ∈ s}) :=
    set.ext (λ x, mem_preimage.trans fderiv_mem_iff),
  rw this,
  exact (measurable_set_of_differentiable_at_of_is_complete _ _ hs.is_complete).union
    ((measurable_set_of_differentiable_at _ _).compl.inter (measurable_set.const _))
end

@[measurability] lemma measurable_fderiv_apply_const [measurable_space F] [borel_space F] (y : E) :
  measurable (λ x, fderiv 𝕜 f x y) :=
(continuous_linear_map.measurable_apply y).comp (measurable_fderiv 𝕜 f)

variable {𝕜}

@[measurability] lemma measurable_deriv [measurable_space 𝕜] [opens_measurable_space 𝕜]
  [measurable_space F] [borel_space F] (f : 𝕜 → F) : measurable (deriv f) :=
by simpa only [fderiv_deriv] using measurable_fderiv_apply_const 𝕜 f 1

lemma strongly_measurable_deriv [measurable_space 𝕜] [opens_measurable_space 𝕜]
  [second_countable_topology F] (f : 𝕜 → F) :
  strongly_measurable (deriv f) :=
by { borelize F, exact (measurable_deriv f).strongly_measurable }

lemma ae_measurable_deriv [measurable_space 𝕜] [opens_measurable_space 𝕜] [measurable_space F]
  [borel_space F] (f : 𝕜 → F) (μ : measure 𝕜) : ae_measurable (deriv f) μ :=
(measurable_deriv f).ae_measurable

lemma ae_strongly_measurable_deriv [measurable_space 𝕜] [opens_measurable_space 𝕜]
  [second_countable_topology F] (f : 𝕜 → F) (μ : measure 𝕜) :
  ae_strongly_measurable (deriv f) μ :=
(strongly_measurable_deriv f).ae_strongly_measurable

end fderiv

section right_deriv

variables {F : Type*} [normed_group F] [normed_space ℝ F]
variables {f : ℝ → F} (K : set F)

namespace right_deriv_measurable_aux

/-- The set `A f L r ε` is the set of points `x` around which the function `f` is well approximated
at scale `r` by the linear map `h ↦ h • L`, up to an error `ε`. We tweak the definition to
make sure that this is open on the right. -/
def A (f : ℝ → F) (L : F) (r ε : ℝ) : set ℝ :=
{x | ∃ r' ∈ Ioc (r/2) r, ∀ y z ∈ Icc x (x + r'), ∥f z - f y - (z-y) • L∥ ≤ ε * r}

/-- The set `B f K r s ε` is the set of points `x` around which there exists a vector
`L` belonging to `K` (a given set of vectors) such that `h • L` approximates well `f (x + h)`
(up to an error `ε`), simultaneously at scales `r` and `s`. -/
def B (f : ℝ → F) (K : set F) (r s ε : ℝ) : set ℝ :=
⋃ (L ∈ K), (A f L r ε) ∩ (A f L s ε)

/-- The set `D f K` is a complicated set constructed using countable intersections and unions. Its
main use is that, when `K` is complete, it is exactly the set of points where `f` is differentiable,
with a derivative in `K`. -/
def D (f : ℝ → F) (K : set F) : set ℝ :=
⋂ (e : ℕ), ⋃ (n : ℕ), ⋂ (p ≥ n) (q ≥ n), B f K ((1/2) ^ p) ((1/2) ^ q) ((1/2) ^ e)

lemma A_mem_nhds_within_Ioi {L : F} {r ε x : ℝ} (hx : x ∈ A f L r ε) :
  A f L r ε ∈ 𝓝[>] x :=
begin
  rcases hx with ⟨r', rr', hr'⟩,
  rw mem_nhds_within_Ioi_iff_exists_Ioo_subset,
  obtain ⟨s, s_gt, s_lt⟩ : ∃ (s : ℝ), r / 2 < s ∧ s < r' := exists_between rr'.1,
  have : s ∈ Ioc (r/2) r := ⟨s_gt, le_of_lt (s_lt.trans_le rr'.2)⟩,
  refine ⟨x + r' - s, by { simp only [mem_Ioi], linarith }, λ x' hx', ⟨s, this, _⟩⟩,
  have A : Icc x' (x' + s) ⊆ Icc x (x + r'),
  { apply Icc_subset_Icc hx'.1.le,
    linarith [hx'.2] },
  assume y hy z hz,
  exact hr' y (A hy) z (A hz)
end

lemma B_mem_nhds_within_Ioi {K : set F} {r s ε x : ℝ} (hx : x ∈ B f K r s ε) :
  B f K r s ε ∈ 𝓝[>] x :=
begin
  obtain ⟨L, LK, hL₁, hL₂⟩ : ∃ (L : F), L ∈ K ∧ x ∈ A f L r ε ∧ x ∈ A f L s ε,
    by simpa only [B, mem_Union, mem_inter_eq, exists_prop] using hx,
  filter_upwards [A_mem_nhds_within_Ioi hL₁, A_mem_nhds_within_Ioi hL₂] with y hy₁ hy₂,
  simp only [B, mem_Union, mem_inter_eq, exists_prop],
  exact ⟨L, LK, hy₁, hy₂⟩
end

lemma measurable_set_B {K : set F} {r s ε : ℝ} : measurable_set (B f K r s ε) :=
measurable_set_of_mem_nhds_within_Ioi (λ x hx, B_mem_nhds_within_Ioi hx)

lemma A_mono (L : F) (r : ℝ) {ε δ : ℝ} (h : ε ≤ δ) :
  A f L r ε ⊆ A f L r δ :=
begin
  rintros x ⟨r', r'r, hr'⟩,
  refine ⟨r', r'r, λ y hy z hz, (hr' y hy z hz).trans (mul_le_mul_of_nonneg_right h _)⟩,
  linarith [hy.1, hy.2, r'r.2],
end

lemma le_of_mem_A {r ε : ℝ} {L : F} {x : ℝ} (hx : x ∈ A f L r ε)
  {y z : ℝ} (hy : y ∈ Icc x (x + r/2)) (hz : z ∈ Icc x (x + r/2)) :
  ∥f z - f y - (z-y) • L∥ ≤ ε * r :=
begin
  rcases hx with ⟨r', r'mem, hr'⟩,
  have A : x + r / 2 ≤ x + r', by linarith [r'mem.1],
  exact hr' _ ((Icc_subset_Icc le_rfl A) hy) _ ((Icc_subset_Icc le_rfl A) hz),
end

lemma mem_A_of_differentiable {ε : ℝ} (hε : 0 < ε) {x : ℝ}
  (hx : differentiable_within_at ℝ f (Ici x) x) :
  ∃ R > 0, ∀ r ∈ Ioo (0 : ℝ) R, x ∈ A f (deriv_within f (Ici x) x) r ε :=
begin
  have := hx.has_deriv_within_at,
  simp_rw [has_deriv_within_at_iff_is_o, is_o_iff] at this,
  rcases mem_nhds_within_Ici_iff_exists_Ico_subset.1 (this (half_pos hε)) with ⟨m, xm, hm⟩,
  refine ⟨m - x, by linarith [show x < m, from xm], λ r hr, _⟩,
  have : r ∈ Ioc (r/2) r := ⟨half_lt_self hr.1, le_rfl⟩,
  refine ⟨r, this, λ y hy z hz, _⟩,
  calc  ∥f z - f y - (z - y) • deriv_within f (Ici x) x∥
      = ∥(f z - f x - (z - x) • deriv_within f (Ici x) x)
           - (f y - f x - (y - x) • deriv_within f (Ici x) x)∥ :
    by { congr' 1, simp only [sub_smul], abel }
  ... ≤ ∥f z - f x - (z - x) • deriv_within f (Ici x) x∥
         + ∥f y - f x - (y - x) • deriv_within f (Ici x) x∥ :
    norm_sub_le _ _
  ... ≤ ε / 2 * ∥z - x∥ + ε / 2 * ∥y - x∥ :
    add_le_add (hm ⟨hz.1, hz.2.trans_lt (by linarith [hr.2])⟩)
               (hm ⟨hy.1, hy.2.trans_lt (by linarith [hr.2])⟩)
  ... ≤ ε / 2 * r + ε / 2 * r :
  begin
    apply add_le_add,
    { apply mul_le_mul_of_nonneg_left _ (le_of_lt (half_pos hε)),
      rw [real.norm_of_nonneg];
      linarith [hz.1, hz.2] },
    { apply mul_le_mul_of_nonneg_left _ (le_of_lt (half_pos hε)),
      rw [real.norm_of_nonneg];
      linarith [hy.1, hy.2] },
   end
  ... = ε * r : by ring
end

lemma norm_sub_le_of_mem_A
  {r x : ℝ} (hr : 0 < r) (ε : ℝ) {L₁ L₂ : F}
  (h₁ : x ∈ A f L₁ r ε) (h₂ : x ∈ A f L₂ r ε) : ∥L₁ - L₂∥ ≤ 4 * ε :=
begin
  suffices H : ∥(r/2) • (L₁ - L₂)∥ ≤ (r / 2) * (4 * ε),
    by rwa [norm_smul, real.norm_of_nonneg (half_pos hr).le, mul_le_mul_left (half_pos hr)] at H,
  calc
  ∥(r/2) • (L₁ - L₂)∥
      = ∥(f (x + r/2) - f x - (x + r/2 - x) • L₂) - (f (x + r/2) - f x - (x + r/2 - x) • L₁)∥ :
    by simp [smul_sub]
  ... ≤ ∥f (x + r/2) - f x - (x + r/2 - x) • L₂∥ + ∥f (x + r/2) - f x - (x + r/2 - x) • L₁∥ :
    norm_sub_le _ _
  ... ≤ ε * r + ε * r :
    begin
      apply add_le_add,
      { apply le_of_mem_A h₂;
        simp [(half_pos hr).le] },
      { apply le_of_mem_A h₁;
        simp [(half_pos hr).le] },
    end
  ... = (r / 2) * (4 * ε) : by ring
end

/-- Easy inclusion: a differentiability point with derivative in `K` belongs to `D f K`. -/
lemma differentiable_set_subset_D :
  {x | differentiable_within_at ℝ f (Ici x) x ∧ deriv_within f (Ici x) x ∈ K} ⊆ D f K :=
begin
  assume x hx,
  rw [D, mem_Inter],
  assume e,
  have : (0 : ℝ) < (1/2) ^ e := pow_pos (by norm_num) _,
  rcases mem_A_of_differentiable this hx.1 with ⟨R, R_pos, hR⟩,
  obtain ⟨n, hn⟩ : ∃ (n : ℕ), (1/2) ^ n < R :=
    exists_pow_lt_of_lt_one R_pos (by norm_num : (1 : ℝ)/2 < 1),
  simp only [mem_Union, mem_Inter, B, mem_inter_eq],
  refine ⟨n, λ p hp q hq, ⟨deriv_within f (Ici x) x, hx.2, ⟨_, _⟩⟩⟩;
  { refine hR _ ⟨pow_pos (by norm_num) _, lt_of_le_of_lt _ hn⟩,
    exact pow_le_pow_of_le_one (by norm_num) (by norm_num) (by assumption) }
end

/-- Harder inclusion: at a point in `D f K`, the function `f` has a derivative, in `K`. -/
lemma D_subset_differentiable_set {K : set F} (hK : is_complete K) :
  D f K ⊆ {x | differentiable_within_at ℝ f (Ici x) x ∧ deriv_within f (Ici x) x ∈ K} :=
begin
  have P : ∀ {n : ℕ}, (0 : ℝ) < (1/2) ^ n := pow_pos (by norm_num),
  assume x hx,
  have : ∀ (e : ℕ), ∃ (n : ℕ), ∀ p q, n ≤ p → n ≤ q → ∃ L ∈ K,
    x ∈ A f L ((1/2) ^ p) ((1/2) ^ e) ∩ A f L ((1/2) ^ q) ((1/2) ^ e),
  { assume e,
    have := mem_Inter.1 hx e,
    rcases mem_Union.1 this with ⟨n, hn⟩,
    refine ⟨n, λ p q hp hq, _⟩,
    simp only [mem_Inter, ge_iff_le] at hn,
    rcases mem_Union.1 (hn p hp q hq) with ⟨L, hL⟩,
    exact ⟨L, mem_Union.1 hL⟩, },
  /- Recast the assumptions: for each `e`, there exist `n e` and linear maps `L e p q` in `K`
  such that, for `p, q ≥ n e`, then `f` is well approximated by `L e p q` at scale `2 ^ (-p)` and
  `2 ^ (-q)`, with an error `2 ^ (-e)`. -/
  choose! n L hn using this,
  /- All the operators `L e p q` that show up are close to each other. To prove this, we argue
    that `L e p q` is close to `L e p r` (where `r` is large enough), as both approximate `f` at
    scale `2 ^(- p)`. And `L e p r` is close to `L e' p' r` as both approximate `f` at scale
    `2 ^ (- r)`. And `L e' p' r` is close to `L e' p' q'` as both approximate `f` at scale
    `2 ^ (- p')`. -/
  have M : ∀ e p q e' p' q', n e ≤ p → n e ≤ q → n e' ≤ p' → n e' ≤ q' → e ≤ e' →
    ∥L e p q - L e' p' q'∥ ≤ 12 * (1/2) ^ e,
  { assume e p q e' p' q' hp hq hp' hq' he',
    let r := max (n e) (n e'),
    have I : ((1:ℝ)/2)^e' ≤ (1/2)^e := pow_le_pow_of_le_one (by norm_num) (by norm_num) he',
    have J1 : ∥L e p q - L e p r∥ ≤ 4 * (1/2)^e,
    { have I1 : x ∈ A f (L e p q) ((1 / 2) ^ p) ((1/2)^e) :=
        (hn e p q hp hq).2.1,
      have I2 : x ∈ A f (L e p r) ((1 / 2) ^ p) ((1/2)^e) :=
        (hn e p r hp (le_max_left _ _)).2.1,
      exact norm_sub_le_of_mem_A P _ I1 I2 },
    have J2 : ∥L e p r - L e' p' r∥ ≤ 4 * (1/2)^e,
    { have I1 : x ∈ A f (L e p r) ((1 / 2) ^ r) ((1/2)^e) :=
        (hn e p r hp (le_max_left _ _)).2.2,
      have I2 : x ∈ A f (L e' p' r) ((1 / 2) ^ r) ((1/2)^e') :=
        (hn e' p' r hp' (le_max_right _ _)).2.2,
      exact norm_sub_le_of_mem_A P _ I1 (A_mono _ _ I I2) },
    have J3 : ∥L e' p' r - L e' p' q'∥ ≤ 4 * (1/2)^e,
    { have I1 : x ∈ A f (L e' p' r) ((1 / 2) ^ p') ((1/2)^e') :=
        (hn e' p' r hp' (le_max_right _ _)).2.1,
      have I2 : x ∈ A f (L e' p' q') ((1 / 2) ^ p') ((1/2)^e') :=
        (hn e' p' q' hp' hq').2.1,
      exact norm_sub_le_of_mem_A P _ (A_mono _ _ I I1) (A_mono _ _ I I2) },
    calc ∥L e p q - L e' p' q'∥
          = ∥(L e p q - L e p r) + (L e p r - L e' p' r) + (L e' p' r - L e' p' q')∥ :
        by { congr' 1, abel }
      ... ≤ ∥L e p q - L e p r∥ + ∥L e p r - L e' p' r∥ + ∥L e' p' r - L e' p' q'∥ :
        le_trans (norm_add_le _ _) (add_le_add_right (norm_add_le _ _) _)
      ... ≤ 4 * (1/2)^e + 4 * (1/2)^e + 4 * (1/2)^e :
        by apply_rules [add_le_add]
      ... = 12 * (1/2)^e : by ring },
  /- For definiteness, use `L0 e = L e (n e) (n e)`, to have a single sequence. We claim that this
  is a Cauchy sequence. -/
  let L0 : ℕ → F := λ e, L e (n e) (n e),
  have : cauchy_seq L0,
  { rw metric.cauchy_seq_iff',
    assume ε εpos,
    obtain ⟨e, he⟩ : ∃ (e : ℕ), (1/2) ^ e < ε / 12 :=
      exists_pow_lt_of_lt_one (div_pos εpos (by norm_num)) (by norm_num),
    refine ⟨e, λ e' he', _⟩,
    rw [dist_comm, dist_eq_norm],
    calc ∥L0 e - L0 e'∥
          ≤ 12 * (1/2)^e : M _ _ _ _ _ _ le_rfl le_rfl le_rfl le_rfl he'
      ... < 12 * (ε / 12) :
        mul_lt_mul' le_rfl he (le_of_lt P) (by norm_num)
      ... = ε : by { field_simp [(by norm_num : (12 : ℝ) ≠ 0)], ring } },
  /- As it is Cauchy, the sequence `L0` converges, to a limit `f'` in `K`.-/
  obtain ⟨f', f'K, hf'⟩ : ∃ f' ∈ K, tendsto L0 at_top (𝓝 f') :=
    cauchy_seq_tendsto_of_is_complete hK (λ e, (hn e (n e) (n e) le_rfl le_rfl).1) this,
  have Lf' : ∀ e p, n e ≤ p → ∥L e (n e) p - f'∥ ≤ 12 * (1/2)^e,
  { assume e p hp,
    apply le_of_tendsto (tendsto_const_nhds.sub hf').norm,
    rw eventually_at_top,
    exact ⟨e, λ e' he', M _ _ _ _ _ _ le_rfl hp le_rfl le_rfl he'⟩ },
  /- Let us show that `f` has right derivative `f'` at `x`. -/
  have : has_deriv_within_at f f' (Ici x) x,
  { simp only [has_deriv_within_at_iff_is_o, is_o_iff],
    /- to get an approximation with a precision `ε`, we will replace `f` with `L e (n e) m` for
    some large enough `e` (yielding a small error by uniform approximation). As one can vary `m`,
    this makes it possible to cover all scales, and thus to obtain a good linear approximation in
    the whole interval of length `(1/2)^(n e)`. -/
    assume ε εpos,
    obtain ⟨e, he⟩ : ∃ (e : ℕ), (1 / 2) ^ e < ε / 16 :=
      exists_pow_lt_of_lt_one (div_pos εpos (by norm_num)) (by norm_num),
    have xmem : x ∈ Ico x (x + (1/2)^(n e + 1)),
      by simp only [one_div, left_mem_Ico, lt_add_iff_pos_right, inv_pos, pow_pos, zero_lt_bit0,
        zero_lt_one],
    filter_upwards [Icc_mem_nhds_within_Ici xmem] with y hy,
    -- We need to show that `f y - f x - f' (y - x)` is small. For this, we will work at scale
    -- `k` where `k` is chosen with `∥y - x∥ ∼ 2 ^ (-k)`.
    rcases eq_or_lt_of_le hy.1 with rfl|xy,
    { simp only [sub_self, zero_smul, norm_zero, mul_zero]},
    have yzero : 0 < y - x := sub_pos.2 xy,
    have y_le : y - x ≤ (1/2) ^ (n e + 1), by linarith [hy.2],
    have yone : y - x ≤ 1 := le_trans y_le (pow_le_one _ (by norm_num) (by norm_num)),
    -- define the scale `k`.
    obtain ⟨k, hk, h'k⟩ : ∃ (k : ℕ), (1/2) ^ (k + 1) < y - x ∧ y - x ≤ (1/2) ^ k :=
      exists_nat_pow_near_of_lt_one yzero yone (by norm_num : (0 : ℝ) < 1/2)
      (by norm_num : (1 : ℝ)/2 < 1),
    -- the scale is large enough (as `y - x` is small enough)
    have k_gt : n e < k,
    { have : ((1:ℝ)/2) ^ (k + 1) < (1/2) ^ (n e + 1) := lt_of_lt_of_le hk y_le,
      rw pow_lt_pow_iff_of_lt_one (by norm_num : (0 : ℝ) < 1/2) (by norm_num) at this,
      linarith },
    set m := k - 1 with hl,
    have m_ge : n e ≤ m := nat.le_pred_of_lt k_gt,
    have km : k = m + 1 := (nat.succ_pred_eq_of_pos (lt_of_le_of_lt (zero_le _) k_gt)).symm,
    rw km at hk h'k,
    -- `f` is well approximated by `L e (n e) k` at the relevant scale
    -- (in fact, we use `m = k - 1` instead of `k` because of the precise definition of `A`).
    have J : ∥f y - f x - (y - x) • L e (n e) m∥ ≤ 4 * (1/2) ^ e * ∥y - x∥ := calc
      ∥f y - f x - (y - x) • L e (n e) m∥ ≤ (1/2) ^ e * (1/2) ^ m :
        begin
          apply le_of_mem_A (hn e (n e) m le_rfl m_ge).2.2,
          { simp only [one_div, inv_pow, left_mem_Icc, le_add_iff_nonneg_right],
            exact div_nonneg (inv_nonneg.2 (pow_nonneg zero_le_two _)) zero_le_two },
          { simp only [pow_add, tsub_le_iff_left] at h'k,
            simpa only [hy.1, mem_Icc, true_and, one_div, pow_one] using h'k }
        end
      ... = 4 * (1/2) ^ e * (1/2) ^ (m + 2) : by { field_simp, ring_exp }
      ... ≤ 4 * (1/2) ^ e * (y - x) :
        mul_le_mul_of_nonneg_left (le_of_lt hk) (mul_nonneg (by norm_num) (le_of_lt P))
      ... = 4 * (1/2) ^ e * ∥y - x∥ : by rw [real.norm_of_nonneg yzero.le],
    calc ∥f y - f x - (y - x) • f'∥
        = ∥(f y - f x - (y - x) • L e (n e) m) + (y - x) • (L e (n e) m - f')∥ :
      by simp only [smul_sub, sub_add_sub_cancel]
    ... ≤ 4 * (1/2) ^ e * ∥y - x∥ + ∥y - x∥ * (12 * (1/2) ^ e) : norm_add_le_of_le J
      (by { rw [norm_smul], exact mul_le_mul_of_nonneg_left (Lf' _ _ m_ge) (norm_nonneg _) })
    ... = 16 * ∥y - x∥ * (1/2) ^ e : by ring
    ... ≤ 16 * ∥y - x∥ * (ε / 16) :
      mul_le_mul_of_nonneg_left he.le (mul_nonneg (by norm_num) (norm_nonneg _))
    ... = ε * ∥y - x∥ : by ring },
  rw ← this.deriv_within (unique_diff_on_Ici x x le_rfl) at f'K,
  exact ⟨this.differentiable_within_at, f'K⟩,
end

theorem differentiable_set_eq_D (hK : is_complete K) :
  {x | differentiable_within_at ℝ f (Ici x) x ∧ deriv_within f (Ici x) x ∈ K} = D f K :=
subset.antisymm (differentiable_set_subset_D _) (D_subset_differentiable_set hK)

end right_deriv_measurable_aux

open right_deriv_measurable_aux

variables (f)

/-- The set of right differentiability points of a function, with derivative in a given complete
set, is Borel-measurable. -/
theorem measurable_set_of_differentiable_within_at_Ici_of_is_complete
  {K : set F} (hK : is_complete K) :
  measurable_set {x | differentiable_within_at ℝ f (Ici x) x ∧ deriv_within f (Ici x) x ∈ K} :=
by simp [differentiable_set_eq_D K hK, D, measurable_set_B, measurable_set.Inter_Prop,
         measurable_set.Inter, measurable_set.Union]

variable [complete_space F]

/-- The set of right differentiability points of a function taking values in a complete space is
Borel-measurable. -/
theorem measurable_set_of_differentiable_within_at_Ici :
  measurable_set {x | differentiable_within_at ℝ f (Ici x) x} :=
begin
  have : is_complete (univ : set F) := complete_univ,
  convert measurable_set_of_differentiable_within_at_Ici_of_is_complete f this,
  simp
end

@[measurability] lemma measurable_deriv_within_Ici [measurable_space F] [borel_space F] :
  measurable (λ x, deriv_within f (Ici x) x) :=
begin
  refine measurable_of_is_closed (λ s hs, _),
  have : (λ x, deriv_within f (Ici x) x) ⁻¹' s =
    {x | differentiable_within_at ℝ f (Ici x) x ∧ deriv_within f (Ici x) x ∈ s} ∪
    ({x | ¬differentiable_within_at ℝ f (Ici x) x} ∩ {x | (0 : F) ∈ s}) :=
    set.ext (λ x, mem_preimage.trans deriv_within_mem_iff),
  rw this,
  exact (measurable_set_of_differentiable_within_at_Ici_of_is_complete _ hs.is_complete).union
    ((measurable_set_of_differentiable_within_at_Ici _).compl.inter (measurable_set.const _))
end

lemma strongly_measurable_deriv_within_Ici [second_countable_topology F] :
  strongly_measurable (λ x, deriv_within f (Ici x) x) :=
by { borelize F, exact (measurable_deriv_within_Ici f).strongly_measurable }

lemma ae_measurable_deriv_within_Ici [measurable_space F] [borel_space F]
  (μ : measure ℝ) : ae_measurable (λ x, deriv_within f (Ici x) x) μ :=
(measurable_deriv_within_Ici f).ae_measurable

lemma ae_strongly_measurable_deriv_within_Ici [second_countable_topology F] (μ : measure ℝ) :
  ae_strongly_measurable (λ x, deriv_within f (Ici x) x) μ :=
(strongly_measurable_deriv_within_Ici f).ae_strongly_measurable

/-- The set of right differentiability points of a function taking values in a complete space is
Borel-measurable. -/
theorem measurable_set_of_differentiable_within_at_Ioi :
  measurable_set {x | differentiable_within_at ℝ f (Ioi x) x} :=
by simpa [differentiable_within_at_Ioi_iff_Ici]
  using measurable_set_of_differentiable_within_at_Ici f

@[measurability] lemma measurable_deriv_within_Ioi [measurable_space F] [borel_space F] :
  measurable (λ x, deriv_within f (Ioi x) x) :=
by simpa [deriv_within_Ioi_eq_Ici] using measurable_deriv_within_Ici f

lemma strongly_measurable_deriv_within_Ioi [second_countable_topology F] :
  strongly_measurable (λ x, deriv_within f (Ioi x) x) :=
by { borelize F, exact (measurable_deriv_within_Ioi f).strongly_measurable }

lemma ae_measurable_deriv_within_Ioi [measurable_space F] [borel_space F]
  (μ : measure ℝ) : ae_measurable (λ x, deriv_within f (Ioi x) x) μ :=
(measurable_deriv_within_Ioi f).ae_measurable

lemma ae_strongly_measurable_deriv_within_Ioi [second_countable_topology F] (μ : measure ℝ) :
  ae_strongly_measurable (λ x, deriv_within f (Ioi x) x) μ :=
(strongly_measurable_deriv_within_Ioi f).ae_strongly_measurable

end right_deriv


-- Integers mod 37

-- a demonstration of how to use equivalence relations and equivalence classes in Lean.

-- We define the "congruent mod 37" relation on integers,
-- prove it is an equivalence relation, define Zmod37 to be the equivalence classes,
-- and put a ring structure on the quotient.

import tactic

definition cong_mod37 (a b : ℤ) := ∃ (k : ℤ), k * 37 = b - a

-- Now check it's an equivalence reln!

theorem cong_mod_refl : reflexive (cong_mod37) :=
begin
  intro x,
  -- to prove cong_mod37 x x we just observe that k=0 will do.
  use 0, -- this is k
  simp,
end

theorem cong_mod_symm : symmetric (cong_mod37) :=
begin
  intros a b H,
  -- H : cond_mod37 a b
  cases H with k Hk,
  -- Hk : k * 37 = (b - a)
  -- Goal is to find an integer k' with k' * 37 = a - b
  use -k,
  simp [Hk],
end

theorem cong_mod_trans : transitive (cong_mod37) :=
begin
  intros a b c Hab Hbc,
  cases Hab with k Hk,
  cases Hbc with l Hl,
  -- k*37 = b - a, l*37 = c - b
  -- need to solve m*37 = c - a
  sorry -- can you finish it?
end

-- so we've now seen a general technique for proving a ≈ b -- existsi (the k that works)

theorem cong_mod_equiv : equivalence (cong_mod37) :=
⟨cong_mod_refl, cong_mod_symm, cong_mod_trans⟩

instance Z_setoid : setoid ℤ := { r := cong_mod37, iseqv := cong_mod_equiv }

definition Zmod37 := quotient (Z_setoid)

namespace Zmod37

definition reduce_mod37 : ℤ → Zmod37 := quot.mk (cong_mod37)

-- now a little bit of basic interface

instance coe_int_Zmod37 : has_coe ℤ (Zmod37) := ⟨reduce_mod37⟩

instance : has_zero (Zmod37) := ⟨reduce_mod37 0⟩
instance : has_one (Zmod37) := ⟨reduce_mod37 1⟩
instance : inhabited (Zmod37) := ⟨0⟩

@[simp] theorem of_int_zero : (0 : (Zmod37))  = reduce_mod37 0 := rfl
@[simp] theorem of_int_one : (1 : (Zmod37))  = reduce_mod37 1 := rfl

-- now back to the maths

-- here's a useful lemma -- it's needed to prove addition is well-defined on the quotient.
-- Note the use of quotient.sound to get from Zmod37 back to Z

lemma congr_add (a₁ a₂ b₁ b₂ : ℤ) : a₁ ≈ b₁ → a₂ ≈ b₂ → ⟦a₁ + a₂⟧ = ⟦b₁ + b₂⟧ :=
begin
  intros H1 H2,
  cases H1 with m Hm, -- Hm : m * 37 = b₁ - a₁
  cases H2 with n Hn, -- Hn : n * 37 = b₂ - a₂
  -- goal is ⟦a₁ + a₂⟧ = ⟦b₁ + b₂⟧
  apply quotient.sound,
  -- goal now a₁ + a₂ ≈ b₁ + b₂, and we know how to do these.
  use (m + n),
  rw [add_mul, Hm, Hn],
  ring,
end

-- That lemma above is *exactly* what we need to make sure addition is
-- well-defined on Zmod37, so let's do this now, using quotient.lift

-- note: stuff like "add" is used everywhere so it's best to protect.
protected definition add : Zmod37 → Zmod37 → Zmod37 :=
quotient.lift₂ (λ a b : ℤ, ⟦a + b⟧) (begin
  show ∀ (a₁ a₂ b₁ b₂ : ℤ), a₁ ≈ b₁ → a₂ ≈ b₂ → ⟦a₁ + a₂⟧ = ⟦b₁ + b₂⟧,
  -- that's what quotient.lift₂ reduces us to doing. But we did it already!
  exact congr_add,
end)

-- Now here's the lemma we need for the definition of neg

-- I spelt out the proof for add, here's a quick term proof for neg.

lemma congr_neg (a b : ℤ) : a ≈ b → ⟦-a⟧ = ⟦-b⟧ :=
λ ⟨m, Hm⟩, quotient.sound ⟨-m, by simp [Hm]⟩

protected def neg : Zmod37 → Zmod37 := quotient.lift (λ a : ℤ, ⟦-a⟧) congr_neg

-- For multiplication I won't even bother proving the lemma, I'll just let ring do it

protected def mul : Zmod37 → Zmod37 → Zmod37 :=
quotient.lift₂ (λ a b : ℤ, ⟦a*b⟧) (λ a₁ a₂ b₁ b₂ ⟨m₁,H₁⟩ ⟨m₂,H₂⟩,quotient.sound ⟨b₁ * m₂ + a₂ * m₁,
  by {rw [add_mul, mul_assoc, mul_assoc, H₁, H₂], ring}⟩)

-- this adds notation to the quotient

instance : has_add (Zmod37) := ⟨Zmod37.add⟩
instance : has_neg (Zmod37) := ⟨Zmod37.neg⟩
instance : has_mul (Zmod37) := ⟨Zmod37.mul⟩

-- these are now very cool proofs:
@[simp] lemma coe_add {a b : ℤ} : (↑(a + b) : Zmod37) = ↑a + ↑b := rfl
@[simp] lemma coe_neg {a : ℤ} : (↑(-a) : Zmod37) = -↑a := rfl
@[simp] lemma coe_mul {a b : ℤ} : (↑(a * b) : Zmod37) = ↑a * ↑b := rfl

-- The proof of coe_add would not be rfl at all if you defined addition on the quotient
-- by choosing representatives and then adding them. Note that choosing reps
-- and adding them is exactly what mathematicians do; they shoot first and
-- ask questions later.

-- Now here's how to use quotient.induction_on and quotient.sound

instance : add_comm_group (Zmod37)  :=
{ add_comm_group .
  zero         := 0, -- because we already defined has_zero
  add          := (+), -- could also have written has_add.add
  neg          := has_neg.neg,
  zero_add     :=
    λ abar, quotient.induction_on abar (begin
      -- goal is ∀ (a : ℤ), 0 + ⟦a⟧ = ⟦a⟧ -- that's what quotient.induction_on does for us
      intro a,
      apply quotient.sound, -- works because 0 + ⟦a⟧ is by definition ⟦0⟧ + ⟦a⟧ which is by definition ⟦0 + a⟧
      -- goal is now 0 + a ≈ a
      -- here's the way we used to do it.
      existsi (0 : ℤ),
      simp,
      -- but there are tricks now, which I'll show you with add_zero and add_assoc.
    end),
  add_assoc    := λ abar bbar cbar,quotient.induction_on₃ abar bbar cbar (λ a b c,
    begin
      -- goal now ⟦a⟧ + ⟦b⟧ + ⟦c⟧ = ⟦a⟧ + (⟦b⟧ + ⟦c⟧)
      apply quotient.sound,
      -- goal now a + b + c ≈ a + (b + c)
      rw add_assoc, -- done :-) because after a rw a goal is closed if it's of the form x ≈ x, as ≈ is
                    -- known to be reflexive.
    end),
  add_zero     := -- I will introduce some more sneaky stuff now now
                  -- add_zero for Zmod37 follows from add_zero on Z.
                  -- Note use of $ instead of the brackets
    λ abar, quotient.induction_on abar $ λ a, quotient.sound $ by rw add_zero,
                  -- that's it! Term mode proof.
  add_left_neg := -- super-slow method not even using quotient.induction_on
    begin
      intro abar,
      cases (quot.exists_rep abar) with a Ha,
      rw [←Ha],
      apply quot.sound,
      existsi (0:ℤ),
      simp,
    end,
  -- but really all proofs should just look something like this
  add_comm     := λ abar bbar, quotient.induction_on₂ abar bbar $ λ _ _,quotient.sound $ by rw add_comm,
  -- the noise at the beginning is just the machine; all the work is done by the rewrite
}

-- Now let's just nail this using all the tricks in the book. All ring axioms on the quotient
-- follow from the corresponding axioms for Z.
instance : comm_ring (Zmod37) :=
{
  mul := (*),
  -- Now look how the proof of mul_assoc is just the same structure as add_comm above
  -- but with three variables not two
  mul_assoc := λ a b c, quotient.induction_on₃ a b c $ λ _ _ _, quotient.sound $ by rw mul_assoc,
  one := 1,
  one_mul := λ a, quotient.induction_on a $ λ _, quotient.sound $ by rw one_mul,
  -- can you finish the job?
  mul_one := sorry,
  left_distrib := sorry,
  right_distrib := sorry,
  mul_comm := sorry,
  ..Zmod37.add_comm_group
}

end Zmod37


/-
Copyright (c) 2014 Robert Lewis. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Robert Lewis, Leonardo de Moura, Johannes Hölzl, Mario Carneiro
-/
import algebra.ring.basic
import algebra.group_with_zero

/-!
# Fields and division rings

This file introduces fields and division rings (also known as skewfields) and proves some basic
statements about them. For a more extensive theory of fields, see the `field_theory` folder.

## Main definitions

* `division_ring`: introduces the notion of a division ring as a `ring` such that `0 ≠ 1` and
  `a * a⁻¹ = 1` for `a ≠ 0`
* `field`: a division ring which is also a commutative ring.
* `is_field`: a predicate on a ring that it is a field, i.e. that the multiplication is commutative,
  that it has more than one element and that all non-zero elements have a multiplicative inverse.
  In contrast to `field`, which contains the data of a function associating to an element of the
  field its multiplicative inverse, this predicate only assumes the existence and can therefore more
  easily be used to e.g. transfer along ring isomorphisms.

## Implementation details

By convention `0⁻¹ = 0` in a field or division ring. This is due to the fact that working with total
functions has the advantage of not constantly having to check that `x ≠ 0` when writing `x⁻¹`. With
this convention in place, some statements like `(a + b) * c⁻¹ = a * c⁻¹ + b * c⁻¹` still remain
true, while others like the defining property `a * a⁻¹ = 1` need the assumption `a ≠ 0`. If you are
a beginner in using Lean and are confused by that, you can read more about why this convention is
taken in Kevin Buzzard's
[blogpost](https://xenaproject.wordpress.com/2020/07/05/division-by-zero-in-type-theory-a-faq/)

A division ring or field is an example of a `group_with_zero`. If you cannot find
a division ring / field lemma that does not involve `+`, you can try looking for
a `group_with_zero` lemma instead.

## Tags

field, division ring, skew field, skew-field, skewfield
-/

open set

set_option old_structure_cmd true

universe u
variables {K : Type u}

/-- A `division_ring` is a `ring` with multiplicative inverses for nonzero elements -/
@[protect_proj, ancestor ring div_inv_monoid nontrivial]
class division_ring (K : Type u) extends ring K, div_inv_monoid K, nontrivial K :=
(mul_inv_cancel : ∀ {a : K}, a ≠ 0 → a * a⁻¹ = 1)
(inv_zero : (0 : K)⁻¹ = 0)

section division_ring
variables [division_ring K] {a b : K}

/-- Every division ring is a `group_with_zero`. -/
@[priority 100] -- see Note [lower instance priority]
instance division_ring.to_group_with_zero :
  group_with_zero K :=
{ .. ‹division_ring K›,
  .. (infer_instance : semiring K) }

lemma inverse_eq_has_inv : (ring.inverse : K → K) = has_inv.inv :=
begin
  ext x,
  by_cases hx : x = 0,
  { simp [hx] },
  { exact ring.inverse_unit (units.mk0 x hx) }
end

attribute [field_simps] inv_eq_one_div

local attribute [simp]
  division_def mul_comm mul_assoc
  mul_left_comm mul_inv_cancel inv_mul_cancel

lemma one_div_neg_one_eq_neg_one : (1:K) / (-1) = -1 :=
have (-1) * (-1) = (1:K), by rw [neg_mul_neg, one_mul],
eq.symm (eq_one_div_of_mul_eq_one this)

lemma one_div_neg_eq_neg_one_div (a : K) : 1 / (- a) = - (1 / a) :=
calc
  1 / (- a) = 1 / ((-1) * a)        : by rw neg_eq_neg_one_mul
        ... = (1 / a) * (1 / (- 1)) : by rw one_div_mul_one_div_rev
        ... = (1 / a) * (-1)        : by rw one_div_neg_one_eq_neg_one
        ... = - (1 / a)             : by rw [mul_neg_eq_neg_mul_symm, mul_one]

lemma div_neg_eq_neg_div (a b : K) : b / (- a) = - (b / a) :=
calc
  b / (- a) = b * (1 / (- a)) : by rw [← inv_eq_one_div, division_def]
        ... = b * -(1 / a)    : by rw one_div_neg_eq_neg_one_div
        ... = -(b * (1 / a))  : by rw neg_mul_eq_mul_neg
        ... = - (b / a)       : by rw mul_one_div

lemma neg_div (a b : K) : (-b) / a = - (b / a) :=
by rw [neg_eq_neg_one_mul, mul_div_assoc, ← neg_eq_neg_one_mul]

@[field_simps] lemma neg_div' {K : Type*} [division_ring K] (a b : K) : - (b / a) = (-b) / a :=
by simp [neg_div]

lemma neg_div_neg_eq (a b : K) : (-a) / (-b) = a / b :=
by rw [div_neg_eq_neg_div, neg_div, neg_neg]

@[field_simps] lemma div_add_div_same (a b c : K) : a / c + b / c = (a + b) / c :=
by simpa only [div_eq_mul_inv] using (right_distrib a b (c⁻¹)).symm

lemma same_add_div {a b : K} (h : b ≠ 0) : (b + a) / b = 1 + a / b :=
by simpa only [← @div_self _ _ b h] using (div_add_div_same b a b).symm

lemma one_add_div {a b : K} (h : b ≠ 0 ) : 1 + a / b = (b + a) / b := (same_add_div h).symm

lemma div_add_same {a b : K} (h : b ≠ 0) : (a + b) / b = a / b + 1 :=
by simpa only [← @div_self _ _ b h] using (div_add_div_same a b b).symm

lemma div_add_one {a b : K} (h : b ≠ 0) : a / b + 1 = (a + b) / b := (div_add_same h).symm

lemma div_sub_div_same (a b c : K) : (a / c) - (b / c) = (a - b) / c :=
by rw [sub_eq_add_neg, ← neg_div, div_add_div_same, sub_eq_add_neg]

lemma same_sub_div {a b : K} (h : b ≠ 0) : (b - a) / b = 1 - a / b :=
by simpa only [← @div_self _ _ b h] using (div_sub_div_same b a b).symm

lemma one_sub_div {a b : K} (h : b ≠ 0) : 1 - a / b = (b - a) / b := (same_sub_div h).symm

lemma div_sub_same {a b : K} (h : b ≠ 0) : (a - b) / b = a / b - 1 :=
by simpa only [← @div_self _ _ b h] using (div_sub_div_same a b b).symm

lemma div_sub_one {a b : K} (h : b ≠ 0) : a / b - 1 = (a - b) / b := (div_sub_same h).symm

lemma neg_inv : - a⁻¹ = (- a)⁻¹ :=
by rw [inv_eq_one_div, inv_eq_one_div, div_neg_eq_neg_div]

lemma add_div (a b c : K) : (a + b) / c = a / c + b / c :=
(div_add_div_same _ _ _).symm

lemma sub_div (a b c : K) : (a - b) / c = a / c - b / c :=
(div_sub_div_same _ _ _).symm

lemma div_neg (a : K) : a / -b = -(a / b) :=
by rw [← div_neg_eq_neg_div]

lemma inv_neg : (-a)⁻¹ = -(a⁻¹) :=
by rw neg_inv

lemma one_div_mul_add_mul_one_div_eq_one_div_add_one_div (ha : a ≠ 0) (hb : b ≠ 0) :
          (1 / a) * (a + b) * (1 / b) = 1 / a + 1 / b :=
by rw [(left_distrib (1 / a)), (one_div_mul_cancel ha), right_distrib, one_mul,
       mul_assoc, (mul_one_div_cancel hb), mul_one, add_comm]

lemma one_div_mul_sub_mul_one_div_eq_one_div_add_one_div (ha : a ≠ 0) (hb : b ≠ 0) :
          (1 / a) * (b - a) * (1 / b) = 1 / a - 1 / b :=
by rw [(mul_sub_left_distrib (1 / a)), (one_div_mul_cancel ha), mul_sub_right_distrib,
       one_mul, mul_assoc, (mul_one_div_cancel hb), mul_one]

lemma add_div_eq_mul_add_div (a b : K) {c : K} (hc : c ≠ 0) : a + b / c = (a * c + b) / c :=
(eq_div_iff_mul_eq hc).2 $ by rw [right_distrib, (div_mul_cancel _ hc)]

@[priority 100] -- see Note [lower instance priority]
instance division_ring.to_domain : domain K :=
{ ..‹division_ring K›, ..(by apply_instance : semiring K),
  ..(by apply_instance : no_zero_divisors K) }

end division_ring

/-- A `field` is a `comm_ring` with multiplicative inverses for nonzero elements -/
@[protect_proj, ancestor comm_ring div_inv_monoid nontrivial]
class field (K : Type u) extends comm_ring K, div_inv_monoid K, nontrivial K :=
(mul_inv_cancel : ∀ {a : K}, a ≠ 0 → a * a⁻¹ = 1)
(inv_zero : (0 : K)⁻¹ = 0)

section field

variable [field K]

@[priority 100] -- see Note [lower instance priority]
instance field.to_division_ring : division_ring K :=
{ ..show field K, by apply_instance }

/-- Every field is a `comm_group_with_zero`. -/
@[priority 100] -- see Note [lower instance priority]
instance field.to_comm_group_with_zero :
  comm_group_with_zero K :=
{ .. (_ : group_with_zero K), .. ‹field K› }

local attribute [simp] mul_assoc mul_comm mul_left_comm

lemma div_add_div (a : K) {b : K} (c : K) {d : K} (hb : b ≠ 0) (hd : d ≠ 0) :
      (a / b) + (c / d) = ((a * d) + (b * c)) / (b * d) :=
by rw [← mul_div_mul_right _ b hd, ← mul_div_mul_left c d hb, div_add_div_same]

lemma one_div_add_one_div {a b : K} (ha : a ≠ 0) (hb : b ≠ 0) : 1 / a + 1 / b = (a + b) / (a * b) :=
by rw [div_add_div _ _ ha hb, one_mul, mul_one, add_comm]

@[field_simps] lemma div_sub_div (a : K) {b : K} (c : K) {d : K} (hb : b ≠ 0) (hd : d ≠ 0) :
  (a / b) - (c / d) = ((a * d) - (b * c)) / (b * d) :=
begin
  simp only [sub_eq_add_neg],
  rw [neg_eq_neg_one_mul, ← mul_div_assoc, div_add_div _ _ hb hd,
      ← mul_assoc, mul_comm b, mul_assoc, ← neg_eq_neg_one_mul]
end

lemma inv_add_inv {a b : K} (ha : a ≠ 0) (hb : b ≠ 0) : a⁻¹ + b⁻¹ = (a + b) / (a * b) :=
by rw [inv_eq_one_div, inv_eq_one_div, one_div_add_one_div ha hb]

lemma inv_sub_inv {a b : K} (ha : a ≠ 0) (hb : b ≠ 0) : a⁻¹ - b⁻¹ = (b - a) / (a * b) :=
by rw [inv_eq_one_div, inv_eq_one_div, div_sub_div _ _ ha hb, one_mul, mul_one]

@[field_simps] lemma add_div' (a b c : K) (hc : c ≠ 0) : b + a / c = (b * c + a) / c :=
by simpa using div_add_div b a one_ne_zero hc

@[field_simps] lemma sub_div' (a b c : K) (hc : c ≠ 0) : b - a / c = (b * c - a) / c :=
by simpa using div_sub_div b a one_ne_zero hc

@[field_simps] lemma div_add' (a b c : K) (hc : c ≠ 0) : a / c + b = (a + b * c) / c :=
by rwa [add_comm, add_div', add_comm]

@[field_simps] lemma div_sub' (a b c : K) (hc : c ≠ 0) : a / c - b = (a - c * b) / c :=
by simpa using div_sub_div a b hc one_ne_zero

@[priority 100] -- see Note [lower instance priority]
instance field.to_integral_domain : integral_domain K :=
{ ..‹field K›, ..division_ring.to_domain }

end field

section is_field

/-- A predicate to express that a ring is a field.

This is mainly useful because such a predicate does not contain data,
and can therefore be easily transported along ring isomorphisms.
Additionaly, this is useful when trying to prove that
a particular ring structure extends to a field. -/
structure is_field (R : Type u) [ring R] : Prop :=
(exists_pair_ne : ∃ (x y : R), x ≠ y)
(mul_comm : ∀ (x y : R), x * y = y * x)
(mul_inv_cancel : ∀ {a : R}, a ≠ 0 → ∃ b, a * b = 1)

/-- Transferring from field to is_field -/
lemma field.to_is_field (R : Type u) [field R] : is_field R :=
{ mul_inv_cancel := λ a ha, ⟨a⁻¹, field.mul_inv_cancel ha⟩,
  ..‹field R› }

open_locale classical

/-- Transferring from is_field to field -/
noncomputable def is_field.to_field (R : Type u) [ring R] (h : is_field R) : field R :=
{ inv := λ a, if ha : a = 0 then 0 else classical.some (is_field.mul_inv_cancel h ha),
  inv_zero := dif_pos rfl,
  mul_inv_cancel := λ a ha,
    begin
      convert classical.some_spec (is_field.mul_inv_cancel h ha),
      exact dif_neg ha
    end,
  .. ‹ring R›, ..h }

/-- For each field, and for each nonzero element of said field, there is a unique inverse.
Since `is_field` doesn't remember the data of an `inv` function and as such,
a lemma that there is a unique inverse could be useful.
-/
lemma uniq_inv_of_is_field (R : Type u) [ring R] (hf : is_field R) :
  ∀ (x : R), x ≠ 0 → ∃! (y : R), x * y = 1 :=
begin
  intros x hx,
  apply exists_unique_of_exists_of_unique,
  { exact hf.mul_inv_cancel hx },
  { intros y z hxy hxz,
    calc y = y * (x * z) : by rw [hxz, mul_one]
       ... = (x * y) * z : by rw [← mul_assoc, hf.mul_comm y x]
       ... = z           : by rw [hxy, one_mul] }
end

end is_field

namespace ring_hom

section

variables {R : Type*} [semiring R] [division_ring K] (f : R →+* K)

@[simp] lemma map_units_inv (u : units R) :
  f ↑u⁻¹ = (f ↑u)⁻¹ :=
(f : R →* K).map_units_inv u

end

section

variables {R K' : Type*} [division_ring K] [semiring R] [nontrivial R] [division_ring K']
  (f : K →+* R) (g : K →+* K') {x y : K}

lemma map_ne_zero : f x ≠ 0 ↔ x ≠ 0 := f.to_monoid_with_zero_hom.map_ne_zero

@[simp] lemma map_eq_zero : f x = 0 ↔ x = 0 := f.to_monoid_with_zero_hom.map_eq_zero

variables (x y)

lemma map_inv : g x⁻¹ = (g x)⁻¹ := g.to_monoid_with_zero_hom.map_inv' x

lemma map_div : g (x / y) = g x / g y := g.to_monoid_with_zero_hom.map_div x y

protected lemma injective : function.injective f := f.injective_iff.2 $ λ x, f.map_eq_zero.1

end

end ring_hom

section noncomputable_defs

variables {R : Type*} [nontrivial R]

/-- Constructs a `division_ring` structure on a `ring` consisting only of units and 0. -/
noncomputable def division_ring_of_is_unit_or_eq_zero [hR : ring R]
  (h : ∀ (a : R), is_unit a ∨ a = 0) : division_ring R :=
{ .. (group_with_zero_of_is_unit_or_eq_zero h), .. hR }

/-- Constructs a `field` structure on a `comm_ring` consisting only of units and 0. -/
noncomputable def field_of_is_unit_or_eq_zero [hR : comm_ring R]
  (h : ∀ (a : R), is_unit a ∨ a = 0) : field R :=
{ .. (group_with_zero_of_is_unit_or_eq_zero h), .. hR }

end noncomputable_defs

/-- Pullback a `division_ring` along an injective function. -/
protected def function.injective.division_ring [division_ring K] {K'}
  [has_zero K'] [has_mul K'] [has_add K'] [has_neg K'] [has_sub K'] [has_one K'] [has_inv K']
  [has_div K']
  (f : K' → K) (hf : function.injective f) (zero : f 0 = 0) (one : f 1 = 1)
  (add : ∀ x y, f (x + y) = f x + f y) (mul : ∀ x y, f (x * y) = f x * f y)
  (neg : ∀ x, f (-x) = -f x) (sub : ∀ x y, f (x - y) = f x - f y)
  (inv : ∀ x, f (x⁻¹) = (f x)⁻¹) (div : ∀ x y, f (x / y) = f x / f y) :
  division_ring K' :=
{ .. hf.group_with_zero f zero one mul inv div,
  .. hf.ring f zero one add mul neg sub }

/-- Pullback a `field` along an injective function. -/
protected def function.injective.field [field K] {K'}
  [has_zero K'] [has_mul K'] [has_add K'] [has_neg K'] [has_sub K'] [has_one K'] [has_inv K']
  [has_div K']
  (f : K' → K) (hf : function.injective f) (zero : f 0 = 0) (one : f 1 = 1)
  (add : ∀ x y, f (x + y) = f x + f y) (mul : ∀ x y, f (x * y) = f x * f y)
  (neg : ∀ x, f (-x) = -f x) (sub : ∀ x y, f (x - y) = f x - f y)
  (inv : ∀ x, f (x⁻¹) = (f x)⁻¹) (div : ∀ x y, f (x / y) = f x / f y) :
  field K' :=
{ .. hf.comm_group_with_zero f zero one mul inv div,
  .. hf.comm_ring f zero one add mul neg sub }