/-
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


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

import testing.slim_check.testable
import testing.slim_check.functions
import data.list.sort

/-!
## Finding counterexamples automatically using `slim_check`

A proposition can be tested by writing it out as:

```lean
example (xs : list ℕ) (w : ∃ x ∈ xs, x < 3) : ∀ y ∈ xs, y < 5 := by slim_check
-- ===================
-- Found problems!

-- xs := [0, 5]
-- x := 0
-- y := 5
-- -------------------

example (x : ℕ) (h : 2 ∣ x) : x < 100 := by slim_check
-- ===================
-- Found problems!

-- x := 258
-- -------------------

example (α : Type) (xs ys : list α) : xs ++ ys = ys ++ xs := by slim_check
-- ===================
-- Found problems!

-- α := ℤ
-- xs := [-4]
-- ys := [1]
-- -------------------

example : ∀ x ∈ [1,2,3], x < 4 := by slim_check
-- Success
```

In the first example, `slim_check` is called on the following goal:

```lean
xs : list ℕ,
h : ∃ (x : ℕ) (H : x ∈ xs), x < 3
⊢ ∀ (y : ℕ), y ∈ xs → y < 5
```

The local constants are reverted and an instance is found for
`testable (∀ (xs : list ℕ), (∃ x ∈ xs, x < 3) → (∀ y ∈ xs, y < 5))`.
The `testable` instance is supported by instances of `sampleable (list ℕ)`,
`decidable (x < 3)` and `decidable (y < 5)`. `slim_check` builds a
`testable` instance step by step with:

```
- testable (∀ (xs : list ℕ), (∃ x ∈ xs, x < 3) → (∀ y ∈ xs, y < 5))
                                     -: sampleable (list xs)
- testable ((∃ x ∈ xs, x < 3) → (∀ y ∈ xs, y < 5))
- testable (∀ x ∈ xs, x < 3 → (∀ y ∈ xs, y < 5))
- testable (x < 3 → (∀ y ∈ xs, y < 5))
                                     -: decidable (x < 3)
- testable (∀ y ∈ xs, y < 5)
                                     -: decidable (y < 5)
```

`sampleable (list ℕ)` lets us create random data of type `list ℕ` in a way that
helps find small counter-examples.  Next, the test of the proposition
hinges on `x < 3` and `y < 5` to both be decidable. The
implication between the two could be tested as a whole but it would be
less informative. Indeed, if we generate lists that only contain numbers
greater than `3`, the implication will always trivially hold but we should
conclude that we haven't found meaningful examples. Instead, when `x < 3`
does not hold, we reject the example (i.e.  we do not count it toward
the 100 required positive examples) and we start over. Therefore, when
`slim_check` prints `Success`, it means that a hundred suitable lists
were found and successfully tested.

If no counter-examples are found, `slim_check` behaves like `admit`.

`slim_check` can also be invoked using `#eval`:

```lean
#eval slim_check.testable.check (∀ (α : Type) (xs ys : list α), xs ++ ys = ys ++ xs)
-- ===================
-- Found problems!

-- α := ℤ
-- xs := [-4]
-- ys := [1]
-- -------------------
```

For more information on writing your own `sampleable` and `testable`
instances, see `testing.slim_check.testable`.
-/

namespace tactic.interactive
open tactic slim_check

declare_trace slim_check.instance
declare_trace slim_check.decoration
declare_trace slim_check.discarded
declare_trace slim_check.success
declare_trace slim_check.shrink.steps
declare_trace slim_check.shrink.candidates .
open expr

/-- Tree structure representing a `testable` instance. -/
meta inductive instance_tree
| node : name → expr → list instance_tree → instance_tree

/-- Gather information about a `testable` instance. Given
an expression of type `testable ?p`, gather the
name of the `testable` instances that it is built from
and the proposition that they test. -/
meta def summarize_instance : expr → tactic instance_tree
| (lam n bi d b) := do
   v ← mk_local' n bi d,
   summarize_instance $ b.instantiate_var v
| e@(app f x) := do
   `(testable %%p) ← infer_type e,
   xs ← e.get_app_args.mmap_filter (try_core ∘ summarize_instance),
   pure $ instance_tree.node e.get_app_fn.const_name p xs
| e := do
  failed

/-- format a `instance_tree` -/
meta def instance_tree.to_format : instance_tree → tactic format
| (instance_tree.node n p xs) := do
  xs ← format.join <$> (xs.mmap $ λ t, flip format.indent 2 <$> instance_tree.to_format t),
  ys ← pformat!"testable ({p})",
  pformat!"+ {n} :{format.indent ys 2}\n{xs}"

meta instance instance_tree.has_to_tactic_format : has_to_tactic_format instance_tree :=
⟨ instance_tree.to_format ⟩

/--
`slim_check` considers a proof goal and tries to generate examples
that would contradict the statement.

Let's consider the following proof goal.

```lean
xs : list ℕ,
h : ∃ (x : ℕ) (H : x ∈ xs), x < 3
⊢ ∀ (y : ℕ), y ∈ xs → y < 5
```

The local constants will be reverted and an instance will be found for
`testable (∀ (xs : list ℕ), (∃ x ∈ xs, x < 3) → (∀ y ∈ xs, y < 5))`.
The `testable` instance is supported by an instance of `sampleable (list ℕ)`,
`decidable (x < 3)` and `decidable (y < 5)`.

Examples will be created in ascending order of size (more or less)

The first counter-examples found will be printed and will result in an error:

```
===================
Found problems!

xs := [1, 28]
x := 1
y := 28
-------------------
```

If `slim_check` successfully tests 100 examples, it acts like
admit. If it gives up or finds a counter-example, it reports an error.

For more information on writing your own `sampleable` and `testable`
instances, see `testing.slim_check.testable`.

Optional arguments given with `slim_check_cfg`
 * num_inst (default 100): number of examples to test properties with
 * max_size (default 100): final size argument
 * enable_tracing (default ff): enable the printing of discarded samples

Options:
  * `set_option trace.slim_check.decoration true`: print the proposition with quantifier annotations
  * `set_option trace.slim_check.discarded true`: print the examples discarded because they do not satisfy assumptions
  * `set_option trace.slim_check.shrink.steps true`: trace the shrinking of counter-example
  * `set_option trace.slim_check.shrink.candidates true`: print the lists of candidates considered when shrinking each variable
  * `set_option trace.slim_check.instance true`: print the instances of `testable` being used to test the proposition
  * `set_option trace.slim_check.success true`: print the tested samples that satisfy a property
-/
meta def slim_check (cfg : slim_check_cfg := {}) : tactic unit := do
{ tgt ← retrieve $ tactic.revert_all >> target,
  let tgt' := tactic.add_decorations tgt,
  let cfg := { cfg with
               trace_discarded         := cfg.trace_discarded         || is_trace_enabled_for `slim_check.discarded,
               trace_shrink            := cfg.trace_shrink            || is_trace_enabled_for `slim_check.shrink.steps,
               trace_shrink_candidates := cfg.trace_shrink_candidates || is_trace_enabled_for `slim_check.shrink.candidates,
               trace_success           := cfg.trace_success           || is_trace_enabled_for `slim_check.success },
  inst ← mk_app ``testable [tgt'] >>= mk_instance <|>
    fail!"Failed to create a `testable` instance for `{tgt}`.
What to do:
1. make sure that the types you are using have `slim_check.sampleable` instances (you can use `#sample my_type` if you are unsure);
2. make sure that the relations and predicates that your proposition use are decidable;
3. make sure that instances of `slim_check.testable` exist that, when combined, apply to your decorated proposition:
```
{tgt'}
```

Use `set_option trace.class_instances true` to understand what instances are missing.

Try this:
set_option trace.class_instances true
#check (by apply_instance : slim_check.testable ({tgt'}))",
  e ← mk_mapp ``testable.check [tgt, `(cfg), tgt', inst],
  when_tracing `slim_check.decoration trace!"[testable decoration]\n  {tgt'}",
  when_tracing `slim_check.instance   $ do
  { inst ← summarize_instance inst >>= pp,
    trace!"\n[testable instance]{format.indent inst 2}" },
  code ← eval_expr (io punit) e,
  unsafe_run_io code,
  admit }

end tactic.interactive


import SciLean.Data.ArrayType.Properties

namespace SciLean

variable {Cont : Type} {Idx : Type |> outParam} {Elem : Type |> outParam}
variable [ArrayType Cont Idx Elem] [Enumtype Idx] [Nonempty Idx]

@[simp]
theorem sum_setElem_zero [Vec Elem] (f : Idx → Elem) :
  ∑ (i : Idx), setElem (0 : Cont) i (f i) = introElem f := sorry_proof

@[simp]
theorem sum_setElem_zero' [Vec Elem] (f : Idx → Elem) (g : Idx → Idx) [IsInv g] :
  ∑ (i : Idx), setElem (0 : Cont) (g i) (f i) = introElem (λ i => f (g⁻¹ i)) := sorry_proof


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.linear_algebra.tensor_product
import Mathlib.algebra.algebra.basic
import Mathlib.PostPort

universes u v₁ v₂ v₃ v₄

namespace Mathlib

/-!
# The tensor product of R-algebras

We construct the R-algebra structure on `A ⊗[R] B`, when `A` and `B` are both `R`-algebras,
and provide the structure isomorphisms

* `R ⊗[R] A ≃ₐ[R] A`
* `A ⊗[R] R ≃ₐ[R] A`
* `A ⊗[R] B ≃ₐ[R] B ⊗[R] A`

The code for
* `((A ⊗[R] B) ⊗[R] C) ≃ₐ[R] (A ⊗[R] (B ⊗[R] C))`
is written and compiles, but takes longer than the `-T100000` time limit,
so is currently commented out.
-/

namespace algebra

namespace tensor_product

/--
(Implementation detail)
The multiplication map on `A ⊗[R] B`,
for a fixed pure tensor in the first argument,
as an `R`-linear map.
-/
def mul_aux {R : Type u} [comm_semiring R] {A : Type v₁} [semiring A] [algebra R A] {B : Type v₂} [semiring B] [algebra R B] (a₁ : A) (b₁ : B) : linear_map R (tensor_product R A B) (tensor_product R A B) :=
  tensor_product.lift
    (linear_map.mk (fun (a₂ : A) => linear_map.mk (fun (b₂ : B) => tensor_product.tmul R (a₁ * a₂) (b₁ * b₂)) sorry sorry)
      sorry sorry)

@[simp] theorem mul_aux_apply {R : Type u} [comm_semiring R] {A : Type v₁} [semiring A] [algebra R A] {B : Type v₂} [semiring B] [algebra R B] (a₁ : A) (a₂ : A) (b₁ : B) (b₂ : B) : coe_fn (mul_aux a₁ b₁) (tensor_product.tmul R a₂ b₂) = tensor_product.tmul R (a₁ * a₂) (b₁ * b₂) :=
  rfl

/--
(Implementation detail)
The multiplication map on `A ⊗[R] B`,
as an `R`-bilinear map.
-/
def mul {R : Type u} [comm_semiring R] {A : Type v₁} [semiring A] [algebra R A] {B : Type v₂} [semiring B] [algebra R B] : linear_map R (tensor_product R A B) (linear_map R (tensor_product R A B) (tensor_product R A B)) :=
  tensor_product.lift
    (linear_map.mk (fun (a₁ : A) => linear_map.mk (fun (b₁ : B) => mul_aux a₁ b₁) sorry sorry) sorry sorry)

@[simp] theorem mul_apply {R : Type u} [comm_semiring R] {A : Type v₁} [semiring A] [algebra R A] {B : Type v₂} [semiring B] [algebra R B] (a₁ : A) (a₂ : A) (b₁ : B) (b₂ : B) : coe_fn (coe_fn mul (tensor_product.tmul R a₁ b₁)) (tensor_product.tmul R a₂ b₂) =
  tensor_product.tmul R (a₁ * a₂) (b₁ * b₂) :=
  rfl

theorem mul_assoc' {R : Type u} [comm_semiring R] {A : Type v₁} [semiring A] [algebra R A] {B : Type v₂} [semiring B] [algebra R B] (mul : linear_map R (tensor_product R A B) (linear_map R (tensor_product R A B) (tensor_product R A B))) (h : ∀ (a₁ a₂ a₃ : A) (b₁ b₂ b₃ : B),
  coe_fn (coe_fn mul (coe_fn (coe_fn mul (tensor_product.tmul R a₁ b₁)) (tensor_product.tmul R a₂ b₂)))
      (tensor_product.tmul R a₃ b₃) =
    coe_fn (coe_fn mul (tensor_product.tmul R a₁ b₁))
      (coe_fn (coe_fn mul (tensor_product.tmul R a₂ b₂)) (tensor_product.tmul R a₃ b₃))) (x : tensor_product R A B) (y : tensor_product R A B) (z : tensor_product R A B) : coe_fn (coe_fn mul (coe_fn (coe_fn mul x) y)) z = coe_fn (coe_fn mul x) (coe_fn (coe_fn mul y) z) := sorry

theorem mul_assoc {R : Type u} [comm_semiring R] {A : Type v₁} [semiring A] [algebra R A] {B : Type v₂} [semiring B] [algebra R B] (x : tensor_product R A B) (y : tensor_product R A B) (z : tensor_product R A B) : coe_fn (coe_fn mul (coe_fn (coe_fn mul x) y)) z = coe_fn (coe_fn mul x) (coe_fn (coe_fn mul y) z) := sorry

theorem one_mul {R : Type u} [comm_semiring R] {A : Type v₁} [semiring A] [algebra R A] {B : Type v₂} [semiring B] [algebra R B] (x : tensor_product R A B) : coe_fn (coe_fn mul (tensor_product.tmul R 1 1)) x = x := sorry

theorem mul_one {R : Type u} [comm_semiring R] {A : Type v₁} [semiring A] [algebra R A] {B : Type v₂} [semiring B] [algebra R B] (x : tensor_product R A B) : coe_fn (coe_fn mul x) (tensor_product.tmul R 1 1) = x := sorry

protected instance tensor_product.semiring {R : Type u} [comm_semiring R] {A : Type v₁} [semiring A] [algebra R A] {B : Type v₂} [semiring B] [algebra R B] : semiring (tensor_product R A B) :=
  semiring.mk Add.add sorry 0 sorry sorry sorry (fun (a b : tensor_product R A B) => coe_fn (coe_fn mul a) b) mul_assoc
    (tensor_product.tmul R 1 1) one_mul mul_one sorry sorry sorry sorry

theorem one_def {R : Type u} [comm_semiring R] {A : Type v₁} [semiring A] [algebra R A] {B : Type v₂} [semiring B] [algebra R B] : 1 = tensor_product.tmul R 1 1 :=
  rfl

@[simp] theorem tmul_mul_tmul {R : Type u} [comm_semiring R] {A : Type v₁} [semiring A] [algebra R A] {B : Type v₂} [semiring B] [algebra R B] (a₁ : A) (a₂ : A) (b₁ : B) (b₂ : B) : tensor_product.tmul R a₁ b₁ * tensor_product.tmul R a₂ b₂ = tensor_product.tmul R (a₁ * a₂) (b₁ * b₂) :=
  rfl

@[simp] theorem tmul_pow {R : Type u} [comm_semiring R] {A : Type v₁} [semiring A] [algebra R A] {B : Type v₂} [semiring B] [algebra R B] (a : A) (b : B) (k : ℕ) : tensor_product.tmul R a b ^ k = tensor_product.tmul R (a ^ k) (b ^ k) := sorry

/--
The algebra map `R →+* (A ⊗[R] B)` giving `A ⊗[R] B` the structure of an `R`-algebra.
-/
def tensor_algebra_map {R : Type u} [comm_semiring R] {A : Type v₁} [semiring A] [algebra R A] {B : Type v₂} [semiring B] [algebra R B] : R →+* tensor_product R A B :=
  ring_hom.mk (fun (r : R) => tensor_product.tmul R (coe_fn (algebra_map R A) r) 1) sorry sorry sorry sorry

protected instance tensor_product.algebra {R : Type u} [comm_semiring R] {A : Type v₁} [semiring A] [algebra R A] {B : Type v₂} [semiring B] [algebra R B] : algebra R (tensor_product R A B) :=
  mk (ring_hom.mk (ring_hom.to_fun tensor_algebra_map) sorry sorry sorry sorry) sorry sorry

@[simp] theorem algebra_map_apply {R : Type u} [comm_semiring R] {A : Type v₁} [semiring A] [algebra R A] {B : Type v₂} [semiring B] [algebra R B] (r : R) : coe_fn (algebra_map R (tensor_product R A B)) r = tensor_product.tmul R (coe_fn (algebra_map R A) r) 1 :=
  rfl

theorem ext {R : Type u} [comm_semiring R] {A : Type v₁} [semiring A] [algebra R A] {B : Type v₂} [semiring B] [algebra R B] {C : Type v₃} [semiring C] [algebra R C] {g : alg_hom R (tensor_product R A B) C} {h : alg_hom R (tensor_product R A B) C} (H : ∀ (a : A) (b : B), coe_fn g (tensor_product.tmul R a b) = coe_fn h (tensor_product.tmul R a b)) : g = h := sorry

/-- The algebra morphism `A →ₐ[R] A ⊗[R] B` sending `a` to `a ⊗ₜ 1`. -/
def include_left {R : Type u} [comm_semiring R] {A : Type v₁} [semiring A] [algebra R A] {B : Type v₂} [semiring B] [algebra R B] : alg_hom R A (tensor_product R A B) :=
  alg_hom.mk (fun (a : A) => tensor_product.tmul R a 1) sorry sorry sorry sorry sorry

@[simp] theorem include_left_apply {R : Type u} [comm_semiring R] {A : Type v₁} [semiring A] [algebra R A] {B : Type v₂} [semiring B] [algebra R B] (a : A) : coe_fn include_left a = tensor_product.tmul R a 1 :=
  rfl

/-- The algebra morphism `B →ₐ[R] A ⊗[R] B` sending `b` to `1 ⊗ₜ b`. -/
def include_right {R : Type u} [comm_semiring R] {A : Type v₁} [semiring A] [algebra R A] {B : Type v₂} [semiring B] [algebra R B] : alg_hom R B (tensor_product R A B) :=
  alg_hom.mk (fun (b : B) => tensor_product.tmul R 1 b) sorry sorry sorry sorry sorry

@[simp] theorem include_right_apply {R : Type u} [comm_semiring R] {A : Type v₁} [semiring A] [algebra R A] {B : Type v₂} [semiring B] [algebra R B] (b : B) : coe_fn include_right b = tensor_product.tmul R 1 b :=
  rfl

protected instance tensor_product.ring {R : Type u} [comm_ring R] {A : Type v₁} [ring A] [algebra R A] {B : Type v₂} [ring B] [algebra R B] : ring (tensor_product R A B) :=
  ring.mk add_comm_group.add sorry add_comm_group.zero sorry sorry add_comm_group.neg add_comm_group.sub sorry sorry
    semiring.mul sorry semiring.one sorry sorry sorry sorry

protected instance tensor_product.comm_ring {R : Type u} [comm_ring R] {A : Type v₁} [comm_ring A] [algebra R A] {B : Type v₂} [comm_ring B] [algebra R B] : comm_ring (tensor_product R A B) :=
  comm_ring.mk ring.add sorry ring.zero sorry sorry ring.neg ring.sub sorry sorry ring.mul sorry ring.one sorry sorry
    sorry sorry sorry

/--
Verify that typeclass search finds the ring structure on `A ⊗[ℤ] B`
when `A` and `B` are merely rings, by treating both as `ℤ`-algebras.
-/
/--
Verify that typeclass search finds the comm_ring structure on `A ⊗[ℤ] B`
when `A` and `B` are merely comm_rings, by treating both as `ℤ`-algebras.
-/
/-!
We now build the structure maps for the symmetric monoidal category of `R`-algebras.
-/

/--
Build an algebra morphism from a linear map out of a tensor product,
and evidence of multiplicativity on pure tensors.
-/
def alg_hom_of_linear_map_tensor_product {R : Type u} [comm_semiring R] {A : Type v₁} [semiring A] [algebra R A] {B : Type v₂} [semiring B] [algebra R B] {C : Type v₃} [semiring C] [algebra R C] (f : linear_map R (tensor_product R A B) C) (w₁ : ∀ (a₁ a₂ : A) (b₁ b₂ : B),
  coe_fn f (tensor_product.tmul R (a₁ * a₂) (b₁ * b₂)) =
    coe_fn f (tensor_product.tmul R a₁ b₁) * coe_fn f (tensor_product.tmul R a₂ b₂)) (w₂ : ∀ (r : R), coe_fn f (tensor_product.tmul R (coe_fn (algebra_map R A) r) 1) = coe_fn (algebra_map R C) r) : alg_hom R (tensor_product R A B) C :=
  alg_hom.mk (linear_map.to_fun f) sorry sorry sorry sorry sorry

@[simp] theorem alg_hom_of_linear_map_tensor_product_apply {R : Type u} [comm_semiring R] {A : Type v₁} [semiring A] [algebra R A] {B : Type v₂} [semiring B] [algebra R B] {C : Type v₃} [semiring C] [algebra R C] (f : linear_map R (tensor_product R A B) C) (w₁ : ∀ (a₁ a₂ : A) (b₁ b₂ : B),
  coe_fn f (tensor_product.tmul R (a₁ * a₂) (b₁ * b₂)) =
    coe_fn f (tensor_product.tmul R a₁ b₁) * coe_fn f (tensor_product.tmul R a₂ b₂)) (w₂ : ∀ (r : R), coe_fn f (tensor_product.tmul R (coe_fn (algebra_map R A) r) 1) = coe_fn (algebra_map R C) r) (x : tensor_product R A B) : coe_fn (alg_hom_of_linear_map_tensor_product f w₁ w₂) x = coe_fn f x :=
  rfl

/--
Build an algebra equivalence from a linear equivalence out of a tensor product,
and evidence of multiplicativity on pure tensors.
-/
def alg_equiv_of_linear_equiv_tensor_product {R : Type u} [comm_semiring R] {A : Type v₁} [semiring A] [algebra R A] {B : Type v₂} [semiring B] [algebra R B] {C : Type v₃} [semiring C] [algebra R C] (f : linear_equiv R (tensor_product R A B) C) (w₁ : ∀ (a₁ a₂ : A) (b₁ b₂ : B),
  coe_fn f (tensor_product.tmul R (a₁ * a₂) (b₁ * b₂)) =
    coe_fn f (tensor_product.tmul R a₁ b₁) * coe_fn f (tensor_product.tmul R a₂ b₂)) (w₂ : ∀ (r : R), coe_fn f (tensor_product.tmul R (coe_fn (algebra_map R A) r) 1) = coe_fn (algebra_map R C) r) : alg_equiv R (tensor_product R A B) C :=
  alg_equiv.mk (alg_hom.to_fun (alg_hom_of_linear_map_tensor_product (↑f) w₁ w₂)) (linear_equiv.inv_fun f) sorry sorry
    sorry sorry sorry

@[simp] theorem alg_equiv_of_linear_equiv_tensor_product_apply {R : Type u} [comm_semiring R] {A : Type v₁} [semiring A] [algebra R A] {B : Type v₂} [semiring B] [algebra R B] {C : Type v₃} [semiring C] [algebra R C] (f : linear_equiv R (tensor_product R A B) C) (w₁ : ∀ (a₁ a₂ : A) (b₁ b₂ : B),
  coe_fn f (tensor_product.tmul R (a₁ * a₂) (b₁ * b₂)) =
    coe_fn f (tensor_product.tmul R a₁ b₁) * coe_fn f (tensor_product.tmul R a₂ b₂)) (w₂ : ∀ (r : R), coe_fn f (tensor_product.tmul R (coe_fn (algebra_map R A) r) 1) = coe_fn (algebra_map R C) r) (x : tensor_product R A B) : coe_fn (alg_equiv_of_linear_equiv_tensor_product f w₁ w₂) x = coe_fn f x :=
  rfl

/--
Build an algebra equivalence from a linear equivalence out of a triple tensor product,
and evidence of multiplicativity on pure tensors.
-/
def alg_equiv_of_linear_equiv_triple_tensor_product {R : Type u} [comm_semiring R] {A : Type v₁} [semiring A] [algebra R A] {B : Type v₂} [semiring B] [algebra R B] {C : Type v₃} [semiring C] [algebra R C] {D : Type v₄} [semiring D] [algebra R D] (f : linear_equiv R (tensor_product R (tensor_product R A B) C) D) (w₁ : ∀ (a₁ a₂ : A) (b₁ b₂ : B) (c₁ c₂ : C),
  coe_fn f (tensor_product.tmul R (tensor_product.tmul R (a₁ * a₂) (b₁ * b₂)) (c₁ * c₂)) =
    coe_fn f (tensor_product.tmul R (tensor_product.tmul R a₁ b₁) c₁) *
      coe_fn f (tensor_product.tmul R (tensor_product.tmul R a₂ b₂) c₂)) (w₂ : ∀ (r : R),
  coe_fn f (tensor_product.tmul R (tensor_product.tmul R (coe_fn (algebra_map R A) r) 1) 1) = coe_fn (algebra_map R D) r) : alg_equiv R (tensor_product R (tensor_product R A B) C) D :=
  alg_equiv.mk (⇑f) (linear_equiv.inv_fun f) sorry sorry sorry sorry sorry

@[simp] theorem alg_equiv_of_linear_equiv_triple_tensor_product_apply {R : Type u} [comm_semiring R] {A : Type v₁} [semiring A] [algebra R A] {B : Type v₂} [semiring B] [algebra R B] {C : Type v₃} [semiring C] [algebra R C] {D : Type v₄} [semiring D] [algebra R D] (f : linear_equiv R (tensor_product R (tensor_product R A B) C) D) (w₁ : ∀ (a₁ a₂ : A) (b₁ b₂ : B) (c₁ c₂ : C),
  coe_fn f (tensor_product.tmul R (tensor_product.tmul R (a₁ * a₂) (b₁ * b₂)) (c₁ * c₂)) =
    coe_fn f (tensor_product.tmul R (tensor_product.tmul R a₁ b₁) c₁) *
      coe_fn f (tensor_product.tmul R (tensor_product.tmul R a₂ b₂) c₂)) (w₂ : ∀ (r : R),
  coe_fn f (tensor_product.tmul R (tensor_product.tmul R (coe_fn (algebra_map R A) r) 1) 1) = coe_fn (algebra_map R D) r) (x : tensor_product R (tensor_product R A B) C) : coe_fn (alg_equiv_of_linear_equiv_triple_tensor_product f w₁ w₂) x = coe_fn f x :=
  rfl

/--
The base ring is a left identity for the tensor product of algebra, up to algebra isomorphism.
-/
protected def lid (R : Type u) [comm_semiring R] (A : Type v₁) [semiring A] [algebra R A] : alg_equiv R (tensor_product R R A) A :=
  alg_equiv_of_linear_equiv_tensor_product (tensor_product.lid R A) sorry sorry

@[simp] theorem lid_tmul (R : Type u) [comm_semiring R] (A : Type v₁) [semiring A] [algebra R A] (r : R) (a : A) : coe_fn (tensor_product.lid R A) (tensor_product.tmul R r a) = r • a := sorry

/--
The base ring is a right identity for the tensor product of algebra, up to algebra isomorphism.
-/
protected def rid (R : Type u) [comm_semiring R] (A : Type v₁) [semiring A] [algebra R A] : alg_equiv R (tensor_product R A R) A :=
  alg_equiv_of_linear_equiv_tensor_product (tensor_product.rid R A) sorry sorry

@[simp] theorem rid_tmul (R : Type u) [comm_semiring R] (A : Type v₁) [semiring A] [algebra R A] (r : R) (a : A) : coe_fn (tensor_product.rid R A) (tensor_product.tmul R a r) = r • a := sorry

/--
The tensor product of R-algebras is commutative, up to algebra isomorphism.
-/
protected def comm (R : Type u) [comm_semiring R] (A : Type v₁) [semiring A] [algebra R A] (B : Type v₂) [semiring B] [algebra R B] : alg_equiv R (tensor_product R A B) (tensor_product R B A) :=
  alg_equiv_of_linear_equiv_tensor_product (tensor_product.comm R A B) sorry sorry

@[simp] theorem comm_tmul (R : Type u) [comm_semiring R] (A : Type v₁) [semiring A] [algebra R A] (B : Type v₂) [semiring B] [algebra R B] (a : A) (b : B) : coe_fn (tensor_product.comm R A B) (tensor_product.tmul R a b) = tensor_product.tmul R b a := sorry

theorem assoc_aux_1 {R : Type u} [comm_semiring R] {A : Type v₁} [semiring A] [algebra R A] {B : Type v₂} [semiring B] [algebra R B] {C : Type v₃} [semiring C] [algebra R C] (a₁ : A) (a₂ : A) (b₁ : B) (b₂ : B) (c₁ : C) (c₂ : C) : coe_fn (tensor_product.assoc R A B C) (tensor_product.tmul R (tensor_product.tmul R (a₁ * a₂) (b₁ * b₂)) (c₁ * c₂)) =
  coe_fn (tensor_product.assoc R A B C) (tensor_product.tmul R (tensor_product.tmul R a₁ b₁) c₁) *
    coe_fn (tensor_product.assoc R A B C) (tensor_product.tmul R (tensor_product.tmul R a₂ b₂) c₂) :=
  rfl

theorem assoc_aux_2 {R : Type u} [comm_semiring R] {A : Type v₁} [semiring A] [algebra R A] {B : Type v₂} [semiring B] [algebra R B] {C : Type v₃} [semiring C] [algebra R C] (r : R) : coe_fn (tensor_product.assoc R A B C) (tensor_product.tmul R (tensor_product.tmul R (coe_fn (algebra_map R A) r) 1) 1) =
  coe_fn (algebra_map R (tensor_product R A (tensor_product R B C))) r :=
  rfl

-- variables (R A B C)

-- -- local attribute [elab_simple] alg_equiv_of_linear_equiv_triple_tensor_product

-- /-- The associator for tensor product of R-algebras, as an algebra isomorphism. -/

-- -- FIXME This is _really_ slow to compile. :-(

-- protected def assoc : ((A ⊗[R] B) ⊗[R] C) ≃ₐ[R] (A ⊗[R] (B ⊗[R] C)) :=

-- alg_equiv_of_linear_equiv_triple_tensor_product

--   (tensor_product.assoc R A B C)

--   assoc_aux_1 assoc_aux_2

-- variables {R A B C}

-- @[simp] theorem assoc_tmul (a : A) (b : B) (c : C) :

--   ((tensor_product.assoc R A B C) : (A ⊗[R] B) ⊗[R] C → A ⊗[R] (B ⊗[R] C)) ((a ⊗ₜ b) ⊗ₜ c) = a ⊗ₜ (b ⊗ₜ c) :=

-- rfl

/-- The tensor product of a pair of algebra morphisms. -/
def map {R : Type u} [comm_semiring R] {A : Type v₁} [semiring A] [algebra R A] {B : Type v₂} [semiring B] [algebra R B] {C : Type v₃} [semiring C] [algebra R C] {D : Type v₄} [semiring D] [algebra R D] (f : alg_hom R A B) (g : alg_hom R C D) : alg_hom R (tensor_product R A C) (tensor_product R B D) :=
  alg_hom_of_linear_map_tensor_product (tensor_product.map (alg_hom.to_linear_map f) (alg_hom.to_linear_map g)) sorry
    sorry

@[simp] theorem map_tmul {R : Type u} [comm_semiring R] {A : Type v₁} [semiring A] [algebra R A] {B : Type v₂} [semiring B] [algebra R B] {C : Type v₃} [semiring C] [algebra R C] {D : Type v₄} [semiring D] [algebra R D] (f : alg_hom R A B) (g : alg_hom R C D) (a : A) (c : C) : coe_fn (map f g) (tensor_product.tmul R a c) = tensor_product.tmul R (coe_fn f a) (coe_fn g c) :=
  rfl

/--
Construct an isomorphism between tensor products of R-algebras
from isomorphisms between the tensor factors.
-/
def congr {R : Type u} [comm_semiring R] {A : Type v₁} [semiring A] [algebra R A] {B : Type v₂} [semiring B] [algebra R B] {C : Type v₃} [semiring C] [algebra R C] {D : Type v₄} [semiring D] [algebra R D] (f : alg_equiv R A B) (g : alg_equiv R C D) : alg_equiv R (tensor_product R A C) (tensor_product R B D) :=
  alg_equiv.of_alg_hom (map ↑f ↑g) (map ↑(alg_equiv.symm f) ↑(alg_equiv.symm g)) sorry sorry

@[simp] theorem congr_apply {R : Type u} [comm_semiring R] {A : Type v₁} [semiring A] [algebra R A] {B : Type v₂} [semiring B] [algebra R B] {C : Type v₃} [semiring C] [algebra R C] {D : Type v₄} [semiring D] [algebra R D] (f : alg_equiv R A B) (g : alg_equiv R C D) (x : tensor_product R A C) : coe_fn (congr f g) x = coe_fn (map ↑f ↑g) x :=
  rfl

@[simp] theorem congr_symm_apply {R : Type u} [comm_semiring R] {A : Type v₁} [semiring A] [algebra R A] {B : Type v₂} [semiring B] [algebra R B] {C : Type v₃} [semiring C] [algebra R C] {D : Type v₄} [semiring D] [algebra R D] (f : alg_equiv R A B) (g : alg_equiv R C D) (x : tensor_product R B D) : coe_fn (alg_equiv.symm (congr f g)) x = coe_fn (map ↑(alg_equiv.symm f) ↑(alg_equiv.symm g)) x :=
  rfl


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Mario Carneiro
-/
import topology.instances.int
/-!
# Topology on the natural numbers

The structure of a metric space on `ℕ` is introduced in this file, induced from `ℝ`.
-/
noncomputable theory
open metric set filter

namespace nat

noncomputable instance : has_dist ℕ := ⟨λ x y, dist (x : ℝ) y⟩

theorem dist_eq (x y : ℕ) : dist x y = |x - y| := rfl

lemma dist_coe_int (x y : ℕ) : dist (x : ℤ) (y : ℤ) = dist x y := rfl

@[norm_cast, simp] theorem dist_cast_real (x y : ℕ) : dist (x : ℝ) y = dist x y := rfl

lemma pairwise_one_le_dist : pairwise (λ m n : ℕ, 1 ≤ dist m n) :=
begin
  intros m n hne,
  rw ← dist_coe_int,
  apply int.pairwise_one_le_dist,
  exact_mod_cast hne
end

lemma uniform_embedding_coe_real : uniform_embedding (coe : ℕ → ℝ) :=
uniform_embedding_bot_of_pairwise_le_dist zero_lt_one pairwise_one_le_dist

lemma closed_embedding_coe_real : closed_embedding (coe : ℕ → ℝ) :=
closed_embedding_of_pairwise_le_dist zero_lt_one pairwise_one_le_dist

instance : metric_space ℕ := nat.uniform_embedding_coe_real.comap_metric_space _

theorem preimage_closed_ball (x : ℕ) (r : ℝ) :
  coe ⁻¹' (closed_ball (x : ℝ) r) = closed_ball x r := rfl

theorem closed_ball_eq_Icc (x : ℕ) (r : ℝ) :
  closed_ball x r = Icc ⌈↑x - r⌉₊ ⌊↑x + r⌋₊ :=
begin
  rcases le_or_lt 0 r with hr|hr,
  { rw [← preimage_closed_ball, real.closed_ball_eq_Icc, preimage_Icc],
    exact add_nonneg (cast_nonneg x) hr },
  { rw closed_ball_eq_empty.2 hr,
    apply (Icc_eq_empty _).symm,
    rw not_le,
    calc ⌊(x : ℝ) + r⌋₊ ≤ ⌊(x : ℝ)⌋₊ : by { apply floor_mono, linarith }
    ... < ⌈↑x - r⌉₊ : by { rw [floor_coe, nat.lt_ceil], linarith } }
end

instance : proper_space ℕ :=
⟨ begin
    intros x r,
    rw closed_ball_eq_Icc,
    exact (set.finite_Icc _ _).is_compact,
  end ⟩

instance : noncompact_space ℕ :=
noncompact_space_of_ne_bot $ by simp [filter.at_top_ne_bot]

end nat


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

! This file was ported from Lean 3 source module data.list.sections
! leanprover-community/mathlib commit 10708587e81b68c763fcdb7505f279d52e569768
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.List.Forall2

/-!
# List sections

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

This file proves some stuff about `list.sections` (definition in `data.list.defs`). A section of a
list of lists `[l₁, ..., lₙ]` is a list whose `i`-th element comes from the `i`-th list.
-/

open Nat Function

namespace List

variable {α β : Type _}

#print List.mem_sections /-
theorem mem_sections {L : List (List α)} {f} : f ∈ sections L ↔ Forall₂ (· ∈ ·) f L :=
  by
  refine' ⟨fun h => _, fun h => _⟩
  · induction L generalizing f
    · cases mem_singleton.1 h
      exact forall₂.nil
    simp only [sections, bind_eq_bind, mem_bind, mem_map] at h
    rcases h with ⟨_, _, _, _, rfl⟩
    simp only [*, forall₂_cons, true_and_iff]
  · induction' h with a l f L al fL fs
    · exact Or.inl rfl
    simp only [sections, bind_eq_bind, mem_bind, mem_map]
    exact ⟨_, fs, _, al, rfl, rfl⟩
#align list.mem_sections List.mem_sections
-/

#print List.mem_sections_length /-
theorem mem_sections_length {L : List (List α)} {f} (h : f ∈ sections L) : length f = length L :=
  (mem_sections.1 h).length_eq
#align list.mem_sections_length List.mem_sections_length
-/

/- warning: list.rel_sections -> List.rel_sections is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} {r : α -> β -> Prop}, Relator.LiftFun.{succ u1, succ u2, succ u1, succ u2} (List.{u1} (List.{u1} α)) (List.{u2} (List.{u2} β)) (List.{u1} (List.{u1} α)) (List.{u2} (List.{u2} β)) (List.Forall₂.{u1, u2} (List.{u1} α) (List.{u2} β) (List.Forall₂.{u1, u2} α β r)) (List.Forall₂.{u1, u2} (List.{u1} α) (List.{u2} β) (List.Forall₂.{u1, u2} α β r)) (List.sections.{u1} α) (List.sections.{u2} β)
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} {r : α -> β -> Prop}, Relator.LiftFun.{succ u2, succ u1, succ u2, succ u1} (List.{u2} (List.{u2} α)) (List.{u1} (List.{u1} β)) (List.{u2} (List.{u2} α)) (List.{u1} (List.{u1} β)) (List.Forall₂.{u2, u1} (List.{u2} α) (List.{u1} β) (List.Forall₂.{u2, u1} α β r)) (List.Forall₂.{u2, u1} (List.{u2} α) (List.{u1} β) (List.Forall₂.{u2, u1} α β r)) (List.sections.{u2} α) (List.sections.{u1} β)
Case conversion may be inaccurate. Consider using '#align list.rel_sections List.rel_sectionsₓ'. -/
theorem rel_sections {r : α → β → Prop} :
    (Forall₂ (Forall₂ r) ⇒ Forall₂ (Forall₂ r)) sections sections
  | _, _, forall₂.nil => Forall₂.cons Forall₂.nil Forall₂.nil
  | _, _, forall₂.cons h₀ h₁ =>
    rel_bind (rel_sections h₁) fun _ _ hl => rel_map (fun _ _ ha => Forall₂.cons ha hl) h₀
#align list.rel_sections List.rel_sections

end List


section s1

structure point (α : Type*) :=
  mk :: (x : α) (y : α)

namespace point

def add (p q : point ℕ) : point ℕ := mk (p.x + q.x) (p.y + q.y)

end point

#check point
#check point.rec_on
#check point.x
#check point.y

-- print all generated constructions
#print prefix point

#reduce point.x (point.mk 10 20)
#reduce (point.mk 10 20).y

example (α : Type*) (a b : α) :
    point.x (point.mk a b) = a :=
  eq.refl a

-- inline-declared universe u
structure {u} produc (α : Type u) (β : Type u) : Type u :=
  (pr1 : α) (pr2 : β)

#check { point . x := 10, y := 20 } -- point ℕ
#check ({x := 10, y := 20} : point ℕ)

-- update only some fields of a structure
def p : point ℕ := {x := 1, y := 2}
#reduce {y := 3, ..p}

inductive color
  | red
  | green
  | blue

structure color_point (α : Type*) extends point α :=
  mk :: (c : color)

#reduce color_point.mk {x := 10, y := 20} color.red

end s1


/-
Copyright (c) 2019 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.list.range
import Mathlib.data.list.bag_inter
import Mathlib.PostPort

namespace Mathlib

namespace list

/--
`Ico n m` is the list of natural numbers `n ≤ x < m`.
(Ico stands for "interval, closed-open".)

See also `data/set/intervals.lean` for `set.Ico`, modelling intervals in general preorders, and
`multiset.Ico` and `finset.Ico` for `n ≤ x < m` as a multiset or as a finset.

@TODO (anyone): Define `Ioo` and `Icc`, state basic lemmas about them.
@TODO (anyone): Also do the versions for integers?
@TODO (anyone): One could generalise even further, defining
'locally finite partial orders', for which `set.Ico a b` is `[finite]`, and
'locally finite total orders', for which there is a list model.
 -/
def Ico (n : ℕ) (m : ℕ) : List ℕ := range' n (m - n)

namespace Ico

theorem zero_bot (n : ℕ) : Ico 0 n = range n :=
  eq.mpr (id (Eq._oldrec (Eq.refl (Ico 0 n = range n)) (equations._eqn_1 0 n)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (range' 0 (n - 0) = range n)) (nat.sub_zero n)))
      (eq.mpr (id (Eq._oldrec (Eq.refl (range' 0 n = range n)) (range_eq_range' n)))
        (Eq.refl (range' 0 n))))

@[simp] theorem length (n : ℕ) (m : ℕ) : length (Ico n m) = m - n := sorry

theorem pairwise_lt (n : ℕ) (m : ℕ) : pairwise Less (Ico n m) :=
  id
    (eq.mpr (id (propext ((fun (s n : ℕ) => iff_true_intro (pairwise_lt_range' s n)) n (m - n))))
      trivial)

theorem nodup (n : ℕ) (m : ℕ) : nodup (Ico n m) :=
  id
    (eq.mpr (id (propext ((fun (s n : ℕ) => iff_true_intro (nodup_range' s n)) n (m - n)))) trivial)

@[simp] theorem mem {n : ℕ} {m : ℕ} {l : ℕ} : l ∈ Ico n m ↔ n ≤ l ∧ l < m := sorry

theorem eq_nil_of_le {n : ℕ} {m : ℕ} (h : m ≤ n) : Ico n m = [] := sorry

theorem map_add (n : ℕ) (m : ℕ) (k : ℕ) : map (Add.add k) (Ico n m) = Ico (n + k) (m + k) := sorry

theorem map_sub (n : ℕ) (m : ℕ) (k : ℕ) (h₁ : k ≤ n) :
    map (fun (x : ℕ) => x - k) (Ico n m) = Ico (n - k) (m - k) :=
  sorry

@[simp] theorem self_empty {n : ℕ} : Ico n n = [] := eq_nil_of_le (le_refl n)

@[simp] theorem eq_empty_iff {n : ℕ} {m : ℕ} : Ico n m = [] ↔ m ≤ n := sorry

theorem append_consecutive {n : ℕ} {m : ℕ} {l : ℕ} (hnm : n ≤ m) (hml : m ≤ l) :
    Ico n m ++ Ico m l = Ico n l :=
  sorry

@[simp] theorem inter_consecutive (n : ℕ) (m : ℕ) (l : ℕ) : Ico n m ∩ Ico m l = [] := sorry

@[simp] theorem bag_inter_consecutive (n : ℕ) (m : ℕ) (l : ℕ) :
    list.bag_inter (Ico n m) (Ico m l) = [] :=
  iff.mpr (bag_inter_nil_iff_inter_nil (Ico n m) (Ico m l)) (inter_consecutive n m l)

@[simp] theorem succ_singleton {n : ℕ} : Ico n (n + 1) = [n] := sorry

theorem succ_top {n : ℕ} {m : ℕ} (h : n ≤ m) : Ico n (m + 1) = Ico n m ++ [m] :=
  eq.mpr (id (Eq._oldrec (Eq.refl (Ico n (m + 1) = Ico n m ++ [m])) (Eq.symm succ_singleton)))
    (eq.mpr
      (id
        (Eq._oldrec (Eq.refl (Ico n (m + 1) = Ico n m ++ Ico m (m + 1)))
          (append_consecutive h (nat.le_succ m))))
      (Eq.refl (Ico n (m + 1))))

theorem eq_cons {n : ℕ} {m : ℕ} (h : n < m) : Ico n m = n :: Ico (n + 1) m :=
  eq.mpr
    (id
      (Eq._oldrec (Eq.refl (Ico n m = n :: Ico (n + 1) m))
        (Eq.symm (append_consecutive (nat.le_succ n) h))))
    (eq.mpr
      (id
        (Eq._oldrec (Eq.refl (Ico n (Nat.succ n) ++ Ico (Nat.succ n) m = n :: Ico (n + 1) m))
          succ_singleton))
      (Eq.refl ([n] ++ Ico (Nat.succ n) m)))

@[simp] theorem pred_singleton {m : ℕ} (h : 0 < m) : Ico (m - 1) m = [m - 1] := sorry

theorem chain'_succ (n : ℕ) (m : ℕ) : chain' (fun (a b : ℕ) => b = Nat.succ a) (Ico n m) := sorry

@[simp] theorem not_mem_top {n : ℕ} {m : ℕ} : ¬m ∈ Ico n m := sorry

theorem filter_lt_of_top_le {n : ℕ} {m : ℕ} {l : ℕ} (hml : m ≤ l) :
    filter (fun (x : ℕ) => x < l) (Ico n m) = Ico n m :=
  iff.mpr filter_eq_self
    fun (k : ℕ) (hk : k ∈ Ico n m) => lt_of_lt_of_le (and.right (iff.mp mem hk)) hml

theorem filter_lt_of_le_bot {n : ℕ} {m : ℕ} {l : ℕ} (hln : l ≤ n) :
    filter (fun (x : ℕ) => x < l) (Ico n m) = [] :=
  iff.mpr filter_eq_nil
    fun (k : ℕ) (hk : k ∈ Ico n m) => not_lt_of_le (le_trans hln (and.left (iff.mp mem hk)))

theorem filter_lt_of_ge {n : ℕ} {m : ℕ} {l : ℕ} (hlm : l ≤ m) :
    filter (fun (x : ℕ) => x < l) (Ico n m) = Ico n l :=
  sorry

@[simp] theorem filter_lt (n : ℕ) (m : ℕ) (l : ℕ) :
    filter (fun (x : ℕ) => x < l) (Ico n m) = Ico n (min m l) :=
  sorry

theorem filter_le_of_le_bot {n : ℕ} {m : ℕ} {l : ℕ} (hln : l ≤ n) :
    filter (fun (x : ℕ) => l ≤ x) (Ico n m) = Ico n m :=
  iff.mpr filter_eq_self fun (k : ℕ) (hk : k ∈ Ico n m) => le_trans hln (and.left (iff.mp mem hk))

theorem filter_le_of_top_le {n : ℕ} {m : ℕ} {l : ℕ} (hml : m ≤ l) :
    filter (fun (x : ℕ) => l ≤ x) (Ico n m) = [] :=
  iff.mpr filter_eq_nil
    fun (k : ℕ) (hk : k ∈ Ico n m) => not_le_of_gt (lt_of_lt_of_le (and.right (iff.mp mem hk)) hml)

theorem filter_le_of_le {n : ℕ} {m : ℕ} {l : ℕ} (hnl : n ≤ l) :
    filter (fun (x : ℕ) => l ≤ x) (Ico n m) = Ico l m :=
  sorry

@[simp] theorem filter_le (n : ℕ) (m : ℕ) (l : ℕ) :
    filter (fun (x : ℕ) => l ≤ x) (Ico n m) = Ico (max n l) m :=
  sorry

theorem filter_lt_of_succ_bot {n : ℕ} {m : ℕ} (hnm : n < m) :
    filter (fun (x : ℕ) => x < n + 1) (Ico n m) = [n] :=
  sorry

@[simp] theorem filter_le_of_bot {n : ℕ} {m : ℕ} (hnm : n < m) :
    filter (fun (x : ℕ) => x ≤ n) (Ico n m) = [n] :=
  eq.mpr
    (id
      (Eq._oldrec (Eq.refl (filter (fun (x : ℕ) => x ≤ n) (Ico n m) = [n]))
        (Eq.symm (filter_lt_of_succ_bot hnm))))
    (filter_congr fun (_x : ℕ) (_x_1 : _x ∈ Ico n m) => iff.symm nat.lt_succ_iff)

/--
For any natural numbers n, a, and b, one of the following holds:
1. n < a
2. n ≥ b
3. n ∈ Ico a b
-/
theorem trichotomy (n : ℕ) (a : ℕ) (b : ℕ) : n < a ∨ b ≤ n ∨ n ∈ Ico a b := sorry

end Mathlib


/-
Copyright (c) 2019 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.topology.category.Top.basic
import Mathlib.category_theory.eq_to_hom
import Mathlib.PostPort

universes u u_1

namespace Mathlib

/-!
# The category of open sets in a topological space.

We define `to_Top : opens X ⥤ Top` and
`map (f : X ⟶ Y) : opens Y ⥤ opens X`, given by taking preimages of open sets.

Unfortunately `opens` isn't (usefully) a functor `Top ⥤ Cat`.
(One can in fact define such a functor,
but using it results in unresolvable `eq.rec` terms in goals.)

Really it's a 2-functor from (spaces, continuous functions, equalities)
to (categories, functors, natural isomorphisms).
We don't attempt to set up the full theory here, but do provide the natural isomorphisms
`map_id : map (𝟙 X) ≅ 𝟭 (opens X)` and
`map_comp : map (f ≫ g) ≅ map g ⋙ map f`.

Beyond that, there's a collection of simp lemmas for working with these constructions.
-/

namespace topological_space.opens

/-!
Since `opens X` has a partial order, it automatically receives a `category` instance.
Unfortunately, because we do not allow morphisms in `Prop`,
the morphisms `U ⟶ V` are not just proofs `U ≤ V`, but rather
`ulift (plift (U ≤ V))`.
-/

protected instance opens_hom_has_coe_to_fun {X : Top} {U : opens ↥X} {V : opens ↥X} : has_coe_to_fun (U ⟶ V) :=
  has_coe_to_fun.mk (fun (f : U ⟶ V) => ↥U → ↥V) fun (f : U ⟶ V) (x : ↥U) => { val := ↑x, property := sorry }

/-!
We now construct as morphisms various inclusions of open sets.
-/

-- This is tedious, but necessary because we decided not to allow Prop as morphisms in a category...

/--
The inclusion `U ⊓ V ⟶ U` as a morphism in the category of open sets.
-/
def inf_le_left {X : Top} (U : opens ↥X) (V : opens ↥X) : U ⊓ V ⟶ U :=
  category_theory.hom_of_le sorry

/--
The inclusion `U ⊓ V ⟶ V` as a morphism in the category of open sets.
-/
def inf_le_right {X : Top} (U : opens ↥X) (V : opens ↥X) : U ⊓ V ⟶ V :=
  category_theory.hom_of_le sorry

/--
The inclusion `U i ⟶ supr U` as a morphism in the category of open sets.
-/
def le_supr {X : Top} {ι : Type u_1} (U : ι → opens ↥X) (i : ι) : U i ⟶ supr U :=
  category_theory.hom_of_le sorry

/--
The inclusion `⊥ ⟶ U` as a morphism in the category of open sets.
-/
def bot_le {X : Top} (U : opens ↥X) : ⊥ ⟶ U :=
  category_theory.hom_of_le sorry

/--
The inclusion `U ⟶ ⊤` as a morphism in the category of open sets.
-/
def le_top {X : Top} (U : opens ↥X) : U ⟶ ⊤ :=
  category_theory.hom_of_le sorry

-- We do not mark this as a simp lemma because it breaks open `x`.

-- Nevertheless, it is useful in `sheaf_of_functions`.

theorem inf_le_left_apply {X : Top} (U : opens ↥X) (V : opens ↥X) (x : ↥(U ⊓ V)) : coe_fn (inf_le_left U V) x = { val := subtype.val x, property := inf_le_left (subtype.val x) (subtype.property x) } :=
  rfl

@[simp] theorem inf_le_left_apply_mk {X : Top} (U : opens ↥X) (V : opens ↥X) (x : ↥X) (m : x ∈ has_coe_t_aux.coe (U ⊓ V)) : coe_fn (inf_le_left U V) { val := x, property := m } = { val := x, property := inf_le_left x m } :=
  rfl

@[simp] theorem le_supr_apply_mk {X : Top} {ι : Type u_1} (U : ι → opens ↥X) (i : ι) (x : ↥X) (m : x ∈ has_coe_t_aux.coe (U i)) : coe_fn (le_supr U i) { val := x, property := m } = { val := x, property := le_supr U i x m } :=
  rfl

/--
The functor from open sets in `X` to `Top`,
realising each open set as a topological space itself.
-/
def to_Top (X : Top) : opens ↥X ⥤ Top :=
  category_theory.functor.mk (fun (U : opens ↥X) => category_theory.bundled.mk ↥(subtype.val U))
    fun (U V : opens ↥X) (i : U ⟶ V) =>
      continuous_map.mk
        fun (x : ↥(category_theory.bundled.mk ↥(subtype.val U))) => { val := subtype.val x, property := sorry }

@[simp] theorem to_Top_map (X : Top) {U : opens ↥X} {V : opens ↥X} {f : U ⟶ V} {x : ↥X} {h : x ∈ subtype.val U} : coe_fn (category_theory.functor.map (to_Top X) f) { val := x, property := h } =
  { val := x, property := category_theory.le_of_hom f x h } :=
  rfl

/--
The inclusion map from an open subset to the whole space, as a morphism in `Top`.
-/
@[simp] theorem inclusion_to_fun {X : Top} (U : opens ↥X) : ∀ (ᾰ : Subtype fun (x : ↥X) => x ∈ subtype.val U), coe_fn (inclusion U) ᾰ = ↑ᾰ :=
  fun (ᾰ : Subtype fun (x : ↥X) => x ∈ subtype.val U) => Eq.refl (coe_fn (inclusion U) ᾰ)

theorem inclusion_open_embedding {X : Top} (U : opens ↥X) : open_embedding ⇑(inclusion U) :=
  is_open.open_embedding_subtype_coe (subtype.property U)

/-- `opens.map f` gives the functor from open sets in Y to open set in X,
    given by taking preimages under f. -/
def map {X : Top} {Y : Top} (f : X ⟶ Y) : opens ↥Y ⥤ opens ↥X :=
  category_theory.functor.mk (fun (U : opens ↥Y) => { val := ⇑f ⁻¹' subtype.val U, property := sorry })
    fun (U V : opens ↥Y) (i : U ⟶ V) => ulift.up (plift.up sorry)

@[simp] theorem map_obj {X : Top} {Y : Top} (f : X ⟶ Y) (U : set ↥Y) (p : is_open U) : category_theory.functor.obj (map f) { val := U, property := p } =
  { val := ⇑f ⁻¹' U, property := is_open.preimage (continuous_map.continuous f) p } :=
  rfl

@[simp] theorem map_id_obj {X : Top} (U : opens ↥X) : category_theory.functor.obj (map 𝟙) U = U :=
  ext (set.ext fun (x : ↥X) => iff.refl (x ∈ ↑(category_theory.functor.obj (map 𝟙) U)))

@[simp] theorem map_id_obj' {X : Top} (U : set ↥X) (p : is_open U) : category_theory.functor.obj (map 𝟙) { val := U, property := p } = { val := U, property := p } :=
  rfl

@[simp] theorem map_id_obj_unop {X : Top} (U : opens ↥Xᵒᵖ) : category_theory.functor.obj (map 𝟙) (opposite.unop U) = opposite.unop U := sorry

@[simp] theorem op_map_id_obj {X : Top} (U : opens ↥Xᵒᵖ) : category_theory.functor.obj (category_theory.functor.op (map 𝟙)) U = U := sorry

/--
The inclusion `U ⟶ (map f).obj ⊤` as a morphism in the category of open sets.
-/
def le_map_top {X : Top} {Y : Top} (f : X ⟶ Y) (U : opens ↥X) : U ⟶ category_theory.functor.obj (map f) ⊤ :=
  category_theory.hom_of_le sorry

@[simp] theorem map_comp_obj {X : Top} {Y : Top} {Z : Top} (f : X ⟶ Y) (g : Y ⟶ Z) (U : opens ↥Z) : category_theory.functor.obj (map (f ≫ g)) U =
  category_theory.functor.obj (map f) (category_theory.functor.obj (map g) U) :=
  ext (set.ext fun (x : ↥X) => iff.refl (x ∈ ↑(category_theory.functor.obj (map (f ≫ g)) U)))

@[simp] theorem map_comp_obj' {X : Top} {Y : Top} {Z : Top} (f : X ⟶ Y) (g : Y ⟶ Z) (U : set ↥Z) (p : is_open U) : category_theory.functor.obj (map (f ≫ g)) { val := U, property := p } =
  category_theory.functor.obj (map f) (category_theory.functor.obj (map g) { val := U, property := p }) :=
  rfl

@[simp] theorem map_comp_map {X : Top} {Y : Top} {Z : Top} (f : X ⟶ Y) (g : Y ⟶ Z) {U : opens ↥Z} {V : opens ↥Z} (i : U ⟶ V) : category_theory.functor.map (map (f ≫ g)) i =
  category_theory.functor.map (map f) (category_theory.functor.map (map g) i) :=
  rfl

@[simp] theorem map_comp_obj_unop {X : Top} {Y : Top} {Z : Top} (f : X ⟶ Y) (g : Y ⟶ Z) (U : opens ↥Zᵒᵖ) : category_theory.functor.obj (map (f ≫ g)) (opposite.unop U) =
  category_theory.functor.obj (map f) (category_theory.functor.obj (map g) (opposite.unop U)) :=
  map_comp_obj f g (opposite.unop U)

@[simp] theorem op_map_comp_obj {X : Top} {Y : Top} {Z : Top} (f : X ⟶ Y) (g : Y ⟶ Z) (U : opens ↥Zᵒᵖ) : category_theory.functor.obj (category_theory.functor.op (map (f ≫ g))) U =
  category_theory.functor.obj (category_theory.functor.op (map f))
    (category_theory.functor.obj (category_theory.functor.op (map g)) U) := sorry

/--
The functor `opens X ⥤ opens X` given by taking preimages under the identity function
is naturally isomorphic to the identity functor.
-/
@[simp] theorem map_id_hom_app (X : Top) (U : opens ↥X) : category_theory.nat_trans.app (category_theory.iso.hom (map_id X)) U = category_theory.eq_to_hom (map_id_obj U) :=
  Eq.refl (category_theory.nat_trans.app (category_theory.iso.hom (map_id X)) U)

/--
The natural isomorphism between taking preimages under `f ≫ g`, and the composite
of taking preimages under `g`, then preimages under `f`.
-/
@[simp] theorem map_comp_hom_app {X : Top} {Y : Top} {Z : Top} (f : X ⟶ Y) (g : Y ⟶ Z) (U : opens ↥Z) : category_theory.nat_trans.app (category_theory.iso.hom (map_comp f g)) U =
  category_theory.eq_to_hom (map_comp_obj f g U) :=
  Eq.refl (category_theory.nat_trans.app (category_theory.iso.hom (map_comp f g)) U)

/--
If two continuous maps `f g : X ⟶ Y` are equal,
then the functors `opens Y ⥤ opens X` they induce are isomorphic.
-/
-- We could make `f g` implicit here, but it's nice to be able to see when

-- they are the identity (often!)

def map_iso {X : Top} {Y : Top} (f : X ⟶ Y) (g : X ⟶ Y) (h : f = g) : map f ≅ map g :=
  category_theory.nat_iso.of_components (fun (U : opens ↥Y) => category_theory.eq_to_iso sorry) sorry

@[simp] theorem map_iso_refl {X : Top} {Y : Top} (f : X ⟶ Y) (h : f = f) : map_iso f f h = category_theory.iso.refl (map f) :=
  rfl

@[simp] theorem map_iso_hom_app {X : Top} {Y : Top} (f : X ⟶ Y) (g : X ⟶ Y) (h : f = g) (U : opens ↥Y) : category_theory.nat_trans.app (category_theory.iso.hom (map_iso f g h)) U =
  category_theory.eq_to_hom (congr_fun (congr_arg category_theory.functor.obj (congr_arg map h)) U) :=
  rfl

@[simp] theorem map_iso_inv_app {X : Top} {Y : Top} (f : X ⟶ Y) (g : X ⟶ Y) (h : f = g) (U : opens ↥Y) : category_theory.nat_trans.app (category_theory.iso.inv (map_iso f g h)) U =
  category_theory.eq_to_hom (congr_fun (congr_arg category_theory.functor.obj (congr_arg map (Eq.symm h))) U) :=
  rfl

end topological_space.opens

/--
An open map `f : X ⟶ Y` induces a functor `opens X ⥤ opens Y`.
-/
@[simp] theorem is_open_map.functor_obj_coe {X : Top} {Y : Top} {f : X ⟶ Y} (hf : is_open_map ⇑f) (U : topological_space.opens ↥X) : ↑(category_theory.functor.obj (is_open_map.functor hf) U) = ⇑f '' ↑U :=
  Eq.refl ↑(category_theory.functor.obj (is_open_map.functor hf) U)

/--
An open map `f : X ⟶ Y` induces an adjunction between `opens X` and `opens Y`.
-/
def is_open_map.adjunction {X : Top} {Y : Top} {f : X ⟶ Y} (hf : is_open_map ⇑f) : is_open_map.functor hf ⊣ topological_space.opens.map f :=
  category_theory.adjunction.mk_of_unit_counit
    (category_theory.adjunction.core_unit_counit.mk
      (category_theory.nat_trans.mk fun (U : topological_space.opens ↥X) => category_theory.hom_of_le sorry)
      (category_theory.nat_trans.mk fun (V : topological_space.opens ↥Y) => category_theory.hom_of_le sorry))


-- Copyright 2022-2023 VMware, Inc.
-- SPDX-License-Identifier: BSD-2-Clause

import .relational

open zset

section count.
variables {a: Type} [decidable_eq a].

def count (m: Z[a]) : ℤ :=
  m.support.sum (λ a, m a).

def count' : Z[a] → Z[ℤ] := λ m, {count m}.

theorem count_ok (s: finset a) :
  count (zset.from_set s) = s.card :=
begin
  unfold count zset.from_set,
  simp,
  congr' 1,
  ext a, simp,
end

theorem count_linear (m1 m2: Z[a]) :
  count (m1 + m2) = count m1 + count m2 :=
begin
  unfold count,
  rw add_support,
  simp only [ne.def],
  rw finset.sum_filter_of_ne, swap,
  { intros x, simp, },
  conv_lhs {
    congr, skip,
    funext,
    simp, skip,
  },
  rw finset.sum_add_distrib,
  congr' 1,
  { rw sum_union_zero_l, simp, },
  { rw finset.union_comm,
    rw sum_union_zero_l, simp, }
end

theorem count'_ok (s: finset a) :
  zset.to_set (count' (zset.from_set s)) = {s.card} :=
begin
  unfold count' zset.to_set,
  rw count_ok,
  simp,
end
end count.

namespace zset.

-- NOTE: this could be generalized to any vector space with ℤ as its constants
protected def sum (m: Z[ℚ]) : ℚ :=
  m.support.sum (λ a, a * m a).

def sum' : Z[ℚ] → Z[ℚ] := λ m, {zset.sum m}.

theorem sum_ok (s: finset ℚ) :
  zset.sum (zset.from_set s) = finset.sum s (λ a, a) :=
begin
  unfold zset.sum zset.from_set,
  simp,
  apply finset.sum_congr,
  { ext a, simp, },
  { intros, refl, },
end

theorem sum_linear (m1 m2: Z[ℚ]) :
  zset.sum (m1 + m2) = zset.sum m1 + zset.sum m2 :=
begin
  unfold zset.sum,
  apply general_sum_linear (λ a m, a * (↑m : ℚ)),
  { intros, simp, },
  { intros, simp, rw mul_add, },
end

theorem sum'_ok (s: finset ℚ) :
  zset.to_set (sum' (zset.from_set s)) = {finset.sum s (λ a, a)} :=
begin
  unfold sum' zset.to_set,
  rw sum_ok,
  simp,
end

end zset.