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

! This file was ported from Lean 3 source module measure_theory.tactic
! leanprover-community/mathlib commit d003c55042c3cd08aefd1ae9a42ef89441cdaaf3
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.MeasureTheory.Measure.MeasureSpaceDef
import Mathbin.Tactic.AutoCases
import Mathbin.Tactic.Tidy
import Mathbin.Tactic.WithLocalReducibility

/-!
# Tactics for measure theory

Currently we have one domain-specific tactic for measure theory: `measurability`.

This tactic is to a large extent a copy of the `continuity` tactic by Reid Barton.
-/

/-!
### `measurability` tactic

Automatically solve goals of the form `measurable f`, `ae_measurable f μ` and `measurable_set s`.

Mark lemmas with `@[measurability]` to add them to the set of lemmas
used by `measurability`. Note: `to_additive` doesn't know yet how to
copy the attribute to the additive version.
-/

/-- User attribute used to mark tactics used by `measurability`. -/
@[user_attribute]
unsafe def measurability : user_attribute
    where
  Name := `measurability
  descr := "lemmas usable to prove (ae)-measurability"
#align measurability measurability

/- Mark some measurability lemmas already defined in `measure_theory.measurable_space_def` and
`measure_theory.measure_space_def` -/
attribute [measurability]
  measurable_id measurable_id' aeMeasurableId aeMeasurableId' measurable_const aeMeasurableConst AeMeasurable.measurable_mk MeasurableSet.empty MeasurableSet.univ MeasurableSet.compl Subsingleton.measurableSet MeasurableSet.unionᵢ MeasurableSet.interᵢ MeasurableSet.union MeasurableSet.inter MeasurableSet.diff MeasurableSet.symmDiff MeasurableSet.ite MeasurableSet.cond MeasurableSet.disjointed MeasurableSet.const MeasurableSet.insert measurableSet_eq Finset.measurableSet MeasurableSpace.measurableSet_top

namespace Tactic

/- ./././Mathport/Syntax/Translate/Expr.lean:330:4: warning: unsupported (TODO): `[tacs] -/
/-- Tactic to apply `measurable.comp` when appropriate.

Applying `measurable.comp` is not always a good idea, so we have some
extra logic here to try to avoid bad cases.

* If the function we're trying to prove measurable is actually
  constant, and that constant is a function application `f z`, then
  measurable.comp would produce new goals `measurable f`, `measurable
  (λ _, z)`, which is silly. We avoid this by failing if we could
  apply `measurable_const`.

* measurable.comp will always succeed on `measurable (λ x, f x)` and
  produce new goals `measurable (λ x, x)`, `measurable f`. We detect
  this by failing if a new goal can be closed by applying
  measurable_id.
-/
unsafe def apply_measurable.comp : tactic Unit :=
  sorry
#align tactic.apply_measurable.comp tactic.apply_measurable.comp

/- ./././Mathport/Syntax/Translate/Expr.lean:330:4: warning: unsupported (TODO): `[tacs] -/
/-- Tactic to apply `measurable.comp_ae_measurable` when appropriate.

Applying `measurable.comp_ae_measurable` is not always a good idea, so we have some
extra logic here to try to avoid bad cases.

* If the function we're trying to prove measurable is actually
  constant, and that constant is a function application `f z`, then
  `measurable.comp_ae_measurable` would produce new goals `measurable f`, `ae_measurable
  (λ _, z) μ`, which is silly. We avoid this by failing if we could
  apply `ae_measurable_const`.

* `measurable.comp_ae_measurable` will always succeed on `ae_measurable (λ x, f x) μ` and
  can produce new goals (`measurable (λ x, x)`, `ae_measurable f μ`) or
  (`measurable f`, `ae_measurable (λ x, x) μ`). We detect those by failing if a new goal can be
  closed by applying `measurable_id` or `ae_measurable_id`.
-/
unsafe def apply_measurable.comp_ae_measurable : tactic Unit :=
  sorry
#align tactic.apply_measurable.comp_ae_measurable tactic.apply_measurable.comp_ae_measurable

/--
We don't want the intro1 tactic to apply to a goal of the form `measurable f`, `ae_measurable f μ`
or `measurable_set s`. This tactic tests the target to see if it matches that form.
 -/
unsafe def goal_is_not_measurable : tactic Unit := do
  let t ← tactic.target
  match t with
    | q(Measurable $(l)) => failed
    | q(AeMeasurable $(l) $(r)) => failed
    | q(MeasurableSet $(l)) => failed
    | _ => skip
#align tactic.goal_is_not_measurable tactic.goal_is_not_measurable

/- ./././Mathport/Syntax/Translate/Expr.lean:330:4: warning: unsupported (TODO): `[tacs] -/
/- ./././Mathport/Syntax/Translate/Expr.lean:330:4: warning: unsupported (TODO): `[tacs] -/
/-- List of tactics used by `measurability` internally. The option `use_exfalso := ff` is passed to
the tactic `apply_assumption` in order to avoid loops in the presence of negated hypotheses in
the context. -/
unsafe def measurability_tactics (md : Transparency := semireducible) : List (tactic String) :=
  [(propositional_goal >> tactic.interactive.apply_assumption none { use_exfalso := false }) >>
      pure "apply_assumption {use_exfalso := ff}",
    goal_is_not_measurable >> intro1 >>= fun ns => pure ("intro " ++ ns.toString),
    apply_rules [] [`` measurability] 50 { md } >> pure "apply_rules with measurability",
    apply_measurable.comp >> pure "refine measurable.comp _ _",
    apply_measurable.comp_ae_measurable >> pure "refine measurable.comp_ae_measurable _ _",
    sorry >> pure "refine measurable.ae_measurable _",
    sorry >> pure "refine measurable.ae_strongly_measurable _"]
#align tactic.measurability_tactics tactic.measurability_tactics

namespace Interactive

/- ./././Mathport/Syntax/Translate/Tactic/Mathlib/Core.lean:38:34: unsupported: setup_tactic_parser -/
/-- Solve goals of the form `measurable f`, `ae_measurable f μ`, `ae_strongly_measurable f μ` or
`measurable_set s`. `measurability?` reports back the proof term it found.
-/
unsafe def measurability (bang : parse <| optional (tk "!")) (trace : parse <| optional (tk "?"))
    (cfg : tidy.cfg := { }) : tactic Unit :=
  let md := if bang.isSome then semireducible else reducible
  let measurability_core := tactic.tidy { cfg with tactics := measurability_tactics md }
  let trace_fn := if trace.isSome then show_term else id
  trace_fn measurability_core
#align tactic.interactive.measurability tactic.interactive.measurability

/-- Version of `measurability` for use with auto_param. -/
unsafe def measurability' : tactic Unit :=
  measurability none none { }
#align tactic.interactive.measurability' tactic.interactive.measurability'

/-- `measurability` solves goals of the form `measurable f`, `ae_measurable f μ`,
`ae_strongly_measurable f μ` or `measurable_set s` by applying lemmas tagged with the
`measurability` user attribute.

You can also use `measurability!`, which applies lemmas with `{ md := semireducible }`.
The default behaviour is more conservative, and only unfolds `reducible` definitions
when attempting to match lemmas with the goal.

`measurability?` reports back the proof term it found.
-/
add_tactic_doc
  { Name := "measurability / measurability'"
    category := DocCategory.tactic
    declNames := [`tactic.interactive.measurability, `tactic.interactive.measurability']
    tags := ["lemma application"] }

end Interactive

end Tactic


import tactic.split_ifs

example (p : Prop) [decidable p] (h : (if p then 1 else 2) > 3) : false :=
by split_ifs at h; repeat {cases h with h h}

example (p : Prop) [decidable p] (x : ℕ) (h : (if p then 1 else 2) > x) :
    x < (if ¬p then 1 else 0) + 1 :=
by split_ifs at *; assumption

example (p : Prop) [decidable p] : if if ¬p then p else true then p else ¬p :=
by split_ifs; assumption

example (p q : Prop) [decidable p] [decidable q] :
    if if if p then ¬p else q then p else q then q else ¬p ∨ ¬q :=
by split_ifs; simp *

example : true :=
by success_if_fail { split_ifs }; trivial


-- Copyright (c) 2017 Scott Morrison. All rights reserved.
-- Released under Apache 2.0 license as described in the file LICENSE.
-- Authors: Tim Baumann, Stephen Morgan, Scott Morrison

import category_theory.fully_faithful
import category_theory.functor_category
import category_theory.natural_isomorphism
import tactic.slice
import tactic.converter.interactive

namespace category_theory

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

structure equivalence (C : Type u₁) [category.{v₁} C] (D : Type u₂) [category.{v₂} D] :=
(functor : C ⥤ D)
(inverse : D ⥤ C)
(fun_inv_id' : (functor ⋙ inverse) ≅ (category_theory.functor.id C) . obviously)
(inv_fun_id' : (inverse ⋙ functor) ≅ (category_theory.functor.id D) . obviously)

restate_axiom equivalence.fun_inv_id'
restate_axiom equivalence.inv_fun_id'

infixr ` ≌ `:10  := equivalence

namespace equivalence

variables {C : Type u₁} [𝒞 : category.{v₁} C]
include 𝒞

@[refl] def refl : C ≌ C :=
{ functor := functor.id C,
  inverse := functor.id C }

variables {D : Type u₂} [𝒟 : category.{v₂} D]
include 𝒟

@[symm] def symm (e : C ≌ D) : D ≌ C :=
{ functor := e.inverse,
  inverse := e.functor,
  fun_inv_id' := e.inv_fun_id,
  inv_fun_id' := e.fun_inv_id }

@[simp] lemma fun_inv_map (e : C ≌ D) (X Y : D) (f : X ⟶ Y) :
e.functor.map (e.inverse.map f) = (e.inv_fun_id.hom.app X) ≫ f ≫ (e.inv_fun_id.inv.app Y) :=
begin
  erw [nat_iso.naturality_2],
  refl
end
@[simp] lemma inv_fun_map (e : C ≌ D) (X Y : C) (f : X ⟶ Y) :
e.inverse.map (e.functor.map f) = (e.fun_inv_id.hom.app X) ≫ f ≫ (e.fun_inv_id.inv.app Y) :=
begin
  erw [nat_iso.naturality_2],
  refl
end

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

@[simp] private def effe_iso_id (e : C ≌ D) (f : D ≌ E) (X : C) :
  (e.inverse).obj ((f.inverse).obj ((f.functor).obj ((e.functor).obj X))) ≅ X :=
calc
  (e.inverse).obj ((f.inverse).obj ((f.functor).obj ((e.functor).obj X)))
    ≅ (e.inverse).obj ((e.functor).obj X) : e.inverse.on_iso (nat_iso.app f.fun_inv_id _)
... ≅ X                                   : nat_iso.app e.fun_inv_id _

@[simp] private def feef_iso_id (e : C ≌ D) (f : D ≌ E) (X : E) :
  (f.functor).obj ((e.functor).obj ((e.inverse).obj ((f.inverse).obj X))) ≅ X :=
calc
  (f.functor).obj ((e.functor).obj ((e.inverse).obj ((f.inverse).obj X)))
    ≅ (f.functor).obj ((f.inverse).obj X) : f.functor.on_iso (nat_iso.app e.inv_fun_id _)
... ≅ X                                   : nat_iso.app f.inv_fun_id _

@[trans] def trans (e : C ≌ D) (f : D ≌ E) : C ≌ E :=
{ functor := e.functor ⋙ f.functor,
  inverse := f.inverse ⋙ e.inverse,
  fun_inv_id' := nat_iso.of_components (effe_iso_id e f)
  begin
    /- `tidy` says -/
    intros X Y f_1, dsimp at *, simp at *, dsimp at *,
    /- `rewrite_search` says -/
    slice_lhs 3 4 { erw [is_iso.hom_inv_id] },
    erw [category.id_comp, is_iso.hom_inv_id, category.comp_id],
  end,
  inv_fun_id' := nat_iso.of_components (feef_iso_id e f)
  begin
    /- `tidy` says -/
    intros X Y f_1, dsimp at *, simp at *, dsimp at *,
    /- `rewrite_search` says -/
    slice_lhs 3 4 { erw [is_iso.hom_inv_id] },
    erw [category.id_comp, is_iso.hom_inv_id, category.comp_id]
  end
}

end equivalence

variables {C : Type u₁} [𝒞 : category.{v₁} C]
include 𝒞

section
variables {D : Type u₂} [𝒟 : category.{v₂} D]
include 𝒟

class is_equivalence (F : C ⥤ D) :=
(inverse        : D ⥤ C)
(fun_inv_id' : (F ⋙ inverse) ≅ (functor.id C) . obviously)
(inv_fun_id' : (inverse ⋙ F) ≅ (functor.id D) . obviously)

restate_axiom is_equivalence.fun_inv_id'
restate_axiom is_equivalence.inv_fun_id'
end

namespace is_equivalence
variables {D : Type u₂} [𝒟 : category.{v₂} D]
include 𝒟

instance of_equivalence (F : C ≌ D) : is_equivalence (F.functor) :=
{ inverse := F.inverse,
  fun_inv_id' := F.fun_inv_id,
  inv_fun_id' := F.inv_fun_id }
instance of_equivalence_inverse (F : C ≌ D) : is_equivalence (F.inverse) :=
{ inverse := F.functor,
  fun_inv_id' := F.inv_fun_id,
  inv_fun_id' := F.fun_inv_id }
end is_equivalence

namespace functor
instance is_equivalence_refl : is_equivalence (functor.id C) :=
{ inverse := functor.id C }
end functor

variables {D : Type u₂} [𝒟 : category.{v₂} D]
include 𝒟

namespace functor
def inv (F : C ⥤ D) [is_equivalence F] : D ⥤ C :=
is_equivalence.inverse F

instance is_equivalence_symm (F : C ⥤ D) [is_equivalence F] : is_equivalence (F.inv) :=
{ inverse := F,
  fun_inv_id' := is_equivalence.inv_fun_id F,
  inv_fun_id' := is_equivalence.fun_inv_id F }

def fun_inv_id (F : C ⥤ D) [is_equivalence F] : (F ⋙ F.inv) ≅ functor.id C :=
is_equivalence.fun_inv_id F

def inv_fun_id (F : C ⥤ D) [is_equivalence F] : (F.inv ⋙ F) ≅ functor.id D :=
is_equivalence.inv_fun_id F

def as_equivalence (F : C ⥤ D) [is_equivalence F] : C ≌ D :=
{ functor := F,
  inverse := is_equivalence.inverse F,
  fun_inv_id' := is_equivalence.fun_inv_id F,
  inv_fun_id' := is_equivalence.inv_fun_id F }

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

instance is_equivalence_trans (F : C ⥤ D) (G : D ⥤ E) [is_equivalence F] [is_equivalence G] :
  is_equivalence (F ⋙ G) :=
is_equivalence.of_equivalence (equivalence.trans (as_equivalence F) (as_equivalence G))

end functor

namespace is_equivalence
instance is_equivalence_functor (e : C ≌ D) : is_equivalence e.functor :=
{ inverse := e.inverse,
  fun_inv_id' := e.fun_inv_id,
  inv_fun_id' := e.inv_fun_id }
instance is_equivalence_inverse (e : C ≌ D) : is_equivalence e.inverse :=
{ inverse := e.functor,
  fun_inv_id' := e.inv_fun_id,
  inv_fun_id' := e.fun_inv_id }

@[simp] lemma fun_inv_map (F : C ⥤ D) [is_equivalence F] (X Y : D) (f : X ⟶ Y) :
  F.map (F.inv.map f) = (F.inv_fun_id.hom.app X) ≫ f ≫ (F.inv_fun_id.inv.app Y) :=
begin
  erw [nat_iso.naturality_2],
  refl
end
@[simp] lemma inv_fun_map (F : C ⥤ D) [is_equivalence F] (X Y : C) (f : X ⟶ Y) :
  F.inv.map (F.map f) = (F.fun_inv_id.hom.app X) ≫ f ≫ (F.fun_inv_id.inv.app Y) :=
begin
  erw [nat_iso.naturality_2],
  refl
end

end is_equivalence

class ess_surj (F : C ⥤ D) :=
(obj_preimage (d : D) : C)
(iso' (d : D) : F.obj (obj_preimage d) ≅ d . obviously)

restate_axiom ess_surj.iso'

namespace functor
def obj_preimage (F : C ⥤ D) [ess_surj F] (d : D) : C := ess_surj.obj_preimage.{v₁ v₂} F d
def fun_obj_preimage_iso (F : C ⥤ D) [ess_surj F] (d : D) : F.obj (F.obj_preimage d) ≅ d :=
ess_surj.iso F d
end functor

namespace equivalence

def ess_surj_of_equivalence (F : C ⥤ D) [is_equivalence F] : ess_surj F :=
⟨ λ Y : D, F.inv.obj Y, λ Y : D, (nat_iso.app F.inv_fun_id Y) ⟩

instance faithful_of_equivalence (F : C ⥤ D) [is_equivalence F] : faithful F :=
{ injectivity' := λ X Y f g w,
  begin
    have p := congr_arg (@category_theory.functor.map _ _ _ _ F.inv _ _) w,
    simp at *,
    assumption
  end }.

instance full_of_equivalence (F : C ⥤ D) [is_equivalence F] : full F :=
{ preimage := λ X Y f, (nat_iso.app F.fun_inv_id X).inv ≫ (F.inv.map f) ≫ (nat_iso.app F.fun_inv_id Y).hom,
  witness' := λ X Y f,
  begin
    apply F.inv.injectivity,
    /- obviously can finish from here... -/
    dsimp, simp, dsimp,
    slice_lhs 4 6 {
      rw [←functor.map_comp, ←functor.map_comp],
      rw [←is_equivalence.fun_inv_map],
    },
    slice_lhs 1 2 { simp },
    dsimp, simp,
    slice_lhs 2 4 {
      rw [←functor.map_comp, ←functor.map_comp],
      erw [nat_iso.naturality_2],
    },
    erw [nat_iso.naturality_1],
    refl,
  end }.

section

@[simp] private def equivalence_inverse (F : C ⥤ D) [full F] [faithful F] [ess_surj F] : D ⥤ C :=
{ obj  := λ X, F.obj_preimage X,
  map := λ X Y f, F.preimage ((F.fun_obj_preimage_iso X).hom ≫ f ≫ (F.fun_obj_preimage_iso Y).inv),
  map_id' := λ X, begin apply F.injectivity, tidy, end,
  map_comp' := λ X Y Z f g, by apply F.injectivity; simp }.

def equivalence_of_fully_faithfully_ess_surj
  (F : C ⥤ D) [full F] [faithful : faithful F] [ess_surj F] : is_equivalence F :=
{ inverse := equivalence_inverse F,
  fun_inv_id' := nat_iso.of_components
    (λ X, preimage_iso (F.fun_obj_preimage_iso (F.obj X)))
    (λ X Y f, begin apply F.injectivity, obviously, end),
  inv_fun_id' := nat_iso.of_components
    (λ Y, (F.fun_obj_preimage_iso Y))
    (by obviously) }
end

end equivalence

end category_theory


import tactic

universes u v

namespace monad

@[simp]
lemma bind_pure_star {m} [monad m] [is_lawful_monad m] (x : m punit) :
  x >>= (λ (_x : punit), pure punit.star : punit → m punit) = x :=
by { transitivity,
     { apply congr_arg, ext z, cases z, refl },
     { simp } }

variables {α β γ : Type u}
variables {m : Type u → Type v} [monad m]

@[reducible]
def pipe (a : α → m β) (b : β → m γ) : α → m γ :=
λ x, a x >>= b

infixr ` >=> `:55 := pipe

@[functor_norm]
lemma map_bind_eq_bind_comp {α β γ} {m} [monad m] [is_lawful_monad m]
  (f : α → β) (cmd : m α) (g : β → m γ) :
  (f <$> cmd) >>= g = cmd >>= g ∘ f :=
by rw [← bind_pure_comp_eq_map,bind_assoc,(∘)]; simp

@[functor_norm]
lemma bind_map {α β γ} {m} [monad m] [is_lawful_monad m]
  (f : α → γ → β) (cmd : m α) (g : α → m γ) :
  cmd >>= (λ x, f x <$> g x) = do { x ← cmd, y ← g x, pure $ f x y }  :=
by congr; ext; rw [← bind_pure (g x),map_bind]; simp

@[functor_norm]
lemma bind_seq {α β γ : Type u} {m} [monad m] [is_lawful_monad m]
  (f : α → m (γ → β)) (cmd : m α) (g : α → m γ) :
  cmd >>= (λ x, f x <*> g x) = do { x ← cmd, h ← f x, y ← g x, pure $ h y }  :=
by congr; ext; simp [seq_eq_bind_map] with functor_norm

end monad

attribute [functor_norm] bind_assoc has_bind.and_then map_bind


import .nnf .predicates

variables {α β : Type}

def lift_nnf_qe (β) [Hα : atom_type α β] (qe : fm α → fm α) : fm α → fm α
| (p ∧' q) := and_o (lift_nnf_qe p) (lift_nnf_qe q)
| (p ∨' q) := or_o  (lift_nnf_qe p) (lift_nnf_qe q)
| (¬' p) := not_o (lift_nnf_qe p)
| (∃' p) := qe (@nnf α β Hα (lift_nnf_qe p))
| p := p

lemma and_o_prsv_qfree (p q : fm α) :
  qfree p → qfree q → qfree (and_o p q) :=
λ Hp Hq,
  begin
    cases p; cases q;
    {trivial <|> apply Hp <|> apply Hq <|> {apply (and.intro Hp Hq)}}
  end

lemma or_o_prsv_qfree (p q : fm α) :
  qfree p → qfree q → qfree (or_o p q) :=
λ Hp Hq,
  begin
    cases p; cases q;
    {trivial <|> apply Hp <|> apply Hq <|> {apply (and.intro Hp Hq)}}
  end

lemma not_o_prsv_qfree (p : fm α) (H : qfree p) : qfree (not_o p) :=
begin cases p; {trivial <|> apply H} end

lemma lnq_qfree [Hα : atom_type α β] (qe : fm α → fm α)
(H : ∀ (f : fm α), nqfree f → qfree (qe f)) :
  ∀ (f : fm α), qfree (@lift_nnf_qe α β Hα qe f) :=
λ f, fm.rec_on f trivial trivial
  (λ a, trivial)
  (λ f1 f2 H1 H2, and_o_prsv_qfree _ _ H1 H2)
  (λ f1 f2 H1 H2, or_o_prsv_qfree _ _ H1 H2)
  (λ f1 H1, not_o_prsv_qfree _ H1)
  (λ f1 H1, begin apply H, apply nnf_nqfree, apply H1 end)

open tactic

lemma lnq_prsv_gen
  [Hα : atom_type α β] (qe : fm α → fm α)
  (hqe : qfree_res_of_nqfree_arg qe)
  (r : fm α → Prop)
  (hdc : down_closed r)
  (hqc : preserves qe r)
  (hnc : preserves (nnf β) r)
  (hlc : ∀ f, preserves f r → preserves (lift_nnf_qe β f) r)
  (hi : ∀ (p : fm α), nqfree p → r p → ∀ (xs : list β), I (qe p) xs ↔ ∃ x, I p (x::xs)) :
  ∀ (p : fm α), r p → ∀ (xs : list β), I (lift_nnf_qe β qe p) xs ↔ I p xs
| ⊤' _ bs := iff.refl _
| ⊥' _ bs := iff.refl _
| (A' a) _ bs := iff.refl _
| (p ∧' q) hr xs :=
  begin
    unfold lift_nnf_qe, rewrite exp_I_and,
    rewrite exp_I_and_o,
    repeat {rewrite lnq_prsv_gen},
    apply hdc _ _ (down.andr _ _) hr,
    apply hdc _ _ (down.andl _ _) hr
  end
| (p ∨' q) hr xs :=
  begin
    unfold lift_nnf_qe, rewrite exp_I_or,
    rewrite exp_I_or_o, repeat {rewrite lnq_prsv_gen},
    apply hdc _ _ (down.orr _ _) hr,
    apply hdc _ _ (down.orl _ _) hr
  end
| (¬' p) hr xs :=
  begin
    unfold lift_nnf_qe, rewrite exp_I_not,
    rewrite exp_I_not_o, repeat {rewrite lnq_prsv_gen},
    apply hdc _ _ (down.not _) hr
  end
| (∃' p) hr xs :=
  begin
    unfold lift_nnf_qe, rewrite exp_I_ex,
    rewrite hi, apply ex_iff_ex, intro b,
    rewrite nnf_prsv, apply lnq_prsv_gen,
    apply hdc _ _ (down.ex _) hr,
    apply lnq_qfree, apply hqe,
    apply nnf_nqfree, apply lnq_qfree,
    apply hqe, apply hnc, apply hlc, apply hqc,
    apply hdc _ _ (down.ex _) hr
  end

lemma lnq_prsv [Hα : atom_type α β] (qe : fm α → fm α)
  (hqe : qfree_res_of_nqfree_arg qe)
  (hi : ∀ (p : fm α), nqfree p → ∀ (xs : list β), I (qe p) xs ↔ ∃ x, I p (x::xs)) :
  ∀ (p : fm α) (xs : list β), I (lift_nnf_qe β qe p) xs ↔ I p xs :=
begin
  intro p, apply (lnq_prsv_gen _ _ (λ _, true)),
  intros _ _ _ _, trivial,
  intros _ _,  trivial,
  intros _ _,  trivial,
  intros _ _ _ _, trivial,
  intros q hf h', apply hi,
  apply hf, trivial, apply hqe
end


import for_mathlib.homological_complex_abelian
import category_theory.limits.preserves.finite
import category_theory.limits.preserves.shapes.kernels
import for_mathlib.homology

.

open category_theory category_theory.limits

universes v u₁ u₂

variables {C : Type u₁} [category.{v} C] [abelian C]
variables {D : Type u₂} [category.{v} D] [abelian D] (F : C ⥤ D)
variables [preserves_finite_limits F] [preserves_finite_colimits F] [functor.additive F]
variables {ι : Type*} {c : complex_shape ι}

@[simps] noncomputable
def category_theory.limits.cokernel.map_arrow_iso {C : Type u₁} [category.{v} C]
  [has_zero_morphisms C] {X₁ Y₁ X₂ Y₂ : C}
  (f₁ : X₁ ⟶ Y₁) (f₂ : X₂ ⟶ Y₂) [has_cokernel f₁] [has_cokernel f₂]
  (e : arrow.mk f₁ ≅ arrow.mk f₂) : cokernel f₁ ≅ cokernel f₂ :=
{ hom := cokernel.map _ _ e.hom.left e.hom.right e.hom.w.symm,
  inv := cokernel.map _ _ e.inv.left e.inv.right e.inv.w.symm,
  hom_inv_id' := begin
    ext,
    simp only [category.comp_id, cokernel.π_desc, cokernel.π_desc_assoc,
      category.assoc, coequalizer_as_cokernel],
    rw [← category.assoc, ← comma.comp_right, e.hom_inv_id, arrow.id_right],
    exact category.id_comp _
  end,
  inv_hom_id' := begin
    ext,
    simp only [category.comp_id, cokernel.π_desc, cokernel.π_desc_assoc,
      category.assoc, coequalizer_as_cokernel],
    rw [← category.assoc, ← comma.comp_right, e.inv_hom_id, arrow.id_right],
    exact category.id_comp _
  end }

@[simps] noncomputable
def category_theory.limits.kernel.map_arrow_iso {C : Type u₁} [category.{v} C]
  [has_zero_morphisms C] {X₁ Y₁ X₂ Y₂ : C}
  (f₁ : X₁ ⟶ Y₁) (f₂ : X₂ ⟶ Y₂) [has_kernel f₁] [has_kernel f₂]
  (e : arrow.mk f₁ ≅ arrow.mk f₂) : kernel f₁ ≅ kernel f₂ :=
{ hom := kernel.map _ _ e.hom.left e.hom.right e.hom.w.symm,
  inv := kernel.map _ _ e.inv.left e.inv.right e.inv.w.symm,
  hom_inv_id' := begin
    ext,
    simp only [category.id_comp, kernel.lift_ι, kernel.lift_ι_assoc,
      category.assoc, equalizer_as_kernel],
    rw [← comma.comp_left, e.hom_inv_id, arrow.id_left],
    exact category.comp_id _
  end,
  inv_hom_id' := begin
    ext,
    simp only [category.id_comp, kernel.lift_ι, kernel.lift_ι_assoc,
      category.assoc, equalizer_as_kernel],
    rw [← comma.comp_left, e.inv_hom_id, arrow.id_left],
    exact category.comp_id _
  end }

noncomputable
def category_theory.functor.map_homological_complex_X_prev (F : C ⥤ D) [F.additive]
  (X : homological_complex C c) (i : ι) :
  ((F.map_homological_complex c).obj X).X_prev i ≅ F.obj (X.X_prev i) :=
iso.refl _

lemma category_theory.functor.map_homological_complex_X_prev_eq (F : C ⥤ D) [F.additive]
  (X : homological_complex C c) {i : ι} :
  F.map_homological_complex_X_prev X i = iso.refl _ := rfl

noncomputable
def category_theory.functor.map_homological_complex_X_next (F : C ⥤ D) [F.additive]
  (X : homological_complex C c) (i : ι) :
  ((F.map_homological_complex c).obj X).X_next i ≅ F.obj (X.X_next i) :=
iso.refl _

lemma category_theory.functor.map_homological_complex_X_next_eq (F : C ⥤ D) [F.additive]
  (X : homological_complex C c) {i : ι} :
  F.map_homological_complex_X_next X i = iso.refl _ := rfl

lemma category_theory.functor.map_homological_complex_d_from (F : C ⥤ D) [F.additive]
  (X : homological_complex C c) (i : ι) :
  ((F.map_homological_complex c).obj X).d_from i = F.map (X.d_from i) := rfl

lemma category_theory.functor.map_homological_complex_d_to (F : C ⥤ D) [F.additive]
  (X : homological_complex C c) (i : ι) :
  ((F.map_homological_complex c).obj X).d_to i = F.map (X.d_to i) := rfl

@[simp, reassoc]
lemma category_theory.limits.preserves_kernel_iso_inv_map (F : C ⥤ D)
  [F.additive] [preserves_finite_limits F]
  {X₁ Y₁ X₂ Y₂ : C} (f₁ : X₁ ⟶ Y₁) (f₂ : X₂ ⟶ Y₂) (iX : X₁ ⟶ X₂) (iY : Y₁ ⟶ Y₂) (e) :
  (preserves_kernel.iso F f₁).inv ≫ F.map (kernel.map _ _ iX iY e) =
    kernel.map _ _ (F.map iX) (F.map iY) (by simp_rw [← F.map_comp, e]) ≫
      (preserves_kernel.iso F f₂).inv :=
begin
  rw [iso.eq_comp_inv, category.assoc, eq_comm, iso.eq_inv_comp],
  ext,
  simp,
end
-- attribute [reassoc] kernel.lift_map

open category_theory category_theory.limits

@[simp, reassoc]
lemma homology.π'_iso_cokernel_lift_hom {X Y Z : C} (f : X ⟶ Y) (g : Y ⟶ Z) (w : f ≫ g = 0) :
  homology.π' f g w ≫ (homology_iso_cokernel_lift f g w).hom = cokernel.π _ :=
begin
  delta homology.π', simp,
end

@[reassoc]
lemma homology.π'_iso_cokernel_lift_inv {X Y Z : C} (f : X ⟶ Y) (g : Y ⟶ Z) (w : f ≫ g = 0) :
  cokernel.π _ ≫ (homology_iso_cokernel_lift f g w).inv = homology.π' f g w := rfl

noncomputable
def preserves_homology_of_exact (i : ι) :
  F.map_homological_complex c ⋙ homology_functor _ c i ≅ homology_functor _ c i ⋙ F :=
begin
  fapply nat_iso.of_components,
  { intro X,
    refine homology_iso_cokernel_lift _ _ _ ≪≫
      cokernel.map_arrow_iso _ _ (arrow.iso_mk _ _ _) ≪≫
      (preserves_cokernel.iso _ _).symm ≪≫ F.map_iso (homology_iso_cokernel_lift _ _ _).symm,
    { exact iso.refl _ },
    { refine kernel.map_arrow_iso _ _ (arrow.iso_mk _ _ _) ≪≫ (preserves_kernel.iso _ _).symm,
      { exact iso.refl _ },
      { exact iso.refl _ },
      { dsimp, rw [category.id_comp, F.map_homological_complex_d_from, category.comp_id] } },
    { dsimp, rw [← category.assoc, iso.eq_comp_inv], ext, simp [F.map_homological_complex_d_to] } },
  { intros X Y f, apply homology.hom_from_ext,
    simp only [category_theory.limits.kernel.map_arrow_iso_hom,
      category_theory.functor.map_iso_inv,
      category_theory.functor.map_homological_complex_map_f,
      homological_complex.hom.sq_from_right,
      category_theory.iso.refl_hom,
      homology.π'_iso_cokernel_lift_hom_assoc,
      category_theory.arrow.iso_mk_hom_right,
      category_theory.arrow.iso_mk_hom_left,
      category_theory.limits.cokernel.map_arrow_iso_hom,
      category_theory.functor.comp_map,
      homology_functor_map,
      category_theory.iso.symm_hom,
      category_theory.limits.cokernel.π_desc_assoc,
      category_theory.limits.preserves_cokernel.iso_inv,
      category_theory.functor.map_iso_symm,
      category_theory.category.assoc,
      category_theory.iso.trans_hom,
      homological_complex.hom.sq_to_right,
      category_theory.limits.π_comp_cokernel_comparison_assoc,
      homology.π'_map_assoc],
    simp only [← functor.map_comp],
    rw [homology.π'_iso_cokernel_lift_inv_assoc, homology.π'_iso_cokernel_lift_inv, homology.π'_map,
      F.map_comp, preserves_kernel_iso_inv_map_assoc],
    simp only [← category.assoc],
    congr' 2,
    ext,
    simp only [category_theory.limits.equalizer_as_kernel,
      homological_complex.hom.sq_from_right,
      category_theory.category.assoc,
      category_theory.limits.kernel.lift_ι,
      homological_complex.hom.sq_to_right,
      category_theory.limits.kernel.lift_ι_assoc],
    dsimp,
    rw [category.id_comp, category.comp_id] }
end
.

-- def preserves_limit_of_lim_commute (J : Type*) [category J] [has_limits_of_shape J C]
--   [has_limits_of_shape J D]  (F : C ⥤ D) (e : lim ⋙ F ≅ (whiskering_right J C D).obj F ⋙ lim):
--     preserves_limits_of_shape J F :=
-- begin
--   refine ⟨λ K, preserves_limit_of_preserves_limit_cone (limit.is_limit _) _⟩,
--   apply is_limit.of_iso_limit (limit.is_limit _),
--   ext, swap,
--   { exact e.symm.app K },
--   { dsimp,
--     have := congr_arg (λ f, f ≫ limit.π _ j) (e.hom.naturality (limit.cone K).π),
--     dsimp at this,
--     simp only [whisker_right_app, limit.cone_π, lim_map_π, category.assoc] at this,
--     let : limit K ≅ limit ((category_theory.functor.const J).obj (limit K)),
--     { refine ⟨limit.lift _ ⟨_, 𝟙 _⟩, lim_map (limit.cone K).π, _, _⟩,
--       { ext, simp },
--       { ext, simp, dsimp, simp,  } }  }
--   -- have := cone.iso_mk
-- end


import analysis.topology.topological_space
import analysis.topology.continuity
import analysis.topology.topological_structures
import ex2

open tactic expr function has_add
variables {X : Type*} {Y : Type*} {Z : Type*} {W : Type*}
          {f f₁ f₂ : X → Y} {g : Y → Z} {h : Z → W}
variables [topological_space X] [topological_space Y]
          [topological_space Z] [topological_space W]

example [add_monoid X] [topological_add_monoid X]:
  (λ x : X, x + x) = (uncurry add) ∘ (λ x : X, (x, x)) :=
by reflexivity

#check @has_add.add .

-- Some preparation is necessary, has_add.add has 4 (in words four) arguments
-- first count the non-implicit (default) args, then find them

meta def get_app_num_default_args_aux : expr → nat
| (pi _ binder_info.default _ bbody) := 1 + (get_app_num_default_args_aux bbody)
| (pi _ _ _ bbody) := get_app_num_default_args_aux bbody
| _ :=  0

meta def get_app_num_default_args : expr → tactic nat :=
assume e,
do type ← infer_type e, -- the type of a function is a pi type, we inspect the binder_info recursively
  return $ get_app_num_default_args_aux type

meta def ith_default_arg_index_aux : expr → nat → tactic nat
| (expr.pi _ binder_info.default _ _) 0 := return 0
| (expr.pi _ binder_info.default _ bbody) (i + 1) := do idx ← ith_default_arg_index_aux bbody i, return $ idx + 1
| (expr.pi _ _ _ bbody) i := do idx ← ith_default_arg_index_aux bbody i, return $ idx + 1
| e i := do fail $ "can't find " ++ to_string i ++ "th default argument index"

meta def ith_default_arg_index (e : expr) (i : nat) : tactic nat :=
do type ← infer_type e,
   index ← ith_default_arg_index_aux type i,
   return index

meta def get_codomain (e : expr) : tactic expr :=
do t ← infer_type e,
match t with
| `(%%domain → %%codomain) := return codomain
| _ := fail $ "Can't determine codomain, '" ++ to_string t ++ "' is not a function type."
end

--now we can 'uncurry' and move λ inside

/- Push a given lambda expression inside in the goal:
 -
 - Takes an expression of the form 'λ x, f _[x]',
 - creates a hypothesis 'λ x, f _[x] = f ∘ (λ x, _[x])',
 - and rewrites the main goal using this hypothesis.
 -
 - Tries to uncurry if there is a curried function with two arguments.
 -
 - Fails if it 'doesn't simplify'.
 -/
meta def push_lam_inside2 (e : expr): tactic unit :=
--do trace $ to_raw_fmt e,
do lam name binfo bdomain bbody ← return e
       <|> (fail "The given expression must be a λ."),
  if ¬ is_app bbody
  then fail $ "The outer most part of the lambda expression '" ++ (to_string e) ++
              "' is not a function application."
  else do
    -- we use fancier versions instead of simple pattern matching
    -- because there are many curried arguments now
    fn ← return $ get_app_fn bbody,
    arg ← return $ app_arg bbody,
    num_default_args ← get_app_num_default_args fn,

    -- uncurry if necessary, then push λ inside
    match num_default_args with
    | 2 := do -- there are two default arguments, uncurry and push lambda inside

      -- get first argument and argument type
      arg0_idx ← ith_default_arg_index fn 0,
      arg0 ← return $ ith_arg bbody arg0_idx,
      arg0_type ← get_codomain (expr.lam name binfo bdomain arg0),

      -- get second argument and argument type
      arg1_idx ← ith_default_arg_index fn 1,
      arg1 ← return $ ith_arg bbody arg1_idx,
      arg1_type ← get_codomain (expr.lam name binfo bdomain arg1),

      -- create the inner expression, i.e. λ x, (arg0[x], arg1[x])
      inner_body_app ← to_expr ``(@prod.mk %%arg0_type %%arg1_type),
      inner ← return $ expr.lam name binfo bdomain
                       (expr.app (expr.app inner_body_app arg0) arg1),

      -- create the outer expression, i.e. (uncurry f)
      expr.const fn_name _ ← return fn,
      outer ← return $ @expr.const ff fn_name [],

      -- create term 'original = outer ∘ inner', need to hint types here
      -- i.e. need to use @comp instead of $∘
      can_uncurry ← to_expr ``(%%e = @comp %%bdomain (%%arg0_type × %%arg1_type) _
                                           (uncurry %%outer) %%inner),

      -- create hypothesis and prove it by reflexivity
      h_can_uncurry ← assert "can_uncurry" can_uncurry,
      reflexivity <|> rotate 1,

      -- rewrite target
      rewrite_target h_can_uncurry,
      to_expr ``(function.uncurry_def) >>= rewrite_target,

      -- fail if the outer or inner part is the same as the original expression
      `(continuous $ %%outer ∘ %%inner) ← target,
      (success_if_fail $ unify e inner) <|> fail "inner not changed!",
      (success_if_fail $ unify e outer) <|> fail "outer not changed!",

      -- done!
      return ()

    | 1 := do -- same as before
      -- create hypothesis
      can_push_inside ← to_expr ``(%%e = %%fn ∘ %%(expr.lam name binfo bdomain arg)),
      -- prove hypothesis
      h_can_push_inside ← assert "can_push_λ_inside" can_push_inside,
      reflexivity <|> fail "Can't prove that λ can be pushed inside by reflexivity.",
      -- rewrite target
      rewrite_target h_can_push_inside,
      return ()
    | _ := fail "uncurrying more than two arguements is not implemented"
    end

example [add_monoid X] [topological_add_monoid X] : (continuous (λ x : X, x + x)) :=
begin
  (do `(continuous %%e) ← target,
    push_lam_inside2 e,
    return ()),
  contcomp2,
  exact topological_add_monoid.continuous_add X,
  sorry
end

example [add_monoid X] [topological_add_monoid X] : (continuous (λ x : X, (x, x))) :=
by sorry

-- Same as contcomp2, bu uses push_lam_inside2
meta def contcomp3 : tactic unit :=
do `(continuous %%e) ← target <|> fail "goal has to be of the form 'continuous _'",

  -- if the goal is to show that the expression e is continuous, check if it is an assumption
  assumption <|>

  -- if e is not continuous by assumption, check if it is of the form 'f ∘ g' for some f and g
  match e with
  | `(%%outer ∘ %%inner) :=
    do
    -- assert that the outer function is continuous, if not, rotate the goal away
    outer_continuous ← to_expr ``(continuous %%outer),
    outer_is_continuous ← assert "h_outer_cont" outer_continuous,
    contcomp <|> rotate 1,

    -- assert that the inner function is continuous, if not, rotate the goal away
    inner_continuous ← to_expr ``(continuous %%inner),
    inner_is_continuous ← assert "h_inner_cont" inner_continuous,
    contcomp <|> rotate 1,

    -- knowing that inner and outer function are continuous, apply the theorem continuous.comp
    -- which shows that the composite is continuous
    cont_comp ← to_expr ``(continuous.comp %%inner_is_continuous %%outer_is_continuous),
    exact cont_comp
  | `(λ _, _) :=
    -- if we can move the lambda inside, to that and apply contcomp2 recursively
    do push_lam_inside2 e <|> fail "can't move lambda inside",
       contcomp3
  | _ := fail "neither composite nor lambda expression"
  end

example [add_monoid X] [topological_add_monoid X] : (continuous (λ x : X, x + x)) :=
begin
  contcomp3,
  exact topological_add_monoid.continuous_add X,
  sorry
end

example [add_monoid X] [topological_add_monoid X] : (continuous (λ x : X, (x, x))) :=
by sorry