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

Without loss of generality tactic.
-/
import tactic.basic tactic.interactive data.list.perm

open expr tactic lean lean.parser

local postfix `?`:9001 := optional
local postfix *:9001 := many

namespace tactic

private meta def update_pp_name : expr → name → expr
| (local_const n _ bi d) pp := local_const n pp bi d
| e n := e

private meta def elim_or : ℕ → expr → tactic (list expr)
| 0       h := fail "zero cases"
| 1       h := return [h]
| (n + 1) h := do
  [(_, [hl], []), (_, [hr], [])] ← induction h, -- there should be no dependent terms
  [gl, gr] ← get_goals,
  set_goals [gr],
  hsr ← elim_or n hr,
  gsr ← get_goals,
  set_goals (gl :: gsr),
  return (hl :: hsr)

private meta def dest_or : expr → tactic (list expr) | e := do
  `(%%a ∨ %%b) ← whnf e | return [e],
  lb ← dest_or b,
  return (a :: lb)

private meta def match_perms (pat : pattern) : expr → tactic (list $ list expr) | t :=
  (do
    m ← match_pattern pat t,
    guard (m.2.all expr.is_local_constant),
    return [m.2]) <|>
  (do
    `(%%l ∨ %%r) ← whnf t,
    m ← match_pattern pat l,
    rs ← match_perms r,
    return (m.2 :: rs))

private meta def update_type : expr → expr → expr
| (local_const n pp bi d) t := local_const n pp bi t
| e t := e

private meta def intron' : ℕ → tactic (list expr)
| 0       := return []
| (i + 1) := do
  n ← intro1,
  ls ← intron' i,
  return (n :: ls)

meta def wlog (vars' : list expr) (h_cases fst_case : expr) (perms : list (list expr)) :
  tactic unit := do
  guard h_cases.is_local_constant,

  -- reorder s.t. context is Γ ⬝ vars ⬝ cases ⊢ ∀deps, …
  nr ← revert_lst (vars' ++ [h_cases]),
  vars ← intron' vars'.length,
  h_cases ← intro h_cases.local_pp_name,

  cases ← infer_type h_cases,
  h_fst_case ←
    mk_local_def h_cases.local_pp_name
      (fst_case.instantiate_locals $ (vars'.zip vars).map $ λ⟨o, n⟩, (o.local_uniq_name, n)),
  ((), pr) ← solve_aux cases (repeat $ exact h_fst_case <|> left >> skip),

  t ← target,
  fixed_vars ← vars.mmap (λv, do t ← infer_type v, return (update_type v t) ),
  let t' := (instantiate_local h_cases.local_uniq_name pr t).pis (fixed_vars ++ [h_fst_case]),

  (h, [g]) ← local_proof `this t' (do
    clear h_cases,
    vars.mmap clear,
    intron nr),

  h₀ :: hs ← elim_or perms.length h_cases,

  solve1 (do
    exact (h.mk_app $ vars ++ [h₀])),

  focus ((hs.zip perms.tail).map $ λ⟨h_case, perm⟩, do
    let p_v := (vars'.zip vars).map (λ⟨p, v⟩, (p.local_uniq_name, v)),
    let p := perm.map (λp, p.instantiate_locals p_v),
    note `this none (h.mk_app $ p ++ [h_case]),
    clear h,
    return ()),
  gs ← get_goals,
  set_goals (g :: gs)

namespace interactive
open interactive interactive.types expr

private meta def parse_permutations : option (list (list name)) → tactic (list (list expr))
| none                    := return []
| (some [])               := return []
| (some perms@(p₀ :: ps)) := do
  (guard p₀.nodup <|>
    fail "No permutation `xs_i` in `using [xs_1, …, xs_n]` should contain the same variable twice."),
  (guard (perms.all $ λp, p.perm p₀) <|>
    fail "The permutations `xs_i` in `using [xs_1, …, xs_n]` must be permutations of the same variables."),
  perms.mmap (λp, p.mmap get_local)

/-- Without loss of generality: reduces to one goal under variables permutations.

Given a goal of the form `g xs`, a predicate `p` over a set of variables, as well as variable
permutations `xs_i`. Then `wlog` produces goals of the form

The case goal, i.e. the permutation `xs_i` covers all possible cases:
  `⊢ p xs_0 ∨ ⋯ ∨ p xs_n`
The main goal, i.e. the goal reduced to `xs_0`:
  `(h : p xs_0) ⊢ g xs_0`
The invariant goals, i.e. `g` is invariant under `xs_i`:
  `(h : p xs_i) (this : g xs_0) ⊢ gs xs_i`

Either the permutation is provided, or a proof of the disjunction is provided to compute the
permutation. The disjunction need to be in assoc normal form, e.g. `p₀ ∨ (p₁ ∨ p₂)`. In many cases
the invariant goals can be solved by AC rewriting using `cc` etc.

Example:
  On a state `(n m : ℕ) ⊢ p n m` the tactic `wlog h : n ≤ m using [n m, m n]` produces the following
  states:
    `(n m : ℕ) ⊢ n ≤ m ∨ m ≤ n`
    `(n m : ℕ) (h : n ≤ m) ⊢ p n m`
    `(n m : ℕ) (h : m ≤ n) (this : p n m) ⊢ p m n`

`wlog` supports different calling conventions. The name `h` is used to give a name to the introduced
case hypothesis. If the name is avoided, the default will be `case`.

(1) `wlog : p xs0 using [xs0, …, xsn]`
  Results in the case goal `p xs0 ∨ ⋯ ∨ ps xsn`, the main goal `(case : p xs0) ⊢ g xs0` and the
  invariance goals `(case : p xsi) (this : g xs0) ⊢ g xsi`.

(2) `wlog : p xs0 := r using xs0`
  The expression `r` is a proof of the shape `p xs0 ∨ ⋯ ∨ p xsi`, it is also used to compute the
  variable permutations.

(3) `wlog := r using xs0`
  The expression `r` is a proof of the shape `p xs0 ∨ ⋯ ∨ p xsi`, it is also used to compute the
  variable permutations. This is not as stable as (2), for example `p` cannot be a disjunction.

(4) `wlog : R x y using x y` and `wlog : R x y`
  Produces the case `R x y ∨ R y x`. If `R` is ≤, then the disjunction discharged using linearity.
  If `using x y` is avoided then `x` and `y` are the last two variables appearing in the
  expression `R x y`. -/
meta def wlog
  (h : parse ident?)
  (pat : parse (tk ":" *> texpr)?)
  (cases : parse (tk ":=" *> texpr)?)
  (perms : parse (tk "using" *> (list_of (ident*) <|> (λx, [x]) <$> ident*))?)
  (discharger : tactic unit :=
    (solve_by_elim <|> tauto <|> using_smt (smt_tactic.intros >> smt_tactic.solve_goals))) :
  tactic unit := do
perms ← parse_permutations perms,
(pat, cases_pr, cases_goal, vars, perms) ← (match cases with
| some r := do
  vars::_ ← return perms |
    fail "At least one set of variables expected, i.e. `using x y` or `using [x y, y x]`.",
  cases_pr ← to_expr r,
  cases_pr ← (if cases_pr.is_local_constant
    then return $ match h with some n := update_pp_name cases_pr n | none := cases_pr end
    else do
      note (h.get_or_else `case) none cases_pr),
  cases ← infer_type cases_pr,
  (pat, perms') ← match pat with
  | some pat := do
    pat ← to_expr pat,
    let vars' := vars.filter $ λv, v.occurs pat,
    case_pat ← mk_pattern [] vars' pat [] vars',
    perms' ← match_perms case_pat cases,
    return (pat, perms')
  | none := do
    (p :: ps) ← dest_or cases,
    let vars' := vars.filter $ λv, v.occurs p,
    case_pat ← mk_pattern [] vars' p [] vars',
    perms' ← (p :: ps).mmap (λp, do m ← match_pattern case_pat p, return m.2),
    return (p, perms')
  end,
  let vars_name := vars.map local_uniq_name,
  guard (perms'.all $ λp, p.all $ λv, v.is_local_constant ∧ v.local_uniq_name ∈ vars_name) <|>
    fail "Cases contains variables not declared in `using x y z`",
  perms ← (if perms.length = 1
    then do
      return (perms'.map $ λp, p ++ vars.filter (λv, p.all (λv', v'.local_uniq_name ≠ v.local_uniq_name)))
    else do
      guard (perms.length = perms'.length) <|>
        fail "The provided permutation list has a different length then the provided cases.",
      return perms),
  return (pat, cases_pr, @none expr, vars, perms)

| none   := do
  let name_h := h.get_or_else `case,
  some pat ← return pat | fail "Either specify cases or a pattern with permutations",
  pat ← to_expr pat,
  (do
    [x, y] ← match perms with
    | []  := return pat.list_local_consts
    | [l] := return l
    | _   := failed
    end,
    let cases := mk_or_lst [pat, pat.instantiate_locals [(x.local_uniq_name, y), (y.local_uniq_name, x)]],
    (do
      `(%%x' ≤ %%y') ← return pat,
      (cases_pr, []) ← local_proof name_h cases (exact ``(le_total %%x' %%y')),
      return (pat, cases_pr, none, [x, y], [[x, y], [y, x]]))
    <|>
    (do
      (cases_pr, [g]) ← local_proof name_h cases skip,
      return (pat, cases_pr, some g, [x, y], [[x, y], [y, x]]))) <|>
  (do
    guard (perms.length ≥ 2) <|>
      fail ("To generate cases at least two permutations are required, i.e. `using [x y, y x]`" ++
        " or exactly 0 or 2 variables"),
    (vars :: perms') ← return perms,
    let names := vars.map local_uniq_name,
    let cases := mk_or_lst (pat :: perms'.map (λp, pat.instantiate_locals (names.zip p))),
    (cases_pr, [g]) ← local_proof name_h cases skip,
    return (pat, cases_pr, some g, vars, perms))
end),
let name_fn :=
  (if perms.length = 2 then λi, `invariant else λi, mk_simple_name ("invariant_" ++ to_string (i + 1))),
with_enable_tags $ tactic.focus1 $ do
  t ← get_main_tag,
  tactic.wlog vars cases_pr pat perms,
  tactic.focus (set_main_tag (mk_num_name `_case 0 :: `main :: t) ::
    (list.range (perms.length - 1)).map (λi, do
      set_main_tag (mk_num_name `_case 0 :: name_fn i :: t),
      try discharger)),
  match cases_goal with
  | some g := do
    set_tag g (mk_num_name `_case 0 :: `cases :: t),
    gs ← get_goals,
    set_goals (g :: gs)
  | none := skip
  end

end interactive

end tactic


/-
Copyright (c) 2022 Henrik Böving. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Henrik Böving, Simon Hudon
-/

import LSpec.SlimCheck.Sampleable
import Lean

/-!
# `Checkable` Class
Checkable 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 `Checkable`, `SampleableExt` and `Shrinkable` are the
means by which `SlimCheck` creates samples and tests them. For instance,
the proposition `∀ i j : ℕ, i ≤ j` has a `Checkable` instance because `ℕ`
is sampleable and `i ≤ j` is decidable. Once `SlimCheck` finds the `Checkable`
instance, it can start using the instance to repeatedly creating samples
and checking whether they satisfy the property. Once it has found a
counter-example it will then use a `Shrinkable` instance to reduce the
example. This allows the user to create new instances and apply
`SlimCheck` to new situations.
### 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 MyType where
  x : ℕ
  y : ℕ
  h : x ≤ y
  deriving Repr
```
How do we test a property about `MyType`? For instance, let us consider
`Checkable.check $ ∀ a b : MyType, 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 `Shrinkable MyType` and `SampleableExt MyType`. We can define one as follows:
```lean
instance : Shrinkable MyType where
  shrink := λ ⟨x,y,h⟩ =>
    let proxy := Shrinkable.shrink (x, y - x)
    proxy.map (λ ⟨⟨fst, snd⟩, ha⟩ => ⟨⟨fst, fst + snd, sorry⟩, sorry⟩)
instance : SampleableExt MyType :=
  SampleableExt.mkSelfContained do
    let x ← SampleableExt.interpSample Nat
    let xyDiff ← SampleableExt.interpSample Nat
    pure $ ⟨x, x + xyDiff, sorry⟩
```
Again, we take advantage of the fact that other types have useful
`Shrinkable` implementations, in this case `Prod`. Note that the second
proof is heavily based on `WellFoundedRelation` since its used for termination so
the first step you want to take is almost always to `simp_wf` in order to
get through the `WellFoundedRelation`.
## Main definitions
  * `Checkable` class
  * `Checkable.check`: a way to test a proposition using random examples
## Tags
random testing
## References
  * https://hackage.haskell.org/package/QuickCheck
-/

namespace SlimCheck

/-- Result of trying to disprove `p`
The constructors are:
  *  `success : (PSum Unit p) → TestResult p`
     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.
   * `gaveUp : ℕ → TestResult p`
     give up when a well-formed example cannot be generated.
     `gaveUp 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) → ℕ → TestResult p`
     a counter-example to `p`; the strings specify values for the relevant variables.
     `failure h vs n` also carries a proof that `p` does not hold. This way, we can
     guarantee that there will be no false positive. The last component, `n`,
     is the number of times that the counter-example was shrunk.
-/
inductive TestResult (p : Prop) where
  | success : PSum Unit p → TestResult p
  | gaveUp : Nat → TestResult p
  | failure : ¬ p → List String → Nat → TestResult p
  deriving Inhabited

/-- Configuration for testing a property. -/
structure Configuration where
  numInst : Nat := 100
  maxSize : Nat := 100
  numRetries : Nat := 10
  traceDiscarded : Bool := false
  traceSuccesses : Bool := false
  traceShrink : Bool := false
  traceShrinkCandidates : Bool := false
  randomSeed : Option Nat := none
  quiet : Bool := false
  deriving Inhabited

/--
`PrintableProp p` allows one to print a proposition so that
`SlimCheck` can indicate how values relate to each other.
It's basically a poor man's delaborator.
-/
class PrintableProp (p : Prop) where
  printProp : String

export PrintableProp (printProp)

instance (priority := low) : PrintableProp p where
  printProp := "⋯"

/-- `Checkable p` uses random examples to try to disprove `p`. -/
class Checkable (p : Prop) where
  run (cfg : Configuration) (minimize : Bool) : Gen (TestResult p)

def NamedBinder (_n : String) (p : Prop) : Prop := p

namespace TestResult

def toString : TestResult p → String
| success (PSum.inl _) => "success (no proof)"
| success (PSum.inr _) => "success (proof)"
| gaveUp n => s!"gave {n} times"
| failure _ counters _ => s!"failed {counters}"

instance : ToString (TestResult p) := ⟨toString⟩

/-- Applicative combinator proof carrying test results. -/
def combine {p q : Prop} : PSum Unit (p → q) → PSum Unit p → PSum Unit q
| PSum.inr f, PSum.inr proof => PSum.inr $ f proof
| _, _ => PSum.inl ()

/-- Combine the test result for properties `p` and `q` to create a test for their conjunction. -/
def and : TestResult p → TestResult q → TestResult (p ∧ q)
| failure h xs n, _ => failure (λ h2 => h h2.left) xs n
| _, failure h xs n => failure (λ h2 => h h2.right) xs n
| success h1, success h2 => success $ combine (combine (PSum.inr And.intro) h1) h2
| gaveUp n, gaveUp m => gaveUp $ n + m
| gaveUp n, _ => gaveUp n
| _, gaveUp n => gaveUp n

/-- Combine the test result for properties `p` and `q` to create a test for their disjunction. -/
def or : TestResult p → TestResult q → TestResult (p ∨ q)
| failure h1 xs n, failure h2 ys m =>
  let h3 := λ h =>
    match h with
    | Or.inl h3 => h1 h3
    | Or.inr h3 => h2 h3
  failure h3 (xs ++ ys) (n + m)
| success h, _ => success $ combine (PSum.inr Or.inl) h
| _, success h => success $ combine (PSum.inr Or.inr) h
| gaveUp n, gaveUp m => gaveUp $ n + m
| gaveUp n, _ => gaveUp n
| _, gaveUp n => gaveUp n

/-- If `q → p`, then `¬ p → ¬ q` which means that testing `p` can allow us
to find counter-examples to `q`. -/
def imp (h : q → p) (r : TestResult p)
    (p : PSum Unit (p → q) := PSum.inl ()) : TestResult q :=
  match r with
  | failure h2 xs n => failure (mt h h2) xs n
  | success h2 => success $ combine p h2
  | gaveUp n => gaveUp n

/-- Test `q` by testing `p` and proving the equivalence between the two. -/
def iff (h : q ↔ p) (r : TestResult p) : TestResult q :=
  imp h.mp r (PSum.inr h.mpr)

/-- 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 addInfo (x : String) (h : q → p) (r : TestResult p)
    (p : PSum Unit (p → q) := PSum.inl ()) : TestResult q :=
  if let failure h2 xs n := r then
    failure (mt h h2) (x :: xs) n
  else
    imp h r p

/-- Add some formatting to the information recorded by `addInfo`. -/
def addVarInfo [Repr γ] (var : String) (x : γ) (h : q → p) (r : TestResult p)
    (p : PSum Unit (p → q) := PSum.inl ()) : TestResult q  :=
  addInfo s!"{var} := {repr x}" h r p

def isFailure : TestResult p → Bool
| failure _ _ _ => true
| _ => false

end TestResult

namespace Configuration

/-- A configuration with all the trace options enabled, useful for debugging. -/
def verbose : Configuration where
  traceDiscarded := true
  traceSuccesses := true
  traceShrink := true
  traceShrinkCandidates := true

end Configuration

namespace Checkable

open TestResult

def runProp (p : Prop) [Checkable p] : Configuration → Bool → Gen (TestResult p) := Checkable.run

/-- A `dbgTrace` with special formatting -/
def slimTrace [Pure m] (s : String) : m PUnit := dbgTrace s!"[SlimCheck: {s}]" (λ _ => pure ())

instance andCheckable [Checkable p] [Checkable q] : Checkable (p ∧ q) where
  run := λ cfg min => do
    let xp ← runProp p cfg min
    let xq ← runProp q cfg min
    pure $ and xp xq

instance orCheckable [Checkable p] [Checkable q] : Checkable (p ∨ q) where
  run := λ cfg min => do
    let xp ← runProp p cfg min
    -- As a little performance optimization we can just not run the second
    -- test if the first succeeds
    match xp with
    | success (PSum.inl h) => pure $ success (PSum.inl h)
    | success (PSum.inr h) => pure $ success (PSum.inr $ Or.inl h)
    | _ =>
      let xq ← runProp q cfg min
      pure $ or xp xq

-- TODO(Winston): Move
protected theorem key : (a ↔ b) ↔ (a ∧ b) ∨ (¬ a ∧ ¬ b) :=
by constructor
   · intro h; rw [h]
     by_cases h : b
     · exact Or.inl <| And.intro h h
     · exact Or.inr <| And.intro h h
   · intro h
     match h with
     | Or.inl h => exact Iff.intro (λ _ => h.2) (λ _ => h.1)
     | Or.inr h => exact Iff.intro (λ a => False.elim $ h.1 a) (λ b => False.elim $ h.2 b)

instance iffCheckable [Checkable ((p ∧ q) ∨ (¬ p ∧ ¬ q))] : Checkable (p ↔ q) where
  run := λ cfg min => do
    let h ← runProp ((p ∧ q) ∨ (¬ p ∧ ¬ q)) cfg min
    pure $ iff Checkable.key h

instance decGuardCheckable [PrintableProp p] [Decidable p] {β : p → Prop} [∀ h, Checkable (β h)] : Checkable (NamedBinder var $ ∀ h, β h) where
  run := λ cfg min => do
    if h : p then
      let res := (runProp (β h) cfg min)
      let s := printProp p
      (λ r => addInfo s!"guard: {s}" (· $ h) r (PSum.inr $ λ q _ => q)) <$> res
    else if cfg.traceDiscarded || cfg.traceSuccesses then
      let res := (λ _ => pure $ gaveUp 1)
      let s := printProp p
      slimTrace s!"discard: Guard {s} does not hold"; res
    else
      pure $ gaveUp 1

instance forallTypesCheckable {f : Type → Prop} [Checkable (f Int)] : Checkable (NamedBinder var $ ∀ x, f x) where
  run := λ cfg min => do
    let r ← runProp (f Int) cfg min
    pure $ addVarInfo var "ℤ" (· $ Int) r

/--
Format the counter-examples found in a test failure.
-/
def formatFailure (s : String) (xs : List String) (n : Nat) : String :=
  let counter := "\n".intercalate xs
  let parts := [
    "\n===================",
    s,
    counter,
    s!"({n} shrinks)",
    "-------------------"
  ]
  "\n".intercalate parts

/--
Increase the number of shrinking steps in a test result.
-/
def addShrinks (n : Nat) : TestResult p → TestResult p
| TestResult.failure p xs m => TestResult.failure p xs (m + n)
| p => p

-- TODO(Winston): Move
instance [Inhabited (m (Option α))]: Inhabited (OptionT m α) where
  default := .mk default

/-- Shrink a counter-example `x` by using `Shrinkable.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`. -/
partial def minimizeAux [SampleableExt α] {β : α → Prop} [∀ x, Checkable (β x)] (cfg : Configuration) (var : String)
    (x : SampleableExt.proxy α) (n : Nat) : OptionT Gen (Σ x, TestResult (β (SampleableExt.interp x))) := do
  let candidates := SampleableExt.shrink.shrink x
  if cfg.traceShrinkCandidates then
    slimTrace s!"Candidates for {var} := {repr x}:\n  {repr candidates}"
  for candidate in candidates do
    if cfg.traceShrinkCandidates then
      slimTrace s!"Trying {var} := {repr candidate}"
    let res ← OptionT.lift $ Checkable.runProp (β (SampleableExt.interp candidate)) cfg true
    if res.isFailure then
      if cfg.traceShrink then
        slimTrace s!"{var} shrunk to {repr candidate} from {repr x}"
      let currentStep := OptionT.lift $ pure $ Sigma.mk candidate (addShrinks (n + 1) res)
      -- todo: `nextStep` is unused. Why is it here?
      -- let nextStep := @minimizeAux α _ β _ cfg var candidate (n + 1)
      return ← (currentStep)
  if cfg.traceShrink then
    slimTrace s!"No shrinking possible for {var} := {repr x}"
  failure

/-- Once a property fails to hold on an example, look for smaller counter-examples
to show the user. -/
def minimize [SampleableExt α] {β : α → Prop} [∀ x, Checkable (β x)] (cfg : Configuration) (var : String)
    (x : SampleableExt.proxy α) (r : TestResult (β $ SampleableExt.interp x)) : Gen (Σ x, TestResult (β $ SampleableExt.interp x)) := do
  if cfg.traceShrink then
     slimTrace "Shrink"
     slimTrace s!"Attempting to shrink {var} := {repr x}"
  let res ← OptionT.run $ minimizeAux cfg var x 0
  pure $ res.getD ⟨x, r⟩

/-- Test a universal property by creating a sample of the right type and instantiating the
bound variable with it. -/
instance varCheckable [SampleableExt α] {β : α → Prop} [∀ x, Checkable (β x)] : Checkable (NamedBinder var $ ∀ x : α, β x) where
  run := λ cfg min => do
    let x ← SampleableExt.sample
    if cfg.traceSuccesses || cfg.traceDiscarded then
      slimTrace s!"{var} := {repr x}"
    let r ← Checkable.runProp (β $ SampleableExt.interp x) cfg false
    let ⟨finalX, finalR⟩ ←
      if isFailure r then
        if cfg.traceSuccesses then
          slimTrace s!"{var} := {repr x} is a failure"
        if min then
          minimize cfg var x r
        else
          pure $ ⟨x, r⟩
      else
        pure $ ⟨x, r⟩
    pure $ addVarInfo var finalX (· $ SampleableExt.interp finalX) finalR

/-- Test a universal property about propositions -/
instance propVarCheckable {β : Prop → Prop} [∀ b : Bool, Checkable (β b)] :
  Checkable (NamedBinder var $ ∀ p : Prop, β p)
where
  run := λ cfg min =>
    imp (λ h (b : Bool) => h b) <$> Checkable.runProp (NamedBinder var $ ∀ b : Bool, β b) cfg min

instance (priority := high) unusedVarCheckable [Nonempty α] [Checkable β] :
  Checkable (NamedBinder var $ ∀ _x : α, β)
where
  run := λ cfg min => do
    if cfg.traceDiscarded || cfg.traceSuccesses then
      slimTrace s!"{var} is unused"
    let r ← Checkable.runProp β cfg min
    let finalR := addInfo s!"{var} is irrelevant (unused)" id r
    pure $ imp (· $ Classical.ofNonempty) finalR (PSum.inr $ λ x _ => x)

instance (priority := low) decidableCheckable {p : Prop} [PrintableProp p] [Decidable p] : Checkable p where
  run := λ _ _ =>
    if h : p then
      pure $ success (PSum.inr h)
    else
      let s := printProp p
      pure $ failure h [s!"issue: {s} does not hold"] 0

end Checkable

section PrintableProp

instance Eq.printableProp [Repr α] {x y : α} : PrintableProp (x = y) where
  printProp := s!"{repr x} = {repr y}"

instance Ne.printableProp [Repr α] {x y : α} : PrintableProp (x ≠ y) where
  printProp := s!"{repr x} ≠ {repr y}"

instance LE.printableProp [Repr α] [LE α] {x y : α} : PrintableProp (x ≤ y) where
  printProp := s!"{repr x} ≤ {repr y}"

instance LT.printableProp [Repr α] [LT α] {x y : α} : PrintableProp (x < y) where
  printProp := s!"{repr x} < {repr y}"

instance And.printableProp [PrintableProp x] [PrintableProp y]  : PrintableProp (x ∧ y) where
  printProp := s!"{printProp x} ∧ {printProp y}"

instance Or.printableProp [PrintableProp x] [PrintableProp y]  : PrintableProp (x ∨ y) where
  printProp := s!"{printProp x} ∨ {printProp y}"

instance Iff.printableProp [PrintableProp x] [PrintableProp y]  : PrintableProp (x ↔ y) where
  printProp := s!"{printProp x} ↔ {printProp y}"

instance Imp.printableProp [PrintableProp x] [PrintableProp y]  : PrintableProp (x → y) where
  printProp := s!"{printProp x} → {printProp y}"

instance Not.printableProp [PrintableProp x] : PrintableProp (¬x) where
  printProp := s!"¬{printProp x}"

instance True.printableProp : PrintableProp True where
  printProp := "True"

instance False.printableProp : PrintableProp False where
  printProp := "False"

instance Bool.printableProp {b : Bool} : PrintableProp b where
  printProp := if b then "true" else "false"

end PrintableProp

section IO
open TestResult

/-- Execute `cmd` and repeat every time the result is `gave_up` (at most `n` times). -/
def retry (cmd : Rand (TestResult p)) : Nat → Rand (TestResult p)
| 0 => pure $ TestResult.gaveUp 1
| n+1 => do
  let r ← cmd
  match r with
  | success hp => pure $ success hp
  | TestResult.failure h xs n => pure $ failure h xs n
  | gaveUp _ => retry cmd n

/-- Count the number of times the test procedure gave up. -/
def giveUp (x : Nat) : TestResult p → TestResult p
| success (PSum.inl ()) => gaveUp x
| success (PSum.inr p) => success $ (PSum.inr p)
| gaveUp n => gaveUp $ n + x
| TestResult.failure h xs n => failure h xs n

/-- Try `n` times to find a counter-example for `p`. -/
def Checkable.runSuiteAux (p : Prop) [Checkable p] (cfg : Configuration) : TestResult p → Nat → Rand (TestResult p)
| r, 0 => pure r
| r, n+1 => do
  let size := (cfg.numInst - n - 1) * cfg.maxSize / cfg.numInst
  if cfg.traceSuccesses then
    slimTrace s!"New sample"
    slimTrace s!"Retrying up to {cfg.numRetries} times until guards hold"
  let x ← retry (ReaderT.run (Checkable.runProp p cfg true) ⟨size⟩) cfg.numRetries
  match x with
  | (success (PSum.inl ())) => runSuiteAux p cfg r n
  | (gaveUp g) => runSuiteAux p cfg (giveUp g r) n
  | _ => pure $ x

/-- Try to find a counter-example of `p`. -/
def Checkable.runSuite (p : Prop) [Checkable p] (cfg : Configuration := {}) : Rand (TestResult p) :=
  Checkable.runSuiteAux p cfg (success $ PSum.inl ()) cfg.numInst

/-- Run a test suite for `p` in `BaseIO` using the global RNG in `stdGenRef`. -/
def Checkable.checkIO (p : Prop) [Checkable p] (cfg : Configuration := {}) : BaseIO (TestResult p) :=
  match cfg.randomSeed with
  | none => IO.runRand (Checkable.runSuite p cfg)
  | some seed => IO.runRandWith seed (Checkable.runSuite p cfg)

end IO

namespace Decorations

open Lean

/-- Traverse the syntax of a proposition to find universal quantifiers
quantifiers and add `NamedBinder` annotations next to them. -/
partial def addDecorations (e : Expr) : Expr :=
  e.replace $ λ expr =>
    match expr with
    | Expr.forallE name type body data =>
      let n := name.toString
      let newType := addDecorations type
      let newBody := addDecorations body
      let rest := Expr.forallE name newType newBody data
      some $ mkApp2 (mkConst `SlimCheck.NamedBinder) (mkStrLit n) rest
    | _ => none

/-- `DecorationsOf 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. -/
abbrev DecorationsOf (_p : Prop) := Prop

open Elab.Tactic
open Meta

/-- In a goal of the shape `⊢ DecorationsOf p`, `mk_decoration` examines
the syntax of `p` and adds `NamedBinder` around universal quantifications
to improve error messages. This tool can be used in the declaration of a
function as follows:
```lean
def foo (p : Prop) (p' : Decorations.DecorationsOf p := by mk_decorations) [Checkable p'] : ...
```
`p` is the parameter given by the user, `p'` is a definitionally equivalent
proposition where the quantifiers are annotated with `NamedBinder`.
-/
scoped elab "mk_decorations" : tactic => do
  let goalType ← (← getMainGoal).getType
  if let Expr.app (.const ``Decorations.DecorationsOf ..) body := goalType then
    closeMainGoal (addDecorations body)

end Decorations

open Decorations in
/-- Run a test suite for `p` and throw an exception if `p` does not not hold.-/
def Checkable.check (p : Prop) (cfg : Configuration := {}) (p' : Decorations.DecorationsOf p := by mk_decorations) [Checkable p'] : IO PUnit := do
  let x ← Checkable.checkIO p' cfg
  go p' x where /-- HACK: https://github.com/leanprover/lean4/issues/1247 -/ go p' (x : TestResult p') : IO PUnit := do
  match x with
  | TestResult.success _ => if !cfg.quiet then IO.println "Success" else pure ()
  | TestResult.gaveUp n => if !cfg.quiet then IO.println s!"Gave up {n} times"
  | TestResult.failure _ xs n => throw (IO.userError $ formatFailure "Found problems!" xs n)

-- #eval Checkable.check (∀ (x y z a : Nat) (h1 : 3 < x) (h2 : 3 < y), x - y = y - x) Configuration.verbose
-- #eval Checkable.check (∀ x : Nat, ∀ y : Nat, x + y = y + x) Configuration.verbose
-- #eval Checkable.check (∀ (x : (Nat × Nat)), x.fst - x.snd - 10 = x.snd - x.fst - 10) Configuration.verbose
-- #eval Checkable.check (∀ (x : Nat) (h : 10 < x), 5 < x) Configuration.verbose

end SlimCheck


import tactic.find data.equiv algebra.group_power data.fintype data.set.finite set_theory.cardinal data.set.lattice

noncomputable theory
local attribute [instance, priority 0] classical.prop_decidable classical.dec_pred
local attribute [instance] set_fintype
open fintype
local infix `^` := gpow
universe u

instance {α : Type*} (p : α → Prop) [fintype α] : fintype {a // p a} :=
set_fintype p

instance {α : Type*} [fintype α] (r : α → α → Prop) : fintype (quot r) :=
of_surjective (quot.mk r) (λ x, quot.exists_rep _)

lemma finset.sum_const {α β : Type*} [decidable_eq α] [add_comm_monoid β]
    (s : finset α) (b : β) : finset.sum s (λ a, b) = add_monoid.smul b (finset.card s) :=
finset.induction_on s (by simp) $ λ a s h hi,
by simp [finset.sum_insert h, finset.card_insert_of_not_mem h, hi, smul_succ]

theorem card_quot {α : Type*} [fintype α] (r : α → α → Prop) :
    card α = (finset.univ : finset (quot r)).sum (λ x, card {a // quot.mk r a = x}) :=
card_sigma (λ x, {a // quot.mk r a = x}) ▸
card_congr ⟨λ x, ⟨quot.mk r x, ⟨x, rfl⟩⟩, λ x, x.2, λ _, rfl, λ ⟨_, _, ⟨_⟩⟩, rfl⟩

instance {α : Type*} [fintype α] (s : setoid α) : fintype (quotient s) := quot.fintype s.r

theorem card_quotient {α : Type*} [fintype α] (s : setoid α) :
    card α = (finset.univ : finset (quotient s)).sum (λ x, card {a // ⟦a⟧ = x}) := card_quot s.r

instance {α : Type*} [fintype α] : fintype (set α) := pi.fintype

section
variable {α : Type*}
open function set finset

set_option pp.implicit true
#print eq.drec_on
lemma set.card_eq_zero {α : Type*} {s : set α} [hf : fintype s] : card s = 0 ↔ s = ∅ :=
⟨λ h, by_contradiction $ λ h₁, let ⟨x, hx⟩ := set.exists_mem_of_ne_empty h₁ in
finset.not_mem_empty (⟨x, hx⟩ : s) $ finset.card_eq_zero.1 h ▸ finset.mem_univ (⟨x, hx⟩ : s),
λ h, by rw ← set.empty_card; congr; assumption⟩

lemma set.to_finset_union_distrib {α : Type*} (s t : set α) [hs : fintype s] [ht : fintype t] :
@set.to_finset α (s ∪ t) (classical.choice $ set.finite_union ⟨hs⟩ ⟨ht⟩) = set.to_finset s ∪ set.to_finset t :=
finset.ext.2 $ λ x, by simp [set.mem_to_finset, finset.mem_union]

lemma set.card_disjoint_union {α : Type*} {s t : set α} (hs : fintype s) (ht : fintype t) (hst : disjoint s t) :
    @finset.card (s ∪ t : set α) (classical.choice $ set.finite_union ⟨hs⟩ ⟨ht⟩) = card s + card t :=
begin
  have h := set.card_fintype_of_finset _ (@set.mem_to_finset _ s hs),
  have h₁ : ∀ {s : set α} (hs : fintype s), @card s hs =  @card ↥s (@set.fintype_of_finset α s (@set.to_finset α s hs) (@set.mem_to_finset _ s hs)) := λ s hs, by congr,
  have h₃ := set.card_fintype_of_finset _ (@set.mem_to_finset _ t ht),
  have h₄ := set.card_fintype_of_finset _ (@set.mem_to_finset _ _ (classical.choice $ set.finite_union ⟨hs⟩ ⟨ht⟩)),
  rw [h₁ hs, h₁ ht, h₁ (classical.choice $ set.finite_union ⟨hs⟩ ⟨ht⟩), h, h₃, h₄, set.to_finset_union_distrib],
  rw finset.card_disjoint_union,
  simp [finset.disjoint],
  exact hst,

end

lemma blah {p q : Prop} (hp : p) (hq : q) : hp == hq :=
@eq.drec_on _ _ (λ r h₁, hp == (h₁ ▸ hp : r)) _
(propext ⟨λ h, hq, λ h, hp⟩) (heq.refl _)

class subgroup {α : Type*} [group α] (s : set α) : Prop :=
(one_mem : (1 : α) ∈ s)
(mul_mem : ∀ {x y}, x ∈ s → y ∈ s → x * y ∈ s)
(inv_mem : ∀ {x}, x ∈ s → x⁻¹ ∈ s)
end
namespace subgroup
variables {α : Type*} [g : group α]
include g

instance group (s : set α) [subgroup s] : group s :=
{ mul := λ ⟨x, hx⟩ ⟨y, hy⟩, ⟨x * y, mul_mem hx hy⟩,
  mul_assoc := λ ⟨x, hx⟩ ⟨y, hy⟩ ⟨z, hz⟩, subtype.eq $ mul_assoc _ _ _,
  one := ⟨1, one_mem s⟩,
  one_mul := λ ⟨x, hx⟩, subtype.eq $ one_mul _,
  mul_one := λ ⟨x, hx⟩, subtype.eq $ mul_one _,
  inv := λ ⟨x, hx⟩, ⟨x⁻¹, inv_mem hx⟩,
  mul_left_inv := λ ⟨x, hx⟩, subtype.eq $ mul_left_inv _ }

@[simp] lemma coe_one (S : set α) [subgroup S] : ((1 : S) : α) = 1 := rfl

@[simp] lemma coe_mul {S : set α} [subgroup S] : ∀ a b : S, ((a * b : S) : α) = (a : α) * (b : α) :=
λ ⟨a, ha⟩ ⟨b, hb⟩, rfl

@[simp] lemma coe_inv {S : set α} [subgroup S] : ∀ a : S, ((a⁻¹ : S) : α) = (a : α)⁻¹ :=
λ ⟨a, ha⟩, rfl

@[simp] lemma coe_pow {S : set α} [subgroup S] (a : S) (n : ℕ) : ((monoid.pow a n : S) : α) = monoid.pow a n :=
by induction n; simp[pow_succ, *]

@[simp] lemma coe_gpow {S : set α} [subgroup S] (a : S) (i : ℤ) : ((gpow a i : S) : α) = gpow a i :=
by cases i; simp

end subgroup

section cyclic

class cyclic_group (α : Type*) extends group α :=
(cyclic : ∃ a, ∀ b : α, ∃ i : ℤ, a^i = b)

instance cyclic_group.comm_group {α : Type*} [h : cyclic_group α] : comm_group α :=
{ mul_comm :=
  λ x y, let ⟨a, ha⟩ := cyclic_group.cyclic α in
         let ⟨i, hi⟩ := ha x in
         let ⟨j, hj⟩ := ha y in
         hi ▸ hj ▸ gpow_mul_comm a i j,
  ..h }

variables {α : Type*} [group α]

def cycle (a : α) := {b : α | ∃ i : ℤ, a^i = b}

instance [fintype α] (a : α) : fintype (cycle a) := set_fintype _

instance (a : α) : subgroup (cycle a) :=
{ one_mem := ⟨0, by simp⟩,
  inv_mem := λ b ⟨i, hi⟩, ⟨-i, hi ▸ gpow_neg _ _⟩,
  mul_mem := λ b c ⟨i, hi⟩ ⟨j, hj⟩, ⟨i + j, hi ▸ (hj ▸ (gpow_add _ _ _))⟩ }

instance (a : α) : cyclic_group (cycle a) :=
{ cyclic := ⟨⟨a, 1, pow_one _⟩, λ ⟨b, ⟨i, hi⟩⟩,
⟨i, subtype.eq ((subgroup.coe_gpow (⟨a, _⟩ : cycle a) i).trans hi)⟩ ⟩ }

lemma mem_cycle_self (a : α) [fintype (cycle a)] : a ∈ cycle a := ⟨1, by simp⟩

lemma exists_int_pow_eq_one_of_finite_cycle (a : α) [fintype (cycle a)] : ∃ i : ℤ, i ≠ 0 ∧ a^i = 1 :=
by_contradiction $ λ h, @not_injective_nat_fintype _ _ _
(λ n, (⟨a^(nat.succ n), ⟨int.nat_abs (nat.succ n), by rw [int.nat_abs_of_nat] ⟩ ⟩ : cycle a)) $
have h : ∀ i : ℤ, ¬(i ≠ 0 ∧ a^i = 1) := not_exists.mp h,
have h₁ : ∀ (i : ℤ), a^i = 1 → ¬i ≠ 0 := λ i, not_and'.mp (h i),
λ m n hmn, have hmn' : a^(nat.succ m) =a^(nat.succ n) := subtype.mk.inj hmn,
begin
  rw [← sub_add_cancel ((nat.succ m) : ℤ) (nat.succ n), gpow_add, ← mul_right_inj (a^nat.succ n)⁻¹,
      mul_inv_self, mul_assoc, mul_inv_self, mul_one] at hmn',
  exact nat.succ_inj (int.coe_nat_inj $ eq_of_sub_eq_zero $ not_not.mp $ h₁ _ hmn')
end

lemma exists_nat_pow_eq_one_of_finite_cycle (a : α) [fintype (cycle a)] :
    ∃ n : ℕ, 0 < n ∧ monoid.pow a n = 1 :=
let ⟨i, hi⟩ := exists_int_pow_eq_one_of_finite_cycle a in
⟨int.nat_abs i, ⟨int.nat_abs_pos_of_ne_zero hi.1,
or.by_cases (int.nat_abs_eq i)
(λ h, by rw h at hi; exact (gpow_coe_nat _ _).symm.trans hi.2)
(λ h, by rw [h, gpow_neg] at hi; exact (gpow_coe_nat _ _).symm.trans (inv_eq_one.1 hi.2)) ⟩ ⟩

def ord (a : α) [fintype (cycle a)] := nat.find $ exists_nat_pow_eq_one_of_finite_cycle a

variables (a : α) [fintype (cycle a)]

@[simp] lemma pow_ord : monoid.pow a (ord a) = 1 := (nat.find_spec $ exists_nat_pow_eq_one_of_finite_cycle a).2

lemma ord_pos : 0 < ord a := (nat.find_spec $ exists_nat_pow_eq_one_of_finite_cycle a).1

lemma ord_le {a : α} [fintype (cycle a)] {n : ℕ} (ha0 : 0 < n) (han : monoid.pow a n = 1) : ord a ≤ n :=
nat.find_min' (exists_nat_pow_eq_one_of_finite_cycle a) ⟨ha0, han⟩

lemma lt_ord {a : α} [fintype (cycle a)] {n : ℕ} (hn : n < ord a) : n = 0 ∨ monoid.pow a n ≠ 1 :=
have h : ¬0 < n ∨ ¬ monoid.pow a n = 1 := (decidable.not_and_iff_or_not _ _).1 (nat.find_min
(exists_nat_pow_eq_one_of_finite_cycle a) hn), by rwa [nat.pos_iff_ne_zero', not_not] at h

lemma ord_dvd_int_iff (i : ℤ) : (ord a : ℤ) ∣ i ↔ a^i = 1 :=
⟨λ h₁, let ⟨k, hk⟩ := exists_eq_mul_right_of_dvd h₁ in by simp [hk, gpow_mul, pow_ord],
λ h₁, by_contradiction $ λ h₂,
begin
  rw int.dvd_iff_mod_eq_zero at h₂,
  have h₃ : gpow a (i % ↑(ord a)) = 1,
  { rw ← int.mod_add_div i (ord a) at h₁,
    simp [gpow_add, gpow_mul] at h₁,
    exact h₁ },
  have hzc := int.coe_nat_ne_zero.2 (ne_of_lt (ord_pos a)).symm,
  have h₄ : (int.nat_abs (i % ord a) : ℤ) = (i % ord a) :=
    int.nat_abs_of_nonneg (int.mod_nonneg _ hzc),
  have h₅ : monoid.pow a (int.nat_abs (i % ↑(ord a))) = 1 := by rwa [← gpow_coe_nat, h₄],
  have h₆ : (ord a : ℤ) ≤ (i % ↑(ord a)) := by rw [← h₄, int.coe_nat_le];
    exact ord_le (int.nat_abs_pos_of_ne_zero h₂) h₅,
  have h₇ := int.mod_lt i hzc,
  rw abs_of_nonneg (int.coe_nat_le.2 (nat.zero_le _)) at h₇,
  exact not_le_of_gt h₇ h₆,
end⟩

lemma ord_dvd_nat_iff (n : ℕ) : ord a ∣ n ↔ monoid.pow a n = 1 :=
let h := ord_dvd_int_iff a n in by simp [int.coe_nat_dvd] at h; assumption

lemma fintype_cycle_of_pow_eq_one (i : ℤ) (a : α) (hi : i ≠ 0) (h : a^i = 1) : fintype (cycle a) :=
fintype.of_surjective
(λ n : fin (int.nat_abs i), (⟨monoid.pow a n.val, n.val, by simp⟩ : cycle a)) $
λ ⟨b, j, hj⟩, have hji : 0 ≤ j % i := int.mod_nonneg _ hi,
⟨⟨int.nat_abs (j % i),
by rw [← int.coe_nat_lt, int.nat_abs_of_nonneg hji, ← int.abs_eq_nat_abs];
exact int.mod_lt _ hi⟩,
subtype.eq $ show monoid.pow a (int.nat_abs (j % i)) = b,
by rw [← gpow_coe_nat, int.nat_abs_of_nonneg hji, int.mod_def, sub_eq_add_neg,
    gpow_add, gpow_neg, gpow_mul, h, hj]; simp⟩

-- lemma ord_eq_cycle_card (a : α) [fintype (cycle a)] : ord a = card (cycle a) :=
-- card_fin (ord a) ▸ card_congr
-- ⟨λ (n : fin (ord a)), (⟨monoid.pow a n.val, ⟨n.val, by simp⟩⟩ : cycle a),
-- λ ⟨b, hb⟩, have ho : (0 : ℤ) < ord a := int.coe_nat_lt.2 (ord_pos a),
-- have h₁ : classical.some hb % ↑(ord a) ≥ 0 := int.mod_nonneg _ (ne_of_lt ho).symm,
-- ⟨int.nat_abs (classical.some hb % (ord a : ℤ)),
-- int.coe_nat_lt.1 ((int.nat_abs_of_nonneg h₁).symm ▸ int.mod_lt_of_pos _ ho)⟩,
-- λ ⟨n, hn⟩, begin cases lt_ord hn with h h,
-- simp [h],
--  end,sorry⟩

-- too long

lemma ord_eq_cycle_card (a : α) [fintype (cycle a)] : ord a = fintype.card (cycle a) :=
fintype.card_fin (ord a) ▸ (fintype.card_congr $ equiv.of_bijective $
show function.bijective (λ (n : fin (ord a)), (⟨monoid.pow a n.val, ⟨n.val, by simp⟩⟩ : cycle a)), from
⟨λ n m h, fin.eq_of_veq $ --injective proof
begin
  cases n with n hn,
  cases m with m hm,
  wlog h : m ≤ n using m n,
  { exact (this hm hn h_1.symm).symm },
  replace h_1 : monoid.pow a n = monoid.pow a m := subtype.mk.inj h_1,
  rw [← nat.sub_add_cancel h, ← one_mul (monoid.pow a m), pow_add, mul_right_inj] at h_1,
  have h₁ := or.neg_resolve_right (lt_ord (lt_of_le_of_lt (nat.sub_le n m) hn)) h_1,
  exact le_antisymm (nat.sub_eq_zero_iff_le.1 (or.neg_resolve_right (lt_ord
    (lt_of_le_of_lt (nat.sub_le n m) hn)) h_1)) h,
end, λ ⟨x, ⟨i, hi⟩ ⟩, -- surjective proof
have ho : (ord a : ℤ) ≠ 0 := int.coe_nat_ne_zero.2 (ne_of_lt (ord_pos _)).symm,
have hio : (int.to_nat (i % ↑(ord a)) : ℤ) = i % ord a := int.to_nat_of_nonneg (int.mod_nonneg _ ho),
⟨⟨int.to_nat (i % (ord a : ℤ)), int.coe_nat_lt.1 $
by rw [hio, ← abs_of_nonneg (int.coe_nat_le.2 (nat.zero_le (ord a))), int.mod_abs];
exact int.mod_lt _ ho⟩,
begin
  simp,
  rw [← gpow_coe_nat, hio, int.mod_def],
  simp [gpow_add, gpow_mul, gpow_neg, hi]
end⟩⟩)
#print ord_eq_cycle_card
end cyclic

section coset

open subgroup

variables {α : Type*} [group α] (S : set α) [subgroup S]

def lcoset (b : α) := {a : α | ∃ s ∈ S, b * s = a}

def rcoset (b : α) := {a : α | ∃ s ∈ S, s * b = a}

lemma lcoset_eq {S : set α} [subgroup S] {a b : α} : b ∈ lcoset S a → lcoset S a = lcoset S b :=
λ ⟨sa, hSsa, hsa⟩, set.ext $ λ x,
⟨λ ⟨sb, hSsb, hsb⟩, ⟨sa⁻¹ * sb, ⟨mul_mem (inv_mem hSsa) hSsb, hsa ▸ by simpa [mul_assoc] ⟩ ⟩,
λ ⟨sb, hSsb, hsb⟩, ⟨sa * sb, ⟨mul_mem hSsa hSsb, mul_assoc a sa sb ▸ hsa.symm ▸ hsb ⟩ ⟩ ⟩

lemma rcoset_eq {S : set α} [subgroup S] {a b : α} : b ∈ rcoset S a → rcoset S a = rcoset S b :=
λ ⟨sa, hSsa, hsa⟩, set.ext $ λ x,
⟨λ ⟨sb, hSsb, hsb⟩, ⟨sb * sa⁻¹, ⟨mul_mem hSsb (inv_mem hSsa), hsa ▸ by simpa [mul_assoc] ⟩ ⟩,
λ ⟨sb, hSsb, hsb⟩, ⟨sb * sa, ⟨mul_mem hSsb hSsa, (mul_assoc sb sa a).symm ▸ hsa.symm ▸ hsb ⟩ ⟩ ⟩

@[simp] lemma mem_lcoset_self (a : α) : a ∈ lcoset S a := ⟨1, one_mem _, mul_one _⟩

@[simp] lemma mem_rcoset_self (a : α) : a ∈ rcoset S a := ⟨1, one_mem _, one_mul _⟩

lemma lcoset_card [fintype α] (a : α) : card (lcoset S a) = fintype.card S :=
fintype.card_congr $ @equiv.of_bijective (lcoset S a) S
(λ x, ⟨a⁻¹ * x, let ⟨y, hyS, (hy : a * y = x)⟩ := x.2 in by rwa ← hy; simpa⟩)
⟨λ x y h, by simp at h; exact subtype.eq h, λ x, ⟨ ⟨a * x, ⟨x, ⟨x.2, rfl⟩ ⟩ ⟩, by simp ⟩ ⟩

lemma rcoset_card [fintype α] (a : α) : card (rcoset S a) = fintype.card S :=
fintype.card_congr $ @equiv.of_bijective (rcoset S a) S
(λ x, ⟨x * a⁻¹, let ⟨y, hyS, (hy : y *  a = x)⟩ := x.2 in by rwa ← hy; simpa⟩)
⟨λ x y h, by simp at h; exact subtype.eq h, λ x, ⟨ ⟨x * a, ⟨x, ⟨x.2, rfl⟩ ⟩ ⟩, by simp ⟩ ⟩

instance lcoset_setoid : setoid α :=
{ r := λ a b, b ∈ lcoset S a,
  iseqv := ⟨mem_lcoset_self S,
  λ a b h, by rw ← lcoset_eq h; exact mem_lcoset_self S a,
  λ a b c hab hbc, by rwa lcoset_eq hab⟩ }

def index [fintype α] := card (quotient (lcoset_setoid S))

theorem lagrange [fintype α] : card α = card S * index S :=
have h : (λ x : quotient (lcoset_setoid S), card {a // ⟦a⟧ = x}) = (λ x, card S) :=
  funext (λ x, begin
    simp only [@eq_comm _ _ x],
    rw [← quot.out_eq x, ← lcoset_card S (quot.out x)],
    congr,
    exact set.ext (λ y, quotient.eq)
  end),
by rw [card_quotient (lcoset_setoid S), h, finset.sum_const, nat.smul_eq_mul]; refl

end coset

lemma card_eq_ord_mul_index {α : Type*} [group α] [fintype α] (a : α) : card α = ord a * index (cycle a) :=
(ord_eq_cycle_card a).symm ▸ lagrange _

@[simp] lemma pow_card {α : Type*} [group α] [fintype α] (a : α) : monoid.pow a (card α) = 1 :=
(ord_dvd_nat_iff _ _).1 $ (card_eq_ord_mul_index a).symm ▸ dvd_mul_right _ _

open equiv

namespace perm
variables {α : Type*}

lemma mul_apply (a b : perm α) (x : α) : (a * b) x = (a (b x)) := rfl

@[simp] lemma one_apply (x : α) : (1 : perm α) x = x := rfl

instance [decidable_eq α] (h : fintype α): fintype (perm α) :=
fintype.of_equiv {y : (α → α) × (α → α) // function.left_inverse y.2 y.1 ∧ function.right_inverse y.2 y.1}
⟨λ x, ⟨x.1.1, x.1.2, x.2.1, x.2.2⟩, λ x, ⟨⟨x.1, x.2⟩, ⟨x.3, x.4⟩⟩, λ ⟨⟨_, _⟩, _, _⟩, rfl, λ ⟨_, _, _, _⟩, rfl⟩

instance perm.cycle.fintype [h : fintype α] (a : perm α) : fintype (cycle a) := @cycle.fintype (perm α) _ (perm.fintype h) a

def support (a : perm α) : set α := {x : α | a x ≠ x}

example (f g : perm α) : support (g * f * g⁻¹) = set.image g (support f) :=
set.ext $ λ y, ⟨λ h : _ ≠ _, ⟨g⁻¹ y, λ h₁, by
  rw [mul_apply, mul_apply, h₁, ← mul_apply, mul_inv_self] at h;
  exact h rfl,
show (g * g⁻¹) y = y,by rw mul_inv_self; refl⟩,
λ ⟨x, (hx : _ ≠ _ ∧ _)⟩, show _ ≠ _, from
begin
  rw [mul_apply, ← hx.2, ← mul_apply, ← mul_apply, mul_assoc, inv_mul_self, mul_one, mul_apply],
  assume h,
  rw (equiv.bijective g).1 h at hx,
  exact hx.1 rfl
end⟩

def disjoint (a b : perm α) := _root_.disjoint (support a) (support b)

lemma disjoint_or {a b : perm α} : disjoint a b ↔ ∀ x : α, a x = x ∨ b x = x :=
have h : disjoint a b ↔ ∀ x : α, ¬ (a x ≠ x ∧ b x ≠ x) :=
  ⟨λ (h : (λ x, a x ≠ x ∧ b x ≠ x : set α) = ∅) x,
  show x ∉ {x : α | a x ≠ x ∧ b x ≠ x}, by rw h; simp,
λ h, set.ext $ λ x, ⟨λ h₁, absurd h₁ (h x), λ h₁, absurd h₁ (set.not_mem_empty _)⟩⟩,
by rw h; simp only [or_iff_not_and_not]

lemma disjoint_comm {a b : perm α} (hd : disjoint a b) : a * b = b * a :=
equiv.ext _ _ $ λ x, show a (b x) = b (a x), from or.by_cases (disjoint_or.1 hd x)
(λ h, h.symm ▸ or.by_cases (disjoint_or.1 hd $ b x) (λ h₁, h₁) (λ h₁, ((equiv.bijective b).1 h₁).symm ▸ h))
(λ h, h.symm ▸ or.by_cases (disjoint_or.1 hd $ a x) (λ h₁, ((equiv.bijective a).1 h₁.symm) ▸ h.symm) (λ h₁, h₁.symm))

lemma eq_one_of_support_eq_empty {a : perm α} [fintype (support a)] (h : support a = ∅) : a = 1 :=
ext _ _ $ λ x, have hx : x ∉ support a := h.symm ▸ set.not_mem_empty x, not_not.1 hx

lemma exists_mem_support_of_ne_one {a : perm α} (h : a ≠ 1) : ∃ x : α, x ∈ support a :=
by_contradiction $ λ h₁, h $ ext _ _ $ by simp [support, *] at *

def same_cycle (a : perm α) (x y : α) := ∃ i : ℤ, (a^i) x = y

@[refl] lemma same_cycle.refl {a : perm α} (x : α) : same_cycle a x x := ⟨0, by rw gpow_zero; refl⟩

@[symm] lemma same_cycle.symm {a : perm α} {x y : α} (h : same_cycle a x y) : same_cycle a y x :=
let ⟨i, hi⟩ := h in ⟨-i, by rw [← hi, ←mul_apply, ← gpow_add, neg_add_self, gpow_zero, one_apply] ⟩

@[trans] lemma same_cycle.trans {a : perm α} {x y z : α} (hxy : same_cycle a x y) (hyz : same_cycle a y z)
    : same_cycle a x z :=
let ⟨i, hi⟩ := hxy in let ⟨j, hj⟩ := hyz in ⟨j + i, begin rw [gpow_add, mul_apply, hi], simp [hi, hj] end⟩

lemma same_cycle_apply {a : perm α} {x y : α} (h : same_cycle a x y) (i : ℤ) : same_cycle a ((a^i) x) y :=
same_cycle.trans (same_cycle.symm (⟨i, rfl⟩ : same_cycle a x ((a^i) x))) h

def cycle_of (a : perm α) (x : α) : perm α :=
{ to_fun   := λ y, ite (same_cycle a x y) (a y) y,
  inv_fun  := λ y, ite (same_cycle a x y) (a⁻¹ y) y,
  left_inv := λ y, dite (same_cycle a x y)
  (λ h, have h₁ : same_cycle a x (a y) := same_cycle.symm (same_cycle_apply (same_cycle.symm h) 1),
    by simp [h, h₁]; rw [← mul_apply, inv_mul_self, one_apply])
  (λ h, by simp [h]),
  right_inv := λ y, dite (same_cycle a x y)
  (λ h, have h₁ : same_cycle a x (a⁻¹ y) := same_cycle.symm (same_cycle_apply (same_cycle.symm h) (-1)),
    by simp [h, h₁]; rw [← mul_apply, mul_inv_self, one_apply])
  (λ h, by simp [h]) }

def is_cycle (a : perm α) := a ≠ 1 ∧ ∀ x y : α, x ∈ support a → y ∈ support a → same_cycle a x y

lemma support_disjoint_mul {a b : perm α} (h : disjoint a b) : support (a * b) = support a ∪ support b :=
set.ext $ λ x, or.by_cases (disjoint_or.1 h x)
(λ h₁, ⟨λ h₂, or.inr (have h₂ : b (a x) ≠ x := by rw disjoint_comm h at h₂; exact h₂, by rw h₁ at h₂; exact h₂),
λ h₂, by rw disjoint_comm h; exact show b (a x) ≠ x, by rw h₁; exact or.resolve_left h₂ (not_not.2 h₁)⟩)
(λ h₁, ⟨λ (h₂ : a (b x) ≠ x), or.inl $ by rw h₁ at h₂; exact h₂,
λ h₂, show a (b x) ≠ x, by rw h₁; exact or.resolve_right h₂ (not_not.2 h₁)⟩)

lemma exists_disjoint_factors [fintype α] (a : perm α) (h : ¬ is_cycle a) (h₁ : a ≠ 1) :
    ∃ b c : perm α, disjoint b c ∧ b * c = a ∧ card (support b) < card (support a) ∧
    card (support c) < card (support a) :=
begin
  suffices : ∀ (n : ℕ) (a : perm α), ¬ is_cycle a → a ≠ 1 → card (support a) ≤ n →
      ∃ b c : perm α, disjoint b c ∧ b * c = a ∧ card (support b) < card (support a) ∧
      card (support c) < card (support a),
  exact this (card (support a)) a h h₁ (le_refl _),
  assume n,
  induction n with n hi,
  { assume a h h₁ h₂,
    exact absurd (eq_one_of_support_eq_empty (set.card_eq_zero.1 (nat.eq_zero_of_le_zero h₂))) h₁ },
  { assume a h h₁ h₂,
    cases exists_mem_support_of_ne_one h₁ with x hx,

     }
end

-- lemma product_disjoint [fintype α] (a : perm α) : ∃ l : list (perm α), (∀ b ∈ l, is_cycle b ∧ b ≠ 1) ∧ (∀ b c ∈ l, disjoint b c) ∧ list.prod l = a :=
-- begin
--   suffices : ∀ (n : ℕ) (a : perm α), ord a ≤ n → ∃ l : list (perm α), (∀ b ∈ l, is_cycle b ∧ b ≠ 1) ∧ (∀ b c ∈ l, disjoint b c) ∧ list.prod l = a,
--   { exact this (ord a) a (le_refl _) },
--   assume n,
--   induction n with n hi,
--   { exact λ a ha, absurd (lt_of_lt_of_le (ord_pos a) ha) dec_trivial },
--   assume a ha,

-- end

end perm


inductive Palindrome : List α → Prop where
  | nil      : Palindrome []
  | single   : (a : α) → Palindrome [a]
  | sandwish : (a : α) → Palindrome as → Palindrome ([a] ++ as ++ [a])

theorem palindrome_reverse (h : Palindrome as) : Palindrome as.reverse := by
  induction h with
  | nil => done
  | single a => exact Palindrome.single a
  | sandwish a h ih => simp; exact Palindrome.sandwish _ ih

#check palindrome_reverse


import tactic

variable { T : Type}

lemma singleton_eq_append_implies_empty (a b: list T) (c d : T) : ([d] = a ++ [c] ++ b) → (a = [] ∧ b = [] ∧ c=d) := by
  {
    intro h,
    have h1 : a=[] := by
    {
      rw [←list.length_eq_zero, ←le_zero_iff],
      apply_fun list.length at h,
      simp only [list.length_append, list.length_singleton, list.append_assoc, list.singleton_append] at h,
      apply le_of_add_le_add_right,
      rw [←h],
      simp,
    },
    have h2 : b=[] := by
    {
      simp [h1] at h,
      rw [eq_comm],
      exact and.elim_right h,
    },
    have h3 : c=d := by
    {
      simp [h1, h2] at h,
      simp [eq_comm, h],
    },
    exact and.intro h1 (and.intro h2 h3),
  }


/-
Copyright (c) 2021 Rémy Degenne. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Zhouhang Zhou, Yury Kudryashov
-/

import measure_theory.function.l1_space
import analysis.normed_space.indicator_function

/-! # Functions integrable on a set and at a filter

We define `integrable_on f s μ := integrable f (μ.restrict s)` and prove theorems like
`integrable_on_union : integrable_on f (s ∪ t) μ ↔ integrable_on f s μ ∧ integrable_on f t μ`.

Next we define a predicate `integrable_at_filter (f : α → E) (l : filter α) (μ : measure α)`
saying that `f` is integrable at some set `s ∈ l` and prove that a measurable function is integrable
at `l` with respect to `μ` provided that `f` is bounded above at `l ⊓ μ.ae` and `μ` is finite
at `l`.

-/

noncomputable theory
open set filter topological_space measure_theory function
open_locale classical topological_space interval big_operators filter ennreal measure_theory

variables {α β E F : Type*} [measurable_space α]

section

variables [topological_space β] {l l' : filter α} {f g : α → β} {μ ν : measure α}

/-- A function `f` is strongly measurable at a filter `l` w.r.t. a measure `μ` if it is
ae strongly measurable w.r.t. `μ.restrict s` for some `s ∈ l`. -/
def strongly_measurable_at_filter (f : α → β) (l : filter α) (μ : measure α . volume_tac) :=
∃ s ∈ l, ae_strongly_measurable f (μ.restrict s)

@[simp] lemma strongly_measurable_at_bot {f : α → β} : strongly_measurable_at_filter f ⊥ μ :=
⟨∅, mem_bot, by simp⟩

protected lemma strongly_measurable_at_filter.eventually (h : strongly_measurable_at_filter f l μ) :
  ∀ᶠ s in l.lift' powerset, ae_strongly_measurable f (μ.restrict s) :=
(eventually_lift'_powerset' $ λ s t, ae_strongly_measurable.mono_set).2 h

protected lemma strongly_measurable_at_filter.filter_mono
  (h : strongly_measurable_at_filter f l μ) (h' : l' ≤ l) :
  strongly_measurable_at_filter f l' μ :=
let ⟨s, hsl, hs⟩ := h in ⟨s, h' hsl, hs⟩

protected lemma measure_theory.ae_strongly_measurable.strongly_measurable_at_filter
  (h : ae_strongly_measurable f μ) :
  strongly_measurable_at_filter f l μ :=
⟨univ, univ_mem, by rwa measure.restrict_univ⟩

lemma ae_strongly_measurable.strongly_measurable_at_filter_of_mem
  {s} (h : ae_strongly_measurable f (μ.restrict s)) (hl : s ∈ l) :
  strongly_measurable_at_filter f l μ :=
⟨s, hl, h⟩

protected lemma measure_theory.strongly_measurable.strongly_measurable_at_filter
  (h : strongly_measurable f) :
  strongly_measurable_at_filter f l μ :=
h.ae_strongly_measurable.strongly_measurable_at_filter

end

namespace measure_theory

section normed_group

lemma has_finite_integral_restrict_of_bounded [normed_group E] {f : α → E} {s : set α}
  {μ : measure α} {C}  (hs : μ s < ∞) (hf : ∀ᵐ x ∂(μ.restrict s), ∥f x∥ ≤ C) :
  has_finite_integral f (μ.restrict s) :=
by haveI : is_finite_measure (μ.restrict s) := ⟨by rwa [measure.restrict_apply_univ]⟩;
  exact has_finite_integral_of_bounded hf

variables [normed_group E] {f g : α → E} {s t : set α} {μ ν : measure α}

/-- A function is `integrable_on` a set `s` if it is almost everywhere strongly measurable on `s`
and if the integral of its pointwise norm over `s` is less than infinity. -/
def integrable_on (f : α → E) (s : set α) (μ : measure α . volume_tac) : Prop :=
integrable f (μ.restrict s)

lemma integrable_on.integrable (h : integrable_on f s μ) :
  integrable f (μ.restrict s) := h

@[simp] lemma integrable_on_empty : integrable_on f ∅ μ :=
by simp [integrable_on, integrable_zero_measure]

@[simp] lemma integrable_on_univ : integrable_on f univ μ ↔ integrable f μ :=
by rw [integrable_on, measure.restrict_univ]

lemma integrable_on_zero : integrable_on (λ _, (0:E)) s μ := integrable_zero _ _ _

@[simp] lemma integrable_on_const {C : E} : integrable_on (λ _, C) s μ ↔ C = 0 ∨ μ s < ∞ :=
integrable_const_iff.trans $ by rw [measure.restrict_apply_univ]

lemma integrable_on.mono (h : integrable_on f t ν) (hs : s ⊆ t) (hμ : μ ≤ ν) :
  integrable_on f s μ :=
h.mono_measure $ measure.restrict_mono hs hμ

lemma integrable_on.mono_set (h : integrable_on f t μ) (hst : s ⊆ t) :
  integrable_on f s μ :=
h.mono hst le_rfl

lemma integrable_on.mono_measure (h : integrable_on f s ν) (hμ : μ ≤ ν) :
  integrable_on f s μ :=
h.mono (subset.refl _) hμ

lemma integrable_on.mono_set_ae (h : integrable_on f t μ) (hst : s ≤ᵐ[μ] t) :
  integrable_on f s μ :=
h.integrable.mono_measure $ measure.restrict_mono_ae hst

lemma integrable_on.congr_set_ae (h : integrable_on f t μ) (hst : s =ᵐ[μ] t) :
  integrable_on f s μ :=
h.mono_set_ae hst.le

lemma integrable_on.congr_fun' (h : integrable_on f s μ) (hst : f =ᵐ[μ.restrict s] g) :
  integrable_on g s μ :=
integrable.congr h hst

lemma integrable_on.congr_fun (h : integrable_on f s μ) (hst : eq_on f g s)
  (hs : measurable_set s) :
  integrable_on g s μ :=
h.congr_fun' ((ae_restrict_iff' hs).2 (eventually_of_forall hst))

lemma integrable.integrable_on (h : integrable f μ) : integrable_on f s μ :=
h.mono_measure $ measure.restrict_le_self

lemma integrable.integrable_on' (h : integrable f (μ.restrict s)) : integrable_on f s μ :=
h

lemma integrable_on.restrict (h : integrable_on f s μ) (hs : measurable_set s) :
  integrable_on f s (μ.restrict t) :=
by { rw [integrable_on, measure.restrict_restrict hs], exact h.mono_set (inter_subset_left _ _) }

lemma integrable_on.left_of_union (h : integrable_on f (s ∪ t) μ) : integrable_on f s μ :=
h.mono_set $ subset_union_left _ _

lemma integrable_on.right_of_union (h : integrable_on f (s ∪ t) μ) : integrable_on f t μ :=
h.mono_set $ subset_union_right _ _

lemma integrable_on.union (hs : integrable_on f s μ) (ht : integrable_on f t μ) :
  integrable_on f (s ∪ t) μ :=
(hs.add_measure ht).mono_measure $ measure.restrict_union_le _ _

@[simp] lemma integrable_on_union :
  integrable_on f (s ∪ t) μ ↔ integrable_on f s μ ∧ integrable_on f t μ :=
⟨λ h, ⟨h.left_of_union, h.right_of_union⟩, λ h, h.1.union h.2⟩

@[simp] lemma integrable_on_singleton_iff {x : α} [measurable_singleton_class α] :
  integrable_on f {x} μ ↔ f x = 0 ∨ μ {x} < ∞ :=
begin
  have : f =ᵐ[μ.restrict {x}] (λ y, f x),
  { filter_upwards [ae_restrict_mem (measurable_set_singleton x)] with _ ha,
    simp only [mem_singleton_iff.1 ha], },
  rw [integrable_on, integrable_congr this, integrable_const_iff],
  simp,
end

@[simp] lemma integrable_on_finite_Union {s : set β} (hs : finite s)
  {t : β → set α} : integrable_on f (⋃ i ∈ s, t i) μ ↔ ∀ i ∈ s, integrable_on f (t i) μ :=
begin
  apply hs.induction_on,
  { simp },
  { intros a s ha hs hf, simp [hf, or_imp_distrib, forall_and_distrib] }
end

@[simp] lemma integrable_on_finset_Union {s : finset β} {t : β → set α} :
  integrable_on f (⋃ i ∈ s, t i) μ ↔ ∀ i ∈ s, integrable_on f (t i) μ :=
integrable_on_finite_Union s.finite_to_set

@[simp] lemma integrable_on_fintype_Union [fintype β] {t : β → set α} :
  integrable_on f (⋃ i, t i) μ ↔ ∀ i, integrable_on f (t i) μ :=
by simpa using @integrable_on_finset_Union _ _ _ _ _ f μ finset.univ t

lemma integrable_on.add_measure (hμ : integrable_on f s μ) (hν : integrable_on f s ν) :
  integrable_on f s (μ + ν) :=
by { delta integrable_on, rw measure.restrict_add, exact hμ.integrable.add_measure hν }

@[simp] lemma integrable_on_add_measure :
  integrable_on f s (μ + ν) ↔ integrable_on f s μ ∧ integrable_on f s ν :=
⟨λ h, ⟨h.mono_measure (measure.le_add_right le_rfl),
  h.mono_measure (measure.le_add_left le_rfl)⟩,
  λ h, h.1.add_measure h.2⟩

lemma _root_.measurable_embedding.integrable_on_map_iff [measurable_space β] {e : α → β}
  (he : measurable_embedding e) {f : β → E} {μ : measure α} {s : set β} :
  integrable_on f s (measure.map e μ) ↔ integrable_on (f ∘ e) (e ⁻¹' s) μ :=
by simp only [integrable_on, he.restrict_map, he.integrable_map_iff]

lemma integrable_on_map_equiv [measurable_space β] (e : α ≃ᵐ β) {f : β → E} {μ : measure α}
  {s : set β} :
  integrable_on f s (measure.map e μ) ↔ integrable_on (f ∘ e) (e ⁻¹' s) μ :=
by simp only [integrable_on, e.restrict_map, integrable_map_equiv e]

lemma measure_preserving.integrable_on_comp_preimage [measurable_space β] {e : α → β} {ν}
  (h₁ : measure_preserving e μ ν) (h₂ : measurable_embedding e) {f : β → E} {s : set β} :
  integrable_on (f ∘ e) (e ⁻¹' s) μ ↔ integrable_on f s ν :=
(h₁.restrict_preimage_emb h₂ s).integrable_comp_emb h₂

lemma measure_preserving.integrable_on_image [measurable_space β] {e : α → β} {ν}
  (h₁ : measure_preserving e μ ν) (h₂ : measurable_embedding e) {f : β → E} {s : set α} :
  integrable_on f (e '' s) ν ↔  integrable_on (f ∘ e) s μ :=
((h₁.restrict_image_emb h₂ s).integrable_comp_emb h₂).symm

lemma integrable_indicator_iff (hs : measurable_set s) :
  integrable (indicator s f) μ ↔ integrable_on f s μ :=
by simp [integrable_on, integrable, has_finite_integral, nnnorm_indicator_eq_indicator_nnnorm,
  ennreal.coe_indicator, lintegral_indicator _ hs, ae_strongly_measurable_indicator_iff hs]

lemma integrable_on.indicator (h : integrable_on f s μ) (hs : measurable_set s) :
  integrable (indicator s f) μ :=
(integrable_indicator_iff hs).2 h

lemma integrable.indicator (h : integrable f μ) (hs : measurable_set s) :
  integrable (indicator s f) μ :=
h.integrable_on.indicator hs

lemma integrable_indicator_const_Lp {E} [normed_group E]
  {p : ℝ≥0∞} {s : set α} (hs : measurable_set s) (hμs : μ s ≠ ∞) (c : E) :
  integrable (indicator_const_Lp p hs hμs c) μ :=
begin
  rw [integrable_congr indicator_const_Lp_coe_fn, integrable_indicator_iff hs, integrable_on,
    integrable_const_iff, lt_top_iff_ne_top],
  right,
  simpa only [set.univ_inter, measurable_set.univ, measure.restrict_apply] using hμs,
end

lemma integrable_on_iff_integable_of_support_subset {f : α → E} {s : set α}
  (h1s : support f ⊆ s) (h2s : measurable_set s) :
  integrable_on f s μ ↔ integrable f μ :=
begin
  refine ⟨λ h, _, λ h, h.integrable_on⟩,
  rwa [← indicator_eq_self.2 h1s, integrable_indicator_iff h2s]
end

lemma integrable_on_Lp_of_measure_ne_top {E} [normed_group E]
  {p : ℝ≥0∞} {s : set α} (f : Lp E p μ) (hp : 1 ≤ p) (hμs : μ s ≠ ∞) :
  integrable_on f s μ :=
begin
  refine mem_ℒp_one_iff_integrable.mp _,
  have hμ_restrict_univ : (μ.restrict s) set.univ < ∞,
    by simpa only [set.univ_inter, measurable_set.univ, measure.restrict_apply, lt_top_iff_ne_top],
  haveI hμ_finite : is_finite_measure (μ.restrict s) := ⟨hμ_restrict_univ⟩,
  exact ((Lp.mem_ℒp _).restrict s).mem_ℒp_of_exponent_le hp,
end

/-- We say that a function `f` is *integrable at filter* `l` if it is integrable on some
set `s ∈ l`. Equivalently, it is eventually integrable on `s` in `l.lift' powerset`. -/
def integrable_at_filter (f : α → E) (l : filter α) (μ : measure α . volume_tac) :=
∃ s ∈ l, integrable_on f s μ

variables {l l' : filter α}

protected lemma integrable_at_filter.eventually (h : integrable_at_filter f l μ) :
  ∀ᶠ s in l.lift' powerset, integrable_on f s μ :=
by { refine (eventually_lift'_powerset' $ λ s t hst ht, _).2 h, exact ht.mono_set hst }

lemma integrable_at_filter.filter_mono (hl : l ≤ l') (hl' : integrable_at_filter f l' μ) :
  integrable_at_filter f l μ :=
let ⟨s, hs, hsf⟩ := hl' in ⟨s, hl hs, hsf⟩

lemma integrable_at_filter.inf_of_left (hl : integrable_at_filter f l μ) :
  integrable_at_filter f (l ⊓ l') μ :=
hl.filter_mono inf_le_left

lemma integrable_at_filter.inf_of_right (hl : integrable_at_filter f l μ) :
  integrable_at_filter f (l' ⊓ l) μ :=
hl.filter_mono inf_le_right

@[simp] lemma integrable_at_filter.inf_ae_iff {l : filter α} :
  integrable_at_filter f (l ⊓ μ.ae) μ ↔ integrable_at_filter f l μ :=
begin
  refine ⟨_, λ h, h.filter_mono inf_le_left⟩,
  rintros ⟨s, ⟨t, ht, u, hu, rfl⟩, hf⟩,
  refine ⟨t, ht, _⟩,
  refine hf.integrable.mono_measure (λ v hv, _),
  simp only [measure.restrict_apply hv],
  refine measure_mono_ae (mem_of_superset hu $ λ x hx, _),
  exact λ ⟨hv, ht⟩, ⟨hv, ⟨ht, hx⟩⟩
end

alias integrable_at_filter.inf_ae_iff ↔ measure_theory.integrable_at_filter.of_inf_ae _

/-- If `μ` is a measure finite at filter `l` and `f` is a function such that its norm is bounded
above at `l`, then `f` is integrable at `l`. -/
lemma measure.finite_at_filter.integrable_at_filter {l : filter α} [is_measurably_generated l]
  (hfm : strongly_measurable_at_filter f l μ) (hμ : μ.finite_at_filter l)
  (hf : l.is_bounded_under (≤) (norm ∘ f)) :
  integrable_at_filter f l μ :=
begin
  obtain ⟨C, hC⟩ : ∃ C, ∀ᶠ s in (l.lift' powerset), ∀ x ∈ s, ∥f x∥ ≤ C,
    from hf.imp (λ C hC, eventually_lift'_powerset.2 ⟨_, hC, λ t, id⟩),
  rcases (hfm.eventually.and (hμ.eventually.and hC)).exists_measurable_mem_of_lift'
    with ⟨s, hsl, hsm, hfm, hμ, hC⟩,
  refine ⟨s, hsl, ⟨hfm, has_finite_integral_restrict_of_bounded hμ _⟩⟩,
  exact C,
  rw [ae_restrict_eq hsm, eventually_inf_principal],
  exact eventually_of_forall hC
end

lemma measure.finite_at_filter.integrable_at_filter_of_tendsto_ae
  {l : filter α} [is_measurably_generated l] (hfm : strongly_measurable_at_filter f l μ)
  (hμ : μ.finite_at_filter l) {b} (hf : tendsto f (l ⊓ μ.ae) (𝓝 b)) :
  integrable_at_filter f l μ :=
(hμ.inf_of_left.integrable_at_filter (hfm.filter_mono inf_le_left)
  hf.norm.is_bounded_under_le).of_inf_ae

alias measure.finite_at_filter.integrable_at_filter_of_tendsto_ae ←
  filter.tendsto.integrable_at_filter_ae

lemma measure.finite_at_filter.integrable_at_filter_of_tendsto {l : filter α}
  [is_measurably_generated l] (hfm : strongly_measurable_at_filter f l μ)
  (hμ : μ.finite_at_filter l) {b} (hf : tendsto f l (𝓝 b)) :
  integrable_at_filter f l μ :=
hμ.integrable_at_filter hfm hf.norm.is_bounded_under_le

alias measure.finite_at_filter.integrable_at_filter_of_tendsto ← filter.tendsto.integrable_at_filter

lemma integrable_add_of_disjoint {f g : α → E}
  (h : disjoint (support f) (support g)) (hf : strongly_measurable f) (hg : strongly_measurable g) :
  integrable (f + g) μ ↔ integrable f μ ∧ integrable g μ :=
begin
  refine ⟨λ hfg, ⟨_, _⟩, λ h, h.1.add h.2⟩,
  { rw ← indicator_add_eq_left h, exact hfg.indicator hf.measurable_set_support },
  { rw ← indicator_add_eq_right h, exact hfg.indicator hg.measurable_set_support }
end

end normed_group

end measure_theory

open measure_theory

variables [normed_group E]

/-- A function which is continuous on a set `s` is almost everywhere measurable with respect to
`μ.restrict s`. -/
lemma continuous_on.ae_measurable [topological_space α] [opens_measurable_space α]
  [measurable_space β] [topological_space β] [borel_space β]
  {f : α → β} {s : set α} {μ : measure α} (hf : continuous_on f s) (hs : measurable_set s) :
  ae_measurable f (μ.restrict s) :=
begin
  nontriviality α, inhabit α,
  have : piecewise s f (λ _, f default) =ᵐ[μ.restrict s] f := piecewise_ae_eq_restrict hs,
  refine ⟨piecewise s f (λ _, f default), _, this.symm⟩,
  apply measurable_of_is_open,
  assume t ht,
  obtain ⟨u, u_open, hu⟩ : ∃ (u : set α), is_open u ∧ f ⁻¹' t ∩ s = u ∩ s :=
    _root_.continuous_on_iff'.1 hf t ht,
  rw [piecewise_preimage, set.ite, hu],
  exact (u_open.measurable_set.inter hs).union ((measurable_const ht.measurable_set).diff hs)
end

/-- A function which is continuous on a separable set `s` is almost everywhere strongly measurable
with respect to `μ.restrict s`. -/
lemma continuous_on.ae_strongly_measurable_of_is_separable
  [topological_space α] [metrizable_space α] [opens_measurable_space α]
  [topological_space β] [metrizable_space β]
  {f : α → β} {s : set α} {μ : measure α} (hf : continuous_on f s) (hs : measurable_set s)
  (h's : topological_space.is_separable s) :
  ae_strongly_measurable f (μ.restrict s) :=
begin
  letI := metrizable_space_metric α,
  borelize β,
  rw ae_strongly_measurable_iff_ae_measurable_separable,
  refine ⟨hf.ae_measurable hs, f '' s, hf.is_separable_image h's, _⟩,
  exact mem_of_superset (self_mem_ae_restrict hs) (subset_preimage_image _ _),
end

/-- A function which is continuous on a set `s` is almost everywhere strongly measurable with
respect to `μ.restrict s` when either the source space or the target space is second-countable. -/
lemma continuous_on.ae_strongly_measurable
  [topological_space α] [topological_space β] [h : second_countable_topology_either α β]
  [opens_measurable_space α] [metrizable_space β]
  {f : α → β} {s : set α} {μ : measure α} (hf : continuous_on f s) (hs : measurable_set s) :
  ae_strongly_measurable f (μ.restrict s) :=
begin
  borelize β,
  refine ae_strongly_measurable_iff_ae_measurable_separable.2 ⟨hf.ae_measurable hs, f '' s, _,
    mem_of_superset (self_mem_ae_restrict hs) (subset_preimage_image _ _)⟩,
  casesI h.out,
  { let f' : s → β := s.restrict f,
    have A : continuous f' := continuous_on_iff_continuous_restrict.1 hf,
    have B : is_separable (univ : set s) := is_separable_of_separable_space _,
    convert is_separable.image B A using 1,
    ext x,
    simp },
  { exact is_separable_of_separable_space _ }
end

lemma continuous_on.integrable_at_nhds_within_of_is_separable
  [topological_space α] [metrizable_space α]
  [opens_measurable_space α] {μ : measure α} [is_locally_finite_measure μ]
  {a : α} {t : set α} {f : α → E} (hft : continuous_on f t) (ht : measurable_set t)
  (h't : topological_space.is_separable t) (ha : a ∈ t) :
  integrable_at_filter f (𝓝[t] a) μ :=
begin
  haveI : (𝓝[t] a).is_measurably_generated := ht.nhds_within_is_measurably_generated _,
  exact (hft a ha).integrable_at_filter ⟨_, self_mem_nhds_within,
    hft.ae_strongly_measurable_of_is_separable ht h't⟩ (μ.finite_at_nhds_within _ _),
end

lemma continuous_on.integrable_at_nhds_within
  [topological_space α] [second_countable_topology_either α E]
  [opens_measurable_space α] {μ : measure α} [is_locally_finite_measure μ]
  {a : α} {t : set α} {f : α → E} (hft : continuous_on f t) (ht : measurable_set t) (ha : a ∈ t) :
  integrable_at_filter f (𝓝[t] a) μ :=
begin
  haveI : (𝓝[t] a).is_measurably_generated := ht.nhds_within_is_measurably_generated _,
  exact (hft a ha).integrable_at_filter ⟨_, self_mem_nhds_within, hft.ae_strongly_measurable ht⟩
    (μ.finite_at_nhds_within _ _),
end

/-- If a function is continuous on an open set `s`, then it is strongly measurable at the filter
`𝓝 x` for all `x ∈ s` if either the source space or the target space is second-countable. -/
lemma continuous_on.strongly_measurable_at_filter [topological_space α]
  [opens_measurable_space α] [topological_space β] [metrizable_space β]
  [second_countable_topology_either α β] {f : α → β} {s : set α} {μ : measure α}
  (hs : is_open s) (hf : continuous_on f s) :
  ∀ x ∈ s, strongly_measurable_at_filter f (𝓝 x) μ :=
λ x hx, ⟨s, is_open.mem_nhds hs hx, hf.ae_strongly_measurable hs.measurable_set⟩

lemma continuous_at.strongly_measurable_at_filter
  [topological_space α] [opens_measurable_space α] [second_countable_topology_either α E]
  {f : α → E} {s : set α} {μ : measure α} (hs : is_open s) (hf : ∀ x ∈ s, continuous_at f x) :
  ∀ x ∈ s, strongly_measurable_at_filter f (𝓝 x) μ :=
continuous_on.strongly_measurable_at_filter hs $ continuous_at.continuous_on hf

lemma continuous.strongly_measurable_at_filter [topological_space α] [opens_measurable_space α]
  [topological_space β] [metrizable_space β] [second_countable_topology_either α β]
  {f : α → β} (hf : continuous f) (μ : measure α) (l : filter α) :
  strongly_measurable_at_filter f l μ :=
hf.strongly_measurable.strongly_measurable_at_filter

/-- If a function is continuous on a measurable set `s`, then it is measurable at the filter
  `𝓝[s] x` for all `x`. -/
lemma continuous_on.strongly_measurable_at_filter_nhds_within {α β : Type*} [measurable_space α]
  [topological_space α] [opens_measurable_space α] [topological_space β] [metrizable_space β]
  [second_countable_topology_either α β] {f : α → β} {s : set α} {μ : measure α}
  (hf : continuous_on f s) (hs : measurable_set s) (x : α) :
  strongly_measurable_at_filter f (𝓝[s] x) μ :=
⟨s, self_mem_nhds_within, hf.ae_strongly_measurable hs⟩