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

! This file was ported from Lean 3 source module tactic.cancel_denoms
! leanprover-community/mathlib commit eaa771fc4f5f356afeacac4ab92e0cbf10b0b1df
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Rat.MetaDefs
import Mathbin.Tactic.NormNum
import Mathbin.Data.Tree
import Mathbin.Meta.Expr

/-!
# A tactic for canceling numeric denominators

This file defines tactics that cancel numeric denominators from field expressions.

As an example, we want to transform a comparison `5*(a/3 + b/4) < c/3` into the equivalent
`5*(4*a + 3*b) < 4*c`.

## Implementation notes

The tooling here was originally written for `linarith`, not intended as an interactive tactic.
The interactive version has been split off because it is sometimes convenient to use on its own.
There are likely some rough edges to it.

Improving this tactic would be a good project for someone interested in learning tactic programming.
-/

namespace CancelFactors

/-! ### Lemmas used in the procedure -/

theorem mul_subst {α} [CommRing α] {n1 n2 k e1 e2 t1 t2 : α} (h1 : n1 * e1 = t1) (h2 : n2 * e2 = t2)
    (h3 : n1 * n2 = k) : k * (e1 * e2) = t1 * t2 := by
  rw [← h3, mul_comm n1, mul_assoc n2, ← mul_assoc n1, h1, ← mul_assoc n2, mul_comm n2, mul_assoc,
    h2]
#align cancel_factors.mul_subst CancelFactors.mul_subst

theorem div_subst {α} [Field α] {n1 n2 k e1 e2 t1 : α} (h1 : n1 * e1 = t1) (h2 : n2 / e2 = 1)
    (h3 : n1 * n2 = k) : k * (e1 / e2) = t1 := by
  rw [← h3, mul_assoc, mul_div_left_comm, h2, ← mul_assoc, h1, mul_comm, one_mul]
#align cancel_factors.div_subst CancelFactors.div_subst

theorem cancel_factors_eq_div {α} [Field α] {n e e' : α} (h : n * e = e') (h2 : n ≠ 0) :
    e = e' / n :=
  eq_div_of_mul_eq h2 <| by rwa [mul_comm] at h
#align cancel_factors.cancel_factors_eq_div CancelFactors.cancel_factors_eq_div

theorem add_subst {α} [Ring α] {n e1 e2 t1 t2 : α} (h1 : n * e1 = t1) (h2 : n * e2 = t2) :
    n * (e1 + e2) = t1 + t2 := by simp [left_distrib, *]
#align cancel_factors.add_subst CancelFactors.add_subst

theorem sub_subst {α} [Ring α] {n e1 e2 t1 t2 : α} (h1 : n * e1 = t1) (h2 : n * e2 = t2) :
    n * (e1 - e2) = t1 - t2 := by simp [left_distrib, *, sub_eq_add_neg]
#align cancel_factors.sub_subst CancelFactors.sub_subst

theorem neg_subst {α} [Ring α] {n e t : α} (h1 : n * e = t) : n * -e = -t := by simp [*]
#align cancel_factors.neg_subst CancelFactors.neg_subst

theorem cancel_factors_lt {α} [LinearOrderedField α] {a b ad bd a' b' gcd : α} (ha : ad * a = a')
    (hb : bd * b = b') (had : 0 < ad) (hbd : 0 < bd) (hgcd : 0 < gcd) :
    (a < b) = (1 / gcd * (bd * a') < 1 / gcd * (ad * b')) :=
  by
  rw [mul_lt_mul_left, ← ha, ← hb, ← mul_assoc, ← mul_assoc, mul_comm bd, mul_lt_mul_left]
  exact mul_pos had hbd
  exact one_div_pos.2 hgcd
#align cancel_factors.cancel_factors_lt CancelFactors.cancel_factors_lt

theorem cancel_factors_le {α} [LinearOrderedField α] {a b ad bd a' b' gcd : α} (ha : ad * a = a')
    (hb : bd * b = b') (had : 0 < ad) (hbd : 0 < bd) (hgcd : 0 < gcd) :
    (a ≤ b) = (1 / gcd * (bd * a') ≤ 1 / gcd * (ad * b')) :=
  by
  rw [mul_le_mul_left, ← ha, ← hb, ← mul_assoc, ← mul_assoc, mul_comm bd, mul_le_mul_left]
  exact mul_pos had hbd
  exact one_div_pos.2 hgcd
#align cancel_factors.cancel_factors_le CancelFactors.cancel_factors_le

theorem cancel_factors_eq {α} [LinearOrderedField α] {a b ad bd a' b' gcd : α} (ha : ad * a = a')
    (hb : bd * b = b') (had : 0 < ad) (hbd : 0 < bd) (hgcd : 0 < gcd) :
    (a = b) = (1 / gcd * (bd * a') = 1 / gcd * (ad * b')) :=
  by
  rw [← ha, ← hb, ← mul_assoc bd, ← mul_assoc ad, mul_comm bd]
  ext; constructor
  · rintro rfl
    rfl
  · intro h
    simp only [← mul_assoc] at h
    refine' mul_left_cancel₀ (mul_ne_zero _ _) h
    apply mul_ne_zero
    apply div_ne_zero
    all_goals apply ne_of_gt <;> first |assumption|exact zero_lt_one
#align cancel_factors.cancel_factors_eq CancelFactors.cancel_factors_eq

open Tactic Expr

/-! ### Computing cancelation factors -/

open Tree

-- failed to format: unknown constant 'term.pseudo.antiquot'
/--
      `find_cancel_factor e` produces a natural number `n`, such that multiplying `e` by `n` will
      be able to cancel all the numeric denominators in `e`. The returned `tree` describes how to
      distribute the value `n` over products inside `e`.
      -/
    unsafe
  def
    find_cancel_factor
    : expr → ℕ × Tree ℕ
    |
        q( $ ( e1 ) + $ ( e2 ) )
        =>
        let
          ( v1 , t1 ) := find_cancel_factor e1
          let ( v2 , t2 ) := find_cancel_factor e2 let lcm := v1 . lcm v2 ( lcm , node lcm t1 t2 )
      |
        q( $ ( e1 ) - $ ( e2 ) )
        =>
        let
          ( v1 , t1 ) := find_cancel_factor e1
          let ( v2 , t2 ) := find_cancel_factor e2 let lcm := v1 . lcm v2 ( lcm , node lcm t1 t2 )
      |
        q( $ ( e1 ) * $ ( e2 ) )
        =>
        let
          ( v1 , t1 ) := find_cancel_factor e1
          let ( v2 , t2 ) := find_cancel_factor e2 let pd := v1 * v2 ( pd , node pd t1 t2 )
      |
        q( $ ( e1 ) / $ ( e2 ) )
        =>
        match
          e2 . to_nonneg_rat
          with
          |
              some q
              =>
              let
                ( v1 , t1 ) := find_cancel_factor e1
                let
                  n := v1 . lcm q . num . natAbs
                  ( n , node n t1 ( node q . num . natAbs Tree.nil Tree.nil ) )
            | none => ( 1 , node 1 Tree.nil Tree.nil )
      | q( - $ ( e ) ) => find_cancel_factor e
      | _ => ( 1 , node 1 Tree.nil Tree.nil )
#align cancel_factors.find_cancel_factor cancel_factors.find_cancel_factor

/- ./././Mathport/Syntax/Translate/Expr.lean:330:4: warning: unsupported (TODO): `[tacs] -/
/- ./././Mathport/Syntax/Translate/Expr.lean:330:4: warning: unsupported (TODO): `[tacs] -/
/- ./././Mathport/Syntax/Translate/Expr.lean:330:4: warning: unsupported (TODO): `[tacs] -/
-- failed to format: unknown constant 'term.pseudo.antiquot'
/--
      `mk_prod_prf n tr e` produces a proof of `n*e = e'`, where numeric denominators have been
      canceled in `e'`, distributing `n` proportionally according to `tr`.
      -/
    unsafe
  def
    mk_prod_prf
    : ℕ → Tree ℕ → expr → tactic expr
    |
        v , node _ lhs rhs , q( $ ( e1 ) + $ ( e2 ) )
        =>
        do
          let v1 ← mk_prod_prf v lhs e1
            let v2 ← mk_prod_prf v rhs e2
            mk_app ` ` add_subst [ v1 , v2 ]
      |
        v , node _ lhs rhs , q( $ ( e1 ) - $ ( e2 ) )
        =>
        do
          let v1 ← mk_prod_prf v lhs e1
            let v2 ← mk_prod_prf v rhs e2
            mk_app ` ` sub_subst [ v1 , v2 ]
      |
        v , node n ( lhs @ ( node ln _ _ ) ) rhs , q( $ ( e1 ) * $ ( e2 ) )
        =>
        do
          let tp ← infer_type e1
            let v1 ← mk_prod_prf ln lhs e1
            let v2 ← mk_prod_prf ( v / ln ) rhs e2
            let ln' ← tp . ofNat ln
            let vln' ← tp . ofNat ( v / ln )
            let v' ← tp . ofNat v
            let ntp ← to_expr ` `( $ ( ln' ) * $ ( vln' ) = $ ( v' ) )
            let ( _ , npf ) ← solve_aux ntp sorry
            mk_app ` ` mul_subst [ v1 , v2 , npf ]
      |
        v , node n lhs rhs @ ( node rn _ _ ) , q( $ ( e1 ) / $ ( e2 ) )
        =>
        do
          let tp ← infer_type e1
            let v1 ← mk_prod_prf ( v / rn ) lhs e1
            let rn' ← tp . ofNat rn
            let vrn' ← tp . ofNat ( v / rn )
            let n' ← tp . ofNat n
            let v' ← tp . ofNat v
            let ntp ← to_expr ` `( $ ( rn' ) / $ ( e2 ) = 1 )
            let ( _ , npf ) ← solve_aux ntp sorry
            let ntp2 ← to_expr ` `( $ ( vrn' ) * $ ( n' ) = $ ( v' ) )
            let ( _ , npf2 ) ← solve_aux ntp2 sorry
            mk_app ` ` div_subst [ v1 , npf , npf2 ]
      | v , t , q( - $ ( e ) ) => do let v' ← mk_prod_prf v t e mk_app ` ` neg_subst [ v' ]
      |
        v , _ , e
        =>
        do
          let tp ← infer_type e
            let v' ← tp . ofNat v
            let e' ← to_expr ` `( $ ( v' ) * $ ( e ) )
            mk_app `eq.refl [ e' ]
#align cancel_factors.mk_prod_prf cancel_factors.mk_prod_prf

/--
Given `e`, a term with rational division, produces a natural number `n` and a proof of `n*e = e'`,
where `e'` has no division. Assumes "well-behaved" division.
-/
unsafe def derive (e : expr) : tactic (ℕ × expr) :=
  let (n, t) := find_cancel_factor e
  Prod.mk n <$> mk_prod_prf n t e <|>
    throwError
      "cancel_factors.derive failed to normalize {← e}. Are you sure this is well-behaved division?"
#align cancel_factors.derive cancel_factors.derive

/- ./././Mathport/Syntax/Translate/Expr.lean:330:4: warning: unsupported (TODO): `[tacs] -/
-- failed to format: unknown constant 'term.pseudo.antiquot'
/--
      Given `e`, a term with rational divison, produces a natural number `n` and a proof of `e = e' / n`,
      where `e'` has no divison. Assumes "well-behaved" division.
      -/
    unsafe
  def
    derive_div
    ( e : expr ) : tactic ( ℕ × expr )
    :=
      do
        let ( n , p ) ← derive e
          let tp ← infer_type e
          let n' ← tp . ofNat n
          let tgt ← to_expr ` `( $ ( n' ) ≠ 0 )
          let ( _ , pn ) ← solve_aux tgt sorry
          Prod.mk n
            <$>
            mk_mapp ` ` cancel_factors_eq_div [ none , none , n' , none , none , p , pn ]
#align cancel_factors.derive_div cancel_factors.derive_div

-- failed to format: unknown constant 'term.pseudo.antiquot'
/--
      `find_comp_lemma e` arranges `e` in the form `lhs R rhs`, where `R ∈ {<, ≤, =}`, and returns
      `lhs`, `rhs`, and the `cancel_factors` lemma corresponding to `R`.
      -/
    unsafe
  def
    find_comp_lemma
    : expr → Option ( expr × expr × Name )
    | q( $ ( a ) < $ ( b ) ) => ( a , b , ` ` cancel_factors_lt )
      | q( $ ( a ) ≤ $ ( b ) ) => ( a , b , ` ` cancel_factors_le )
      | q( $ ( a ) = $ ( b ) ) => ( a , b , ` ` cancel_factors_eq )
      | q( $ ( a ) ≥ $ ( b ) ) => ( b , a , ` ` cancel_factors_le )
      | q( $ ( a ) > $ ( b ) ) => ( b , a , ` ` cancel_factors_lt )
      | _ => none
#align cancel_factors.find_comp_lemma cancel_factors.find_comp_lemma

/- ./././Mathport/Syntax/Translate/Expr.lean:330:4: warning: unsupported (TODO): `[tacs] -/
/- ./././Mathport/Syntax/Translate/Expr.lean:330:4: warning: unsupported (TODO): `[tacs] -/
/- ./././Mathport/Syntax/Translate/Expr.lean:330:4: warning: unsupported (TODO): `[tacs] -/
/-- `cancel_denominators_in_type h` assumes that `h` is of the form `lhs R rhs`,
where `R ∈ {<, ≤, =, ≥, >}`.
It produces an expression `h'` of the form `lhs' R rhs'` and a proof that `h = h'`.
Numeric denominators have been canceled in `lhs'` and `rhs'`.
-/
unsafe def cancel_denominators_in_type (h : expr) : tactic (expr × expr) := do
  let some (lhs, rhs, lem) ← return <| find_comp_lemma h |
    fail "cannot kill factors"
  let (al, lhs_p) ← derive lhs
  let (ar, rhs_p) ← derive rhs
  let gcd := al.gcd ar
  let tp ← infer_type lhs
  let al ← tp.ofNat al
  let ar ← tp.ofNat ar
  let gcd ← tp.ofNat gcd
  let al_pos ← to_expr ``(0 < $(al))
  let ar_pos ← to_expr ``(0 < $(ar))
  let gcd_pos ← to_expr ``(0 < $(gcd))
  let (_, al_pos) ← solve_aux al_pos sorry
  let (_, ar_pos) ← solve_aux ar_pos sorry
  let (_, gcd_pos) ← solve_aux gcd_pos sorry
  let pf ← mk_app lem [lhs_p, rhs_p, al_pos, ar_pos, gcd_pos]
  let pf_tp ← infer_type pf
  return ((find_comp_lemma pf_tp).elim default (Prod.fst ∘ Prod.snd), pf)
#align cancel_factors.cancel_denominators_in_type cancel_factors.cancel_denominators_in_type

end CancelFactors

/-! ### Interactive version -/

/- ./././Mathport/Syntax/Translate/Tactic/Mathlib/Core.lean:38:34: unsupported: setup_tactic_parser -/
open Tactic Expr CancelFactors

/-- `cancel_denoms` attempts to remove numerals from the denominators of fractions.
It works on propositions that are field-valued inequalities.

```lean
variables {α : Type} [linear_ordered_field α] (a b c : α)

example (h : a / 5 + b / 4 < c) : 4*a + 5*b < 20*c :=
begin
  cancel_denoms at h,
  exact h
end

example (h : a > 0) : a / 5 > 0 :=
begin
  cancel_denoms,
  exact h
end
```
-/
unsafe def tactic.interactive.cancel_denoms (l : parse location) : tactic Unit := do
  let locs ← l.get_locals
  tactic.replace_at cancel_denominators_in_type locs l >>= guardb <|>
      fail "failed to cancel any denominators"
  tactic.interactive.norm_num [simp_arg_type.symm_expr ``(mul_assoc)] l
#align tactic.interactive.cancel_denoms tactic.interactive.cancel_denoms

add_tactic_doc
  { Name := "cancel_denoms"
    category := DocCategory.tactic
    declNames := [`tactic.interactive.cancel_denoms]
    tags := ["simplification"] }


/-
Copyright (c) 2018 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro

Additional equiv and encodable instances for lists, finsets, and fintypes.
-/
import data.equiv.denumerable
import data.finset.sort

open nat list

namespace encodable
variables {α : Type*}

section list
variable [encodable α]

def encode_list : list α → ℕ
| []     := 0
| (a::l) := succ (mkpair (encode a) (encode_list l))

def decode_list : ℕ → option (list α)
| 0        := some []
| (succ v) := match unpair v, unpair_le_right v with
  | (v₁, v₂), h :=
    have v₂ < succ v, from lt_succ_of_le h,
    (::) <$> decode α v₁ <*> decode_list v₂
  end

instance list : encodable (list α) :=
⟨encode_list, decode_list, λ l,
  by induction l with a l IH; simp [encode_list, decode_list, unpair_mkpair, encodek, *]⟩

@[simp] theorem encode_list_nil : encode (@nil α) = 0 := rfl
@[simp] theorem encode_list_cons (a : α) (l : list α) :
  encode (a :: l) = succ (mkpair (encode a) (encode l)) := rfl

@[simp] theorem decode_list_zero : decode (list α) 0 = some [] :=
show decode_list 0 = some [], by rw decode_list

@[simp] theorem decode_list_succ (v : ℕ) :
  decode (list α) (succ v) =
  (::) <$> decode α v.unpair.1 <*> decode (list α) v.unpair.2 :=
show decode_list (succ v) = _, begin
  cases e : unpair v with v₁ v₂,
  simp [decode_list, e], refl
end

theorem length_le_encode : ∀ (l : list α), length l ≤ encode l
| [] := _root_.zero_le _
| (a :: l) := succ_le_succ $
  le_trans (length_le_encode l) (le_mkpair_right _ _)

end list

section finset
variables [encodable α]

private def enle : α → α → Prop := encode ⁻¹'o (≤)

private lemma enle.is_linear_order : is_linear_order α enle :=
(rel_embedding.preimage ⟨encode, encode_injective⟩ (≤)).is_linear_order

private def decidable_enle (a b : α) : decidable (enle a b) :=
by unfold enle order.preimage; apply_instance

local attribute [instance] enle.is_linear_order decidable_enle

def encode_multiset (s : multiset α) : ℕ :=
encode (s.sort enle)

def decode_multiset (n : ℕ) : option (multiset α) :=
coe <$> decode (list α) n

instance multiset : encodable (multiset α) :=
⟨encode_multiset, decode_multiset,
 λ s, by simp [encode_multiset, decode_multiset, encodek]⟩

end finset

def encodable_of_list [decidable_eq α] (l : list α) (H : ∀ x, x ∈ l) : encodable α :=
⟨λ a, index_of a l, l.nth, λ a, index_of_nth (H _)⟩

def trunc_encodable_of_fintype (α : Type*) [decidable_eq α] [fintype α] : trunc (encodable α) :=
@@quot.rec_on_subsingleton _
  (λ s : multiset α, (∀ x:α, x ∈ s) → trunc (encodable α)) _
  finset.univ.1
  (λ l H, trunc.mk $ encodable_of_list l H)
  finset.mem_univ

/-- A noncomputable way to arbitrarily choose an ordering on a finite type.
  It is not made into a global instance, since it involves an arbitrary choice.
  This can be locally made into an instance with `local attribute [instance] fintype.encodable`. -/
noncomputable def fintype.encodable (α : Type*) [fintype α] : encodable α :=
by { classical, exact (encodable.trunc_encodable_of_fintype α).out }

instance vector [encodable α] {n} : encodable (vector α n) :=
encodable.subtype

instance fin_arrow [encodable α] {n} : encodable (fin n → α) :=
of_equiv _ (equiv.vector_equiv_fin _ _).symm

instance fin_pi (n) (π : fin n → Type*) [∀i, encodable (π i)] : encodable (Πi, π i) :=
of_equiv _ (equiv.pi_equiv_subtype_sigma (fin n) π)

instance array [encodable α] {n} : encodable (array n α) :=
of_equiv _ (equiv.array_equiv_fin _ _)

instance finset [encodable α] : encodable (finset α) :=
by haveI := decidable_eq_of_encodable α; exact
 of_equiv {s : multiset α // s.nodup}
  ⟨λ ⟨a, b⟩, ⟨a, b⟩, λ⟨a, b⟩, ⟨a, b⟩, λ ⟨a, b⟩, rfl, λ⟨a, b⟩, rfl⟩

def fintype_arrow (α : Type*) (β : Type*) [decidable_eq α] [fintype α] [encodable β] :
  trunc (encodable (α → β)) :=
(fintype.trunc_equiv_fin α).map $
  λf, encodable.of_equiv (fin (fintype.card α) → β) $
  equiv.arrow_congr f (equiv.refl _)

def fintype_pi (α : Type*) (π : α → Type*) [decidable_eq α] [fintype α] [∀a, encodable (π a)] :
  trunc (encodable (Πa, π a)) :=
(encodable.trunc_encodable_of_fintype α).bind $ λa,
  (@fintype_arrow α (Σa, π a) _ _ (@encodable.sigma _ _ a _)).bind $ λf,
  trunc.mk $ @encodable.of_equiv _ _ (@encodable.subtype _ _ f _) (equiv.pi_equiv_subtype_sigma α π)

/-- The elements of a `fintype` as a sorted list. -/
def sorted_univ (α) [fintype α] [encodable α] : list α :=
finset.univ.sort (encodable.encode' α ⁻¹'o (≤))

theorem mem_sorted_univ {α} [fintype α] [encodable α] (x : α) : x ∈ sorted_univ α :=
(finset.mem_sort _).2 (finset.mem_univ _)

theorem length_sorted_univ {α} [fintype α] [encodable α] :
  (sorted_univ α).length = fintype.card α :=
finset.length_sort _

theorem sorted_univ_nodup {α} [fintype α] [encodable α] : (sorted_univ α).nodup :=
finset.sort_nodup _ _

/-- An encodable `fintype` is equivalent a `fin`.-/
def fintype_equiv_fin {α} [fintype α] [encodable α] :
  α ≃ fin (fintype.card α) :=
begin
  haveI : decidable_eq α := encodable.decidable_eq_of_encodable _,
  transitivity,
  { exact fintype.equiv_fin_of_forall_mem_list mem_sorted_univ (@sorted_univ_nodup α _ _) },
  exact equiv.cast (congr_arg _ (@length_sorted_univ α _ _))
end

instance fintype_arrow_of_encodable {α β : Type*} [encodable α] [fintype α] [encodable β] :
  encodable (α → β) :=
of_equiv (fin (fintype.card α) → β) $ equiv.arrow_congr fintype_equiv_fin (equiv.refl _)

end encodable

namespace denumerable
variables {α : Type*} {β : Type*} [denumerable α] [denumerable β]
open encodable

section list

theorem denumerable_list_aux : ∀ n : ℕ,
  ∃ a ∈ @decode_list α _ n, encode_list a = n
| 0        := by rw decode_list; exact ⟨_, rfl, rfl⟩
| (succ v) := begin
  cases e : unpair v with v₁ v₂,
  have h := unpair_le_right v,
  rw e at h,
  rcases have v₂ < succ v, from lt_succ_of_le h,
    denumerable_list_aux v₂ with ⟨a, h₁, h₂⟩,
  simp at h₁,
  simp [decode_list, e, h₂, h₁, encode_list, mkpair_unpair' e]
end

instance denumerable_list : denumerable (list α) := ⟨denumerable_list_aux⟩

@[simp] theorem list_of_nat_zero : of_nat (list α) 0 = [] :=
by rw [← @encode_list_nil α, of_nat_encode]

@[simp] theorem list_of_nat_succ (v : ℕ) :
  of_nat (list α) (succ v) =
  of_nat α v.unpair.1 :: of_nat (list α) v.unpair.2 :=
of_nat_of_decode $ show decode_list (succ v) = _,
begin
  cases e : unpair v with v₁ v₂,
  simp [decode_list, e],
  rw [show decode_list v₂ = decode (list α) v₂,
      from rfl, decode_eq_of_nat]; refl
end

end list

section multiset

def lower : list ℕ → ℕ → list ℕ
| []       n := []
| (m :: l) n := (m - n) :: lower l m

def raise : list ℕ → ℕ → list ℕ
| []       n := []
| (m :: l) n := (m + n) :: raise l (m + n)

lemma lower_raise : ∀ l n, lower (raise l n) n = l
| []       n := rfl
| (m :: l) n := by simp [raise, lower, nat.add_sub_cancel, lower_raise]

lemma raise_lower : ∀ {l n}, list.sorted (≤) (n :: l) → raise (lower l n) n = l
| []       n h := rfl
| (m :: l) n h :=
  have n ≤ m, from list.rel_of_sorted_cons h _ (l.mem_cons_self _),
  by simp [raise, lower, nat.sub_add_cancel this,
           raise_lower (list.sorted_of_sorted_cons h)]

lemma raise_chain : ∀ l n, list.chain (≤) n (raise l n)
| []       n := list.chain.nil
| (m :: l) n := list.chain.cons (nat.le_add_left _ _) (raise_chain _ _)

lemma raise_sorted : ∀ l n, list.sorted (≤) (raise l n)
| []       n := list.sorted_nil
| (m :: l) n := (list.chain_iff_pairwise (@le_trans _ _)).1 (raise_chain _ _)

/- Warning: this is not the same encoding as used in `encodable` -/
instance multiset : denumerable (multiset α) := mk' ⟨
  λ s : multiset α, encode $ lower ((s.map encode).sort (≤)) 0,
  λ n, multiset.map (of_nat α) (raise (of_nat (list ℕ) n) 0),
  λ s, by have := raise_lower
      (list.sorted_cons.2 ⟨λ n _, zero_le n, (s.map encode).sort_sorted _⟩);
    simp [-multiset.coe_map, this],
  λ n, by simp [-multiset.coe_map, list.merge_sort_eq_self _ (raise_sorted _ _), lower_raise]⟩

end multiset

section finset

def lower' : list ℕ → ℕ → list ℕ
| []       n := []
| (m :: l) n := (m - n) :: lower' l (m + 1)

def raise' : list ℕ → ℕ → list ℕ
| []       n := []
| (m :: l) n := (m + n) :: raise' l (m + n + 1)

lemma lower_raise' : ∀ l n, lower' (raise' l n) n = l
| []       n := rfl
| (m :: l) n := by simp [raise', lower', nat.add_sub_cancel, lower_raise']

lemma raise_lower' : ∀ {l n}, (∀ m ∈ l, n ≤ m) → list.sorted (<) l → raise' (lower' l n) n = l
| []       n h₁ h₂ := rfl
| (m :: l) n h₁ h₂ :=
  have n ≤ m, from h₁ _ (l.mem_cons_self _),
  by simp [raise', lower', nat.sub_add_cancel this, raise_lower'
    (list.rel_of_sorted_cons h₂ : ∀ a ∈ l, m < a) (list.sorted_of_sorted_cons h₂)]

lemma raise'_chain : ∀ l {m n}, m < n → list.chain (<) m (raise' l n)
| []       m n h := list.chain.nil
| (a :: l) m n h := list.chain.cons
  (lt_of_lt_of_le h (nat.le_add_left _ _)) (raise'_chain _ (lt_succ_self _))

lemma raise'_sorted : ∀ l n, list.sorted (<) (raise' l n)
| []       n := list.sorted_nil
| (m :: l) n := (list.chain_iff_pairwise (@lt_trans _ _)).1
  (raise'_chain _ (lt_succ_self _))

def raise'_finset (l : list ℕ) (n : ℕ) : finset ℕ :=
⟨raise' l n, (raise'_sorted _ _).imp (@ne_of_lt _ _)⟩

/- Warning: this is not the same encoding as used in `encodable` -/
instance finset : denumerable (finset α) := mk' ⟨
  λ s : finset α, encode $ lower' ((s.map (eqv α).to_embedding).sort (≤)) 0,
  λ n, finset.map (eqv α).symm.to_embedding (raise'_finset (of_nat (list ℕ) n) 0),
  λ s, finset.eq_of_veq $ by simp [-multiset.coe_map, raise'_finset,
    raise_lower' (λ n _, zero_le n) (finset.sort_sorted_lt _)],
  λ n, by simp [-multiset.coe_map, finset.map, raise'_finset, finset.sort,
    list.merge_sort_eq_self (≤) ((raise'_sorted _ _).imp (@le_of_lt _ _)),
    lower_raise']⟩

end finset

end denumerable

namespace equiv

/-- The type lists on unit is canonically equivalent to the natural numbers. -/
def list_unit_equiv : list unit ≃ ℕ :=
{ to_fun := list.length,
  inv_fun := list.repeat (),
  left_inv := λ u, list.length_injective (by simp),
  right_inv := λ n, list.length_repeat () n }

def list_nat_equiv_nat : list ℕ ≃ ℕ := denumerable.eqv _

def list_equiv_self_of_equiv_nat {α : Type} (e : α ≃ ℕ) : list α ≃ α :=
calc list α ≃ list ℕ : list_equiv_of_equiv e
        ... ≃ ℕ      : list_nat_equiv_nat
        ... ≃ α      : e.symm
end equiv


import data.mv_polynomial

-- workaround for the "open_locale at top of file" issue in Lean 3
example : ℕ := 37

open_locale classical

lemma sum.rec_comp_left (X : Type*) (Y : Type*) (β : Type*) (γ : Type*)
  (i : β → X) (j : γ → X) (f : X → Y) (x : β ⊕ γ) :
  f (sum.rec i j x) = sum.rec (f ∘ i) (f ∘ j) x := by cases x; refl

namespace mv_polynomial

/-- Evaluating the constant polynomial 1 anywhere gives 1 -/
theorem eval_one {X : Type*} {R : Type*} [comm_semiring R]
  (x : X → R) : eval x 1 = 1 := eval_C _

-- this must be done somewhere else because the analogue is
-- in the polynomial namespace
theorem eval_pow {X : Type*} {R : Type*} [comm_semiring R]
  (f : mv_polynomial X R) (m : ℕ) (x : X → R) :
eval x (f ^ m) = (eval x f)^m :=
begin
  induction m with d hd,
    rw pow_zero,
    rw pow_zero,
    rw eval_one,
  rw pow_succ,
  rw pow_succ,
  rw eval_mul,
  rw hd,
end

end mv_polynomial

namespace polynomial

-- Thanks to Johan Commelin for doing a bunch of the eval stuff below.

/-- Over an infinite integral domain a polynomial f is zero if it
    evaluates to zero everywhere -/
lemma eval_eq_zero
  {k : Type*} [integral_domain k] [infinite k] {f : polynomial k}
  (H : ∀ x, polynomial.eval x f = 0) : f = 0 :=
begin
  rcases infinite.exists_not_mem_finset (roots f) with ⟨x, hx⟩,
  contrapose! hx with hf,
  rw mem_roots hf,
  apply H,
end

/-- Over an infinite integral domain a polynomial f is zero iff it
    evaluates to zero everywhere -/
lemma eval_eq_zero_iff
  {k : Type*} [integral_domain k] [infinite k] {f : polynomial k} :
  (∀ x, polynomial.eval x f = 0) ↔ f = 0 :=
⟨polynomial.eval_eq_zero, by { rintro rfl x, exact rfl }⟩

end polynomial

def fin.equiv_empty : fin 0 ≃ empty :=
{ to_fun := λ i, false.elim $ nat.not_lt_zero _ i.2,
  inv_fun := empty.elim,
  left_inv := λ i, false.elim $ nat.not_lt_zero _ i.2,
  right_inv := λ x, x.elim }

def fin.equiv_pempty : fin 0 ≃ pempty :=
{ to_fun := λ i, false.elim $ nat.not_lt_zero _ i.2,
  inv_fun := pempty.elim,
  left_inv := λ i, false.elim $ nat.not_lt_zero _ i.2,
  right_inv := λ x, x.elim }

namespace mv_polynomial

@[simp] lemma eval_rename
  {k : Type*} [comm_semiring k]
  {m : Type*} {n : Type*} (e : m → n) (f : mv_polynomial m k) (x) :
  eval x (rename e f) = eval (x ∘ e) f :=
by apply f.induction_on; { intros, simp * }

lemma equiv_eval_eq_zero
  {k : Type*} [comm_semiring k]
  {m : Type*} {n : Type*} (e : m ≃ n)
  (H : (∀ f : mv_polynomial m k, (∀ x, eval x f = 0) → f = 0))
  (f : mv_polynomial n k) (hf : ∀ x, eval x f = 0) : f = 0 :=
begin
  let φ := ring_equiv_of_equiv k e,
  suffices h : φ.symm f = 0, { simpa using congr_arg φ h },
  apply H,
  intro x,
  show eval x (rename e.symm f) = 0,
  simp [hf],
end

end mv_polynomial

universe variables u v

def equiv.option {X : Type u} {Y : Type v} (e : X ≃ Y) : option X ≃ option Y :=
{ to_fun := option.map e,
  inv_fun := option.map e.symm,
  left_inv := λ x, by { cases x, refl, simp },
  right_inv :=  λ x, by { cases x, refl, simp } }

/-- n ↦ none -/
def fin_succ_equiv_option' (n : ℕ) : fin (n+1) ≃ option (fin n) :=
{ to_fun := λ x, if h : x.1 < n then some ⟨_, h⟩ else none,
  inv_fun := λ x, option.rec_on x ⟨n, nat.lt_succ_self _⟩ $
    λ x, ⟨x.1, lt_trans x.2 $ nat.lt_succ_self _⟩,
  left_inv := λ x,
  begin
    cases x with x hx,
    rw [nat.lt_succ_iff, le_iff_lt_or_eq] at hx,
    cases hx with hx hx,
    { dsimp, rw dif_pos hx},
    { dsimp, rw dif_neg _, cases hx, refl, apply not_lt_of_le, cases hx, refl}
  end,
  right_inv := begin
    intro x,
    cases x with x,
    { dsimp, rw dif_neg, apply lt_irrefl},
    dsimp,
    cases x with x hx,
    rw dif_pos hx,
  end }

/-- 0 ↦ none-/
def fin_succ_equiv_option (n : ℕ) : fin (n+1) ≃ option (fin n) :=
{ to_fun := λ x, if h : x.1 = 0 then none else some ⟨x.1 - 1, begin
    rw nat.sub_lt_left_iff_lt_add,
      convert x.2 using 1, apply add_comm,
    exact nat.pos_of_ne_zero h,
  end⟩,
  inv_fun := λ x, option.rec ⟨0, nat.zero_lt_succ _⟩
    (λ y, ⟨y.1 + 1, add_lt_add_right y.2 1⟩) x,
  left_inv :=
  begin
    rintro ⟨⟨x⟩, hx⟩,
      refl,
    dsimp,
    rw dif_neg,
      simp,
    apply nat.succ_ne_zero
  end,
  right_inv := begin
    rintro (_ | ⟨x, h⟩),
      refl,
    dsimp,
    rw dif_neg,
      simp,
    apply nat.succ_ne_zero
  end }

lemma fintype.induction {P : Π (X : Type*) [fintype X], Prop}
  (h0 : P pempty) (hs : ∀ (X : Type*) [fintype X], P X → P (option X))
  (he : ∀ {X Y : Type*} [fintype X] [fintype Y] (e : X ≃ Y), P X → P Y)
  (X : Type*) [fintype X] : P X :=
begin
  rcases fintype.exists_equiv_fin X with ⟨n, ⟨e⟩⟩,
  apply he (equiv.ulift.trans e.symm), clear e,
  induction n with n ih,
  { exact he (equiv.ulift.trans fin.equiv_pempty).symm h0 },
  { specialize hs _ ih,
    apply he _ hs,
    refine (equiv.ulift.trans _).symm,
    refine (fin_succ_equiv_option n).trans _,
    refine equiv.ulift.option.symm }
end

/-
mv_polynomial.option_equiv_right :
-- mv_polynomial (option β) α ≃+* mv_polynomial β (polynomial α)

it's built from

. mv_polynomial.ring_equiv_of_equiv
. mv_polynomial.sum_ring_equiv
. mv_polynomial.ring_equiv_congr

glued together with

. ring_equiv.trans
-/

namespace mv_polynomial

attribute [simp] sum_to_iter_Xr sum_to_iter_Xl sum_to_iter_C

@[simp] theorem option_equiv_right_X_none {α β} [comm_semiring α] :
  option_equiv_right α β (X none) = C polynomial.X :=
show map (eval₂ polynomial.C (λu:punit, polynomial.X))
  (sum_to_iter α β unit
    (rename (equiv.option_equiv_sum_punit._match_1 β)
      (X none))) = C polynomial.X,
by simp

@[simp] theorem option_equiv_right_X_some {α β} [comm_semiring α] (b : β) :
  option_equiv_right α β (X (some b)) = X b :=
show map (eval₂ polynomial.C (λu:punit, polynomial.X))
  (sum_to_iter α β unit
    (rename (equiv.option_equiv_sum_punit._match_1 β)
      (X (some b)))) = X b,
by simp

@[simp] theorem option_equiv_right_C {α β} [comm_semiring α] (a : α) :
  option_equiv_right α β (C a) = C (polynomial.C a) :=
show map (eval₂ polynomial.C (λu:punit, polynomial.X))
  (sum_to_iter α β unit
    (rename (equiv.option_equiv_sum_punit._match_1 β)
      (C a))) = C (polynomial.C a),
by simp

/-
Mario Carneiro: I also brute forced my way through several other definitions
here, that should have definitional lemmas: ring_equiv_of_equiv,
option_equiv_sum_punit (the definition should not be simp), sum_comm (ditto),
sum_ring_equiv, punit_ring_equiv

Mario Carneiro: Ideally this proof should be dunfold option_equiv_right; simp
-/

theorem eval₂_eval₂ (R : Type*) [comm_semiring R] (β : Type*) (γ : Type*)
(S : Type*) [comm_semiring S] (f : R → S) [is_semiring_hom f]
(i : β → S) (j : γ → S) (p : mv_polynomial β (mv_polynomial γ R)) :
eval₂ (eval₂ f j) i p = eval i (map (eval₂ f j) p) :=
hom_eq_hom _ _ (by apply_instance) (by apply_instance)
  (λ _, by rw [eval₂_C, map_C, eval_C]) (λ _, by rw [eval₂_X, map_X, eval_X]) p

set_option class.instance_max_depth 100
theorem map_eval₂' {R : Type*} [comm_semiring R] {β : Type*} {γ : Type*}
  {S : Type*} [comm_semiring S] {f : R → S} [is_semiring_hom f]
  {j : γ → S} {p : mv_polynomial β (mv_polynomial γ R)} :
  map (eval₂ f j) p = eval₂ (C ∘ f) (λ n, sum.rec X (C ∘ j) n) (iter_to_sum _ _ _ p) :=
begin
  rw iter_to_sum,
  rw eval₂_eval₂,
  rw ←eval₂_eq_eval_map,
  apply hom_eq_hom, apply_instance, apply_instance,
  { intro b,
    suffices : (C (eval₂ f j b) : mv_polynomial β S) =
      eval₂ (C ∘ f) (λ n, sum.rec X (C ∘ j) n) (eval₂ C (X ∘ sum.inr) b),
    simpa using this,
    rw ←rename,
    rw eval₂_rename,
    rw [show ((λ (n : β ⊕ γ), sum.rec X (C ∘ j) n) ∘ sum.inr : γ → mv_polynomial β S) = C ∘ j,
      by funext b; refl],
    apply eval₂_comp_left},
  { intro b,
    simp},
end

theorem eval₂_eval₂' (R : Type*) [comm_semiring R] (β : Type*) (γ : Type*)
(S : Type*) [comm_semiring S] (f : R → S) [is_semiring_hom f]
(i : β → S) (j : γ → S) (p : mv_polynomial β (mv_polynomial γ R)) :
eval₂ (eval₂ f j) i p = eval₂ f (λ n, sum.rec i j n) (iter_to_sum _ _ _ p) :=
begin
  rw eval₂_eval₂,
  rw map_eval₂',
  generalize : iter_to_sum _ _ _ p = p',
  apply hom_eq_hom _ _ _ _ _ _ p',
    apply_instance, apply_instance, apply_instance,
  { intro r,
    rw [eval₂_C, eval₂_C, eval_C]},
  { rintro (b | c),
    { simp},
    { simp},
  }
end

/-- Over an infinite integral domain a polynomial f in finitely many
    variables is zero if it evaluates to zero everywhere -/
lemma fin_eval_eq_zero
  {k : Type*} [int : integral_domain k] [inf : infinite k]
  {n : Type*} [fin : fintype n] :
  ∀ {f : mv_polynomial n k}, (∀ x, eval x f = 0) → f = 0 :=
begin
  unfreezeI,
  revert inf int k,
  revert fin n,
  refine fintype.induction _ _ _,
  { intros k int inf f H,
    have h : (pempty_ring_equiv k) f = 0 := H _,
    replace h := congr_arg (pempty_ring_equiv k).symm h,
    rw [ring_equiv.symm_apply_apply] at h,
    convert h, symmetry, exact ring_equiv.map_zero _ },
  { intros n _ ih k int inf f hf,
    set φ := option_equiv_right k n with hφ,
    suffices h : φ f = 0, { simpa using congr_arg φ.symm h },
    apply ih,
    { intro x,
      apply polynomial.eval_eq_zero,
      intro xoo,
      let xo : option n → k :=
        λ j, option.rec xoo (λ i, polynomial.eval xoo (x i)) j,
        convert hf xo,
        rw hφ,
        apply hom_eq_hom _ _ _ _ _ _ f,
          apply_instance, apply_instance, apply_instance,
        { intro a,
          rw eval_C,
          simp},
        { intro xn,
          cases xn with xn hxn,
          { simp },
          { simp },
        }
      },
    { resetI,
      apply infinite.of_injective polynomial.C,
      swap, assumption,
      intros x y h, exact polynomial.C_inj.1 h,
    } },
  { intros m n _ _ e H k int inf f,
    apply mv_polynomial.equiv_eval_eq_zero e,
    apply @H }
end
.

-- no longer sure if I even care about `vars`.
lemma mem_vars_iff_mem_degrees {R : Type*} [comm_semiring R] {σ : Type*}
  {p : mv_polynomial σ R} {n : σ} : n ∈ vars p ↔ n ∈ degrees p :=
multiset.mem_to_finset

-- Chris Hughes' alternative definition of `mv_polynomial.vars` using `bind`.
-- I have no idea whether this should be noncomputable.
/-- `vars' p` is the set of variables appearing in the polynomial `p`.
    It's probably the same as `vars p`. -/
noncomputable def vars' {R : Type*} {σ : Type*} [comm_semiring R]
  (p : mv_polynomial σ R) :
finset σ :=
p.support.bind finsupp.support

-- things which might need proving?

-- I will need to learn the interface for finsupp to do this one
-- Remark: I think only need φ 0 = 0, not semiring hom, but coeff_map wanted it.
lemma vars_map_sub {R : Type*} [comm_semiring R] {S : Type*} [comm_semiring S]
  {σ : Type*} {φ : R → S} [is_semiring_hom φ] {p : mv_polynomial σ R} :
vars' (map φ p) ⊆ vars' p :=
begin
  intros i hi,
  unfold vars' at hi ⊢,
  rw finset.mem_bind at hi ⊢,
  rcases hi with ⟨s, hs, his⟩,
  use s,
  existsi _, exact his, clear his i,
  simp,
  intro hps,
  dunfold mv_polynomial at p,
  have hps' : φ (p.to_fun s) = 0,
    convert is_semiring_hom.map_zero _, assumption,
  revert hs,
  simp,
  intro h1,
  apply h1,
  convert hps',
  change mv_polynomial σ R at p,
  change (map φ p).coeff s = φ (p.coeff s),
  apply coeff_map,
end

-- Thanks to Chris for this one

lemma eval₂_eq_of_eq_on_vars {R : Type*} [comm_semiring R]
  {S : Type*} [comm_semiring S] {σ : Type*}
  (f g : σ → S) (φ : R → S) (p : mv_polynomial σ R)
  [is_semiring_hom φ] -- do we need this??
  (h : ∀ i ∈ vars' p, f i = g i) :
eval₂ φ f p = eval₂ φ g p :=
begin
  unfold eval₂,
  unfold finsupp.sum finsupp.prod,
  refine finset.sum_congr rfl _,
  intros x hx,
  congr' 1,
  refine finset.prod_congr rfl _,
  intros i hi,
  simp only [vars', finset.mem_bind, exists_imp_distrib] at h,
  have := h i x hx hi,
  rw this,
end

-- KB practicing.
example {R : Type*} [comm_semiring R]
  {S : Type*} [comm_semiring S] {σ : Type*}
  (f g : σ → S) (φ : R → S) (p : mv_polynomial σ R)
  [is_semiring_hom φ] -- do we need this??
  (h : ∀ i ∈ vars' p, f i = g i) :
eval₂ φ f p = eval₂ φ g p :=
begin
  unfold eval₂,
  unfold finsupp.prod finsupp.sum,
  rw finset.sum_congr rfl,
  intros x hx,
  congr' 1,
  rw finset.prod_congr rfl,
  intros i hi,
  rw h,
  unfold vars',
  rw finset.mem_bind,
  use x,
  use hx,
  assumption,
end

def eq_sum_monomial_coeff {R : Type*} [comm_semiring R] {σ : Type*}
{p : mv_polynomial σ R} :
finset.sum p.support (λ s, monomial s (p.coeff s)) = p :=
begin
  apply mv_polynomial.ext,
  intro s,
  rw coeff_sum,
  simp only [coeff_monomial],
  by_cases hs : s ∈ p.support,
  { rw ←finset.sum_subset (show {s} ⊆ p.support, begin
      intros i hi,
      convert hs,
      cases hi, assumption, cases hi
    end),
    swap,
    { intros t ht hts,
      rw if_neg,
      intro hts2,
      apply hts,
      rw hts2,
      apply set.mem_singleton,
    },
    convert finset.sum_singleton,
    rw if_pos,
    refl
  },
  { rw ←finset.sum_subset (finset.empty_subset p.support),
    swap,
    { intros t ht1 ht2,
      rw if_neg,
      intro hts,
      apply hs,
      rwa hts at ht1,
    },
    rw finset.sum_empty,
    rw finsupp.not_mem_support_iff at hs,
    exact hs.symm
  }
end

/- Is this a sensible thing to prove?

lemma mem_rename_range {R : Type*} [comm_semiring R]
  {σ τ : Type*} {g : σ → τ} (p : mv_polynomial τ R)
  (h : (vars' p).to_set ⊆ set.range g) :
  ∃ q : mv_polynomial σ R, rename g q = p := sorry

-/

lemma preimage_subtype_range {R : Type*} [comm_semiring R]
  {σ : Type*} (p : mv_polynomial σ R) :
  ∃ q : mv_polynomial {i : σ // i ∈ p.vars'} R, rename subtype.val q = p :=
begin
  use finset.sum p.support
    (λ s,
      monomial (finsupp.comap_domain subtype.val s (λ _ _ _ _, subtype.eq))
        (p.coeff s)),
  apply mv_polynomial.ext,
  intro s,
  rw ←finset.sum_hom p.support (rename subtype.val),
    all_goals {try {apply_instance}},
  rw coeff_sum,
  conv begin to_rhs,
  rw ←@eq_sum_monomial_coeff _ _ _ p,
  end,
  rw coeff_sum,
  apply finset.sum_congr rfl,
  intros t ht,
  rw coeff_monomial,
  rw rename_monomial,
  rw coeff_monomial,
  congr',
  rw finsupp.map_domain_comap_domain, intros i j, exact subtype.eq,
  suffices : t.support ⊆ vars' p, by simpa,
  unfold vars',
  intros i hi,
  rw finset.mem_bind,
  use t,
  use ht,
  assumption,
end

-- We know `fin_eval_eq_zero` from above, which is the below
-- theorem in the special case where `n` is finite.
-- We now use it to prove the general case.

/-- Over an infinite integral domain a polynomial f is zero iff it
    evaluates to zero everywhere -/
lemma eval_eq_zero  {k : Type*} [integral_domain k] [infinite k]
  {σ : Type*} {p : mv_polynomial σ k} :
(∀ x, eval x p = 0) ↔ p = 0 :=
begin
  split, swap, intros hf x, rw [hf, eval_zero], -- easy direction
  intro hev,
  cases preimage_subtype_range p with q hq,
  suffices : q = 0,
    rw this at hq, rw ←hq, apply is_semiring_hom.map_zero,
  apply fin_eval_eq_zero,
  intro s₀,
  set s : σ → k := λ i, if hi : i ∈ p.vars' then s₀ ⟨i, hi⟩ else 0 with hs,
  have hs₀ : s₀ = s ∘ subtype.val,
    ext i,
    rw hs,
    dsimp, split_ifs, simp, cases i, contradiction,
  rw hs₀,
  rw ←eval_rename,
  rw hq,
  apply hev,
end

-- finset.sum p.support (λ s, monomial s (p.coeff s)) = p :=

end mv_polynomial


/-
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, Aaron Anderson

-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.algebra.gcd_monoid
import Mathlib.ring_theory.integral_domain
import Mathlib.ring_theory.noetherian
import Mathlib.PostPort

universes u_2 l u_1 u

namespace Mathlib

/--

# Unique factorization

## Main Definitions
* `wf_dvd_monoid` holds for `monoid`s for which a strict divisibility relation is
  well-founded.
* `unique_factorization_monoid` holds for `wf_dvd_monoid`s where
  `irreducible` is equivalent to `prime`

## To do
* set up the complete lattice structure on `factor_set`.

-/
/-- Well-foundedness of the strict version of |, which is equivalent to the descending chain
condition on divisibility and to the ascending chain condition on
principal ideals in an integral domain.
  -/
class wf_dvd_monoid (α : Type u_2) [comm_monoid_with_zero α] where
  well_founded_dvd_not_unit : well_founded dvd_not_unit

protected instance is_noetherian_ring.wf_dvd_monoid {α : Type u_1} [integral_domain α]
    [is_noetherian_ring α] : wf_dvd_monoid α :=
  wf_dvd_monoid.mk
    (eq.mpr
      ((fun (r r_1 : α → α → Prop) (e_1 : r = r_1) => congr_arg well_founded e_1) dvd_not_unit
        (inv_image gt fun (a : α) => ideal.span (singleton a))
        (funext
          fun (x : α) =>
            funext fun (x_1 : α) => propext (iff.symm ideal.span_singleton_lt_span_singleton)))
      (inv_image.wf (fun (a : α) => ideal.span (singleton a)) (well_founded_submodule_gt α α)))

namespace wf_dvd_monoid

theorem of_wf_dvd_monoid_associates {α : Type u_1} [comm_monoid_with_zero α]
    (h : wf_dvd_monoid (associates α)) : wf_dvd_monoid α :=
  sorry

protected instance wf_dvd_monoid_associates {α : Type u_1} [comm_monoid_with_zero α]
    [wf_dvd_monoid α] : wf_dvd_monoid (associates α) :=
  mk
    (iff.mp
      (surjective.well_founded_iff associates.mk_surjective
        fun (a b : α) =>
          eq.mpr
            (id
              (Eq._oldrec
                (Eq.refl (dvd_not_unit a b ↔ dvd_not_unit (associates.mk a) (associates.mk b)))
                (propext associates.mk_dvd_not_unit_mk_iff)))
            (iff.refl (dvd_not_unit a b)))
      well_founded_dvd_not_unit)

theorem well_founded_associates {α : Type u_1} [comm_monoid_with_zero α] [wf_dvd_monoid α] :
    well_founded Less :=
  subrelation.wf (fun (x y : associates α) => associates.dvd_not_unit_of_lt)
    well_founded_dvd_not_unit

theorem exists_irreducible_factor {α : Type u_1} [comm_monoid_with_zero α] [wf_dvd_monoid α] {a : α}
    (ha : ¬is_unit a) (ha0 : a ≠ 0) : ∃ (i : α), irreducible i ∧ i ∣ a :=
  sorry

theorem induction_on_irreducible {α : Type u_1} [comm_monoid_with_zero α] [wf_dvd_monoid α]
    {P : α → Prop} (a : α) (h0 : P 0) (hu : ∀ (u : α), is_unit u → P u)
    (hi : ∀ (a i : α), a ≠ 0 → irreducible i → P a → P (i * a)) : P a :=
  sorry

theorem exists_factors {α : Type u_1} [comm_monoid_with_zero α] [wf_dvd_monoid α] (a : α) :
    a ≠ 0 →
        ∃ (f : multiset α), (∀ (b : α), b ∈ f → irreducible b) ∧ associated (multiset.prod f) a :=
  sorry

end wf_dvd_monoid

theorem wf_dvd_monoid.of_well_founded_associates {α : Type u_1} [comm_cancel_monoid_with_zero α]
    (h : well_founded Less) : wf_dvd_monoid α :=
  sorry

theorem wf_dvd_monoid.iff_well_founded_associates {α : Type u_1} [comm_cancel_monoid_with_zero α] :
    wf_dvd_monoid α ↔ well_founded Less :=
  { mp := wf_dvd_monoid.well_founded_associates, mpr := wf_dvd_monoid.of_well_founded_associates }

/-- unique factorization monoids.

These are defined as `comm_cancel_monoid_with_zero`s with well-founded strict divisibility
relations, but this is equivalent to more familiar definitions:

Each element (except zero) is uniquely represented as a multiset of irreducible factors.
Uniqueness is only up to associated elements.

Each element (except zero) is non-uniquely represented as a multiset
of prime factors.

To define a UFD using the definition in terms of multisets
of irreducible factors, use the definition `of_exists_unique_irreducible_factors`

To define a UFD using the definition in terms of multisets
of prime factors, use the definition `of_exists_prime_factors`

-/
class unique_factorization_monoid (α : Type u_2) [comm_cancel_monoid_with_zero α]
    extends wf_dvd_monoid α where
  irreducible_iff_prime : ∀ {a : α}, irreducible a ↔ prime a

protected instance ufm_of_gcd_of_wf_dvd_monoid {α : Type u_1} [nontrivial α]
    [comm_cancel_monoid_with_zero α] [wf_dvd_monoid α] [gcd_monoid α] :
    unique_factorization_monoid α :=
  unique_factorization_monoid.mk fun (_x : α) => gcd_monoid.irreducible_iff_prime

protected instance associates.ufm {α : Type u_1} [comm_cancel_monoid_with_zero α]
    [unique_factorization_monoid α] : unique_factorization_monoid (associates α) :=
  unique_factorization_monoid.mk
    (eq.mpr
      (id
        (Eq._oldrec (Eq.refl (∀ {a : associates α}, irreducible a ↔ prime a))
          (Eq.symm (propext associates.irreducible_iff_prime_iff))))
      unique_factorization_monoid.irreducible_iff_prime)

namespace unique_factorization_monoid

theorem exists_prime_factors {α : Type u_1} [comm_cancel_monoid_with_zero α]
    [unique_factorization_monoid α] (a : α) :
    a ≠ 0 → ∃ (f : multiset α), (∀ (b : α), b ∈ f → prime b) ∧ associated (multiset.prod f) a :=
  sorry

theorem induction_on_prime {α : Type u_1} [comm_cancel_monoid_with_zero α]
    [unique_factorization_monoid α] {P : α → Prop} (a : α) (h₁ : P 0)
    (h₂ : ∀ (x : α), is_unit x → P x) (h₃ : ∀ (a p : α), a ≠ 0 → prime p → P a → P (p * a)) : P a :=
  sorry

theorem factors_unique {α : Type u_1} [comm_cancel_monoid_with_zero α]
    [unique_factorization_monoid α] {f : multiset α} {g : multiset α} :
    (∀ (x : α), x ∈ f → irreducible x) →
        (∀ (x : α), x ∈ g → irreducible x) →
          associated (multiset.prod f) (multiset.prod g) → multiset.rel associated f g :=
  sorry

end unique_factorization_monoid

theorem prime_factors_unique {α : Type u_1} [comm_cancel_monoid_with_zero α] {f : multiset α}
    {g : multiset α} :
    (∀ (x : α), x ∈ f → prime x) →
        (∀ (x : α), x ∈ g → prime x) →
          associated (multiset.prod f) (multiset.prod g) → multiset.rel associated f g :=
  sorry

/-- If an irreducible has a prime factorization,
  then it is an associate of one of its prime factors. -/
theorem prime_factors_irreducible {α : Type u_1} [comm_cancel_monoid_with_zero α] {a : α}
    {f : multiset α} (ha : irreducible a)
    (pfa : (∀ (b : α), b ∈ f → prime b) ∧ associated (multiset.prod f) a) :
    ∃ (p : α), associated a p ∧ f = p ::ₘ 0 :=
  sorry

theorem wf_dvd_monoid.of_exists_prime_factors {α : Type u_1} [comm_cancel_monoid_with_zero α]
    (pf :
      ∀ (a : α),
        a ≠ 0 → ∃ (f : multiset α), (∀ (b : α), b ∈ f → prime b) ∧ associated (multiset.prod f) a) :
    wf_dvd_monoid α :=
  sorry

theorem irreducible_iff_prime_of_exists_prime_factors {α : Type u_1}
    [comm_cancel_monoid_with_zero α]
    (pf :
      ∀ (a : α),
        a ≠ 0 → ∃ (f : multiset α), (∀ (b : α), b ∈ f → prime b) ∧ associated (multiset.prod f) a)
    {p : α} : irreducible p ↔ prime p :=
  sorry

theorem unique_factorization_monoid.of_exists_prime_factors {α : Type u_1}
    [comm_cancel_monoid_with_zero α]
    (pf :
      ∀ (a : α),
        a ≠ 0 → ∃ (f : multiset α), (∀ (b : α), b ∈ f → prime b) ∧ associated (multiset.prod f) a) :
    unique_factorization_monoid α :=
  unique_factorization_monoid.mk fun (_x : α) => irreducible_iff_prime_of_exists_prime_factors pf

theorem unique_factorization_monoid.iff_exists_prime_factors {α : Type u_1}
    [comm_cancel_monoid_with_zero α] :
    unique_factorization_monoid α ↔
        ∀ (a : α),
          a ≠ 0 →
            ∃ (f : multiset α), (∀ (b : α), b ∈ f → prime b) ∧ associated (multiset.prod f) a :=
  { mp :=
      fun (h : unique_factorization_monoid α) => unique_factorization_monoid.exists_prime_factors,
    mpr := unique_factorization_monoid.of_exists_prime_factors }

theorem irreducible_iff_prime_of_exists_unique_irreducible_factors {α : Type u_1}
    [comm_cancel_monoid_with_zero α]
    (eif :
      ∀ (a : α),
        a ≠ 0 →
          ∃ (f : multiset α), (∀ (b : α), b ∈ f → irreducible b) ∧ associated (multiset.prod f) a)
    (uif :
      ∀ (f g : multiset α),
        (∀ (x : α), x ∈ f → irreducible x) →
          (∀ (x : α), x ∈ g → irreducible x) →
            associated (multiset.prod f) (multiset.prod g) → multiset.rel associated f g)
    (p : α) : irreducible p ↔ prime p :=
  sorry

theorem unique_factorization_monoid.of_exists_unique_irreducible_factors {α : Type u_1}
    [comm_cancel_monoid_with_zero α]
    (eif :
      ∀ (a : α),
        a ≠ 0 →
          ∃ (f : multiset α), (∀ (b : α), b ∈ f → irreducible b) ∧ associated (multiset.prod f) a)
    (uif :
      ∀ (f g : multiset α),
        (∀ (x : α), x ∈ f → irreducible x) →
          (∀ (x : α), x ∈ g → irreducible x) →
            associated (multiset.prod f) (multiset.prod g) → multiset.rel associated f g) :
    unique_factorization_monoid α :=
  sorry

namespace unique_factorization_monoid

/-- Noncomputably determines the multiset of prime factors. -/
def factors {α : Type u_1} [comm_cancel_monoid_with_zero α] [DecidableEq α] [nontrivial α]
    [normalization_monoid α] [unique_factorization_monoid α] (a : α) : multiset α :=
  dite (a = 0) (fun (h : a = 0) => 0)
    fun (h : ¬a = 0) => multiset.map (⇑normalize) (classical.some (exists_prime_factors a h))

theorem factors_prod {α : Type u_1} [comm_cancel_monoid_with_zero α] [DecidableEq α] [nontrivial α]
    [normalization_monoid α] [unique_factorization_monoid α] {a : α} (ane0 : a ≠ 0) :
    associated (multiset.prod (factors a)) a :=
  sorry

theorem prime_of_factor {α : Type u_1} [comm_cancel_monoid_with_zero α] [DecidableEq α]
    [nontrivial α] [normalization_monoid α] [unique_factorization_monoid α] {a : α} (x : α) :
    x ∈ factors a → prime x :=
  sorry

theorem irreducible_of_factor {α : Type u_1} [comm_cancel_monoid_with_zero α] [DecidableEq α]
    [nontrivial α] [normalization_monoid α] [unique_factorization_monoid α] {a : α} (x : α) :
    x ∈ factors a → irreducible x :=
  fun (h : x ∈ factors a) => irreducible_of_prime (prime_of_factor x h)

theorem normalize_factor {α : Type u_1} [comm_cancel_monoid_with_zero α] [DecidableEq α]
    [nontrivial α] [normalization_monoid α] [unique_factorization_monoid α] {a : α} (x : α) :
    x ∈ factors a → coe_fn normalize x = x :=
  sorry

theorem factors_irreducible {α : Type u_1} [comm_cancel_monoid_with_zero α] [DecidableEq α]
    [nontrivial α] [normalization_monoid α] [unique_factorization_monoid α] {a : α}
    (ha : irreducible a) : factors a = coe_fn normalize a ::ₘ 0 :=
  sorry

theorem exists_mem_factors_of_dvd {α : Type u_1} [comm_cancel_monoid_with_zero α] [DecidableEq α]
    [nontrivial α] [normalization_monoid α] [unique_factorization_monoid α] {a : α} {p : α}
    (ha0 : a ≠ 0) (hp : irreducible p) : p ∣ a → ∃ (q : α), ∃ (H : q ∈ factors a), associated p q :=
  sorry

@[simp] theorem factors_zero {α : Type u_1} [comm_cancel_monoid_with_zero α] [DecidableEq α]
    [nontrivial α] [normalization_monoid α] [unique_factorization_monoid α] : factors 0 = 0 :=
  dif_pos rfl

@[simp] theorem factors_one {α : Type u_1} [comm_cancel_monoid_with_zero α] [DecidableEq α]
    [nontrivial α] [normalization_monoid α] [unique_factorization_monoid α] : factors 1 = 0 :=
  sorry

@[simp] theorem factors_mul {α : Type u_1} [comm_cancel_monoid_with_zero α] [DecidableEq α]
    [nontrivial α] [normalization_monoid α] [unique_factorization_monoid α] {x : α} {y : α}
    (hx : x ≠ 0) (hy : y ≠ 0) : factors (x * y) = factors x + factors y :=
  sorry

@[simp] theorem factors_pow {α : Type u_1} [comm_cancel_monoid_with_zero α] [DecidableEq α]
    [nontrivial α] [normalization_monoid α] [unique_factorization_monoid α] {x : α} (n : ℕ) :
    factors (x ^ n) = n •ℕ factors x :=
  sorry

theorem dvd_iff_factors_le_factors {α : Type u_1} [comm_cancel_monoid_with_zero α] [DecidableEq α]
    [nontrivial α] [normalization_monoid α] [unique_factorization_monoid α] {x : α} {y : α}
    (hx : x ≠ 0) (hy : y ≠ 0) : x ∣ y ↔ factors x ≤ factors y :=
  sorry

end unique_factorization_monoid

namespace unique_factorization_monoid

/-- Noncomputably defines a `normalization_monoid` structure on a `unique_factorization_monoid`. -/
protected def normalization_monoid {α : Type u_1} [comm_cancel_monoid_with_zero α] [nontrivial α]
    [unique_factorization_monoid α] : normalization_monoid α :=
  normalization_monoid_of_monoid_hom_right_inverse
    (monoid_hom.mk
      (fun (a : associates α) =>
        ite (a = 0) 0 (multiset.prod (multiset.map (classical.some sorry) (factors a))))
      sorry sorry)
    sorry

protected instance normalization_monoid.inhabited {α : Type u_1} [comm_cancel_monoid_with_zero α]
    [nontrivial α] [unique_factorization_monoid α] : Inhabited (normalization_monoid α) :=
  { default := unique_factorization_monoid.normalization_monoid }

end unique_factorization_monoid

namespace unique_factorization_monoid

theorem no_factors_of_no_prime_factors {R : Type u_2} [comm_cancel_monoid_with_zero R]
    [unique_factorization_monoid R] {a : R} {b : R} (ha : a ≠ 0)
    (h : ∀ {d : R}, d ∣ a → d ∣ b → ¬prime d) {d : R} : d ∣ a → d ∣ b → is_unit d :=
  sorry

/-- Euclid's lemma: if `a ∣ b * c` and `a` and `c` have no common prime factors, `a ∣ b`.
Compare `is_coprime.dvd_of_dvd_mul_left`. -/
theorem dvd_of_dvd_mul_left_of_no_prime_factors {R : Type u_2} [comm_cancel_monoid_with_zero R]
    [unique_factorization_monoid R] {a : R} {b : R} {c : R} (ha : a ≠ 0) :
    (∀ {d : R}, d ∣ a → d ∣ c → ¬prime d) → a ∣ b * c → a ∣ b :=
  sorry

/-- Euclid's lemma: if `a ∣ b * c` and `a` and `b` have no common prime factors, `a ∣ c`.
Compare `is_coprime.dvd_of_dvd_mul_right`. -/
theorem dvd_of_dvd_mul_right_of_no_prime_factors {R : Type u_2} [comm_cancel_monoid_with_zero R]
    [unique_factorization_monoid R] {a : R} {b : R} {c : R} (ha : a ≠ 0)
    (no_factors : ∀ {d : R}, d ∣ a → d ∣ b → ¬prime d) : a ∣ b * c → a ∣ c :=
  sorry

/-- If `a ≠ 0, b` are elements of a unique factorization domain, then dividing
out their common factor `c'` gives `a'` and `b'` with no factors in common. -/
theorem exists_reduced_factors {R : Type u_2} [comm_cancel_monoid_with_zero R]
    [unique_factorization_monoid R] (a : R) (H : a ≠ 0) (b : R) :
    ∃ (a' : R),
        ∃ (b' : R),
          ∃ (c' : R), (∀ {d : R}, d ∣ a' → d ∣ b' → is_unit d) ∧ c' * a' = a ∧ c' * b' = b :=
  sorry

theorem exists_reduced_factors' {R : Type u_2} [comm_cancel_monoid_with_zero R]
    [unique_factorization_monoid R] (a : R) (b : R) (hb : b ≠ 0) :
    ∃ (a' : R),
        ∃ (b' : R),
          ∃ (c' : R), (∀ {d : R}, d ∣ a' → d ∣ b' → is_unit d) ∧ c' * a' = a ∧ c' * b' = b :=
  sorry

theorem le_multiplicity_iff_repeat_le_factors {R : Type u_2} [comm_cancel_monoid_with_zero R]
    [unique_factorization_monoid R] [nontrivial R] [normalization_monoid R] [DecidableEq R]
    [DecidableRel has_dvd.dvd] {a : R} {b : R} {n : ℕ} (ha : irreducible a) (hb : b ≠ 0) :
    ↑n ≤ multiplicity a b ↔ multiset.repeat (coe_fn normalize a) n ≤ factors b :=
  sorry

theorem multiplicity_eq_count_factors {R : Type u_2} [comm_cancel_monoid_with_zero R]
    [unique_factorization_monoid R] [nontrivial R] [normalization_monoid R] [DecidableEq R]
    [DecidableRel has_dvd.dvd] {a : R} {b : R} (ha : irreducible a) (hb : b ≠ 0) :
    multiplicity a b = ↑(multiset.count (coe_fn normalize a) (factors b)) :=
  sorry

end unique_factorization_monoid

namespace associates

/-- `factor_set α` representation elements of unique factorization domain as multisets.
`multiset α` produced by `factors` are only unique up to associated elements, while the multisets in
`factor_set α` are unqiue by equality and restricted to irreducible elements. This gives us a
representation of each element as a unique multisets (or the added ⊤ for 0), which has a complete
lattice struture. Infimum is the greatest common divisor and supremum is the least common multiple.
-/
def factor_set (α : Type u) [comm_cancel_monoid_with_zero α] :=
  with_top (multiset (Subtype fun (a : associates α) => irreducible a))

theorem factor_set.coe_add {α : Type u_1} [comm_cancel_monoid_with_zero α]
    {a : multiset (Subtype fun (a : associates α) => irreducible a)}
    {b : multiset (Subtype fun (a : associates α) => irreducible a)} : ↑(a + b) = ↑a + ↑b :=
  sorry

theorem factor_set.sup_add_inf_eq_add {α : Type u_1} [comm_cancel_monoid_with_zero α]
    [DecidableEq (associates α)] (a : factor_set α) (b : factor_set α) : a ⊔ b + a ⊓ b = a + b :=
  sorry

/-- Evaluates the product of a `factor_set` to be the product of the corresponding multiset,
  or `0` if there is none. -/
def factor_set.prod {α : Type u_1} [comm_cancel_monoid_with_zero α] : factor_set α → associates α :=
  sorry

@[simp] theorem prod_top {α : Type u_1} [comm_cancel_monoid_with_zero α] : factor_set.prod ⊤ = 0 :=
  rfl

@[simp] theorem prod_coe {α : Type u_1} [comm_cancel_monoid_with_zero α]
    {s : multiset (Subtype fun (a : associates α) => irreducible a)} :
    factor_set.prod ↑s = multiset.prod (multiset.map coe s) :=
  rfl

@[simp] theorem prod_add {α : Type u_1} [comm_cancel_monoid_with_zero α] (a : factor_set α)
    (b : factor_set α) : factor_set.prod (a + b) = factor_set.prod a * factor_set.prod b :=
  sorry

theorem prod_mono {α : Type u_1} [comm_cancel_monoid_with_zero α] {a : factor_set α}
    {b : factor_set α} : a ≤ b → factor_set.prod a ≤ factor_set.prod b :=
  sorry

/-- `bcount p s` is the multiplicity of `p` in the factor_set `s` (with bundled `p`)-/
def bcount {α : Type u_1} [comm_cancel_monoid_with_zero α] [DecidableEq (associates α)]
    (p : Subtype fun (a : associates α) => irreducible a) : factor_set α → ℕ :=
  sorry

/-- `count p s` is the multiplicity of the irreducible `p` in the factor_set `s`.

If `p` is not irreducible, `count p s` is defined to be `0`. -/
def count {α : Type u_1} [comm_cancel_monoid_with_zero α]
    [dec_irr : (p : associates α) → Decidable (irreducible p)] [DecidableEq (associates α)]
    (p : associates α) : factor_set α → ℕ :=
  dite (irreducible p) (fun (hp : irreducible p) => bcount { val := p, property := hp })
    fun (hp : ¬irreducible p) => 0

@[simp] theorem count_some {α : Type u_1} [comm_cancel_monoid_with_zero α]
    [dec_irr : (p : associates α) → Decidable (irreducible p)] [DecidableEq (associates α)]
    {p : associates α} (hp : irreducible p)
    (s : multiset (Subtype fun (a : associates α) => irreducible a)) :
    count p (some s) = multiset.count { val := p, property := hp } s :=
  sorry

@[simp] theorem count_zero {α : Type u_1} [comm_cancel_monoid_with_zero α]
    [dec_irr : (p : associates α) → Decidable (irreducible p)] [DecidableEq (associates α)]
    {p : associates α} (hp : irreducible p) : count p 0 = 0 :=
  sorry

theorem count_reducible {α : Type u_1} [comm_cancel_monoid_with_zero α]
    [dec_irr : (p : associates α) → Decidable (irreducible p)] [DecidableEq (associates α)]
    {p : associates α} (hp : ¬irreducible p) : count p = 0 :=
  dif_neg hp

/-- membership in a factor_set (bundled version) -/
def bfactor_set_mem {α : Type u_1} [comm_cancel_monoid_with_zero α] :
    (Subtype fun (a : associates α) => irreducible a) → factor_set α → Prop :=
  sorry

/-- `factor_set_mem p s` is the predicate that the irreducible `p` is a member of `s : factor_set α`.

If `p` is not irreducible, `p` is not a member of any `factor_set`. -/
def factor_set_mem {α : Type u_1} [comm_cancel_monoid_with_zero α]
    [dec_irr : (p : associates α) → Decidable (irreducible p)] (p : associates α)
    (s : factor_set α) :=
  dite (irreducible p) (fun (hp : irreducible p) => bfactor_set_mem { val := p, property := hp } s)
    fun (hp : ¬irreducible p) => False

protected instance factor_set.has_mem {α : Type u_1} [comm_cancel_monoid_with_zero α]
    [dec_irr : (p : associates α) → Decidable (irreducible p)] :
    has_mem (associates α) (factor_set α) :=
  has_mem.mk factor_set_mem

@[simp] theorem factor_set_mem_eq_mem {α : Type u_1} [comm_cancel_monoid_with_zero α]
    [dec_irr : (p : associates α) → Decidable (irreducible p)] (p : associates α)
    (s : factor_set α) : factor_set_mem p s = (p ∈ s) :=
  rfl

theorem mem_factor_set_top {α : Type u_1} [comm_cancel_monoid_with_zero α]
    [dec_irr : (p : associates α) → Decidable (irreducible p)] {p : associates α}
    {hp : irreducible p} : p ∈ ⊤ :=
  id (id (eq.mpr (id (dif_pos hp)) trivial))

theorem mem_factor_set_some {α : Type u_1} [comm_cancel_monoid_with_zero α]
    [dec_irr : (p : associates α) → Decidable (irreducible p)] {p : associates α}
    {hp : irreducible p} {l : multiset (Subtype fun (a : associates α) => irreducible a)} :
    p ∈ ↑l ↔ { val := p, property := hp } ∈ l :=
  sorry

theorem reducible_not_mem_factor_set {α : Type u_1} [comm_cancel_monoid_with_zero α]
    [dec_irr : (p : associates α) → Decidable (irreducible p)] {p : associates α}
    (hp : ¬irreducible p) (s : factor_set α) : ¬p ∈ s :=
  sorry

theorem unique' {α : Type u_1} [comm_cancel_monoid_with_zero α] [unique_factorization_monoid α]
    {p : multiset (associates α)} {q : multiset (associates α)} :
    (∀ (a : associates α), a ∈ p → irreducible a) →
        (∀ (a : associates α), a ∈ q → irreducible a) → multiset.prod p = multiset.prod q → p = q :=
  sorry

theorem prod_le_prod_iff_le {α : Type u_1} [comm_cancel_monoid_with_zero α]
    [unique_factorization_monoid α] [nontrivial α] [normalization_monoid α]
    {p : multiset (associates α)} {q : multiset (associates α)}
    (hp : ∀ (a : associates α), a ∈ p → irreducible a)
    (hq : ∀ (a : associates α), a ∈ q → irreducible a) :
    multiset.prod p ≤ multiset.prod q ↔ p ≤ q :=
  sorry

/-- This returns the multiset of irreducible factors as a `factor_set`,
  a multiset of irreducible associates `with_top`. -/
def factors' {α : Type u_1} [comm_cancel_monoid_with_zero α] [unique_factorization_monoid α]
    [nontrivial α] [normalization_monoid α] [dec : DecidableEq α] (a : α) :
    multiset (Subtype fun (a : associates α) => irreducible a) :=
  multiset.pmap (fun (a : α) (ha : irreducible a) => { val := associates.mk a, property := sorry })
    (unique_factorization_monoid.factors a) sorry

@[simp] theorem map_subtype_coe_factors' {α : Type u_1} [comm_cancel_monoid_with_zero α]
    [unique_factorization_monoid α] [nontrivial α] [normalization_monoid α] [dec : DecidableEq α]
    {a : α} :
    multiset.map coe (factors' a) =
        multiset.map associates.mk (unique_factorization_monoid.factors a) :=
  sorry

theorem factors'_cong {α : Type u_1} [comm_cancel_monoid_with_zero α]
    [unique_factorization_monoid α] [nontrivial α] [normalization_monoid α] [dec : DecidableEq α]
    {a : α} {b : α} (ha : a ≠ 0) (hb : b ≠ 0) (h : associated a b) : factors' a = factors' b :=
  sorry

/-- This returns the multiset of irreducible factors of an associate as a `factor_set`,
  a multiset of irreducible associates `with_top`. -/
def factors {α : Type u_1} [comm_cancel_monoid_with_zero α] [unique_factorization_monoid α]
    [nontrivial α] [normalization_monoid α] [dec : DecidableEq α]
    [dec' : DecidableEq (associates α)] (a : associates α) : factor_set α :=
  dite (a = 0) (fun (h : a = 0) => ⊤)
    fun (h : ¬a = 0) =>
      quotient.hrec_on a (fun (x : α) (h : ¬quotient.mk x = 0) => some (factors' x)) sorry h

@[simp] theorem factors_0 {α : Type u_1} [comm_cancel_monoid_with_zero α]
    [unique_factorization_monoid α] [nontrivial α] [normalization_monoid α] [dec : DecidableEq α]
    [dec' : DecidableEq (associates α)] : factors 0 = ⊤ :=
  dif_pos rfl

@[simp] theorem factors_mk {α : Type u_1} [comm_cancel_monoid_with_zero α]
    [unique_factorization_monoid α] [nontrivial α] [normalization_monoid α] [dec : DecidableEq α]
    [dec' : DecidableEq (associates α)] (a : α) (h : a ≠ 0) :
    factors (associates.mk a) = ↑(factors' a) :=
  dif_neg (mt (iff.mp mk_eq_zero) h)

theorem prod_factors {α : Type u_1} [comm_cancel_monoid_with_zero α] [unique_factorization_monoid α]
    [nontrivial α] [normalization_monoid α] [dec : DecidableEq α]
    [dec' : DecidableEq (associates α)] (s : factor_set α) : factors (factor_set.prod s) = s :=
  sorry

@[simp] theorem factors_prod {α : Type u_1} [comm_cancel_monoid_with_zero α]
    [unique_factorization_monoid α] [nontrivial α] [normalization_monoid α] [dec : DecidableEq α]
    [dec' : DecidableEq (associates α)] (a : associates α) : factor_set.prod (factors a) = a :=
  sorry

theorem eq_of_factors_eq_factors {α : Type u_1} [comm_cancel_monoid_with_zero α]
    [unique_factorization_monoid α] [nontrivial α] [normalization_monoid α] [dec : DecidableEq α]
    [dec' : DecidableEq (associates α)] {a : associates α} {b : associates α}
    (h : factors a = factors b) : a = b :=
  sorry

theorem eq_of_prod_eq_prod {α : Type u_1} [comm_cancel_monoid_with_zero α]
    [unique_factorization_monoid α] [nontrivial α] [normalization_monoid α] {a : factor_set α}
    {b : factor_set α} (h : factor_set.prod a = factor_set.prod b) : a = b :=
  sorry

@[simp] theorem factors_mul {α : Type u_1} [comm_cancel_monoid_with_zero α]
    [unique_factorization_monoid α] [nontrivial α] [normalization_monoid α] [dec : DecidableEq α]
    [dec' : DecidableEq (associates α)] (a : associates α) (b : associates α) :
    factors (a * b) = factors a + factors b :=
  sorry

theorem factors_mono {α : Type u_1} [comm_cancel_monoid_with_zero α] [unique_factorization_monoid α]
    [nontrivial α] [normalization_monoid α] [dec : DecidableEq α]
    [dec' : DecidableEq (associates α)] {a : associates α} {b : associates α} :
    a ≤ b → factors a ≤ factors b :=
  sorry

theorem factors_le {α : Type u_1} [comm_cancel_monoid_with_zero α] [unique_factorization_monoid α]
    [nontrivial α] [normalization_monoid α] [dec : DecidableEq α]
    [dec' : DecidableEq (associates α)] {a : associates α} {b : associates α} :
    factors a ≤ factors b ↔ a ≤ b :=
  sorry

theorem prod_le {α : Type u_1} [comm_cancel_monoid_with_zero α] [unique_factorization_monoid α]
    [nontrivial α] [normalization_monoid α] {a : factor_set α} {b : factor_set α} :
    factor_set.prod a ≤ factor_set.prod b ↔ a ≤ b :=
  sorry

protected instance has_sup {α : Type u_1} [comm_cancel_monoid_with_zero α]
    [unique_factorization_monoid α] [nontrivial α] [normalization_monoid α] [dec : DecidableEq α]
    [dec' : DecidableEq (associates α)] : has_sup (associates α) :=
  has_sup.mk fun (a b : associates α) => factor_set.prod (factors a ⊔ factors b)

protected instance has_inf {α : Type u_1} [comm_cancel_monoid_with_zero α]
    [unique_factorization_monoid α] [nontrivial α] [normalization_monoid α] [dec : DecidableEq α]
    [dec' : DecidableEq (associates α)] : has_inf (associates α) :=
  has_inf.mk fun (a b : associates α) => factor_set.prod (factors a ⊓ factors b)

protected instance bounded_lattice {α : Type u_1} [comm_cancel_monoid_with_zero α]
    [unique_factorization_monoid α] [nontrivial α] [normalization_monoid α] [dec : DecidableEq α]
    [dec' : DecidableEq (associates α)] : bounded_lattice (associates α) :=
  bounded_lattice.mk has_sup.sup partial_order.le partial_order.lt sorry sorry sorry sorry sorry
    sorry has_inf.inf sorry sorry sorry order_top.top sorry order_bot.bot sorry

theorem sup_mul_inf {α : Type u_1} [comm_cancel_monoid_with_zero α] [unique_factorization_monoid α]
    [nontrivial α] [normalization_monoid α] [dec : DecidableEq α]
    [dec' : DecidableEq (associates α)] (a : associates α) (b : associates α) :
    (a ⊔ b) * (a ⊓ b) = a * b :=
  sorry

theorem dvd_of_mem_factors {α : Type u_1} [comm_cancel_monoid_with_zero α]
    [dec_irr : (p : associates α) → Decidable (irreducible p)] [unique_factorization_monoid α]
    [nontrivial α] [normalization_monoid α] [dec : DecidableEq α]
    [dec' : DecidableEq (associates α)] {a : associates α} {p : associates α} {hp : irreducible p}
    (hm : p ∈ factors a) : p ∣ a :=
  sorry

theorem dvd_of_mem_factors' {α : Type u_1} [comm_cancel_monoid_with_zero α]
    [dec_irr : (p : associates α) → Decidable (irreducible p)] [unique_factorization_monoid α]
    [nontrivial α] [normalization_monoid α] [dec : DecidableEq α] {a : α} {p : associates α}
    {hp : irreducible p} {hz : a ≠ 0} (h_mem : { val := p, property := hp } ∈ factors' a) :
    p ∣ associates.mk a :=
  dvd_of_mem_factors
    (eq.mpr (id (Eq._oldrec (Eq.refl (p ∈ factors (associates.mk a))) (factors_mk a hz)))
      (iff.mpr mem_factor_set_some h_mem))

theorem mem_factors'_of_dvd {α : Type u_1} [comm_cancel_monoid_with_zero α]
    [unique_factorization_monoid α] [nontrivial α] [normalization_monoid α] [dec : DecidableEq α]
    {a : α} {p : α} (ha0 : a ≠ 0) (hp : irreducible p) (hd : p ∣ a) :
    { val := associates.mk p, property := iff.mpr (irreducible_mk p) hp } ∈ factors' a :=
  sorry

theorem mem_factors'_iff_dvd {α : Type u_1} [comm_cancel_monoid_with_zero α]
    [dec_irr : (p : associates α) → Decidable (irreducible p)] [unique_factorization_monoid α]
    [nontrivial α] [normalization_monoid α] [dec : DecidableEq α] {a : α} {p : α} (ha0 : a ≠ 0)
    (hp : irreducible p) :
    { val := associates.mk p, property := iff.mpr (irreducible_mk p) hp } ∈ factors' a ↔ p ∣ a :=
  sorry

theorem mem_factors_of_dvd {α : Type u_1} [comm_cancel_monoid_with_zero α]
    [dec_irr : (p : associates α) → Decidable (irreducible p)] [unique_factorization_monoid α]
    [nontrivial α] [normalization_monoid α] [dec : DecidableEq α]
    [dec' : DecidableEq (associates α)] {a : α} {p : α} (ha0 : a ≠ 0) (hp : irreducible p)
    (hd : p ∣ a) : associates.mk p ∈ factors (associates.mk a) :=
  eq.mpr
    (id (Eq._oldrec (Eq.refl (associates.mk p ∈ factors (associates.mk a))) (factors_mk a ha0)))
    (iff.mpr mem_factor_set_some (mem_factors'_of_dvd ha0 hp hd))

theorem mem_factors_iff_dvd {α : Type u_1} [comm_cancel_monoid_with_zero α]
    [dec_irr : (p : associates α) → Decidable (irreducible p)] [unique_factorization_monoid α]
    [nontrivial α] [normalization_monoid α] [dec : DecidableEq α]
    [dec' : DecidableEq (associates α)] {a : α} {p : α} (ha0 : a ≠ 0) (hp : irreducible p) :
    associates.mk p ∈ factors (associates.mk a) ↔ p ∣ a :=
  sorry

theorem exists_prime_dvd_of_not_inf_one {α : Type u_1} [comm_cancel_monoid_with_zero α]
    [dec_irr : (p : associates α) → Decidable (irreducible p)] [unique_factorization_monoid α]
    [nontrivial α] [normalization_monoid α] [dec : DecidableEq α]
    [dec' : DecidableEq (associates α)] {a : α} {b : α} (ha : a ≠ 0) (hb : b ≠ 0)
    (h : associates.mk a ⊓ associates.mk b ≠ 1) : ∃ (p : α), prime p ∧ p ∣ a ∧ p ∣ b :=
  sorry

theorem coprime_iff_inf_one {α : Type u_1} [comm_cancel_monoid_with_zero α]
    [dec_irr : (p : associates α) → Decidable (irreducible p)] [unique_factorization_monoid α]
    [nontrivial α] [normalization_monoid α] [dec : DecidableEq α]
    [dec' : DecidableEq (associates α)] {a : α} {b : α} (ha0 : a ≠ 0) (hb0 : b ≠ 0) :
    associates.mk a ⊓ associates.mk b = 1 ↔ ∀ {d : α}, d ∣ a → d ∣ b → ¬prime d :=
  sorry

theorem factors_prime_pow {α : Type u_1} [comm_cancel_monoid_with_zero α]
    [unique_factorization_monoid α] [nontrivial α] [normalization_monoid α] [dec : DecidableEq α]
    [dec' : DecidableEq (associates α)] {p : associates α} (hp : irreducible p) (k : ℕ) :
    factors (p ^ k) = some (multiset.repeat { val := p, property := hp } k) :=
  sorry

theorem prime_pow_dvd_iff_le {α : Type u_1} [comm_cancel_monoid_with_zero α]
    [dec_irr : (p : associates α) → Decidable (irreducible p)] [unique_factorization_monoid α]
    [nontrivial α] [normalization_monoid α] [dec : DecidableEq α]
    [dec' : DecidableEq (associates α)] {m : associates α} {p : associates α} (h₁ : m ≠ 0)
    (h₂ : irreducible p) {k : ℕ} : p ^ k ≤ m ↔ k ≤ count p (factors m) :=
  sorry

theorem le_of_count_ne_zero {α : Type u_1} [comm_cancel_monoid_with_zero α]
    [dec_irr : (p : associates α) → Decidable (irreducible p)] [unique_factorization_monoid α]
    [nontrivial α] [normalization_monoid α] [dec : DecidableEq α]
    [dec' : DecidableEq (associates α)] {m : associates α} {p : associates α} (h0 : m ≠ 0)
    (hp : irreducible p) : count p (factors m) ≠ 0 → p ≤ m :=
  sorry

theorem count_mul {α : Type u_1} [comm_cancel_monoid_with_zero α]
    [dec_irr : (p : associates α) → Decidable (irreducible p)] [unique_factorization_monoid α]
    [nontrivial α] [normalization_monoid α] [dec : DecidableEq α]
    [dec' : DecidableEq (associates α)] {a : associates α} (ha : a ≠ 0) {b : associates α}
    (hb : b ≠ 0) {p : associates α} (hp : irreducible p) :
    count p (factors (a * b)) = count p (factors a) + count p (factors b) :=
  sorry

theorem count_of_coprime {α : Type u_1} [comm_cancel_monoid_with_zero α]
    [dec_irr : (p : associates α) → Decidable (irreducible p)] [unique_factorization_monoid α]
    [nontrivial α] [normalization_monoid α] [dec : DecidableEq α]
    [dec' : DecidableEq (associates α)] {a : associates α} (ha : a ≠ 0) {b : associates α}
    (hb : b ≠ 0) (hab : ∀ (d : associates α), d ∣ a → d ∣ b → ¬prime d) {p : associates α}
    (hp : irreducible p) : count p (factors a) = 0 ∨ count p (factors b) = 0 :=
  sorry

theorem count_mul_of_coprime {α : Type u_1} [comm_cancel_monoid_with_zero α]
    [dec_irr : (p : associates α) → Decidable (irreducible p)] [unique_factorization_monoid α]
    [nontrivial α] [normalization_monoid α] [dec : DecidableEq α]
    [dec' : DecidableEq (associates α)] {a : associates α} (ha : a ≠ 0) {b : associates α}
    (hb : b ≠ 0) {p : associates α} (hp : irreducible p)
    (hab : ∀ (d : associates α), d ∣ a → d ∣ b → ¬prime d) :
    count p (factors a) = 0 ∨ count p (factors a) = count p (factors (a * b)) :=
  sorry

theorem count_mul_of_coprime' {α : Type u_1} [comm_cancel_monoid_with_zero α]
    [dec_irr : (p : associates α) → Decidable (irreducible p)] [unique_factorization_monoid α]
    [nontrivial α] [normalization_monoid α] [dec : DecidableEq α]
    [dec' : DecidableEq (associates α)] {a : associates α} (ha : a ≠ 0) {b : associates α}
    (hb : b ≠ 0) {p : associates α} (hp : irreducible p)
    (hab : ∀ (d : associates α), d ∣ a → d ∣ b → ¬prime d) :
    count p (factors (a * b)) = count p (factors a) ∨
        count p (factors (a * b)) = count p (factors b) :=
  sorry

theorem dvd_count_of_dvd_count_mul {α : Type u_1} [comm_cancel_monoid_with_zero α]
    [dec_irr : (p : associates α) → Decidable (irreducible p)] [unique_factorization_monoid α]
    [nontrivial α] [normalization_monoid α] [dec : DecidableEq α]
    [dec' : DecidableEq (associates α)] {a : associates α} {b : associates α} (ha : a ≠ 0)
    (hb : b ≠ 0) {p : associates α} (hp : irreducible p)
    (hab : ∀ (d : associates α), d ∣ a → d ∣ b → ¬prime d) {k : ℕ}
    (habk : k ∣ count p (factors (a * b))) : k ∣ count p (factors a) :=
  sorry

@[simp] theorem factors_one {α : Type u_1} [comm_cancel_monoid_with_zero α]
    [unique_factorization_monoid α] [nontrivial α] [normalization_monoid α] [dec : DecidableEq α]
    [dec' : DecidableEq (associates α)] : factors 1 = 0 :=
  eq_of_prod_eq_prod
    (eq.mpr
      (id (Eq._oldrec (Eq.refl (factor_set.prod (factors 1) = factor_set.prod 0)) (factors_prod 1)))
      multiset.prod_zero)

@[simp] theorem pow_factors {α : Type u_1} [comm_cancel_monoid_with_zero α]
    [unique_factorization_monoid α] [nontrivial α] [normalization_monoid α] [dec : DecidableEq α]
    [dec' : DecidableEq (associates α)] {a : associates α} {k : ℕ} :
    factors (a ^ k) = k •ℕ factors a :=
  sorry

theorem count_pow {α : Type u_1} [comm_cancel_monoid_with_zero α]
    [dec_irr : (p : associates α) → Decidable (irreducible p)] [unique_factorization_monoid α]
    [nontrivial α] [normalization_monoid α] [dec : DecidableEq α]
    [dec' : DecidableEq (associates α)] {a : associates α} (ha : a ≠ 0) {p : associates α}
    (hp : irreducible p) (k : ℕ) : count p (factors (a ^ k)) = k * count p (factors a) :=
  sorry

theorem dvd_count_pow {α : Type u_1} [comm_cancel_monoid_with_zero α]
    [dec_irr : (p : associates α) → Decidable (irreducible p)] [unique_factorization_monoid α]
    [nontrivial α] [normalization_monoid α] [dec : DecidableEq α]
    [dec' : DecidableEq (associates α)] {a : associates α} (ha : a ≠ 0) {p : associates α}
    (hp : irreducible p) (k : ℕ) : k ∣ count p (factors (a ^ k)) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (k ∣ count p (factors (a ^ k)))) (count_pow ha hp k)))
    (dvd_mul_right k (count p (factors a)))

theorem is_pow_of_dvd_count {α : Type u_1} [comm_cancel_monoid_with_zero α]
    [dec_irr : (p : associates α) → Decidable (irreducible p)] [unique_factorization_monoid α]
    [nontrivial α] [normalization_monoid α] [dec : DecidableEq α]
    [dec' : DecidableEq (associates α)] {a : associates α} (ha : a ≠ 0) {k : ℕ}
    (hk : ∀ (p : associates α), irreducible p → k ∣ count p (factors a)) :
    ∃ (b : associates α), a = b ^ k :=
  sorry

theorem eq_pow_of_mul_eq_pow {α : Type u_1} [comm_cancel_monoid_with_zero α]
    [unique_factorization_monoid α] [nontrivial α] [normalization_monoid α] {a : associates α}
    {b : associates α} {c : associates α} (ha : a ≠ 0) (hb : b ≠ 0)
    (hab : ∀ (d : associates α), d ∣ a → d ∣ b → ¬prime d) {k : ℕ} (h : a * b = c ^ k) :
    ∃ (d : associates α), a = d ^ k :=
  sorry

end associates

/-- `to_gcd_monoid` constructs a GCD monoid out of a normalization on a
  unique factorization domain. -/
def unique_factorization_monoid.to_gcd_monoid (α : Type u_1) [comm_cancel_monoid_with_zero α]
    [nontrivial α] [unique_factorization_monoid α] [normalization_monoid α]
    [DecidableEq (associates α)] [DecidableEq α] : gcd_monoid α :=
  gcd_monoid.mk norm_unit norm_unit_zero norm_unit_mul norm_unit_coe_units
    (fun (a b : α) => associates.out (associates.mk a ⊓ associates.mk b))
    (fun (a b : α) => associates.out (associates.mk a ⊔ associates.mk b)) sorry sorry sorry sorry
    sorry sorry sorry

end Mathlib


import BackwardProofs.TacticMode
/-!
# Backward Proofs

In this chapter, we see how to prove Lean lemmas using tactics, and we review the most important
Lean tactics. A _tactic_ is a procedure that operates on the goal— the proposition to prove—and
either fully proves it or produces new subgoals (or fails). When we state a lemma, the lemma
statement is the initial goal. A proof is complete once all (sub)goals have been eliminated using
suitable tactics. The tactics described here are documented in more detail in Chapter 5 of [Theorem
Proving in Lean](./bib.md#1) and Chapter 6 of [The Lean Reference Manual](./bib.md/#3). Tactics
are a backward proof mechanism. They start from the goal and work backwards towards the already
proved lemmas. Consider the lemmas `a, a → b`, and `b → c` and the goal `⊢ c`. An informal backward
proof is as follow:

- To prove `c`, by `b → c` it suffices to prove `b`.
- To prove `b`, by `a → b` it suffices to prove `a`.
- To prove `a`, we use `a`.

The telltale sign of a backward proof is the phrase “it suffices to.” Notice how we
progress from one goal to another ( `⊢ c`, `⊢ b`, `⊢ a`) until no goal is left to prove. By
contrast, a forward proof would start from the lemma `a` and progress, one theorem
at a time, towards the desired theorem `c`:

- From `a` and `a → b`, we have `b`.
- From `b` and `b → c`, we have `c`, as desired.

A forward proof only manipulates theorems, not goals. We will study forward
proofs more deeply in Chapter 3.
-/