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

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 update_type,
  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 :=
    (tactic.solve_by_elim <|> tactic.tautology {classical := tt} <|>
      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

add_tactic_doc
{ name := "wlog",
  category := doc_category.tactic,
  decl_names := [``wlog],
  tags := ["logic"] }

end interactive

end tactic


/-
Copyright (c) 2019 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes
-/
import order.well_founded
import algebra.group.pi
import algebra.order.group.defs

/-!
# Lexicographic order on Pi types

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

This file defines the lexicographic order for Pi types. `a` is less than `b` if `a i = b i` for all
`i` up to some point `k`, and `a k < b k`.

## Notation

* `Πₗ i, α i`: Pi type equipped with the lexicographic order. Type synonym of `Π i, α i`.

## See also

Related files are:
* `data.finset.colex`: Colexicographic order on finite sets.
* `data.list.lex`: Lexicographic order on lists.
* `data.sigma.order`: Lexicographic order on `Σₗ i, α i`.
* `data.psigma.order`: Lexicographic order on `Σₗ' i, α i`.
* `data.prod.lex`: Lexicographic order on `α × β`.
-/

variables {ι : Type*} {β : ι → Type*} (r : ι → ι → Prop)
  (s : Π {i}, β i → β i → Prop)

namespace pi

instance {α : Type*} : Π [inhabited α], inhabited (lex α) := id

/-- The lexicographic relation on `Π i : ι, β i`, where `ι` is ordered by `r`,
  and each `β i` is ordered by `s`. -/
protected def lex (x y : Π i, β i) : Prop :=
∃ i, (∀ j, r j i → x j = y j) ∧ s (x i) (y i)

/- This unfortunately results in a type that isn't delta-reduced, so we keep the notation out of the
basic API, just in case -/
notation `Πₗ` binders `, ` r:(scoped p, lex (Π i, p i)) := r

@[simp] lemma to_lex_apply (x : Π i, β i) (i : ι) : to_lex x i = x i := rfl
@[simp] lemma of_lex_apply (x : lex (Π i, β i)) (i : ι) : of_lex x i = x i := rfl

lemma lex_lt_of_lt_of_preorder [Π i, preorder (β i)] {r} (hwf : well_founded r)
  {x y : Π i, β i} (hlt : x < y) : ∃ i, (∀ j, r j i → x j ≤ y j ∧ y j ≤ x j) ∧ x i < y i :=
let h' := pi.lt_def.1 hlt, ⟨i, hi, hl⟩ := hwf.has_min _ h'.2 in
  ⟨i, λ j hj, ⟨h'.1 j, not_not.1 $ λ h, hl j (lt_of_le_not_le (h'.1 j) h) hj⟩, hi⟩

lemma lex_lt_of_lt [Π i, partial_order (β i)] {r} (hwf : well_founded r)
  {x y : Π i, β i} (hlt : x < y) : pi.lex r (λ i, (<)) x y :=
by { simp_rw [pi.lex, le_antisymm_iff], exact lex_lt_of_lt_of_preorder hwf hlt }

lemma is_trichotomous_lex [∀ i, is_trichotomous (β i) s] (wf : well_founded r) :
  is_trichotomous (Π i, β i) (pi.lex r @s) :=
{ trichotomous := λ a b,
    begin
      cases eq_or_ne a b with hab hab,
      { exact or.inr (or.inl hab) },
      { rw function.ne_iff at hab,
        let i := wf.min _ hab,
        have hri : ∀ j, r j i → a j = b j,
        { intro j, rw ← not_imp_not,
          exact λ h', wf.not_lt_min _ _ h' },
        have hne : a i ≠ b i, from wf.min_mem _ hab,
        cases trichotomous_of s (a i) (b i) with hi hi,
        exacts [or.inl ⟨i, hri, hi⟩,
          or.inr $ or.inr $ ⟨i, λ j hj, (hri j hj).symm, hi.resolve_left hne⟩] },
    end }

instance [has_lt ι] [Π a, has_lt (β a)] : has_lt (lex (Π i, β i)) := ⟨pi.lex (<) (λ _, (<))⟩

instance lex.is_strict_order [linear_order ι] [∀ a, partial_order (β a)] :
  is_strict_order (lex (Π i, β i)) (<) :=
{ irrefl := λ a ⟨k, hk₁, hk₂⟩, lt_irrefl (a k) hk₂,
  trans :=
    begin
      rintro a b c ⟨N₁, lt_N₁, a_lt_b⟩ ⟨N₂, lt_N₂, b_lt_c⟩,
      rcases lt_trichotomy N₁ N₂ with (H|rfl|H),
      exacts [⟨N₁, λ j hj, (lt_N₁ _ hj).trans (lt_N₂ _ $ hj.trans H), lt_N₂ _ H ▸ a_lt_b⟩,
        ⟨N₁, λ j hj, (lt_N₁ _ hj).trans (lt_N₂ _ hj), a_lt_b.trans b_lt_c⟩,
        ⟨N₂, λ j hj, (lt_N₁ _ (hj.trans H)).trans (lt_N₂ _ hj), (lt_N₁ _ H).symm ▸ b_lt_c⟩]
    end }

instance [linear_order ι] [Π a, partial_order (β a)] : partial_order (lex (Π i, β i)) :=
partial_order_of_SO (<)

/-- `Πₗ i, α i` is a linear order if the original order is well-founded. -/
noncomputable instance [linear_order ι] [is_well_order ι (<)] [∀ a, linear_order (β a)] :
  linear_order (lex (Π i, β i)) :=
@linear_order_of_STO (Πₗ i, β i) (<)
  { to_is_trichotomous := is_trichotomous_lex _ _ is_well_founded.wf } (classical.dec_rel _)

section partial_order
variables [linear_order ι] [is_well_order ι (<)] [Π i, partial_order (β i)] {x y : Π i, β i} {i : ι}
  {a b : β i}

open function

lemma to_lex_monotone : monotone (@to_lex (Π i, β i)) :=
λ a b h, or_iff_not_imp_left.2 $ λ hne,
  let ⟨i, hi, hl⟩ := is_well_founded.wf.has_min {i | a i ≠ b i} (function.ne_iff.1 hne) in
  ⟨i, λ j hj, by { contrapose! hl, exact ⟨j, hl, hj⟩ }, (h i).lt_of_ne hi⟩

lemma to_lex_strict_mono : strict_mono (@to_lex (Π i, β i)) :=
λ a b h, let ⟨i, hi, hl⟩ := is_well_founded.wf.has_min {i | a i ≠ b i} (function.ne_iff.1 h.ne) in
  ⟨i, λ j hj, by { contrapose! hl, exact ⟨j, hl, hj⟩ }, (h.le i).lt_of_ne hi⟩

@[simp] lemma lt_to_lex_update_self_iff : to_lex x < to_lex (update x i a) ↔ x i < a :=
begin
  refine ⟨_, λ h, to_lex_strict_mono $ lt_update_self_iff.2 h⟩,
  rintro ⟨j, hj, h⟩,
  dsimp at h,
  obtain rfl : j = i,
  { by_contra H,
    rw update_noteq H at h,
    exact h.false },
  { rwa update_same at h }
end

@[simp] lemma to_lex_update_lt_self_iff : to_lex (update x i a) < to_lex x ↔ a < x i :=
begin
  refine ⟨_, λ h, to_lex_strict_mono $ update_lt_self_iff.2 h⟩,
  rintro ⟨j, hj, h⟩,
  dsimp at h,
  obtain rfl : j = i,
  { by_contra H,
    rw update_noteq H at h,
    exact h.false },
  { rwa update_same at h }
end

@[simp] lemma le_to_lex_update_self_iff : to_lex x ≤ to_lex (update x i a) ↔ x i ≤ a :=
by simp_rw [le_iff_lt_or_eq, lt_to_lex_update_self_iff, to_lex_inj, eq_update_self_iff]

@[simp] lemma to_lex_update_le_self_iff : to_lex (update x i a) ≤ to_lex x ↔ a ≤ x i :=
by simp_rw [le_iff_lt_or_eq, to_lex_update_lt_self_iff, to_lex_inj, update_eq_self_iff]

end partial_order

instance [linear_order ι] [is_well_order ι (<)] [Π a, partial_order (β a)]
  [Π a, order_bot (β a)] : order_bot (lex (Π a, β a)) :=
{ bot := to_lex ⊥,
  bot_le := λ f, to_lex_monotone bot_le }

instance [linear_order ι] [is_well_order ι (<)] [Π a, partial_order (β a)]
  [Π a, order_top (β a)] : order_top (lex (Π a, β a)) :=
{ top := to_lex ⊤,
  le_top := λ f, to_lex_monotone le_top }

instance [linear_order ι] [is_well_order ι (<)] [Π a, partial_order (β a)]
  [Π a, bounded_order (β a)] : bounded_order (lex (Π a, β a)) :=
{ .. pi.lex.order_bot, .. pi.lex.order_top }

instance [preorder ι] [Π i, has_lt (β i)] [Π i, densely_ordered (β i)] :
  densely_ordered (lex (Π i, β i)) :=
⟨begin
  rintro _ _ ⟨i, h, hi⟩,
  obtain ⟨a, ha₁, ha₂⟩ := exists_between hi,
  classical,
  refine ⟨a₂.update _ a, ⟨i, λ j hj, _, _⟩, i, λ j hj, _, _⟩,
  rw h j hj,
  iterate 2 { { rw a₂.update_noteq hj.ne a }, { rwa a₂.update_same i a } },
end⟩

lemma lex.no_max_order' [preorder ι] [Π i, has_lt (β i)] (i : ι) [no_max_order (β i)] :
  no_max_order (lex (Π i, β i)) :=
⟨λ a, begin
  classical,
  obtain ⟨b, hb⟩ := exists_gt (a i),
  exact ⟨a.update i b, i, λ j hj, (a.update_noteq hj.ne b).symm, by rwa a.update_same i b⟩
end⟩

instance [linear_order ι] [is_well_order ι (<)] [nonempty ι] [Π i, partial_order (β i)]
  [Π i, no_max_order (β i)] :
  no_max_order (lex (Π i, β i)) :=
⟨λ a, let ⟨b, hb⟩ := exists_gt (of_lex a) in ⟨_, to_lex_strict_mono hb⟩⟩

instance [linear_order ι] [is_well_order ι (<)] [nonempty ι] [Π i, partial_order (β i)]
  [Π i, no_min_order (β i)] :
  no_min_order (lex (Π i, β i)) :=
⟨λ a, let ⟨b, hb⟩ := exists_lt (of_lex a) in ⟨_, to_lex_strict_mono hb⟩⟩

--we might want the analog of `pi.ordered_cancel_comm_monoid` as well in the future
@[to_additive]
instance lex.ordered_comm_group [linear_order ι] [∀ a, ordered_comm_group (β a)] :
  ordered_comm_group (lex (Π i, β i)) :=
{ mul_le_mul_left := λ x y hxy z,
    hxy.elim
      (λ hxyz, hxyz ▸ le_rfl)
      (λ ⟨i, hi⟩,
        or.inr ⟨i, λ j hji, show z j * x j = z j * y j, by rw hi.1 j hji,
          mul_lt_mul_left' hi.2 _⟩),
  ..pi.lex.partial_order,
  ..pi.comm_group }

/-- If we swap two strictly decreasing values in a function, then the result is lexicographically
smaller than the original function. -/
lemma lex_desc {α} [preorder ι] [decidable_eq ι] [preorder α] {f : ι → α} {i j : ι}
  (h₁ : i < j) (h₂ : f j < f i) :
  to_lex (f ∘ equiv.swap i j) < to_lex f :=
⟨i, λ k hik, congr_arg f (equiv.swap_apply_of_ne_of_ne hik.ne (hik.trans h₁).ne),
  by simpa only [pi.to_lex_apply, function.comp_app, equiv.swap_apply_left] using h₂⟩

end pi


/-
Copyright (c) 2020 Anatole Dedecker. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Anatole Dedecker
-/
import analysis.calculus.mean_value

/-!
# L'Hôpital's rule for 0/0 indeterminate forms

In this file, we prove several forms of "L'Hopital's rule" for computing 0/0
indeterminate forms. The proof of `has_deriv_at.lhopital_zero_right_on_Ioo`
is based on the one given in the corresponding
[Wikibooks](https://en.wikibooks.org/wiki/Calculus/L%27H%C3%B4pital%27s_Rule)
chapter, and all other statements are derived from this one by composing by
carefully chosen functions.

Note that the filter `f'/g'` tends to isn't required to be one of `𝓝 a`,
`at_top` or `at_bot`. In fact, we give a slightly stronger statement by
allowing it to be any filter on `ℝ`.

Each statement is available in a `has_deriv_at` form and a `deriv` form, which
is denoted by each statement being in either the `has_deriv_at` or the `deriv`
namespace.

## Tags

L'Hôpital's rule, L'Hopital's rule
-/

open filter set
open_locale filter topology pointwise

variables {a b : ℝ} (hab : a < b) {l : filter ℝ} {f f' g g' : ℝ → ℝ}

/-!
## Interval-based versions

We start by proving statements where all conditions (derivability, `g' ≠ 0`) have
to be satisfied on an explicitly-provided interval.
-/

namespace has_deriv_at

include hab

theorem lhopital_zero_right_on_Ioo
  (hff' : ∀ x ∈ Ioo a b, has_deriv_at f (f' x) x) (hgg' : ∀ x ∈ Ioo a b, has_deriv_at g (g' x) x)
  (hg' : ∀ x ∈ Ioo a b, g' x ≠ 0)
  (hfa : tendsto f (𝓝[>] a) (𝓝 0)) (hga : tendsto g (𝓝[>] a) (𝓝 0))
  (hdiv : tendsto (λ x, (f' x) / (g' x)) (𝓝[>] a) l) :
  tendsto (λ x, (f x) / (g x)) (𝓝[>] a) l :=
begin
  have sub : ∀ x ∈ Ioo a b, Ioo a x ⊆ Ioo a b := λ x hx, Ioo_subset_Ioo (le_refl a) (le_of_lt hx.2),
  have hg : ∀ x ∈ (Ioo a b), g x ≠ 0,
  { intros x hx h,
    have : tendsto g (𝓝[<] x) (𝓝 0),
    { rw [← h, ← nhds_within_Ioo_eq_nhds_within_Iio hx.1],
      exact ((hgg' x hx).continuous_at.continuous_within_at.mono $ sub x hx).tendsto },
    obtain ⟨y, hyx, hy⟩ : ∃ c ∈ Ioo a x, g' c = 0,
      from exists_has_deriv_at_eq_zero' hx.1 hga this (λ y hy, hgg' y $ sub x hx hy),
    exact hg' y (sub x hx hyx) hy },
  have : ∀ x ∈ Ioo a b, ∃ c ∈ Ioo a x, (f x) * (g' c) = (g x) * (f' c),
  { intros x hx,
    rw [← sub_zero (f x), ← sub_zero (g x)],
    exact exists_ratio_has_deriv_at_eq_ratio_slope' g g' hx.1 f f'
      (λ y hy, hgg' y $ sub x hx hy) (λ y hy, hff' y $ sub x hx hy) hga hfa
      (tendsto_nhds_within_of_tendsto_nhds (hgg' x hx).continuous_at.tendsto)
      (tendsto_nhds_within_of_tendsto_nhds (hff' x hx).continuous_at.tendsto) },
  choose! c hc using this,
  have : ∀ x ∈ Ioo a b, ((λ x', (f' x') / (g' x')) ∘ c) x = f x / g x,
  { intros x hx,
    rcases hc x hx with ⟨h₁, h₂⟩,
    field_simp [hg x hx, hg' (c x) ((sub x hx) h₁)],
    simp only [h₂],
    rwa mul_comm },
  have cmp : ∀ x ∈ Ioo a b, a < c x ∧ c x < x,
    from λ x hx, (hc x hx).1,
  rw ← nhds_within_Ioo_eq_nhds_within_Ioi hab,
  apply tendsto_nhds_within_congr this,
  simp only,
  apply hdiv.comp,
  refine tendsto_nhds_within_of_tendsto_nhds_of_eventually_within _
    (tendsto_of_tendsto_of_tendsto_of_le_of_le' tendsto_const_nhds
      (tendsto_nhds_within_of_tendsto_nhds tendsto_id) _ _) _,
  all_goals
  { apply eventually_nhds_within_of_forall,
    intros x hx,
    have := cmp x hx,
    try {simp},
    linarith [this] }
end

theorem lhopital_zero_right_on_Ico
  (hff' : ∀ x ∈ Ioo a b, has_deriv_at f (f' x) x) (hgg' : ∀ x ∈ Ioo a b, has_deriv_at g (g' x) x)
  (hcf : continuous_on f (Ico a b)) (hcg : continuous_on g (Ico a b))
  (hg' : ∀ x ∈ Ioo a b, g' x ≠ 0)
  (hfa : f a = 0) (hga : g a = 0)
  (hdiv : tendsto (λ x, (f' x) / (g' x)) (𝓝[>] a) l) :
  tendsto (λ x, (f x) / (g x)) (𝓝[>] a) l :=
begin
  refine lhopital_zero_right_on_Ioo hab hff' hgg' hg' _ _ hdiv,
  { rw [← hfa, ← nhds_within_Ioo_eq_nhds_within_Ioi hab],
    exact ((hcf a $ left_mem_Ico.mpr hab).mono Ioo_subset_Ico_self).tendsto },
  { rw [← hga, ← nhds_within_Ioo_eq_nhds_within_Ioi hab],
    exact ((hcg a $ left_mem_Ico.mpr hab).mono Ioo_subset_Ico_self).tendsto },
end

theorem lhopital_zero_left_on_Ioo
  (hff' : ∀ x ∈ Ioo a b, has_deriv_at f (f' x) x) (hgg' : ∀ x ∈ Ioo a b, has_deriv_at g (g' x) x)
  (hg' : ∀ x ∈ Ioo a b, g' x ≠ 0)
  (hfb : tendsto f (𝓝[<] b) (𝓝 0)) (hgb : tendsto g (𝓝[<] b) (𝓝 0))
  (hdiv : tendsto (λ x, (f' x) / (g' x)) (𝓝[<] b) l) :
  tendsto (λ x, (f x) / (g x)) (𝓝[<] b) l :=
begin
  -- Here, we essentially compose by `has_neg.neg`. The following is mostly technical details.
  have hdnf : ∀ x ∈ -Ioo a b, has_deriv_at (f ∘ has_neg.neg) (f' (-x) * (-1)) x,
    from λ x hx, comp x (hff' (-x) hx) (has_deriv_at_neg x),
  have hdng : ∀ x ∈ -Ioo a b, has_deriv_at (g ∘ has_neg.neg) (g' (-x) * (-1)) x,
    from λ x hx, comp x (hgg' (-x) hx) (has_deriv_at_neg x),
  rw preimage_neg_Ioo at hdnf,
  rw preimage_neg_Ioo at hdng,
  have := lhopital_zero_right_on_Ioo (neg_lt_neg hab) hdnf hdng
    (by { intros x hx h,
          apply hg' _ (by {rw ← preimage_neg_Ioo at hx, exact hx}),
          rwa [mul_comm, ← neg_eq_neg_one_mul, neg_eq_zero] at h })
    (hfb.comp tendsto_neg_nhds_within_Ioi_neg)
    (hgb.comp tendsto_neg_nhds_within_Ioi_neg)
    (by { simp only [neg_div_neg_eq, mul_one, mul_neg],
          exact (tendsto_congr $ λ x, rfl).mp (hdiv.comp tendsto_neg_nhds_within_Ioi_neg) }),
  have := this.comp tendsto_neg_nhds_within_Iio,
  unfold function.comp at this,
  simpa only [neg_neg]
end

theorem lhopital_zero_left_on_Ioc
  (hff' : ∀ x ∈ Ioo a b, has_deriv_at f (f' x) x) (hgg' : ∀ x ∈ Ioo a b, has_deriv_at g (g' x) x)
  (hcf : continuous_on f (Ioc a b)) (hcg : continuous_on g (Ioc a b))
  (hg' : ∀ x ∈ Ioo a b, g' x ≠ 0)
  (hfb : f b = 0) (hgb : g b = 0)
  (hdiv : tendsto (λ x, (f' x) / (g' x)) (𝓝[<] b) l) :
  tendsto (λ x, (f x) / (g x)) (𝓝[<] b) l :=
begin
  refine lhopital_zero_left_on_Ioo hab hff' hgg' hg' _ _ hdiv,
  { rw [← hfb, ← nhds_within_Ioo_eq_nhds_within_Iio hab],
    exact ((hcf b $ right_mem_Ioc.mpr hab).mono Ioo_subset_Ioc_self).tendsto },
  { rw [← hgb, ← nhds_within_Ioo_eq_nhds_within_Iio hab],
    exact ((hcg b $ right_mem_Ioc.mpr hab).mono Ioo_subset_Ioc_self).tendsto },
end

omit hab

theorem lhopital_zero_at_top_on_Ioi
  (hff' : ∀ x ∈ Ioi a, has_deriv_at f (f' x) x) (hgg' : ∀ x ∈ Ioi a, has_deriv_at g (g' x) x)
  (hg' : ∀ x ∈ Ioi a, g' x ≠ 0)
  (hftop : tendsto f at_top (𝓝 0)) (hgtop : tendsto g at_top (𝓝 0))
  (hdiv : tendsto (λ x, (f' x) / (g' x)) at_top l) :
  tendsto (λ x, (f x) / (g x)) at_top l :=
begin
  obtain ⟨ a', haa', ha'⟩ : ∃ a', a < a' ∧ 0 < a' :=
    ⟨1 + max a 0, ⟨lt_of_le_of_lt (le_max_left a 0) (lt_one_add _),
                   lt_of_le_of_lt (le_max_right a 0) (lt_one_add _)⟩⟩,
  have fact1 : ∀ (x:ℝ), x ∈ Ioo 0 a'⁻¹ → x ≠ 0 := λ _ hx, (ne_of_lt hx.1).symm,
  have fact2 : ∀ x ∈ Ioo 0 a'⁻¹, a < x⁻¹,
    from λ _ hx, lt_trans haa' ((lt_inv ha' hx.1).mpr hx.2),
  have hdnf : ∀ x ∈ Ioo 0 a'⁻¹, has_deriv_at (f ∘ has_inv.inv) (f' (x⁻¹) * (-(x^2)⁻¹)) x,
    from λ x hx, comp x (hff' (x⁻¹) $ fact2 x hx) (has_deriv_at_inv $ fact1 x hx),
  have hdng : ∀ x ∈ Ioo 0 a'⁻¹, has_deriv_at (g ∘ has_inv.inv) (g' (x⁻¹) * (-(x^2)⁻¹)) x,
    from λ x hx, comp x (hgg' (x⁻¹) $ fact2 x hx) (has_deriv_at_inv $ fact1 x hx),
  have := lhopital_zero_right_on_Ioo (inv_pos.mpr ha') hdnf hdng
    (by { intros x hx,
          refine mul_ne_zero _ (neg_ne_zero.mpr $ inv_ne_zero $ pow_ne_zero _ $ fact1 x hx),
          exact hg' _ (fact2 x hx) })
    (hftop.comp tendsto_inv_zero_at_top)
    (hgtop.comp tendsto_inv_zero_at_top)
    (by { refine (tendsto_congr' _).mp (hdiv.comp tendsto_inv_zero_at_top),
          rw eventually_eq_iff_exists_mem,
          use [Ioi 0, self_mem_nhds_within],
          intros x hx,
          unfold function.comp,
          erw mul_div_mul_right,
          refine neg_ne_zero.mpr (inv_ne_zero $ pow_ne_zero _ $ ne_of_gt hx) }),
  have := this.comp tendsto_inv_at_top_zero',
  unfold function.comp at this,
  simpa only [inv_inv],
end

theorem lhopital_zero_at_bot_on_Iio
  (hff' : ∀ x ∈ Iio a, has_deriv_at f (f' x) x) (hgg' : ∀ x ∈ Iio a, has_deriv_at g (g' x) x)
  (hg' : ∀ x ∈ Iio a, g' x ≠ 0)
  (hfbot : tendsto f at_bot (𝓝 0)) (hgbot : tendsto g at_bot (𝓝 0))
  (hdiv : tendsto (λ x, (f' x) / (g' x)) at_bot l) :
  tendsto (λ x, (f x) / (g x)) at_bot l :=
begin
  -- Here, we essentially compose by `has_neg.neg`. The following is mostly technical details.
  have hdnf : ∀ x ∈ -Iio a, has_deriv_at (f ∘ has_neg.neg) (f' (-x) * (-1)) x,
    from λ x hx, comp x (hff' (-x) hx) (has_deriv_at_neg x),
  have hdng : ∀ x ∈ -Iio a, has_deriv_at (g ∘ has_neg.neg) (g' (-x) * (-1)) x,
    from λ x hx, comp x (hgg' (-x) hx) (has_deriv_at_neg x),
  rw preimage_neg_Iio at hdnf,
  rw preimage_neg_Iio at hdng,
  have := lhopital_zero_at_top_on_Ioi hdnf hdng
    (by { intros x hx h,
          apply hg' _ (by {rw ← preimage_neg_Iio at hx, exact hx}),
          rwa [mul_comm, ← neg_eq_neg_one_mul, neg_eq_zero] at h })
    (hfbot.comp tendsto_neg_at_top_at_bot)
    (hgbot.comp tendsto_neg_at_top_at_bot)
    (by { simp only [mul_one, mul_neg, neg_div_neg_eq],
          exact (tendsto_congr $ λ x, rfl).mp (hdiv.comp tendsto_neg_at_top_at_bot) }),
  have := this.comp tendsto_neg_at_bot_at_top,
  unfold function.comp at this,
  simpa only [neg_neg],
end

end has_deriv_at

namespace deriv

include hab

theorem lhopital_zero_right_on_Ioo
  (hdf : differentiable_on ℝ f (Ioo a b)) (hg' : ∀ x ∈ Ioo a b, deriv g x ≠ 0)
  (hfa : tendsto f (𝓝[>] a) (𝓝 0)) (hga : tendsto g (𝓝[>] a) (𝓝 0))
  (hdiv : tendsto (λ x, ((deriv f) x) / ((deriv g) x)) (𝓝[>] a) l) :
  tendsto (λ x, (f x) / (g x)) (𝓝[>] a) l :=
begin
  have hdf : ∀ x ∈ Ioo a b, differentiable_at ℝ f x,
    from λ x hx, (hdf x hx).differentiable_at (Ioo_mem_nhds hx.1 hx.2),
  have hdg : ∀ x ∈ Ioo a b, differentiable_at ℝ g x,
    from λ x hx, classical.by_contradiction (λ h, hg' x hx (deriv_zero_of_not_differentiable_at h)),
  exact has_deriv_at.lhopital_zero_right_on_Ioo hab (λ x hx, (hdf x hx).has_deriv_at)
    (λ x hx, (hdg x hx).has_deriv_at) hg' hfa hga hdiv
end

theorem lhopital_zero_right_on_Ico
  (hdf : differentiable_on ℝ f (Ioo a b))
  (hcf : continuous_on f (Ico a b)) (hcg : continuous_on g (Ico a b))
  (hg' : ∀ x ∈ (Ioo a b), (deriv g) x ≠ 0)
  (hfa : f a = 0) (hga : g a = 0)
  (hdiv : tendsto (λ x, ((deriv f) x) / ((deriv g) x)) (𝓝[>] a) l) :
  tendsto (λ x, (f x) / (g x)) (𝓝[>] a) l :=
begin
  refine lhopital_zero_right_on_Ioo hab hdf hg' _ _ hdiv,
  { rw [← hfa, ← nhds_within_Ioo_eq_nhds_within_Ioi hab],
    exact ((hcf a $ left_mem_Ico.mpr hab).mono Ioo_subset_Ico_self).tendsto },
  { rw [← hga, ← nhds_within_Ioo_eq_nhds_within_Ioi hab],
    exact ((hcg a $ left_mem_Ico.mpr hab).mono Ioo_subset_Ico_self).tendsto },
end

theorem lhopital_zero_left_on_Ioo
  (hdf : differentiable_on ℝ f (Ioo a b))
  (hg' : ∀ x ∈ (Ioo a b), (deriv g) x ≠ 0)
  (hfb : tendsto f (𝓝[<] b) (𝓝 0)) (hgb : tendsto g (𝓝[<] b) (𝓝 0))
  (hdiv : tendsto (λ x, ((deriv f) x) / ((deriv g) x)) (𝓝[<] b) l) :
  tendsto (λ x, (f x) / (g x)) (𝓝[<] b) l :=
begin
  have hdf : ∀ x ∈ Ioo a b, differentiable_at ℝ f x,
    from λ x hx, (hdf x hx).differentiable_at (Ioo_mem_nhds hx.1 hx.2),
  have hdg : ∀ x ∈ Ioo a b, differentiable_at ℝ g x,
    from λ x hx, classical.by_contradiction (λ h, hg' x hx (deriv_zero_of_not_differentiable_at h)),
  exact has_deriv_at.lhopital_zero_left_on_Ioo hab (λ x hx, (hdf x hx).has_deriv_at)
    (λ x hx, (hdg x hx).has_deriv_at) hg' hfb hgb hdiv
end

omit hab

theorem lhopital_zero_at_top_on_Ioi
  (hdf : differentiable_on ℝ f (Ioi a))
  (hg' : ∀ x ∈ (Ioi a), (deriv g) x ≠ 0)
  (hftop : tendsto f at_top (𝓝 0)) (hgtop : tendsto g at_top (𝓝 0))
  (hdiv : tendsto (λ x, ((deriv f) x) / ((deriv g) x)) at_top l) :
  tendsto (λ x, (f x) / (g x)) at_top l :=
begin
  have hdf : ∀ x ∈ Ioi a, differentiable_at ℝ f x,
    from λ x hx, (hdf x hx).differentiable_at (Ioi_mem_nhds hx),
  have hdg : ∀ x ∈ Ioi a, differentiable_at ℝ g x,
    from λ x hx, classical.by_contradiction (λ h, hg' x hx (deriv_zero_of_not_differentiable_at h)),
  exact has_deriv_at.lhopital_zero_at_top_on_Ioi (λ x hx, (hdf x hx).has_deriv_at)
    (λ x hx, (hdg x hx).has_deriv_at) hg' hftop hgtop hdiv,
end

theorem lhopital_zero_at_bot_on_Iio
  (hdf : differentiable_on ℝ f (Iio a))
  (hg' : ∀ x ∈ (Iio a), (deriv g) x ≠ 0)
  (hfbot : tendsto f at_bot (𝓝 0)) (hgbot : tendsto g at_bot (𝓝 0))
  (hdiv : tendsto (λ x, ((deriv f) x) / ((deriv g) x)) at_bot l) :
  tendsto (λ x, (f x) / (g x)) at_bot l :=
begin
  have hdf : ∀ x ∈ Iio a, differentiable_at ℝ f x,
    from λ x hx, (hdf x hx).differentiable_at (Iio_mem_nhds hx),
  have hdg : ∀ x ∈ Iio a, differentiable_at ℝ g x,
    from λ x hx, classical.by_contradiction (λ h, hg' x hx (deriv_zero_of_not_differentiable_at h)),
  exact has_deriv_at.lhopital_zero_at_bot_on_Iio (λ x hx, (hdf x hx).has_deriv_at)
    (λ x hx, (hdg x hx).has_deriv_at) hg' hfbot hgbot hdiv,
end

end deriv

/-!
## Generic versions

The following statements no longer any explicit interval, as they only require
conditions holding eventually.
-/

namespace has_deriv_at

/-- L'Hôpital's rule for approaching a real from the right, `has_deriv_at` version -/
theorem lhopital_zero_nhds_right
  (hff' : ∀ᶠ x in 𝓝[>] a, has_deriv_at f (f' x) x)
  (hgg' : ∀ᶠ x in 𝓝[>] a, has_deriv_at g (g' x) x)
  (hg' : ∀ᶠ x in 𝓝[>] a, g' x ≠ 0)
  (hfa : tendsto f (𝓝[>] a) (𝓝 0)) (hga : tendsto g (𝓝[>] a) (𝓝 0))
  (hdiv : tendsto (λ x, (f' x) / (g' x)) (𝓝[>] a) l) :
  tendsto (λ x, (f x) / (g x)) (𝓝[>] a) l :=
begin
  rw eventually_iff_exists_mem at *,
  rcases hff' with ⟨s₁, hs₁, hff'⟩,
  rcases hgg' with ⟨s₂, hs₂, hgg'⟩,
  rcases hg' with ⟨s₃, hs₃, hg'⟩,
  let s := s₁ ∩ s₂ ∩ s₃,
  have hs : s ∈ 𝓝[>] a := inter_mem (inter_mem hs₁ hs₂) hs₃,
  rw mem_nhds_within_Ioi_iff_exists_Ioo_subset at hs,
  rcases hs with ⟨u, hau, hu⟩,
  refine lhopital_zero_right_on_Ioo hau _ _ _ hfa hga hdiv;
  intros x hx;
  apply_assumption;
  exact (hu hx).1.1 <|> exact (hu hx).1.2 <|> exact (hu hx).2
end

/-- L'Hôpital's rule for approaching a real from the left, `has_deriv_at` version -/
theorem lhopital_zero_nhds_left
  (hff' : ∀ᶠ x in 𝓝[<] a, has_deriv_at f (f' x) x)
  (hgg' : ∀ᶠ x in 𝓝[<] a, has_deriv_at g (g' x) x)
  (hg' : ∀ᶠ x in 𝓝[<] a, g' x ≠ 0)
  (hfa : tendsto f (𝓝[<] a) (𝓝 0)) (hga : tendsto g (𝓝[<] a) (𝓝 0))
  (hdiv : tendsto (λ x, (f' x) / (g' x)) (𝓝[<] a) l) :
  tendsto (λ x, (f x) / (g x)) (𝓝[<] a) l :=
begin
  rw eventually_iff_exists_mem at *,
  rcases hff' with ⟨s₁, hs₁, hff'⟩,
  rcases hgg' with ⟨s₂, hs₂, hgg'⟩,
  rcases hg' with ⟨s₃, hs₃, hg'⟩,
  let s := s₁ ∩ s₂ ∩ s₃,
  have hs : s ∈ 𝓝[<] a := inter_mem (inter_mem hs₁ hs₂) hs₃,
  rw mem_nhds_within_Iio_iff_exists_Ioo_subset at hs,
  rcases hs with ⟨l, hal, hl⟩,
  refine lhopital_zero_left_on_Ioo hal _ _ _ hfa hga hdiv;
  intros x hx;
  apply_assumption;
  exact (hl hx).1.1 <|> exact (hl hx).1.2 <|> exact (hl hx).2
end

/-- L'Hôpital's rule for approaching a real, `has_deriv_at` version. This
  does not require anything about the situation at `a` -/
theorem lhopital_zero_nhds'
  (hff' : ∀ᶠ x in 𝓝[≠] a, has_deriv_at f (f' x) x)
  (hgg' : ∀ᶠ x in 𝓝[≠] a, has_deriv_at g (g' x) x)
  (hg' : ∀ᶠ x in 𝓝[≠] a, g' x ≠ 0)
  (hfa : tendsto f (𝓝[≠] a) (𝓝 0)) (hga : tendsto g (𝓝[≠] a) (𝓝 0))
  (hdiv : tendsto (λ x, (f' x) / (g' x)) (𝓝[≠] a) l) :
  tendsto (λ x, (f x) / (g x)) (𝓝[≠] a) l :=
begin
  simp only [←Iio_union_Ioi, nhds_within_union, tendsto_sup, eventually_sup] at *,
  exact ⟨lhopital_zero_nhds_left hff'.1 hgg'.1 hg'.1 hfa.1 hga.1 hdiv.1,
          lhopital_zero_nhds_right hff'.2 hgg'.2 hg'.2 hfa.2 hga.2 hdiv.2⟩
end

/-- **L'Hôpital's rule** for approaching a real, `has_deriv_at` version -/
theorem lhopital_zero_nhds
  (hff' : ∀ᶠ x in 𝓝 a, has_deriv_at f (f' x) x)
  (hgg' : ∀ᶠ x in 𝓝 a, has_deriv_at g (g' x) x)
  (hg' : ∀ᶠ x in 𝓝 a, g' x ≠ 0)
  (hfa : tendsto f (𝓝 a) (𝓝 0)) (hga : tendsto g (𝓝 a) (𝓝 0))
  (hdiv : tendsto (λ x, f' x / g' x) (𝓝 a) l) :
  tendsto (λ x, f x / g x) (𝓝[≠] a) l :=
begin
  apply @lhopital_zero_nhds' _ _ _ f' _ g';
  apply eventually_nhds_within_of_eventually_nhds <|> apply tendsto_nhds_within_of_tendsto_nhds;
  assumption
end

/-- L'Hôpital's rule for approaching +∞, `has_deriv_at` version -/
theorem lhopital_zero_at_top
  (hff' : ∀ᶠ x in at_top, has_deriv_at f (f' x) x)
  (hgg' : ∀ᶠ x in at_top, has_deriv_at g (g' x) x)
  (hg' : ∀ᶠ x in at_top, g' x ≠ 0)
  (hftop : tendsto f at_top (𝓝 0)) (hgtop : tendsto g at_top (𝓝 0))
  (hdiv : tendsto (λ x, (f' x) / (g' x)) at_top l) :
  tendsto (λ x, (f x) / (g x)) at_top l :=
begin
  rw eventually_iff_exists_mem at *,
  rcases hff' with ⟨s₁, hs₁, hff'⟩,
  rcases hgg' with ⟨s₂, hs₂, hgg'⟩,
  rcases hg' with ⟨s₃, hs₃, hg'⟩,
  let s := s₁ ∩ s₂ ∩ s₃,
  have hs : s ∈ at_top := inter_mem (inter_mem hs₁ hs₂) hs₃,
  rw mem_at_top_sets at hs,
  rcases hs with ⟨l, hl⟩,
  have hl' : Ioi l ⊆ s := λ x hx, hl x (le_of_lt hx),
  refine lhopital_zero_at_top_on_Ioi _ _ (λ x hx, hg' x $ (hl' hx).2) hftop hgtop hdiv;
  intros x hx;
  apply_assumption;
  exact (hl' hx).1.1 <|> exact (hl' hx).1.2
end

/-- L'Hôpital's rule for approaching -∞, `has_deriv_at` version -/
theorem lhopital_zero_at_bot
  (hff' : ∀ᶠ x in at_bot, has_deriv_at f (f' x) x)
  (hgg' : ∀ᶠ x in at_bot, has_deriv_at g (g' x) x)
  (hg' : ∀ᶠ x in at_bot, g' x ≠ 0)
  (hfbot : tendsto f at_bot (𝓝 0)) (hgbot : tendsto g at_bot (𝓝 0))
  (hdiv : tendsto (λ x, (f' x) / (g' x)) at_bot l) :
  tendsto (λ x, (f x) / (g x)) at_bot l :=
begin
  rw eventually_iff_exists_mem at *,
  rcases hff' with ⟨s₁, hs₁, hff'⟩,
  rcases hgg' with ⟨s₂, hs₂, hgg'⟩,
  rcases hg' with ⟨s₃, hs₃, hg'⟩,
  let s := s₁ ∩ s₂ ∩ s₃,
  have hs : s ∈ at_bot := inter_mem (inter_mem hs₁ hs₂) hs₃,
  rw mem_at_bot_sets at hs,
  rcases hs with ⟨l, hl⟩,
  have hl' : Iio l ⊆ s := λ x hx, hl x (le_of_lt hx),
  refine lhopital_zero_at_bot_on_Iio _ _ (λ x hx, hg' x $ (hl' hx).2) hfbot hgbot hdiv;
  intros x hx;
  apply_assumption;
  exact (hl' hx).1.1 <|> exact (hl' hx).1.2
end

end has_deriv_at

namespace deriv

/-- **L'Hôpital's rule** for approaching a real from the right, `deriv` version -/
theorem lhopital_zero_nhds_right
  (hdf : ∀ᶠ x in 𝓝[>] a, differentiable_at ℝ f x)
  (hg' : ∀ᶠ x in 𝓝[>] a, deriv g x ≠ 0)
  (hfa : tendsto f (𝓝[>] a) (𝓝 0)) (hga : tendsto g (𝓝[>] a) (𝓝 0))
  (hdiv : tendsto (λ x, ((deriv f) x) / ((deriv g) x)) (𝓝[>] a) l) :
  tendsto (λ x, (f x) / (g x)) (𝓝[>] a) l :=
begin
  have hdg : ∀ᶠ x in 𝓝[>] a, differentiable_at ℝ g x,
    from hg'.mp (eventually_of_forall $
      λ _ hg', classical.by_contradiction (λ h, hg' (deriv_zero_of_not_differentiable_at h))),
  have hdf' : ∀ᶠ x in 𝓝[>] a, has_deriv_at f (deriv f x) x,
    from hdf.mp (eventually_of_forall $ λ _, differentiable_at.has_deriv_at),
  have hdg' : ∀ᶠ x in 𝓝[>] a, has_deriv_at g (deriv g x) x,
    from hdg.mp (eventually_of_forall $ λ _, differentiable_at.has_deriv_at),
  exact has_deriv_at.lhopital_zero_nhds_right hdf' hdg' hg' hfa hga hdiv
end

/-- **L'Hôpital's rule** for approaching a real from the left, `deriv` version -/
theorem lhopital_zero_nhds_left
  (hdf : ∀ᶠ x in 𝓝[<] a, differentiable_at ℝ f x)
  (hg' : ∀ᶠ x in 𝓝[<] a, deriv g x ≠ 0)
  (hfa : tendsto f (𝓝[<] a) (𝓝 0)) (hga : tendsto g (𝓝[<] a) (𝓝 0))
  (hdiv : tendsto (λ x, ((deriv f) x) / ((deriv g) x)) (𝓝[<] a) l) :
  tendsto (λ x, (f x) / (g x)) (𝓝[<] a) l :=
begin
  have hdg : ∀ᶠ x in 𝓝[<] a, differentiable_at ℝ g x,
    from hg'.mp (eventually_of_forall $
      λ _ hg', classical.by_contradiction (λ h, hg' (deriv_zero_of_not_differentiable_at h))),
  have hdf' : ∀ᶠ x in 𝓝[<] a, has_deriv_at f (deriv f x) x,
    from hdf.mp (eventually_of_forall $ λ _, differentiable_at.has_deriv_at),
  have hdg' : ∀ᶠ x in 𝓝[<] a, has_deriv_at g (deriv g x) x,
    from hdg.mp (eventually_of_forall $ λ _, differentiable_at.has_deriv_at),
  exact has_deriv_at.lhopital_zero_nhds_left hdf' hdg' hg' hfa hga hdiv
end

/-- **L'Hôpital's rule** for approaching a real, `deriv` version. This
  does not require anything about the situation at `a` -/
theorem lhopital_zero_nhds'
  (hdf : ∀ᶠ x in 𝓝[≠] a, differentiable_at ℝ f x)
  (hg' : ∀ᶠ x in 𝓝[≠] a, deriv g x ≠ 0)
  (hfa : tendsto f (𝓝[≠] a) (𝓝 0)) (hga : tendsto g (𝓝[≠] a) (𝓝 0))
  (hdiv : tendsto (λ x, ((deriv f) x) / ((deriv g) x)) (𝓝[≠] a) l) :
  tendsto (λ x, (f x) / (g x)) (𝓝[≠] a) l :=
begin
  simp only [←Iio_union_Ioi, nhds_within_union, tendsto_sup, eventually_sup] at *,
  exact ⟨lhopital_zero_nhds_left hdf.1 hg'.1 hfa.1 hga.1 hdiv.1,
          lhopital_zero_nhds_right hdf.2 hg'.2 hfa.2 hga.2 hdiv.2⟩,
end

/-- **L'Hôpital's rule** for approaching a real, `deriv` version -/
theorem lhopital_zero_nhds
  (hdf : ∀ᶠ x in 𝓝 a, differentiable_at ℝ f x)
  (hg' : ∀ᶠ x in 𝓝 a, deriv g x ≠ 0)
  (hfa : tendsto f (𝓝 a) (𝓝 0)) (hga : tendsto g (𝓝 a) (𝓝 0))
  (hdiv : tendsto (λ x, ((deriv f) x) / ((deriv g) x)) (𝓝 a) l) :
  tendsto (λ x, (f x) / (g x)) (𝓝[≠] a) l :=
begin
  apply lhopital_zero_nhds';
  apply eventually_nhds_within_of_eventually_nhds <|> apply tendsto_nhds_within_of_tendsto_nhds;
  assumption
end

/-- **L'Hôpital's rule** for approaching +∞, `deriv` version -/
theorem lhopital_zero_at_top
  (hdf : ∀ᶠ (x : ℝ) in at_top, differentiable_at ℝ f x)
  (hg' : ∀ᶠ (x : ℝ) in at_top, deriv g x ≠ 0)
  (hftop : tendsto f at_top (𝓝 0)) (hgtop : tendsto g at_top (𝓝 0))
  (hdiv : tendsto (λ x, ((deriv f) x) / ((deriv g) x)) at_top l) :
  tendsto (λ x, (f x) / (g x)) at_top l :=
begin
  have hdg : ∀ᶠ x in at_top, differentiable_at ℝ g x,
    from hg'.mp (eventually_of_forall $
      λ _ hg', classical.by_contradiction (λ h, hg' (deriv_zero_of_not_differentiable_at h))),
  have hdf' : ∀ᶠ x in at_top, has_deriv_at f (deriv f x) x,
    from hdf.mp (eventually_of_forall $ λ _, differentiable_at.has_deriv_at),
  have hdg' : ∀ᶠ x in at_top, has_deriv_at g (deriv g x) x,
    from hdg.mp (eventually_of_forall $ λ _, differentiable_at.has_deriv_at),
  exact has_deriv_at.lhopital_zero_at_top hdf' hdg' hg' hftop hgtop hdiv
end

/-- **L'Hôpital's rule** for approaching -∞, `deriv` version -/
theorem lhopital_zero_at_bot
  (hdf : ∀ᶠ (x : ℝ) in at_bot, differentiable_at ℝ f x)
  (hg' : ∀ᶠ (x : ℝ) in at_bot, deriv g x ≠ 0)
  (hfbot : tendsto f at_bot (𝓝 0)) (hgbot : tendsto g at_bot (𝓝 0))
  (hdiv : tendsto (λ x, ((deriv f) x) / ((deriv g) x)) at_bot l) :
  tendsto (λ x, (f x) / (g x)) at_bot l :=
begin
  have hdg : ∀ᶠ x in at_bot, differentiable_at ℝ g x,
    from hg'.mp (eventually_of_forall $
      λ _ hg', classical.by_contradiction (λ h, hg' (deriv_zero_of_not_differentiable_at h))),
  have hdf' : ∀ᶠ x in at_bot, has_deriv_at f (deriv f x) x,
    from hdf.mp (eventually_of_forall $ λ _, differentiable_at.has_deriv_at),
  have hdg' : ∀ᶠ x in at_bot, has_deriv_at g (deriv g x) x,
    from hdg.mp (eventually_of_forall $ λ _, differentiable_at.has_deriv_at),
  exact has_deriv_at.lhopital_zero_at_bot hdf' hdg' hg' hfbot hgbot hdiv
end

end deriv


-- Introducción del condicional en Lean
-- ====================================

-- ----------------------------------------------------
-- Ej. 1. (p. 9) Demostrar que
--    P → P
-- ----------------------------------------------------

import tactic
variable (P : Prop)

-- 1ª demostración
example : P → P :=
assume h : P,
show P, from h

-- 2ª demostración
example : P → P :=
assume : P,
show P, from this

-- 3ª demostración
example : P → P :=
assume : P,
show P, from ‹P›

-- 4ª demostración
example : P → P :=
assume h : P, h

-- 5ª demostración
example : P → P :=
λ h, h

-- 6ª demostración
example : P → P :=
-- by library_search
id

-- 7ª demostración
example : P → P :=
begin
  intro h,
  exact h,
end

-- 8ª demostración
example : P → P :=
begin
  intro,
  exact ‹P›,
end

-- 9ª demostración
example : P → P :=
begin
  intro h,
  assumption,
end

-- 10ª demostración
example : P → P :=
begin
  intro,
  assumption,
end

-- 11ª demostración
example : P → P :=
-- by hint
by tauto

-- 12ª demostración
example : P → P :=
by finish

-- 13ª demostración
example : P → P :=
by simp


/-
Copyright 2021 Google LLC

Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at

      http://www.apache.org/licenses/LICENSE-2.0

Unless required by applicable law or agreed to in writing, software
distributed under the License is distributed on an "AS IS" BASIS,
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
See the License for the specific language governing permissions and
limitations under the License.
 -/
import measure_theory.measurable_space

import measure_theory.measure_space
import measure_theory.outer_measure
import measure_theory.lebesgue_measure
import measure_theory.integration

import measure_theory.borel_space
import data.set.countable
import formal_ml.nnreal
import formal_ml.sum
import formal_ml.lattice
import formal_ml.measurable_space
import formal_ml.classical
import data.equiv.list
import formal_ml.prod_measure
import formal_ml.finite_pi_measure
import formal_ml.probability_space
import formal_ml.monotone_class
import formal_ml.independent_events

/-!
  This file focuses on more esoteric proofs that random variables are identical.
  In particular, given two random variables X Y with a common measurable space as a codomain,
  where the codomain is generated by some set of measurable sets S.
  X and Y are identical if they are identical on measurable sets in S, assuming S
  has some particular properties. The first is that S is an algebra, i.e. S has the
  universal set and is closed under set difference.

  An alternative is that S is (basically) a semi-algebra, i.e. it has the empty set
  and is closed under intersection, and semi-closed under complement. Normally, a
  semi-algebra would require the universal set, but that is not required for this
  purpose.

  This is most useful for proving independent and identical random variables, when
  considered as an aggregate random variable, are identical.

  The core is the monotone class theorem, measurable_space.generate_from_monotone_class,
  defined in formal_ml.monotone_class.
-/

lemma independent_event_pair_forall
  {Ω:Type*} {P:probability_space Ω} {A:event P} {f : ℕ → event P}:
                           (∀ (i:ℕ), (f i.succ).val ⊆ (f i).val) →
   (∀ (i:ℕ), independent_event_pair A (f i)) →
   (independent_event_pair A (∀ᵣ i, f i)) := begin
  intros h1 h2,
  unfold independent_event_pair,
  rw Pr_forall_eq_infi h1,
  have h3:(A∧∀ᵣ (i : ℕ), f i) = (∀ᵣ (i : ℕ), A ∧ f i),
  { apply event.eq, simp, ext ω, split; intros h3_1; simp at h3_1; simp [h3_1],
    apply (h3_1 0).left },
  rw h3,
  rw Pr_forall_eq_infi,
  rw nnreal.mul_infi,
  unfold independent_event_pair at h2,
  have h4:(λ i, Pr[A ∧ (f i)]) = (λ i, Pr[A] * Pr[f i]),
  { ext i, rw h2 i },
  rw h4,
  intros i,
  simp,
  apply set.subset.trans,
  apply set.inter_subset_right,
  apply h1,
end

lemma independent_event_pair_exists_monotone
  {Ω:Type*} {P:probability_space Ω} {A:event P} {f : ℕ → event P}:
                           monotone (λ (i:ℕ), (f i).val) →
   (∀ (i:ℕ), independent_event_pair A (f i)) →
   (independent_event_pair A (∃ᵣ i, f i)) := begin
  intros h1 h2,
  unfold independent_event_pair,
  rw Pr_exists_eq_supr h1,
  have h3:(A∧∃ᵣ (i : ℕ), f i) = (∃ᵣ (i : ℕ), A ∧ f i),
  { apply event.eq, simp, ext ω, split; intros h3_1,
    { simp at h3_1, simp [h3_1] },
    { simp at h3_1, simp [h3_1] }, },
  rw h3,
  rw Pr_exists_eq_supr,
  rw nnreal.mul_supr,
  unfold independent_event_pair at h2,
  have h4:(λ i, Pr[A ∧ (f i)]) = (λ i, Pr[A] * Pr[f i]),
  { ext i, rw h2 i },
  rw h4,
  { simp [bdd_above], rw set.nonempty_def,
    apply exists.intro (1:nnreal),
    rw mem_upper_bounds,
    intros x h_mem,
    simp at h_mem,
    cases h_mem with i h_mem,
    subst x,
    apply Pr_le_one },
  { intros i j h_le, simp,
    apply set.subset.trans,
    apply set.inter_subset_right,
    apply h1, apply h_le },
end

lemma random_variable_independent_pair_on_algebra {Ω α₁ α₂:Type*} (s₁: set (set α₁)) (s₂:set (set α₂))
  (A₁:s₁.is_algebra) (A₂:s₂.is_algebra)
  {P:probability_space Ω}
  {X₁:P →ᵣ (measurable_space.generate_from s₁)}
  {X₂:P →ᵣ (measurable_space.generate_from s₂)}:
  (∀ (T₁:measurable_setB (measurable_space.generate_from s₁))
     (T₂:measurable_setB (measurable_space.generate_from s₂)),
     T₁.val ∈ s₁ → T₂.val ∈ s₂
     → independent_event_pair (X₁ ∈ᵣ T₁) (X₂ ∈ᵣ T₂)) →
  random_variable_independent_pair X₁ X₂ := begin
  intros h1 U₁,
  cases U₁,
  have AM₁ := A₁.monotone_class,
  have AM₂ := A₂.monotone_class,

  have h_meas₁:∀ {T':set α₁}, s₁.monotone_class T' →
          (measurable_space.generate_from s₁).measurable_set' T',
  { intros T' h_1,
    rw measurable_space.generate_from_monotone_class at h_1,
    simp [measurable_space.generate_from],
    apply h_1, apply A₁ },
  have h_meas₂:∀ {T':set α₂}, s₂.monotone_class T' →
          (measurable_space.generate_from s₂).measurable_set' T',
  { intros T' h_1,
    rw measurable_space.generate_from_monotone_class at h_1,
    simp [measurable_space.generate_from],
    apply h_1, apply A₂ },
  have h_mono_1:s₁.monotone_class U₁_val,
  { rw measurable_space.generate_from_monotone_class,
    simp [measurable_space.generate_from] at U₁_property,
    apply U₁_property, apply A₁ },
  induction h_mono_1 with U₁' h_U₁' f₁ h_rec₁ h_mono₁ h_ind₁ f₁ h_rec₁ h_mono₁ h_ind₁,
  -- The base case for U₁, solved by induction on U₂.
  intros U₂, cases U₂,
  have h_mono_2:s₂.monotone_class U₂_val,
  { rw measurable_space.generate_from_monotone_class,
    simp [measurable_space.generate_from] at U₂_property,
    apply U₂_property, apply A₂ },
  induction h_mono_2 with U₂' h_U₂' f₂ h_rec₂ h_mono₂ h_ind₂ f₂ h_rec₂ h_mono₂ h_ind₂,
  -- The base base case.
  { apply h1, apply h_U₁', apply h_U₂' },
  { have h_Inter:(X₂ ∈ᵣ ⟨set.Inter f₂, U₂_property⟩)
                 = (∀ᵣ i, (X₂ ∈ᵣ ⟨f₂ i, h_meas₂ (h_rec₂ i)⟩)),
    { apply event.eq, ext1 ω, split; intros h_Inter; simp at h_Inter;
      simp [h_Inter] },
    rw h_Inter,
    apply independent_event_pair_forall,
    { intros i, have h_mono_i := h_mono₂ i,
      simp, intros ω, apply h_mono_i },
    { intros i, have h_ind_i := h_ind₂ i,
      apply h_ind_i } },
  { have h_Union: (X₂ ∈ᵣ ⟨set.Union f₂, U₂_property⟩)
                  = (∃ᵣ i, (X₂ ∈ᵣ ⟨f₂ i, h_meas₂ (h_rec₂ i)⟩)),
    { apply event.eq, ext1 ω, split; intros h_Union_1; simp at h_Union_1;
      simp [h_Union_1] },
    rw h_Union,
    apply independent_event_pair_exists_monotone,
    { intros i j h_le, have h_mono_i := h_mono₂ h_le,
      simp, intros ω, apply h_mono_i },
    { intros i, have h_ind_i := h_ind₂ i,
      apply h_ind_i } },
  -- The base case of T₁ is resolved. Now we continue...
  { intros T₁, apply independent_event_pair.symm,
    have h_Inter:(X₁ ∈ᵣ ⟨set.Inter f₁, U₁_property⟩)
                 = (∀ᵣ i, (X₁ ∈ᵣ ⟨f₁ i, h_meas₁ (h_rec₁ i)⟩)),
    { apply event.eq, ext1 ω, split; intros h_Inter; simp at h_Inter;
      simp [h_Inter] },
    rw h_Inter,
    apply independent_event_pair_forall,
    { intros i, have h_mono_i := h_mono₁ i,
      simp, intros ω, apply h_mono_i },
    { intros i, apply independent_event_pair.symm,
      have h_ind_i := h_ind₁ i,
      apply h_ind_i } },
  { intros T₁, apply independent_event_pair.symm,
    have h_Union: (X₁ ∈ᵣ ⟨set.Union f₁, U₁_property⟩)
                  = (∃ᵣ i, (X₁ ∈ᵣ ⟨f₁ i, h_meas₁ (h_rec₁ i)⟩)),
    { apply event.eq, ext1 ω, split; intros h_Union_1; simp at h_Union_1;
      simp [h_Union_1] },
    rw h_Union,
    apply independent_event_pair_exists_monotone,
    { intros i j h_le, have h_mono_i := h_mono₁ h_le,
      simp, intros ω, apply h_mono_i },
    { intros i, apply independent_event_pair.symm,
      have h_ind_i := h_ind₁ i,
      apply h_ind_i } },
end

/- This allows for the measurable space to be generated from a different
   set. -/
lemma random_variable_independent_pair_on_algebra' {Ω α₁ α₂:Type*} (s₁: set (set α₁)) (s₂:set (set α₂))
  (A₁:s₁.is_algebra) (A₂:s₂.is_algebra)
  (M₁:measurable_space α₁)
  (M₂:measurable_space α₂)
  {P:probability_space Ω}
  {X₁:P →ᵣ M₁}
  {X₂:P →ᵣ M₂}:
  (M₁ = measurable_space.generate_from s₁) →
  (M₂ = measurable_space.generate_from s₂) →
  (∀ (T₁:measurable_setB M₁)
     (T₂:measurable_setB M₂),
     T₁.val ∈ s₁ → T₂.val ∈ s₂
     → independent_event_pair (X₁ ∈ᵣ T₁) (X₂ ∈ᵣ T₂)) →
  random_variable_independent_pair X₁ X₂ := begin
  intros h1 h2 h3 T₁ T₂,
  tactic.unfreeze_local_instances,
  subst M₁,
  subst M₂,
  apply random_variable_independent_pair_on_algebra,
  apply A₁,
  apply A₂,
  apply h3,
end

lemma measurable_space.generate_from_disjoint_union_closure {α:Type*}
  {s:set (set α)}:
  measurable_space.generate_from s = measurable_space.generate_from s.disjoint_union_closure :=
begin
  apply le_antisymm,
  { apply measurable_space.generate_from_le,
    intros t h_t, simp [measurable_space.generate_from],
    apply measurable_space.generate_measurable.basic,
    apply set.disjoint_union_closure_self,
    apply h_t },
  { apply measurable_space.generate_from_le,
    intros t h_t, rw set.mem_disjoint_union_closure_iff at h_t,
    cases h_t with m h_t,
    cases h_t with f h_t,
    cases h_t with h_in_s h_t,
    cases h_t with h_pairwise h_f_def,
    subst t,
    haveI E:encodable (fin m) := fintype.encodable (fin m),
    apply measurable_set.Union, intros b,
    apply measurable_space.measurable_set_generate_from, apply h_in_s },
end

lemma random_variable_independent_pair_on_semialgebra {Ω α₁ α₂:Type*} (s₁: set (set α₁))
  (s₂:set (set α₂))
  (A₁:s₁.is_semialgebra) (A₂:s₂.is_semialgebra)
  {P:probability_space Ω}
  {X₁:P →ᵣ (measurable_space.generate_from s₁)}
  {X₂:P →ᵣ (measurable_space.generate_from s₂)}:
  (∀ (T₁:measurable_setB (measurable_space.generate_from s₁))
     (T₂:measurable_setB (measurable_space.generate_from s₂)),
     T₁.val ∈ s₁ → T₂.val ∈ s₂
     → independent_event_pair (X₁ ∈ᵣ T₁) (X₂ ∈ᵣ T₂)) →
  random_variable_independent_pair X₁ X₂ := begin
  intros h1,
  have CA₁ := A₁.disjoint_union_closure,
  have CA₂ := A₂.disjoint_union_closure,
  apply random_variable_independent_pair_on_algebra' (s₁.disjoint_union_closure)
    (s₂.disjoint_union_closure) (A₁.disjoint_union_closure) (A₂.disjoint_union_closure),
  apply measurable_space.generate_from_disjoint_union_closure,
  apply measurable_space.generate_from_disjoint_union_closure,
  intros T₁ T₂ h_T₁ h_T₂,
  rw set.mem_disjoint_union_closure_iff at h_T₁,
  cases h_T₁ with m₁ h_T₁,
  cases h_T₁ with f₁ h_T₁,
  cases h_T₁ with h_f₁_in_s h_T₁,
  cases h_T₁ with h_pairwise₁ h_def₁,
  rw set.mem_disjoint_union_closure_iff at h_T₂,
  cases h_T₂ with m₂ h_T₂,
  cases h_T₂ with f₂ h_T₂,
  cases h_T₂ with h_f₂_in_s h_T₂,
  cases h_T₂ with h_pairwise₂ h_def₂,
  cases T₁,
  cases T₂,
  simp at h_def₁,
  simp at h_def₂,
  subst T₁_val,
  subst T₂_val,
  have h_meas₁:∀ (i:fin m₁), (measurable_space.generate_from s₁).measurable_set' (f₁ i),
  { intros i, apply measurable_space.measurable_set_generate_from, apply h_f₁_in_s },
  have h_meas₂:∀ (i:fin m₂), (measurable_space.generate_from s₂).measurable_set' (f₂ i),
  { intros i, apply measurable_space.measurable_set_generate_from, apply h_f₂_in_s },
  have h_union1: (X₁ ∈ᵣ ⟨set.Union f₁, T₁_property⟩) = (∃ᵣ i, X₁ ∈ᵣ ⟨f₁ i, h_meas₁ i⟩),
  { apply event.eq, ext ω, split; intros h_union1_1; simp at h_union1_1; simp [h_union1_1] },
  have h_union2: (X₂ ∈ᵣ ⟨set.Union f₂, T₂_property⟩) = (∃ᵣ i, X₂ ∈ᵣ ⟨f₂ i, h_meas₂ i⟩),
  { apply event.eq, ext ω, split; intros h_union2_1; simp at h_union2_1; simp [h_union2_1] },
  rw h_union1,
  rw h_union2,
  classical,
  apply independent_event_pair_exists,
  intros i h_i,
  apply independent_event_pair.symm,
  apply independent_event_pair_exists,
  intros j h_j,
  apply independent_event_pair.symm,
  apply h1,
  { simp, apply h_f₁_in_s },
  { simp, apply h_f₂_in_s },
  { intros i h_i_in_univ j h_j_in_univ h_ne, simp [function.on_fun],
    have h_pairwise_ij := h_pairwise₁ i j h_ne,
    simp [function.on_fun] at h_pairwise_ij, rw disjoint_iff, rw disjoint_iff at h_pairwise_ij,
    simp at h_pairwise_ij, simp [h_pairwise_ij], rw ← set.subset_empty_iff, rw set.subset_def,
    intros ω h_ω, simp at h_ω, rw ← set.subset_empty_iff at h_pairwise_ij, rw set.subset_def
    at h_pairwise_ij, have h_X := h_pairwise_ij (X₁.val ω), simp at h_X, exfalso, apply h_X,
    simp [h_ω], simp [h_ω] },
  { intros i h_i_univ j h_j_univ h_ne, simp [function.on_fun],
    have h_pairwise_ij := h_pairwise₂ i j h_ne,
    simp [function.on_fun] at h_pairwise_ij, rw disjoint_iff, rw disjoint_iff at h_pairwise_ij,
    simp at h_pairwise_ij, simp [h_pairwise_ij], rw ← set.subset_empty_iff, rw set.subset_def,
    intros ω h_ω, simp at h_ω, rw ← set.subset_empty_iff at h_pairwise_ij, rw set.subset_def
    at h_pairwise_ij, have h_X := h_pairwise_ij (X₂.val ω), simp at h_X, exfalso, apply h_X,
    simp [h_ω], simp [h_ω] },
end

lemma random_variable_independent_pair_on_semialgebra' {Ω α₁ α₂:Type*} (s₁: set (set α₁))
  (s₂:set (set α₂))
  (A₁:s₁.is_semialgebra) (A₂:s₂.is_semialgebra)
  (M₁:measurable_space α₁)
  (M₂:measurable_space α₂)
  {P:probability_space Ω}
  {X₁:P →ᵣ M₁}
  {X₂:P →ᵣ M₂}:
  (M₁ = measurable_space.generate_from s₁) →
  (M₂ = measurable_space.generate_from s₂) →
  (∀ (T₁:measurable_setB M₁)
     (T₂:measurable_setB M₂),
     T₁.val ∈ s₁ → T₂.val ∈ s₂
     → independent_event_pair (X₁ ∈ᵣ T₁) (X₂ ∈ᵣ T₂)) →
  random_variable_independent_pair X₁ X₂ := begin
  intros h1 h2 h3 T₁ T₂,
  tactic.unfreeze_local_instances,
  subst M₁,
  subst M₂,
  apply random_variable_independent_pair_on_semialgebra,
  apply A₁,
  apply A₂,
  apply h3,
end


/-
Copyright (c) 2018 Simon Hudon. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Simon Hudon, Patrick Massot, Eric Wieser
-/
import group_theory.group_action.defs
import algebra.group.prod

/-!
# Prod instances for additive and multiplicative actions

This file defines instances for binary product of additive and multiplicative actions
-/

variables {M N α β : Type*}

namespace prod

section

variables [has_scalar M α] [has_scalar M β] [has_scalar N α] [has_scalar N β] (a : M) (x : α × β)

@[to_additive prod.has_vadd] instance : has_scalar M (α × β) := ⟨λa p, (a • p.1, a • p.2)⟩

@[simp, to_additive] theorem smul_fst : (a • x).1 = a • x.1 := rfl
@[simp, to_additive] theorem smul_snd : (a • x).2 = a • x.2 := rfl
@[simp, to_additive] theorem smul_mk (a : M) (b : α) (c : β) : a • (b, c) = (a • b, a • c) := rfl

instance [has_scalar M N] [is_scalar_tower M N α] [is_scalar_tower M N β] :
  is_scalar_tower M N (α × β) :=
⟨λ x y z, mk.inj_iff.mpr ⟨smul_assoc _ _ _, smul_assoc _ _ _⟩⟩

@[to_additive] instance [smul_comm_class M N α] [smul_comm_class M N β] :
  smul_comm_class M N (α × β) :=
{ smul_comm := λ r s x, mk.inj_iff.mpr ⟨smul_comm _ _ _, smul_comm _ _ _⟩ }

end

@[to_additive] instance {m : monoid M} [mul_action M α] [mul_action M β] : mul_action M (α × β) :=
{ mul_smul  := λ a₁ a₂ p, mk.inj_iff.mpr ⟨mul_smul _ _ _, mul_smul _ _ _⟩,
  one_smul  := λ ⟨b, c⟩, mk.inj_iff.mpr ⟨one_smul _ _, one_smul _ _⟩ }

instance {R M N : Type*} {r : monoid R} [add_monoid M] [add_monoid N]
  [distrib_mul_action R M] [distrib_mul_action R N] : distrib_mul_action R (M × N) :=
{ smul_add  := λ a p₁ p₂, mk.inj_iff.mpr ⟨smul_add _ _ _, smul_add _ _ _⟩,
  smul_zero := λ a, mk.inj_iff.mpr ⟨smul_zero _, smul_zero _⟩ }

end prod


theorem zero_lt_of_lt : {a b : Nat} → a < b → 0 < b
| 0,   _, h => h
| a+1, b, h =>
  have : a < b := Nat.lt_trans (Nat.lt_succ_self _) h
  zero_lt_of_lt this

def fold {m α β} [Monad m] (as : Array α) (b : β) (f : α → β → m β) : m β := do
let rec loop : (i : Nat) → i ≤ as.size → β → m β
  | 0,   h, b => pure b
  | i+1, h, b => do
    have h' : i < as.size          := Nat.lt_of_lt_of_le (Nat.lt_succ_self i) h
    have : as.size - 1 < as.size     := Nat.sub_lt (zero_lt_of_lt h') (by decide)
    have : as.size - 1 - i < as.size := Nat.lt_of_le_of_lt (Nat.sub_le (as.size - 1) i) this
    let b ← f (as.get ⟨as.size - 1 - i, this⟩) b
    loop i (Nat.le_of_lt h') b
loop as.size (Nat.le_refl _) b

#eval Id.run $ fold #[1, 2, 3, 4] 0 (pure $ · + ·)

theorem ex : (Id.run $ fold #[1, 2, 3, 4] 0 (pure $ · + ·)) = 10 :=
rfl

def fold2 {m α β} [Monad m] (as : Array α) (b : β) (f : α → β → m β) : m β :=
let rec loop (i : Nat) (h : i ≤ as.size) (b : β) : m β := do
  match i, h with
  | 0,   h => return b
  | i+1, h =>
    have h' : i < as.size          := Nat.lt_of_lt_of_le (Nat.lt_succ_self i) h
    have : as.size - 1 < as.size     := Nat.sub_lt (zero_lt_of_lt h') (by decide)
    have : as.size - 1 - i < as.size := Nat.lt_of_le_of_lt (Nat.sub_le (as.size - 1) i) this
    let b ← f (as.get ⟨as.size - 1 - i, this⟩) b
    loop i (Nat.le_of_lt h') b
loop as.size (Nat.le_refl _) b

def f (x : Nat) (ref : IO.Ref Nat) : IO Nat := do
let mut x := x
if x == 0 then
  x ← ref.get
IO.println x
return x + 1

def fTest : IO Unit := do
unless (← f 0 (← IO.mkRef 10)) == 11 do throw $ IO.userError "unexpected"
unless (← f 1 (← IO.mkRef 10)) == 2 do throw $ IO.userError "unexpected"

def g (x y : Nat) (ref : IO.Ref (Nat × Nat)) : IO (Nat × Nat) := do
  let mut (x, y) := (x, y)
  if x == 0 then
    (x, y) ← ref.get
  IO.println ("x: " ++ toString x ++ ", y: " ++ toString y)
  return (x, y)

def gTest : IO Unit := do
unless (← g 2 1 (← IO.mkRef (10, 20))) == (2, 1)   do throw $ IO.userError "unexpected"
unless (← g 0 1 (← IO.mkRef (10, 20))) == (10, 20) do throw $ IO.userError "unexpected"
return ()

#eval gTest

macro "ret!" x:term : doElem => `(doElem| return $x)

def f1 (x : Nat) : Nat := Id.run <| do
  let mut x := x
  if x == 0 then
    ret! 100
  x := x + 1
  ret! x

theorem ex1 : f1 0 = 100 := rfl
theorem ex2 : f1 1 = 2 := rfl
theorem ex3 : f1 3 = 4 := rfl

syntax "inc!" ident : doElem

macro_rules
| `(doElem| inc! $x) => `(doElem| $x:ident := $x + 1)

def f2 (x : Nat) : Nat := Id.run <| do
  let mut x := x
  inc! x
  ret! x

theorem ex4 : f2 0 = 1 := rfl
theorem ex5 : f2 3 = 4 := rfl


/-
Copyright (c) 2018 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Keeley Hoek, Scott Morrison
-/

import tactic.rewrite_search.explain
import tactic.rewrite_search.discovery
import tactic.rewrite_search.search

/-!
# `rewrite_search`: solving goals by searching for a series of rewrites.

`rewrite_search` is a tactic for solving equalities or iff statements by searching for a
sequence of rewrite tactic applications.

## Algorithm sketch

The fundamental data structure behind the search algorithm is a graph of expressions. Each
vertex represents one expression, and an edge in the graph represents a way to rewrite one
expression into another with a single application of a rewrite tactic. Thus, a path in the
graph represents a way to rewrite one expression into another with multiple applications of
a rewrite tactic.

The graph starts out with two vertices, one for the left hand side of the equality, and one
for the right hand side of the equality. The basic loop of the algorithm is to repeatedly add
edges to the graph by taking vertices in the graph and applying a possible rewrite to them.
Through this process, the graph is made up of two connected components; one component contains
expressions that are equivalent to the left hand side, and one component contains expressions
that are equivalent to the right hand side. The algorithm completes when we discover an
edge that connects the two components, creating a path of rewrites that connects the
left hand side and right hand side of the graph. For more detail, see Keeley's report at
https://hoek.io/res/2018.s2.lean.report.pdf, although note that the edit distance mechanism
described is currently not implemented, only plain breadth-first search.

This algorithm is generally superior to one that only expands nodes starting from a single
side, because it is replacing one tree of depth `2d` with two trees of depth `d`. This is
a quadratic speedup for regular trees; our trees aren't regular but it's still probably
a much better algorithm. We can only use this specific algorithm for rewrite-type tactics,
though, not general sequences of tactics, because it relies on the fact that any rewrite
can be reversed.

## File structure

* `discovery.lean` contains the logic for figuring out which rewrite rules to consider.
* `search.lean` contains the graph algorithms to find a successful sequence of tactics.
* `explain.lean` generates concise Lean code to run a tactic, from the autogenerated sequence
  of tactics.
* `frontend.lean` contains the user-facing interface to the `rewrite_search` tactics.
* `types.lean` contains data structures shared across multiple of these components.
-/

namespace tactic.interactive

open lean.parser interactive interactive.types tactic.rewrite_search

/--
Parse a specification for a single rewrite rule.
The name of a lemma indicates using it as a rewrite. Prepending a "←" reverses the direction.
-/
private meta def rws_parser : lean.parser (pexpr × bool) :=
do flipped ← optional $ tk "←",
   pexp ← lean.parser.pexpr 0,
   return (pexp, flipped.is_some)

/--
Search for a chain of rewrites to prove an equation or iff statement.

Collects rewrite rules, runs a graph search to find a chain of rewrites to prove the
current target, and generates a string explanation for it.

Takes an optional list of rewrite rules specified in the same way as the `rw` tactic accepts.
-/
meta def rewrite_search (explain : parse $ optional (tk "?"))
  (rs : parse $ optional (list_of rws_parser)) (cfg : config := {}) : tactic unit :=
do t ← tactic.target,
  if t.has_meta_var then
    tactic.fail "rewrite_search is not suitable for goals containing metavariables"
  else tactic.skip,
  implicit_rules ← collect_rules,
  explicit_rules ← (rs.get_or_else []).mmap (λ ⟨pe, dir⟩, do e ← to_expr' pe, return (e, dir)),
  let rules := implicit_rules ++ explicit_rules,
  g ← mk_graph cfg rules t,
  (_, proof, steps) ← g.find_proof,
  tactic.exact proof,
  if explain.is_some then explain_search_result cfg rules proof steps else skip

add_tactic_doc
{ name        := "rewrite_search",
  category    := doc_category.tactic,
  decl_names  := [`tactic.interactive.rewrite_search],
  tags        := ["rewrite", "automation"] }

end tactic.interactive