/-
Copyright (c) 2022 Matthias Uschold. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Matthias Uschold.
-/

import tactic
import algebra.group.basic
import topology.basic
import topology.algebra.polynomial
import topology.separation
import data.real.basic
import data.finset.basic
import .def_amenable

import topology.continuous_function.bounded

import algebra.big_operators.basic
import algebra.big_operators.order

import .nonprincipal_ultrafilter
import .aux_lemmas_sums
import .aux_lemmas_bounded

/-!

# Amenability via Følner sets

We define Følner amenability (i.e. amenability via the existence of
a Folner set). Because of restrictions with finset, this requires
decidable equality on the group (at least for the moment).

This characterisation is useful, in particular because it allows to explicitely
exhibit that some groups are amenable (e.g. ℤ, which is done in `Folner_example.lean`).

## Main Definitions

- `Folner_sequence`             : Structure of a Folner sequence
- `Folner_amenable`             : Folner amenability (i.e. there exists a Folner sequence)
- `inv_mean_of_Folner_seq`      : Construction of an invariant mean out of a Folner sequence

## Main Statements

- `amenable_of_Folner_sequence` : If a group admits a Folner-sequence, it is amenable
- `amenable_of_Folner_amenable` : Folner amenability implies amenability

## References
* [C. Löh, *Geometric Group Theory*, Section 9.2.1, Theorem 9.2.6][loeh17]

## Tags

Folner sequence, Følner sequence, Folner amenable,
Følner amenable

-/
open classical
open real
open finset

variables
{G: Type*}
[group G]

/--left-translating a finite set of elements-/
def left_translate_set
  (g : G)
  (A : finset G)
  : finset G
:= finset.map (function.embedding.mk (λ x, g*x) (mul_right_injective g)) A

open_locale big_operators -- to enable ∑ notation

variable  [decidable_eq G]

/--summing over left-translates can be expressed via the left-translation
of the function -/
lemma left_translate_summation
  (g:G)
  (A : finset G)
  (f : bounded_continuous_function G ℝ)
  : ∑ x in left_translate_set g⁻¹ A,  f x = ∑ x in A, (left_translate g f) x
:= begin
  dsimp [left_translate_set],
  simp,
end

def translate_symm_diff
  (g: G)
  (A : finset G)
  : finset G
:= symm_diff A (left_translate_set g A)

/--The sequence appearing in the Folner condition -/
noncomputable def Folner_quotients
  (g: G)
  (sets: ℕ → finset G)
  : ℕ → ℝ
:= (λ n:ℕ, ((translate_symm_diff g (sets n)).card : ℝ)
                / (sets n).card)

/--Structure for a Folner sequence,
  most important: The Folner condition -/
structure Folner_sequence
  (G: Type*)
  [group G]
  [decidable_eq G]
:= mk ::
  (sets: ℕ → finset G)
  (sets_nonempty: ∀ n, sets n ≠ ∅)
  (Folner_cond : ∀ g : G,
        filter.tendsto (Folner_quotients g sets)  filter.at_top (nhds 0))

/--often, we speak of the sets when talking about the Folner seq-/
instance : has_coe (Folner_sequence G) (ℕ → finset G)
      := {coe := Folner_sequence.sets}

/--A group is called Folner amenable if there exists a Folner sequence-/
def Folner_amenable
  (G: Type*)
  [group G]
  [decidable_eq G]
  : Prop
:= nonempty (Folner_sequence G)

/- have to get rid of decidable
equality-/

lemma nonzero_card_of_Folner_sequence
  (F : Folner_sequence G)
  : ∀{n:ℕ}, ((F.sets n).card :ℝ) ≠ 0
:= begin
  assume n,
  simp,
  exact F.sets_nonempty n,
end

/--If a group is Folner amenable, we can pick a Folner sequence-/
noncomputable def Folner_sequence_of_Folner_amenable
  (h : Folner_amenable G)
  : Folner_sequence G
:= classical.some (classical.exists_true_of_nonempty h)

namespace Folner_amenable_to_amenable

/-!

  ### Folner amenability implies amenability

  We have to construct a left invariant mean from a Folner sequence.
  The main idea is to average over the Folner sets, then take the
  limit with respect to a nonprincipal ultrafilter (which always exists
  if the sequence is bounded). The left-invariance will then follow from
  the Folner condition
-/

open bounded_continuous_function
open_locale big_operators -- to enable ∑ notation

/--The sequence of averages-/
@[simp]
noncomputable def avg_seq
  (sets: ℕ → finset G)
  (f : bounded_continuous_function G ℝ)
  : ℕ → ℝ
:= (λ n, (1:ℝ)/(sets n).card *  ∑ x in sets n, f x)

lemma nonneg_one_over_card
  {A : Type*}
  {S : finset A}
  : (1:ℝ) / S.card ≥ 0
:= begin
  apply div_nonneg,
  by simp,
  simp,
end

@[simp]
lemma abs_one_over_card
  {A : Type*}
  {S : finset A}
  : |(1:ℝ) / S.card | = (1:ℝ) / S.card
:= abs_of_nonneg nonneg_one_over_card

lemma avg_seq_add
  {sets: ℕ → finset G}
  {f g : bounded_continuous_function G ℝ}
  : avg_seq sets (f+g) = avg_seq sets f + avg_seq sets g
:= begin
  ext n,
  calc  avg_seq sets (f + g) n
      = (1:ℝ)/(sets n).card *  ∑ x in sets n, (f+g) x
        : by simp
  ... = (1:ℝ)/(sets n).card *  ∑ x in sets n, (f x + g x)
        : by tauto
  ... = (1:ℝ)/(sets n).card *  (∑ x in sets n, f x + ∑ x in sets n, g x)
        : by {congr' 1, simp [finset.sum_add_distrib],}
  ... = (1:ℝ)/(sets n).card *  ∑ x in sets n, f x
        + (1:ℝ)/(sets n).card *  ∑ x in sets n, g x
        : by ring
  ... = avg_seq sets f n + avg_seq sets g n
        : by simp,
end

lemma avg_seq_smul
  {sets: ℕ → finset G}
  {a:ℝ}
  {f : bounded_continuous_function G ℝ}
  : avg_seq sets (a•f) = a•avg_seq sets f
:= begin
  ext n,
  calc  avg_seq sets (a • f) n
      = (1:ℝ)/(sets n).card *  ∑ x in sets n, (a•f) x
        : by simp
  ... = (1:ℝ)/(sets n).card *  ∑ x in sets n, a*(f x)
        : by tauto
  ... = (1:ℝ)/(sets n).card * (a* ∑ x in sets n, (f x))
        : by {congr' 1, exact sum_scalar a,}
  ... = a * ((1:ℝ)/(sets n).card *  ∑ x in sets n, f x)
        : by ring
  ... = (a • avg_seq sets f) n
        : by simp,
end

open filter

/--The sequence of averages converges to a real number
(wrt a fixed nonprincipal ultrafilter)-/
lemma avg_seq_conv
  (F: Folner_sequence G)
  (f : bounded_continuous_function G ℝ)
  : ∃ x:ℝ, filter.tendsto (avg_seq F.sets f) (hyperfilter ℕ) (nhds x)
:=
begin
  -- We apply the ultrafilter convergence theorem :
  -- It therefore suffices to show that the sequence is bounded
  apply ultrafilter_convergence_R,

  -- The same bound as for f works
  have f_bound : ∃ (C:ℝ), ∀ (g:G), abs (f g) ≤ C
      := function_bounded_classical' f,
  rcases f_bound with ⟨C, f_bound⟩,
  use C,
  assume n:ℕ,
  calc  |avg_seq F.sets f n|
      = |(1:ℝ)/(F.sets n).card *  ∑ x in F.sets n, f x|
        : by simp[avg_seq]
  ... = |(1:ℝ)/(F.sets n).card| *  |∑ x in F.sets n, f x|
        : abs_mul (1 / ↑((F.sets n).card)) (∑ (x : G) in F.sets n, f x)
  ... ≤ |(1:ℝ)/(F.sets n).card| *  ∑ x in F.sets n, |f x|
        : by {
          apply mul_le_mul_of_nonneg_left,
            exact is_absolute_value.abv_sum abs (λ (i : G), f i) (F.sets n),
          exact abs_nonneg _,
        }
  ... ≤ |(1:ℝ)/(F.sets n).card| *  ∑ x in F.sets n, C
        : by {
          apply mul_le_mul_of_nonneg_left,
            apply finset.sum_le_sum,
            intros x xin,
            exact f_bound x,
          exact abs_nonneg _,
        }
  ... = |(1:ℝ)/(F.sets n).card| * ((F.sets n).card *C )
        : by {congr' 1, simp,}
  ... = (|(1:ℝ)/(F.sets n).card| * (F.sets n).card) *C
        : by ring
  ... = ((1:ℝ)/(F.sets n).card * (F.sets n).card) *C
        : by rw abs_one_over_card
  ... = (1:ℝ) * C
        : by {congr' 1,
              exact (eq_div_iff (nonzero_card_of_Folner_sequence F)).mp rfl,}
  ... = C
        : by simp,
end

/-- The sequence is nonnegative if f is nonnegative-/
lemma avg_seq_pos
  (F: Folner_sequence G)
  {f : bounded_continuous_function G ℝ}
  (fpos : ∀ x : G, f x ≥ 0)
  : ∀ n: ℕ, avg_seq F.sets f n ≥ 0
:= begin
  assume n:ℕ,
  calc  avg_seq F.sets f n
      = (1:ℝ)/(F.sets n).card *  ∑ x in F.sets n, f x
        : by simp
  ... ≥ (1:ℝ)/(F.sets n).card * ∑ x in F.sets n, 0
        : by {
          apply mul_le_mul_of_nonneg_left,
            apply finset.sum_le_sum,
            assume x xin,
            exact fpos x,
          exact nonneg_one_over_card,
        }
  ... = 0
        : by simp,
end

/-- We pick (the) limit as mean function-/
noncomputable def mean_fct_of_Folner_seq
  (F: Folner_sequence G)
  : (bounded_continuous_function G ℝ) → ℝ
:= (λ f, classical.some (avg_seq_conv F f))

lemma mean_fct_of_Folner_seq_spec
  (F: Folner_sequence G)
  (f: bounded_continuous_function G ℝ)
  : filter.tendsto (avg_seq F.sets f) (hyperfilter ℕ)
        (nhds (mean_fct_of_Folner_seq F f))
:= classical.some_spec (avg_seq_conv F f)

/--The limit is unique-/
lemma mean_fct_of_Folner_unique
  (F: Folner_sequence G)
  (f: bounded_continuous_function G ℝ)
  {x:ℝ}
  (avg_tendsto_x : filter.tendsto (avg_seq F.sets f) (hyperfilter ℕ)
                    (nhds x))
  : mean_fct_of_Folner_seq F f = x
:= begin
  symmetry,
  apply tendsto_nhds_unique avg_tendsto_x,
  exact mean_fct_of_Folner_seq_spec F f,
end

lemma mean_lin_fct_of_Folner_seq_add
  (F: Folner_sequence G)
  : ∀ f g, (mean_fct_of_Folner_seq F) (f+g) =
            (mean_fct_of_Folner_seq F) f + (mean_fct_of_Folner_seq F) g
:= begin
  assume f g : bounded_continuous_function G ℝ,
  apply mean_fct_of_Folner_unique,
  rw avg_seq_add,
  apply filter.tendsto.add,
  exact mean_fct_of_Folner_seq_spec F f,
  exact mean_fct_of_Folner_seq_spec F g,
end

lemma mean_lin_fct_of_Folner_seq_smul
  (F: Folner_sequence G)
  : ∀a:ℝ, ∀ f, (mean_fct_of_Folner_seq F) (a•f) =
            a•mean_fct_of_Folner_seq F f
:= begin
  assume a: ℝ,
  assume f: bounded_continuous_function G ℝ,
  apply mean_fct_of_Folner_unique,
  have : a • mean_fct_of_Folner_seq F f = a * mean_fct_of_Folner_seq F f
      := by simp,
  rw this,
  rw avg_seq_smul,
  exact filter.tendsto.const_mul a (mean_fct_of_Folner_seq_spec F f),
end

/--The mean function is linear-/
noncomputable def mean_lin_fct_of_Folner_seq
  (F: Folner_sequence G)
  : (bounded_continuous_function G ℝ) →ₗ[ℝ] ℝ
:= linear_map.mk (mean_fct_of_Folner_seq F)
      (mean_lin_fct_of_Folner_seq_add F)
      (mean_lin_fct_of_Folner_seq_smul F)

@[simp]
lemma mean_lin_fct_of_Folner_seq_apply
  (F: Folner_sequence G)
  (f: bounded_continuous_function G ℝ)
  : mean_lin_fct_of_Folner_seq F f = mean_fct_of_Folner_seq F f
:= by refl

lemma avg_seq_const
  (F: Folner_sequence G)
  : ∀ n:ℕ, avg_seq F.sets (bounded_continuous_function.const G (1:ℝ)) n = 1
:= begin
  assume n,
  dsimp[avg_seq],
  simp,
  have : ((F.sets n).card:ℝ) ≠ 0,
  {
    simp,
    exact F.sets_nonempty n,
  },
  exact inv_mul_cancel this,
end

lemma mean_lin_fct_of_Folner_seq_normality
   (F: Folner_sequence G)
  : (mean_lin_fct_of_Folner_seq F) (bounded_continuous_function.const G (1:ℝ)) = 1
:= begin
  simp,
  apply mean_fct_of_Folner_unique,
  have avg_seq_is_one : avg_seq F.sets (const G 1) = (λ n, (1:ℝ)),
  {
    ext n,
    calc  avg_seq F.sets (const G 1) n
        = (1:ℝ)/(F.sets n).card *  ∑ x in F.sets n, (const G 1) x
          : by simp
    ... = (1:ℝ)/(F.sets n).card *  ∑ x in F.sets n, 1
          : by simp
    ... = (1:ℝ)/(F.sets n).card * (F.sets n).card
          : by simp
    ... = (1:ℝ)
          : by exact (eq_div_iff (nonzero_card_of_Folner_sequence F)).mp rfl,
  },
  rw avg_seq_is_one,
  exact tendsto_const_nhds,
end

lemma mean_lin_fct_of_Folner_seq_positivity
   (F: Folner_sequence G)
  : ∀ {f : bounded_continuous_function G ℝ},
                          (∀ (x:G), f x ≥ 0) → (mean_lin_fct_of_Folner_seq F) f ≥ 0
:= begin
  assume f,
  assume fpos,
  have avg_pos : ∀ n, avg_seq F.sets f n ≥ 0
        := avg_seq_pos F fpos,
  exact limit_positive_of_positive_ultrafilter
        (mean_fct_of_Folner_seq_spec F f)
        avg_pos,
end

/--We obtain a mean from avg_seq-/
noncomputable def mean_of_Folner_seq
  (F: Folner_sequence G)
  : mean G
:= mean.mk (mean_lin_fct_of_Folner_seq F)
           (mean_lin_fct_of_Folner_seq_normality F)
           (@mean_lin_fct_of_Folner_seq_positivity G _ _ F)

@[simp]
lemma mean_of_Folner_seq_simp
  (F: Folner_sequence G)
  (f : bounded_continuous_function G ℝ)
  : mean_of_Folner_seq F f =  mean_fct_of_Folner_seq  F f
:= by refl

/--This mean is left-invariant
  (this basically is a long technical calculation, the
  main reason is that the Folner condition holds)-/
lemma mean_of_Folner_seq_inv
  (F: Folner_sequence G)
  : ∀(g:G), ∀(f: bounded_continuous_function G ℝ),
      (mean_of_Folner_seq F) (left_translate g f)
    = (mean_of_Folner_seq F)  f
:= begin
  assume g f,
  simp,
  -- choose a constant that bounds f
  have f_bound : ∃ (C:ℝ), ∀ (g:G), abs (f g) ≤ C
      := function_bounded_classical' f,
  rcases f_bound with ⟨C, f_bound⟩,

  -- difference in avg_seq is given by
  -- symmetric difference
  have avg_diff : ∀ n:ℕ,
    |avg_seq F.sets f n - avg_seq F.sets (left_translate g f) n|
   ≤ (1:ℝ)/(F.sets n).card * ∑ x in translate_symm_diff g⁻¹ (F.sets n), |f x|,
  {
    assume n,
    calc  |avg_seq F.sets f n - avg_seq F.sets (left_translate g f) n|
        = |(1:ℝ)/(F.sets n).card *  ∑ x in F.sets n, f x
            - (1:ℝ)/(F.sets n).card *  ∑ x in F.sets n, (left_translate g f) x|
          : by refl
    ... = |(1:ℝ)/(F.sets n).card *  ∑ x in F.sets n, f x
            - (1:ℝ)/(F.sets n).card *  ∑ x in (left_translate_set g⁻¹ (F.sets n)), f x|
          : by rw left_translate_summation
    ... = |(1:ℝ)/(F.sets n).card *  (∑ x in F.sets n, f x
            -  ∑ x in (left_translate_set g⁻¹ (F.sets n)), f x)|
          : by ring_nf
    ... = |(1:ℝ)/(F.sets n).card | * |(∑ x in F.sets n, f x
            -  ∑ x in (left_translate_set g⁻¹ (F.sets n)), f x)|
          : by exact abs_mul _ _
    ... ≤  |(1:ℝ)/(F.sets n).card| * ∑ x in translate_symm_diff g⁻¹ (F.sets n), |f x|
          : by {apply mul_le_mul_of_nonneg_left,
                exact abs_le_symm_diff_of_diff_sum,
                exact abs_nonneg _,
              }
    ... = (1:ℝ)/(F.sets n).card * ∑ x in translate_symm_diff g⁻¹ (F.sets n), |f x|
          : by {congr' 1, exact abs_one_over_card},
  },

  have avg_diff_bound : ∀ n, (1:ℝ)/(F.sets n).card * ∑ x in translate_symm_diff g⁻¹ (F.sets n), |f x|
              ≤ C * Folner_quotients g⁻¹ F.sets n,
  {
    assume n:ℕ,
    calc  (1:ℝ)/(F.sets n).card * ∑ x in translate_symm_diff g⁻¹ (F.sets n), |f x|
        ≤ (1:ℝ)/(F.sets n).card * ∑ x in translate_symm_diff g⁻¹ (F.sets n), C
          : by {
            apply mul_le_mul_of_nonneg_left,
              apply finset.sum_le_sum,
              assume x xin,
              exact f_bound x,
            exact nonneg_one_over_card,
          }
    ... = (1:ℝ)/(F.sets n).card * (C* (translate_symm_diff g⁻¹ (F.sets n)).card)
          : by {
            congr' 1,
            rw finset.sum_const C,
            finish,
          }
    ... = C * (((translate_symm_diff g⁻¹ (F.sets n)).card : ℝ) / (F.sets n).card)
          : by field_simp
    ... = C * Folner_quotients g⁻¹ F.sets n
          : by tauto,
  },
  have avg_diff_bound_to_zero :
      filter.tendsto (λ n, C * Folner_quotients g⁻¹ F.sets n)
            filter.at_top
            (nhds 0),
  {
    have : filter.tendsto  (C•(Folner_quotients g⁻¹ F.sets))
            filter.at_top (nhds (C*0))
        := filter.tendsto.const_mul C (F.Folner_cond g⁻¹),
    rw mul_zero at this,
    exact this,
  },

   have avg_diff_to_zero :
      filter.tendsto (λ n, avg_seq F.sets (left_translate g f) n - avg_seq F.sets f n)
            (hyperfilter ℕ)
            (nhds 0),
  {
    apply conv_hyperfilter_of_conv,
    have ineq : ∀ n, |avg_seq F.sets (left_translate g f) n - avg_seq F.sets f n|
              ≤ C * Folner_quotients g⁻¹ F.sets n
        := begin
           assume n,
           rw abs_sub_comm,
           exact le_trans (avg_diff n) (avg_diff_bound n),
        end,
    exact limit_wedge_zero ineq avg_diff_bound_to_zero,
  },

  have avg_tendsto : filter.tendsto (avg_seq F.sets f) (hyperfilter ℕ)
                  (nhds (mean_fct_of_Folner_seq F f))
        := mean_fct_of_Folner_seq_spec F f,

  apply mean_fct_of_Folner_unique,
  change filter.tendsto (avg_seq F.sets (left_translate g f))
                (hyperfilter ℕ)
                (nhds (mean_fct_of_Folner_seq F f)),

  have conv_sum := filter.tendsto.add avg_diff_to_zero avg_tendsto,
  simp [-avg_seq] at conv_sum,
  exact conv_sum,
end

/--We obtain an invariant mean-/
noncomputable def inv_mean_of_Folner_seq
  (F: Folner_sequence G)
  : left_invariant_mean G
:= left_invariant_mean.mk (mean_of_Folner_seq F) (mean_of_Folner_seq_inv F)

end Folner_amenable_to_amenable

/--The existence of a Folner sequence implies amenability-/
theorem amenable_of_Folner_sequence
  {G: Type*}
  [group G]
  [decidable_eq G]
  (F: Folner_sequence G)
  : amenable G
:= amenable_of_invmean (Folner_amenable_to_amenable.inv_mean_of_Folner_seq F)

/--Folner amenable groups are amenable -/
theorem amenable_of_Folner_amenable
  {G: Type*}
  [group G]
  [decidable_eq G]
  (Fam: Folner_amenable G)
  : amenable G
:= amenable_of_Folner_sequence (Folner_sequence_of_Folner_amenable Fam)


class OpAssoc (op : α → α → α) : Prop where
  protected op_assoc (x y z) : op (op x y) z = op x (op y z)

abbrev op_assoc (op : α → α → α) [self : OpAssoc op] := self.op_assoc

@[reducible]
structure SemigroupSig (α) where
  op : α → α → α

@[reducible]
structure SemiringSig (α) where
  add : α → α → α
  mul : α → α → α

def SemiringSig.toAddSemigroupSig (s : SemiringSig α) : SemigroupSig α where
  op := s.add

def SemiringSig.toMulSemigroupSig (s : SemiringSig α) : SemigroupSig α where
  op := s.mul

unif_hint (s : SemiringSig α) (t : SemigroupSig α) where
  t =?= s.toAddSemigroupSig ⊢ t.op =?= s.add

unif_hint (s : SemiringSig α) (t : SemigroupSig α) where
  t =?= s.toMulSemigroupSig ⊢ t.op =?= s.mul

class Semigroup (s : SemigroupSig α) : Prop where
  protected op_assoc (x y z) : s.op (s.op x y) z = s.op x (s.op y z)

instance Semirgoup.toOpAssoc (s : SemigroupSig α) [Semigroup s] : OpAssoc (no_index s.op) := ⟨Semigroup.op_assoc⟩

class Semiring (s : SemiringSig α) : Prop where
  protected add_assoc (x y z) : s.add (s.add x y) z = s.add x (s.add y z)
  protected mul_assoc (x y z) : s.mul (s.mul x y) z = s.mul x (s.mul y z)

instance Semiring.toAddSemigroup (s : SemiringSig α) [Semiring s] : Semigroup (no_index s.toAddSemigroupSig) where
  op_assoc := Semiring.add_assoc

instance Semiring.toMulSemigroup (s : SemiringSig α) [Semiring s] : Semigroup (no_index s.toMulSemigroupSig) where
  op_assoc := Semiring.mul_assoc

section Test
variable (s : SemiringSig α) [Semiring s]

local infix:70 " ⋆ " => s.mul

example (w x y z : α) : (w ⋆ x) ⋆ (y ⋆ z) = w ⋆ ((x ⋆ y) ⋆ z) := by
  repeat rw [op_assoc (.⋆.)]

end Test


import algebra.module.basic
import algebra.module.linear_map
import linear_algebra.basic
import linear_algebra.prod
import linear_algebra.projection
import order.bounded_lattice
import logic.function.conjugate

-- Montrer qu'un endomorphisme f d'un K -espace vectoriel E commute avec un
-- projecteur p si, et seulement si, les espaces Im(p) et Ker(p) sont stables par f .

theorem cpge_reduction_3_b
  {K : Type*} [ring K] {E : Type*}
  [add_comm_group E] [module K E]
  (A B : submodule K E)
  (h : is_compl A B)
  (u : linear_map K E E):
  let p: linear_map K E E := A.subtype.comp (A.linear_proj_of_is_compl B h) in
  function.commute p u <-> (A.map u = A /\ B.map u = B)
:= sorry


theorem ex1 : a * 2 = 2 * a := by
  have h : ∀ (a b : Nat), a * b = a * b := by
    intros; rfl
  conv at h =>
    intro a b; lhs; rw [Nat.mul_comm]
  exact h 2 a

#print ex1

theorem ex2 : a * 2 = 2 * a := by
  have h : (fun x y => x * y) = Nat.mul := by
    rfl
  conv at h =>
    lhs; intro x y; rw [Nat.mul_comm]
  exact congrFun (congrFun h 2) a

#print ex2


import algebra.ring

universes u v
variable {α : Type u}

section domain
  variable [domain α]

  lemma mul_ne_zero_iff {a b : α} : a * b ≠ 0 ↔ a ≠ 0 ∧ b ≠ 0 :=
  by classical; rw [←not_iff_not, not_and_distrib, not_not, not_not, not_not, mul_eq_zero]

end domain


/-
Copyright (c) 2019 Simon Hudon. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Simon Hudon
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.tactic.monotonicity.basic
import Mathlib.data.set.lattice
import Mathlib.order.bounds
import Mathlib.PostPort

universes u_1

namespace Mathlib

theorem mul_mono_nonneg {α : Type u_1} {x : α} {y : α} {z : α} [ordered_semiring α] (h' : 0 ≤ z) (h : x ≤ y) : x * z ≤ y * z :=
  mul_le_mul_of_nonneg_right h h'

theorem lt_of_mul_lt_mul_neg_right {α : Type u_1} {a : α} {b : α} {c : α} [linear_ordered_ring α] (h : a * c < b * c) (hc : c ≤ 0) : b < a := sorry

theorem mul_mono_nonpos {α : Type u_1} {x : α} {y : α} {z : α} [linear_ordered_ring α] (h' : z ≤ 0) (h : y ≤ x) : x * z ≤ y * z :=
  decidable.by_contradiction
    fun (h'' : ¬x * z ≤ y * z) => not_le_of_lt (lt_of_mul_lt_mul_neg_right (lt_of_not_ge h'') h') h

theorem nat.sub_mono_left_strict {x : ℕ} {y : ℕ} {z : ℕ} (h' : z ≤ x) (h : x < y) : x - z < y - z :=
  nat.lt_of_add_lt_add_left
    (eq.mpr (id (Eq._oldrec (Eq.refl (z + (x - z) < z + (y - z))) (nat.add_sub_of_le h')))
      (eq.mpr (id (Eq._oldrec (Eq.refl (x < z + (y - z))) (nat.add_sub_of_le (le_trans h' (le_of_lt h))))) h))

theorem nat.sub_mono_right_strict {x : ℕ} {y : ℕ} {z : ℕ} (h' : x ≤ z) (h : y < x) : z - x < z - y := sorry


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

/-!
# Lift filters along filter and set functions
-/

open set

open_locale classical filter

namespace filter
variables {α : Type*} {β : Type*} {γ : Type*} {ι : Sort*}

section lift

/-- A variant on `bind` using a function `g` taking a set instead of a member of `α`.
This is essentially a push-forward along a function mapping each set to a filter. -/
protected def lift (f : filter α) (g : set α → filter β) :=
⨅s ∈ f, g s

variables {f f₁ f₂ : filter α} {g g₁ g₂ : set α → filter β}

@[simp] lemma lift_top (g : set α → filter β) : (⊤ : filter α).lift g = g univ :=
by simp [filter.lift]

/-- If `(p : ι → Prop, s : ι → set α)` is a basis of a filter `f`, `g` is a monotone function
`set α → filter γ`, and for each `i`, `(pg : β i → Prop, sg : β i → set α)` is a basis
of the filter `g (s i)`, then `(λ (i : ι) (x : β i), p i ∧ pg i x, λ (i : ι) (x : β i), sg i x)`
is a basis of the filter `f.lift g`.

This basis is parametrized by `i : ι` and `x : β i`, so in order to formulate this fact using
`has_basis` one has to use `Σ i, β i` as the index type, see `filter.has_basis.lift`.
This lemma states the corresponding `mem_iff` statement without using a sigma type. -/
lemma has_basis.mem_lift_iff {ι} {p : ι → Prop} {s : ι → set α} {f : filter α}
  (hf : f.has_basis p s) {β : ι → Type*} {pg : Π i, β i → Prop} {sg : Π i, β i → set γ}
  {g : set α → filter γ} (hg : ∀ i, (g $ s i).has_basis (pg i) (sg i)) (gm : monotone g)
  {s : set γ} :
  s ∈ f.lift g ↔ ∃ (i : ι) (hi : p i) (x : β i) (hx : pg i x), sg i x ⊆ s :=
begin
  refine (mem_binfi_of_directed _ ⟨univ, univ_sets _⟩).trans _,
  { intros t₁ ht₁ t₂ ht₂,
    exact ⟨t₁ ∩ t₂, inter_mem ht₁ ht₂, gm $ inter_subset_left _ _,
      gm $ inter_subset_right _ _⟩ },
  { simp only [← (hg _).mem_iff],
    exact hf.exists_iff (λ t₁ t₂ ht H, gm ht H) }
end

/-- If `(p : ι → Prop, s : ι → set α)` is a basis of a filter `f`, `g` is a monotone function
`set α → filter γ`, and for each `i`, `(pg : β i → Prop, sg : β i → set α)` is a basis
of the filter `g (s i)`, then `(λ (i : ι) (x : β i), p i ∧ pg i x, λ (i : ι) (x : β i), sg i x)`
is a basis of the filter `f.lift g`.

This basis is parametrized by `i : ι` and `x : β i`, so in order to formulate this fact using
`has_basis` one has to use `Σ i, β i` as the index type. See also `filter.has_basis.mem_lift_iff`
for the corresponding `mem_iff` statement formulated without using a sigma type. -/
lemma has_basis.lift {ι} {p : ι → Prop} {s : ι → set α} {f : filter α} (hf : f.has_basis p s)
  {β : ι → Type*} {pg : Π i, β i → Prop} {sg : Π i, β i → set γ} {g : set α → filter γ}
  (hg : ∀ i, (g $ s i).has_basis (pg i) (sg i)) (gm : monotone g) :
  (f.lift g).has_basis (λ i : Σ i, β i, p i.1 ∧ pg i.1 i.2) (λ i : Σ i, β i, sg i.1 i.2) :=
begin
  refine ⟨λ t, (hf.mem_lift_iff hg gm).trans _⟩,
  simp [sigma.exists, and_assoc, exists_and_distrib_left]
end

lemma mem_lift_sets (hg : monotone g) {s : set β} :
  s ∈ f.lift g ↔ ∃t∈f, s ∈ g t :=
(f.basis_sets.mem_lift_iff (λ s, (g s).basis_sets) hg).trans $
  by simp only [id, ← exists_mem_subset_iff]

lemma mem_lift {s : set β} {t : set α} (ht : t ∈ f) (hs : s ∈ g t) :
  s ∈ f.lift g :=
le_principal_iff.mp $ show f.lift g ≤ 𝓟 s,
  from infi_le_of_le t $ infi_le_of_le ht $ le_principal_iff.mpr hs

lemma lift_le {f : filter α} {g : set α → filter β} {h : filter β} {s : set α}
  (hs : s ∈ f) (hg : g s ≤ h) : f.lift g ≤ h :=
infi_le_of_le s $ infi_le_of_le hs $ hg

lemma le_lift {f : filter α} {g : set α → filter β} {h : filter β}
  (hh : ∀s∈f, h ≤ g s) : h ≤ f.lift g :=
le_infi $ assume s, le_infi $ assume hs, hh s hs

lemma lift_mono (hf : f₁ ≤ f₂) (hg : g₁ ≤ g₂) : f₁.lift g₁ ≤ f₂.lift g₂ :=
infi_le_infi $ assume s, infi_le_infi2 $ assume hs, ⟨hf hs, hg s⟩

lemma lift_mono' (hg : ∀s∈f, g₁ s ≤ g₂ s) : f.lift g₁ ≤ f.lift g₂ :=
infi_le_infi $ assume s, infi_le_infi $ assume hs, hg s hs

lemma tendsto_lift {m : γ → β} {l : filter γ} :
  tendsto m l (f.lift g) ↔ ∀ s ∈ f, tendsto m l (g s) :=
by simp only [filter.lift, tendsto_infi]

lemma map_lift_eq {m : β → γ} (hg : monotone g) : map m (f.lift g) = f.lift (map m ∘ g) :=
have monotone (map m ∘ g),
  from map_mono.comp hg,
filter.ext $ λ s,
  by simp only [mem_lift_sets hg, mem_lift_sets this, exists_prop, mem_map, function.comp_app]

lemma comap_lift_eq {m : γ → β} (hg : monotone g) : comap m (f.lift g) = f.lift (comap m ∘ g) :=
have monotone (comap m ∘ g),
  from comap_mono.comp hg,
begin
  ext,
  simp only [mem_lift_sets hg, mem_lift_sets this, mem_comap, exists_prop, mem_lift_sets],
  exact ⟨λ ⟨b, ⟨a, ha, hb⟩, hs⟩, ⟨a, ha, b, hb, hs⟩, λ ⟨a, ha, b, hb, hs⟩, ⟨b, ⟨a, ha, hb⟩, hs⟩⟩
end

theorem comap_lift_eq2 {m : β → α} {g : set β → filter γ} (hg : monotone g) :
  (comap m f).lift g = f.lift (g ∘ preimage m) :=
le_antisymm
  (le_infi $ assume s, le_infi $ assume hs,
    infi_le_of_le (preimage m s) $ infi_le _ ⟨s, hs, subset.refl _⟩)
  (le_infi $ assume s, le_infi $ assume ⟨s', hs', (h_sub : preimage m s' ⊆ s)⟩,
    infi_le_of_le s' $ infi_le_of_le hs' $ hg h_sub)

lemma map_lift_eq2 {g : set β → filter γ} {m : α → β} (hg : monotone g) :
  (map m f).lift g = f.lift (g ∘ image m) :=
le_antisymm
  (infi_le_infi2 $ assume s, ⟨image m s,
    infi_le_infi2 $ assume hs, ⟨
      f.sets_of_superset hs $ assume a h, mem_image_of_mem _ h,
      le_refl _⟩⟩)
  (infi_le_infi2 $ assume t, ⟨preimage m t,
    infi_le_infi2 $ assume ht, ⟨ht,
      hg $ assume x, assume h : x ∈ m '' preimage m t,
        let ⟨y, hy, h_eq⟩ := h in
        show x ∈ t, from h_eq ▸ hy⟩⟩)

lemma lift_comm {g : filter β} {h : set α → set β → filter γ} :
  f.lift (λs, g.lift (h s)) = g.lift (λt, f.lift (λs, h s t)) :=
le_antisymm
  (le_infi $ assume i, le_infi $ assume hi, le_infi $ assume j, le_infi $ assume hj,
    infi_le_of_le j $ infi_le_of_le hj $ infi_le_of_le i $ infi_le _ hi)
  (le_infi $ assume i, le_infi $ assume hi, le_infi $ assume j, le_infi $ assume hj,
    infi_le_of_le j $ infi_le_of_le hj $ infi_le_of_le i $ infi_le _ hi)

lemma lift_assoc {h : set β → filter γ} (hg : monotone g)  :
  (f.lift g).lift h = f.lift (λs, (g s).lift h) :=
le_antisymm
  (le_infi $ assume s, le_infi $ assume hs, le_infi $ assume t, le_infi $ assume ht,
    infi_le_of_le t $ infi_le _ $ (mem_lift_sets hg).mpr ⟨_, hs, ht⟩)
  (le_infi $ assume t, le_infi $ assume ht,
    let ⟨s, hs, h'⟩ := (mem_lift_sets hg).mp ht in
    infi_le_of_le s $ infi_le_of_le hs $ infi_le_of_le t $ infi_le _ h')

lemma lift_lift_same_le_lift {g : set α → set α → filter β} :
  f.lift (λs, f.lift (g s)) ≤ f.lift (λs, g s s) :=
le_infi $ assume s, le_infi $ assume hs, infi_le_of_le s $ infi_le_of_le hs $ infi_le_of_le s $
  infi_le _ hs

lemma lift_lift_same_eq_lift {g : set α → set α → filter β}
  (hg₁ : ∀s, monotone (λt, g s t)) (hg₂ : ∀t, monotone (λs, g s t)) :
  f.lift (λs, f.lift (g s)) = f.lift (λs, g s s) :=
le_antisymm
  lift_lift_same_le_lift
  (le_infi $ assume s, le_infi $ assume hs, le_infi $ assume t, le_infi $ assume ht,
    infi_le_of_le (s ∩ t) $
    infi_le_of_le (inter_mem hs ht) $
    calc g (s ∩ t) (s ∩ t) ≤ g s (s ∩ t) : hg₂ (s ∩ t) (inter_subset_left _ _)
      ... ≤ g s t                        : hg₁ s (inter_subset_right _ _))

lemma lift_principal {s : set α} (hg : monotone g) :
  (𝓟 s).lift g = g s :=
le_antisymm
  (infi_le_of_le s $ infi_le _ $ subset.refl _)
  (le_infi $ assume t, le_infi $ assume hi, hg hi)

theorem monotone_lift [preorder γ] {f : γ → filter α} {g : γ → set α → filter β}
  (hf : monotone f) (hg : monotone g) : monotone (λc, (f c).lift (g c)) :=
assume a b h, lift_mono (hf h) (hg h)

lemma lift_ne_bot_iff (hm : monotone g) : (ne_bot $ f.lift g) ↔ (∀s∈f, ne_bot (g s)) :=
begin
  rw [filter.lift, infi_subtype', infi_ne_bot_iff_of_directed', subtype.forall'],
  { rintros ⟨s, hs⟩ ⟨t, ht⟩,
    exact ⟨⟨s ∩ t, inter_mem hs ht⟩, hm (inter_subset_left s t), hm (inter_subset_right s t)⟩ }
end

@[simp] lemma lift_const {f : filter α} {g : filter β} : f.lift (λx, g) = g :=
le_antisymm (lift_le univ_mem $ le_refl g) (le_lift $ assume s hs, le_refl g)

@[simp] lemma lift_inf {f : filter α} {g h : set α → filter β} :
  f.lift (λx, g x ⊓ h x) = f.lift g ⊓ f.lift h :=
by simp only [filter.lift, infi_inf_eq, eq_self_iff_true]

@[simp] lemma lift_principal2 {f : filter α} : f.lift 𝓟 = f :=
le_antisymm
  (assume s hs, mem_lift hs (mem_principal_self s))
  (le_infi $ assume s, le_infi $ assume hs, by simp only [hs, le_principal_iff])

lemma lift_infi {f : ι → filter α} {g : set α → filter β}
  [hι : nonempty ι] (hg : ∀{s t}, g s ⊓ g t = g (s ∩ t)) : (infi f).lift g = (⨅i, (f i).lift g) :=
le_antisymm
  (le_infi $ assume i, lift_mono (infi_le _ _) (le_refl _))
  (assume s,
    have g_mono : monotone g,
      from assume s t h, le_of_inf_eq $ eq.trans hg $ congr_arg g $ inter_eq_self_of_subset_left h,
    have ∀t∈(infi f), (⨅ (i : ι), filter.lift (f i) g) ≤ g t,
      from assume t ht, infi_sets_induct ht
        (let ⟨i⟩ := hι in infi_le_of_le i $ infi_le_of_le univ $ infi_le _ univ_mem)
        (assume i s₁ s₂ hs₁ hs₂,
          @hg s₁ s₂ ▸ le_inf (infi_le_of_le i $ infi_le_of_le s₁ $ infi_le _ hs₁) hs₂),
    begin
      simp only [mem_lift_sets g_mono,  exists_imp_distrib],
      exact assume t ht hs, this t ht hs
    end)

end lift

section lift'
/-- Specialize `lift` to functions `set α → set β`. This can be viewed as a generalization of `map`.
This is essentially a push-forward along a function mapping each set to a set. -/
protected def lift' (f : filter α) (h : set α → set β) :=
f.lift (𝓟 ∘ h)

variables {f f₁ f₂ : filter α} {h h₁ h₂ : set α → set β}

@[simp] lemma lift'_top (h : set α → set β) : (⊤ : filter α).lift' h = 𝓟 (h univ) :=
lift_top _

lemma mem_lift' {t : set α} (ht : t ∈ f) : h t ∈ (f.lift' h) :=
le_principal_iff.mp $ show f.lift' h ≤ 𝓟 (h t),
  from infi_le_of_le t $ infi_le_of_le ht $ le_refl _

lemma tendsto_lift' {m : γ → β} {l : filter γ} :
  tendsto m l (f.lift' h) ↔ ∀ s ∈ f, ∀ᶠ a in l, m a ∈ h s :=
by simp only [filter.lift', tendsto_lift, tendsto_principal]

lemma has_basis.lift' {ι} {p : ι → Prop} {s} (hf : f.has_basis p s) (hh : monotone h) :
  (f.lift' h).has_basis p (h ∘ s) :=
begin
  refine ⟨λ t, (hf.mem_lift_iff _ (monotone_principal.comp hh)).trans _⟩,
  show ∀ i, (𝓟 (h (s i))).has_basis (λ j : unit, true) (λ (j : unit), h (s i)),
    from λ i, has_basis_principal _,
  simp only [exists_const]
end

lemma mem_lift'_sets (hh : monotone h) {s : set β} : s ∈ (f.lift' h) ↔ (∃t∈f, h t ⊆ s) :=
mem_lift_sets $ monotone_principal.comp hh

lemma eventually_lift'_iff (hh : monotone h) {p : β → Prop} :
  (∀ᶠ y in f.lift' h, p y) ↔ (∃ t ∈ f, ∀ y ∈ h t, p y) :=
mem_lift'_sets hh

lemma lift'_le {f : filter α} {g : set α → set β} {h : filter β} {s : set α}
  (hs : s ∈ f) (hg : 𝓟 (g s) ≤ h) : f.lift' g ≤ h :=
lift_le hs hg

lemma lift'_mono (hf : f₁ ≤ f₂) (hh : h₁ ≤ h₂) : f₁.lift' h₁ ≤ f₂.lift' h₂ :=
lift_mono hf $ assume s, principal_mono.mpr $ hh s

lemma lift'_mono' (hh : ∀s∈f, h₁ s ⊆ h₂ s) : f.lift' h₁ ≤ f.lift' h₂ :=
infi_le_infi $ assume s, infi_le_infi $ assume hs, principal_mono.mpr $ hh s hs

lemma lift'_cong (hh : ∀s∈f, h₁ s = h₂ s) : f.lift' h₁ = f.lift' h₂ :=
le_antisymm (lift'_mono' $ assume s hs, le_of_eq $ hh s hs)
  (lift'_mono' $ assume s hs, le_of_eq $ (hh s hs).symm)

lemma map_lift'_eq {m : β → γ} (hh : monotone h) : map m (f.lift' h) = f.lift' (image m ∘ h) :=
calc map m (f.lift' h) = f.lift (map m ∘ 𝓟 ∘ h) :
    map_lift_eq $ monotone_principal.comp hh
  ... = f.lift' (image m ∘ h) : by simp only [(∘), filter.lift', map_principal, eq_self_iff_true]

lemma map_lift'_eq2 {g : set β → set γ} {m : α → β} (hg : monotone g) :
  (map m f).lift' g = f.lift' (g ∘ image m) :=
map_lift_eq2 $ monotone_principal.comp hg

theorem comap_lift'_eq {m : γ → β} (hh : monotone h) :
  comap m (f.lift' h) = f.lift' (preimage m ∘ h) :=
calc comap m (f.lift' h) = f.lift (comap m ∘ 𝓟 ∘ h) :
    comap_lift_eq $ monotone_principal.comp hh
  ... = f.lift' (preimage m ∘ h) :
    by simp only [(∘), filter.lift', comap_principal, eq_self_iff_true]

theorem comap_lift'_eq2 {m : β → α} {g : set β → set γ} (hg : monotone g) :
  (comap m f).lift' g = f.lift' (g ∘ preimage m) :=
comap_lift_eq2 $ monotone_principal.comp hg

lemma lift'_principal {s : set α} (hh : monotone h) :
  (𝓟 s).lift' h = 𝓟 (h s) :=
lift_principal $ monotone_principal.comp hh

lemma lift'_bot (hh : monotone h) : (⊥ : filter α).lift' h = 𝓟 (h ∅) :=
by rw [← principal_empty, lift'_principal hh]

lemma principal_le_lift' {t : set β} (hh : ∀s∈f, t ⊆ h s) :
  𝓟 t ≤ f.lift' h :=
le_infi $ assume s, le_infi $ assume hs, principal_mono.mpr (hh s hs)

theorem monotone_lift' [preorder γ] {f : γ → filter α} {g : γ → set α → set β}
  (hf : monotone f) (hg : monotone g) : monotone (λc, (f c).lift' (g c)) :=
assume a b h, lift'_mono (hf h) (hg h)

lemma lift_lift'_assoc {g : set α → set β} {h : set β → filter γ}
  (hg : monotone g) (hh : monotone h) :
  (f.lift' g).lift h = f.lift (λs, h (g s)) :=
calc (f.lift' g).lift h = f.lift (λs, (𝓟 (g s)).lift h) :
    lift_assoc (monotone_principal.comp hg)
  ... = f.lift (λs, h (g s)) : by simp only [lift_principal, hh, eq_self_iff_true]

lemma lift'_lift'_assoc {g : set α → set β} {h : set β → set γ}
  (hg : monotone g) (hh : monotone h) :
  (f.lift' g).lift' h = f.lift' (λs, h (g s)) :=
lift_lift'_assoc hg (monotone_principal.comp hh)

lemma lift'_lift_assoc {g : set α → filter β} {h : set β → set γ}
  (hg : monotone g) : (f.lift g).lift' h = f.lift (λs, (g s).lift' h) :=
lift_assoc hg

lemma lift_lift'_same_le_lift' {g : set α → set α → set β} :
  f.lift (λs, f.lift' (g s)) ≤ f.lift' (λs, g s s) :=
lift_lift_same_le_lift

lemma lift_lift'_same_eq_lift' {g : set α → set α → set β}
  (hg₁ : ∀s, monotone (λt, g s t)) (hg₂ : ∀t, monotone (λs, g s t)) :
  f.lift (λs, f.lift' (g s)) = f.lift' (λs, g s s) :=
lift_lift_same_eq_lift
  (assume s, monotone_principal.comp (hg₁ s))
  (assume t, monotone_principal.comp (hg₂ t))

lemma lift'_inf_principal_eq {h : set α → set β} {s : set β} :
  f.lift' h ⊓ 𝓟 s = f.lift' (λt, h t ∩ s) :=
by simp only [filter.lift', filter.lift, (∘), ← inf_principal, infi_subtype', ← infi_inf]

lemma lift'_ne_bot_iff (hh : monotone h) : (ne_bot (f.lift' h)) ↔ (∀s∈f, (h s).nonempty) :=
calc (ne_bot (f.lift' h)) ↔ (∀s∈f, ne_bot (𝓟 (h s))) :
    lift_ne_bot_iff (monotone_principal.comp hh)
  ... ↔ (∀s∈f, (h s).nonempty) : by simp only [principal_ne_bot_iff]

@[simp] lemma lift'_id {f : filter α} : f.lift' id = f :=
lift_principal2

lemma le_lift' {f : filter α} {h : set α → set β} {g : filter β}
  (h_le : ∀s∈f, h s ∈ g) : g ≤ f.lift' h :=
le_infi $ assume s, le_infi $ assume hs,
  by simpa only [h_le, le_principal_iff, function.comp_app] using h_le s hs

lemma lift_infi' {f : ι → filter α} {g : set α → filter β}
  [nonempty ι] (hf : directed (≥) f) (hg : monotone g) : (infi f).lift g = (⨅i, (f i).lift g) :=
le_antisymm
  (le_infi $ assume i, lift_mono (infi_le _ _) (le_refl _))
  (assume s,
  begin
    rw mem_lift_sets hg,
    simp only [exists_imp_distrib, mem_infi_of_directed hf],
    exact assume t i ht hs, mem_infi_of_mem i $ mem_lift ht hs
  end)

lemma lift'_infi {f : ι → filter α} {g : set α → set β}
  [nonempty ι] (hg : ∀{s t}, g s ∩ g t = g (s ∩ t)) : (infi f).lift' g = (⨅i, (f i).lift' g) :=
lift_infi $ λ s t, by simp only [principal_eq_iff_eq, inf_principal, (∘), hg]

lemma lift'_inf (f g : filter α) {s : set α → set β} (hs : ∀ {t₁ t₂}, s t₁ ∩ s t₂ = s (t₁ ∩ t₂)) :
  (f ⊓ g).lift' s = f.lift' s ⊓ g.lift' s :=
have (⨅ b : bool, cond b f g).lift' s = ⨅ b : bool, (cond b f g).lift' s :=
  lift'_infi @hs,
by simpa only [infi_bool_eq]

theorem comap_eq_lift' {f : filter β} {m : α → β} :
  comap m f = f.lift' (preimage m) :=
filter.ext $ λ s, (mem_lift'_sets monotone_preimage).symm

lemma lift'_infi_powerset {f : ι → filter α} :
  (infi f).lift' powerset = (⨅i, (f i).lift' powerset) :=
begin
  casesI is_empty_or_nonempty ι,
  { rw [infi_of_empty f, infi_of_empty, lift'_top, powerset_univ, principal_univ] },
  { exact (lift'_infi $ λ _ _, (powerset_inter _ _).symm) },
end

lemma lift'_inf_powerset (f g : filter α) :
  (f ⊓ g).lift' powerset = f.lift' powerset ⊓ g.lift' powerset :=
lift'_inf f g $ λ _ _, (powerset_inter _ _).symm

lemma eventually_lift'_powerset {f : filter α} {p : set α → Prop} :
  (∀ᶠ s in f.lift' powerset, p s) ↔ ∃ s ∈ f, ∀ t ⊆ s, p t :=
eventually_lift'_iff monotone_powerset

lemma eventually_lift'_powerset' {f : filter α} {p : set α → Prop}
  (hp : ∀ ⦃s t⦄, s ⊆ t → p t → p s) :
  (∀ᶠ s in f.lift' powerset, p s) ↔ ∃ s ∈ f, p s :=
eventually_lift'_powerset.trans $ exists_congr $ λ s, exists_congr $
  λ hsf, ⟨λ H, H s (subset.refl s), λ hs t ht, hp ht hs⟩

instance lift'_powerset_ne_bot (f : filter α) : ne_bot (f.lift' powerset) :=
(lift'_ne_bot_iff monotone_powerset).2 $ λ _ _, powerset_nonempty

lemma tendsto_lift'_powerset_mono {la : filter α} {lb : filter β} {s t : α → set β}
  (ht : tendsto t la (lb.lift' powerset)) (hst : ∀ᶠ x in la, s x ⊆ t x) :
  tendsto s la (lb.lift' powerset) :=
begin
  simp only [filter.lift', filter.lift, (∘), tendsto_infi, tendsto_principal] at ht ⊢,
  exact λ u hu, (ht u hu).mp (hst.mono $ λ a hst ht, subset.trans hst ht)
end

@[simp] lemma eventually_lift'_powerset_forall {f : filter α} {p : α → Prop} :
  (∀ᶠ s in f.lift' powerset, ∀ x ∈ s, p x) ↔ ∀ᶠ x in f, p x :=
iff.trans (eventually_lift'_powerset' $ λ s t hst ht x hx, ht x (hst hx))
  exists_mem_subset_iff

alias eventually_lift'_powerset_forall ↔
  filter.eventually.of_lift'_powerset filter.eventually.lift'_powerset

@[simp] lemma eventually_lift'_powerset_eventually {f g : filter α} {p : α → Prop} :
  (∀ᶠ s in f.lift' powerset, ∀ᶠ x in g, x ∈ s → p x) ↔ ∀ᶠ x in f ⊓ g, p x :=
calc _ ↔ ∃ s ∈ f, ∀ᶠ x in g, x ∈ s → p x :
  eventually_lift'_powerset' $ λ s t hst ht, ht.mono $ λ x hx hs, hx (hst hs)
... ↔ ∃ (s ∈ f) (t ∈ g), ∀ x, x ∈ t → x ∈ s → p x :
  by simp only [eventually_iff_exists_mem]
... ↔ ∀ᶠ x in f ⊓ g, p x : by { rw eventually_inf, finish }

end lift'

section prod
variables {f : filter α}

lemma prod_def {f : filter α} {g : filter β} : f ×ᶠ g = (f.lift $ λs, g.lift' $ set.prod s) :=
have ∀(s:set α) (t : set β),
    𝓟 (set.prod s t) = (𝓟 s).comap prod.fst ⊓ (𝓟 t).comap prod.snd,
  by simp only [principal_eq_iff_eq, comap_principal, inf_principal]; intros; refl,
begin
  simp only [filter.lift', function.comp, this, lift_inf, lift_const, lift_inf],
  rw [← comap_lift_eq monotone_principal, ← comap_lift_eq monotone_principal],
  simp only [filter.prod, lift_principal2, eq_self_iff_true]
end

lemma prod_same_eq : f ×ᶠ f = f.lift' (λt, set.prod t t) :=
by rw [prod_def];
from lift_lift'_same_eq_lift'
  (assume s, set.monotone_prod monotone_const monotone_id)
  (assume t, set.monotone_prod monotone_id monotone_const)

lemma mem_prod_same_iff {s : set (α×α)} :
  s ∈ f ×ᶠ f ↔ (∃t∈f, set.prod t t ⊆ s) :=
by rw [prod_same_eq, mem_lift'_sets]; exact set.monotone_prod monotone_id monotone_id

lemma tendsto_prod_self_iff {f : α × α → β} {x : filter α} {y : filter β} :
  filter.tendsto f (x ×ᶠ x) y ↔
  ∀ W ∈ y, ∃ U ∈ x, ∀ (x x' : α), x ∈ U → x' ∈ U → f (x, x') ∈ W :=
by simp only [tendsto_def, mem_prod_same_iff, prod_sub_preimage_iff, exists_prop, iff_self]

variables {α₁ : Type*} {α₂ : Type*} {β₁ : Type*} {β₂ : Type*}

lemma prod_lift_lift
  {f₁ : filter α₁} {f₂ : filter α₂} {g₁ : set α₁ → filter β₁} {g₂ : set α₂ → filter β₂}
  (hg₁ : monotone g₁) (hg₂ : monotone g₂) :
  (f₁.lift g₁) ×ᶠ (f₂.lift g₂) = f₁.lift (λs, f₂.lift (λt, g₁ s ×ᶠ g₂ t)) :=
begin
  simp only [prod_def],
  rw [lift_assoc],
  apply congr_arg, funext x,
  rw [lift_comm],
  apply congr_arg, funext y,
  rw [lift'_lift_assoc],
  exact hg₂,
  exact hg₁
end

lemma prod_lift'_lift'
  {f₁ : filter α₁} {f₂ : filter α₂} {g₁ : set α₁ → set β₁} {g₂ : set α₂ → set β₂}
  (hg₁ : monotone g₁) (hg₂ : monotone g₂) :
  f₁.lift' g₁ ×ᶠ f₂.lift' g₂ = f₁.lift (λs, f₂.lift' (λt, (g₁ s).prod (g₂ t))) :=
begin
  rw [prod_def, lift_lift'_assoc],
  apply congr_arg, funext x,
  rw [lift'_lift'_assoc],
  exact hg₂,
  exact set.monotone_prod monotone_const monotone_id,
  exact hg₁,
  exact (monotone_lift' monotone_const $ monotone_lam $
    assume x, set.monotone_prod monotone_id monotone_const)
end

end prod

end filter


namespace bool

-- inductive bool : Type

#check bool
#check ff
#check tt

--tt,ff are the only elements of bool

def bnot: bool → bool
| ff := tt
| tt := ff

#eval bnot ff --the result #eval
#eval bnot tt

def band : bool → bool → bool
| ff x := ff
--| ff ff := ff
--| ff tt := ff
| tt x := x
--| tt ff := ff
--| tt tt := tt

--tt && x = x
--ff & x = dd
--to use them we use dsimp[(&&),band]
--to use them in an assumption h we use dsimp[(&&),band] at h

def bor: bool → bool → bool
| tt x := tt
| ff x := x

local notation x && y := band x y
local notation x || y := bor x y
--predicate logic that every element of bool is either tt or ff:

example : ∀ x : bool, x=tt ∨ x=ff :=
begin
  assume a,
  cases a, -- a = ff, or a = tt
  right,
  reflexivity, --equal to themselves
  left,
  reflexivity,
end

-- to prove bool : cases

--tt and ff are different

def is_tt : bool → Prop
|ff := false
|tt := true

#reduce is_tt ff

theorem cons : tt ≠ ff  := --- \ne
-- ¬ (tt = ff)
-- (tt = ff) → false
begin
  assume tf,
  change (is_tt ff), -- to use is_tt replaces the current goal with another one that is definitionally the same
  rewrite ← tf,
  dsimp [is_tt], --move it back
  constructor,--trivial,
  --contradiction,
  --contradiction will solve the current goal if there is an inconsistent assumption like assuming that two different constructors of an inductive type are equal.
end

theorem distr_b : ∀ x y z : bool, x && (y || z) = x && y || x && z :=
begin
  assume a b c,
  cases a, --every a b c is either tt or ff
  --dsimp [band], --eliminate unneccarry part to make it clear
  --dsimp [bor],
  reflexivity,

  --dsimp[band],
  reflexivity,
end

theorem dm1_b : ∀ x y : bool, bnot (x || y) = bnot x && bnot y :=
begin
  sorry,
end

theorem dm2_b : ∀ x y : bool, bnot (x && y) = bnot x || bnot y :=
begin
  sorry,
end

-- prop, true, false
-- bool tt ff\

-- (∧) : Prop → Prop → Prop
-- (&&) : bool → bool → bool

theorem and_thm : ∀ x y : bool,  (x && y = tt) ↔ (x = tt) ∧ (y = tt) :=
begin
  assume a b,
  constructor,
  assume h,
  cases a,
  dsimp[(&&),band] at h,
  contradiction,

  constructor,
  reflexivity,
  exact h, -- b has to be tt if assumption h wotks

  assume g,
  cases g with g1 g2,
  rewrite g1,
  --dsimp
  exact g2,
end

example: ∀ x : bool, ∃ y : bool, y = bnot x  :=
begin
  assume a,
  existsi (bnot a), -- y = bnot a
  reflexivity,
end

example: ∀ y : bool, ∃ x : bool, y = bnot x  :=
begin
  assume y,
  existsi (bnot y), -- y = bnot a
  cases y,
  dsimp[bnot],
  reflexivity,
  dsimp[bnot],
  reflexivity,
end

example :∀ f : bool → bool, ∀ x : bool, ∃ y: bool, y = f x :=
begin
  assume f x,
  existsi (f x), --f(x) but in lean is f x
  reflexivity,
end

def foo (x : bool) : bool := ff
#reduce foo tt
#reduce foo ff

example : ¬ (∀ f : bool → bool, ∀ y : bool, ∃ x: bool, y = f x) :=
begin
  assume f,
  have g : ∀ y : bool, ∃ x: bool, y = foo x,
  apply f,

  have k : ∃ x: bool, tt = foo x,
  apply g,
  cases k with x y,
  dsimp[foo] at y,
  contradiction,
end

--can we always prove either p or not p?
--if we hace only bool, no type variables, no predicate variables, no prosositional variables,,,

end bool


/-
Copyright (c) 2022 Kevin H. Wilson. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kevin H. Wilson
-/
import analysis.calculus.mean_value
import analysis.normed_space.is_R_or_C
import order.filter.curry

/-!
# Swapping limits and derivatives via uniform convergence

The purpose of this file is to prove that the derivative of the pointwise limit of a sequence of
functions is the pointwise limit of the functions' derivatives when the derivatives converge
_uniformly_. The formal statement appears as `has_fderiv_at_of_tendsto_locally_uniformly_at`.

## Main statements

* `uniform_cauchy_seq_on_filter_of_fderiv`: If
    1. `f : ℕ → E → G` is a sequence of functions which have derivatives
       `f' : ℕ → E → (E →L[𝕜] G)` on a neighborhood of `x`,
    2. the functions `f` converge at `x`, and
    3. the derivatives `f'` form a Cauchy sequence uniformly on a neighborhood of `x`,
  then the `f` form a Cauchy sequence _uniformly_ on a neighborhood of `x`
* `has_fderiv_at_of_tendsto_uniformly_on_filter` : Suppose (1), (2), and (3) above are true. Let
  `g` (resp. `g'`) be the limiting function of the `f` (resp. `g'`). Then `f'` is the derivative of
  `g` on a neighborhood of `x`
* `has_fderiv_at_of_tendsto_uniformly_on`: An often-easier-to-use version of the above theorem when
  *all* the derivatives exist and functions converge on a common open set and the derivatives
  converge uniformly there.

Each of the above statements also has variations that support `deriv` instead of `fderiv`.

## Implementation notes

Our technique for proving the main result is the famous "`ε / 3` proof." In words, you can find it
explained, for instance, at [this StackExchange post](https://math.stackexchange.com/questions/214218/uniform-convergence-of-derivatives-tao-14-2-7).
The subtlety is that we want to prove that the difference quotients of the `g` converge to the `g'`.
That is, we want to prove something like:

```
∀ ε > 0, ∃ δ > 0, ∀ y ∈ B_δ(x), |y - x|⁻¹ * |(g y - g x) - g' x (y - x)| < ε.
```

To do so, we will need to introduce a pair of quantifers

```lean
∀ ε > 0, ∃ N, ∀ n ≥ N, ∃ δ > 0, ∀ y ∈ B_δ(x), |y - x|⁻¹ * |(g y - g x) - g' x (y - x)| < ε.
```

So how do we write this in terms of filters? Well, the initial definition of the derivative is

```lean
tendsto (|y - x|⁻¹ * |(g y - g x) - g' x (y - x)|) (𝓝 x) (𝓝 0)
```

There are two ways we might introduce `n`. We could do:

```lean
∀ᶠ (n : ℕ) in at_top, tendsto (|y - x|⁻¹ * |(g y - g x) - g' x (y - x)|) (𝓝 x) (𝓝 0)
```

but this is equivalent to the quantifier order `∃ N, ∀ n ≥ N, ∀ ε > 0, ∃ δ > 0, ∀ y ∈ B_δ(x)`,
which _implies_ our desired `∀ ∃ ∀ ∃ ∀` but is _not_ equivalent to it. On the other hand, we might
try

```lean
tendsto (|y - x|⁻¹ * |(g y - g x) - g' x (y - x)|) (at_top ×ᶠ 𝓝 x) (𝓝 0)
```

but this is equivalent to the quantifer order `∀ ε > 0, ∃ N, ∃ δ > 0, ∀ n ≥ N, ∀ y ∈ B_δ(x)`, which
again _implies_ our desired `∀ ∃ ∀ ∃ ∀` but is not equivalent to it.

So to get the quantifier order we want, we need to introduce a new filter construction, which we
call a "curried filter"

```lean
tendsto (|y - x|⁻¹ * |(g y - g x) - g' x (y - x)|) (at_top.curry (𝓝 x)) (𝓝 0)
```

Then the above implications are `filter.tendsto.curry` and
`filter.tendsto.mono_left filter.curry_le_prod`. We will use both of these deductions as part of
our proof.

We note that if you loosen the assumptions of the main theorem then the proof becomes quite a bit
easier. In particular, if you assume there is a common neighborhood `s` where all of the three
assumptions of `has_fderiv_at_of_tendsto_uniformly_on_filter` hold and that the `f'` are
continuous, then you can avoid the mean value theorem and much of the work around curried filters.

## Tags

uniform convergence, limits of derivatives
-/

open filter
open_locale uniformity filter topology

section limits_of_derivatives

variables {ι : Type*} {l : filter ι}
  {E : Type*} [normed_add_comm_group E]
  {𝕜 : Type*} [is_R_or_C 𝕜] [normed_space 𝕜 E]
  {G : Type*} [normed_add_comm_group G] [normed_space 𝕜 G]
  {f : ι → E → G} {g : E → G} {f' : ι → (E → (E →L[𝕜] G))} {g' : E → (E →L[𝕜] G)}
  {x : E}

/-- If a sequence of functions real or complex functions are eventually differentiable on a
neighborhood of `x`, they are Cauchy _at_ `x`, and their derivatives
are a uniform Cauchy sequence in a neighborhood of `x`, then the functions form a uniform Cauchy
sequence in a neighborhood of `x`. -/
lemma uniform_cauchy_seq_on_filter_of_fderiv
  (hf' : uniform_cauchy_seq_on_filter f' l (𝓝 x))
  (hf : ∀ᶠ (n : ι × E) in (l ×ᶠ 𝓝 x), has_fderiv_at (f n.1) (f' n.1 n.2) n.2)
  (hfg : cauchy (map (λ n, f n x) l)) :
  uniform_cauchy_seq_on_filter f l (𝓝 x) :=
begin
  letI : normed_space ℝ E, from normed_space.restrict_scalars ℝ 𝕜 _,
  rw seminormed_add_group.uniform_cauchy_seq_on_filter_iff_tendsto_uniformly_on_filter_zero at
    hf' ⊢,

  suffices : tendsto_uniformly_on_filter
    (λ (n : ι × ι) (z : E), f n.1 z - f n.2 z - (f n.1 x - f n.2 x)) 0 (l ×ᶠ l) (𝓝 x) ∧
    tendsto_uniformly_on_filter (λ (n : ι × ι) (z : E), f n.1 x - f n.2 x) 0 (l ×ᶠ l) (𝓝 x),
  { have := this.1.add this.2,
    rw add_zero at this,
    exact this.congr (by simp), },
  split,
  { -- This inequality follows from the mean value theorem. To apply it, we will need to shrink our
    -- neighborhood to small enough ball
    rw metric.tendsto_uniformly_on_filter_iff at hf' ⊢,
    intros ε hε,
    have := (tendsto_swap4_prod.eventually (hf.prod_mk hf)).diag_of_prod_right,
    obtain ⟨a, b, c, d, e⟩ := eventually_prod_iff.1 ((hf' ε hε).and this),
    obtain ⟨R, hR, hR'⟩ := metric.nhds_basis_ball.eventually_iff.mp d,
    let r := min 1 R,
    have hr : 0 < r, { simp [hR], },
    have hr' : ∀ ⦃y : E⦄, y ∈ metric.ball x r → c y,
    { exact (λ y hy, hR' (lt_of_lt_of_le (metric.mem_ball.mp hy) (min_le_right _ _))), },
    have hxy : ∀ (y : E), y ∈ metric.ball x r → ‖y - x‖ < 1,
    { intros y hy,
      rw [metric.mem_ball, dist_eq_norm] at hy,
      exact lt_of_lt_of_le hy (min_le_left _ _), },
    have hxyε : ∀ (y : E), y ∈ metric.ball x r → ε * ‖y - x‖ < ε,
    { intros y hy,
      exact (mul_lt_iff_lt_one_right hε.lt).mpr (hxy y hy), },

    -- With a small ball in hand, apply the mean value theorem
    refine eventually_prod_iff.mpr ⟨_, b, (λ e : E, metric.ball x r e),
      eventually_mem_set.mpr (metric.nhds_basis_ball.mem_of_mem hr), (λ n hn y hy, _)⟩,
    simp only [pi.zero_apply, dist_zero_left] at e ⊢,
    refine lt_of_le_of_lt _ (hxyε y hy),
    exact convex.norm_image_sub_le_of_norm_has_fderiv_within_le
      (λ y hy, ((e hn (hr' hy)).2.1.sub (e hn (hr' hy)).2.2).has_fderiv_within_at)
      (λ y hy, (e hn (hr' hy)).1.le)
      (convex_ball x r) (metric.mem_ball_self hr) hy, },
  { -- This is just `hfg` run through `eventually_prod_iff`
    refine metric.tendsto_uniformly_on_filter_iff.mpr (λ ε hε, _),
    obtain ⟨t, ht, ht'⟩ := (metric.cauchy_iff.mp hfg).2 ε hε,
    exact eventually_prod_iff.mpr
    ⟨ (λ (n : ι × ι), (f n.1 x ∈ t) ∧ (f n.2 x ∈ t)),
      eventually_prod_iff.mpr ⟨_, ht, _, ht, (λ n hn n' hn', ⟨hn, hn'⟩)⟩,
      (λ y, true),
      (by simp),
      (λ n hn y hy, by simpa [norm_sub_rev, dist_eq_norm] using ht' _ hn.1 _ hn.2)⟩, },
end

/-- A variant of the second fundamental theorem of calculus (FTC-2): If a sequence of functions
between real or complex normed spaces are differentiable on a ball centered at `x`, they
form a Cauchy sequence _at_ `x`, and their derivatives are Cauchy uniformly on the ball, then the
functions form a uniform Cauchy sequence on the ball.

NOTE: The fact that we work on a ball is typically all that is necessary to work with power series
and Dirichlet series (our primary use case). However, this can be generalized by replacing the ball
with any connected, bounded, open set and replacing uniform convergence with local uniform
convergence. See `cauchy_map_of_uniform_cauchy_seq_on_fderiv`.
-/
lemma uniform_cauchy_seq_on_ball_of_fderiv
  {r : ℝ} (hf' : uniform_cauchy_seq_on f' l (metric.ball x r))
  (hf : ∀ n : ι, ∀ y : E, y ∈ metric.ball x r → has_fderiv_at (f n) (f' n y) y)
  (hfg : cauchy (map (λ n, f n x) l)) :
  uniform_cauchy_seq_on f l (metric.ball x r) :=
begin
  letI : normed_space ℝ E, from normed_space.restrict_scalars ℝ 𝕜 _,
  haveI : ne_bot l, from (cauchy_map_iff.1 hfg).1,
  rcases le_or_lt r 0 with hr|hr,
  { simp only [metric.ball_eq_empty.2 hr, uniform_cauchy_seq_on, set.mem_empty_iff_false,
      is_empty.forall_iff, eventually_const, implies_true_iff] },
  rw seminormed_add_group.uniform_cauchy_seq_on_iff_tendsto_uniformly_on_zero at hf' ⊢,
  suffices : tendsto_uniformly_on
    (λ (n : ι × ι) (z : E), f n.1 z - f n.2 z - (f n.1 x - f n.2 x)) 0
      (l ×ᶠ l) (metric.ball x r) ∧
    tendsto_uniformly_on (λ (n : ι × ι) (z : E), f n.1 x - f n.2 x) 0
      (l ×ᶠ l) (metric.ball x r),
  { have := this.1.add this.2,
    rw add_zero at this,
    refine this.congr _,
    apply eventually_of_forall,
    intros n z hz,
    simp, },
  split,
  { -- This inequality follows from the mean value theorem
    rw metric.tendsto_uniformly_on_iff at hf' ⊢,
    intros ε hε,
    obtain ⟨q, hqpos, hq⟩ : ∃ q : ℝ, 0 < q ∧ q * r < ε,
    { simp_rw mul_comm,
      exact exists_pos_mul_lt hε.lt r, },
    apply (hf' q hqpos.gt).mono,
    intros n hn y hy,
    simp_rw [dist_eq_norm, pi.zero_apply, zero_sub, norm_neg] at hn ⊢,
    have mvt := convex.norm_image_sub_le_of_norm_has_fderiv_within_le
      (λ z hz, ((hf n.1 z hz).sub (hf n.2 z hz)).has_fderiv_within_at)
      (λ z hz, (hn z hz).le) (convex_ball x r) (metric.mem_ball_self hr) hy,
    refine lt_of_le_of_lt mvt _,
    have : q * ‖y - x‖ < q * r,
    { exact mul_lt_mul' rfl.le (by simpa only [dist_eq_norm] using metric.mem_ball.mp hy)
        (norm_nonneg _) hqpos, },
    exact this.trans hq, },
  { -- This is just `hfg` run through `eventually_prod_iff`
    refine metric.tendsto_uniformly_on_iff.mpr (λ ε hε, _),
    obtain ⟨t, ht, ht'⟩ := (metric.cauchy_iff.mp hfg).2 ε hε,
    rw eventually_prod_iff,
    refine ⟨(λ n, f n x ∈ t), ht, (λ n, f n x ∈ t), ht, _⟩,
    intros n hn n' hn' z hz,
    rw [dist_eq_norm, pi.zero_apply, zero_sub, norm_neg, ←dist_eq_norm],
    exact (ht' _ hn _ hn'), },
end

/-- If a sequence of functions between real or complex normed spaces are differentiable on a
preconnected open set, they form a Cauchy sequence _at_ `x`, and their derivatives are Cauchy
uniformly on the set, then the functions form a Cauchy sequence at any point in the set. -/
lemma cauchy_map_of_uniform_cauchy_seq_on_fderiv
  {s : set E} (hs : is_open s) (h's : is_preconnected s)
  (hf' : uniform_cauchy_seq_on f' l s)
  (hf : ∀ n : ι, ∀ y : E, y ∈ s → has_fderiv_at (f n) (f' n y) y)
  {x₀ x : E} (hx₀ : x₀ ∈ s) (hx : x ∈ s)
  (hfg : cauchy (map (λ n, f n x₀) l)) :
  cauchy (map (λ n, f n x) l) :=
begin
  haveI : ne_bot l, from (cauchy_map_iff.1 hfg).1,
  let t := {y | y ∈ s ∧ cauchy (map (λ n, f n y) l)},
  suffices H : s ⊆ t, from (H hx).2,
  have A : ∀ x ε, x ∈ t → metric.ball x ε ⊆ s → metric.ball x ε ⊆ t,
  from λ x ε xt hx y hy, ⟨hx hy, (uniform_cauchy_seq_on_ball_of_fderiv (hf'.mono hx)
    (λ n y hy, hf n y (hx hy)) xt.2).cauchy_map hy⟩,
  have open_t : is_open t,
  { rw metric.is_open_iff,
    assume x hx,
    rcases metric.is_open_iff.1 hs x hx.1 with ⟨ε, εpos, hε⟩,
    exact ⟨ε, εpos, A x ε hx hε⟩ },
  have st_nonempty : (s ∩ t).nonempty, from ⟨x₀, hx₀, ⟨hx₀, hfg⟩⟩,
  suffices H : closure t ∩ s ⊆ t, from h's.subset_of_closure_inter_subset open_t st_nonempty H,
  rintros x ⟨xt, xs⟩,
  obtain ⟨ε, εpos, hε⟩ : ∃ (ε : ℝ) (H : ε > 0), metric.ball x ε ⊆ s,
    from metric.is_open_iff.1 hs x xs,
  obtain ⟨y, yt, hxy⟩ : ∃ (y : E) (yt : y ∈ t), dist x y < ε / 2,
    from metric.mem_closure_iff.1 xt _ (half_pos εpos),
  have B : metric.ball y (ε / 2) ⊆ metric.ball x ε,
  { apply metric.ball_subset_ball', rw dist_comm, linarith },
  exact A y (ε / 2) yt (B.trans hε) (metric.mem_ball.2 hxy)
end

/-- If `f_n → g` pointwise and the derivatives `(f_n)' → h` _uniformly_ converge, then
in fact for a fixed `y`, the difference quotients `‖z - y‖⁻¹ • (f_n z - f_n y)` converge
_uniformly_ to `‖z - y‖⁻¹ • (g z - g y)` -/
lemma difference_quotients_converge_uniformly
  (hf' : tendsto_uniformly_on_filter f' g' l (𝓝 x))
  (hf : ∀ᶠ (n : ι × E) in (l ×ᶠ 𝓝 x), has_fderiv_at (f n.1) (f' n.1 n.2) n.2)
  (hfg : ∀ᶠ (y : E) in 𝓝 x, tendsto (λ n, f n y) l (𝓝 (g y))) :
  tendsto_uniformly_on_filter
    (λ n : ι, λ y : E, (‖y - x‖⁻¹ : 𝕜) • (f n y - f n x))
    (λ y : E, (‖y - x‖⁻¹ : 𝕜) • (g y - g x))
    l (𝓝 x) :=
begin
  letI : normed_space ℝ E, from normed_space.restrict_scalars ℝ 𝕜 _,
  rcases eq_or_ne l ⊥ with hl|hl,
  { simp only [hl, tendsto_uniformly_on_filter, bot_prod, eventually_bot, implies_true_iff] },
  haveI : ne_bot l := ⟨hl⟩,
  refine uniform_cauchy_seq_on_filter.tendsto_uniformly_on_filter_of_tendsto _
    ((hfg.and (eventually_const.mpr hfg.self_of_nhds)).mono (λ y hy, (hy.1.sub hy.2).const_smul _)),
  rw seminormed_add_group.uniform_cauchy_seq_on_filter_iff_tendsto_uniformly_on_filter_zero,
  rw metric.tendsto_uniformly_on_filter_iff,

  have hfg' := hf'.uniform_cauchy_seq_on_filter,
  rw seminormed_add_group.uniform_cauchy_seq_on_filter_iff_tendsto_uniformly_on_filter_zero at hfg',
  rw metric.tendsto_uniformly_on_filter_iff at hfg',
  intros ε hε,
  obtain ⟨q, hqpos, hqε⟩ := exists_pos_rat_lt hε,
  specialize hfg' (q : ℝ) (by simp [hqpos]),

  have := (tendsto_swap4_prod.eventually (hf.prod_mk hf)).diag_of_prod_right,
  obtain ⟨a, b, c, d, e⟩ := eventually_prod_iff.1 (hfg'.and this),
  obtain ⟨r, hr, hr'⟩ := metric.nhds_basis_ball.eventually_iff.mp d,

  rw eventually_prod_iff,
  refine ⟨_, b, (λ e : E, metric.ball x r e),
    eventually_mem_set.mpr (metric.nhds_basis_ball.mem_of_mem hr), (λ n hn y hy, _)⟩,
  simp only [pi.zero_apply, dist_zero_left],
  rw [← smul_sub, norm_smul, norm_inv, is_R_or_C.norm_coe_norm],
  refine lt_of_le_of_lt _ hqε,
  by_cases hyz' : x = y, { simp [hyz', hqpos.le], },
  have hyz : 0 < ‖y - x‖,
  {rw norm_pos_iff, intros hy', exact hyz' (eq_of_sub_eq_zero hy').symm, },
  rw [inv_mul_le_iff hyz, mul_comm, sub_sub_sub_comm],
  simp only [pi.zero_apply, dist_zero_left] at e,
  refine convex.norm_image_sub_le_of_norm_has_fderiv_within_le
    (λ y hy, ((e hn (hr' hy)).2.1.sub (e hn (hr' hy)).2.2).has_fderiv_within_at)
    (λ y hy, (e hn (hr' hy)).1.le)
    (convex_ball x r) (metric.mem_ball_self hr) hy,
end

/-- `(d/dx) lim_{n → ∞} f n x = lim_{n → ∞} f' n x` when the `f' n` converge
_uniformly_ to their limit at `x`.

In words the assumptions mean the following:
  * `hf'`: The `f'` converge "uniformly at" `x` to `g'`. This does not mean that the `f' n` even
    converge away from `x`!
  * `hf`: For all `(y, n)` with `y` sufficiently close to `x` and `n` sufficiently large, `f' n` is
    the derivative of `f n`
  * `hfg`: The `f n` converge pointwise to `g` on a neighborhood of `x` -/
lemma has_fderiv_at_of_tendsto_uniformly_on_filter [ne_bot l]
  (hf' : tendsto_uniformly_on_filter f' g' l (𝓝 x))
  (hf : ∀ᶠ (n : ι × E) in (l ×ᶠ 𝓝 x), has_fderiv_at (f n.1) (f' n.1 n.2) n.2)
  (hfg : ∀ᶠ y in 𝓝 x, tendsto (λ n, f n y) l (𝓝 (g y))) :
  has_fderiv_at g (g' x) x :=
begin
  -- The proof strategy follows several steps:
  --   1. The quantifiers in the definition of the derivative are
  --      `∀ ε > 0, ∃δ > 0, ∀y ∈ B_δ(x)`. We will introduce a quantifier in the middle:
  --      `∀ ε > 0, ∃N, ∀n ≥ N, ∃δ > 0, ∀y ∈ B_δ(x)` which will allow us to introduce the `f(') n`
  --   2. The order of the quantifiers `hfg` are opposite to what we need. We will be able to swap
  --      the quantifiers using the uniform convergence assumption
  rw has_fderiv_at_iff_tendsto,

  -- Introduce extra quantifier via curried filters
  suffices : tendsto
    (λ (y : ι × E), ‖y.2 - x‖⁻¹ * ‖g y.2 - g x - (g' x) (y.2 - x)‖) (l.curry (𝓝 x)) (𝓝 0),
  { rw metric.tendsto_nhds at this ⊢,
    intros ε hε,
    specialize this ε hε,
    rw eventually_curry_iff at this,
    simp only at this,
    exact (eventually_const.mp this).mono (by simp only [imp_self, forall_const]), },

  -- With the new quantifier in hand, we can perform the famous `ε/3` proof. Specifically,
  -- we will break up the limit (the difference functions minus the derivative go to 0) into 3:
  --   * The difference functions of the `f n` converge *uniformly* to the difference functions
  --     of the `g n`
  --   * The `f' n` are the derivatives of the `f n`
  --   * The `f' n` converge to `g'` at `x`
  conv
  { congr, funext,
    rw [←norm_norm, ←norm_inv,←@is_R_or_C.norm_of_real 𝕜 _ _,
      is_R_or_C.of_real_inv, ←norm_smul], },
  rw ←tendsto_zero_iff_norm_tendsto_zero,
  have : (λ a : ι × E, (‖a.2 - x‖⁻¹ : 𝕜) • (g a.2 - g x - (g' x) (a.2 - x))) =
    (λ a : ι × E, (‖a.2 - x‖⁻¹ : 𝕜) • (g a.2 - g x - (f a.1 a.2 - f a.1 x))) +
    (λ a : ι × E, (‖a.2 - x‖⁻¹ : 𝕜) • ((f a.1 a.2 - f a.1 x) -
      ((f' a.1 x) a.2 - (f' a.1 x) x))) +
    (λ a : ι × E, (‖a.2 - x‖⁻¹ : 𝕜) • ((f' a.1 x - g' x) (a.2 - x))),
  { ext, simp only [pi.add_apply], rw [←smul_add, ←smul_add], congr,
  simp only [map_sub, sub_add_sub_cancel, continuous_linear_map.coe_sub', pi.sub_apply], },
  simp_rw this,
  have : 𝓝 (0 : G) = 𝓝 (0 + 0 + 0), simp only [add_zero],
  rw this,
  refine tendsto.add (tendsto.add _ _) _,
  simp only,
  { have := difference_quotients_converge_uniformly hf' hf hfg,
    rw metric.tendsto_uniformly_on_filter_iff at this,
    rw metric.tendsto_nhds,
    intros ε hε,
    apply ((this ε hε).filter_mono curry_le_prod).mono,
    intros n hn,
    rw dist_eq_norm at hn ⊢,
    rw ← smul_sub at hn,
    rwa sub_zero, },
  { -- (Almost) the definition of the derivatives
    rw metric.tendsto_nhds,
    intros ε hε,
    rw eventually_curry_iff,
    refine hf.curry.mono (λ n hn, _),
    have := hn.self_of_nhds,
    rw [has_fderiv_at_iff_tendsto, metric.tendsto_nhds] at this,
    refine (this ε hε).mono (λ y hy, _),
    rw dist_eq_norm at hy ⊢,
    simp only [sub_zero, map_sub, norm_mul, norm_inv, norm_norm] at hy ⊢,
    rw [norm_smul, norm_inv, is_R_or_C.norm_coe_norm],
    exact hy, },
  { -- hfg' after specializing to `x` and applying the definition of the operator norm
    refine tendsto.mono_left _ curry_le_prod,
    have h1: tendsto (λ n : ι × E, g' n.2 - f' n.1 n.2) (l ×ᶠ 𝓝 x) (𝓝 0),
    { rw metric.tendsto_uniformly_on_filter_iff at hf',
      exact metric.tendsto_nhds.mpr (λ ε hε, by simpa using hf' ε hε), },
    have h2: tendsto (λ n : ι, g' x - f' n x) l (𝓝 0),
    { rw metric.tendsto_nhds at h1 ⊢,
      exact (λ ε hε, (h1 ε hε).curry.mono (λ n hn, hn.self_of_nhds)), },
    have := (tendsto_fst.comp (h2.prod_map tendsto_id)),
    refine squeeze_zero_norm _ (tendsto_zero_iff_norm_tendsto_zero.mp this),
    intros n,
    simp_rw [norm_smul, norm_inv, is_R_or_C.norm_coe_norm],
    by_cases hx : x = n.2, { simp [hx], },
    have hnx : 0 < ‖n.2 - x‖,
    { rw norm_pos_iff, intros hx', exact hx (eq_of_sub_eq_zero hx').symm, },
    rw [inv_mul_le_iff hnx, mul_comm],
    simp only [function.comp_app, prod_map],
    rw norm_sub_rev,
    exact (f' n.1 x - g' x).le_op_norm (n.2 - x), },
end

lemma has_fderiv_at_of_tendsto_locally_uniformly_on [ne_bot l] {s : set E} (hs : is_open s)
  (hf' : tendsto_locally_uniformly_on f' g' l s)
  (hf : ∀ n, ∀ x ∈ s, has_fderiv_at (f n) (f' n x) x)
  (hfg : ∀ x ∈ s, tendsto (λ n, f n x) l (𝓝 (g x)))
  (hx : x ∈ s) :
  has_fderiv_at g (g' x) x :=
begin
  have h1 : s ∈ 𝓝 x := hs.mem_nhds hx,
  have h3 : set.univ ×ˢ s ∈ l ×ᶠ 𝓝 x := by simp only [h1, prod_mem_prod_iff, univ_mem, and_self],
  have h4 : ∀ᶠ (n : ι × E) in l ×ᶠ 𝓝 x, has_fderiv_at (f n.1) (f' n.1 n.2) n.2,
    from eventually_of_mem h3 (λ ⟨n, z⟩ ⟨hn, hz⟩, hf n z hz),
  refine has_fderiv_at_of_tendsto_uniformly_on_filter _ h4 (eventually_of_mem h1 hfg),
  simpa [is_open.nhds_within_eq hs hx] using tendsto_locally_uniformly_on_iff_filter.mp hf' x hx,
end

/-- A slight variant of `has_fderiv_at_of_tendsto_locally_uniformly_on` with the assumption stated
in terms of `differentiable_on` rather than `has_fderiv_at`. This makes a few proofs nicer in
complex analysis where holomorphicity is assumed but the derivative is not known a priori. -/
lemma has_fderiv_at_of_tendsto_locally_uniformly_on' [ne_bot l] {s : set E} (hs : is_open s)
  (hf' : tendsto_locally_uniformly_on (fderiv 𝕜 ∘ f) g' l s)
  (hf : ∀ n, differentiable_on 𝕜 (f n) s)
  (hfg : ∀ x ∈ s, tendsto (λ n, f n x) l (𝓝 (g x)))
  (hx : x ∈ s) :
  has_fderiv_at g (g' x) x :=
begin
  refine has_fderiv_at_of_tendsto_locally_uniformly_on hs hf' (λ n z hz, _) hfg hx,
  exact ((hf n z hz).differentiable_at (hs.mem_nhds hz)).has_fderiv_at
end

/-- `(d/dx) lim_{n → ∞} f n x = lim_{n → ∞} f' n x` when the `f' n` converge
_uniformly_ to their limit on an open set containing `x`. -/
lemma has_fderiv_at_of_tendsto_uniformly_on [ne_bot l]
  {s : set E} (hs : is_open s)
  (hf' : tendsto_uniformly_on f' g' l s)
  (hf : ∀ (n : ι), ∀ (x : E), x ∈ s → has_fderiv_at (f n) (f' n x) x)
  (hfg : ∀ (x : E), x ∈ s → tendsto (λ n, f n x) l (𝓝 (g x))) :
  ∀ (x : E), x ∈ s → has_fderiv_at g (g' x) x :=
λ x, has_fderiv_at_of_tendsto_locally_uniformly_on hs hf'.tendsto_locally_uniformly_on hf hfg

/-- `(d/dx) lim_{n → ∞} f n x = lim_{n → ∞} f' n x` when the `f' n` converge
_uniformly_ to their limit. -/
lemma has_fderiv_at_of_tendsto_uniformly [ne_bot l]
  (hf' : tendsto_uniformly f' g' l)
  (hf : ∀ (n : ι), ∀ (x : E), has_fderiv_at (f n) (f' n x) x)
  (hfg : ∀ (x : E), tendsto (λ n, f n x) l (𝓝 (g x))) :
  ∀ (x : E), has_fderiv_at g (g' x) x :=
begin
  intros x,
  have hf : ∀ (n : ι), ∀ (x : E), x ∈ set.univ → has_fderiv_at (f n) (f' n x) x, { simp [hf], },
  have hfg : ∀ (x : E), x ∈ set.univ → tendsto (λ n, f n x) l (𝓝 (g x)), { simp [hfg], },
  have hf' : tendsto_uniformly_on f' g' l set.univ, { rwa tendsto_uniformly_on_univ, },
  refine has_fderiv_at_of_tendsto_uniformly_on is_open_univ hf' hf hfg x (set.mem_univ x),
end

end limits_of_derivatives

section deriv

/-! ### `deriv` versions of above theorems

In this section, we provide `deriv` equivalents of the `fderiv` lemmas in the previous section.
The protected function `promote_deriv` provides the translation between derivatives and Fréchet
derivatives
-/

variables {ι : Type*} {l : filter ι}
  {𝕜 : Type*} [is_R_or_C 𝕜]
  {G : Type*} [normed_add_comm_group G] [normed_space 𝕜 G]
  {f : ι → 𝕜 → G} {g : 𝕜 → G} {f' : ι → 𝕜 → G} {g' : 𝕜 → G}
  {x : 𝕜}

/-- If our derivatives converge uniformly, then the Fréchet derivatives converge uniformly -/
lemma uniform_cauchy_seq_on_filter.one_smul_right {l' : filter 𝕜}
  (hf' : uniform_cauchy_seq_on_filter f' l l') :
  uniform_cauchy_seq_on_filter (λ n, λ z, (1 : 𝕜 →L[𝕜] 𝕜).smul_right (f' n z)) l l' :=
begin
  -- The tricky part of this proof is that operator norms are written in terms of `≤` whereas
  -- metrics are written in terms of `<`. So we need to shrink `ε` utilizing the archimedean
  -- property of `ℝ`

  rw [seminormed_add_group.uniform_cauchy_seq_on_filter_iff_tendsto_uniformly_on_filter_zero,
      metric.tendsto_uniformly_on_filter_iff] at hf' ⊢,
  intros ε hε,
  obtain ⟨q, hq, hq'⟩ := exists_between hε.lt,
  apply (hf' q hq).mono,
  intros n hn,
  refine lt_of_le_of_lt _ hq',
  simp only [dist_eq_norm, pi.zero_apply, zero_sub, norm_neg] at hn ⊢,
  refine continuous_linear_map.op_norm_le_bound _ hq.le _,
  intros z,
  simp only [continuous_linear_map.coe_sub', pi.sub_apply, continuous_linear_map.smul_right_apply,
    continuous_linear_map.one_apply],
  rw [←smul_sub, norm_smul, mul_comm],
  exact mul_le_mul hn.le rfl.le (norm_nonneg _) hq.le,
end

lemma uniform_cauchy_seq_on_filter_of_deriv
  (hf' : uniform_cauchy_seq_on_filter f' l (𝓝 x))
  (hf : ∀ᶠ (n : ι × 𝕜) in (l ×ᶠ 𝓝 x), has_deriv_at (f n.1) (f' n.1 n.2) n.2)
  (hfg : cauchy (map (λ n, f n x) l)) :
  uniform_cauchy_seq_on_filter f l (𝓝 x) :=
begin
  simp_rw has_deriv_at_iff_has_fderiv_at at hf,
  exact uniform_cauchy_seq_on_filter_of_fderiv
    hf'.one_smul_right hf hfg,
end

lemma uniform_cauchy_seq_on_ball_of_deriv
  {r : ℝ} (hf' : uniform_cauchy_seq_on f' l (metric.ball x r))
  (hf : ∀ n : ι, ∀ y : 𝕜, y ∈ metric.ball x r → has_deriv_at (f n) (f' n y) y)
  (hfg : cauchy (map (λ n, f n x) l)) :
  uniform_cauchy_seq_on f l (metric.ball x r) :=
begin
  simp_rw has_deriv_at_iff_has_fderiv_at at hf,
  rw uniform_cauchy_seq_on_iff_uniform_cauchy_seq_on_filter at hf',
  have hf' : uniform_cauchy_seq_on (λ n, λ z, (1 : 𝕜 →L[𝕜] 𝕜).smul_right (f' n z)) l
    (metric.ball x r),
  { rw uniform_cauchy_seq_on_iff_uniform_cauchy_seq_on_filter,
    exact hf'.one_smul_right, },
  exact uniform_cauchy_seq_on_ball_of_fderiv hf' hf hfg,
end

lemma has_deriv_at_of_tendsto_uniformly_on_filter [ne_bot l]
  (hf' : tendsto_uniformly_on_filter f' g' l (𝓝 x))
  (hf : ∀ᶠ (n : ι × 𝕜) in (l ×ᶠ 𝓝 x), has_deriv_at (f n.1) (f' n.1 n.2) n.2)
  (hfg : ∀ᶠ y in 𝓝 x, tendsto (λ n, f n y) l (𝓝 (g y))) :
  has_deriv_at g (g' x) x :=
begin
  -- The first part of the proof rewrites `hf` and the goal to be functions so that Lean
  -- can recognize them when we apply `has_fderiv_at_of_tendsto_uniformly_on_filter`
  let F' := (λ n, λ z, (1 : 𝕜 →L[𝕜] 𝕜).smul_right (f' n z)),
  let G' := λ z, (1 : 𝕜 →L[𝕜] 𝕜).smul_right (g' z),
  simp_rw has_deriv_at_iff_has_fderiv_at at hf ⊢,

  -- Now we need to rewrite hf' in terms of continuous_linear_maps. The tricky part is that
  -- operator norms are written in terms of `≤` whereas metrics are written in terms of `<`. So we
  -- need to shrink `ε` utilizing the archimedean property of `ℝ`
  have hf' : tendsto_uniformly_on_filter F' G' l (𝓝 x),
  { rw metric.tendsto_uniformly_on_filter_iff at hf' ⊢,
    intros ε hε,
    obtain ⟨q, hq, hq'⟩ := exists_between hε.lt,
    apply (hf' q hq).mono,
    intros n hn,
    refine lt_of_le_of_lt _ hq',
    simp only [F', G', dist_eq_norm] at hn ⊢,
    refine continuous_linear_map.op_norm_le_bound _ hq.le _,
    intros z,
    simp only [continuous_linear_map.coe_sub', pi.sub_apply, continuous_linear_map.smul_right_apply,
      continuous_linear_map.one_apply],
    rw [←smul_sub, norm_smul, mul_comm],
    exact mul_le_mul hn.le rfl.le (norm_nonneg _) hq.le, },
  exact has_fderiv_at_of_tendsto_uniformly_on_filter hf' hf hfg,
end

lemma has_deriv_at_of_tendsto_locally_uniformly_on [ne_bot l] {s : set 𝕜} (hs : is_open s)
  (hf' : tendsto_locally_uniformly_on f' g' l s)
  (hf : ∀ᶠ n in l, ∀ x ∈ s, has_deriv_at (f n) (f' n x) x)
  (hfg : ∀ x ∈ s, tendsto (λ n, f n x) l (𝓝 (g x)))
  (hx : x ∈ s) :
  has_deriv_at g (g' x) x :=
begin
  have h1 : s ∈ 𝓝 x := hs.mem_nhds hx,
  have h2 : ∀ᶠ (n : ι × 𝕜) in l ×ᶠ 𝓝 x, has_deriv_at (f n.1) (f' n.1 n.2) n.2,
    from eventually_prod_iff.2 ⟨_, hf, λ x, x ∈ s, h1, λ n, id⟩,
  refine has_deriv_at_of_tendsto_uniformly_on_filter _ h2 (eventually_of_mem h1 hfg),
  simpa [is_open.nhds_within_eq hs hx] using tendsto_locally_uniformly_on_iff_filter.mp hf' x hx,
end

/-- A slight variant of `has_deriv_at_of_tendsto_locally_uniformly_on` with the assumption stated in
terms of `differentiable_on` rather than `has_deriv_at`. This makes a few proofs nicer in complex
analysis where holomorphicity is assumed but the derivative is not known a priori. -/
lemma has_deriv_at_of_tendsto_locally_uniformly_on' [ne_bot l] {s : set 𝕜} (hs : is_open s)
  (hf' : tendsto_locally_uniformly_on (deriv ∘ f) g' l s)
  (hf : ∀ᶠ n in l, differentiable_on 𝕜 (f n) s)
  (hfg : ∀ x ∈ s, tendsto (λ n, f n x) l (𝓝 (g x)))
  (hx : x ∈ s) :
  has_deriv_at g (g' x) x :=
begin
  refine has_deriv_at_of_tendsto_locally_uniformly_on hs hf' _ hfg hx,
  filter_upwards [hf] with n h z hz using ((h z hz).differentiable_at (hs.mem_nhds hz)).has_deriv_at
end

lemma has_deriv_at_of_tendsto_uniformly_on [ne_bot l]
  {s : set 𝕜} (hs : is_open s)
  (hf' : tendsto_uniformly_on f' g' l s)
  (hf : ∀ᶠ n in l, ∀ (x : 𝕜), x ∈ s → has_deriv_at (f n) (f' n x) x)
  (hfg : ∀ (x : 𝕜), x ∈ s → tendsto (λ n, f n x) l (𝓝 (g x))) :
  ∀ (x : 𝕜), x ∈ s → has_deriv_at g (g' x) x :=
λ x, has_deriv_at_of_tendsto_locally_uniformly_on hs hf'.tendsto_locally_uniformly_on hf hfg

lemma has_deriv_at_of_tendsto_uniformly [ne_bot l]
  (hf' : tendsto_uniformly f' g' l)
  (hf : ∀ᶠ n in l, ∀ (x : 𝕜), has_deriv_at (f n) (f' n x) x)
  (hfg : ∀ (x : 𝕜), tendsto (λ n, f n x) l (𝓝 (g x))) :
  ∀ (x : 𝕜), has_deriv_at g (g' x) x :=
begin
  intros x,
  have hf : ∀ᶠ n in l, ∀ (x : 𝕜), x ∈ set.univ → has_deriv_at (f n) (f' n x) x,
    by filter_upwards [hf] with n h x hx using h x,
  have hfg : ∀ (x : 𝕜), x ∈ set.univ → tendsto (λ n, f n x) l (𝓝 (g x)), { simp [hfg], },
  have hf' : tendsto_uniformly_on f' g' l set.univ, { rwa tendsto_uniformly_on_univ, },
  exact has_deriv_at_of_tendsto_uniformly_on is_open_univ hf' hf hfg x (set.mem_univ x),
end

end deriv


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

The "standard" semantics for type theory: `type`s denote `Type`s, and `terms` denote values of the corresponding types.
-/
import .syntax data.bool

/-
For now, we're only dealing with "pure" types, i.e. types without type variables and constructors only basic types and arrows.

Also, the use of Type* is illusory. Because we interpret `nat`, `bool`, etc. as the corresponding elements of Type 1, Type* is forced to be Type 1. Maybe we can get around this with lifting.
-/

namespace hol

/-
structure model :=
(domain : Type*)
(const_val : term.const → domain)
(app : domain → domain → domain)
-/

namespace type

/- evaluate the value of a type modulo a partial assignment, `bval`, to basic types -/

namespace basic

def evalp (bval : ℕ → option Type*) : type.basic → option Type*
| (user n) := bval n
| prop     := some Prop
| nat      := some _root_.nat
| bool     := some _root_.bool
| int      := some _root_.int
| unit     := some _root_.unit

def ok (bval : ℕ → option Type*) : type.basic → _root_.bool
| (user n) := option.is_some (bval n)
| prop     := tt
| nat      := tt
| bool     := tt
| int      := tt
| unit     := tt

def eval (bval : ℕ → option Type*) : Π b : type.basic, b.ok bval = tt → Type*
| (user n) h := option.get h
| prop     h := Prop
| nat      h := _root_.nat
| bool     h := _root_.bool
| int      h := _root_.int
| unit     h := _root_.unit

end basic

def lift_arrow : option Type* → option Type* → option Type*
| (some T₁) (some T₂) := some (T₁ → T₂)
| _         _         := none

def evalp (bval : ℕ → option Type*) : type → option Type*
| (Var n)         := none
| (Basic b)       := basic.evalp bval b
| (Arr t₁ t₂)     := lift_arrow (evalp t₁) (evalp t₂)
| (Constructor _) := none
| (App _ _ )      := none

def ok (bval : ℕ → option Type*) : type → bool
| (Var n)         := ff
| (Basic b)       := b.ok bval
| (Arr t₁ t₂)     := ok t₁ && ok t₂
| (Constructor _) := ff
| (App _ _ )      := ff

def eval (bval : ℕ → option Type*) : Π t : type, t.ok bval → Type*
| (Var n)         h := by { simp [type.ok] at h, contradiction }
| (Basic b)       h := b.eval bval h
| (Arr t₁ t₂)     h := eval t₁ (bool.band_elim_left h) →
                         eval t₂ (bool.band_elim_right h)
| (Constructor _) h := by { simp [type.ok] at h, contradiction }
| (App _ _ )      h := by { simp [type.ok] at h, contradiction }

/- some useful functions -/
theorem ok_domain (bval : ℕ → option Type*): Π t : type, t.ok bval = tt → t.domain.ok bval = tt :=
begin
  intro t, induction t; try {exact id},
  simp [type.domain, type.ok], intro h, simp [h]
end

theorem ok_codomain (bval : ℕ → option Type*): Π t : type, t.ok bval → t.codomain.ok bval :=
begin
  intro t, induction t; try {exact id},
  simp [type.codomain, type.ok]
end

def eval_ext (bval : ℕ → option Type*) (t₁ t₂: type) (h : t₁ = t₂) :
  ∀ h₁ h₂, t₁.eval bval h₁ = t₂.eval bval h₂ :=
by { rw h, intros, reflexivity }

end type

/- We can use these to interpret quantifiers with bool in place of Prop.

section
local attribute [instance] classical.prop_decidable

noncomputable def classical_ball (T : Type*) (f : T → bool) : bool :=
if ∀ t : T, f t = bool.tt then bool.tt else bool.ff

noncomputable def classical_bex (T : Type*) (f : T → bool) : bool :=
if ∃ t : T, f t = bool.tt then bool.tt else bool.ff

end
-/

namespace term

namespace const

inductive evaluates_to (bval : ℕ → option Type*) (cval : ℕ → option (Σ T : Type*, T)) :
  const → Π T : Type*, T → Prop
| eval_user (n : ℕ) (h : option.is_some (cval n)) (t : hol.type) (l : list hol.type) :
    evaluates_to ⟨kind.user n, t, l⟩ (option.get h).1 (option.get h).2
| eval_true    : evaluates_to ⟨kind.true, mk_prop, []⟩ Prop _root_.true
| eval_false   : evaluates_to ⟨kind.false, mk_prop, []⟩ Prop _root_.false
| eval_not     : evaluates_to ⟨kind.not, mk_prop ⇒ mk_prop, []⟩ (Prop → Prop) (λ P, ¬ P)
| eval_and     : evaluates_to ⟨kind.and, mk_prop ⇒ mk_prop ⇒ mk_prop, []⟩ (Prop → Prop → Prop)
                _root_.and
| eval_or      : evaluates_to ⟨kind.or, mk_prop ⇒ mk_prop ⇒ mk_prop, []⟩ (Prop → Prop → Prop)
                _root_.or
| eval_implies : evaluates_to ⟨kind.implies, mk_prop ⇒ mk_prop ⇒ mk_prop, []⟩
                    (Prop → Prop → Prop) (λ P Q, P → Q)
| eval_iff     : evaluates_to ⟨kind.iff, mk_prop ⇒ mk_prop ⇒ mk_prop, []⟩
                    (Prop → Prop → Prop) _root_.iff
| eval_all (t : hol.type) (h : t.ok bval) :
                  let T := type.eval bval t h in
                  evaluates_to ⟨kind.all, (t ⇒ mk_prop) ⇒ mk_prop, [t]⟩ ((T → Prop) → Prop)
                    (λ P, ∀ x : T, P x)
| eval_ex  (t : hol.type) (h : t.ok bval) :
                  let T := type.eval bval t h in
                  evaluates_to ⟨kind.all, (t ⇒ mk_prop) ⇒ mk_prop, [t]⟩ ((T → Prop) → Prop)
                    (λ P, ∃ x : T, P x)
| eval_add     : evaluates_to ⟨kind.add, mk_nat ⇒ mk_nat ⇒ mk_nat, []⟩ (nat → nat → nat) nat.add
| eval_mul     : evaluates_to ⟨kind.mul, mk_nat ⇒ mk_nat ⇒ mk_nat, []⟩ (nat → nat → nat) nat.mul
| eval_sub     : evaluates_to ⟨kind.sub, mk_nat ⇒ mk_nat ⇒ mk_nat, []⟩ (nat → nat → nat) nat.sub
| eval_bval (b : bool) : evaluates_to ⟨kind.bval b, mk_bool, []⟩ bool b
| eval_nval (n : nat)  : evaluates_to ⟨kind.nval n, mk_nat, []⟩ nat n

inductive ok (bval : ℕ → option Type*) (cval : ℕ → option (Σ T : Type*, T)) :
  const → Prop
| ok_user (n : ℕ) (t : hol.type) (l : list hol.type)
    (h₀ : option.is_some (cval n)) (h₁ : t.ok bval)
    (h₂ : t.eval bval h₁ = (option.get h₀).fst ) :
    ok ⟨kind.user n, t, l⟩
| ok_true  : ok ⟨kind.true, mk_prop, []⟩
| ok_false : ok ⟨kind.false, mk_prop, []⟩
| ok_not   : ok ⟨kind.not, mk_prop ⇒ mk_prop, []⟩
| ok_and   : ok ⟨kind.and, mk_prop ⇒ mk_prop ⇒ mk_prop, []⟩
| ok_or    : ok ⟨kind.or, mk_prop ⇒ mk_prop ⇒ mk_prop, []⟩
| ok_implies : ok ⟨kind.implies, mk_prop ⇒ mk_prop ⇒ mk_prop, []⟩
| ok_iff   : ok ⟨kind.iff, mk_prop ⇒ mk_prop ⇒ mk_prop, []⟩
| ok_all (t : hol.type) (h : t.ok bval)  :
                  ok ⟨kind.all, (t ⇒ mk_prop) ⇒ mk_prop, [t]⟩
| ok_ex  (t : hol.type) (h : t.ok bval)  :
                  ok ⟨kind.ex, (t ⇒ mk_prop) ⇒ mk_prop, [t]⟩
| ok_add   : ok ⟨kind.add, mk_nat ⇒ mk_nat ⇒ mk_nat, []⟩
| ok_mul   : ok ⟨kind.mul, mk_nat ⇒ mk_nat ⇒ mk_nat, []⟩
| ok_sub   : ok ⟨kind.sub, mk_nat ⇒ mk_nat ⇒ mk_nat, []⟩
| ok_bval (b : bool) : ok ⟨kind.bval b, mk_bool, []⟩
| ok_nval (n : nat) : ok ⟨kind.nval n, mk_nat, []⟩

def type_ok (bval : ℕ → option Type*) (cval : ℕ → option (Σ T : Type*, T)) :
  ∀ c : const, c.ok bval cval → c.type.ok bval
| ⟨kind.user n, t, l⟩ h  := by cases h; assumption
| ⟨kind.true, t, k⟩ h    := by cases h; apply eq.refl
| ⟨kind.false, t, k⟩ h   := by cases h; apply eq.refl
| ⟨kind.not, t, k⟩ h     := by cases h; apply eq.refl
| ⟨kind.and, t, k⟩ h     := by cases h; apply eq.refl
| ⟨kind.or, t, k⟩ h      := by cases h; apply eq.refl
| ⟨kind.implies, t, k⟩ h := by cases h; apply eq.refl
| ⟨kind.iff, t, k⟩ h     := by cases h; apply eq.refl
| ⟨kind.all, t, k⟩ h     :=
    begin
      cases k with ty k',
      cases h,
      cases k'; cases h,
      simp [type.ok, mk_prop, type.basic.ok],
      assumption
    end
| ⟨kind.ex, t, k⟩ h     :=
    begin
      cases k with ty k',
      cases h,
      cases k'; cases h,
      simp [type.ok, mk_prop, type.basic.ok],
      assumption
    end
| ⟨kind.add, t, k⟩ h     := by cases h; apply eq.refl
| ⟨kind.mul, t, k⟩ h     := by cases h; apply eq.refl
| ⟨kind.sub, t, k⟩ h     := by cases h; apply eq.refl
| ⟨kind.bval b, t, k⟩ h  := by cases h; apply eq.refl
| ⟨kind.nval n, t, k⟩ h  := by cases h; apply eq.refl

def eval (bval : ℕ → option Type*) (cval : ℕ → option (Σ T : Type*, T)) :
  Π (c : const) (h : c.ok bval cval),
    (c.type).eval bval (c.type_ok bval cval h)
| c@⟨kind.user n, ty, l⟩ h :=
    have h' : option.is_some (cval n), by cases h; assumption,
    have h'' :  c.type.eval bval (c.type_ok bval cval h)  = (option.get h').fst,
      by {cases h, assumption},
    cast h''.symm (option.get h').snd
| c@⟨kind.true, _, _⟩     h := cast (by cases h; reflexivity) _root_.true
| c@⟨kind.false, _, _⟩    h := cast (by cases h; reflexivity) _root_.false
| c@⟨kind.not, _, _⟩      h :=
    have h' : (c.type).eval bval (c.type_ok bval cval h) = (Prop → Prop),
      by cases h; reflexivity,
    cast h'.symm (λ p : Prop, ¬ p)
| c@⟨kind.and, _, _⟩      h :=
    have h' : (c.type).eval bval (c.type_ok bval cval h) = (Prop → (Prop → Prop)),
      by cases h; reflexivity,
    cast h'.symm _root_.and
| c@⟨kind.or, _, _⟩       h :=
    have h' : (c.type).eval bval (c.type_ok bval cval h) = (Prop → (Prop → Prop)),
      by cases h; reflexivity,
    cast h'.symm _root_.or
| c@⟨kind.implies, _, _⟩  h :=
    have h' : (c.type).eval bval (c.type_ok bval cval h) = (Prop → (Prop → Prop)),
      by cases h; reflexivity,
    cast h'.symm (λ p q, p → q)
| c@⟨kind.iff, _, _⟩      h :=
    have h' : (c.type).eval bval (c.type_ok bval cval h) = (Prop → (Prop → Prop)),
      by cases h; reflexivity,
    cast h'.symm _root_.iff
| c@⟨kind.all, _, [ty]⟩    h  :=
    have h' : ty.ok bval, by cases h; assumption,
    let T := ty.eval bval h' in
    have h'' : (c.type).eval bval (c.type_ok bval cval h) = ((T → Prop) → Prop),
      by cases h; reflexivity,
    cast h''.symm (λ P, ∀ x : T, P x)
| c@⟨kind.ex, _, [ty]⟩    h  :=
    have h' : ty.ok bval, by cases h; assumption,
    let T := ty.eval bval h' in
    have h'' : (c.type).eval bval (c.type_ok bval cval h) = ((T → Prop) → Prop),
      by cases h; reflexivity,
    cast h''.symm Exists
| c@⟨kind.add, _, _⟩      h := cast (by cases h; reflexivity) nat.add
| c@⟨kind.mul, _, _⟩      h := cast (by cases h; reflexivity) nat.mul
| c@⟨kind.sub, _, _⟩      h := cast (by cases h; reflexivity) nat.sub
| c@⟨kind.bval b, _, _⟩   h := cast (by cases h; reflexivity) b
| c@⟨kind.nval n, _, _⟩   h := cast (by cases h; reflexivity) n
| c@⟨kind.all, _, []⟩     h := false.elim (by cases h)
| c@⟨kind.all, _, a :: b :: l⟩ h := false.elim (by cases h)
| c@⟨kind.ex, _, []⟩     h := false.elim (by cases h)
| c@⟨kind.ex, _, a :: b :: l⟩ h := false.elim (by cases h)

/- TODO: prove that `evaluates_to` agrees with `eval`. -/

end const

inductive evaluates_to (bval : ℕ → option Type*) (cval : ℕ → option (Σ T : Type*, T)) :
  term → (list (Σ T : Type*, T)) → Π T : Type*, T → Prop
| eval_var {n : ℕ} {T : Type*} (σ : list (Σ T : Type*, T)) {h : n < σ.length} :
    evaluates_to (Var n) σ (σ.nth_le n h).fst (σ.nth_le n h).snd
| eval_const {c : const} {T : Type*} {a : T} {σ} (h : c.evaluates_to bval cval T a) :
    evaluates_to (Const c) σ T a
| eval_app {t₁ t₂ : term} {σ} {T₁ T₂ : Type} {f : T₁ → T₂} {a : T₁}
      (h₁ : evaluates_to t₁ σ (T₁ → T₂) f) (h₂ : evaluates_to t₂ σ T₁ a) :
    evaluates_to (term.App t₁ t₂) σ T₂ (f a)
| eval_abs {s : string} {ty : type} {t : term} {σ} {T₁ T₂ : Type} {f : T₁ → T₂} {a : T₁}
      (h₁ : ty.evalp bval = some T₁) (h₂ : ∀ a : T₁, evaluates_to t (⟨T₁, a⟩ :: σ) T₂ (f a)) :
    evaluates_to (term.Abs s ty t) σ (T₁ → T₂) f

/-
The reason it is so hard to write an evaluation function for a term is that there is
so much data, and constraints. To evaluate a term `t`, we need

  `σ` : a specification of the types of the free deBruijn indices
  `bval` : an interpretation of basic types
  `cval` : an interpretation of constants
  `l` : an assignment of values to the indices

and we need to know:

  `t` is well-typed with respect to `σ`, and `σ` assigns types to all free variables
  `bval` interprets all the relevant basic types
  `cval` interprets all the relevant constants, and assigns values of the right types
  `l` interprets all the relevant deBruin indices, and assigns values of the right types

The next complicated predicate says that a term `t` is well-typed and we have the right
data to interpret it.
-/

inductive ok (bval : ℕ → option Type*) (cval : ℕ → option (Σ T : Type*, T)) :
  Π (t : term) (σ : list type) (l : list (Σ T : Type*, T)), Prop
| var_ok (n : nat) (σ : list type) (l : list (Σ T : Type*, T))
      (h₀ : n < σ.length) (h₁ : n < l.length) (h₂ : (σ.nth_le n h₀).ok bval)
      (h₃ : (σ.nth_le n h₀).eval bval h₂ = (l.nth_le n h₁).fst) :
    ok (Var n) σ l
| const_ok (c : const) (σ : list type) (l : list (Σ T : Type*, T)) (h : c.ok bval cval) :
    ok (Const c) σ l
| app_ok (t₁ t₂ : term) (σ : list type) (l : list (Σ T : Type*, T))
      (h₁ : ok t₁ σ l) (h₂ : ok t₂ σ l)
      (h₃ : (typeof t₁ σ).is_arrow)
      (h₄ : (typeof t₁ σ).domain = typeof t₂ σ):
    ok (App t₁ t₂) σ l
| abs_ok (s : string) (ty : type) (t : term) (σ : list type) (l : list (Σ T : Type*, T))
      (h₀ : ty.ok bval)
      (h₁ : (typeof t (ty :: σ)).ok bval)
    ( h₂ : let T := ty.eval bval h₀ in
            ∀ a : T, ok t (ty :: σ) (⟨T, a⟩ :: l)) :
    ok (Abs s ty t) σ l

def type_ok (bval : ℕ → option Type*) (cval : ℕ → option (Σ T : Type*, T)) :
  Π (t : term) (σ : list type) (l : list (Σ T : Type*, T)) (h : t.ok bval cval σ l),
    (t.typeof σ).ok bval
| t@(Var n) σ l h :=
    have h₀ : n < σ.length, by cases h; assumption,
    have h' : t.typeof σ = σ.nth_le n h₀, by simp [typeof, h₀],
    by { rw h', cases h, assumption }
| (Const c) σ l h :=
    have h₀ : c.ok bval cval, by cases h; assumption,
    c.type_ok bval cval h₀
| (App t₁ t₂) σ l h :=
    have h₁ : t₁.ok bval cval σ l, by {cases h, assumption},
    by { simp [typeof], apply type.ok_codomain, apply type_ok t₁ σ l, assumption}
| (Abs s ty t) σ l h :=
    by { simp [typeof, type.ok], cases h, split; assumption }

def eval (bval : ℕ → option Type*) (cval : ℕ → option (Σ T : Type*, T)) :
  Π (t : term) (σ : list type) (l : list (Σ T : Type*, T)) (h : t.ok bval cval σ l),
    (t.typeof σ).eval bval (t.type_ok bval cval σ l h)
| (Var n) σ l h :=
    have h₀ : n < σ.length, by cases h; assumption,
    have h₁ : n < l.length, by cases h; assumption,
    have h₂ : (σ.nth_le n h₀).ok bval, by cases h; assumption,
    have h₃ : (σ.nth_le n h₀).eval bval h₂ = (l.nth_le n h₁).fst, by cases h; assumption,
    have h₄ : (typeof (Var n) σ).eval bval ((Var n).type_ok bval cval σ l h) =
        (l.nth_le n h₁).fst,
      by { rw ← h₃, apply type.eval_ext, simp [typeof, h₀] },
     cast h₄.symm (l.nth_le n h₁).snd
| (Const c) σ l h :=
    have h : c.ok bval cval, by cases h; assumption,
    c.eval bval cval h
| (App t₁ t₂) σ l h :=
    have h₁ : t₁.ok bval cval σ l, by cases h; assumption,
    have h₂ : t₂.ok bval cval σ l, by cases h; assumption,
    have h₃ : (typeof t₁ σ).is_arrow, by cases h; assumption,
    have h₄ : (typeof t₁ σ).domain = typeof t₂ σ, by cases h; assumption,
    have h₅ : typeof t₁ σ = ((typeof t₁ σ).domain ⇒ (typeof t₁ σ).codomain), from type.eq_of_is_arrow _ h₃,
    have h₆ : (typeof t₁ σ).ok bval, from t₁.type_ok bval cval σ l h₁,
    have h₇ : ((typeof t₁ σ).domain ⇒ (typeof t₁ σ).codomain).ok bval, by rw ← h₅; exact h₆,
    have h₈ : (typeof t₁ σ).eval bval h₆ = ((typeof t₁ σ).domain ⇒ (typeof t₁ σ).codomain).eval bval h₇,
      from type.eval_ext bval _ _ h₅ _ _,
    have h₉ : (typeof t₁ σ).domain.ok bval, from type.ok_domain _ _ h₆,
    have h₁₀ : (typeof t₁ σ).codomain.ok bval, from type.ok_codomain _ _ h₆,
    have h₁₁ : (typeof t₁ σ).eval bval h₆ =
                  ((typeof t₁ σ).domain.eval bval h₉ → (typeof t₁ σ).codomain.eval bval h₁₀),
      from h₈,
    have h₁₂ : (typeof t₂ σ).ok bval, from t₂.type_ok bval cval σ l h₂,
    have h₁₃ : (typeof t₂ σ).eval bval h₁₂ = (typeof t₁ σ).domain.eval bval h₉,
      from type.eval_ext bval _ _ h₄.symm _ _,
    let  v₁ := eval t₁ σ l h₁,
         v₂ := eval t₂ σ l h₂ in
    (cast h₁₁ v₁) (cast h₁₃ v₂)
| (Abs s ty t) σ l h :=
    have h₀ : ty.ok bval, by cases h; assumption,
    have h₁ : (typeof t (ty :: σ)).ok bval, by cases h; assumption,
    let T := ty.eval bval h₀ in
    have h₂ : ∀ a : T, t.ok bval cval (ty :: σ) (⟨T, a⟩ :: l), by cases h; assumption,
    have h₃ : ∀ a : T, (typeof t (ty :: σ)).ok bval,
      from assume a, type_ok bval cval t _ (⟨T, a⟩ :: l) (h₂ a),
    let v := λ a : T, eval t (ty :: σ) (⟨T, a⟩ :: l) (h₂ a) in
    have h₄ : (Π (a : T), type.eval bval (typeof t (ty :: σ)) (h₃ a)) =
           type.eval bval (typeof (Abs s ty t) σ) ((Abs s ty t).type_ok bval cval σ l h),
      from rfl,
    cast h₄ v

end term

end hol


/-
unit tests suggested by Kevin Buzzard
-/

import data.complex.basic -- ℕ, ℤ, ℚ, ℝ, ℂ
import norm_cast

constants (an bn cn dn : ℕ) (az bz cz dz : ℤ) (aq bq cq dq : ℚ)
constants (ar br cr dr : ℝ) (ac bc cc dc : ℂ)

example : (an : ℤ) = bn → an = bn := λ h, by exact_mod_cast h -- by simp
example : an = bn → (an : ℤ) = bn := λ h, by exact_mod_cast h -- by simp
example : az = bz ↔ (az : ℚ) = bz := by norm_cast -- by simp

example : (aq : ℝ) = br ↔ (aq : ℂ) = br := by norm_cast
example : (an : ℚ) = bz ↔ (an : ℂ) = bz := by norm_cast
example : (((an : ℤ) : ℚ) : ℝ) = bq ↔ ((an : ℚ) : ℂ) = (bq : ℝ) :=
by norm_cast

example : (an : ℤ) < bn ↔ an < bn             := by norm_cast -- by simp
example : (an : ℚ) < bz ↔ (an : ℝ) < bz       := by norm_cast
example : ((an : ℤ) : ℝ) < bq ↔ (an : ℚ) < bq := by norm_cast
example : (an : ℤ) ≠ (bn : ℤ) ↔ an ≠ bn := by norm_cast -- by simp

-- zero and one cause special problems
example : 0 < (bq : ℝ) ↔ 0 < bq := by norm_cast -- by simp
example : az > (1 : ℕ) ↔ az > 1 := by norm_cast -- by simp
example : az > (0 : ℕ) ↔ az > 0 := by norm_cast -- by simp
example : (an : ℤ) ≠ 0 ↔ an ≠ 0 := by norm_cast -- by simp
example : aq < (1 : ℕ) ↔ (aq : ℝ) < (1 : ℤ) := by norm_cast

example : (an : ℤ) + bn = (an + bn : ℕ)   := by norm_cast -- by simp
example : (an : ℂ) + bq = ((an + bq) : ℚ) := by norm_cast -- by simp
example : (((an : ℤ) : ℚ) : ℝ) + bn = (an + (bn : ℤ)) := by norm_cast -- by simp

example : (((((an : ℚ) : ℝ) * bq) + (cq : ℝ) ^ dn) : ℂ) = (an : ℂ) * (bq : ℝ) + cq ^ dn :=
by norm_cast -- by simp
example : ((an : ℤ) : ℝ) < bq ∧ (cr : ℂ) ^ 2 = dz ↔ (an : ℚ) < bq ∧ ((cr ^ 2) : ℂ) = dz :=
by norm_cast

example : (an : ℤ) = 1 → an = 1 := λ h, by exact_mod_cast h
example : (an : ℤ) < 5 → an < 5 := λ h, by exact_mod_cast h
example : an < 5 → (an : ℤ) < 5 := λ h, by exact_mod_cast h
example : (an + 5) < 10 → (an : ℤ) + 5 < 10 := λ h, by exact_mod_cast h
example : (an : ℤ) + 5 < 10 → (an + 5) < 10 := λ h, by exact_mod_cast h
example : ((an + 5 : ℕ) : ℤ) < 10 → an + 5 < 10 := λ h, by exact_mod_cast h
example : an + 5 < 10 → ((an + 5 : ℕ) : ℤ) < 10 := λ h, by exact_mod_cast h

example (h : (cz : ℚ) = az / bz) : (cz : ℝ) = az / bz :=
by rw_mod_cast [← rat.cast_coe_int az, h]

example (h : bn ≤ an) : an - bn = 1 ↔ (an - bn : ℤ) = 1 :=
by norm_cast