/-
Copyright (c) 2019 Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sébastien Gouëzel
-/
import data.set.function
import logic.equiv.defs

/-!
# Local equivalences

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

This files defines equivalences between subsets of given types.
An element `e` of `local_equiv α β` is made of two maps `e.to_fun` and `e.inv_fun` respectively
from α to β and from  β to α (just like equivs), which are inverse to each other on the subsets
`e.source` and `e.target` of respectively α and β.

They are designed in particular to define charts on manifolds.

The main functionality is `e.trans f`, which composes the two local equivalences by restricting
the source and target to the maximal set where the composition makes sense.

As for equivs, we register a coercion to functions and use it in our simp normal form: we write
`e x` and `e.symm y` instead of `e.to_fun x` and `e.inv_fun y`.

## Main definitions

`equiv.to_local_equiv`: associating a local equiv to an equiv, with source = target = univ
`local_equiv.symm`    : the inverse of a local equiv
`local_equiv.trans`   : the composition of two local equivs
`local_equiv.refl`    : the identity local equiv
`local_equiv.of_set`  : the identity on a set `s`
`eq_on_source`        : equivalence relation describing the "right" notion of equality for local
                        equivs (see below in implementation notes)

## Implementation notes

There are at least three possible implementations of local equivalences:
* equivs on subtypes
* pairs of functions taking values in `option α` and `option β`, equal to none where the local
equivalence is not defined
* pairs of functions defined everywhere, keeping the source and target as additional data

Each of these implementations has pros and cons.
* When dealing with subtypes, one still need to define additional API for composition and
restriction of domains. Checking that one always belongs to the right subtype makes things very
tedious, and leads quickly to DTT hell (as the subtype `u ∩ v` is not the "same" as `v ∩ u`, for
instance).
* With option-valued functions, the composition is very neat (it is just the usual composition, and
the domain is restricted automatically). These are implemented in `pequiv.lean`. For manifolds,
where one wants to discuss thoroughly the smoothness of the maps, this creates however a lot of
overhead as one would need to extend all classes of smoothness to option-valued maps.
* The local_equiv version as explained above is easier to use for manifolds. The drawback is that
there is extra useless data (the values of `to_fun` and `inv_fun` outside of `source` and `target`).
In particular, the equality notion between local equivs is not "the right one", i.e., coinciding
source and target and equality there. Moreover, there are no local equivs in this sense between
an empty type and a nonempty type. Since empty types are not that useful, and since one almost never
needs to talk about equal local equivs, this is not an issue in practice.
Still, we introduce an equivalence relation `eq_on_source` that captures this right notion of
equality, and show that many properties are invariant under this equivalence relation.

### Local coding conventions

If a lemma deals with the intersection of a set with either source or target of a `local_equiv`,
then it should use `e.source ∩ s` or `e.target ∩ t`, not `s ∩ e.source` or `t ∩ e.target`.

-/

mk_simp_attribute mfld_simps "The simpset `mfld_simps` records several simp lemmas that are
especially useful in manifolds. It is a subset of the whole set of simp lemmas, but it makes it
possible to have quicker proofs (when used with `squeeze_simp` or `simp only`) while retaining
readability.

The typical use case is the following, in a file on manifolds:
If `simp [foo, bar]` is slow, replace it with `squeeze_simp [foo, bar] with mfld_simps` and paste
its output. The list of lemmas should be reasonable (contrary to the output of
`squeeze_simp [foo, bar]` which might contain tens of lemmas), and the outcome should be quick
enough.
"

-- register in the simpset `mfld_simps` several lemmas that are often useful when dealing
-- with manifolds
attribute [mfld_simps] id.def function.comp.left_id set.mem_set_of_eq set.image_eq_empty
set.univ_inter set.preimage_univ set.prod_mk_mem_set_prod_eq and_true set.mem_univ
set.mem_image_of_mem true_and set.mem_inter_iff set.mem_preimage function.comp_app
set.inter_subset_left set.mem_prod set.range_id set.range_prod_map and_self set.mem_range_self
eq_self_iff_true forall_const forall_true_iff set.inter_univ set.preimage_id function.comp.right_id
not_false_iff and_imp set.prod_inter_prod set.univ_prod_univ true_or or_true prod.map_mk
set.preimage_inter heq_iff_eq equiv.sigma_equiv_prod_apply equiv.sigma_equiv_prod_symm_apply
subtype.coe_mk equiv.to_fun_as_coe equiv.inv_fun_as_coe

/-- Common `@[simps]` configuration options used for manifold-related declarations. -/
def mfld_cfg : simps_cfg := {attrs := [`simp, `mfld_simps], fully_applied := ff}

namespace tactic.interactive

/-- A very basic tactic to show that sets showing up in manifolds coincide or are included in
one another. -/
meta def mfld_set_tac : tactic unit := do
  goal ← tactic.target,
  match goal with
  | `(%%e₁ = %%e₂) :=
      `[ext my_y,
        split;
        { assume h_my_y,
          try { simp only [*, -h_my_y] with mfld_simps at h_my_y },
          simp only [*] with mfld_simps }]
  | `(%%e₁ ⊆ %%e₂) :=
      `[assume my_y h_my_y,
        try { simp only [*, -h_my_y] with mfld_simps at h_my_y },
        simp only [*] with mfld_simps]
  | _ := tactic.fail "goal should be an equality or an inclusion"
  end

end tactic.interactive

open function set

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

/-- Local equivalence between subsets `source` and `target` of α and β respectively. The (global)
maps `to_fun : α → β` and `inv_fun : β → α` map `source` to `target` and conversely, and are inverse
to each other there. The values of `to_fun` outside of `source` and of `inv_fun` outside of `target`
are irrelevant. -/
structure local_equiv (α : Type*) (β : Type*) :=
(to_fun      : α → β)
(inv_fun     : β → α)
(source      : set α)
(target      : set β)
(map_source' : ∀ {{x}}, x ∈ source → to_fun x ∈ target)
(map_target' : ∀ {{x}}, x ∈ target → inv_fun x ∈ source)
(left_inv'   : ∀ {{x}}, x ∈ source → inv_fun (to_fun x) = x)
(right_inv'  : ∀ {{x}}, x ∈ target → to_fun (inv_fun x) = x)

namespace local_equiv

variables (e : local_equiv α β) (e' : local_equiv β γ)

instance [inhabited α] [inhabited β] : inhabited (local_equiv α β) :=
⟨⟨const α default, const β default, ∅, ∅, maps_to_empty _ _, maps_to_empty _ _,
  eq_on_empty _ _, eq_on_empty _ _⟩⟩

/-- The inverse of a local equiv -/
protected def symm : local_equiv β α :=
{ to_fun     := e.inv_fun,
  inv_fun    := e.to_fun,
  source     := e.target,
  target     := e.source,
  map_source' := e.map_target',
  map_target' := e.map_source',
  left_inv'   := e.right_inv',
  right_inv'  := e.left_inv' }

instance : has_coe_to_fun (local_equiv α β) (λ _, α → β) := ⟨local_equiv.to_fun⟩

/-- See Note [custom simps projection] -/
def simps.symm_apply (e : local_equiv α β) : β → α := e.symm

initialize_simps_projections local_equiv (to_fun → apply, inv_fun → symm_apply)

@[simp, mfld_simps] theorem coe_mk (f : α → β) (g s t ml mr il ir) :
  (local_equiv.mk f g s t ml mr il ir : α → β) = f := rfl

@[simp, mfld_simps] theorem coe_symm_mk (f : α → β) (g s t ml mr il ir) :
  ((local_equiv.mk f g s t ml mr il ir).symm : β → α) = g := rfl

@[simp, mfld_simps] lemma to_fun_as_coe : e.to_fun = e := rfl

@[simp, mfld_simps] lemma inv_fun_as_coe : e.inv_fun = e.symm := rfl

@[simp, mfld_simps] lemma map_source {x : α} (h : x ∈ e.source) : e x ∈ e.target :=
e.map_source' h

@[simp, mfld_simps] lemma map_target {x : β} (h : x ∈ e.target) : e.symm x ∈ e.source :=
e.map_target' h

@[simp, mfld_simps] lemma left_inv {x : α} (h : x ∈ e.source) : e.symm (e x) = x :=
e.left_inv' h

@[simp, mfld_simps] lemma right_inv {x : β} (h : x ∈ e.target) : e (e.symm x) = x :=
e.right_inv' h

lemma eq_symm_apply {x : α} {y : β} (hx : x ∈ e.source) (hy : y ∈ e.target) :
  x = e.symm y ↔ e x = y :=
⟨λ h, by rw [← e.right_inv hy, h], λ h, by rw [← e.left_inv hx, h]⟩

protected lemma maps_to : maps_to e e.source e.target := λ x, e.map_source
lemma symm_maps_to : maps_to e.symm e.target e.source := e.symm.maps_to
protected lemma left_inv_on : left_inv_on e.symm e e.source := λ x, e.left_inv
protected lemma right_inv_on : right_inv_on e.symm e e.target := λ x, e.right_inv
protected lemma inv_on : inv_on e.symm e e.source e.target := ⟨e.left_inv_on, e.right_inv_on⟩
protected lemma inj_on : inj_on e e.source := e.left_inv_on.inj_on
protected lemma bij_on : bij_on e e.source e.target := e.inv_on.bij_on e.maps_to e.symm_maps_to
protected lemma surj_on : surj_on e e.source e.target := e.bij_on.surj_on

/-- Associating a local_equiv to an equiv-/
@[simps (mfld_cfg)] def _root_.equiv.to_local_equiv (e : α ≃ β) : local_equiv α β :=
{ to_fun      := e,
  inv_fun     := e.symm,
  source      := univ,
  target      := univ,
  map_source' := λx hx, mem_univ _,
  map_target' := λy hy, mem_univ _,
  left_inv'   := λx hx, e.left_inv x,
  right_inv'  := λx hx, e.right_inv x }

instance inhabited_of_empty [is_empty α] [is_empty β] : inhabited (local_equiv α β) :=
⟨((equiv.equiv_empty α).trans (equiv.equiv_empty β).symm).to_local_equiv⟩

/-- Create a copy of a `local_equiv` providing better definitional equalities. -/
@[simps {fully_applied := ff}]
def copy (e : local_equiv α β) (f : α → β) (hf : ⇑e = f) (g : β → α) (hg : ⇑e.symm = g)
  (s : set α) (hs : e.source = s) (t : set β) (ht : e.target = t) :
  local_equiv α β :=
{ to_fun := f,
  inv_fun := g,
  source := s,
  target := t,
  map_source' := λ x, ht ▸ hs ▸ hf ▸ e.map_source,
  map_target' := λ y, hs ▸ ht ▸ hg ▸ e.map_target,
  left_inv' := λ x, hs ▸ hf ▸ hg ▸ e.left_inv,
  right_inv' := λ x, ht ▸ hf ▸ hg ▸ e.right_inv }

lemma copy_eq (e : local_equiv α β) (f : α → β) (hf : ⇑e = f) (g : β → α) (hg : ⇑e.symm = g)
  (s : set α) (hs : e.source = s) (t : set β) (ht : e.target = t) :
  e.copy f hf g hg s hs t ht = e :=
by { substs f g s t, cases e, refl }

/-- Associating to a local_equiv an equiv between the source and the target -/
protected def to_equiv : equiv (e.source) (e.target) :=
{ to_fun    := λ x, ⟨e x, e.map_source x.mem⟩,
  inv_fun   := λ y, ⟨e.symm y, e.map_target y.mem⟩,
  left_inv  := λ⟨x, hx⟩, subtype.eq $ e.left_inv hx,
  right_inv := λ⟨y, hy⟩, subtype.eq $ e.right_inv hy }

@[simp, mfld_simps] lemma symm_source : e.symm.source = e.target := rfl
@[simp, mfld_simps] lemma symm_target : e.symm.target = e.source := rfl
@[simp, mfld_simps] lemma symm_symm : e.symm.symm = e := by { cases e, refl }

lemma image_source_eq_target : e '' e.source = e.target := e.bij_on.image_eq

lemma forall_mem_target {p : β → Prop} : (∀ y ∈ e.target, p y) ↔ ∀ x ∈ e.source, p (e x) :=
by rw [← image_source_eq_target, ball_image_iff]

lemma exists_mem_target {p : β → Prop} : (∃ y ∈ e.target, p y) ↔ ∃ x ∈ e.source, p (e x) :=
by rw [← image_source_eq_target, bex_image_iff]

/-- We say that `t : set β` is an image of `s : set α` under a local equivalence if
any of the following equivalent conditions hold:

* `e '' (e.source ∩ s) = e.target ∩ t`;
* `e.source ∩ e ⁻¹ t = e.source ∩ s`;
* `∀ x ∈ e.source, e x ∈ t ↔ x ∈ s` (this one is used in the definition).
-/
def is_image (s : set α) (t : set β) : Prop := ∀ ⦃x⦄, x ∈ e.source → (e x ∈ t ↔ x ∈ s)

namespace is_image

variables {e} {s : set α} {t : set β} {x : α} {y : β}

lemma apply_mem_iff (h : e.is_image s t) (hx : x ∈ e.source) : e x ∈ t ↔ x ∈ s := h hx

lemma symm_apply_mem_iff (h : e.is_image s t) : ∀ ⦃y⦄, y ∈ e.target → (e.symm y ∈ s ↔ y ∈ t) :=
e.forall_mem_target.mpr $ λ x hx, by rw [e.left_inv hx, h hx]

protected lemma symm (h : e.is_image s t) : e.symm.is_image t s := h.symm_apply_mem_iff

@[simp] lemma symm_iff : e.symm.is_image t s ↔ e.is_image s t := ⟨λ h, h.symm, λ h, h.symm⟩

protected lemma maps_to (h : e.is_image s t) : maps_to e (e.source ∩ s) (e.target ∩ t) :=
λ x hx, ⟨e.maps_to hx.1, (h hx.1).2 hx.2⟩

lemma symm_maps_to (h : e.is_image s t) : maps_to e.symm (e.target ∩ t) (e.source ∩ s) :=
h.symm.maps_to

/-- Restrict a `local_equiv` to a pair of corresponding sets. -/
@[simps {fully_applied := ff}] def restr (h : e.is_image s t) : local_equiv α β :=
{ to_fun := e,
  inv_fun := e.symm,
  source := e.source ∩ s,
  target := e.target ∩ t,
  map_source' := h.maps_to,
  map_target' := h.symm_maps_to,
  left_inv' := e.left_inv_on.mono (inter_subset_left _ _),
  right_inv' := e.right_inv_on.mono (inter_subset_left _ _) }

lemma image_eq (h : e.is_image s t) : e '' (e.source ∩ s) = e.target ∩ t :=
h.restr.image_source_eq_target

lemma symm_image_eq (h : e.is_image s t) : e.symm '' (e.target ∩ t) = e.source ∩ s :=
h.symm.image_eq

lemma iff_preimage_eq : e.is_image s t ↔ e.source ∩ e ⁻¹' t = e.source ∩ s :=
by simp only [is_image, set.ext_iff, mem_inter_iff, and.congr_right_iff, mem_preimage]

alias iff_preimage_eq ↔ preimage_eq of_preimage_eq

lemma iff_symm_preimage_eq : e.is_image s t ↔ e.target ∩ e.symm ⁻¹' s = e.target ∩ t :=
symm_iff.symm.trans iff_preimage_eq

alias iff_symm_preimage_eq ↔ symm_preimage_eq of_symm_preimage_eq

lemma of_image_eq (h : e '' (e.source ∩ s) = e.target ∩ t) : e.is_image s t :=
of_symm_preimage_eq $ eq.trans (of_symm_preimage_eq rfl).image_eq.symm h

lemma of_symm_image_eq (h : e.symm '' (e.target ∩ t) = e.source ∩ s) : e.is_image s t :=
of_preimage_eq $ eq.trans (of_preimage_eq rfl).symm_image_eq.symm h

protected lemma compl (h : e.is_image s t) : e.is_image sᶜ tᶜ :=
λ x hx, not_congr (h hx)

protected lemma inter {s' t'} (h : e.is_image s t) (h' : e.is_image s' t') :
  e.is_image (s ∩ s') (t ∩ t') :=
λ x hx, and_congr (h hx) (h' hx)

protected lemma union {s' t'} (h : e.is_image s t) (h' : e.is_image s' t') :
  e.is_image (s ∪ s') (t ∪ t') :=
λ x hx, or_congr (h hx) (h' hx)

protected lemma diff {s' t'} (h : e.is_image s t) (h' : e.is_image s' t') :
  e.is_image (s \ s') (t \ t') :=
h.inter h'.compl

lemma left_inv_on_piecewise {e' : local_equiv α β} [∀ i, decidable (i ∈ s)] [∀ i, decidable (i ∈ t)]
  (h : e.is_image s t) (h' : e'.is_image s t) :
  left_inv_on (t.piecewise e.symm e'.symm) (s.piecewise e e') (s.ite e.source e'.source) :=
begin
  rintro x (⟨he, hs⟩|⟨he, hs : x ∉ s⟩),
  { rw [piecewise_eq_of_mem _ _ _ hs, piecewise_eq_of_mem _ _ _ ((h he).2 hs), e.left_inv he], },
  { rw [piecewise_eq_of_not_mem _ _ _ hs, piecewise_eq_of_not_mem _ _ _ ((h'.compl he).2 hs),
      e'.left_inv he] }
end

lemma inter_eq_of_inter_eq_of_eq_on {e' : local_equiv α β} (h : e.is_image s t)
  (h' : e'.is_image s t) (hs : e.source ∩ s = e'.source ∩ s) (Heq : eq_on e e' (e.source ∩ s)) :
  e.target ∩ t = e'.target ∩ t :=
by rw [← h.image_eq, ← h'.image_eq, ← hs, Heq.image_eq]

lemma symm_eq_on_of_inter_eq_of_eq_on {e' : local_equiv α β} (h : e.is_image s t)
  (hs : e.source ∩ s = e'.source ∩ s) (Heq : eq_on e e' (e.source ∩ s)) :
  eq_on e.symm e'.symm (e.target ∩ t) :=
begin
  rw [← h.image_eq],
  rintros y ⟨x, hx, rfl⟩,
  have hx' := hx, rw hs at hx',
  rw [e.left_inv hx.1, Heq hx, e'.left_inv hx'.1]
end

end is_image

lemma is_image_source_target : e.is_image e.source e.target := λ x hx, by simp [hx]

lemma is_image_source_target_of_disjoint (e' : local_equiv α β) (hs : disjoint e.source e'.source)
  (ht : disjoint e.target e'.target) :
  e.is_image e'.source e'.target :=
is_image.of_image_eq $ by rw [hs.inter_eq, ht.inter_eq, image_empty]

lemma image_source_inter_eq' (s : set α) :
  e '' (e.source ∩ s) = e.target ∩ e.symm ⁻¹' s :=
by rw [inter_comm, e.left_inv_on.image_inter', image_source_eq_target, inter_comm]

lemma image_source_inter_eq (s : set α) :
  e '' (e.source ∩ s) = e.target ∩ e.symm ⁻¹' (e.source ∩ s) :=
by rw [inter_comm, e.left_inv_on.image_inter, image_source_eq_target, inter_comm]

lemma image_eq_target_inter_inv_preimage {s : set α} (h : s ⊆ e.source) :
  e '' s = e.target ∩ e.symm ⁻¹' s :=
by rw [← e.image_source_inter_eq', inter_eq_self_of_subset_right h]

lemma symm_image_eq_source_inter_preimage {s : set β} (h : s ⊆ e.target) :
  e.symm '' s = e.source ∩ e ⁻¹' s :=
e.symm.image_eq_target_inter_inv_preimage h

lemma symm_image_target_inter_eq (s : set β) :
  e.symm '' (e.target ∩ s) = e.source ∩ e ⁻¹' (e.target ∩ s) :=
e.symm.image_source_inter_eq _

lemma symm_image_target_inter_eq' (s : set β) :
  e.symm '' (e.target ∩ s) = e.source ∩ e ⁻¹' s :=
e.symm.image_source_inter_eq' _

lemma source_inter_preimage_inv_preimage (s : set α) :
  e.source ∩ e ⁻¹' (e.symm ⁻¹' s) = e.source ∩ s :=
set.ext $ λ x, and.congr_right_iff.2 $ λ hx, by simp only [mem_preimage, e.left_inv hx]

lemma source_inter_preimage_target_inter (s : set β) :
  e.source ∩ (e ⁻¹' (e.target ∩ s)) = e.source ∩ (e ⁻¹' s) :=
ext $ λ x, ⟨λ hx, ⟨hx.1, hx.2.2⟩, λ hx, ⟨hx.1, e.map_source hx.1, hx.2⟩⟩

lemma target_inter_inv_preimage_preimage (s : set β) :
  e.target ∩ e.symm ⁻¹' (e ⁻¹' s) = e.target ∩ s :=
e.symm.source_inter_preimage_inv_preimage _

lemma symm_image_image_of_subset_source {s : set α} (h : s ⊆ e.source) :
  e.symm '' (e '' s) = s :=
(e.left_inv_on.mono h).image_image

lemma image_symm_image_of_subset_target {s : set β} (h : s ⊆ e.target) :
  e '' (e.symm '' s) = s :=
e.symm.symm_image_image_of_subset_source h

lemma source_subset_preimage_target : e.source ⊆ e ⁻¹' e.target :=
e.maps_to

lemma symm_image_target_eq_source : e.symm '' e.target = e.source :=
e.symm.image_source_eq_target

/-- Two local equivs that have the same `source`, same `to_fun` and same `inv_fun`, coincide. -/
@[ext]
protected lemma ext {e e' : local_equiv α β} (h : ∀x, e x = e' x)
  (hsymm : ∀x, e.symm x = e'.symm x) (hs : e.source = e'.source) : e = e' :=
begin
  have A : (e : α → β) = e', by { ext x, exact h x },
  have B : (e.symm : β → α) = e'.symm, by { ext x, exact hsymm x },
  have I : e '' e.source = e.target := e.image_source_eq_target,
  have I' : e' '' e'.source = e'.target := e'.image_source_eq_target,
  rw [A, hs, I'] at I,
  cases e; cases e',
  simp * at *
end

/-- Restricting a local equivalence to e.source ∩ s -/
protected def restr (s : set α) : local_equiv α β :=
(@is_image.of_symm_preimage_eq α β e s (e.symm ⁻¹' s) rfl).restr

@[simp, mfld_simps] lemma restr_coe (s : set α) : (e.restr s : α → β) = e := rfl
@[simp, mfld_simps] lemma restr_coe_symm (s : set α) : ((e.restr s).symm : β → α) = e.symm := rfl
@[simp, mfld_simps] lemma restr_source (s : set α) : (e.restr s).source = e.source ∩ s := rfl
@[simp, mfld_simps] lemma restr_target (s : set α) :
  (e.restr s).target = e.target ∩ e.symm ⁻¹' s := rfl

lemma restr_eq_of_source_subset {e : local_equiv α β} {s : set α} (h : e.source ⊆ s) :
  e.restr s = e :=
local_equiv.ext (λ_, rfl) (λ_, rfl) (by simp [inter_eq_self_of_subset_left h])

@[simp, mfld_simps] lemma restr_univ {e : local_equiv α β} : e.restr univ = e :=
restr_eq_of_source_subset (subset_univ _)

/-- The identity local equiv -/
protected def refl (α : Type*) : local_equiv α α := (equiv.refl α).to_local_equiv

@[simp, mfld_simps] lemma refl_source : (local_equiv.refl α).source = univ := rfl
@[simp, mfld_simps] lemma refl_target : (local_equiv.refl α).target = univ := rfl
@[simp, mfld_simps] lemma refl_coe : (local_equiv.refl α : α → α) = id := rfl
@[simp, mfld_simps] lemma refl_symm : (local_equiv.refl α).symm = local_equiv.refl α := rfl

@[simp, mfld_simps] lemma refl_restr_source (s : set α) :
  ((local_equiv.refl α).restr s).source = s :=
by simp

@[simp, mfld_simps] lemma refl_restr_target (s : set α) :
  ((local_equiv.refl α).restr s).target = s :=
by { change univ ∩ id⁻¹' s = s, simp }

/-- The identity local equiv on a set `s` -/
def of_set (s : set α) : local_equiv α α :=
{ to_fun      := id,
  inv_fun     := id,
  source      := s,
  target      := s,
  map_source' := λx hx, hx,
  map_target' := λx hx, hx,
  left_inv'   := λx hx, rfl,
  right_inv'  := λx hx, rfl }

@[simp, mfld_simps] lemma of_set_source (s : set α) : (local_equiv.of_set s).source = s := rfl
@[simp, mfld_simps] lemma of_set_target (s : set α) : (local_equiv.of_set s).target = s := rfl
@[simp, mfld_simps] lemma of_set_coe (s : set α) : (local_equiv.of_set s : α → α) = id := rfl
@[simp, mfld_simps] lemma of_set_symm (s : set α) :
  (local_equiv.of_set s).symm = local_equiv.of_set s := rfl

/-- Composing two local equivs if the target of the first coincides with the source of the
second. -/
protected def trans' (e' : local_equiv β γ) (h : e.target = e'.source) :
  local_equiv α γ :=
{ to_fun := e' ∘ e,
  inv_fun := e.symm ∘ e'.symm,
  source := e.source,
  target := e'.target,
  map_source' := λx hx, by simp [h.symm, hx],
  map_target' := λy hy, by simp [h, hy],
  left_inv' := λx hx, by simp [hx, h.symm],
  right_inv' := λy hy, by simp [hy, h] }

/-- Composing two local equivs, by restricting to the maximal domain where their composition
is well defined. -/
protected def trans : local_equiv α γ :=
  local_equiv.trans' (e.symm.restr (e'.source)).symm (e'.restr (e.target)) (inter_comm _ _)

@[simp, mfld_simps] lemma coe_trans : (e.trans e' : α → γ) = e' ∘ e := rfl
@[simp, mfld_simps] lemma coe_trans_symm : ((e.trans e').symm : γ → α) = e.symm ∘ e'.symm := rfl
lemma trans_apply {x : α} : (e.trans e') x = e' (e x) := rfl

lemma trans_symm_eq_symm_trans_symm : (e.trans e').symm = e'.symm.trans e.symm :=
by cases e; cases e'; refl

@[simp, mfld_simps] lemma trans_source : (e.trans e').source = e.source ∩ e ⁻¹' e'.source := rfl

lemma trans_source' : (e.trans e').source = e.source ∩ e ⁻¹' (e.target ∩ e'.source) :=
by mfld_set_tac

lemma trans_source'' : (e.trans e').source = e.symm '' (e.target ∩ e'.source) :=
by rw [e.trans_source', e.symm_image_target_inter_eq]

lemma image_trans_source : e '' (e.trans e').source = e.target ∩ e'.source :=
(e.symm.restr e'.source).symm.image_source_eq_target

@[simp, mfld_simps] lemma trans_target :
  (e.trans e').target = e'.target ∩ e'.symm ⁻¹' e.target := rfl

lemma trans_target' : (e.trans e').target = e'.target ∩ e'.symm ⁻¹' (e'.source ∩ e.target) :=
trans_source' e'.symm e.symm

lemma trans_target'' : (e.trans e').target = e' '' (e'.source ∩ e.target) :=
trans_source'' e'.symm e.symm

lemma inv_image_trans_target : e'.symm '' (e.trans e').target = e'.source ∩ e.target :=
image_trans_source e'.symm e.symm

lemma trans_assoc (e'' : local_equiv γ δ) : (e.trans e').trans e'' = e.trans (e'.trans e'') :=
local_equiv.ext (λx, rfl) (λx, rfl) (by simp [trans_source, @preimage_comp α β γ, inter_assoc])

@[simp, mfld_simps] lemma trans_refl : e.trans (local_equiv.refl β) = e :=
local_equiv.ext (λx, rfl) (λx, rfl) (by simp [trans_source])

@[simp, mfld_simps] lemma refl_trans : (local_equiv.refl α).trans e = e :=
local_equiv.ext (λx, rfl) (λx, rfl) (by simp [trans_source, preimage_id])

lemma trans_refl_restr (s : set β) :
  e.trans ((local_equiv.refl β).restr s) = e.restr (e ⁻¹' s) :=
local_equiv.ext (λx, rfl) (λx, rfl) (by simp [trans_source])

lemma trans_refl_restr' (s : set β) :
  e.trans ((local_equiv.refl β).restr s) = e.restr (e.source ∩ e ⁻¹' s) :=
local_equiv.ext (λx, rfl) (λx, rfl) $ by { simp [trans_source], rw [← inter_assoc, inter_self] }

lemma restr_trans (s : set α) :
  (e.restr s).trans e' = (e.trans e').restr s :=
local_equiv.ext (λx, rfl) (λx, rfl) $ by { simp [trans_source, inter_comm], rwa inter_assoc }

/-- A lemma commonly useful when `e` and `e'` are charts of a manifold. -/
lemma mem_symm_trans_source {e' : local_equiv α γ} {x : α} (he : x ∈ e.source)
  (he' : x ∈ e'.source) : e x ∈ (e.symm.trans e').source :=
⟨e.maps_to he, by rwa [mem_preimage, local_equiv.symm_symm, e.left_inv he]⟩

/-- Postcompose a local equivalence with an equivalence.
We modify the source and target to have better definitional behavior. -/
@[simps] def trans_equiv (e' : β ≃ γ) : local_equiv α γ :=
(e.trans e'.to_local_equiv).copy _ rfl _ rfl e.source (inter_univ _) (e'.symm ⁻¹' e.target)
  (univ_inter _)

lemma trans_equiv_eq_trans (e' : β ≃ γ) : e.trans_equiv e' = e.trans e'.to_local_equiv :=
copy_eq _ _ _ _ _ _ _ _ _

/-- Precompose a local equivalence with an equivalence.
We modify the source and target to have better definitional behavior. -/
@[simps] def _root_.equiv.trans_local_equiv (e : α ≃ β) : local_equiv α γ :=
(e.to_local_equiv.trans e').copy _ rfl _ rfl (e ⁻¹' e'.source) (univ_inter _) e'.target
  (inter_univ _)

lemma _root_.equiv.trans_local_equiv_eq_trans (e : α ≃ β) :
  e.trans_local_equiv e' = e.to_local_equiv.trans e' :=
copy_eq _ _ _ _ _ _ _ _ _

/-- `eq_on_source e e'` means that `e` and `e'` have the same source, and coincide there. Then `e`
and `e'` should really be considered the same local equiv. -/
def eq_on_source (e e' : local_equiv α β) : Prop :=
e.source = e'.source ∧ (e.source.eq_on e e')

/-- `eq_on_source` is an equivalence relation -/
instance eq_on_source_setoid : setoid (local_equiv α β) :=
{ r     := eq_on_source,
  iseqv := ⟨
    λe, by simp [eq_on_source],
    λe e' h, by { simp [eq_on_source, h.1.symm], exact λx hx, (h.2 hx).symm },
    λe e' e'' h h', ⟨by rwa [← h'.1, ← h.1], λx hx, by { rw [← h'.2, h.2 hx], rwa ← h.1 }⟩⟩ }

lemma eq_on_source_refl : e ≈ e := setoid.refl _

/-- Two equivalent local equivs have the same source -/
lemma eq_on_source.source_eq {e e' : local_equiv α β} (h : e ≈ e') : e.source = e'.source :=
h.1

/-- Two equivalent local equivs coincide on the source -/
lemma eq_on_source.eq_on {e e' : local_equiv α β} (h : e ≈ e') : e.source.eq_on e e' :=
h.2

/-- Two equivalent local equivs have the same target -/
lemma eq_on_source.target_eq {e e' : local_equiv α β} (h : e ≈ e') : e.target = e'.target :=
by simp only [← image_source_eq_target, ← h.source_eq, h.2.image_eq]

/-- If two local equivs are equivalent, so are their inverses. -/
lemma eq_on_source.symm' {e e' : local_equiv α β} (h : e ≈ e') : e.symm ≈ e'.symm :=
begin
  refine ⟨h.target_eq, eq_on_of_left_inv_on_of_right_inv_on e.left_inv_on _ _⟩;
    simp only [symm_source, h.target_eq, h.source_eq, e'.symm_maps_to],
  exact e'.right_inv_on.congr_right e'.symm_maps_to (h.source_eq ▸ h.eq_on.symm),
end

/-- Two equivalent local equivs have coinciding inverses on the target -/
lemma eq_on_source.symm_eq_on {e e' : local_equiv α β} (h : e ≈ e') :
  eq_on e.symm e'.symm e.target :=
h.symm'.eq_on

/-- Composition of local equivs respects equivalence -/
lemma eq_on_source.trans' {e e' : local_equiv α β} {f f' : local_equiv β γ}
  (he : e ≈ e') (hf : f ≈ f') : e.trans f ≈ e'.trans f' :=
begin
  split,
  { rw [trans_source'', trans_source'', ← he.target_eq, ← hf.1],
    exact (he.symm'.eq_on.mono $ inter_subset_left _ _).image_eq },
  { assume x hx,
    rw trans_source at hx,
    simp [(he.2 hx.1).symm, hf.2 hx.2] }
end

/-- Restriction of local equivs respects equivalence -/
lemma eq_on_source.restr {e e' : local_equiv α β} (he : e ≈ e') (s : set α) :
  e.restr s ≈ e'.restr s :=
begin
  split,
  { simp [he.1] },
  { assume x hx,
    simp only [mem_inter_iff, restr_source] at hx,
    exact he.2 hx.1 }
end

/-- Preimages are respected by equivalence -/
lemma eq_on_source.source_inter_preimage_eq {e e' : local_equiv α β} (he : e ≈ e') (s : set β) :
  e.source ∩ e ⁻¹' s = e'.source ∩ e' ⁻¹' s :=
by rw [he.eq_on.inter_preimage_eq, he.source_eq]

/-- Composition of a local equiv and its inverse is equivalent to the restriction of the identity
to the source -/
lemma trans_self_symm :
  e.trans e.symm ≈ local_equiv.of_set e.source :=
begin
  have A : (e.trans e.symm).source = e.source, by mfld_set_tac,
  refine ⟨by simp [A], λx hx, _⟩,
  rw A at hx,
  simp only [hx] with mfld_simps
end

/-- Composition of the inverse of a local equiv and this local equiv is equivalent to the
restriction of the identity to the target -/
lemma trans_symm_self :
  e.symm.trans e ≈ local_equiv.of_set e.target :=
trans_self_symm (e.symm)

/-- Two equivalent local equivs are equal when the source and target are univ -/
lemma eq_of_eq_on_source_univ (e e' : local_equiv α β) (h : e ≈ e')
  (s : e.source = univ) (t : e.target = univ) : e = e' :=
begin
  apply local_equiv.ext (λx, _) (λx, _) h.1,
  { apply h.2,
    rw s,
    exact mem_univ _ },
  { apply h.symm'.2,
    rw [symm_source, t],
    exact mem_univ _ }
end

section prod

/-- The product of two local equivs, as a local equiv on the product. -/
def prod (e : local_equiv α β) (e' : local_equiv γ δ) : local_equiv (α × γ) (β × δ) :=
{ source := e.source ×ˢ e'.source,
  target := e.target ×ˢ e'.target,
  to_fun := λp, (e p.1, e' p.2),
  inv_fun := λp, (e.symm p.1, e'.symm p.2),
  map_source' := λp hp, by { simp at hp, simp [hp] },
  map_target' := λp hp, by { simp at hp, simp [map_target, hp] },
  left_inv'   := λp hp, by { simp at hp, simp [hp] },
  right_inv'  := λp hp, by { simp at hp, simp [hp] } }

@[simp, mfld_simps] lemma prod_source (e : local_equiv α β) (e' : local_equiv γ δ) :
  (e.prod e').source = e.source ×ˢ e'.source := rfl

@[simp, mfld_simps] lemma prod_target (e : local_equiv α β) (e' : local_equiv γ δ) :
  (e.prod e').target = e.target ×ˢ e'.target := rfl

@[simp, mfld_simps] lemma prod_coe (e : local_equiv α β) (e' : local_equiv γ δ) :
  ((e.prod e') : α × γ → β × δ) = (λp, (e p.1, e' p.2)) := rfl

lemma prod_coe_symm (e : local_equiv α β) (e' : local_equiv γ δ) :
  ((e.prod e').symm : β × δ → α × γ) = (λp, (e.symm p.1, e'.symm p.2)) := rfl

@[simp, mfld_simps] lemma prod_symm (e : local_equiv α β) (e' : local_equiv γ δ) :
  (e.prod e').symm = (e.symm.prod e'.symm) :=
by ext x; simp [prod_coe_symm]

@[simp, mfld_simps] lemma refl_prod_refl :
  (local_equiv.refl α).prod (local_equiv.refl β) = local_equiv.refl (α × β) :=
by { ext1 ⟨x, y⟩, { refl }, { rintro ⟨x, y⟩, refl }, exact univ_prod_univ }

@[simp, mfld_simps] lemma prod_trans {η : Type*} {ε : Type*}
  (e : local_equiv α β) (f : local_equiv β γ) (e' : local_equiv δ η) (f' : local_equiv η ε) :
  (e.prod e').trans (f.prod f') = (e.trans f).prod (e'.trans f') :=
by ext x; simp [ext_iff]; tauto

end prod

/-- Combine two `local_equiv`s using `set.piecewise`. The source of the new `local_equiv` is
`s.ite e.source e'.source = e.source ∩ s ∪ e'.source \ s`, and similarly for target.  The function
sends `e.source ∩ s` to `e.target ∩ t` using `e` and `e'.source \ s` to `e'.target \ t` using `e'`,
and similarly for the inverse function. The definition assumes `e.is_image s t` and
`e'.is_image s t`. -/
@[simps {fully_applied := ff}] def piecewise (e e' : local_equiv α β) (s : set α) (t : set β)
  [∀ x, decidable (x ∈ s)] [∀ y, decidable (y ∈ t)] (H : e.is_image s t) (H' : e'.is_image s t) :
  local_equiv α β :=
{ to_fun := s.piecewise e e',
  inv_fun := t.piecewise e.symm e'.symm,
  source := s.ite e.source e'.source,
  target := t.ite e.target e'.target,
  map_source' := H.maps_to.piecewise_ite H'.compl.maps_to,
  map_target' := H.symm.maps_to.piecewise_ite H'.symm.compl.maps_to,
  left_inv' := H.left_inv_on_piecewise H',
  right_inv' := H.symm.left_inv_on_piecewise H'.symm }

lemma symm_piecewise (e e' : local_equiv α β) {s : set α} {t : set β}
  [∀ x, decidable (x ∈ s)] [∀ y, decidable (y ∈ t)]
  (H : e.is_image s t) (H' : e'.is_image s t) :
  (e.piecewise e' s t H H').symm = e.symm.piecewise e'.symm t s H.symm H'.symm :=
rfl

/-- Combine two `local_equiv`s with disjoint sources and disjoint targets. We reuse
`local_equiv.piecewise`, then override `source` and `target` to ensure better definitional
equalities. -/
@[simps {fully_applied := ff}]
def disjoint_union (e e' : local_equiv α β) (hs : disjoint e.source e'.source)
  (ht : disjoint e.target e'.target) [∀ x, decidable (x ∈ e.source)]
  [∀ y, decidable (y ∈ e.target)] :
  local_equiv α β :=
(e.piecewise e' e.source e.target e.is_image_source_target $
  e'.is_image_source_target_of_disjoint _ hs.symm ht.symm).copy
  _ rfl _ rfl (e.source ∪ e'.source) (ite_left _ _) (e.target ∪ e'.target) (ite_left _ _)

lemma disjoint_union_eq_piecewise (e e' : local_equiv α β) (hs : disjoint e.source e'.source)
  (ht : disjoint e.target e'.target) [∀ x, decidable (x ∈ e.source)]
  [∀ y, decidable (y ∈ e.target)] :
  e.disjoint_union e' hs ht = e.piecewise e' e.source e.target e.is_image_source_target
    (e'.is_image_source_target_of_disjoint _ hs.symm ht.symm) :=
copy_eq _ _ _ _ _ _ _ _ _

section pi

variables {ι : Type*} {αi βi : ι → Type*} (ei : Π i, local_equiv (αi i) (βi i))

/-- The product of a family of local equivs, as a local equiv on the pi type. -/
@[simps (mfld_cfg)] protected def pi : local_equiv (Π i, αi i) (Π i, βi i) :=
{ to_fun := λ f i, ei i (f i),
  inv_fun := λ f i, (ei i).symm (f i),
  source := pi univ (λ i, (ei i).source),
  target := pi univ (λ i, (ei i).target),
  map_source' := λ f hf i hi, (ei i).map_source (hf i hi),
  map_target' := λ f hf i hi, (ei i).map_target (hf i hi),
  left_inv' := λ f hf, funext $ λ i, (ei i).left_inv (hf i trivial),
  right_inv' := λ f hf, funext $ λ i, (ei i).right_inv (hf i trivial) }

end pi

end local_equiv

namespace set

-- All arguments are explicit to avoid missing information in the pretty printer output
/-- A bijection between two sets `s : set α` and `t : set β` provides a local equivalence
between `α` and `β`. -/
@[simps {fully_applied := ff}] noncomputable def bij_on.to_local_equiv [nonempty α] (f : α → β)
  (s : set α) (t : set β) (hf : bij_on f s t) :
  local_equiv α β :=
{ to_fun := f,
  inv_fun := inv_fun_on f s,
  source := s,
  target := t,
  map_source' := hf.maps_to,
  map_target' := hf.surj_on.maps_to_inv_fun_on,
  left_inv'   := hf.inv_on_inv_fun_on.1,
  right_inv'  := hf.inv_on_inv_fun_on.2 }

/-- A map injective on a subset of its domain provides a local equivalence. -/
@[simp, mfld_simps] noncomputable def inj_on.to_local_equiv [nonempty α] (f : α → β) (s : set α)
  (hf : inj_on f s) :
  local_equiv α β :=
hf.bij_on_image.to_local_equiv f s (f '' s)

end set

namespace equiv
/- equivs give rise to local_equiv. We set up simp lemmas to reduce most properties of the local
equiv to that of the equiv. -/
variables (e : α ≃ β) (e' : β ≃ γ)

@[simp, mfld_simps] lemma refl_to_local_equiv :
  (equiv.refl α).to_local_equiv = local_equiv.refl α := rfl
@[simp, mfld_simps] lemma symm_to_local_equiv : e.symm.to_local_equiv = e.to_local_equiv.symm := rfl
@[simp, mfld_simps] lemma trans_to_local_equiv :
  (e.trans e').to_local_equiv = e.to_local_equiv.trans e'.to_local_equiv :=
local_equiv.ext (λx, rfl) (λx, rfl) (by simp [local_equiv.trans_source, equiv.to_local_equiv])

end equiv


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

! This file was ported from Lean 3 source module testing.slim_check.testable
! leanprover-community/mathlib commit d13b3a4a392ea7273dfa4727dbd1892e26cfd518
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Testing.SlimCheck.Sampleable

/-!
# `testable` Class

Testable propositions have a procedure that can generate counter-examples
together with a proof that they invalidate the proposition.

This is a port of the Haskell QuickCheck library.

## Creating Customized Instances

The type classes `testable` and `sampleable` are the means by which
`slim_check` creates samples and tests them. For instance, the proposition
`∀ i j : ℕ, i ≤ j` has a `testable` instance because `ℕ` is sampleable
and `i ≤ j` is decidable. Once `slim_check` finds the `testable`
instance, it can start using the instance to repeatedly creating samples
and checking whether they satisfy the property. This allows the
user to create new instances and apply `slim_check` to new situations.

### Polymorphism

The property `testable.check (∀ (α : Type) (xs ys : list α), xs ++ ys
= ys ++ xs)` shows us that type-polymorphic properties can be
tested. `α` is instantiated with `ℤ` first and then tested as normal
monomorphic properties.

The monomorphisation limits the applicability of `slim_check` to
polymorphic properties that can be stated about integers. The
limitation may be lifted in the future but, for now, if
one wishes to use a different type than `ℤ`, one has to refer to
the desired type.

### What do I do if I'm testing a property about my newly defined type?

Let us consider a type made for a new formalization:

```lean
structure my_type :=
(x y : ℕ)
(h : x ≤ y)
```

How do we test a property about `my_type`? For instance, let us consider
`testable.check $ ∀ a b : my_type, a.y ≤ b.x → a.x ≤ b.y`. Writing this
property as is will give us an error because we do not have an instance
of `sampleable my_type`. We can define one as follows:

```lean
instance : sampleable my_type :=
{ sample := do
  x ← sample ℕ,
  xy_diff ← sample ℕ,
  return { x := x, y := x + xy_diff, h := /- some proof -/ } }
```

We can see that the instance is very simple because our type is built
up from other type that have `sampleable` instances. `sampleable` also
has a `shrink` method but it is optional. We may want to implement one
for ease of testing as:

```lean
/- ... -/
  shrink := λ ⟨x,y,h⟩, (λ ⟨x,y⟩, { x := x, y := x + y, h := /- proof -/}) <$> shrink (x, y - x) }
```

Again, we take advantage of the fact that other types have useful
`shrink` implementations, in this case `prod`.

### Optimizing the sampling

Some properties are guarded by a proposition. For instance, recall this
example:

```lean
#eval testable.check (∀ x : ℕ, 2 ∣ x → x < 100)
```

When testing the above example, we generate a natural number, we check
that it is even and test it if it is even or throw it away and start
over otherwise. Statistically, we can expect half of our samples to be
thrown away by such a filter. Sometimes, the filter is more
restrictive. For instance we might need `x` to be a `prime`
number. This would cause most of our samples to be discarded.

We can help `slim_check` find good samples by providing specialized
sampleable instances. Below, we show an instance for the subtype
of even natural numbers. This means that, when producing
a sample, it is forced to produce a proof that it is even.

```lean
instance {k : ℕ} [fact (0 < k)] : sampleable { x : ℕ // k ∣ x } :=
{ sample := do { n ← sample ℕ, pure ⟨k*n, dvd_mul_right _ _⟩ },
  shrink := λ ⟨x,h⟩, (λ y, ⟨k*y, dvd_mul_right _ _⟩) <$> shrink x }
```

Such instance will be preferred when testing a proposition of the shape
`∀ x : T, p x → q`

We can observe the effect by enabling tracing:

```lean
/- no specialized sampling -/
#eval testable.check (∀ x : ℕ, 2 ∣ x → x < 100) { trace_discarded := tt }
-- discard
--  x := 1
-- discard
--  x := 41
-- discard
--  x := 3
-- discard
--  x := 5
-- discard
--  x := 5
-- discard
--  x := 197
-- discard
--  x := 469
-- discard
--  x := 9
-- discard

-- ===================
-- Found problems!

-- x := 552
-- -------------------

/- let us define a specialized sampling instance -/
instance {k : ℕ} : sampleable { x : ℕ // k ∣ x } :=
{ sample := do { n ← sample ℕ, pure ⟨k*n, dvd_mul_right _ _⟩ },
  shrink := λ ⟨x,h⟩, (λ y, ⟨k*y, dvd_mul_right _ _⟩) <$> shrink x }

#eval testable.check (∀ x : ℕ, 2 ∣ x → x < 100) { enable_tracing := tt }
-- ===================
-- Found problems!

-- x := 358
-- -------------------
```

Similarly, it is common to write properties of the form: `∀ i j, i ≤ j → ...`
as the following example show:

```lean
#eval check (∀ i j k : ℕ, j < k → i - k < i - j)
```

Without subtype instances, the above property discards many samples
because `j < k` does not hold. Fortunately, we have appropriate
instance to choose `k` intelligently.

## Main definitions
  * `testable` class
  * `testable.check`: a way to test a proposition using random examples

## Tags

random testing

## References

  * https://hackage.haskell.org/package/QuickCheck

-/

universe u v

variable (var var' : String)

variable (α : Type u)

variable (β : α → Prop)

variable (f : Type → Prop)

namespace SlimCheck

/- ./././Mathport/Syntax/Translate/Command.lean:364:30: infer kinds are unsupported in Lean 4: gave_up {} -/
#print SlimCheck.TestResult /-
/-- Result of trying to disprove `p`

The constructors are:
  *  `success : (psum unit p) → test_result`
     succeed when we find another example satisfying `p`
     In `success h`, `h` is an optional proof of the proposition.
     Without the proof, all we know is that we found one example
     where `p` holds. With a proof, the one test was sufficient to
     prove that `p` holds and we do not need to keep finding examples.
   * `gave_up {} : ℕ → test_result`
     give up when a well-formed example cannot be generated.
     `gave_up n` tells us that `n` invalid examples were tried.
     Above 100, we give up on the proposition and report that we
     did not find a way to properly test it.
   * `failure : ¬ p → (list string) → ℕ → test_result`
     a counter-example to `p`; the strings specify values for the relevant variables.
     `failure h vs n` also carries a proof that `p` does not hold. This way, we can
     guarantee that there will be no false positive. The last component, `n`,
     is the number of times that the counter-example was shrunk.
-/
inductive TestResult (p : Prop)
  | success : PSum Unit p → test_result
  | gave_up : ℕ → test_result
  | failure : ¬p → List String → ℕ → test_result
  deriving Inhabited
#align slim_check.test_result SlimCheck.TestResult
-/

#print SlimCheck.TestResult.toString /-
/-- format a `test_result` as a string. -/
protected def TestResult.toString {p} : TestResult p → String
  | test_result.success (PSum.inl ()) => "success (without proof)"
  | test_result.success (PSum.inr h) => "success (with proof)"
  | test_result.gave_up n => s! "gave up {n} times"
  | test_result.failure a vs _ => s! "failed {vs}"
#align slim_check.test_result.to_string SlimCheck.TestResult.toString
-/

/-- configuration for testing a property -/
structure SlimCheckCfg where
  numInst : ℕ := 100
  -- number of examples
  maxSize : ℕ := 100
  -- final size argument
  traceDiscarded : Bool := false
  -- enable the printing out of discarded samples
  traceSuccess : Bool := false
  -- enable the printing out of successful tests
  traceShrink : Bool := false
  -- enable the printing out of shrinking steps
  traceShrinkCandidates : Bool := false
  -- enable the printing out of shrinking candidates
  randomSeed : Option ℕ := none
  -- specify a seed to the random number generator to
  -- obtain a deterministic behavior
  quiet : Bool := false
  deriving has_reflect, Inhabited
#align slim_check.slim_check_cfg SlimCheck.SlimCheckCfg

-- suppress success message when running `slim_check`
instance {p} : ToString (TestResult p) :=
  ⟨TestResult.toString⟩

#print SlimCheck.PrintableProp /-
/-- `printable_prop p` allows one to print a proposition so that
`slim_check` can indicate how values relate to each other.
-/
class PrintableProp (p : Prop) where
  printProp : Option String
#align slim_check.printable_prop SlimCheck.PrintableProp
-/

-- see [note priority]
instance (priority := 100) defaultPrintableProp {p} : PrintableProp p :=
  ⟨none⟩
#align slim_check.default_printable_prop SlimCheck.defaultPrintableProp

#print SlimCheck.Testable /-
/- ./././Mathport/Syntax/Translate/Command.lean:388:30: infer kinds are unsupported in Lean 4: #[`run] [] -/
/-- `testable p` uses random examples to try to disprove `p`. -/
class Testable (p : Prop) where
  run (cfg : SlimCheckCfg) (minimize : Bool) : Gen (TestResult p)
#align slim_check.testable SlimCheck.Testable
-/

open _Root_.List

open TestResult

/-- applicative combinator proof carrying test results -/
def combine {p q : Prop} : PSum Unit (p → q) → PSum Unit p → PSum Unit q
  | PSum.inr f, PSum.inr x => PSum.inr (f x)
  | _, _ => PSum.inl ()
#align slim_check.combine SlimCheck.combine

/-- Combine the test result for properties `p` and `q` to create a test for their conjunction. -/
def andCounterExample {p q : Prop} : TestResult p → TestResult q → TestResult (p ∧ q)
  | failure Hce xs n, _ => failure (fun h => Hce h.1) xs n
  | _, failure Hce xs n => failure (fun h => Hce h.2) xs n
  | success xs, success ys => success <| combine (combine (PSum.inr And.intro) xs) ys
  | gave_up n, gave_up m => gaveUp <| n + m
  | gave_up n, _ => gaveUp n
  | _, gave_up n => gaveUp n
#align slim_check.and_counter_example SlimCheck.andCounterExample

/-- Combine the test result for properties `p` and `q` to create a test for their disjunction -/
def orCounterExample {p q : Prop} : TestResult p → TestResult q → TestResult (p ∨ q)
  | failure Hce xs n, failure Hce' ys n' =>
    failure (fun h => or_iff_not_and_not.1 h ⟨Hce, Hce'⟩) (xs ++ ys) (n + n')
  | success xs, _ => success <| combine (PSum.inr Or.inl) xs
  | _, success ys => success <| combine (PSum.inr Or.inr) ys
  | gave_up n, gave_up m => gaveUp <| n + m
  | gave_up n, _ => gaveUp n
  | _, gave_up n => gaveUp n
#align slim_check.or_counter_example SlimCheck.orCounterExample

/-- If `q → p`, then `¬ p → ¬ q` which means that testing `p` can allow us
to find counter-examples to `q`. -/
def convertCounterExample {p q : Prop} (h : q → p) :
    TestResult p → optParam (PSum Unit (p → q)) (PSum.inl ()) → TestResult q
  | failure Hce xs n, _ => failure (mt h Hce) xs n
  | success Hp, Hpq => success (combine Hpq Hp)
  | gave_up n, _ => gaveUp n
#align slim_check.convert_counter_example SlimCheck.convertCounterExample

/-- Test `q` by testing `p` and proving the equivalence between the two. -/
def convertCounterExample' {p q : Prop} (h : p ↔ q) (r : TestResult p) : TestResult q :=
  convertCounterExample h.2 r (PSum.inr h.1)
#align slim_check.convert_counter_example' SlimCheck.convertCounterExample'

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/-- When we assign a value to a universally quantified variable,
we record that value using this function so that our counter-examples
can be informative. -/
def addToCounterExample (x : String) {p q : Prop} (h : q → p) :
    TestResult p → optParam (PSum Unit (p → q)) (PSum.inl ()) → TestResult q
  | failure Hce xs n, _ => failure (mt h Hce) (x::xs) n
  | r, hpq => convertCounterExample h r hpq
#align slim_check.add_to_counter_example SlimCheck.addToCounterExample

/-- Add some formatting to the information recorded by `add_to_counter_example`. -/
def addVarToCounterExample {γ : Type v} [Repr γ] (var : String) (x : γ) {p q : Prop} (h : q → p) :
    TestResult p → optParam (PSum Unit (p → q)) (PSum.inl ()) → TestResult q :=
  @addToCounterExample (var ++ " := " ++ repr x) _ _ h
#align slim_check.add_var_to_counter_example SlimCheck.addVarToCounterExample

#print SlimCheck.NamedBinder /-
/-- Gadget used to introspect the name of bound variables.

It is used with the `testable` typeclass so that
`testable (named_binder "x" (∀ x, p x))` can use the variable name
of `x` in error messages displayed to the user. If we find that instantiating
the above quantifier with 3 falsifies it, we can print:

```
==============
Problem found!
==============
x := 3
```
 -/
@[simp, nolint unused_arguments]
def NamedBinder (n : String) (p : Prop) : Prop :=
  p
#align slim_check.named_binder SlimCheck.NamedBinder
-/

/-- Is the given test result a failure? -/
def isFailure {p} : TestResult p → Bool
  | test_result.failure _ _ _ => true
  | _ => false
#align slim_check.is_failure SlimCheck.isFailure

instance andTestable (p q : Prop) [Testable p] [Testable q] : Testable (p ∧ q) :=
  ⟨fun cfg min => do
    let xp ← Testable.run p cfg min
    let xq ← Testable.run q cfg min
    pure <| and_counter_example xp xq⟩
#align slim_check.and_testable SlimCheck.andTestable

instance orTestable (p q : Prop) [Testable p] [Testable q] : Testable (p ∨ q) :=
  ⟨fun cfg min => do
    let xp ← Testable.run p cfg min
    match xp with
      | success (PSum.inl h) => pure <| success (PSum.inl h)
      | success (PSum.inr h) => pure <| success (PSum.inr <| Or.inl h)
      | _ => do
        let xq ← testable.run q cfg min
        pure <| or_counter_example xp xq⟩
#align slim_check.or_testable SlimCheck.orTestable

instance iffTestable (p q : Prop) [Testable (p ∧ q ∨ ¬p ∧ ¬q)] : Testable (p ↔ q) :=
  ⟨fun cfg min => do
    let xp ← Testable.run (p ∧ q ∨ ¬p ∧ ¬q) cfg min
    return <| convert_counter_example' (by tauto) xp⟩
#align slim_check.iff_testable SlimCheck.iffTestable

open PrintableProp

instance (priority := 1000) decGuardTestable (p : Prop) [PrintableProp p] [Decidable p]
    (β : p → Prop) [∀ h, Testable (β h)] : Testable (NamedBinder var <| ∀ h, β h) :=
  ⟨fun cfg min => do
    if h : p then
        match print_prop p with
        | none =>
          (fun r => convert_counter_example (· <| h) r (PSum.inr fun q _ => q)) <$>
            testable.run (β h) cfg min
        | some str =>
          (fun r =>
              add_to_counter_example (s! "guard: {str}") (· <| h) r (PSum.inr fun q _ => q)) <$>
            testable.run (β h) cfg min
      else
        if cfg ∨ cfg then
          match print_prop p with
          | none => trace "discard" <| return <| gave_up 1
          | some str => (trace s! "discard: {str} does not hold") <| return <| gave_up 1
        else return <| gave_up 1⟩
#align slim_check.dec_guard_testable SlimCheck.decGuardTestable

/-- Type tag that replaces a type's `has_repr` instance with its `has_to_string` instance. -/
def UseHasToString (α : Type _) :=
  α
#align slim_check.use_has_to_string SlimCheck.UseHasToString

instance UseHasToString.inhabited [I : Inhabited α] : Inhabited (UseHasToString α) :=
  I
#align slim_check.use_has_to_string.inhabited SlimCheck.UseHasToString.inhabited

/-- Add the type tag `use_has_to_string` to an expression's type. -/
def UseHasToString.mk {α} (x : α) : UseHasToString α :=
  x
#align slim_check.use_has_to_string.mk SlimCheck.UseHasToString.mk

instance [ToString α] : Repr (UseHasToString α) :=
  ⟨@toString α _⟩

instance (priority := 2000) allTypesTestable [Testable (f ℤ)] :
    Testable (NamedBinder var <| ∀ x, f x) :=
  ⟨fun cfg min => do
    let r ← Testable.run (f ℤ) cfg min
    return <| add_var_to_counter_example var (use_has_to_string.mk "ℤ") (· <| ℤ) r⟩
#align slim_check.all_types_testable SlimCheck.allTypesTestable

/- warning: slim_check.trace_if_giveup -> SlimCheck.traceIfGiveup is a dubious translation:
lean 3 declaration is
  forall {p : Prop} {α : Type.{u1}} {β : Type.{u2}} [_inst_1 : Repr.{u1} α], Bool -> String -> α -> (SlimCheck.TestResult p) -> (Thunkₓ.{u2} β) -> β
but is expected to have type
  forall {p : Prop} {α : Type.{u2}} {β : Type.{u1}} [_inst_1 : Repr.{u2} α], Bool -> String -> α -> (SlimCheck.TestResult p) -> (Thunkₓ.{u1} β) -> β
Case conversion may be inaccurate. Consider using '#align slim_check.trace_if_giveup SlimCheck.traceIfGiveupₓ'. -/
/-- Trace the value of sampled variables if the sample is discarded. -/
def traceIfGiveup {p α β} [Repr α] (tracing_enabled : Bool) (var : String) (val : α) :
    TestResult p → Thunk β → β
  | test_result.gave_up _ => if tracing_enabled then trace s! " {var } := {repr val}" else (· <| ())
  | _ => (· <| ())
#align slim_check.trace_if_giveup SlimCheck.traceIfGiveup

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/-- testable instance for a property iterating over the element of a list -/
instance (priority := 5000) testForallInList [∀ x, Testable (β x)] [Repr α] :
    ∀ xs : List α, Testable (NamedBinder var <| ∀ x, NamedBinder var' <| x ∈ xs → β x)
  | [] =>
    ⟨fun tracing min =>
      return <|
        success <|
          PSum.inr
            (by
              introv x h
              cases h)⟩
  | x::xs =>
    ⟨fun cfg min => do
      let r ← Testable.run (β x) cfg min
      trace_if_giveup cfg var x r <|
          match r with
          | failure _ _ _ =>
            return <|
              add_var_to_counter_example var x
                (by
                  intro h
                  apply h
                  left
                  rfl)
                r
          | success hp => do
            let rs ← @testable.run _ (test_forall_in_list xs) cfg min
            return <|
                convert_counter_example
                  (by
                    intro h i h'
                    apply h
                    right
                    apply h')
                  rs
                  (combine
                    (PSum.inr <| by
                      intro j h
                      simp only [ball_cons, named_binder]
                      constructor <;> assumption)
                    hp)
          | gave_up n => do
            let rs ← @testable.run _ (test_forall_in_list xs) cfg min
            match rs with
              | success _ => return <| gave_up n
              | failure Hce xs n =>
                return <|
                  failure
                    (by
                      simp only [ball_cons, named_binder]
                      apply not_and_of_not_right _ Hce)
                    xs n
              | gave_up n' => return <| gave_up (n + n')⟩
#align slim_check.test_forall_in_list SlimCheck.testForallInList

/-- Test proposition `p` by randomly selecting one of the provided
testable instances. -/
def combineTestable (p : Prop) (t : List <| Testable p) (h : 0 < t.length) : Testable p :=
  ⟨fun cfg min =>
    have : 0 < length (map (fun t => @Testable.run _ t cfg min) t) :=
      by
      rw [length_map]
      apply h
    Gen.oneOf (List.map (fun t => @Testable.run _ t cfg min) t) this⟩
#align slim_check.combine_testable SlimCheck.combineTestable

open SampleableExt

/-- Format the counter-examples found in a test failure.
-/
def formatFailure (s : String) (xs : List String) (n : ℕ) : String :=
  let counter_ex := String.intercalate "\n" xs
  s! "
    ===================
    {s }

    {counter_ex }
    ({n} shrinks)
    -------------------
    "
#align slim_check.format_failure SlimCheck.formatFailure

/-- Format the counter-examples found in a test failure.
-/
def formatFailure' (s : String) {p} : TestResult p → String
  | success a => ""
  | gave_up a => ""
  | test_result.failure _ xs n => formatFailure s xs n
#align slim_check.format_failure' SlimCheck.formatFailure'

/-- Increase the number of shrinking steps in a test result.
-/
def addShrinks {p} (n : ℕ) : TestResult p → TestResult p
  | r@(success a) => r
  | r@(gave_up a) => r
  | test_result.failure h vs n' => TestResult.failure h vs <| n + n'
#align slim_check.add_shrinks SlimCheck.addShrinks

/-- Shrink a counter-example `x` by using `shrink x`, picking the first
candidate that falsifies a property and recursively shrinking that one.

The process is guaranteed to terminate because `shrink x` produces
a proof that all the values it produces are smaller (according to `sizeof`)
than `x`. -/
def minimizeAux [SampleableExt α] [∀ x, Testable (β x)] (cfg : SlimCheckCfg) (var : String) :
    ProxyRepr α → ℕ → OptionT Gen (Σx, TestResult (β (interp α x))) :=
  WellFounded.fix WellFoundedRelation.wf fun x f_rec n => do
    if cfg then
        return <|
          trace
            (s! "candidates for {var } :=
              {repr (sampleable_ext.shrink x).toList}
              ")
            ()
      else pure ()
    let ⟨y, r, ⟨h₁⟩⟩ ←
      (SampleableExt.shrink x).firstM fun ⟨a, h⟩ => do
          let ⟨r⟩ ←
            monadLift
                (Uliftable.up <| Testable.run (β (interp α a)) cfg true :
                  Gen (ULift <| TestResult <| β <| interp α a))
          if is_failure r then
              pure (⟨a, r, ⟨h⟩⟩ : Σa, test_result (β (interp α a)) × PLift (sizeof_lt a x))
            else failure
    if cfg then
        return <|
          trace ((s! "{var } := {repr y}") ++ format_failure' "Shrink counter-example:" r) ()
      else pure ()
    f_rec y h₁ (n + 1) <|> pure ⟨y, add_shrinks (n + 1) r⟩
#align slim_check.minimize_aux SlimCheck.minimizeAux

/-- Once a property fails to hold on an example, look for smaller counter-examples
to show the user. -/
def minimize [SampleableExt α] [∀ x, Testable (β x)] (cfg : SlimCheckCfg) (var : String)
    (x : ProxyRepr α) (r : TestResult (β (interp α x))) : Gen (Σx, TestResult (β (interp α x))) :=
  do
  if cfg then
      return <| trace ((s! "{var } := {repr x}") ++ format_failure' "Shrink counter-example:" r) ()
    else pure ()
  let x' ← OptionT.run <| minimizeAux α _ cfg var x 0
  pure <| x' ⟨x, r⟩
#align slim_check.minimize SlimCheck.minimize

instance (priority := 2000) existsTestable (p : Prop)
    [Testable (NamedBinder var (∀ x, NamedBinder var' <| β x → p))] :
    Testable (NamedBinder var' (NamedBinder var (∃ x, β x) → p)) :=
  ⟨fun cfg min => do
    let x ← Testable.run (NamedBinder var (∀ x, NamedBinder var' <| β x → p)) cfg min
    pure <| convert_counter_example' exists_imp x⟩
#align slim_check.exists_testable SlimCheck.existsTestable

/-- Test a universal property by creating a sample of the right type and instantiating the
bound variable with it -/
instance varTestable [SampleableExt α] [∀ x, Testable (β x)] :
    Testable (NamedBinder var <| ∀ x : α, β x) :=
  ⟨fun cfg min => do
    Uliftable.adaptDown (sampleable_ext.sample α) fun x => do
        let r ← testable.run (β (sampleable_ext.interp α x)) cfg ff
        Uliftable.adaptDown
            (if is_failure r ∧ min then minimize _ _ cfg var x r
            else if cfg then (trace s! "  {var } := {repr x}") <| pure ⟨x, r⟩ else pure ⟨x, r⟩)
            fun ⟨x, r⟩ =>
            return <|
              trace_if_giveup cfg var x r
                (add_var_to_counter_example var x (· <| sampleable_ext.interp α x) r)⟩
#align slim_check.var_testable SlimCheck.varTestable

/-- Test a universal property about propositions -/
instance propVarTestable (β : Prop → Prop) [I : ∀ b : Bool, Testable (β b)] :
    Testable (NamedBinder var <| ∀ p : Prop, β p) :=
  ⟨fun cfg min => do
    (convert_counter_example fun h (b : Bool) => h b) <$>
        @testable.run (named_binder var <| ∀ b : Bool, β b) _ cfg min⟩
#align slim_check.prop_var_testable SlimCheck.propVarTestable

instance (priority := 3000) unusedVarTestable (β) [Inhabited α] [Testable β] :
    Testable (NamedBinder var <| ∀ x : α, β) :=
  ⟨fun cfg min => do
    let r ← Testable.run β cfg min
    pure <| convert_counter_example (· <| default) r (PSum.inr fun x _ => x)⟩
#align slim_check.unused_var_testable SlimCheck.unusedVarTestable

instance (priority := 2000) subtypeVarTestable {p : α → Prop} [∀ x, PrintableProp (p x)]
    [∀ x, Testable (β x)] [I : SampleableExt (Subtype p)] :
    Testable (NamedBinder var <| ∀ x : α, NamedBinder var' <| p x → β x) :=
  ⟨fun cfg min => do
    let test (x : Subtype p) : Testable (β x) :=
      ⟨fun cfg min => do
        let r ← Testable.run (β x.val) cfg min
        match print_prop (p x) with
          | none => pure r
          | some str =>
            pure <| add_to_counter_example (s! "guard: {str} (by construction)") id r (PSum.inr id)⟩
    let r ← @Testable.run (∀ x : Subtype p, β x.val) (@SlimCheck.varTestable var _ _ I test) cfg min
    pure <|
        convert_counter_example'
          ⟨fun (h : ∀ x : Subtype p, β x) x h' => h ⟨x, h'⟩, fun h ⟨x, h'⟩ => h x h'⟩ r⟩
#align slim_check.subtype_var_testable SlimCheck.subtypeVarTestable

instance (priority := 100) decidableTestable (p : Prop) [PrintableProp p] [Decidable p] :
    Testable p :=
  ⟨fun cfg min =>
    return <|
      if h : p then success (PSum.inr h)
      else
        match printProp p with
        | none => failure h [] 0
        | some str => failure h [s! "issue: {str} does not hold"] 0⟩
#align slim_check.decidable_testable SlimCheck.decidableTestable

#print SlimCheck.Eq.printableProp /-
instance Eq.printableProp {α} [Repr α] (x y : α) : PrintableProp (x = y) :=
  ⟨some s!"{(repr x)} = {repr y}"⟩
#align slim_check.eq.printable_prop SlimCheck.Eq.printableProp
-/

#print SlimCheck.Ne.printableProp /-
instance Ne.printableProp {α} [Repr α] (x y : α) : PrintableProp (x ≠ y) :=
  ⟨some s!"{(repr x)} ≠ {repr y}"⟩
#align slim_check.ne.printable_prop SlimCheck.Ne.printableProp
-/

instance Le.printableProp {α} [LE α] [Repr α] (x y : α) : PrintableProp (x ≤ y) :=
  ⟨some s!"{(repr x)} ≤ {repr y}"⟩
#align slim_check.le.printable_prop SlimCheck.Le.printableProp

instance Lt.printableProp {α} [LT α] [Repr α] (x y : α) : PrintableProp (x < y) :=
  ⟨some s!"{(repr x)} < {repr y}"⟩
#align slim_check.lt.printable_prop SlimCheck.Lt.printableProp

instance Perm.printableProp {α} [Repr α] (xs ys : List α) : PrintableProp (xs ~ ys) :=
  ⟨some s!"{(repr xs)} ~ {repr ys}"⟩
#align slim_check.perm.printable_prop SlimCheck.Perm.printableProp

#print SlimCheck.And.printableProp /-
instance And.printableProp (x y : Prop) [PrintableProp x] [PrintableProp y] :
    PrintableProp (x ∧ y) :=
  ⟨do
    let x' ← printProp x
    let y' ← printProp y
    some s! "({x' } ∧ {y'})"⟩
#align slim_check.and.printable_prop SlimCheck.And.printableProp
-/

#print SlimCheck.Or.printableProp /-
instance Or.printableProp (x y : Prop) [PrintableProp x] [PrintableProp y] :
    PrintableProp (x ∨ y) :=
  ⟨do
    let x' ← printProp x
    let y' ← printProp y
    some s! "({x' } ∨ {y'})"⟩
#align slim_check.or.printable_prop SlimCheck.Or.printableProp
-/

#print SlimCheck.Iff.printableProp /-
instance Iff.printableProp (x y : Prop) [PrintableProp x] [PrintableProp y] :
    PrintableProp (x ↔ y) :=
  ⟨do
    let x' ← printProp x
    let y' ← printProp y
    some s! "({x' } ↔ {y'})"⟩
#align slim_check.iff.printable_prop SlimCheck.Iff.printableProp
-/

#print SlimCheck.Imp.printableProp /-
instance Imp.printableProp (x y : Prop) [PrintableProp x] [PrintableProp y] :
    PrintableProp (x → y) :=
  ⟨do
    let x' ← printProp x
    let y' ← printProp y
    some s! "({x' } → {y'})"⟩
#align slim_check.imp.printable_prop SlimCheck.Imp.printableProp
-/

#print SlimCheck.Not.printableProp /-
instance Not.printableProp (x : Prop) [PrintableProp x] : PrintableProp ¬x :=
  ⟨do
    let x' ← printProp x
    some s! "¬ {x'}"⟩
#align slim_check.not.printable_prop SlimCheck.Not.printableProp
-/

#print SlimCheck.True.printableProp /-
instance True.printableProp : PrintableProp True :=
  ⟨some "true"⟩
#align slim_check.true.printable_prop SlimCheck.True.printableProp
-/

#print SlimCheck.False.printableProp /-
instance False.printableProp : PrintableProp False :=
  ⟨some "false"⟩
#align slim_check.false.printable_prop SlimCheck.False.printableProp
-/

#print SlimCheck.Bool.printableProp /-
instance Bool.printableProp (b : Bool) : PrintableProp b :=
  ⟨some <| if b then "true" else "false"⟩
#align slim_check.bool.printable_prop SlimCheck.Bool.printableProp
-/

section Io

open _Root_.Nat

variable {p : Prop}

#print SlimCheck.retry /-
/-- Execute `cmd` and repeat every time the result is `gave_up` (at most
`n` times). -/
def retry (cmd : Rand (TestResult p)) : ℕ → Rand (TestResult p)
  | 0 => return <| gaveUp 1
  | succ n => do
    let r ← cmd
    match r with
      | success hp => return <| success hp
      | failure Hce xs n => return (failure Hce xs n)
      | gave_up _ => retry n
#align slim_check.retry SlimCheck.retry
-/

#print SlimCheck.giveUp /-
/-- Count the number of times the test procedure gave up. -/
def giveUp (x : ℕ) : TestResult p → TestResult p
  | success (PSum.inl ()) => gaveUp x
  | success (PSum.inr p) => success (PSum.inr p)
  | gave_up n => gaveUp (n + x)
  | failure Hce xs n => failure Hce xs n
#align slim_check.give_up SlimCheck.giveUp
-/

variable (p)

variable [Testable p]

/- warning: slim_check.testable.run_suite_aux -> SlimCheck.Testable.runSuiteAux is a dubious translation:
lean 3 declaration is
  forall (p : Prop) [_inst_1 : SlimCheck.Testable p], SlimCheck.SlimCheckCfg -> (SlimCheck.TestResult p) -> Nat -> (Rand.{0} (SlimCheck.TestResult p))
but is expected to have type
  forall (p : Prop) [_inst_1 : SlimCheck.Testable p], SlimCheck.Configuration -> (SlimCheck.TestResult p) -> Nat -> (Rand.{0} (SlimCheck.TestResult p))
Case conversion may be inaccurate. Consider using '#align slim_check.testable.run_suite_aux SlimCheck.Testable.runSuiteAuxₓ'. -/
/-- Try `n` times to find a counter-example for `p`. -/
def Testable.runSuiteAux (cfg : SlimCheckCfg) : TestResult p → ℕ → Rand (TestResult p)
  | r, 0 => return r
  | r, succ n => do
    let size := (cfg.numInst - n - 1) * cfg.maxSize / cfg.numInst
    when cfg <| return <| trace s!"[slim_check: sample]" ()
    let x ← retry ((Testable.run p cfg true).run ⟨size⟩) 10
    match x with
      | success (PSum.inl ()) => testable.run_suite_aux r n
      | success (PSum.inr Hp) => return <| success (PSum.inr Hp)
      | failure Hce xs n => return (failure Hce xs n)
      | gave_up g => testable.run_suite_aux (give_up g r) n
#align slim_check.testable.run_suite_aux SlimCheck.Testable.runSuiteAux

/- warning: slim_check.testable.run_suite -> SlimCheck.Testable.runSuite is a dubious translation:
lean 3 declaration is
  forall (p : Prop) [_inst_1 : SlimCheck.Testable p], (optParam.{1} SlimCheck.SlimCheckCfg (SlimCheck.SlimCheckCfg.mk (OfNat.ofNat.{0} Nat 100 (OfNat.mk.{0} Nat 100 (bit0.{0} Nat Nat.hasAdd (bit0.{0} Nat Nat.hasAdd (bit1.{0} Nat Nat.hasOne Nat.hasAdd (bit0.{0} Nat Nat.hasAdd (bit0.{0} Nat Nat.hasAdd (bit1.{0} Nat Nat.hasOne Nat.hasAdd (One.one.{0} Nat Nat.hasOne))))))))) (OfNat.ofNat.{0} Nat 100 (OfNat.mk.{0} Nat 100 (bit0.{0} Nat Nat.hasAdd (bit0.{0} Nat Nat.hasAdd (bit1.{0} Nat Nat.hasOne Nat.hasAdd (bit0.{0} Nat Nat.hasAdd (bit0.{0} Nat Nat.hasAdd (bit1.{0} Nat Nat.hasOne Nat.hasAdd (One.one.{0} Nat Nat.hasOne))))))))) Bool.false Bool.false Bool.false Bool.false (Option.none.{0} Nat) Bool.false)) -> (Rand.{0} (SlimCheck.TestResult p))
but is expected to have type
  forall (p : Prop) [_inst_1 : SlimCheck.Testable p], (optParam.{1} SlimCheck.Configuration (SlimCheck.Configuration.mk ([mdata structInstDefault:1 OfNat.ofNat.{0} Nat 100 (instOfNatNat 100)]) ([mdata structInstDefault:1 OfNat.ofNat.{0} Nat 100 (instOfNatNat 100)]) ([mdata structInstDefault:1 OfNat.ofNat.{0} Nat 10 (instOfNatNat 10)]) ([mdata structInstDefault:1 Bool.false]) ([mdata structInstDefault:1 Bool.false]) ([mdata structInstDefault:1 Bool.false]) ([mdata structInstDefault:1 Bool.false]) ([mdata structInstDefault:1 Option.none.{0} Nat]) ([mdata structInstDefault:1 Bool.false]))) -> (Rand.{0} (SlimCheck.TestResult p))
Case conversion may be inaccurate. Consider using '#align slim_check.testable.run_suite SlimCheck.Testable.runSuiteₓ'. -/
/-- Try to find a counter-example of `p`. -/
def Testable.runSuite (cfg : SlimCheckCfg := { }) : Rand (TestResult p) :=
  Testable.runSuiteAux p cfg (success <| PSum.inl ()) cfg.numInst
#align slim_check.testable.run_suite SlimCheck.Testable.runSuite

/-- Run a test suite for `p` in `io`. -/
def Testable.check' (cfg : SlimCheckCfg := { }) : Io (TestResult p) :=
  match cfg.randomSeed with
  | some seed => Io.runRandWith seed (Testable.runSuite p cfg)
  | none => Io.runRand (Testable.runSuite p cfg)
#align slim_check.testable.check' SlimCheck.Testable.check'

namespace Tactic

open _Root_.Tactic Expr

/-!
## Decorations

Instances of `testable` use `named_binder` as a decoration on
propositions in order to access the name of bound variables, as in
`named_binder "x" (forall x, x < y)`.  This helps the
`testable` instances create useful error messages where variables
are matched with values that falsify a given proposition.

The following functions help support the gadget so that the user does
not have to put them in themselves.
-/

/-- `add_existential_decorations p` adds `a `named_binder` annotation at the
root of `p` if `p` is an existential quantification. -/
unsafe def add_existential_decorations : expr → expr
  | e@q(@Exists $(α) $(lam n bi d b)) =>
    let n := toString n
    const `` named_binder [] (q(n) : expr) e
  | e => e
#align slim_check.tactic.add_existential_decorations slim_check.tactic.add_existential_decorations

/-- Traverse the syntax of a proposition to find universal quantifiers
and existential quantifiers and add `named_binder` annotations next to
them. -/
unsafe def add_decorations : expr → expr
  | e =>
    e.replace fun e _ =>
      match e with
      | pi n bi d b =>
        let n := toString n
        some <|
          const `` named_binder [] (q(n) : expr)
            (pi n bi (add_existential_decorations d) (add_decorations b))
      | e => none
#align slim_check.tactic.add_decorations slim_check.tactic.add_decorations

/-- `decorations_of p` is used as a hint to `mk_decorations` to specify
that the goal should be satisfied with a proposition equivalent to `p`
with added annotations. -/
@[reducible, nolint unused_arguments]
def DecorationsOf (p : Prop) :=
  Prop
#align slim_check.tactic.decorations_of SlimCheck.Tactic.DecorationsOf

/-- In a goal of the shape `⊢ tactic.decorations_of p`, `mk_decoration` examines
the syntax of `p` and add `named_binder` around universal quantifications and
existential quantifications to improve error messages.

This tool can be used in the declaration of a function as follows:

```lean
def foo (p : Prop) (p' : tactic.decorations_of p . mk_decorations) [testable p'] : ...
```

`p` is the parameter given by the user, `p'` is an equivalent proposition where
the quantifiers are annotated with `named_binder`.
-/
unsafe def mk_decorations : tactic Unit := do
  let q(Tactic.DecorationsOf $(p)) ← target
  exact <| add_decorations p
#align slim_check.tactic.mk_decorations slim_check.tactic.mk_decorations

end Tactic

/- warning: slim_check.testable.check -> SlimCheck.Testable.check is a dubious translation:
lean 3 declaration is
  forall (p : Prop), (optParam.{1} SlimCheck.SlimCheckCfg (SlimCheck.SlimCheckCfg.mk (OfNat.ofNat.{0} Nat 100 (OfNat.mk.{0} Nat 100 (bit0.{0} Nat Nat.hasAdd (bit0.{0} Nat Nat.hasAdd (bit1.{0} Nat Nat.hasOne Nat.hasAdd (bit0.{0} Nat Nat.hasAdd (bit0.{0} Nat Nat.hasAdd (bit1.{0} Nat Nat.hasOne Nat.hasAdd (One.one.{0} Nat Nat.hasOne))))))))) (OfNat.ofNat.{0} Nat 100 (OfNat.mk.{0} Nat 100 (bit0.{0} Nat Nat.hasAdd (bit0.{0} Nat Nat.hasAdd (bit1.{0} Nat Nat.hasOne Nat.hasAdd (bit0.{0} Nat Nat.hasAdd (bit0.{0} Nat Nat.hasAdd (bit1.{0} Nat Nat.hasOne Nat.hasAdd (One.one.{0} Nat Nat.hasOne))))))))) Bool.false Bool.false Bool.false Bool.false (Option.none.{0} Nat) Bool.false)) -> (forall (p' : autoParamₓ.{1} (SlimCheck.Tactic.DecorationsOf p) (Name.mk_string (String.str (String.str (String.str (String.str (String.str (String.str (String.str (String.str (String.str (String.str (String.str (String.str (String.str (String.str String.empty (Char.ofNat (OfNat.ofNat.{0} Nat 109 (OfNat.mk.{0} Nat 109 (bit1.{0} Nat Nat.hasOne Nat.hasAdd (bit0.{0} Nat Nat.hasAdd (bit1.{0} Nat Nat.hasOne Nat.hasAdd (bit1.{0} Nat Nat.hasOne Nat.hasAdd (bit0.{0} Nat Nat.hasAdd (bit1.{0} Nat Nat.hasOne Nat.hasAdd (One.one.{0} Nat Nat.hasOne))))))))))) (Char.ofNat (OfNat.ofNat.{0} Nat 107 (OfNat.mk.{0} Nat 107 (bit1.{0} Nat Nat.hasOne Nat.hasAdd (bit1.{0} Nat Nat.hasOne Nat.hasAdd (bit0.{0} Nat Nat.hasAdd (bit1.{0} Nat Nat.hasOne Nat.hasAdd (bit0.{0} Nat Nat.hasAdd (bit1.{0} Nat Nat.hasOne Nat.hasAdd (One.one.{0} Nat Nat.hasOne))))))))))) (Char.ofNat (OfNat.ofNat.{0} Nat 95 (OfNat.mk.{0} Nat 95 (bit1.{0} Nat Nat.hasOne Nat.hasAdd (bit1.{0} Nat Nat.hasOne Nat.hasAdd (bit1.{0} Nat Nat.hasOne Nat.hasAdd (bit1.{0} Nat Nat.hasOne Nat.hasAdd (bit1.{0} Nat Nat.hasOne Nat.hasAdd (bit0.{0} Nat Nat.hasAdd (One.one.{0} Nat Nat.hasOne))))))))))) (Char.ofNat (OfNat.ofNat.{0} Nat 100 (OfNat.mk.{0} Nat 100 (bit0.{0} Nat Nat.hasAdd (bit0.{0} Nat Nat.hasAdd (bit1.{0} Nat Nat.hasOne Nat.hasAdd (bit0.{0} Nat Nat.hasAdd (bit0.{0} Nat Nat.hasAdd (bit1.{0} Nat Nat.hasOne Nat.hasAdd (One.one.{0} Nat Nat.hasOne))))))))))) (Char.ofNat (OfNat.ofNat.{0} Nat 101 (OfNat.mk.{0} Nat 101 (bit1.{0} Nat Nat.hasOne Nat.hasAdd (bit0.{0} Nat Nat.hasAdd (bit1.{0} Nat Nat.hasOne Nat.hasAdd (bit0.{0} Nat Nat.hasAdd (bit0.{0} Nat Nat.hasAdd (bit1.{0} Nat Nat.hasOne Nat.hasAdd (One.one.{0} Nat Nat.hasOne))))))))))) (Char.ofNat (OfNat.ofNat.{0} Nat 99 (OfNat.mk.{0} Nat 99 (bit1.{0} Nat Nat.hasOne Nat.hasAdd (bit1.{0} Nat Nat.hasOne Nat.hasAdd (bit0.{0} Nat Nat.hasAdd (bit0.{0} Nat Nat.hasAdd (bit0.{0} Nat Nat.hasAdd (bit1.{0} Nat Nat.hasOne Nat.hasAdd (One.one.{0} Nat Nat.hasOne))))))))))) (Char.ofNat (OfNat.ofNat.{0} Nat 111 (OfNat.mk.{0} Nat 111 (bit1.{0} Nat Nat.hasOne Nat.hasAdd (bit1.{0} Nat Nat.hasOne Nat.hasAdd (bit1.{0} Nat Nat.hasOne Nat.hasAdd (bit1.{0} Nat Nat.hasOne Nat.hasAdd (bit0.{0} Nat Nat.hasAdd (bit1.{0} Nat Nat.hasOne Nat.hasAdd (One.one.{0} Nat Nat.hasOne))))))))))) (Char.ofNat (OfNat.ofNat.{0} Nat 114 (OfNat.mk.{0} Nat 114 (bit0.{0} Nat Nat.hasAdd (bit1.{0} Nat Nat.hasOne Nat.hasAdd (bit0.{0} Nat Nat.hasAdd (bit0.{0} Nat Nat.hasAdd (bit1.{0} Nat Nat.hasOne Nat.hasAdd (bit1.{0} Nat Nat.hasOne Nat.hasAdd (One.one.{0} Nat Nat.hasOne))))))))))) (Char.ofNat (OfNat.ofNat.{0} Nat 97 (OfNat.mk.{0} Nat 97 (bit1.{0} Nat Nat.hasOne Nat.hasAdd (bit0.{0} Nat Nat.hasAdd (bit0.{0} Nat Nat.hasAdd (bit0.{0} Nat Nat.hasAdd (bit0.{0} Nat Nat.hasAdd (bit1.{0} Nat Nat.hasOne Nat.hasAdd (One.one.{0} Nat Nat.hasOne))))))))))) (Char.ofNat (OfNat.ofNat.{0} Nat 116 (OfNat.mk.{0} Nat 116 (bit0.{0} Nat Nat.hasAdd (bit0.{0} Nat Nat.hasAdd (bit1.{0} Nat Nat.hasOne Nat.hasAdd (bit0.{0} Nat Nat.hasAdd (bit1.{0} Nat Nat.hasOne Nat.hasAdd (bit1.{0} Nat Nat.hasOne Nat.hasAdd (One.one.{0} Nat Nat.hasOne))))))))))) (Char.ofNat (OfNat.ofNat.{0} Nat 105 (OfNat.mk.{0} Nat 105 (bit1.{0} Nat Nat.hasOne Nat.hasAdd (bit0.{0} Nat Nat.hasAdd (bit0.{0} Nat Nat.hasAdd (bit1.{0} Nat Nat.hasOne Nat.hasAdd (bit0.{0} Nat Nat.hasAdd (bit1.{0} Nat Nat.hasOne Nat.hasAdd (One.one.{0} Nat Nat.hasOne))))))))))) (Char.ofNat (OfNat.ofNat.{0} Nat 111 (OfNat.mk.{0} Nat 111 (bit1.{0} Nat Nat.hasOne Nat.hasAdd (bit1.{0} Nat Nat.hasOne Nat.hasAdd (bit1.{0} Nat Nat.hasOne Nat.hasAdd (bit1.{0} Nat Nat.hasOne Nat.hasAdd (bit0.{0} Nat Nat.hasAdd (bit1.{0} Nat Nat.hasOne Nat.hasAdd (One.one.{0} Nat Nat.hasOne))))))))))) (Char.ofNat (OfNat.ofNat.{0} Nat 110 (OfNat.mk.{0} Nat 110 (bit0.{0} Nat Nat.hasAdd (bit1.{0} Nat Nat.hasOne Nat.hasAdd (bit1.{0} Nat Nat.hasOne Nat.hasAdd (bit1.{0} Nat Nat.hasOne Nat.hasAdd (bit0.{0} Nat Nat.hasAdd (bit1.{0} Nat Nat.hasOne Nat.hasAdd (One.one.{0} Nat Nat.hasOne))))))))))) (Char.ofNat (OfNat.ofNat.{0} Nat 115 (OfNat.mk.{0} Nat 115 (bit1.{0} Nat Nat.hasOne Nat.hasAdd (bit1.{0} Nat Nat.hasOne Nat.hasAdd (bit0.{0} Nat Nat.hasAdd (bit0.{0} Nat Nat.hasAdd (bit1.{0} Nat Nat.hasOne Nat.hasAdd (bit1.{0} Nat Nat.hasOne Nat.hasAdd (One.one.{0} Nat Nat.hasOne))))))))))) (Name.mk_string (String.str (String.str (String.str (String.str (String.str (String.str String.empty (Char.ofNat (OfNat.ofNat.{0} Nat 116 (OfNat.mk.{0} Nat 116 (bit0.{0} Nat Nat.hasAdd (bit0.{0} Nat Nat.hasAdd (bit1.{0} Nat Nat.hasOne Nat.hasAdd (bit0.{0} Nat Nat.hasAdd (bit1.{0} Nat Nat.hasOne Nat.hasAdd (bit1.{0} Nat Nat.hasOne Nat.hasAdd (One.one.{0} Nat Nat.hasOne))))))))))) (Char.ofNat (OfNat.ofNat.{0} Nat 97 (OfNat.mk.{0} Nat 97 (bit1.{0} Nat Nat.hasOne Nat.hasAdd (bit0.{0} Nat Nat.hasAdd (bit0.{0} Nat Nat.hasAdd (bit0.{0} Nat Nat.hasAdd (bit0.{0} Nat Nat.hasAdd (bit1.{0} Nat Nat.hasOne Nat.hasAdd (One.one.{0} Nat Nat.hasOne))))))))))) (Char.ofNat (OfNat.ofNat.{0} Nat 99 (OfNat.mk.{0} Nat 99 (bit1.{0} Nat Nat.hasOne Nat.hasAdd (bit1.{0} Nat Nat.hasOne Nat.hasAdd (bit0.{0} Nat Nat.hasAdd (bit0.{0} Nat Nat.hasAdd (bit0.{0} Nat Nat.hasAdd (bit1.{0} Nat Nat.hasOne Nat.hasAdd (One.one.{0} Nat Nat.hasOne))))))))))) (Char.ofNat (OfNat.ofNat.{0} Nat 116 (OfNat.mk.{0} Nat 116 (bit0.{0} Nat Nat.hasAdd (bit0.{0} Nat Nat.hasAdd (bit1.{0} Nat Nat.hasOne Nat.hasAdd (bit0.{0} Nat Nat.hasAdd (bit1.{0} Nat Nat.hasOne Nat.hasAdd (bit1.{0} Nat Nat.hasOne Nat.hasAdd (One.one.{0} Nat Nat.hasOne))))))))))) (Char.ofNat (OfNat.ofNat.{0} Nat 105 (OfNat.mk.{0} Nat 105 (bit1.{0} Nat Nat.hasOne Nat.hasAdd (bit0.{0} Nat Nat.hasAdd (bit0.{0} Nat Nat.hasAdd (bit1.{0} Nat Nat.hasOne Nat.hasAdd (bit0.{0} Nat Nat.hasAdd (bit1.{0} Nat Nat.hasOne Nat.hasAdd (One.one.{0} Nat Nat.hasOne))))))))))) (Char.ofNat (OfNat.ofNat.{0} Nat 99 (OfNat.mk.{0} Nat 99 (bit1.{0} Nat Nat.hasOne Nat.hasAdd (bit1.{0} Nat Nat.hasOne Nat.hasAdd (bit0.{0} Nat Nat.hasAdd (bit0.{0} Nat Nat.hasAdd (bit0.{0} Nat Nat.hasAdd (bit1.{0} Nat Nat.hasOne Nat.hasAdd (One.one.{0} Nat Nat.hasOne))))))))))) (Name.mk_string (String.str (String.str (String.str (String.str (String.str (String.str (String.str (String.str (String.str (String.str String.empty (Char.ofNat (OfNat.ofNat.{0} Nat 115 (OfNat.mk.{0} Nat 115 (bit1.{0} Nat Nat.hasOne Nat.hasAdd (bit1.{0} Nat Nat.hasOne Nat.hasAdd (bit0.{0} Nat Nat.hasAdd (bit0.{0} Nat Nat.hasAdd (bit1.{0} Nat Nat.hasOne Nat.hasAdd (bit1.{0} Nat Nat.hasOne Nat.hasAdd (One.one.{0} Nat Nat.hasOne))))))))))) (Char.ofNat (OfNat.ofNat.{0} Nat 108 (OfNat.mk.{0} Nat 108 (bit0.{0} Nat Nat.hasAdd (bit0.{0} Nat Nat.hasAdd (bit1.{0} Nat Nat.hasOne Nat.hasAdd (bit1.{0} Nat Nat.hasOne Nat.hasAdd (bit0.{0} Nat Nat.hasAdd (bit1.{0} Nat Nat.hasOne Nat.hasAdd (One.one.{0} Nat Nat.hasOne))))))))))) (Char.ofNat (OfNat.ofNat.{0} Nat 105 (OfNat.mk.{0} Nat 105 (bit1.{0} Nat Nat.hasOne Nat.hasAdd (bit0.{0} Nat Nat.hasAdd (bit0.{0} Nat Nat.hasAdd (bit1.{0} Nat Nat.hasOne Nat.hasAdd (bit0.{0} Nat Nat.hasAdd (bit1.{0} Nat Nat.hasOne Nat.hasAdd (One.one.{0} Nat Nat.hasOne))))))))))) (Char.ofNat (OfNat.ofNat.{0} Nat 109 (OfNat.mk.{0} Nat 109 (bit1.{0} Nat Nat.hasOne Nat.hasAdd (bit0.{0} Nat Nat.hasAdd (bit1.{0} Nat Nat.hasOne Nat.hasAdd (bit1.{0} Nat Nat.hasOne Nat.hasAdd (bit0.{0} Nat Nat.hasAdd (bit1.{0} Nat Nat.hasOne Nat.hasAdd (One.one.{0} Nat Nat.hasOne))))))))))) (Char.ofNat (OfNat.ofNat.{0} Nat 95 (OfNat.mk.{0} Nat 95 (bit1.{0} Nat Nat.hasOne Nat.hasAdd (bit1.{0} Nat Nat.hasOne Nat.hasAdd (bit1.{0} Nat Nat.hasOne Nat.hasAdd (bit1.{0} Nat Nat.hasOne Nat.hasAdd (bit1.{0} Nat Nat.hasOne Nat.hasAdd (bit0.{0} Nat Nat.hasAdd (One.one.{0} Nat Nat.hasOne))))))))))) (Char.ofNat (OfNat.ofNat.{0} Nat 99 (OfNat.mk.{0} Nat 99 (bit1.{0} Nat Nat.hasOne Nat.hasAdd (bit1.{0} Nat Nat.hasOne Nat.hasAdd (bit0.{0} Nat Nat.hasAdd (bit0.{0} Nat Nat.hasAdd (bit0.{0} Nat Nat.hasAdd (bit1.{0} Nat Nat.hasOne Nat.hasAdd (One.one.{0} Nat Nat.hasOne))))))))))) (Char.ofNat (OfNat.ofNat.{0} Nat 104 (OfNat.mk.{0} Nat 104 (bit0.{0} Nat Nat.hasAdd (bit0.{0} Nat Nat.hasAdd (bit0.{0} Nat Nat.hasAdd (bit1.{0} Nat Nat.hasOne Nat.hasAdd (bit0.{0} Nat Nat.hasAdd (bit1.{0} Nat Nat.hasOne Nat.hasAdd (One.one.{0} Nat Nat.hasOne))))))))))) (Char.ofNat (OfNat.ofNat.{0} Nat 101 (OfNat.mk.{0} Nat 101 (bit1.{0} Nat Nat.hasOne Nat.hasAdd (bit0.{0} Nat Nat.hasAdd (bit1.{0} Nat Nat.hasOne Nat.hasAdd (bit0.{0} Nat Nat.hasAdd (bit0.{0} Nat Nat.hasAdd (bit1.{0} Nat Nat.hasOne Nat.hasAdd (One.one.{0} Nat Nat.hasOne))))))))))) (Char.ofNat (OfNat.ofNat.{0} Nat 99 (OfNat.mk.{0} Nat 99 (bit1.{0} Nat Nat.hasOne Nat.hasAdd (bit1.{0} Nat Nat.hasOne Nat.hasAdd (bit0.{0} Nat Nat.hasAdd (bit0.{0} Nat Nat.hasAdd (bit0.{0} Nat Nat.hasAdd (bit1.{0} Nat Nat.hasOne Nat.hasAdd (One.one.{0} Nat Nat.hasOne))))))))))) (Char.ofNat (OfNat.ofNat.{0} Nat 107 (OfNat.mk.{0} Nat 107 (bit1.{0} Nat Nat.hasOne Nat.hasAdd (bit1.{0} Nat Nat.hasOne Nat.hasAdd (bit0.{0} Nat Nat.hasAdd (bit1.{0} Nat Nat.hasOne Nat.hasAdd (bit0.{0} Nat Nat.hasAdd (bit1.{0} Nat Nat.hasOne Nat.hasAdd (One.one.{0} Nat Nat.hasOne))))))))))) Name.anonymous)))) [_inst_2 : SlimCheck.Testable p'], Io PUnit.{1})
but is expected to have type
  forall (p : Prop), (optParam.{1} SlimCheck.Configuration (SlimCheck.Configuration.mk ([mdata structInstDefault:1 OfNat.ofNat.{0} Nat 100 (instOfNatNat 100)]) ([mdata structInstDefault:1 OfNat.ofNat.{0} Nat 100 (instOfNatNat 100)]) ([mdata structInstDefault:1 OfNat.ofNat.{0} Nat 10 (instOfNatNat 10)]) ([mdata structInstDefault:1 Bool.false]) ([mdata structInstDefault:1 Bool.false]) ([mdata structInstDefault:1 Bool.false]) ([mdata structInstDefault:1 Bool.false]) ([mdata structInstDefault:1 Option.none.{0} Nat]) ([mdata structInstDefault:1 Bool.false]))) -> (forall (p' : autoParam.{1} (SlimCheck.Decorations.DecorationsOf p) _auto._@.Mathlib.Testing.SlimCheck.Testable._hyg.6287) [_inst_2 : SlimCheck.Testable p'], IO PUnit.{1})
Case conversion may be inaccurate. Consider using '#align slim_check.testable.check SlimCheck.Testable.checkₓ'. -/
/- ./././Mathport/Syntax/Translate/Tactic/Builtin.lean:69:18: unsupported non-interactive tactic tactic.mk_decorations -/
/-- Run a test suite for `p` and return true or false: should we believe that `p` holds? -/
def Testable.check (p : Prop) (cfg : SlimCheckCfg := { })
    (p' : Tactic.DecorationsOf p := by
      run_tac
        tactic.mk_decorations)
    [Testable p'] : Io PUnit := do
  let x ←
    match cfg.randomSeed with
      | some seed => Io.runRandWith seed (Testable.runSuite p' cfg)
      | none => Io.runRand (Testable.runSuite p' cfg)
  match x with
    | success _ => when ¬cfg <| Io.putStrLn "Success"
    | gave_up n => Io.fail s! "Gave up {repr n} times"
    | failure _ xs n => do
      Io.fail <| format_failure "Found problems!" xs n
#align slim_check.testable.check SlimCheck.Testable.check

end Io

end SlimCheck


/-
Copyright (c) 2018 Ellen Arlt. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Ellen Arlt, Blair Shi, Sean Leather, Mario Carneiro, Johan Commelin
-/
import data.matrix.basic

/-!
# Block Matrices

## Main definitions

* `matrix.from_blocks`: build a block matrix out of 4 blocks
* `matrix.to_blocks₁₁`, `matrix.to_blocks₁₂`, `matrix.to_blocks₂₁`, `matrix.to_blocks₂₂`:
  extract each of the four blocks from `matrix.from_blocks`.
* `matrix.block_diagonal`: block diagonal of equally sized blocks
* `matrix.block_diagonal'`: block diagonal of unequally sized blocks
-/

variables {l m n o : Type*} {m' : o → Type*} {n' : o → Type*}
variables {R : Type*} {S : Type*} {α : Type*} {β : Type*}

open_locale matrix

namespace matrix

section block_matrices

/-- We can form a single large matrix by flattening smaller 'block' matrices of compatible
dimensions. -/
@[pp_nodot]
def from_blocks (A : matrix n l α) (B : matrix n m α) (C : matrix o l α) (D : matrix o m α) :
  matrix (n ⊕ o) (l ⊕ m) α :=
sum.elim (λ i, sum.elim (A i) (B i))
         (λ i, sum.elim (C i) (D i))

@[simp] lemma from_blocks_apply₁₁
  (A : matrix n l α) (B : matrix n m α) (C : matrix o l α) (D : matrix o m α) (i : n) (j : l) :
  from_blocks A B C D (sum.inl i) (sum.inl j) = A i j :=
rfl

@[simp] lemma from_blocks_apply₁₂
  (A : matrix n l α) (B : matrix n m α) (C : matrix o l α) (D : matrix o m α) (i : n) (j : m) :
  from_blocks A B C D (sum.inl i) (sum.inr j) = B i j :=
rfl

@[simp] lemma from_blocks_apply₂₁
  (A : matrix n l α) (B : matrix n m α) (C : matrix o l α) (D : matrix o m α) (i : o) (j : l) :
  from_blocks A B C D (sum.inr i) (sum.inl j) = C i j :=
rfl

@[simp] lemma from_blocks_apply₂₂
  (A : matrix n l α) (B : matrix n m α) (C : matrix o l α) (D : matrix o m α) (i : o) (j : m) :
  from_blocks A B C D (sum.inr i) (sum.inr j) = D i j :=
rfl

/-- Given a matrix whose row and column indexes are sum types, we can extract the corresponding
"top left" submatrix. -/
def to_blocks₁₁ (M : matrix (n ⊕ o) (l ⊕ m) α) : matrix n l α :=
λ i j, M (sum.inl i) (sum.inl j)

/-- Given a matrix whose row and column indexes are sum types, we can extract the corresponding
"top right" submatrix. -/
def to_blocks₁₂ (M : matrix (n ⊕ o) (l ⊕ m) α) : matrix n m α :=
λ i j, M (sum.inl i) (sum.inr j)

/-- Given a matrix whose row and column indexes are sum types, we can extract the corresponding
"bottom left" submatrix. -/
def to_blocks₂₁ (M : matrix (n ⊕ o) (l ⊕ m) α) : matrix o l α :=
λ i j, M (sum.inr i) (sum.inl j)

/-- Given a matrix whose row and column indexes are sum types, we can extract the corresponding
"bottom right" submatrix. -/
def to_blocks₂₂ (M : matrix (n ⊕ o) (l ⊕ m) α) : matrix o m α :=
λ i j, M (sum.inr i) (sum.inr j)

lemma from_blocks_to_blocks (M : matrix (n ⊕ o) (l ⊕ m) α) :
  from_blocks M.to_blocks₁₁ M.to_blocks₁₂ M.to_blocks₂₁ M.to_blocks₂₂ = M :=
begin
  ext i j, rcases i; rcases j; refl,
end

@[simp] lemma to_blocks_from_blocks₁₁
  (A : matrix n l α) (B : matrix n m α) (C : matrix o l α) (D : matrix o m α) :
  (from_blocks A B C D).to_blocks₁₁ = A :=
rfl

@[simp] lemma to_blocks_from_blocks₁₂
  (A : matrix n l α) (B : matrix n m α) (C : matrix o l α) (D : matrix o m α) :
  (from_blocks A B C D).to_blocks₁₂ = B :=
rfl

@[simp] lemma to_blocks_from_blocks₂₁
  (A : matrix n l α) (B : matrix n m α) (C : matrix o l α) (D : matrix o m α) :
  (from_blocks A B C D).to_blocks₂₁ = C :=
rfl

@[simp] lemma to_blocks_from_blocks₂₂
  (A : matrix n l α) (B : matrix n m α) (C : matrix o l α) (D : matrix o m α) :
  (from_blocks A B C D).to_blocks₂₂ = D :=
rfl

lemma from_blocks_map
  (A : matrix n l α) (B : matrix n m α) (C : matrix o l α) (D : matrix o m α) (f : α → β) :
  (from_blocks A B C D).map f = from_blocks (A.map f) (B.map f) (C.map f) (D.map f) :=
begin
  ext i j, rcases i; rcases j; simp [from_blocks],
end

lemma from_blocks_transpose
  (A : matrix n l α) (B : matrix n m α) (C : matrix o l α) (D : matrix o m α) :
  (from_blocks A B C D)ᵀ = from_blocks Aᵀ Cᵀ Bᵀ Dᵀ :=
begin
  ext i j, rcases i; rcases j; simp [from_blocks],
end

lemma from_blocks_conj_transpose [has_star α]
  (A : matrix n l α) (B : matrix n m α) (C : matrix o l α) (D : matrix o m α) :
  (from_blocks A B C D)ᴴ = from_blocks Aᴴ Cᴴ Bᴴ Dᴴ :=
begin
  simp only [conj_transpose, from_blocks_transpose, from_blocks_map]
end

/-- A 2x2 block matrix is block diagonal if the blocks outside of the diagonal vanish -/
def is_two_block_diagonal [has_zero α] (A : matrix (n ⊕ o) (l ⊕ m) α) : Prop :=
to_blocks₁₂ A = 0 ∧ to_blocks₂₁ A = 0

/-- Let `p` pick out certain rows and `q` pick out certain columns of a matrix `M`. Then
  `to_block M p q` is the corresponding block matrix. -/
def to_block (M : matrix m n α) (p : m → Prop) (q : n → Prop) :
  matrix {a // p a} {a // q a} α := M.minor coe coe

@[simp] lemma to_block_apply (M : matrix m n α) (p : m → Prop) (q : n → Prop)
  (i : {a // p a}) (j : {a // q a}) : to_block M p q i j = M ↑i ↑j := rfl

/-- Let `b` map rows and columns of a square matrix `M` to blocks. Then
  `to_square_block M b k` is the block `k` matrix. -/
def to_square_block (M : matrix m m α) {n : nat} (b : m → fin n) (k : fin n) :
  matrix {a // b a = k} {a // b a = k} α := M.minor coe coe

@[simp] lemma to_square_block_def (M : matrix m m α) {n : nat} (b : m → fin n) (k : fin n) :
  to_square_block M b k = λ i j, M ↑i ↑j := rfl

/-- Alternate version with `b : m → nat`. Let `b` map rows and columns of a square matrix `M` to
  blocks. Then `to_square_block' M b k` is the block `k` matrix. -/
def to_square_block' (M : matrix m m α) (b : m → nat) (k : nat) :
  matrix {a // b a = k} {a // b a = k} α := M.minor coe coe

@[simp] lemma to_square_block_def' (M : matrix m m α) (b : m → nat) (k : nat) :
  to_square_block' M b k = λ i j, M ↑i ↑j := rfl

/-- Let `p` pick out certain rows and columns of a square matrix `M`. Then
  `to_square_block_prop M p` is the corresponding block matrix. -/
def to_square_block_prop (M : matrix m m α) (p : m → Prop) :
  matrix {a // p a} {a // p a} α := M.minor coe coe

@[simp] lemma to_square_block_prop_def (M : matrix m m α) (p : m → Prop) :
  to_square_block_prop M p = λ i j, M ↑i ↑j := rfl

variables [semiring α]

lemma from_blocks_smul
  (x : α) (A : matrix n l α) (B : matrix n m α) (C : matrix o l α) (D : matrix o m α) :
  x • (from_blocks A B C D) = from_blocks (x • A) (x • B) (x • C) (x • D) :=
begin
  ext i j, rcases i; rcases j; simp [from_blocks],
end

lemma from_blocks_add
  (A  : matrix n l α) (B  : matrix n m α) (C  : matrix o l α) (D  : matrix o m α)
  (A' : matrix n l α) (B' : matrix n m α) (C' : matrix o l α) (D' : matrix o m α) :
  (from_blocks A B C D) + (from_blocks A' B' C' D') =
  from_blocks (A + A') (B + B')
              (C + C') (D + D') :=
begin
  ext i j, rcases i; rcases j; refl,
end

lemma from_blocks_multiply {p q : Type*} [fintype l] [fintype m]
  (A  : matrix n l α) (B  : matrix n m α) (C  : matrix o l α) (D  : matrix o m α)
  (A' : matrix l p α) (B' : matrix l q α) (C' : matrix m p α) (D' : matrix m q α) :
  (from_blocks A B C D) ⬝ (from_blocks A' B' C' D') =
  from_blocks (A ⬝ A' + B ⬝ C') (A ⬝ B' + B ⬝ D')
              (C ⬝ A' + D ⬝ C') (C ⬝ B' + D ⬝ D') :=
begin
  ext i j, rcases i; rcases j;
  simp only [from_blocks, mul_apply, fintype.sum_sum_type, sum.elim_inl, sum.elim_inr,
    pi.add_apply],
end

variables [decidable_eq l] [decidable_eq m]

@[simp] lemma from_blocks_diagonal (d₁ : l → α) (d₂ : m → α) :
  from_blocks (diagonal d₁) 0 0 (diagonal d₂) = diagonal (sum.elim d₁ d₂) :=
begin
  ext i j, rcases i; rcases j; simp [diagonal],
end

@[simp] lemma from_blocks_one : from_blocks (1 : matrix l l α) 0 0 (1 : matrix m m α) = 1 :=
by { ext i j, rcases i; rcases j; simp [one_apply] }

end block_matrices

section block_diagonal

variables (M N : o → matrix m n α) [decidable_eq o]

section has_zero

variables [has_zero α] [has_zero β]

/-- `matrix.block_diagonal M` turns a homogenously-indexed collection of matrices
`M : o → matrix m n α'` into a `m × o`-by-`n × o` block matrix which has the entries of `M` along
the diagonal and zero elsewhere.

See also `matrix.block_diagonal'` if the matrices may not have the same size everywhere.
-/
def block_diagonal : matrix (m × o) (n × o) α
| ⟨i, k⟩ ⟨j, k'⟩ := if k = k' then M k i j else 0

lemma block_diagonal_apply (ik jk) :
  block_diagonal M ik jk = if ik.2 = jk.2 then M ik.2 ik.1 jk.1 else 0 :=
by { cases ik, cases jk, refl }

@[simp]
lemma block_diagonal_apply_eq (i j k) :
  block_diagonal M (i, k) (j, k) = M k i j :=
if_pos rfl

lemma block_diagonal_apply_ne (i j) {k k'} (h : k ≠ k') :
  block_diagonal M (i, k) (j, k') = 0 :=
if_neg h

lemma block_diagonal_map (f : α → β) (hf : f 0 = 0) :
  (block_diagonal M).map f = block_diagonal (λ k, (M k).map f) :=
begin
  ext,
  simp only [map_apply, block_diagonal_apply, eq_comm],
  rw [apply_ite f, hf],
end

@[simp] lemma block_diagonal_transpose :
  (block_diagonal M)ᵀ = block_diagonal (λ k, (M k)ᵀ) :=
begin
  ext,
  simp only [transpose_apply, block_diagonal_apply, eq_comm],
  split_ifs with h,
  { rw h },
  { refl }
end

@[simp] lemma block_diagonal_conj_transpose
  {α : Type*} [semiring α] [star_ring α] (M : o → matrix m n α) :
  (block_diagonal M)ᴴ = block_diagonal (λ k, (M k)ᴴ) :=
begin
  simp only [conj_transpose, block_diagonal_transpose],
  rw block_diagonal_map _ star (star_zero α),
end

@[simp] lemma block_diagonal_zero :
  block_diagonal (0 : o → matrix m n α) = 0 :=
by { ext, simp [block_diagonal_apply] }

@[simp] lemma block_diagonal_diagonal [decidable_eq m] (d : o → m → α) :
  block_diagonal (λ k, diagonal (d k)) = diagonal (λ ik, d ik.2 ik.1) :=
begin
  ext ⟨i, k⟩ ⟨j, k'⟩,
  simp only [block_diagonal_apply, diagonal, prod.mk.inj_iff, ← ite_and],
  congr' 1,
  rw and_comm,
end

@[simp] lemma block_diagonal_one [decidable_eq m] [has_one α] :
  block_diagonal (1 : o → matrix m m α) = 1 :=
show block_diagonal (λ (_ : o), diagonal (λ (_ : m), (1 : α))) = diagonal (λ _, 1),
by rw [block_diagonal_diagonal]

end has_zero

@[simp] lemma block_diagonal_add [add_monoid α] :
  block_diagonal (M + N) = block_diagonal M + block_diagonal N :=
begin
  ext,
  simp only [block_diagonal_apply, pi.add_apply],
  split_ifs; simp
end

@[simp] lemma block_diagonal_neg [add_group α] :
  block_diagonal (-M) = - block_diagonal M :=
begin
  ext,
  simp only [block_diagonal_apply, pi.neg_apply],
  split_ifs; simp
end

@[simp] lemma block_diagonal_sub [add_group α] :
  block_diagonal (M - N) = block_diagonal M - block_diagonal N :=
by simp [sub_eq_add_neg]

@[simp] lemma block_diagonal_mul {p : Type*} [fintype n] [fintype o] [semiring α]
  (N : o → matrix n p α) :
  block_diagonal (λ k, M k ⬝ N k) = block_diagonal M ⬝ block_diagonal N :=
begin
  ext ⟨i, k⟩ ⟨j, k'⟩,
  simp only [block_diagonal_apply, mul_apply, ← finset.univ_product_univ, finset.sum_product],
  split_ifs with h; simp [h]
end

@[simp] lemma block_diagonal_smul {R : Type*} [semiring R] [add_comm_monoid α] [module R α]
  (x : R) : block_diagonal (x • M) = x • block_diagonal M :=
by { ext, simp only [block_diagonal_apply, pi.smul_apply], split_ifs; simp }

end block_diagonal

section block_diagonal'

variables (M N : Π i, matrix (m' i) (n' i) α) [decidable_eq o]

section has_zero

variables [has_zero α] [has_zero β]

/-- `matrix.block_diagonal' M` turns `M : Π i, matrix (m i) (n i) α` into a
`Σ i, m i`-by-`Σ i, n i` block matrix which has the entries of `M` along the diagonal
and zero elsewhere.

This is the dependently-typed version of `matrix.block_diagonal`. -/
def block_diagonal' : matrix (Σ i, m' i) (Σ i, n' i) α
| ⟨k, i⟩ ⟨k', j⟩ := if h : k = k' then M k i (cast (congr_arg n' h.symm) j) else 0

lemma block_diagonal'_eq_block_diagonal (M : o → matrix m n α) {k k'} (i j) :
  block_diagonal M (i, k) (j, k') = block_diagonal' M ⟨k, i⟩ ⟨k', j⟩ :=
rfl

lemma block_diagonal'_minor_eq_block_diagonal (M : o → matrix m n α) :
  (block_diagonal' M).minor (prod.to_sigma ∘ prod.swap) (prod.to_sigma ∘ prod.swap) =
    block_diagonal M :=
matrix.ext $ λ ⟨k, i⟩ ⟨k', j⟩, rfl

lemma block_diagonal'_apply (ik jk) :
  block_diagonal' M ik jk = if h : ik.1 = jk.1 then
    M ik.1 ik.2 (cast (congr_arg n' h.symm) jk.2) else 0 :=
by { cases ik, cases jk, refl }

@[simp]
lemma block_diagonal'_apply_eq (k i j) :
  block_diagonal' M ⟨k, i⟩ ⟨k, j⟩ = M k i j :=
dif_pos rfl

lemma block_diagonal'_apply_ne {k k'} (i j) (h : k ≠ k') :
  block_diagonal' M ⟨k, i⟩ ⟨k', j⟩ = 0 :=
dif_neg h

lemma block_diagonal'_map (f : α → β) (hf : f 0 = 0) :
  (block_diagonal' M).map f = block_diagonal' (λ k, (M k).map f) :=
begin
  ext,
  simp only [map_apply, block_diagonal'_apply, eq_comm],
  rw [apply_dite f, hf],
end

@[simp] lemma block_diagonal'_transpose :
  (block_diagonal' M)ᵀ = block_diagonal' (λ k, (M k)ᵀ) :=
begin
  ext ⟨ii, ix⟩ ⟨ji, jx⟩,
  simp only [transpose_apply, block_diagonal'_apply],
  split_ifs; cc
end

@[simp] lemma block_diagonal'_conj_transpose {α} [semiring α] [star_ring α]
  (M : Π i, matrix (m' i) (n' i) α) :
  (block_diagonal' M)ᴴ = block_diagonal' (λ k, (M k)ᴴ) :=
begin
  simp only [conj_transpose, block_diagonal'_transpose],
  exact block_diagonal'_map _ star (star_zero α),
end

@[simp] lemma block_diagonal'_zero :
  block_diagonal' (0 : Π i, matrix (m' i) (n' i) α) = 0 :=
by { ext, simp [block_diagonal'_apply] }

@[simp] lemma block_diagonal'_diagonal [∀ i, decidable_eq (m' i)] (d : Π i, m' i → α) :
  block_diagonal' (λ k, diagonal (d k)) = diagonal (λ ik, d ik.1 ik.2) :=
begin
  ext ⟨i, k⟩ ⟨j, k'⟩,
  simp only [block_diagonal'_apply, diagonal],
  split_ifs; cc
end

@[simp] lemma block_diagonal'_one [∀ i, decidable_eq (m' i)] [has_one α] :
  block_diagonal' (1 : Π i, matrix (m' i) (m' i) α) = 1 :=
show block_diagonal' (λ (i : o), diagonal (λ (_ : m' i), (1 : α))) = diagonal (λ _, 1),
by rw [block_diagonal'_diagonal]

end has_zero

@[simp] lemma block_diagonal'_add [add_monoid α] :
  block_diagonal' (M + N) = block_diagonal' M + block_diagonal' N :=
begin
  ext,
  simp only [block_diagonal'_apply, pi.add_apply],
  split_ifs; simp
end

@[simp]

@[simp] lemma block_diagonal'_sub [add_group α] :
  block_diagonal' (M - N) = block_diagonal' M - block_diagonal' N :=
by simp [sub_eq_add_neg]

@[simp] lemma block_diagonal'_mul {p : o → Type*} [semiring α] [Π i, fintype (n' i)] [fintype o]
  (N : Π i, matrix (n' i) (p i) α) :
    block_diagonal' (λ k, M k ⬝ N k) = block_diagonal' M ⬝ block_diagonal' N :=
begin
  ext ⟨k, i⟩ ⟨k', j⟩,
  simp only [block_diagonal'_apply, mul_apply, ← finset.univ_sigma_univ, finset.sum_sigma],
  rw fintype.sum_eq_single k,
  { split_ifs; simp },
  { intros j' hj', exact finset.sum_eq_zero (λ _ _, by rw [dif_neg hj'.symm, zero_mul]) },
end

@[simp] lemma block_diagonal'_smul {R : Type*} [semiring R] [add_comm_monoid α] [module R α]
  (x : R) : block_diagonal' (x • M) = x • block_diagonal' M :=
by { ext, simp only [block_diagonal'_apply, pi.smul_apply], split_ifs; simp }

end block_diagonal'

end matrix