import BrownCs22.Library.Tactics

namespace HW2

set_option linter.unusedVariables false
open Dvd

/-

# Welcome to the Lean section of HW2!

In this assignment, we're going to move beyond random letters.
Enough of those `p`, `q`, `r` problems.

Some things to keep in mind:

* The file `BrownCs22/Demos/QuickReference.lean` has some brief notes on
  which tactics we've seen and what they do. Check it out!

* There's also an FAQ thread on Ed. Check there before making a new post
  if you run into issues.

* You can hover over any fancy character in VSCode to see how to type it.

* Remember, the autograder will not be happy if your submission has any
  *red* error messages. If you can't finish a question, you can replace your work
  with `sorry`. You won't get points on that question but the autograder will run.

Our goal today: let's prove some interesting things about numbers!
We're looking a little bit ahead, preparing for the number theory
section of this class. In the process, we'll get familiar with the proof rules
for the *quantifiers* `∀` and `∃`.

(If you don't remember those rules, check out the Lecture 6 notes and the
quick reference.)

## A few helpful tactics

In addition to the proof rules for quantifiers, these tactics may be useful
to finish your proofs. Depending on how you do your proofs, you may not
need all of these.

* `positivity`: if your goal is to show something is positive or nonnegative
  (like `0 < x`, `x ≥ 0`, `0 ≤ a^2`, ...) and this "obviously" follows from
  your hypotheses, write `positivity` to finish that goal. This tactic knows
  basic facts like "natural numbers are nonnegative" and "the square of a
  positive number is positive." It does not know complicated arithmetic.

* `numbers`: If your goal is to show an arithmetic statement about numerals,
  like `5 + 5 = 10` or `1000 < 50000000`, `numbers` will close the goal.
  It's basically a calculator!

* `linarith`: stands for "linear arithmetic." (If you don't know this term,
  don't worry.) `linarith` does similar things to `positivity` and `numbers`,
  but it can do some simple arithmetic, and use hypotheses.
  For instance, if you know `h1 : x < 10` and `h2 : x + y < 20`, `linarith`
  can prove the goal `3*x + 2*y < 50`.

A good strategy: if you have a goal with no variables in it (only numbers),
try `numbers`. If it's a comparison between some variables and 0, try
`positivity`. Otherwise, try `linarith`.

-/

/-

## Problem 1

Here's some practice with quantifiers. Read the statement of this question
out loud to yourself -- what is it stating?

Remember `ℕ = {0, 1, 2, ...}`, the natural numbers.

-/

/- 3 points -/
theorem problem_1 : ∃ n : ℕ, ∀ x : ℕ, n ≤ x := by
  sorry

/-

## Problems 2-3

We say that a natural number `x : ℕ` *divides* a natural number `y : ℕ`,
written `x ∣ y`, if there exists `c : ℕ` such that `y = x * c`.

This is an existential claim in disguise! Written in logic, we can say
`x ∣ y` is defined to mean `∃ c : ℕ, y = x * c`.

If you see a statement like `x ∣ y` in your goal or in a hypothesis,
you can use the tactic `dsimp [dvd]` to change it to the equivalent existential.
This stands for "definition simplify".
(In the future, we'll use `dsimp` to unfold more than just division.)

For example:
-/

example (x : ℕ) : x ∣ 10 → x ∣ 10 := by
  intro hx10
  dsimp [dvd] -- change the goal to an existential
  dsimp [dvd] at hx10 -- change the hypothesis hx10 to an existential
  assumption

/-

We don't *need* to use `dsimp`.
If we want to prove a "divides" statement, we use `existsi` directly,
just like for the existential statement.
If we want to use a "divides" hypotheses, we can `eliminate` it directly,
again just like for an existential.
But it should never hurt to use `dsimp` if you want to.

First, practice an introduction:

-/

/- 1 point -/
theorem problem_2 : 5 ∣ 15 := by
  sorry

/-

Let's use this definition of divides to prove that any divisor of 10
is also a divisor of 100.

-/

/- 3 points -/
theorem problem_3 : ∀ x : ℕ, x ∣ 10 → x ∣ 100 := by
  sorry

/-

## Problem 4

This time, you're going to practice a forall elimination!
Remember the syntax for this:
if you have a hypothesis `h : ∀ x : ℕ, MyProperty1 x ∧ MyProperty2 x`,
you could write `have h2 : MyProperty1 100 ∧ MyProperty2 100 := h 100`,
or even `have h4 : MyProperty1 my_var ∧ MyProperty2 my_var := h my_var`,
if you have a variable named `my_var`.
We say that we have *instantiated* the universal statement
with `100` and `my_var`, respectively, "plugging in" these values for `x`.

Your creative step in this problem is to decide how to instantiate `h`.
`h` says a certain proposition is true for every `x`.
Which value of `x` is useful to you?

Try to reason through this problem on paper before solving it in Lean.
There's a hint at the bottom of this file.

Notice that we've already introduced the hypothesis `h` for you in this problem.
No need to start with `intro`.

-/

/- 3 points -/
theorem problem_4 (a b : ℤ) (h : ∀ x, 2*a ≤ x ∨ x ≤ 2*b) : a ≤ b := by
  sorry

/-

## Bonus challenge

This one isn't for points, and doesn't have to do with numbers.
But it's a fun logic puzzle.
Try it if you're enjoying Lean and want a challenge.
But don't feel bad if you can't figure it out!
This problem relates to the infamous "barber paradox" (look it up!).

A hint: the `have` syntax we used for modus ponens is very general.
You can use this whenever you want, to create a new fact in your context.
But you can't create a fact without justifying it.
If you write, for instance, `have h_new_hyp : p ∧ q`
(*without* a `:=` at the end, which we used for modus ponens),
you will see that a new goal appears. First Lean wants you to prove `p ∧ q`.
Then it wants you to return to your original goal, with a new hypothesis
`h_new_hyp : p ∧ q` in your context.

An example:

-/

example (p q : Prop) (hp : p) (hq : q) : True := by
  have hpq : p ∧ q -- after this line, the goal becomes to show `p ∧ q`
  { split_goal     -- use brackets to focus on the first goal
    assumption
    assumption }
  -- at this point in the proof, we have a new hypothesis `hpq : p ∧ q`.
  -- but this was just a silly example so we don't need to use it
  trivial

/- Informally, this is like "reasoning forward". From things you already know,
you're deriving a new thing, and then using that new thing later on.

This technique is very helpful to finish this problem, when you look at
the proof state and feel stuck. Try puzzling through it: what new thing(s)
can you state and use?

-/

theorem bonus_challenge (p : Prop) : ¬ (p ↔ ¬ p) := by
  sorry

/-

## Problem 4 hint

Just thinking informally, not in Lean:
if `2*a ≤ a + b`, then `a ≤ b`,
since we can subtract `a` from both sides.

-/

end HW2


import tactic.ring_exp
import tactic.zify
import algebra.group_with_zero.power
import tactic.field_simp

universes u

section addition
/-!
  ### `addition` section

  Test associativity and commutativity of `(+)`.
-/
example (a b : ℚ) : a = a := by ring_exp
example (a b : ℚ) : a + b = a + b := by ring_exp
example (a b : ℚ) : b + a = a + b := by ring_exp
example (a b : ℤ) : a + b + b = b + (a + b) := by ring_exp
example (a b c : ℕ) : a + b + b + (c + c) = c + (b + c) + (a + b) := by ring_exp
end addition

section numerals
/-!
  ### `numerals` section

  Test that numerals behave like rational numbers.
-/
example (a : ℕ) : a + 5 + 5 = 0 + a + 10 := by ring_exp
example (a : ℤ) : a + 5 + 5 = 0 + a + 10 := by ring_exp
example (a : ℚ) : (1/2) * a + (1/2) * a = a := by ring_exp
end numerals

section multiplication
/-!
  ### `multiplication section`

  Test that multiplication is associative and commutative.
  Also test distributivity of `(+)` and `(*)`.
-/
example (a : ℕ) : 0 = a * 0 := by ring_exp_eq
example (a : ℕ) : a = a * 1 := by ring_exp
example (a : ℕ) : a + a = a * 2 := by ring_exp
example (a b : ℤ) : a * b = b * a := by ring_exp
example (a b : ℕ) : a * 4 * b + a = a * (4 * b + 1) := by ring_exp
end multiplication

section exponentiation
/-!
  ### `exponentiation` section

  Test that exponentiation has the correct distributivity properties.
-/
example : 0 ^ 1 = 0 := by ring_exp
example : 0 ^ 2 = 0 := by ring_exp
example (a : ℕ) : a ^ 0 = 1 := by ring_exp
example (a : ℕ) : a ^ 1 = a := by ring_exp
example (a : ℕ) : a ^ 2 = a * a := by ring_exp
example (a b : ℕ) : a ^ b = a ^ b := by ring_exp
example (a b : ℕ) : a ^ (b + 1) = a * a ^ b := by ring_exp
example (n : ℕ) (a m : ℕ) : a * a^n * m = a^(n+1) * m := by ring_exp
example (n : ℕ) (a m : ℕ) : m * a^n * a = a^(n+1) * m := by ring_exp
example (n : ℕ) (a m : ℤ) : a * a^n * m = a^(n+1) * m := by ring_exp
example (n : ℕ) (m : ℤ) : 2 * 2^n * m = 2^(n+1) * m := by ring_exp
example (n : ℕ) (m : ℤ) : 2^(n+1) * m = 2 * 2^n * m := by ring_exp
example (n m : ℕ) (a : ℤ) : (a ^ n)^m = a^(n * m) := by ring_exp
example (n m : ℕ) (a : ℤ) : a^(n^0) = a^1 := by ring_exp
example (n : ℕ) : 0^(n + 1) = 0 := by ring_exp
example {α} [comm_ring α] (x : α) (k : ℕ) : x ^ (k + 2) = x * x * x^k := by ring_exp
example {α} [comm_ring α] (k : ℕ) (x y z : α) :
  x * (z * (x - y)) + (x * (y * y ^ k) - y * (y * y ^ k)) = (z * x + y * y ^ k) * (x - y)
:= by ring_exp

-- We can represent a large exponent `n` more efficiently than just `n` multiplications:
example (a b : ℚ) : (a * b) ^ 1000000 = (b * a) ^ 1000000 := by ring_exp

example (n : ℕ) : 2 ^ (n + 1 + 1)  = 2 * 2 ^ (n + 1) :=
by ring_exp_eq

end exponentiation

section power_of_sum
/-!
  ### `power_of_sum` section

  Test that raising a sum to a power behaves like repeated multiplication,
  if needed.
-/
example (a b : ℤ) : (a + b)^2 = a^2 + b^2 + a * b + b * a := by ring_exp
example (a b : ℤ) (n : ℕ) : (a + b)^(n + 2) = (a^2 + b^2 + a * b + b * a) * (a + b)^n := by ring_exp
end power_of_sum

section negation
/-!
  ### `negation` section

  Test that negation and subtraction satisfy the expected properties,
  also in semirings such as `ℕ`.
-/
example {α} [comm_ring α] (a : α) : a - a = 0 := by ring_exp_eq
example (a : ℤ) : a - a = 0 := by ring_exp
example (a : ℤ) : a + - a = 0 := by ring_exp
example (a : ℤ) : - a = (-1) * a := by ring_exp
-- Here, (a - b) is treated as an atom.
example (a b : ℕ) : a - b + a + a = a - b + 2 * a := by ring_exp
example (n : ℕ) : n + 1 - 1 = n := by ring_exp! -- But we can force a bit of evaluation anyway.
end negation

constant f {α} : α → α
section complicated
/-!
  ### `complicated` section

  Test that complicated, real-life expressions also get normalized.
-/
example {α : Type} [linear_ordered_field α] (x : α) :
  2 * x + 1 * 1 - (2 * f (x + 1 / 2) + 2 * 1) + (1 * 1 - (2 * x - 2 * f (x + 1 / 2))) = 0
:= by ring_exp_eq
example {α : Type u} [linear_ordered_field α] (x : α) :
  f (x + 1 / 2) ^ 1 * -2 + (f (x + 1 / 2) ^ 1 * 2 + 0) = 0
:= by ring_exp_eq

example (x y : ℕ) : x + id y = y + id x := by ring_exp!

-- Here, we check that `n - s` is not treated as `n + additive_inverse s`,
-- if `s` doesn't have an additive inverse.
example (B s n : ℕ) : B * (f s * ((n - s) * f (n - s - 1))) = B * (n - s) * (f s * f (n - s - 1)) :=
by ring_exp

-- This is a somewhat subtle case: `-c/b` is parsed as `(-c)/b`,
-- so we can't simply treat both sides of the division as atoms.
-- Instead, we follow the `ring` tactic in interpreting `-c / b` as `-c * b⁻¹`,
-- with only `b⁻¹` an atom.
example {α} [linear_ordered_field α] (a b c : α) : a*(-c/b)*(-c/b) = a*((c/b)*(c/b)) := by ring_exp

-- test that `field_simp` works fine with powers and `ring_exp`.
example (x y : ℚ) (n : ℕ) (hx : x ≠ 0) (hy : y ≠ 0) :
  1/ (2/(x / y))^(2 * n) + y / y^(n+1) - (x/y)^n * (x/(2 * y))^n / 2 ^n = 1/y^n :=
begin
  field_simp,
  ring_exp
end
end complicated

-- Test that `nat.succ d` gets handled as `d + 1`.
example (d : ℕ) : 2 * (2 ^ d - 1) + 1 = 2 ^ d.succ - 1 :=
begin
  zify [nat.one_le_pow'],
  ring_exp,
end

section conv
/-!
  ### `conv` section

  Test that `ring_exp` works inside of `conv`, both with and without `!`.
-/

example (n : ℕ) : (2^n * 2 + 1)^10 = (2^(n+1) + 1)^10 :=
begin
conv_rhs
{ congr,
  ring_exp, },
conv_lhs
{ congr,
  ring_exp, },
end

example (x y : ℤ) : x + id y - y + id x = x * 2 := begin
  conv_lhs { ring_exp!, },
end
end conv

section benchmark
/-!
  ### `benchmark` section

  The `ring_exp` tactic shouldn't be too slow.
-/
-- This last example was copied from `data/polynomial.lean`, because it timed out.
-- After some optimization, it doesn't.
variables {α : Type} [comm_ring α]
def pow_sub_pow_factor (x y : α) : Π {i : ℕ},{z // x^i - y^i = z*(x - y)}
| 0 := ⟨0, by simp⟩
| 1 := ⟨1, by simp⟩
| (k+2) :=
begin
  cases @pow_sub_pow_factor (k+1) with z hz,
  existsi z*x + y^(k+1),
  rw [pow_succ x, pow_succ y, ←sub_add_sub_cancel (x*x^(k+1)) (x*y^(k+1)),
  ←mul_sub x, hz],
  ring_exp_eq
end

-- Another benchmark: bound the growth of the complexity somewhat.
example {α} [comm_semiring α] (x : α) : (x + 1) ^ 4 = (1 + x) ^ 4   := by try_for  5000 {ring_exp}
example {α} [comm_semiring α] (x : α) : (x + 1) ^ 6 = (1 + x) ^ 6   := by try_for 10000 {ring_exp}
example {α} [comm_semiring α] (x : α) : (x + 1) ^ 8 = (1 + x) ^ 8   := by try_for 15000 {ring_exp}
end benchmark


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

/-!
# Multiplication and division of submodules of an algebra.

An interface for multiplication and division of sub-R-modules of an R-algebra A is developed.

## Main definitions

Let `R` be a commutative ring (or semiring) and aet `A` be an `R`-algebra.

* `1 : submodule R A`       : the R-submodule R of the R-algebra A
* `has_mul (submodule R A)` : multiplication of two sub-R-modules M and N of A is defined to be
                              the smallest submodule containing all the products `m * n`.
* `has_div (submodule R A)` : `I / J` is defined to be the submodule consisting of all `a : A` such
                              that `a • J ⊆ I`

It is proved that `submodule R A` is a semiring, and also an algebra over `set A`.

## Tags

multiplication of submodules, division of subodules, submodule semiring
-/

universes uι u v

open algebra set
open_locale big_operators
open_locale pointwise

namespace submodule

variables {ι : Sort uι}
variables {R : Type u} [comm_semiring R]

section ring

variables {A : Type v} [semiring A] [algebra R A]
variables (S T : set A) {M N P Q : submodule R A} {m n : A}

/-- `1 : submodule R A` is the submodule R of A. -/
instance : has_one (submodule R A) :=
⟨(algebra.linear_map R A).range⟩

theorem one_eq_range :
  (1 : submodule R A) = (algebra.linear_map R A).range := rfl

lemma algebra_map_mem (r : R) : algebra_map R A r ∈ (1 : submodule R A) :=
linear_map.mem_range_self _ _

@[simp] lemma mem_one {x : A} : x ∈ (1 : submodule R A) ↔ ∃ y, algebra_map R A y = x :=
by simp only [one_eq_range, linear_map.mem_range, algebra.linear_map_apply]

theorem one_eq_span : (1 : submodule R A) = R ∙ 1 :=
begin
  apply submodule.ext,
  intro a,
  simp only [mem_one, mem_span_singleton, algebra.smul_def, mul_one]
end

theorem one_le : (1 : submodule R A) ≤ P ↔ (1 : A) ∈ P :=
by simpa only [one_eq_span, span_le, set.singleton_subset_iff]

/-- Multiplication of sub-R-modules of an R-algebra A. The submodule `M * N` is the
smallest R-submodule of `A` containing the elements `m * n` for `m ∈ M` and `n ∈ N`. -/
instance : has_mul (submodule R A) :=
⟨λ M N, ⨆ s : M, N.map $ algebra.lmul R A s.1⟩

theorem mul_mem_mul (hm : m ∈ M) (hn : n ∈ N) : m * n ∈ M * N :=
(le_supr _ ⟨m, hm⟩ : _ ≤ M * N) ⟨n, hn, rfl⟩

theorem mul_le : M * N ≤ P ↔ ∀ (m ∈ M) (n ∈ N), m * n ∈ P :=
⟨λ H m hm n hn, H $ mul_mem_mul hm hn,
λ H, supr_le $ λ ⟨m, hm⟩, map_le_iff_le_comap.2 $ λ n hn, H m hm n hn⟩

@[elab_as_eliminator] protected theorem mul_induction_on
  {C : A → Prop} {r : A} (hr : r ∈ M * N)
  (hm : ∀ (m ∈ M) (n ∈ N), C (m * n))
  (h0 : C 0) (ha : ∀ x y, C x → C y → C (x + y))
  (hs : ∀ (r : R) x, C x → C (r • x)) : C r :=
(@mul_le _ _ _ _ _ _ _ ⟨C, h0, ha, hs⟩).2 hm hr

variables R
theorem span_mul_span : span R S * span R T = span R (S * T) :=
begin
  apply le_antisymm,
  { rw mul_le, intros a ha b hb,
    apply span_induction ha,
    work_on_goal 0 { intros, apply span_induction hb,
      work_on_goal 0 { intros, exact subset_span ⟨_, _, ‹_›, ‹_›, rfl⟩ } },
    all_goals { intros, simp only [mul_zero, zero_mul, zero_mem,
        left_distrib, right_distrib, mul_smul_comm, smul_mul_assoc],
      try {apply add_mem _ _ _}, try {apply smul_mem _ _ _} }, assumption' },
  { rw span_le, rintros _ ⟨a, b, ha, hb, rfl⟩,
    exact mul_mem_mul (subset_span ha) (subset_span hb) }
end
variables {R}

variables (M N P Q)
protected theorem mul_assoc : (M * N) * P = M * (N * P) :=
le_antisymm (mul_le.2 $ λ mn hmn p hp,
  suffices M * N ≤ (M * (N * P)).comap (algebra.lmul_right R p), from this hmn,
  mul_le.2 $ λ m hm n hn, show m * n * p ∈ M * (N * P), from
  (mul_assoc m n p).symm ▸ mul_mem_mul hm (mul_mem_mul hn hp))
(mul_le.2 $ λ m hm np hnp,
  suffices N * P ≤ (M * N * P).comap (algebra.lmul_left R m), from this hnp,
  mul_le.2 $ λ n hn p hp, show m * (n * p) ∈ M * N * P, from
  mul_assoc m n p ▸ mul_mem_mul (mul_mem_mul hm hn) hp)

@[simp] theorem mul_bot : M * ⊥ = ⊥ :=
eq_bot_iff.2 $ mul_le.2 $ λ m hm n hn, by rw [submodule.mem_bot] at hn ⊢; rw [hn, mul_zero]

@[simp] theorem bot_mul : ⊥ * M = ⊥ :=
eq_bot_iff.2 $ mul_le.2 $ λ m hm n hn, by rw [submodule.mem_bot] at hm ⊢; rw [hm, zero_mul]

@[simp] protected theorem one_mul : (1 : submodule R A) * M = M :=
by { conv_lhs { rw [one_eq_span, ← span_eq M] }, erw [span_mul_span, one_mul, span_eq] }

@[simp] protected theorem mul_one : M * 1 = M :=
by { conv_lhs { rw [one_eq_span, ← span_eq M] }, erw [span_mul_span, mul_one, span_eq] }

variables {M N P Q}

@[mono] theorem mul_le_mul (hmp : M ≤ P) (hnq : N ≤ Q) : M * N ≤ P * Q :=
mul_le.2 $ λ m hm n hn, mul_mem_mul (hmp hm) (hnq hn)

theorem mul_le_mul_left (h : M ≤ N) : M * P ≤ N * P :=
mul_le_mul h (le_refl P)

theorem mul_le_mul_right (h : N ≤ P) : M * N ≤ M * P :=
mul_le_mul (le_refl M) h

variables (M N P)

theorem sup_mul : (M ⊔ N) * P = M * P ⊔ N * P :=
le_antisymm (mul_le.2 $ λ mn hmn p hp, let ⟨m, hm, n, hn, hmn⟩ := mem_sup.1 hmn in
  mem_sup.2 ⟨_, mul_mem_mul hm hp, _, mul_mem_mul hn hp, hmn ▸ (add_mul m n p).symm⟩)
(sup_le (mul_le_mul_left le_sup_left) (mul_le_mul_left le_sup_right))

lemma mul_subset_mul : (↑M : set A) * (↑N : set A) ⊆ (↑(M * N) : set A) :=
by { rintros _ ⟨i, j, hi, hj, rfl⟩, exact mul_mem_mul hi hj }

lemma map_mul {A'} [semiring A'] [algebra R A'] (f : A →ₐ[R] A') :
  map f.to_linear_map (M * N) = map f.to_linear_map M * map f.to_linear_map N :=
calc map f.to_linear_map (M * N)
    = ⨆ (i : M), (N.map (lmul R A i)).map f.to_linear_map : map_supr _ _
... = map f.to_linear_map M * map f.to_linear_map N  :
  begin
    apply congr_arg Sup,
    ext S,
    split; rintros ⟨y, hy⟩,
    { use [f y, mem_map.mpr ⟨y.1, y.2, rfl⟩],
      refine trans _ hy,
      ext,
      simp },
    { obtain ⟨y', hy', fy_eq⟩ := mem_map.mp y.2,
      use [y', hy'],
      refine trans _ hy,
      rw f.to_linear_map_apply at fy_eq,
      ext,
      simp [fy_eq] }
end

section decidable_eq

open_locale classical

lemma mem_span_mul_finite_of_mem_span_mul {S : set A} {S' : set A} {x : A}
  (hx : x ∈ span R (S * S')) :
  ∃ (T T' : finset A), ↑T ⊆ S ∧ ↑T' ⊆ S' ∧ x ∈ span R (T * T' : set A) :=
begin
  obtain ⟨U, h, hU⟩ := mem_span_finite_of_mem_span hx,
  obtain ⟨T, T', hS, hS', h⟩ := finset.subset_mul h,
  use [T, T', hS, hS'],
  have h' : (U : set A) ⊆ T * T', { assumption_mod_cast, },
  have h'' := span_mono h' hU,
  assumption,
end

end decidable_eq

lemma mul_eq_span_mul_set (s t : submodule R A) : s * t = span R ((s : set A) * (t : set A)) :=
by rw [← span_mul_span, span_eq, span_eq]

lemma supr_mul (s : ι → submodule R A) (t : submodule R A) : (⨆ i, s i) * t = ⨆ i, s i * t :=
begin
  suffices : (⨆ i, span R (s i : set A)) * span R t = (⨆ i, span R (s i) * span R t),
  { simpa only [span_eq] using this },
  simp_rw [span_mul_span, ← span_Union, span_mul_span, set.Union_mul],
end

lemma mul_supr (t : submodule R A) (s : ι → submodule R A) : t * (⨆ i, s i) = ⨆ i, t * s i :=
begin
  suffices : span R (t : set A) * (⨆ i, span R (s i)) = (⨆ i, span R t * span R (s i)),
  { simpa only [span_eq] using this },
  simp_rw [span_mul_span, ← span_Union, span_mul_span, set.mul_Union],
end

lemma mem_span_mul_finite_of_mem_mul {P Q : submodule R A} {x : A} (hx : x ∈ P * Q) :
  ∃ (T T' : finset A), (T : set A) ⊆ P ∧ (T' : set A) ⊆ Q ∧ x ∈ span R (T * T' : set A) :=
submodule.mem_span_mul_finite_of_mem_span_mul
  (by rwa [← submodule.span_eq P, ← submodule.span_eq Q, submodule.span_mul_span] at hx)

variables {M N P}

/-- Sub-R-modules of an R-algebra form a semiring. -/
instance : semiring (submodule R A) :=
{ one_mul       := submodule.one_mul,
  mul_one       := submodule.mul_one,
  mul_assoc     := submodule.mul_assoc,
  zero_mul      := bot_mul,
  mul_zero      := mul_bot,
  left_distrib  := mul_sup,
  right_distrib := sup_mul,
  ..submodule.pointwise_add_comm_monoid,
  ..submodule.has_one,
  ..submodule.has_mul }

variables (M)

lemma pow_subset_pow {n : ℕ} : (↑M : set A)^n ⊆ ↑(M^n : submodule R A) :=
begin
  induction n with n ih,
  { erw [pow_zero, pow_zero, set.singleton_subset_iff],
    rw [set_like.mem_coe, ← one_le],
    exact le_refl _ },
  { rw [pow_succ, pow_succ],
    refine set.subset.trans (set.mul_subset_mul (subset.refl _) ih) _,
    apply mul_subset_mul }
end

/-- `span` is a semiring homomorphism (recall multiplication is pointwise multiplication of subsets
on either side). -/
def span.ring_hom : set_semiring A →+* submodule R A :=
{ to_fun := submodule.span R,
  map_zero' := span_empty,
  map_one' := one_eq_span.symm,
  map_add' := span_union,
  map_mul' := λ s t, by erw [span_mul_span, ← image_mul_prod] }

end ring

section comm_ring

variables {A : Type v} [comm_semiring A] [algebra R A]
variables {M N : submodule R A} {m n : A}

theorem mul_mem_mul_rev (hm : m ∈ M) (hn : n ∈ N) : n * m ∈ M * N :=
mul_comm m n ▸ mul_mem_mul hm hn

variables (M N)
protected theorem mul_comm : M * N = N * M :=
le_antisymm (mul_le.2 $ λ r hrm s hsn, mul_mem_mul_rev hsn hrm)
(mul_le.2 $ λ r hrn s hsm, mul_mem_mul_rev hsm hrn)

/-- Sub-R-modules of an R-algebra A form a semiring. -/
instance : comm_semiring (submodule R A) :=
{ mul_comm := submodule.mul_comm,
  .. submodule.semiring }

lemma prod_span {ι : Type*} (s : finset ι) (M : ι → set A) :
  (∏ i in s, submodule.span R (M i)) = submodule.span R (∏ i in s, M i) :=
begin
  letI := classical.dec_eq ι,
  refine finset.induction_on s _ _,
  { simp [one_eq_span, set.singleton_one] },
  { intros _ _ H ih,
    rw [finset.prod_insert H, finset.prod_insert H, ih, span_mul_span] }
end

lemma prod_span_singleton {ι : Type*} (s : finset ι) (x : ι → A) :
  (∏ i in s, span R ({x i} : set A)) = span R {∏ i in s, x i} :=
by rw [prod_span, set.finset_prod_singleton]

variables (R A)

/-- R-submodules of the R-algebra A are a module over `set A`. -/
instance module_set : module (set_semiring A) (submodule R A) :=
{ smul := λ s P, span R s * P,
  smul_add := λ _ _ _, mul_add _ _ _,
  add_smul := λ s t P, show span R (s ⊔ t) * P = _, by { erw [span_union, right_distrib] },
  mul_smul := λ s t P, show _ = _ * (_ * _),
    by { rw [← mul_assoc, span_mul_span, ← image_mul_prod] },
  one_smul := λ P, show span R {(1 : A)} * P = _,
    by { conv_lhs {erw ← span_eq P}, erw [span_mul_span, one_mul, span_eq] },
  zero_smul := λ P, show span R ∅ * P = ⊥, by erw [span_empty, bot_mul],
  smul_zero := λ _, mul_bot _ }

variables {R A}

lemma smul_def {s : set_semiring A} {P : submodule R A} : s • P = span R s * P := rfl

lemma smul_le_smul {s t : set_semiring A} {M N : submodule R A} (h₁ : s.down ≤ t.down)
  (h₂ : M ≤ N) : s • M ≤ t • N :=
mul_le_mul (span_mono h₁) h₂

lemma smul_singleton (a : A) (M : submodule R A) :
  ({a} : set A).up • M = M.map (lmul_left _ a) :=
begin
  conv_lhs {rw ← span_eq M},
  change span _ _ * span _ _ = _,
  rw [span_mul_span],
  apply le_antisymm,
  { rw span_le,
    rintros _ ⟨b, m, hb, hm, rfl⟩,
    rw [set_like.mem_coe, mem_map, set.mem_singleton_iff.mp hb],
    exact ⟨m, hm, rfl⟩ },
  { rintros _ ⟨m, hm, rfl⟩, exact subset_span ⟨a, m, set.mem_singleton a, hm, rfl⟩ }
end

section quotient

/-- The elements of `I / J` are the `x` such that `x • J ⊆ I`.

In fact, we define `x ∈ I / J` to be `∀ y ∈ J, x * y ∈ I` (see `mem_div_iff_forall_mul_mem`),
which is equivalent to `x • J ⊆ I` (see `mem_div_iff_smul_subset`), but nicer to use in proofs.

This is the general form of the ideal quotient, traditionally written $I : J$.
-/
instance : has_div (submodule R A) :=
⟨ λ I J,
{ carrier   := { x | ∀ y ∈ J, x * y ∈ I },
  zero_mem' := λ y hy, by { rw zero_mul, apply submodule.zero_mem },
  add_mem'  := λ a b ha hb y hy, by { rw add_mul, exact submodule.add_mem _ (ha _ hy) (hb _ hy) },
  smul_mem' := λ r x hx y hy, by { rw algebra.smul_mul_assoc,
    exact submodule.smul_mem _ _ (hx _ hy) } } ⟩

lemma mem_div_iff_forall_mul_mem {x : A} {I J : submodule R A} :
  x ∈ I / J ↔ ∀ y ∈ J, x * y ∈ I :=
iff.refl _

lemma mem_div_iff_smul_subset {x : A} {I J : submodule R A} : x ∈ I / J ↔ x • (J : set A) ⊆ I :=
⟨ λ h y ⟨y', hy', xy'_eq_y⟩, by { rw ← xy'_eq_y, apply h, assumption },
  λ h y hy, h (set.smul_mem_smul_set hy) ⟩

lemma le_div_iff {I J K : submodule R A} : I ≤ J / K ↔ ∀ (x ∈ I) (z ∈ K), x * z ∈ J := iff.refl _

lemma le_div_iff_mul_le {I J K : submodule R A} : I ≤ J / K ↔ I * K ≤ J :=
by rw [le_div_iff, mul_le]

@[simp] lemma one_le_one_div {I : submodule R A} :
  1 ≤ 1 / I ↔ I ≤ 1 :=
begin
  split, all_goals {intro hI},
  {rwa [le_div_iff_mul_le, one_mul] at hI},
  {rwa [le_div_iff_mul_le, one_mul]},
end

lemma le_self_mul_one_div {I : submodule R A} (hI : I ≤ 1) :
  I ≤ I * (1 / I) :=
begin
  rw [← mul_one I] {occs := occurrences.pos [1]},
  apply mul_le_mul_right (one_le_one_div.mpr hI),
end

lemma mul_one_div_le_one {I : submodule R A} : I * (1 / I) ≤ 1 :=
begin
  rw submodule.mul_le,
  intros m hm n hn,
  rw [submodule.mem_div_iff_forall_mul_mem] at hn,
  rw mul_comm,
  exact hn m hm,
end

@[simp] lemma map_div {B : Type*} [comm_ring B] [algebra R B]
  (I J : submodule R A) (h : A ≃ₐ[R] B) :
  (I / J).map h.to_linear_map = I.map h.to_linear_map / J.map h.to_linear_map :=
begin
  ext x,
  simp only [mem_map, mem_div_iff_forall_mul_mem],
  split,
  { rintro ⟨x, hx, rfl⟩ _ ⟨y, hy, rfl⟩,
    exact ⟨x * y, hx _ hy, h.map_mul x y⟩ },
  { rintro hx,
    refine ⟨h.symm x, λ z hz, _, h.apply_symm_apply x⟩,
    obtain ⟨xz, xz_mem, hxz⟩ := hx (h z) ⟨z, hz, rfl⟩,
    convert xz_mem,
    apply h.injective,
    erw [h.map_mul, h.apply_symm_apply, hxz] }
end

end quotient

end comm_ring

end submodule


import data.polynomial ring_theory.associated

open finset

namespace polynomial

variables {α : Type*} [decidable_eq α]

theorem degree_add_eq_of_degree_gt [comm_semiring α]
  {f g : polynomial α} (H : degree g < degree f) :
  degree (f + g) = degree f :=
add_comm g f ▸ degree_add_eq_of_degree_lt H

theorem degree_sub_eq_of_degree_gt [comm_ring α]
  {f g : polynomial α} (H : degree g < degree f) :
  degree (f - g) = degree f :=
degree_add_eq_of_degree_gt ((degree_neg g).symm ▸ H)

theorem leading_coeff_add_of_degree_gt [comm_semiring α]
  {f g : polynomial α} (H : degree g < degree f) :
  leading_coeff (f + g) = leading_coeff f :=
add_comm g f ▸ leading_coeff_add_of_degree_lt H

theorem leading_coeff_sub_of_degree_gt [comm_ring α]
  {f g : polynomial α} (H : degree g < degree f) :
  leading_coeff (f - g) = leading_coeff f :=
leading_coeff_add_of_degree_gt ((degree_neg g).symm ▸ H)

theorem leading_coeff_X_sub_C [comm_ring α] {r : α} :
  leading_coeff (X - C r) = 1 :=
begin
  by_cases h : (0:α) = 1,
  { haveI := subsingleton_of_zero_eq_one _ h,
    apply subsingleton.elim, },
  letI : nonzero_comm_ring α := { zero_ne_one := h, .. (infer_instance : comm_ring α)},
  rw [leading_coeff_sub_of_degree_gt, leading_coeff_X],
  apply lt_of_le_of_lt degree_C_le,
  rw degree_X, exact dec_trivial
end

theorem leading_coeff_neg [comm_ring α] {p : polynomial α} :
  leading_coeff (-p) = -leading_coeff p :=
by simp only [leading_coeff, nat_degree, degree_neg, coeff_neg]

section
variables [comm_semiring α] {ι : Type*} [decidable_eq ι] {f : ι → polynomial α} {s : finset ι}

theorem eval_prod {x : α} : eval x (s.prod f) = s.prod (λ i, eval x (f i)) :=
eq.symm $ prod_hom (eval x) eval_one (λ _ _, eval_mul)
end

section
variables [integral_domain α] {ι : Type*} [decidable_eq ι] {f : ι → polynomial α} {s : finset ι}

theorem degree_prod : degree (s.prod f) = s.sum (λ i, degree (f i)) :=
finset.induction_on s (by rw [prod_empty, degree_one, sum_empty]) $ λ a s has ih,
by rw [prod_insert has, degree_mul_eq, ih, sum_insert has]

theorem leading_coeff_prod : leading_coeff (s.prod f) = s.prod (λ i, leading_coeff (f i)) :=
eq.symm $ prod_hom leading_coeff leading_coeff_one leading_coeff_mul
end

end polynomial

namespace int

theorem mul_eq_neg_one {p q : ℤ} : p * q = -1 ↔ p = 1 ∧ q = -1 ∨ p = -1 ∧ q = 1 :=
begin
  split,
  { intro hpq,
    have : p.nat_abs ∣ 1,
    { existsi q.nat_abs, rw [← nat_abs_mul, hpq], refl },
    rw nat.dvd_one at this,
    replace this := congr_arg (coe : ℕ → ℤ) this,
    cases le_total p 0 with hp hp,
    { rw [of_nat_nat_abs_of_nonpos hp, neg_eq_iff_neg_eq] at this, subst p,
      rw [int.coe_nat_one, neg_one_mul, neg_inj'] at hpq, subst q,
      right, split; refl },
    { rw [nat_abs_of_nonneg hp] at this, subst p,
      rw [int.coe_nat_one, one_mul] at hpq, subst q,
      left, split; refl } },
  { rintro (⟨rfl, rfl⟩ | ⟨rfl, rfl⟩); refl }
end

end int

@[simp] lemma with_bot.nat_cast (n : ℕ) : @eq (with_bot ℕ) (@coe _ _ (@coe_to_lift _ _ (@coe_base _ _ nat.cast_coe)) n) n :=
nat.rec_on n rfl (λ n (ih : nat.cast _ = _), show _ + _ = _, by rw ih; refl)

@[simp] lemma with_bot_zero : (0 : with_bot ℕ) = (0:ℕ) := rfl
@[simp] lemma with_bot_one : (1 : with_bot ℕ) = (1:ℕ) := rfl
@[simp] lemma with_bot_bit0 (n:ℕ) : bit0 (n : with_bot ℕ) = (bit0 n : ℕ) := rfl
@[simp] lemma with_bot_bit1 (n:ℕ) : bit1 (n : with_bot ℕ) = (bit1 n : ℕ) := rfl

open polynomial

theorem q5 (s : finset ℤ) (hs : s ≠ ∅) : irreducible (s.prod (λ n, X - C n) - 1 : polynomial ℤ) :=
begin
  have deg_prod : degree (s.prod (λ n, X - C n)) = card s,
  { simp only [degree_prod, degree_X_sub_C, sum_const,
      add_monoid.smul_one, with_bot.nat_cast] },
  have deg_lt : degree (1 : polynomial ℤ) < degree (s.prod (λ n, X - C n)),
  { rwa [deg_prod, degree_one, with_bot_zero, with_bot.coe_lt_coe, card_pos] },
  split,
  { show ¬is_unit (s.prod (λ n, X - C n) - 1),
    assume h : is_unit (s.prod (λ n, X - C n) - 1),
    rcases h with ⟨⟨f, g, hfg, hgf⟩, hf⟩,
    change s.prod (λ n, X - C n) - 1 = f at hf, subst f,
    replace hfg := congr_arg degree hfg,
    rw [degree_mul_eq, degree_sub_eq_of_degree_gt deg_lt] at hfg,
    rw [deg_prod, degree_one, with_bot_zero] at hfg,
    cases degree g with dg,
    case option.none { cases hfg },
    case option.some {
      change some (s.card + dg) = some 0 at hfg,
      rw [option.some_inj, add_eq_zero_iff, card_eq_zero] at hfg,
      exact hs hfg.1 } },
  { show ∀ p q, s.prod (λ n, X - C n) - 1 = p * q → is_unit p ∨ is_unit q,
    assume p q : polynomial ℤ,
    assume hpq : s.prod (λ n, X - C n) - 1 = p * q,
    have hpq0 : p + q ≠ 0,
    { assume h : p + q = 0,
      rw add_eq_zero_iff_neg_eq at h, subst q,
      rw mul_neg_eq_neg_mul_symm at hpq,
      replace hpq := congr_arg leading_coeff hpq,
      rw [leading_coeff_sub_of_degree_gt deg_lt] at hpq,
      rw [leading_coeff_prod, leading_coeff_neg, leading_coeff_mul] at hpq,
      simp only [leading_coeff_X_sub_C, prod_const_one] at hpq,
      refine absurd hpq (ne_of_gt (lt_of_le_of_lt (neg_nonpos.2 _) _)),
      { exact mul_self_nonneg _ },
      { exact dec_trivial } },
    have hp0 : p ≠ 0,
    { assume h : p = 0, subst p,
      replace hpq := congr_arg degree hpq,
      rw [degree_sub_eq_of_degree_gt deg_lt, deg_prod, zero_mul, degree_zero] at hpq,
      cases hpq },
    have hq0 : q ≠ 0,
    { assume h : q = 0, subst q,
      replace hpq := congr_arg degree hpq,
      rw [degree_sub_eq_of_degree_gt deg_lt, deg_prod, mul_zero, degree_zero] at hpq,
      cases hpq },
    have hroots : s ⊆ roots (p + q),
    { show ∀ x, x ∈ s → x ∈ roots (p + q),
      intros x hxs, rw [mem_roots hpq0, is_root.def, eval_add],
      replace hpq := congr_arg (eval x) hpq,
      rw [eval_sub, eval_one, eval_mul, eval_prod] at hpq,
      simp only [eval_sub, eval_X, eval_C] at hpq,
      rw [prod_eq_zero hxs (sub_self x), zero_sub, eq_comm, int.mul_eq_neg_one] at hpq,
      rcases hpq with ⟨hp, hq⟩ | ⟨hp, hq⟩; rw [hp, hq]; refl },
    have hdpmq : degree (p * q) = s.card,
    { rw [← hpq, degree_sub_eq_of_degree_gt deg_lt, deg_prod] },
    have hdpdq : degree p + degree q = s.card,
    { rw [← degree_mul_eq, hdpmq] },
    rw [degree_eq_nat_degree hp0, degree_eq_nat_degree hq0, ← with_bot.coe_add, with_bot.coe_eq_coe] at hdpdq,
    have hdpq : degree (p + q) = s.card,
    { apply le_antisymm,
      { show degree (p + q) ≤ s.card,
        refine le_trans (degree_add_le _ _) (max_le _ _),
        { rw [degree_eq_nat_degree hp0, with_bot.coe_le_coe, ← hdpdq],
          exact nat.le_add_right _ _ },
        { rw [degree_eq_nat_degree hq0, with_bot.coe_le_coe, ← hdpdq],
          exact nat.le_add_left _ _ } },
      { show (s.card : with_bot ℕ) ≤ degree (p + q),
        refine le_trans _ (card_roots hpq0),
        rw [with_bot.coe_le_coe], exact card_le_of_subset hroots } },
    cases le_total (degree p) (degree q) with hdplq hdqlp,
    { have hdp0 : degree p ≤ 0,
      { rw [degree_eq_nat_degree hp0, with_bot_zero, with_bot.coe_le_coe],
        rw [← add_le_add_iff_right (nat_degree q), hdpdq, zero_add, ← with_bot.coe_le_coe],
        rw [← hdpq, ← degree_eq_nat_degree hq0],
        refine le_trans (degree_add_le _ _) (max_le hdplq (le_refl _)) },
      have : coeff p 0 = leading_coeff p,
      { rw leading_coeff, congr, rw [eq_C_of_degree_le_zero hdp0, nat_degree_C] },
      left, refine is_unit_of_mul_one _ (C (leading_coeff q)) _,
      rw [eq_C_of_degree_le_zero hdp0, this, ← C_mul, ← leading_coeff_mul, ← hpq],
      rw [leading_coeff_sub_of_degree_gt deg_lt, leading_coeff_prod],
      simp only [leading_coeff_X_sub_C, prod_const_one, C_1] },
    { have hdq0 : degree q ≤ 0,
      { rw [degree_eq_nat_degree hq0, with_bot_zero, with_bot.coe_le_coe],
        rw [← add_le_add_iff_left (nat_degree p), hdpdq, add_zero, ← with_bot.coe_le_coe],
        rw [← hdpq, ← degree_eq_nat_degree hp0],
        refine le_trans (degree_add_le _ _) (max_le (le_refl _) hdqlp) },
      have : coeff q 0 = leading_coeff q,
      { rw leading_coeff, congr, rw [eq_C_of_degree_le_zero hdq0, nat_degree_C] },
      right, refine is_unit_of_mul_one _ (C (leading_coeff p)) _,
      rw [eq_C_of_degree_le_zero hdq0, this, ← C_mul, ← leading_coeff_mul, mul_comm, ← hpq],
      rw [leading_coeff_sub_of_degree_gt deg_lt, leading_coeff_prod],
      simp only [leading_coeff_X_sub_C, prod_const_one, C_1] } }
end


--lean is working
import topology.basic
#check topological_space
#eval 1+1
theorem add_one_one : 1 + 1 = 2 := by refl

--EXAMPLE 1: transfering order from nat to custom nat (bijection)
namespace example1

-- a type N
def N : Type := sorry

-- a type nat
--nat is a type

-- order on N
def ordern : N → N → Prop := sorry

-- order on nat
--nat has an order

-- function nto
def nto : N → nat := sorry

-- function nof
def nof : nat → N := sorry

axiom ax1 : ∀ x : nat, nto(nof(x)) = x

axiom ax2 : ∀ x : N, nof(nto(x)) = x

axiom ax3 : ∀ x y : N, ordern x y → nto x <= nto y

axiom ax4 : ∀ x y : nat, x <= y → ordern (nof x) (nof y)

theorem thetheoremfornat : ∀ x y z : nat, x <= y → y <= z → x <= z := sorry

theorem thetheoremforN : ∀ x y z : N, ordern x y → ordern y z → ordern x z :=
begin
    intros,
    rw← ax2 x,
    rw← ax2 z,
    apply ax4,
    apply thetheoremfornat (nto x) (nto y) (nto z);
    finish using [ax3],
    --apply ax3,
    --assumption,
    --apply ax3,
    --assumption,
end

--TODO thetheoremfornatagain
end example1

--EXAMPLE 2: transfer the theorem that odd+odd=even from z to z mod 2 and back.
namespace example2

--even and odd on Z
definition even (n : int) : Prop := n % 2 = 0
--definition odd (n : int) : Prop := n % 2 = 1

--type Z/2Z
inductive Z2 : Type
| zero : Z2
| one : Z2

def Z2.add : Z2 → Z2 → Z2
| Z2.zero y := y
| Z2.one Z2.zero := Z2.one
| Z2.one Z2.one := Z2.zero

open Z2

--even on z/2z
inductive evenZ2 : Z2 → Prop
| zeroiseven : evenZ2 zero

--transfer function (mod 2)
def ztoz2 : int → Z2 := λ n, if n % 2 = 0 then zero else one

--transfer respects add
axiom transfer_add : ∀ m n : int, (ztoz2 m).add (ztoz2 n) = ztoz2(m + n)

--DIRECTION Z to Z2
axiom eventransfertoz2 : ∀ n : int, even n → evenZ2 (ztoz2 n)

--DIRECTION Z2 to Z
axiom eventransferfromz2  : ∀ x : Z2, ∀ y : int, evenZ2 x → ztoz2 y = x → even y

-- axiom transfer_add_2 : ∀ x y : Z2, ∀ m n : int, ztoz2 m = x → ztoz2 n = y → x.add y = ztoz2 (m + n)

axiom ztoz2surj : function.surjective ztoz2

--theorem about even numbers
theorem thetheoremforint : ∀ m n : int, ¬ even m → ¬ even n → even (m + n) := sorry

--theorem about even numbers in z2, using only axioms, the proven theorem in int, and assumptions
theorem thetheoremforZ2 : ∀ x y : Z2, ¬ evenZ2 x → ¬ evenZ2 y → evenZ2 (add x y) :=
begin
    intros,
    --pick numbers such that m % 2 = x, n % 2 = y
    --rw transfer_add_2,
    --apply eventransfertoz2,
    --apply thetheoremforint,
    let m := classical.some (ztoz2surj x),
    let n := classical.some (ztoz2surj y),
    have mx : ztoz2 m = x := classical.some_spec(ztoz2surj x),
    have ny : ztoz2 n = y := classical.some_spec(ztoz2surj y),

    rw← mx,
    rw← ny,

    rw transfer_add,
    apply eventransfertoz2,
    apply thetheoremforint,

   -- have : ¬ even m,
   { finish using [eventransfertoz2] },
   -- have : ¬ even n,
   { finish using [eventransfertoz2] },

   -- assumption,
   -- assumption,
   -- assumption,
    --have test: ¬ even 1 := sorry,
    --apply test,
    --have test: ¬ even 1 := sorry,
    --apply test,
  --  sorry --  WIP
end

theorem thetheoremforZ2_2 : ∀ x y : Z2, ¬ evenZ2 x → ¬ evenZ2 y → evenZ2 (add x y) :=
begin
    intros,
    have surj : function.surjective ztoz2 := sorry,

    rw [← classical.some_spec (surj x)] at *,
    rw [← classical.some_spec (surj y)] at *,
    rw transfer_add,
    apply eventransfertoz2,
    apply thetheoremforint;

    finish using [eventransfertoz2],
end

    --adding two odd numbers in Z2, so one.add one
    --*any number* that % 2 equals one is odd, --map is surjective so the numbers exist
    --odd plus odd = even
    --even number % 2 is even too
    --this result is equal to adding in Z2

    --classical.some to pick one of the ints

theorem thetheoremforZ2again : ∀ x y : Z2, ¬ evenZ2 x → ¬ evenZ2 y → evenZ2 (add x y) :=
begin
  --practice proof
  intros,
  cases x,
  { apply false.elim,
    apply a,
    apply evenZ2.zeroiseven},
  { cases y,
      { apply false.elim,
        apply a_1,
       apply evenZ2.zeroiseven},
      { simp [Z2.add],
        apply evenZ2.zeroiseven}},
end

--proof using only the theorem in Z2, axioms, and assumptions
theorem thetheoremforintagain : ∀ x y : int, ¬ even x → ¬ even y → even (x + y) :=
begin
  intros,

  apply eventransferfromz2,

  have addinZ2iseven : evenZ2 ((ztoz2 x).add (ztoz2 y)) :=
      begin
        apply thetheoremforZ2again,

        intro bla2,
        apply a,
        apply eventransferfromz2,
        apply bla2,
        simp,

        intro bla2,
        apply a_1,
        apply eventransferfromz2,
        apply bla2,
        simp,
      end,

  apply addinZ2iseven,

  simp [transfer_add],
end

end example2

namespace example3
-- EXAMPLE 3: do an example with injection natural numbers to integers
-- even op natuurlijke getallen naar even op integers

--nat is a type
--int is a type

--even prop
definition even (n : nat) : Prop := n % 2 = 0
definition evenint (x : int) : Prop := x % 2 = 0

--transfer functions
def ntoi : nat → int := int.of_nat --implementations optional
def nofi : int → nat := int.nat_abs

axiom inverse1way : ∀ n : nat, nofi(ntoi n) = n

--transfer lemmas
--axiom transfer_add : ∀ m n : nat, ntoi m + ntoi n = ntoi (m + n)
axiom transfer_add2 : ∀ x y : int, nofi x + nofi y = nofi (x + y)

--axiom eventoint : ∀ (x : int), even (nofi x) → evenint x
--axiom eventoint : ∀ n : nat, even n → evenint (ntoi n) --verkeerd om
--axiom evenfromint : ∀ x : int, evenint x → even (nofi x)

--axiom eventoint' : ∀ x : int, even (nofi x) → evenint x
--lemma eventoint : ∀ n : nat, even n → evenint (ntoi n) :=
--λ n hn, eventoint' _ (inverse1way n ▸ hn)

--axiom evenfromint' : ∀ x : int, evenint x → even (nofi x)
--lemma evenfromint : ∀ n : nat, evenint (ntoi n) → even n :=
--λ n hn, inverse1way n ▸ evenfromint' _ hn

axiom eventoint': ∀ x : int, even (nofi x) → evenint x
lemma eventoint : ∀ n : nat, even n → evenint (ntoi n) :=
λ n hn, eventoint' _ (by { rw  ← inverse1way n, exact hn })

axiom evenfromint' : ∀ x : int, evenint x → even (nofi x)
lemma evenfromint : ∀ n : nat, evenint (ntoi n) → even n :=
λ n hn, by { rw ← inverse1way n, exact evenfromint' _ hn }

theorem thetheoremfornat : ∀ m n : nat, ¬ even m → ¬ even n → even (m + n) := sorry

theorem thetheoremforint : ∀ x y : int, ¬ evenint x → ¬ evenint y → evenint (x + y) :=
begin
  intros,
  apply eventoint',
  rw← transfer_add2,
  apply thetheoremfornat;
  finish using [eventoint'],

  --have addinnatiseven : even ((nofi x).add (nofi y)) :=
  --begin
  --  apply thetheoremfornat,

  --  intro bla2,
  --  apply a,
  --  apply eventoint',
  --  apply bla2,

  --  intro bla2,
  --  apply a_1,
  --  apply eventoint',
  --  apply bla2,
  --end,

--  rw ←transfer_add2,
  --apply addinnatiseven,
end

  --Cant do this:
  --let m be such that ntoi m = x
  --let n be such that ntoi n = y

  --let m = nofi x
  --let n = nofi y

  -- old
  --have test: even (nofi x + nofi y) :=
  --begin
  --  apply thetheoremfornat,

  --  intro b,
  --  apply a,
    --rw← inverse1way (nofi x) at *,

    --finish using [eventoint],
    --rw transfer_add2,
  --sorry, sorry
  --end,
--end

theorem thetheoremfornatagain : ∀ m n : nat, ¬ even m → ¬ even n → even (m + n) :=
begin
  intros,
  rw← inverse1way m at *,
  rw← inverse1way n at *,
  rw transfer_add2,
  apply evenfromint',
  apply thetheoremforint;
  finish using [evenfromint'],
end

end example3


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

! This file was ported from Lean 3 source module algebra.order.sub.canonical
! leanprover-community/mathlib commit 62a5626868683c104774de8d85b9855234ac807c
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.Order.Monoid.Canonical.Defs
import Mathlib.Algebra.Order.Sub.Defs

/-!
# Lemmas about subtraction in canonically ordered monoids
-/

variable {α : Type _}

section ExistsAddOfLE

variable [AddCommSemigroup α] [PartialOrder α] [ExistsAddOfLE α]
  [CovariantClass α α (· + ·) (· ≤ ·)] [Sub α] [OrderedSub α] {a b c d : α}

@[simp]
theorem add_tsub_cancel_of_le (h : a ≤ b) : a + (b - a) = b := by
  refine' le_antisymm _ le_add_tsub
  obtain ⟨c, rfl⟩ := exists_add_of_le h
  exact add_le_add_left add_tsub_le_left a
#align add_tsub_cancel_of_le add_tsub_cancel_of_le

theorem tsub_add_cancel_of_le (h : a ≤ b) : b - a + a = b := by
  rw [add_comm]
  exact add_tsub_cancel_of_le h
#align tsub_add_cancel_of_le tsub_add_cancel_of_le

theorem add_le_of_le_tsub_right_of_le (h : b ≤ c) (h2 : a ≤ c - b) : a + b ≤ c :=
  (add_le_add_right h2 b).trans_eq <| tsub_add_cancel_of_le h
#align add_le_of_le_tsub_right_of_le add_le_of_le_tsub_right_of_le

theorem add_le_of_le_tsub_left_of_le (h : a ≤ c) (h2 : b ≤ c - a) : a + b ≤ c :=
  (add_le_add_left h2 a).trans_eq <| add_tsub_cancel_of_le h
#align add_le_of_le_tsub_left_of_le add_le_of_le_tsub_left_of_le

theorem tsub_le_tsub_iff_right (h : c ≤ b) : a - c ≤ b - c ↔ a ≤ b := by
  rw [tsub_le_iff_right, tsub_add_cancel_of_le h]
#align tsub_le_tsub_iff_right tsub_le_tsub_iff_right

theorem tsub_left_inj (h1 : c ≤ a) (h2 : c ≤ b) : a - c = b - c ↔ a = b := by
  simp_rw [le_antisymm_iff, tsub_le_tsub_iff_right h1, tsub_le_tsub_iff_right h2]
#align tsub_left_inj tsub_left_inj

theorem tsub_inj_left (h₁ : a ≤ b) (h₂ : a ≤ c) : b - a = c - a → b = c :=
  (tsub_left_inj h₁ h₂).1
#align tsub_inj_left tsub_inj_left

/-- See `lt_of_tsub_lt_tsub_right` for a stronger statement in a linear order. -/
theorem lt_of_tsub_lt_tsub_right_of_le (h : c ≤ b) (h2 : a - c < b - c) : a < b := by
  refine' ((tsub_le_tsub_iff_right h).mp h2.le).lt_of_ne _
  rintro rfl
  exact h2.false
#align lt_of_tsub_lt_tsub_right_of_le lt_of_tsub_lt_tsub_right_of_le

theorem tsub_add_tsub_cancel (hab : b ≤ a) (hcb : c ≤ b) : a - b + (b - c) = a - c := by
  convert tsub_add_cancel_of_le (tsub_le_tsub_right hab c) using 2
  rw [tsub_tsub, add_tsub_cancel_of_le hcb]
#align tsub_add_tsub_cancel tsub_add_tsub_cancel

theorem tsub_tsub_tsub_cancel_right (h : c ≤ b) : a - c - (b - c) = a - b := by
  rw [tsub_tsub, add_tsub_cancel_of_le h]
#align tsub_tsub_tsub_cancel_right tsub_tsub_tsub_cancel_right

/-! #### Lemmas that assume that an element is `AddLECancellable`. -/

namespace AddLECancellable

protected theorem eq_tsub_iff_add_eq_of_le (hc : AddLECancellable c) (h : c ≤ b) :
    a = b - c ↔ a + c = b :=
  ⟨by
    rintro rfl
    exact tsub_add_cancel_of_le h, hc.eq_tsub_of_add_eq⟩
#align add_le_cancellable.eq_tsub_iff_add_eq_of_le AddLECancellable.eq_tsub_iff_add_eq_of_le

protected theorem tsub_eq_iff_eq_add_of_le (hb : AddLECancellable b) (h : b ≤ a) :
    a - b = c ↔ a = c + b := by rw [eq_comm, hb.eq_tsub_iff_add_eq_of_le h, eq_comm]
#align add_le_cancellable.tsub_eq_iff_eq_add_of_le AddLECancellable.tsub_eq_iff_eq_add_of_le

protected theorem add_tsub_assoc_of_le (hc : AddLECancellable c) (h : c ≤ b) (a : α) :
    a + b - c = a + (b - c) := by
  conv_lhs => rw [← add_tsub_cancel_of_le h, add_comm c, ← add_assoc, hc.add_tsub_cancel_right]
#align add_le_cancellable.add_tsub_assoc_of_le AddLECancellable.add_tsub_assoc_of_le

protected theorem tsub_add_eq_add_tsub (hb : AddLECancellable b) (h : b ≤ a) :
    a - b + c = a + c - b := by rw [add_comm a, hb.add_tsub_assoc_of_le h, add_comm]
#align add_le_cancellable.tsub_add_eq_add_tsub AddLECancellable.tsub_add_eq_add_tsub

protected theorem tsub_tsub_assoc (hbc : AddLECancellable (b - c)) (h₁ : b ≤ a) (h₂ : c ≤ b) :
    a - (b - c) = a - b + c :=
  hbc.tsub_eq_of_eq_add <| by rw [add_assoc, add_tsub_cancel_of_le h₂, tsub_add_cancel_of_le h₁]
#align add_le_cancellable.tsub_tsub_assoc AddLECancellable.tsub_tsub_assoc

protected theorem tsub_add_tsub_comm (hb : AddLECancellable b) (hd : AddLECancellable d)
    (hba : b ≤ a) (hdc : d ≤ c) : a - b + (c - d) = a + c - (b + d) := by
  rw [hb.tsub_add_eq_add_tsub hba, ← hd.add_tsub_assoc_of_le hdc, tsub_tsub, add_comm d]
#align add_le_cancellable.tsub_add_tsub_comm AddLECancellable.tsub_add_tsub_comm

protected theorem le_tsub_iff_left (ha : AddLECancellable a) (h : a ≤ c) : b ≤ c - a ↔ a + b ≤ c :=
  ⟨add_le_of_le_tsub_left_of_le h, ha.le_tsub_of_add_le_left⟩
#align add_le_cancellable.le_tsub_iff_left AddLECancellable.le_tsub_iff_left

protected theorem le_tsub_iff_right (ha : AddLECancellable a) (h : a ≤ c) :
    b ≤ c - a ↔ b + a ≤ c := by
  rw [add_comm]
  exact ha.le_tsub_iff_left h
#align add_le_cancellable.le_tsub_iff_right AddLECancellable.le_tsub_iff_right

protected theorem tsub_lt_iff_left (hb : AddLECancellable b) (hba : b ≤ a) :
    a - b < c ↔ a < b + c := by
  refine' ⟨hb.lt_add_of_tsub_lt_left, _⟩
  intro h; refine' (tsub_le_iff_left.mpr h.le).lt_of_ne _
  rintro rfl; exact h.ne' (add_tsub_cancel_of_le hba)
#align add_le_cancellable.tsub_lt_iff_left AddLECancellable.tsub_lt_iff_left

protected theorem tsub_lt_iff_right (hb : AddLECancellable b) (hba : b ≤ a) :
    a - b < c ↔ a < c + b := by
  rw [add_comm]
  exact hb.tsub_lt_iff_left hba
#align add_le_cancellable.tsub_lt_iff_right AddLECancellable.tsub_lt_iff_right

protected theorem tsub_lt_iff_tsub_lt (hb : AddLECancellable b) (hc : AddLECancellable c)
    (h₁ : b ≤ a) (h₂ : c ≤ a) : a - b < c ↔ a - c < b := by
  rw [hb.tsub_lt_iff_left h₁, hc.tsub_lt_iff_right h₂]
#align add_le_cancellable.tsub_lt_iff_tsub_lt AddLECancellable.tsub_lt_iff_tsub_lt

protected theorem le_tsub_iff_le_tsub (ha : AddLECancellable a) (hc : AddLECancellable c)
    (h₁ : a ≤ b) (h₂ : c ≤ b) : a ≤ b - c ↔ c ≤ b - a := by
  rw [ha.le_tsub_iff_left h₁, hc.le_tsub_iff_right h₂]
#align add_le_cancellable.le_tsub_iff_le_tsub AddLECancellable.le_tsub_iff_le_tsub

protected theorem lt_tsub_iff_right_of_le (hc : AddLECancellable c) (h : c ≤ b) :
    a < b - c ↔ a + c < b := by
  refine' ⟨fun h' => (add_le_of_le_tsub_right_of_le h h'.le).lt_of_ne _, hc.lt_tsub_of_add_lt_right⟩
  rintro rfl
  exact h'.ne' hc.add_tsub_cancel_right
#align add_le_cancellable.lt_tsub_iff_right_of_le AddLECancellable.lt_tsub_iff_right_of_le

protected theorem lt_tsub_iff_left_of_le (hc : AddLECancellable c) (h : c ≤ b) :
    a < b - c ↔ c + a < b := by
  rw [add_comm]
  exact hc.lt_tsub_iff_right_of_le h
#align add_le_cancellable.lt_tsub_iff_left_of_le AddLECancellable.lt_tsub_iff_left_of_le

protected theorem tsub_inj_right (hab : AddLECancellable (a - b)) (h₁ : b ≤ a) (h₂ : c ≤ a)
    (h₃ : a - b = a - c) : b = c := by
  rw [← hab.inj]
  rw [tsub_add_cancel_of_le h₁, h₃, tsub_add_cancel_of_le h₂]
#align add_le_cancellable.tsub_inj_right AddLECancellable.tsub_inj_right

protected theorem lt_of_tsub_lt_tsub_left_of_le [ContravariantClass α α (· + ·) (· < ·)]
    (hb : AddLECancellable b) (hca : c ≤ a) (h : a - b < a - c) : c < b := by
  conv_lhs at h => rw [← tsub_add_cancel_of_le hca]
  exact lt_of_add_lt_add_left (hb.lt_add_of_tsub_lt_right h)
#align add_le_cancellable.lt_of_tsub_lt_tsub_left_of_le AddLECancellable.lt_of_tsub_lt_tsub_left_of_le

protected theorem tsub_lt_tsub_left_of_le (hab : AddLECancellable (a - b)) (h₁ : b ≤ a)
    (h : c < b) : a - b < a - c :=
  (tsub_le_tsub_left h.le _).lt_of_ne fun h' => h.ne' <| hab.tsub_inj_right h₁ (h.le.trans h₁) h'
#align add_le_cancellable.tsub_lt_tsub_left_of_le AddLECancellable.tsub_lt_tsub_left_of_le

protected theorem tsub_lt_tsub_right_of_le (hc : AddLECancellable c) (h : c ≤ a) (h2 : a < b) :
    a - c < b - c := by
  apply hc.lt_tsub_of_add_lt_left
  rwa [add_tsub_cancel_of_le h]
#align add_le_cancellable.tsub_lt_tsub_right_of_le AddLECancellable.tsub_lt_tsub_right_of_le

protected theorem tsub_lt_tsub_iff_left_of_le_of_le [ContravariantClass α α (· + ·) (· < ·)]
    (hb : AddLECancellable b) (hab : AddLECancellable (a - b)) (h₁ : b ≤ a) (h₂ : c ≤ a) :
    a - b < a - c ↔ c < b :=
  ⟨hb.lt_of_tsub_lt_tsub_left_of_le h₂, hab.tsub_lt_tsub_left_of_le h₁⟩
#align add_le_cancellable.tsub_lt_tsub_iff_left_of_le_of_le AddLECancellable.tsub_lt_tsub_iff_left_of_le_of_le

@[simp]
protected theorem add_tsub_tsub_cancel (hac : AddLECancellable (a - c)) (h : c ≤ a) :
    a + b - (a - c) = b + c :=
  hac.tsub_eq_of_eq_add <| by rw [add_assoc, add_tsub_cancel_of_le h, add_comm]
#align add_le_cancellable.add_tsub_tsub_cancel AddLECancellable.add_tsub_tsub_cancel

protected theorem tsub_tsub_cancel_of_le (hba : AddLECancellable (b - a)) (h : a ≤ b) :
    b - (b - a) = a :=
  hba.tsub_eq_of_eq_add (add_tsub_cancel_of_le h).symm
#align add_le_cancellable.tsub_tsub_cancel_of_le AddLECancellable.tsub_tsub_cancel_of_le

protected theorem tsub_tsub_tsub_cancel_left (hab : AddLECancellable (a - b)) (h : b ≤ a) :
    a - c - (a - b) = b - c := by rw [tsub_right_comm, hab.tsub_tsub_cancel_of_le h]
#align add_le_cancellable.tsub_tsub_tsub_cancel_left AddLECancellable.tsub_tsub_tsub_cancel_left

end AddLECancellable

section Contra

/-! ### Lemmas where addition is order-reflecting. -/

variable [ContravariantClass α α (· + ·) (· ≤ ·)]

theorem eq_tsub_iff_add_eq_of_le (h : c ≤ b) : a = b - c ↔ a + c = b :=
  Contravariant.AddLECancellable.eq_tsub_iff_add_eq_of_le h
#align eq_tsub_iff_add_eq_of_le eq_tsub_iff_add_eq_of_le

theorem tsub_eq_iff_eq_add_of_le (h : b ≤ a) : a - b = c ↔ a = c + b :=
  Contravariant.AddLECancellable.tsub_eq_iff_eq_add_of_le h
#align tsub_eq_iff_eq_add_of_le tsub_eq_iff_eq_add_of_le

/-- See `add_tsub_le_assoc` for an inequality. -/
theorem add_tsub_assoc_of_le (h : c ≤ b) (a : α) : a + b - c = a + (b - c) :=
  Contravariant.AddLECancellable.add_tsub_assoc_of_le h a
#align add_tsub_assoc_of_le add_tsub_assoc_of_le

theorem tsub_add_eq_add_tsub (h : b ≤ a) : a - b + c = a + c - b :=
  Contravariant.AddLECancellable.tsub_add_eq_add_tsub h
#align tsub_add_eq_add_tsub tsub_add_eq_add_tsub

theorem tsub_tsub_assoc (h₁ : b ≤ a) (h₂ : c ≤ b) : a - (b - c) = a - b + c :=
  Contravariant.AddLECancellable.tsub_tsub_assoc h₁ h₂
#align tsub_tsub_assoc tsub_tsub_assoc

theorem tsub_add_tsub_comm (hba : b ≤ a) (hdc : d ≤ c) : a - b + (c - d) = a + c - (b + d) :=
  Contravariant.AddLECancellable.tsub_add_tsub_comm Contravariant.AddLECancellable hba hdc
#align tsub_add_tsub_comm tsub_add_tsub_comm

theorem le_tsub_iff_left (h : a ≤ c) : b ≤ c - a ↔ a + b ≤ c :=
  Contravariant.AddLECancellable.le_tsub_iff_left h
#align le_tsub_iff_left le_tsub_iff_left

theorem le_tsub_iff_right (h : a ≤ c) : b ≤ c - a ↔ b + a ≤ c :=
  Contravariant.AddLECancellable.le_tsub_iff_right h
#align le_tsub_iff_right le_tsub_iff_right

theorem tsub_lt_iff_left (hbc : b ≤ a) : a - b < c ↔ a < b + c :=
  Contravariant.AddLECancellable.tsub_lt_iff_left hbc
#align tsub_lt_iff_left tsub_lt_iff_left

theorem tsub_lt_iff_right (hbc : b ≤ a) : a - b < c ↔ a < c + b :=
  Contravariant.AddLECancellable.tsub_lt_iff_right hbc
#align tsub_lt_iff_right tsub_lt_iff_right

theorem tsub_lt_iff_tsub_lt (h₁ : b ≤ a) (h₂ : c ≤ a) : a - b < c ↔ a - c < b :=
  Contravariant.AddLECancellable.tsub_lt_iff_tsub_lt Contravariant.AddLECancellable h₁ h₂
#align tsub_lt_iff_tsub_lt tsub_lt_iff_tsub_lt

theorem le_tsub_iff_le_tsub (h₁ : a ≤ b) (h₂ : c ≤ b) : a ≤ b - c ↔ c ≤ b - a :=
  Contravariant.AddLECancellable.le_tsub_iff_le_tsub Contravariant.AddLECancellable h₁ h₂
#align le_tsub_iff_le_tsub le_tsub_iff_le_tsub

/-- See `lt_tsub_iff_right` for a stronger statement in a linear order. -/
theorem lt_tsub_iff_right_of_le (h : c ≤ b) : a < b - c ↔ a + c < b :=
  Contravariant.AddLECancellable.lt_tsub_iff_right_of_le h
#align lt_tsub_iff_right_of_le lt_tsub_iff_right_of_le

/-- See `lt_tsub_iff_left` for a stronger statement in a linear order. -/
theorem lt_tsub_iff_left_of_le (h : c ≤ b) : a < b - c ↔ c + a < b :=
  Contravariant.AddLECancellable.lt_tsub_iff_left_of_le h
#align lt_tsub_iff_left_of_le lt_tsub_iff_left_of_le

/-- See `lt_of_tsub_lt_tsub_left` for a stronger statement in a linear order. -/
theorem lt_of_tsub_lt_tsub_left_of_le [ContravariantClass α α (· + ·) (· < ·)] (hca : c ≤ a)
    (h : a - b < a - c) : c < b :=
  Contravariant.AddLECancellable.lt_of_tsub_lt_tsub_left_of_le hca h
#align lt_of_tsub_lt_tsub_left_of_le lt_of_tsub_lt_tsub_left_of_le

theorem tsub_lt_tsub_left_of_le : b ≤ a → c < b → a - b < a - c :=
  Contravariant.AddLECancellable.tsub_lt_tsub_left_of_le
#align tsub_lt_tsub_left_of_le tsub_lt_tsub_left_of_le

theorem tsub_lt_tsub_right_of_le (h : c ≤ a) (h2 : a < b) : a - c < b - c :=
  Contravariant.AddLECancellable.tsub_lt_tsub_right_of_le h h2
#align tsub_lt_tsub_right_of_le tsub_lt_tsub_right_of_le

theorem tsub_inj_right (h₁ : b ≤ a) (h₂ : c ≤ a) (h₃ : a - b = a - c) : b = c :=
  Contravariant.AddLECancellable.tsub_inj_right h₁ h₂ h₃
#align tsub_inj_right tsub_inj_right

/-- See `tsub_lt_tsub_iff_left_of_le` for a stronger statement in a linear order. -/
theorem tsub_lt_tsub_iff_left_of_le_of_le [ContravariantClass α α (· + ·) (· < ·)] (h₁ : b ≤ a)
    (h₂ : c ≤ a) : a - b < a - c ↔ c < b :=
  Contravariant.AddLECancellable.tsub_lt_tsub_iff_left_of_le_of_le Contravariant.AddLECancellable h₁
    h₂
#align tsub_lt_tsub_iff_left_of_le_of_le tsub_lt_tsub_iff_left_of_le_of_le

@[simp]
theorem add_tsub_tsub_cancel (h : c ≤ a) : a + b - (a - c) = b + c :=
  Contravariant.AddLECancellable.add_tsub_tsub_cancel h
#align add_tsub_tsub_cancel add_tsub_tsub_cancel

/-- See `tsub_tsub_le` for an inequality. -/
theorem tsub_tsub_cancel_of_le (h : a ≤ b) : b - (b - a) = a :=
  Contravariant.AddLECancellable.tsub_tsub_cancel_of_le h
#align tsub_tsub_cancel_of_le tsub_tsub_cancel_of_le

theorem tsub_tsub_tsub_cancel_left (h : b ≤ a) : a - c - (a - b) = b - c :=
  Contravariant.AddLECancellable.tsub_tsub_tsub_cancel_left h
#align tsub_tsub_tsub_cancel_left tsub_tsub_tsub_cancel_left

end Contra

end ExistsAddOfLE

/-! ### Lemmas in a canonically ordered monoid. -/

section CanonicallyOrderedAddMonoid

variable [CanonicallyOrderedAddMonoid α] [Sub α] [OrderedSub α] {a b c d : α}

theorem add_tsub_cancel_iff_le : a + (b - a) = b ↔ a ≤ b :=
  ⟨fun h => le_iff_exists_add.mpr ⟨b - a, h.symm⟩, add_tsub_cancel_of_le⟩
#align add_tsub_cancel_iff_le add_tsub_cancel_iff_le

theorem tsub_add_cancel_iff_le : b - a + a = b ↔ a ≤ b := by
  rw [add_comm]
  exact add_tsub_cancel_iff_le
#align tsub_add_cancel_iff_le tsub_add_cancel_iff_le

@[simp]
theorem tsub_eq_zero_iff_le : a - b = 0 ↔ a ≤ b := by
  rw [← nonpos_iff_eq_zero, tsub_le_iff_left, add_zero]
#align tsub_eq_zero_iff_le tsub_eq_zero_iff_le

alias tsub_eq_zero_iff_le ↔ _ tsub_eq_zero_of_le
#align tsub_eq_zero_of_le tsub_eq_zero_of_le

attribute [simp] tsub_eq_zero_of_le

theorem tsub_self (a : α) : a - a = 0 :=
  tsub_eq_zero_of_le le_rfl
#align tsub_self tsub_self

theorem tsub_le_self : a - b ≤ a :=
  tsub_le_iff_left.mpr <| le_add_left le_rfl
#align tsub_le_self tsub_le_self

theorem zero_tsub (a : α) : 0 - a = 0 :=
  tsub_eq_zero_of_le <| zero_le a
#align zero_tsub zero_tsub

theorem tsub_self_add (a b : α) : a - (a + b) = 0 :=
  tsub_eq_zero_of_le <| self_le_add_right _ _
#align tsub_self_add tsub_self_add

theorem tsub_pos_iff_not_le : 0 < a - b ↔ ¬a ≤ b := by
  rw [pos_iff_ne_zero, Ne.def, tsub_eq_zero_iff_le]
#align tsub_pos_iff_not_le tsub_pos_iff_not_le

theorem tsub_pos_of_lt (h : a < b) : 0 < b - a :=
  tsub_pos_iff_not_le.mpr h.not_le
#align tsub_pos_of_lt tsub_pos_of_lt

theorem tsub_lt_of_lt (h : a < b) : a - c < b :=
  lt_of_le_of_lt tsub_le_self h
#align tsub_lt_of_lt tsub_lt_of_lt

namespace AddLECancellable

protected theorem tsub_le_tsub_iff_left (ha : AddLECancellable a) (hc : AddLECancellable c)
    (h : c ≤ a) : a - b ≤ a - c ↔ c ≤ b := by
  refine' ⟨_, fun h => tsub_le_tsub_left h a⟩
  rw [tsub_le_iff_left, ← hc.add_tsub_assoc_of_le h, hc.le_tsub_iff_right (h.trans le_add_self),
    add_comm b]
  apply ha
#align add_le_cancellable.tsub_le_tsub_iff_left AddLECancellable.tsub_le_tsub_iff_left

protected theorem tsub_right_inj (ha : AddLECancellable a) (hb : AddLECancellable b)
    (hc : AddLECancellable c) (hba : b ≤ a) (hca : c ≤ a) : a - b = a - c ↔ b = c := by
  simp_rw [le_antisymm_iff, ha.tsub_le_tsub_iff_left hb hba, ha.tsub_le_tsub_iff_left hc hca,
    and_comm]
#align add_le_cancellable.tsub_right_inj AddLECancellable.tsub_right_inj

end AddLECancellable

/-! #### Lemmas where addition is order-reflecting. -/

section Contra

variable [ContravariantClass α α (· + ·) (· ≤ ·)]

theorem tsub_le_tsub_iff_left (h : c ≤ a) : a - b ≤ a - c ↔ c ≤ b :=
  Contravariant.AddLECancellable.tsub_le_tsub_iff_left Contravariant.AddLECancellable h
#align tsub_le_tsub_iff_left tsub_le_tsub_iff_left

theorem tsub_right_inj (hba : b ≤ a) (hca : c ≤ a) : a - b = a - c ↔ b = c :=
  Contravariant.AddLECancellable.tsub_right_inj Contravariant.AddLECancellable
    Contravariant.AddLECancellable hba hca
#align tsub_right_inj tsub_right_inj

variable (α)

/-- A `CanonicallyOrderedAddMonoid` with ordered subtraction and order-reflecting addition is
cancellative. This is not an instance at it would form a typeclass loop.

See note [reducible non-instances]. -/
@[reducible]
def CanonicallyOrderedAddMonoid.toAddCancelCommMonoid : AddCancelCommMonoid α :=
  { (by infer_instance : AddCommMonoid α) with
    add_left_cancel := fun a b c h => by
      simpa only [add_tsub_cancel_left] using congr_arg (fun x => x - a) h }
#align canonically_ordered_add_monoid.to_add_cancel_comm_monoid CanonicallyOrderedAddMonoid.toAddCancelCommMonoid

end Contra

end CanonicallyOrderedAddMonoid

/-! ### Lemmas in a linearly canonically ordered monoid. -/

section CanonicallyLinearOrderedAddMonoid

variable [CanonicallyLinearOrderedAddMonoid α] [Sub α] [OrderedSub α] {a b c d : α}

@[simp]
theorem tsub_pos_iff_lt : 0 < a - b ↔ b < a := by rw [tsub_pos_iff_not_le, not_le]
#align tsub_pos_iff_lt tsub_pos_iff_lt

theorem tsub_eq_tsub_min (a b : α) : a - b = a - min a b := by
  cases' le_total a b with h h
  · rw [min_eq_left h, tsub_self, tsub_eq_zero_of_le h]
  · rw [min_eq_right h]
#align tsub_eq_tsub_min tsub_eq_tsub_min

namespace AddLECancellable

protected theorem lt_tsub_iff_right (hc : AddLECancellable c) : a < b - c ↔ a + c < b :=
  ⟨lt_imp_lt_of_le_imp_le tsub_le_iff_right.mpr, hc.lt_tsub_of_add_lt_right⟩
#align add_le_cancellable.lt_tsub_iff_right AddLECancellable.lt_tsub_iff_right

protected theorem lt_tsub_iff_left (hc : AddLECancellable c) : a < b - c ↔ c + a < b :=
  ⟨lt_imp_lt_of_le_imp_le tsub_le_iff_left.mpr, hc.lt_tsub_of_add_lt_left⟩
#align add_le_cancellable.lt_tsub_iff_left AddLECancellable.lt_tsub_iff_left

protected theorem tsub_lt_tsub_iff_right (hc : AddLECancellable c) (h : c ≤ a) :
    a - c < b - c ↔ a < b := by rw [hc.lt_tsub_iff_left, add_tsub_cancel_of_le h]
#align add_le_cancellable.tsub_lt_tsub_iff_right AddLECancellable.tsub_lt_tsub_iff_right

protected theorem tsub_lt_self (ha : AddLECancellable a) (h₁ : 0 < a) (h₂ : 0 < b) : a - b < a := by
  refine' tsub_le_self.lt_of_ne fun h => _
  rw [← h, tsub_pos_iff_lt] at h₁
  exact h₂.not_le (ha.add_le_iff_nonpos_left.1 <| add_le_of_le_tsub_left_of_le h₁.le h.ge)
#align add_le_cancellable.tsub_lt_self AddLECancellable.tsub_lt_self

protected theorem tsub_lt_self_iff (ha : AddLECancellable a) : a - b < a ↔ 0 < a ∧ 0 < b := by
  refine'
    ⟨fun h => ⟨(zero_le _).trans_lt h, (zero_le b).lt_of_ne _⟩, fun h => ha.tsub_lt_self h.1 h.2⟩
  rintro rfl
  rw [tsub_zero] at h
  exact h.false
#align add_le_cancellable.tsub_lt_self_iff AddLECancellable.tsub_lt_self_iff

/-- See `lt_tsub_iff_left_of_le_of_le` for a weaker statement in a partial order. -/
protected theorem tsub_lt_tsub_iff_left_of_le (ha : AddLECancellable a) (hb : AddLECancellable b)
    (h : b ≤ a) : a - b < a - c ↔ c < b :=
  lt_iff_lt_of_le_iff_le <| ha.tsub_le_tsub_iff_left hb h
#align add_le_cancellable.tsub_lt_tsub_iff_left_of_le AddLECancellable.tsub_lt_tsub_iff_left_of_le

end AddLECancellable

section Contra

variable [ContravariantClass α α (· + ·) (· ≤ ·)]

/-- This lemma also holds for `ENNReal`, but we need a different proof for that. -/
theorem tsub_lt_tsub_iff_right (h : c ≤ a) : a - c < b - c ↔ a < b :=
  Contravariant.AddLECancellable.tsub_lt_tsub_iff_right h
#align tsub_lt_tsub_iff_right tsub_lt_tsub_iff_right

theorem tsub_lt_self : 0 < a → 0 < b → a - b < a :=
  Contravariant.AddLECancellable.tsub_lt_self
#align tsub_lt_self tsub_lt_self

theorem tsub_lt_self_iff : a - b < a ↔ 0 < a ∧ 0 < b :=
  Contravariant.AddLECancellable.tsub_lt_self_iff
#align tsub_lt_self_iff tsub_lt_self_iff

/-- See `lt_tsub_iff_left_of_le_of_le` for a weaker statement in a partial order. -/
theorem tsub_lt_tsub_iff_left_of_le (h : b ≤ a) : a - b < a - c ↔ c < b :=
  Contravariant.AddLECancellable.tsub_lt_tsub_iff_left_of_le Contravariant.AddLECancellable h
#align tsub_lt_tsub_iff_left_of_le tsub_lt_tsub_iff_left_of_le

end Contra

/-! ### Lemmas about `max` and `min`. -/

theorem tsub_add_eq_max : a - b + b = max a b := by
  cases' le_total a b with h h
  · rw [max_eq_right h, tsub_eq_zero_of_le h, zero_add]
  · rw [max_eq_left h, tsub_add_cancel_of_le h]
#align tsub_add_eq_max tsub_add_eq_max

theorem add_tsub_eq_max : a + (b - a) = max a b := by rw [add_comm, max_comm, tsub_add_eq_max]
#align add_tsub_eq_max add_tsub_eq_max

theorem tsub_min : a - min a b = a - b := by
  cases' le_total a b with h h
  · rw [min_eq_left h, tsub_self, tsub_eq_zero_of_le h]
  · rw [min_eq_right h]
#align tsub_min tsub_min

theorem tsub_add_min : a - b + min a b = a := by
  rw [← tsub_min, @tsub_add_cancel_of_le]
  apply min_le_left
#align tsub_add_min tsub_add_min

end CanonicallyLinearOrderedAddMonoid


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

import algebra.group_with_zero.power
import algebra.big_operators.order
import algebra.big_operators.ring
import algebra.big_operators.intervals

/-!
# Partial sums of geometric series

This file determines the values of the geometric series $\sum_{i=0}^{n-1} x^i$ and
$\sum_{i=0}^{n-1} x^i y^{n-1-i}$ and variants thereof.

## Main definitions

* `geom_sum` defines for each $x$ in a semiring and each natural number $n$ the partial sum
  $\sum_{i=0}^{n-1} x^i$ of the geometric series.
* `geom_sum₂` defines for each $x,y$ in a semiring and each natural number $n$ the partial sum
  $\sum_{i=0}^{n-1} x^i y^{n-1-i}$ of the geometric series.

## Main statements

* `geom_sum_Ico` proves that $\sum_{i=m}^{n-1} x^i=\frac{x^n-x^m}{x-1}$ in a division ring.
* `geom_sum₂_Ico` proves that $\sum_{i=m}^{n-1} x^i=\frac{x^n-y^{n-m}x^m}{x-y}$ in a field.

Several variants are recorded, generalising in particular to the case of a noncommutative ring in
which `x` and `y` commute. Even versions not using division or subtraction, valid in each semiring,
are recorded.
-/

universe u
variable {α : Type u}

open finset opposite

open_locale big_operators

/-- Sum of the finite geometric series $\sum_{i=0}^{n-1} x^i$. -/
def geom_sum [semiring α] (x : α) (n : ℕ) :=
∑ i in range n, x ^ i

theorem geom_sum_def [semiring α] (x : α) (n : ℕ) :
  geom_sum x n = ∑ i in range n, x ^ i := rfl

@[simp] theorem geom_sum_zero [semiring α] (x : α) :
  geom_sum x 0 = 0 := rfl

@[simp] theorem geom_sum_one [semiring α] (x : α) :
  geom_sum x 1 = 1 :=
by { rw [geom_sum_def, sum_range_one, pow_zero] }

@[simp] lemma op_geom_sum [ring α] (x : α) (n : ℕ) :
  op (geom_sum x n) = geom_sum (op x) n :=
by simp [geom_sum_def]

/-- Sum of the finite geometric series $\sum_{i=0}^{n-1} x^i y^{n-1-i}$. -/
def geom_sum₂ [semiring α] (x y : α) (n : ℕ) :=
∑ i in range n, x ^ i * (y ^ (n - 1 - i))

theorem geom_sum₂_def [semiring α] (x y : α) (n : ℕ) :
  geom_sum₂ x y n = ∑ i in range n, x ^ i * y ^ (n - 1 - i) := rfl

@[simp] theorem geom_sum₂_zero [semiring α] (x y : α) :
  geom_sum₂ x y 0 = 0 := rfl

@[simp] theorem geom_sum₂_one [semiring α] (x y : α) :
  geom_sum₂ x y 1 = 1 :=
by { have : 1 - 1 - 0 = 0 := rfl,
     rw [geom_sum₂_def, sum_range_one, this, pow_zero, pow_zero, mul_one] }

@[simp] lemma op_geom_sum₂ [ring α] (x y : α) (n : ℕ) :
  op (geom_sum₂ x y n) = geom_sum₂ (op y) (op x) n :=
begin
  simp only [geom_sum₂_def, op_sum, op_mul, units.op_pow],
  rw ← sum_range_reflect,
  refine sum_congr rfl (λ j j_in, _),
  rw [mem_range, nat.lt_iff_add_one_le] at j_in,
  congr,
  apply nat.sub_sub_self,
  exact nat.le_sub_right_of_add_le j_in
end

@[simp] theorem geom_sum₂_with_one [semiring α] (x : α) (n : ℕ) :
  geom_sum₂ x 1 n = geom_sum x n :=
sum_congr rfl (λ i _, by { rw [one_pow, mul_one] })

/-- $x^n-y^n = (x-y) \sum x^ky^{n-1-k}$ reformulated without `-` signs. -/
protected theorem commute.geom_sum₂_mul_add [semiring α] {x y : α} (h : commute x y) (n : ℕ) :
  (geom_sum₂ (x + y) y n) * x + y ^ n = (x + y) ^ n :=
begin
  let f := λ (m i : ℕ), (x + y) ^ i * y ^ (m - 1 - i),
  change (∑ i in range n, (f n) i) * x + y ^ n = (x + y) ^ n,
  induction n with n ih,
  { rw [range_zero, sum_empty, zero_mul, zero_add, pow_zero, pow_zero] },
  { have f_last : f (n + 1) n = (x + y) ^ n :=
     by { dsimp [f],
          rw [nat.sub_sub, nat.add_comm, nat.sub_self, pow_zero, mul_one] },
    have f_succ : ∀ i, i ∈ range n → f (n + 1) i = y * f n i :=
      λ i hi, by {
        dsimp [f],
        have : commute y ((x + y) ^ i) :=
         (h.symm.add_right (commute.refl y)).pow_right i,
        rw [← mul_assoc, this.eq, mul_assoc, ← pow_succ y (n - 1 - i)],
        congr' 2,
        rw [nat.add_sub_cancel, nat.sub_sub, add_comm 1 i],
        have : i + 1 + (n - (i + 1)) = n := nat.add_sub_of_le (mem_range.mp hi),
        rw [add_comm (i + 1)] at this,
        rw [← this, nat.add_sub_cancel, add_comm i 1, ← add_assoc,
            nat.add_sub_cancel] },
    rw [pow_succ (x + y), add_mul, sum_range_succ_comm, add_mul, f_last, add_assoc],
    rw (((commute.refl x).add_right h).pow_right n).eq,
    congr' 1,
    rw [sum_congr rfl f_succ, ← mul_sum, pow_succ y, mul_assoc, ← mul_add y, ih] }
end

theorem geom_sum₂_self {α : Type*} [comm_ring α] (x : α) (n : ℕ) :
  geom_sum₂ x x n = n * x ^ (n-1) :=
calc  ∑ i in finset.range n, x ^ i * x ^ (n - 1 - i)
    = ∑ i in finset.range n, x ^ (i + (n - 1 - i)) : by simp_rw [← pow_add]
... = ∑ i in finset.range n, x ^ (n - 1) : finset.sum_congr rfl
  (λ i hi, congr_arg _ $ nat.add_sub_cancel' $ nat.le_pred_of_lt $ finset.mem_range.1 hi)
... = (finset.range n).card • (x ^ (n - 1)) : finset.sum_const _
... = n * x ^ (n - 1) : by rw [finset.card_range, nsmul_eq_mul]

/-- $x^n-y^n = (x-y) \sum x^ky^{n-1-k}$ reformulated without `-` signs. -/
theorem geom_sum₂_mul_add [comm_semiring α] (x y : α) (n : ℕ) :
  (geom_sum₂ (x + y) y n) * x + y ^ n = (x + y) ^ n :=
(commute.all x y).geom_sum₂_mul_add n

theorem geom_sum_mul_add [semiring α] (x : α) (n : ℕ) :
  (geom_sum (x + 1) n) * x + 1 = (x + 1) ^ n :=
begin
  have := (commute.one_right x).geom_sum₂_mul_add n,
  rw [one_pow, geom_sum₂_with_one] at this,
  exact this
end

protected theorem commute.geom_sum₂_mul [ring α] {x y : α} (h : commute x y) (n : ℕ) :
  (geom_sum₂ x y n) * (x - y) = x ^ n - y ^ n :=
begin
  have := (h.sub_left (commute.refl y)).geom_sum₂_mul_add n,
  rw [sub_add_cancel] at this,
  rw [← this, add_sub_cancel]
end

lemma commute.mul_neg_geom_sum₂ [ring α] {x y : α} (h : commute x y) (n : ℕ) :
  (y - x) * (geom_sum₂ x y n) = y ^ n - x ^ n :=
begin
  rw ← op_inj_iff,
  simp only [op_mul, op_sub, op_geom_sum₂, units.op_pow],
  exact (commute.op h.symm).geom_sum₂_mul n
end

lemma commute.mul_geom_sum₂ [ring α] {x y : α} (h : commute x y) (n : ℕ) :
  (x - y) * (geom_sum₂ x y n) = x ^ n - y ^ n :=
by rw [← neg_sub (y ^ n), ← h.mul_neg_geom_sum₂, ← neg_mul_eq_neg_mul_symm, neg_sub]

theorem geom_sum₂_mul [comm_ring α] (x y : α) (n : ℕ) :
  (geom_sum₂ x y n) * (x - y) = x ^ n - y ^ n :=
(commute.all x y).geom_sum₂_mul n

theorem geom_sum_mul [ring α] (x : α) (n : ℕ) :
  (geom_sum x n) * (x - 1) = x ^ n - 1 :=
begin
  have := (commute.one_right x).geom_sum₂_mul n,
  rw [one_pow, geom_sum₂_with_one] at this,
  exact this
end

lemma mul_geom_sum [ring α] (x : α) (n : ℕ) :
  (x - 1) * (geom_sum x n) = x ^ n - 1 :=
begin
  rw ← op_inj_iff,
  simpa using geom_sum_mul (op x) n,
end

theorem geom_sum_mul_neg [ring α] (x : α) (n : ℕ) :
  (geom_sum x n) * (1 - x) = 1 - x ^ n :=
begin
  have := congr_arg has_neg.neg (geom_sum_mul x n),
  rw [neg_sub, ← mul_neg_eq_neg_mul_symm, neg_sub] at this,
  exact this
end

lemma mul_neg_geom_sum [ring α] (x : α) (n : ℕ) :
  (1 - x) * (geom_sum x n) = 1 - x ^ n :=
begin
  rw ← op_inj_iff,
  simpa using geom_sum_mul_neg (op x) n,
end

protected theorem commute.geom_sum₂ [division_ring α] {x y : α} (h' : commute x y) (h : x ≠ y)
  (n : ℕ) : (geom_sum₂ x y n) = (x ^ n - y ^ n) / (x - y) :=
have x - y ≠ 0, by simp [*, -sub_eq_add_neg, sub_eq_iff_eq_add] at *,
by rw [← h'.geom_sum₂_mul, mul_div_cancel _ this]

theorem geom₂_sum [field α] {x y : α} (h : x ≠ y) (n : ℕ) :
  (geom_sum₂ x y n) = (x ^ n - y ^ n) / (x - y) :=
(commute.all x y).geom_sum₂ h n

theorem geom_sum_eq [division_ring α] {x : α} (h : x ≠ 1) (n : ℕ) :
  (geom_sum x n) = (x ^ n - 1) / (x - 1) :=
have x - 1 ≠ 0, by simp [*, -sub_eq_add_neg, sub_eq_iff_eq_add] at *,
by rw [← geom_sum_mul, mul_div_cancel _ this]

protected theorem commute.mul_geom_sum₂_Ico [ring α] {x y : α} (h : commute x y) {m n : ℕ}
  (hmn : m ≤ n) :
  (x - y) * (∑ i in finset.Ico m n, x ^ i * y ^ (n - 1 - i)) = x ^ n - x ^ m * y ^ (n - m) :=
begin
  rw [sum_Ico_eq_sub _ hmn, ← geom_sum₂_def],
  have : ∑ k in range m, x ^ k * y ^ (n - 1 - k)
    = ∑ k in range m, x ^ k * (y ^ (n - m) * y ^ (m - 1 - k)),
    { refine sum_congr rfl (λ j j_in, _),
      rw ← pow_add,
      congr,
      rw [mem_range, nat.lt_iff_add_one_le, add_comm] at j_in,
      have h' : n - m + (m - (1 + j)) = n - (1 + j) := nat.sub_add_sub_cancel hmn j_in,
      rw [nat.sub_sub m, h', nat.sub_sub] },
  rw this,
  simp_rw pow_mul_comm y (n-m) _,
  simp_rw ← mul_assoc,
  rw [← sum_mul, ← geom_sum₂_def, mul_sub, h.mul_geom_sum₂, ← mul_assoc,
    h.mul_geom_sum₂, sub_mul, ← pow_add, nat.add_sub_of_le hmn,
    sub_sub_sub_cancel_right (x ^ n) (x ^ m * y ^ (n - m)) (y ^ n)],
end

protected theorem commute.geom_sum₂_succ_eq {α : Type u} [ring α] {x y : α}
  (h : commute x y) {n : ℕ} :
  geom_sum₂ x y (n + 1) = x ^ n + y * (geom_sum₂ x y n) :=
begin
  simp_rw [geom_sum₂, mul_sum, sum_range_succ_comm, nat.add_succ_sub_one, add_zero, nat.sub_self,
    pow_zero, mul_one, add_right_inj, ←mul_assoc, (h.symm.pow_right _).eq, mul_assoc, ←pow_succ],
  refine sum_congr rfl (λ i hi, _),
  suffices : n - 1 - i + 1 = n - i, { rw this },
  cases n,
  { exact absurd (list.mem_range.mp hi) i.not_lt_zero },
  { rw [nat.sub_add_eq_add_sub (nat.le_pred_of_lt (list.mem_range.mp hi)),
        nat.sub_add_cancel (nat.succ_le_iff.mpr n.succ_pos)] },
end

theorem geom_sum₂_succ_eq {α : Type u} [comm_ring α] (x y : α)  {n : ℕ} :
  geom_sum₂ x y (n + 1) = x ^ n + y * (geom_sum₂ x y n) :=
(commute.all x y).geom_sum₂_succ_eq

theorem mul_geom_sum₂_Ico [comm_ring α] (x y : α) {m n : ℕ} (hmn : m ≤ n) :
  (x - y) * (∑ i in finset.Ico m n, x ^ i * y ^ (n - 1 - i)) = x ^ n - x ^ m * y ^ (n - m) :=
(commute.all x y).mul_geom_sum₂_Ico hmn

protected theorem commute.geom_sum₂_Ico_mul [ring α] {x y : α} (h : commute x y) {m n : ℕ}
  (hmn : m ≤ n) :
  (∑ i in finset.Ico m n, x ^ i * y ^ (n - 1 - i)) * (x - y) = x ^ n -  y ^ (n - m) * x ^ m :=
begin
  rw ← op_inj_iff,
  simp only [op_sub, op_mul, units.op_pow, op_sum],
  have : ∑ k in Ico m n, op y ^ (n - 1 - k) * op x ^ k
    = ∑ k in Ico m n, op x ^ k * op y ^ (n - 1 - k),
  { refine sum_congr rfl (λ k k_in, _),
    apply commute.pow_pow (commute.op h.symm) },
  rw this,
  exact (commute.op h).mul_geom_sum₂_Ico hmn
end

theorem geom_sum_Ico_mul [ring α] (x : α) {m n : ℕ} (hmn : m ≤ n) :
  (∑ i in finset.Ico m n, x ^ i) * (x - 1) = x^n - x^m :=
by rw [sum_Ico_eq_sub _ hmn, ← geom_sum_def, ← geom_sum_def, sub_mul,
  geom_sum_mul, geom_sum_mul, sub_sub_sub_cancel_right]

theorem geom_sum_Ico_mul_neg [ring α] (x : α) {m n : ℕ} (hmn : m ≤ n) :
  (∑ i in finset.Ico m n, x ^ i) * (1 - x) = x^m - x^n :=
by rw [sum_Ico_eq_sub _ hmn, ← geom_sum_def, ← geom_sum_def, sub_mul,
  geom_sum_mul_neg, geom_sum_mul_neg, sub_sub_sub_cancel_left]

protected theorem commute.geom_sum₂_Ico [division_ring α] {x y : α} (h : commute x y) (hxy : x ≠ y)
  {m n : ℕ} (hmn : m ≤ n) :
  ∑ i in finset.Ico m n, x ^ i * y ^ (n - 1 - i) = (x ^ n - y ^ (n - m) * x ^ m ) / (x - y) :=
have x - y ≠ 0, by simp [*, -sub_eq_add_neg, sub_eq_iff_eq_add] at *,
by rw [← h.geom_sum₂_Ico_mul hmn, mul_div_cancel _ this]

theorem geom_sum₂_Ico [field α] {x y : α} (hxy : x ≠ y) {m n : ℕ} (hmn : m ≤ n) :
  ∑ i in finset.Ico m n, x ^ i * y ^ (n - 1 - i) = (x ^ n - y ^ (n - m) * x ^ m ) / (x - y) :=
(commute.all x y).geom_sum₂_Ico hxy hmn

theorem geom_sum_Ico [division_ring α] {x : α} (hx : x ≠ 1) {m n : ℕ} (hmn : m ≤ n) :
  ∑ i in finset.Ico m n, x ^ i = (x ^ n - x ^ m) / (x - 1) :=
by simp only [sum_Ico_eq_sub _ hmn, (geom_sum_def _ _).symm, geom_sum_eq hx, div_sub_div_same,
  sub_sub_sub_cancel_right]

theorem geom_sum_Ico' [division_ring α] {x : α} (hx : x ≠ 1) {m n : ℕ} (hmn : m ≤ n) :
  ∑ i in finset.Ico m n, x ^ i = (x ^ m - x ^ n) / (1 - x) :=
by { simp only [geom_sum_Ico hx hmn], convert neg_div_neg_eq (x^m - x^n) (1-x); abel }

lemma geom_sum_inv [division_ring α] {x : α} (hx1 : x ≠ 1) (hx0 : x ≠ 0) (n : ℕ) :
  (geom_sum x⁻¹ n) = (x - 1)⁻¹ * (x - x⁻¹ ^ n * x) :=
have h₁ : x⁻¹ ≠ 1, by rwa [inv_eq_one_div, ne.def, div_eq_iff_mul_eq hx0, one_mul],
have h₂ : x⁻¹ - 1 ≠ 0, from mt sub_eq_zero.1 h₁,
have h₃ : x - 1 ≠ 0, from mt sub_eq_zero.1 hx1,
have h₄ : x * (x ^ n)⁻¹ = (x ^ n)⁻¹ * x :=
  nat.rec_on n (by simp)
  (λ n h, by rw [pow_succ, mul_inv_rev', ←mul_assoc, h, mul_assoc, mul_inv_cancel hx0, mul_assoc,
    inv_mul_cancel hx0]),
begin
  rw [geom_sum_eq h₁, div_eq_iff_mul_eq h₂, ← mul_right_inj' h₃,
    ← mul_assoc, ← mul_assoc, mul_inv_cancel h₃],
  simp [mul_add, add_mul, mul_inv_cancel hx0, mul_assoc, h₄, sub_eq_add_neg, add_comm,
    add_left_comm],
end

variables {β : Type*}

theorem ring_hom.map_geom_sum [semiring α] [semiring β] (x : α) (n : ℕ) (f : α →+* β) :
  f (geom_sum x n) = geom_sum (f x) n :=
by simp [geom_sum_def, f.map_sum]

theorem ring_hom.map_geom_sum₂ [semiring α] [semiring β] (x y : α) (n : ℕ) (f : α →+* β) :
  f (geom_sum₂ x y n) = geom_sum₂ (f x) (f y) n :=
by simp [geom_sum₂_def, f.map_sum]


import mynat.definition
import mynat.mul
import world2.level2

namespace mynat

lemma mul_add (t a b : mynat) : t * (a + b) = t * a + t * b :=
begin [nat_num_game]
    induction b with d hd,
    {
        rw add_zero,
        rw mul_zero,
        rw add_zero,
        refl,
    },
    {
        rw add_succ,
        rw mul_succ,
        rw hd,
        rw mul_succ,
        rw add_assoc,
        refl,
    },
end

end mynat


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

import tactic.basic

open tactic

-- `suggest` fails if there are no goals.
example : true :=
begin
  trivial,
  success_if_fail { suggest },
end

example (a : Prop) : a ∨ true :=
begin
  (do s ← suggest_scripts, guard $ s.head = "Try this: exact or.inr trivial"), exact or.inr trivial,
end

example {a a' : ℕ} (h : a == a') : a = a' :=
begin
  (do s ← suggest_scripts, guard $ s.head = "Try this: exact eq_of_heq h"), exact eq_of_heq h,
end
example {a b c : ℤ} (h₁ : a = b) (h₂ : b = c) : a = c :=
begin
  (do s ← suggest_scripts, guard $ "Try this: exact eq.trans h₁ h₂" ∈ s), exact eq.trans h₁ h₂,
end

example (n : nat) : n + 0 = n :=
begin
  (do s ← suggest_scripts, guard $ s.head = "Try this: exact rfl"), exact rfl,
end

example (n : nat) : n < n + 1 :=
begin
  (do s ← suggest_scripts, guard $ s.head = "Try this: exact nat.lt.base n"),
  exact nat.lt.base n
end
example (n : nat) : n < n + 2 :=
begin
  (do s ← suggest_scripts, guard $ "Try this: refine nat.lt.step _" ∈ s),
  refine nat.lt.step _, -- this wasn't the first result; humans still necessary :-(
  (do s ← suggest_scripts, guard $ s.head = "Try this: exact nat.lt.base n"),
  exact nat.lt.base n
end

example (a b : Prop) : (a ∨ true) ∧ (b ∨ true) :=
begin
  (do s ← suggest_scripts, guard $ "Try this: refine ⟨_, _⟩" ∈ s),
  refine ⟨_, _⟩, -- wasn't the first result, because it created two new goals
  { (do s ← suggest_scripts, guard $ s.head = "Try this: exact or.inr trivial"),
    exact or.inr trivial },
  { (do s ← suggest_scripts, guard $ s.head = "Try this: exact or.inr trivial"),
    exact or.inr trivial },
end

example (A B : Prop) (a : A) (b : unit → B) : A ∧ B :=
begin
  (do s ← suggest_scripts, guard $ s.head = "Try this: refine ⟨a, _⟩"),
  refine ⟨a, _⟩,
  replace b := b (),
  (do s ← suggest_scripts, guard $ s.head = "Try this: exact b"),
  exact b,
end

example {a b c : ℕ} (h₁ : a ≤ b) (h₂ : b ≤ c) : a ≤ c :=
begin
  (do s ← suggest_scripts, guard $ s.head = "Try this: exact le_trans h₁ h₂"),
  exact le_trans h₁ h₂
end

-- Verify that `suggest` focuses on the first goal when there are multiple goals.
example (a b c d e f : ℕ) (hab : a ≤ b) (hbc : b ≤ c) (hde : d ≤ e) (hef : e ≤ f) :
  a ≤ c ∧ d ≤ f :=
begin
  split,
  (do s ← suggest_scripts, guard $ s.head = "Try this: exact le_trans hab hbc"),
  exact le_trans hab hbc,
  exact le_trans hde hef
end