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

import number_theory.pell
import data.pfun
import data.fin2

/-!
# Diophantine functions and Matiyasevic's theorem

Hilbert's tenth problem asked whether there exists an algorithm which for a given integer polynomial
determines whether this polynomial has integer solutions. It was answered in the negative in 1970,
the final step being completed by Matiyasevic who showed that the power function is Diophantine.

Here a function is called Diophantine if its graph is Diophantine as a set. A subset `S ⊆ ℕ ^ α` in
turn is called Diophantine if there exists an integer polynomial on `α ⊕ β` such that `v ∈ S` iff
there exists `t : ℕ^β` with `p (v, t) = 0`.

## Main definitions

* `is_poly`: a predicate stating that a function is a multivariate integer polynomial.
* `poly`: the type of multivariate integer polynomial functions.
* `dioph`: a predicate stating that a set `S ⊆ ℕ^α` is Diophantine, i.e. that
* `dioph_fn`: a predicate on a function stating that it is Diophantine in the sense that its graph
  is Diophantine as a set.

## Main statements

* `pell_dioph` states that solutions to Pell's equation form a Diophantine set.
* `pow_dioph` states that the power function is Diophantine, a version of Matiyasevic's theorem.

## References

* [M. Carneiro, _A Lean formalization of Matiyasevic's theorem_][carneiro2018matiyasevic]
* [M. Davis, _Hilbert's tenth problem is unsolvable_][MR317916]

## Tags

Matiyasevic's theorem, Hilbert's tenth problem

## TODO

* Finish the solution of Hilbert's tenth problem.
* Connect `poly` to `mv_polynomial`
-/

universe u

open nat function

namespace int

lemma eq_nat_abs_iff_mul (x n) : nat_abs x = n ↔ (x - n) * (x + n) = 0 :=
begin
  refine iff.trans _ mul_eq_zero.symm,
  refine iff.trans _ (or_congr sub_eq_zero add_eq_zero_iff_eq_neg).symm,
  exact ⟨λe, by rw ← e; apply nat_abs_eq,
    λo, by cases o; subst x; simp [nat_abs_of_nat]⟩
end

end int

open fin2

/-- Alternate definition of `vector` based on `fin2`. -/
def vector3 (α : Type u) (n : ℕ) : Type u := fin2 n → α

namespace vector3

/-- The empty vector -/
@[pattern] def nil {α} : vector3 α 0.

/-- The vector cons operation -/
@[pattern] def cons {α} {n} (a : α) (v : vector3 α n) : vector3 α (succ n) :=
λi, by {refine i.cases' _ _, exact a, exact v}

/- We do not want to make the following notation global, because then these expressions will be
overloaded, and only the expected type will be able to disambiguate the meaning. Worse: Lean will
try to insert a coercion from `vector3 α _` to `list α`, if a list is expected. -/
localized "notation `[` l:(foldr `, ` (h t, vector3.cons h t) nil `]`) := l" in vector3
notation a :: b := cons a b

@[simp] theorem cons_fz {α} {n} (a : α) (v : vector3 α n) : (a :: v) fz = a := rfl
@[simp] theorem cons_fs {α} {n} (a : α) (v : vector3 α n) (i) : (a :: v) (fs i) = v i := rfl

/-- Get the `i`th element of a vector -/
@[reducible] def nth {α} {n} (i : fin2 n) (v : vector3 α n) : α := v i

/-- Construct a vector from a function on `fin2`. -/
@[reducible] def of_fn {α} {n} (f : fin2 n → α) : vector3 α n := f

/-- Get the head of a nonempty vector. -/
def head {α} {n} (v : vector3 α (succ n)) : α := v fz

/-- Get the tail of a nonempty vector. -/
def tail {α} {n} (v : vector3 α (succ n)) : vector3 α n := λi, v (fs i)

theorem eq_nil {α} (v : vector3 α 0) : v = [] :=
funext $ λi, match i with end

theorem cons_head_tail {α} {n} (v : vector3 α (succ n)) : head v :: tail v = v :=
funext $ λi, fin2.cases' rfl (λ_, rfl) i

def nil_elim {α} {C : vector3 α 0 → Sort u} (H : C []) (v : vector3 α 0) : C v :=
by rw eq_nil v; apply H

def cons_elim {α n} {C : vector3 α (succ n) → Sort u} (H : Π (a : α) (t : vector3 α n), C (a :: t))
  (v : vector3 α (succ n)) : C v :=
by rw ← (cons_head_tail v); apply H

@[simp] theorem cons_elim_cons {α n C H a t} : @cons_elim α n C H (a :: t) = H a t := rfl

@[elab_as_eliminator]
protected def rec_on {α} {C : Π {n}, vector3 α n → Sort u} {n} (v : vector3 α n)
  (H0 : C [])
  (Hs : Π {n} (a) (w : vector3 α n), C w → C (a :: w)) : C v :=
nat.rec_on n
  (λv, v.nil_elim H0)
  (λn IH v, v.cons_elim (λa t, Hs _ _ (IH _))) v

@[simp] theorem rec_on_nil {α C H0 Hs} : @vector3.rec_on α @C 0 [] H0 @Hs = H0 :=
rfl

@[simp] theorem rec_on_cons {α C H0 Hs n a v} :
  @vector3.rec_on α @C (succ n) (a :: v) H0 @Hs = Hs a v (@vector3.rec_on α @C n v H0 @Hs) :=
rfl

/-- Append two vectors -/
def append {α} {m} (v : vector3 α m) {n} (w : vector3 α n) : vector3 α (n+m) :=
nat.rec_on m (λ_, w) (λm IH v, v.cons_elim $ λa t, @fin2.cases' (n+m) (λ_, α) a (IH t)) v

local infix ` +-+ `:65 := vector3.append

@[simp] theorem append_nil {α} {n} (w : vector3 α n) : [] +-+ w = w := rfl

@[simp] theorem append_cons {α} (a : α) {m} (v : vector3 α m) {n} (w : vector3 α n) :
  (a::v) +-+ w = a :: (v +-+ w) := rfl

@[simp] theorem append_left {α} : ∀ {m} (i : fin2 m) (v : vector3 α m) {n} (w : vector3 α n),
  (v +-+ w) (left n i) = v i
| ._ (@fz m)   v n w := v.cons_elim (λa t, by simp [*, left])
| ._ (@fs m i) v n w := v.cons_elim (λa t, by simp [*, left])

@[simp] theorem append_add {α} : ∀ {m} (v : vector3 α m) {n} (w : vector3 α n) (i : fin2 n),
  (v +-+ w) (add i m) = w i
| 0        v n w i := rfl
| (succ m) v n w i := v.cons_elim (λa t, by simp [*, add])

/-- Insert `a` into `v` at index `i`. -/
def insert {α} (a : α) {n} (v : vector3 α n) (i : fin2 (succ n)) : vector3 α (succ n) :=
λj, (a :: v) (insert_perm i j)

@[simp] theorem insert_fz {α} (a : α) {n} (v : vector3 α n) : insert a v fz = a :: v :=
by refine funext (λj, j.cases' _ _); intros; refl

@[simp] theorem insert_fs {α} (a : α) {n} (b : α) (v : vector3 α n) (i : fin2 (succ n)) :
  insert a (b :: v) (fs i) = b :: insert a v i :=
funext $ λj, by {
  refine j.cases' _ (λj, _); simp [insert, insert_perm],
  refine fin2.cases' _ _ (insert_perm i j); simp [insert_perm] }

theorem append_insert {α} (a : α) {k} (t : vector3 α k) {n} (v : vector3 α n) (i : fin2 (succ n))
  (e : succ n + k = succ (n + k)) :
  insert a (t +-+ v) (eq.rec_on e (i.add k)) = eq.rec_on e (t +-+ insert a v i) :=
begin
  refine vector3.rec_on t (λe, _) (λk b t IH e, _) e, refl,
  have e' := succ_add n k,
  change insert a (b :: (t +-+ v)) (eq.rec_on (congr_arg succ e') (fs (add i k)))
    = eq.rec_on (congr_arg succ e') (b :: (t +-+ insert a v i)),
  rw ← (eq.drec_on e' rfl : fs (eq.rec_on e' (i.add k) : fin2 (succ (n + k))) = eq.rec_on
    (congr_arg succ e') (fs (i.add k))),
  simp, rw IH, exact eq.drec_on e' rfl
end

end vector3

section vector3
open vector3
open_locale vector3

/-- "Curried" exists, i.e. ∃ x1 ... xn, f [x1, ..., xn] -/
def vector_ex {α} : Π k, (vector3 α k → Prop) → Prop
| 0        f := f []
| (succ k) f := ∃x : α, vector_ex k (λv, f (x :: v))

/-- "Curried" forall, i.e. ∀ x1 ... xn, f [x1, ..., xn] -/
def vector_all {α} : Π k, (vector3 α k → Prop) → Prop
| 0        f := f []
| (succ k) f := ∀x : α, vector_all k (λv, f (x :: v))

theorem exists_vector_zero {α} (f : vector3 α 0 → Prop) : Exists f ↔ f [] :=
⟨λ⟨v, fv⟩, by rw ← (eq_nil v); exact fv, λf0, ⟨[], f0⟩⟩

theorem exists_vector_succ {α n} (f : vector3 α (succ n) → Prop) : Exists f ↔ ∃x v, f (x :: v) :=
⟨λ⟨v, fv⟩, ⟨_, _, by rw cons_head_tail v; exact fv⟩, λ⟨x, v, fxv⟩, ⟨_, fxv⟩⟩

theorem vector_ex_iff_exists {α} : ∀ {n} (f : vector3 α n → Prop), vector_ex n f ↔ Exists f
| 0        f := (exists_vector_zero f).symm
| (succ n) f := iff.trans (exists_congr (λx, vector_ex_iff_exists _)) (exists_vector_succ f).symm

theorem vector_all_iff_forall {α} : ∀ {n} (f : vector3 α n → Prop), vector_all n f ↔ ∀ v, f v
| 0        f := ⟨λf0 v, v.nil_elim f0, λal, al []⟩
| (succ n) f := (forall_congr (λx, vector_all_iff_forall (λv, f (x :: v)))).trans
  ⟨λal v, v.cons_elim al, λal x v, al (x::v)⟩

/-- `vector_allp p v` is equivalent to `∀ i, p (v i)`, but unfolds directly to a conjunction,
  i.e. `vector_allp p [0, 1, 2] = p 0 ∧ p 1 ∧ p 2`. -/
def vector_allp {α} (p : α → Prop) {n} (v : vector3 α n) : Prop :=
vector3.rec_on v true (λn a v IH, @vector3.rec_on _ (λn v, Prop) _ v (p a) (λn b v' _, p a ∧ IH))

@[simp] theorem vector_allp_nil {α} (p : α → Prop) : vector_allp p [] = true := rfl
@[simp] theorem vector_allp_singleton {α} (p : α → Prop) (x : α) : vector_allp p [x] = p x := rfl
@[simp] theorem vector_allp_cons {α} (p : α → Prop) {n} (x : α) (v : vector3 α n) :
  vector_allp p (x :: v) ↔ p x ∧ vector_allp p v :=
vector3.rec_on v (and_true _).symm (λn a v IH, iff.rfl)

theorem vector_allp_iff_forall {α} (p : α → Prop) {n} (v : vector3 α n) :
  vector_allp p v ↔ ∀ i, p (v i) :=
begin refine v.rec_on _ _,
  { exact ⟨λ_, fin2.elim0, λ_, trivial⟩ },
  { simp, refine λn a v IH, (and_congr_right (λ_, IH)).trans
      ⟨λ⟨pa, h⟩ i, by {refine i.cases' _ _, exacts [pa, h]}, λh, ⟨_, λi, _⟩⟩,
    { have h0 := h fz, simp at h0, exact h0 },
    { have hs := h (fs i), simp at hs, exact hs } }
end

theorem vector_allp.imp {α} {p q : α → Prop} (h : ∀ x, p x → q x)
  {n} {v : vector3 α n} (al : vector_allp p v) : vector_allp q v :=
(vector_allp_iff_forall _ _).2 (λi, h _ $ (vector_allp_iff_forall _ _).1 al _)
end vector3

/-- `list_all p l` is equivalent to `∀ a ∈ l, p a`, but unfolds directly to a conjunction,
  i.e. `list_all p [0, 1, 2] = p 0 ∧ p 1 ∧ p 2`. -/
@[simp] def list_all {α} (p : α → Prop) : list α → Prop
| []        := true
| (x :: []) := p x
| (x :: l)  := p x ∧ list_all l

@[simp] theorem list_all_cons {α} (p : α → Prop) (x : α) :
  ∀ (l : list α), list_all p (x :: l) ↔ p x ∧ list_all p l
| []       := (and_true _).symm
| (x :: l) := iff.rfl

theorem list_all_iff_forall {α} (p : α → Prop) : ∀ (l : list α), list_all p l ↔ ∀ x ∈ l, p x
| []       := (iff_true_intro $ list.ball_nil _).symm
| (x :: l) := by rw [list.ball_cons, ← list_all_iff_forall l]; simp

theorem list_all.imp {α} {p q : α → Prop} (h : ∀ x, p x → q x) :
  ∀ {l : list α}, list_all p l → list_all q l
| []       := id
| (x :: l) := by simpa using and.imp (h x) list_all.imp

@[simp] theorem list_all_map {α β} {p : β → Prop} (f : α → β) {l : list α} :
  list_all p (l.map f) ↔ list_all (p ∘ f) l :=
by induction l; simp *

theorem list_all_congr {α} {p q : α → Prop} (h : ∀ x, p x ↔ q x) {l : list α} :
  list_all p l ↔ list_all q l :=
⟨list_all.imp (λx, (h x).1), list_all.imp (λx, (h x).2)⟩

instance decidable_list_all {α} (p : α → Prop) [decidable_pred p] (l : list α) :
  decidable (list_all p l) :=
decidable_of_decidable_of_iff (by apply_instance) (list_all_iff_forall _ _).symm

/- poly -/

/-- A predicate asserting that a function is a multivariate integer polynomial.
  (We are being a bit lazy here by allowing many representations for multiplication,
  rather than only allowing monomials and addition, but the definition is equivalent
  and this is easier to use.) -/
inductive is_poly {α} : ((α → ℕ) → ℤ) → Prop
| proj : ∀ i, is_poly (λx : α → ℕ, x i)
| const : Π (n : ℤ), is_poly (λx : α → ℕ, n)
| sub : Π {f g : (α → ℕ) → ℤ}, is_poly f → is_poly g → is_poly (λx, f x - g x)
| mul : Π {f g : (α → ℕ) → ℤ}, is_poly f → is_poly g → is_poly (λx, f x * g x)

/-- The type of multivariate integer polynomials -/
def poly (α : Type u) := {f : (α → ℕ) → ℤ // is_poly f}

namespace poly
section
parameter {α : Type u}

instance : has_coe_to_fun (poly α) := ⟨_, λ f, f.1⟩

/-- The underlying function of a `poly` is a polynomial -/
lemma isp (f : poly α) : is_poly f := f.2

/-- Extensionality for `poly α` -/
lemma ext {f g : poly α} (e : ∀x, f x = g x) : f = g :=
subtype.eq (funext e)

/-- Construct a `poly` given an extensionally equivalent `poly`. -/
def subst (f : poly α) (g : (α → ℕ) → ℤ) (e : ∀x, f x = g x) : poly α :=
⟨g, by rw ← (funext e : coe_fn f = g); exact f.isp⟩
@[simp] theorem subst_eval (f g e x) : subst f g e x = g x := rfl

/-- The `i`th projection function, `x_i`. -/
def proj (i) : poly α := ⟨_, is_poly.proj i⟩
@[simp] theorem proj_eval (i x) : proj i x = x i := rfl

/-- The constant function with value `n : ℤ`. -/
def const (n) : poly α := ⟨_, is_poly.const n⟩
@[simp] theorem const_eval (n x) : const n x = n := rfl

/-- The zero polynomial -/
def zero : poly α := const 0
instance : has_zero (poly α) := ⟨poly.zero⟩
@[simp] theorem zero_eval (x) : (0 : poly α) x = 0 := rfl

/-- The zero polynomial -/
def one : poly α := const 1
instance : has_one (poly α) := ⟨poly.one⟩
@[simp] theorem one_eval (x) : (1 : poly α) x = 1 := rfl

/-- Subtraction of polynomials -/
def sub : poly α → poly α → poly α | ⟨f, pf⟩ ⟨g, pg⟩ :=
⟨_, is_poly.sub pf pg⟩
instance : has_sub (poly α) := ⟨poly.sub⟩
@[simp] theorem sub_eval : Π (f g x), (f - g : poly α) x = f x - g x
| ⟨f, pf⟩ ⟨g, pg⟩ x := rfl

/-- Negation of a polynomial -/
def neg (f : poly α) : poly α := 0 - f
instance : has_neg (poly α) := ⟨poly.neg⟩
@[simp] theorem neg_eval (f x) : (-f : poly α) x = -f x :=
show (0-f) x = _, by simp

/-- Addition of polynomials -/
def add : poly α → poly α → poly α | ⟨f, pf⟩ ⟨g, pg⟩ :=
subst (⟨f, pf⟩ - -⟨g, pg⟩) _
 (λx, show f x - (0 - g x) = f x + g x, by simp)
instance : has_add (poly α) := ⟨poly.add⟩
@[simp] theorem add_eval : Π (f g x), (f + g : poly α) x = f x + g x
| ⟨f, pf⟩ ⟨g, pg⟩ x := rfl

/-- Multiplication of polynomials -/
def mul : poly α → poly α → poly α | ⟨f, pf⟩ ⟨g, pg⟩ :=
⟨_, is_poly.mul pf pg⟩
instance : has_mul (poly α) := ⟨poly.mul⟩
@[simp] theorem mul_eval : Π (f g x), (f * g : poly α) x = f x * g x
| ⟨f, pf⟩ ⟨g, pg⟩ x := rfl

instance : comm_ring (poly α) := by refine_struct
{ add   := (+),
  zero  := (0 : poly α),
  neg   := has_neg.neg,
  mul   := (*),
  one   := 1,
  sub   := has_sub.sub,
  npow  := @npow_rec _ ⟨1⟩ ⟨(*)⟩,
  nsmul := @nsmul_rec _ ⟨0⟩ ⟨(+)⟩,
  gsmul := @gsmul_rec _ ⟨0⟩ ⟨(+)⟩ ⟨neg⟩ };
intros; try { refl }; refine ext (λ _, _);
simp [sub_eq_add_neg, mul_add, mul_left_comm, mul_comm, add_comm, add_assoc]

lemma induction {C : poly α → Prop}
  (H1 : ∀i, C (proj i)) (H2 : ∀n, C (const n))
  (H3 : ∀f g, C f → C g → C (f - g))
  (H4 : ∀f g, C f → C g → C (f * g)) (f : poly α) : C f :=
begin
  cases f with f pf,
  induction pf with i n f g pf pg ihf ihg f g pf pg ihf ihg,
  apply H1, apply H2, apply H3 _ _ ihf ihg, apply H4 _ _ ihf ihg
end

/-- The sum of squares of a list of polynomials. This is relevant for
  Diophantine equations, because it means that a list of equations
  can be encoded as a single equation: `x = 0 ∧ y = 0 ∧ z = 0` is
  equivalent to `x^2 + y^2 + z^2 = 0`. -/
def sumsq : list (poly α) → poly α
| []      := 0
| (p::ps) := p*p + sumsq ps

theorem sumsq_nonneg (x) : ∀ l, 0 ≤ sumsq l x
| []      := le_refl 0
| (p::ps) := by rw sumsq; simp [-add_comm];
                exact add_nonneg (mul_self_nonneg _) (sumsq_nonneg ps)

theorem sumsq_eq_zero (x) : ∀ l, sumsq l x = 0 ↔ list_all (λa : poly α, a x = 0) l
| []      := eq_self_iff_true _
| (p::ps) := by rw [list_all_cons, ← sumsq_eq_zero ps]; rw sumsq; simp [-add_comm]; exact
  ⟨λ(h : p x * p x + sumsq ps x = 0),
   have p x = 0, from eq_zero_of_mul_self_eq_zero $ le_antisymm
     (by rw ← h; have t := add_le_add_left (sumsq_nonneg x ps) (p x * p x); rwa [add_zero] at t)
     (mul_self_nonneg _),
   ⟨this, by simp [this] at h; exact h⟩,
  λ⟨h1, h2⟩, by rw [h1, h2]; refl⟩

end

/-- Map the index set of variables, replacing `x_i` with `x_(f i)`. -/
def remap {α β} (f : α → β) (g : poly α) : poly β :=
⟨λv, g $ v ∘ f, g.induction
  (λi, by simp; apply is_poly.proj)
  (λn, by simp; apply is_poly.const)
  (λf g pf pg, by simp; apply is_poly.sub pf pg)
  (λf g pf pg, by simp; apply is_poly.mul pf pg)⟩
@[simp] theorem remap_eval {α β} (f : α → β) (g : poly α) (v) : remap f g v = g (v ∘ f) := rfl

end poly

namespace sum

/-- combine two functions into a function on the disjoint union -/
def join {α β γ} (f : α → γ) (g : β → γ) : α ⊕ β → γ :=
by {refine sum.rec _ _, exacts [f, g]}

end sum

local infixr ` ⊗ `:65 := sum.join

open sum

namespace option

/-- Functions from `option` can be combined similarly to `vector.cons` -/
def cons {α β} (a : β) (v : α → β) : option α → β :=
by {refine option.rec _ _, exacts [a, v]}

notation a :: b := cons a b

@[simp] theorem cons_head_tail {α β} (v : option α → β) : v none :: v ∘ some = v :=
funext $ λo, by cases o; refl
end option

/- dioph -/

/-- A set `S ⊆ ℕ^α` is Diophantine if there exists a polynomial on
  `α ⊕ β` such that `v ∈ S` iff there exists `t : ℕ^β` with `p (v, t) = 0`. -/
def dioph {α : Type u} (S : set (α → ℕ)) : Prop :=
∃ {β : Type u} (p : poly (α ⊕ β)), ∀ (v : α → ℕ), S v ↔ ∃t, p (v ⊗ t) = 0

namespace dioph
section
variables {α β γ : Type u}
theorem ext {S S' : set (α → ℕ)} (d : dioph S) (H : ∀v, S v ↔ S' v) : dioph S' :=
eq.rec d $ show S = S', from set.ext H

theorem of_no_dummies (S : set (α → ℕ)) (p : poly α) (h : ∀ (v : α → ℕ), S v ↔ p v = 0) :
  dioph S :=
⟨ulift empty, p.remap inl, λv, (h v).trans
  ⟨λh, ⟨λt, empty.rec _ t.down, by simp; rw [
    show (v ⊗ λt:ulift empty, empty.rec _ t.down) ∘ inl = v, from rfl, h]⟩,
  λ⟨t, ht⟩, by simp at ht; rwa [show (v ⊗ t) ∘ inl = v, from rfl] at ht⟩⟩

lemma inject_dummies_lem (f : β → γ) (g : γ → option β) (inv : ∀ x, g (f x) = some x)
  (p : poly (α ⊕ β)) (v : α → ℕ) : (∃t, p (v ⊗ t) = 0) ↔
    (∃t, p.remap (inl ⊗ (inr ∘ f)) (v ⊗ t) = 0) :=
begin
  simp, refine ⟨λt, _, λt, _⟩; cases t with t ht,
  { have : (v ⊗ (0 :: t) ∘ g) ∘ (inl ⊗ inr ∘ f) = v ⊗ t :=
    funext (λs, by cases s with a b; dsimp [join, (∘)]; try {rw inv}; refl),
    exact ⟨(0 :: t) ∘ g, by rwa this⟩ },
  { have : v ⊗ t ∘ f = (v ⊗ t) ∘ (inl ⊗ inr ∘ f) :=
    funext (λs, by cases s with a b; refl),
    exact ⟨t ∘ f, by rwa this⟩ }
end

theorem inject_dummies {S : set (α → ℕ)} (f : β → γ) (g : γ → option β)
  (inv : ∀ x, g (f x) = some x) (p : poly (α ⊕ β)) (h : ∀ (v : α → ℕ), S v ↔ ∃t, p (v ⊗ t) = 0) :
  ∃ q : poly (α ⊕ γ), ∀ (v : α → ℕ), S v ↔ ∃t, q (v ⊗ t) = 0 :=
⟨p.remap (inl ⊗ (inr ∘ f)), λv, (h v).trans $ inject_dummies_lem f g inv _ _⟩

theorem reindex_dioph {S : set (α → ℕ)} : Π (d : dioph S) (f : α → β), dioph (λv, S (v ∘ f))
| ⟨γ, p, pe⟩ f := ⟨γ, p.remap ((inl ∘ f) ⊗ inr), λv, (pe _).trans $ exists_congr $ λt,
  suffices v ∘ f ⊗ t = (v ⊗ t) ∘ (inl ∘ f ⊗ inr), by simp [this],
  funext $ λs, by cases s with a b; refl⟩

theorem dioph_list_all (l) (d : list_all dioph l) :
  dioph (λv, list_all (λS : set (α → ℕ), S v) l) :=
suffices ∃ β (pl : list (poly (α ⊕ β))), ∀ v,
  list_all (λS : set _, S v) l ↔ ∃t, list_all (λp : poly (α ⊕ β), p (v ⊗ t) = 0) pl,
from let ⟨β, pl, h⟩ := this
  in ⟨β, poly.sumsq pl, λv, (h v).trans $ exists_congr $ λt, (poly.sumsq_eq_zero _ _).symm⟩,
begin
  induction l with S l IH,
  exact ⟨ulift empty, [], λv, by simp; exact ⟨λ⟨t⟩, empty.rec _ t, trivial⟩⟩,
  simp at d,
  exact let ⟨⟨β, p, pe⟩, dl⟩ := d, ⟨γ, pl, ple⟩ := IH dl in
  ⟨β ⊕ γ, p.remap (inl ⊗ inr ∘ inl) :: pl.map (λq, q.remap (inl ⊗ (inr ∘ inr))), λv,
    by simp; exact iff.trans (and_congr (pe v) (ple v))
    ⟨λ⟨⟨m, hm⟩, ⟨n, hn⟩⟩,
      ⟨m ⊗ n, by rw [
        show (v ⊗ m ⊗ n) ∘ (inl ⊗ inr ∘ inl) = v ⊗ m,
        from funext $ λs, by cases s with a b; refl]; exact hm,
      by { refine list_all.imp (λq hq, _) hn, dsimp [(∘)],
           rw [show (λ (x : α ⊕ γ), (v ⊗ m ⊗ n) ((inl ⊗ λ (x : γ), inr (inr x)) x)) = v ⊗ n,
               from funext $ λs, by cases s with a b; refl]; exact hq }⟩,
    λ⟨t, hl, hr⟩,
      ⟨⟨t ∘ inl, by rwa [
        show (v ⊗ t) ∘ (inl ⊗ inr ∘ inl) = v ⊗ t ∘ inl,
        from funext $ λs, by cases s with a b; refl] at hl⟩,
      ⟨t ∘ inr, by {
        refine list_all.imp (λq hq, _) hr, dsimp [(∘)] at hq,
        rwa [show (λ (x : α ⊕ γ), (v ⊗ t) ((inl ⊗ λ (x : γ), inr (inr x)) x)) = v ⊗ t ∘ inr,
             from funext $ λs, by cases s with a b; refl] at hq }⟩⟩⟩⟩
end

theorem and_dioph {S S' : set (α → ℕ)} (d : dioph S) (d' : dioph S') : dioph (λv, S v ∧ S' v) :=
dioph_list_all [S, S'] ⟨d, d'⟩

theorem or_dioph {S S' : set (α → ℕ)} : ∀ (d : dioph S) (d' : dioph S'), dioph (λv, S v ∨ S' v)
| ⟨β, p, pe⟩ ⟨γ, q, qe⟩ := ⟨β ⊕ γ, p.remap (inl ⊗ inr ∘ inl) * q.remap (inl ⊗ inr ∘ inr), λv,
  begin
    refine iff.trans (or_congr ((pe v).trans _) ((qe v).trans _))
      (exists_or_distrib.symm.trans (exists_congr $ λt,
      (@mul_eq_zero _ _ _ (p ((v ⊗ t) ∘ (inl ⊗ inr ∘ inl)))
        (q ((v ⊗ t) ∘ (inl ⊗ inr ∘ inr)))).symm)),
    exact inject_dummies_lem _ (some ⊗ (λ_, none)) (λx, rfl) _ _,
    exact inject_dummies_lem _ ((λ_, none) ⊗ some) (λx, rfl) _ _,
  end⟩

/-- A partial function is Diophantine if its graph is Diophantine. -/
def dioph_pfun (f : (α → ℕ) →. ℕ) := dioph (λv : option α → ℕ, f.graph (v ∘ some, v none))

/-- A function is Diophantine if its graph is Diophantine. -/
def dioph_fn (f : (α → ℕ) → ℕ) := dioph (λv : option α → ℕ, f (v ∘ some) = v none)

theorem reindex_dioph_fn {f : (α → ℕ) → ℕ} (d : dioph_fn f) (g : α → β) :
  dioph_fn (λv, f (v ∘ g)) :=
reindex_dioph d (functor.map g)

theorem ex_dioph {S : set (α ⊕ β → ℕ)} : dioph S → dioph (λv, ∃x, S (v ⊗ x))
| ⟨γ, p, pe⟩ := ⟨β ⊕ γ, p.remap ((inl ⊗ inr ∘ inl) ⊗ inr ∘ inr), λv,
  ⟨λ⟨x, hx⟩, let ⟨t, ht⟩ := (pe _).1 hx in ⟨x ⊗ t, by simp; rw [
    show (v ⊗ x ⊗ t) ∘ ((inl ⊗ inr ∘ inl) ⊗ inr ∘ inr) = (v ⊗ x) ⊗ t,
    from funext $ λs, by cases s with a b; try {cases a}; refl]; exact ht⟩,
  λ⟨t, ht⟩, ⟨t ∘ inl, (pe _).2 ⟨t ∘ inr, by simp at ht; rwa [
    show (v ⊗ t) ∘ ((inl ⊗ inr ∘ inl) ⊗ inr ∘ inr) = (v ⊗ t ∘ inl) ⊗ t ∘ inr,
    from funext $ λs, by cases s with a b; try {cases a}; refl] at ht⟩⟩⟩⟩

theorem ex1_dioph {S : set (option α → ℕ)} : dioph S → dioph (λv, ∃x, S (x :: v))
| ⟨β, p, pe⟩ := ⟨option β, p.remap (inr none :: inl ⊗ inr ∘ some), λv,
  ⟨λ⟨x, hx⟩, let ⟨t, ht⟩ := (pe _).1 hx in ⟨x :: t, by simp; rw [
    show (v ⊗ x :: t) ∘ (inr none :: inl ⊗ inr ∘ some) = x :: v ⊗ t,
    from funext $ λs, by cases s with a b; try {cases a}; refl]; exact ht⟩,
  λ⟨t, ht⟩, ⟨t none, (pe _).2 ⟨t ∘ some, by simp at ht; rwa [
    show (v ⊗ t) ∘ (inr none :: inl ⊗ inr ∘ some) = t none :: v ⊗ t ∘ some,
    from funext $ λs, by cases s with a b; try {cases a}; refl] at ht⟩⟩⟩⟩

theorem dom_dioph {f : (α → ℕ) →. ℕ} (d : dioph_pfun f) : dioph f.dom :=
cast (congr_arg dioph $ set.ext $ λv, (pfun.dom_iff_graph _ _).symm) (ex1_dioph d)

theorem dioph_fn_iff_pfun (f : (α → ℕ) → ℕ) : dioph_fn f = @dioph_pfun α f :=
by refine congr_arg dioph (set.ext $ λv, _); exact pfun.lift_graph.symm

theorem abs_poly_dioph (p : poly α) : dioph_fn (λv, (p v).nat_abs) :=
by refine of_no_dummies _ ((p.remap some - poly.proj none) * (p.remap some + poly.proj none))
  (λv, _); apply int.eq_nat_abs_iff_mul

theorem proj_dioph (i : α) : dioph_fn (λv, v i) :=
abs_poly_dioph (poly.proj i)

theorem dioph_pfun_comp1 {S : set (option α → ℕ)} (d : dioph S) {f} (df : dioph_pfun f) :
  dioph (λv : α → ℕ, ∃ h : f.dom v, S (f.fn v h :: v)) :=
ext (ex1_dioph (and_dioph d df)) $ λv,
⟨λ⟨x, hS, (h: Exists _)⟩, by
  rw [show (x :: v) ∘ some = v, from funext $ λs, rfl] at h;
  cases h with hf h; refine ⟨hf, _⟩; rw [pfun.fn, h]; exact hS,
λ⟨x, hS⟩, ⟨f.fn v x, hS, show Exists _,
  by rw [show (f.fn v x :: v) ∘ some = v, from funext $ λs, rfl]; exact ⟨x, rfl⟩⟩⟩

theorem dioph_fn_comp1 {S : set (option α → ℕ)} (d : dioph S) {f : (α → ℕ) → ℕ} (df : dioph_fn f) :
  dioph (λv : α → ℕ, S (f v :: v)) :=
ext (dioph_pfun_comp1 d (cast (dioph_fn_iff_pfun f) df)) $ λv,
⟨λ⟨_, h⟩, h, λh, ⟨trivial, h⟩⟩

end

section
variables {α β γ : Type}
open vector3
open_locale vector3
theorem dioph_fn_vec_comp1 {n} {S : set (vector3 ℕ (succ n))} (d : dioph S) {f : (vector3 ℕ n) → ℕ}
  (df : dioph_fn f) :
  dioph (λv : vector3 ℕ n, S (cons (f v) v)) :=
ext (dioph_fn_comp1 (reindex_dioph d (none :: some)) df) $ λv, by rw [
  show option.cons (f v) v ∘ (cons none some) = f v :: v,
  from funext $ λs, by cases s with a b; refl]

theorem vec_ex1_dioph (n) {S : set (vector3 ℕ (succ n))} (d : dioph S) :
  dioph (λv : vector3 ℕ n, ∃x, S (x :: v)) :=
ext (ex1_dioph $ reindex_dioph d (none :: some)) $ λv, exists_congr $ λx, by rw [
  show (option.cons x v) ∘ (cons none some) = x :: v,
  from funext $ λs, by cases s with a b; refl]

theorem dioph_fn_vec {n} (f : vector3 ℕ n → ℕ) :
  dioph_fn f ↔ dioph (λv : vector3 ℕ (succ n), f (v ∘ fs) = v fz) :=
⟨λh, reindex_dioph h (fz :: fs), λh, reindex_dioph h (none :: some)⟩

theorem dioph_pfun_vec {n} (f : vector3 ℕ n →. ℕ) :
  dioph_pfun f ↔ dioph (λv : vector3 ℕ (succ n), f.graph (v ∘ fs, v fz)) :=
⟨λh, reindex_dioph h (fz :: fs), λh, reindex_dioph h (none :: some)⟩

theorem dioph_fn_compn {α : Type} : ∀ {n} {S : set (α ⊕ fin2 n → ℕ)} (d : dioph S)
  {f : vector3 ((α → ℕ) → ℕ) n} (df : vector_allp dioph_fn f),
  dioph (λv : α → ℕ, S (v ⊗ λi, f i v))
| 0 S d f := λdf, ext (reindex_dioph d (id ⊗ fin2.elim0)) $ λv,
  by refine eq.to_iff (congr_arg S $ funext $ λs, _); {cases s with a b, refl, cases b}
| (succ n) S d f := f.cons_elim $ λf fl, by simp; exact λ df dfl,
  have dioph (λv, S (v ∘ inl ⊗ f (v ∘ inl) :: v ∘ inr)),
  from ext (dioph_fn_comp1 (reindex_dioph d (some ∘ inl ⊗ none :: some ∘ inr))
    (reindex_dioph_fn df inl)) $
    λv, by {refine eq.to_iff (congr_arg S $ funext $ λs, _); cases s with a b, refl, cases b; refl},
  have dioph (λv, S (v ⊗ f v :: λ (i : fin2 n), fl i v)),
  from @dioph_fn_compn n (λv, S (v ∘ inl ⊗ f (v ∘ inl) :: v ∘ inr)) this _ dfl,
  ext this $ λv, by rw [
    show cons (f v) (λ (i : fin2 n), fl i v) = λ (i : fin2 (succ n)), (f :: fl) i v,
    from funext $ λs, by cases s with a b; refl]

theorem dioph_comp {n} {S : set (vector3 ℕ n)} (d : dioph S)
  (f : vector3 ((α → ℕ) → ℕ) n) (df : vector_allp dioph_fn f) : dioph (λv, S (λi, f i v)) :=
dioph_fn_compn (reindex_dioph d inr) df

theorem dioph_fn_comp {n} {f : vector3 ℕ n → ℕ} (df : dioph_fn f)
  (g : vector3 ((α → ℕ) → ℕ) n) (dg : vector_allp dioph_fn g) : dioph_fn (λv, f (λi, g i v)) :=
dioph_comp ((dioph_fn_vec _).1 df) ((λv, v none) :: λi v, g i (v ∘ some)) $
by simp; exact ⟨proj_dioph none, (vector_allp_iff_forall _ _).2 $ λi,
  reindex_dioph_fn ((vector_allp_iff_forall _ _).1 dg _) _⟩

localized "notation x ` D∧ `:35 y := dioph.and_dioph x y" in dioph
localized "notation x ` D∨ `:35 y := dioph.or_dioph x y" in dioph

localized "notation `D∃`:30 := dioph.vec_ex1_dioph" in dioph

localized "prefix `&`:max := of_nat'" in dioph
theorem proj_dioph_of_nat {n : ℕ} (m : ℕ) [is_lt m n] : dioph_fn (λv : vector3 ℕ n, v &m) :=
proj_dioph &m
localized "prefix `D&`:100 := dioph.proj_dioph_of_nat" in dioph

theorem const_dioph (n : ℕ) : dioph_fn (const (α → ℕ) n) :=
abs_poly_dioph (poly.const n)
localized "prefix `D.`:100 := dioph.const_dioph" in dioph

variables {f g : (α → ℕ) → ℕ} (df : dioph_fn f) (dg : dioph_fn g)
include df dg

theorem dioph_comp2 {S : ℕ → ℕ → Prop} (d : dioph (λv:vector3 ℕ 2, S (v &0) (v &1))) :
  dioph (λv, S (f v) (g v)) :=
dioph_comp d [f, g] (by exact ⟨df, dg⟩)

theorem dioph_fn_comp2 {h : ℕ → ℕ → ℕ} (d : dioph_fn (λv:vector3 ℕ 2, h (v &0) (v &1))) :
  dioph_fn (λv, h (f v) (g v)) :=
dioph_fn_comp d [f, g] (by exact ⟨df, dg⟩)

theorem eq_dioph : dioph (λv, f v = g v) :=
dioph_comp2 df dg $ of_no_dummies _ (poly.proj &0 - poly.proj &1)
  (λv, (int.coe_nat_eq_coe_nat_iff _ _).symm.trans
  ⟨@sub_eq_zero_of_eq ℤ _ (v &0) (v &1), eq_of_sub_eq_zero⟩)
localized "infix ` D= `:50 := dioph.eq_dioph" in dioph

theorem add_dioph : dioph_fn (λv, f v + g v) :=
dioph_fn_comp2 df dg $ abs_poly_dioph (poly.proj &0 + poly.proj &1)
localized "infix ` D+ `:80 := dioph.add_dioph" in dioph

theorem mul_dioph : dioph_fn (λv, f v * g v) :=
dioph_fn_comp2 df dg $ abs_poly_dioph (poly.proj &0 * poly.proj &1)
localized "infix ` D* `:90 := dioph.mul_dioph" in dioph

theorem le_dioph : dioph (λv, f v ≤ g v) :=
dioph_comp2 df dg $ ext (D∃2 $ D&1 D+ D&0 D= D&2) (λv, ⟨λ⟨x, hx⟩, le.intro hx, le.dest⟩)
localized "infix ` D≤ `:50 := dioph.le_dioph" in dioph

theorem lt_dioph : dioph (λv, f v < g v) := df D+ (D. 1) D≤ dg
localized "infix ` D< `:50 := dioph.lt_dioph" in dioph

theorem ne_dioph : dioph (λv, f v ≠ g v) :=
ext (df D< dg D∨ dg D< df) $ λv, ne_iff_lt_or_gt.symm
localized "infix ` D≠ `:50 := dioph.ne_dioph" in dioph

theorem sub_dioph : dioph_fn (λv, f v - g v) :=
dioph_fn_comp2 df dg $ (dioph_fn_vec _).2 $
ext (D&1 D= D&0 D+ D&2 D∨ D&1 D≤ D&2 D∧ D&0 D= D.0) $ (vector_all_iff_forall _).1 $ λx y z,
show (y = x + z ∨ y ≤ z ∧ x = 0) ↔ y - z = x, from
⟨λo, begin
  rcases o with ae | ⟨yz, x0⟩,
  { rw [ae, nat.add_sub_cancel] },
  { rw [x0, nat.sub_eq_zero_of_le yz] }
end, λh, begin
  subst x,
  cases le_total y z with yz zy,
  { exact or.inr ⟨yz, nat.sub_eq_zero_of_le yz⟩ },
  { exact or.inl (nat.sub_add_cancel zy).symm },
end⟩
localized "infix ` D- `:80 := dioph.sub_dioph" in dioph

theorem dvd_dioph : dioph (λv, f v ∣ g v) :=
dioph_comp (D∃2 $ D&2 D= D&1 D* D&0) [f, g] (by exact ⟨df, dg⟩)
localized "infix ` D∣ `:50 := dioph.dvd_dioph" in dioph

theorem mod_dioph : dioph_fn (λv, f v % g v) :=
have dioph (λv : vector3 ℕ 3, (v &2 = 0 ∨ v &0 < v &2) ∧ ∃ (x : ℕ), v &0 + v &2 * x = v &1),
from (D&2 D= D.0 D∨ D&0 D< D&2) D∧ (D∃3 $ D&1 D+ D&3 D* D&0 D= D&2),
dioph_fn_comp2 df dg $ (dioph_fn_vec _).2 $ ext this $ (vector_all_iff_forall _).1 $ λz x y,
show ((y = 0 ∨ z < y) ∧ ∃ c, z + y * c = x) ↔ x % y = z, from
⟨λ⟨h, c, hc⟩, begin rw ← hc; simp; cases h with x0 hl, rw [x0, mod_zero], exact mod_eq_of_lt hl end,
λe, by rw ← e; exact ⟨or_iff_not_imp_left.2 $ λh, mod_lt _ (nat.pos_of_ne_zero h), x / y,
  mod_add_div _ _⟩⟩

localized "infix ` D% `:80 := dioph.mod_dioph" in dioph

theorem modeq_dioph {h : (α → ℕ) → ℕ} (dh : dioph_fn h) : dioph (λv, f v ≡ g v [MOD h v]) :=
df D% dh D= dg D% dh
localized "notation `D≡` := dioph.modeq_dioph" in dioph

theorem div_dioph : dioph_fn (λv, f v / g v) :=
have dioph (λv : vector3 ℕ 3, v &2 = 0 ∧ v &0 = 0 ∨ v &0 * v &2 ≤ v &1 ∧ v &1 < (v &0 + 1) * v &2),
from (D&2 D= D.0 D∧ D&0 D= D.0) D∨ D&0 D* D&2 D≤ D&1 D∧ D&1 D< (D&0 D+ D.1) D* D&2,
dioph_fn_comp2 df dg $ (dioph_fn_vec _).2 $ ext this $ (vector_all_iff_forall _).1 $ λz x y,
show y = 0 ∧ z = 0 ∨ z * y ≤ x ∧ x < (z + 1) * y ↔ x / y = z,
by refine iff.trans _ eq_comm; exact y.eq_zero_or_pos.elim
  (λy0, by rw [y0, nat.div_zero]; exact
    ⟨λo, (o.resolve_right $ λ⟨_, h2⟩, not_lt_zero _ h2).right, λz0, or.inl ⟨rfl, z0⟩⟩)
  (λypos, iff.trans ⟨λo, o.resolve_left $ λ⟨h1, _⟩, ne_of_gt ypos h1, or.inr⟩
    (le_antisymm_iff.trans $ and_congr (nat.le_div_iff_mul_le _ _ ypos) $
      iff.trans ⟨lt_succ_of_le, le_of_lt_succ⟩ (div_lt_iff_lt_mul _ _ ypos)).symm)
localized "infix ` D/ `:80 := dioph.div_dioph" in dioph

omit df dg
open pell

theorem pell_dioph : dioph (λv:vector3 ℕ 4, ∃ h : 1 < v &0,
  xn h (v &1) = v &2 ∧ yn h (v &1) = v &3) :=
have dioph {v : vector3 ℕ 4 |
1 < v &0 ∧ v &1 ≤ v &3 ∧
(v &2 = 1 ∧ v &3 = 0 ∨
∃ (u w s t b : ℕ),
  v &2 * v &2 - (v &0 * v &0 - 1) * v &3 * v &3 = 1 ∧
  u * u - (v &0 * v &0 - 1) * w * w = 1 ∧
  s * s - (b * b - 1) * t * t = 1 ∧
  1 < b ∧ (b ≡ 1 [MOD 4 * v &3]) ∧ (b ≡ v &0 [MOD u]) ∧
  0 < w ∧ v &3 * v &3 ∣ w ∧
  (s ≡ v &2 [MOD u]) ∧
  (t ≡ v &1 [MOD 4 * v &3]))}, from
D.1 D< D&0 D∧ D&1 D≤ D&3 D∧
((D&2 D= D.1 D∧ D&3 D= D.0) D∨
 (D∃4 $ D∃5 $ D∃6 $ D∃7 $ D∃8 $
  D&7 D* D&7 D- (D&5 D* D&5 D- D.1) D* D&8 D* D&8 D= D.1 D∧
  D&4 D* D&4 D- (D&5 D* D&5 D- D.1) D* D&3 D* D&3 D= D.1 D∧
  D&2 D* D&2 D- (D&0 D* D&0 D- D.1) D* D&1 D* D&1 D= D.1 D∧
  D.1 D< D&0 D∧ (D≡ (D&0) (D.1) (D.4 D* D&8)) D∧ (D≡ (D&0) (D&5) D&4) D∧
  D.0 D< D&3 D∧ D&8 D* D&8 D∣ D&3 D∧
  (D≡ (D&2) (D&7) D&4) D∧
  (D≡ (D&1) (D&6) (D.4 D* D&8)))),
dioph.ext this $ λv, matiyasevic.symm

theorem xn_dioph : dioph_pfun (λv:vector3 ℕ 2, ⟨1 < v &0, λh, xn h (v &1)⟩) :=
have dioph (λv:vector3 ℕ 3, ∃ y, ∃ h : 1 < v &1, xn h (v &2) = v &0 ∧ yn h (v &2) = y), from
let D_pell := @reindex_dioph _ (fin2 4) _ pell_dioph [&2, &3, &1, &0] in D∃3 D_pell,
(dioph_pfun_vec _).2 $ dioph.ext this $ λv, ⟨λ⟨y, h, xe, ye⟩, ⟨h, xe⟩, λ⟨h, xe⟩, ⟨_, h, xe, rfl⟩⟩

include df dg
theorem pow_dioph : dioph_fn (λv, f v ^ g v) :=
have dioph {v : vector3 ℕ 3 |
v &2 = 0 ∧ v &0 = 1 ∨ 0 < v &2 ∧
(v &1 = 0 ∧ v &0 = 0 ∨ 0 < v &1 ∧
∃ (w a t z x y : ℕ),
  (∃ (a1 : 1 < a), xn a1 (v &2) = x ∧ yn a1 (v &2) = y) ∧
  (x ≡ y * (a - v &1) + v &0 [MOD t]) ∧
  2 * a * v &1 = t + (v &1 * v &1 + 1) ∧
  v &0 < t ∧ v &1 ≤ w ∧ v &2 ≤ w ∧
  a * a - ((w + 1) * (w + 1) - 1) * (w * z) * (w * z) = 1)}, from
let D_pell := @reindex_dioph _ (fin2 9) _ pell_dioph [&4, &8, &1, &0] in
(D&2 D= D.0 D∧ D&0 D= D.1) D∨ (D.0 D< D&2 D∧
((D&1 D= D.0 D∧ D&0 D= D.0) D∨ (D.0 D< D&1 D∧
 (D∃3 $ D∃4 $ D∃5 $ D∃6 $ D∃7 $ D∃8 $ D_pell D∧
  (D≡ (D&1) (D&0 D* (D&4 D- D&7) D+ D&6) (D&3)) D∧
  D.2 D* D&4 D* D&7 D= D&3 D+ (D&7 D* D&7 D+ D.1) D∧
  D&6 D< D&3 D∧ D&7 D≤ D&5 D∧ D&8 D≤ D&5 D∧
  D&4 D* D&4 D- ((D&5 D+ D.1) D* (D&5 D+ D.1) D- D.1) D* (D&5 D* D&2) D* (D&5 D* D&2) D= D.1)))),
dioph_fn_comp2 df dg $ (dioph_fn_vec _).2 $ dioph.ext this $ λv, iff.symm $
eq_pow_of_pell.trans $ or_congr iff.rfl $ and_congr iff.rfl $ or_congr iff.rfl $ and_congr iff.rfl $
⟨λ⟨w, a, t, z, a1, h⟩, ⟨w, a, t, z, _, _, ⟨a1, rfl, rfl⟩, h⟩,
 λ⟨w, a, t, z, ._, ._, ⟨a1, rfl, rfl⟩, h⟩, ⟨w, a, t, z, a1, h⟩⟩

end
end dioph


/-
Copyright (c) 2019 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import category_theory.functor

/-!
# Unbundled functors, as a typeclass decorating the object-level function.
-/

namespace category_theory

-- declare the `v`'s first; see `category_theory.category` for an explanation
universes v v₁ v₂ v₃ u u₁ u₂ u₃

variables {C : Type u₁} [category.{v₁} C] {D : Type u₂} [category.{v₂} D]

/-- A unbundled functor. -/
-- Perhaps in the future we could redefine `functor` in terms of this, but that isn't the
-- immediate plan.
class functorial (F : C → D) : Type (max v₁ v₂ u₁ u₂) :=
(map       : Π {X Y : C}, (X ⟶ Y) → ((F X) ⟶ (F Y)))
(map_id'   : ∀ (X : C), map (𝟙 X) = 𝟙 (F X) . obviously)
(map_comp' : ∀ {X Y Z : C} (f : X ⟶ Y) (g : Y ⟶ Z), map (f ≫ g) = (map f) ≫ (map g) . obviously)

/--
If `F : C → D` (just a function) has `[functorial F]`,
we can write `map F f : F X ⟶ F Y` for the action of `F` on a morphism `f : X ⟶ Y`.
-/
def map (F : C → D) [functorial.{v₁ v₂} F] {X Y : C} (f : X ⟶ Y) : F X ⟶ F Y :=
functorial.map.{v₁ v₂} f

@[simp] lemma map_as_map {F : C → D} [functorial.{v₁ v₂} F] {X Y : C} {f : X ⟶ Y} :
  functorial.map.{v₁ v₂} f = map F f := rfl

@[simp] lemma functorial.map_id {F : C → D} [functorial.{v₁ v₂} F] {X : C} :
  map F (𝟙 X) = 𝟙 (F X) := functorial.map_id' X

@[simp] lemma functorial.map_comp
  {F : C → D} [functorial.{v₁ v₂} F] {X Y Z : C} {f : X ⟶ Y} {g : Y ⟶ Z} :
  map F (f ≫ g) = map F f ≫ map F g := functorial.map_comp' f g

namespace functor

/--
Bundle a functorial function as a functor.
-/
def of (F : C → D) [I : functorial.{v₁ v₂} F] : C ⥤ D :=
{ obj := F,
  ..I }

end functor

instance (F : C ⥤ D) : functorial.{v₁ v₂} (F.obj) := { .. F }

@[simp]
lemma map_functorial_obj (F : C ⥤ D) {X Y : C} (f : X ⟶ Y) : map F.obj f = F.map f := rfl

instance functorial_id : functorial.{v₁ v₁} (id : C → C) :=
{ map := λ X Y f, f }

section
variables {E : Type u₃} [category.{v₃} E]

/--
`G ∘ F` is a functorial if both `F` and `G` are.
-/
-- This is no longer viable as an instance in Lean 3.7,
-- #lint reports an instance loop
-- Will this be a problem?
def functorial_comp (F : C → D) [functorial.{v₁ v₂} F] (G : D → E) [functorial.{v₂ v₃} G] :
  functorial.{v₁ v₃} (G ∘ F) :=
{ ..(functor.of F ⋙ functor.of G) }

end

end category_theory


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

! This file was ported from Lean 3 source module category_theory.sites.compatible_sheafification
! leanprover-community/mathlib commit 70fd9563a21e7b963887c9360bd29b2393e6225a
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.CategoryTheory.Sites.CompatiblePlus
import Mathbin.CategoryTheory.Sites.Sheafification

/-!

In this file, we prove that sheafification is compatible with functors which
preserve the correct limits and colimits.

-/

namespace CategoryTheory.GrothendieckTopology

open CategoryTheory

open CategoryTheory.Limits

open Opposite

universe w₁ w₂ v u

variable {C : Type u} [Category.{v} C] (J : GrothendieckTopology C)

variable {D : Type w₁} [Category.{max v u} D]

variable {E : Type w₂} [Category.{max v u} E]

variable (F : D ⥤ E)

noncomputable section

variable [∀ (α β : Type max v u) (fst snd : β → α), HasLimitsOfShape (WalkingMulticospan fst snd) D]

variable [∀ (α β : Type max v u) (fst snd : β → α), HasLimitsOfShape (WalkingMulticospan fst snd) E]

variable [∀ X : C, HasColimitsOfShape (J.cover X)ᵒᵖ D]

variable [∀ X : C, HasColimitsOfShape (J.cover X)ᵒᵖ E]

variable [∀ X : C, PreservesColimitsOfShape (J.cover X)ᵒᵖ F]

variable [∀ (X : C) (W : J.cover X) (P : Cᵒᵖ ⥤ D), PreservesLimit (W.index P).multicospan F]

variable (P : Cᵒᵖ ⥤ D)

/-- The isomorphism between the sheafification of `P` composed with `F` and
the sheafification of `P ⋙ F`.

Use the lemmas `whisker_right_to_sheafify_sheafify_comp_iso_hom`,
`to_sheafify_comp_sheafify_comp_iso_inv` and `sheafify_comp_iso_inv_eq_sheafify_lift` to reduce
the components of this isomorphisms to a state that can be handled using the universal property
of sheafification. -/
def sheafifyCompIso : J.sheafify P ⋙ F ≅ J.sheafify (P ⋙ F) :=
  J.plusCompIso _ _ ≪≫ (J.plusFunctor _).mapIso (J.plusCompIso _ _)
#align category_theory.grothendieck_topology.sheafify_comp_iso CategoryTheory.GrothendieckTopology.sheafifyCompIso

/-- The isomorphism between the sheafification of `P` composed with `F` and
the sheafification of `P ⋙ F`, functorially in `F`. -/
def sheafificationWhiskerLeftIso (P : Cᵒᵖ ⥤ D)
    [∀ (F : D ⥤ E) (X : C), PreservesColimitsOfShape (J.cover X)ᵒᵖ F]
    [∀ (F : D ⥤ E) (X : C) (W : J.cover X) (P : Cᵒᵖ ⥤ D),
        PreservesLimit (W.index P).multicospan F] :
    (whiskeringLeft _ _ E).obj (J.sheafify P) ≅ (whiskeringLeft _ _ _).obj P ⋙ J.sheafification E :=
  by
  refine' J.plus_functor_whisker_left_iso _ ≪≫ _ ≪≫ functor.associator _ _ _
  refine' iso_whisker_right _ _
  refine' J.plus_functor_whisker_left_iso _
#align category_theory.grothendieck_topology.sheafification_whisker_left_iso CategoryTheory.GrothendieckTopology.sheafificationWhiskerLeftIso

@[simp]
theorem sheafificationWhiskerLeftIso_hom_app (P : Cᵒᵖ ⥤ D) (F : D ⥤ E)
    [∀ (F : D ⥤ E) (X : C), PreservesColimitsOfShape (J.cover X)ᵒᵖ F]
    [∀ (F : D ⥤ E) (X : C) (W : J.cover X) (P : Cᵒᵖ ⥤ D),
        PreservesLimit (W.index P).multicospan F] :
    (sheafificationWhiskerLeftIso J P).Hom.app F = (J.sheafifyCompIso F P).Hom :=
  by
  dsimp [sheafification_whisker_left_iso, sheafify_comp_iso]
  rw [category.comp_id]
#align category_theory.grothendieck_topology.sheafification_whisker_left_iso_hom_app CategoryTheory.GrothendieckTopology.sheafificationWhiskerLeftIso_hom_app

@[simp]
theorem sheafificationWhiskerLeftIso_inv_app (P : Cᵒᵖ ⥤ D) (F : D ⥤ E)
    [∀ (F : D ⥤ E) (X : C), PreservesColimitsOfShape (J.cover X)ᵒᵖ F]
    [∀ (F : D ⥤ E) (X : C) (W : J.cover X) (P : Cᵒᵖ ⥤ D),
        PreservesLimit (W.index P).multicospan F] :
    (sheafificationWhiskerLeftIso J P).inv.app F = (J.sheafifyCompIso F P).inv :=
  by
  dsimp [sheafification_whisker_left_iso, sheafify_comp_iso]
  erw [category.id_comp]
#align category_theory.grothendieck_topology.sheafification_whisker_left_iso_inv_app CategoryTheory.GrothendieckTopology.sheafificationWhiskerLeftIso_inv_app

/-- The isomorphism between the sheafification of `P` composed with `F` and
the sheafification of `P ⋙ F`, functorially in `P`. -/
def sheafificationWhiskerRightIso :
    J.sheafification D ⋙ (whiskeringRight _ _ _).obj F ≅
      (whiskeringRight _ _ _).obj F ⋙ J.sheafification E :=
  by
  refine' functor.associator _ _ _ ≪≫ _
  refine' iso_whisker_left (J.plus_functor D) (J.plus_functor_whisker_right_iso _) ≪≫ _
  refine' _ ≪≫ functor.associator _ _ _
  refine' (functor.associator _ _ _).symm ≪≫ _
  exact iso_whisker_right (J.plus_functor_whisker_right_iso _) (J.plus_functor E)
#align category_theory.grothendieck_topology.sheafification_whisker_right_iso CategoryTheory.GrothendieckTopology.sheafificationWhiskerRightIso

@[simp]
theorem sheafificationWhiskerRightIso_hom_app :
    (J.sheafificationWhiskerRightIso F).Hom.app P = (J.sheafifyCompIso F P).Hom :=
  by
  dsimp [sheafification_whisker_right_iso, sheafify_comp_iso]
  simp only [category.id_comp, category.comp_id]
  erw [category.id_comp]
#align category_theory.grothendieck_topology.sheafification_whisker_right_iso_hom_app CategoryTheory.GrothendieckTopology.sheafificationWhiskerRightIso_hom_app

@[simp]
theorem sheafificationWhiskerRightIso_inv_app :
    (J.sheafificationWhiskerRightIso F).inv.app P = (J.sheafifyCompIso F P).inv :=
  by
  dsimp [sheafification_whisker_right_iso, sheafify_comp_iso]
  simp only [category.id_comp, category.comp_id]
  erw [category.id_comp]
#align category_theory.grothendieck_topology.sheafification_whisker_right_iso_inv_app CategoryTheory.GrothendieckTopology.sheafificationWhiskerRightIso_inv_app

@[simp, reassoc.1]
theorem whiskerRight_toSheafify_sheafifyCompIso_hom :
    whiskerRight (J.toSheafify _) _ ≫ (J.sheafifyCompIso F P).Hom = J.toSheafify _ :=
  by
  dsimp [sheafify_comp_iso]
  erw [whisker_right_comp, category.assoc]
  slice_lhs 2 3 => rw [plus_comp_iso_whisker_right]
  rw [category.assoc, ← J.plus_map_comp, whisker_right_to_plus_comp_plus_comp_iso_hom, ←
    category.assoc, whisker_right_to_plus_comp_plus_comp_iso_hom]
  rfl
#align category_theory.grothendieck_topology.whisker_right_to_sheafify_sheafify_comp_iso_hom CategoryTheory.GrothendieckTopology.whiskerRight_toSheafify_sheafifyCompIso_hom

@[simp, reassoc.1]
theorem toSheafify_comp_sheafifyCompIso_inv :
    J.toSheafify _ ≫ (J.sheafifyCompIso F P).inv = whiskerRight (J.toSheafify _) _ :=
  by
  rw [iso.comp_inv_eq]
  simp
#align category_theory.grothendieck_topology.to_sheafify_comp_sheafify_comp_iso_inv CategoryTheory.GrothendieckTopology.toSheafify_comp_sheafifyCompIso_inv

section

-- We will sheafify `D`-valued presheaves in this section.
variable [ConcreteCategory.{max v u} D] [PreservesLimits (forget D)]
  [∀ X : C, PreservesColimitsOfShape (J.cover X)ᵒᵖ (forget D)] [ReflectsIsomorphisms (forget D)]

@[simp]
theorem sheafifyCompIso_inv_eq_sheafifyLift :
    (J.sheafifyCompIso F P).inv =
      J.sheafifyLift (whiskerRight (J.toSheafify _) _) ((J.sheafify_isSheaf _).comp _) :=
  by
  apply J.sheafify_lift_unique
  rw [iso.comp_inv_eq]
  simp
#align category_theory.grothendieck_topology.sheafify_comp_iso_inv_eq_sheafify_lift CategoryTheory.GrothendieckTopology.sheafifyCompIso_inv_eq_sheafifyLift

end

end CategoryTheory.GrothendieckTopology


/-
Copyright (c) 2022 Yaël Dillies. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies

! This file was ported from Lean 3 source module data.multiset.sum
! leanprover-community/mathlib commit f2f413b9d4be3a02840d0663dace76e8fe3da053
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Multiset.Nodup

/-!
# Disjoint sum of multisets

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

This file defines the disjoint sum of two multisets as `multiset (α ⊕ β)`. Beware not to confuse
with the `multiset.sum` operation which computes the additive sum.

## Main declarations

* `multiset.disj_sum`: `s.disj_sum t` is the disjoint sum of `s` and `t`.
-/

open Sum

namespace Multiset

variable {α β : Type _} (s : Multiset α) (t : Multiset β)

#print Multiset.disjSum /-
/-- Disjoint sum of multisets. -/
def disjSum : Multiset (Sum α β) :=
  s.map inl + t.map inr
#align multiset.disj_sum Multiset.disjSum
-/

/- warning: multiset.zero_disj_sum -> Multiset.zero_disjSum is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} (t : Multiset.{u2} β), Eq.{succ (max u1 u2)} (Multiset.{max u1 u2} (Sum.{u1, u2} α β)) (Multiset.disjSum.{u1, u2} α β (OfNat.ofNat.{u1} (Multiset.{u1} α) 0 (OfNat.mk.{u1} (Multiset.{u1} α) 0 (Zero.zero.{u1} (Multiset.{u1} α) (Multiset.hasZero.{u1} α)))) t) (Multiset.map.{u2, max u1 u2} β (Sum.{u1, u2} α β) (Sum.inr.{u1, u2} α β) t)
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} (t : Multiset.{u1} β), Eq.{max (succ u2) (succ u1)} (Multiset.{max u1 u2} (Sum.{u2, u1} α β)) (Multiset.disjSum.{u2, u1} α β (OfNat.ofNat.{u2} (Multiset.{u2} α) 0 (Zero.toOfNat0.{u2} (Multiset.{u2} α) (Multiset.instZeroMultiset.{u2} α))) t) (Multiset.map.{u1, max u1 u2} β (Sum.{u2, u1} α β) (Sum.inr.{u2, u1} α β) t)
Case conversion may be inaccurate. Consider using '#align multiset.zero_disj_sum Multiset.zero_disjSumₓ'. -/
@[simp]
theorem zero_disjSum : (0 : Multiset α).disjSum t = t.map inr :=
  zero_add _
#align multiset.zero_disj_sum Multiset.zero_disjSum

/- warning: multiset.disj_sum_zero -> Multiset.disjSum_zero is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} (s : Multiset.{u1} α), Eq.{succ (max u1 u2)} (Multiset.{max u1 u2} (Sum.{u1, u2} α β)) (Multiset.disjSum.{u1, u2} α β s (OfNat.ofNat.{u2} (Multiset.{u2} β) 0 (OfNat.mk.{u2} (Multiset.{u2} β) 0 (Zero.zero.{u2} (Multiset.{u2} β) (Multiset.hasZero.{u2} β))))) (Multiset.map.{u1, max u1 u2} α (Sum.{u1, u2} α β) (Sum.inl.{u1, u2} α β) s)
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} (s : Multiset.{u2} α), Eq.{max (succ u2) (succ u1)} (Multiset.{max u1 u2} (Sum.{u2, u1} α β)) (Multiset.disjSum.{u2, u1} α β s (OfNat.ofNat.{u1} (Multiset.{u1} β) 0 (Zero.toOfNat0.{u1} (Multiset.{u1} β) (Multiset.instZeroMultiset.{u1} β)))) (Multiset.map.{u2, max u1 u2} α (Sum.{u2, u1} α β) (Sum.inl.{u2, u1} α β) s)
Case conversion may be inaccurate. Consider using '#align multiset.disj_sum_zero Multiset.disjSum_zeroₓ'. -/
@[simp]
theorem disjSum_zero : s.disjSum (0 : Multiset β) = s.map inl :=
  add_zero _
#align multiset.disj_sum_zero Multiset.disjSum_zero

/- warning: multiset.card_disj_sum -> Multiset.card_disjSum is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} (s : Multiset.{u1} α) (t : Multiset.{u2} β), Eq.{1} Nat (coeFn.{succ (max u1 u2), succ (max u1 u2)} (AddMonoidHom.{max u1 u2, 0} (Multiset.{max u1 u2} (Sum.{u1, u2} α β)) Nat (AddMonoid.toAddZeroClass.{max u1 u2} (Multiset.{max u1 u2} (Sum.{u1, u2} α β)) (AddRightCancelMonoid.toAddMonoid.{max u1 u2} (Multiset.{max u1 u2} (Sum.{u1, u2} α β)) (AddCancelMonoid.toAddRightCancelMonoid.{max u1 u2} (Multiset.{max u1 u2} (Sum.{u1, u2} α β)) (AddCancelCommMonoid.toAddCancelMonoid.{max u1 u2} (Multiset.{max u1 u2} (Sum.{u1, u2} α β)) (OrderedCancelAddCommMonoid.toCancelAddCommMonoid.{max u1 u2} (Multiset.{max u1 u2} (Sum.{u1, u2} α β)) (Multiset.orderedCancelAddCommMonoid.{max u1 u2} (Sum.{u1, u2} α β))))))) (AddMonoid.toAddZeroClass.{0} Nat Nat.addMonoid)) (fun (_x : AddMonoidHom.{max u1 u2, 0} (Multiset.{max u1 u2} (Sum.{u1, u2} α β)) Nat (AddMonoid.toAddZeroClass.{max u1 u2} (Multiset.{max u1 u2} (Sum.{u1, u2} α β)) (AddRightCancelMonoid.toAddMonoid.{max u1 u2} (Multiset.{max u1 u2} (Sum.{u1, u2} α β)) (AddCancelMonoid.toAddRightCancelMonoid.{max u1 u2} (Multiset.{max u1 u2} (Sum.{u1, u2} α β)) (AddCancelCommMonoid.toAddCancelMonoid.{max u1 u2} (Multiset.{max u1 u2} (Sum.{u1, u2} α β)) (OrderedCancelAddCommMonoid.toCancelAddCommMonoid.{max u1 u2} (Multiset.{max u1 u2} (Sum.{u1, u2} α β)) (Multiset.orderedCancelAddCommMonoid.{max u1 u2} (Sum.{u1, u2} α β))))))) (AddMonoid.toAddZeroClass.{0} Nat Nat.addMonoid)) => (Multiset.{max u1 u2} (Sum.{u1, u2} α β)) -> Nat) (AddMonoidHom.hasCoeToFun.{max u1 u2, 0} (Multiset.{max u1 u2} (Sum.{u1, u2} α β)) Nat (AddMonoid.toAddZeroClass.{max u1 u2} (Multiset.{max u1 u2} (Sum.{u1, u2} α β)) (AddRightCancelMonoid.toAddMonoid.{max u1 u2} (Multiset.{max u1 u2} (Sum.{u1, u2} α β)) (AddCancelMonoid.toAddRightCancelMonoid.{max u1 u2} (Multiset.{max u1 u2} (Sum.{u1, u2} α β)) (AddCancelCommMonoid.toAddCancelMonoid.{max u1 u2} (Multiset.{max u1 u2} (Sum.{u1, u2} α β)) (OrderedCancelAddCommMonoid.toCancelAddCommMonoid.{max u1 u2} (Multiset.{max u1 u2} (Sum.{u1, u2} α β)) (Multiset.orderedCancelAddCommMonoid.{max u1 u2} (Sum.{u1, u2} α β))))))) (AddMonoid.toAddZeroClass.{0} Nat Nat.addMonoid)) (Multiset.card.{max u1 u2} (Sum.{u1, u2} α β)) (Multiset.disjSum.{u1, u2} α β s t)) (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) (coeFn.{succ u1, succ u1} (AddMonoidHom.{u1, 0} (Multiset.{u1} α) Nat (AddMonoid.toAddZeroClass.{u1} (Multiset.{u1} α) (AddRightCancelMonoid.toAddMonoid.{u1} (Multiset.{u1} α) (AddCancelMonoid.toAddRightCancelMonoid.{u1} (Multiset.{u1} α) (AddCancelCommMonoid.toAddCancelMonoid.{u1} (Multiset.{u1} α) (OrderedCancelAddCommMonoid.toCancelAddCommMonoid.{u1} (Multiset.{u1} α) (Multiset.orderedCancelAddCommMonoid.{u1} α)))))) (AddMonoid.toAddZeroClass.{0} Nat Nat.addMonoid)) (fun (_x : AddMonoidHom.{u1, 0} (Multiset.{u1} α) Nat (AddMonoid.toAddZeroClass.{u1} (Multiset.{u1} α) (AddRightCancelMonoid.toAddMonoid.{u1} (Multiset.{u1} α) (AddCancelMonoid.toAddRightCancelMonoid.{u1} (Multiset.{u1} α) (AddCancelCommMonoid.toAddCancelMonoid.{u1} (Multiset.{u1} α) (OrderedCancelAddCommMonoid.toCancelAddCommMonoid.{u1} (Multiset.{u1} α) (Multiset.orderedCancelAddCommMonoid.{u1} α)))))) (AddMonoid.toAddZeroClass.{0} Nat Nat.addMonoid)) => (Multiset.{u1} α) -> Nat) (AddMonoidHom.hasCoeToFun.{u1, 0} (Multiset.{u1} α) Nat (AddMonoid.toAddZeroClass.{u1} (Multiset.{u1} α) (AddRightCancelMonoid.toAddMonoid.{u1} (Multiset.{u1} α) (AddCancelMonoid.toAddRightCancelMonoid.{u1} (Multiset.{u1} α) (AddCancelCommMonoid.toAddCancelMonoid.{u1} (Multiset.{u1} α) (OrderedCancelAddCommMonoid.toCancelAddCommMonoid.{u1} (Multiset.{u1} α) (Multiset.orderedCancelAddCommMonoid.{u1} α)))))) (AddMonoid.toAddZeroClass.{0} Nat Nat.addMonoid)) (Multiset.card.{u1} α) s) (coeFn.{succ u2, succ u2} (AddMonoidHom.{u2, 0} (Multiset.{u2} β) Nat (AddMonoid.toAddZeroClass.{u2} (Multiset.{u2} β) (AddRightCancelMonoid.toAddMonoid.{u2} (Multiset.{u2} β) (AddCancelMonoid.toAddRightCancelMonoid.{u2} (Multiset.{u2} β) (AddCancelCommMonoid.toAddCancelMonoid.{u2} (Multiset.{u2} β) (OrderedCancelAddCommMonoid.toCancelAddCommMonoid.{u2} (Multiset.{u2} β) (Multiset.orderedCancelAddCommMonoid.{u2} β)))))) (AddMonoid.toAddZeroClass.{0} Nat Nat.addMonoid)) (fun (_x : AddMonoidHom.{u2, 0} (Multiset.{u2} β) Nat (AddMonoid.toAddZeroClass.{u2} (Multiset.{u2} β) (AddRightCancelMonoid.toAddMonoid.{u2} (Multiset.{u2} β) (AddCancelMonoid.toAddRightCancelMonoid.{u2} (Multiset.{u2} β) (AddCancelCommMonoid.toAddCancelMonoid.{u2} (Multiset.{u2} β) (OrderedCancelAddCommMonoid.toCancelAddCommMonoid.{u2} (Multiset.{u2} β) (Multiset.orderedCancelAddCommMonoid.{u2} β)))))) (AddMonoid.toAddZeroClass.{0} Nat Nat.addMonoid)) => (Multiset.{u2} β) -> Nat) (AddMonoidHom.hasCoeToFun.{u2, 0} (Multiset.{u2} β) Nat (AddMonoid.toAddZeroClass.{u2} (Multiset.{u2} β) (AddRightCancelMonoid.toAddMonoid.{u2} (Multiset.{u2} β) (AddCancelMonoid.toAddRightCancelMonoid.{u2} (Multiset.{u2} β) (AddCancelCommMonoid.toAddCancelMonoid.{u2} (Multiset.{u2} β) (OrderedCancelAddCommMonoid.toCancelAddCommMonoid.{u2} (Multiset.{u2} β) (Multiset.orderedCancelAddCommMonoid.{u2} β)))))) (AddMonoid.toAddZeroClass.{0} Nat Nat.addMonoid)) (Multiset.card.{u2} β) t))
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} (s : Multiset.{u2} α) (t : Multiset.{u1} β), Eq.{1} ((fun (x._@.Mathlib.Algebra.Hom.Group._hyg.403 : Multiset.{max u2 u1} (Sum.{u2, u1} α β)) => Nat) (Multiset.disjSum.{u2, u1} α β s t)) (FunLike.coe.{succ (max u2 u1), succ (max u2 u1), 1} (AddMonoidHom.{max u2 u1, 0} (Multiset.{max u2 u1} (Sum.{u2, u1} α β)) Nat (AddMonoid.toAddZeroClass.{max u2 u1} (Multiset.{max u2 u1} (Sum.{u2, u1} α β)) (AddRightCancelMonoid.toAddMonoid.{max u2 u1} (Multiset.{max u2 u1} (Sum.{u2, u1} α β)) (AddCancelMonoid.toAddRightCancelMonoid.{max u2 u1} (Multiset.{max u2 u1} (Sum.{u2, u1} α β)) (AddCancelCommMonoid.toAddCancelMonoid.{max u2 u1} (Multiset.{max u2 u1} (Sum.{u2, u1} α β)) (OrderedCancelAddCommMonoid.toCancelAddCommMonoid.{max u2 u1} (Multiset.{max u2 u1} (Sum.{u2, u1} α β)) (Multiset.instOrderedCancelAddCommMonoidMultiset.{max u2 u1} (Sum.{u2, u1} α β))))))) (AddMonoid.toAddZeroClass.{0} Nat Nat.addMonoid)) (Multiset.{max u2 u1} (Sum.{u2, u1} α β)) (fun (_x : Multiset.{max u2 u1} (Sum.{u2, u1} α β)) => (fun (x._@.Mathlib.Algebra.Hom.Group._hyg.403 : Multiset.{max u2 u1} (Sum.{u2, u1} α β)) => Nat) _x) (AddHomClass.toFunLike.{max u2 u1, max u2 u1, 0} (AddMonoidHom.{max u2 u1, 0} (Multiset.{max u2 u1} (Sum.{u2, u1} α β)) Nat (AddMonoid.toAddZeroClass.{max u2 u1} (Multiset.{max u2 u1} (Sum.{u2, u1} α β)) (AddRightCancelMonoid.toAddMonoid.{max u2 u1} (Multiset.{max u2 u1} (Sum.{u2, u1} α β)) (AddCancelMonoid.toAddRightCancelMonoid.{max u2 u1} (Multiset.{max u2 u1} (Sum.{u2, u1} α β)) (AddCancelCommMonoid.toAddCancelMonoid.{max u2 u1} (Multiset.{max u2 u1} (Sum.{u2, u1} α β)) (OrderedCancelAddCommMonoid.toCancelAddCommMonoid.{max u2 u1} (Multiset.{max u2 u1} (Sum.{u2, u1} α β)) (Multiset.instOrderedCancelAddCommMonoidMultiset.{max u2 u1} (Sum.{u2, u1} α β))))))) (AddMonoid.toAddZeroClass.{0} Nat Nat.addMonoid)) (Multiset.{max u2 u1} (Sum.{u2, u1} α β)) Nat (AddZeroClass.toAdd.{max u2 u1} (Multiset.{max u2 u1} (Sum.{u2, u1} α β)) (AddMonoid.toAddZeroClass.{max u2 u1} (Multiset.{max u2 u1} (Sum.{u2, u1} α β)) (AddRightCancelMonoid.toAddMonoid.{max u2 u1} (Multiset.{max u2 u1} (Sum.{u2, u1} α β)) (AddCancelMonoid.toAddRightCancelMonoid.{max u2 u1} (Multiset.{max u2 u1} (Sum.{u2, u1} α β)) (AddCancelCommMonoid.toAddCancelMonoid.{max u2 u1} (Multiset.{max u2 u1} (Sum.{u2, u1} α β)) (OrderedCancelAddCommMonoid.toCancelAddCommMonoid.{max u2 u1} (Multiset.{max u2 u1} (Sum.{u2, u1} α β)) (Multiset.instOrderedCancelAddCommMonoidMultiset.{max u2 u1} (Sum.{u2, u1} α β)))))))) (AddZeroClass.toAdd.{0} Nat (AddMonoid.toAddZeroClass.{0} Nat Nat.addMonoid)) (AddMonoidHomClass.toAddHomClass.{max u2 u1, max u2 u1, 0} (AddMonoidHom.{max u2 u1, 0} (Multiset.{max u2 u1} (Sum.{u2, u1} α β)) Nat (AddMonoid.toAddZeroClass.{max u2 u1} (Multiset.{max u2 u1} (Sum.{u2, u1} α β)) (AddRightCancelMonoid.toAddMonoid.{max u2 u1} (Multiset.{max u2 u1} (Sum.{u2, u1} α β)) (AddCancelMonoid.toAddRightCancelMonoid.{max u2 u1} (Multiset.{max u2 u1} (Sum.{u2, u1} α β)) (AddCancelCommMonoid.toAddCancelMonoid.{max u2 u1} (Multiset.{max u2 u1} (Sum.{u2, u1} α β)) (OrderedCancelAddCommMonoid.toCancelAddCommMonoid.{max u2 u1} (Multiset.{max u2 u1} (Sum.{u2, u1} α β)) (Multiset.instOrderedCancelAddCommMonoidMultiset.{max u2 u1} (Sum.{u2, u1} α β))))))) (AddMonoid.toAddZeroClass.{0} Nat Nat.addMonoid)) (Multiset.{max u2 u1} (Sum.{u2, u1} α β)) Nat (AddMonoid.toAddZeroClass.{max u2 u1} (Multiset.{max u2 u1} (Sum.{u2, u1} α β)) (AddRightCancelMonoid.toAddMonoid.{max u2 u1} (Multiset.{max u2 u1} (Sum.{u2, u1} α β)) (AddCancelMonoid.toAddRightCancelMonoid.{max u2 u1} (Multiset.{max u2 u1} (Sum.{u2, u1} α β)) (AddCancelCommMonoid.toAddCancelMonoid.{max u2 u1} (Multiset.{max u2 u1} (Sum.{u2, u1} α β)) (OrderedCancelAddCommMonoid.toCancelAddCommMonoid.{max u2 u1} (Multiset.{max u2 u1} (Sum.{u2, u1} α β)) (Multiset.instOrderedCancelAddCommMonoidMultiset.{max u2 u1} (Sum.{u2, u1} α β))))))) (AddMonoid.toAddZeroClass.{0} Nat Nat.addMonoid) (AddMonoidHom.addMonoidHomClass.{max u2 u1, 0} (Multiset.{max u2 u1} (Sum.{u2, u1} α β)) Nat (AddMonoid.toAddZeroClass.{max u2 u1} (Multiset.{max u2 u1} (Sum.{u2, u1} α β)) (AddRightCancelMonoid.toAddMonoid.{max u2 u1} (Multiset.{max u2 u1} (Sum.{u2, u1} α β)) (AddCancelMonoid.toAddRightCancelMonoid.{max u2 u1} (Multiset.{max u2 u1} (Sum.{u2, u1} α β)) (AddCancelCommMonoid.toAddCancelMonoid.{max u2 u1} (Multiset.{max u2 u1} (Sum.{u2, u1} α β)) (OrderedCancelAddCommMonoid.toCancelAddCommMonoid.{max u2 u1} (Multiset.{max u2 u1} (Sum.{u2, u1} α β)) (Multiset.instOrderedCancelAddCommMonoidMultiset.{max u2 u1} (Sum.{u2, u1} α β))))))) (AddMonoid.toAddZeroClass.{0} Nat Nat.addMonoid)))) (Multiset.card.{max u2 u1} (Sum.{u2, u1} α β)) (Multiset.disjSum.{u2, u1} α β s t)) (HAdd.hAdd.{0, 0, 0} ((fun (x._@.Mathlib.Algebra.Hom.Group._hyg.403 : Multiset.{u2} α) => Nat) s) ((fun (x._@.Mathlib.Algebra.Hom.Group._hyg.403 : Multiset.{u1} β) => Nat) t) ((fun (x._@.Mathlib.Algebra.Hom.Group._hyg.403 : Multiset.{u2} α) => Nat) s) (instHAdd.{0} ((fun (x._@.Mathlib.Algebra.Hom.Group._hyg.403 : Multiset.{u2} α) => Nat) s) instAddNat) (FunLike.coe.{succ u2, succ u2, 1} (AddMonoidHom.{u2, 0} (Multiset.{u2} α) Nat (AddMonoid.toAddZeroClass.{u2} (Multiset.{u2} α) (AddRightCancelMonoid.toAddMonoid.{u2} (Multiset.{u2} α) (AddCancelMonoid.toAddRightCancelMonoid.{u2} (Multiset.{u2} α) (AddCancelCommMonoid.toAddCancelMonoid.{u2} (Multiset.{u2} α) (OrderedCancelAddCommMonoid.toCancelAddCommMonoid.{u2} (Multiset.{u2} α) (Multiset.instOrderedCancelAddCommMonoidMultiset.{u2} α)))))) (AddMonoid.toAddZeroClass.{0} Nat Nat.addMonoid)) (Multiset.{u2} α) (fun (_x : Multiset.{u2} α) => (fun (x._@.Mathlib.Algebra.Hom.Group._hyg.403 : Multiset.{u2} α) => Nat) _x) (AddHomClass.toFunLike.{u2, u2, 0} (AddMonoidHom.{u2, 0} (Multiset.{u2} α) Nat (AddMonoid.toAddZeroClass.{u2} (Multiset.{u2} α) (AddRightCancelMonoid.toAddMonoid.{u2} (Multiset.{u2} α) (AddCancelMonoid.toAddRightCancelMonoid.{u2} (Multiset.{u2} α) (AddCancelCommMonoid.toAddCancelMonoid.{u2} (Multiset.{u2} α) (OrderedCancelAddCommMonoid.toCancelAddCommMonoid.{u2} (Multiset.{u2} α) (Multiset.instOrderedCancelAddCommMonoidMultiset.{u2} α)))))) (AddMonoid.toAddZeroClass.{0} Nat Nat.addMonoid)) (Multiset.{u2} α) Nat (AddZeroClass.toAdd.{u2} (Multiset.{u2} α) (AddMonoid.toAddZeroClass.{u2} (Multiset.{u2} α) (AddRightCancelMonoid.toAddMonoid.{u2} (Multiset.{u2} α) (AddCancelMonoid.toAddRightCancelMonoid.{u2} (Multiset.{u2} α) (AddCancelCommMonoid.toAddCancelMonoid.{u2} (Multiset.{u2} α) (OrderedCancelAddCommMonoid.toCancelAddCommMonoid.{u2} (Multiset.{u2} α) (Multiset.instOrderedCancelAddCommMonoidMultiset.{u2} α))))))) (AddZeroClass.toAdd.{0} Nat (AddMonoid.toAddZeroClass.{0} Nat Nat.addMonoid)) (AddMonoidHomClass.toAddHomClass.{u2, u2, 0} (AddMonoidHom.{u2, 0} (Multiset.{u2} α) Nat (AddMonoid.toAddZeroClass.{u2} (Multiset.{u2} α) (AddRightCancelMonoid.toAddMonoid.{u2} (Multiset.{u2} α) (AddCancelMonoid.toAddRightCancelMonoid.{u2} (Multiset.{u2} α) (AddCancelCommMonoid.toAddCancelMonoid.{u2} (Multiset.{u2} α) (OrderedCancelAddCommMonoid.toCancelAddCommMonoid.{u2} (Multiset.{u2} α) (Multiset.instOrderedCancelAddCommMonoidMultiset.{u2} α)))))) (AddMonoid.toAddZeroClass.{0} Nat Nat.addMonoid)) (Multiset.{u2} α) Nat (AddMonoid.toAddZeroClass.{u2} (Multiset.{u2} α) (AddRightCancelMonoid.toAddMonoid.{u2} (Multiset.{u2} α) (AddCancelMonoid.toAddRightCancelMonoid.{u2} (Multiset.{u2} α) (AddCancelCommMonoid.toAddCancelMonoid.{u2} (Multiset.{u2} α) (OrderedCancelAddCommMonoid.toCancelAddCommMonoid.{u2} (Multiset.{u2} α) (Multiset.instOrderedCancelAddCommMonoidMultiset.{u2} α)))))) (AddMonoid.toAddZeroClass.{0} Nat Nat.addMonoid) (AddMonoidHom.addMonoidHomClass.{u2, 0} (Multiset.{u2} α) Nat (AddMonoid.toAddZeroClass.{u2} (Multiset.{u2} α) (AddRightCancelMonoid.toAddMonoid.{u2} (Multiset.{u2} α) (AddCancelMonoid.toAddRightCancelMonoid.{u2} (Multiset.{u2} α) (AddCancelCommMonoid.toAddCancelMonoid.{u2} (Multiset.{u2} α) (OrderedCancelAddCommMonoid.toCancelAddCommMonoid.{u2} (Multiset.{u2} α) (Multiset.instOrderedCancelAddCommMonoidMultiset.{u2} α)))))) (AddMonoid.toAddZeroClass.{0} Nat Nat.addMonoid)))) (Multiset.card.{u2} α) s) (FunLike.coe.{succ u1, succ u1, 1} (AddMonoidHom.{u1, 0} (Multiset.{u1} β) Nat (AddMonoid.toAddZeroClass.{u1} (Multiset.{u1} β) (AddRightCancelMonoid.toAddMonoid.{u1} (Multiset.{u1} β) (AddCancelMonoid.toAddRightCancelMonoid.{u1} (Multiset.{u1} β) (AddCancelCommMonoid.toAddCancelMonoid.{u1} (Multiset.{u1} β) (OrderedCancelAddCommMonoid.toCancelAddCommMonoid.{u1} (Multiset.{u1} β) (Multiset.instOrderedCancelAddCommMonoidMultiset.{u1} β)))))) (AddMonoid.toAddZeroClass.{0} Nat Nat.addMonoid)) (Multiset.{u1} β) (fun (_x : Multiset.{u1} β) => (fun (x._@.Mathlib.Algebra.Hom.Group._hyg.403 : Multiset.{u1} β) => Nat) _x) (AddHomClass.toFunLike.{u1, u1, 0} (AddMonoidHom.{u1, 0} (Multiset.{u1} β) Nat (AddMonoid.toAddZeroClass.{u1} (Multiset.{u1} β) (AddRightCancelMonoid.toAddMonoid.{u1} (Multiset.{u1} β) (AddCancelMonoid.toAddRightCancelMonoid.{u1} (Multiset.{u1} β) (AddCancelCommMonoid.toAddCancelMonoid.{u1} (Multiset.{u1} β) (OrderedCancelAddCommMonoid.toCancelAddCommMonoid.{u1} (Multiset.{u1} β) (Multiset.instOrderedCancelAddCommMonoidMultiset.{u1} β)))))) (AddMonoid.toAddZeroClass.{0} Nat Nat.addMonoid)) (Multiset.{u1} β) Nat (AddZeroClass.toAdd.{u1} (Multiset.{u1} β) (AddMonoid.toAddZeroClass.{u1} (Multiset.{u1} β) (AddRightCancelMonoid.toAddMonoid.{u1} (Multiset.{u1} β) (AddCancelMonoid.toAddRightCancelMonoid.{u1} (Multiset.{u1} β) (AddCancelCommMonoid.toAddCancelMonoid.{u1} (Multiset.{u1} β) (OrderedCancelAddCommMonoid.toCancelAddCommMonoid.{u1} (Multiset.{u1} β) (Multiset.instOrderedCancelAddCommMonoidMultiset.{u1} β))))))) (AddZeroClass.toAdd.{0} Nat (AddMonoid.toAddZeroClass.{0} Nat Nat.addMonoid)) (AddMonoidHomClass.toAddHomClass.{u1, u1, 0} (AddMonoidHom.{u1, 0} (Multiset.{u1} β) Nat (AddMonoid.toAddZeroClass.{u1} (Multiset.{u1} β) (AddRightCancelMonoid.toAddMonoid.{u1} (Multiset.{u1} β) (AddCancelMonoid.toAddRightCancelMonoid.{u1} (Multiset.{u1} β) (AddCancelCommMonoid.toAddCancelMonoid.{u1} (Multiset.{u1} β) (OrderedCancelAddCommMonoid.toCancelAddCommMonoid.{u1} (Multiset.{u1} β) (Multiset.instOrderedCancelAddCommMonoidMultiset.{u1} β)))))) (AddMonoid.toAddZeroClass.{0} Nat Nat.addMonoid)) (Multiset.{u1} β) Nat (AddMonoid.toAddZeroClass.{u1} (Multiset.{u1} β) (AddRightCancelMonoid.toAddMonoid.{u1} (Multiset.{u1} β) (AddCancelMonoid.toAddRightCancelMonoid.{u1} (Multiset.{u1} β) (AddCancelCommMonoid.toAddCancelMonoid.{u1} (Multiset.{u1} β) (OrderedCancelAddCommMonoid.toCancelAddCommMonoid.{u1} (Multiset.{u1} β) (Multiset.instOrderedCancelAddCommMonoidMultiset.{u1} β)))))) (AddMonoid.toAddZeroClass.{0} Nat Nat.addMonoid) (AddMonoidHom.addMonoidHomClass.{u1, 0} (Multiset.{u1} β) Nat (AddMonoid.toAddZeroClass.{u1} (Multiset.{u1} β) (AddRightCancelMonoid.toAddMonoid.{u1} (Multiset.{u1} β) (AddCancelMonoid.toAddRightCancelMonoid.{u1} (Multiset.{u1} β) (AddCancelCommMonoid.toAddCancelMonoid.{u1} (Multiset.{u1} β) (OrderedCancelAddCommMonoid.toCancelAddCommMonoid.{u1} (Multiset.{u1} β) (Multiset.instOrderedCancelAddCommMonoidMultiset.{u1} β)))))) (AddMonoid.toAddZeroClass.{0} Nat Nat.addMonoid)))) (Multiset.card.{u1} β) t))
Case conversion may be inaccurate. Consider using '#align multiset.card_disj_sum Multiset.card_disjSumₓ'. -/
@[simp]
theorem card_disjSum : (s.disjSum t).card = s.card + t.card := by
  rw [disj_sum, card_add, card_map, card_map]
#align multiset.card_disj_sum Multiset.card_disjSum

variable {s t} {s₁ s₂ : Multiset α} {t₁ t₂ : Multiset β} {a : α} {b : β} {x : Sum α β}

/- warning: multiset.mem_disj_sum -> Multiset.mem_disjSum is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} {s : Multiset.{u1} α} {t : Multiset.{u2} β} {x : Sum.{u1, u2} α β}, Iff (Membership.Mem.{max u1 u2, max u1 u2} (Sum.{u1, u2} α β) (Multiset.{max u1 u2} (Sum.{u1, u2} α β)) (Multiset.hasMem.{max u1 u2} (Sum.{u1, u2} α β)) x (Multiset.disjSum.{u1, u2} α β s t)) (Or (Exists.{succ u1} α (fun (a : α) => And (Membership.Mem.{u1, u1} α (Multiset.{u1} α) (Multiset.hasMem.{u1} α) a s) (Eq.{max (succ u1) (succ u2)} (Sum.{u1, u2} α β) (Sum.inl.{u1, u2} α β a) x))) (Exists.{succ u2} β (fun (b : β) => And (Membership.Mem.{u2, u2} β (Multiset.{u2} β) (Multiset.hasMem.{u2} β) b t) (Eq.{max (succ u1) (succ u2)} (Sum.{u1, u2} α β) (Sum.inr.{u1, u2} α β b) x))))
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} {s : Multiset.{u2} α} {t : Multiset.{u1} β} {x : Sum.{u2, u1} α β}, Iff (Membership.mem.{max u2 u1, max u2 u1} (Sum.{u2, u1} α β) (Multiset.{max u1 u2} (Sum.{u2, u1} α β)) (Multiset.instMembershipMultiset.{max u2 u1} (Sum.{u2, u1} α β)) x (Multiset.disjSum.{u2, u1} α β s t)) (Or (Exists.{succ u2} α (fun (a : α) => And (Membership.mem.{u2, u2} α (Multiset.{u2} α) (Multiset.instMembershipMultiset.{u2} α) a s) (Eq.{max (succ u2) (succ u1)} (Sum.{u2, u1} α β) (Sum.inl.{u2, u1} α β a) x))) (Exists.{succ u1} β (fun (b : β) => And (Membership.mem.{u1, u1} β (Multiset.{u1} β) (Multiset.instMembershipMultiset.{u1} β) b t) (Eq.{max (succ u2) (succ u1)} (Sum.{u2, u1} α β) (Sum.inr.{u2, u1} α β b) x))))
Case conversion may be inaccurate. Consider using '#align multiset.mem_disj_sum Multiset.mem_disjSumₓ'. -/
theorem mem_disjSum : x ∈ s.disjSum t ↔ (∃ a, a ∈ s ∧ inl a = x) ∨ ∃ b, b ∈ t ∧ inr b = x := by
  simp_rw [disj_sum, mem_add, mem_map]
#align multiset.mem_disj_sum Multiset.mem_disjSum

#print Multiset.inl_mem_disjSum /-
@[simp]
theorem inl_mem_disjSum : inl a ∈ s.disjSum t ↔ a ∈ s :=
  by
  rw [mem_disj_sum, or_iff_left]
  simp only [exists_eq_right]
  rintro ⟨b, _, hb⟩
  exact inr_ne_inl hb
#align multiset.inl_mem_disj_sum Multiset.inl_mem_disjSum
-/

#print Multiset.inr_mem_disjSum /-
@[simp]
theorem inr_mem_disjSum : inr b ∈ s.disjSum t ↔ b ∈ t :=
  by
  rw [mem_disj_sum, or_iff_right]
  simp only [exists_eq_right]
  rintro ⟨a, _, ha⟩
  exact inl_ne_inr ha
#align multiset.inr_mem_disj_sum Multiset.inr_mem_disjSum
-/

/- warning: multiset.disj_sum_mono -> Multiset.disjSum_mono is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} {s₁ : Multiset.{u1} α} {s₂ : Multiset.{u1} α} {t₁ : Multiset.{u2} β} {t₂ : Multiset.{u2} β}, (LE.le.{u1} (Multiset.{u1} α) (Preorder.toLE.{u1} (Multiset.{u1} α) (PartialOrder.toPreorder.{u1} (Multiset.{u1} α) (Multiset.partialOrder.{u1} α))) s₁ s₂) -> (LE.le.{u2} (Multiset.{u2} β) (Preorder.toLE.{u2} (Multiset.{u2} β) (PartialOrder.toPreorder.{u2} (Multiset.{u2} β) (Multiset.partialOrder.{u2} β))) t₁ t₂) -> (LE.le.{max u1 u2} (Multiset.{max u1 u2} (Sum.{u1, u2} α β)) (Preorder.toLE.{max u1 u2} (Multiset.{max u1 u2} (Sum.{u1, u2} α β)) (PartialOrder.toPreorder.{max u1 u2} (Multiset.{max u1 u2} (Sum.{u1, u2} α β)) (Multiset.partialOrder.{max u1 u2} (Sum.{u1, u2} α β)))) (Multiset.disjSum.{u1, u2} α β s₁ t₁) (Multiset.disjSum.{u1, u2} α β s₂ t₂))
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} {s₁ : Multiset.{u2} α} {s₂ : Multiset.{u2} α} {t₁ : Multiset.{u1} β} {t₂ : Multiset.{u1} β}, (LE.le.{u2} (Multiset.{u2} α) (Preorder.toLE.{u2} (Multiset.{u2} α) (PartialOrder.toPreorder.{u2} (Multiset.{u2} α) (Multiset.instPartialOrderMultiset.{u2} α))) s₁ s₂) -> (LE.le.{u1} (Multiset.{u1} β) (Preorder.toLE.{u1} (Multiset.{u1} β) (PartialOrder.toPreorder.{u1} (Multiset.{u1} β) (Multiset.instPartialOrderMultiset.{u1} β))) t₁ t₂) -> (LE.le.{max u2 u1} (Multiset.{max u1 u2} (Sum.{u2, u1} α β)) (Preorder.toLE.{max u2 u1} (Multiset.{max u1 u2} (Sum.{u2, u1} α β)) (PartialOrder.toPreorder.{max u2 u1} (Multiset.{max u1 u2} (Sum.{u2, u1} α β)) (Multiset.instPartialOrderMultiset.{max u2 u1} (Sum.{u2, u1} α β)))) (Multiset.disjSum.{u2, u1} α β s₁ t₁) (Multiset.disjSum.{u2, u1} α β s₂ t₂))
Case conversion may be inaccurate. Consider using '#align multiset.disj_sum_mono Multiset.disjSum_monoₓ'. -/
theorem disjSum_mono (hs : s₁ ≤ s₂) (ht : t₁ ≤ t₂) : s₁.disjSum t₁ ≤ s₂.disjSum t₂ :=
  add_le_add (map_le_map hs) (map_le_map ht)
#align multiset.disj_sum_mono Multiset.disjSum_mono

/- warning: multiset.disj_sum_mono_left -> Multiset.disjSum_mono_left is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} (t : Multiset.{u2} β), Monotone.{u1, max u1 u2} (Multiset.{u1} α) (Multiset.{max u1 u2} (Sum.{u1, u2} α β)) (PartialOrder.toPreorder.{u1} (Multiset.{u1} α) (Multiset.partialOrder.{u1} α)) (PartialOrder.toPreorder.{max u1 u2} (Multiset.{max u1 u2} (Sum.{u1, u2} α β)) (Multiset.partialOrder.{max u1 u2} (Sum.{u1, u2} α β))) (fun (s : Multiset.{u1} α) => Multiset.disjSum.{u1, u2} α β s t)
but is expected to have type
  forall {α : Type.{u1}} {β : Type.{u2}} (t : Multiset.{u2} β), Monotone.{u1, max u1 u2} (Multiset.{u1} α) (Multiset.{max u2 u1} (Sum.{u1, u2} α β)) (PartialOrder.toPreorder.{u1} (Multiset.{u1} α) (Multiset.instPartialOrderMultiset.{u1} α)) (PartialOrder.toPreorder.{max u1 u2} (Multiset.{max u2 u1} (Sum.{u1, u2} α β)) (Multiset.instPartialOrderMultiset.{max u1 u2} (Sum.{u1, u2} α β))) (fun (s : Multiset.{u1} α) => Multiset.disjSum.{u1, u2} α β s t)
Case conversion may be inaccurate. Consider using '#align multiset.disj_sum_mono_left Multiset.disjSum_mono_leftₓ'. -/
theorem disjSum_mono_left (t : Multiset β) : Monotone fun s : Multiset α => s.disjSum t :=
  fun s₁ s₂ hs => add_le_add_right (map_le_map hs) _
#align multiset.disj_sum_mono_left Multiset.disjSum_mono_left

/- warning: multiset.disj_sum_mono_right -> Multiset.disjSum_mono_right is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} (s : Multiset.{u1} α), Monotone.{u2, max u1 u2} (Multiset.{u2} β) (Multiset.{max u1 u2} (Sum.{u1, u2} α β)) (PartialOrder.toPreorder.{u2} (Multiset.{u2} β) (Multiset.partialOrder.{u2} β)) (PartialOrder.toPreorder.{max u1 u2} (Multiset.{max u1 u2} (Sum.{u1, u2} α β)) (Multiset.partialOrder.{max u1 u2} (Sum.{u1, u2} α β))) (Multiset.disjSum.{u1, u2} α β s)
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} (s : Multiset.{u2} α), Monotone.{u1, max u2 u1} (Multiset.{u1} β) (Multiset.{max u1 u2} (Sum.{u2, u1} α β)) (PartialOrder.toPreorder.{u1} (Multiset.{u1} β) (Multiset.instPartialOrderMultiset.{u1} β)) (PartialOrder.toPreorder.{max u2 u1} (Multiset.{max u1 u2} (Sum.{u2, u1} α β)) (Multiset.instPartialOrderMultiset.{max u2 u1} (Sum.{u2, u1} α β))) (Multiset.disjSum.{u2, u1} α β s)
Case conversion may be inaccurate. Consider using '#align multiset.disj_sum_mono_right Multiset.disjSum_mono_rightₓ'. -/
theorem disjSum_mono_right (s : Multiset α) :
    Monotone (s.disjSum : Multiset β → Multiset (Sum α β)) := fun t₁ t₂ ht =>
  add_le_add_left (map_le_map ht) _
#align multiset.disj_sum_mono_right Multiset.disjSum_mono_right

/- warning: multiset.disj_sum_lt_disj_sum_of_lt_of_le -> Multiset.disjSum_lt_disjSum_of_lt_of_le is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} {s₁ : Multiset.{u1} α} {s₂ : Multiset.{u1} α} {t₁ : Multiset.{u2} β} {t₂ : Multiset.{u2} β}, (LT.lt.{u1} (Multiset.{u1} α) (Preorder.toLT.{u1} (Multiset.{u1} α) (PartialOrder.toPreorder.{u1} (Multiset.{u1} α) (Multiset.partialOrder.{u1} α))) s₁ s₂) -> (LE.le.{u2} (Multiset.{u2} β) (Preorder.toLE.{u2} (Multiset.{u2} β) (PartialOrder.toPreorder.{u2} (Multiset.{u2} β) (Multiset.partialOrder.{u2} β))) t₁ t₂) -> (LT.lt.{max u1 u2} (Multiset.{max u1 u2} (Sum.{u1, u2} α β)) (Preorder.toLT.{max u1 u2} (Multiset.{max u1 u2} (Sum.{u1, u2} α β)) (PartialOrder.toPreorder.{max u1 u2} (Multiset.{max u1 u2} (Sum.{u1, u2} α β)) (Multiset.partialOrder.{max u1 u2} (Sum.{u1, u2} α β)))) (Multiset.disjSum.{u1, u2} α β s₁ t₁) (Multiset.disjSum.{u1, u2} α β s₂ t₂))
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} {s₁ : Multiset.{u2} α} {s₂ : Multiset.{u2} α} {t₁ : Multiset.{u1} β} {t₂ : Multiset.{u1} β}, (LT.lt.{u2} (Multiset.{u2} α) (Preorder.toLT.{u2} (Multiset.{u2} α) (PartialOrder.toPreorder.{u2} (Multiset.{u2} α) (Multiset.instPartialOrderMultiset.{u2} α))) s₁ s₂) -> (LE.le.{u1} (Multiset.{u1} β) (Preorder.toLE.{u1} (Multiset.{u1} β) (PartialOrder.toPreorder.{u1} (Multiset.{u1} β) (Multiset.instPartialOrderMultiset.{u1} β))) t₁ t₂) -> (LT.lt.{max u2 u1} (Multiset.{max u1 u2} (Sum.{u2, u1} α β)) (Preorder.toLT.{max u2 u1} (Multiset.{max u1 u2} (Sum.{u2, u1} α β)) (PartialOrder.toPreorder.{max u2 u1} (Multiset.{max u1 u2} (Sum.{u2, u1} α β)) (Multiset.instPartialOrderMultiset.{max u2 u1} (Sum.{u2, u1} α β)))) (Multiset.disjSum.{u2, u1} α β s₁ t₁) (Multiset.disjSum.{u2, u1} α β s₂ t₂))
Case conversion may be inaccurate. Consider using '#align multiset.disj_sum_lt_disj_sum_of_lt_of_le Multiset.disjSum_lt_disjSum_of_lt_of_leₓ'. -/
theorem disjSum_lt_disjSum_of_lt_of_le (hs : s₁ < s₂) (ht : t₁ ≤ t₂) :
    s₁.disjSum t₁ < s₂.disjSum t₂ :=
  add_lt_add_of_lt_of_le (map_lt_map hs) (map_le_map ht)
#align multiset.disj_sum_lt_disj_sum_of_lt_of_le Multiset.disjSum_lt_disjSum_of_lt_of_le

/- warning: multiset.disj_sum_lt_disj_sum_of_le_of_lt -> Multiset.disjSum_lt_disjSum_of_le_of_lt is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} {s₁ : Multiset.{u1} α} {s₂ : Multiset.{u1} α} {t₁ : Multiset.{u2} β} {t₂ : Multiset.{u2} β}, (LE.le.{u1} (Multiset.{u1} α) (Preorder.toLE.{u1} (Multiset.{u1} α) (PartialOrder.toPreorder.{u1} (Multiset.{u1} α) (Multiset.partialOrder.{u1} α))) s₁ s₂) -> (LT.lt.{u2} (Multiset.{u2} β) (Preorder.toLT.{u2} (Multiset.{u2} β) (PartialOrder.toPreorder.{u2} (Multiset.{u2} β) (Multiset.partialOrder.{u2} β))) t₁ t₂) -> (LT.lt.{max u1 u2} (Multiset.{max u1 u2} (Sum.{u1, u2} α β)) (Preorder.toLT.{max u1 u2} (Multiset.{max u1 u2} (Sum.{u1, u2} α β)) (PartialOrder.toPreorder.{max u1 u2} (Multiset.{max u1 u2} (Sum.{u1, u2} α β)) (Multiset.partialOrder.{max u1 u2} (Sum.{u1, u2} α β)))) (Multiset.disjSum.{u1, u2} α β s₁ t₁) (Multiset.disjSum.{u1, u2} α β s₂ t₂))
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} {s₁ : Multiset.{u2} α} {s₂ : Multiset.{u2} α} {t₁ : Multiset.{u1} β} {t₂ : Multiset.{u1} β}, (LE.le.{u2} (Multiset.{u2} α) (Preorder.toLE.{u2} (Multiset.{u2} α) (PartialOrder.toPreorder.{u2} (Multiset.{u2} α) (Multiset.instPartialOrderMultiset.{u2} α))) s₁ s₂) -> (LT.lt.{u1} (Multiset.{u1} β) (Preorder.toLT.{u1} (Multiset.{u1} β) (PartialOrder.toPreorder.{u1} (Multiset.{u1} β) (Multiset.instPartialOrderMultiset.{u1} β))) t₁ t₂) -> (LT.lt.{max u2 u1} (Multiset.{max u1 u2} (Sum.{u2, u1} α β)) (Preorder.toLT.{max u2 u1} (Multiset.{max u1 u2} (Sum.{u2, u1} α β)) (PartialOrder.toPreorder.{max u2 u1} (Multiset.{max u1 u2} (Sum.{u2, u1} α β)) (Multiset.instPartialOrderMultiset.{max u2 u1} (Sum.{u2, u1} α β)))) (Multiset.disjSum.{u2, u1} α β s₁ t₁) (Multiset.disjSum.{u2, u1} α β s₂ t₂))
Case conversion may be inaccurate. Consider using '#align multiset.disj_sum_lt_disj_sum_of_le_of_lt Multiset.disjSum_lt_disjSum_of_le_of_ltₓ'. -/
theorem disjSum_lt_disjSum_of_le_of_lt (hs : s₁ ≤ s₂) (ht : t₁ < t₂) :
    s₁.disjSum t₁ < s₂.disjSum t₂ :=
  add_lt_add_of_le_of_lt (map_le_map hs) (map_lt_map ht)
#align multiset.disj_sum_lt_disj_sum_of_le_of_lt Multiset.disjSum_lt_disjSum_of_le_of_lt

/- warning: multiset.disj_sum_strict_mono_left -> Multiset.disjSum_strictMono_left is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} (t : Multiset.{u2} β), StrictMono.{u1, max u1 u2} (Multiset.{u1} α) (Multiset.{max u1 u2} (Sum.{u1, u2} α β)) (PartialOrder.toPreorder.{u1} (Multiset.{u1} α) (Multiset.partialOrder.{u1} α)) (PartialOrder.toPreorder.{max u1 u2} (Multiset.{max u1 u2} (Sum.{u1, u2} α β)) (Multiset.partialOrder.{max u1 u2} (Sum.{u1, u2} α β))) (fun (s : Multiset.{u1} α) => Multiset.disjSum.{u1, u2} α β s t)
but is expected to have type
  forall {α : Type.{u1}} {β : Type.{u2}} (t : Multiset.{u2} β), StrictMono.{u1, max u1 u2} (Multiset.{u1} α) (Multiset.{max u2 u1} (Sum.{u1, u2} α β)) (PartialOrder.toPreorder.{u1} (Multiset.{u1} α) (Multiset.instPartialOrderMultiset.{u1} α)) (PartialOrder.toPreorder.{max u1 u2} (Multiset.{max u2 u1} (Sum.{u1, u2} α β)) (Multiset.instPartialOrderMultiset.{max u1 u2} (Sum.{u1, u2} α β))) (fun (s : Multiset.{u1} α) => Multiset.disjSum.{u1, u2} α β s t)
Case conversion may be inaccurate. Consider using '#align multiset.disj_sum_strict_mono_left Multiset.disjSum_strictMono_leftₓ'. -/
theorem disjSum_strictMono_left (t : Multiset β) : StrictMono fun s : Multiset α => s.disjSum t :=
  fun s₁ s₂ hs => disjSum_lt_disjSum_of_lt_of_le hs le_rfl
#align multiset.disj_sum_strict_mono_left Multiset.disjSum_strictMono_left

/- warning: multiset.disj_sum_strict_mono_right -> Multiset.disjSum_strictMono_right is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} (s : Multiset.{u1} α), StrictMono.{u2, max u1 u2} (Multiset.{u2} β) (Multiset.{max u1 u2} (Sum.{u1, u2} α β)) (PartialOrder.toPreorder.{u2} (Multiset.{u2} β) (Multiset.partialOrder.{u2} β)) (PartialOrder.toPreorder.{max u1 u2} (Multiset.{max u1 u2} (Sum.{u1, u2} α β)) (Multiset.partialOrder.{max u1 u2} (Sum.{u1, u2} α β))) (Multiset.disjSum.{u1, u2} α β s)
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} (s : Multiset.{u2} α), StrictMono.{u1, max u2 u1} (Multiset.{u1} β) (Multiset.{max u1 u2} (Sum.{u2, u1} α β)) (PartialOrder.toPreorder.{u1} (Multiset.{u1} β) (Multiset.instPartialOrderMultiset.{u1} β)) (PartialOrder.toPreorder.{max u2 u1} (Multiset.{max u1 u2} (Sum.{u2, u1} α β)) (Multiset.instPartialOrderMultiset.{max u2 u1} (Sum.{u2, u1} α β))) (Multiset.disjSum.{u2, u1} α β s)
Case conversion may be inaccurate. Consider using '#align multiset.disj_sum_strict_mono_right Multiset.disjSum_strictMono_rightₓ'. -/
theorem disjSum_strictMono_right (s : Multiset α) :
    StrictMono (s.disjSum : Multiset β → Multiset (Sum α β)) := fun s₁ s₂ =>
  disjSum_lt_disjSum_of_le_of_lt le_rfl
#align multiset.disj_sum_strict_mono_right Multiset.disjSum_strictMono_right

/- warning: multiset.nodup.disj_sum -> Multiset.Nodup.disjSum is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} {s : Multiset.{u1} α} {t : Multiset.{u2} β}, (Multiset.Nodup.{u1} α s) -> (Multiset.Nodup.{u2} β t) -> (Multiset.Nodup.{max u1 u2} (Sum.{u1, u2} α β) (Multiset.disjSum.{u1, u2} α β s t))
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} {s : Multiset.{u2} α} {t : Multiset.{u1} β}, (Multiset.Nodup.{u2} α s) -> (Multiset.Nodup.{u1} β t) -> (Multiset.Nodup.{max u2 u1} (Sum.{u2, u1} α β) (Multiset.disjSum.{u2, u1} α β s t))
Case conversion may be inaccurate. Consider using '#align multiset.nodup.disj_sum Multiset.Nodup.disjSumₓ'. -/
protected theorem Nodup.disjSum (hs : s.Nodup) (ht : t.Nodup) : (s.disjSum t).Nodup :=
  by
  refine' ((hs.map inl_injective).add_iff <| ht.map inr_injective).2 fun x hs ht => _
  rw [Multiset.mem_map] at hs ht
  obtain ⟨a, _, rfl⟩ := hs
  obtain ⟨b, _, h⟩ := ht
  exact inr_ne_inl h
#align multiset.nodup.disj_sum Multiset.Nodup.disjSum

end Multiset


import data.matrix.notation
import linear_algebra.matrix.determinant
import group_theory.perm.fin
import tactic.norm_swap

variables {α β : Type} [semiring α] [ring β]

namespace matrix

open_locale matrix

/-! Test that the dimensions are inferred correctly, even for empty matrices -/
section dimensions

set_option pp.universes true
set_option pp.all true

meta def get_dims (e : pexpr) : tactic (expr × expr) :=
do
  elem_t ← tactic.mk_meta_var (expr.sort level.zero.succ),
  e ← tactic.to_expr ``(%%e : matrix _ _ %%elem_t) tt ff,
  t ← tactic.infer_type e,
  `(matrix.{0 0 0} (fin %%m) (fin %%n) %%elem_t) ← tactic.infer_type e,
  return (m, n)

-- we test equality of expressions here to ensure that we have `2` and not `1.succ` in the type
run_cmd do d ← get_dims ``(!![]),        guard $ d = (`(0), `(0))
run_cmd do d ← get_dims ``(!![;]),       guard $ d = (`(1), `(0))
run_cmd do d ← get_dims ``(!![;;]),      guard $ d = (`(2), `(0))
run_cmd do d ← get_dims ``(!![,]),       guard $ d = (`(0), `(1))
run_cmd do d ← get_dims ``(!![,,]),      guard $ d = (`(0), `(2))
run_cmd do d ← get_dims ``(!![1]),       guard $ d = (`(1), `(1))
run_cmd do d ← get_dims ``(!![1,]),      guard $ d = (`(1), `(1))
run_cmd do d ← get_dims ``(!![1;]),      guard $ d = (`(1), `(1))
run_cmd do d ← get_dims ``(!![1,2;3,4]), guard $ d = (`(2), `(2))

end dimensions

run_cmd guard $ (!![1;2])       = of ![![1], ![2]]
run_cmd guard $ (!![1,3])       = of ![![1,3]]
run_cmd guard $ (!![1,2;3,4])   = of ![![1,2], ![3,4]]
run_cmd guard $ (!![1,2;3,4;])  = of ![![1,2], ![3,4]]
run_cmd guard $ (!![1,2,;3,4,]) = of ![![1,2], ![3,4]]

example {a a' b b' c c' d d' : α} :
  !![a, b; c, d] + !![a', b'; c', d'] = !![a + a', b + b'; c + c', d + d'] :=
by simp

example {a a' b b' c c' d d' : β} :
  !![a, b; c, d] - !![a', b'; c', d'] = !![a - a', b - b'; c - c', d - d'] :=
by simp

example {a a' b b' c c' d d' : α} :
  !![a, b; c, d] ⬝ !![a', b'; c', d'] =
    !![a * a' + b * c', a * b' + b * d'; c * a' + d * c', c * b' + d * d'] :=
by simp [-equiv.perm.coe_subsingleton]

example {a b c d x y : α} :
  mul_vec !![a, b; c, d] ![x, y] = ![a * x + b * y, c * x + d * y] :=
by simp

example {a b c d : α} : submatrix !![a, b; c, d] ![1, 0] ![0] = !![c; a] :=
by { ext, simp }

example {a b c : α} : ![a, b, c] 0 = a := by simp
example {a b c : α} : ![a, b, c] 1 = b := by simp
example {a b c : α} : ![a, b, c] 2 = c := by simp

example {a b c d : α} : ![a, b, c, d] 0 = a := by simp
example {a b c d : α} : ![a, b, c, d] 1 = b := by simp
example {a b c d : α} : ![a, b, c, d] 2 = c := by simp
example {a b c d : α} : ![a, b, c, d] 3 = d := by simp
example {a b c d : α} : ![a, b, c, d] 42 = c := by simp

example {a b c d e : α} : ![a, b, c, d, e] 0 = a := by simp
example {a b c d e : α} : ![a, b, c, d, e] 1 = b := by simp
example {a b c d e : α} : ![a, b, c, d, e] 2 = c := by simp
example {a b c d e : α} : ![a, b, c, d, e] 3 = d := by simp
example {a b c d e : α} : ![a, b, c, d, e] 4 = e := by simp
example {a b c d e : α} : ![a, b, c, d, e] 5 = a := by simp
example {a b c d e : α} : ![a, b, c, d, e] 6 = b := by simp
example {a b c d e : α} : ![a, b, c, d, e] 7 = c := by simp
example {a b c d e : α} : ![a, b, c, d, e] 8 = d := by simp
example {a b c d e : α} : ![a, b, c, d, e] 9 = e := by simp
example {a b c d e : α} : ![a, b, c, d, e] 123 = d := by simp
example {a b c d e : α} : ![a, b, c, d, e] 123456789 = e := by simp

example {a b c d e f g h : α} : ![a, b, c, d, e, f, g, h] 5 = f := by simp
example {a b c d e f g h : α} : ![a, b, c, d, e, f, g, h] 7 = h := by simp
example {a b c d e f g h : α} : ![a, b, c, d, e, f, g, h] 37 = f := by simp
example {a b c d e f g h : α} : ![a, b, c, d, e, f, g, h] 99 = d := by simp

example {α : Type*} [comm_ring α] {a b c d : α} :
  matrix.det !![a, b; c, d] = a * d - b * c :=
begin
  simp [matrix.det_succ_row_zero, fin.sum_univ_succ],
  /-
  Try this: simp only [det_succ_row_zero, fin.sum_univ_succ, neg_mul, mul_one,
  fin.default_eq_zero, fin.coe_zero, one_mul, cons_val_one, fin.coe_succ, univ_unique,
  submatrix_apply, pow_one, fin.zero_succ_above, fin.succ_succ_above_zero,  finset.sum_singleton,
  cons_val_zero, cons_val_succ, det_fin_zero, pow_zero]
  -/
  ring
end

example {α : Type*} [comm_ring α] {a b c d e f g h i : α} :
  matrix.det !![a, b, c; d, e, f; g, h, i] =
    a * e * i - a * f * h - b * d * i + b * f * g + c * d * h - c * e * g :=
begin
  simp [matrix.det_succ_row_zero, fin.sum_univ_succ],
  /-
  Try this: simp only [det_succ_row_zero, fin.sum_univ_succ, neg_mul, cons_append,
  mul_one, fin.default_eq_zero, fin.coe_zero, cons_vec_bit0_eq_alt0, one_mul, cons_val_one,
  cons_vec_alt0, fin.succ_succ_above_one, fin.coe_succ, univ_unique, submatrix_apply, pow_one,
  fin.zero_succ_above, fin.succ_zero_eq_one, fin.succ_succ_above_zero, nat.neg_one_sq,
  finset.sum_singleton, cons_val_zero, cons_val_succ, det_fin_zero, head_cons, pow_zero]
   -/
  ring
end

end matrix


/-
Copyright (c) 2021 Yaël Dillies. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies
-/
import data.set.pairwise.basic
import order.bounds.basic
import order.directed
import order.hom.set

/-!
# Antichains

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

This file defines antichains. An antichain is a set where any two distinct elements are not related.
If the relation is `(≤)`, this corresponds to incomparability and usual order antichains. If the
relation is `G.adj` for `G : simple_graph α`, this corresponds to independent sets of `G`.

## Definitions

* `is_antichain r s`: Any two elements of `s : set α` are unrelated by `r : α → α → Prop`.
* `is_strong_antichain r s`: Any two elements of `s : set α` are not related by `r : α → α → Prop`
  to a common element.
* `is_antichain.mk r s`: Turns `s` into an antichain by keeping only the "maximal" elements.
-/

open function set

section general
variables {α β : Type*} {r r₁ r₂ : α → α → Prop} {r' : β → β → Prop} {s t : set α} {a b : α}

protected lemma symmetric.compl (h : symmetric r) : symmetric rᶜ := λ x y hr hr', hr $ h hr'

/-- An antichain is a set such that no two distinct elements are related. -/
def is_antichain (r : α → α → Prop) (s : set α) : Prop := s.pairwise rᶜ

namespace is_antichain

protected lemma subset (hs : is_antichain r s) (h : t ⊆ s) : is_antichain r t := hs.mono h

lemma mono (hs : is_antichain r₁ s) (h : r₂ ≤ r₁) : is_antichain r₂ s := hs.mono' $ compl_le_compl h

protected lemma eq (hs : is_antichain r s) {a b : α} (ha : a ∈ s) (hb : b ∈ s) (h : r a b) :
  a = b :=
hs.eq ha hb $ not_not_intro h

protected lemma eq' (hs : is_antichain r s) {a b : α} (ha : a ∈ s) (hb : b ∈ s) (h : r b a) :
  a = b :=
(hs.eq hb ha h).symm

protected lemma is_antisymm (h : is_antichain r univ) : is_antisymm α r :=
⟨λ a b ha _, h.eq trivial trivial ha⟩

protected lemma subsingleton [is_trichotomous α r] (h : is_antichain r s) : s.subsingleton :=
begin
  rintro a ha b hb,
  obtain hab | hab | hab := trichotomous_of r a b,
  { exact h.eq ha hb hab },
  { exact hab },
  { exact h.eq' ha hb hab }
end

protected lemma flip (hs : is_antichain r s) : is_antichain (flip r) s :=
λ a ha b hb h, hs hb ha h.symm

lemma swap (hs : is_antichain r s) : is_antichain (swap r) s := hs.flip

lemma image (hs : is_antichain r s) (f : α → β) (h : ∀ ⦃a b⦄, r' (f a) (f b) → r a b) :
  is_antichain r' (f '' s) :=
begin
  rintro _ ⟨b, hb, rfl⟩ _ ⟨c, hc, rfl⟩ hbc hr,
  exact hs hb hc (ne_of_apply_ne _ hbc) (h hr),
end

lemma preimage (hs : is_antichain r s) {f : β → α} (hf : injective f)
  (h : ∀ ⦃a b⦄, r' a b → r (f a) (f b)) :
  is_antichain r' (f ⁻¹' s) :=
λ b hb c hc hbc hr, hs hb hc (hf.ne hbc) $ h hr

lemma _root_.is_antichain_insert :
  is_antichain r (insert a s) ↔ is_antichain r s ∧ ∀ ⦃b⦄, b ∈ s → a ≠ b → ¬ r a b ∧ ¬ r b a :=
set.pairwise_insert

protected lemma insert (hs : is_antichain r s) (hl : ∀ ⦃b⦄, b ∈ s → a ≠ b → ¬ r b a)
  (hr : ∀ ⦃b⦄, b ∈ s → a ≠ b → ¬ r a b) :
  is_antichain r (insert a s) :=
is_antichain_insert.2 ⟨hs, λ b hb hab, ⟨hr hb hab, hl hb hab⟩⟩

lemma _root_.is_antichain_insert_of_symmetric (hr : symmetric r) :
  is_antichain r (insert a s) ↔ is_antichain r s ∧ ∀ ⦃b⦄, b ∈ s → a ≠ b → ¬ r a b :=
pairwise_insert_of_symmetric hr.compl

lemma insert_of_symmetric (hs : is_antichain r s) (hr : symmetric r)
  (h : ∀ ⦃b⦄, b ∈ s → a ≠ b → ¬ r a b) :
  is_antichain r (insert a s) :=
(is_antichain_insert_of_symmetric hr).2 ⟨hs, h⟩

lemma image_rel_embedding (hs : is_antichain r s) (φ : r ↪r r') : is_antichain r' (φ '' s) :=
begin
  intros b hb b' hb' h₁ h₂,
  rw set.mem_image at hb hb',
  obtain ⟨⟨a,has,rfl⟩,⟨a',has',rfl⟩⟩ := ⟨hb,hb'⟩,
  exact hs has has' (λ haa', h₁ (haa'.subst (by refl))) (φ.map_rel_iff.mp h₂),
end

lemma preimage_rel_embedding {t : set β} (ht : is_antichain r' t) (φ : r ↪r r') :
  is_antichain r (φ ⁻¹' t) :=
λ a ha a' ha' hne hle, ht ha ha' (λ h, hne (φ.injective h)) (φ.map_rel_iff.mpr hle)

lemma image_rel_iso (hs : is_antichain r s) (φ : r ≃r r') : is_antichain r' (φ '' s) :=
hs.image_rel_embedding φ

lemma preimage_rel_iso {t : set β} (hs : is_antichain r' t) (φ : r ≃r r') :
  is_antichain r (φ ⁻¹' t) :=
hs.preimage_rel_embedding φ

lemma image_rel_embedding_iff {φ : r ↪r r'} : is_antichain r' (φ '' s) ↔ is_antichain r s :=
⟨λ h, (φ.injective.preimage_image s).subst (h.preimage_rel_embedding φ),
  λ h, h.image_rel_embedding φ⟩

lemma image_rel_iso_iff {φ : r ≃r r'} : is_antichain r' (φ '' s) ↔ is_antichain r s :=
  @image_rel_embedding_iff _ _ _ _ _ (φ : r ↪r r')

lemma image_embedding [has_le α] [has_le β] (hs : is_antichain (≤) s) (φ : α ↪o β) :
  is_antichain (≤) (φ '' s) :=
image_rel_embedding hs _

lemma preimage_embedding [has_le α] [has_le β] {t : set β} (ht : is_antichain (≤) t) (φ : α ↪o β) :
  is_antichain (≤) (φ ⁻¹' t) :=
preimage_rel_embedding ht _

lemma image_embedding_iff [has_le α] [has_le β] {φ : α ↪o β} :
  is_antichain (≤) (φ '' s) ↔ is_antichain (≤) s :=
image_rel_embedding_iff

lemma image_iso [has_le α] [has_le β] (hs : is_antichain (≤) s) (φ : α ≃o β) :
  is_antichain (≤) (φ '' s) :=
image_rel_embedding hs _

lemma image_iso_iff [has_le α] [has_le β] {φ : α ≃o β} :
  is_antichain (≤) (φ '' s) ↔ is_antichain (≤) s :=
image_rel_embedding_iff

lemma preimage_iso [has_le α] [has_le β] {t : set β} (ht : is_antichain (≤) t) (φ : α ≃o β) :
  is_antichain (≤) (φ ⁻¹' t) :=
preimage_rel_embedding ht _

lemma preimage_iso_iff [has_le α] [has_le β] {t : set β} {φ : α ≃o β} :
  is_antichain (≤) (φ ⁻¹' t) ↔ is_antichain (≤) t :=
⟨λ h, (φ.image_preimage t).subst (h.image_iso φ), λ h, h.preimage_iso _⟩

lemma to_dual [has_le α] (hs : is_antichain (≤) s) : @is_antichain αᵒᵈ (≤) s :=
λ a ha b hb hab, hs hb ha hab.symm

lemma to_dual_iff [has_le α] : is_antichain (≤) s ↔ @is_antichain αᵒᵈ (≤) s := ⟨to_dual, to_dual⟩

lemma image_compl [boolean_algebra α] (hs : is_antichain (≤) s) :
  is_antichain (≤) (compl '' s) :=
(hs.image_embedding (order_iso.compl α).to_order_embedding).flip

lemma preimage_compl [boolean_algebra α] (hs : is_antichain (≤) s) :
  is_antichain (≤) (compl ⁻¹' s) :=
λ a ha a' ha' hne hle, hs ha' ha (λ h, hne (compl_inj_iff.mp h.symm)) (compl_le_compl hle)

end is_antichain

lemma is_antichain_singleton (a : α) (r : α → α → Prop) : is_antichain r {a} :=
pairwise_singleton _ _

lemma set.subsingleton.is_antichain (hs : s.subsingleton) (r : α → α → Prop) : is_antichain r s :=
hs.pairwise _

section preorder
variables [preorder α]

lemma is_antichain.not_lt (hs : is_antichain (≤) s) (ha : a ∈ s) (hb : b ∈ s) : ¬ a < b :=
λ h, hs ha hb h.ne h.le

lemma is_antichain_and_least_iff : is_antichain (≤) s ∧ is_least s a ↔ s = {a} :=
⟨λ h, eq_singleton_iff_unique_mem.2 ⟨h.2.1, λ b hb, h.1.eq' hb h.2.1 (h.2.2 hb)⟩,
  by { rintro rfl, exact ⟨is_antichain_singleton _ _, is_least_singleton⟩ }⟩

lemma is_antichain_and_greatest_iff : is_antichain (≤) s ∧ is_greatest s a ↔ s = {a} :=
⟨λ h, eq_singleton_iff_unique_mem.2 ⟨h.2.1, λ b hb, h.1.eq hb h.2.1 (h.2.2 hb)⟩,
  by { rintro rfl, exact ⟨is_antichain_singleton _ _, is_greatest_singleton⟩ }⟩

lemma is_antichain.least_iff (hs : is_antichain (≤) s) : is_least s a ↔ s = {a} :=
(and_iff_right hs).symm.trans is_antichain_and_least_iff

lemma is_antichain.greatest_iff (hs : is_antichain (≤) s) : is_greatest s a ↔ s = {a} :=
(and_iff_right hs).symm.trans is_antichain_and_greatest_iff

lemma is_least.antichain_iff (hs : is_least s a) : is_antichain (≤) s ↔ s = {a} :=
(and_iff_left hs).symm.trans is_antichain_and_least_iff

lemma is_greatest.antichain_iff (hs : is_greatest s a) : is_antichain (≤) s ↔ s = {a} :=
(and_iff_left hs).symm.trans is_antichain_and_greatest_iff

lemma is_antichain.bot_mem_iff [order_bot α] (hs : is_antichain (≤) s) : ⊥ ∈ s ↔ s = {⊥} :=
is_least_bot_iff.symm.trans hs.least_iff

lemma is_antichain.top_mem_iff [order_top α] (hs : is_antichain (≤) s) : ⊤ ∈ s ↔ s = {⊤} :=
is_greatest_top_iff.symm.trans hs.greatest_iff

end preorder

section partial_order
variables [partial_order α]

lemma is_antichain_iff_forall_not_lt : is_antichain (≤) s ↔ ∀ ⦃a⦄, a ∈ s → ∀ ⦃b⦄, b ∈ s → ¬ a < b :=
⟨λ hs a ha b, hs.not_lt ha, λ hs a ha b hb h h', hs ha hb $ h'.lt_of_ne h⟩

end partial_order

/-! ### Strong antichains -/

/-- A strong (upward) antichain is a set such that no two distinct elements are related to a common
element. -/
def is_strong_antichain (r : α → α → Prop) (s : set α) : Prop :=
s.pairwise $ λ a b, ∀ c, ¬ r a c ∨ ¬ r b c

namespace is_strong_antichain

protected lemma subset (hs : is_strong_antichain r s) (h : t ⊆ s) : is_strong_antichain r t :=
hs.mono h

lemma mono (hs : is_strong_antichain r₁ s) (h : r₂ ≤ r₁) : is_strong_antichain r₂ s :=
hs.mono' $ λ a b hab c, (hab c).imp (compl_le_compl h _ _) (compl_le_compl h _ _)

lemma eq (hs : is_strong_antichain r s) {a b c : α} (ha : a ∈ s) (hb : b ∈ s) (hac : r a c)
  (hbc : r b c) :
  a = b :=
hs.eq ha hb $ λ h, false.elim $ (h c).elim (not_not_intro hac) (not_not_intro hbc)

protected lemma is_antichain [is_refl α r] (h : is_strong_antichain r s) : is_antichain r s :=
h.imp $ λ a b hab, (hab b).resolve_right (not_not_intro $ refl _)

protected lemma subsingleton [is_directed α r] (h : is_strong_antichain r s) : s.subsingleton :=
λ a ha b hb, let ⟨c, hac, hbc⟩ := directed_of r a b in h.eq ha hb hac hbc

protected lemma flip [is_symm α r] (hs : is_strong_antichain r s) :
  is_strong_antichain (flip r) s :=
λ a ha b hb h c, (hs ha hb h c).imp (mt $ symm_of r) (mt $ symm_of r)

lemma swap [is_symm α r] (hs : is_strong_antichain r s) : is_strong_antichain (swap r) s := hs.flip

lemma image (hs : is_strong_antichain r s) {f : α → β} (hf : surjective f)
  (h : ∀ a b, r' (f a) (f b) → r a b) :
  is_strong_antichain r' (f '' s) :=
begin
  rintro _ ⟨a, ha, rfl⟩ _ ⟨b, hb, rfl⟩ hab c,
  obtain ⟨c, rfl⟩ := hf c,
  exact (hs ha hb (ne_of_apply_ne _ hab) _).imp (mt $ h _ _) (mt $ h _ _),
end

lemma preimage (hs : is_strong_antichain r s) {f : β → α} (hf : injective f)
  (h : ∀ a b, r' a b → r (f a) (f b)) :
  is_strong_antichain r' (f ⁻¹' s) :=
λ a ha b hb hab c, (hs ha hb (hf.ne hab) _).imp (mt $ h _ _) (mt $ h _ _)

lemma _root_.is_strong_antichain_insert :
  is_strong_antichain r (insert a s) ↔ is_strong_antichain r s ∧
    ∀ ⦃b⦄, b ∈ s → a ≠ b → ∀ c, ¬ r a c ∨ ¬ r b c :=
set.pairwise_insert_of_symmetric $ λ a b h c, (h c).symm

protected lemma insert (hs : is_strong_antichain r s)
  (h : ∀ ⦃b⦄, b ∈ s → a ≠ b → ∀ c, ¬ r a c ∨ ¬ r b c) :
  is_strong_antichain r (insert a s) :=
is_strong_antichain_insert.2 ⟨hs, h⟩

end is_strong_antichain

lemma set.subsingleton.is_strong_antichain (hs : s.subsingleton) (r : α → α → Prop) :
  is_strong_antichain r s :=
hs.pairwise _

end general

/-! ### Weak antichains -/

section pi
variables {ι : Type*} {α : ι → Type*} [Π i, preorder (α i)] {s t : set (Π i, α i)}
  {a b c : Π i, α i}

local infix ` ≺ `:50 := strong_lt

/-- A weak antichain in `Π i, α i` is a set such that no two distinct elements are strongly less
than each other. -/
def is_weak_antichain (s : set (Π i, α i)) : Prop := is_antichain (≺) s

namespace is_weak_antichain

protected lemma subset (hs : is_weak_antichain s) : t ⊆ s → is_weak_antichain t := hs.subset
protected lemma eq (hs : is_weak_antichain s) : a ∈ s → b ∈ s → a ≺ b → a = b := hs.eq

protected lemma insert (hs : is_weak_antichain s) : (∀ ⦃b⦄, b ∈ s → a ≠ b → ¬ b ≺ a) →
  (∀ ⦃b⦄, b ∈ s → a ≠ b → ¬ a ≺ b) → is_weak_antichain (insert a s) :=
hs.insert

end is_weak_antichain

lemma is_weak_antichain_insert :
  is_weak_antichain (insert a s) ↔ is_weak_antichain s ∧ ∀ ⦃b⦄, b ∈ s → a ≠ b → ¬ a ≺ b ∧ ¬ b ≺ a :=
is_antichain_insert

protected lemma is_antichain.is_weak_antichain (hs : is_antichain (≤) s) : is_weak_antichain s :=
hs.mono $ λ a b, le_of_strong_lt

lemma set.subsingleton.is_weak_antichain (hs : s.subsingleton) : is_weak_antichain s :=
hs.is_antichain _

end pi


#check sub_self

example (x : ℤ) : x * 0 = 0 :=
  by rw [←sub_self (1 : ℤ), mul_sub, mul_one, sub_self, sub_self]


definition Power (X : Type*) := X → Type*
notation `𝒫` X := Power X
definition const {X : Type*} {Y : Type*} := λ b:Y, (λ x:X, b)
notation `↓`:max y:max := const y
section difference_domain
variables (Y : Type*)
class DifferenceDomain extends has_zero Y, has_sub Y := (vanishing_diagonal : Π y, y - y = zero)
class OrderedDifferenceDomain extends has_le Y, DifferenceDomain Y
end difference_domain
section reduction
variables {Y : Type*} {X : Type*} (𝓕 : 𝒫 (X → Y))
definition Reduction := Π f, 𝓕 f → Y
definition left_closed_at (f : X → Y) (g : Y → Y) := 𝓕 f → 𝓕 (g ∘ f)
definition left_closed (g : Y → Y) := Π f, left_closed_at 𝓕 f g
class PointFamily := (has_constants : Π y, 𝓕 ↓y)
section subtraction
instance pointwise_subtraction [has_sub Y] : has_sub (X → Y) := ⟨λ f g, (λ x, f x - g x)⟩
class DifferenceFamily [has_sub Y] := (closure : Π f g (f𝓕 : 𝓕 f) (g𝓕 : 𝓕 g), 𝓕 (f - g))
variables (Int : Reduction 𝓕)
definition left_factors (β : Y → Y) (lc_β : left_closed 𝓕 β) := Π f (f𝓕 : 𝓕 f), Int (β ∘ f) (lc_β f f𝓕) = β (Int f f𝓕)
variables [PointFamily 𝓕]
class UnitalReduction := (constant_reduction : Π y, Int ↓y (PointFamily.has_constants 𝓕 y) = y)
variables [has_le Y]
instance pointwise_le : has_le (X → Y) := ⟨λ f g, (Π x, f x ≤ g x)⟩
class MonotonicReduction := (monotonicity : Π f g {f𝓕 g𝓕}, (f ≤ g) → (Int f f𝓕 ≤ Int g g𝓕))
variables [has_zero Y] [has_sub Y] [DifferenceFamily 𝓕]
definition constant_difference_property := Π f k {f𝓕}, Int (f - ↓k) (DifferenceFamily.closure f ↓k f𝓕 (PointFamily.has_constants 𝓕 k)) = Int f f𝓕 - Int ↓k (PointFamily.has_constants 𝓕 k)
definition translation_invariance_property := Π f g {f𝓕 g𝓕}, 0 ≤ Int (g - f) (DifferenceFamily.closure g f g𝓕 f𝓕) → Int f f𝓕 ≤ Int g g𝓕
class TranslativeReduction := (constant_difference : constant_difference_property 𝓕 Int) (translation_invariance : translation_invariance_property 𝓕 Int)
end subtraction
end reduction
section subdifferential
variables {Y : Type*} [has_zero Y] [has_sub Y] [has_le Y] (φ : Y → Y) (t : Y) (𝒩 : 𝒫 Y)
structure SubDifferential := (map : Y → Y) (root_at_zero : map 0 = 0) (lower_bound_property : Π s, 𝒩 s → map (s - t) ≤ (φ s) - (φ t))
variables {X : Type*} (𝓕 : 𝒫 (X → Y)) (Int : Reduction 𝓕)
structure LeftFactorSubDifferential extends SubDifferential φ t 𝒩 := (is_left_closed : left_closed 𝓕 map) (left_factors : left_factors 𝓕 Int map is_left_closed)
end subdifferential
section jensen_inequality
variables {Y : Type*} [OrderedDifferenceDomain Y] {X : Type*} (𝓕 : 𝒫 (X → Y)) [PointFamily 𝓕] [DifferenceFamily 𝓕] (Int : Reduction 𝓕)
class JensenReduction extends UnitalReduction 𝓕 Int, MonotonicReduction 𝓕 Int, TranslativeReduction 𝓕 Int
theorem jensen_inequality [JensenReduction 𝓕 Int] (f : X → Y) (f𝓕 : 𝓕 f) (𝒩 : 𝒫 Y) (image_contained_in_𝒩 : Π x, 𝒩 (f x)) (φ : Y → Y) (φf𝓕 : 𝓕 (φ ∘ f)) (subdifferential : LeftFactorSubDifferential φ (Int f f𝓕) 𝒩 𝓕 Int) : φ (Int f f𝓕) ≤ Int (φ ∘ f) φf𝓕 := begin
    let t := Int f f𝓕,
    let F := f - ↓t,
    let F𝓕 := DifferenceFamily.closure f ↓t _ _,
    let inequality := λ x, subdifferential.lower_bound_property (f x) (image_contained_in_𝒩 x),
    let inequality := MonotonicReduction.monotonicity Int (subdifferential.map ∘ F) (φ ∘ f - ↓(φ t)) inequality,
    rewrite subdifferential.left_factors F F𝓕 at inequality,
    rewrite TranslativeReduction.constant_difference Int at inequality,
    rewrite UnitalReduction.constant_reduction Int at inequality,
    rewrite DifferenceDomain.vanishing_diagonal at inequality,
    rewrite subdifferential.root_at_zero at inequality,
    let inequality := TranslativeReduction.translation_invariance Int ↓(φ t) (φ ∘ f) inequality,
    rewrite UnitalReduction.constant_reduction Int at inequality,
    exact inequality,
end
end jensen_inequality