/-
Copyright (c) 2020 Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sébastien Gouëzel, Floris van Doorn

! This file was ported from Lean 3 source module geometry.manifold.local_invariant_properties
! leanprover-community/mathlib commit be2c24f56783935652cefffb4bfca7e4b25d167e
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Geometry.Manifold.ChartedSpace

/-!
# Local properties invariant under a groupoid

We study properties of a triple `(g, s, x)` where `g` is a function between two spaces `H` and `H'`,
`s` is a subset of `H` and `x` is a point of `H`. Our goal is to register how such a property
should behave to make sense in charted spaces modelled on `H` and `H'`.

The main examples we have in mind are the properties "`g` is differentiable at `x` within `s`", or
"`g` is smooth at `x` within `s`". We want to develop general results that, when applied in these
specific situations, say that the notion of smooth function in a manifold behaves well under
restriction, intersection, is local, and so on.

## Main definitions

* `local_invariant_prop G G' P` says that a property `P` of a triple `(g, s, x)` is local, and
  invariant under composition by elements of the groupoids `G` and `G'` of `H` and `H'`
  respectively.
* `charted_space.lift_prop_within_at` (resp. `lift_prop_at`, `lift_prop_on` and `lift_prop`):
  given a property `P` of `(g, s, x)` where `g : H → H'`, define the corresponding property
  for functions `M → M'` where `M` and `M'` are charted spaces modelled respectively on `H` and
  `H'`. We define these properties within a set at a point, or at a point, or on a set, or in the
  whole space. This lifting process (obtained by restricting to suitable chart domains) can always
  be done, but it only behaves well under locality and invariance assumptions.

Given `hG : local_invariant_prop G G' P`, we deduce many properties of the lifted property on the
charted spaces. For instance, `hG.lift_prop_within_at_inter` says that `P g s x` is equivalent to
`P g (s ∩ t) x` whenever `t` is a neighborhood of `x`.

## Implementation notes

We do not use dot notation for properties of the lifted property. For instance, we have
`hG.lift_prop_within_at_congr` saying that if `lift_prop_within_at P g s x` holds, and `g` and `g'`
coincide on `s`, then `lift_prop_within_at P g' s x` holds. We can't call it
`lift_prop_within_at.congr` as it is in the namespace associated to `local_invariant_prop`, not
in the one for `lift_prop_within_at`.
-/

noncomputable section

open Classical Manifold Topology

open Set Filter

variable {H M H' M' X : Type _}

variable [TopologicalSpace H] [TopologicalSpace M] [ChartedSpace H M]

variable [TopologicalSpace H'] [TopologicalSpace M'] [ChartedSpace H' M']

variable [TopologicalSpace X]

namespace StructureGroupoid

variable (G : StructureGroupoid H) (G' : StructureGroupoid H')

/-- Structure recording good behavior of a property of a triple `(f, s, x)` where `f` is a function,
`s` a set and `x` a point. Good behavior here means locality and invariance under given groupoids
(both in the source and in the target). Given such a good behavior, the lift of this property
to charted spaces admitting these groupoids will inherit the good behavior. -/
structure LocalInvariantProp (P : (H → H') → Set H → H → Prop) : Prop where
  is_local : ∀ {s x u} {f : H → H'}, IsOpen u → x ∈ u → (P f s x ↔ P f (s ∩ u) x)
  right_invariance' :
    ∀ {s x f} {e : LocalHomeomorph H H},
      e ∈ G → x ∈ e.source → P f s x → P (f ∘ e.symm) (e.symm ⁻¹' s) (e x)
  congr_of_forall : ∀ {s x} {f g : H → H'}, (∀ y ∈ s, f y = g y) → f x = g x → P f s x → P g s x
  left_invariance' :
    ∀ {s x f} {e' : LocalHomeomorph H' H'},
      e' ∈ G' → s ⊆ f ⁻¹' e'.source → f x ∈ e'.source → P f s x → P (e' ∘ f) s x
#align structure_groupoid.local_invariant_prop StructureGroupoid.LocalInvariantProp

variable {G G'} {P : (H → H') → Set H → H → Prop} {s t u : Set H} {x : H}

variable (hG : G.LocalInvariantProp G' P)

include hG

namespace LocalInvariantProp

theorem congr_set {s t : Set H} {x : H} {f : H → H'} (hu : s =ᶠ[𝓝 x] t) : P f s x ↔ P f t x :=
  by
  obtain ⟨o, host, ho, hxo⟩ := mem_nhds_iff.mp hu.mem_iff
  simp_rw [subset_def, mem_set_of, ← and_congr_left_iff, ← mem_inter_iff, ← Set.ext_iff] at host
  rw [hG.is_local ho hxo, host, ← hG.is_local ho hxo]
#align structure_groupoid.local_invariant_prop.congr_set StructureGroupoid.LocalInvariantProp.congr_set

theorem is_local_nhds {s u : Set H} {x : H} {f : H → H'} (hu : u ∈ 𝓝[s] x) :
    P f s x ↔ P f (s ∩ u) x :=
  hG.congr_set <| mem_nhdsWithin_iff_eventuallyEq.mp hu
#align structure_groupoid.local_invariant_prop.is_local_nhds StructureGroupoid.LocalInvariantProp.is_local_nhds

theorem congr_iff_nhdsWithin {s : Set H} {x : H} {f g : H → H'} (h1 : f =ᶠ[𝓝[s] x] g)
    (h2 : f x = g x) : P f s x ↔ P g s x :=
  by
  simp_rw [hG.is_local_nhds h1]
  exact
    ⟨hG.congr_of_forall (fun y hy => hy.2) h2, hG.congr_of_forall (fun y hy => hy.2.symm) h2.symm⟩
#align structure_groupoid.local_invariant_prop.congr_iff_nhds_within StructureGroupoid.LocalInvariantProp.congr_iff_nhdsWithin

theorem congr_nhdsWithin {s : Set H} {x : H} {f g : H → H'} (h1 : f =ᶠ[𝓝[s] x] g) (h2 : f x = g x)
    (hP : P f s x) : P g s x :=
  (hG.congr_iff_nhdsWithin h1 h2).mp hP
#align structure_groupoid.local_invariant_prop.congr_nhds_within StructureGroupoid.LocalInvariantProp.congr_nhdsWithin

theorem congr_nhds_within' {s : Set H} {x : H} {f g : H → H'} (h1 : f =ᶠ[𝓝[s] x] g) (h2 : f x = g x)
    (hP : P g s x) : P f s x :=
  (hG.congr_iff_nhdsWithin h1 h2).mpr hP
#align structure_groupoid.local_invariant_prop.congr_nhds_within' StructureGroupoid.LocalInvariantProp.congr_nhds_within'

theorem congr_iff {s : Set H} {x : H} {f g : H → H'} (h : f =ᶠ[𝓝 x] g) : P f s x ↔ P g s x :=
  hG.congr_iff_nhdsWithin (mem_nhdsWithin_of_mem_nhds h) (mem_of_mem_nhds h : _)
#align structure_groupoid.local_invariant_prop.congr_iff StructureGroupoid.LocalInvariantProp.congr_iff

theorem congr {s : Set H} {x : H} {f g : H → H'} (h : f =ᶠ[𝓝 x] g) (hP : P f s x) : P g s x :=
  (hG.congr_iff h).mp hP
#align structure_groupoid.local_invariant_prop.congr StructureGroupoid.LocalInvariantProp.congr

theorem congr' {s : Set H} {x : H} {f g : H → H'} (h : f =ᶠ[𝓝 x] g) (hP : P g s x) : P f s x :=
  hG.congr h.symm hP
#align structure_groupoid.local_invariant_prop.congr' StructureGroupoid.LocalInvariantProp.congr'

theorem left_invariance {s : Set H} {x : H} {f : H → H'} {e' : LocalHomeomorph H' H'}
    (he' : e' ∈ G') (hfs : ContinuousWithinAt f s x) (hxe' : f x ∈ e'.source) :
    P (e' ∘ f) s x ↔ P f s x :=
  by
  have h2f := hfs.preimage_mem_nhds_within (e'.open_source.mem_nhds hxe')
  have h3f :=
    ((e'.continuous_at hxe').comp_continuousWithinAt hfs).preimage_mem_nhdsWithin <|
      e'.symm.open_source.mem_nhds <| e'.maps_to hxe'
  constructor
  · intro h
    rw [hG.is_local_nhds h3f] at h
    have h2 := hG.left_invariance' (G'.symm he') (inter_subset_right _ _) (e'.maps_to hxe') h
    rw [← hG.is_local_nhds h3f] at h2
    refine' hG.congr_nhds_within _ (e'.left_inv hxe') h2
    exact eventually_of_mem h2f fun x' => e'.left_inv
  · simp_rw [hG.is_local_nhds h2f]
    exact hG.left_invariance' he' (inter_subset_right _ _) hxe'
#align structure_groupoid.local_invariant_prop.left_invariance StructureGroupoid.LocalInvariantProp.left_invariance

theorem right_invariance {s : Set H} {x : H} {f : H → H'} {e : LocalHomeomorph H H} (he : e ∈ G)
    (hxe : x ∈ e.source) : P (f ∘ e.symm) (e.symm ⁻¹' s) (e x) ↔ P f s x :=
  by
  refine' ⟨fun h => _, hG.right_invariance' he hxe⟩
  have := hG.right_invariance' (G.symm he) (e.maps_to hxe) h
  rw [e.symm_symm, e.left_inv hxe] at this
  refine' hG.congr _ ((hG.congr_set _).mp this)
  · refine' eventually_of_mem (e.open_source.mem_nhds hxe) fun x' hx' => _
    simp_rw [Function.comp_apply, e.left_inv hx']
  · rw [eventually_eq_set]
    refine' eventually_of_mem (e.open_source.mem_nhds hxe) fun x' hx' => _
    simp_rw [mem_preimage, e.left_inv hx']
#align structure_groupoid.local_invariant_prop.right_invariance StructureGroupoid.LocalInvariantProp.right_invariance

end LocalInvariantProp

end StructureGroupoid

namespace ChartedSpace

/-- Given a property of germs of functions and sets in the model space, then one defines
a corresponding property in a charted space, by requiring that it holds at the preferred chart at
this point. (When the property is local and invariant, it will in fact hold using any chart, see
`lift_prop_within_at_indep_chart`). We require continuity in the lifted property, as otherwise one
single chart might fail to capture the behavior of the function.
-/
def LiftPropWithinAt (P : (H → H') → Set H → H → Prop) (f : M → M') (s : Set M) (x : M) : Prop :=
  ContinuousWithinAt f s x ∧
    P (chartAt H' (f x) ∘ f ∘ (chartAt H x).symm) ((chartAt H x).symm ⁻¹' s) (chartAt H x x)
#align charted_space.lift_prop_within_at ChartedSpace.LiftPropWithinAt

/-- Given a property of germs of functions and sets in the model space, then one defines
a corresponding property of functions on sets in a charted space, by requiring that it holds
around each point of the set, in the preferred charts. -/
def LiftPropOn (P : (H → H') → Set H → H → Prop) (f : M → M') (s : Set M) :=
  ∀ x ∈ s, LiftPropWithinAt P f s x
#align charted_space.lift_prop_on ChartedSpace.LiftPropOn

/-- Given a property of germs of functions and sets in the model space, then one defines
a corresponding property of a function at a point in a charted space, by requiring that it holds
in the preferred chart. -/
def LiftPropAt (P : (H → H') → Set H → H → Prop) (f : M → M') (x : M) :=
  LiftPropWithinAt P f univ x
#align charted_space.lift_prop_at ChartedSpace.LiftPropAt

theorem liftPropAt_iff {P : (H → H') → Set H → H → Prop} {f : M → M'} {x : M} :
    LiftPropAt P f x ↔
      ContinuousAt f x ∧ P (chartAt H' (f x) ∘ f ∘ (chartAt H x).symm) univ (chartAt H x x) :=
  by rw [lift_prop_at, lift_prop_within_at, continuousWithinAt_univ, preimage_univ]
#align charted_space.lift_prop_at_iff ChartedSpace.liftPropAt_iff

/-- Given a property of germs of functions and sets in the model space, then one defines
a corresponding property of a function in a charted space, by requiring that it holds
in the preferred chart around every point. -/
def LiftProp (P : (H → H') → Set H → H → Prop) (f : M → M') :=
  ∀ x, LiftPropAt P f x
#align charted_space.lift_prop ChartedSpace.LiftProp

theorem liftProp_iff {P : (H → H') → Set H → H → Prop} {f : M → M'} :
    LiftProp P f ↔
      Continuous f ∧ ∀ x, P (chartAt H' (f x) ∘ f ∘ (chartAt H x).symm) univ (chartAt H x x) :=
  by simp_rw [lift_prop, lift_prop_at_iff, forall_and, continuous_iff_continuousAt]
#align charted_space.lift_prop_iff ChartedSpace.liftProp_iff

end ChartedSpace

open ChartedSpace

namespace StructureGroupoid

variable {G : StructureGroupoid H} {G' : StructureGroupoid H'} {e e' : LocalHomeomorph M H}
  {f f' : LocalHomeomorph M' H'} {P : (H → H') → Set H → H → Prop} {g g' : M → M'} {s t : Set M}
  {x : M} {Q : (H → H) → Set H → H → Prop}

theorem liftPropWithinAt_univ : LiftPropWithinAt P g univ x ↔ LiftPropAt P g x :=
  Iff.rfl
#align structure_groupoid.lift_prop_within_at_univ StructureGroupoid.liftPropWithinAt_univ

theorem liftPropOn_univ : LiftPropOn P g univ ↔ LiftProp P g := by
  simp [lift_prop_on, lift_prop, lift_prop_at]
#align structure_groupoid.lift_prop_on_univ StructureGroupoid.liftPropOn_univ

theorem liftPropWithinAt_self {f : H → H'} {s : Set H} {x : H} :
    LiftPropWithinAt P f s x ↔ ContinuousWithinAt f s x ∧ P f s x :=
  Iff.rfl
#align structure_groupoid.lift_prop_within_at_self StructureGroupoid.liftPropWithinAt_self

theorem liftPropWithinAt_self_source {f : H → M'} {s : Set H} {x : H} :
    LiftPropWithinAt P f s x ↔ ContinuousWithinAt f s x ∧ P (chartAt H' (f x) ∘ f) s x :=
  Iff.rfl
#align structure_groupoid.lift_prop_within_at_self_source StructureGroupoid.liftPropWithinAt_self_source

theorem liftPropWithinAt_self_target {f : M → H'} :
    LiftPropWithinAt P f s x ↔
      ContinuousWithinAt f s x ∧
        P (f ∘ (chartAt H x).symm) ((chartAt H x).symm ⁻¹' s) (chartAt H x x) :=
  Iff.rfl
#align structure_groupoid.lift_prop_within_at_self_target StructureGroupoid.liftPropWithinAt_self_target

namespace LocalInvariantProp

variable (hG : G.LocalInvariantProp G' P)

include hG

/-- `lift_prop_within_at P f s x` is equivalent to a definition where we restrict the set we are
  considering to the domain of the charts at `x` and `f x`. -/
theorem liftPropWithinAt_iff {f : M → M'} :
    LiftPropWithinAt P f s x ↔
      ContinuousWithinAt f s x ∧
        P (chartAt H' (f x) ∘ f ∘ (chartAt H x).symm)
          ((chartAt H x).target ∩ (chartAt H x).symm ⁻¹' (s ∩ f ⁻¹' (chartAt H' (f x)).source))
          (chartAt H x x) :=
  by
  refine' and_congr_right fun hf => hG.congr_set _
  exact
    LocalHomeomorph.preimage_eventuallyEq_target_inter_preimage_inter hf (mem_chart_source H x)
      (chart_source_mem_nhds H' (f x))
#align structure_groupoid.local_invariant_prop.lift_prop_within_at_iff StructureGroupoid.LocalInvariantProp.liftPropWithinAt_iff

theorem lift_prop_within_at_indep_chart_source_aux (g : M → H') (he : e ∈ G.maximalAtlas M)
    (xe : x ∈ e.source) (he' : e' ∈ G.maximalAtlas M) (xe' : x ∈ e'.source) :
    P (g ∘ e.symm) (e.symm ⁻¹' s) (e x) ↔ P (g ∘ e'.symm) (e'.symm ⁻¹' s) (e' x) :=
  by
  rw [← hG.right_invariance (compatible_of_mem_maximal_atlas he he')]
  swap; · simp only [xe, xe', mfld_simps]
  simp_rw [LocalHomeomorph.trans_apply, e.left_inv xe]
  rw [hG.congr_iff]
  · refine' hG.congr_set _
    refine' (eventually_of_mem _ fun y (hy : y ∈ e'.symm ⁻¹' e.source) => _).set_eq
    · refine' (e'.symm.continuous_at <| e'.maps_to xe').preimage_mem_nhds (e.open_source.mem_nhds _)
      simp_rw [e'.left_inv xe', xe]
    simp_rw [mem_preimage, LocalHomeomorph.coe_trans_symm, LocalHomeomorph.symm_symm,
      Function.comp_apply, e.left_inv hy]
  · refine' ((e'.eventually_nhds' _ xe').mpr <| e.eventually_left_inverse xe).mono fun y hy => _
    simp only [mfld_simps]
    rw [hy]
#align structure_groupoid.local_invariant_prop.lift_prop_within_at_indep_chart_source_aux StructureGroupoid.LocalInvariantProp.lift_prop_within_at_indep_chart_source_aux

theorem lift_prop_within_at_indep_chart_target_aux2 (g : H → M') {x : H} {s : Set H}
    (hf : f ∈ G'.maximalAtlas M') (xf : g x ∈ f.source) (hf' : f' ∈ G'.maximalAtlas M')
    (xf' : g x ∈ f'.source) (hgs : ContinuousWithinAt g s x) : P (f ∘ g) s x ↔ P (f' ∘ g) s x :=
  by
  have hcont : ContinuousWithinAt (f ∘ g) s x := (f.continuous_at xf).comp_continuousWithinAt hgs
  rw [←
    hG.left_invariance (compatible_of_mem_maximal_atlas hf hf') hcont
      (by simp only [xf, xf', mfld_simps])]
  refine' hG.congr_iff_nhds_within _ (by simp only [xf, mfld_simps])
  exact (hgs.eventually <| f.eventually_left_inverse xf).mono fun y => congr_arg f'
#align structure_groupoid.local_invariant_prop.lift_prop_within_at_indep_chart_target_aux2 StructureGroupoid.LocalInvariantProp.lift_prop_within_at_indep_chart_target_aux2

theorem lift_prop_within_at_indep_chart_target_aux {g : X → M'} {e : LocalHomeomorph X H} {x : X}
    {s : Set X} (xe : x ∈ e.source) (hf : f ∈ G'.maximalAtlas M') (xf : g x ∈ f.source)
    (hf' : f' ∈ G'.maximalAtlas M') (xf' : g x ∈ f'.source) (hgs : ContinuousWithinAt g s x) :
    P (f ∘ g ∘ e.symm) (e.symm ⁻¹' s) (e x) ↔ P (f' ∘ g ∘ e.symm) (e.symm ⁻¹' s) (e x) :=
  by
  rw [← e.left_inv xe] at xf xf' hgs
  refine' hG.lift_prop_within_at_indep_chart_target_aux2 (g ∘ e.symm) hf xf hf' xf' _
  exact hgs.comp (e.symm.continuous_at <| e.maps_to xe).ContinuousWithinAt subset.rfl
#align structure_groupoid.local_invariant_prop.lift_prop_within_at_indep_chart_target_aux StructureGroupoid.LocalInvariantProp.lift_prop_within_at_indep_chart_target_aux

/-- If a property of a germ of function `g` on a pointed set `(s, x)` is invariant under the
structure groupoid (by composition in the source space and in the target space), then
expressing it in charted spaces does not depend on the element of the maximal atlas one uses
both in the source and in the target manifolds, provided they are defined around `x` and `g x`
respectively, and provided `g` is continuous within `s` at `x` (otherwise, the local behavior
of `g` at `x` can not be captured with a chart in the target). -/
theorem lift_prop_within_at_indep_chart_aux (he : e ∈ G.maximalAtlas M) (xe : x ∈ e.source)
    (he' : e' ∈ G.maximalAtlas M) (xe' : x ∈ e'.source) (hf : f ∈ G'.maximalAtlas M')
    (xf : g x ∈ f.source) (hf' : f' ∈ G'.maximalAtlas M') (xf' : g x ∈ f'.source)
    (hgs : ContinuousWithinAt g s x) :
    P (f ∘ g ∘ e.symm) (e.symm ⁻¹' s) (e x) ↔ P (f' ∘ g ∘ e'.symm) (e'.symm ⁻¹' s) (e' x) := by
  rw [hG.lift_prop_within_at_indep_chart_source_aux (f ∘ g) he xe he' xe',
    hG.lift_prop_within_at_indep_chart_target_aux xe' hf xf hf' xf' hgs]
#align structure_groupoid.local_invariant_prop.lift_prop_within_at_indep_chart_aux StructureGroupoid.LocalInvariantProp.lift_prop_within_at_indep_chart_aux

theorem liftPropWithinAt_indep_chart [HasGroupoid M G] [HasGroupoid M' G']
    (he : e ∈ G.maximalAtlas M) (xe : x ∈ e.source) (hf : f ∈ G'.maximalAtlas M')
    (xf : g x ∈ f.source) :
    LiftPropWithinAt P g s x ↔ ContinuousWithinAt g s x ∧ P (f ∘ g ∘ e.symm) (e.symm ⁻¹' s) (e x) :=
  and_congr_right <|
    hG.lift_prop_within_at_indep_chart_aux (chart_mem_maximalAtlas _ _) (mem_chart_source _ _) he xe
      (chart_mem_maximalAtlas _ _) (mem_chart_source _ _) hf xf
#align structure_groupoid.local_invariant_prop.lift_prop_within_at_indep_chart StructureGroupoid.LocalInvariantProp.liftPropWithinAt_indep_chart

/-- A version of `lift_prop_within_at_indep_chart`, only for the source. -/
theorem liftPropWithinAt_indep_chart_source [HasGroupoid M G] (he : e ∈ G.maximalAtlas M)
    (xe : x ∈ e.source) :
    LiftPropWithinAt P g s x ↔ LiftPropWithinAt P (g ∘ e.symm) (e.symm ⁻¹' s) (e x) :=
  by
  have := e.symm.continuous_within_at_iff_continuous_within_at_comp_right xe
  rw [e.symm_symm] at this
  rw [lift_prop_within_at_self_source, lift_prop_within_at, ← this]
  simp_rw [Function.comp_apply, e.left_inv xe]
  refine' and_congr Iff.rfl _
  rw [hG.lift_prop_within_at_indep_chart_source_aux (chart_at H' (g x) ∘ g)
      (chart_mem_maximal_atlas G x) (mem_chart_source H x) he xe]
#align structure_groupoid.local_invariant_prop.lift_prop_within_at_indep_chart_source StructureGroupoid.LocalInvariantProp.liftPropWithinAt_indep_chart_source

/-- A version of `lift_prop_within_at_indep_chart`, only for the target. -/
theorem liftPropWithinAt_indep_chart_target [HasGroupoid M' G'] (hf : f ∈ G'.maximalAtlas M')
    (xf : g x ∈ f.source) :
    LiftPropWithinAt P g s x ↔ ContinuousWithinAt g s x ∧ LiftPropWithinAt P (f ∘ g) s x :=
  by
  rw [lift_prop_within_at_self_target, lift_prop_within_at, and_congr_right_iff]
  intro hg
  simp_rw [(f.continuous_at xf).comp_continuousWithinAt hg, true_and_iff]
  exact
    hG.lift_prop_within_at_indep_chart_target_aux (mem_chart_source _ _)
      (chart_mem_maximal_atlas _ _) (mem_chart_source _ _) hf xf hg
#align structure_groupoid.local_invariant_prop.lift_prop_within_at_indep_chart_target StructureGroupoid.LocalInvariantProp.liftPropWithinAt_indep_chart_target

/-- A version of `lift_prop_within_at_indep_chart`, that uses `lift_prop_within_at` on both sides.
-/
theorem liftPropWithinAt_indep_chart' [HasGroupoid M G] [HasGroupoid M' G']
    (he : e ∈ G.maximalAtlas M) (xe : x ∈ e.source) (hf : f ∈ G'.maximalAtlas M')
    (xf : g x ∈ f.source) :
    LiftPropWithinAt P g s x ↔
      ContinuousWithinAt g s x ∧ LiftPropWithinAt P (f ∘ g ∘ e.symm) (e.symm ⁻¹' s) (e x) :=
  by
  rw [hG.lift_prop_within_at_indep_chart he xe hf xf, lift_prop_within_at_self, and_left_comm,
    Iff.comm, and_iff_right_iff_imp]
  intro h
  have h1 := (e.symm.continuous_within_at_iff_continuous_within_at_comp_right xe).mp h.1
  have : ContinuousAt f ((g ∘ e.symm) (e x)) := by
    simp_rw [Function.comp, e.left_inv xe, f.continuous_at xf]
  exact this.comp_continuous_within_at h1
#align structure_groupoid.local_invariant_prop.lift_prop_within_at_indep_chart' StructureGroupoid.LocalInvariantProp.liftPropWithinAt_indep_chart'

theorem liftPropOn_indep_chart [HasGroupoid M G] [HasGroupoid M' G'] (he : e ∈ G.maximalAtlas M)
    (hf : f ∈ G'.maximalAtlas M') (h : LiftPropOn P g s) {y : H}
    (hy : y ∈ e.target ∩ e.symm ⁻¹' (s ∩ g ⁻¹' f.source)) : P (f ∘ g ∘ e.symm) (e.symm ⁻¹' s) y :=
  by
  convert((hG.lift_prop_within_at_indep_chart he (e.symm_maps_to hy.1) hf hy.2.2).1 (h _ hy.2.1)).2
  rw [e.right_inv hy.1]
#align structure_groupoid.local_invariant_prop.lift_prop_on_indep_chart StructureGroupoid.LocalInvariantProp.liftPropOn_indep_chart

theorem liftPropWithinAt_inter' (ht : t ∈ 𝓝[s] x) :
    LiftPropWithinAt P g (s ∩ t) x ↔ LiftPropWithinAt P g s x :=
  by
  rw [lift_prop_within_at, lift_prop_within_at, continuousWithinAt_inter' ht, hG.congr_set]
  simp_rw [eventually_eq_set, mem_preimage,
    (chart_at H x).eventually_nhds' (fun x => x ∈ s ∩ t ↔ x ∈ s) (mem_chart_source H x)]
  exact (mem_nhds_within_iff_eventually_eq.mp ht).symm.mem_iff
#align structure_groupoid.local_invariant_prop.lift_prop_within_at_inter' StructureGroupoid.LocalInvariantProp.liftPropWithinAt_inter'

theorem liftPropWithinAt_inter (ht : t ∈ 𝓝 x) :
    LiftPropWithinAt P g (s ∩ t) x ↔ LiftPropWithinAt P g s x :=
  hG.liftPropWithinAt_inter' (mem_nhdsWithin_of_mem_nhds ht)
#align structure_groupoid.local_invariant_prop.lift_prop_within_at_inter StructureGroupoid.LocalInvariantProp.liftPropWithinAt_inter

theorem liftPropAt_of_liftPropWithinAt (h : LiftPropWithinAt P g s x) (hs : s ∈ 𝓝 x) :
    LiftPropAt P g x := by rwa [← univ_inter s, hG.lift_prop_within_at_inter hs] at h
#align structure_groupoid.local_invariant_prop.lift_prop_at_of_lift_prop_within_at StructureGroupoid.LocalInvariantProp.liftPropAt_of_liftPropWithinAt

theorem liftPropWithinAt_of_liftPropAt_of_mem_nhds (h : LiftPropAt P g x) (hs : s ∈ 𝓝 x) :
    LiftPropWithinAt P g s x := by rwa [← univ_inter s, hG.lift_prop_within_at_inter hs]
#align structure_groupoid.local_invariant_prop.lift_prop_within_at_of_lift_prop_at_of_mem_nhds StructureGroupoid.LocalInvariantProp.liftPropWithinAt_of_liftPropAt_of_mem_nhds

theorem liftPropOn_of_locally_liftPropOn
    (h : ∀ x ∈ s, ∃ u, IsOpen u ∧ x ∈ u ∧ LiftPropOn P g (s ∩ u)) : LiftPropOn P g s :=
  by
  intro x hx
  rcases h x hx with ⟨u, u_open, xu, hu⟩
  have := hu x ⟨hx, xu⟩
  rwa [hG.lift_prop_within_at_inter] at this
  exact IsOpen.mem_nhds u_open xu
#align structure_groupoid.local_invariant_prop.lift_prop_on_of_locally_lift_prop_on StructureGroupoid.LocalInvariantProp.liftPropOn_of_locally_liftPropOn

theorem liftProp_of_locally_liftPropOn (h : ∀ x, ∃ u, IsOpen u ∧ x ∈ u ∧ LiftPropOn P g u) :
    LiftProp P g := by
  rw [← lift_prop_on_univ]
  apply hG.lift_prop_on_of_locally_lift_prop_on fun x hx => _
  simp [h x]
#align structure_groupoid.local_invariant_prop.lift_prop_of_locally_lift_prop_on StructureGroupoid.LocalInvariantProp.liftProp_of_locally_liftPropOn

theorem liftPropWithinAt_congr_of_eventuallyEq (h : LiftPropWithinAt P g s x) (h₁ : g' =ᶠ[𝓝[s] x] g)
    (hx : g' x = g x) : LiftPropWithinAt P g' s x :=
  by
  refine' ⟨h.1.congr_of_eventuallyEq h₁ hx, _⟩
  refine'
    hG.congr_nhds_within' _
      (by simp_rw [Function.comp_apply, (chart_at H x).left_inv (mem_chart_source H x), hx]) h.2
  simp_rw [eventually_eq, Function.comp_apply,
    (chart_at H x).eventually_nhdsWithin'
      (fun y => chart_at H' (g' x) (g' y) = chart_at H' (g x) (g y)) (mem_chart_source H x)]
  exact h₁.mono fun y hy => by rw [hx, hy]
#align structure_groupoid.local_invariant_prop.lift_prop_within_at_congr_of_eventually_eq StructureGroupoid.LocalInvariantProp.liftPropWithinAt_congr_of_eventuallyEq

theorem liftPropWithinAt_congr_iff_of_eventuallyEq (h₁ : g' =ᶠ[𝓝[s] x] g) (hx : g' x = g x) :
    LiftPropWithinAt P g' s x ↔ LiftPropWithinAt P g s x :=
  ⟨fun h => hG.liftPropWithinAt_congr_of_eventuallyEq h h₁.symm hx.symm, fun h =>
    hG.liftPropWithinAt_congr_of_eventuallyEq h h₁ hx⟩
#align structure_groupoid.local_invariant_prop.lift_prop_within_at_congr_iff_of_eventually_eq StructureGroupoid.LocalInvariantProp.liftPropWithinAt_congr_iff_of_eventuallyEq

theorem liftPropWithinAt_congr_iff (h₁ : ∀ y ∈ s, g' y = g y) (hx : g' x = g x) :
    LiftPropWithinAt P g' s x ↔ LiftPropWithinAt P g s x :=
  hG.liftPropWithinAt_congr_iff_of_eventuallyEq (eventually_nhdsWithin_of_forall h₁) hx
#align structure_groupoid.local_invariant_prop.lift_prop_within_at_congr_iff StructureGroupoid.LocalInvariantProp.liftPropWithinAt_congr_iff

theorem liftPropWithinAt_congr (h : LiftPropWithinAt P g s x) (h₁ : ∀ y ∈ s, g' y = g y)
    (hx : g' x = g x) : LiftPropWithinAt P g' s x :=
  (hG.liftPropWithinAt_congr_iff h₁ hx).mpr h
#align structure_groupoid.local_invariant_prop.lift_prop_within_at_congr StructureGroupoid.LocalInvariantProp.liftPropWithinAt_congr

theorem liftPropAt_congr_iff_of_eventuallyEq (h₁ : g' =ᶠ[𝓝 x] g) :
    LiftPropAt P g' x ↔ LiftPropAt P g x :=
  hG.liftPropWithinAt_congr_iff_of_eventuallyEq (by simp_rw [nhdsWithin_univ, h₁]) h₁.eq_of_nhds
#align structure_groupoid.local_invariant_prop.lift_prop_at_congr_iff_of_eventually_eq StructureGroupoid.LocalInvariantProp.liftPropAt_congr_iff_of_eventuallyEq

theorem liftPropAt_congr_of_eventuallyEq (h : LiftPropAt P g x) (h₁ : g' =ᶠ[𝓝 x] g) :
    LiftPropAt P g' x :=
  (hG.liftPropAt_congr_iff_of_eventuallyEq h₁).mpr h
#align structure_groupoid.local_invariant_prop.lift_prop_at_congr_of_eventually_eq StructureGroupoid.LocalInvariantProp.liftPropAt_congr_of_eventuallyEq

theorem liftPropOn_congr (h : LiftPropOn P g s) (h₁ : ∀ y ∈ s, g' y = g y) : LiftPropOn P g' s :=
  fun x hx => hG.liftPropWithinAt_congr (h x hx) h₁ (h₁ x hx)
#align structure_groupoid.local_invariant_prop.lift_prop_on_congr StructureGroupoid.LocalInvariantProp.liftPropOn_congr

theorem liftPropOn_congr_iff (h₁ : ∀ y ∈ s, g' y = g y) : LiftPropOn P g' s ↔ LiftPropOn P g s :=
  ⟨fun h => hG.liftPropOn_congr h fun y hy => (h₁ y hy).symm, fun h => hG.liftPropOn_congr h h₁⟩
#align structure_groupoid.local_invariant_prop.lift_prop_on_congr_iff StructureGroupoid.LocalInvariantProp.liftPropOn_congr_iff

omit hG

theorem liftPropWithinAt_mono_of_mem
    (mono_of_mem : ∀ ⦃s x t⦄ ⦃f : H → H'⦄, s ∈ 𝓝[t] x → P f s x → P f t x)
    (h : LiftPropWithinAt P g s x) (hst : s ∈ 𝓝[t] x) : LiftPropWithinAt P g t x :=
  by
  refine' ⟨h.1.mono_of_mem hst, mono_of_mem _ h.2⟩
  simp_rw [← mem_map, (chart_at H x).symm.map_nhdsWithin_preimage_eq (mem_chart_target H x),
    (chart_at H x).left_inv (mem_chart_source H x), hst]
#align structure_groupoid.local_invariant_prop.lift_prop_within_at_mono_of_mem StructureGroupoid.LocalInvariantProp.liftPropWithinAt_mono_of_mem

theorem liftPropWithinAt_mono (mono : ∀ ⦃s x t⦄ ⦃f : H → H'⦄, t ⊆ s → P f s x → P f t x)
    (h : LiftPropWithinAt P g s x) (hts : t ⊆ s) : LiftPropWithinAt P g t x :=
  by
  refine' ⟨h.1.mono hts, _⟩
  apply mono (fun y hy => _) h.2
  simp only [mfld_simps] at hy
  simp only [hy, hts _, mfld_simps]
#align structure_groupoid.local_invariant_prop.lift_prop_within_at_mono StructureGroupoid.LocalInvariantProp.liftPropWithinAt_mono

theorem liftPropWithinAt_of_liftPropAt (mono : ∀ ⦃s x t⦄ ⦃f : H → H'⦄, t ⊆ s → P f s x → P f t x)
    (h : LiftPropAt P g x) : LiftPropWithinAt P g s x :=
  by
  rw [← lift_prop_within_at_univ] at h
  exact lift_prop_within_at_mono mono h (subset_univ _)
#align structure_groupoid.local_invariant_prop.lift_prop_within_at_of_lift_prop_at StructureGroupoid.LocalInvariantProp.liftPropWithinAt_of_liftPropAt

theorem liftPropOn_mono (mono : ∀ ⦃s x t⦄ ⦃f : H → H'⦄, t ⊆ s → P f s x → P f t x)
    (h : LiftPropOn P g t) (hst : s ⊆ t) : LiftPropOn P g s := fun x hx =>
  liftPropWithinAt_mono mono (h x (hst hx)) hst
#align structure_groupoid.local_invariant_prop.lift_prop_on_mono StructureGroupoid.LocalInvariantProp.liftPropOn_mono

theorem liftPropOn_of_liftProp (mono : ∀ ⦃s x t⦄ ⦃f : H → H'⦄, t ⊆ s → P f s x → P f t x)
    (h : LiftProp P g) : LiftPropOn P g s :=
  by
  rw [← lift_prop_on_univ] at h
  exact lift_prop_on_mono mono h (subset_univ _)
#align structure_groupoid.local_invariant_prop.lift_prop_on_of_lift_prop StructureGroupoid.LocalInvariantProp.liftPropOn_of_liftProp

theorem liftPropAt_of_mem_maximalAtlas [HasGroupoid M G] (hG : G.LocalInvariantProp G Q)
    (hQ : ∀ y, Q id univ y) (he : e ∈ maximalAtlas M G) (hx : x ∈ e.source) : LiftPropAt Q e x :=
  by
  simp_rw [lift_prop_at,
    hG.lift_prop_within_at_indep_chart he hx G.id_mem_maximal_atlas (mem_univ _),
    (e.continuous_at hx).ContinuousWithinAt, true_and_iff]
  exact hG.congr' (e.eventually_right_inverse' hx) (hQ _)
#align structure_groupoid.local_invariant_prop.lift_prop_at_of_mem_maximal_atlas StructureGroupoid.LocalInvariantProp.liftPropAt_of_mem_maximalAtlas

theorem liftPropOn_of_mem_maximalAtlas [HasGroupoid M G] (hG : G.LocalInvariantProp G Q)
    (hQ : ∀ y, Q id univ y) (he : e ∈ maximalAtlas M G) : LiftPropOn Q e e.source :=
  by
  intro x hx
  apply
    hG.lift_prop_within_at_of_lift_prop_at_of_mem_nhds
      (hG.lift_prop_at_of_mem_maximal_atlas hQ he hx)
  exact IsOpen.mem_nhds e.open_source hx
#align structure_groupoid.local_invariant_prop.lift_prop_on_of_mem_maximal_atlas StructureGroupoid.LocalInvariantProp.liftPropOn_of_mem_maximalAtlas

theorem liftPropAt_symm_of_mem_maximalAtlas [HasGroupoid M G] {x : H}
    (hG : G.LocalInvariantProp G Q) (hQ : ∀ y, Q id univ y) (he : e ∈ maximalAtlas M G)
    (hx : x ∈ e.target) : LiftPropAt Q e.symm x :=
  by
  suffices h : Q (e ∘ e.symm) univ x
  · have A : e.symm ⁻¹' e.source ∩ e.target = e.target := by mfld_set_tac
    have : e.symm x ∈ e.source := by simp only [hx, mfld_simps]
    rw [lift_prop_at,
      hG.lift_prop_within_at_indep_chart G.id_mem_maximal_atlas (mem_univ _) he this]
    refine' ⟨(e.symm.continuous_at hx).ContinuousWithinAt, _⟩
    simp only [h, mfld_simps]
  exact hG.congr' (e.eventually_right_inverse hx) (hQ x)
#align structure_groupoid.local_invariant_prop.lift_prop_at_symm_of_mem_maximal_atlas StructureGroupoid.LocalInvariantProp.liftPropAt_symm_of_mem_maximalAtlas

theorem liftPropOn_symm_of_mem_maximalAtlas [HasGroupoid M G] (hG : G.LocalInvariantProp G Q)
    (hQ : ∀ y, Q id univ y) (he : e ∈ maximalAtlas M G) : LiftPropOn Q e.symm e.target :=
  by
  intro x hx
  apply
    hG.lift_prop_within_at_of_lift_prop_at_of_mem_nhds
      (hG.lift_prop_at_symm_of_mem_maximal_atlas hQ he hx)
  exact IsOpen.mem_nhds e.open_target hx
#align structure_groupoid.local_invariant_prop.lift_prop_on_symm_of_mem_maximal_atlas StructureGroupoid.LocalInvariantProp.liftPropOn_symm_of_mem_maximalAtlas

theorem liftPropAt_chart [HasGroupoid M G] (hG : G.LocalInvariantProp G Q) (hQ : ∀ y, Q id univ y) :
    LiftPropAt Q (chartAt H x) x :=
  hG.liftPropAt_of_mem_maximalAtlas hQ (chart_mem_maximalAtlas G x) (mem_chart_source H x)
#align structure_groupoid.local_invariant_prop.lift_prop_at_chart StructureGroupoid.LocalInvariantProp.liftPropAt_chart

theorem liftPropOn_chart [HasGroupoid M G] (hG : G.LocalInvariantProp G Q) (hQ : ∀ y, Q id univ y) :
    LiftPropOn Q (chartAt H x) (chartAt H x).source :=
  hG.liftPropOn_of_mem_maximalAtlas hQ (chart_mem_maximalAtlas G x)
#align structure_groupoid.local_invariant_prop.lift_prop_on_chart StructureGroupoid.LocalInvariantProp.liftPropOn_chart

theorem liftPropAt_chart_symm [HasGroupoid M G] (hG : G.LocalInvariantProp G Q)
    (hQ : ∀ y, Q id univ y) : LiftPropAt Q (chartAt H x).symm ((chartAt H x) x) :=
  hG.liftPropAt_symm_of_mem_maximalAtlas hQ (chart_mem_maximalAtlas G x) (by simp)
#align structure_groupoid.local_invariant_prop.lift_prop_at_chart_symm StructureGroupoid.LocalInvariantProp.liftPropAt_chart_symm

theorem liftPropOn_chart_symm [HasGroupoid M G] (hG : G.LocalInvariantProp G Q)
    (hQ : ∀ y, Q id univ y) : LiftPropOn Q (chartAt H x).symm (chartAt H x).target :=
  hG.liftPropOn_symm_of_mem_maximalAtlas hQ (chart_mem_maximalAtlas G x)
#align structure_groupoid.local_invariant_prop.lift_prop_on_chart_symm StructureGroupoid.LocalInvariantProp.liftPropOn_chart_symm

theorem liftPropAt_of_mem_groupoid (hG : G.LocalInvariantProp G Q) (hQ : ∀ y, Q id univ y)
    {f : LocalHomeomorph H H} (hf : f ∈ G) {x : H} (hx : x ∈ f.source) : LiftPropAt Q f x :=
  liftPropAt_of_mem_maximalAtlas hG hQ (G.mem_maximalAtlas_of_mem_groupoid hf) hx
#align structure_groupoid.local_invariant_prop.lift_prop_at_of_mem_groupoid StructureGroupoid.LocalInvariantProp.liftPropAt_of_mem_groupoid

theorem liftPropOn_of_mem_groupoid (hG : G.LocalInvariantProp G Q) (hQ : ∀ y, Q id univ y)
    {f : LocalHomeomorph H H} (hf : f ∈ G) : LiftPropOn Q f f.source :=
  liftPropOn_of_mem_maximalAtlas hG hQ (G.mem_maximalAtlas_of_mem_groupoid hf)
#align structure_groupoid.local_invariant_prop.lift_prop_on_of_mem_groupoid StructureGroupoid.LocalInvariantProp.liftPropOn_of_mem_groupoid

theorem liftProp_id (hG : G.LocalInvariantProp G Q) (hQ : ∀ y, Q id univ y) :
    LiftProp Q (id : M → M) :=
  by
  simp_rw [lift_prop_iff, continuous_id, true_and_iff]
  exact fun x => hG.congr' ((chart_at H x).eventually_right_inverse <| mem_chart_target H x) (hQ _)
#align structure_groupoid.local_invariant_prop.lift_prop_id StructureGroupoid.LocalInvariantProp.liftProp_id

end LocalInvariantProp

section LocalStructomorph

variable (G)

open LocalHomeomorph

/-- A function from a model space `H` to itself is a local structomorphism, with respect to a
structure groupoid `G` for `H`, relative to a set `s` in `H`, if for all points `x` in the set, the
function agrees with a `G`-structomorphism on `s` in a neighbourhood of `x`. -/
def IsLocalStructomorphWithinAt (f : H → H) (s : Set H) (x : H) : Prop :=
  x ∈ s → ∃ e : LocalHomeomorph H H, e ∈ G ∧ EqOn f e.toFun (s ∩ e.source) ∧ x ∈ e.source
#align structure_groupoid.is_local_structomorph_within_at StructureGroupoid.IsLocalStructomorphWithinAt

/-- For a groupoid `G` which is `closed_under_restriction`, being a local structomorphism is a local
invariant property. -/
theorem isLocalStructomorphWithinAt_localInvariantProp [ClosedUnderRestriction G] :
    LocalInvariantProp G G (IsLocalStructomorphWithinAt G) :=
  { is_local := by
      intro s x u f hu hux
      constructor
      · rintro h hx
        rcases h hx.1 with ⟨e, heG, hef, hex⟩
        have : s ∩ u ∩ e.source ⊆ s ∩ e.source := by mfld_set_tac
        exact ⟨e, heG, hef.mono this, hex⟩
      · rintro h hx
        rcases h ⟨hx, hux⟩ with ⟨e, heG, hef, hex⟩
        refine' ⟨e.restr (interior u), _, _, _⟩
        · exact closed_under_restriction' heG isOpen_interior
        · have : s ∩ u ∩ e.source = s ∩ (e.source ∩ u) := by mfld_set_tac
          simpa only [this, interior_interior, hu.interior_eq, mfld_simps] using hef
        · simp only [*, interior_interior, hu.interior_eq, mfld_simps]
    right_invariance' := by
      intro s x f e' he'G he'x h hx
      have hxs : x ∈ s := by simpa only [e'.left_inv he'x, mfld_simps] using hx
      rcases h hxs with ⟨e, heG, hef, hex⟩
      refine' ⟨e'.symm.trans e, G.trans (G.symm he'G) heG, _, _⟩
      · intro y hy
        simp only [mfld_simps] at hy
        simp only [hef ⟨hy.1, hy.2.2⟩, mfld_simps]
      · simp only [hex, he'x, mfld_simps]
    congr_of_forall := by
      intro s x f g hfgs hfg' h hx
      rcases h hx with ⟨e, heG, hef, hex⟩
      refine' ⟨e, heG, _, hex⟩
      intro y hy
      rw [← hef hy, hfgs y hy.1]
    left_invariance' := by
      intro s x f e' he'G he' hfx h hx
      rcases h hx with ⟨e, heG, hef, hex⟩
      refine' ⟨e.trans e', G.trans heG he'G, _, _⟩
      · intro y hy
        simp only [mfld_simps] at hy
        simp only [hef ⟨hy.1, hy.2.1⟩, mfld_simps]
      · simpa only [hex, hef ⟨hx, hex⟩, mfld_simps] using hfx }
#align structure_groupoid.is_local_structomorph_within_at_local_invariant_prop StructureGroupoid.isLocalStructomorphWithinAt_localInvariantProp

/-- A slight reformulation of `is_local_structomorph_within_at` when `f` is a local homeomorph.
  This gives us an `e` that is defined on a subset of `f.source`. -/
theorem LocalHomeomorph.isLocalStructomorphWithinAt_iff {G : StructureGroupoid H}
    [ClosedUnderRestriction G] (f : LocalHomeomorph H H) {s : Set H} {x : H}
    (hx : x ∈ f.source ∪ sᶜ) :
    G.IsLocalStructomorphWithinAt (⇑f) s x ↔
      x ∈ s →
        ∃ e : LocalHomeomorph H H,
          e ∈ G ∧ e.source ⊆ f.source ∧ EqOn f (⇑e) (s ∩ e.source) ∧ x ∈ e.source :=
  by
  constructor
  · intro hf h2x
    obtain ⟨e, he, hfe, hxe⟩ := hf h2x
    refine' ⟨e.restr f.source, closed_under_restriction' he f.open_source, _, _, hxe, _⟩
    · simp_rw [LocalHomeomorph.restr_source]
      refine' (inter_subset_right _ _).trans interior_subset
    · intro x' hx'
      exact hfe ⟨hx'.1, hx'.2.1⟩
    · rw [f.open_source.interior_eq]
      exact Or.resolve_right hx (not_not.mpr h2x)
  · intro hf hx
    obtain ⟨e, he, h2e, hfe, hxe⟩ := hf hx
    exact ⟨e, he, hfe, hxe⟩
#align local_homeomorph.is_local_structomorph_within_at_iff LocalHomeomorph.isLocalStructomorphWithinAt_iff

/-- A slight reformulation of `is_local_structomorph_within_at` when `f` is a local homeomorph and
  the set we're considering is a superset of `f.source`. -/
theorem LocalHomeomorph.isLocalStructomorphWithinAt_iff' {G : StructureGroupoid H}
    [ClosedUnderRestriction G] (f : LocalHomeomorph H H) {s : Set H} {x : H} (hs : f.source ⊆ s)
    (hx : x ∈ f.source ∪ sᶜ) :
    G.IsLocalStructomorphWithinAt (⇑f) s x ↔
      x ∈ s →
        ∃ e : LocalHomeomorph H H,
          e ∈ G ∧ e.source ⊆ f.source ∧ EqOn f (⇑e) e.source ∧ x ∈ e.source :=
  by
  simp_rw [f.is_local_structomorph_within_at_iff hx]
  refine' imp_congr_right fun hx => exists_congr fun e => and_congr_right fun he => _
  refine' and_congr_right fun h2e => _
  rw [inter_eq_right_iff_subset.mpr (h2e.trans hs)]
#align local_homeomorph.is_local_structomorph_within_at_iff' LocalHomeomorph.isLocalStructomorphWithinAt_iff'

/-- A slight reformulation of `is_local_structomorph_within_at` when `f` is a local homeomorph and
  the set we're considering is `f.source`. -/
theorem LocalHomeomorph.isLocalStructomorphWithinAt_source_iff {G : StructureGroupoid H}
    [ClosedUnderRestriction G] (f : LocalHomeomorph H H) {x : H} :
    G.IsLocalStructomorphWithinAt (⇑f) f.source x ↔
      x ∈ f.source →
        ∃ e : LocalHomeomorph H H,
          e ∈ G ∧ e.source ⊆ f.source ∧ EqOn f (⇑e) e.source ∧ x ∈ e.source :=
  haveI : x ∈ f.source ∪ f.sourceᶜ := by simp_rw [union_compl_self]
  f.is_local_structomorph_within_at_iff' subset.rfl this
#align local_homeomorph.is_local_structomorph_within_at_source_iff LocalHomeomorph.isLocalStructomorphWithinAt_source_iff

variable {H₁ : Type _} [TopologicalSpace H₁] {H₂ : Type _} [TopologicalSpace H₂] {H₃ : Type _}
  [TopologicalSpace H₃] [ChartedSpace H₁ H₂] [ChartedSpace H₂ H₃] {G₁ : StructureGroupoid H₁}
  [HasGroupoid H₂ G₁] [ClosedUnderRestriction G₁] (G₂ : StructureGroupoid H₂) [HasGroupoid H₃ G₂]

variable (G₂)

theorem HasGroupoid.comp
    (H : ∀ e ∈ G₂, LiftPropOn (IsLocalStructomorphWithinAt G₁) (e : H₂ → H₂) e.source) :
    @HasGroupoid H₁ _ H₃ _ (ChartedSpace.comp H₁ H₂ H₃) G₁ :=
  {
    compatible := by
      rintro _ _ ⟨e, f, he, hf, rfl⟩ ⟨e', f', he', hf', rfl⟩
      apply G₁.locality
      intro x hx
      simp only [mfld_simps] at hx
      have hxs : x ∈ f.symm ⁻¹' (e.symm ≫ₕ e').source := by simp only [hx, mfld_simps]
      have hxs' : x ∈ f.target ∩ f.symm ⁻¹' ((e.symm ≫ₕ e').source ∩ e.symm ≫ₕ e' ⁻¹' f'.source) :=
        by simp only [hx, mfld_simps]
      obtain ⟨φ, hφG₁, hφ, hφ_dom⟩ :=
        local_invariant_prop.lift_prop_on_indep_chart
          (is_local_structomorph_within_at_local_invariant_prop G₁) (G₁.subset_maximal_atlas hf)
          (G₁.subset_maximal_atlas hf') (H _ (G₂.compatible he he')) hxs' hxs
      simp_rw [← LocalHomeomorph.coe_trans, LocalHomeomorph.trans_assoc] at hφ
      simp_rw [LocalHomeomorph.trans_symm_eq_symm_trans_symm, LocalHomeomorph.trans_assoc]
      have hs : IsOpen (f.symm ≫ₕ e.symm ≫ₕ e' ≫ₕ f').source :=
        (f.symm ≫ₕ e.symm ≫ₕ e' ≫ₕ f').open_source
      refine' ⟨_, hs.inter φ.open_source, _, _⟩
      · simp only [hx, hφ_dom, mfld_simps]
      · refine' G₁.eq_on_source (closed_under_restriction' hφG₁ hs) _
        rw [LocalHomeomorph.restr_source_inter]
        refine' (hφ.mono _).restr_eqOn_source
        mfld_set_tac }
#align structure_groupoid.has_groupoid.comp StructureGroupoid.HasGroupoid.comp

end LocalStructomorph

end StructureGroupoid


/-
Copyright (c) 2021 Oliver Nash. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Oliver Nash
-/
import topology.algebra.continuous_affine_map
import analysis.normed_space.affine_isometry
import analysis.normed_space.operator_norm

/-!
# Continuous affine maps between normed spaces.

This file develops the theory of continuous affine maps between affine spaces modelled on normed
spaces.

In the particular case that the affine spaces are just normed vector spaces `V`, `W`, we define a
norm on the space of continuous affine maps by defining the norm of `f : V →A[𝕜] W` to be
`‖f‖ = max ‖f 0‖ ‖f.cont_linear‖`. This is chosen so that we have a linear isometry:
`(V →A[𝕜] W) ≃ₗᵢ[𝕜] W × (V →L[𝕜] W)`.

The abstract picture is that for an affine space `P` modelled on a vector space `V`, together with
a vector space `W`, there is an exact sequence of `𝕜`-modules: `0 → C → A → L → 0` where `C`, `A`
are the spaces of constant and affine maps `P → W` and `L` is the space of linear maps `V → W`.

Any choice of a base point in `P` corresponds to a splitting of this sequence so in particular if we
take `P = V`, using `0 : V` as the base point provides a splitting, and we prove this is an
isometric decomposition.

On the other hand, choosing a base point breaks the affine invariance so the norm fails to be
submultiplicative: for a composition of maps, we have only `‖f.comp g‖ ≤ ‖f‖ * ‖g‖ + ‖f 0‖`.

## Main definitions:

 * `continuous_affine_map.cont_linear`
 * `continuous_affine_map.has_norm`
 * `continuous_affine_map.norm_comp_le`
 * `continuous_affine_map.to_const_prod_continuous_linear_map`

-/

namespace continuous_affine_map

variables {𝕜 R V W W₂ P Q Q₂ : Type*}
variables [normed_add_comm_group V] [metric_space P] [normed_add_torsor V P]
variables [normed_add_comm_group W] [metric_space Q] [normed_add_torsor W Q]
variables [normed_add_comm_group W₂] [metric_space Q₂] [normed_add_torsor W₂ Q₂]
variables [normed_field R] [normed_space R V] [normed_space R W] [normed_space R W₂]
variables [nontrivially_normed_field 𝕜] [normed_space 𝕜 V] [normed_space 𝕜 W] [normed_space 𝕜 W₂]

include V W

/-- The linear map underlying a continuous affine map is continuous. -/
def cont_linear (f : P →A[R] Q) : V →L[R] W :=
{ to_fun := f.linear,
  cont   := by { rw affine_map.continuous_linear_iff, exact f.cont, },
  .. f.linear, }

@[simp] lemma coe_cont_linear (f : P →A[R] Q) :
  (f.cont_linear : V → W) = f.linear :=
rfl

@[simp] lemma coe_cont_linear_eq_linear (f : P →A[R] Q) :
  (f.cont_linear : V →ₗ[R] W) = (f : P →ᵃ[R] Q).linear :=
by { ext, refl, }

@[simp] lemma coe_mk_const_linear_eq_linear (f : P →ᵃ[R] Q) (h) :
  ((⟨f, h⟩ : P →A[R] Q).cont_linear : V → W) = f.linear :=
rfl

lemma coe_linear_eq_coe_cont_linear (f : P →A[R] Q) :
  ((f : P →ᵃ[R] Q).linear : V → W) = (⇑f.cont_linear : V → W) :=
rfl

include W₂

@[simp] lemma comp_cont_linear (f : P →A[R] Q) (g : Q →A[R] Q₂) :
  (g.comp f).cont_linear = g.cont_linear.comp f.cont_linear :=
rfl

omit W₂

@[simp] lemma map_vadd (f : P →A[R] Q) (p : P) (v : V) :
  f (v +ᵥ p) = f.cont_linear v +ᵥ f p :=
f.map_vadd' p v

@[simp] lemma cont_linear_map_vsub (f : P →A[R] Q) (p₁ p₂ : P) :
  f.cont_linear (p₁ -ᵥ p₂) = f p₁ -ᵥ f p₂ :=
f.to_affine_map.linear_map_vsub p₁ p₂

@[simp] lemma const_cont_linear (q : Q) : (const R P q).cont_linear = 0 := rfl

lemma cont_linear_eq_zero_iff_exists_const (f : P →A[R] Q) :
  f.cont_linear = 0 ↔ ∃ q, f = const R P q :=
begin
  have h₁ : f.cont_linear = 0 ↔ (f : P →ᵃ[R] Q).linear = 0,
  { refine ⟨λ h, _, λ h, _⟩;
    ext,
    { rw [← coe_cont_linear_eq_linear, h], refl, },
    { rw [← coe_linear_eq_coe_cont_linear, h], refl, }, },
  have h₂ : ∀ (q : Q), f = const R P q ↔ (f : P →ᵃ[R] Q) = affine_map.const R P q,
  { intros q,
    refine ⟨λ h, _, λ h, _⟩;
    ext,
    { rw h, refl, },
    { rw [← coe_to_affine_map, h], refl, }, },
  simp_rw [h₁, h₂],
  exact (f : P →ᵃ[R] Q).linear_eq_zero_iff_exists_const,
end

@[simp] lemma to_affine_map_cont_linear (f : V →L[R] W) :
  f.to_continuous_affine_map.cont_linear = f :=
by { ext, refl, }

@[simp] lemma zero_cont_linear :
  (0 : P →A[R] W).cont_linear = 0 :=
rfl

@[simp] lemma add_cont_linear (f g : P →A[R] W) :
  (f + g).cont_linear = f.cont_linear + g.cont_linear :=
rfl

@[simp] lemma sub_cont_linear (f g : P →A[R] W) :
  (f - g).cont_linear = f.cont_linear - g.cont_linear :=
rfl

@[simp] lemma neg_cont_linear (f : P →A[R] W) :
  (-f).cont_linear = -f.cont_linear :=
rfl

@[simp] lemma smul_cont_linear (t : R) (f : P →A[R] W) :
  (t • f).cont_linear = t • f.cont_linear :=
rfl

lemma decomp (f : V →A[R] W) :
  (f : V → W) = f.cont_linear + function.const V (f 0) :=
begin
  rcases f with ⟨f, h⟩,
  rw [coe_mk_const_linear_eq_linear, coe_mk, f.decomp, pi.add_apply, linear_map.map_zero, zero_add],
end

section normed_space_structure

variables (f : V →A[𝕜] W)

/-- Note that unlike the operator norm for linear maps, this norm is _not_ submultiplicative:
we do _not_ necessarily have `‖f.comp g‖ ≤ ‖f‖ * ‖g‖`. See `norm_comp_le` for what we can say. -/
noncomputable instance has_norm : has_norm (V →A[𝕜] W) := ⟨λ f, max ‖f 0‖ ‖f.cont_linear‖⟩

lemma norm_def : ‖f‖ = (max ‖f 0‖ ‖f.cont_linear‖) := rfl

lemma norm_cont_linear_le : ‖f.cont_linear‖ ≤ ‖f‖ := le_max_right _ _

lemma norm_image_zero_le : ‖f 0‖ ≤ ‖f‖ := le_max_left _ _

@[simp] lemma norm_eq (h : f 0 = 0) : ‖f‖ = ‖f.cont_linear‖ :=
calc ‖f‖ = (max ‖f 0‖ ‖f.cont_linear‖) : by rw norm_def
    ... = (max 0 ‖f.cont_linear‖) : by rw [h, norm_zero]
    ... = ‖f.cont_linear‖ : max_eq_right (norm_nonneg _)

noncomputable instance : normed_add_comm_group (V →A[𝕜] W) :=
add_group_norm.to_normed_add_comm_group
{ to_fun := λ f, max ‖f 0‖ ‖f.cont_linear‖,
  map_zero' := by simp,
  neg' := λ f, by simp,
  add_le' := λ f g, begin
      simp only [pi.add_apply, add_cont_linear, coe_add, max_le_iff],
      exact ⟨(norm_add_le _ _).trans (add_le_add (le_max_left _ _) (le_max_left _ _)),
             (norm_add_le _ _).trans (add_le_add (le_max_right _ _) (le_max_right _ _))⟩,
    end,
  eq_zero_of_map_eq_zero' := λ f h₀, begin
      rcases max_eq_iff.mp h₀ with ⟨h₁, h₂⟩ | ⟨h₁, h₂⟩;
      rw h₁ at h₂,
      { rw [norm_le_zero_iff, cont_linear_eq_zero_iff_exists_const] at h₂,
        obtain ⟨q, rfl⟩ := h₂,
        simp only [function.const_apply, coe_const, norm_eq_zero] at h₁,
        rw h₁,
        refl, },
      { rw [norm_eq_zero', cont_linear_eq_zero_iff_exists_const] at h₁,
        obtain ⟨q, rfl⟩ := h₁,
        simp only [function.const_apply, coe_const, norm_le_zero_iff] at h₂,
        rw h₂,
        refl, },
    end }

instance : normed_space 𝕜 (V →A[𝕜] W) :=
{ norm_smul_le := λ t f, by simp only [norm_def, smul_cont_linear, coe_smul, pi.smul_apply,
    norm_smul, ← mul_max_of_nonneg _ _ (norm_nonneg t)], }

lemma norm_comp_le (g : W₂ →A[𝕜] V) :
  ‖f.comp g‖ ≤ ‖f‖ * ‖g‖ + ‖f 0‖ :=
begin
  rw [norm_def, max_le_iff],
  split,
  { calc ‖f.comp g 0‖ = ‖f (g 0)‖ : by simp
                 ... = ‖f.cont_linear (g 0) + f 0‖ : by { rw f.decomp, simp, }
                 ... ≤ ‖f.cont_linear‖ * ‖g 0‖ + ‖f 0‖ :
                          (norm_add_le _ _).trans (add_le_add_right (f.cont_linear.le_op_norm _) _)
                 ... ≤ ‖f‖ * ‖g‖ + ‖f 0‖ :
                          add_le_add_right (mul_le_mul f.norm_cont_linear_le g.norm_image_zero_le
                          (norm_nonneg _) (norm_nonneg _)) _, },
  { calc ‖(f.comp g).cont_linear‖ ≤ ‖f.cont_linear‖ * ‖g.cont_linear‖ :
                                      (g.comp_cont_linear f).symm ▸ f.cont_linear.op_norm_comp_le _
                             ... ≤ ‖f‖ * ‖g‖ :
                                      mul_le_mul f.norm_cont_linear_le g.norm_cont_linear_le
                                      (norm_nonneg _) (norm_nonneg _)
                             ... ≤ ‖f‖ * ‖g‖ + ‖f 0‖ :
                                      by { rw le_add_iff_nonneg_right, apply norm_nonneg, }, },
end

variables (𝕜 V W)

/-- The space of affine maps between two normed spaces is linearly isometric to the product of the
codomain with the space of linear maps, by taking the value of the affine map at `(0 : V)` and the
linear part. -/
def to_const_prod_continuous_linear_map : (V →A[𝕜] W) ≃ₗᵢ[𝕜] W × (V →L[𝕜] W) :=
{ to_fun    := λ f, ⟨f 0, f.cont_linear⟩,
  inv_fun   := λ p, p.2.to_continuous_affine_map + const 𝕜 V p.1,
  left_inv  := λ f, by { ext, rw f.decomp, simp, },
  right_inv := by { rintros ⟨v, f⟩, ext; simp, },
  map_add'  := λ _ _, rfl,
  map_smul' := λ _ _, rfl,
  norm_map' := λ f, rfl }

@[simp] lemma to_const_prod_continuous_linear_map_fst (f : V →A[𝕜] W) :
  (to_const_prod_continuous_linear_map 𝕜 V W f).fst = f 0 :=
rfl

@[simp] lemma to_const_prod_continuous_linear_map_snd (f : V →A[𝕜] W) :
  (to_const_prod_continuous_linear_map 𝕜 V W f).snd = f.cont_linear :=
rfl

end normed_space_structure

end continuous_affine_map


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

namespace Lake

/--
Proof that the equality of a compare function corresponds
to propositional equality.
-/
class EqOfCmp (α : Type u) (cmp : α → α → Ordering) where
  eq_of_cmp {a a' : α} : cmp a a' = .eq → a = a'

export EqOfCmp (eq_of_cmp)

/--
Proof that the equality of a compare function corresponds
to propositional equality and vice versa.
-/
class LawfulCmpEq (α : Type u) (cmp : α → α → Ordering) extends EqOfCmp α cmp where
  cmp_rfl {a : α} : cmp a a = .eq

export LawfulCmpEq (cmp_rfl)

attribute [simp] cmp_rfl

@[simp] theorem cmp_iff_eq [LawfulCmpEq α cmp] : cmp a a' = .eq ↔ a = a' :=
  Iff.intro eq_of_cmp fun a_eq => a_eq ▸ cmp_rfl

/--
Proof that the equality of a compare function corresponds
to propositional equality with respect to a given function.
-/
class EqOfCmpWrt (α : Type u) {β : Type v} (f : α → β) (cmp : α → α → Ordering) where
  eq_of_cmp_wrt {a a' : α} : cmp a a' = .eq → f a = f a'

export EqOfCmpWrt (eq_of_cmp_wrt)

instance : EqOfCmpWrt α (fun _ => α) cmp := ⟨fun _ => rfl⟩

instance [EqOfCmp α cmp] : EqOfCmpWrt α f cmp where
  eq_of_cmp_wrt h := by rw [eq_of_cmp h]

instance [EqOfCmpWrt α (fun a => a) cmp] : EqOfCmp α cmp where
  eq_of_cmp h := eq_of_cmp_wrt (f := fun a => a) h

-- ## Basic Instances

theorem eq_of_compareOfLessAndEq [LT α] [DecidableEq α] {a a' : α}
[Decidable (a < a')] (h : compareOfLessAndEq a a' = .eq) : a = a' := by
  unfold compareOfLessAndEq at h
  split at h; case inl => exact False.elim h
  split at h; case inr => exact False.elim h
  assumption

theorem compareOfLessAndEq_rfl [LT α] [DecidableEq α] {a : α}
[Decidable (a < a)] (lt_irrefl : ¬ a < a) : compareOfLessAndEq a a = .eq := by
  simp [compareOfLessAndEq, lt_irrefl]

instance : LawfulCmpEq Nat compare where
  eq_of_cmp := eq_of_compareOfLessAndEq
  cmp_rfl := compareOfLessAndEq_rfl <| Nat.lt_irrefl _

theorem Fin.eq_of_compare {n n' : Fin m} (h : compare n n' = .eq) : n = n' := by
  dsimp only [compare] at h
  have h' := eq_of_compareOfLessAndEq h
  exact Fin.eq_of_val_eq h'

instance : LawfulCmpEq (Fin n) compare where
  eq_of_cmp := Fin.eq_of_compare
  cmp_rfl := compareOfLessAndEq_rfl <| Nat.lt_irrefl _

instance : LawfulCmpEq UInt64 compare where
  eq_of_cmp h := eq_of_compareOfLessAndEq h
  cmp_rfl := compareOfLessAndEq_rfl <| Nat.lt_irrefl _

theorem List.lt_irrefl [LT α] (irrefl_α : ∀ a : α, ¬ a < a)
: (a : List α) → ¬ a < a
| _, .head _ _ h => irrefl_α _ h
| _, .tail _ _ h3 => lt_irrefl irrefl_α _ h3

@[simp] theorem String.lt_irrefl (s : String) : ¬ s < s :=
  List.lt_irrefl (fun c => Nat.lt_irrefl c.1.1) _

instance : LawfulCmpEq String compare where
  eq_of_cmp := eq_of_compareOfLessAndEq
  cmp_rfl := compareOfLessAndEq_rfl <| String.lt_irrefl _

@[macro_inline]
def Option.compareWith (cmp : α → α → Ordering) : Option α → Option α → Ordering
| none,   none    => .eq
| none,   some _  => .lt
| some _, none    => .gt
| some x, some y  => cmp x y

instance [EqOfCmp α cmp] : EqOfCmp (Option α) (Option.compareWith cmp) where
  eq_of_cmp := by
    intro o o'
    unfold Option.compareWith
    cases o <;> cases o' <;> simp
    exact eq_of_cmp

instance [LawfulCmpEq α cmp] : LawfulCmpEq (Option α) (Option.compareWith cmp) where
  cmp_rfl := by
    intro o
    unfold Option.compareWith
    cases o <;> simp

def Prod.compareWith
(cmpA : α → α → Ordering) (cmpB : β → β → Ordering)
: (α × β) → (α × β) → Ordering :=
  fun (a, b) (a', b') => match cmpA a a' with | .eq => cmpB b b' | ord => ord

instance [EqOfCmp α cmpA] [EqOfCmp β cmpB]
: EqOfCmp (α × β) (Prod.compareWith cmpA cmpB) where
  eq_of_cmp := by
    intro (a, b) (a', b')
    dsimp only [Prod.compareWith]
    split; next ha => intro hb; rw [eq_of_cmp ha, eq_of_cmp hb]
    intros; contradiction

instance [LawfulCmpEq α cmpA] [LawfulCmpEq β cmpB]
: LawfulCmpEq (α × β) (Prod.compareWith cmpA cmpB) where
  cmp_rfl := by simp [Prod.compareWith]


/-
Copyright (c) 2020 Simon Hudon. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author(s): Simon Hudon
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.testing.slim_check.sampleable
import Mathlib.PostPort

universes l v u_1 u u_2

namespace Mathlib

/-!
# `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
/- ... -/

/- no specialized sampling -/

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

-- ===================

-- Found problems!

-- x := 358

-- -------------------

namespace slim_check

/-- 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 test_result (p : Prop)
where
| success : psum Unit p → test_result p
| gave_up : ℕ → test_result p
| failure : ¬p → List string → ℕ → test_result p

/-- format a `test_result` as a string. -/
protected def test_result.to_string {p : Prop} : test_result p → string :=
  sorry

/-- configuration for testing a property -/
structure slim_check_cfg
where
  num_inst : ℕ
  max_size : ℕ
  trace_discarded : Bool
  trace_success : Bool
  trace_shrink : Bool
  trace_shrink_candidates : Bool
  random_seed : Option ℕ
  quiet : Bool

protected instance test_result.has_to_string {p : Prop} : has_to_string (test_result p) :=
  has_to_string.mk test_result.to_string

/--
`printable_prop p` allows one to print a proposition so that
`slim_check` can indicate how values relate to each other.
-/
class printable_prop (p : Prop)
where
  print_prop : Option string

protected instance default_printable_prop {p : Prop} : printable_prop p :=
  printable_prop.mk none

/-- `testable p` uses random examples to try to disprove `p`. -/
class testable (p : Prop)
where
  run : slim_check_cfg → Bool → gen (test_result p)

/-- applicative combinator proof carrying test results -/
def combine {p : Prop} {q : Prop} : psum Unit (p → q) → psum Unit p → psum Unit q :=
  sorry

/-- Combine the test result for properties `p` and `q` to create a test for their conjunction. -/
def and_counter_example {p : Prop} {q : Prop} : test_result p → test_result q → test_result (p ∧ q) :=
  sorry

/-- Combine the test result for properties `p` and `q` to create a test for their disjunction -/
def or_counter_example {p : Prop} {q : Prop} : test_result p → test_result q → test_result (p ∨ q) :=
  sorry

/-- If `q → p`, then `¬ p → ¬ q` which means that testing `p` can allow us
to find counter-examples to `q`. -/
def convert_counter_example {p : Prop} {q : Prop} (h : q → p) : test_result p → optParam (psum Unit (p → q)) (psum.inl Unit.unit) → test_result q :=
  sorry

/-- Test `q` by testing `p` and proving the equivalence between the two. -/
def convert_counter_example' {p : Prop} {q : Prop} (h : p ↔ q) (r : test_result p) : test_result q :=
  convert_counter_example (iff.mpr h) r (psum.inr (iff.mp h))

/-- 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 add_to_counter_example (x : string) {p : Prop} {q : Prop} (h : q → p) : test_result p → optParam (psum Unit (p → q)) (psum.inl Unit.unit) → test_result q :=
  sorry

/-- Add some formatting to the information recorded by `add_to_counter_example`. -/
def add_var_to_counter_example {γ : Type v} [has_repr γ] (var : string) (x : γ) {p : Prop} {q : Prop} (h : q → p) : test_result p → optParam (psum Unit (p → q)) (psum.inl Unit.unit) → test_result q :=
  add_to_counter_example
    (var ++
        string.str
          (string.str
            (string.str (string.str string.empty (char.of_nat (bit0 (bit0 (bit0 (bit0 (bit0 1)))))))
              (char.of_nat (bit0 (bit1 (bit0 (bit1 (bit1 1)))))))
            (char.of_nat (bit1 (bit0 (bit1 (bit1 (bit1 1)))))))
          (char.of_nat (bit0 (bit0 (bit0 (bit0 (bit0 1)))))) ++
      repr x)
    h

/-- 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] def named_binder (n : string) (p : Prop) :=
  p

/-- Is the given test result a failure? -/
def is_failure {p : Prop} : test_result p → Bool :=
  sorry

protected instance and_testable (p : Prop) (q : Prop) [testable p] [testable q] : testable (p ∧ q) :=
  testable.mk
    fun (cfg : slim_check_cfg) (min : Bool) =>
      do
        let xp ← testable.run p cfg min
        let xq ← testable.run q cfg min
        pure (and_counter_example xp xq)

protected instance or_testable (p : Prop) (q : Prop) [testable p] [testable q] : testable (p ∨ q) :=
  testable.mk
    fun (cfg : slim_check_cfg) (min : Bool) =>
      do
        testable.run p cfg min
        sorry

protected instance iff_testable (p : Prop) (q : Prop) [testable (p ∧ q ∨ ¬p ∧ ¬q)] : testable (p ↔ q) :=
  testable.mk
    fun (cfg : slim_check_cfg) (min : Bool) =>
      do
        let xp ← testable.run (p ∧ q ∨ ¬p ∧ ¬q) cfg min
        return (convert_counter_example' sorry xp)

protected instance dec_guard_testable (var : string) (p : Prop) [printable_prop p] [Decidable p] (β : p → Prop) [(h : p) → testable (β h)] : testable (named_binder var (∀ (h : p), β h)) :=
  testable.mk
    fun (cfg : slim_check_cfg) (min : Bool) =>
      dite p (fun (h : p) => sorry)
        fun (h : ¬p) =>
          ite (↥(slim_check_cfg.trace_discarded cfg) ∨ ↥(slim_check_cfg.trace_success cfg)) sorry
            (return (test_result.gave_up 1))

/-- Type tag that replaces a type's `has_repr` instance with its `has_to_string` instance. -/
def use_has_to_string (α : Type u_1) :=
  α

protected instance use_has_to_string.inhabited (α : Type u) [I : Inhabited α] : Inhabited (use_has_to_string α) :=
  I

/-- Add the type tag `use_has_to_string` to an expression's type. -/
def use_has_to_string.mk {α : Type u_1} (x : α) : use_has_to_string α :=
  x

protected instance use_has_to_string.has_repr (α : Type u) [has_to_string α] : has_repr (use_has_to_string α) :=
  has_repr.mk to_string

protected instance all_types_testable (var : string) (f : Type → Prop) [testable (f ℤ)] : testable (named_binder var (∀ (x : Type), f x)) :=
  testable.mk
    fun (cfg : slim_check_cfg) (min : Bool) =>
      do
        let r ← testable.run (f ℤ) cfg min
        return
            (add_var_to_counter_example var
              (use_has_to_string.mk
                (string.str string.empty
                  (char.of_nat
                    (bit0 (bit0 (bit1 (bit0 (bit0 (bit1 (bit0 (bit0 (bit1 (bit0 (bit0 (bit0 (bit0 1))))))))))))))))
              sorry r (psum.inl Unit.unit))

/-- Trace the value of sampled variables if the sample is discarded. -/
def trace_if_giveup {p : Prop} {α : Type u_1} {β : Type u_2} [has_repr α] (tracing_enabled : Bool) (var : string) (val : α) : test_result p → thunk β → β :=
  sorry

/-- testable instance for a property iterating over the element of a list -/
protected instance test_forall_in_list (var : string) (var' : string) (α : Type u) (β : α → Prop) [(x : α) → testable (β x)] [has_repr α] (xs : List α) : testable (named_binder var (∀ (x : α), named_binder var' (x ∈ xs → β x))) :=
  sorry

/-- Test proposition `p` by randomly selecting one of the provided
testable instances. -/
def combine_testable (p : Prop) (t : List (testable p)) (h : 0 < list.length t) : testable p :=
  testable.mk
    fun (cfg : slim_check_cfg) (min : Bool) =>
      (fun (this : 0 < list.length (list.map (fun (t : testable p) => testable.run p cfg min) t)) =>
          gen.one_of (list.map (fun (t : testable p) => testable.run p cfg min) t) this)
        sorry

/--
Format the counter-examples found in a test failure.
-/
def format_failure (s : string) (xs : List string) (n : ℕ) : string := sorry

-------------------

/--
Format the counter-examples found in a test failure.
-/
def format_failure' (s : string) {p : Prop} : test_result p → string :=
  sorry

/--
Increase the number of shrinking steps in a test result.
-/
def add_shrinks {p : Prop} (n : ℕ) : test_result p → test_result p :=
  sorry

/-- 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 minimize_aux (α : Type u) (β : α → Prop) [sampleable_ext α] [(x : α) → testable (β x)] (cfg : slim_check_cfg) (var : string) : sampleable_ext.proxy_repr α →
  ℕ → option_t gen (sigma fun (x : sampleable_ext.proxy_repr α) => test_result (β (sampleable_ext.interp α x))) := sorry

/-- Once a property fails to hold on an example, look for smaller counter-examples
to show the user. -/
def minimize (α : Type u) (β : α → Prop) [sampleable_ext α] [(x : α) → testable (β x)] (cfg : slim_check_cfg) (var : string) (x : sampleable_ext.proxy_repr α) (r : test_result (β (sampleable_ext.interp α x))) : gen (sigma fun (x : sampleable_ext.proxy_repr α) => test_result (β (sampleable_ext.interp α x))) := sorry

protected instance exists_testable (var : string) (var' : string) (α : Type u) (β : α → Prop) (p : Prop) [testable (named_binder var (∀ (x : α), named_binder var' (β x → p)))] : testable (named_binder var' (named_binder var (∃ (x : α), β x) → p)) :=
  testable.mk
    fun (cfg : slim_check_cfg) (min : Bool) =>
      do
        let x ← testable.run (named_binder var (∀ (x : α), named_binder var' (β x → p))) cfg min
        pure (convert_counter_example' sorry x)

/-- Test a universal property by creating a sample of the right type and instantiating the
bound variable with it -/
protected instance var_testable (var : string) (α : Type u) (β : α → Prop) [sampleable_ext α] [(x : α) → testable (β x)] : testable (named_binder var (∀ (x : α), β x)) := sorry

/-- Test a universal property about propositions -/
protected instance prop_var_testable (var : string) (β : Prop → Prop) [I : (b : Bool) → testable (β ↥b)] : testable (named_binder var (∀ (p : Prop), β p)) :=
  testable.mk
    fun (cfg : slim_check_cfg) (min : Bool) =>
      (fun (ᾰ : test_result (∀ (b : Bool), β ↥b)) => convert_counter_example sorry ᾰ (psum.inl Unit.unit)) <$>
        testable.run (named_binder var (∀ (b : Bool), β ↥b)) cfg min

protected instance unused_var_testable (var : string) (α : Type u) (β : Prop) [Inhabited α] [testable β] : testable (named_binder var (α → β)) :=
  testable.mk
    fun (cfg : slim_check_cfg) (min : Bool) =>
      do
        let r ← testable.run β cfg min
        pure (convert_counter_example sorry r (psum.inr sorry))

protected instance subtype_var_testable (var : string) (var' : string) (α : Type u) (β : α → Prop) {p : α → Prop} [(x : α) → printable_prop (p x)] [(x : α) → testable (β x)] [I : sampleable_ext (Subtype p)] : testable (named_binder var (∀ (x : α), named_binder var' (p x → β x))) :=
  testable.mk
    fun (cfg : slim_check_cfg) (min : Bool) =>
      let test : (x : Subtype p) → testable (β ↑x) :=
        fun (x : Subtype p) =>
          testable.mk
            fun (cfg : slim_check_cfg) (min : Bool) =>
              do
                testable.run (β (subtype.val x)) cfg min
                sorry;
      do
        let r ← testable.run (∀ (x : Subtype p), β (subtype.val x)) cfg min
        pure (convert_counter_example' sorry r)

protected instance decidable_testable (p : Prop) [printable_prop p] [Decidable p] : testable p :=
  testable.mk
    fun (cfg : slim_check_cfg) (min : Bool) =>
      return (dite p (fun (h : p) => test_result.success (psum.inr h)) fun (h : ¬p) => sorry)

protected instance eq.printable_prop {α : Type u_1} [has_repr α] (x : α) (y : α) : printable_prop (x = y) :=
  printable_prop.mk
    (some
      (string.empty ++ to_string (repr x) ++
        (string.str
              (string.str (string.str string.empty (char.of_nat (bit0 (bit0 (bit0 (bit0 (bit0 1)))))))
                (char.of_nat (bit1 (bit0 (bit1 (bit1 (bit1 1)))))))
              (char.of_nat (bit0 (bit0 (bit0 (bit0 (bit0 1)))))) ++
            to_string (repr y) ++
          string.empty)))

protected instance ne.printable_prop {α : Type u_1} [has_repr α] (x : α) (y : α) : printable_prop (x ≠ y) :=
  printable_prop.mk
    (some
      (string.empty ++ to_string (repr x) ++
        (string.str
              (string.str (string.str string.empty (char.of_nat (bit0 (bit0 (bit0 (bit0 (bit0 1)))))))
                (char.of_nat
                  (bit0 (bit0 (bit0 (bit0 (bit0 (bit1 (bit1 (bit0 (bit0 (bit1 (bit0 (bit0 (bit0 1)))))))))))))))
              (char.of_nat (bit0 (bit0 (bit0 (bit0 (bit0 1)))))) ++
            to_string (repr y) ++
          string.empty)))

protected instance le.printable_prop {α : Type u_1} [HasLessEq α] [has_repr α] (x : α) (y : α) : printable_prop (x ≤ y) :=
  printable_prop.mk
    (some
      (string.empty ++ to_string (repr x) ++
        (string.str
              (string.str (string.str string.empty (char.of_nat (bit0 (bit0 (bit0 (bit0 (bit0 1)))))))
                (char.of_nat
                  (bit0 (bit0 (bit1 (bit0 (bit0 (bit1 (bit1 (bit0 (bit0 (bit1 (bit0 (bit0 (bit0 1)))))))))))))))
              (char.of_nat (bit0 (bit0 (bit0 (bit0 (bit0 1)))))) ++
            to_string (repr y) ++
          string.empty)))

protected instance lt.printable_prop {α : Type u_1} [HasLess α] [has_repr α] (x : α) (y : α) : printable_prop (x < y) :=
  printable_prop.mk
    (some
      (string.empty ++ to_string (repr x) ++
        (string.str
              (string.str (string.str string.empty (char.of_nat (bit0 (bit0 (bit0 (bit0 (bit0 1)))))))
                (char.of_nat (bit0 (bit0 (bit1 (bit1 (bit1 1)))))))
              (char.of_nat (bit0 (bit0 (bit0 (bit0 (bit0 1)))))) ++
            to_string (repr y) ++
          string.empty)))

protected instance perm.printable_prop {α : Type u_1} [has_repr α] (xs : List α) (ys : List α) : printable_prop (xs ~ ys) :=
  printable_prop.mk
    (some
      (string.empty ++ to_string (repr xs) ++
        (string.str
              (string.str (string.str string.empty (char.of_nat (bit0 (bit0 (bit0 (bit0 (bit0 1)))))))
                (char.of_nat (bit0 (bit1 (bit1 (bit1 (bit1 (bit1 1))))))))
              (char.of_nat (bit0 (bit0 (bit0 (bit0 (bit0 1)))))) ++
            to_string (repr ys) ++
          string.empty)))

protected instance and.printable_prop (x : Prop) (y : Prop) [printable_prop x] [printable_prop y] : printable_prop (x ∧ y) :=
  printable_prop.mk
    (do
      let x' ← printable_prop.print_prop x
      let y' ← printable_prop.print_prop y
      some
          (string.str string.empty (char.of_nat (bit0 (bit0 (bit0 (bit1 (bit0 1)))))) ++ to_string x' ++
            (string.str
                  (string.str (string.str string.empty (char.of_nat (bit0 (bit0 (bit0 (bit0 (bit0 1)))))))
                    (char.of_nat
                      (bit1 (bit1 (bit1 (bit0 (bit0 (bit1 (bit0 (bit0 (bit0 (bit1 (bit0 (bit0 (bit0 1)))))))))))))))
                  (char.of_nat (bit0 (bit0 (bit0 (bit0 (bit0 1)))))) ++
                to_string y' ++
              string.str string.empty (char.of_nat (bit1 (bit0 (bit0 (bit1 (bit0 1)))))))))

protected instance or.printable_prop (x : Prop) (y : Prop) [printable_prop x] [printable_prop y] : printable_prop (x ∨ y) :=
  printable_prop.mk
    (do
      let x' ← printable_prop.print_prop x
      let y' ← printable_prop.print_prop y
      some
          (string.str string.empty (char.of_nat (bit0 (bit0 (bit0 (bit1 (bit0 1)))))) ++ to_string x' ++
            (string.str
                  (string.str (string.str string.empty (char.of_nat (bit0 (bit0 (bit0 (bit0 (bit0 1)))))))
                    (char.of_nat
                      (bit0 (bit0 (bit0 (bit1 (bit0 (bit1 (bit0 (bit0 (bit0 (bit1 (bit0 (bit0 (bit0 1)))))))))))))))
                  (char.of_nat (bit0 (bit0 (bit0 (bit0 (bit0 1)))))) ++
                to_string y' ++
              string.str string.empty (char.of_nat (bit1 (bit0 (bit0 (bit1 (bit0 1)))))))))

protected instance iff.printable_prop (x : Prop) (y : Prop) [printable_prop x] [printable_prop y] : printable_prop (x ↔ y) :=
  printable_prop.mk
    (do
      let x' ← printable_prop.print_prop x
      let y' ← printable_prop.print_prop y
      some
          (string.str string.empty (char.of_nat (bit0 (bit0 (bit0 (bit1 (bit0 1)))))) ++ to_string x' ++
            (string.str
                  (string.str (string.str string.empty (char.of_nat (bit0 (bit0 (bit0 (bit0 (bit0 1)))))))
                    (char.of_nat
                      (bit0 (bit0 (bit1 (bit0 (bit1 (bit0 (bit0 (bit1 (bit1 (bit0 (bit0 (bit0 (bit0 1)))))))))))))))
                  (char.of_nat (bit0 (bit0 (bit0 (bit0 (bit0 1)))))) ++
                to_string y' ++
              string.str string.empty (char.of_nat (bit1 (bit0 (bit0 (bit1 (bit0 1)))))))))

protected instance imp.printable_prop (x : Prop) (y : Prop) [printable_prop x] [printable_prop y] : printable_prop (x → y) :=
  printable_prop.mk
    (do
      let x' ← printable_prop.print_prop x
      let y' ← printable_prop.print_prop y
      some
          (string.str string.empty (char.of_nat (bit0 (bit0 (bit0 (bit1 (bit0 1)))))) ++ to_string x' ++
            (string.str
                  (string.str (string.str string.empty (char.of_nat (bit0 (bit0 (bit0 (bit0 (bit0 1)))))))
                    (char.of_nat
                      (bit0 (bit1 (bit0 (bit0 (bit1 (bit0 (bit0 (bit1 (bit1 (bit0 (bit0 (bit0 (bit0 1)))))))))))))))
                  (char.of_nat (bit0 (bit0 (bit0 (bit0 (bit0 1)))))) ++
                to_string y' ++
              string.str string.empty (char.of_nat (bit1 (bit0 (bit0 (bit1 (bit0 1)))))))))

protected instance not.printable_prop (x : Prop) [printable_prop x] : printable_prop (¬x) :=
  printable_prop.mk
    (do
      let x' ← printable_prop.print_prop x
      some
          (string.str (string.str string.empty (char.of_nat (bit0 (bit0 (bit1 (bit1 (bit0 (bit1 (bit0 1)))))))))
                (char.of_nat (bit0 (bit0 (bit0 (bit0 (bit0 1)))))) ++
              to_string x' ++
            string.empty))

protected instance true.printable_prop : printable_prop True :=
  printable_prop.mk
    (some
      (string.str
        (string.str
          (string.str (string.str string.empty (char.of_nat (bit0 (bit0 (bit1 (bit0 (bit1 (bit1 1))))))))
            (char.of_nat (bit0 (bit1 (bit0 (bit0 (bit1 (bit1 1))))))))
          (char.of_nat (bit1 (bit0 (bit1 (bit0 (bit1 (bit1 1))))))))
        (char.of_nat (bit1 (bit0 (bit1 (bit0 (bit0 (bit1 1)))))))))

protected instance false.printable_prop : printable_prop False :=
  printable_prop.mk
    (some
      (string.str
        (string.str
          (string.str
            (string.str (string.str string.empty (char.of_nat (bit0 (bit1 (bit1 (bit0 (bit0 (bit1 1))))))))
              (char.of_nat (bit1 (bit0 (bit0 (bit0 (bit0 (bit1 1))))))))
            (char.of_nat (bit0 (bit0 (bit1 (bit1 (bit0 (bit1 1))))))))
          (char.of_nat (bit1 (bit1 (bit0 (bit0 (bit1 (bit1 1))))))))
        (char.of_nat (bit1 (bit0 (bit1 (bit0 (bit0 (bit1 1)))))))))

protected instance bool.printable_prop (b : Bool) : printable_prop ↥b :=
  printable_prop.mk
    (some
      (ite (↥b)
        (string.str
          (string.str
            (string.str (string.str string.empty (char.of_nat (bit0 (bit0 (bit1 (bit0 (bit1 (bit1 1))))))))
              (char.of_nat (bit0 (bit1 (bit0 (bit0 (bit1 (bit1 1))))))))
            (char.of_nat (bit1 (bit0 (bit1 (bit0 (bit1 (bit1 1))))))))
          (char.of_nat (bit1 (bit0 (bit1 (bit0 (bit0 (bit1 1))))))))
        (string.str
          (string.str
            (string.str
              (string.str (string.str string.empty (char.of_nat (bit0 (bit1 (bit1 (bit0 (bit0 (bit1 1))))))))
                (char.of_nat (bit1 (bit0 (bit0 (bit0 (bit0 (bit1 1))))))))
              (char.of_nat (bit0 (bit0 (bit1 (bit1 (bit0 (bit1 1))))))))
            (char.of_nat (bit1 (bit1 (bit0 (bit0 (bit1 (bit1 1))))))))
          (char.of_nat (bit1 (bit0 (bit1 (bit0 (bit0 (bit1 1))))))))))

/-- Execute `cmd` and repeat every time the result is `gave_up` (at most
`n` times). -/
def retry {p : Prop} (cmd : rand (test_result p)) : ℕ → rand (test_result p) :=
  sorry

/-- Count the number of times the test procedure gave up. -/
def give_up {p : Prop} (x : ℕ) : test_result p → test_result p :=
  sorry

/-- Try `n` times to find a counter-example for `p`. -/
def testable.run_suite_aux (p : Prop) [testable p] (cfg : slim_check_cfg) : test_result p → ℕ → rand (test_result p) :=
  sorry

/-- Try to find a counter-example of `p`. -/
def testable.run_suite (p : Prop) [testable p] (cfg : optParam slim_check_cfg
  (slim_check_cfg.mk (bit0 (bit0 (bit1 (bit0 (bit0 (bit1 1)))))) (bit0 (bit0 (bit1 (bit0 (bit0 (bit1 1)))))) false false
    false false none false)) : rand (test_result p) :=
  testable.run_suite_aux p cfg (test_result.success (psum.inl Unit.unit)) (slim_check_cfg.num_inst cfg)

/-- Run a test suite for `p` in `io`. -/
def testable.check' (p : Prop) [testable p] (cfg : optParam slim_check_cfg
  (slim_check_cfg.mk (bit0 (bit0 (bit1 (bit0 (bit0 (bit1 1)))))) (bit0 (bit0 (bit1 (bit0 (bit0 (bit1 1)))))) false false
    false false none false)) : io (test_result p) :=
  sorry

namespace tactic

/-!
## 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. -/
/-- Traverse the syntax of a proposition to find universal quantifiers
and existential quantifiers and add `named_binder` annotations next to
them. -/
/-- `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. -/
def decorations_of (p : Prop) :=
  Prop

/-- 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`.
-/
end tactic

/-- Run a test suite for `p` and return true or false: should we believe that `p` holds? -/
def testable.check (p : Prop) (cfg : optParam slim_check_cfg
  (slim_check_cfg.mk (bit0 (bit0 (bit1 (bit0 (bit0 (bit1 1)))))) (bit0 (bit0 (bit1 (bit0 (bit0 (bit1 1)))))) false false
    false false none false)) (p' : autoParam (tactic.decorations_of p)
  (Lean.Syntax.ident Lean.SourceInfo.none (String.toSubstring "Mathlib.slim_check.tactic.mk_decorations")
    (Lean.Name.mkStr
      (Lean.Name.mkStr (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "slim_check") "tactic")
      "mk_decorations")
    [])) [testable p'] : io PUnit :=
  do
    sorry
    sorry


-- Z : Type u,
-- a : Z,
-- _x α : Type u,
-- k : Z → α,
-- g f : α → _x,
-- w : (λ (x : Z), f (k x)) = λ (x : Z), g (k x)
-- ⊢ f (k a) = g (k a)

lemma {u} f
  ( Z : Type u )
  ( a : Z )
  ( α β  : Type u )
  ( k : Z → α )
  ( g f : α → β )
  ( w : (λ (x : Z), f (k x)) = λ (x : Z), g (k x) )
    : f (k a) = g (k a) := congr_fun w a
    -- begin
    --     -- I'd thought I could use:
    --     --   exact (congr_fun w a),
    --     -- this fails with:
    --     -- type mismatch at application
    --     --   congr_fun w
    --     -- term
    --     --   w
    --     -- has type
    --     --   (λ (x : Z), f (k x)) = λ (x : Z), g (k x)
    --     -- but is expected to have type
    --     --   f = g
    --   have p := congr_fun w a,
    --   exact p
    -- end


universes u

inductive Partial (α : Type u)
| val (a : α) : Partial
| bot {} : Partial

def terminates {α : Type u} (p : Partial α) : Prop := p ≠ Partial.bot

def fooAux (s : String) (c : Char) : Nat → String.Pos → Partial String.Pos
| 0            i := Partial.bot
| (Nat.succ k) i :=
  if s.atEnd i then Partial.val i
  else if s.get i == c then Partial.val i
  else fooAux k (s.next i)

theorem fooAuxEqSucc (s : String) (c : Char) : ∀ (k : Nat) (i : String.Pos), terminates (fooAux s c k i) → fooAux s c k.succ i = fooAux s c k i
| 0            i ht := absurd rfl ht
| (Nat.succ k) i ht :=
  show (fooAux s c k.succ.succ i = fooAux s c k.succ i), from
  Decidable.byCases
    (λ h : s.atEnd i,
      have h₁ : fooAux s c (k.succ.succ) i = Partial.val i, from ifPos h,
      have h₂ : fooAux s c k.succ i = Partial.val i, from ifPos h,
      Eq.trans h₁ h₂.symm)
    (λ h : ¬ s.atEnd i,
      Decidable.byCases
        (λ h' : s.get i == c,
           have h₁ : fooAux s c (k.succ.succ) i = Partial.val i, from Eq.trans (ifNeg h) (ifPos h'),
           have h₂ : fooAux s c k.succ i = Partial.val i, from Eq.trans (ifNeg h) (ifPos h'),
           Eq.trans h₁ h₂.symm)
        (λ h' : ¬ s.get i == c,
           have h₁ : fooAux s c (k.succ.succ) i   = fooAux s c k.succ (s.next i), from Eq.trans (ifNeg h) (ifNeg h'),
           have h₂ : fooAux s c k.succ i          = fooAux s c k (s.next i), from Eq.trans (ifNeg h) (ifNeg h'),
           have h₃ : fooAux s c k (s.next i) ≠ Partial.bot, from h₂ ▸ ht,
           have ih : fooAux s c k.succ (s.next i) = fooAux s c k (s.next i), from fooAuxEqSucc k _ h₃,
           Eq.trans h₁ (Eq.trans ih h₂.symm)))

theorem fooAuxTermSucc (s : String) (c : Char) (k : Nat) (i : String.Pos)
                       (h₁ : terminates (fooAux s c k.succ i)) (h₂ : ¬ (s.atEnd i)) (h₃ : ¬ (s.get i == c)) : terminates (fooAux s c k (s.next i)) :=
have (fooAux s c k.succ i) = fooAux s c k (s.next i), from Eq.trans (ifNeg h₂) (ifNeg h₃),
this ▸ h₁

constant bigNat : Nat := 1000000

def foo (s : String) (c : Char) (i : String.Pos) : Partial String.Pos :=
fooAux s c bigNat i

theorem fooEq (s : String) (c : Char) (i : String.Pos) :
     terminates (foo s c i) →
     foo s c i =  if s.atEnd i then Partial.val i
                  else if s.get i == c then Partial.val i
                  else foo s c (s.next i) :=
show terminates (fooAux s c bigNat i) → fooAux s c bigNat i =  (if s.atEnd i then Partial.val i
                                          else if s.get i == c then Partial.val i
                                          else fooAux s c bigNat (s.next i)), from
Nat.casesOn bigNat
  (λ h : fooAux s c 0 i ≠ Partial.bot, absurd rfl h)
  (λ N h,
    have h₁ : fooAux s c N.succ i = (if s.atEnd i then Partial.val i
                                     else if s.get i == c then Partial.val i
                                     else fooAux s c N (s.next i)), from rfl,
    Decidable.byCases
     (λ c₁ : s.atEnd i,
       have aux₁ : fooAux s c N.succ i = Partial.val i, from ifPos c₁,
       have aux₂ : ite (String.atEnd s i) (Partial.val i)
                       (ite (String.get s i == c) (Partial.val i) (fooAux s c (Nat.succ N) (String.next s i))) = Partial.val i, from ifPos c₁,
       Eq.trans aux₁ aux₂.symm)
     (λ c₁ : ¬ s.atEnd i,
       Decidable.byCases
         (λ c₂ : s.get i == c,
            have aux₁ : fooAux s c N.succ i = Partial.val i, from Eq.trans (ifNeg c₁) (ifPos c₂),
            have aux₂ : ite (String.atEnd s i) (Partial.val i)
                          (ite (String.get s i == c) (Partial.val i) (fooAux s c (Nat.succ N) (String.next s i))) = Partial.val i, from Eq.trans (ifNeg c₁) (ifPos c₂),
            Eq.trans aux₁ aux₂.symm)
         (λ c₂ : ¬ s.get i == c,
            have h₂ : terminates (fooAux s c N (s.next i)), from fooAuxTermSucc _ _ _ _ h c₁ c₂,
            have h₃ : fooAux s c N (s.next i) = fooAux s c N.succ (s.next i), from (fooAuxEqSucc _ _ _ _ h₂).symm,
            h₃ ▸ h₁)))


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

! This file was ported from Lean 3 source module algebraic_topology.dold_kan.split_simplicial_object
! leanprover-community/mathlib commit 31019c2504b17f85af7e0577585fad996935a317
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.AlgebraicTopology.SplitSimplicialObject
import Mathbin.AlgebraicTopology.DoldKan.Degeneracies
import Mathbin.AlgebraicTopology.DoldKan.FunctorN

/-!

# Split simplicial objects in preadditive categories

In this file we define a functor `nondeg_complex : simplicial_object.split C ⥤ chain_complex C ℕ`
when `C` is a preadditive category with finite coproducts, and get an isomorphism
`to_karoubi_nondeg_complex_iso_N₁ : nondeg_complex ⋙ to_karoubi _ ≅ forget C ⋙ dold_kan.N₁`.
-/

noncomputable section

open
  CategoryTheory CategoryTheory.Limits CategoryTheory.Category CategoryTheory.Preadditive CategoryTheory.Idempotents Opposite AlgebraicTopology AlgebraicTopology.DoldKan

open BigOperators Simplicial DoldKan

namespace SimplicialObject

namespace Splitting

variable {C : Type _} [Category C] [HasFiniteCoproducts C] {X : SimplicialObject C}
  (s : Splitting X)

/-- The projection on a summand of the coproduct decomposition given
by a splitting of a simplicial object. -/
def πSummand [HasZeroMorphisms C] {Δ : SimplexCategoryᵒᵖ} (A : IndexSet Δ) :
    X.obj Δ ⟶ s.n A.1.unop.len :=
  by
  refine' (s.iso Δ).inv ≫ sigma.desc fun B => _
  by_cases B = A
  ·
    exact
      eq_to_hom
        (by
          subst h
          rfl)
  · exact 0
#align simplicial_object.splitting.π_summand SimplicialObject.Splitting.πSummand

@[simp, reassoc.1]
theorem ι_πSummand_eq_id [HasZeroMorphisms C] {Δ : SimplexCategoryᵒᵖ} (A : IndexSet Δ) :
    s.ιSummand A ≫ s.πSummand A = 𝟙 _ :=
  by
  dsimp [ι_summand, π_summand]
  simp only [summand, assoc, is_iso.hom_inv_id_assoc]
  erw [colimit.ι_desc, cofan.mk_ι_app]
  dsimp
  simp only [eq_self_iff_true, if_true]
#align simplicial_object.splitting.ι_π_summand_eq_id SimplicialObject.Splitting.ι_πSummand_eq_id

@[simp, reassoc.1]
theorem ι_πSummand_eq_zero [HasZeroMorphisms C] {Δ : SimplexCategoryᵒᵖ} (A B : IndexSet Δ)
    (h : B ≠ A) : s.ιSummand A ≫ s.πSummand B = 0 :=
  by
  dsimp [ι_summand, π_summand]
  simp only [summand, assoc, is_iso.hom_inv_id_assoc]
  erw [colimit.ι_desc, cofan.mk_ι_app]
  apply dif_neg
  exact h.symm
#align simplicial_object.splitting.ι_π_summand_eq_zero SimplicialObject.Splitting.ι_πSummand_eq_zero

variable [Preadditive C]

theorem decomposition_id (Δ : SimplexCategoryᵒᵖ) :
    𝟙 (X.obj Δ) = ∑ A : IndexSet Δ, s.πSummand A ≫ s.ιSummand A :=
  by
  apply s.hom_ext'
  intro A
  rw [comp_id, comp_sum, Finset.sum_eq_single A, ι_π_summand_eq_id_assoc]
  · intro B h₁ h₂
    rw [s.ι_π_summand_eq_zero_assoc _ _ h₂, zero_comp]
  · simp only [Finset.mem_univ, not_true, IsEmpty.forall_iff]
#align simplicial_object.splitting.decomposition_id SimplicialObject.Splitting.decomposition_id

@[simp, reassoc.1]
theorem σ_comp_πSummand_id_eq_zero {n : ℕ} (i : Fin (n + 1)) :
    X.σ i ≫ s.πSummand (IndexSet.id (op [n + 1])) = 0 :=
  by
  apply s.hom_ext'
  intro A
  dsimp only [simplicial_object.σ]
  rw [comp_zero, s.ι_summand_epi_naturality_assoc A (SimplexCategory.σ i).op, ι_π_summand_eq_zero]
  symm
  change ¬(A.epi_comp (SimplexCategory.σ i).op).EqId
  rw [index_set.eq_id_iff_len_eq]
  have h := SimplexCategory.len_le_of_epi (inferInstance : epi A.e)
  dsimp at h⊢
  linarith
#align simplicial_object.splitting.σ_comp_π_summand_id_eq_zero SimplicialObject.Splitting.σ_comp_πSummand_id_eq_zero

/-- If a simplicial object `X` in an additive category is split,
then `P_infty` vanishes on all the summands of `X _[n]` which do
not correspond to the identity of `[n]`. -/
theorem ιSummand_comp_pInfty_eq_zero {X : SimplicialObject C} (s : SimplicialObject.Splitting X)
    {n : ℕ} (A : SimplicialObject.Splitting.IndexSet (op [n])) (hA : ¬A.EqId) :
    s.ιSummand A ≫ pInfty.f n = 0 :=
  by
  rw [SimplicialObject.Splitting.IndexSet.eqId_iff_mono] at hA
  rw [SimplicialObject.Splitting.ιSummand_eq, assoc, degeneracy_comp_P_infty X n A.e hA, comp_zero]
#align simplicial_object.splitting.ι_summand_comp_P_infty_eq_zero SimplicialObject.Splitting.ιSummand_comp_pInfty_eq_zero

theorem comp_pInfty_eq_zero_iff {Z : C} {n : ℕ} (f : Z ⟶ X _[n]) :
    f ≫ pInfty.f n = 0 ↔ f ≫ s.πSummand (IndexSet.id (op [n])) = 0 :=
  by
  constructor
  · intro h
    cases n
    · dsimp at h
      rw [comp_id] at h
      rw [h, zero_comp]
    · have h' := f ≫= P_infty_f_add_Q_infty_f (n + 1)
      dsimp at h'
      rw [comp_id, comp_add, h, zero_add] at h'
      rw [← h', assoc, Q_infty_f, decomposition_Q, preadditive.sum_comp, preadditive.comp_sum,
        Finset.sum_eq_zero]
      intro i hi
      simp only [assoc, σ_comp_π_summand_id_eq_zero, comp_zero]
  · intro h
    rw [← comp_id f, assoc, s.decomposition_id, preadditive.sum_comp, preadditive.comp_sum,
      Fintype.sum_eq_zero]
    intro A
    by_cases hA : A.eq_id
    · dsimp at hA
      subst hA
      rw [assoc, reassoc_of h, zero_comp]
    · simp only [assoc, s.ι_summand_comp_P_infty_eq_zero A hA, comp_zero]
#align simplicial_object.splitting.comp_P_infty_eq_zero_iff SimplicialObject.Splitting.comp_pInfty_eq_zero_iff

@[simp, reassoc.1]
theorem pInfty_comp_πSummand_id (n : ℕ) :
    pInfty.f n ≫ s.πSummand (IndexSet.id (op [n])) = s.πSummand (IndexSet.id (op [n])) :=
  by
  conv_rhs => rw [← id_comp (s.π_summand _)]
  symm
  rw [← sub_eq_zero, ← sub_comp, ← comp_P_infty_eq_zero_iff, sub_comp, id_comp, P_infty_f_idem,
    sub_self]
#align simplicial_object.splitting.P_infty_comp_π_summand_id SimplicialObject.Splitting.pInfty_comp_πSummand_id

@[simp, reassoc.1]
theorem πSummand_comp_ιSummand_comp_pInfty_eq_pInfty (n : ℕ) :
    s.πSummand (IndexSet.id (op [n])) ≫ s.ιSummand (IndexSet.id (op [n])) ≫ pInfty.f n =
      pInfty.f n :=
  by
  conv_rhs => rw [← id_comp (P_infty.f n)]
  erw [s.decomposition_id, preadditive.sum_comp]
  rw [Fintype.sum_eq_single (index_set.id (op [n])), assoc]
  rintro A (hA : ¬A.eq_id)
  rw [assoc, s.ι_summand_comp_P_infty_eq_zero A hA, comp_zero]
#align simplicial_object.splitting.π_summand_comp_ι_summand_comp_P_infty_eq_P_infty SimplicialObject.Splitting.πSummand_comp_ιSummand_comp_pInfty_eq_pInfty

/-- The differentials `s.d i j : s.N i ⟶ s.N j` on nondegenerate simplices of a split
simplicial object are induced by the differentials on the alternating face map complex. -/
@[simp]
def d (i j : ℕ) : s.n i ⟶ s.n j :=
  s.ιSummand (IndexSet.id (op [i])) ≫ K[X].d i j ≫ s.πSummand (IndexSet.id (op [j]))
#align simplicial_object.splitting.d SimplicialObject.Splitting.d

theorem ιSummand_comp_d_comp_πSummand_eq_zero (j k : ℕ) (A : IndexSet (op [j])) (hA : ¬A.EqId) :
    s.ιSummand A ≫ K[X].d j k ≫ s.πSummand (IndexSet.id (op [k])) = 0 :=
  by
  rw [A.eq_id_iff_mono] at hA
  rw [← assoc, ← s.comp_P_infty_eq_zero_iff, assoc, ← P_infty.comm j k, s.ι_summand_eq, assoc,
    degeneracy_comp_P_infty_assoc X j A.e hA, zero_comp, comp_zero]
#align simplicial_object.splitting.ι_summand_comp_d_comp_π_summand_eq_zero SimplicialObject.Splitting.ιSummand_comp_d_comp_πSummand_eq_zero

/-- If `s` is a splitting of a simplicial object `X` in a preadditive category,
`s.nondeg_complex` is a chain complex which is given in degree `n` by
the nondegenerate `n`-simplices of `X`. -/
@[simps]
def nondegComplex : ChainComplex C ℕ where
  pt := s.n
  d := s.d
  shape' i j hij := by simp only [d, K[X].shape i j hij, zero_comp, comp_zero]
  d_comp_d' i j k hij hjk := by
    simp only [d, assoc]
    have eq :
      K[X].d i j ≫ 𝟙 (X.obj (op [j])) ≫ K[X].d j k ≫ s.π_summand (index_set.id (op [k])) = 0 := by
      erw [id_comp, HomologicalComplex.d_comp_d_assoc, zero_comp]
    rw [s.decomposition_id] at eq
    classical
      rw [Fintype.sum_eq_add_sum_compl (index_set.id (op [j])), add_comp, comp_add, assoc,
        preadditive.sum_comp, preadditive.comp_sum, Finset.sum_eq_zero, add_zero] at eq
      swap
      · intro A hA
        simp only [Finset.mem_compl, Finset.mem_singleton] at hA
        simp only [assoc, ι_summand_comp_d_comp_π_summand_eq_zero _ _ _ _ hA, comp_zero]
      rw [Eq, comp_zero]
#align simplicial_object.splitting.nondeg_complex SimplicialObject.Splitting.nondegComplex

/-- The chain complex `s.nondeg_complex` attached to a splitting of a simplicial object `X`
becomes isomorphic to the normalized Moore complex `N₁.obj X` defined as a formal direct
factor in the category `karoubi (chain_complex C ℕ)`. -/
@[simps]
def toKaroubiNondegComplexIsoN₁ : (toKaroubi _).obj s.nondegComplex ≅ n₁.obj X
    where
  Hom :=
    { f :=
        { f := fun n => s.ιSummand (IndexSet.id (op [n])) ≫ pInfty.f n
          comm' := fun i j hij => by
            dsimp
            rw [assoc, assoc, assoc, π_summand_comp_ι_summand_comp_P_infty_eq_P_infty,
              HomologicalComplex.Hom.comm] }
      comm := by
        ext n
        dsimp
        rw [id_comp, assoc, P_infty_f_idem] }
  inv :=
    { f :=
        { f := fun n => s.πSummand (IndexSet.id (op [n]))
          comm' := fun i j hij => by
            dsimp
            slice_rhs 1 1 => rw [← id_comp (K[X].d i j)]
            erw [s.decomposition_id]
            rw [sum_comp, sum_comp, Finset.sum_eq_single (index_set.id (op [i])), assoc, assoc]
            · intro A h hA
              simp only [assoc, s.ι_summand_comp_d_comp_π_summand_eq_zero _ _ _ hA, comp_zero]
            · simp only [Finset.mem_univ, not_true, IsEmpty.forall_iff] }
      comm := by
        ext n
        dsimp
        simp only [comp_id, P_infty_comp_π_summand_id] }
  hom_inv_id' := by
    ext n
    simpa only [assoc, P_infty_comp_π_summand_id, karoubi.comp_f, HomologicalComplex.comp_f,
      ι_π_summand_eq_id]
  inv_hom_id' := by
    ext n
    simp only [π_summand_comp_ι_summand_comp_P_infty_eq_P_infty, karoubi.comp_f,
      HomologicalComplex.comp_f, N₁_obj_p, karoubi.id_eq]
#align simplicial_object.splitting.to_karoubi_nondeg_complex_iso_N₁ SimplicialObject.Splitting.toKaroubiNondegComplexIsoN₁

end Splitting

namespace Split

variable {C : Type _} [Category C] [Preadditive C] [HasFiniteCoproducts C]

/-- The functor which sends a split simplicial object in a preadditive category to
the chain complex which consists of nondegenerate simplices. -/
@[simps]
def nondegComplexFunctor : Split C ⥤ ChainComplex C ℕ
    where
  obj S := S.s.nondegComplex
  map S₁ S₂ Φ :=
    { f := Φ.f
      comm' := fun i j hij => by
        dsimp
        erw [← ι_summand_naturality_symm_assoc Φ (splitting.index_set.id (op [i])),
          ((alternating_face_map_complex C).map Φ.F).comm_assoc i j]
        simp only [assoc]
        congr 2
        apply S₁.s.hom_ext'
        intro A
        dsimp [alternating_face_map_complex]
        erw [ι_summand_naturality_symm_assoc Φ A]
        by_cases A.eq_id
        · dsimp at h
          subst h
          simpa only [splitting.ι_π_summand_eq_id, comp_id, splitting.ι_π_summand_eq_id_assoc]
        · have h' : splitting.index_set.id (op [j]) ≠ A :=
            by
            symm
            exact h
          rw [S₁.s.ι_π_summand_eq_zero_assoc _ _ h', S₂.s.ι_π_summand_eq_zero _ _ h', zero_comp,
            comp_zero] }
#align simplicial_object.split.nondeg_complex_functor SimplicialObject.Split.nondegComplexFunctor

/-- The natural isomorphism (in `karoubi (chain_complex C ℕ)`) between the chain complex
of nondegenerate simplices of a split simplicial object and the normalized Moore complex
defined as a formal direct factor of the alternating face map complex. -/
@[simps]
def toKaroubiNondegComplexFunctorIsoN₁ :
    nondegComplexFunctor ⋙ toKaroubi (ChainComplex C ℕ) ≅ forget C ⋙ DoldKan.n₁ :=
  NatIso.ofComponents (fun S => S.s.toKaroubiNondegComplexIsoN₁) fun S₁ S₂ Φ =>
    by
    ext n
    dsimp
    simp only [karoubi.comp_f, to_karoubi_map_f, HomologicalComplex.comp_f,
      nondeg_complex_functor_map_f, splitting.to_karoubi_nondeg_complex_iso_N₁_hom_f_f, N₁_map_f,
      alternating_face_map_complex.map_f, assoc, P_infty_f_idem_assoc]
    erw [← split.ι_summand_naturality_symm_assoc Φ (splitting.index_set.id (op [n]))]
    rw [P_infty_f_naturality]
#align simplicial_object.split.to_karoubi_nondeg_complex_functor_iso_N₁ SimplicialObject.Split.toKaroubiNondegComplexFunctorIsoN₁

end Split

end SimplicialObject


/-
Copyright (c) 2019 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes
-/
import data.rat
import set_theory.cardinal

namespace rat
open denumerable

instance : infinite ℚ :=
infinite.of_injective (coe : ℕ → ℚ) nat.cast_injective

private def denumerable_aux : ℚ ≃ { x : ℤ × ℕ // 0 < x.2 ∧ x.1.nat_abs.coprime x.2 } :=
{ to_fun := λ x, ⟨⟨x.1, x.2⟩, x.3, x.4⟩,
  inv_fun := λ x, ⟨x.1.1, x.1.2, x.2.1, x.2.2⟩,
  left_inv := λ ⟨_, _, _, _⟩, rfl,
  right_inv := λ ⟨⟨_, _⟩, _, _⟩, rfl }

instance : denumerable ℚ :=
begin
  let T := { x : ℤ × ℕ // 0 < x.2 ∧ x.1.nat_abs.coprime x.2 },
  letI : infinite T := infinite.of_injective _ denumerable_aux.injective,
  letI : encodable T := encodable.subtype,
  letI : denumerable T := of_encodable_of_infinite T,
  exact denumerable.of_equiv T denumerable_aux
end

end rat

namespace cardinal
lemma mk_rat : cardinal.mk ℚ = omega :=
denumerable_iff.mp ⟨by apply_instance⟩

end cardinal