/-
Copyright (c) 2018 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison, Reid Barton, Simon Hudon, Kenny Lau
-/
import data.equiv.basic

/-!
# Opposites

In this file we define a type synonym `opposite α := α`, denoted by `αᵒᵖ` and two synonyms for the
identity map, `op : α → αᵒᵖ` and `unop : αᵒᵖ → α`. If `α` is a category, then `αᵒᵖ` is the opposite
category, with all arrows reversed.
-/

universes v u -- morphism levels before object levels. See note [category_theory universes].

variable (α : Sort u)

/-- The type of objects of the opposite of `α`; used to define the opposite category.

  In order to avoid confusion between `α` and its opposite type, we
  set up the type of objects `opposite α` using the following pattern,
  which will be repeated later for the morphisms.

  1. Define `opposite α := α`.
  2. Define the isomorphisms `op : α → opposite α`, `unop : opposite α → α`.
  3. Make the definition `opposite` irreducible.

  This has the following consequences.

  * `opposite α` and `α` are distinct types in the elaborator, so you
    must use `op` and `unop` explicitly to convert between them.
  * Both `unop (op X) = X` and `op (unop X) = X` are definitional
    equalities. Notably, every object of the opposite category is
    definitionally of the form `op X`, which greatly simplifies the
    definition of the structure of the opposite category, for example.

  (If Lean supported definitional eta equality for records, we could
  achieve the same goals using a structure with one field.)
-/
def opposite : Sort u := α

-- Use a high right binding power (like that of postfix ⁻¹) so that, for example,
-- `presheaf Cᵒᵖ` parses as `presheaf (Cᵒᵖ)` and not `(presheaf C)ᵒᵖ`.
notation α `ᵒᵖ`:std.prec.max_plus := opposite α

namespace opposite

variables {α}
/-- The canonical map `α → αᵒᵖ`. -/
@[pp_nodot]
def op : α → αᵒᵖ := id
/-- The canonical map `αᵒᵖ → α`. -/
@[pp_nodot]
def unop : αᵒᵖ → α := id

lemma op_injective : function.injective (op : α → αᵒᵖ) := λ _ _, id
lemma unop_injective : function.injective (unop : αᵒᵖ → α) := λ _ _, id

@[simp] lemma op_inj_iff (x y : α) : op x = op y ↔ x = y := iff.rfl
@[simp] lemma unop_inj_iff (x y : αᵒᵖ) : unop x = unop y ↔ x = y := iff.rfl

@[simp] lemma op_unop (x : αᵒᵖ) : op (unop x) = x := rfl
@[simp] lemma unop_op (x : α) : unop (op x) = x := rfl

attribute [irreducible] opposite

/-- The type-level equivalence between a type and its opposite. -/
def equiv_to_opposite : α ≃ αᵒᵖ :=
{ to_fun := op,
  inv_fun := unop,
  left_inv := unop_op,
  right_inv := op_unop }

@[simp]

lemma op_eq_iff_eq_unop {x : α} {y} : op x = y ↔ x = unop y :=
equiv_to_opposite.apply_eq_iff_eq_symm_apply

lemma unop_eq_iff_eq_op {x} {y : α} : unop x = y ↔ x = op y :=
equiv_to_opposite.symm.apply_eq_iff_eq_symm_apply

instance [inhabited α] : inhabited αᵒᵖ := ⟨op (default _)⟩

/-- A recursor for `opposite`. Use as `induction x using opposite.rec`. -/
@[simp]
protected def rec {F : Π (X : αᵒᵖ), Sort v} (h : Π X, F (op X)) : Π X, F X :=
λ X, h (unop X)

end opposite

namespace tactic

open opposite

namespace op_induction

/-- Test if `e : expr` is of type `opposite α` for some `α`. -/
meta def is_opposite (e : expr) : tactic bool :=
do t ← infer_type e,
   `(opposite _) ← whnf t | return ff,
   return tt

/-- Find the first hypothesis of type `opposite _`. Fail if no such hypothesis exist in the local
context. -/
meta def find_opposite_hyp : tactic name :=
do lc ← local_context,
   h :: _ ← lc.mfilter $ is_opposite | fail "No hypotheses of the form Xᵒᵖ",
   return h.local_pp_name

end op_induction

open op_induction

/-- A version of `induction x using opposite.rec` which finds the appropriate hypothesis
automatically, for use with `local attribute [tidy] op_induction'`. This is necessary because
`induction x` is not able to deduce that `opposite.rec` should be used. -/
meta def op_induction' : tactic unit :=
do h ← find_opposite_hyp,
   h' ← tactic.get_local h,
   tactic.induction' h' [] `opposite.rec

end tactic


import PropositionWorld.Level1
import PropositionWorld.Level2
import PropositionWorld.Level3
import PropositionWorld.Level4
import PropositionWorld.Level5
import PropositionWorld.Level6
import PropositionWorld.Level7
import PropositionWorld.Level8
import PropositionWorld.Level9
/-!

# Proposition world.

A Proposition is a true/false statement, like `2 + 2 = 4` or `2 + 2 = 5`.
Just like we can have concrete sets in Lean like `MyNat`, and abstract
sets called things like `X`, we can also have concrete propositions like
`2 + 2 = 5` and abstract propositions called things like `P`.

Mathematicians are very good at conflating a theorem with its proof.
They might say "now use theorem 12 and we're done". What they really
mean is "now use the proof of theorem 12..." (i.e. the fact that we proved
it already). Particularly problematic is the fact that mathematicians
use the word Proposition to mean "a relatively straightforward statement
which is true" and computer scientists use it to mean "a statement of
arbitrary complexity, which might be true or false". Computer scientists
are far more careful about distinguishing between a proposition and a proof.
For example: `x + 0 = x` is a proposition, and `add_zero x`
is its proof. The convention we'll use is capital letters for propositions
and small letters for proofs.

In this world you will see the local context in the following kind of state:

```
P : Prop
p : P
```

Here `P` is the true/false statement (the statement of proposition), and `p` is its proof.
It's like `P` being the set and `p` being the element. In fact, computer scientists
sometimes think about the following analogy: propositions are like sets,
and their proofs are like their elements.

## What's going on in this world?

We're going to learn about manipulating propositions and proofs.
Fortunately, we don't need to learn a bunch of new tactics -- the
ones we just learnt (`exact`, `intro`, `have`, `apply`) will be perfect.

The levels in proposition world are "back to normal", we're proving
theorems, not constructing elements of sets. Or are we?

In Lean, Propositions, like sets, are types, and proofs, like elements of sets, are terms.

Let's get started [Level 1](./PropositionWorld/Level1.lean.md)
-/


/-
Copyright (c) 2020 Fox Thomson. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Fox Thomson
-/

import data.fintype.basic
import computability.language
import tactic.norm_num

/-!
# Deterministic Finite Automata
This file contains the definition of a Deterministic Finite Automaton (DFA), a state machine which
determines whether a string (implemented as a list over an arbitrary alphabet) is in a regular set
in linear time.
Note that this definition allows for Automaton with infinite states, a `fintype` instance must be
supplied for true DFA's.
-/

universes u v

/-- A DFA is a set of states (`σ`), a transition function from state to state labelled by the
  alphabet (`step`), a starting state (`start`) and a set of acceptance states (`accept`). -/
structure DFA (α : Type u) (σ : Type v) :=
(step : σ → α → σ)
(start : σ)
(accept : set σ)

namespace DFA

variables {α : Type u} {σ : Type v} (M : DFA α σ)

instance [inhabited σ] : inhabited (DFA α σ) :=
⟨DFA.mk (λ _ _, default) default ∅⟩

/-- `M.eval_from s x` evaluates `M` with input `x` starting from the state `s`. -/
def eval_from (start : σ) : list α → σ :=
list.foldl M.step start

/-- `M.eval x` evaluates `M` with input `x` starting from the state `M.start`. -/
def eval := M.eval_from M.start

/-- `M.accepts` is the language of `x` such that `M.eval x` is an accept state. -/
def accepts : language α :=
λ x, M.eval x ∈ M.accept

lemma mem_accepts (x : list α) : x ∈ M.accepts ↔ M.eval_from M.start x ∈ M.accept := by refl

lemma eval_from_of_append (start : σ) (x y : list α) :
  M.eval_from start (x ++ y) = M.eval_from (M.eval_from start x) y :=
x.foldl_append _ _ y

lemma eval_from_split [fintype σ] {x : list α} {s t : σ} (hlen : fintype.card σ ≤ x.length)
  (hx : M.eval_from s x = t) :
  ∃ q a b c,
  x = a ++ b ++ c ∧
  a.length + b.length ≤ fintype.card σ ∧
  b ≠ [] ∧
  M.eval_from s a = q ∧
  M.eval_from q b = q ∧
  M.eval_from q c = t :=
begin
  obtain ⟨n, m, hneq, heq⟩ := fintype.exists_ne_map_eq_of_card_lt
    (λ n : fin (fintype.card σ + 1), M.eval_from s (x.take n)) (by norm_num),
  wlog hle : (n : ℕ) ≤ m using n m,
  have hlt : (n : ℕ) < m := (ne.le_iff_lt hneq).mp hle,
  have hm : (m : ℕ) ≤ fintype.card σ := fin.is_le m,
  dsimp at heq,

  refine ⟨M.eval_from s ((x.take m).take n), (x.take m).take n, (x.take m).drop n, x.drop m,
    _, _, _, by refl, _⟩,

  { rw [list.take_append_drop, list.take_append_drop] },

  { simp only [list.length_drop, list.length_take],
    rw [min_eq_left (hm.trans hlen), min_eq_left hle, add_tsub_cancel_of_le hle],
    exact hm },

  { intro h,
    have hlen' := congr_arg list.length h,
    simp only [list.length_drop, list.length, list.length_take] at hlen',
    rw [min_eq_left, tsub_eq_zero_iff_le] at hlen',
    { apply hneq,
      apply le_antisymm,
      assumption' },
    exact hm.trans hlen, },

  have hq :
    M.eval_from (M.eval_from s ((x.take m).take n)) ((x.take m).drop n) =
      M.eval_from s ((x.take m).take n),
  { rw [list.take_take, min_eq_left hle, ←eval_from_of_append, heq, ←min_eq_left hle,
        ←list.take_take, min_eq_left hle, list.take_append_drop] },

  use hq,
  rwa [←hq, ←eval_from_of_append, ←eval_from_of_append, ←list.append_assoc, list.take_append_drop,
       list.take_append_drop]
end

lemma eval_from_of_pow {x y : list α} {s : σ} (hx : M.eval_from s x = s)
  (hy : y ∈ @language.star α {x}) : M.eval_from s y = s :=
begin
  rw language.mem_star at hy,
  rcases hy with ⟨ S, rfl, hS ⟩,
  induction S with a S ih,
  { refl },
  { have ha := hS a (list.mem_cons_self _ _),
    rw set.mem_singleton_iff at ha,
    rw [list.join, eval_from_of_append, ha, hx],
    apply ih,
    intros z hz,
    exact hS z (list.mem_cons_of_mem a hz) }
end

lemma pumping_lemma [fintype σ] {x : list α} (hx : x ∈ M.accepts)
  (hlen : fintype.card σ ≤ list.length x) :
  ∃ a b c, x = a ++ b ++ c ∧ a.length + b.length ≤ fintype.card σ ∧ b ≠ [] ∧
  {a} * language.star {b} * {c} ≤ M.accepts :=
begin
  obtain ⟨_, a, b, c, hx, hlen, hnil, rfl, hb, hc⟩ := M.eval_from_split hlen rfl,
  use [a, b, c, hx, hlen, hnil],
  intros y hy,
  rw language.mem_mul at hy,
  rcases hy with ⟨ ab, c', hab, hc', rfl ⟩,
  rw language.mem_mul at hab,
  rcases hab with ⟨ a', b', ha', hb', rfl ⟩,
  rw set.mem_singleton_iff at ha' hc',
  substs ha' hc',
  have h := M.eval_from_of_pow hb hb',
  rwa [mem_accepts, eval_from_of_append, eval_from_of_append, h, hc]
end

end DFA


import field_definition
import field_results
import numbers
import roots

def quadratic_subst (f : Type) [myfld f] : f -> f -> f -> f -> f
| x a b c := (a .* (x .* x)) .+ ((b .* x) .+ c)

lemma complete_the_square (f : Type) [myfld f] (x b : f) :
    (x .* x) .+ (((two f) .* b) .* x) =
    (square f (x .+ b)) .+ (.- (square f b)) :=
begin
  unfold square, unfold two, rw distrib_simp, rw distrib_simp_alt, repeat {rw distrib_simp}, rw one_mul,
  repeat {rw <- myfld.add_assoc _ _ _}, rw myfld.add_negate _, rw zero_simp f _, rw myfld.mul_comm x b,
end

lemma multiply_out_squared (f : Type) [myfld f] (x a : f) :
  (square f (x .+ a)) = ((square f x) .+ (((two f) .* (a .* x)) .+ (square f a))) :=
begin
  unfold square, unfold two,
  repeat {rw distrib_simp f _ _ _}, repeat {rw distrib_simp_alt f _ _ _},
  rw one_mul_simp f _, rw myfld.mul_comm a x,
  repeat {rw myfld.add_assoc _ _ _},
end

def quadratic_formula (f : Type) [myfld f] [fld_with_sqrt f] [fld_not_char_two f] (a b c : f)
                                 (a_ne_zero : a ≠ myfld.zero) :=
      (.- b .+ (sqroot ((b .* b) .+ (.- ((four f) .* (a .* c))))))
      .*
      (myfld.reciprocal ((two f) .* a) (mul_nonzero f (two f) a (two_ne_zero f) a_ne_zero))

/- The proof of the correctness of the quadratic formula starts here.
  The proof is split into a couple of different sections so that they can be reused when it comes time to
     prove that negating the square root still gives a correct formula.-/

/- This first section does all the work between unfolding the formula and multiplying the square root by itself.-/
lemma quadratic_formula_sub_proof_a (f : Type) [myfld f] [fld_with_sqrt f] [fld_not_char_two f] (a b c sqrt : f) (a_ne_zero : a ≠ myfld.zero) :
  (((a .* (((.- b) .* (myfld.reciprocal ((two f) .* a) (mul_nonzero f (two f) a (two_ne_zero f) a_ne_zero))) .* ((.- b) .* (myfld.reciprocal ((two f) .* a) (mul_nonzero f (two f) a (two_ne_zero f) a_ne_zero))))) .+ (a .* (((.- b) .* (myfld.reciprocal ((two f) .* a) (mul_nonzero f (two f) a (two_ne_zero f) a_ne_zero))) .* (sqrt .* (myfld.reciprocal ((two f) .* a) (mul_nonzero f (two f) a (two_ne_zero f) a_ne_zero)))))) .+ ((a .* ((sqrt .* (myfld.reciprocal ((two f) .* a) (mul_nonzero f (two f) a (two_ne_zero f) a_ne_zero))) .* ((.- b) .* (myfld.reciprocal ((two f) .* a) (mul_nonzero f (two f) a (two_ne_zero f) a_ne_zero))))) .+ (a .* ((sqrt .* (myfld.reciprocal ((two f) .* a) (mul_nonzero f (two f) a (two_ne_zero f) a_ne_zero))) .* (sqrt .* (myfld.reciprocal ((two f) .* a) (mul_nonzero f (two f) a (two_ne_zero f) a_ne_zero))))))) .+ (((b .* ((.- b) .* (myfld.reciprocal ((two f) .* a) (mul_nonzero f (two f) a (two_ne_zero f) a_ne_zero)))) .+ (b .* (sqrt .* (myfld.reciprocal ((two f) .* a) (mul_nonzero f (two f) a (two_ne_zero f) a_ne_zero))))) .+ c)
=
c .+ ((myfld.reciprocal ((two f) .* a) (mul_nonzero f (two f) a (two_ne_zero f) a_ne_zero)) .* ((b .* (b .* (myfld.reciprocal (two f) (two_ne_zero f)))) .+ ((sqrt .* ((myfld.reciprocal (two f) (two_ne_zero f)) .* sqrt)) .+ ((.- b) .* b)))) :=
begin
  /- First we can cancel inside some terms that have a * 1/2a.-/
  rw myfld.mul_comm _ (myfld.reciprocal ((two f) .* a) _),
  repeat {rw <- myfld.mul_assoc (myfld.reciprocal ((two f) .* a) _) _ _},
  repeat {rw myfld.mul_assoc a (myfld.reciprocal ((two f) .* a) _) _},
  rw myfld.mul_comm sqrt (myfld.reciprocal ((two f) .* a) _),
  rw <- myfld.mul_assoc (myfld.reciprocal ((two f) .* a) _) sqrt _,
  rw myfld.mul_assoc a (myfld.reciprocal ((two f) .* a) _) _,
  have cancel_a : (a .* (myfld.reciprocal ((two f) .* a) _)) = (myfld.reciprocal (two f) (two_ne_zero f)),
    rw split_reciprocal f (two f) a _,
    rw only_one_reciprocal f (two f) _ (two_ne_zero f),
    rw myfld.mul_comm (myfld.reciprocal (two f) _) (myfld.reciprocal a _),
    rw myfld.mul_assoc, rw myfld.mul_reciprocal a _, rw myfld.mul_comm _ _,
    rw <- myfld.mul_one (myfld.reciprocal (two f) (two_ne_zero f)),
  rw cancel_a,

  /- There are two terms consisting of 1/2 * (-b) * 1/2a * sqrt (det) .
  We can add these together into a single (-b) * 1/2a * sqrt (det) term.-/
  rw myfld.mul_assoc sqrt (myfld.reciprocal ((two f) .* a) _) (.- b),
  rw myfld.mul_comm (sqrt .* (myfld.reciprocal ((two f) .* a) _)) (.- b),
  rw myfld.mul_comm sqrt (myfld.reciprocal ((two f) .* a) _),
  rw assoc_tree f _ ((myfld.reciprocal (two f) _) .* ((.- b) .* ((myfld.reciprocal ((two f) .* a) _) .* sqrt))) ((myfld.reciprocal (two f) _) .* ((.- b) .* ((myfld.reciprocal ((two f) .* a) _) .* sqrt))) _,
  rw <- distrib_simp f (myfld.reciprocal (two f) _) _ _,
  rw only_one_reciprocal f (two f) _ (two_ne_zero f),
  rw add_two_halves f, rw one_mul f _,

  /- (-b) * 1/2a * sqrt (det) cancels with b * 1/2a * sqrt (det) -/
  repeat {rw mul_negate f b _},
  rw myfld.add_comm (.- (b .* ((myfld.reciprocal ((two f) .* a) _) .* sqrt))) (a .* (((myfld.reciprocal ((two f) .* a) _) .* sqrt) .* ((myfld.reciprocal ((two f) .* a) _) .* sqrt))),
  rw myfld.add_comm (b .* ((myfld.reciprocal ((two f) .* a) _) .* (.- b))) (b .* ((myfld.reciprocal ((two f) .* a) _) .* sqrt)),
  repeat {rw <- myfld.add_assoc},
  rw myfld.add_assoc (.- (b .* ((myfld.reciprocal ((two f) .* a) _) .* sqrt))) (b .* ((myfld.reciprocal ((two f) .* a) _) .* sqrt)) ((b .* ((myfld.reciprocal ((two f) .* a) _) .* (.- b))) .+ c),
  rw myfld.add_comm (.- (b .* ((myfld.reciprocal ((two f) .* a) _) .* sqrt))) (b .* ((myfld.reciprocal ((two f) .* a) _) .* sqrt)),
  rw myfld.add_negate (b .* ((myfld.reciprocal ((two f) .* a) _) .* sqrt)),
  rw myfld.add_comm myfld.zero _, rw zero_simp f _,

  /- We can factorise out a common factor of 1/2a from everything except the +c at the end.-/
  rw myfld.mul_comm b ((myfld.reciprocal ((two f) .* a) _) .* (.- b)),
  repeat {rw myfld.add_assoc _ _ _}, rw myfld.add_comm _ c, repeat {rw <- myfld.add_assoc _ _ _},
  rw myfld.mul_comm (myfld.reciprocal (two f) _) (.- (((myfld.reciprocal ((two f) .* a) _) .* (.- b)) .* b)),
  rw <- mul_negate f ((myfld.reciprocal ((two f) .* a) _) .* (.- b)) b,
  rw mul_negate_alt f (myfld.reciprocal ((two f) .* a) _) (.- b),
  rw double_negative f b,
  rw myfld.mul_comm a (((myfld.reciprocal ((two f) .* a) _) .* sqrt) .* ((myfld.reciprocal ((two f) .* a) _) .* sqrt)),
  repeat {rw <- myfld.mul_assoc _ _ _},
  rw only_one_reciprocal f ((two f) .* a) _ (mul_nonzero f (two f) a (two_ne_zero f) a_ne_zero),
  repeat {rw <- distrib_simp_alt f (myfld.reciprocal ((two f) .* a) _) _ _},

  /- There's one term left with a * 1/2a, which we cancel..-/
  rw myfld.mul_comm sqrt a,
  rw myfld.mul_assoc (myfld.reciprocal ((two f) .* a) _) a _,
  rw myfld.mul_comm (myfld.reciprocal ((two f) .* a) _) a,
  rw cancel_a, clear cancel_a,

  rw only_one_reciprocal f ((two f) .* a) _ (mul_nonzero f (two f) a (two_ne_zero f) a_ne_zero),
  rw only_one_reciprocal f (two f) _ (two_ne_zero f),
  rw mul_negate f b b,
end

/- This second section does all the work after the part that goes
   (sqrt discriminant) * (sqrt discriminant) = discriminant.-/
lemma quadratic_formula_sub_proof_b (f : Type) [myfld f] [fld_with_sqrt f] [fld_not_char_two f] (a b c : f) (a_ne_zero : a ≠ myfld.zero) :
  c .+ ((myfld.reciprocal ((two f) .* a) (mul_nonzero f (two f) a (two_ne_zero f) a_ne_zero)) .* ((b .* (b .* (myfld.reciprocal (two f) (two_ne_zero f)))) .+ ((((b .* b) .* (myfld.reciprocal (two f) (two_ne_zero f))) .+ ((.- ((four f) .* (a .* c))) .* (myfld.reciprocal (two f) (two_ne_zero f)))) .+ ((.- b) .* b))))
  = myfld.zero :=
begin
  /- Two copies of b * b * 1/2 add together to give b * b...-/
  rw myfld.mul_assoc b b (myfld.reciprocal (two f) _),
  repeat {rw <- myfld.add_assoc _ _ _},
  rw myfld.add_assoc ((b .* b) .* (myfld.reciprocal (two f) _)) ((b .* b) .* (myfld.reciprocal (two f) _)) _,
  rw <- distrib_simp_alt f (b .* b) _ _,
  rw add_two_halves f, rw <- myfld.mul_one (b .* b),

  /- The b^2 that we just made cancels with the -b^2...-/
  rw myfld.add_comm (b .* b) (((.- ((four f) .* (a .* c))) .* (myfld.reciprocal (two f) _)) .+ ((.- b) .* b)),
  rw <- myfld.add_assoc _ ((.- b) .* b) (b .* b),
  rw mul_negate f b b,
  rw myfld.add_comm (.- (b .* b)) (b .* b),
  rw myfld.add_negate (b .* b),
  rw <- myfld.add_zero ((.- ((four f) .* (a .* c))) .* (myfld.reciprocal (two f) _)),

  /- We're now down to c + 1/2a * 4ac * 1/2, which is fairly obviously zero.-/
  /- All that's left to do is to simplify the second term.-/
  rw split_reciprocal f (two f) a _, rw myfld.mul_assoc (four f) a c,
  rw myfld.mul_comm (four f) a,
  rw mul_negate _ _, rw <- mul_negate_alt _ _,
  rw assoc_tree_mul f _ _ _ _, rw myfld.mul_assoc (myfld.reciprocal a _) _ _, rw myfld.mul_assoc (myfld.reciprocal a _) a _,
  rw myfld.mul_comm (myfld.reciprocal a _) a, rw myfld.mul_reciprocal a _,
  rw one_mul f (four f),
  rw myfld.mul_comm ((four f) .* c) (myfld.reciprocal (two f) _),
  rw myfld.mul_assoc _ _ _, rw mul_two_reciprocals f (two f) (two f) _ _,
  unfold four, rw two_plus_two f,
  rw myfld.mul_assoc (myfld.reciprocal ((two f) .* (two f)) _) ((two f) .* (two f)) c,
  rw myfld.mul_comm (myfld.reciprocal ((two f) .* (two f)) _) ((two f) .* (two f)),
  rw myfld.mul_reciprocal ((two f) .* (two f)) _, rw one_mul f c,
  exact myfld.add_negate c,
end

/- And so this brings the two halves together into a proof of the correctness of the formula.-/
lemma quadratic_formula_works (f : Type) [myfld f] [fld_with_sqrt f] [fld_not_char_two f] (a b c : f) (a_ne_zero : a ≠ myfld.zero) :
    quadratic_subst f (quadratic_formula f a b c a_ne_zero) a b c = myfld.zero :=
begin
  unfold quadratic_formula, unfold quadratic_subst,
  rw distrib_simp f _ _ _, rw distrib_simp f _ _ _, repeat {rw distrib_simp_alt f _ _ _},

  rw quadratic_formula_sub_proof_a f a b c (sqroot  ((b .* b) .+ (.- ((four f) .* (a .* c))))) a_ne_zero,

  /- One of our terms now has the square root of the discriminant multiplied by itself.
  This, of course, gives us the discriminant.-/
  rw myfld.mul_comm (myfld.reciprocal (two f) _) (sqroot  ((b .* b) .+ (.- ((four f) .* (a .* c))))),
  rw myfld.mul_assoc (sqroot  ((b .* b) .+ (.- ((four f) .* (a .* c))))) (sqroot  ((b .* b) .+ (.- ((four f) .* (a .* c))))) _,
  rw fld_with_sqrt.sqrt_mul_sqrt ((b .* b) .+ (.- ((four f) .* (a .* c)))),
  rw distrib_simp f _ _ _,

  exact quadratic_formula_sub_proof_b f a b c a_ne_zero,
end

/- Of course, a given quadratic has two solutions...-/
def quadratic_formula_alt (f : Type) [myfld f] [fld_with_sqrt f] [fld_not_char_two f] (a b c : f)
                                      (a_ne_zero : a ≠ myfld.zero) :=
      ((.- b) .+ (.- (sqroot  ((b .* b) .+ (.- ((four f) .* (a .* c))))))) .*
      (myfld.reciprocal ((two f) .* a) (mul_nonzero f (two f) a (two_ne_zero f) a_ne_zero))

/- And both solutions are correct...-/
lemma quadratic_formula_alt_works (f : Type) [myfld f] [fld_with_sqrt f] [fld_not_char_two f] (a b c : f) (a_ne_zero : a ≠ myfld.zero) :
    quadratic_subst f (quadratic_formula_alt f a b c a_ne_zero) a b c = myfld.zero :=
begin
  unfold quadratic_formula_alt, unfold quadratic_subst,
  rw distrib_simp f _ _ _, rw distrib_simp f _ _ _, repeat {rw distrib_simp_alt f _ _ _},

  rw quadratic_formula_sub_proof_a f a b c (.- (sqroot  ((b .* b) .+ (.- ((four f) .* (a .* c)))))) a_ne_zero,

  /- One of our terms now has the negative of the square root of the discriminant multiplied by itself.
  This, of course, gives us the discriminant.-/
  rw myfld.mul_comm (myfld.reciprocal (two f) _) (.- (sqroot  ((b .* b) .+ (.- ((four f) .* (a .* c)))))),
  rw myfld.mul_assoc (.- (sqroot  ((b .* b) .+ (.- ((four f) .* (a .* c)))))) (.- (sqroot  ((b .* b) .+ (.- ((four f) .* (a .* c)))))) _,
  rw negative_sqrt f ((b .* b) .+ (.- ((four f) .* (a .* c)))),
  rw distrib_simp f _ _ _,

  exact quadratic_formula_sub_proof_b f a b c a_ne_zero,
end
/- So both versions of the quadratic formula work properly.-/
/- However we have not proven that these are the only solutions.-/

/- OK: proof that no solutions to a quadratic exist besides the formula ones. -/
lemma quadratic_solution_unique (f : Type) [myfld f] [fld_with_sqrt f] [fld_not_char_two f]
                                            (a b c x : f) (a_ne_zero : a ≠ myfld.zero) :
          (x ≠ quadratic_formula f a b c a_ne_zero /\ x ≠ quadratic_formula_alt f a b c a_ne_zero) ->
          quadratic_subst f x a b c ≠ myfld.zero :=
begin
  intros not_formula h,

  /- This will involve reducing the introduced formulae into a form that can be passed to
        only_two_square_roots, which requires three formulae of the forms:
        k ≠ sqrt (y)
        k ≠ - sqrt (y)
        k * k = y
        So we first have to unfold the statement that x is not the solution to the quadratic formula
        and reduce it to a form that looks like something ≠ ± (sqrt (something else)) . -/
  unfold quadratic_formula at not_formula, unfold quadratic_formula_alt at not_formula,
  repeat {rw distrib_simp f _ _ _ at not_formula},
  repeat {rw myfld.add_comm ((.- b) .* (myfld.reciprocal ((two f) .* a) _)) _ at not_formula},
  rw mul_negate f _ _ at not_formula,
  repeat {rw <- carry_term_across_ne f x _ (b .* (myfld.reciprocal ((two f) .* a) _)) at not_formula},
  cases not_formula with nfa nfb,
  have two_a_ne_zero : ((two f) .* a) ≠ myfld.zero,
    exact mul_nonzero f (two f) a (two_ne_zero f) a_ne_zero,
  have nfa_tmp : (x .+ (b .* (myfld.reciprocal ((two f) .* a) _))) .* ((two f) .* a) ≠ ((sqroot  ((b .* b) .+ (.- ((four f) .* (a .* c))))) .* (myfld.reciprocal ((two f) .* a) _)) .* ((two f) .* a) ,
    exact mul_both_sides_ne f _ _ ((two f) .* a) nfa two_a_ne_zero,
  clear nfa, rename nfa_tmp nfa,
  have nfb_tmp : (x .+ (b .* (myfld.reciprocal ((two f) .* a) _))) .* ((two f) .* a) ≠ ((.- (sqroot  ((b .* b) .+ (.- ((four f) .* (a .* c)))))) .* (myfld.reciprocal ((two f) .* a) _)) .* ((two f) .* a) ,
    exact mul_both_sides_ne f _ _ ((two f) .* a) nfb two_a_ne_zero,
  clear nfb, rename nfb_tmp nfb,
  rw distrib_simp f x (b .* (myfld.reciprocal ((two f) .* a) _)) _ at nfa nfb,
  rw <- myfld.mul_assoc _ _ ((two f) .* a) at nfa nfb, rw <- myfld.mul_assoc _ _ ((two f) .* a) at nfa nfb,
  repeat {rw myfld.mul_comm (myfld.reciprocal ((two f) .* a) _) ((two f) .* a) at nfa nfb},
  repeat {rw myfld.mul_reciprocal ((two f) .* a) _ at nfa nfb},
  rw <- myfld.mul_one b at nfa nfb,
  rw <- myfld.mul_one (sqroot  ((b .* b) .+ (.- ((four f) .* (a .* c))))) at nfa,
  rw <- myfld.mul_one (.- (sqroot  ((b .* b) .+ (.- ((four f) .* (a .* c)))))) at nfb,
  clear two_a_ne_zero,

  /- Next we have to unfold the actual quadratic and transform it into a similar form as the above, but with
       square (something) ≠ (something else) .
    This is pretty much just using the method of "completing the square" that we all learned at school.-/
  unfold quadratic_subst at h,
  have h1 : ((a .* (x .* x)) .+ ((b .* x) .+ c)) .* (myfld.reciprocal a a_ne_zero)
                      = myfld.zero,
    rw h, exact mul_zero f _,
  clear h, rename h1 h,
  rw distrib_simp f _ _ _ at h,
  rw myfld.mul_comm (a .* (x .* x)) (myfld.reciprocal a a_ne_zero) at h,
  rw myfld.mul_assoc (myfld.reciprocal a a_ne_zero) a _ at h,
  rw myfld.mul_comm (myfld.reciprocal a a_ne_zero) a at h, rw myfld.mul_reciprocal a _ at h,
  rw one_mul f _ at h,
  rw distrib_simp f _ _ _ at h, rw myfld.add_assoc _ _ _ at h,
  have tmp : ((b .* x) .* (myfld.reciprocal a a_ne_zero)) =
             ((two f) .* ((myfld.reciprocal (two f) fld_not_char_two.not_char_two) .* ((b .* x) .* (myfld.reciprocal a a_ne_zero)))),
    have sub_tmp : ((two f) .* (myfld.reciprocal (two f) fld_not_char_two.not_char_two)) = myfld.one,
      exact myfld.mul_reciprocal (two f) _,
    rw myfld.mul_assoc (two f) (myfld.reciprocal (two f) _) _, rw sub_tmp, rw one_mul f _,
  rw tmp at h, clear tmp,
  rw <- myfld.mul_assoc b x _ at h, rw myfld.mul_comm x (myfld.reciprocal a a_ne_zero) at h,
  rw myfld.mul_assoc _ _ x at h, rw myfld.mul_assoc _ _ x at h, rw myfld.mul_assoc _ _ x at h,
  rw complete_the_square f x _ at h,
  rw carry_term_across f _ _ (c .* (myfld.reciprocal a a_ne_zero)) at h,
  rw simp_zero at h,
  rw carry_term_across f _ _ (.- (square f ((myfld.reciprocal (two f) fld_not_char_two.not_char_two) .* (b .* (myfld.reciprocal a a_ne_zero))))) at h,

  /- All the work that is at all interesting has been done above, the below is just a load of tedious rearranging
       to make various expressions that anyone can see are equivalent visibly equal to the computer.
     I wouldn't bother scrutinizing the below in detail unless you're having insomnia trouble.-/
  have h1 : (square f (x .+ ((myfld.reciprocal (two f) fld_not_char_two.not_char_two) .* (b .* (myfld.reciprocal a a_ne_zero))))) .* (square f ((two f) .* a)) = ((.- (c .* (myfld.reciprocal a a_ne_zero))) .+ (.- (.- (square f ((myfld.reciprocal (two f) fld_not_char_two.not_char_two) .* (b .* (myfld.reciprocal a a_ne_zero))))))) .* (square f ((two f) .* a)) ,
    have h_tmp : (square f (x .+ ((myfld.reciprocal (two f) fld_not_char_two.not_char_two) .* (b .* (myfld.reciprocal a a_ne_zero))))) .* (square f ((two f) .* a)) = (square f (x .+ ((myfld.reciprocal (two f) fld_not_char_two.not_char_two) .* (b .* (myfld.reciprocal a a_ne_zero))))) .* (square f ((two f) .* a)) ,
      refl,
    rw h at h_tmp {occs := occurrences.pos [2]}, exact h_tmp,
  clear h, rename h1 h,
  rw multiply_two_squares f _ _ at h,
  rw distrib_simp f _ _ _ at h,
  rw myfld.mul_assoc ((myfld.reciprocal (two f) fld_not_char_two.not_char_two) .* (b .* (myfld.reciprocal a a_ne_zero))) (two f) a at h,
  rw myfld.mul_comm (myfld.reciprocal (two f) fld_not_char_two.not_char_two) _ at h,
  rw <- myfld.mul_assoc _ (myfld.reciprocal (two f) fld_not_char_two.not_char_two) (two f) at h,
  rw myfld.mul_comm (myfld.reciprocal (two f) fld_not_char_two.not_char_two) (two f) at h,
  rw myfld.mul_reciprocal _ _ at h, rw simp_mul_one f _ at h,
  rw <- myfld.mul_assoc _ (myfld.reciprocal a a_ne_zero) a at h,
  rw myfld.mul_comm (myfld.reciprocal a a_ne_zero) a at h,
  rw myfld.mul_reciprocal _ _ at h, rw simp_mul_one f _ at h,

  rw double_negative f _ at h, rw distrib_simp f _ _ _ at h, rw multiply_two_squares f _ _ at h,
  have tmp : (square f ((two f) .* a)) = a .* ((four f) .* a) ,
    unfold square, unfold four, rw two_plus_two f, rw <- myfld.mul_assoc (two f) (two f) a,
    have tmp_tmp : a .* ((two f) .* ((two f) .* a)) = a .* ((two f) .* (a .* (two f))) ,
      rw myfld.mul_comm (two f) a,
    rw tmp_tmp, rw myfld.mul_comm (two f) a, repeat {rw myfld.mul_assoc _ _ _},
  rw tmp at h, clear tmp,
  rw mul_negate at h,
  rw myfld.mul_assoc (c .* (myfld.reciprocal a a_ne_zero)) a _ at h,
  rw <- myfld.mul_assoc c _ a at h, rw myfld.mul_comm (myfld.reciprocal a _) a at h,
  rw myfld.mul_reciprocal a _ at h, rw simp_mul_one f _ at h,
  rw <- myfld.mul_assoc _ (myfld.reciprocal (two f) _) _ at h,
  rw myfld.mul_assoc (myfld.reciprocal (two f) _) (two f) a at h,
  rw myfld.mul_comm (myfld.reciprocal (two f) _) (two f) at h,
  rw myfld.mul_reciprocal (two f) _ at h, rw one_mul f _ at h,
  rw <- myfld.mul_assoc b _ a at h, rw myfld.mul_comm (myfld.reciprocal a a_ne_zero) a at h,
  rw myfld.mul_reciprocal a a_ne_zero at h, rw simp_mul_one f b at h,
  have tmp : (square f b) = b .* b, unfold square,
  rw tmp at h, clear tmp,
  rw myfld.add_comm _ (b .* b) at h,
  rw myfld.mul_assoc c (four f) a at h, rw myfld.mul_comm c (four f) at h,
  rw <- myfld.mul_assoc (four f) c a at h, rw myfld.mul_comm c a at h,

  /- Having finally finished rearranging, the problem has been reduced to the question of whether
     more than two square roots of the same number can exist.
     They can't.-/
  exact only_two_square_roots f ((x .* ((two f) .* a)) .+ b) ((b .* b) .+ (.- ((four f) .* (a .* c)))) nfa nfb h,
end

/- QED.-/

lemma quadratic_factorize (f : Type) [myfld f] [fld_with_sqrt f] [fld_not_char_two f] (b c x : f)
    : (x .+ .- (quadratic_formula f myfld.one b c myfld.zero_distinct_one)) .*
        (x .+ .- (quadratic_formula_alt f myfld.one b c myfld.zero_distinct_one))
    =
    (quadratic_subst f x myfld.one b c) :=
begin
  rw distrib_simp, rw distrib_simp_alt, rw distrib_simp_alt,
  repeat {rw mul_negate, rw mul_negate_alt_simp}, rw double_negative,
  rw myfld.mul_comm (quadratic_formula f myfld.one b c _) x,
  repeat {rw <- myfld.add_assoc}, rw myfld.add_assoc (.- _) (.- _) _, rw <- add_negate,
  rw <- distrib_simp_alt,
  have tmp : (quadratic_formula f myfld.one b c myfld.zero_distinct_one) .+
             (quadratic_formula_alt f myfld.one b c myfld.zero_distinct_one) = .- b,
    unfold quadratic_formula, unfold quadratic_formula_alt,
    rw <- distrib_simp, repeat {rw <- myfld.add_assoc},
    rw reciprocal_rewrite f _ _ (simp_mul_one f _) _,
    rw one_mul_simp f,
    rw myfld.add_comm _ (.- sqroot _), rw myfld.add_assoc (sqroot _) (.- sqroot _) _,
    rw myfld.add_negate, rw simp_zero,
    rw distrib_simp, rw <- distrib_simp_alt, rw add_two_halves, rw simp_mul_one,
  rw myfld.add_comm at tmp,
  rw tmp, clear tmp,
  have clear_term : ∀ (a b x : f), a = b -> (x .+ a) = (x .+ b),
    intros a b x h, rw h,
  unfold quadratic_subst, rw one_mul_simp, apply clear_term,
  rw mul_negate_alt_simp, rw double_negative, rw myfld.mul_comm x b, apply clear_term,
  clear clear_term,
  unfold quadratic_formula, unfold quadratic_formula_alt,
  repeat {rw <- myfld.mul_assoc}, rw myfld.mul_comm (myfld.reciprocal _ _) _,
  repeat {rw myfld.mul_assoc},
  rw difference_of_squares,
  rw sqrt_squared, unfold square,
  rw mul_negate, rw mul_negate_alt_simp, rw double_negative, rw add_negate,
  rw myfld.add_assoc, rw myfld.add_negate, rw simp_zero, rw double_negative,
  rw <- myfld.mul_assoc,
  rw reciprocal_rewrite f _ _ (simp_mul_one f _) _,
  rw mul_two_reciprocals, rw myfld.mul_comm _ c,
  rw <- myfld.mul_assoc c _ _, rw simp_mul_one,
  unfold four, rw two_plus_two, rw myfld.mul_reciprocal, rw simp_mul_one,
end


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import data.fintype.units

/-!
# Some facts about finite rings

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

open_locale classical

lemma card_units_lt (M₀ : Type*) [monoid_with_zero M₀] [nontrivial M₀] [fintype M₀] :
  fintype.card M₀ˣ < fintype.card M₀ :=
fintype.card_lt_of_injective_of_not_mem (coe : M₀ˣ → M₀) units.ext not_is_unit_zero


/-
Copyright (c) 2022 Aaron Anderson. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Aaron Anderson
-/
import data.fintype.basic
import model_theory.semantics

/-!
# Quotients of First-Order Structures
This file defines prestructures and quotients of first-order structures.

## Main Definitions
* If `s` is a setoid (equivalence relation) on `M`, a `first_order.language.prestructure s` is the
data for a first-order structure on `M` that will still be a structure when modded out by `s`.
* The structure `first_order.language.quotient_structure s` is the resulting structure on
`quotient s`.

-/

namespace first_order
namespace language

variables (L : language) {M : Type*}
open_locale first_order
open Structure

/-- A prestructure is a first-order structure with a `setoid` equivalence relation on it,
  such that quotienting by that equivalence relation is still a structure. -/
class prestructure (s : setoid M) :=
(to_structure : L.Structure M)
(fun_equiv : ∀{n} {f : L.functions n} (x y : fin n → M),
  x ≈ y → fun_map f x ≈ fun_map f y)
(rel_equiv : ∀{n} {r : L.relations n} (x y : fin n → M) (h : x ≈ y),
  (rel_map r x = rel_map r y))

variables {L} {s : setoid M} [ps : L.prestructure s]

instance quotient_structure :
  L.Structure (quotient s) :=
{ fun_map := λ n f x, quotient.map (@fun_map L M ps.to_structure n f) prestructure.fun_equiv
    (quotient.fin_choice x),
  rel_map := λ n r x, quotient.lift (@rel_map L M ps.to_structure n r) prestructure.rel_equiv
    (quotient.fin_choice x) }

variables [s]
include s

lemma fun_map_quotient_mk {n : ℕ} (f : L.functions n) (x : fin n → M) :
  fun_map f (λ i, ⟦x i⟧) = ⟦@fun_map _ _ ps.to_structure _ f x⟧ :=
begin
  change quotient.map (@fun_map L M ps.to_structure n f) prestructure.fun_equiv
    (quotient.fin_choice _) = _,
  rw [quotient.fin_choice_eq, quotient.map_mk],
end

lemma rel_map_quotient_mk {n : ℕ} (r : L.relations n) (x : fin n → M) :
  rel_map r (λ i, ⟦x i⟧) ↔ @rel_map _ _ ps.to_structure _ r x :=
begin
  change quotient.lift (@rel_map L M ps.to_structure n r) prestructure.rel_equiv
    (quotient.fin_choice _) ↔ _,
  rw [quotient.fin_choice_eq, quotient.lift_mk],
end

lemma term.realize_quotient_mk {β : Type*} (t : L.term β) (x : β → M)  :
  t.realize (λ i, ⟦x i⟧) = ⟦@term.realize _ _ ps.to_structure _ x t⟧ :=
begin
  induction t with _ _ _ _ ih,
  { refl },
  { simp only [ih, fun_map_quotient_mk, term.realize] },
end

end language
end first_order


import game.max.level02 -- hide

open_locale classical -- hide

noncomputable theory -- hide

namespace xena -- hide

/-
# Chapter 4 : Max and abs

## Level 3

`le_max_left` is the statement that `a ≤ max a b`.

Technical note: in contrast to the natural number game, the `rw` used
in the real number game is Lean's more powerful `rw`, which automatically
tries `refl` after a rewrite; note that `≤` is reflexive, so `refl` will
close a goal of the form `a ≤ a`.
-/

/- Lemma
For any real numbers $a$ and $b$, we have $a\leq\max(a,b).$
-/
theorem le_max_left (a b : ℝ) : a ≤ max a b :=
begin
  cases le_total a b with hab hba,
  rw max_eq_right hab,
  exact hab,
  rw max_eq_left hba,

end

end xena --hide


import data.real.basic data.set.intervals.basic

open set

/-
  Continuous function
  A function f(x) is said to be continuous at x = a if, for any ε > 0,
  there is δ > 0 s.t. |f(x) - f(a)| < ε whenever |x - a| < δ
-/

def continuous_at (f : ℝ → ℝ) (a : ℝ) :=
  ∀ ε > 0, ∃ δ > 0, ∀ x, abs (x - a) < δ → abs (f x - f a) < ε

theorem continuous_function_about_an_open_interval {f a}
  (hcont : continuous_at f a) (hgt : f a > 0) :
  ∃ b c : ℝ, a ∈ Ioo b c ∧ ∀ x ∈ Ioo b c, f x > 0 :=
begin
    specialize hcont ((f a) / 2) (half_pos hgt),
    rcases hcont with ⟨δ, δ_pos, hδ⟩,
    use [a - δ, a + δ],
    split,
        {
            split; linarith,
        },
        {
            intros x x_in,
            cases x_in with gt lt,
            have key : abs (x - a) < δ,
                rw abs_sub_lt_iff,
                split; linarith,
            specialize hδ x key,
            have key2 : f x > f a - f a / 2,
                by exact sub_lt_of_abs_sub_lt_left hδ,
            linarith,
        }
end


set_option pp.rawOnError true

theorem ex1 (f : Nat → Nat) (x : Nat) (h1 : (x : Nat) → x > 0 → f x = x) (h2 : x > 0) : f x = x := by
  exact h1 _ _

theorem ex2 (f : Nat → Nat) (x : Nat) (h1 : (x : Nat) → x > 0 → f x = x) (h2 : x > 0) : f x = x := by
  refine h1 _ _

theorem ex3 (f : Nat → Nat) (x : Nat) (h1 : (x : Nat) → x > 0 → f x = x) (h2 : x > 0) : f x = x := by
  first | exact h1 _ _ | apply h1
  assumption

theorem ex4 (f : Nat → Nat) (x : Nat) (h1 : (x : Nat) → x > 0 → f x = x) (h2 : x > 0) : f x = x := by
  first | refine h1 _ _ | apply h1
  assumption

theorem ex5 (f g : Nat → Nat) (x : Nat) (h1 : (x : Nat) → x > 0 → f x = x) (h2 : x > 0) (h3 : g x = x) : f x = x := by
  first | apply h3 | apply h1
  assumption

theorem ex6 (f : Nat → Nat) (x : Nat) (h1 : (x : Nat) → x > 0 → f x = x) (h2 : x > 0) : f x = x := by
  first | refine h1 _ _ | refine h1 _ _
  assumption


import ring_theory.ideal_operations
import data.equiv.algebra

universes u v

namespace ideal

variable {α : Type u}
variable [comm_ring α]

lemma eq_bot (I : ideal α) : I = ⊥ ↔ ∀ x : α, x ∈ I → x = 0 :=
begin
  rw [lattice.eq_bot_iff, submodule.le_def],
  apply forall_congr,
  intro x,
  apply imp_congr_right,
  intro h,
  exact submodule.mem_bot
end

lemma bot_ne_top {α : Type u} [nonzero_comm_ring α] : (⊥ : ideal α) ≠ (⊤ : ideal α) :=
by rw[ideal.ne_top_iff_one, submodule.mem_bot]; exact one_ne_zero

lemma mem_of_not_bot (I : ideal α) : I ≠ (⊥ : ideal α) → ∃ x ∈ I, (x : α) ≠ 0 :=
assume h : I ≠ ⊥,
have ¬ (∀ x : α, x ∈ I → x = 0), by rw ←eq_bot; assumption,
have ∃ x : α, ¬ (x ∈ I → x = 0), from classical.not_forall.mp this,
let ⟨x, h₁⟩ := this in
have x ∈ I, from classical.not_not.mp (not_not_of_not_imp h₁),
have x ≠ 0, from not_of_not_imp h₁,
show ∃ x ∈ I, (x : α) ≠ 0, from ⟨x, ‹x ∈ I›, ‹x ≠ 0›⟩

instance bot_is_prime {α : Type u} [integral_domain α] :
is_prime (⊥ : ideal α) :=
begin
apply and.intro bot_ne_top,
intros x y h,
repeat {rw[submodule.mem_bot]},
exact no_zero_divisors.eq_zero_or_eq_zero_of_mul_eq_zero x y
  (submodule.mem_bot.mp h)
end

end ideal

namespace is_ring_hom

open function ideal ideal.quotient

variables {α : Type u} {β : Type v}
variables [comm_ring α] [comm_ring β]

def ker (f : α → β) [is_ring_hom f] : ideal α := comap f ⊥
variables {f : α → β} [is_ring_hom f]

lemma mem_ker {x : α} : x ∈ ker f ↔ f x = 0 :=
submodule.mem_bot

theorem ker_eq_bot : ker f = ⊥ ↔ injective f :=
begin
  rw [is_add_group_hom.injective_iff f, eq_bot],
  apply forall_congr,
  intro,
  rw mem_ker,
end

lemma le_ker {I : ideal α} : I ≤ ker f ↔ ∀ x : α, x ∈ I → f x = 0 :=
begin
  apply forall_congr,
  intro x,
  apply imp_congr_right,
  intro h,
  exact mem_ker
end

variable {I : ideal α}

lemma map_mk_eq_bot : map_mk I I = ⊥ :=
suffices ∀ x : quotient I, x ∈ map_mk I I → x = 0, from (eq_bot (map_mk I I)).mpr this,
assume x : quotient I,
assume hx : x ∈ map_mk I I,
have ∃ y : α, y ∈ I ∧ ideal.quotient.mk I y = x,
  from (set.mem_image (ideal.quotient.mk I) I x).mp hx,
let ⟨y, hy, heq⟩ := this in
have y - 0 ∈ I, from eq.symm (sub_zero y) ▸ hy,
have x = ideal.quotient.mk I 0, from heq ▸ ideal.quotient.eq.mpr this,
show x = 0, from eq.symm this ▸ mk_zero I

/-- The homomorphism theorem for rings --/
def factor (f : α → β) [is_ring_hom f] (I : ideal α) (h : I ≤ ker f) : quotient I → β :=
lift I f (le_ker.mp h)

lemma factor_to_ring_hom' {h : I ≤ ker f} : is_ring_hom (factor f I h) :=
ideal.quotient.is_ring_hom

instance factor_to_ring_hom {h : I ≤ ker f} : is_ring_hom (factor f I h) :=
ideal.quotient.is_ring_hom

theorem factor_commutes (h : I ≤ ker f) {x : α} :
                        (factor f I h) (ideal.quotient.mk I x) = f x :=
lift_mk

lemma ker_factor (h : I ≤ ker f) : ker (factor f I h) = map_mk I (ker f) :=
suffices ∀ x : quotient I, x ∈ ker (factor f I h) ↔ x ∈ map_mk I (ker f),
  from ext this,
assume x : quotient I,
suffices ∀ y : α, ideal.quotient.mk I y ∈ ker (factor f I h) ↔ ideal.quotient.mk I y ∈ map_mk I (ker f),
  from quotient.induction_on' x this,
assume y : α,
suffices y ∈ ker f ↔ ideal.quotient.mk I y ∈ map_mk I (ker f),
  by rw [mem_ker, factor_commutes h]; rw mem_ker at this; assumption,
iff.intro
  (assume h0 : y ∈ ker f,
   show ideal.quotient.mk I y ∈ map_mk I (ker f),
     from set.mem_image_of_mem (ideal.quotient.mk I) h0)
  (assume h0 : ideal.quotient.mk I y ∈ map_mk I (ker f),
   have ∃ y' : α, y' ∈ ker f ∧ ideal.quotient.mk I y' = ideal.quotient.mk I y,
     from (set.mem_image (ideal.quotient.mk I) (ker f) (ideal.quotient.mk I y)).mp h0,
   let ⟨y', hy', heq⟩ := this in
   have y - y' ∈ I, from ideal.quotient.eq.mp (eq.symm heq),
   have y - y' ∈ ker f, from h this,
   show y ∈ ker f, from sub_add_cancel y y' ▸ (ker f).add this hy')

/-- The first isomorphism theorem for rings --/
theorem factor_injective : injective (factor f (ker f) (le_refl (ker f))) :=
begin
  apply ker_eq_bot.mp,
  rw ker_factor,
  exact map_mk_eq_bot
end

theorem factor_surjective (h : I ≤ ker f) (hf : surjective f) : surjective (factor f I h) :=
assume y : β,
have ∃ x : α, f x = y, from hf y,
let ⟨x, hfx⟩ := this in
have (factor f I h) (ideal.quotient.mk I x) = y, from hfx ▸ factor_commutes h,
show ∃ x' : quotient I, (factor f I h) x' = y, from ⟨ideal.quotient.mk I x, this⟩

theorem factor_bijective (hf : surjective f) :
  bijective (factor f (ker f) (le_refl (ker f))) :=
⟨factor_injective, factor_surjective (le_refl (ker f)) hf⟩

noncomputable theorem factor_iso (hf : surjective f) : quotient (ker f) ≃r β :=
ring_equiv.mk (equiv.of_bijective (factor_bijective hf)) factor_to_ring_hom'

end is_ring_hom


/-
Copyright (c) 2015 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura, Johannes Hölzl, Mario Carneiro
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.int.basic
import Mathlib.PostPort

namespace Mathlib

/-!
# Square root of natural numbers

An efficient binary implementation of a (`sqrt n`) function that
returns `s` such that
```
s*s ≤ n ≤ s*s + s + s
```
-/

namespace nat

theorem sqrt_aux_dec {b : ℕ} (h : b ≠ 0) : shiftr b (bit0 1) < b := sorry

/-- Auxiliary function for `nat.sqrt`. See e.g.
<https://en.wikipedia.org/wiki/Methods_of_computing_square_roots#Binary_numeral_system_(base_2)> -/
def sqrt_aux : ℕ → ℕ → ℕ → ℕ := sorry

/-- `sqrt n` is the square root of a natural number `n`. If `n` is not a
  perfect square, it returns the largest `k:ℕ` such that `k*k ≤ n`. -/
def sqrt (n : ℕ) : ℕ := sorry

theorem sqrt_aux_0 (r : ℕ) (n : ℕ) : sqrt_aux 0 r n = r := sorry

theorem sqrt_aux_1 {r : ℕ} {n : ℕ} {b : ℕ} (h : b ≠ 0) {n' : ℕ} (h₂ : r + b + n' = n) :
    sqrt_aux b r n = sqrt_aux (shiftr b (bit0 1)) (div2 r + b) n' :=
  sorry

theorem sqrt_aux_2 {r : ℕ} {n : ℕ} {b : ℕ} (h : b ≠ 0) (h₂ : n < r + b) :
    sqrt_aux b r n = sqrt_aux (shiftr b (bit0 1)) (div2 r) n :=
  sorry

theorem sqrt_le (n : ℕ) : sqrt n * sqrt n ≤ n := and.left (sqrt_is_sqrt n)

theorem lt_succ_sqrt (n : ℕ) : n < Nat.succ (sqrt n) * Nat.succ (sqrt n) :=
  and.right (sqrt_is_sqrt n)

theorem sqrt_le_add (n : ℕ) : n ≤ sqrt n * sqrt n + sqrt n + sqrt n :=
  eq.mpr
    (id
      (Eq._oldrec (Eq.refl (n ≤ sqrt n * sqrt n + sqrt n + sqrt n))
        (Eq.symm (succ_mul (sqrt n) (sqrt n)))))
    (le_of_lt_succ (lt_succ_sqrt n))

theorem le_sqrt {m : ℕ} {n : ℕ} : m ≤ sqrt n ↔ m * m ≤ n :=
  { mp := fun (h : m ≤ sqrt n) => le_trans (mul_self_le_mul_self h) (sqrt_le n),
    mpr :=
      fun (h : m * m ≤ n) =>
        le_of_lt_succ (iff.mpr mul_self_lt_mul_self_iff (lt_of_le_of_lt h (lt_succ_sqrt n))) }

theorem sqrt_lt {m : ℕ} {n : ℕ} : sqrt m < n ↔ m < n * n := lt_iff_lt_of_le_iff_le le_sqrt

theorem sqrt_le_self (n : ℕ) : sqrt n ≤ n := le_trans (le_mul_self (sqrt n)) (sqrt_le n)

theorem sqrt_le_sqrt {m : ℕ} {n : ℕ} (h : m ≤ n) : sqrt m ≤ sqrt n :=
  iff.mpr le_sqrt (le_trans (sqrt_le m) h)

theorem sqrt_eq_zero {n : ℕ} : sqrt n = 0 ↔ n = 0 := sorry

theorem eq_sqrt {n : ℕ} {q : ℕ} : q = sqrt n ↔ q * q ≤ n ∧ n < (q + 1) * (q + 1) := sorry

theorem le_three_of_sqrt_eq_one {n : ℕ} (h : sqrt n = 1) : n ≤ bit1 1 :=
  le_of_lt_succ
    (iff.mp sqrt_lt (eq.mpr (id (Eq._oldrec (Eq.refl (sqrt n < bit0 1)) h)) (of_as_true trivial)))

theorem sqrt_lt_self {n : ℕ} (h : 1 < n) : sqrt n < n :=
  iff.mpr sqrt_lt
    (eq.mp (Eq._oldrec (Eq.refl (n * 1 < n * n)) (mul_one n))
      (nat.mul_lt_mul_of_pos_left h (lt_of_succ_lt h)))

theorem sqrt_pos {n : ℕ} : 0 < sqrt n ↔ 0 < n := le_sqrt

theorem sqrt_add_eq (n : ℕ) {a : ℕ} (h : a ≤ n + n) : sqrt (n * n + a) = n := sorry

theorem sqrt_eq (n : ℕ) : sqrt (n * n) = n := sqrt_add_eq n (zero_le (n + n))

theorem sqrt_succ_le_succ_sqrt (n : ℕ) : sqrt (Nat.succ n) ≤ Nat.succ (sqrt n) := sorry

theorem exists_mul_self (x : ℕ) : (∃ (n : ℕ), n * n = x) ↔ sqrt x * sqrt x = x := sorry

theorem sqrt_mul_sqrt_lt_succ (n : ℕ) : sqrt n * sqrt n < n + 1 := iff.mpr lt_succ_iff (sqrt_le n)

theorem succ_le_succ_sqrt (n : ℕ) : n + 1 ≤ (sqrt n + 1) * (sqrt n + 1) :=
  le_of_pred_lt (lt_succ_sqrt (Nat.pred (n + 1)))

/-- There are no perfect squares strictly between m² and (m+1)² -/
theorem not_exists_sq {n : ℕ} {m : ℕ} (hl : m * m < n) (hr : n < (m + 1) * (m + 1)) :
    ¬∃ (t : ℕ), t * t = n :=
  sorry

end Mathlib


/-
Copyright (c) 2018 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Jens Wagemaker
-/
import data.multiset.basic
import algebra.divisibility
import algebra.invertible

/-!
# Associated, prime, and irreducible elements.
-/

variables {α : Type*} {β : Type*} {γ : Type*} {δ : Type*}

theorem is_unit_iff_dvd_one [comm_monoid α] {x : α} : is_unit x ↔ x ∣ 1 :=
⟨by rintro ⟨u, rfl⟩; exact ⟨_, u.mul_inv.symm⟩,
 λ ⟨y, h⟩, ⟨⟨x, y, h.symm, by rw [h, mul_comm]⟩, rfl⟩⟩

theorem is_unit_iff_forall_dvd [comm_monoid α] {x : α} :
  is_unit x ↔ ∀ y, x ∣ y :=
is_unit_iff_dvd_one.trans ⟨λ h y, dvd.trans h (one_dvd _), λ h, h _⟩

theorem is_unit_of_dvd_unit {α} [comm_monoid α] {x y : α}
  (xy : x ∣ y) (hu : is_unit y) : is_unit x :=
is_unit_iff_dvd_one.2 $ dvd_trans xy $ is_unit_iff_dvd_one.1 hu

lemma is_unit_of_dvd_one [comm_monoid α] : ∀a ∣ 1, is_unit (a:α)
| a ⟨b, eq⟩ := ⟨units.mk_of_mul_eq_one a b eq.symm, rfl⟩

lemma dvd_and_not_dvd_iff [comm_cancel_monoid_with_zero α] {x y : α} :
  x ∣ y ∧ ¬y ∣ x ↔ dvd_not_unit x y :=
⟨λ ⟨⟨d, hd⟩, hyx⟩, ⟨λ hx0, by simpa [hx0] using hyx, ⟨d,
    mt is_unit_iff_dvd_one.1 (λ ⟨e, he⟩, hyx ⟨e, by rw [hd, mul_assoc, ← he, mul_one]⟩), hd⟩⟩,
  λ ⟨hx0, d, hdu, hdx⟩, ⟨⟨d, hdx⟩, λ ⟨e, he⟩, hdu (is_unit_of_dvd_one _
    ⟨e, mul_left_cancel' hx0 $ by conv {to_lhs, rw [he, hdx]};simp [mul_assoc]⟩)⟩⟩

lemma pow_dvd_pow_iff [comm_cancel_monoid_with_zero α]
  {x : α} {n m : ℕ} (h0 : x ≠ 0) (h1 : ¬ is_unit x) :
  x ^ n ∣ x ^ m ↔ n ≤ m :=
begin
  split,
  { intro h, rw [← not_lt], intro hmn, apply h1,
    have : x ^ m * x ∣ x ^ m * 1,
    { rw [← pow_succ', mul_one], exact dvd_trans (pow_dvd_pow _ (nat.succ_le_of_lt hmn)) h },
    rwa [mul_dvd_mul_iff_left, ← is_unit_iff_dvd_one] at this, apply pow_ne_zero m h0 },
  { apply pow_dvd_pow }
end

section prime
variables [comm_monoid_with_zero α]

/-- prime element of a `comm_monoid_with_zero` -/
def prime (p : α) : Prop :=
p ≠ 0 ∧ ¬ is_unit p ∧ (∀a b, p ∣ a * b → p ∣ a ∨ p ∣ b)

namespace prime
variables {p : α} (hp : prime p)

lemma ne_zero (hp : prime p) : p ≠ 0 :=
hp.1

lemma not_unit (hp : prime p) : ¬ is_unit p :=
hp.2.1

lemma ne_one (hp : prime p) : p ≠ 1 :=
λ h, hp.2.1 (h.symm ▸ is_unit_one)

lemma div_or_div (hp : prime p) {a b : α} (h : p ∣ a * b) :
  p ∣ a ∨ p ∣ b :=
hp.2.2 a b h

lemma dvd_of_dvd_pow (hp : prime p) {a : α} {n : ℕ} (h : p ∣ a^n) :
  p ∣ a :=
begin
  induction n with n ih,
  { rw pow_zero at h,
    have := is_unit_of_dvd_one _ h,
    have := not_unit hp,
    contradiction },
  rw pow_succ at h,
  cases div_or_div hp h with dvd_a dvd_pow,
  { assumption },
  exact ih dvd_pow
end

end prime

@[simp] lemma not_prime_zero : ¬ prime (0 : α) :=
λ h, h.ne_zero rfl

@[simp] lemma not_prime_one : ¬ prime (1 : α) :=
λ h, h.not_unit is_unit_one

lemma exists_mem_multiset_dvd_of_prime {s : multiset α} {p : α} (hp : prime p) :
  p ∣ s.prod → ∃a∈s, p ∣ a :=
multiset.induction_on s (assume h, (hp.not_unit $ is_unit_of_dvd_one _ h).elim) $
assume a s ih h,
  have p ∣ a * s.prod, by simpa using h,
  match hp.div_or_div this with
  | or.inl h := ⟨a, multiset.mem_cons_self a s, h⟩
  | or.inr h := let ⟨a, has, h⟩ := ih h in ⟨a, multiset.mem_cons_of_mem has, h⟩
  end

end prime

lemma left_dvd_or_dvd_right_of_dvd_prime_mul [comm_cancel_monoid_with_zero α] {a : α} :
  ∀ {b p : α}, prime p → a ∣ p * b → p ∣ a ∨ a ∣ b :=
begin
  rintros b p hp ⟨c, hc⟩,
  rcases hp.2.2 a c (hc ▸ dvd_mul_right _ _) with h | ⟨x, rfl⟩,
  { exact or.inl h },
  { rw [mul_left_comm, mul_right_inj' hp.ne_zero] at hc,
    exact or.inr (hc.symm ▸ dvd_mul_right _ _) }
end

/-- `irreducible p` states that `p` is non-unit and only factors into units.

We explicitly avoid stating that `p` is non-zero, this would require a semiring. Assuming only a
monoid allows us to reuse irreducible for associated elements.
-/
class irreducible [monoid α] (p : α) : Prop :=
(not_unit' : ¬ is_unit p)
(is_unit_or_is_unit' : ∀a b, p = a * b → is_unit a ∨ is_unit b)

namespace irreducible

lemma not_unit [monoid α] {p : α} (hp : irreducible p) : ¬ is_unit p :=
hp.1

lemma is_unit_or_is_unit [monoid α] {p : α} (hp : irreducible p) {a b : α} (h : p = a * b) :
  is_unit a ∨ is_unit b :=
irreducible.is_unit_or_is_unit' a b h

end irreducible

lemma irreducible_iff [monoid α] {p : α} :
  irreducible p ↔ ¬ is_unit p ∧ ∀a b, p = a * b → is_unit a ∨ is_unit b :=
⟨λ h, ⟨h.1, h.2⟩, λ h, ⟨h.1, h.2⟩⟩

@[simp] theorem not_irreducible_one [monoid α] : ¬ irreducible (1 : α) :=
by simp [irreducible_iff]

@[simp] theorem not_irreducible_zero [monoid_with_zero α] : ¬ irreducible (0 : α)
| ⟨hn0, h⟩ := have is_unit (0:α) ∨ is_unit (0:α), from h 0 0 ((mul_zero 0).symm),
  this.elim hn0 hn0

theorem irreducible.ne_zero [monoid_with_zero α] : ∀ {p:α}, irreducible p → p ≠ 0
| _ hp rfl := not_irreducible_zero hp

theorem of_irreducible_mul {α} [monoid α] {x y : α} :
  irreducible (x * y) → is_unit x ∨ is_unit y
| ⟨_, h⟩ := h _ _ rfl

theorem irreducible_or_factor {α} [monoid α] (x : α) (h : ¬ is_unit x) :
  irreducible x ∨ ∃ a b, ¬ is_unit a ∧ ¬ is_unit b ∧ a * b = x :=
begin
  haveI := classical.dec,
  refine or_iff_not_imp_right.2 (λ H, _),
  simp [h, irreducible_iff] at H ⊢,
  refine λ a b h, classical.by_contradiction $ λ o, _,
  simp [not_or_distrib] at o,
  exact H _ o.1 _ o.2 h.symm
end

lemma irreducible_of_prime [comm_cancel_monoid_with_zero α] {p : α} (hp : prime p) :
  irreducible p :=
⟨hp.not_unit, λ a b hab,
  (show a * b ∣ a ∨ a * b ∣ b, from hab ▸ hp.div_or_div (hab ▸ (dvd_refl _))).elim
    (λ ⟨x, hx⟩, or.inr (is_unit_iff_dvd_one.2
      ⟨x, mul_right_cancel' (show a ≠ 0, from λ h, by simp [*, prime] at *)
        $ by conv {to_lhs, rw hx}; simp [mul_comm, mul_assoc, mul_left_comm]⟩))
    (λ ⟨x, hx⟩, or.inl (is_unit_iff_dvd_one.2
      ⟨x, mul_right_cancel' (show b ≠ 0, from λ h, by simp [*, prime] at *)
        $ by conv {to_lhs, rw hx}; simp [mul_comm, mul_assoc, mul_left_comm]⟩))⟩

lemma succ_dvd_or_succ_dvd_of_succ_sum_dvd_mul [comm_cancel_monoid_with_zero α]
  {p : α} (hp : prime p) {a b : α} {k l : ℕ} :
  p ^ k ∣ a → p ^ l ∣ b → p ^ ((k + l) + 1) ∣ a * b → p ^ (k + 1) ∣ a ∨ p ^ (l + 1) ∣ b :=
λ ⟨x, hx⟩ ⟨y, hy⟩ ⟨z, hz⟩,
have h : p ^ (k + l) * (x * y) = p ^ (k + l) * (p * z),
  by simpa [mul_comm, pow_add, hx, hy, mul_assoc, mul_left_comm] using hz,
have hp0: p ^ (k + l) ≠ 0, from pow_ne_zero _ hp.ne_zero,
have hpd : p ∣ x * y, from ⟨z, by rwa [mul_right_inj' hp0] at h⟩,
(hp.div_or_div hpd).elim
  (λ ⟨d, hd⟩, or.inl ⟨d, by simp [*, pow_succ, mul_comm, mul_left_comm, mul_assoc]⟩)
  (λ ⟨d, hd⟩, or.inr ⟨d, by simp [*, pow_succ, mul_comm, mul_left_comm, mul_assoc]⟩)

/-- If `p` and `q` are irreducible, then `p ∣ q` implies `q ∣ p`. -/
lemma dvd_symm_of_irreducible [monoid α] {p q : α}
  (hp : irreducible p) (hq : irreducible q) : p ∣ q → q ∣ p :=
begin
  tactic.unfreeze_local_instances,
  rintros ⟨q', rfl⟩,
  rw is_unit.mul_right_dvd (or.resolve_left (of_irreducible_mul hq) hp.not_unit),
end

lemma dvd_symm_iff_of_irreducible [monoid α] {p q : α}
  (hp : irreducible p) (hq : irreducible q) : p ∣ q ↔ q ∣ p :=
⟨dvd_symm_of_irreducible hp hq, dvd_symm_of_irreducible hq hp⟩

/-- Two elements of a `monoid` are `associated` if one of them is another one
multiplied by a unit on the right. -/
def associated [monoid α] (x y : α) : Prop := ∃u:units α, x * u = y

local infix ` ~ᵤ ` : 50 := associated

namespace associated

@[refl] protected theorem refl [monoid α] (x : α) : x ~ᵤ x := ⟨1, by simp⟩

@[symm] protected theorem symm [monoid α] : ∀{x y : α}, x ~ᵤ y → y ~ᵤ x
| x _ ⟨u, rfl⟩ := ⟨u⁻¹, by rw [mul_assoc, units.mul_inv, mul_one]⟩

@[trans] protected theorem trans [monoid α] : ∀{x y z : α}, x ~ᵤ y → y ~ᵤ z → x ~ᵤ z
| x _ _ ⟨u, rfl⟩ ⟨v, rfl⟩ := ⟨u * v, by rw [units.coe_mul, mul_assoc]⟩

/-- The setoid of the relation `x ~ᵤ y` iff there is a unit `u` such that `x * u = y` -/
protected def setoid (α : Type*) [monoid α] : setoid α :=
{ r := associated, iseqv := ⟨associated.refl, λa b, associated.symm, λa b c, associated.trans⟩ }

end associated

local attribute [instance] associated.setoid

theorem unit_associated_one [monoid α] {u : units α} : (u : α) ~ᵤ 1 := ⟨u⁻¹, units.mul_inv u⟩

theorem associated_one_iff_is_unit [monoid α] {a : α} : (a : α) ~ᵤ 1 ↔ is_unit a :=
iff.intro
  (assume h, let ⟨c, h⟩ := h.symm in h ▸ ⟨c, (one_mul _).symm⟩)
  (assume ⟨c, h⟩, associated.symm ⟨c, by simp [h]⟩)

theorem associated_zero_iff_eq_zero [monoid_with_zero α] (a : α) : a ~ᵤ 0 ↔ a = 0 :=
iff.intro
  (assume h, let ⟨u, h⟩ := h.symm in by simpa using h.symm)
  (assume h, h ▸ associated.refl a)

theorem associated_one_of_mul_eq_one [comm_monoid α] {a : α} (b : α) (hab : a * b = 1) : a ~ᵤ 1 :=
show (units.mk_of_mul_eq_one a b hab : α) ~ᵤ 1, from unit_associated_one

theorem associated_one_of_associated_mul_one [comm_monoid α] {a b : α} :
  a * b ~ᵤ 1 → a ~ᵤ 1
| ⟨u, h⟩ := associated_one_of_mul_eq_one (b * u) $ by simpa [mul_assoc] using h

lemma associated_mul_mul [comm_monoid α] {a₁ a₂ b₁ b₂ : α} :
  a₁ ~ᵤ b₁ → a₂ ~ᵤ b₂ → (a₁ * a₂) ~ᵤ (b₁ * b₂)
| ⟨c₁, h₁⟩ ⟨c₂, h₂⟩ := ⟨c₁ * c₂, by simp [h₁.symm, h₂.symm, mul_assoc, mul_comm, mul_left_comm]⟩

lemma associated_pow_pow [comm_monoid α] {a b : α} {n : ℕ} (h : a ~ᵤ b) :
  a ^ n ~ᵤ b ^ n :=
begin
  induction n with n ih, { simp [h] },
  convert associated_mul_mul h ih;
  rw pow_succ
end

lemma dvd_of_associated [monoid α] {a b : α} : a ~ᵤ b → a ∣ b := λ ⟨u, hu⟩, ⟨u, hu.symm⟩

lemma dvd_dvd_of_associated [monoid α] {a b : α} (h : a ~ᵤ b) : a ∣ b ∧ b ∣ a :=
⟨dvd_of_associated h, dvd_of_associated h.symm⟩

theorem associated_of_dvd_dvd [cancel_monoid_with_zero α]
  {a b : α} (hab : a ∣ b) (hba : b ∣ a) : a ~ᵤ b :=
begin
  rcases hab with ⟨c, rfl⟩,
  rcases hba with ⟨d, a_eq⟩,
  by_cases ha0 : a = 0,
  { simp [*] at * },
  have hac0 : a * c ≠ 0,
  { intro con, rw [con, zero_mul] at a_eq, apply ha0 a_eq, },
  have : a * (c * d) =  a * 1 := by rw [← mul_assoc, ← a_eq, mul_one],
  have hcd : (c * d) = 1, from mul_left_cancel' ha0 this,
  have : a * c * (d * c) = a * c * 1 := by rw [← mul_assoc, ← a_eq, mul_one],
  have hdc : d * c = 1, from mul_left_cancel' hac0 this,
  exact ⟨⟨c, d, hcd, hdc⟩, rfl⟩
end

theorem dvd_dvd_iff_associated [cancel_monoid_with_zero α] {a b : α} : a ∣ b ∧ b ∣ a ↔ a ~ᵤ b :=
⟨λ ⟨h1, h2⟩, associated_of_dvd_dvd h1 h2, dvd_dvd_of_associated⟩

lemma exists_associated_mem_of_dvd_prod [comm_cancel_monoid_with_zero α] {p : α}
  (hp : prime p) {s : multiset α} : (∀ r ∈ s, prime r) → p ∣ s.prod → ∃ q ∈ s, p ~ᵤ q :=
multiset.induction_on s (by simp [mt is_unit_iff_dvd_one.2 hp.not_unit])
  (λ a s ih hs hps, begin
    rw [multiset.prod_cons] at hps,
    cases hp.div_or_div hps with h h,
    { use [a, by simp],
      cases h with u hu,
      cases ((irreducible_of_prime (hs a (multiset.mem_cons.2
        (or.inl rfl)))).is_unit_or_is_unit hu).resolve_left hp.not_unit with v hv,
      exact ⟨v, by simp [hu, hv]⟩ },
    { rcases ih (λ r hr, hs _ (multiset.mem_cons.2 (or.inr hr))) h with ⟨q, hq₁, hq₂⟩,
      exact ⟨q, multiset.mem_cons.2 (or.inr hq₁), hq₂⟩ }
  end)

lemma dvd_iff_dvd_of_rel_left [comm_monoid_with_zero α] {a b c : α} (h : a ~ᵤ b) : a ∣ c ↔ b ∣ c :=
let ⟨u, hu⟩ := h in hu ▸ units.mul_right_dvd.symm

lemma dvd_iff_dvd_of_rel_right [comm_monoid_with_zero α] {a b c : α} (h : b ~ᵤ c) : a ∣ b ↔ a ∣ c :=
let ⟨u, hu⟩ := h in hu ▸ units.dvd_mul_right.symm

lemma eq_zero_iff_of_associated [comm_monoid_with_zero α] {a b : α} (h : a ~ᵤ b) : a = 0 ↔ b = 0 :=
⟨λ ha, let ⟨u, hu⟩ := h in by simp [hu.symm, ha],
  λ hb, let ⟨u, hu⟩ := h.symm in by simp [hu.symm, hb]⟩

lemma ne_zero_iff_of_associated [comm_monoid_with_zero α] {a b : α} (h : a ~ᵤ b) : a ≠ 0 ↔ b ≠ 0 :=
by haveI := classical.dec; exact not_iff_not.2 (eq_zero_iff_of_associated h)

lemma prime_of_associated [comm_monoid_with_zero α] {p q : α} (h : p ~ᵤ q) (hp : prime p) :
  prime q :=
⟨(ne_zero_iff_of_associated h).1 hp.ne_zero,
  let ⟨u, hu⟩ := h in
    ⟨λ ⟨v, hv⟩, hp.not_unit ⟨v * u⁻¹, by simp [hv, hu.symm]⟩,
      hu ▸ by { simp [units.mul_right_dvd], intros a b, exact hp.div_or_div }⟩⟩

lemma associated_of_irreducible_of_dvd [comm_cancel_monoid_with_zero α] {p q : α}
  (p_irr : irreducible p) (q_irr : irreducible q) (dvd : p ∣ q) : associated p q :=
associated_of_dvd_dvd dvd (dvd_symm_of_irreducible p_irr q_irr dvd)

lemma associated_of_prime_of_dvd [comm_cancel_monoid_with_zero α] {p q : α}
  (p_prime : prime p) (q_prime : prime q) (dvd : p ∣ q) : associated p q :=
associated_of_irreducible_of_dvd (irreducible_of_prime p_prime) (irreducible_of_prime q_prime) dvd

lemma prime_iff_of_associated [comm_monoid_with_zero α] {p q : α}
  (h : p ~ᵤ q) : prime p ↔ prime q :=
⟨prime_of_associated h, prime_of_associated h.symm⟩

lemma is_unit_iff_of_associated [monoid α] {a b : α} (h :  a ~ᵤ b) : is_unit a ↔ is_unit b :=
⟨let ⟨u, hu⟩ := h in λ ⟨v, hv⟩, ⟨v * u, by simp [hv, hu.symm]⟩,
  let ⟨u, hu⟩ := h.symm in λ ⟨v, hv⟩, ⟨v * u, by simp [hv, hu.symm]⟩⟩

lemma irreducible_of_associated [comm_monoid_with_zero α] {p q : α} (h : p ~ᵤ q)
  (hp : irreducible p) : irreducible q :=
⟨mt (is_unit_iff_of_associated h).2 hp.1,
  let ⟨u, hu⟩ := h in λ a b hab,
  have hpab : p = a * (b * (u⁻¹ : units α)),
    from calc p = (p * u) * (u ⁻¹ : units α) : by simp
      ... = _ : by rw hu; simp [hab, mul_assoc],
  (hp.is_unit_or_is_unit hpab).elim or.inl (λ ⟨v, hv⟩, or.inr ⟨v * u, by simp [hv]⟩)⟩

lemma irreducible_iff_of_associated [comm_monoid_with_zero α] {p q : α} (h : p ~ᵤ q) :
  irreducible p ↔ irreducible q :=
⟨irreducible_of_associated h, irreducible_of_associated h.symm⟩

lemma associated_mul_left_cancel [comm_cancel_monoid_with_zero α] {a b c d : α}
(h : a * b ~ᵤ c * d) (h₁ : a ~ᵤ c) (ha : a ≠ 0) : b ~ᵤ d :=
let ⟨u, hu⟩ := h in let ⟨v, hv⟩ := associated.symm h₁ in
⟨u * (v : units α), mul_left_cancel' ha
  begin
    rw [← hv, mul_assoc c (v : α) d, mul_left_comm c, ← hu],
    simp [hv.symm, mul_assoc, mul_comm, mul_left_comm]
  end⟩

lemma associated_mul_right_cancel [comm_cancel_monoid_with_zero α] {a b c d : α} :
  a * b ~ᵤ c * d → b ~ᵤ d → b ≠ 0 → a ~ᵤ c :=
by rw [mul_comm a, mul_comm c]; exact associated_mul_left_cancel

section unique_units
variables [monoid α] [unique (units α)]

theorem associated_iff_eq {x y : α} : x ~ᵤ y ↔ x = y :=
begin
  split,
  { rintro ⟨c, rfl⟩, simp [subsingleton.elim c 1] },
  { rintro rfl, refl },
end

theorem associated_eq_eq : (associated : α → α → Prop) = eq :=
by { ext, rw associated_iff_eq }

end unique_units

/-- The quotient of a monoid by the `associated` relation. Two elements `x` and `y`
  are associated iff there is a unit `u` such that `x * u = y`. There is a natural
  monoid structure on `associates α`. -/
def associates (α : Type*) [monoid α] : Type* :=
quotient (associated.setoid α)

namespace associates
open associated

/-- The canonical quotient map from a monoid `α` into the `associates` of `α` -/
protected def mk {α : Type*} [monoid α] (a : α) : associates α :=
⟦ a ⟧

instance [monoid α] : inhabited (associates α) := ⟨⟦1⟧⟩

theorem mk_eq_mk_iff_associated [monoid α] {a b : α} :
  associates.mk a = associates.mk b ↔ a ~ᵤ b :=
iff.intro quotient.exact quot.sound

theorem quotient_mk_eq_mk [monoid α] (a : α) : ⟦ a ⟧ = associates.mk a := rfl

theorem quot_mk_eq_mk [monoid α] (a : α) : quot.mk setoid.r a = associates.mk a := rfl

theorem forall_associated [monoid α] {p : associates α → Prop} :
  (∀a, p a) ↔ (∀a, p (associates.mk a)) :=
iff.intro
  (assume h a, h _)
  (assume h a, quotient.induction_on a h)

theorem mk_surjective [monoid α] : function.surjective (@associates.mk α _) :=
forall_associated.2 (λ a, ⟨a, rfl⟩)

instance [monoid α] : has_one (associates α) := ⟨⟦ 1 ⟧⟩

theorem one_eq_mk_one [monoid α] : (1 : associates α) = associates.mk 1 := rfl

instance [monoid α] : has_bot (associates α) := ⟨1⟩

lemma exists_rep [monoid α] (a : associates α) : ∃ a0 : α, associates.mk a0 = a :=
quot.exists_rep a

section comm_monoid
variable [comm_monoid α]

instance : has_mul (associates α) :=
⟨λa' b', quotient.lift_on₂ a' b' (λa b, ⟦ a * b ⟧) $
  assume a₁ a₂ b₁ b₂ ⟨c₁, h₁⟩ ⟨c₂, h₂⟩,
  quotient.sound $ ⟨c₁ * c₂, by simp [h₁.symm, h₂.symm, mul_assoc, mul_comm, mul_left_comm]⟩⟩

theorem mk_mul_mk {x y : α} : associates.mk x * associates.mk y = associates.mk (x * y) :=
rfl

instance : comm_monoid (associates α) :=
{ one       := 1,
  mul       := (*),
  mul_one   := assume a', quotient.induction_on a' $
    assume a, show ⟦a * 1⟧ = ⟦ a ⟧, by simp,
  one_mul   := assume a', quotient.induction_on a' $
    assume a, show ⟦1 * a⟧ = ⟦ a ⟧, by simp,
  mul_assoc := assume a' b' c', quotient.induction_on₃ a' b' c' $
    assume a b c, show ⟦a * b * c⟧ = ⟦a * (b * c)⟧, by rw [mul_assoc],
  mul_comm  := assume a' b', quotient.induction_on₂ a' b' $
    assume a b, show ⟦a * b⟧ = ⟦b * a⟧, by rw [mul_comm] }

instance : preorder (associates α) :=
{ le := has_dvd.dvd,
  le_refl := dvd_refl,
  le_trans := λ a b c, dvd_trans}

@[simp] lemma mk_one : associates.mk (1 : α) = 1 := rfl

/-- `associates.mk` as a `monoid_hom`. -/
protected def mk_monoid_hom : α →* (associates α) := ⟨associates.mk, mk_one, λ x y, mk_mul_mk⟩

@[simp] lemma mk_monoid_hom_apply (a : α) : associates.mk_monoid_hom a = associates.mk a := rfl

lemma associated_map_mk {f : associates α →* α}
  (hinv : function.right_inverse f associates.mk) (a : α) :
  a ~ᵤ f (associates.mk a) :=
associates.mk_eq_mk_iff_associated.1 (hinv (associates.mk a)).symm

lemma mk_pow (a : α) (n : ℕ) : associates.mk (a ^ n) = (associates.mk a) ^ n :=
by induction n; simp [*, pow_succ, associates.mk_mul_mk.symm]

lemma dvd_eq_le : ((∣) : associates α → associates α → Prop) = (≤) := rfl

theorem prod_mk {p : multiset α} : (p.map associates.mk).prod = associates.mk p.prod :=
multiset.induction_on p (by simp; refl) $ assume a s ih, by simp [ih]; refl

theorem rel_associated_iff_map_eq_map {p q : multiset α} :
  multiset.rel associated p q ↔ p.map associates.mk = q.map associates.mk :=
by { rw [← multiset.rel_eq, multiset.rel_map], simp only [mk_eq_mk_iff_associated] }

theorem mul_eq_one_iff {x y : associates α} : x * y = 1 ↔ (x = 1 ∧ y = 1) :=
iff.intro
  (quotient.induction_on₂ x y $ assume a b h,
    have a * b ~ᵤ 1, from quotient.exact h,
    ⟨quotient.sound $ associated_one_of_associated_mul_one this,
      quotient.sound $ associated_one_of_associated_mul_one $ by rwa [mul_comm] at this⟩)
  (by simp {contextual := tt})

theorem prod_eq_one_iff {p : multiset (associates α)} :
  p.prod = 1 ↔ (∀a ∈ p, (a:associates α) = 1) :=
multiset.induction_on p
  (by simp)
  (by simp [mul_eq_one_iff, or_imp_distrib, forall_and_distrib] {contextual := tt})

theorem units_eq_one (u : units (associates α)) : u = 1 :=
units.ext (mul_eq_one_iff.1 u.val_inv).1

instance unique_units : unique (units (associates α)) :=
{ default := 1, uniq := associates.units_eq_one }

theorem coe_unit_eq_one (u : units (associates α)): (u : associates α) = 1 :=
by simp

theorem is_unit_iff_eq_one (a : associates α) : is_unit a ↔ a = 1 :=
iff.intro
  (assume ⟨u, h⟩, h ▸ coe_unit_eq_one _)
  (assume h, h.symm ▸ is_unit_one)

theorem is_unit_mk {a : α} : is_unit (associates.mk a) ↔ is_unit a :=
calc is_unit (associates.mk a) ↔ a ~ᵤ 1 :
    by rw [is_unit_iff_eq_one, one_eq_mk_one, mk_eq_mk_iff_associated]
  ... ↔ is_unit a : associated_one_iff_is_unit

section order

theorem mul_mono {a b c d : associates α} (h₁ : a ≤ b) (h₂ : c ≤ d) :
  a * c ≤ b * d :=
let ⟨x, hx⟩ := h₁, ⟨y, hy⟩ := h₂ in
⟨x * y, by simp [hx, hy, mul_comm, mul_assoc, mul_left_comm]⟩

theorem one_le {a : associates α} : 1 ≤ a :=
dvd.intro _ (one_mul a)

theorem prod_le_prod {p q : multiset (associates α)} (h : p ≤ q) : p.prod ≤ q.prod :=
begin
  haveI := classical.dec_eq (associates α),
  haveI := classical.dec_eq α,
  suffices : p.prod ≤ (p + (q - p)).prod, { rwa [multiset.add_sub_of_le h] at this },
  suffices : p.prod * 1 ≤ p.prod * (q - p).prod, { simpa },
  exact mul_mono (le_refl p.prod) one_le
end

theorem le_mul_right {a b : associates α} : a ≤ a * b := ⟨b, rfl⟩

theorem le_mul_left {a b : associates α} : a ≤ b * a :=
by rw [mul_comm]; exact le_mul_right

end order

end comm_monoid

instance [has_zero α] [monoid α] : has_zero (associates α) := ⟨⟦ 0 ⟧⟩
instance [has_zero α] [monoid α] : has_top (associates α) := ⟨0⟩

section comm_monoid_with_zero

variables [comm_monoid_with_zero α]

@[simp] theorem mk_eq_zero {a : α} : associates.mk a = 0 ↔ a = 0 :=
⟨assume h, (associated_zero_iff_eq_zero a).1 $ quotient.exact h, assume h, h.symm ▸ rfl⟩

instance : comm_monoid_with_zero (associates α) :=
{ zero_mul := by { rintro ⟨a⟩, show associates.mk (0 * a) = associates.mk 0, rw [zero_mul] },
  mul_zero := by { rintro ⟨a⟩, show associates.mk (a * 0) = associates.mk 0, rw [mul_zero] },
  .. associates.comm_monoid, .. associates.has_zero }

instance [nontrivial α] : nontrivial (associates α) :=
⟨⟨0, 1,
assume h,
have (0 : α) ~ᵤ 1, from quotient.exact h,
have (0 : α) = 1, from ((associated_zero_iff_eq_zero 1).1 this.symm).symm,
zero_ne_one this⟩⟩

lemma exists_non_zero_rep {a : associates α} : a ≠ 0 → ∃ a0 : α, a0 ≠ 0 ∧ associates.mk a0 = a :=
quotient.induction_on a (λ b nz, ⟨b, mt (congr_arg quotient.mk) nz, rfl⟩)

theorem dvd_of_mk_le_mk {a b : α} : associates.mk a ≤ associates.mk b → a ∣ b
| ⟨c', hc'⟩ := (quotient.induction_on c' $ assume c hc,
    let ⟨d, hd⟩ := (quotient.exact hc).symm in
    ⟨(↑d) * c,
      calc b = (a * c) * ↑d : hd.symm
        ... = a * (↑d * c) : by ac_refl⟩) hc'

theorem mk_le_mk_of_dvd {a b : α} : a ∣ b → associates.mk a ≤ associates.mk b :=
assume ⟨c, hc⟩, ⟨associates.mk c, by simp [hc]; refl⟩

theorem mk_le_mk_iff_dvd_iff {a b : α} : associates.mk a ≤ associates.mk b ↔ a ∣ b :=
iff.intro dvd_of_mk_le_mk mk_le_mk_of_dvd

theorem mk_dvd_mk {a b : α} : associates.mk a ∣ associates.mk b ↔ a ∣ b :=
iff.intro dvd_of_mk_le_mk mk_le_mk_of_dvd

lemma prime.le_or_le {p : associates α} (hp : prime p) {a b : associates α} (h : p ≤ a * b) :
  p ≤ a ∨ p ≤ b :=
hp.2.2 a b h

lemma exists_mem_multiset_le_of_prime {s : multiset (associates α)} {p : associates α}
  (hp : prime p) :
  p ≤ s.prod → ∃a∈s, p ≤ a :=
multiset.induction_on s (assume ⟨d, eq⟩, (hp.ne_one (mul_eq_one_iff.1 eq.symm).1).elim) $
assume a s ih h,
  have p ≤ a * s.prod, by simpa using h,
  match prime.le_or_le hp this with
  | or.inl h := ⟨a, multiset.mem_cons_self a s, h⟩
  | or.inr h := let ⟨a, has, h⟩ := ih h in ⟨a, multiset.mem_cons_of_mem has, h⟩
  end

lemma prime_mk (p : α) : prime (associates.mk p) ↔ _root_.prime p :=
begin
  rw [prime, _root_.prime, forall_associated],
  transitivity,
  { apply and_congr, refl,
    apply and_congr, refl,
    apply forall_congr, assume a,
    exact forall_associated },
  apply and_congr,
  { rw [(≠), mk_eq_zero] },
  apply and_congr,
  { rw [is_unit_mk], },
  apply forall_congr, assume a,
  apply forall_congr, assume b,
  rw [mk_mul_mk, mk_dvd_mk, mk_dvd_mk, mk_dvd_mk],
end

theorem irreducible_mk (a : α) : irreducible (associates.mk a) ↔ irreducible a :=
begin
  simp only [irreducible_iff, is_unit_mk],
  apply and_congr iff.rfl,
  split,
  { rintro h x y rfl,
    simpa [is_unit_mk] using h (associates.mk x) (associates.mk y) rfl },
  { intros h x y,
    refine quotient.induction_on₂ x y (assume x y a_eq, _),
    rcases quotient.exact a_eq.symm with ⟨u, a_eq⟩,
    rw mul_assoc at a_eq,
    show is_unit (associates.mk x) ∨ is_unit (associates.mk y),
    simpa [is_unit_mk] using h _ _ a_eq.symm }
end

theorem mk_dvd_not_unit_mk_iff {a b : α} :
  dvd_not_unit (associates.mk a) (associates.mk b) ↔
  dvd_not_unit a b :=
begin
  rw [dvd_not_unit, dvd_not_unit, ne, ne, mk_eq_zero],
  apply and_congr_right, intro ane0,
  split,
  { contrapose!, rw forall_associated,
    intros h x hx hbax,
    rw [mk_mul_mk, mk_eq_mk_iff_associated] at hbax,
    cases hbax with u hu,
    apply h (x * ↑u⁻¹),
    { rw is_unit_mk at hx,
      rw is_unit_iff_of_associated,
      apply hx,
      use u,
      simp, },
    simp [← mul_assoc, ← hu] },
  { rintro ⟨x, ⟨hx, rfl⟩⟩,
    use associates.mk x,
    simp [is_unit_mk, mk_mul_mk, hx], }
end

theorem dvd_not_unit_of_lt {a b : associates α} (hlt : a < b) :
  dvd_not_unit a b :=
begin
  split, { rintro rfl, apply not_lt_of_le _ hlt, apply dvd_zero },
  rcases hlt with ⟨⟨x, rfl⟩, ndvd⟩,
  refine ⟨x, _, rfl⟩,
  contrapose! ndvd,
  rcases ndvd with ⟨u, rfl⟩,
  simp,
end

end comm_monoid_with_zero

section comm_cancel_monoid_with_zero
variable [comm_cancel_monoid_with_zero α]

instance : partial_order (associates α) :=
{ le_antisymm := λ a' b', quotient.induction_on₂ a' b' (λ a b hab hba,
  quot.sound $ associated_of_dvd_dvd (dvd_of_mk_le_mk hab) (dvd_of_mk_le_mk hba))
  .. associates.preorder }

instance : order_bot (associates α) :=
{ bot := 1,
  bot_le := assume a, one_le,
  .. associates.partial_order }

instance : order_top (associates α) :=
{ top := 0,
  le_top := assume a, ⟨0, (mul_zero a).symm⟩,
  .. associates.partial_order }

instance : no_zero_divisors (associates α) :=
⟨λ x y,
  (quotient.induction_on₂ x y $ assume a b h,
    have a * b = 0, from (associated_zero_iff_eq_zero _).1 (quotient.exact h),
    have a = 0 ∨ b = 0, from mul_eq_zero.1 this,
    this.imp (assume h, h.symm ▸ rfl) (assume h, h.symm ▸ rfl))⟩

theorem irreducible_iff_prime_iff :
  (∀ a : α, irreducible a ↔ prime a) ↔ (∀ a : (associates α), irreducible a ↔ prime a) :=
begin
  rw forall_associated, split;
  intros h a; have ha := h a; rw irreducible_mk at *; rw prime_mk at *; exact ha,
end

lemma eq_of_mul_eq_mul_left :
  ∀(a b c : associates α), a ≠ 0 → a * b = a * c → b = c :=
begin
  rintros ⟨a⟩ ⟨b⟩ ⟨c⟩ ha h,
  rcases quotient.exact' h with ⟨u, hu⟩,
  have hu : a * (b * ↑u) = a * c, { rwa [← mul_assoc] },
  exact quotient.sound' ⟨u, mul_left_cancel' (mt mk_eq_zero.2 ha) hu⟩
end

lemma eq_of_mul_eq_mul_right :
  ∀(a b c : associates α), b ≠ 0 → a * b = c * b → a = c :=
λ a b c bne0, (mul_comm b a) ▸ (mul_comm b c) ▸ (eq_of_mul_eq_mul_left b a c bne0)

lemma le_of_mul_le_mul_left (a b c : associates α) (ha : a ≠ 0) :
  a * b ≤ a * c → b ≤ c
| ⟨d, hd⟩ := ⟨d, eq_of_mul_eq_mul_left a _ _ ha $ by rwa ← mul_assoc⟩

lemma one_or_eq_of_le_of_prime :
  ∀(p m : associates α), prime p → m ≤ p → (m = 1 ∨ m = p)
| _ m ⟨hp0, hp1, h⟩ ⟨d, rfl⟩ :=
match h m d (dvd_refl _) with
| or.inl h := classical.by_cases (assume : m = 0, by simp [this]) $
  assume : m ≠ 0,
  have m * d ≤ m * 1, by simpa using h,
  have d ≤ 1, from associates.le_of_mul_le_mul_left m d 1 ‹m ≠ 0› this,
  have d = 1, from bot_unique this,
  by simp [this]
| or.inr h := classical.by_cases (assume : d = 0, by simp [this] at hp0; contradiction) $
  assume : d ≠ 0,
  have d * m ≤ d * 1, by simpa [mul_comm] using h,
  or.inl $ bot_unique $ associates.le_of_mul_le_mul_left d m 1 ‹d ≠ 0› this
end

instance : comm_cancel_monoid_with_zero (associates α) :=
{ mul_left_cancel_of_ne_zero := eq_of_mul_eq_mul_left,
  mul_right_cancel_of_ne_zero := eq_of_mul_eq_mul_right,
  .. (infer_instance : comm_monoid_with_zero (associates α)) }

theorem dvd_not_unit_iff_lt {a b : associates α} :
  dvd_not_unit a b ↔ a < b :=
dvd_and_not_dvd_iff.symm

end comm_cancel_monoid_with_zero

end associates


import declaration_with_docstring

/-- A list of fixed prompts for theorem autoformalisation.
  This is the same list used in `Lean Chat`.
-/
def fixed_prompts : list declaration_with_docstring := [
  ("If $z_1, \\dots, z_n$ are complex, then $|z_1 + z_2 + \\dots + z_n|\\leq |z_1| + |z_2| + \\dots + |z_n|$.", "theorem abs_sum_leq_sum_abs (n : ℕ) (f : ℕ → ℂ) :
    abs (∑ i in finset.range n, f i) ≤ ∑ i in finset.range n, abs (f i)"),

  ("If x and y are in $\\mathbb{R}^n$, then $|x+y|^2 + |x-y|^2 = 2|x|^2 + 2|y|^2$.", "theorem sum_add_square_sub_square_eq_sum_square (n : ℕ) (x y : euclidean_space ℝ (fin n)) :
  ∥x + y∥^2 + ∥x - y∥^2 = 2*∥x∥^2 + 2*∥y∥^2"),

  ("If $x$ is an element of infinite order in $G$, prove that the elements $x^n$, $n\\in\\mathbb{Z}$ are all distinct.", "theorem distinct_powers_of_infinite_order_element (G : Type*) [group G] (x : G)
  (hx : x ≠ 1) (hx_inf : ∀ n : ℕ, x ^ n ≠ 1) :
  ∀ m n : ℤ, m ≠ n → x ^ m ≠ x ^ n"),

  ("Let $X$ be a topological space; let $A$ be a subset of $X$. Suppose that for each $x\\in A$ there is an open set $U$ containing $x$ such that $U\\subset A$. Show that $A$ is open in $X$.", "theorem subset_of_open_subset_is_open (X : Type*) [topological_space X]
  (A : set X) (hA : ∀ x ∈ A, ∃ U : set X, is_open U ∧ x ∈ U ∧ U ⊆ A):
  is_open A ")

].map (λ ⟨doc, thm⟩, declaration_with_docstring.from_string thm doc)

-- #eval declaration_with_docstring.args <$> fixed_prompts


import data.fin

open fin nat

def fin' := fin

variables {n : ℕ} (a b c : fin' n.succ)

instance : has_one (fin' n.succ) := ⟨(0 : fin n.succ)⟩
instance : has_mul (fin' n.succ) := ⟨((+) : fin n.succ → fin n.succ → fin n.succ)⟩

include a
private def inv : fin' n.succ :=
begin
  cases a,
  cases a_val,
  {
    exact 1,
  },
  {
    exact (n - a_val : fin n.succ),
  },
end
omit a

instance : has_inv (fin' n.succ) := ⟨inv⟩

private lemma mul_assoc : a * b * c = a * (b * c) :=
begin
  apply eq_of_veq,
  simp [(*), fin.add_def, add_assoc],
end

private lemma one_mul : 1 * a = a :=
begin
  apply eq_of_veq,
  simp [has_one.one, (*), fin.add_def, mod_eq_of_lt a.is_lt],
end

private lemma mul_one : a * 1 = a :=
begin
  apply eq_of_veq,
  simp [has_one.one, (*), fin.add_def, mod_eq_of_lt a.is_lt],
end

private lemma mul_left_inv : a⁻¹ * a = 1 :=
begin
  apply eq_of_veq,
  cases a,
  cases a_val,
  {
    simp only [has_one.one, (*), has_inv.inv, inv, fin.add_def],
    simp,
  },
  {
    simp only [(*), has_inv.inv, inv, fin.add_def, fin.sub_def],
    rw [coe_val_of_lt, coe_val_of_lt]; try { simp [lt_of_succ_lt a_property], },
    have : (n - a_val + a_val.succ) = n.succ,
    {
      rw add_succ,
      congr,
      apply nat.sub_add_cancel,
      apply le_of_lt,
      apply lt_of_succ_lt_succ,
      apply a_property,
    },
    rw this,
    apply mod_self,
  },
end

private lemma mul_comm : a * b = b * a :=
begin
  apply eq_of_veq,
  simp [(*), fin.add_def, add_comm],
end

instance : comm_group (fin' n.succ) :=
{
  mul := (*),
  mul_assoc := mul_assoc,
  one := 0,
  one_mul := one_mul,
  mul_one := mul_one,
  inv := inv,
  mul_left_inv := mul_left_inv,
  mul_comm := mul_comm,
}


/-
Copyright (c) 2023 David Loeffler. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: David Loeffler
-/

import data.real.pi.wallis
import measure_theory.integral.peak_function

/-! # Euler's infinite product for the sine function

This file proves the infinite product formula

$$ \sin \pi z = \pi z \prod_{n = 1}^\infty \left(1 - \frac{z ^ 2}{n ^ 2}\right) $$

for any real or complex `z`. Our proof closely follows the article
[Salwinski, *Euler's Sine Product Formula: An Elementary Proof*][salwinski2018]: the basic strategy
is to prove a recurrence relation for the integrals `∫ x in 0..π/2, cos 2 z x * cos x ^ (2 * n)`,
generalising the arguments used to prove Wallis' limit formula for `π`.
-/

open_locale real topology big_operators
open real set filter interval_integral measure_theory.measure_space

namespace euler_sine

section integral_recursion

/-! ## Recursion formula for the integral of `cos (2 * z * x) * cos x ^ n`

We evaluate the integral of `cos (2 * z * x) * cos x ^ n`, for any complex `z` and even integers
`n`, via repeated integration by parts. -/

variables {z : ℂ} {n : ℕ}

lemma antideriv_cos_comp_const_mul (hz : z ≠ 0) (x : ℝ) :
  has_deriv_at (λ y:ℝ, complex.sin (2 * z * y)  / (2 * z)) (complex.cos (2 * z * x)) x :=
begin
  have a : has_deriv_at _ _ ↑x := has_deriv_at_mul_const _,
  have b : has_deriv_at (λ (y : ℂ), complex.sin (y * (2 * z))) _ ↑x :=
    has_deriv_at.comp x (complex.has_deriv_at_sin (x * (2 * z))) a,
  convert (b.comp_of_real).div_const (2 * z),
  { ext1 x, rw mul_comm _ (2 * z) },
  { field_simp, rw mul_comm _ (2 * z) },
end

lemma antideriv_sin_comp_const_mul (hz : z ≠ 0) (x : ℝ) :
  has_deriv_at (λ y:ℝ, -complex.cos (2 * z * y)  / (2 * z)) (complex.sin (2 * z * x)) x :=
begin
  have a : has_deriv_at _ _ ↑x := has_deriv_at_mul_const _,
  have b : has_deriv_at (λ (y : ℂ), complex.cos (y * (2 * z))) _ ↑x :=
    has_deriv_at.comp x (complex.has_deriv_at_cos (x * (2 * z))) a,
  convert ((b.comp_of_real).div_const (2 * z)).neg,
  { ext1 x, rw mul_comm _ (2 * z), field_simp },
  { field_simp, rw mul_comm _ (2 * z) },
end

lemma integral_cos_mul_cos_pow_aux (hn : 2 ≤ n) (hz : z ≠ 0):
  (∫ x:ℝ in 0..π/2, complex.cos (2 * z * x) * cos x ^ n) =
  n / (2 * z) * ∫ x:ℝ in 0..π/2, complex.sin (2 * z * x) * sin x * cos x ^ (n - 1) :=
begin
  have der1 : ∀ (x : ℝ), (x ∈ uIcc 0 (π/2)) → has_deriv_at (λ y, (↑(cos y)) ^ n : ℝ → ℂ)
    (-n * sin x * cos x ^ (n - 1)) x,
  { intros x hx,
    have b : has_deriv_at (λ y, ↑(cos y) : ℝ → ℂ) (-sin x) x,
      by simpa using (has_deriv_at_cos x).of_real_comp,
    convert has_deriv_at.comp x (has_deriv_at_pow _ _) b using 1,
    ring, },
  convert integral_mul_deriv_eq_deriv_mul der1 (λ x hx, antideriv_cos_comp_const_mul hz x) _ _,
  { ext1 x, rw mul_comm },
  { rw [complex.of_real_zero, mul_zero, complex.sin_zero, zero_div, mul_zero, sub_zero,
      cos_pi_div_two, complex.of_real_zero, zero_pow (by positivity : 0 < n), zero_mul, zero_sub,
      ←integral_neg, ←integral_const_mul],
    refine integral_congr (λ x hx, _),
    field_simp, ring },
  { apply continuous.interval_integrable,
    exact (continuous_const.mul (complex.continuous_of_real.comp continuous_sin)).mul
      ((complex.continuous_of_real.comp continuous_cos).pow (n - 1)) },
  { apply continuous.interval_integrable,
    exact complex.continuous_cos.comp (continuous_const.mul complex.continuous_of_real) }
end

lemma integral_sin_mul_sin_mul_cos_pow_eq (hn : 2 ≤ n) (hz : z ≠ 0) :
  ∫ x:ℝ in 0..π/2, complex.sin (2 * z * x) * sin x * cos x ^ (n - 1) =
  n / (2 * z) * (∫ x:ℝ in 0..π/2, complex.cos (2 * z * x) * cos x ^ n) -
  (n - 1) / (2 * z) * (∫ x:ℝ in 0..π/2, complex.cos (2 * z * x) * cos x ^ (n - 2)) :=
begin
  have der1 : ∀ (x : ℝ), (x ∈ uIcc 0 (π/2)) →
    has_deriv_at (λ y, (sin y) * (cos y) ^ (n - 1) : ℝ → ℂ)
    (cos x ^ n - (n - 1) * sin x ^ 2 * cos x ^ (n - 2)) x,
  { intros x hx,
    have c := has_deriv_at.comp (x:ℂ) (has_deriv_at_pow (n - 1) _) (complex.has_deriv_at_cos x),
    convert ((complex.has_deriv_at_sin x).mul c).comp_of_real using 1,
    { ext1 y, simp only [complex.of_real_sin, complex.of_real_cos] },
    { simp only [complex.of_real_cos, complex.of_real_sin],
      rw [mul_neg, mul_neg, ←sub_eq_add_neg, function.comp_app],
      congr' 1,
      { rw [←pow_succ, nat.sub_add_cancel (by linarith : 1 ≤ n)] },
      { have : ((n - 1 : ℕ) : ℂ) = (n:ℂ) - 1,
        { rw [nat.cast_sub (one_le_two.trans hn), nat.cast_one] },
        rw [nat.sub_sub, this],
        ring } } },
  convert integral_mul_deriv_eq_deriv_mul der1 (λ x hx, antideriv_sin_comp_const_mul hz x) _ _
    using 1,
  { refine integral_congr (λ x hx, _),
    ring_nf },
  { -- now a tedious rearrangement of terms
    -- gather into a single integral, and deal with continuity subgoals:
    rw [sin_zero, cos_pi_div_two, complex.of_real_zero, zero_pow, zero_mul, mul_zero, zero_mul,
      zero_mul, sub_zero, zero_sub, ←integral_neg, ←integral_const_mul,  ←integral_const_mul,
      ←integral_sub],
    rotate,
    { apply continuous.interval_integrable,
      exact continuous_const.mul ((complex.continuous_cos.comp (continuous_const.mul
        complex.continuous_of_real)).mul ((complex.continuous_of_real.comp
        continuous_cos).pow n)) },
    { apply continuous.interval_integrable,
      exact continuous_const.mul
        ((complex.continuous_cos.comp (continuous_const.mul complex.continuous_of_real)).mul
        ((complex.continuous_of_real.comp continuous_cos).pow (n - 2))), },
    { apply nat.sub_pos_of_lt, exact one_lt_two.trans_le hn },
    refine integral_congr (λ x hx, _),
    dsimp only,
    -- get rid of real trig functions and divions by 2 * z:
    rw [complex.of_real_cos, complex.of_real_sin, complex.sin_sq, ←mul_div_right_comm,
      ←mul_div_right_comm, ←sub_div, mul_div, ←neg_div],
    congr' 1,
    have : complex.cos ↑x ^ n = complex.cos ↑x ^ (n - 2) * complex.cos ↑x ^ 2,
    { conv_lhs { rw [←nat.sub_add_cancel hn, pow_add] } },
    rw this,
    ring },
  { apply continuous.interval_integrable,
    exact ((complex.continuous_of_real.comp continuous_cos).pow n).sub
      ((continuous_const.mul ((complex.continuous_of_real.comp continuous_sin).pow 2)).mul
      ((complex.continuous_of_real.comp continuous_cos).pow (n - 2))) },
  { apply continuous.interval_integrable,
    exact complex.continuous_sin.comp (continuous_const.mul complex.continuous_of_real) },
end

/-- Note this also holds for `z = 0`, but we do not need this case for `sin_pi_mul_eq`.  -/
lemma integral_cos_mul_cos_pow (hn : 2 ≤ n) (hz : z ≠ 0) :
  (1 - 4 * z ^ 2 / n ^ 2) * (∫ x:ℝ in 0..π/2, complex.cos (2 * z * x) * cos x ^ n) =
  (n - 1 : ℂ) / n * ∫ x:ℝ in 0..π/2, complex.cos (2 * z * x) * cos x ^ (n - 2) :=
begin
  have nne : (n : ℂ) ≠ 0,
  { contrapose! hn, rw nat.cast_eq_zero at hn, rw hn, exact zero_lt_two },
  have := integral_cos_mul_cos_pow_aux hn hz,
  rw [integral_sin_mul_sin_mul_cos_pow_eq hn hz, sub_eq_neg_add, mul_add, ←sub_eq_iff_eq_add]
    at this,
  convert congr_arg (λ u:ℂ, -u * (2 * z) ^ 2 / n ^ 2) this using 1;
  { field_simp, ring },
end

/-- Note this also holds for `z = 0`, but we do not need this case for `sin_pi_mul_eq`. -/
lemma integral_cos_mul_cos_pow_even (n : ℕ) (hz : z ≠ 0) :
  (1 - z ^ 2 / (n + 1) ^ 2) * (∫ x:ℝ in 0..π/2, complex.cos (2 * z * x) * cos x ^ (2 * n + 2)) =
  (2 * n + 1 : ℂ) / (2 * n + 2) * ∫ x:ℝ in 0..π/2, complex.cos (2 * z * x) * cos x ^ (2 * n) :=
begin
  convert integral_cos_mul_cos_pow (by linarith : 2 ≤ 2 * n + 2) hz using 3,
  { simp only [nat.cast_add, nat.cast_mul, nat.cast_two],
    nth_rewrite_rhs 2 ←mul_one (2:ℂ),
    rw [←mul_add, mul_pow, ←div_div],
    ring },
  { push_cast, ring },
  { push_cast, ring },
end

/-- Relate the integral `cos x ^ n` over `[0, π/2]` to the integral of `sin x ^ n` over `[0, π]`,
which is studied in `data.real.pi.wallis` and other places. -/
lemma integral_cos_pow_eq (n : ℕ) :
  (∫ (x:ℝ) in 0..π/2, cos x ^ n) = 1 / 2 * (∫ (x:ℝ) in 0..π, (sin x) ^ n) :=
begin
  rw [mul_comm (1/2 : ℝ), ←div_eq_iff (one_div_ne_zero (two_ne_zero' ℝ)), ←div_mul, div_one,
    mul_two],
  have L : interval_integrable _ volume 0 (π / 2) := (continuous_sin.pow n).interval_integrable _ _,
  have R : interval_integrable _ volume (π / 2) π := (continuous_sin.pow n).interval_integrable _ _,
  rw ←integral_add_adjacent_intervals L R,
  congr' 1,
  { nth_rewrite 0 (by ring : 0 = π/2 - π/2),
    nth_rewrite 2 (by ring : π/2 = π/2 - 0),
    rw ←integral_comp_sub_left,
    refine integral_congr (λ x _, _),
    dsimp only,
    rw cos_pi_div_two_sub },
  { nth_rewrite 2 (by ring : π = π/2 + π/2),
    nth_rewrite 1 (by ring : π/2 = 0 + π/2),
    rw ←integral_comp_add_right,
    refine integral_congr (λ x _, _),
    dsimp only,
    rw sin_add_pi_div_two },
end

lemma integral_cos_pow_pos (n : ℕ) : 0 < (∫ (x:ℝ) in 0..π/2, cos x ^ n) :=
(integral_cos_pow_eq n).symm ▸ (mul_pos one_half_pos (integral_sin_pow_pos _))

/-- Finite form of Euler's sine product, with remainder term expressed as a ratio of cosine
integrals. -/
lemma sin_pi_mul_eq (z : ℂ) (n : ℕ) :
  complex.sin (π * z) = π * z * (∏ j in finset.range n, (1 - z ^ 2 / (j + 1) ^ 2)) *
  (∫ x in 0..π/2, complex.cos (2 * z * x) * cos x ^ (2 * n)) / ↑∫ x in 0..π/2, cos x ^ (2 * n) :=
begin
  rcases eq_or_ne z 0 with rfl | hz,
  { simp },
  induction n with n hn,
  { simp_rw [mul_zero, pow_zero, mul_one, finset.prod_range_zero, mul_one, integral_one, sub_zero],
    rw [integral_cos_mul_complex (mul_ne_zero two_ne_zero hz), complex.of_real_zero, mul_zero,
      complex.sin_zero, zero_div, sub_zero,
      (by { push_cast, field_simp, ring } : 2 * z * ↑(π / 2) = π * z)],
    field_simp [complex.of_real_ne_zero.mpr pi_pos.ne'],
    ring },
  { rw [hn, finset.prod_range_succ],
    set A := ∏ j in finset.range n, (1 - z ^ 2 / (j + 1) ^ 2),
    set B := ∫ x:ℝ in 0..π/2, complex.cos (2 * z * x) * cos x ^ (2 * n),
    set C := ∫ x:ℝ in 0..π/2, cos x ^ (2 * n),
    have aux' : 2 * n.succ = 2 * n + 2,
    { rw [nat.succ_eq_add_one, mul_add, mul_one], },
    have : ∫ x:ℝ in 0..π/2, cos x ^ (2 * n.succ) = (2 * (n:ℝ) + 1) / (2 * n + 2) * C,
    { rw integral_cos_pow_eq,
      dsimp only [C],
      rw [integral_cos_pow_eq, aux', integral_sin_pow, sin_zero, sin_pi, pow_succ, zero_mul,
        zero_mul, zero_mul, sub_zero, zero_div, zero_add, ←mul_assoc, ←mul_assoc,
        mul_comm (1 / 2 : ℝ) _, nat.cast_mul, nat.cast_bit0, nat.cast_one] },
    rw this,
    change ↑π * z * A * B / ↑C =
      (↑π * z * (A * (1 - z ^ 2 / (↑n + 1) ^ 2)) *
       ∫ (x : ℝ) in 0..π / 2, complex.cos (2 * z * ↑x) * ↑(cos x) ^ (2 * n.succ)) /
    ↑((2 * ↑n + 1) / (2 * ↑n + 2) * C),
    have : ↑π * z * (A * (1 - z ^ 2 / (↑n + 1) ^ 2)) *
      ∫ (x : ℝ) in 0..π / 2, complex.cos (2 * z * ↑x) * ↑(cos x) ^ (2 * n.succ)
    = ↑π * z * A * ((1 - z ^ 2 / (↑n.succ) ^ 2) *
      ∫ (x : ℝ) in 0..π / 2, complex.cos (2 * z * ↑x) * ↑(cos x) ^ (2 * n.succ)),
    { nth_rewrite_rhs 0 nat.succ_eq_add_one,
      rw nat.cast_add_one,
      ring },
    rw this,
    suffices : (1 - z ^ 2 / ↑(n.succ) ^ 2) *
      ∫ (x : ℝ) in 0..π / 2, complex.cos (2 * z * ↑x) * ↑(cos x) ^ (2 * n.succ) =
      (2 * n + 1) / (2 * n + 2) * B,
    { rw [this, complex.of_real_mul, complex.of_real_div],
      have : (C:ℂ) ≠ 0 := complex.of_real_ne_zero.mpr (integral_cos_pow_pos _).ne',
      have : 2 * (n:ℂ) + 1 ≠ 0,
      { convert (nat.cast_add_one_ne_zero (2 * n) : (↑(2 * n) + 1 : ℂ) ≠ 0),
        simp },
      have : 2 * (n:ℂ) + 2 ≠ 0,
      { convert (nat.cast_add_one_ne_zero (2 * n + 1) : (↑(2 * n + 1) + 1 : ℂ) ≠ 0) using 1,
        push_cast, ring },
      field_simp, ring },
    convert integral_cos_mul_cos_pow_even n hz,
    rw nat.cast_succ }
end

end integral_recursion

/-! ## Conclusion of the proof

The main theorem `complex.tendsto_euler_sin_prod`, and its real variant
`real.tendsto_euler_sin_prod`, now follow by combining `sin_pi_mul_eq` with a lemma
stating that the sequence of measures on `[0, π/2]` given by integration against `cos x ^ n`
(suitably normalised) tends to the Dirac measure at 0, as a special case of the general result
`tendsto_set_integral_pow_smul_of_unique_maximum_of_is_compact_of_continuous_on`. -/

lemma tendsto_integral_cos_pow_mul_div {f : ℝ → ℂ} (hf : continuous_on f (Icc 0 (π/2))) :
  tendsto (λ (n : ℕ), (∫ x:ℝ in 0..π/2, ↑(cos x) ^ n * f x) / ↑(∫ x:ℝ in 0..π/2, (cos x) ^ n))
  at_top (𝓝 $ f 0) :=
begin
  simp_rw [div_eq_inv_mul _ (coe _), ←complex.of_real_inv, integral_of_le (pi_div_two_pos.le),
    ←measure_theory.integral_Icc_eq_integral_Ioc, ←complex.of_real_pow, ←complex.real_smul],
  have c_lt : ∀ (y : ℝ), y ∈ Icc 0 (π / 2) → y ≠ 0 → cos y < cos 0, from λ y hy hy',
    cos_lt_cos_of_nonneg_of_le_pi_div_two (le_refl 0) hy.2 (lt_of_le_of_ne hy.1 hy'.symm),
  have c_nonneg : ∀ (x : ℝ), x ∈ Icc 0 (π / 2) → 0 ≤ cos x, from λ x hx, cos_nonneg_of_mem_Icc
    ((Icc_subset_Icc_left (neg_nonpos_of_nonneg pi_div_two_pos.le)) hx),
  have c_zero_pos : 0 < cos 0, by { rw cos_zero, exact zero_lt_one },
  have zero_mem : (0:ℝ) ∈ closure (interior (Icc 0 (π / 2))),
  { rw [interior_Icc, closure_Ioo pi_div_two_pos.ne, left_mem_Icc],
    exact pi_div_two_pos.le },
  exact tendsto_set_integral_pow_smul_of_unique_maximum_of_is_compact_of_continuous_on
    is_compact_Icc continuous_on_cos c_lt c_nonneg c_zero_pos zero_mem hf
end

/-- Euler's infinite product formula for the complex sine function. -/
lemma _root_.complex.tendsto_euler_sin_prod (z : ℂ) :
  tendsto (λ n:ℕ, ↑π * z * (∏ j in finset.range n, (1 - z ^ 2 / (j + 1) ^ 2)))
  at_top (𝓝 $ complex.sin (π * z)) :=
begin
  have A : tendsto (λ n:ℕ, ↑π * z * (∏ j in finset.range n, (1 - z ^ 2 / (j + 1) ^ 2)) *
    (∫ x in 0..π / 2, complex.cos (2 * z * x) * cos x ^ (2 * n)) /
    ↑∫ x in 0..π / 2, cos x ^ (2 * n))
    at_top (𝓝 $ _) := tendsto.congr (λ n, (sin_pi_mul_eq z n)) tendsto_const_nhds,
  have : 𝓝 (complex.sin (π * z)) = 𝓝 (complex.sin (π * z) * 1) := by rw mul_one,
  simp_rw [this, mul_div_assoc] at A,
  convert (tendsto_mul_iff_of_ne_zero _ one_ne_zero).mp A,
  suffices : tendsto (λ n:ℕ, (∫ x:ℝ in 0..π/2, complex.cos (2 * z * x) * cos x ^ n)
    / ↑(∫ x:ℝ in 0..π/2, cos x ^ n)) at_top (𝓝 1),
  from this.comp (tendsto_id.const_mul_at_top' zero_lt_two),
  have : continuous_on (λ x:ℝ, complex.cos (2 * z * x)) (Icc 0 (π/2)), from
    (complex.continuous_cos.comp (continuous_const.mul complex.continuous_of_real)).continuous_on,
  convert tendsto_integral_cos_pow_mul_div this,
  { ext1 n, congr' 2 with x:1, rw mul_comm },
  { rw [complex.of_real_zero, mul_zero, complex.cos_zero] },
end

/-- Euler's infinite product formula for the real sine function. -/
lemma _root_.real.tendsto_euler_sin_prod (x : ℝ) :
  tendsto (λ n:ℕ, π * x * (∏ j in finset.range n, (1 - x ^ 2 / (j + 1) ^ 2)))
  at_top (𝓝 $ sin (π * x)) :=
begin
  convert (complex.continuous_re.tendsto _).comp (complex.tendsto_euler_sin_prod x),
  { ext1 n,
    rw [function.comp_app, ←complex.of_real_mul, complex.of_real_mul_re],
    suffices : ∏ (j : ℕ) in finset.range n, (1 - (x:ℂ) ^ 2 / (↑j + 1) ^ 2) =
      ↑∏ (j : ℕ) in finset.range n, (1 - x ^ 2 / (↑j + 1) ^ 2), by rw [this, complex.of_real_re],
    rw complex.of_real_prod,
    refine finset.prod_congr (by refl) (λ n hn, _),
    norm_cast },
  { rw [←complex.of_real_mul, ←complex.of_real_sin, complex.of_real_re] }
end

end euler_sine


/-
Copyright (c) 2020 Johan Commelin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin

! This file was ported from Lean 3 source module algebra.group_with_zero.power
! leanprover-community/mathlib commit 46a64b5b4268c594af770c44d9e502afc6a515cb
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.GroupPower.Lemmas
import Mathlib.Data.Int.Bitwise

/-!
# Powers of elements of groups with an adjoined zero element

In this file we define integer power functions for groups with an adjoined zero element.
This generalises the integer power function on a division ring.
-/

section GroupWithZero

variable {G₀ : Type _} [GroupWithZero G₀] {a : G₀} {m n : ℕ}

section NatPow

theorem pow_sub₀ (a : G₀) {m n : ℕ} (ha : a ≠ 0) (h : n ≤ m) : a ^ (m - n) = a ^ m * (a ^ n)⁻¹ := by
  have h1 : m - n + n = m := tsub_add_cancel_of_le h
  have h2 : a ^ (m - n) * a ^ n = a ^ m := by rw [← pow_add, h1]
  simpa only [div_eq_mul_inv] using eq_div_of_mul_eq (pow_ne_zero _ ha) h2
#align pow_sub₀ pow_sub₀

theorem pow_sub_of_lt (a : G₀) {m n : ℕ} (h : n < m) : a ^ (m - n) = a ^ m * (a ^ n)⁻¹ := by
  obtain rfl | ha := eq_or_ne a 0
  · rw [zero_pow (tsub_pos_of_lt h), zero_pow (n.zero_le.trans_lt h), zero_mul]
  · exact pow_sub₀ _ ha h.le
#align pow_sub_of_lt pow_sub_of_lt

theorem pow_inv_comm₀ (a : G₀) (m n : ℕ) : a⁻¹ ^ m * a ^ n = a ^ n * a⁻¹ ^ m :=
  (Commute.refl a).inv_left₀.pow_pow m n
#align pow_inv_comm₀ pow_inv_comm₀

theorem inv_pow_sub₀ (ha : a ≠ 0) (h : n ≤ m) : a⁻¹ ^ (m - n) = (a ^ m)⁻¹ * a ^ n := by
  rw [pow_sub₀ _ (inv_ne_zero ha) h, inv_pow, inv_pow, inv_inv]
#align inv_pow_sub₀ inv_pow_sub₀

theorem inv_pow_sub_of_lt (a : G₀) (h : n < m) : a⁻¹ ^ (m - n) = (a ^ m)⁻¹ * a ^ n := by
  rw [pow_sub_of_lt a⁻¹ h, inv_pow, inv_pow, inv_inv]
#align inv_pow_sub_of_lt inv_pow_sub_of_lt

end NatPow

end GroupWithZero

section ZPow

open Int

variable {G₀ : Type _} [GroupWithZero G₀]

-- Porting note: removed `attribute [local ematch] le_of_lt`

theorem zero_zpow : ∀ z : ℤ, z ≠ 0 → (0 : G₀) ^ z = 0
  | (n : ℕ), h => by
    rw [zpow_ofNat, zero_pow']
    simpa using h
  | -[n+1], _ => by simp
#align zero_zpow zero_zpow

theorem zero_zpow_eq (n : ℤ) : (0 : G₀) ^ n = if n = 0 then 1 else 0 := by
  split_ifs with h
  · rw [h, zpow_zero]
  · rw [zero_zpow _ h]
#align zero_zpow_eq zero_zpow_eq

theorem zpow_add_one₀ {a : G₀} (ha : a ≠ 0) : ∀ n : ℤ, a ^ (n + 1) = a ^ n * a
  | (n : ℕ) => by simp only [← Int.ofNat_succ, zpow_ofNat, pow_succ']
  | -[0+1] => by erw [zpow_zero, zpow_negSucc, pow_one, inv_mul_cancel ha]
  | -[n + 1+1] => by
    rw [Int.negSucc_eq, zpow_neg, neg_add, neg_add_cancel_right, zpow_neg, ← Int.ofNat_succ,
      zpow_ofNat, zpow_ofNat, pow_succ _ (n + 1), mul_inv_rev, mul_assoc, inv_mul_cancel ha,
      mul_one]
#align zpow_add_one₀ zpow_add_one₀

theorem zpow_sub_one₀ {a : G₀} (ha : a ≠ 0) (n : ℤ) : a ^ (n - 1) = a ^ n * a⁻¹ :=
  calc
    a ^ (n - 1) = a ^ (n - 1) * a * a⁻¹ := by rw [mul_assoc, mul_inv_cancel ha, mul_one]
    _ = a ^ n * a⁻¹ := by rw [← zpow_add_one₀ ha, sub_add_cancel]
#align zpow_sub_one₀ zpow_sub_one₀

theorem zpow_add₀ {a : G₀} (ha : a ≠ 0) (m n : ℤ) : a ^ (m + n) = a ^ m * a ^ n := by
  induction' n using Int.induction_on with n ihn n ihn
  · simp
  · simp only [← add_assoc, zpow_add_one₀ ha, ihn, mul_assoc]
  · rw [zpow_sub_one₀ ha, ← mul_assoc, ← ihn, ← zpow_sub_one₀ ha, add_sub_assoc]
#align zpow_add₀ zpow_add₀

theorem zpow_add' {a : G₀} {m n : ℤ} (h : a ≠ 0 ∨ m + n ≠ 0 ∨ m = 0 ∧ n = 0) :
    a ^ (m + n) = a ^ m * a ^ n := by
  by_cases hm : m = 0
  · simp [hm]
  by_cases hn : n = 0
  · simp [hn]
  by_cases ha : a = 0
  · subst a
    simp only [false_or_iff, eq_self_iff_true, not_true, Ne.def, hm, hn, false_and_iff,
      or_false_iff] at h
    rw [zero_zpow _ h, zero_zpow _ hm, zero_mul]
  · exact zpow_add₀ ha m n
#align zpow_add' zpow_add'

theorem zpow_one_add₀ {a : G₀} (h : a ≠ 0) (i : ℤ) : a ^ (1 + i) = a * a ^ i := by
  rw [zpow_add₀ h, zpow_one]
#align zpow_one_add₀ zpow_one_add₀

theorem SemiconjBy.zpow_right₀ {a x y : G₀} (h : SemiconjBy a x y) :
    ∀ m : ℤ, SemiconjBy a (x ^ m) (y ^ m)
  | (n : ℕ) => by simp [h.pow_right n]
  | -[n+1] => by simp only [zpow_negSucc, (h.pow_right (n + 1)).inv_right₀]
#align semiconj_by.zpow_right₀ SemiconjBy.zpow_right₀

theorem Commute.zpow_right₀ {a b : G₀} (h : Commute a b) : ∀ m : ℤ, Commute a (b ^ m) :=
  SemiconjBy.zpow_right₀ h
#align commute.zpow_right₀ Commute.zpow_right₀

theorem Commute.zpow_left₀ {a b : G₀} (h : Commute a b) (m : ℤ) : Commute (a ^ m) b :=
  (h.symm.zpow_right₀ m).symm
#align commute.zpow_left₀ Commute.zpow_left₀

theorem Commute.zpow_zpow₀ {a b : G₀} (h : Commute a b) (m n : ℤ) : Commute (a ^ m) (b ^ n) :=
  (h.zpow_left₀ m).zpow_right₀ n
#align commute.zpow_zpow₀ Commute.zpow_zpow₀

theorem Commute.zpow_self₀ (a : G₀) (n : ℤ) : Commute (a ^ n) a :=
  (Commute.refl a).zpow_left₀ n
#align commute.zpow_self₀ Commute.zpow_self₀

theorem Commute.self_zpow₀ (a : G₀) (n : ℤ) : Commute a (a ^ n) :=
  (Commute.refl a).zpow_right₀ n
#align commute.self_zpow₀ Commute.self_zpow₀

theorem Commute.zpow_zpow_self₀ (a : G₀) (m n : ℤ) : Commute (a ^ m) (a ^ n) :=
  (Commute.refl a).zpow_zpow₀ m n
#align commute.zpow_zpow_self₀ Commute.zpow_zpow_self₀

set_option linter.deprecated false in
theorem zpow_bit1₀ (a : G₀) (n : ℤ) : a ^ bit1 n = a ^ n * a ^ n * a := by
  rw [← zpow_bit0, bit1, zpow_add', zpow_one]
  right; left
  apply bit1_ne_zero
#align zpow_bit1₀ zpow_bit1₀

theorem zpow_ne_zero_of_ne_zero {a : G₀} (ha : a ≠ 0) : ∀ z : ℤ, a ^ z ≠ 0
  | (_ : ℕ) => by
    rw [zpow_ofNat]
    exact pow_ne_zero _ ha
  | -[_+1] => by
    rw [zpow_negSucc]
    exact inv_ne_zero (pow_ne_zero _ ha)
#align zpow_ne_zero_of_ne_zero zpow_ne_zero_of_ne_zero

theorem zpow_sub₀ {a : G₀} (ha : a ≠ 0) (z1 z2 : ℤ) : a ^ (z1 - z2) = a ^ z1 / a ^ z2 := by
  rw [sub_eq_add_neg, zpow_add₀ ha, zpow_neg, div_eq_mul_inv]
#align zpow_sub₀ zpow_sub₀

set_option linter.deprecated false in
theorem zpow_bit1' (a : G₀) (n : ℤ) : a ^ bit1 n = (a * a) ^ n * a := by
  rw [zpow_bit1₀, (Commute.refl a).mul_zpow]
#align zpow_bit1' zpow_bit1'

theorem zpow_eq_zero {x : G₀} {n : ℤ} (h : x ^ n = 0) : x = 0 :=
  by_contradiction fun hx => zpow_ne_zero_of_ne_zero hx n h
#align zpow_eq_zero zpow_eq_zero

theorem zpow_eq_zero_iff {a : G₀} {n : ℤ} (hn : n ≠ 0) : a ^ n = 0 ↔ a = 0 :=
  ⟨zpow_eq_zero, fun ha => ha.symm ▸ zero_zpow _ hn⟩
#align zpow_eq_zero_iff zpow_eq_zero_iff

theorem zpow_ne_zero {x : G₀} (n : ℤ) : x ≠ 0 → x ^ n ≠ 0 :=
  mt zpow_eq_zero
#align zpow_ne_zero zpow_ne_zero

theorem zpow_neg_mul_zpow_self (n : ℤ) {x : G₀} (h : x ≠ 0) : x ^ (-n) * x ^ n = 1 := by
  rw [zpow_neg]
  exact inv_mul_cancel (zpow_ne_zero n h)
#align zpow_neg_mul_zpow_self zpow_neg_mul_zpow_self

end ZPow

section

variable {G₀ : Type _} [CommGroupWithZero G₀]

theorem div_sq_cancel (a b : G₀) : a ^ 2 * b / a = a * b := by
  by_cases ha : a = 0
  · simp [ha]
  rw [sq, mul_assoc, mul_div_cancel_left _ ha]
#align div_sq_cancel div_sq_cancel

end

/-- If a monoid homomorphism `f` between two `GroupWithZero`s maps `0` to `0`, then it maps `x^n`,
`n : ℤ`, to `(f x)^n`. -/
@[simp]
theorem map_zpow₀ {F G₀ G₀' : Type _} [GroupWithZero G₀] [GroupWithZero G₀']
    [MonoidWithZeroHomClass F G₀ G₀'] (f : F) (x : G₀) (n : ℤ) : f (x ^ n) = f x ^ n :=
  map_zpow' f (map_inv₀ f) x n
#align map_zpow₀ map_zpow₀