/- Formalization of floating-point numbers, using the Flocq library. -/

import .integers .lib .flocq .archi

namespace floats
open integers flocq word

/- Boolean-valued comparisons -/

def cmp_of_comparison : comparison → option ordering → bool
| Ceq (some ordering.eq) := tt
| Ceq _                  := ff
| Cne (some ordering.eq) := ff
| Cne _                  := tt
| Clt (some ordering.lt) := tt
| Clt _                  := ff
| Cle (some ordering.lt) := tt
| Cle (some ordering.eq) := tt
| Cle _                  := ff
| Cgt (some ordering.gt) := tt
| Cgt _                  := ff
| Cge (some ordering.gt) := tt
| Cge (some ordering.eq) := tt
| Cge _                  := ff

lemma cmp_of_comparison_swap (c x) :
  cmp_of_comparison (swap_comparison c) x =
  cmp_of_comparison c (ordering.swap <$> x) := sorry'

lemma cmp_of_comparison_ne_eq (x) :
  cmp_of_comparison Cne x = bnot (cmp_of_comparison Ceq x) := sorry'

lemma cmp_of_comparison_lt_not_eq (x) :
  cmp_of_comparison Clt x → ¬ cmp_of_comparison Ceq x := sorry'

lemma cmp_of_comparison_le_lt_eq (x) :
  cmp_of_comparison Cle x = cmp_of_comparison Clt x || cmp_of_comparison Ceq x := sorry'

lemma cmp_of_comparison_gt_not_eq (x) :
  cmp_of_comparison Cgt x → ¬ cmp_of_comparison Ceq x := sorry'

lemma cmp_of_comparison_ge_gt_eq (x) :
  cmp_of_comparison Cge x = cmp_of_comparison Cgt x || cmp_of_comparison Ceq x := sorry'

lemma cmp_of_comparison_lt_not_gt (x) :
  cmp_of_comparison Clt x → ¬ cmp_of_comparison Cgt x := sorry'

def float : Type := sorry' /- the type of IEE754 double-precision FP numbers -/
def float32 : Type := sorry' /- the type of IEE754 single-precision FP numbers -/

/- * Double-precision FP numbers -/

namespace float

/- ** NaN payload manipulations -/

/- The following definitions are not part of the IEEE754 standard but
    apply to all architectures supported by CompCert. -/

/- Transform a Nan payload to a quiet Nan payload. -/

def transform_quiet_pl (pl : nan_pl 53) : nan_pl 53 :=
word.or pl (word.repr (2^22))

lemma transform_quiet_pl_idempotent (pl) :
  transform_quiet_pl (transform_quiet_pl pl) = transform_quiet_pl pl := sorry'

/- Nan payload operations for single <-> double conversions. -/

def expand_pl (pl : nan_pl 24) : nan_pl 53 :=
word.shl (ucoe pl) (repr 29)

def of_single_pl (s : bool) (pl : nan_pl 24) : bool × nan_pl 53 :=
(s, if archi.float_of_single_preserves_sNaN
    then expand_pl pl
    else transform_quiet_pl (expand_pl pl))

def reduce_pl (pl : nan_pl 53) : nan_pl 24 :=
ucoe (word.shr pl (repr 29))

def to_single_pl (s : bool) (pl : nan_pl 53) : bool × nan_pl 24 :=
(s, reduce_pl (transform_quiet_pl pl))

/- NaN payload operations for opposite and absolute value. -/

def neg_pl (s : bool) (pl : nan_pl 53) := (bnot s, pl)
def abs_pl (s : bool) (pl : nan_pl 53) := (ff, pl)

/- The NaN payload operations for two-argument arithmetic operations
   are not part of the IEEE754 standard, but all architectures of
   Compcert share a similar NaN behavior, parameterized by:
- a "default" payload which occurs when an operation generates a NaN from
  non-NaN arguments;
- a choice function determining which of the payload arguments to choose,
  when an operation is given two NaN arguments. -/

def binop_pl (x y : binary64) : bool × nan_pl 53 := sorry'

/- ** Operations over double-precision floats -/

def zero : float := sorry' /- the float [+0.0] -/

instance : has_zero float := ⟨zero⟩

instance eq_dec : decidable_eq float := sorry'

/- Arithmetic operations -/

protected def neg : float → float := sorry' /- opposite (change sign) -/
def abs : float → float := sorry' /- absolute value (set sign to [+]) -/
protected def add : float → float → float := sorry' /- addition -/
protected def sub : float → float → float := sorry' /- subtraction -/
protected def mul : float → float → float := sorry' /- multiplication -/
protected def div : float → float → float := sorry' /- division -/
def cmp (c:comparison) (f1 f2 : float) : bool := /- comparison -/
cmp_of_comparison c sorry'

instance : has_add float := ⟨float.add⟩
instance : has_neg float := ⟨float.neg⟩
instance : has_sub float := ⟨float.sub⟩
instance : has_mul float := ⟨float.mul⟩
instance : has_div float := ⟨float.div⟩

/- Conversions -/

def of_single : float32 → float := sorry'
def to_single : float → float32 := sorry'

def to_int (f:float) : option int32 := /- conversion to signed 32-bit int -/
repr <$> sorry'
def to_intu (f:float) : option int32 := /- conversion to unsigned 32-bit int -/
repr <$> sorry'
def to_long (f:float) : option int64 := /- conversion to signed 64-bit int -/
repr <$> sorry'
def to_longu (f:float) : option int64 := /- conversion to unsigned 64-bit int -/
repr <$> sorry'

def of_int (n:int32) : float := /- conversion from signed 32-bit int -/
sorry'
def of_intu (n:int32) : float:= /- conversion from unsigned 32-bit int -/
sorry'

def of_long (n:int64) : float := /- conversion from signed 64-bit int -/
sorry'
def of_longu (n:int64) : float:= /- conversion from unsigned 64-bit int -/
sorry'

instance coe_int32_float : has_coe int32 float := ⟨of_int⟩
instance coe_int64_float : has_coe int64 float := ⟨of_long⟩

def from_parsed (base : pos_num) (intPart : pos_num) (expPart : ℤ) : float :=
sorry'

/- Conversions between floats and their concrete in-memory representation
    as a sequence of 64 bits. -/

def to_bits (f : float) : int64 := sorry'
def of_bits (b : int64) : float := sorry'

def from_words (hi lo : int32) : float := of_bits (int64.ofwords hi lo)

def is_nan : float → bool := sorry'

/- ** Properties -/

/- Below are the only properties of floating-point arithmetic that we
  rely on in the compiler proof. -/

/- Commutativity properties of addition and multiplication. -/

theorem add_comm (x y) : ¬ is_nan x ∨ ¬ is_nan y → x + y = y + x := sorry'

theorem mul_comm (x y) : ¬ is_nan x ∨ ¬ is_nan y → x * y = y * x := sorry'

/- Multiplication by 2 is diagonal addition. -/

theorem mul2_add (f) : f + f = f * of_int 2 := sorry'

/- Divisions that can be turned into multiplication by an inverse. -/

def exact_inverse : float → option float := sorry'

theorem div_mul_inverse (x y z) : exact_inverse y = some z → x / y = x * z := sorry'

/- Properties of comparisons. -/

lemma cmp_swap (c x y) : cmp (swap_comparison c) x y = cmp c y x := sorry'

lemma cmp_ne_eq (x y) : cmp Cne x y = bnot (cmp Ceq x y) := sorry'

lemma cmp_lt_not_eq (x y) : cmp Clt x y → ¬ cmp Ceq x y := sorry'

lemma cmp_le_lt_eq (x y) : cmp Cle x y = cmp Clt x y || cmp Ceq x y := sorry'

lemma cmp_gt_not_eq (x y) : cmp Cgt x y → ¬ cmp Ceq x y := sorry'

lemma cmp_ge_gt_eq (x y) : cmp Cge x y = cmp Cgt x y || cmp Ceq x y := sorry'

lemma cmp_lt_not_gt (x y) : cmp Clt x y → ¬ cmp Cgt x y := sorry'

/- Properties of conversions to/from in-memory representation.
  The conversions are bijective (one-to-one). -/

theorem of_to_bits (f) : of_bits (to_bits f) = f := sorry'

theorem to_of_bits (b) : to_bits (of_bits b) = b := sorry'

/- Conversions between floats and unsigned ints can be defined
  in terms of conversions between floats and signed ints.
  (Most processors provide only the latter, forcing the compiler
  to emulate the former.)   -/

def half32 : int32 := repr (@min_signed W32).  /- [0x8000_0000] -/

theorem of_intu_of_int_1 (x) : word.ltu x half32 → of_intu x = of_int x := sorry'

theorem of_intu_of_int_2 (x) : ¬ word.ltu x half32 → of_intu x = of_int (x - half32) + of_intu half32 := sorry'

theorem to_intu_to_int_1 (x n) : cmp Clt x (of_intu half32) → to_intu x = some n → to_int x = some n := sorry'

theorem to_intu_to_int_2 (x n) : ¬ cmp Clt x (of_intu half32) → to_intu x = some n →
  to_int (x - of_intu half32) = some (n - half32) := sorry'

/- Conversions from ints to floats can be defined as bitwise manipulations
  over the in-memory representation.  This is what the PowerPC port does.
  The trick is that [from_words 0x4330_0000 x] is the float
  [2^52 + of_intu x]. -/

def bit433 : int32 := repr 0x43300000

lemma split_bits_or (x) :
  split_bits 52 11 (unsigned (int64.ofwords bit433 x)) = (ff, unsigned x, 1075) := sorry'

theorem of_intu_from_words (x) :
  of_intu x = from_words bit433 x - from_words bit433 0 := sorry'

lemma half32_signed_unsigned (x) :
  (unsigned (x + half32) : ℤ) = signed x + @half_modulus W32 := sorry'

theorem of_int_from_words (x) :
  of_int x = from_words bit433 (x + half32) - from_words bit433 half32 := sorry'

def bit453 : int32 := repr 0x45300000

lemma split_bits_or' (x) :
  split_bits 52 11 (unsigned (int64.ofwords bit453 x)) = (ff, unsigned x, 1107) := sorry'

theorem of_longu_from_words (l) : of_longu l =
  from_words bit453 (int64.hiword l) -
  from_words bit453 (repr (2^20)) +
  from_words bit433 (int64.loword l) := sorry'

theorem of_long_from_words (l) : of_long l =
    from_words bit453 (int64.hiword l + half32) -
    from_words bit453 (repr (2^20+2^31)) +
    from_words bit433 (int64.loword l) := sorry'

/- Conversions from unsigned longs can be expressed in terms of conversions from signed longs.
    If the unsigned long is too big, a round-to-odd must be performed on it
    to avoid double rounding. -/

theorem of_longu_of_long_1 (x) :
  word.ltu x (repr (@half_modulus W64)) →
  of_longu x = of_long x := sorry'

theorem of_longu_of_long_2 (x) :
  ¬ word.ltu x (repr (@half_modulus W64)) →
  of_longu x = of_long (word.or (word.shru x 1) (word.and x 1)) * of_int (repr 2) := sorry'

end float

/- * Single-precision FP numbers -/

namespace float32

/- ** NaN payload manipulations -/

def transform_quiet_pl (pl : nan_pl 24) : nan_pl 24 :=
word.or pl (repr (2^22))

lemma transform_quiet_pl_idempotent (pl) :
  transform_quiet_pl (transform_quiet_pl pl) = transform_quiet_pl pl := sorry'

def neg_pl (s:bool) (pl:nan_pl 24) := (bnot s, pl)
def abs_pl (s:bool) (pl:nan_pl 24) := (ff, pl)

def binop_pl (x y : binary32) : bool × nan_pl 24 := sorry'

/- ** Operations over single-precision floats -/

def zero : float32 := sorry' /- the float [+0.0] -/

instance : has_zero float32 := ⟨zero⟩

instance eq_dec : decidable_eq float32 := sorry'

/- Arithmetic operations -/

protected def neg : float32 → float32 := sorry' /- opposite (change sign) -/
def abs : float32 → float32 := sorry' /- absolute value (set sign to [+]) -/
protected def add : float32 → float32 → float32 := sorry' /- addition -/
protected def sub : float32 → float32 → float32 := sorry' /- subtraction -/
protected def mul : float32 → float32 → float32 := sorry' /- multiplication -/
protected def div : float32 → float32 → float32 := sorry' /- division -/
def cmp (c:comparison) (f1 f2 : float32) : bool := /- comparison -/
cmp_of_comparison c sorry'

instance : has_add float32 := ⟨float32.add⟩
instance : has_neg float32 := ⟨float32.neg⟩
instance : has_sub float32 := ⟨float32.sub⟩
instance : has_mul float32 := ⟨float32.mul⟩
instance : has_div float32 := ⟨float32.div⟩

/- Conversions -/

def of_double : float → float32 := float.to_single
def to_double : float32 → float := float.of_single

def to_int (f:float32) : option int32 := /- conversion to signed 32-bit int -/
repr <$> sorry'
def to_intu (f:float32) : option int32 := /- conversion to unsigned 32-bit int -/
repr <$> sorry'
def to_long (f:float32) : option int64 := /- conversion to signed 64-bit int -/
repr <$> sorry'
def to_longu (f:float32) : option int64 := /- conversion to unsigned 64-bit int -/
repr <$> sorry'

def of_int (n:int32) : float32 := /- conversion from signed 32-bit int to single-precision float -/
sorry'
def of_intu (n:int32) : float32 := /- conversion from unsigned 32-bit int to single-precision float -/
sorry'

def of_long (n:int64) : float32 := /- conversion from signed 64-bit int to single-precision float -/
sorry'
def of_longu (n:int64) : float32 := /- conversion from unsigned 64-bit int to single-precision float -/
sorry'

def from_parsed (base : pos_num) (intPart : pos_num) (expPart : ℤ) : float32 :=
sorry'

/- Conversions between floats and their concrete in-memory representation
    as a sequence of 32 bits. -/

def to_bits (f : float32) : int32 := sorry'
def of_bits (b : int32) : float32 := sorry'

def is_nan : float32 → bool := sorry'

/- ** Properties -/

/- Commutativity properties of addition and multiplication. -/

theorem add_comm (x y) : ¬ is_nan x ∨ ¬ is_nan y → x + y = y + x := sorry'

theorem mul_comm (x y) : ¬ is_nan x ∨ ¬ is_nan y → x * y = y * x := sorry'

/- Multiplication by 2 is diagonal addition. -/

theorem mul2_add (f) : f + f = f * of_int 2 := sorry'

/- Divisions that can be turned into multiplication by an inverse. -/

def exact_inverse : float32 → option float32 := sorry'

theorem div_mul_inverse (x y z) : exact_inverse y = some z → x / y = x * z := sorry'

/- Properties of comparisons. -/

lemma cmp_swap (c x y) : cmp (swap_comparison c) x y = cmp c y x := sorry'

lemma cmp_ne_eq (x y) : cmp Cne x y = bnot (cmp Ceq x y) := sorry'

lemma cmp_lt_not_eq (x y) : cmp Clt x y → ¬ cmp Ceq x y := sorry'

lemma cmp_le_lt_eq (x y) : cmp Cle x y = cmp Clt x y || cmp Ceq x y := sorry'

lemma cmp_gt_not_eq (x y) : cmp Cgt x y → ¬ cmp Ceq x y := sorry'

lemma cmp_ge_gt_eq (x y) : cmp Cge x y = cmp Cgt x y || cmp Ceq x y := sorry'

lemma cmp_lt_not_gt (x y) : cmp Clt x y → ¬ cmp Cgt x y := sorry'

theorem cmp_double (f1 f2 c) : cmp c f1 f2 = float.cmp c (to_double f1) (to_double f2) := sorry'

/- Properties of conversions to/from in-memory representation.
  The conversions are bijective (one-to-one). -/

theorem of_to_bits (f) : of_bits (to_bits f) = f := sorry'

theorem to_of_bits (b) : to_bits (of_bits b) = b := sorry'

/- Conversions from 32-bit integers to single-precision floats can
  be decomposed into a conversion to a double-precision float,
  followed by a [Float32.of_double] conversion.  No double rounding occurs. -/

theorem of_int_double (n) : of_int n = of_double (float.of_int n) := sorry'

theorem of_intu_double (n) : of_intu n = of_double (float.of_intu n) := sorry'

/- Conversion of single-precision floats to integers can be decomposed
  into a [Float32.to_double] extension, followed by a double-precision-to-int
  conversion. -/

theorem to_int_double (f n) : to_int f = some n → float.to_int (to_double f) = some n := sorry'

theorem to_intu_double (f n) : to_intu f = some n → float.to_intu (to_double f) = some n := sorry'

theorem to_long_double (f n) : to_long f = some n → float.to_long (to_double f) = some n := sorry'

theorem to_longu_double (f n) : to_longu f = some n → float.to_longu (to_double f) = some n := sorry'

/- Conversions from 64-bit integers to single-precision floats can be expressed
  as conversion to a double-precision float followed by a [Float32.of_double] conversion.
  To avoid double rounding when the integer is large (above [2^53]), a round
  to odd must be performed on the integer before conversion to double-precision float. -/

lemma int_round_odd_plus (p n) :
  int_round_odd n p = int.land (int.lor n (int.land n (2^p-1) + (2^p-1))) (-(2^p)) := sorry'

theorem of_longu_double_1 (n) : unsigned n ≤ 2^53 →
  of_longu n = of_double (float.of_longu n) := sorry'

theorem of_longu_double_2 (n) : 2^36 ≤ unsigned n →
  of_longu n = of_double (float.of_longu $
    word.and (word.or n (word.and n (repr 2047) + repr 2047)) (repr (-2048))) := sorry'

theorem of_long_double_1 (n) : (signed n).nat_abs ≤ 2^53 →
  of_long n = of_double (float.of_long n) := sorry'

theorem of_long_double_2 (n) : 2^36 ≤ (signed n).nat_abs →
  of_long n = of_double (float.of_long $
    word.and (word.or n (word.and n (repr 2047) + repr 2047)) (repr (-2048))) := sorry'

end float32

end floats


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

! This file was ported from Lean 3 source module data.part
! leanprover-community/mathlib commit 80c43012d26f63026d362c3aba28f3c3bafb07e6
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Set.Basic
import Mathlib.Logic.Equiv.Defs

/-!
# Partial values of a type
This file defines `Part α`, the partial values of a type.
`o : Part α` carries a proposition `o.Dom`, its domain, along with a function `get : o.Dom → α`, its
value. The rule is then that every partial value has a value but, to access it, you need to provide
a proof of the domain.
`Part α` behaves the same as `Option α` except that `o : Option α` is decidably `none` or `some a`
for some `a : α`, while the domain of `o : Part α` doesn't have to be decidable. That means you can
translate back and forth between a partial value with a decidable domain and an option, and
`Option α` and `Part α` are classically equivalent. In general, `Part α` is bigger than `Option α`.
In current mathlib, `Part ℕ`, aka `PartENat`, is used to move decidability of the order to
decidability of `PartENat.find` (which is the smallest natural satisfying a predicate, or `∞` if
there's none).
## Main declarations
`Option`-like declarations:
* `Part.none`: The partial value whose domain is `False`.
* `Part.some a`: The partial value whose domain is `True` and whose value is `a`.
* `Part.ofOption`: Converts an `Option α` to a `Part α` by sending `none` to `none` and `some a` to
  `some a`.
* `Part.toOption`: Converts a `Part α` with a decidable domain to an `Option α`.
* `Part.equivOption`: Classical equivalence between `Part α` and `Option α`.
Monadic structure:
* `Part.bind`: `o.bind f` has value `(f (o.get _)).get _` (`f o` morally) and is defined when `o`
  and `f (o.get _)` are defined.
* `Part.map`: Maps the value and keeps the same domain.
Other:
* `Part.restrict`: `Part.restrict p o` replaces the domain of `o : Part α` by `p : Prop` so long as
  `p → o.Dom`.
* `Part.assert`: `assert p f` appends `p` to the domains of the values of a partial function.
* `Part.unwrap`: Gets the value of a partial value regardless of its domain. Unsound.
## Notation
For `a : α`, `o : Part α`, `a ∈ o` means that `o` is defined and equal to `a`. Formally, it means
`o.Dom` and `o.get _ = a`.
-/

open Function

/-- `Part α` is the type of "partial values" of type `α`. It
  is similar to `Option α` except the domain condition can be an
  arbitrary proposition, not necessarily decidable. -/
structure Part.{u} (α : Type u) : Type u where
  /-- The domain of a partial value -/
  Dom : Prop
  /-- Extract a value from a partial value given a proof of `Dom` -/
  get : Dom → α
#align part Part

namespace Part

variable {α : Type _} {β : Type _} {γ : Type _}

/-- Convert a `Part α` with a decidable domain to an option -/
def toOption (o : Part α) [Decidable o.Dom] : Option α :=
  if h : Dom o then some (o.get h) else none
#align part.to_option Part.toOption

@[simp] lemma toOption_isSome (o : Part α) [Decidable o.Dom] : o.toOption.isSome ↔ o.Dom := by
  by_cases h : o.Dom <;> simp [h, toOption]
#align part.to_option_is_some Part.toOption_isSome

@[simp] lemma toOption_isNone (o : Part α) [Decidable o.Dom] : o.toOption.isNone ↔ ¬o.Dom := by
  by_cases h : o.Dom <;> simp [h, toOption]
#align part.to_option_is_none Part.toOption_isNone

/-- `Part` extensionality -/
theorem ext' : ∀ {o p : Part α} (_ : o.Dom ↔ p.Dom) (_ : ∀ h₁ h₂, o.get h₁ = p.get h₂), o = p
  | ⟨od, o⟩, ⟨pd, p⟩, H1, H2 => by
    have t : od = pd := propext H1
    cases t; rw [show o = p from funext fun p => H2 p p]
#align part.ext' Part.ext'

/-- `Part` eta expansion -/
@[simp]
theorem eta : ∀ o : Part α, (⟨o.Dom, fun h => o.get h⟩ : Part α) = o
  | ⟨_, _⟩ => rfl
#align part.eta Part.eta

/-- `a ∈ o` means that `o` is defined and equal to `a` -/
protected def Mem (a : α) (o : Part α) : Prop :=
  ∃ h, o.get h = a
#align part.mem Part.Mem

instance : Membership α (Part α) :=
  ⟨Part.Mem⟩

theorem mem_eq (a : α) (o : Part α) : (a ∈ o) = ∃ h, o.get h = a :=
  rfl
#align part.mem_eq Part.mem_eq

theorem dom_iff_mem : ∀ {o : Part α}, o.Dom ↔ ∃ y, y ∈ o
  | ⟨_, f⟩ => ⟨fun h => ⟨f h, h, rfl⟩, fun ⟨_, h, rfl⟩ => h⟩
#align part.dom_iff_mem Part.dom_iff_mem

theorem get_mem {o : Part α} (h) : get o h ∈ o :=
  ⟨_, rfl⟩
#align part.get_mem Part.get_mem

@[simp]
theorem mem_mk_iff {p : Prop} {o : p → α} {a : α} : a ∈ Part.mk p o ↔ ∃ h, o h = a :=
  Iff.rfl
#align part.mem_mk_iff Part.mem_mk_iff

/-- `Part` extensionality -/
@[ext]
theorem ext {o p : Part α} (H : ∀ a, a ∈ o ↔ a ∈ p) : o = p :=
  (ext' ⟨fun h => ((H _).1 ⟨h, rfl⟩).fst, fun h => ((H _).2 ⟨h, rfl⟩).fst⟩) fun _ _ =>
    ((H _).2 ⟨_, rfl⟩).snd
#align part.ext Part.ext

/-- The `none` value in `Part` has a `False` domain and an empty function. -/
def none : Part α :=
  ⟨False, False.rec⟩
#align part.none Part.none

instance : Inhabited (Part α) :=
  ⟨none⟩

@[simp]
theorem not_mem_none (a : α) : a ∉ @none α := fun h => h.fst
#align part.not_mem_none Part.not_mem_none

/-- The `some a` value in `Part` has a `true` domain and the
  function returns `a`. -/
def some (a : α) : Part α :=
  ⟨True, fun _ => a⟩
#align part.some Part.some

@[simp]
theorem some_dom (a : α) : (some a).Dom :=
  trivial
#align part.some_dom Part.some_dom

theorem mem_unique : ∀ {a b : α} {o : Part α}, a ∈ o → b ∈ o → a = b
  | _, _, ⟨_, _⟩, ⟨_, rfl⟩, ⟨_, rfl⟩ => rfl
#align part.mem_unique Part.mem_unique

theorem Mem.left_unique : Relator.LeftUnique ((· ∈ ·) : α → Part α → Prop) := fun _ _ _ =>
  mem_unique
#align part.mem.left_unique Part.Mem.left_unique

theorem get_eq_of_mem {o : Part α} {a} (h : a ∈ o) (h') : get o h' = a :=
  mem_unique ⟨_, rfl⟩ h
#align part.get_eq_of_mem Part.get_eq_of_mem

protected theorem subsingleton (o : Part α) : Set.Subsingleton { a | a ∈ o } := fun _ ha _ hb =>
  mem_unique ha hb
#align part.subsingleton Part.subsingleton

@[simp]
theorem get_some {a : α} (ha : (some a).Dom) : get (some a) ha = a :=
  rfl
#align part.get_some Part.get_some

theorem mem_some (a : α) : a ∈ some a :=
  ⟨trivial, rfl⟩
#align part.mem_some Part.mem_some

@[simp]
theorem mem_some_iff {a b} : b ∈ (some a : Part α) ↔ b = a :=
  ⟨fun ⟨_, e⟩ => e.symm, fun e => ⟨trivial, e.symm⟩⟩
#align part.mem_some_iff Part.mem_some_iff

theorem eq_some_iff {a : α} {o : Part α} : o = some a ↔ a ∈ o :=
  ⟨fun e => e.symm ▸ mem_some _, fun ⟨h, e⟩ => e ▸ ext' (iff_true_intro h) fun _ _ => rfl⟩
#align part.eq_some_iff Part.eq_some_iff

theorem eq_none_iff {o : Part α} : o = none ↔ ∀ a, a ∉ o :=
  ⟨fun e => e.symm ▸ not_mem_none, fun h => ext (by simpa)⟩
#align part.eq_none_iff Part.eq_none_iff

theorem eq_none_iff' {o : Part α} : o = none ↔ ¬o.Dom :=
  ⟨fun e => e.symm ▸ id, fun h => eq_none_iff.2 fun _ h' => h h'.fst⟩
#align part.eq_none_iff' Part.eq_none_iff'

@[simp]
theorem not_none_dom : ¬(none : Part α).Dom :=
  id
#align part.not_none_dom Part.not_none_dom

@[simp]
theorem some_ne_none (x : α) : some x ≠ none := by
  intro h
  exact true_ne_false (congr_arg Dom h)
#align part.some_ne_none Part.some_ne_none

@[simp]
theorem none_ne_some (x : α) : none ≠ some x :=
  (some_ne_none x).symm
#align part.none_ne_some Part.none_ne_some

theorem ne_none_iff {o : Part α} : o ≠ none ↔ ∃ x, o = some x := by
  constructor
  · rw [Ne, eq_none_iff', not_not]
    exact fun h => ⟨o.get h, eq_some_iff.2 (get_mem h)⟩
  · rintro ⟨x, rfl⟩
    apply some_ne_none
#align part.ne_none_iff Part.ne_none_iff

theorem eq_none_or_eq_some (o : Part α) : o = none ∨ ∃ x, o = some x :=
  or_iff_not_imp_left.2 ne_none_iff.1
#align part.eq_none_or_eq_some Part.eq_none_or_eq_some

theorem some_injective : Injective (@Part.some α) := fun _ _ h =>
  congr_fun (eq_of_heq (Part.mk.inj h).2) trivial
#align part.some_injective Part.some_injective

@[simp]
theorem some_inj {a b : α} : Part.some a = some b ↔ a = b :=
  some_injective.eq_iff
#align part.some_inj Part.some_inj

@[simp]
theorem some_get {a : Part α} (ha : a.Dom) : Part.some (Part.get a ha) = a :=
  Eq.symm (eq_some_iff.2 ⟨ha, rfl⟩)
#align part.some_get Part.some_get

theorem get_eq_iff_eq_some {a : Part α} {ha : a.Dom} {b : α} : a.get ha = b ↔ a = some b :=
  ⟨fun h => by simp [h.symm], fun h => by simp [h]⟩
#align part.get_eq_iff_eq_some Part.get_eq_iff_eq_some

theorem get_eq_get_of_eq (a : Part α) (ha : a.Dom) {b : Part α} (h : a = b) :
    a.get ha = b.get (h ▸ ha) := by
  congr
#align part.get_eq_get_of_eq Part.get_eq_get_of_eq

theorem get_eq_iff_mem {o : Part α} {a : α} (h : o.Dom) : o.get h = a ↔ a ∈ o :=
  ⟨fun H => ⟨h, H⟩, fun ⟨_, H⟩ => H⟩
#align part.get_eq_iff_mem Part.get_eq_iff_mem

theorem eq_get_iff_mem {o : Part α} {a : α} (h : o.Dom) : a = o.get h ↔ a ∈ o :=
  eq_comm.trans (get_eq_iff_mem h)
#align part.eq_get_iff_mem Part.eq_get_iff_mem

@[simp]
theorem none_toOption [Decidable (@none α).Dom] : (none : Part α).toOption = Option.none :=
  dif_neg id
#align part.none_to_option Part.none_toOption

@[simp]
theorem some_toOption (a : α) [Decidable (some a).Dom] : (some a).toOption = Option.some a :=
  dif_pos trivial
#align part.some_to_option Part.some_toOption

instance noneDecidable : Decidable (@none α).Dom :=
  instDecidableFalse
#align part.none_decidable Part.noneDecidable

instance someDecidable (a : α) : Decidable (some a).Dom :=
  instDecidableTrue
#align part.some_decidable Part.someDecidable

/-- Retrieves the value of `a : part α` if it exists, and return the provided default value
otherwise. -/
def getOrElse (a : Part α) [Decidable a.Dom] (d : α) :=
  if ha : a.Dom then a.get ha else d
#align part.get_or_else Part.getOrElse

theorem getOrElse_of_dom (a : Part α) (h : a.Dom) [Decidable a.Dom] (d : α) :
    getOrElse a d = a.get h :=
  dif_pos h
#align part.get_or_else_of_dom Part.getOrElse_of_dom

theorem getOrElse_of_not_dom (a : Part α) (h : ¬a.Dom) [Decidable a.Dom] (d : α) :
    getOrElse a d = d :=
  dif_neg h
#align part.get_or_else_of_not_dom Part.getOrElse_of_not_dom

@[simp]
theorem getOrElse_none (d : α) [Decidable (none : Part α).Dom] : getOrElse none d = d :=
  none.getOrElse_of_not_dom not_none_dom d
#align part.get_or_else_none Part.getOrElse_none

@[simp]
theorem getOrElse_some (a : α) (d : α) [Decidable (some a).Dom] : getOrElse (some a) d = a :=
  (some a).getOrElse_of_dom (some_dom a) d
#align part.get_or_else_some Part.getOrElse_some

--Porting note: removed `simp`
theorem mem_toOption {o : Part α} [Decidable o.Dom] {a : α} : a ∈ toOption o ↔ a ∈ o := by
  unfold toOption
  by_cases h : o.Dom <;> simp [h]
  · exact ⟨fun h => ⟨_, h⟩, fun ⟨_, h⟩ => h⟩
  · exact mt Exists.fst h
#align part.mem_to_option Part.mem_toOption

--Porting note : New theorem, like `mem_toOption` but with LHS in `simp` normal form
@[simp]
theorem toOption_eq_some_iff {o : Part α} [Decidable o.Dom] {a : α} :
    toOption o = Option.some a ↔ a ∈ o :=
  by rw [← Option.mem_def, mem_toOption]

protected theorem Dom.toOption {o : Part α} [Decidable o.Dom] (h : o.Dom) : o.toOption = o.get h :=
  dif_pos h
#align part.dom.to_option Part.Dom.toOption

theorem toOption_eq_none_iff {a : Part α} [Decidable a.Dom] : a.toOption = Option.none ↔ ¬a.Dom :=
  Ne.dite_eq_right_iff fun _ => Option.some_ne_none _
#align part.to_option_eq_none_iff Part.toOption_eq_none_iff

/- Porting TODO: Removed `simp`. Maybe add `@[simp]` later if `@[simp]` is taken off definition of
`Option.elim` -/
theorem elim_toOption {α β : Type _} (a : Part α) [Decidable a.Dom] (b : β) (f : α → β) :
    a.toOption.elim b f = if h : a.Dom then f (a.get h) else b := by
  split_ifs with h
  · rw [h.toOption]
    rfl
  · rw [Part.toOption_eq_none_iff.2 h]
    rfl
#align part.elim_to_option Part.elim_toOption

/-- Converts an `Option α` into a `Part α`. -/
def ofOption : Option α → Part α
  | Option.none => none
  | Option.some a => some a
#align part.of_option Part.ofOption

@[simp]
theorem mem_ofOption {a : α} : ∀ {o : Option α}, a ∈ ofOption o ↔ a ∈ o
  | Option.none => ⟨fun h => h.fst.elim, fun h => Option.noConfusion h⟩
  | Option.some _ => ⟨fun h => congr_arg Option.some h.snd, fun h => ⟨trivial, Option.some.inj h⟩⟩
#align part.mem_of_option Part.mem_ofOption

@[simp]
theorem ofOption_dom {α} : ∀ o : Option α, (ofOption o).Dom ↔ o.isSome
  | Option.none => by simp [ofOption, none]
  | Option.some a => by simp [ofOption]
#align part.of_option_dom Part.ofOption_dom

theorem ofOption_eq_get {α} (o : Option α) : ofOption o = ⟨_, @Option.get _ o⟩ :=
  Part.ext' (ofOption_dom o) fun h₁ h₂ => by
    cases o
    . simp at h₂
    . rfl
#align part.of_option_eq_get Part.ofOption_eq_get

instance : Coe (Option α) (Part α) :=
  ⟨ofOption⟩

theorem mem_coe {a : α} {o : Option α} : a ∈ (o : Part α) ↔ a ∈ o :=
  mem_ofOption
#align part.mem_coe Part.mem_coe

@[simp]

@[simp]
theorem coe_some (a : α) : (Option.some a : Part α) = some a :=
  rfl
#align part.coe_some Part.coe_some

@[elab_as_elim]
protected theorem induction_on {P : Part α → Prop} (a : Part α) (hnone : P none)
    (hsome : ∀ a : α, P (some a)) : P a :=
  (Classical.em a.Dom).elim (fun h => Part.some_get h ▸ hsome _) fun h =>
    (eq_none_iff'.2 h).symm ▸ hnone
#align part.induction_on Part.induction_on

instance ofOptionDecidable : ∀ o : Option α, Decidable (ofOption o).Dom
  | Option.none => Part.noneDecidable
  | Option.some a => Part.someDecidable a
#align part.of_option_decidable Part.ofOptionDecidable

@[simp]
theorem to_ofOption (o : Option α) : toOption (ofOption o) = o := by cases o <;> rfl
#align part.to_of_option Part.to_ofOption

@[simp]
theorem of_toOption (o : Part α) [Decidable o.Dom] : ofOption (toOption o) = o :=
  ext fun _ => mem_ofOption.trans mem_toOption
#align part.of_to_option Part.of_toOption

/-- `Part α` is (classically) equivalent to `Option α`. -/
noncomputable def equivOption : Part α ≃ Option α :=
  haveI := Classical.dec
  ⟨fun o => toOption o, ofOption, fun o => of_toOption o, fun o =>
    Eq.trans (by dsimp; congr ) (to_ofOption o)⟩
#align part.equiv_option Part.equivOption

/-- We give `Part α` the order where everything is greater than `none`. -/
instance : PartialOrder (Part
        α) where
  le x y := ∀ i, i ∈ x → i ∈ y
  le_refl x y := id
  le_trans x y z f g i := g _ ∘ f _
  le_antisymm x y f g := Part.ext fun z => ⟨f _, g _⟩

instance : OrderBot (Part α) where
  bot := none
  bot_le := by
    introv x
    rintro ⟨⟨_⟩, _⟩

theorem le_total_of_le_of_le {x y : Part α} (z : Part α) (hx : x ≤ z) (hy : y ≤ z) :
    x ≤ y ∨ y ≤ x := by
  rcases Part.eq_none_or_eq_some x with (h | ⟨b, h₀⟩)
  · rw [h]
    left
    apply OrderBot.bot_le _
  right; intro b' h₁
  rw [Part.eq_some_iff] at h₀
  have hx := hx _ h₀; have hy := hy _ h₁
  have hx := Part.mem_unique hx hy; subst hx
  exact h₀
#align part.le_total_of_le_of_le Part.le_total_of_le_of_le

/-- `assert p f` is a bind-like operation which appends an additional condition
  `p` to the domain and uses `f` to produce the value. -/
def assert (p : Prop) (f : p → Part α) : Part α :=
  ⟨∃ h : p, (f h).Dom, fun ha => (f ha.fst).get ha.snd⟩
#align part.assert Part.assert

/-- The bind operation has value `g (f.get)`, and is defined when all the
  parts are defined. -/
protected def bind (f : Part α) (g : α → Part β) : Part β :=
  assert (Dom f) fun b => g (f.get b)
#align part.bind Part.bind

/-- The map operation for `Part` just maps the value and maintains the same domain. -/
@[simps]
def map (f : α → β) (o : Part α) : Part β :=
  ⟨o.Dom, f ∘ o.get⟩
#align part.map Part.map
#align part.map_dom Part.map_Dom
#align part.map_get Part.map_get

theorem mem_map (f : α → β) {o : Part α} : ∀ {a}, a ∈ o → f a ∈ map f o
  | _, ⟨_, rfl⟩ => ⟨_, rfl⟩
#align part.mem_map Part.mem_map

@[simp]
theorem mem_map_iff (f : α → β) {o : Part α} {b} : b ∈ map f o ↔ ∃ a ∈ o, f a = b :=
  ⟨fun hb => match b, hb with
    | _, ⟨_, rfl⟩ => ⟨_, ⟨_, rfl⟩, rfl⟩,
    fun ⟨_, h₁, h₂⟩ => h₂ ▸ mem_map f h₁⟩
#align part.mem_map_iff Part.mem_map_iff

@[simp]
theorem map_none (f : α → β) : map f none = none :=
  eq_none_iff.2 fun a => by simp
#align part.map_none Part.map_none

@[simp]
theorem map_some (f : α → β) (a : α) : map f (some a) = some (f a) :=
  eq_some_iff.2 <| mem_map f <| mem_some _
#align part.map_some Part.map_some

theorem mem_assert {p : Prop} {f : p → Part α} : ∀ {a} (h : p), a ∈ f h → a ∈ assert p f
  | _, x, ⟨h, rfl⟩ => ⟨⟨x, h⟩, rfl⟩
#align part.mem_assert Part.mem_assert

@[simp]
theorem mem_assert_iff {p : Prop} {f : p → Part α} {a} : a ∈ assert p f ↔ ∃ h : p, a ∈ f h :=
  ⟨fun ha => match a, ha with
    | _, ⟨_, rfl⟩ => ⟨_, ⟨_, rfl⟩⟩,
    fun ⟨_, h⟩ => mem_assert _ h⟩
#align part.mem_assert_iff Part.mem_assert_iff

theorem assert_pos {p : Prop} {f : p → Part α} (h : p) : assert p f = f h := by
  dsimp [assert]
  cases h' : f h
  simp [h', mk.injEq, h, exists_prop_of_true, true_and]
  apply Function.hfunext
  · simp only [h, h', exists_prop_of_true]
  · aesop
#align part.assert_pos Part.assert_pos

theorem assert_neg {p : Prop} {f : p → Part α} (h : ¬p) : assert p f = none := by
  dsimp [assert, none]; congr
  · simp only [h, not_false_iff, exists_prop_of_false]
  · apply Function.hfunext
    · simp only [h, not_false_iff, exists_prop_of_false]
    simp at *
#align part.assert_neg Part.assert_neg

theorem mem_bind {f : Part α} {g : α → Part β} : ∀ {a b}, a ∈ f → b ∈ g a → b ∈ f.bind g
  | _, _, ⟨h, rfl⟩, ⟨h₂, rfl⟩ => ⟨⟨h, h₂⟩, rfl⟩
#align part.mem_bind Part.mem_bind

@[simp]
theorem mem_bind_iff {f : Part α} {g : α → Part β} {b} : b ∈ f.bind g ↔ ∃ a ∈ f, b ∈ g a :=
  ⟨fun hb => match b, hb with
    | _, ⟨⟨_, _⟩, rfl⟩ => ⟨_, ⟨_, rfl⟩, ⟨_, rfl⟩⟩,
    fun ⟨_, h₁, h₂⟩ => mem_bind h₁ h₂⟩
#align part.mem_bind_iff Part.mem_bind_iff

protected theorem Dom.bind {o : Part α} (h : o.Dom) (f : α → Part β) : o.bind f = f (o.get h) := by
  ext b
  simp only [Part.mem_bind_iff, exists_prop]
  refine' ⟨_, fun hb => ⟨o.get h, Part.get_mem _, hb⟩⟩
  rintro ⟨a, ha, hb⟩
  rwa [Part.get_eq_of_mem ha]
#align part.dom.bind Part.Dom.bind

theorem Dom.of_bind {f : α → Part β} {a : Part α} (h : (a.bind f).Dom) : a.Dom :=
  h.1
#align part.dom.of_bind Part.Dom.of_bind

@[simp]
theorem bind_none (f : α → Part β) : none.bind f = none :=
  eq_none_iff.2 fun a => by simp
#align part.bind_none Part.bind_none

@[simp]
theorem bind_some (a : α) (f : α → Part β) : (some a).bind f = f a :=
  ext <| by simp
#align part.bind_some Part.bind_some

theorem bind_of_mem {o : Part α} {a : α} (h : a ∈ o) (f : α → Part β) : o.bind f = f a := by
  rw [eq_some_iff.2 h, bind_some]
#align part.bind_of_mem Part.bind_of_mem

theorem bind_some_eq_map (f : α → β) (x : Part α) : x.bind (some ∘ f) = map f x :=
  ext <| by simp [eq_comm]
#align part.bind_some_eq_map Part.bind_some_eq_map

theorem bind_toOption (f : α → Part β) (o : Part α) [Decidable o.Dom] [∀ a, Decidable (f a).Dom]
    [Decidable (o.bind f).Dom] :
    (o.bind f).toOption = o.toOption.elim Option.none fun a => (f a).toOption := by
  by_cases h : o.Dom
  · simp_rw [h.toOption, h.bind]
    rfl
  · rw [Part.toOption_eq_none_iff.2 h]
    exact Part.toOption_eq_none_iff.2 fun ho => h ho.of_bind
#align part.bind_to_option Part.bind_toOption

theorem bind_assoc {γ} (f : Part α) (g : α → Part β) (k : β → Part γ) :
    (f.bind g).bind k = f.bind fun x => (g x).bind k :=
  ext fun a => by
    simp;
      exact
        ⟨fun ⟨_, ⟨_, h₁, h₂⟩, h₃⟩ => ⟨_, h₁, _, h₂, h₃⟩, fun ⟨_, h₁, _, h₂, h₃⟩ =>
          ⟨_, ⟨_, h₁, h₂⟩, h₃⟩⟩
#align part.bind_assoc Part.bind_assoc

@[simp]
theorem bind_map {γ} (f : α → β) (x) (g : β → Part γ) :
    (map f x).bind g = x.bind fun y => g (f y) := by rw [← bind_some_eq_map, bind_assoc]; simp
#align part.bind_map Part.bind_map

@[simp]
theorem map_bind {γ} (f : α → Part β) (x : Part α) (g : β → γ) :
    map g (x.bind f) = x.bind fun y => map g (f y) := by
  rw [← bind_some_eq_map, bind_assoc]; simp [bind_some_eq_map]
#align part.map_bind Part.map_bind

theorem map_map (g : β → γ) (f : α → β) (o : Part α) : map g (map f o) = map (g ∘ f) o := by
  erw [← bind_some_eq_map, bind_map, bind_some_eq_map]
#align part.map_map Part.map_map

instance : Monad Part where
  pure := @some
  map := @map
  bind := @Part.bind

instance : LawfulMonad
      Part where
  bind_pure_comp := @bind_some_eq_map
  id_map f := by cases f; rfl
  pure_bind := @bind_some
  bind_assoc := @bind_assoc
  map_const := by simp [Functor.mapConst, Functor.map]
  --Porting TODO : In Lean3 these were automatic by a tactic
  seqLeft_eq x y := ext'
    (by simp [SeqLeft.seqLeft, Part.bind, assert, Seq.seq, const, (. <$> .), and_comm])
    (fun _ _ => rfl)
  seqRight_eq x y := ext'
    (by simp [SeqRight.seqRight, Part.bind, assert, Seq.seq, const, (. <$> .), and_comm])
    (fun _ _ => rfl)
  pure_seq x y := ext'
    (by simp [Seq.seq, Part.bind, assert, (. <$> .), pure])
    (fun _ _ => rfl)
  bind_map x y := ext'
    (by simp [(. >>= .), Part.bind, assert, Seq.seq, get, (. <$> .)] )
    (fun _ _ => rfl)

theorem map_id' {f : α → α} (H : ∀ x : α, f x = x) (o) : map f o = o := by
  rw [show f = id from funext H]; exact id_map o
#align part.map_id' Part.map_id'

@[simp]
theorem bind_some_right (x : Part α) : x.bind some = x := by
  erw [bind_some_eq_map]; simp [map_id']
#align part.bind_some_right Part.bind_some_right

@[simp]
theorem pure_eq_some (a : α) : pure a = some a :=
  rfl
#align part.pure_eq_some Part.pure_eq_some

@[simp]
theorem ret_eq_some (a : α) : (return a : Part α) = some a :=
  rfl
#align part.ret_eq_some Part.ret_eq_some

@[simp]
theorem map_eq_map {α β} (f : α → β) (o : Part α) : f <$> o = map f o :=
  rfl
#align part.map_eq_map Part.map_eq_map

@[simp]
theorem bind_eq_bind {α β} (f : Part α) (g : α → Part β) : f >>= g = f.bind g :=
  rfl
#align part.bind_eq_bind Part.bind_eq_bind

theorem bind_le {α} (x : Part α) (f : α → Part β) (y : Part β) :
    x >>= f ≤ y ↔ ∀ a, a ∈ x → f a ≤ y := by
  constructor <;> intro h
  · intro a h' b
    have h := h b
    simp only [and_imp, exists_prop, bind_eq_bind, mem_bind_iff, exists_imp] at h
    apply h _ h'
  · intro b h'
    simp only [exists_prop, bind_eq_bind, mem_bind_iff] at h'
    rcases h' with ⟨a, h₀, h₁⟩
    apply h _ h₀ _ h₁
#align part.bind_le Part.bind_le

--Porting note: No MonadFail in Lean4 yet
-- instance : MonadFail Part :=
--   { Part.monad with fail := fun _ _ => none }

/-- `restrict p o h` replaces the domain of `o` with `p`, and is well defined when
  `p` implies `o` is defined. -/
def restrict (p : Prop) (o : Part α) (H : p → o.Dom) : Part α :=
  ⟨p, fun h => o.get (H h)⟩
#align part.restrict Part.restrict

@[simp]
theorem mem_restrict (p : Prop) (o : Part α) (h : p → o.Dom) (a : α) :
    a ∈ restrict p o h ↔ p ∧ a ∈ o := by
  dsimp [restrict, mem_eq]; constructor
  · rintro ⟨h₀, h₁⟩
    exact ⟨h₀, ⟨_, h₁⟩⟩
  rintro ⟨h₀, _, h₂⟩; exact ⟨h₀, h₂⟩
#align part.mem_restrict Part.mem_restrict

/-- `unwrap o` gets the value at `o`, ignoring the condition. This function is unsound. -/
unsafe def unwrap (o : Part α) : α :=
  o.get lcProof
#align part.unwrap Part.unwrap

theorem assert_defined {p : Prop} {f : p → Part α} : ∀ h : p, (f h).Dom → (assert p f).Dom :=
  Exists.intro
#align part.assert_defined Part.assert_defined

theorem bind_defined {f : Part α} {g : α → Part β} :
    ∀ h : f.Dom, (g (f.get h)).Dom → (f.bind g).Dom :=
  assert_defined
#align part.bind_defined Part.bind_defined

@[simp]
theorem bind_dom {f : Part α} {g : α → Part β} : (f.bind g).Dom ↔ ∃ h : f.Dom, (g (f.get h)).Dom :=
  Iff.rfl
#align part.bind_dom Part.bind_dom

section Instances

-- We define several instances for constants and operations on `Part α` inherited from `α`.
@[to_additive]
instance [One α] : One (Part α) where one := pure 1

@[to_additive]
instance [Mul α] : Mul (Part α) where mul a b := (· * ·) <$> a <*> b

@[to_additive]
instance [Inv α] : Inv (Part α) where inv := map Inv.inv

@[to_additive]
instance [Div α] : Div (Part α) where div a b := (· / ·) <$> a <*> b

instance [Mod α] : Mod (Part α) where mod a b := (· % ·) <$> a <*> b

instance [Append α] : Append (Part α) where append a b := (· ++ ·) <$> a <*> b

instance [Inter α] : Inter (Part α) where inter a b := (· ∩ ·) <$> a <*> b

instance [Union α] : Union (Part α) where union a b := (· ∪ ·) <$> a <*> b

instance [SDiff α] : SDiff (Part α) where sdiff a b := (· \ ·) <$> a <*> b

section
-- Porting note : new theorems to unfold definitions
theorem mul_def [Mul α] (a b : Part α) : a * b = bind a fun y ↦ map (y * .) b := rfl
theorem one_def [One α] : (1 : Part α) = some 1 := rfl
theorem inv_def [Inv α] (a : Part α) : a⁻¹ = Part.map (. ⁻¹) a := rfl
theorem div_def [Div α] (a b : Part α) : a / b = bind a fun y => map (y / .) b := rfl
theorem mod_def [Mod α] (a b : Part α) : a % b = bind a fun y => map (y % .) b := rfl
theorem append_def [Append α] (a b : Part α) : a ++ b = bind a fun y => map (y ++ .) b := rfl
theorem inter_def [Inter α] (a b : Part α) : a ∩ b = bind a fun y => map (y ∩ .) b := rfl
theorem union_def [Union α] (a b : Part α) : a ∪ b = bind a fun y => map (y ∪ .) b := rfl
theorem sdiff_def [SDiff α] (a b : Part α) : a \ b = bind a fun y => map (y \ .) b := rfl

end

@[to_additive]
theorem one_mem_one [One α] : (1 : α) ∈ (1 : Part α) :=
  ⟨trivial, rfl⟩
#align part.one_mem_one Part.one_mem_one
#align part.zero_mem_zero Part.zero_mem_zero

@[to_additive]
theorem mul_mem_mul [Mul α] (a b : Part α) (ma mb : α) (ha : ma ∈ a) (hb : mb ∈ b) :
    ma * mb ∈ a * b := ⟨⟨ha.1, hb.1⟩, by simp [← ha.2, ← hb.2]; rfl⟩
#align part.mul_mem_mul Part.mul_mem_mul
#align part.add_mem_add Part.add_mem_add

@[to_additive]
theorem left_dom_of_mul_dom [Mul α] {a b : Part α} (hab : Dom (a * b)) : a.Dom := hab.1
#align part.left_dom_of_mul_dom Part.left_dom_of_mul_dom
#align part.left_dom_of_add_dom Part.left_dom_of_add_dom

@[to_additive]
theorem right_dom_of_mul_dom [Mul α] {a b : Part α} (hab : Dom (a * b)) : b.Dom := hab.2
#align part.right_dom_of_mul_dom Part.right_dom_of_mul_dom
#align part.right_dom_of_add_dom Part.right_dom_of_add_dom

@[to_additive (attr := simp)]
theorem mul_get_eq [Mul α] (a b : Part α) (hab : Dom (a * b)) :
    (a * b).get hab = a.get (left_dom_of_mul_dom hab) * b.get (right_dom_of_mul_dom hab) := rfl
#align part.mul_get_eq Part.mul_get_eq
#align part.add_get_eq Part.add_get_eq

@[to_additive]
theorem some_mul_some [Mul α] (a b : α) : some a * some b = some (a * b) := by simp [mul_def]
#align part.some_mul_some Part.some_mul_some
#align part.some_add_some Part.some_add_some

@[to_additive]
theorem inv_mem_inv [Inv α] (a : Part α) (ma : α) (ha : ma ∈ a) : ma⁻¹ ∈ a⁻¹ :=
  by simp [inv_def]; aesop
#align part.inv_mem_inv Part.inv_mem_inv
#align part.neg_mem_neg Part.neg_mem_neg

@[to_additive]
theorem inv_some [Inv α] (a : α) : (some a)⁻¹ = some a⁻¹ :=
  rfl
#align part.inv_some Part.inv_some
#align part.neg_some Part.neg_some

@[to_additive]
theorem div_mem_div [Div α] (a b : Part α) (ma mb : α) (ha : ma ∈ a) (hb : mb ∈ b) :
    ma / mb ∈ a / b := by simp [div_def]; aesop
#align part.div_mem_div Part.div_mem_div
#align part.sub_mem_sub Part.sub_mem_sub

@[to_additive]
theorem left_dom_of_div_dom [Div α] {a b : Part α} (hab : Dom (a / b)) : a.Dom := hab.1
#align part.left_dom_of_div_dom Part.left_dom_of_div_dom
#align part.left_dom_of_sub_dom Part.left_dom_of_sub_dom

@[to_additive]
theorem right_dom_of_div_dom [Div α] {a b : Part α} (hab : Dom (a / b)) : b.Dom := hab.2
#align part.right_dom_of_div_dom Part.right_dom_of_div_dom
#align part.right_dom_of_sub_dom Part.right_dom_of_sub_dom

@[to_additive (attr := simp)]
theorem div_get_eq [Div α] (a b : Part α) (hab : Dom (a / b)) :
    (a / b).get hab = a.get (left_dom_of_div_dom hab) / b.get (right_dom_of_div_dom hab) :=
  by simp [div_def]; aesop
#align part.div_get_eq Part.div_get_eq
#align part.sub_get_eq Part.sub_get_eq

@[to_additive]
theorem some_div_some [Div α] (a b : α) : some a / some b = some (a / b) := by simp [div_def]
#align part.some_div_some Part.some_div_some
#align part.some_sub_some Part.some_sub_some

theorem mod_mem_mod [Mod α] (a b : Part α) (ma mb : α) (ha : ma ∈ a) (hb : mb ∈ b) :
    ma % mb ∈ a % b := by simp [mod_def]; aesop
#align part.mod_mem_mod Part.mod_mem_mod

theorem left_dom_of_mod_dom [Mod α] {a b : Part α} (hab : Dom (a % b)) : a.Dom := hab.1
#align part.left_dom_of_mod_dom Part.left_dom_of_mod_dom

theorem right_dom_of_mod_dom [Mod α] {a b : Part α} (hab : Dom (a % b)) : b.Dom := hab.2
#align part.right_dom_of_mod_dom Part.right_dom_of_mod_dom

@[simp]
theorem mod_get_eq [Mod α] (a b : Part α) (hab : Dom (a % b)) :
    (a % b).get hab = a.get (left_dom_of_mod_dom hab) % b.get (right_dom_of_mod_dom hab) :=
  by simp [mod_def]; aesop
#align part.mod_get_eq Part.mod_get_eq

theorem some_mod_some [Mod α] (a b : α) : some a % some b = some (a % b) := by simp [mod_def]
#align part.some_mod_some Part.some_mod_some

theorem append_mem_append [Append α] (a b : Part α) (ma mb : α) (ha : ma ∈ a) (hb : mb ∈ b) :
    ma ++ mb ∈ a ++ b := by simp [append_def]; aesop
#align part.append_mem_append Part.append_mem_append

theorem left_dom_of_append_dom [Append α] {a b : Part α} (hab : Dom (a ++ b)) : a.Dom := hab.1
#align part.left_dom_of_append_dom Part.left_dom_of_append_dom

theorem right_dom_of_append_dom [Append α] {a b : Part α} (hab : Dom (a ++ b)) : b.Dom := hab.2
#align part.right_dom_of_append_dom Part.right_dom_of_append_dom

@[simp]
theorem append_get_eq [Append α] (a b : Part α) (hab : Dom (a ++ b)) :
    (a ++ b).get hab = a.get (left_dom_of_append_dom hab) ++ b.get (right_dom_of_append_dom hab) :=
  by simp [append_def]; aesop
#align part.append_get_eq Part.append_get_eq

theorem some_append_some [Append α] (a b : α) : some a ++ some b = some (a ++ b) :=
  by simp [append_def]
#align part.some_append_some Part.some_append_some

theorem inter_mem_inter [Inter α] (a b : Part α) (ma mb : α) (ha : ma ∈ a) (hb : mb ∈ b) :
    ma ∩ mb ∈ a ∩ b := by simp [inter_def]; aesop
#align part.inter_mem_inter Part.inter_mem_inter

theorem left_dom_of_inter_dom [Inter α] {a b : Part α} (hab : Dom (a ∩ b)) : a.Dom := hab.1
#align part.left_dom_of_inter_dom Part.left_dom_of_inter_dom

theorem right_dom_of_inter_dom [Inter α] {a b : Part α} (hab : Dom (a ∩ b)) : b.Dom := hab.2
#align part.right_dom_of_inter_dom Part.right_dom_of_inter_dom

@[simp]
theorem inter_get_eq [Inter α] (a b : Part α) (hab : Dom (a ∩ b)) :
    (a ∩ b).get hab = a.get (left_dom_of_inter_dom hab) ∩ b.get (right_dom_of_inter_dom hab) :=
  by simp [inter_def]; aesop
#align part.inter_get_eq Part.inter_get_eq

theorem some_inter_some [Inter α] (a b : α) : some a ∩ some b = some (a ∩ b) :=
  by simp [inter_def]
#align part.some_inter_some Part.some_inter_some

theorem union_mem_union [Union α] (a b : Part α) (ma mb : α) (ha : ma ∈ a) (hb : mb ∈ b) :
    ma ∪ mb ∈ a ∪ b := by simp [union_def]; aesop
#align part.union_mem_union Part.union_mem_union

theorem left_dom_of_union_dom [Union α] {a b : Part α} (hab : Dom (a ∪ b)) : a.Dom := hab.1
#align part.left_dom_of_union_dom Part.left_dom_of_union_dom

theorem right_dom_of_union_dom [Union α] {a b : Part α} (hab : Dom (a ∪ b)) : b.Dom := hab.2
#align part.right_dom_of_union_dom Part.right_dom_of_union_dom

@[simp]
theorem union_get_eq [Union α] (a b : Part α) (hab : Dom (a ∪ b)) :
    (a ∪ b).get hab = a.get (left_dom_of_union_dom hab) ∪ b.get (right_dom_of_union_dom hab) :=
  by simp [union_def]; aesop
#align part.union_get_eq Part.union_get_eq

theorem some_union_some [Union α] (a b : α) : some a ∪ some b = some (a ∪ b) := by simp [union_def]
#align part.some_union_some Part.some_union_some

theorem sdiff_mem_sdiff [SDiff α] (a b : Part α) (ma mb : α) (ha : ma ∈ a) (hb : mb ∈ b) :
    ma \ mb ∈ a \ b := by simp [sdiff_def]; aesop
#align part.sdiff_mem_sdiff Part.sdiff_mem_sdiff

theorem left_dom_of_sdiff_dom [SDiff α] {a b : Part α} (hab : Dom (a \ b)) : a.Dom := hab.1
#align part.left_dom_of_sdiff_dom Part.left_dom_of_sdiff_dom

theorem right_dom_of_sdiff_dom [SDiff α] {a b : Part α} (hab : Dom (a \ b)) : b.Dom := hab.2
#align part.right_dom_of_sdiff_dom Part.right_dom_of_sdiff_dom

@[simp]
theorem sdiff_get_eq [SDiff α] (a b : Part α) (hab : Dom (a \ b)) :
    (a \ b).get hab = a.get (left_dom_of_sdiff_dom hab) \ b.get (right_dom_of_sdiff_dom hab) :=
  by simp [sdiff_def]; aesop
#align part.sdiff_get_eq Part.sdiff_get_eq

theorem some_sdiff_some [SDiff α] (a b : α) : some a \ some b = some (a \ b) := by simp [sdiff_def]
#align part.some_sdiff_some Part.some_sdiff_some

end Instances

end Part


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

! This file was ported from Lean 3 source module logic.encodable.lattice
! 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.Logic.Encodable.Basic
import Mathbin.Logic.Pairwise

/-!
# Lattice operations on encodable types

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

Lemmas about lattice and set operations on encodable types

## Implementation Notes

This is a separate file, to avoid unnecessary imports in basic files.

Previously some of these results were in the `measure_theory` folder.
-/

open Set

namespace Encodable

variable {α : Type _} {β : Type _} [Encodable β]

/- warning: encodable.supr_decode₂ -> Encodable.supᵢ_decode₂ is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} [_inst_1 : Encodable.{u2} β] [_inst_2 : CompleteLattice.{u1} α] (f : β -> α), Eq.{succ u1} α (supᵢ.{u1, 1} α (CompleteSemilatticeSup.toHasSup.{u1} α (CompleteLattice.toCompleteSemilatticeSup.{u1} α _inst_2)) Nat (fun (i : Nat) => supᵢ.{u1, succ u2} α (CompleteSemilatticeSup.toHasSup.{u1} α (CompleteLattice.toCompleteSemilatticeSup.{u1} α _inst_2)) β (fun (b : β) => supᵢ.{u1, 0} α (CompleteSemilatticeSup.toHasSup.{u1} α (CompleteLattice.toCompleteSemilatticeSup.{u1} α _inst_2)) (Membership.Mem.{u2, u2} β (Option.{u2} β) (Option.hasMem.{u2} β) b (Encodable.decode₂.{u2} β _inst_1 i)) (fun (H : Membership.Mem.{u2, u2} β (Option.{u2} β) (Option.hasMem.{u2} β) b (Encodable.decode₂.{u2} β _inst_1 i)) => f b)))) (supᵢ.{u1, succ u2} α (CompleteSemilatticeSup.toHasSup.{u1} α (CompleteLattice.toCompleteSemilatticeSup.{u1} α _inst_2)) β (fun (b : β) => f b))
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} [_inst_1 : Encodable.{u1} β] [_inst_2 : CompleteLattice.{u2} α] (f : β -> α), Eq.{succ u2} α (supᵢ.{u2, 1} α (CompleteLattice.toSupSet.{u2} α _inst_2) Nat (fun (i : Nat) => supᵢ.{u2, succ u1} α (CompleteLattice.toSupSet.{u2} α _inst_2) β (fun (b : β) => supᵢ.{u2, 0} α (CompleteLattice.toSupSet.{u2} α _inst_2) (Membership.mem.{u1, u1} β (Option.{u1} β) (Option.instMembershipOption.{u1} β) b (Encodable.decode₂.{u1} β _inst_1 i)) (fun (H : Membership.mem.{u1, u1} β (Option.{u1} β) (Option.instMembershipOption.{u1} β) b (Encodable.decode₂.{u1} β _inst_1 i)) => f b)))) (supᵢ.{u2, succ u1} α (CompleteLattice.toSupSet.{u2} α _inst_2) β (fun (b : β) => f b))
Case conversion may be inaccurate. Consider using '#align encodable.supr_decode₂ Encodable.supᵢ_decode₂ₓ'. -/
theorem supᵢ_decode₂ [CompleteLattice α] (f : β → α) :
    (⨆ (i : ℕ) (b ∈ decode₂ β i), f b) = ⨆ b, f b :=
  by
  rw [supᵢ_comm]
  simp [mem_decode₂]
#align encodable.supr_decode₂ Encodable.supᵢ_decode₂

/- warning: encodable.Union_decode₂ -> Encodable.unionᵢ_decode₂ is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} [_inst_1 : Encodable.{u2} β] (f : β -> (Set.{u1} α)), Eq.{succ u1} (Set.{u1} α) (Set.unionᵢ.{u1, 1} α Nat (fun (i : Nat) => Set.unionᵢ.{u1, succ u2} α β (fun (b : β) => Set.unionᵢ.{u1, 0} α (Membership.Mem.{u2, u2} β (Option.{u2} β) (Option.hasMem.{u2} β) b (Encodable.decode₂.{u2} β _inst_1 i)) (fun (H : Membership.Mem.{u2, u2} β (Option.{u2} β) (Option.hasMem.{u2} β) b (Encodable.decode₂.{u2} β _inst_1 i)) => f b)))) (Set.unionᵢ.{u1, succ u2} α β (fun (b : β) => f b))
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} [_inst_1 : Encodable.{u1} β] (f : β -> (Set.{u2} α)), Eq.{succ u2} (Set.{u2} α) (Set.unionᵢ.{u2, 1} α Nat (fun (i : Nat) => Set.unionᵢ.{u2, succ u1} α β (fun (b : β) => Set.unionᵢ.{u2, 0} α (Membership.mem.{u1, u1} β (Option.{u1} β) (Option.instMembershipOption.{u1} β) b (Encodable.decode₂.{u1} β _inst_1 i)) (fun (H : Membership.mem.{u1, u1} β (Option.{u1} β) (Option.instMembershipOption.{u1} β) b (Encodable.decode₂.{u1} β _inst_1 i)) => f b)))) (Set.unionᵢ.{u2, succ u1} α β (fun (b : β) => f b))
Case conversion may be inaccurate. Consider using '#align encodable.Union_decode₂ Encodable.unionᵢ_decode₂ₓ'. -/
theorem unionᵢ_decode₂ (f : β → Set α) : (⋃ (i : ℕ) (b ∈ decode₂ β i), f b) = ⋃ b, f b :=
  supᵢ_decode₂ f
#align encodable.Union_decode₂ Encodable.unionᵢ_decode₂

/- warning: encodable.Union_decode₂_cases -> Encodable.unionᵢ_decode₂_cases is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} [_inst_1 : Encodable.{u2} β] {f : β -> (Set.{u1} α)} {C : (Set.{u1} α) -> Prop}, (C (EmptyCollection.emptyCollection.{u1} (Set.{u1} α) (Set.hasEmptyc.{u1} α))) -> (forall (b : β), C (f b)) -> (forall {n : Nat}, C (Set.unionᵢ.{u1, succ u2} α β (fun (b : β) => Set.unionᵢ.{u1, 0} α (Membership.Mem.{u2, u2} β (Option.{u2} β) (Option.hasMem.{u2} β) b (Encodable.decode₂.{u2} β _inst_1 n)) (fun (H : Membership.Mem.{u2, u2} β (Option.{u2} β) (Option.hasMem.{u2} β) b (Encodable.decode₂.{u2} β _inst_1 n)) => f b))))
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} [_inst_1 : Encodable.{u1} β] {f : β -> (Set.{u2} α)} {C : (Set.{u2} α) -> Prop}, (C (EmptyCollection.emptyCollection.{u2} (Set.{u2} α) (Set.instEmptyCollectionSet.{u2} α))) -> (forall (b : β), C (f b)) -> (forall {n : Nat}, C (Set.unionᵢ.{u2, succ u1} α β (fun (b : β) => Set.unionᵢ.{u2, 0} α (Membership.mem.{u1, u1} β (Option.{u1} β) (Option.instMembershipOption.{u1} β) b (Encodable.decode₂.{u1} β _inst_1 n)) (fun (H : Membership.mem.{u1, u1} β (Option.{u1} β) (Option.instMembershipOption.{u1} β) b (Encodable.decode₂.{u1} β _inst_1 n)) => f b))))
Case conversion may be inaccurate. Consider using '#align encodable.Union_decode₂_cases Encodable.unionᵢ_decode₂_casesₓ'. -/
@[elab_as_elim]
theorem unionᵢ_decode₂_cases {f : β → Set α} {C : Set α → Prop} (H0 : C ∅) (H1 : ∀ b, C (f b)) {n} :
    C (⋃ b ∈ decode₂ β n, f b) :=
  match decode₂ β n with
  | none => by
    simp
    apply H0
  | some b => by
    convert H1 b
    simp [ext_iff]
#align encodable.Union_decode₂_cases Encodable.unionᵢ_decode₂_cases

/- warning: encodable.Union_decode₂_disjoint_on -> Encodable.unionᵢ_decode₂_disjoint_on is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} [_inst_1 : Encodable.{u2} β] {f : β -> (Set.{u1} α)}, (Pairwise.{u2} β (Function.onFun.{succ u2, succ u1, 1} β (Set.{u1} α) Prop (Disjoint.{u1} (Set.{u1} α) (CompleteSemilatticeInf.toPartialOrder.{u1} (Set.{u1} α) (CompleteLattice.toCompleteSemilatticeInf.{u1} (Set.{u1} α) (Order.Coframe.toCompleteLattice.{u1} (Set.{u1} α) (CompleteDistribLattice.toCoframe.{u1} (Set.{u1} α) (CompleteBooleanAlgebra.toCompleteDistribLattice.{u1} (Set.{u1} α) (Set.completeBooleanAlgebra.{u1} α)))))) (GeneralizedBooleanAlgebra.toOrderBot.{u1} (Set.{u1} α) (BooleanAlgebra.toGeneralizedBooleanAlgebra.{u1} (Set.{u1} α) (Set.booleanAlgebra.{u1} α)))) f)) -> (Pairwise.{0} Nat (Function.onFun.{1, succ u1, 1} Nat (Set.{u1} α) Prop (Disjoint.{u1} (Set.{u1} α) (CompleteSemilatticeInf.toPartialOrder.{u1} (Set.{u1} α) (CompleteLattice.toCompleteSemilatticeInf.{u1} (Set.{u1} α) (Order.Coframe.toCompleteLattice.{u1} (Set.{u1} α) (CompleteDistribLattice.toCoframe.{u1} (Set.{u1} α) (CompleteBooleanAlgebra.toCompleteDistribLattice.{u1} (Set.{u1} α) (Set.completeBooleanAlgebra.{u1} α)))))) (GeneralizedBooleanAlgebra.toOrderBot.{u1} (Set.{u1} α) (BooleanAlgebra.toGeneralizedBooleanAlgebra.{u1} (Set.{u1} α) (Set.booleanAlgebra.{u1} α)))) (fun (i : Nat) => Set.unionᵢ.{u1, succ u2} α β (fun (b : β) => Set.unionᵢ.{u1, 0} α (Membership.Mem.{u2, u2} β (Option.{u2} β) (Option.hasMem.{u2} β) b (Encodable.decode₂.{u2} β _inst_1 i)) (fun (H : Membership.Mem.{u2, u2} β (Option.{u2} β) (Option.hasMem.{u2} β) b (Encodable.decode₂.{u2} β _inst_1 i)) => f b)))))
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} [_inst_1 : Encodable.{u1} β] {f : β -> (Set.{u2} α)}, (Pairwise.{u1} β (Function.onFun.{succ u1, succ u2, 1} β (Set.{u2} α) Prop (Disjoint.{u2} (Set.{u2} α) (CompleteSemilatticeInf.toPartialOrder.{u2} (Set.{u2} α) (CompleteLattice.toCompleteSemilatticeInf.{u2} (Set.{u2} α) (Order.Coframe.toCompleteLattice.{u2} (Set.{u2} α) (CompleteDistribLattice.toCoframe.{u2} (Set.{u2} α) (CompleteBooleanAlgebra.toCompleteDistribLattice.{u2} (Set.{u2} α) (Set.instCompleteBooleanAlgebraSet.{u2} α)))))) (BoundedOrder.toOrderBot.{u2} (Set.{u2} α) (Preorder.toLE.{u2} (Set.{u2} α) (PartialOrder.toPreorder.{u2} (Set.{u2} α) (CompleteSemilatticeInf.toPartialOrder.{u2} (Set.{u2} α) (CompleteLattice.toCompleteSemilatticeInf.{u2} (Set.{u2} α) (Order.Coframe.toCompleteLattice.{u2} (Set.{u2} α) (CompleteDistribLattice.toCoframe.{u2} (Set.{u2} α) (CompleteBooleanAlgebra.toCompleteDistribLattice.{u2} (Set.{u2} α) (Set.instCompleteBooleanAlgebraSet.{u2} α)))))))) (CompleteLattice.toBoundedOrder.{u2} (Set.{u2} α) (Order.Coframe.toCompleteLattice.{u2} (Set.{u2} α) (CompleteDistribLattice.toCoframe.{u2} (Set.{u2} α) (CompleteBooleanAlgebra.toCompleteDistribLattice.{u2} (Set.{u2} α) (Set.instCompleteBooleanAlgebraSet.{u2} α))))))) f)) -> (Pairwise.{0} Nat (Function.onFun.{1, succ u2, 1} Nat (Set.{u2} α) Prop (Disjoint.{u2} (Set.{u2} α) (CompleteSemilatticeInf.toPartialOrder.{u2} (Set.{u2} α) (CompleteLattice.toCompleteSemilatticeInf.{u2} (Set.{u2} α) (Order.Coframe.toCompleteLattice.{u2} (Set.{u2} α) (CompleteDistribLattice.toCoframe.{u2} (Set.{u2} α) (CompleteBooleanAlgebra.toCompleteDistribLattice.{u2} (Set.{u2} α) (Set.instCompleteBooleanAlgebraSet.{u2} α)))))) (BoundedOrder.toOrderBot.{u2} (Set.{u2} α) (Preorder.toLE.{u2} (Set.{u2} α) (PartialOrder.toPreorder.{u2} (Set.{u2} α) (CompleteSemilatticeInf.toPartialOrder.{u2} (Set.{u2} α) (CompleteLattice.toCompleteSemilatticeInf.{u2} (Set.{u2} α) (Order.Coframe.toCompleteLattice.{u2} (Set.{u2} α) (CompleteDistribLattice.toCoframe.{u2} (Set.{u2} α) (CompleteBooleanAlgebra.toCompleteDistribLattice.{u2} (Set.{u2} α) (Set.instCompleteBooleanAlgebraSet.{u2} α)))))))) (CompleteLattice.toBoundedOrder.{u2} (Set.{u2} α) (Order.Coframe.toCompleteLattice.{u2} (Set.{u2} α) (CompleteDistribLattice.toCoframe.{u2} (Set.{u2} α) (CompleteBooleanAlgebra.toCompleteDistribLattice.{u2} (Set.{u2} α) (Set.instCompleteBooleanAlgebraSet.{u2} α))))))) (fun (i : Nat) => Set.unionᵢ.{u2, succ u1} α β (fun (b : β) => Set.unionᵢ.{u2, 0} α (Membership.mem.{u1, u1} β (Option.{u1} β) (Option.instMembershipOption.{u1} β) b (Encodable.decode₂.{u1} β _inst_1 i)) (fun (H : Membership.mem.{u1, u1} β (Option.{u1} β) (Option.instMembershipOption.{u1} β) b (Encodable.decode₂.{u1} β _inst_1 i)) => f b)))))
Case conversion may be inaccurate. Consider using '#align encodable.Union_decode₂_disjoint_on Encodable.unionᵢ_decode₂_disjoint_onₓ'. -/
theorem unionᵢ_decode₂_disjoint_on {f : β → Set α} (hd : Pairwise (Disjoint on f)) :
    Pairwise (Disjoint on fun i => ⋃ b ∈ decode₂ β i, f b) :=
  by
  rintro i j ij
  refine' disjoint_left.mpr fun x => _
  suffices ∀ a, encode a = i → x ∈ f a → ∀ b, encode b = j → x ∉ f b by simpa [decode₂_eq_some]
  rintro a rfl ha b rfl hb
  exact (hd (mt (congr_arg encode) ij)).le_bot ⟨ha, hb⟩
#align encodable.Union_decode₂_disjoint_on Encodable.unionᵢ_decode₂_disjoint_on

end Encodable


/-
Copyright (c) 2018 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Mario Carneiro
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.computability.partrec_code
import Mathlib.PostPort

universes u_1 u_4 u_2 u_3

namespace Mathlib

/-!
# Computability theory and the halting problem

A universal partial recursive function, Rice's theorem, and the halting problem.

## References

* [Mario Carneiro, *Formalizing computability theory via partial recursive functions*][carneiro2019]
-/

namespace nat.partrec

theorem merge' {f : ℕ →. ℕ} {g : ℕ →. ℕ} (hf : partrec f) (hg : partrec g) : ∃ (h : ℕ →. ℕ),
  partrec h ∧
    ∀ (a : ℕ), (∀ (x : ℕ), x ∈ h a → x ∈ f a ∨ x ∈ g a) ∧ (roption.dom (h a) ↔ roption.dom (f a) ∨ roption.dom (g a)) := sorry

end nat.partrec

namespace partrec

theorem merge' {α : Type u_1} {σ : Type u_4} [primcodable α] [primcodable σ] {f : α →. σ} {g : α →. σ} (hf : partrec f) (hg : partrec g) : ∃ (k : α →. σ),
  partrec k ∧
    ∀ (a : α), (∀ (x : σ), x ∈ k a → x ∈ f a ∨ x ∈ g a) ∧ (roption.dom (k a) ↔ roption.dom (f a) ∨ roption.dom (g a)) := sorry

theorem merge {α : Type u_1} {σ : Type u_4} [primcodable α] [primcodable σ] {f : α →. σ} {g : α →. σ} (hf : partrec f) (hg : partrec g) (H : ∀ (a : α) (x : σ), x ∈ f a → ∀ (y : σ), y ∈ g a → x = y) : ∃ (k : α →. σ), partrec k ∧ ∀ (a : α) (x : σ), x ∈ k a ↔ x ∈ f a ∨ x ∈ g a := sorry

theorem cond {α : Type u_1} {σ : Type u_4} [primcodable α] [primcodable σ] {c : α → Bool} {f : α →. σ} {g : α →. σ} (hc : computable c) (hf : partrec f) (hg : partrec g) : partrec fun (a : α) => cond (c a) (f a) (g a) := sorry

theorem sum_cases {α : Type u_1} {β : Type u_2} {γ : Type u_3} {σ : Type u_4} [primcodable α] [primcodable β] [primcodable γ] [primcodable σ] {f : α → β ⊕ γ} {g : α → β →. σ} {h : α → γ →. σ} (hf : computable f) (hg : partrec₂ g) (hh : partrec₂ h) : partrec fun (a : α) => sum.cases_on (f a) (g a) (h a) := sorry

end partrec

/-- A computable predicate is one whose indicator function is computable. -/
def computable_pred {α : Type u_1} [primcodable α] (p : α → Prop) :=
  Exists (computable fun (a : α) => to_bool (p a))

/-- A recursively enumerable predicate is one which is the domain of a computable partial function.
 -/
def re_pred {α : Type u_1} [primcodable α] (p : α → Prop) :=
  partrec fun (a : α) => roption.assert (p a) fun (_x : p a) => roption.some Unit.unit

theorem computable_pred.of_eq {α : Type u_1} [primcodable α] {p : α → Prop} {q : α → Prop} (hp : computable_pred p) (H : ∀ (a : α), p a ↔ q a) : computable_pred q :=
  (funext fun (a : α) => propext (H a)) ▸ hp

namespace computable_pred

theorem computable_iff {α : Type u_1} [primcodable α] {p : α → Prop} : computable_pred p ↔ ∃ (f : α → Bool), computable f ∧ p = fun (a : α) => ↥(f a) := sorry

protected theorem not {α : Type u_1} [primcodable α] {p : α → Prop} (hp : computable_pred p) : computable_pred fun (a : α) => ¬p a := sorry

theorem to_re {α : Type u_1} [primcodable α] {p : α → Prop} (hp : computable_pred p) : re_pred p := sorry

theorem rice (C : set (ℕ →. ℕ)) (h : computable_pred fun (c : nat.partrec.code) => nat.partrec.code.eval c ∈ C) {f : ℕ →. ℕ} {g : ℕ →. ℕ} (hf : nat.partrec f) (hg : nat.partrec g) (fC : f ∈ C) : g ∈ C := sorry

theorem rice₂ (C : set nat.partrec.code) (H : ∀ (cf cg : nat.partrec.code), nat.partrec.code.eval cf = nat.partrec.code.eval cg → (cf ∈ C ↔ cg ∈ C)) : (computable_pred fun (c : nat.partrec.code) => c ∈ C) ↔ C = ∅ ∨ C = set.univ := sorry

theorem halting_problem (n : ℕ) : ¬computable_pred fun (c : nat.partrec.code) => roption.dom (nat.partrec.code.eval c n) :=
  fun (ᾰ : computable_pred fun (c : nat.partrec.code) => roption.dom (nat.partrec.code.eval c n)) =>
    idRhs ((fun (n : ℕ) => roption.none) ∈ set_of fun (f : ℕ →. ℕ) => roption.dom (f n))
      (rice (set_of fun (f : ℕ →. ℕ) => roption.dom (f n)) ᾰ nat.partrec.zero nat.partrec.none trivial)

-- Post's theorem on the equivalence of r.e., co-r.e. sets and

-- computable sets. The assumption that p is decidable is required

-- unless we assume Markov's principle or LEM.

theorem computable_iff_re_compl_re {α : Type u_1} [primcodable α] {p : α → Prop} [decidable_pred p] : computable_pred p ↔ re_pred p ∧ re_pred fun (a : α) => ¬p a := sorry

end computable_pred

namespace nat

/-- A simplified basis for `partrec`. -/
inductive partrec' : {n : ℕ} → (vector ℕ n →. ℕ) → Prop
where
| prim : ∀ {n : ℕ} {f : vector ℕ n → ℕ}, primrec' f → partrec' ↑f
| comp : ∀ {m n : ℕ} {f : vector ℕ n →. ℕ} (g : fin n → vector ℕ m →. ℕ),
  partrec' f →
    (∀ (i : fin n), partrec' (g i)) → partrec' fun (v : vector ℕ m) => (vector.m_of_fn fun (i : fin n) => g i v) >>= f
| rfind : ∀ {n : ℕ} {f : vector ℕ (n + 1) → ℕ},
  partrec' ↑f → partrec' fun (v : vector ℕ n) => rfind fun (n_1 : ℕ) => roption.some (to_bool (f (n_1::ᵥv) = 0))

end nat

namespace nat.partrec'

theorem to_part {n : ℕ} {f : vector ℕ n →. ℕ} (pf : partrec' f) : partrec f := sorry

theorem of_eq {n : ℕ} {f : vector ℕ n →. ℕ} {g : vector ℕ n →. ℕ} (hf : partrec' f) (H : ∀ (i : vector ℕ n), f i = g i) : partrec' g :=
  funext H ▸ hf

theorem of_prim {n : ℕ} {f : vector ℕ n → ℕ} (hf : primrec f) : partrec' ↑f :=
  prim (primrec'.of_prim hf)

theorem head {n : ℕ} : partrec' ↑vector.head :=
  prim primrec'.head

theorem tail {n : ℕ} {f : vector ℕ n →. ℕ} (hf : partrec' f) : partrec' fun (v : vector ℕ (Nat.succ n)) => f (vector.tail v) := sorry

protected theorem bind {n : ℕ} {f : vector ℕ n →. ℕ} {g : vector ℕ (n + 1) →. ℕ} (hf : partrec' f) (hg : partrec' g) : partrec' fun (v : vector ℕ n) => roption.bind (f v) fun (a : ℕ) => g (a::ᵥv) := sorry

protected theorem map {n : ℕ} {f : vector ℕ n →. ℕ} {g : vector ℕ (n + 1) → ℕ} (hf : partrec' f) (hg : partrec' ↑g) : partrec' fun (v : vector ℕ n) => roption.map (fun (a : ℕ) => g (a::ᵥv)) (f v) := sorry

/-- Analogous to `nat.partrec'` for `ℕ`-valued functions, a predicate for partial recursive
  vector-valued functions.-/
def vec {n : ℕ} {m : ℕ} (f : vector ℕ n → vector ℕ m) :=
  ∀ (i : fin m), partrec' ↑fun (v : vector ℕ n) => vector.nth (f v) i

theorem vec.prim {n : ℕ} {m : ℕ} {f : vector ℕ n → vector ℕ m} (hf : primrec'.vec f) : vec f :=
  fun (i : fin m) => prim (hf i)

protected theorem nil {n : ℕ} : vec fun (_x : vector ℕ n) => vector.nil :=
  fun (i : fin 0) => fin.elim0 i

protected theorem cons {n : ℕ} {m : ℕ} {f : vector ℕ n → ℕ} {g : vector ℕ n → vector ℕ m} (hf : partrec' ↑f) (hg : vec g) : vec fun (v : vector ℕ n) => f v::ᵥg v := sorry

theorem idv {n : ℕ} : vec id :=
  vec.prim primrec'.idv

theorem comp' {n : ℕ} {m : ℕ} {f : vector ℕ m →. ℕ} {g : vector ℕ n → vector ℕ m} (hf : partrec' f) (hg : vec g) : partrec' fun (v : vector ℕ n) => f (g v) := sorry

theorem comp₁ {n : ℕ} (f : ℕ →. ℕ) {g : vector ℕ n → ℕ} (hf : partrec' fun (v : vector ℕ 1) => f (vector.head v)) (hg : partrec' ↑g) : partrec' fun (v : vector ℕ n) => f (g v) := sorry

theorem rfind_opt {n : ℕ} {f : vector ℕ (n + 1) → ℕ} (hf : partrec' ↑f) : partrec' fun (v : vector ℕ n) => rfind_opt fun (a : ℕ) => denumerable.of_nat (Option ℕ) (f (a::ᵥv)) := sorry

theorem of_part {n : ℕ} {f : vector ℕ n →. ℕ} : partrec f → partrec' f := sorry

theorem part_iff {n : ℕ} {f : vector ℕ n →. ℕ} : partrec' f ↔ partrec f :=
  { mp := to_part, mpr := of_part }

theorem part_iff₁ {f : ℕ →. ℕ} : (partrec' fun (v : vector ℕ 1) => f (vector.head v)) ↔ partrec f := sorry

theorem part_iff₂ {f : ℕ → ℕ →. ℕ} : (partrec' fun (v : vector ℕ (bit0 1)) => f (vector.head v) (vector.head (vector.tail v))) ↔ partrec₂ f := sorry

theorem vec_iff {m : ℕ} {n : ℕ} {f : vector ℕ m → vector ℕ n} : vec f ↔ computable f := sorry


import .defs
import .metric
import data.enat.basic
import tactic.basic

universes u v w

variables {V V' V'' : Type u} (G : simple_graph V) (G' : simple_graph V') (G'' : simple_graph V'')

open simple_graph

@[reducible]
def coarse_lipschitz_with (K : ℕ∞) (C : ℕ) (f : V → V') :=
  ∀ ⦃x y : V⦄, ∀ ⦃a : ℕ∞⦄, G.edist x y < a → G'.edist (f x) (f y) < K * a + C

def coarse_equal_with (K : ℕ∞) (f g : V → V'):=
  ∀ x : V, G'.edist (f x) (g x) < K

namespace coarse_lipschitz

variables {G} {G'}

-- can be derived from `hom`
protected theorem id : coarse_lipschitz_with G G 1 0 id := by {
  simp [coarse_lipschitz_with],
}

theorem hom (φ : G →g G') : coarse_lipschitz_with G G' 1 0 φ := by {
  intros x y a h,
  cases le_iff_lt_or_eq.mp (simple_graph.hom.edist_le φ x y) with
    hedist_lt hedist_eq,
  { simp only [one_mul, algebra_map.coe_zero, add_zero],
    exact lt_trans hedist_lt h, },
  { simp only [h, hedist_eq, one_mul, algebra_map.coe_zero, add_zero], }}

theorem mono {f : V → V'} {K K' : ℕ∞} {C C' : ℕ} (hK : K ≤ K') (hC : C ≤ C')
  (hf : coarse_lipschitz_with G G' K C f)
  : coarse_lipschitz_with G G' K' C' f := by {
    rw [coarse_lipschitz_with],
    intros x y a hdist,
    refine lt_of_le_of_lt' _ (hf hdist),
    exact add_le_add (enat.mul_right_le hK) (with_top.coe_mono hC),
  }

theorem comp (f : V → V') (g : V' → V'')
  {K K' : ℕ∞} {C C' : ℕ}
  (hf : coarse_lipschitz_with G G' K C f) (hg : coarse_lipschitz_with G' G'' K' C' g)
  : coarse_lipschitz_with G G'' (K' * K) (K'.to_nat * C + C') (g ∘ f) := by {
    intros _ _ a hdist,
    refine lt_of_le_of_lt' _ (hg (hf hdist)),
    rw [enat.coe_add, ← add_assoc, mul_add, ← mul_assoc, enat.coe_mul],
    refine add_le_add _ (le_refl _),
    by_cases h : K' = ⊤,
    { subst h,
      simp only [enat.top_mul_left, enat.top_add_left, top_le_iff], },
    { rw [(enat.coe_to_nat_eq_self).mpr h],
      exact le_refl _, }
  }

def infty_wlog {P : (V → V') → Sort*} (C : ℕ) :
  (∀ (f : V → V') (hf : coarse_lipschitz_with G G' ⊤ C f), P f) →
  (∀ (f : V → V') (K : ℕ∞) (hf : coarse_lipschitz_with G G' K C f), P f) :=
begin
  intros h f K hf,
  apply h,
  exact mono le_top (le_refl _) hf,
end

theorem infty_iff (f : V → V') {C : ℕ} :
  (coarse_lipschitz_with G G' ⊤ C f) ↔ (∀ x y : V, G.reachable x y → G'.reachable (f x) (f y)) := by {
    simp_rw [simple_graph.reachable_iff_edist_lt_top],
    split,
    { intros hcoarse x y hdist,
      refine lt_of_le_of_lt' _ (hcoarse hdist),
      simp only [enat.top_mul_right, enat.top_add_left, top_le_iff],
    },
    { intros hreach _ _ _ hdist,
      simp only [enat.top_mul_left, enat.top_add_left],
      apply hreach,
      exact lt_of_le_of_lt' le_top hdist,
     }
  }

def out_restrict {f : V → V'} {k : ℕ∞} {c : ℕ} (hf : coarse_lipschitz_with G G' k c f) (K : set V) :
  coarse_lipschitz_with (G.induce Kᶜ) G' k c (f ∘ subtype.val) := by {
    intros x y a hdist,
    apply hf,
    refine lt_of_le_of_lt _ hdist,
    rw [G.val_of_out_val_hom, G.val_of_out_val_hom],
    apply hom.edist_le, }

-- the "relative" version of `out_restrict`
def out'_restrict {K K' : set V} (h : K ⊆ K') {f : ↥(K)ᶜ → V'} {k : ℕ∞} {c : ℕ}
  (hf : coarse_lipschitz_with (G.out K) G' k c f) :
    coarse_lipschitz_with (G.out K') G' k c (f ∘ (simple_graph.out_hom G h).to_fun) := by {
      intros x y a hdist,
      apply hf,
      exact lt_of_le_of_lt (hom.edist_le (G.out_hom h) x y) hdist, }

def expand_out {L L' : set V'} (h : L ⊆ L') {f : V → ↥L'ᶜ} {k : ℕ∞} {c : ℕ}
  (hf : coarse_lipschitz_with G (G'.out L') k c f) :
  coarse_lipschitz_with G (G'.out L) k c ((induce_out id h) ∘ f) :=
  -- TODO maybe replace `induce_out id h`
    by { intros _ _ a hdist,
      exact lt_of_le_of_lt (hom.edist_le (induce_out_hom hom.id h) (f x) (f y)) (hf hdist), }

def comp_map {f : V → V'} {k : ℕ∞} {c : ℕ} (hf : coarse_lipschitz_with G G' k c f) :
  G.connected_component → G'.connected_component :=
    simple_graph.connected_component.lift (λ v, G'.connected_component_mk (f v)) (by {
      intros _ _ p _,
      rw simple_graph.connected_component.eq,
      apply (infty_iff f).mp,
      refine mono le_top (nat.le_refl c) hf,
      exact nonempty.intro p, })

-- this could potentially be stated better using an "absolute" rather than a "relative" perspective
theorem up_comp {K K' : set V} (h : K ⊆ K') {f : ↥(K)ᶜ → V'} {k : ℕ∞} {c : ℕ}
  (hf : coarse_lipschitz_with (G.out K) G' k c f) (C : G.comp_out K') :
    comp_map hf (C.hom h) = comp_map (out'_restrict h hf) C := by {
      refine C.ind _,
      intros _ _,
      dsimp [comp_out.hom, connected_component.map, comp_map],
      congr, }

theorem comp_down {L L' : finset V'} (h : L ⊆ L') {f : V → ↥(↑L')ᶜ} {k : ℕ∞} {c : ℕ}
  (hf : coarse_lipschitz_with G (G'.out L') k c f) {C : G.connected_component} :
    comp_out.hom h (comp_map hf C) = (comp_map (expand_out h hf) C) := by {
      refine C.ind _,
      intro _,
      dsimp [comp_out.hom, connected_component.map, comp_map],
      congr,
      apply subtype.eq,
      simp, }

end coarse_lipschitz

def induce_out (f : V → V') {K : set V} {L : set V'} (h : f⁻¹' L ⊆ K) : Kᶜ → Lᶜ :=
  λ ⟨k, hk⟩, ⟨f k, λ hL, hk (h hL)⟩

/-- The kind of map between graphs which induces a map on the ends. -/
structure coarse_map {V V' : Type u} (G : simple_graph V) (G' : simple_graph V') (φ : V → V') :=
  (κ : ℕ∞) (C : ℕ)
  (finset_mapping : finset V' → finset V)
  (finset_inv_sub : ∀ L : finset V', φ ⁻¹' (L : set V') ⊆ (finset_mapping L : set V))
  (induced_coarse_lipschitz : ∀ L : finset V',
    coarse_lipschitz_with (G.induce (finset_mapping L)ᶜ) (G'.induce Lᶜ)
      κ C (induce_out φ (finset_inv_sub L)))

-- TODO maybe there can be a parametrized structure "lifting" any property of homomorphisms
-- to its coarse version
structure coarse_close {V V' : Type u} (G : simple_graph V) (G' : simple_graph V') (f g : V → V') :=
  (κ : ℕ∞)
  (finset_mapping : finset V' → finset V)
  (finset_inv_subl : ∀ L : finset V', f⁻¹' (L : set V') ⊆ (finset_mapping L : set V))
  (finset_inv_subr : ∀ L : finset V', g⁻¹' (L : set V') ⊆ (finset_mapping L : set V))
  (induced_coarse_equal : ∀ L : finset V', coarse_equal_with (G'.induce Lᶜ) κ
    (induce_out f (finset_inv_subl L)) (induce_out g (finset_inv_subr L)))

variables {G} {G'}

-- TODO Move this to `defs`
lemma end_back {K K' : (finset V)ᵒᵖ} (h : K.unop ⊆ K'.unop) (e : G.end) :
  e.val K = (e.val K').hom h := by {
    symmetry,
    exact e.property (category_theory.op_hom_of_le h),  }

def coarse_map.end_map [decidable_eq V] {f : V → V'} (fcoarse : coarse_map G G' f) : G.end → G'.end := by
  {
    rintro e,
    refine ⟨λ L, _, _⟩,
    let comp_map := coarse_lipschitz.comp_map (fcoarse.induced_coarse_lipschitz L.unop),
    apply comp_map,
    let Gcomp := e.val (opposite.op $ fcoarse.finset_mapping L.unop),
    exact Gcomp,
    { intros L L' hLL',
      let K : (finset V)ᵒᵖ := opposite.op (
        (fcoarse.finset_mapping L.unop) ∪ (fcoarse.finset_mapping L'.unop)),
      have hL : (opposite.op $ fcoarse.finset_mapping L.unop).unop ⊆ K.unop := by {
        simp only [opposite.unop_op], apply finset.subset_union_left, },
      have hL' : (opposite.op $ fcoarse.finset_mapping L'.unop).unop ⊆ K.unop := by {
        simp only [opposite.unop_op], apply finset.subset_union_right, },
      dsimp,
      rw [← subtype.val_eq_coe,
      end_back hL e, end_back hL' e,
      coarse_lipschitz.up_comp, coarse_lipschitz.up_comp],
      dsimp [comp_out_functor],
      rw [coarse_lipschitz.comp_down],
      refl,
    },
  }

def coarse_close.left_coarse_map {f g : V → V'} (hclose : coarse_close G G' f g) : coarse_map G G' f :=
{ κ := hclose.κ,
  C := 0,
  finset_mapping := hclose.finset_mapping,
  finset_inv_sub := hclose.finset_inv_subl,
  induced_coarse_lipschitz := by {
    intro L,
    unfold coarse_lipschitz_with,
    have := hclose.induced_coarse_equal L,
    unfold coarse_equal_with at this,
    sorry -- seems impossible, more assumptions needed
  } }

def coarse_close.right_coarse_map {f g : V → V'} (hclose : coarse_close G G' f g) : coarse_map G G' g := sorry

private lemma well_separated (G : simple_graph V) (Gpc : G.preconnected) (K : finset V) (m : ℕ)
  (C : G.comp_out K)
  (c : V) (cC : c ∈ C) (c' : V) :
  c ∉ (G.closed_neighborhood K m) → G.edist c c' ≤ m → c' ∈ C :=
begin
  rintro cnK,
  sorry,
/-rintro cnK,
  obtain ⟨w,wm⟩ := reachable.exists_walk_of_dist (Gpc c c'), rw ←wm,
  rintro hwm,
  have wdisK : disjoint (w.support.to_finset : set V) K, by {
    rw finset.disjoint_coe,
    by_contradiction h, rw finset.not_disjoint_iff at h,
    obtain ⟨x,xw,xK⟩ := h,
    rw [list.mem_to_finset,walk.mem_support_iff_exists_append] at xw,
    obtain ⟨cx,_,rfl⟩ := xw,
    apply cnK,
    dsimp only [thicken_],
    simp only [finite.mem_to_finset, mem_set_of_eq, exists_prop],
    use [x,xK],
    apply (dist_le cx).trans,
    refine le_trans _ hwm,
    simp only [length_append, le_add_iff_nonneg_right, zero_le'],},

  let Cw := comp_out.of_connected_disjoint (w.support.to_finset : set V) (connected.walk_support w) wdisK.symm,
  have : C = Cw, by
  { apply comp_out.eq_of_not_disjoint,
    rw set.not_disjoint_iff,
    use [c,cC],
    apply comp_out.of_connected_disjoint_sub,
    simp only [mem_coe, list.mem_to_finset, start_mem_support],},
  rw this,
  apply comp_out.of_connected_disjoint_sub,
  simp only [mem_coe, list.mem_to_finset, end_mem_support], -/
end

def coarse_equal.of_coarse_close [decidable_eq V] {f g : V → V'} {k : ℕ∞}
  (fcoarse : coarse_map G G' f) (gcoarse : coarse_map G G' g)
  (close : coarse_equal_with G' k f g)  : coarse_close G G' f g :=
  sorry -- TODO

def coarse_equal.end_equal [decidable_eq V] {f g : V → V'} {k : ℕ∞}
  (fcoarse : coarse_map G G' f) (gcoarse : coarse_map G G' g)
  (close : coarse_equal_with G' k f g) :
  coarse_map.end_map fcoarse = coarse_map.end_map gcoarse := by {
    dsimp [coarse_map.end_map],
    ext e L,
    dsimp,
    let K : (finset V)ᵒᵖ := opposite.op (
        (fcoarse.finset_mapping L.unop) ∪ (gcoarse.finset_mapping L.unop)),
    have hfL : (opposite.op $ fcoarse.finset_mapping L.unop).unop ⊆ K.unop := sorry,
    have hgL : (opposite.op $ gcoarse.finset_mapping L.unop).unop ⊆ K.unop := sorry,
    rw [← subtype.val_eq_coe,
    end_back hfL e, end_back hgL e,
    coarse_lipschitz.up_comp, coarse_lipschitz.up_comp],

    generalize : e.val K = C,
    refine C.ind _,
    intros v hv,
    dsimp [coarse_lipschitz.comp_map],
    rw [simple_graph.connected_component.eq, simple_graph.reachable_iff_edist_ne_top],
    dsimp [induce_out],
    have hyp := (coarse_equal.of_coarse_close fcoarse gcoarse close).induced_coarse_equal L.unop
      ⟨v, sorry⟩,
    dsimp [induce_out, coarse_equal_with] at hyp,
    sorry, -- need `coarse_close`, not just `coarse_equal`
  }


def f (x : Nat) : IO Nat := do
IO.println "hello world"
let aux (y : Nat) (z : Nat) : IO Nat := do
  IO.println "aux started"
  IO.println s!"y: {y}, z: {z}"
  pure (x+y)
discard <| aux x
  (x + 1) -- It is part of the application since it is indented
discard <| aux x (x -- parentheses use `withoutPosition`
-1)
discard <| aux x x;
  aux x
 x

#eval f 10

def g (xs : List Nat) : StateT Nat Id Nat := do
let mut xs := xs
if xs.isEmpty then
  xs := [← get]
dbg_trace ">>> xs: {xs}"
return xs.length

#eval g [1, 2, 3] |>.run' 10
#eval g [] |>.run' 10

theorem ex1 : (g [1, 2, 4, 5] |>.run' 0) = 4 :=
rfl

theorem ex2 : (g [] |>.run' 0) = 1 :=
rfl

def h (x : Nat) (y : Nat) : Nat := do
let mut x := x
let mut y := y
if x > 0 then
  let y' := x + 1
  x := y'
else
  y := y + 1
return x + y

theorem ex3 (y : Nat) : h 0 y = 0 + (y + 1) :=
rfl

theorem ex4 (y : Nat) : h 1 y = (1 + 1) + y :=
rfl

def sumOdd (xs : List Nat) (threshold : Nat) : Nat := do
let mut sum := 0
for x in xs do
  if x % 2 == 1 then
    sum := sum + x
  if sum > threshold then
    break
  unless x % 2 == 1 do
    continue
  dbg_trace ">> x: {x}"
return sum

#eval sumOdd [1, 2, 3, 4, 5, 6, 7, 9, 11, 101] 10

theorem ex5 : sumOdd [1, 2, 3, 4, 5, 6, 7, 9, 11, 101] 10 = 16 :=
rfl

-- We need `Id.run` because we still have `Monad Option`
def find? (xs : List Nat) (p : Nat → Bool) : Option Nat := Id.run do
let mut result := none
for x in xs do
  if p x then
    result := x
    break
return result

def sumDiff (ps : List (Nat × Nat)) : Nat := do
let mut sum := 0
for (x, y) in ps do
  sum := sum + x - y
return sum

theorem ex7 : sumDiff [(2, 1), (10, 5)] = 6 :=
rfl

def f1 (x : Nat) : IO Unit := do
let rec loop : Nat → IO Unit
  | 0   => pure ()
  | x+1 => do IO.println x; loop x
loop x

#eval f1 10

partial def f2 (x : Nat) : IO Unit := do
let rec
  isEven : Nat → Bool
    | 0   => true
    | x+1 => isOdd x,
  isOdd : Nat → Bool
    | 0   => false
    | x+1 => isEven x
IO.println ("isOdd(" ++ toString x ++ "): " ++ toString (isOdd x))

#eval f2 11
#eval f2 10

def split (xs : List Nat) : List Nat × List Nat := do
let mut evens := []
let mut odds  := []
for x in xs.reverse do
  if x % 2 == 0 then
    evens := x :: evens
  else
    odds := x :: odds
return (evens, odds)

theorem ex8 : split [1, 2, 3, 4] = ([2, 4], [1, 3]) :=
rfl

def f3 (x : Nat) : IO Bool := do
let y ← cond (x == 0) (do IO.println "hello"; true) false;
!y

def f4 (x y : Nat) : Nat × Nat := do
  let mut (x, y) := (x, y)
  match x with
  | 0 => y := y + 1
  | _ => x := x + y
  return (x, y)

#eval f4 0 10
#eval f4 5 10

theorem ex9 (y : Nat) : f4 0 y = (0, y+1) :=
rfl

theorem ex10 (x y : Nat) : f4 (x+1) y = ((x+1)+y, y) :=
rfl

def f5 (x y : Nat) : Nat × Nat := do
  let mut (x, y) := (x, y)
  match x with
  | 0   => y := y + 1
  | z+1 => dbg_trace "z: {z}"; x := x + y
  return (x, y)

#eval f5 5 6

theorem ex11 (x y : Nat) : f5 (x+1) y = ((x+1)+y, y) :=
rfl

def f6 (x : Nat) : Nat := do
  let mut x := x
  if x > 10 then
    return 0
  x := x + 1
  return x

theorem ex12 : f6 11 = 0 :=
rfl

theorem ex13 : f6 5 = 6 :=
rfl

def findOdd (xs : List Nat) : Nat := do
for x in xs do
  if x % 2 == 1 then
    return x
return 0

theorem ex14 : findOdd [2, 4, 5, 8, 7] = 5 :=
rfl

theorem ex15 : findOdd [2, 4, 8, 10] = 0 :=
rfl

def f7 (ref : IO.Ref (Option (Nat × Nat))) : IO Nat := do
let some (x, y) ← ref.get | pure 100
IO.println (toString x ++ ", " ++ toString y)
return x+y

def f7Test : IO Unit := do
unless (← f7 (← IO.mkRef (some (10, 20)))) == 30 do throw $ IO.userError "unexpected"
unless (← f7 (← IO.mkRef none)) == 100 do throw $ IO.userError "unexpected"

#eval f7Test

def f8 (x : Nat) : IO Nat := do
let y ←
  if x == 0 then
    IO.println "x is zero"
    return 100 --  returns from the `do`-block
  else
    pure (x + 1)
IO.println ("y: " ++ toString y)
return y

def f8Test : IO Unit := do
unless (← f8 0) == 100 do throw $ IO.userError "unexpected"
unless (← f8 1) == 2 do throw $ IO.userError "unexpected"

#eval f8Test


example {a : Type u} {s t : list α} : length (s ++ t) = length s + length t :=
list.rec_on s
(
    -- length t = length [] + length t
    -- length [] = 0 by definition
    -- 0 + x = x by definition
    show length ([] ++ t) = length [] + length t, from
    begin
        have z : [] ++ t = t, from rfl,
        rw z,
        have g : length [] = 0, from rfl,
        assumption,
        rw g,
        rw zero_add,
    end
)
(
    λ x y z,
    -- z : length (y ++ t) = length y + length t
    show length (x :: y ++ t) = length (x :: y) + length t, from
    begin
        show length (x :: y ++ t) = ((length y) + 1) + length t,
        have r : length (x :: y) = ((length y) + 1), refl,
        -- unfinished
    end
)


import category_theory.limits.shapes.finite_products

noncomputable theory

namespace category_theory

open category

namespace limits

section

variables {J₁ J₂ C : Type*} [category C] (X : J₂ → C) [has_product X] (e : J₁ ≃ J₂)

def fan_of_equiv : fan (X ∘ e) := fan.mk (∏ X)
(λ j, pi.π _ (e j))

@[simp]
lemma fan_of_equiv_proj (j : J₁) : (fan_of_equiv X e).proj j = pi.π _ (e j) := rfl

lemma fan.congr_proj {J : Type*} {F : J → C} (s : fan F)
  {j₁ j₂ : J} (h : j₁ = j₂) : s.proj j₁ ≫ eq_to_hom (by rw h) = s.proj j₂ :=
by { subst h, rw [eq_to_hom_refl, comp_id], }

lemma cone.congr_π {J : Type*} [category J] {F : J ⥤ C} (s : cone F)
  {j₁ j₂ : J} (h : j₁ = j₂) : s.π.app j₁ ≫ eq_to_hom (by rw h) = (s.π.app j₂ : s.X ⟶ _) :=
by { subst h, rw [eq_to_hom_refl, comp_id], }

lemma is_limit_fan_of_equiv : is_limit (fan_of_equiv X e) :=
mk_fan_limit _ (λ s, pi.lift (λ j₂,s.proj (e.symm j₂) ≫ eq_to_hom (by simp)))
(λ s j, begin
  simp only [fan_of_equiv_proj, limit.lift_π, fan.mk_π_app],
  exact fan.congr_proj _ (by simp),
end)
(λ s m hm, begin
  ext j₂,
  discrete_cases,
  simp only [limit.lift_π, fan.mk_π_app, ← hm, assoc],
  congr' 1,
  dsimp,
  symmetry,
  have h : discrete.mk (e (e.symm j₂)) = discrete.mk j₂ := by simp,
  apply cone.congr_π _ h,
end)

lemma has_product_of_equiv : has_product (X ∘ e) :=
⟨nonempty.intro ⟨_, is_limit_fan_of_equiv X e⟩⟩

lemma product_iso_of_equiv [has_product (X ∘ e)] : ∏ (X ∘ e) ≅ ∏ X :=
is_limit.cone_point_unique_up_to_iso (limit.is_limit _) (is_limit_fan_of_equiv X e)

end

lemma product_iso_option {C J : Type*} [category C]
  (X : option J → C) [has_product X] [has_product (λ j, X (some j))]
  [has_binary_product (∏ (λ j, X (some j))) (X none)] :
  (∏ X) ≅ (∏ (λ j, X (some j))) ⨯ (X none) :=
{ hom := limits.prod.lift (pi.lift (λ j, pi.π _ (some j))) (pi.π _ none),
  inv := pi.lift (by { rintro (_|j), exacts [prod.snd, prod.fst ≫ pi.π _ j], } ),
  hom_inv_id' := begin
    ext,
    discrete_cases,
    rcases j with (_|j),
    { simp only [assoc, limit.lift_π, fan.mk_π_app, prod.lift_snd, id_comp], },
    { simp only [assoc, limit.lift_π, fan.mk_π_app, prod.lift_fst_assoc, id_comp], },
  end,
  inv_hom_id' := begin
    ext j,
    { discrete_cases,
      simp only [limit.lift_π, fan.mk_π_app, prod.lift_fst, assoc, id_comp], },
    { simp only [prod.comp_lift, limit.lift_π, fan.mk_π_app, prod.lift_snd, id_comp], },
  end, }

end limits

end category_theory