Theory Domain_of_Attraction
section ‹Domain of Attraction›
theory Domain_of_Attraction
imports
"HOL-Probability.Weak_Convergence"
"Cauchy_Functional_Equation.Cauchy_Functional_Equation"
"Pareto_Distribution"
begin
text ‹This theory file is based on Chapter~1 of the book
by de Haan and Ferreira~\<^cite>‹deHaanFerreira›.›
subsection ‹Definitions›
text ‹We work with distribution functions as plain functions \<^typ>‹real ⇒ real›,
as does the book.
The corresponding statements for i.i.d.\ random variables
are given in Section~\ref{sec:examples}.›
subsubsection ‹Degenerate Distributions›
definition degenerate_df :: "(real ⇒ real) ⇒ bool" where
"degenerate_df F ⟷ (∀x. F x = 0 ∨ F x = 1)"
lemma degenerate_df_iff_indicator:
assumes "right_continuous_mono F 0 1"
shows "degenerate_df F ⟷ (∃c. F = (λx. indicat_real {c..} x))"
proof -
interpret right_continuous_mono F 0 1 by fact
show ?thesis
proof
assume deg: "degenerate_df F"
hence F01: "⋀x. F x = 0 ∨ F x = 1"
by (auto simp: degenerate_df_def)
obtain z where z: "F z = 1"
using order_tendstoD[OF top, of "1/2"] F01
by (fastforce dest!: eventually_happens'[OF trivial_limit_at_top_linorder])
obtain w where w: "F w = 0"
using order_tendstoD[OF bot, of "1/2"] F01
by (fastforce dest!: eventually_happens'[OF trivial_limit_at_bot_linorder])
define c where "c = Inf {x. F x = 1}"
have ne: "{x. F x = 1} ≠ {}"
using z by auto
have bdd: "bdd_below {x. F x = 1}"
proof (intro bdd_belowI[of _ w])
fix x
assume "x ∈ {x. F x = 1}"
thus "w ≤ x"
using monoD[OF mono, of x w] w by force
qed
have F1: "F x = 1" if "c < x" for x
proof -
have "Inf {x. F x = 1} < x"
using that by (simp add: c_def)
from cInf_lessD[OF ne this] obtain x' where "F x' = 1" "x' < x"
by auto
thus ?thesis
using monoD[OF mono, of x' x] F01[of x] by auto
qed
have F0: "F x = 0" if "x < c" for x
using cInf_lower[OF _ bdd] that F01[of x] by (fastforce simp: c_def leD)
have Fc: "F c = 1"
proof (rule tendsto_unique[of "at_right c" F])
show "(F ⤏ F c) (at_right c)"
using cont[of c] by (simp add: continuous_within)
show "(F ⤏ 1) (at_right c)"
by (intro tendsto_eventually eventually_mono[OF eventually_at_right_less])
(simp add: F1)
qed auto
have "F = (λx. indicat_real {c..} x)"
proof
fix x
consider "x < c" | "x = c" | "c < x"
by argo
thus "F x = indicat_real {c..} x"
by cases (auto simp: F0 F1 Fc indicator_def)
qed
thus "∃c. F = (λx. indicat_real {c..} x)" ..
qed(auto simp: degenerate_df_def indicator_def)
qed
lemma EVD_cdf_nondegenerate:
assumes [arith]:"0 < σ"
shows "¬ degenerate_df (EVD_cdf ξ μ σ)"
by(auto simp: degenerate_df_def EVD_cdf_def Let_def intro!: exI[where x=μ])
subsubsection ‹Domain of Attraction›
definition domain_of_attraction :: "(real ⇒ real) ⇒ (real ⇒ real) ⇒ bool"
(infix ‹(in'_domain'_attraction'_of)› 50) where
"domain_of_attraction F G ⟷
right_continuous_mono F 0 1 ∧ right_continuous_mono G 0 1 ∧
(∃a b. (∀n::nat. 0 < a n) ∧ weak_conv (λn x. F (a n * x + b n) ^ n) G)"
lemma domain_of_attractionD:
assumes "domain_of_attraction F G"
shows "right_continuous_mono F 0 1" "right_continuous_mono G 0 1"
and "∃a b. (∀n::nat. 0 < a n) ∧ weak_conv (λn x. F (a n * x + b n) ^ n) G"
using assms by(auto simp: domain_of_attraction_def)
lemma domain_of_attractionI_eventually_pos:
assumes F:"right_continuous_mono F 0 1"
and G:"right_continuous_mono G 0 1"
and a_pos:"∀⇩F n in at_top. a n > 0"
and wc:"weak_conv (λn x. F (a n * x + b n) ^ n) G"
shows "domain_of_attraction F G"
proof -
obtain k where a:"⋀n. k ≤ n ⟹ a n > 0"
using a_pos eventually_sequentially by auto
define a' where "a' ≡ λn. if n < k then 1 else a n"
have a'_pos:"a' n > 0" for n
using a by(cases "n < k") (auto simp: a'_def)
have ev:"∀⇩F n in sequentially.
F (a n * x + b n) ^ n = F (a' n * x + b n) ^ n" for x
by(auto intro!: eventually_sequentiallyI[where c=k] simp: a'_def)
hence wc':"weak_conv (λn x. F (a' n * x + b n) ^ n) G"
using wc by(auto simp: weak_conv_cong[OF ev])
thus ?thesis
unfolding domain_of_attraction_def
using F G a'_pos
by(intro conjI exI[where x=a',OF exI[where x=b]]) auto
qed
lemma domain_of_attraction_EVD_cdf_rescale:
fixes γ μ1 μ2 σ1 σ2 :: real
assumes sigma1[arith]: "0 < σ1" and sigma2[arith]: "0 < σ2"
and dom: "domain_of_attraction F (EVD_cdf γ μ1 σ1)"
shows "domain_of_attraction F (EVD_cdf γ μ2 σ2)"
proof -
obtain a b where a: "⋀n. 0 < a n"
and wc: "weak_conv (λn x. F (a n * x + b n) ^ n) (EVD_cdf γ μ1 σ1)"
and F: "right_continuous_mono F 0 1"
using dom unfolding domain_of_attraction_def by blast
define a' where "a' = (λn. a n * σ1 / σ2)"
define b' where "b' = (λn. a n * μ1 - a n * σ1 * μ2 / σ2 + b n)"
have a'_pos: "0 < a' n" for n
using a by (simp add: a'_def)
have arg_eq: "a' n * y + b' n = a n * (σ1 / σ2 * (y - μ2) + μ1) + b n" for n y
by (simp add: a'_def b'_def field_simps)
have fun_eq: "(λn. F (a' n * y + b' n) ^ n)
= (λn. F (a n * (σ1 / σ2 * (y - μ2) + μ1) + b n) ^ n)" for y
by (simp add: arg_eq)
have EVD_eq: "EVD_cdf γ μ1 σ1 (σ1 / σ2 * (y - μ2) + μ1) = EVD_cdf γ μ2 σ2 y" for y
proof -
have "EVD_cdf γ μ1 σ1 (σ1 / σ2 * (y - μ2) + μ1)
= EVD_cdf γ 0 1 ((σ1 / σ2 * (y - μ2) + μ1 - μ1) / σ1)"
by (subst EVD_cdf_location_scale) simp_all
also have "... = EVD_cdf γ 0 1 ((y - μ2) / σ2) "
by simp
also have "... = EVD_cdf γ μ2 σ2 y"
by (simp add: EVD_cdf_location_scale)
finally show ?thesis .
qed
have wc': "weak_conv (λn y. F (a' n * y + b' n) ^ n) (EVD_cdf γ μ2 σ2)"
using wc isCont_EVD_cdf[OF sigma1]
unfolding weak_conv_def EVD_eq[symmetric] fun_eq
by simp
show ?thesis
unfolding domain_of_attraction_def
using F a'_pos right_continuous_mono_EVD_cdf[OF sigma2] wc' by blast
qed
theorem domain_of_attraction_EVD_cdf_iff:
fixes γ μ σ :: real
assumes sigma[arith]: "0 < σ"
shows "domain_of_attraction F (EVD_cdf γ μ σ) ⟷ domain_of_attraction F (EVD_cdf γ 0 1)"
using domain_of_attraction_EVD_cdf_rescale[OF sigma,of 1]
domain_of_attraction_EVD_cdf_rescale[OF zero_less_one sigma] by auto
lemma EVD_cdf_MDA:
assumes sigma[arith]:"0 < σ"
shows "domain_of_attraction (EVD_cdf ξ μ σ) (EVD_cdf ξ μ σ)"
proof -
interpret real_distribution "density lborel (EVD_density ξ μ σ)"
by(rule real_distribution_EVD[OF sigma])
define a where "a = (λn::nat. if n = 0 ∨ ξ = 0 then 1 else real n powr ξ)"
define b where "b = (λn::nat. if n = 0 then 0 else if ξ = 0 then σ * ln (real n)
else (μ - σ / ξ) * (1 - real n powr ξ))"
have a_pos: "0 < a n" for n
by (auto simp: a_def)
have eq: "EVD_cdf ξ μ σ (a n * x + b n) ^ n = EVD_cdf ξ μ σ x" if n: "0 < n" for n x
proof -
have npos: "(0::real) < real n"
using n by simp
have "EVD_cdf ξ μ σ (a n * x + b n) ^ n = EVD_cdf ξ 0 1 ((a n * x + b n - μ) / σ) ^ n"
by(simp add: EVD_cdf_location_scale)
also have "… = EVD_cdf ξ 0 1 (if ξ = 0 then (a n * x + b n - μ) / σ - ln (real n)
else real n powr (- ξ) * ((a n * x + b n - μ) / σ)
+ (real n powr (- ξ) - 1) / ξ)"
by (rule EVD_cdf_max_stable[OF n])
also have "(if ξ = 0 then (a n * x + b n - μ) / σ - ln (real n)
else real n powr (- ξ) * ((a n * x + b n - μ) / σ)
+ (real n powr (- ξ) - 1) / ξ) = (x - μ) / σ"
by (cases "ξ = 0")
(use npos in "auto simp: a_def b_def field_simps powr_minus_divide")
also have "EVD_cdf ξ 0 1 ((x - μ) / σ) = EVD_cdf ξ μ σ x"
by(simp add: EVD_cdf_location_scale)
finally show ?thesis .
qed
have wc: "weak_conv (λn x. EVD_cdf ξ μ σ (a n * x + b n) ^ n) (EVD_cdf ξ μ σ)"
unfolding weak_conv_def
by (intro allI impI tendsto_eventually eventually_mono[OF eventually_gt_at_top[of 0]])
(simp add: eq)
show ?thesis
unfolding domain_of_attraction_def
using right_continuous_mono_axioms a_pos wc by blast
qed
lemma GPD_cdf_MDA:
fixes γ μ σ :: real
assumes "0 < σ"
shows "domain_of_attraction (GPD_cdf γ μ σ) (EVD_cdf γ 0 1)"
using assms
by(intro domain_of_attractionI_eventually_pos[OF _ _ eventually_sequentiallyI[of 1],
where a="λn. σ * (if γ = 0 then 1 else real n powr γ)"
and b="λn. μ + σ * (if γ = 0 then ln (real n) else (real n powr γ - 1) / γ)"]
right_continuous_mono_GPD_cdf right_continuous_mono_EVD_cdf
LIMSEQ_imp_weak_conv GPD_normalization) auto
lemma domain_of_attraction_affine:
fixes c d :: real
assumes c[arith]:"0 < c" and dm:"domain_of_attraction F G"
shows "domain_of_attraction (λx. F ((x - d) / c)) G"
proof -
have F:"right_continuous_mono F 0 1"
and G:"right_continuous_mono G 0 1"
and "∃a b. (∀n. 0 < a n) ∧ weak_conv (λn x. F (a n * x + b n) ^ n) G"
using domain_of_attractionD[OF dm] by auto
then obtain a b where a:"⋀n. 0 < a n" and wc:"weak_conv (λn x. F (a n * x + b n) ^ n) G"
by blast
interpret F: right_continuous_mono F 0 1
by fact
have lim1:"LIM x at_top. (x - d) / c :> at_top"
using filterlim_tendsto_pos_mult_at_top[OF tendsto_const[of "1 / c"] _
filterlim_tendsto_add_at_top[OF tendsto_const[of "- d" at_top],of "λx. x"]]
by(simp add: filterlim_ident)
have lim2:"LIM x at_bot. (x - d) / c :> at_bot"
using filterlim_tendsto_pos_mult_at_bot[OF tendsto_const[of "1 / c"] _
filterlim_tendsto_add_at_bot_iff
[THEN iffD2,OF tendsto_const[of "- d" at_bot],of "λx. x"]]
by(simp add: filterlim_ident)
have 1:"right_continuous_mono (λx. F ((x - d) / c)) 0 1"
proof
fix x :: real
have *:"(λx. (x - d) / c) ` {x<..} = {(x - d) / c<..}"
by(intro image_mono_on_continuous_on_greaterThan)
(auto intro!: strict_mono_onI continuous_on_divide continuous_on_diff
simp: divide_strict_right_mono lim1)
show "continuous (at_right x) (λx. F ((x - d) / c))"
by(rule continuous_within_compose2[where g=F])
(auto simp: continuous_cdivide_iff continuous_diff * F.cont)
show " ((λx. F ((x - d) / c)) ⤏ 0) at_bot"
"((λx. F ((x - d) / c)) ⤏ 1) at_top"
by(auto intro!: filterlim_compose[where g=F,OF _ lim1] F.bot F.top
filterlim_compose[where g=F,OF _ lim2])
show "mono (λx. F ((x - d) / c))"
by(auto intro!: monoD[OF F.mono] monoI simp: divide_right_mono)
qed
show ?thesis
by(auto intro!: exI[where x="λn. c * a n",OF conjI[OF _ exI[where x="λn. c * b n + d"]]]
simp: domain_of_attraction_def 1 G a distrib_left[symmetric] mult.assoc wc)
qed
subsection ‹Fisher--Tippett--Gnedenko Theorem›
text ‹The following two definitions correspond to
the functions $U$ and $D$ in equation~(1.1.6) in the book.›
abbreviation tail_quantile :: "(real ⇒ real) ⇒ real ⇒ real" where
"tail_quantile F t ≡ ginv F (1 - 1 / t)"
text ‹@{term tail_quantile} is exactly the \emph{return level}
associated with \emph{return period} $t$.›
abbreviation limit_quantile :: "(real ⇒ real) ⇒ real ⇒ real" where
"limit_quantile G y ≡ ginv G (exp (- (1 / y)))"
lemma lt_tail_quantile_iff:
fixes F :: "real ⇒ real"
assumes F: "right_continuous_mono F 0 1" and s: "1 < s"
shows "w < tail_quantile F s ⟷ 1 / s < 1 - F w"
proof -
have p: "0 < 1 - 1 / s" "1 - 1 / s < 1"
using s by simp_all
show ?thesis
using right_continuous_mono.ginv_le_iff[OF F p, of w] by linarith
qed
lemma tail_quantile_le_of_lt_inv:
assumes F: "right_continuous_mono F 0 1"
and Ft[arith]: "F t < 1"
and u1[arith]: "1 < u" and u2[arith]: "u < 1 / (1 - F t)"
shows "tail_quantile F u ≤ t"
by(subst right_continuous_mono.ginv_le_iff[OF F])
(use pos_less_divide_eq[THEN iffD1,OF _ u2] in "simp_all add: field_simps")
lemma t_lt_tail_quantile_of_gt_inv:
fixes F :: "real ⇒ real" and t u :: real
assumes F: "right_continuous_mono F 0 1"
and Ft: "F t < 1"
and u: "1 / (1 - F t) < u"
shows "t < tail_quantile F u"
by (smt (verit, best) assms ln_divide_pos ln_less_cancel_iff right_continuous_mono.a_le_f
right_continuous_mono.ginv_le_iff zero_less_divide_1_iff)
lemma tail_quantile_at_top:
fixes F :: "real ⇒ real"
assumes F: "right_continuous_mono F 0 1"
and unbdd: "⋀x. F x < 1"
shows "filterlim (tail_quantile F) at_top at_top"
unfolding filterlim_at_top
proof
interpret right_continuous_mono F 0 1
by fact
fix M :: real
show "∀⇩F t in at_top. M ≤ tail_quantile F t"
using eventually_gt_at_top[of "1 / (1 - F M)"] eventually_gt_at_top[of "1::real"]
by eventually_elim
(use assms less_eq_real_def F t_lt_tail_quantile_of_gt_inv in presburger)
qed
lemma limit_quantile_left_cont:
assumes G: "right_continuous_mono G 0 1" and p: "0 < p"
shows "(limit_quantile G ⤏ limit_quantile G p) (at_left p)"
proof -
interpret right_continuous_mono G 0 1
by fact
define g where "g = (λy::real. exp (- 1 / y))"
have g_tendsto: "(g ⤏ g p) (at_left p)"
unfolding g_def using p by (intro tendsto_intros) simp
have g_ev: "∀⇩F y in at_left p. 0 < y ∧ y < p"
using eventually_at_left_field[where x = p] p by auto
have g_lt: "∀⇩F y in at_left p. g y < g p"
using p by(auto intro!: eventually_mono[OF g_ev] simp: g_def field_simps)
note g_at_left = tendsto_imp_filterlim_at_left[OF g_tendsto g_lt]
have g01: "0 < g p" "g p < 1"
unfolding g_def using p by auto
have "filterlim (ginv G) (nhds (ginv G (g p))) (at_left (g p))"
using ginv_left_cont[OF g01] by simp
from filterlim_compose[OF this g_at_left]
show ?thesis
by(simp add: g_def)
qed
lemma limit_quantile_left_cont_scale:
assumes G: "right_continuous_mono G 0 1" and y: "0 < y" and p: "0 < p"
shows "((λx. limit_quantile G (x * y)) ⤏ limit_quantile G (p * y)) (at_left p)"
proof -
have mult_tendsto: "((λx. x * y) ⤏ p * y) (at_left p)"
by (intro tendsto_intros)
have mult_ev: "∀⇩F x in at_left p. 0 < x ∧ x < p"
using eventually_at_left_field[where x = p] p by auto
have mult_lt: "∀⇩F x in at_left p. x * y < p * y"
using mult_ev by eventually_elim (use y in ‹auto intro!: mult_strict_right_mono›)
note mult_at_left = tendsto_imp_filterlim_at_left[OF mult_tendsto mult_lt]
have py: "0 < p * y"
using y p by simp
have "filterlim (limit_quantile G) (nhds (limit_quantile G (p * y))) (at_left (p * y))"
using limit_quantile_left_cont[OF G py] by simp
from filterlim_compose[OF this mult_at_left]
show ?thesis
by simp
qed
lemma tail_quantile_mono:
assumes F: "right_continuous_mono F 0 1" and s: "1 < s" and st: "s ≤ t"
shows "tail_quantile F s ≤ tail_quantile F t"
proof -
interpret right_continuous_mono F 0 1
by fact
show ?thesis
using s st ex_ge_b ex_less_a
by(intro ginv_compose_mono[where A="{0<..<1}",THEN mono_onD] mono mono_onI)
(auto simp: divide_mono)
qed
lemma limit_quantile_mono:
assumes G: "right_continuous_mono G 0 1" and y1: "0 < y1" and y12: "y1 ≤ y2"
shows "limit_quantile G y1 ≤ limit_quantile G y2"
proof -
interpret right_continuous_mono G 0 1 by fact
show ?thesis
using y1 y12 ex_ge_b ex_less_a
by(intro ginv_compose_mono[where A="{0<..<1}",THEN mono_onD] mono mono_onI)
(auto simp: divide_mono)
qed
lemma limit_quantile_EVD_cdf:
assumes sigma[arith]:"0 < σ"
and ypos[arith]: "0 < y"
shows "limit_quantile (EVD_cdf ξ μ σ) y
= (if ξ = 0 then σ * ln y + μ else σ * (y powr ξ - 1) / ξ + μ)"
(is "ginv _ ?p = ?xs")
proof -
have yppos: "0 < y powr ξ"
using ypos by simp
have iff: "?p ≤ EVD_cdf ξ μ σ x ⟷ ?xs ≤ x" for x
proof -
consider "ξ = 0" | "0 < ξ" | "ξ < 0" by argo
thus ?thesis
proof cases
case 1
have "?p ≤ EVD_cdf ξ μ σ x ⟷ exp (- ((x - μ) / σ)) ≤ 1 / y"
by (simp add: EVD_cdf_def Let_def 1)
also have "… ⟷ exp (- ((x - μ) / σ)) ≤ exp (- ln y)"
by (simp add: exp_minus inverse_eq_divide)
also have "… ⟷ ln y ≤ (x - μ) / σ"
by simp
also have "… ⟷ σ * ln y + μ ≤ x"
by (auto simp: field_simps)
finally show ?thesis
by (simp add: 1)
next
case 2
define u where "u = 1 + ξ * ((x - μ) / σ)"
show ?thesis
proof (cases "0 < u")
assume u[arith]:"0 < u"
have "?p ≤ EVD_cdf ξ μ σ x ⟷ u powr (- 1 / ξ) ≤ 1 / y"
using 2 u by (auto simp add: EVD_cdf_def Let_def u_def)
also have "… ⟷ ln (u powr (- 1 / ξ)) ≤ ln (1 / y)"
by (rule ln_le_cancel_iff[symmetric]) auto
also have "… ⟷ (- 1 / ξ) * ln u ≤ - ln y"
by (simp add: ln_div)
also have "… ⟷ ξ * ln y ≤ ln u"
using 2 by (auto simp: field_simps)
also have "… ⟷ ln (y powr ξ) ≤ ln u"
by simp
also have "… ⟷ y powr ξ ≤ u"
by (rule ln_le_cancel_iff) auto
also have "… ⟷ y powr ξ - 1 ≤ ξ * ((x - μ) / σ)"
by (simp add: u_def) linarith
also have "… ⟷ ?xs ≤ x"
using 2 by (simp add: field_simps)
finally show ?thesis .
next
assume u:"¬ 0 < u"
have y:"0 < σ * y powr ξ"
using yppos by simp
show ?thesis
using 2 u add_strict_increasing[OF y]
by(auto simp: EVD_cdf_def Let_def u_def not_less not_le field_simps)
qed
next
case 3
define u where "u = 1 + ξ * ((x - μ) / σ)"
show ?thesis
proof (cases "0 < u")
case True
have "?p ≤ EVD_cdf ξ μ σ x ⟷ u powr (- 1 / ξ) ≤ 1 / y"
using 3 True by (auto simp add: EVD_cdf_def Let_def u_def)
also have "… ⟷ ln (u powr (- 1 / ξ)) ≤ ln (1 / y)"
by (rule ln_le_cancel_iff[symmetric]) (use True in auto)
also have "… ⟷ (- 1 / ξ) * ln u ≤ - ln y"
by (simp add: ln_div)
also have "… ⟷ ln u ≤ ξ * ln y"
using 3 by (auto simp: field_simps)
also have "… ⟷ ln u ≤ ln (y powr ξ)"
by simp
also have "… ⟷ u ≤ y powr ξ"
by (rule ln_le_cancel_iff) (auto simp: True)
also have "… ⟷ ξ * ((x - μ) / σ) ≤ y powr ξ - 1"
unfolding u_def by auto
also have "… ⟷ ?xs ≤ x"
using 3 by (simp add: field_simps)
finally show ?thesis .
next
assume u:"¬ 0 < u"
have Gx: "EVD_cdf ξ μ σ x = 1"
using 3 u by (auto simp: EVD_cdf_def Let_def u_def not_less)
have "ξ * ((x - μ) / σ) < y powr ξ - 1"
using u yppos unfolding u_def by linarith
hence "σ * (y powr ξ - 1) / ξ + μ ≤ x"
using 3 by (simp add: field_simps)
hence "?xs ≤ x"
using 3 by simp
moreover have "?p ≤ 1"
by (auto intro!: less_imp_le)
ultimately show ?thesis
by (simp add: Gx)
qed
qed
qed
have set_eq: "{x. ?p ≤ EVD_cdf ξ μ σ x} = {?xs..}"
using iff by auto
show ?thesis
unfolding ginv_def set_eq by simp
qed
corollary isCont_limit_quantile_EVD_cdf:
assumes sigma[arith]:"0 < σ"
and ypos[arith]: "0 < y"
shows "isCont (limit_quantile (EVD_cdf ξ μ σ)) y"
proof(subst isCont_cong)
show "∀⇩F x in nhds y.
limit_quantile (EVD_cdf ξ μ σ) x
= (if ξ = 0 then σ * ln x + μ else σ * (x powr ξ - 1) / ξ + μ)"
unfolding eventually_nhds
by(auto intro!: exI[where x="{y/2<..<2*y}"] simp: limit_quantile_EVD_cdf)
next
show "isCont (λx. if ξ = 0 then σ * ln x + μ else σ * (x powr ξ - 1) / ξ + μ) y"
by(cases "ξ = 0")
(auto intro!: isCont_add isCont_mult isCont_ln isCont_divide isCont_diff
simp: continuous_at_within_powr)
qed
lemma dist_function_unique_limit_quantile:
assumes G:"right_continuous_mono G 0 1" and G':"right_continuous_mono G' 0 1"
and eq:"⋀y. 0 < y ⟹ limit_quantile G y = limit_quantile G' y"
shows "G = G'"
proof -
have ginv_eq: "ginv G p = ginv G' p" if p: "0 < p" "p < 1" for p
using eq[of "- 1 / ln p"] using p by simp
have le: "H' x ≤ H x"
if H: "right_continuous_mono H 0 1" and H': "right_continuous_mono H' 0 1"
and geq: "⋀p. 0 < p ⟹ p < 1 ⟹ ginv H p = ginv H' p"
for H H' :: "real ⇒ real" and x
proof (rule ccontr)
interpret H: right_continuous_mono H 0 1
by fact
interpret H':right_continuous_mono H' 0 1
by fact
assume "¬ H' x ≤ H x"
hence lt: "H x < H' x"
by simp
define p where "p = (H x + H' x) / 2"
have p1: "H x < p" "p < H' x"
using lt by (simp_all add: p_def)
have p0: "0 < p" "p < 1"
using H.a_le_f[of x] p1 H'.f_le_b[of x]
by auto
have "ginv H' p ≤ x"
using H'.ginv_le_iff p0 p1 by auto
hence "ginv H p ≤ x"
by (simp add: geq p0)
with p1 show False
by (simp add: H.ginv_le_iff p0(1,2))
qed
show ?thesis
using le[OF G G' ginv_eq] le[OF G' G ginv_eq[symmetric]]
by(auto dest: antisym)
qed
lemma isCont_ginv_iff_isCont_limit_quantile:
assumes G: "right_continuous_mono G 0 1"
and y: "0 < y"
shows "isCont (ginv G) (exp (- (1 / y))) ⟷ isCont (limit_quantile G) y"
proof
assume cont:"isCont (limit_quantile G) y"
have 1: "isCont (λx. - 1 / ln x) (exp (- 1 / y))"
using y by (intro continuous_intros) simp_all
have 2: "isCont (limit_quantile G) (- 1 / ln (exp (- 1 / y)))"
using y by(simp add: cont)
have 3: "∀⇩F p' in nhds (exp (- (1 / y))). limit_quantile G (- 1 / ln p') = ginv G p'"
using eventually_nhds_in_open[of "{0<..<1}" "exp (- (1 / y))"] y
by (auto elim!: eventually_mono)
show "isCont (ginv G) (exp (- (1 / y)))"
using continuous_at_compose[OF 1 2] isCont_cong[OF 3]
by(auto simp: comp_def)
next
assume cont:"isCont (ginv G) (exp (- (1 / y)))"
show "isCont (limit_quantile G) y"
using continuous_at_compose[where f="λx. exp (- (1 / x))",OF _ cont] y
by(simp add: comp_def)
qed
lemma seq_exp_quantile_tendsto:
fixes F G :: "real ⇒ real" and a b :: "nat ⇒ real" and y :: real
assumes F: "right_continuous_mono F 0 1" and G: "right_continuous_mono G 0 1"
and a: "⋀n. 0 < a n"
and wc: "weak_conv (λn x. F (a n * x + b n) ^ n) G"
and y: "0 < y" and cont: "isCont (limit_quantile G) y"
shows "(λn. (limit_quantile F (real n * y) - b n) / a n) ⇢ limit_quantile G y"
proof -
interpret G: right_continuous_mono G 0 1 by fact
interpret F: right_continuous_mono F 0 1 by fact
define p where "p = exp (- (1 / y))"
have p01: "0 < p" "p < 1"
using y by (auto simp: p_def)
have cont': "isCont (ginv G) p"
unfolding p_def using cont by(simp add: isCont_ginv_iff_isCont_limit_quantile[OF G y])
obtain z where z: "p < G z"
using order_tendstoD(1)[OF G.top p01(2)]
by (auto dest!: eventually_happens'[OF trivial_limit_at_top_linorder])
obtain w where w: "G w < p"
using order_tendstoD(2)[OF G.bot p01(1)]
by (auto dest!: eventually_happens'[OF trivial_limit_at_bot_linorder])
have monoFn: "mono (λx. F (a n * x + b n) ^ n)" for n
using a by(auto intro!: monoI power_mono monoD[OF F.mono] F.a_le_f)
have main: "(λn. ginv (λx. F (a n * x + b n) ^ n) p) ⇢ ginv G p"
by (rule tendsto_ginv[OF monoFn G.mono _ cont' z w])
(use wc in ‹auto simp: weak_conv_def›)
have eq: "ginv (λx. F (a n * x + b n) ^ n) p
= (ginv F (exp (- 1 / (real n * y))) - b n) / a n" if n: "0 < n" for n
proof -
define qn where "qn = exp (- 1 / (real n * y))"
have qn01: "0 < qn" "qn < 1"
using n y by (auto simp: qn_def)
have qn_pow: "qn ^ n = p"
using n y by (simp add: qn_def p_def exp_of_nat_mult[symmetric])
have iff1: "p ≤ F (a n * x + b n) ^ n ⟷ qn ≤ F (a n * x + b n)" for x
proof
assume "qn ≤ F (a n * x + b n)"
hence "qn ^ n ≤ F (a n * x + b n) ^ n"
using qn01(1) by (intro power_mono) auto
thus "p ≤ F (a n * x + b n) ^ n"
by (simp add: qn_pow)
next
assume *: "p ≤ F (a n * x + b n) ^ n"
show "qn ≤ F (a n * x + b n)"
proof (rule ccontr)
assume "¬ qn ≤ F (a n * x + b n)"
hence "F (a n * x + b n) ^ n < qn ^ n"
using F.a_le_f n by (intro power_strict_mono) auto
with * show False
by (simp add: qn_pow)
qed
qed
have iff2: "qn ≤ F v ⟷ ginv F qn ≤ v" for v
using F.ginv_le_iff[OF qn01] by simp
have iff3: "ginv F qn ≤ a n * x + b n ⟷ (ginv F qn - b n) / a n ≤ x" for x
using a[of n] by (auto simp: field_simps)
have "{x. p ≤ F (a n * x + b n) ^ n} = {(ginv F qn - b n) / a n..}"
by (auto simp: iff1 iff2 iff3)
thus ?thesis
by (simp add: ginv_def qn_def)
qed
have "(λn. ginv (λx. F (a n * x + b n) ^ n) p) ⇢ limit_quantile G y"
using main by (simp add: p_def)
moreover have "∀⇩F n in sequentially. ginv (λx. F (a n * x + b n) ^ n) p
= (limit_quantile F (real n * y) - b n) / a n"
using eventually_gt_at_top[of 0] by eventually_elim (simp add: eq)
ultimately show ?thesis
by (rule Lim_transform_eventually)
qed
lemma seq_tail_quantile_tendsto:
fixes F G :: "real ⇒ real" and a b :: "nat ⇒ real" and y :: real
assumes F:"right_continuous_mono F 0 1" and G:"right_continuous_mono G 0 1"
and dg: "¬ degenerate_df G"
and a:"⋀n. 0 < a n"
and wc:"weak_conv (λn x. F (a n * x + b n) ^ n) G"
and y:"0 < y" and cont:"isCont (limit_quantile G) y"
shows "(λn. (tail_quantile F (real n * y) - b n) / a n) ⇢ limit_quantile G y"
proof (rule metric_LIMSEQ_I)
interpret F: right_continuous_mono F 0 1 by fact
interpret G: right_continuous_mono G 0 1 by fact
fix ε :: real
assume eps: "0 < ε"
obtain δ where δ: "0 < δ"
"⋀y''. y'' ≠ y ∧ ¦y'' - y¦ < δ ⟹ ¦limit_quantile G y'' - limit_quantile G y¦ < ε / 2"
using LIM_D[of _ _ _ "ε / 2"] eps cont by (fastforce simp: isCont_def)
have cd: "countable {s ∈ {0<..}. ¬ isCont (limit_quantile G) s}"
by (intro mono_on_ctble_discont_open)
(fastforce intro!: mono_onI limit_quantile_mono[OF G])+
obtain y' where y': "y' ∈ {max (y - δ) (y / 2)<..<y}"
"y' ∉ {s ∈ {0<..}. ¬ isCont (limit_quantile G) s}"
using real_interval_avoid_countable_set[OF _ cd, of "max (y - δ) (y / 2)" y] δ(1) y
by auto
have y'1: "0 < y'" "y' < y" "¦y' - y¦ < δ"
using y' y by auto
have y'2: "isCont (limit_quantile G) y'"
using y' y'1(1) by auto
have y'3: "limit_quantile G y - ε / 2 < limit_quantile G y'"
using δ(2)[of y'] y'1(2,3) by argo
note L = seq_exp_quantile_tendsto[OF F G a wc y cont]
note L' = seq_exp_quantile_tendsto[OF F G a wc y'1(1) y'2]
have up: "∀⇩F n in sequentially. tail_quantile F (real n * y)
≤ ginv F (exp (- 1 / (real n * y)))"
using eventually_gt_at_top[of "nat ⌈1 / y⌉"]
proof eventually_elim
case (elim n)
have n1: "1 < real n * y"
proof -
have "real (nat ⌈1 / y⌉) < real n"
using elim by simp
moreover have "1 / y ≤ real (nat ⌈1 / y⌉)"
by (rule real_nat_ceiling_ge)
ultimately have "1 / y < real n"
by simp
thus ?thesis
using y by (simp add: pos_divide_less_eq)
qed
have "1 - 1 / (real n * y) ≤ exp (- 1 / (real n * y))"
using exp_ge_add_one_self[of "- 1 / (real n * y)"] by simp
thus ?case
using n1
by (intro ginv_mono[OF F.mono] F.ex_less_a F.ex_ge_b) auto
qed
have low: "∀⇩F n in sequentially. ginv F (exp (- 1 / (real n * y')))
≤ tail_quantile F (real n * y)"
proof -
have ev1: "∀⇩F n in sequentially. y' / y < exp (- 1 / (real n * y'))"
proof (rule order_tendstoD(1))
have "(λn. - 1 / (real n * y')) ⇢ 0"
using y'1(1) tendsto_mult[OF tendsto_const[of "- 1 / y'"] lim_1_over_n]
by (auto simp: field_simps intro: Lim_transform_eventually)
thus "(λn. exp (- 1 / (real n * y'))) ⇢ 1"
using tendsto_exp[of _ 0] by fastforce
show "y' / y < 1"
using y'1(1,2) y by simp
qed
show ?thesis
using ev1 eventually_gt_at_top[of 0]
proof eventually_elim
case (elim n)
define s where "s = 1 / (real n * y')"
have s_pos: "0 < s"
using elim y'1(1) by (auto simp: s_def)
have ny_pos: "0 < real n * y"
using elim y by auto
have "exp s ≥ 1 + s"
by (rule exp_ge_add_one_self)
hence "1 ≥ (1 + s) * exp (- s)"
using mult_right_mono[of "1 + s" "exp s" "exp (- s)"]
by (simp add: exp_minus field_simps)
hence *: "s * exp (- s) ≤ 1 - exp (- s)"
by (simp add: algebra_simps)
have "1 / (real n * y) = (y' / y) * s"
using elim y'1(1) by (simp add: s_def field_simps)
also have "… ≤ exp (- s) * s"
using elim s_pos by (fastforce intro!: mult_right_mono simp: s_def)
also have "… ≤ 1 - exp (- s)"
using * by (simp add: mult.commute)
finally have "exp (- 1 / (real n * y')) ≤ 1 - 1 / (real n * y)"
by (simp add: s_def)
moreover have "0 < exp (- 1 / (real n * y'))"
by simp
moreover have "1 - 1 / (real n * y) < 1"
using ny_pos by simp
ultimately show ?case
by(intro ginv_mono[OF F.mono] F.ex_ge_b F.ex_less_a) auto
qed
qed
have evlow: "∀⇩F n in sequentially. limit_quantile G y - ε
< (tail_quantile F (real n * y) - b n) / a n"
proof -
have *:"∀⇩F n in sequentially. limit_quantile G y - ε
< ((limit_quantile F (real n * y')) - b n) / a n"
using y'3 eps by (intro order_tendstoD(1)[OF L']) auto
show ?thesis
using a
by(intro eventually_mono[OF eventually_conj[OF * low]])
(smt (verit, ccfv_SIG) divide_minus_left divide_right_mono)
qed
have evup: "∀⇩F n in sequentially. (tail_quantile F (real n * y) - b n) / a n
< limit_quantile G y + ε"
proof -
have *:"∀⇩F n in sequentially. ((limit_quantile F (real n * y)) - b n) / a n
< limit_quantile G y + ε"
using eps by (intro order_tendstoD(2)[OF L]) auto
show ?thesis
using a
by(intro eventually_mono[OF eventually_conj[OF * up]])
(smt (verit, ccfv_SIG) divide_right_mono_neg minus_divide_divide minus_divide_left)
qed
from evlow evup
have "∀⇩F n in sequentially. dist ((tail_quantile F (real n * y) - b n) / a n)
(limit_quantile G y) < ε"
by eventually_elim (simp add: dist_real_def abs_diff_less_iff)
thus "∃no. ∀n≥no. dist ((tail_quantile F (real n * y) - b n) / a n)
(limit_quantile G y) < ε"
unfolding eventually_sequentially by blast
qed
lemma nondegenerate_growth_points:
assumes G: "right_continuous_mono G 0 1" and deg: "¬ degenerate_df G"
and N: "countable N"
obtains y1 y2 where "0 < y1" "y1 < y2" "y1 ∉ N" "y2 ∉ N"
"isCont (limit_quantile G) y1" "isCont (limit_quantile G) y2"
"limit_quantile G y1 < limit_quantile G y2"
proof -
interpret G: right_continuous_mono G 0 1
by fact
obtain x0 where x0: "0 < G x0" "G x0 < 1"
proof -
from deg obtain x0 where "G x0 ≠ 0" "G x0 ≠ 1"
by (auto simp: degenerate_df_def)
thus thesis
using G.a_le_f[of x0] G.f_le_b[of x0]
by (intro that[of x0]) auto
qed
define p1 where "p1 = G x0"
define p2 where "p2 = (G x0 + 1) / 2"
have p12: "0 < p1" "p1 < p2" "p2 < 1"
using x0 by (auto simp: p1_def p2_def)
define v1 where "v1 = - 1 / ln p1"
define v2 where "v2 = - 1 / ln p2"
have ln1: "ln p1 < 0" and ln2: "ln p2 < 0"
using p12 by auto
have v1pos: "0 < v1"
unfolding v1_def using ln1 by simp
have v2pos: "0 < v2"
unfolding v2_def using ln2 by simp
have exp1: "exp (- 1 / v1) = p1"
using ln1 p12(1) by (simp add: v1_def)
have exp2: "exp (- 1 / v2) = p2"
using ln2 p12 by (simp add: v2_def)
have v12: "v1 < v2"
proof -
have *: "ln p1 < ln p2"
using p12 by simp
have "v1 = 1 / (- ln p1)" "v2 = 1 / (- ln p2)"
by (simp_all add: v1_def v2_def)
moreover have "1 / (- ln p1) < 1 / (- ln p2)"
using * ln1 ln2 by (intro divide_strict_left_mono)
(auto simp: zero_less_mult_iff)
ultimately show ?thesis
by simp
qed
have Dv1: "limit_quantile G v1 ≤ x0"
using G.ginv_le_iff[of p1 x0] p12 exp1
by (simp add: p1_def)
have Dv2: "x0 < limit_quantile G v2"
proof -
have "¬ ginv G p2 ≤ x0"
using G.ginv_le_iff[of p2 x0] p12
by (simp add: p1_def[symmetric])
thus ?thesis
using exp2 by simp
qed
have cd: "countable (N ∪ {s ∈ {0<..}. ¬ isCont (limit_quantile G) s})"
using N
by (intro countable_Un mono_on_ctble_discont_open)
(fastforce intro!: mono_onI limit_quantile_mono[OF G])+
obtain y1 where y1: "y1 ∈ {v1 / 2<..<v1}"
"y1 ∉ N ∪ {s ∈ {0<..}. ¬ isCont (limit_quantile G) s}"
using real_interval_avoid_countable_set[OF _ cd, of "v1 / 2" v1] v1pos by auto
obtain y2 where y2: "y2 ∈ {v2<..<v2 + 1}"
"y2 ∉ N ∪ {s ∈ {0<..}. ¬ isCont (limit_quantile G) s}"
using real_interval_avoid_countable_set[OF _ cd, of v2 "v2 + 1"] by auto
have y1f: "0 < y1" "y1 < v1"
using y1(1) v1pos by auto
have y2f: "0 < y2" "v2 < y2"
using y2(1) v2pos by auto
show ?thesis
proof (rule that[of y1 y2])
show "0 < y1"
by fact
show "y1 < y2"
using y1f y2f v12 by simp
show "y1 ∉ N" "y2 ∉ N"
using y1(2) y2(2) by auto
show "isCont (limit_quantile G) y1" "isCont (limit_quantile G) y2"
using y1 y2 y1f(1) y2f(1) by auto
have "limit_quantile G y1 ≤ limit_quantile G v1"
using y1f by (intro limit_quantile_mono[OF G]) auto
moreover have "limit_quantile G v2 ≤ limit_quantile G y2"
using y2f v2pos by (intro limit_quantile_mono[OF G]) auto
ultimately show "limit_quantile G y1 < limit_quantile G y2"
using Dv1 Dv2 by simp
qed
qed
lemma
fixes F G :: "real ⇒ real" and a b :: "nat ⇒ real"
assumes F:"right_continuous_mono F 0 1" and G:"right_continuous_mono G 0 1"
and deg:"¬ degenerate_df G"
and a:"⋀n. 0 < a n"
and wc:"weak_conv (λn x. F (a n * x + b n) ^ n) G"
shows normalizing_ratio1:"(λn. a (Suc n) / a n) ⇢ 1"
and normalizing_ratio2:"(λn. (b (Suc n) - b n) / a n) ⇢ 0"
proof -
have er:"⋀c. ∀⇩F n in sequentially. c ≤ real n"
using filterlim_real_sequentially unfolding filterlim_at_top by blast
obtain y1 y2 where y12: "0 < y1" "y1 < y2"
and cont12: "isCont (limit_quantile G) y1" "isCont (limit_quantile G) y2"
and D12: "limit_quantile G y1 < limit_quantile G y2"
by (rule nondegenerate_growth_points[OF G deg countable_empty]) auto
have y2pos: "0 < y2"
using y12 by simp
have base: "(λn. (tail_quantile F (real n * z) - b n) / a n) ⇢ limit_quantile G z"
if z: "0 < z" "isCont (limit_quantile G) z" for z
by (rule seq_tail_quantile_tendsto[OF F G deg a wc z])
have shifted: "(λn. (tail_quantile F (real n * z) - b (Suc n)) / a (Suc n))
⇢ limit_quantile G z"
if z: "0 < z" "isCont (limit_quantile G) z" for z
proof (rule squeeze_tendsto_cont_points_pos[where
gr = "λy' n. (tail_quantile F (real (Suc n) * y') - b (Suc n)) / a (Suc n)"
and f = "limit_quantile G", OF _ z])
show "mono_on {0<..} (limit_quantile G)"
by (auto intro!: mono_onI limit_quantile_mono[OF G])
next
fix y' :: real
assume y': "0 < y'" "isCont (limit_quantile G) y'"
show "(λn. (tail_quantile F (real (Suc n) * y') - b (Suc n)) / a (Suc n))
⇢ limit_quantile G y'"
by (intro LIMSEQ_Suc base y')
next
fix y' :: real
assume y': "0 < y'" "y' < z"
show "∀⇩F n in sequentially. (tail_quantile F (real (Suc n) * y') - b (Suc n)) / a (Suc n)
≤ (tail_quantile F (real n * z) - b (Suc n)) / a (Suc n)"
using er[of "max (y' / (z - y')) (1 / y')"]
proof eventually_elim
case h:(elim n)
have 1: "1 < real (Suc n) * y'"
proof -
have "1 = (1 / y') * y'"
using y'(1) by simp
also have "… ≤ real n * y'"
using h y'(1) by (intro mult_right_mono) auto
also have "… < real (Suc n) * y'"
using y'(1) by simp
finally show ?thesis .
qed
have 2: "real (Suc n) * y' ≤ real n * z"
proof -
have "y' / (z - y') ≤ real n"
using h by simp
hence "y' ≤ real n * (z - y')"
using y' by (simp add: field_simps)
thus ?thesis
by (simp add: algebra_simps)
qed
have "tail_quantile F (real (Suc n) * y') ≤ tail_quantile F (real n * z)"
by (rule tail_quantile_mono[OF F 1 2])
thus ?case
using a[of "Suc n"] by (auto intro!: divide_right_mono)
qed
next
fix y' :: real
assume y': "z < y'"
show "∀⇩F n in sequentially. (tail_quantile F (real n * z) - b (Suc n)) / a (Suc n)
≤ (tail_quantile F (real (Suc n) * y') - b (Suc n)) / a (Suc n)"
using er[of "1 / z + 1"]
proof eventually_elim
case (elim n)
have zpos: "0 < z"
using z by simp
have 1: "1 < real n * z"
proof -
have "1 < (1 / z + 1) * z"
using zpos by (simp add: field_simps)
also have "… ≤ real n * z"
using elim zpos by (intro mult_right_mono) auto
finally show ?thesis .
qed
have 2: "real n * z ≤ real (Suc n) * y'"
using y' zpos by (intro mult_mono) auto
have "tail_quantile F (real n * z) ≤ tail_quantile F (real (Suc n) * y')"
by (rule tail_quantile_mono[OF F 1 2])
thus ?case
using a[of "Suc n"] by (auto intro!: divide_right_mono)
qed
qed
note B1 = base[OF y12(1) cont12(1)] and B2 = base[OF y2pos cont12(2)]
note S1 = shifted[OF y12(1) cont12(1)] and S2 = shifted[OF y2pos cont12(2)]
define D where "D = limit_quantile G y2 - limit_quantile G y1"
have D_pos: "0 < D"
using D12 by (simp add: D_def)
have d1: "(λn. (tail_quantile F (real n * y2) - tail_quantile F (real n * y1)) / a n)
⇢ D"
using tendsto_diff[OF B2 B1]
by (simp add: diff_divide_distrib D_def)
have d2: "(λn. (tail_quantile F (real n * y2) - tail_quantile F (real n * y1)) / a (Suc n))
⇢ D"
using tendsto_diff[OF S2 S1]
by (simp add: diff_divide_distrib D_def)
have ev_pos: "∀⇩F n in sequentially. 0 < (tail_quantile F (real n * y2)
- tail_quantile F (real n * y1)) / a n"
using order_tendstoD(1)[OF d1 D_pos] .
show r1: "(λn. a (Suc n) / a n) ⇢ 1"
proof -
have "(λn. ((tail_quantile F (real n * y2) - tail_quantile F (real n * y1)) / a n)
/ ((tail_quantile F (real n * y2) - tail_quantile F (real n * y1)) / a (Suc n)))
⇢ D / D"
using D_pos by (intro tendsto_divide d1 d2) auto
hence *: "(λn. ((tail_quantile F (real n * y2) - tail_quantile F (real n * y1)) / a n)
/ ((tail_quantile F (real n * y2) - tail_quantile F (real n * y1)) / a (Suc n)))
⇢ 1"
using D_pos by simp
have "∀⇩F n in sequentially. ((tail_quantile F (real n * y2)
- tail_quantile F (real n * y1)) / a n)
/ ((tail_quantile F (real n * y2)
- tail_quantile F (real n * y1)) / a (Suc n))
= a (Suc n) / a n"
using ev_pos
proof eventually_elim
case (elim n)
have "0 < tail_quantile F (real n * y2) - tail_quantile F (real n * y1)"
using elim a[of n] by (simp add: zero_less_divide_iff)
thus ?case
using a[of n] a[of "Suc n"] by (auto simp: field_simps)
qed
from Lim_transform_eventually[OF * this]
show ?thesis .
qed
have eq: "(tail_quantile F (real n * y1) - b n) / a n
- ((tail_quantile F (real n * y1) - b (Suc n)) / a (Suc n)) * (a (Suc n) / a n)
= (b (Suc n) - b n) / a n" for n
using a[of n] a[of "Suc n"] by (simp add: field_simps)
have "(λn. (tail_quantile F (real n * y1) - b n) / a n
- ((tail_quantile F (real n * y1) - b (Suc n)) / a (Suc n)) * (a (Suc n) / a n))
⇢ limit_quantile G y1 - limit_quantile G y1 * 1"
by (intro tendsto_diff tendsto_mult B1 S1 r1)
thus "(λn. (b (Suc n) - b n) / a n) ⇢ 0"
unfolding eq by simp
qed
lemma real_tail_quantile_tendsto:
fixes F G :: "real ⇒ real" and a b :: "nat ⇒ real" and y :: real
assumes F:"right_continuous_mono F 0 1" and G:"right_continuous_mono G 0 1"
and deg:"¬ degenerate_df G"
and a:"⋀n. 0 < a n"
and wc:"weak_conv (λn x. F (a n * x + b n) ^ n) G"
and y:"0 < y" and cont:"isCont (limit_quantile G) y"
shows "((λt. (tail_quantile F (t * y) - b (nat ⌊t⌋)) / a (nat ⌊t⌋))
⤏ limit_quantile G y) at_top"
proof -
note nf = filterlim_compose[OF filterlim_nat_sequentially filterlim_floor_sequentially]
note nf_real = filterlim_compose[OF filterlim_real_sequentially nf]
have ev_nf: "∀⇩F t::real in at_top. c ≤ real (nat ⌊t⌋)" for c
using nf_real unfolding filterlim_at_top by blast
show ?thesis
proof (rule squeeze_tendsto_cont_points_pos[where
gr = "λy' t. (tail_quantile F (real (nat ⌊t⌋) * y') - b (nat ⌊t⌋)) / a (nat ⌊t⌋)"
and f = "limit_quantile G", OF _ y cont])
show "mono_on {0<..} (limit_quantile G)"
by (auto intro!: mono_onI limit_quantile_mono[OF G])
next
fix y' :: real
assume y': "0 < y'" "isCont (limit_quantile G) y'"
show "((λt. (tail_quantile F (real (nat ⌊t⌋) * y') - b (nat ⌊t⌋)) / a (nat ⌊t⌋))
⤏ limit_quantile G y') at_top"
using filterlim_compose[OF seq_tail_quantile_tendsto[OF F G deg a wc y'] nf]
by simp
next
fix y' :: real
assume y'1: "0 < y'" and y'2: "y' < y"
show "∀⇩F t in at_top. (tail_quantile F (real (nat ⌊t⌋) * y') - b (nat ⌊t⌋)) / a (nat ⌊t⌋)
≤ (tail_quantile F (t * y) - b (nat ⌊t⌋)) / a (nat ⌊t⌋)"
using ev_nf[of "1 / y' + 1"] eventually_ge_at_top[of 0]
proof eventually_elim
case (elim t)
have 1: "1 < real (nat ⌊t⌋) * y'"
proof -
have "1 < (1 / y' + 1) * y'"
using y'1 by (simp add: field_simps)
also have "… ≤ real (nat ⌊t⌋) * y'"
using elim y'1 by (intro mult_right_mono) auto
finally show ?thesis .
qed
have "real (nat ⌊t⌋) ≤ t"
using elim by linarith
hence 2: "real (nat ⌊t⌋) * y' ≤ t * y"
using y'1 y'2 y elim by (intro mult_mono) auto
have "tail_quantile F (real (nat ⌊t⌋) * y') ≤ tail_quantile F (t * y)"
by (rule tail_quantile_mono[OF F 1 2])
thus ?case
using a[of "nat ⌊t⌋"] by (auto intro!: divide_right_mono)
qed
next
fix y' :: real
assume y': "y < y'"
show "∀⇩F t in at_top. (tail_quantile F (t * y) - b (nat ⌊t⌋)) / a (nat ⌊t⌋)
≤ (tail_quantile F (real (nat ⌊t⌋) * y') - b (nat ⌊t⌋)) / a (nat ⌊t⌋)"
using ev_nf[of "y / (y' - y)"] eventually_gt_at_top[of "1 / y"]
proof eventually_elim
case (elim t)
have t_pos: "0 < t"
using elim(2) y zero_less_divide_1_iff[of y] by linarith
have 1: "1 < t * y"
using elim(2) y by (simp add: field_simps)
have 2: "t * y ≤ real (nat ⌊t⌋) * y'"
proof -
have "t ≤ real (nat ⌊t⌋) + 1"
using t_pos by linarith
hence "t * y ≤ (real (nat ⌊t⌋) + 1) * y"
using y by (intro mult_right_mono) auto
also have "… ≤ real (nat ⌊t⌋) * y'"
using elim(1) y' y by (simp add: field_simps)
finally show ?thesis .
qed
show ?case
using a[of "nat ⌊t⌋"] tail_quantile_mono[OF F 1 2]
by (auto intro!: divide_right_mono)
qed
qed
qed
lemma scaling_limits_ex:
fixes F G :: "real ⇒ real" and a b :: "nat ⇒ real"
assumes F:"right_continuous_mono F 0 1" and G:"right_continuous_mono G 0 1"
and deg: "¬ degenerate_df G"
and a:"⋀n. 0 < a n"
and wc:"weak_conv (λn x. F (a n * x + b n) ^ n) G"
obtains A B where
"⋀y. 0 < y ⟹ 0 < A y"
and "⋀y. 0 < y ⟹ ((λt. a (nat ⌊t * y⌋) / a (nat ⌊t⌋)) ⤏ A y) at_top"
and "⋀y. 0 < y ⟹
((λt. (b (nat ⌊t * y⌋) - b (nat ⌊t⌋)) / a (nat ⌊t⌋)) ⤏ B y) at_top"
and "A ∈ borel_measurable (restrict_space borel {0<..})"
and "⋀x y. 0 < x ⟹ 0 < y ⟹ A (x * y) = A x * A y"
and "⋀x y. 0 < x ⟹ 0 < y ⟹ isCont (limit_quantile G) x
⟹ isCont (limit_quantile G) (x * y)
⟹ limit_quantile G (x * y) = limit_quantile G x * A y + B y"
proof -
have RT: "((λt. (tail_quantile F (t * s) - b (nat ⌊t⌋)) / a (nat ⌊t⌋))
⤏ limit_quantile G s) at_top"
if "0 < s" "isCont (limit_quantile G) s" for s
by (rule real_tail_quantile_tendsto[OF F G deg a wc that])
have mult_top: "filterlim (λt::real. t * y) at_top at_top" if "0 < y" for y :: real
using filterlim_tendsto_pos_mult_at_top[OF tendsto_const that filterlim_ident]
by (simp add: mult.commute)
have RTy: "((λt. (tail_quantile F (t * y * s) - b (nat ⌊t * y⌋)) / a (nat ⌊t * y⌋))
⤏ limit_quantile G s) at_top"
if y: "0 < y" and s: "0 < s" "isCont (limit_quantile G) s" for y s
by (rule filterlim_compose[OF RT[OF s] mult_top[OF y]])
have ex: "∃L M. 0 ≤ L ∧
((λt. a (nat ⌊t * y⌋) / a (nat ⌊t⌋)) ⤏ L) at_top ∧
((λt. (b (nat ⌊t * y⌋) - b (nat ⌊t⌋)) / a (nat ⌊t⌋)) ⤏ M) at_top"
if y: "0 < y" for y :: real
proof -
have cN: "countable {s ∈ {0<..}. ¬ isCont (limit_quantile G) (y * s)}"
proof -
have *: "countable {u ∈ {0<..}. ¬ isCont (limit_quantile G) u}"
by (intro mono_on_ctble_discont_open)
(fastforce intro!: mono_onI limit_quantile_mono[OF G])+
have sub: "{s ∈ {0<..}. ¬ isCont (limit_quantile G) (y * s)}
⊆ (λu. u / y) ` {u ∈ {0<..}. ¬ isCont (limit_quantile G) u}"
proof
fix s
assume s: "s ∈ {s ∈ {0<..}. ¬ isCont (limit_quantile G) (y * s)}"
hence "y * s ∈ {u ∈ {0<..}. ¬ isCont (limit_quantile G) u}"
using y by auto
moreover have "s = (y * s) / y"
using y by simp
ultimately show "s ∈ (λu. u / y) ` {u ∈ {0<..}. ¬ isCont (limit_quantile G) u}"
by blast
qed
show ?thesis
by (rule countable_subset[OF sub countable_image[OF *]])
qed
obtain s1 s2 where s12: "0 < s1" "s1 < s2"
and nn: "s1 ∉ {s ∈ {0<..}. ¬ isCont (limit_quantile G) (y * s)}"
"s2 ∉ {s ∈ {0<..}. ¬ isCont (limit_quantile G) (y * s)}"
and cs: "isCont (limit_quantile G) s1" "isCont (limit_quantile G) s2"
and Ds: "limit_quantile G s1 < limit_quantile G s2"
by (rule nondegenerate_growth_points[OF G deg cN])
have s2pos: "0 < s2"
using s12 by simp
have cys: "isCont (limit_quantile G) (y * s1)" "isCont (limit_quantile G) (y * s2)"
using nn s12 s2pos by auto
have ys_pos: "0 < y * s1" "0 < y * s2"
using y s12 s2pos by auto
have P1: "((λt. (tail_quantile F (t * y * s1) - b (nat ⌊t⌋)) / a (nat ⌊t⌋))
⤏ limit_quantile G (y * s1)) at_top"
using RT[OF ys_pos(1) cys(1)] by (simp add: mult.assoc)
have P2: "((λt. (tail_quantile F (t * y * s2) - b (nat ⌊t⌋)) / a (nat ⌊t⌋))
⤏ limit_quantile G (y * s2)) at_top"
using RT[OF ys_pos(2) cys(2)] by (simp add: mult.assoc)
note Q1 = RTy[OF y s12(1) cs(1)] and Q2 = RTy[OF y s2pos cs(2)]
define d where "d = limit_quantile G s2 - limit_quantile G s1"
have d_pos: "0 < d"
using Ds by (simp add: d_def)
have Qdiff: "((λt. (tail_quantile F (t * y * s2) - tail_quantile F (t * y * s1))
/ a (nat ⌊t * y⌋)) ⤏ d) at_top"
using tendsto_diff[OF Q2 Q1] by (simp add: diff_divide_distrib d_def)
have Pdiff: "((λt. (tail_quantile F (t * y * s2) - tail_quantile F (t * y * s1))
/ a (nat ⌊t⌋))
⤏ limit_quantile G (y * s2) - limit_quantile G (y * s1)) at_top"
using tendsto_diff[OF P2 P1] by (simp add: diff_divide_distrib)
have ev_pos: "∀⇩F t in at_top. 0 < (tail_quantile F (t * y * s2)
- tail_quantile F (t * y * s1)) / a (nat ⌊t * y⌋)"
using order_tendstoD(1)[OF Qdiff d_pos] .
define L where "L = (limit_quantile G (y * s2) - limit_quantile G (y * s1)) / d"
have Alim: "((λt. a (nat ⌊t * y⌋) / a (nat ⌊t⌋)) ⤏ L) at_top"
proof -
have *: "((λt. ((tail_quantile F (t * y * s2) - tail_quantile F (t * y * s1))
/ a (nat ⌊t⌋))
/ ((tail_quantile F (t * y * s2) - tail_quantile F (t * y * s1))
/ a (nat ⌊t * y⌋))) ⤏ L) at_top"
unfolding L_def using d_pos by (intro tendsto_divide Pdiff Qdiff) auto
have "∀⇩F t in at_top. ((tail_quantile F (t * y * s2) - tail_quantile F (t * y * s1))
/ a (nat ⌊t⌋))
/ ((tail_quantile F (t * y * s2) - tail_quantile F (t * y * s1))
/ a (nat ⌊t * y⌋)) = a (nat ⌊t * y⌋) / a (nat ⌊t⌋)"
using ev_pos
proof eventually_elim
case (elim t)
have "0 < tail_quantile F (t * y * s2) - tail_quantile F (t * y * s1)"
using elim a[of "nat ⌊t * y⌋"] by (simp add: zero_less_divide_iff)
thus ?case
using a[of "nat ⌊t⌋"] a[of "nat ⌊t * y⌋"] by (auto simp: field_simps)
qed
from Lim_transform_eventually[OF * this]
show ?thesis .
qed
have L_nonneg: "0 ≤ L"
using a
by(auto intro!: tendsto_lowerbound[OF Alim] always_eventually less_imp_le[of _ "_ / _"])
have Blim: "((λt. (b (nat ⌊t * y⌋) - b (nat ⌊t⌋)) / a (nat ⌊t⌋))
⤏ limit_quantile G (y * s1) - limit_quantile G s1 * L) at_top"
proof -
have eq: "(tail_quantile F (t * y * s1) - b (nat ⌊t⌋)) / a (nat ⌊t⌋)
- ((tail_quantile F (t * y * s1) - b (nat ⌊t * y⌋)) / a (nat ⌊t * y⌋))
* (a (nat ⌊t * y⌋) / a (nat ⌊t⌋))
= (b (nat ⌊t * y⌋) - b (nat ⌊t⌋)) / a (nat ⌊t⌋)" for t
using a[of "nat ⌊t⌋"] a[of "nat ⌊t * y⌋"] by (simp add: field_simps)
have "((λt. (tail_quantile F (t * y * s1) - b (nat ⌊t⌋)) / a (nat ⌊t⌋)
- ((tail_quantile F (t * y * s1) - b (nat ⌊t * y⌋)) / a (nat ⌊t * y⌋))
* (a (nat ⌊t * y⌋) / a (nat ⌊t⌋)))
⤏ limit_quantile G (y * s1) - limit_quantile G s1 * L) at_top"
by (intro tendsto_diff tendsto_mult P1 Q1 Alim)
thus ?thesis
unfolding eq .
qed
show ?thesis
using L_nonneg Alim Blim by blast
qed
define A where "A = (λy::real. Lim at_top (λt. a (nat ⌊t * y⌋) / a (nat ⌊t⌋)))"
define B where "B = (λy::real. Lim at_top (λt. (b (nat ⌊t * y⌋) - b (nat ⌊t⌋)) / a (nat ⌊t⌋)))"
have AB: "0 ≤ A y ∧
((λt. a (nat ⌊t * y⌋) / a (nat ⌊t⌋)) ⤏ A y) at_top ∧
((λt. (b (nat ⌊t * y⌋) - b (nat ⌊t⌋)) / a (nat ⌊t⌋)) ⤏ B y) at_top"
if y: "0 < y" for y
proof -
obtain L M where LM: "0 ≤ L"
"((λt. a (nat ⌊t * y⌋) / a (nat ⌊t⌋)) ⤏ L) at_top"
"((λt. (b (nat ⌊t * y⌋) - b (nat ⌊t⌋)) / a (nat ⌊t⌋)) ⤏ M) at_top"
using ex[OF y] by blast
have "A y = L"
unfolding A_def by (intro tendsto_Lim LM(2)) simp
moreover have "B y = M"
unfolding B_def by (intro tendsto_Lim LM(3)) simp
ultimately show ?thesis
using LM by simp
qed
have Anonneg: "0 ≤ A y" if "0 < y" for y
using AB[OF that] by blast
have Atend: "((λt. a (nat ⌊t * y⌋) / a (nat ⌊t⌋)) ⤏ A y) at_top" if "0 < y" for y
using AB[OF that] by blast
have Btend: "((λt. (b (nat ⌊t * y⌋) - b (nat ⌊t⌋)) / a (nat ⌊t⌋)) ⤏ B y) at_top"
if "0 < y" for y
using AB[OF that] by blast
have Amul: "A (x * y) = A x * A y" if x: "0 < x" and y: "0 < y" for x y
proof -
have 1: "((λt. a (nat ⌊t * (x * y)⌋) / a (nat ⌊t⌋)) ⤏ A (x * y)) at_top"
using x y by (intro Atend) auto
have "((λt. (a (nat ⌊t * x * y⌋) / a (nat ⌊t * x⌋))
* (a (nat ⌊t * x⌋) / a (nat ⌊t⌋))) ⤏ A y * A x) at_top"
by (intro tendsto_mult Atend[OF x] filterlim_compose[OF Atend[OF y] mult_top[OF x]])
moreover have "(a (nat ⌊t * x * y⌋) / a (nat ⌊t * x⌋))
* (a (nat ⌊t * x⌋) / a (nat ⌊t⌋)) = a (nat ⌊t * x * y⌋) / a (nat ⌊t⌋)"
for t
using a[of "nat ⌊t * x⌋"] by (auto simp: field_simps)
ultimately have "((λt::real. a (nat ⌊t * x * y⌋) / a (nat ⌊t⌋)) ⤏ A y * A x) at_top"
by (metis (no_types, lifting) ext)
hence "((λt. a (nat ⌊t * (x * y)⌋) / a (nat ⌊t⌋)) ⤏ A y * A x) at_top"
by (simp add: mult.assoc)
from tendsto_unique[OF _ 1 this]
show ?thesis
by (simp add: mult.commute)
qed
have A1: "A 1 = 1"
proof -
have "(λt::real. a (nat ⌊t * 1⌋) / a (nat ⌊t⌋)) = (λt. 1)"
using a
by (metis divide_self_if less_irrefl mult.comm_neutral)
hence "((λt::real. a (nat ⌊t * 1⌋) / a (nat ⌊t⌋)) ⤏ 1) at_top"
by simp
from tendsto_unique[OF _ Atend[of 1] this]
show ?thesis
by simp
qed
have Apos: "0 < A y" if y: "0 < y" for y
proof -
have "A (y * (1 / y)) = A y * A (1 / y)"
using y by (intro Amul) auto
moreover have "y * (1 / y) = 1"
using y by simp
ultimately have "A y * A (1 / y) = 1"
using A1 by simp
hence "A y ≠ 0"
by auto
with Anonneg[OF y] show ?thesis
by simp
qed
have Deq: "limit_quantile G (x * y) = limit_quantile G x * A y + B y"
if x: "0 < x" and y: "0 < y"
and cx: "isCont (limit_quantile G) x" and cxy: "isCont (limit_quantile G) (x * y)"
for x y
proof -
have xy: "0 < x * y"
using x y by simp
have eq: "((tail_quantile F (t * y * x) - b (nat ⌊t * y⌋)) / a (nat ⌊t * y⌋))
* (a (nat ⌊t * y⌋) / a (nat ⌊t⌋))
+ (b (nat ⌊t * y⌋) - b (nat ⌊t⌋)) / a (nat ⌊t⌋)
= (tail_quantile F (t * y * x) - b (nat ⌊t⌋)) / a (nat ⌊t⌋)" for t
using a[of "nat ⌊t⌋"] a[of "nat ⌊t * y⌋"] by (simp add: field_simps)
have "((λt. ((tail_quantile F (t * y * x) - b (nat ⌊t * y⌋)) / a (nat ⌊t * y⌋))
* (a (nat ⌊t * y⌋) / a (nat ⌊t⌋))
+ (b (nat ⌊t * y⌋) - b (nat ⌊t⌋)) / a (nat ⌊t⌋))
⤏ limit_quantile G x * A y + B y) at_top"
by (intro tendsto_add tendsto_mult RTy[OF y x cx] Atend[OF y] Btend[OF y])
hence "((λt. (tail_quantile F (t * (x * y)) - b (nat ⌊t⌋)) / a (nat ⌊t⌋))
⤏ limit_quantile G x * A y + B y) at_top"
unfolding eq by (simp add: ac_simps)
from tendsto_unique[OF _ RT[OF xy cxy] this]
show ?thesis
by simp
qed
have Ameas: "A ∈ borel_measurable (restrict_space borel {0<..})"
proof (rule borel_measurable_LIMSEQ_real)
fix i :: nat
show "(λy::real. a (nat ⌊real i * y⌋) / a (nat ⌊real i⌋))
∈ borel_measurable (restrict_space borel {0<..})"
by(auto intro!: measurable_restrict_space1)
next
fix y::real
assume "y ∈ space (restrict_space borel {0<..})"
hence y: "0 < y"
by (simp add: space_restrict_space)
have "((λi. a (nat ⌊real i * y⌋) / a (nat ⌊real i⌋)) ⤏ A y) sequentially"
by (rule filterlim_compose[OF Atend[OF y] filterlim_real_sequentially])
thus "(λi. a (nat ⌊real i * y⌋) / a (nat ⌊real i⌋)) ⇢ A y" .
qed
show ?thesis
by (rule that[of A B]) (fact Apos Atend Btend Ameas Amul Deq)+
qed
theorem limit_quantile_form:
fixes F G :: "real ⇒ real" and a b :: "nat ⇒ real"
assumes F: "right_continuous_mono F 0 1" and G: "right_continuous_mono G 0 1"
and deg: "¬ degenerate_df G"
and a: "⋀n. 0 < a n"
and wc: "weak_conv (λn x. F (a n * x + b n) ^ n) G"
obtains γ c d where "0 < c"
and "⋀y. 0 < y ⟹ limit_quantile G y
= (if γ = 0 then c * ln y + d else c * (y powr γ - 1) / γ + d)"
proof -
obtain A B where Apos: "⋀y. 0 < y ⟹ 0 < A y"
and Atend: "⋀y. 0 < y ⟹ ((λt. a (nat ⌊t * y⌋) / a (nat ⌊t⌋)) ⤏ A y) at_top"
and Btend: "⋀y. 0 < y ⟹
((λt. (b (nat ⌊t * y⌋) - b (nat ⌊t⌋)) / a (nat ⌊t⌋)) ⤏ B y) at_top"
and Ameas: "A ∈ borel_measurable (restrict_space borel {0<..})"
and Amul: "⋀x y. 0 < x ⟹ 0 < y ⟹ A (x * y) = A x * A y"
and Deq: "⋀x y. 0 < x ⟹ 0 < y ⟹ isCont (limit_quantile G) x
⟹ isCont (limit_quantile G) (x * y)
⟹ limit_quantile G (x * y) = limit_quantile G x * A y + B y"
by (rule scaling_limits_ex[OF F G deg a wc]) auto
obtain γ where Aform: "⋀x. 0 < x ⟹ A x = x powr γ"
by (rule multiplicative_measurable_powr[where A=A,OF Ameas Apos Amul]) auto
have Nx_ctble: "countable {s ∈ {0<..}. ¬ isCont (limit_quantile G) s}"
by (intro mono_on_ctble_discont_open)
(fastforce intro!: mono_onI limit_quantile_mono[OF G])+
have DeqFull: "limit_quantile G (x * y) = limit_quantile G x * A y + B y"
if x: "0 < x" and y: "0 < y" for x y
proof -
define Nx where "Nx = {s ∈ {0<..}. ¬ isCont (limit_quantile G) s}"
have Nx_ctble': "countable Nx"
unfolding Nx_def by (rule Nx_ctble)
define N where "N = Nx ∪ (λs. s / y) ` Nx"
have N_ctble: "countable N"
unfolding N_def using Nx_ctble' by (intro countable_Un countable_image) auto
define f where "f = (λx. limit_quantile G (x * y))"
define h where "h = (λx. limit_quantile G x * A y + B y)"
have eq0: "f x' = h x'" if x'pos: "0 < x'" and x'N: "x' ∉ N" for x'
proof -
have cx': "isCont (limit_quantile G) x'"
using x'N x'pos by (auto simp: N_def Nx_def)
have cxy': "isCont (limit_quantile G) (x' * y)"
proof (rule ccontr)
assume "¬ isCont (limit_quantile G) (x' * y)"
hence "(x' * y) / y ∈ (λs. s / y) ` Nx"
using x'pos y unfolding Nx_def by fastforce
hence "x' ∈ N"
using y by (auto simp add: N_def)
with x'N show False
by simp
qed
show ?thesis
unfolding f_def h_def using Deq[OF x'pos y cx' cxy'] .
qed
have left_cont_f: "(f ⤏ f x) (at_left x)"
unfolding f_def using limit_quantile_left_cont_scale[OF G y x] .
have left_cont_h: "(h ⤏ h x) (at_left x)"
unfolding h_def using limit_quantile_left_cont[OF G x] by (intro tendsto_intros)
have "f x = h x"
by (rule left_cont_agree_cocountable_eq[OF N_ctble x left_cont_f left_cont_h])
(use eq0 in blast)
thus ?thesis
by (simp add: f_def h_def)
qed
define d where "d = limit_quantile G 1"
have Bform: "B y = limit_quantile G y - d * A y" if y: "0 < y" for y
using DeqFull[OF zero_less_one y] by (simp add: d_def)
define H where "H = (λu. limit_quantile G (exp u) - d)"
have Acomp: "A (exp v) = exp (γ * v)" for v
by(simp add: Aform powr_def)
have H_eq: "H (u + v) = H u * exp (γ * v) + H v" for u v
proof -
have "limit_quantile G (exp (u + v)) = limit_quantile G (exp u * exp v)"
by (simp add: exp_add)
also have "… = limit_quantile G (exp u) * A (exp v) + B (exp v)"
by (rule DeqFull[OF exp_gt_zero exp_gt_zero])
also have "… = limit_quantile G (exp u) * exp (γ * v)
+ (limit_quantile G (exp v) - d * exp (γ * v))"
using Bform[OF exp_gt_zero] Acomp by simp
also have "… = H u * exp (γ * v) + limit_quantile G (exp v)"
by (simp add: H_def algebra_simps)
finally have "limit_quantile G (exp (u + v)) = H u * exp (γ * v) + limit_quantile G (exp v)" .
thus ?thesis
by (simp add: H_def)
qed
have H_mono: "mono H"
by(auto intro!: monoI limit_quantile_mono G simp: H_def)
obtain c where c_nonneg: "0 ≤ c"
and Hform: "⋀u. H u = (if γ = 0 then c * u else c * (exp (γ * u) - 1) / γ)"
by (rule cocycle_mono_solution[OF H_mono H_eq]) simp
have Dform: "limit_quantile G y
= (if γ = 0 then c * ln y + d else c * (y powr γ - 1) / γ + d)" if y: "0 < y" for y
proof -
have "limit_quantile G y = H (ln y) + d"
using y by (simp add: H_def)
also have "… = (if γ = 0 then c * ln y else c * (exp (γ * ln y) - 1) / γ) + d"
using Hform[of "ln y"] by simp
also have "(if γ = 0 then c * ln y else c * (exp (γ * ln y) - 1) / γ) + d
= (if γ = 0 then c * ln y + d else c * (y powr γ - 1) / γ + d)"
using y by (simp add: powr_def)
finally show ?thesis .
qed
have c_pos: "0 < c"
proof (rule ccontr)
assume "¬ 0 < c"
with c_nonneg have c0: "c = 0"
by simp
obtain y1 y2 where y12: "0 < y1" "y1 < y2"
and D12: "limit_quantile G y1 < limit_quantile G y2"
by (rule nondegenerate_growth_points[OF G deg countable_empty]) auto
have y2pos: "0 < y2"
using y12 by linarith
have "limit_quantile G y1 = d" "limit_quantile G y2 = d"
using Dform[OF y12(1)] Dform[OF y2pos] c0 by simp_all
with D12 show False
by simp
qed
show thesis
by (rule that[of c γ d]) (use Dform c_pos in auto)
qed
text ‹The Fisher--Tippett--Gnedenko theorem, which is Theorem~1.1.3 of the book by
de Haan and Ferreira~\<^cite>‹deHaanFerreira›
(Fisher and Tippett (1928)~\<^cite>‹FisherTippett1928›,
Gnedenko (1943)~\<^cite>‹Gnedenko1943›).›
theorem Fisher_Tippett_Gnedenko:
fixes F G :: "real ⇒ real" and a b :: "nat ⇒ real"
assumes F: "right_continuous_mono F 0 1" and G: "right_continuous_mono G 0 1"
and deg: "¬ degenerate_df G"
and a: "⋀n. 0 < a n"
and wc: "weak_conv (λn x. F (a n * x + b n) ^ n) G"
obtains γ μ σ where "0 < σ" and "G = EVD_cdf γ μ σ"
proof -
obtain γ c d where c_pos: "0 < c"
and Dform: "⋀y. 0 < y ⟹ limit_quantile G y
= (if γ = 0 then c * ln y + d else c * (y powr γ - 1) / γ + d)"
by (rule limit_quantile_form[OF assms]) simp
have Dform': "⋀y. 0 < y ⟹ limit_quantile (EVD_cdf γ d c) y
= (if γ = 0 then c * ln y + d else c * (y powr γ - 1) / γ + d)"
using limit_quantile_EVD_cdf[OF c_pos] by simp
have eq: "⋀y. 0 < y ⟹ limit_quantile G y = limit_quantile (EVD_cdf γ d c) y"
using Dform Dform' by simp
have "G = EVD_cdf γ d c"
by (intro dist_function_unique_limit_quantile[OF G _ eq]
right_continuous_mono_cdf[OF real_distribution_EVD[OF c_pos]])
with c_pos that
show thesis
by blast
qed
theorem Fisher_Tippett_Gnedenko':
fixes F G :: "real ⇒ real" and a b :: "nat ⇒ real"
assumes "right_continuous_mono F 0 1" "right_continuous_mono G 0 1" "¬ degenerate_df G"
and "⋀n. 0 < a n"
and "weak_conv (λn x. F (a n * x + b n) ^ n) G"
obtains γ α β where "0 < α" "⋀x. G x = EVD_cdf γ 0 1 (α * x + β)"
proof -
obtain γ μ σ where "0 < σ" and "G = EVD_cdf γ μ σ"
using Fisher_Tippett_Gnedenko[OF assms] by metis
thus ?thesis
using that[of "1 / σ" γ "- μ / σ"]
by(simp add: EVD_cdf_location_scale[of σ γ,symmetric] diff_divide_distrib)
qed
corollary Fisher_Tippett_Gnedenko_MDA':
assumes deg: "¬ degenerate_df G"
and dom: "domain_of_attraction F G"
obtains γ μ σ where "0 < σ" and "G = EVD_cdf γ μ σ"
proof -
obtain a b where a: "⋀n. 0 < a n"
and wc: "weak_conv (λn x. F (a n * x + b n) ^ n) G"
using dom unfolding domain_of_attraction_def by blast
have G: "right_continuous_mono G 0 1" and F:"right_continuous_mono F 0 1"
using dom unfolding domain_of_attraction_def by auto
obtain γ μ σ where "0 < σ" and "G = EVD_cdf γ μ σ"
by (rule Fisher_Tippett_Gnedenko[OF F G deg a wc])
thus thesis
by (rule that)
qed
corollary Fisher_Tippett_Gnedenko_MDA:
assumes "¬ degenerate_df G"
and d:"domain_of_attraction F G"
shows "∃γ. domain_of_attraction F (EVD_cdf γ 0 1)"
proof -
obtain γ μ σ where sigma:"0 < σ" and G:"G = EVD_cdf γ μ σ"
using Fisher_Tippett_Gnedenko_MDA'[OF assms] by metis
thus ?thesis
using d domain_of_attraction_EVD_cdf_iff[of σ]
by(auto intro!: exI[where x=γ])
qed
subsection ‹Alternative Characterizations of the Domain of Attraction›
text ‹We formalize Theorems~1.1.2 and~1.1.6 of the book~\<^cite>‹deHaanFerreira›.›
subsubsection ‹Theorem 1.1.2 Part›
lemma MDA_tail_probability_witness:
fixes F a :: "real ⇒ real" and γ :: real
assumes F: "right_continuous_mono F 0 1"
and a_pos: "⋀t. 0 < a t" and sigma[arith]:"0 < σ"
and tail: "⋀x. 1 + γ * (x - μ) / σ > 0 ⟹
((λt. t * (1 - F (a t * x + b t)))
⤏ - ln (EVD_cdf γ μ σ x)) at_top"
shows "(λn. F (a (real n) * x + b (real n)) ^ n) ⇢ EVD_cdf γ μ σ x"
proof -
have inside_conv: "(λn. F (a (real n) * x' + b (real n)) ^ n)
⇢ EVD_cdf γ μ σ x'"
if supp': "1 + γ * (x' - μ) / σ > 0" for x'
proof -
have seqtail: "(λn::nat. real n * (1 - F (a (real n) * x' + b (real n))))
⇢ - ln (EVD_cdf γ μ σ x')"
by (rule filterlim_compose[OF tail[OF supp'] filterlim_real_sequentially])
have Fbound: "⋀n. 0 ≤ F (a (real n) * x' + b (real n))"
"⋀n. F (a (real n) * x' + b (real n)) ≤ 1"
using right_continuous_mono.a_le_f[OF F] right_continuous_mono.f_le_b[OF F] by auto
have EVDbound: "0 < EVD_cdf γ μ σ x'" "EVD_cdf γ μ σ x' ≤ 1"
using EVD_cdf_supp_bounds[OF supp'] by auto
show ?thesis
using power_tendsto_iff_tendsto_tail
[of "λn. F (a (real n) * x' + b (real n))" "EVD_cdf γ μ σ x'"]
Fbound EVDbound seqtail
by auto
qed
consider "1 + γ * (x - μ) / σ > 0" | "1 + γ * (x - μ) / σ ≤ 0" "γ > 0"
| "1 + γ * (x - μ) / σ ≤ 0" "γ < 0"
by fastforce
thus "(λn. F (a (real n) * x + b (real n)) ^ n) ⇢ EVD_cdf γ μ σ x"
proof cases
assume "1 + γ * (x - μ) / σ > 0"
thus ?thesis
using inside_conv by simp
next
assume supp_out:"1 + γ * (x - μ) / σ ≤ 0" and gamma:"γ > 0"
define y0 where "y0 = - σ / γ + μ"
have xy0: "x ≤ y0"
using supp_out gamma
by (simp add: y0_def field_simps)
have val0: "EVD_cdf γ μ σ x = 0"
using supp_out gamma by(simp add: EVD_cdf_def Let_def)
have valY0: "EVD_cdf γ μ σ y0 = 0"
using gamma by (simp add: EVD_cdf_def Let_def y0_def)
have contY0: "isCont (EVD_cdf γ μ σ) y0"
by (rule isCont_EVD_cdf) simp
have base_nonneg: "0 ≤ F (a (real n) * x + b (real n)) ^ n" for n
using right_continuous_mono.a_le_f[OF F] by simp
show ?thesis
unfolding val0 tendsto_iff dist_real_def
proof safe
fix e :: real
assume e: "0 < e"
obtain δ where δ: "0 < δ"
"⋀x''. x'' ≠ y0 ∧ ¦x'' - y0¦ < δ ⟹ ¦EVD_cdf γ μ σ x'' - EVD_cdf γ μ σ y0¦ < e"
using LIM_D[OF contY0[unfolded isCont_def], of e] e by auto
define x' where "x' = y0 + δ / 2"
have x'y0: "y0 < x'" "x' ≠ y0 ∧ ¦x' - y0¦ < δ"
using δ(1) by (simp_all add: x'_def)
have xx': "x ≤ x'"
using xy0 x'y0(1) by linarith
have anpos: "⋀n. 0 ≤ a (real n)"
using a_pos by (simp add: less_imp_le)
have supp'': "1 + γ * (x' - μ) / σ > 0"
using x'y0(1) gamma by (simp add: y0_def field_simps)
have target: "EVD_cdf γ μ σ x' < e"
using δ(2)[OF x'y0(2)] valY0 EVD_cdf_supp_bounds[OF supp'']
by simp
have convx': "(λn. F (a (real n) * x' + b (real n)) ^ n)
⇢ EVD_cdf γ μ σ x'"
using inside_conv[OF supp''] .
obtain N where N: "⋀n. N ≤ n ⟹ F (a (real n) * x' + b (real n)) ^ n < e"
using order_tendstoD(2)[OF convx' target]
unfolding eventually_sequentially by blast
show "∀⇩F n in sequentially. ¦F (a (real n) * x + b (real n)) ^ n - 0¦ < e"
proof (intro eventually_sequentiallyI[where c=N])
fix n
assume Nn: "N ≤ n"
have "F (a (real n) * x + b (real n)) ^ n ≤ F (a (real n) * x' + b (real n)) ^ n"
using right_continuous_mono.a_le_f[OF F] anpos xx'
by (auto intro!: power_mono monoD[OF right_continuous_mono.mono[OF F]] mult_left_mono)
thus "¦F (a (real n) * x + b (real n)) ^ n - 0¦ < e"
using base_nonneg N[OF Nn] by simp
qed
qed
next
assume supp_out:"1 + γ * (x - μ) / σ ≤ 0" and neg:"γ < 0"
define y0 where "y0 = - σ / γ + μ"
have xy0: "y0 ≤ x"
using supp_out neg by (simp add: y0_def field_simps)
have val0: "EVD_cdf γ μ σ x = 1"
using neg supp_out by (simp add: EVD_cdf_def Let_def)
have valY0: "EVD_cdf γ μ σ y0 = 1"
using neg by (simp add: EVD_cdf_def y0_def Let_def)
have contY0: "isCont (EVD_cdf γ μ σ) y0"
by (rule isCont_EVD_cdf) simp
have base_le1: "F (a (real n) * x + b (real n)) ^ n ≤ 1" for n
using right_continuous_mono.a_le_f[OF F] right_continuous_mono.f_le_b[OF F]
by (simp add: power_le_one)
show ?thesis
unfolding val0 tendsto_iff dist_real_def
proof safe
fix e :: real
assume e: "0 < e"
obtain δ where δ: "0 < δ"
"⋀x''. x'' ≠ y0 ∧ ¦x'' - y0¦ < δ ⟹ ¦EVD_cdf γ μ σ x'' - EVD_cdf γ μ σ y0¦ < e"
using LIM_D[OF contY0[unfolded isCont_def], of e] e by auto
define x' where "x' = y0 - δ / 2"
have x'y0: "x' < y0" "x' ≠ y0 ∧ ¦x' - y0¦ < δ"
using δ(1) by (simp_all add: x'_def)
have xx': "x' ≤ x"
using xy0 x'y0(1) by linarith
have anpos: "⋀n. 0 ≤ a (real n)"
using a_pos by (simp add: less_imp_le)
have supp'': "1 + γ * (x' - μ) / σ > 0"
using x'y0(1) neg by (simp add: y0_def field_simps)
have target: "1 - e < EVD_cdf γ μ σ x'"
using δ(2)[OF x'y0(2)] valY0 EVD_cdf_supp_bounds[OF supp''] by simp
have convx': "(λn. F (a (real n) * x' + b (real n)) ^ n)
⇢ EVD_cdf γ μ σ x'"
using inside_conv[OF supp''] .
obtain N where N: "⋀n. N ≤ n ⟹ 1 - e < F (a (real n) * x' + b (real n)) ^ n"
using order_tendstoD(1)[OF convx' target]
unfolding eventually_sequentially by blast
show "∀⇩F n in sequentially. ¦F (a (real n) * x + b (real n)) ^ n - 1¦ < e"
proof (intro eventually_sequentiallyI[where c=N])
fix n
assume Nn: "N ≤ n"
have "F (a (real n) * x' + b (real n)) ^ n ≤ F (a (real n) * x + b (real n)) ^ n"
using right_continuous_mono.a_le_f[OF F] anpos xx'
by (auto intro!: power_mono monoD[OF right_continuous_mono.mono[OF F]] mult_left_mono)
thus "¦F (a (real n) * x + b (real n)) ^ n - 1¦ < e"
using base_le1 N[OF Nn] by simp
qed
qed
qed
qed
lemma MDA_tail_quantile_to_tail_probability:
fixes F a :: "real ⇒ real" and γ x :: real
assumes F: "right_continuous_mono F 0 1"
and a_pos: "⋀t. 0 < a t"
and sigma[arith]:"0 < σ"
and quant: "⋀x. 0 < x ⟹
((λt. (tail_quantile F (t * x) - b t) / a t)
⤏ (if γ = 0
then σ * ln x + μ
else σ * (x powr γ - 1) / γ + μ)) at_top"
(is "⋀x. 0 < x ⟹ (_ ⤏ ?G x) at_top")
and supp: "1 + γ * (x - μ) / σ > 0"
shows "((λt. t * (1 - F (a t * x + b t)))
⤏ - ln (EVD_cdf γ μ σ x)) at_top"
proof -
have st_mono1:"σ * ln y + μ < σ * ln z + μ"
if "0 < y" "y < z" for y z
using that by auto
have st_mono2:"σ * (y powr γ - 1) / γ + μ < σ * (z powr γ - 1) / γ + μ"
if "0 < y" "y < z" "γ ≠ 0" for y z
proof(cases "γ > 0")
show "0 < γ ⟹
σ * (y powr γ - 1) / γ + μ < σ * (z powr γ - 1) / γ + μ"
using that by(auto intro!: divide_strict_right_mono powr_less_mono2)
next
show "¬ 0 < γ ⟹
σ * (y powr γ - 1) / γ + μ < σ * (z powr γ - 1) / γ + μ"
using that by(auto intro!: divide_strict_right_mono_neg powr_less_mono2_neg)
qed
define ρ where "ρ = (if γ = 0 then exp ((x - μ) / σ) else (1 + γ * (x - μ) / σ) powr (1 / γ))"
have ρ_pos: "0 < ρ"
using supp by (simp add: ρ_def)
have Dρ: "?G ρ = x"
using supp by(auto simp: ρ_def powr_powr)
have EVD_val: "EVD_cdf γ μ σ x
= exp (- (if γ = 0 then exp (- ((x - μ) / σ))
else (1 + γ * (x - μ) / σ) powr (- 1 / γ)))"
using supp by (simp add: EVD_cdf_def Let_def)
have target_eq: "- ln (EVD_cdf γ μ σ x) = 1 / ρ"
by(auto simp add: EVD_val ρ_def exp_minus[of "(x - μ) / σ"] inverse_eq_divide powr_minus)
show "((λt. t * (1 - F (a t * x + b t)))
⤏ - ln (EVD_cdf γ μ σ x)) at_top"
unfolding target_eq tendsto_iff dist_real_def
proof safe
fix e :: real
assume e: "0 < e"
have inv_cont: "isCont (λr. 1 / r) ρ"
using ρ_pos by (intro continuous_intros) simp
obtain δ where δpos: "0 < δ"
and δbound: "⋀r. r ≠ ρ ⟹ ¦r - ρ¦ < δ ⟹ ¦1 / r - 1 / ρ¦ < e"
using LIM_D[OF inv_cont[unfolded isCont_def], of e] e by auto
define η where "η = min δ ρ / 2"
have ηpos: "0 < η" and ηltρ: "η < ρ" and ηltδ: "η < δ"
using δpos ρ_pos by (simp_all add: η_def)
define ρ1 where "ρ1 = ρ - η"
define ρ2 where "ρ2 = ρ + η"
have ρ1pos: "0 < ρ1" and ρ1ltρ: "ρ1 < ρ" and ρltρ2: "ρ < ρ2"
using ηpos ηltρ by (simp_all add: ρ1_def ρ2_def)
have e1: "¦1 / ρ1 - 1 / ρ¦ < e"
using δbound[of ρ1] ηpos ηltδ by (simp add: ρ1_def)
have e2: "¦1 / ρ2 - 1 / ρ¦ < e"
using δbound[of ρ2] ηpos ηltδ by (simp add: ρ2_def)
have ρ2pos: "0 < ρ2"
using ρltρ2 ρ_pos by linarith
have x2gt: "x < ?G ρ2"
using st_mono1[OF ρ_pos ρltρ2] st_mono2[OF ρ_pos ρltρ2] Dρ by auto
have x1lt: "?G ρ1 < x"
using st_mono1[OF ρ1pos ρ1ltρ] st_mono2[OF ρ1pos ρ1ltρ] Dρ by auto
obtain T1 where T1: "⋀t. T1 ≤ t ⟹ x < (tail_quantile F (t * ρ2) - b t) / a t"
using order_tendstoD(1)[OF quant[OF ρ2pos] x2gt]
unfolding eventually_at_top_linorder by blast
obtain T2 where T2: "⋀t. T2 ≤ t ⟹ (tail_quantile F (t * ρ1) - b t) / a t < x"
using order_tendstoD(2)[OF quant[OF ρ1pos] x1lt]
unfolding eventually_at_top_linorder by blast
define T where "T = max (max T1 T2) (max (1 / ρ1 + 1) (1 / ρ2 + 1))"
show "∀⇩F t in at_top. ¦t * (1 - F (a t * x + b t)) - 1 / ρ¦ < e"
proof (intro eventually_at_top_linorderI[where c=T])
fix t
assume Tt: "T ≤ t"
have T1t: "T1 ≤ t" and T2t: "T2 ≤ t"
and t_ge1: "1 / ρ1 + 1 ≤ t" and t_ge2: "1 / ρ2 + 1 ≤ t"
using Tt by (simp_all add: T_def)
have ρ1inv_pos: "0 < 1 / ρ1"
using ρ1pos by simp
have tpos: "0 < t"
using t_ge1 ρ1inv_pos by linarith
have tρ1: "1 < t * ρ1"
using mult_strict_right_mono[OF _ ρ1pos, of "1 / ρ1" t] t_ge1 ρ1pos
by simp
have tρ2: "1 < t * ρ2"
using mult_strict_right_mono[OF _ ρ2pos, of "1 / ρ2" t] t_ge2 ρ2pos
by simp
have ineq1: "a t * x + b t < tail_quantile F (t * ρ2)"
using T1[OF T1t] a_pos[of t] by (simp add: field_simps)
have ineq2: "tail_quantile F (t * ρ1) < a t * x + b t"
using T2[OF T2t] a_pos[of t] by (simp add: field_simps)
have p_bounds2: "0 < 1 - 1 / (t * ρ2)" "1 - 1 / (t * ρ2) < 1"
using tρ2 by simp_all
have lower: "1 / ρ2 < t * (1 - F (a t * x + b t))"
proof -
have "1 / (t * ρ2) < 1 - F (a t * x + b t)"
using right_continuous_mono.ginv_le_iff[OF F p_bounds2, of "a t * x + b t"] ineq1
by linarith
hence "t * (1 / (t * ρ2)) < t * (1 - F (a t * x + b t))"
using tpos by (intro mult_strict_left_mono) auto
thus ?thesis
using tpos ρ2pos by (simp add: field_simps)
qed
have p_bounds1: "0 < 1 - 1 / (t * ρ1)" "1 - 1 / (t * ρ1) < 1"
using tρ1 by simp_all
have upper: "t * (1 - F (a t * x + b t)) ≤ 1 / ρ1"
proof -
have "F (tail_quantile F (t * ρ1)) ≤ F (a t * x + b t)"
by (rule monoD[OF right_continuous_mono.mono[OF F], OF less_imp_le[OF ineq2]])
moreover have "1 - 1 / (t * ρ1) ≤ F (tail_quantile F (t * ρ1))"
using right_continuous_mono.ginv_attained[OF F p_bounds1] by simp
ultimately have "1 - 1 / (t * ρ1) ≤ F (a t * x + b t)"
by linarith
hence "t * (1 - F (a t * x + b t)) ≤ t * (1 / (t * ρ1))"
using tpos by (intro mult_left_mono) auto
moreover have "t * (1 / (t * ρ1)) = 1 / ρ1"
using tpos ρ1pos by (simp add: field_simps)
ultimately show ?thesis
by linarith
qed
show "¦t * (1 - F (a t * x + b t)) - 1 / ρ¦ < e"
using lower upper e1 e2 by linarith
qed
qed
qed
lemma MDA_tail_quantile_witness:
fixes F a :: "real ⇒ real" and γ :: real
assumes F: "right_continuous_mono F 0 1"
and a_pos: "⋀t. 0 < a t" and sigma:"0 < σ"
and quant: "⋀x. 0 < x ⟹
((λt. (tail_quantile F (t * x) - b t) / a t)
⤏ (if γ = 0
then σ * ln x + μ
else σ * (x powr γ - 1) / γ + μ)) at_top"
shows "(λn. F (a (real n) * x + b (real n)) ^ n) ⇢ EVD_cdf γ μ σ x"
by(intro MDA_tail_probability_witness[OF F a_pos]
MDA_tail_quantile_to_tail_probability[OF F a_pos _ quant] sigma) auto
lemma MDA_imp_tail_probability:
fixes F :: "real ⇒ real" and γ :: real
assumes F: "right_continuous_mono F 0 1"
and G: "right_continuous_mono G 0 1"
and a:"⋀n. 0 < a n"
and deg:"¬ degenerate_df G"
and lim:"⋀y. (λn. F (a n * y + b n) ^ n) ⇢ EVD_cdf γ 0 1 y"
and sigma[arith]:"0 < σ"
and supp:"1 + γ * x > 0"
shows"((λt. t * (1 - F (a (nat ⌊t⌋) * x + tail_quantile F t)))
⤏ - ln (EVD_cdf γ 0 1 x)) at_top"
proof -
have G': "right_continuous_mono (EVD_cdf γ 0 1) 0 1"
by (rule right_continuous_mono_EVD_cdf) simp
have deg': "¬ degenerate_df (EVD_cdf γ 0 1)"
by (rule EVD_cdf_nondegenerate) simp
have wc: "weak_conv (λn x'. F (a n * x' + b n) ^ n) (EVD_cdf γ 0 1)"
by(subst weak_conv_EVD_cdf_iff) (auto simp: lim)
have cont: "isCont (limit_quantile (EVD_cdf γ 0 1)) y" if y: "0 < y" for y
by(intro isCont_limit_quantile_EVD_cdf y) simp
have quant: "((λt. (tail_quantile F (t * x') - tail_quantile F t) / a (nat ⌊t⌋))
⤏ (if γ = 0 then 1 * ln x' + 0 else 1 * (x' powr γ - 1) / γ + 0)) at_top"
if x': "0 < x'" for x'
proof -
note at_x' = real_tail_quantile_tendsto[OF F G' deg' a wc x' cont[OF x']]
have at_1: "((λt. (tail_quantile F t - b (nat ⌊t⌋)) / a (nat ⌊t⌋))
⤏ limit_quantile (EVD_cdf γ 0 1) 1) at_top"
using real_tail_quantile_tendsto[OF F G' deg' a wc zero_less_one cont[OF zero_less_one]]
by simp
have diff: "((λt. (tail_quantile F (t * x') - b (nat ⌊t⌋)) / a (nat ⌊t⌋)
- (tail_quantile F t - b (nat ⌊t⌋)) / a (nat ⌊t⌋))
⤏ limit_quantile (EVD_cdf γ 0 1) x' - limit_quantile (EVD_cdf γ 0 1) 1) at_top"
by (intro tendsto_diff at_x' at_1)
have val_1: "limit_quantile (EVD_cdf γ 0 1) 1 = 0"
using limit_quantile_EVD_cdf[OF zero_less_one zero_less_one, of γ 0] by simp
show ?thesis
using diff val_1 limit_quantile_EVD_cdf[OF zero_less_one x', of γ 0]
by (simp add: diff_divide_distrib)
qed
have a': "⋀t. 0 < a (nat ⌊t⌋)"
using a by simp
have supp01: "1 + γ * (x - 0) / 1 > 0"
using supp by simp
show ?thesis
using MDA_tail_quantile_to_tail_probability
[where a = "λt. a (nat ⌊t⌋)" and b = "tail_quantile F",
OF F a' zero_less_one quant supp01]
by simp
qed
lemma MDA_imp_tail_quantile:
fixes F :: "real ⇒ real" and γ :: real
assumes F: "right_continuous_mono F 0 1"
and G: "right_continuous_mono G 0 1"
and a:"⋀n. 0 < a n"
and deg:"¬ degenerate_df G"
and lim:"⋀y. (λn. F (a n * y + b n) ^ n) ⇢ EVD_cdf γ 0 1 y"
and sigma[arith]:"0 < σ"
and x:"x > 0"
shows"((λt. (tail_quantile F (t * x) - tail_quantile F t) / a (nat (floor t)))
⤏ (if γ = 0 then ln x else (x powr γ - 1) / γ)) at_top"
proof -
have G': "right_continuous_mono (EVD_cdf γ 0 1) 0 1"
by (rule right_continuous_mono_EVD_cdf) simp
have deg': "¬ degenerate_df (EVD_cdf γ 0 1)"
by (rule EVD_cdf_nondegenerate) simp
have wc: "weak_conv (λn x'. F (a n * x' + b n) ^ n) (EVD_cdf γ 0 1)"
by(auto intro!: weak_conv_EVD_cdf_iff[THEN iffD2] lim)
have cont: "isCont (limit_quantile (EVD_cdf γ 0 1)) y" if y: "0 < y" for y
by(intro isCont_limit_quantile_EVD_cdf y) simp
have at_x: "((λt. (tail_quantile F (t * x) - b (nat ⌊t⌋)) / a (nat ⌊t⌋))
⤏ limit_quantile (EVD_cdf γ 0 1) x) at_top"
by (rule real_tail_quantile_tendsto[OF F G' deg' a wc x cont[OF x]])
have at_1: "((λt. (tail_quantile F t - b (nat ⌊t⌋)) / a (nat ⌊t⌋))
⤏ limit_quantile (EVD_cdf γ 0 1) 1) at_top"
using real_tail_quantile_tendsto[OF F G' deg' a wc zero_less_one cont[OF zero_less_one]]
by simp
have diff: "((λt. (tail_quantile F (t * x) - b (nat ⌊t⌋)) / a (nat ⌊t⌋)
- (tail_quantile F t - b (nat ⌊t⌋)) / a (nat ⌊t⌋))
⤏ limit_quantile (EVD_cdf γ 0 1) x - limit_quantile (EVD_cdf γ 0 1) 1) at_top"
by (intro tendsto_diff at_x at_1)
have val_1: "limit_quantile (EVD_cdf γ 0 1) 1 = 0"
using limit_quantile_EVD_cdf[OF zero_less_one zero_less_one, of γ 0] by simp
show ?thesis
using diff val_1 limit_quantile_EVD_cdf[OF zero_less_one x, of γ 0]
by (auto simp: diff_divide_distrib)
qed
lemma MDA_iff_tail_probability:
fixes F :: "real ⇒ real" and γ :: real
assumes F: "right_continuous_mono F 0 1"
and a:"⋀n. 0 < a n"
and sigma[arith]:"0 < σ"
shows "(∀x. (λn. F (a n * x + b n) ^ n) ⇢ EVD_cdf γ μ σ x) ⟷
(∀x. (1 + γ * (x - μ) / σ > 0 ⟶
((λt. t * (1 - F (a (nat ⌊t⌋) * x + b (nat ⌊t⌋))))
⤏ - ln (EVD_cdf γ μ σ x)) at_top))"
proof
assume wc:"∀x. (λn. F (a n * x + b n) ^ n) ⇢ EVD_cdf γ μ σ x"
have cont: "isCont (limit_quantile (EVD_cdf γ μ σ)) y" if y: "0 < y" for y
by(intro isCont_limit_quantile_EVD_cdf y) simp
have "⋀y. 0 < y ⟹
((λt. (tail_quantile F (t * y) - b (nat ⌊t⌋)) / a (nat ⌊t⌋))
⤏ (if γ = 0 then σ * ln y + μ
else σ * (y powr γ - 1) / γ + μ)) at_top"
using real_tail_quantile_tendsto[OF F right_continuous_mono_EVD_cdf
EVD_cdf_nondegenerate a weak_conv_EVD_cdf_iff[THEN iffD2] _ cont]
wc sigma
by(auto simp add: limit_quantile_EVD_cdf[OF sigma,of _ γ μ])
from MDA_tail_quantile_to_tail_probability[OF F a sigma this]
show "∀x. 0 < 1 + γ * (x - μ) / σ ⟶
((λt. t * (1 - F (a (nat ⌊t⌋) * x + b (nat ⌊t⌋))))
⤏ - ln (EVD_cdf γ μ σ x)) at_top"
by blast
qed(use MDA_tail_probability_witness[where a="λt. a (nat ⌊t⌋)"
and b ="λt. b (nat ⌊t⌋)",OF F a sigma]
in simp)
lemma MDA_iff_tail_quantile:
fixes F :: "real ⇒ real" and γ :: real
assumes F: "right_continuous_mono F 0 1"
and a:"⋀n. 0 < a n"
and sigma[arith]:"0 < σ"
shows "(∀x. (λn. F (a n * x + b n) ^ n) ⇢ EVD_cdf γ μ σ x) ⟷
(∀x>0. ((λt. (tail_quantile F (t * x) - b (nat ⌊t⌋)) / a (nat ⌊t⌋))
⤏ (if γ = 0 then σ * ln x + μ else σ * (x powr γ - 1) / γ + μ)) at_top)"
proof
assume wc:"∀x. (λn. F (a n * x + b n) ^ n) ⇢ EVD_cdf γ μ σ x"
have cont: "isCont (limit_quantile (EVD_cdf γ μ σ)) y" if y: "0 < y" for y
by(intro isCont_limit_quantile_EVD_cdf y) simp
show "∀x>0. ((λt. (tail_quantile F (t * x) - b (nat ⌊t⌋)) / a (nat ⌊t⌋))
⤏ (if γ = 0 then σ * ln x + μ else σ * (x powr γ - 1) / γ + μ)) at_top"
using real_tail_quantile_tendsto[OF F right_continuous_mono_EVD_cdf
EVD_cdf_nondegenerate a weak_conv_EVD_cdf_iff[THEN iffD2] _ cont]
wc
by(auto simp: limit_quantile_EVD_cdf[OF sigma,of _ γ μ])
qed(use MDA_tail_quantile_witness[where a="λt. a (nat ⌊t⌋)" and b ="λt. b (nat ⌊t⌋)",OF assms]
in simp)
lemma MDA_iff_tail_quantile':
fixes F :: "real ⇒ real" and γ :: real
assumes F: "right_continuous_mono F 0 1"
shows "domain_of_attraction F (EVD_cdf γ 0 1)
⟷ (∃a. (∀t. 0 < a t) ∧
(∀x>0. ((λt. (tail_quantile F (t * x) - tail_quantile F t) / a t)
⤏ (if γ = 0 then ln x else (x powr γ - 1) / γ)) at_top))"
proof safe
assume dom: "domain_of_attraction F (EVD_cdf γ 0 1)"
obtain a b where a: "⋀n. 0 < a n"
and lim: "⋀y. (λn. F (a n * y + b n) ^ n) ⇢ EVD_cdf γ 0 1 y"
using dom unfolding domain_of_attraction_def
by (auto simp: weak_conv_EVD_cdf_iff)
show "∃a. (∀t. 0 < a t) ∧
(∀x>0. ((λt. (tail_quantile F (t * x) - tail_quantile F t) / a t)
⤏ (if γ = 0 then ln x else (x powr γ - 1) / γ)) at_top)"
using a
by(intro exI[of _ "λt. a (nat ⌊t⌋)"] conjI allI
MDA_imp_tail_quantile[OF F right_continuous_mono_EVD_cdf
a EVD_cdf_nondegenerate lim] impI)
auto
next
fix a
assume a: "∀t. 0 < a t"
and quant: "∀x>0.
((λt. (tail_quantile F (t * x) - tail_quantile F t) / a t)
⤏ (if γ = 0 then ln x else (x powr γ - 1) / γ)) at_top"
thus "domain_of_attraction F (EVD_cdf γ 0 1)"
by(auto intro!: exI[of _ "λn. a (real n)",
OF conjI[OF _ exI[of _ "λn. tail_quantile F (real n)"]]]
MDA_tail_quantile_witness[where b = "tail_quantile F", OF F]
right_continuous_mono_EVD_cdf F
simp: weak_conv_EVD_cdf_iff domain_of_attraction_def)
qed
lemma MDA_iff_tail_probability':
fixes F :: "real ⇒ real" and γ :: real
assumes F: "right_continuous_mono F 0 1"
shows "domain_of_attraction F (EVD_cdf γ 0 1)
⟷ (∃a. (∀t. 0 < a t) ∧
(∀x. 1 + γ * x > 0 ⟶
((λt. t * (1 - F (a t * x + tail_quantile F t)))
⤏ - ln (EVD_cdf γ 0 1 x)) at_top))"
proof safe
assume dom: "domain_of_attraction F (EVD_cdf γ 0 1)"
obtain a b where a: "⋀n. 0 < a n"
and lim: "⋀y. (λn. F (a n * y + b n) ^ n) ⇢ EVD_cdf γ 0 1 y"
using dom unfolding domain_of_attraction_def
by (auto simp: weak_conv_EVD_cdf_iff)
show "∃a. (∀t. 0 < a t) ∧
(∀x. 1 + γ * x > 0 ⟶
((λt. t * (1 - F (a t * x + tail_quantile F t)))
⤏ - ln (EVD_cdf γ 0 1 x)) at_top)"
using a
by(intro exI[of _ "λt. a (nat ⌊t⌋)"] conjI allI
MDA_imp_tail_probability[OF F right_continuous_mono_EVD_cdf
a EVD_cdf_nondegenerate lim] impI)
auto
next
fix a
assume a: "∀t. 0 < a t"
and tail: "∀x. 1 + γ * x > 0 ⟶
((λt. t * (1 - F (a t * x + tail_quantile F t)))
⤏ - ln (EVD_cdf γ 0 1 x)) at_top"
thus "domain_of_attraction F (EVD_cdf γ 0 1)"
by(auto intro!: exI[of _ "λn. a (real n)",
OF conjI[OF _ exI[of _ "λn. tail_quantile F (real n)"]]]
MDA_tail_probability_witness[where b = "tail_quantile F", OF F]
right_continuous_mono_EVD_cdf F
simp: weak_conv_EVD_cdf_iff domain_of_attraction_def)
qed
subsubsection ‹Theorem 1.1.6 Part›
definition x_star :: "(real ⇒ real) ⇒ real" where
"x_star F = Sup {x. F x < 1}"
abbreviation bdd_support :: "(real ⇒ real) ⇒ bool" where
"bdd_support F ≡ bdd_above {x. F x < 1}"
lemma not_bdd_supportI:
assumes "⋀x. ∃y>x. F y < 1"
shows "¬ bdd_support F"
using assms by(auto simp: bdd_above_def) (meson linorder_not_le)
lemma not_bdd_supportI':
assumes "⋀x. F x < 1"
shows "¬ bdd_support F"
by(intro not_bdd_supportI) (meson assms less_add_one)
definition endpoint_filter :: "(real ⇒ real) ⇒ real filter" where
"endpoint_filter F = (if bdd_support F then at_left (x_star F) else at_top)"
lemma endpoint_filter:
"bdd_support F ⟹ endpoint_filter F = at_left (x_star F)"
"¬ bdd_support F ⟹ endpoint_filter F = at_top"
by(auto simp: endpoint_filter_def)
lemma endpoint_filter_neq_bot: "endpoint_filter F ≠ ⊥"
by (simp add: endpoint_filter_def)
lemma F_x_star_eq_1:
assumes "right_continuous_mono F 0 1"
and bdd:"bdd_above {x. F x < 1}"
shows "F (x_star F) = 1"
proof(rule antisym)
interpret right_continuous_mono F 0 1
by fact
show "1 ≤ F (x_star F)"
proof(rule ccontr)
assume h:"¬ 1 ≤ F (x_star F)"
hence "Sup {x. F x < 1} ∈ {x. F x < 1}"
by(auto simp: x_star_def)
have "∀ε>0. ∃δ>0. F (⨆ {x. F x < 1} + δ) - F (⨆ {x. F x < 1}) < ε"
using mono cont
by(subst continuous_at_right_real_increasing[symmetric]) (auto simp: monoD)
then obtain d where d:"d > 0"
"F (⨆ {x. F x < 1} + d) - F (⨆ {x. F x < 1}) < 1 - F (Sup {x. F x < 1})"
using h unfolding x_star_def
by (metis diff_less_0_iff_less less_eq_real_def linorder_not_less right_minus_eq)
hence "F (⨆ {x. F x < 1} + d) < 1"
by simp
hence "(⨆ {x. F x < 1} + d) ≤ (⨆ {x. F x < 1})"
by (metis bdd cSup_upper mem_Collect_eq)
with d show False
by simp
qed
qed(auto intro!: assms right_continuous_mono.f_le_b[of F])
lemma F_tendsto_1_endpoint:
fixes F :: "real ⇒ real" and γ :: real
assumes F: "right_continuous_mono F 0 1"
and a:"⋀n. 0 < a n"
and sigma[arith]:"0 < σ"
and wc:"⋀x. (λn. F (a n * x + b n) ^ n) ⇢ EVD_cdf γ μ σ x"
shows "(F ⤏ 1) (endpoint_filter F)"
proof (cases "bdd_support F")
assume "¬ bdd_support F"
with F show ?thesis
by(simp add: endpoint_filter right_continuous_mono_def)
next
assume bdd:"bdd_support F"
have EVD_mu: "EVD_cdf γ μ σ μ = exp (- 1)"
by (simp add: EVD_cdf_def)
have supp_mu: "0 < 1 + γ * (μ - μ) / σ"
by simp
have tail_at_mu: "((λt. t * (1 - F (a (nat ⌊t⌋) * μ + b (nat ⌊t⌋))))
⤏ - ln (EVD_cdf γ μ σ μ)) at_top"
using F MDA_iff_tail_probability a sigma supp_mu wc
by blast
have tail_at_mu': "((λt. t * (1 - F (a (nat ⌊t⌋) * μ + b (nat ⌊t⌋)))) ⤏ 1) at_top"
using tail_at_mu unfolding EVD_mu by simp
have inv_tendsto: "((λt::real. 1 / t) ⤏ 0) at_top"
using tendsto_inverse_0_at_top[OF filterlim_ident] by (simp add: inverse_eq_divide)
have step0: "((λt::real. 1 - F (a (nat ⌊t⌋) * μ + b (nat ⌊t⌋))) ⤏ 0) at_top"
proof -
have eq: "∀⇩F t::real in at_top. 1 - F (a (nat ⌊t⌋) * μ + b (nat ⌊t⌋))
= t * (1 - F (a (nat ⌊t⌋) * μ + b (nat ⌊t⌋))) * (1 / t)"
by (rule eventually_mono[OF eventually_gt_at_top[of 0]]) simp
have prod_tendsto: "((λt. t * (1 - F (a (nat ⌊t⌋) * μ
+ b (nat ⌊t⌋))) * (1 / t)) ⤏ 0) at_top"
using tendsto_mult[OF tail_at_mu' inv_tendsto] by simp
show ?thesis
using tendsto_cong[OF eq] prod_tendsto by simp
qed
have Fxstar: "F (x_star F) = 1"
by(intro F_x_star_eq_1 bdd assms)
have filter_eq: "endpoint_filter F = at_left (x_star F)"
using bdd by (simp add: endpoint_filter)
have upper_ev: "∀⇩F t in at_left (x_star F). F t ≤ 1"
using right_continuous_mono.f_le_b[OF F] by (intro always_eventually) simp
show ?thesis
unfolding filter_eq tendsto_iff dist_real_def
proof safe
fix e :: real
assume e: "0 < e"
have c2: "(1::real) / 2 < 1"
by simp
have ev_c: "∀⇩F t in at_top. 1 - F (a (nat ⌊t⌋) * μ + b (nat ⌊t⌋)) < e
∧ 1 / 2 < t * (1 - F (a (nat ⌊t⌋) * μ + b (nat ⌊t⌋)))"
using eventually_conj[OF order_tendstoD(2)
[OF step0 e] order_tendstoD(1)[OF tail_at_mu' c2]] .
then obtain t0 where t0: "1 - F (a (nat ⌊t0⌋) * μ + b (nat ⌊t0⌋)) < e"
"1 / 2 < t0 * (1 - F (a (nat ⌊t0⌋) * μ + b (nat ⌊t0⌋)))"
using eventually_happens'[OF trivial_limit_at_top_linorder] by blast
define z where "z = a (nat ⌊t0⌋) * μ + b (nat ⌊t0⌋)"
have Fz: "1 - e < F z"
using t0(1) by (simp add: z_def)
have t0pos: "0 < t0"
proof (rule ccontr)
assume "¬ 0 < t0"
hence "t0 * (1 - F z) ≤ 0"
using right_continuous_mono.f_le_b[OF F] unfolding z_def
by (intro mult_nonpos_nonneg) auto
with t0(2) show False
unfolding z_def by simp
qed
have Fzlt1: "F z < 1"
proof (rule ccontr)
assume "¬ F z < 1"
hence "F z = 1"
using right_continuous_mono.f_le_b[OF F, of z] by linarith
thus False
using t0(2) t0pos unfolding z_def by simp
qed
have zlt: "z < x_star F"
proof -
have "z ≤ x_star F"
using Fzlt1 bdd unfolding x_star_def z_def by (intro cSup_upper) auto
moreover have "z ≠ x_star F"
using Fzlt1 Fxstar by auto
ultimately show ?thesis
by simp
qed
have lower_ev: "∀⇩F t in at_left (x_star F). 1 - e < F t"
unfolding eventually_at_left_field
proof (intro exI[of _ z] conjI zlt allI impI)
fix y
assume "z < y" "y < x_star F"
hence "F z ≤ F y"
by (intro monoD[OF right_continuous_mono.mono[OF F]]) simp
thus "1 - e < F y"
using Fz by simp
qed
show "∀⇩F t in at_left (x_star F). ¦F t - 1¦ < e"
using lower_ev upper_ev by eventually_elim linarith
qed
qed
lemma lt_x_star_iff_F_lt_1:
fixes F :: "real ⇒ real"
assumes F: "right_continuous_mono F 0 1" and bdd: "bdd_support F"
shows "y < x_star F ⟷ F y < 1"
proof -
interpret right_continuous_mono F 0 1
by fact
show ?thesis
proof
assume c: "y < x_star F"
show "F y < 1"
proof (rule ccontr)
assume "¬ F y < 1"
hence "F y = 1"
using f_le_b[of y] by linarith
hence "y ≤ x ⟹ F x = 1" for x
using monoD[OF mono,of y x] f_le_b[of x] by simp
hence "{x. F x < 1} ⊆ {..<y}"
by (metis lessThan_iff linorder_not_le mem_Collect_eq order_less_irrefl subsetI)
from cSup_subset_mono[OF _ _ this] ex_less_a[of 1] c
show False
by(auto simp: x_star_def)
qed
next
assume y: "F y < 1"
hence "y ≤ x_star F"
unfolding x_star_def using bdd by (auto intro!: cSup_upper)
thus "y < x_star F"
using y F_x_star_eq_1[OF F bdd] by (metis order_less_le)
qed
qed
lemma F_lt_1_unbdd_support:
assumes F: "right_continuous_mono F 0 1" and bdd: "¬ bdd_support F"
shows "F x < 1"
proof (rule ccontr)
interpret right_continuous_mono F 0 1
by fact
assume "¬ F x < 1"
hence Fx: "F x = 1"
using f_le_b[of x] by linarith
hence Fx1:"x ≤ y ⟹ F y = 1" for y
using monoD[OF mono,of x y] f_le_b[of y] by simp
hence "{x. F x < 1} ⊆ {..<x}"
by (metis lessThan_iff linorder_not_le mem_Collect_eq order_less_irrefl subsetI)
with bdd show False
by (meson bdd_above.mono bdd_above_Iio)
qed
lemma F_lt_1_endpoint:
fixes F :: "real ⇒ real"
assumes F: "right_continuous_mono F 0 1"
shows "∀⇩F t in endpoint_filter F. F t < 1"
using F_lt_1_unbdd_support[OF F] lt_x_star_iff_F_lt_1[OF F, THEN iffD1]
by (cases "bdd_support F")
(auto simp: endpoint_filter intro!: eventually_at_leftI[of "x_star F - 1"])
lemma tail_quantile_tendsto_x_star:
fixes F :: "real ⇒ real"
assumes F: "right_continuous_mono F 0 1" and bdd: "bdd_support F"
shows "(tail_quantile F ⤏ x_star F) at_top"
proof -
interpret right_continuous_mono F 0 1
by fact
have U_le_xstar: "tail_quantile F t ≤ x_star F" if t1: "1 < t" for t
using t1 F_x_star_eq_1[OF F bdd] by (simp add: field_simps ginv_le_iff)
show ?thesis
unfolding tendsto_iff dist_real_def
proof safe
fix e :: real
assume e: "0 < e"
define c where "c = x_star F - e"
have Fc: "F c < 1"
by (rule lt_x_star_iff_F_lt_1[OF F bdd, THEN iffD1]) (simp add: c_def e)
have tendsto1: "((λt::real. 1 - 1 / t) ⤏ 1) at_top"
using tendsto_diff[OF tendsto_const[of 1] tendsto_inverse_0_at_top[OF filterlim_ident]]
by (simp add: inverse_eq_divide)
obtain T1 where T1: "⋀t. T1 ≤ t ⟹ F c < 1 - 1 / t"
using order_tendstoD(1)[OF tendsto1 Fc]
unfolding eventually_at_top_linorder by blast
define T where "T = max 2 T1"
show "∀⇩F t in at_top. ¦tail_quantile F t - x_star F¦ < e"
proof (intro eventually_at_top_linorderI[where c=T])
fix t
assume Tt: "T ≤ t"
have t1: "1 < t" and T1t: "T1 ≤ t"
using Tt by (simp_all add: T_def)
have p_bounds: "0 < 1 - 1 / t" "1 - 1 / t < 1"
using t1 by simp_all
have lower: "c < tail_quantile F t"
using ginv_le_iff[OF p_bounds, of c] T1[OF T1t] by linarith
show "¦tail_quantile F t - x_star F¦ < e"
using lower U_le_xstar[OF t1] by (simp add: c_def)
qed
qed
qed
lemma tail_quantile_lt_x_star:
fixes F :: "real ⇒ real"
assumes F: "right_continuous_mono F 0 1" and bdd: "bdd_support F"
and Flim: "(F ⤏ 1) (endpoint_filter F)" and t1: "1 < t"
shows "tail_quantile F t < x_star F"
proof -
interpret right_continuous_mono F 0 1
by fact
have p0: "0 < 1 - 1 / t" and p1: "1 - 1 / t < 1"
using t1 by simp_all
obtain y where y: "1 - 1 / t < F y" "F y < 1"
using eventually_happens'[OF endpoint_filter_neq_bot
eventually_conj[OF order_tendstoD(1)[OF Flim p1] F_lt_1_endpoint[OF F]]] by blast
have "F (tail_quantile F t) < 1"
using ginv_le_iff[OF p0 p1, of y] y monoD[OF mono, of "ginv F (1 - 1 / t)" y] by force
moreover have "tail_quantile F t ≤ x_star F"
using calculation bdd by (auto simp: x_star_def intro!: cSup_upper)
ultimately show ?thesis
using F_x_star_eq_1[OF F bdd] by (metis order_less_le)
qed
lemma tail_quantile_tendsto_endpoint:
fixes F :: "real ⇒ real"
assumes F: "right_continuous_mono F 0 1"
and Flim: "(F ⤏ 1) (endpoint_filter F)"
shows "filterlim (tail_quantile F) (endpoint_filter F) at_top"
proof (cases "bdd_support F")
case True
have "∀⇩F t in at_top. tail_quantile F t ∈ {..<x_star F} ∧ tail_quantile F t ≠ x_star F"
using eventually_gt_at_top[of "1::real"]
by eventually_elim (use tail_quantile_lt_x_star[OF F True Flim] in force)
thus ?thesis
unfolding endpoint_filter(1)[OF True] filterlim_at
using tail_quantile_tendsto_x_star[OF F True] by simp
next
case False
thus ?thesis
using tail_quantile_at_top[OF F F_lt_1_unbdd_support[OF F]] by (simp add: endpoint_filter)
qed
lemma F_tendsto_1_endpoint_of_lim:
fixes F :: "real ⇒ real" and γ :: real
assumes F: "right_continuous_mono F 0 1"
and f1:"⋀t. bdd_support F ⟹ t < x_star F ⟹ 0 < f t"
and f2:"⋀t. ¬ bdd_support F ⟹ 0 < f t"
and sigma[arith]: "0 < σ"
and lim:"⋀x. 0 < 1 + γ * (x - μ) / σ
⟹ ((λt. (1 - F (t + (x - μ) * f t)) / (1 - F t))
⤏ - ln (EVD_cdf γ μ σ x)) (endpoint_filter F)"
shows "(F ⤏ 1) (endpoint_filter F)"
proof (cases "bdd_support F")
assume "¬ bdd_support F"
thus ?thesis
using right_continuous_mono.top[OF F]
by (simp add: endpoint_filter)
next
assume bdd:"bdd_support F"
have goal_eq: "endpoint_filter F = at_left (x_star F)"
using bdd by (simp add: endpoint_filter)
have op: "open {x'. 0 < 1 + γ * (x' - μ) / σ}"
by (intro open_Collect_less continuous_intros) simp
hence "∀⇩F x' in nhds μ. x' ∈ {x'. 0 < 1 + γ * (x' - μ) / σ}"
by (intro eventually_nhds_in_open) auto
then obtain η where eta: "0 < η" and eta_supp: "⋀x'. ¦x' - μ¦ < η ⟹ 0 < 1 + γ * (x' - μ) / σ"
using eventually_nhds_metric[of "λx'. 0 < 1 + γ * (x' - μ) / σ" μ]
by (auto simp: dist_real_def)
define x1 where "x1 = μ + η / 2"
have x1_supp: "0 < 1 + γ * (x1 - μ) / σ"
using eta_supp[of x1] eta by (simp add: x1_def)
have x1_gt: "μ < x1"
using eta by (simp add: x1_def)
define c1 where "c1 = - ln (EVD_cdf γ μ σ x1)"
have c1_pos: "0 < c1"
using x1_supp
by(cases "γ = 0")
(auto simp: c1_def ln_EVD_cdf_0 ln_EVD_cdf_1[OF sigma])
have c1_lt1: "c1 < 1"
proof (cases "γ = 0")
show "γ = 0 ⟹ ?thesis"
using x1_gt by(simp add: ln_EVD_cdf_0 c1_def)
next
assume h:"¬ γ = 0"
have eq: "c1 = (1 + γ * (x1 - μ) / σ) powr (- 1 / γ)"
using ln_EVD_cdf_1[OF sigma x1_supp h] by (simp add: c1_def)
show ?thesis
by (smt (verit) h eq eta mult_eq_0_iff mult_pos_pos mult_sign_intros(3)
powr01_less_one powr_less_one sigma x1_def x1_supp
zero_compare_simps(11,7))
qed
have limx1: "((λt. (1 - F (t + (x1 - μ) * f t)) / (1 - F t)) ⤏ c1) (endpoint_filter F)"
using lim[OF x1_supp] by (simp add: c1_def)
define φ where "φ = (λt. 1 - F t)"
have phi_mono: "⋀s t. s ≤ t ⟹ φ t ≤ φ s"
using monoD[OF right_continuous_mono.mono[OF F]] by (auto simp: φ_def)
have phi_ge0: "⋀t. 0 ≤ φ t"
using right_continuous_mono.f_le_b[OF F] by (simp add: φ_def)
define L where "L = Inf (φ ` {..<x_star F})"
have ne: "φ ` {..<x_star F} ≠ {}"
by force
have bddb: "bdd_below (φ ` {..<x_star F})"
using phi_ge0 by (intro bdd_belowI[of _ 0]) auto
have Lge0: "0 ≤ L"
unfolding L_def using phi_ge0 ne bddb by (intro cInf_greatest) auto
have Lbound: "⋀t. t < x_star F ⟹ L ≤ φ t"
unfolding L_def using bddb by (intro cInf_lower) auto
have phi_tendsto_L: "(φ ⤏ L) (at_left (x_star F))"
proof (rule order_tendstoI)
fix c
assume c: "c < L"
have "∀⇩F t in at_left (x_star F). t < x_star F"
by (rule eventually_at_leftI[of "x_star F - 1"]) auto
thus "∀⇩F t in at_left (x_star F). c < φ t"
by(eventually_elim) (use Lbound c in fastforce)
next
fix c
assume c: "L < c"
obtain t0 where t0: "t0 < x_star F" "φ t0 < c"
using cInf_lessD[OF ne, of c] c unfolding L_def by force
have "∀⇩F t in at_left (x_star F). t0 < t"
using t0 by(auto intro!: eventually_at_leftI[of t0])
thus "∀⇩F t in at_left (x_star F). φ t < c"
by eventually_elim (auto intro!: order.strict_trans1[of _ "φ t0" c,OF phi_mono t0(2)])
qed
have "∀⇩F t in at_left (x_star F). c1 / 2 < (1 - F (t + (x1 - μ) * f t)) / (1 - F t)"
using order_tendstoD(1)[OF limx1, of "c1 / 2"] c1_pos goal_eq by simp
hence t'_lt: "∀⇩F t in at_left (x_star F). t + (x1 - μ) * f t < x_star F"
proof eventually_elim
case (elim t)
show ?case
proof (rule ccontr)
assume "¬ t + (x1 - μ) * f t < x_star F"
hence "F (x_star F) ≤ F (t + (x1 - μ) * f t)"
by (intro monoD[OF right_continuous_mono.mono[OF F]]) simp
hence "F (t + (x1 - μ) * f t) = 1"
using right_continuous_mono.f_le_b[OF F, of "t + (x1 - μ) * f t"]
F_x_star_eq_1[OF F bdd] by simp
with elim c1_pos show False
by simp
qed
qed
have "∀⇩F t in at_left (x_star F). t < x_star F"
by (rule eventually_at_leftI[of "x_star F - 1"]) auto
hence t'_ge: "∀⇩F t in at_left (x_star F). t ≤ t + (x1 - μ) * f t"
by eventually_elim (use f1[OF bdd] x1_gt in fastforce)
have t'_tendsto: "((λt. t + (x1 - μ) * f t) ⤏ x_star F) (at_left (x_star F))"
unfolding tendsto_iff dist_real_def
proof safe
fix e :: real
assume e: "0 < e"
have ev1: "∀⇩F t in at_left (x_star F). x_star F - e < t"
by (intro order_tendstoD(1)[OF tendsto_ident_at]) (use e in simp)
have lower: "∀⇩F t in at_left (x_star F). x_star F - e < t + (x1 - μ) * f t"
using eventually_conj[OF ev1 t'_ge] by eventually_elim simp
show "∀⇩F t in at_left (x_star F). ¦t + (x1 - μ) * f t - x_star F¦ < e"
using lower t'_lt by eventually_elim linarith
qed
have t'_filterlim: "filterlim (λt. t + (x1 - μ) * f t)
(at_left (x_star F)) (at_left (x_star F))"
using tendsto_imp_filterlim_at_left[OF t'_tendsto] t'_lt by blast
have phit'_to_L: "((λt. φ (t + (x1 - μ) * f t)) ⤏ L) (at_left (x_star F))"
using filterlim_compose[OF phi_tendsto_L t'_filterlim] by simp
have eq_ratio: "∀⇩F t in at_left (x_star F). ((1 - F (t + (x1 - μ) * f t)) / (1 - F t)) * φ t
= φ (t + (x1 - μ) * f t)"
using F_lt_1_endpoint[OF F] unfolding goal_eq
by eventually_elim (simp add: φ_def)
have prod_tendsto: "((λt. ((1 - F (t + (x1 - μ) * f t)) / (1 - F t)) * φ t)
⤏ c1 * L) (at_left (x_star F))"
using tendsto_mult[OF limx1[unfolded goal_eq] phi_tendsto_L] by simp
note phit'_to_c1L = Lim_transform_eventually[OF prod_tendsto eq_ratio]
have LeqC1L: "L = c1 * L"
by (rule tendsto_unique[OF trivial_limit_at_left_real[of "x_star F"]
phit'_to_L phit'_to_c1L])
have Lzero: "L = 0"
using c1_lt1 LeqC1L by simp
have z: "((λt. 1 - F t) ⤏ 0) (at_left (x_star F))"
using phi_tendsto_L Lzero by (simp add: φ_def)
have "((λt. 1 - (1 - F t)) ⤏ 1 - (0::real)) (at_left (x_star F))"
by (rule tendsto_diff[OF tendsto_const z])
thus ?thesis
by(simp add: goal_eq)
qed
lemma s_tendsto_at_top_endpoint:
fixes F :: "real ⇒ real" and γ :: real
assumes F: "right_continuous_mono F 0 1"
and a:"⋀n. 0 < a n"
and sigma[arith]:"0 < σ"
and wc:"⋀x. (λn. F (a n * x + b n) ^ n) ⇢ EVD_cdf γ μ σ x"
shows "filterlim (λt. 1 / (1 - F t)) at_top (endpoint_filter F)"
proof -
have Ftend: "((λt. 1 - F t) ⤏ 0) (endpoint_filter F)"
using tendsto_diff[OF tendsto_const[where k="1::real"]
F_tendsto_1_endpoint[OF F a sigma wc]]
by simp
have Fpos: "∀⇩F t in endpoint_filter F. 0 < 1 - F t"
using F_lt_1_endpoint[OF F] by (rule eventually_mono) simp
show ?thesis
using filterlim_inverse_at_top[OF Ftend Fpos]
by (simp add: inverse_eq_divide)
qed
lemma t_div_a_tendsto_mu_endpoint:
fixes F :: "real ⇒ real" and γ :: real
assumes F: "right_continuous_mono F 0 1"
and a:"⋀n. 0 < a n"
and sigma[arith]:"0 < σ"
and wc:"⋀x. (λn. F (a n * x + b n) ^ n) ⇢ EVD_cdf γ μ σ x"
shows "((λt. (t - b (nat ⌊1 / (1 - F t)⌋))
/ a (nat ⌊1 / (1 - F t)⌋)) ⤏ μ) (endpoint_filter F)"
proof -
define s where "s = (λt::real. 1 / (1 - F t))"
define N where "N = (λt::real. nat ⌊s t⌋)"
have goal_eq: "(λt. (t - b (nat ⌊1 / (1 - F t)⌋)) / a (nat ⌊1 / (1 - F t)⌋))
= (λt. (t - b (N t)) / a (N t))"
by (simp add: s_def N_def)
have stop: "filterlim s at_top (endpoint_filter F)"
unfolding s_def by (rule s_tendsto_at_top_endpoint[OF F a sigma wc])
note Flt1 = F_lt_1_endpoint[OF F]
have spos: "∀⇩F t in endpoint_filter F. 0 < s t"
using stop[unfolded filterlim_at_top_dense, rule_format, of 0] by simp
have MDAtq: "∀y>0. ((λt. (tail_quantile F (t * y) - b (nat ⌊t⌋)) / a (nat ⌊t⌋))
⤏ (if γ = 0 then σ * ln y + μ else σ * (y powr γ - 1) / γ + μ)) at_top"
using MDA_iff_tail_quantile[OF F a sigma] wc by fast
define D where "D = (λy::real. if γ = 0 then σ * ln y + μ else σ * (y powr γ - 1) / γ + μ)"
have D1:"D 1 = μ"
by(simp add: D_def)
have Dcont: "isCont D 1"
unfolding D_def
by(cases "γ = 0")
(auto intro!: isCont_add isCont_mult isCont_ln isCont_divide isCont_diff continuous_powr)
have conv: "⋀y'. ¦y' - 1¦ < 1 ⟹
((λt. (tail_quantile F (s t * y') - b (N t)) / a (N t)) ⤏ D y') (endpoint_filter F)"
using MDAtq by(auto simp: D_def N_def intro!: filterlim_compose[OF _ stop])
have low: "∀⇩F t in endpoint_filter F. (tail_quantile F (s t * y') - b (N t)) / a (N t)
≤ (t - b (N t)) / a (N t)"
if y': "(1::real) - 1 < y'" "y' < 1" for y'
using stop[unfolded filterlim_at_top_dense, rule_format, of "1 / y'"] spos Flt1
proof eventually_elim
case (elim t)
hence s_gt: "1 / y' < s t" and s_pos: "0 < s t" and Ft: "F t < 1"
by auto
have u1: "1 < s t * y'"
using mult_strict_right_mono[OF s_gt] y' by force
have u2: "s t * y' < 1 / (1 - F t)"
using mult_strict_left_mono[OF y'(2) s_pos]
by(simp add: s_def)
show ?case
using a[of "N t"] Ft u1 u2
by(auto intro!: divide_right_mono tail_quantile_le_of_lt_inv[OF F])
qed
have up: "∀⇩F t in endpoint_filter F. (t - b (N t)) / a (N t)
≤ (tail_quantile F (s t * y') - b (N t)) / a (N t)"
if y': "(1::real) < y'" "y' < 1 + 1" for y'
using spos Flt1
proof eventually_elim
case (elim t)
hence s_pos: "0 < s t" and Ft: "F t < 1"
by auto
have u: "1 / (1 - F t) < s t * y'"
using mult_strict_left_mono[OF _ s_pos] y'
by(simp add: s_def)
show ?case
using a[of "N t"]
by(auto intro!: divide_right_mono less_imp_le[OF t_lt_tail_quantile_of_gt_inv[OF F Ft u]])
qed
show ?thesis
using squeeze_tendsto_local[OF zero_less_one Dcont conv low up]
unfolding goal_eq
by (simp add: D1)
qed
lemma MDA_imp_divide_tail:
assumes F: "right_continuous_mono F 0 1"
and a:"⋀n. 0 < a n"
and sigma[arith]:"0 < σ"
and wc:"⋀x. (λn. F (a n * x + b n) ^ n) ⇢ EVD_cdf γ μ σ x"
and x:"0 < 1 + γ * (x - μ) / σ"
shows "((λt. (1 - F (t + (x - μ) * a (nat ⌊1 / (1 - F (t))⌋))) / (1 - F t))
⤏ - ln (EVD_cdf γ μ σ x)) (endpoint_filter F)"
proof -
define s where "s = (λt::real. 1 / (1 - F t))"
define N where "N = (λt::real. nat ⌊s t⌋)"
have goal_eq: "(λt. (1 - F (t + (x - μ) * a (nat ⌊1 / (1 - F (t))⌋))) / (1 - F t))
= (λt. (1 - F (t + (x - μ) * a (N t))) / (1 - F t))"
by (simp add: s_def N_def)
have stop: "filterlim s at_top (endpoint_filter F)"
unfolding s_def by(intro s_tendsto_at_top_endpoint[OF _ _ _ wc] assms)
note Flt1 = F_lt_1_endpoint[OF F]
have delta_tendsto: "((λt. (t - b (N t)) / a (N t) - μ) ⤏ 0) (endpoint_filter F)"
using tendsto_diff[OF t_div_a_tendsto_mu_endpoint[OF F a sigma wc] tendsto_const[of μ]]
by(simp add: s_def N_def)
have op: "open {x'. 0 < 1 + γ * (x' - μ) / σ}"
by (auto intro!: open_Collect_less continuous_on_add
continuous_on_divide continuous_on_mult continuous_on_diff)
have "∀⇩F x' in nhds x. x' ∈ {x'. 0 < 1 + γ * (x' - μ) / σ}"
using x op by (intro eventually_nhds_in_open) auto
hence ev: "∀⇩F x' in nhds x. 0 < 1 + γ * (x' - μ) / σ"
by eventually_elim simp
then obtain η where eta: "0 < η"
and eta_supp: "⋀x'. ¦x' - x¦ < η ⟹ 0 < 1 + γ * (x' - μ) / σ"
using eventually_nhds_metric[of "λx'. 0 < 1 + γ * (x' - μ) / σ" x]
by(auto simp: dist_real_def)
have Dcont: "isCont (λx'. ln (EVD_cdf γ μ σ x')) x"
using EVD_cdf_supp_bounds[OF x sigma]
by(auto intro!: isCont_ln' isCont_EVD_cdf)
have conv: "((λt. - ((1 - F (a (N t) * x' + b (N t))) / (1 - F t)))
⤏ ln (EVD_cdf γ μ σ x')) (endpoint_filter F)"
if x': "¦x' - x¦ < η" for x'
proof -
have supp': "0 < 1 + γ * (x' - μ) / σ"
using that eta_supp by simp
have base: "((λt. t * (1 - F (a (nat ⌊t⌋) * x' + b (nat ⌊t⌋))))
⤏ - ln (EVD_cdf γ μ σ x')) at_top"
using MDA_iff_tail_probability[where a=a,OF F a sigma] wc eta_supp supp' by blast
show ?thesis
using tendsto_minus[OF filterlim_compose[OF base stop]] by(simp add: N_def s_def)
qed
have low: "∀⇩F t in endpoint_filter F. - ((1 - F (a (N t) * x' + b (N t))) / (1 - F t))
≤ - ((1 - F (t + (x - μ) * a (N t))) / (1 - F t))"
if x': "x - η < x'" "x' < x" for x'
proof -
have dlt: "x' - x < 0"
using x' by simp
have ev1: "∀⇩F t in endpoint_filter F. x' - x < (t - b (N t)) / a (N t) - μ"
using order_tendstoD(1)[OF delta_tendsto dlt] .
show "∀⇩F t in endpoint_filter F. - ((1 - F (a (N t) * x' + b (N t))) / (1 - F t))
≤ - ((1 - F (t + (x - μ) * a (N t))) / (1 - F t))"
using ev1 Flt1
proof eventually_elim
case (elim t)
hence d: "x' - x < (t - b (N t)) / a (N t) - μ" and Ft: "F t < 1"
by auto
have apos: "0 < a (N t)"
using a by simp
have "(x' - x) * a (N t) < ((t - b (N t)) / a (N t) - μ) * a (N t)"
using mult_strict_right_mono[OF d apos] .
also have "… = t - b (N t) - μ * a (N t)"
using apos by (simp add: field_simps)
finally have ineq: "(x' - x) * a (N t) < t - b (N t) - μ * a (N t)" .
have "a (N t) * x' + b (N t) < t + (x - μ) * a (N t)"
using ineq by (simp add: field_simps)
hence fmono: "F (a (N t) * x' + b (N t)) ≤ F (t + (x - μ) * a (N t))"
by (intro monoD[OF right_continuous_mono.mono[OF F]]) simp
have hFQ: "1 - F (t + (x - μ) * a (N t)) ≤ 1 - F (a (N t) * x' + b (N t))"
using fmono by simp
have "(1 - F (t + (x - μ) * a (N t))) / (1 - F t)
≤ (1 - F (a (N t) * x' + b (N t))) / (1 - F t)"
by (rule divide_right_mono[OF hFQ]) (use Ft in simp)
thus ?case
by simp
qed
qed
have up: "⋀x'. x < x' ⟹ x' < x + η ⟹
∀⇩F t in endpoint_filter F. - ((1 - F (t + (x - μ) * a (N t))) / (1 - F t))
≤ - ((1 - F (a (N t) * x' + b (N t))) / (1 - F t))"
proof -
fix x' :: real
assume x': "x < x'" "x' < x + η"
have dpos: "0 < x' - x"
using x' by simp
have ev1: "∀⇩F t in endpoint_filter F. (t - b (N t)) / a (N t) - μ < x' - x"
using order_tendstoD(2)[OF delta_tendsto dpos] .
show "∀⇩F t in endpoint_filter F. - ((1 - F (t + (x - μ) * a (N t))) / (1 - F t))
≤ - ((1 - F (a (N t) * x' + b (N t))) / (1 - F t))"
using ev1 Flt1
proof eventually_elim
case (elim t)
hence d: "(t - b (N t)) / a (N t) - μ < x' - x" and Ft: "F t < 1"
by auto
have apos: "0 < a (N t)"
using a by simp
have "((t - b (N t)) / a (N t) - μ) * a (N t) < (x' - x) * a (N t)"
using mult_strict_right_mono[OF d apos] .
also have "((t - b (N t)) / a (N t) - μ) * a (N t) = t - b (N t) - μ * a (N t)"
using apos by (simp add: field_simps)
finally have ineq: "t - b (N t) - μ * a (N t) < (x' - x) * a (N t)"
by simp
have "t + (x - μ) * a (N t) < a (N t) * x' + b (N t)"
using ineq by (simp add: field_simps)
hence fmono: "F (t + (x - μ) * a (N t)) ≤ F (a (N t) * x' + b (N t))"
by (intro monoD[OF right_continuous_mono.mono[OF F]]) simp
have hFQ: "1 - F (a (N t) * x' + b (N t)) ≤ 1 - F (t + (x - μ) * a (N t))"
using fmono by simp
have "(1 - F (a (N t) * x' + b (N t))) / (1 - F t)
≤ (1 - F (t + (x - μ) * a (N t))) / (1 - F t)"
by (rule divide_right_mono[OF hFQ]) (use Ft in simp)
thus ?case
by simp
qed
qed
show ?thesis
unfolding goal_eq
using tendsto_minus[OF squeeze_tendsto_local[OF eta Dcont conv low up]]
by simp
qed
lemma tail_quantile_asymp_inverse_of_lim:
fixes F :: "real ⇒ real" and γ :: real
assumes F: "right_continuous_mono F 0 1"
and f1:"⋀t. bdd_support F ⟹ t < x_star F ⟹ 0 < f t"
and f2:"⋀t. ¬ bdd_support F ⟹ 0 < f t"
and sigma[arith]: "0 < σ"
and lim:"⋀x. 0 < 1 + γ * (x - μ) / σ
⟹ ((λt. (1 - F (t + (x - μ) * f t)) / (1 - F t))
⤏ - ln (EVD_cdf γ μ σ x)) (endpoint_filter F)"
shows "((λt. t * (1 - F (tail_quantile F t))) ⤏ 1) at_top"
proof -
interpret right_continuous_mono F 0 1
by fact
note Flim = F_tendsto_1_endpoint_of_lim[OF F f1 f2 sigma lim]
note Uendpoint = tail_quantile_tendsto_endpoint[OF F Flim]
have fU_pos: "0 < f (tail_quantile F t)" if t1: "1 < t" for t
proof (cases "bdd_support F")
case True
show ?thesis
by (rule f1[OF True tail_quantile_lt_x_star[OF F True Flim t1]])
next
case False
show ?thesis
by (rule f2[OF False])
qed
have fact_le1: "⋀t. 1 < t ⟹ t * (1 - F (tail_quantile F t)) ≤ 1"
by (smt (verit, best) divide_less_eq zero_less_mult_iff t_lt_tail_quantile_of_gt_inv[OF F])
have fact_gt1: "⋀t z. 1 < t ⟹ z < tail_quantile F t ⟹ 1 < t * (1 - F z)"
by (smt (verit, ccfv_SIG) divide_less_eq_1_pos divide_pos_pos
nonzero_mult_div_cancel_left pos_less_divide_eq
ginv_le_iff)
have FUlt1: "∀⇩F t in at_top. F (tail_quantile F t) < 1"
by (rule eventually_compose_filterlim[OF F_lt_1_endpoint[OF F] Uendpoint])
define D where "D = (λx'. - ln (EVD_cdf γ μ σ x'))"
have Dmu: "D μ = 1"
by (cases "γ = 0") (simp_all add: D_def ln_EVD_cdf_0 ln_EVD_cdf_1)
have supp_mu: "0 < 1 + γ * (μ - μ) / σ"
by simp
have Dcont: "isCont D μ"
unfolding D_def
using isCont_EVD_cdf[OF sigma] EVD_cdf_supp_bounds[OF supp_mu sigma]
by (intro continuous_intros) auto
have op: "open {x'. 0 < 1 + γ * (x' - μ) / σ}"
by (intro open_Collect_less continuous_intros) simp
have "∀⇩F x' in nhds μ. x' ∈ {x'. 0 < 1 + γ * (x' - μ) / σ}"
using op by (intro eventually_nhds_in_open) auto
hence ev: "∀⇩F x' in nhds μ. 0 < 1 + γ * (x' - μ) / σ"
by eventually_elim simp
then obtain η where eta: "0 < η" and eta_supp: "⋀x'. ¦x' - μ¦ < η ⟹ 0 < 1 + γ * (x' - μ) / σ"
using eventually_nhds_metric[of "λx'. 0 < 1 + γ * (x' - μ) / σ" μ]
by(auto simp: dist_real_def)
have upper: "t * (1 - F (tail_quantile F t)) ≤ 1" if t1: "1 < t" for t
using fact_le1[OF t1] .
show ?thesis
unfolding tendsto_iff dist_real_def
proof safe
fix e :: real
assume e: "0 < e"
define e' where "e' = min (1 / 2) e"
have e'_pos: "0 < e'" and e'_le: "e' ≤ e" and e'_lt1: "e' < 1"
using e by (simp_all add: e'_def)
define c where "c = 1 - e'"
have cpos[arith]: "0 < c" and clt1[arith]: "c < 1"
using e'_pos e'_lt1 by (simp_all add: c_def)
define c' where "c' = 1 / c"
have c'gt1: "1 < c'"
by (simp add: c'_def)
obtain δ where δpos: "0 < δ"
and δbound: "⋀x''. x'' ≠ μ ∧ ¦x'' - μ¦ < δ ⟹ ¦D x'' - D μ¦ < c' - 1"
using LIM_D[OF Dcont[unfolded isCont_def], of "c' - 1"] c'gt1 by auto
have minpos: "0 < min δ η" "min δ η ≤ δ" "min δ η ≤ η"
using δpos eta by auto
define x1 where "x1 = μ - min δ η / 2"
have x1_diff: "x1 - μ = - (min δ η / 2)"
by (simp add: x1_def)
have x1_abs: "¦x1 - μ¦ = min δ η / 2"
using minpos(1) by (simp add: x1_diff)
have x1_ne: "x1 ≠ μ ∧ ¦x1 - μ¦ < δ"
using minpos x1_abs by linarith
have x1_eta: "¦x1 - μ¦ < η"
using minpos x1_abs by linarith
have x1_lt: "x1 < μ"
using minpos x1_diff by linarith
have x1_supp: "0 < 1 + γ * (x1 - μ) / σ"
using eta_supp[OF x1_eta] .
have Dx1: "D x1 < c'"
using δbound[OF x1_ne] Dmu by linarith
have Dx1_pos: "0 < D x1"
using x1_supp by (cases "γ = 0")
(auto simp: EVD_cdf_def D_def)
have ratio: "((λt. (1 - F (tail_quantile F t + (x1 - μ) * f (tail_quantile F t)))
/ (1 - F (tail_quantile F t))) ⤏ D x1) at_top"
using filterlim_compose[OF lim[OF x1_supp] Uendpoint] by (simp add: D_def)
obtain T1 where T1: "⋀t. T1 ≤ t ⟹
(1 - F (tail_quantile F t + (x1 - μ) * f (tail_quantile F t)))
/ (1 - F (tail_quantile F t)) < c'"
using order_tendstoD(2)[OF ratio Dx1] unfolding eventually_at_top_linorder by blast
obtain T2 where T2: "⋀t. T2 ≤ t ⟹ 0 <
(1 - F (tail_quantile F t + (x1 - μ) * f (tail_quantile F t)))
/ (1 - F (tail_quantile F t))"
using order_tendstoD(1)[OF ratio Dx1_pos] unfolding eventually_at_top_linorder
by blast
obtain T3 where T3: "⋀t. T3 ≤ t ⟹ F (tail_quantile F t) < 1"
using FUlt1 unfolding eventually_at_top_linorder by blast
define T where "T = max (max T1 T2) (max T3 2)"
have lower_ev: "∀⇩F t in at_top. c < t * (1 - F (tail_quantile F t))"
proof (intro eventually_at_top_linorderI[where c=T])
fix t
assume Tt: "T ≤ t"
have T1t: "T1 ≤ t" and T2t: "T2 ≤ t" and T3t: "T3 ≤ t" and t1: "1 < t"
using Tt by (simp_all add: T_def)
have rlt: "(1 - F (tail_quantile F t + (x1 - μ) * f (tail_quantile F t)))
/ (1 - F (tail_quantile F t)) < c'"
using T1[OF T1t] .
have rpos: "0 < (1 - F (tail_quantile F t + (x1 - μ) * f (tail_quantile F t)))
/ (1 - F (tail_quantile F t))"
using T2[OF T2t] .
have FUlt: "F (tail_quantile F t) < 1"
using T3[OF T3t] .
have gt1: "1 < t * (1 - F (tail_quantile F t + (x1 - μ) * f (tail_quantile F t)))"
using x1_lt fU_pos[OF t1] by(auto intro!: fact_gt1 t1 mult_neg_pos)
have "t * (1 - F (tail_quantile F t + (x1 - μ) * f (tail_quantile F t)))
< t * (c' * (1 - F (tail_quantile F t)))"
using rlt FUlt t1
by(intro comm_mult_strict_left_mono)
(auto simp: field_simps)
hence "c * 1 < c * (t * (1 - F (tail_quantile F t)) / c)"
using gt1 order.strict_trans
by(intro mult_strict_left_mono) (fastforce simp: c'_def)+
thus "c < t * (1 - F (tail_quantile F t))"
by simp
qed
have upper_ev: "∀⇩F t in at_top. t * (1 - F (tail_quantile F t)) ≤ 1"
using eventually_gt_at_top[of "1::real"] by eventually_elim (use upper in blast)
show "∀⇩F t in at_top. ¦t * (1 - F (tail_quantile F t)) - 1¦ < e"
using lower_ev upper_ev
by eventually_elim (use e'_le in "simp add: c_def")
qed
qed
lemma divide_tail_imp_MDA:
assumes F: "right_continuous_mono F 0 1"
and a:"⋀n. 0 < a n"
and sigma[arith]:"0 < σ"
and f1:"⋀t. bdd_support F ⟹ t < x_star F ⟹ 0 < f t"
and f2:"⋀t. ¬ bdd_support F ⟹ 0 < f t"
and lim:"⋀x. 0 < 1 + γ * (x - μ) / σ
⟹ ((λt. (1 - F (t + (x - μ) * f t)) / (1 - F t))
⤏ - ln (EVD_cdf γ μ σ x)) (endpoint_filter F)"
shows "∃a b. (∀n. 0 < a n) ∧ (∀x. (λn. F (a n * x + b n) ^ n) ⇢ EVD_cdf γ μ σ x)"
proof -
note Flim = F_tendsto_1_endpoint_of_lim[OF F f1 f2 sigma lim]
note Uendpoint = tail_quantile_tendsto_endpoint[OF F Flim]
have fU_pos: "0 < f (tail_quantile F t)" if t1:"1 < t" for t
proof (cases "bdd_support F")
case True
show ?thesis
by (rule f1[OF True tail_quantile_lt_x_star[OF F True Flim t1]])
next
case False
show ?thesis
by (rule f2[OF False])
qed
note asymp = tail_quantile_asymp_inverse_of_lim[OF F f1 f2 sigma lim]
note Flt1 = F_lt_1_endpoint[OF F]
have FUlt1: "∀⇩F t in at_top. F (tail_quantile F t) < 1"
by (rule eventually_compose_filterlim[OF Flt1 Uendpoint])
define A where "A = (λt. if 1 < t then f (tail_quantile F t) else f (tail_quantile F 2))"
define B where "B = (λt. if 1 < t then tail_quantile F t - μ * f (tail_quantile F t)
else tail_quantile F 2 - μ * f (tail_quantile F 2))"
have A_pos: "⋀t. 0 < A t"
using fU_pos[of 2] fU_pos by(auto simp: A_def)
have AB_eq: "⋀t. 1 < t ⟹ A t = f (tail_quantile F t)"
"⋀t. 1 < t ⟹ B t = tail_quantile F t - μ * f (tail_quantile F t)"
unfolding A_def B_def by simp_all
have tail: "⋀x. 0 < 1 + γ * (x - μ) / σ ⟹
((λt. t * (1 - F (A t * x + B t))) ⤏ - ln (EVD_cdf γ μ σ x)) at_top"
proof -
fix x :: real
assume supp: "0 < 1 + γ * (x - μ) / σ"
have argeq: "⋀t. 1 < t ⟹
A t * x + B t = tail_quantile F t + (x - μ) * f (tail_quantile F t)"
using AB_eq by (simp add: algebra_simps)
have prod: "((λt. (t * (1 - F (tail_quantile F t))) *
((1 - F (tail_quantile F t + (x - μ) * f (tail_quantile F t)))
/ (1 - F (tail_quantile F t))))
⤏ 1 * (- ln (EVD_cdf γ μ σ x))) at_top"
by (intro tendsto_mult asymp filterlim_compose[OF lim[OF supp] Uendpoint])
have eqprod: "∀⇩F t in at_top. (t * (1 - F (tail_quantile F t))) *
((1 - F (tail_quantile F t + (x - μ) * f (tail_quantile F t)))
/ (1 - F (tail_quantile F t)))
= t * (1 - F (tail_quantile F t + (x - μ) * f (tail_quantile F t)))"
using FUlt1 by eventually_elim (simp add: field_simps)
have main: "((λt. t * (1 - F (tail_quantile F t + (x - μ) * f (tail_quantile F t))))
⤏ - ln (EVD_cdf γ μ σ x)) at_top"
using Lim_transform_eventually[OF prod eqprod] by simp
have eqarg: "∀⇩F t in at_top.
t * (1 - F (tail_quantile F t + (x - μ) * f (tail_quantile F t)))
= t * (1 - F (A t * x + B t))"
using eventually_gt_at_top[of "1::real"] by eventually_elim (simp add: argeq)
show "((λt. t * (1 - F (A t * x + B t))) ⤏ - ln (EVD_cdf γ μ σ x)) at_top"
by (rule Lim_transform_eventually[OF main eqarg])
qed
define aa where "aa = (λn::nat. A (real n))"
define bb where "bb = (λn::nat. B (real n))"
have aa_pos: "∀n. 0 < aa n"
unfolding aa_def using A_pos by simp
have main: "∀x. (λn. F (aa n * x + bb n) ^ n) ⇢ EVD_cdf γ μ σ x"
using MDA_tail_probability_witness[OF F A_pos sigma tail]
by(auto simp: aa_def bb_def)
show ?thesis
using aa_pos main by blast
qed
lemma MDA_iff_divide_tail:
fixes F :: "real ⇒ real" and γ :: real
assumes F: "right_continuous_mono F 0 1"
shows "domain_of_attraction F (EVD_cdf γ 0 1)
⟷ (∃f. (∀t. 0 < f t) ∧
(∀x. 1 + γ * x > 0 ⟶
((λt. (1 - F (t + x * f t)) / (1 - F t))
⤏ - ln (EVD_cdf γ 0 1 x)) (endpoint_filter F)))"
proof
assume dom: "domain_of_attraction F (EVD_cdf γ 0 1)"
obtain a b where a: "⋀n. 0 < a n"
and "weak_conv (λn x. F (a n * x + b n) ^ n) (EVD_cdf γ 0 1)"
using dom unfolding domain_of_attraction_def by blast
hence wc: "⋀x. (λn. F (a n * x + b n) ^ n) ⇢ EVD_cdf γ 0 1 x"
by(simp add: weak_conv_EVD_cdf_iff)
define f where "f = (λt. a (nat ⌊1 / (1 - F t)⌋))"
have fpos: "⋀t. 0 < f t"
using a by (simp add: f_def)
have lim: "⋀x. 0 < 1 + γ * x ⟹
((λt. (1 - F (t + x * f t)) / (1 - F t))
⤏ - ln (EVD_cdf γ 0 1 x)) (endpoint_filter F)"
proof -
fix x :: real
assume x: "0 < 1 + γ * x"
have x': "0 < 1 + γ * (x - 0) / 1"
using x by simp
show "((λt. (1 - F (t + x * f t)) / (1 - F t))
⤏ - ln (EVD_cdf γ 0 1 x)) (endpoint_filter F)"
using MDA_imp_divide_tail[OF F a zero_less_one wc x']
by (simp add: f_def)
qed
show "∃f. (∀t. 0 < f t) ∧
(∀x. 1 + γ * x > 0 ⟶
((λt. (1 - F (t + x * f t)) / (1 - F t))
⤏ - ln (EVD_cdf γ 0 1 x)) (endpoint_filter F))"
using fpos lim by blast
next
assume "∃f. (∀t. 0 < f t) ∧
(∀x. 1 + γ * x > 0 ⟶
((λt. (1 - F (t + x * f t)) / (1 - F t))
⤏ - ln (EVD_cdf γ 0 1 x)) (endpoint_filter F))"
then obtain f where fpos: "⋀t. 0 < f t"
and lim: "⋀x. 1 + γ * x > 0 ⟹
((λt. (1 - F (t + x * f t)) / (1 - F t))
⤏ - ln (EVD_cdf γ 0 1 x)) (endpoint_filter F)"
by blast
have lim': "⋀x. 0 < 1 + γ * (x - 0) / 1 ⟹
((λt. (1 - F (t + (x - 0) * f t)) / (1 - F t))
⤏ - ln (EVD_cdf γ 0 1 x)) (endpoint_filter F)"
using lim by simp
have ex: "∃a b. (∀n. 0 < a n) ∧ (∀x. (λn. F (a n * x + b n) ^ n) ⇢ EVD_cdf γ 0 1 x)"
using divide_tail_imp_MDA[where μ = 0 and σ = 1 and f = f and a = "λn::nat. 1"
,OF F _ _ _ _ lim'] fpos
by auto
thus "domain_of_attraction F (EVD_cdf γ 0 1)"
unfolding domain_of_attraction_def
using F right_continuous_mono_EVD_cdf[OF zero_less_one]
by(auto simp: weak_conv_EVD_cdf_iff)
qed
subsection ‹von Mises' Conditions›
lemma
fixes F :: "real ⇒ real" and x0 t :: real
assumes F: "right_continuous_mono F 0 1"
and x0: "F x0 < 1"
and Flim: "(F ⤏ 1) (endpoint_filter F)"
and Fcont: "⋀x. x0 < x ⟹ F x < 1 ⟹ isCont F x"
and t: "1 / (1 - F x0) < t"
shows tail_quantile_tail_eq: "1 - F (tail_quantile F t) = 1 / t"
and F_tail_quantile_lt_1: "F (tail_quantile F t) < 1"
proof -
interpret right_continuous_mono F 0 1
by fact
have t1: "1 < t"
using one_less_of_inverse_tail_less[OF F x0 t] .
define p where "p = 1 - 1 / t"
have p0: "0 < p" and p1: "p < 1"
using t1 by (simp_all add: p_def)
have px0: "F x0 < p"
using t x0 t1 by (simp add: p_def field_simps)
have c_gt: "x0 < ginv F p"
using ginv_le_iff[OF p0 p1, of x0] px0 by force
obtain y where y: "p < F y" "F y < 1"
using eventually_happens'[OF endpoint_filter_neq_bot
eventually_conj[OF order_tendstoD(1)[OF Flim p1] F_lt_1_endpoint[OF F]]] by blast
have Fc1: "F (ginv F p) < 1"
using ginv_le_iff[OF p0 p1, of y] y monoD[OF mono, of "ginv F p" y] by force
have "F (ginv F p) ≤ p"
proof (rule tendsto_upperbound[where F = "at_left (ginv F p)"])
show "(F ⤏ F (ginv F p)) (at_left (ginv F p))"
using Fcont[OF c_gt Fc1] by (simp add: isCont_def Lim_at_imp_Lim_at_within)
show "∀⇩F z in at_left (ginv F p). F z ≤ p"
by (intro eventually_at_leftI[OF _ c_gt])
(force simp: linorder_not_le[symmetric] ginv_le_iff[OF p0 p1])
qed (rule trivial_limit_at_left_real)
thus eq: "1 - F (tail_quantile F t) = 1 / t"
using ginv_attained[OF p0 p1] unfolding p_def by linarith
show "F (tail_quantile F t) < 1"
using eq zero_less_divide_1_iff[of t] t1 by linarith
qed
context
fixes F f :: "real ⇒ real" and x0 :: real
assumes F: "right_continuous_mono F 0 1"
and x0: "F x0 < 1"
and Flim: "(F ⤏ 1) (endpoint_filter F)"
and Fderiv: "⋀y. x0 < y ⟹ F y < 1 ⟹ (F has_real_derivative f y) (at y)"
and fpos: "⋀y. x0 < y ⟹ F y < 1 ⟹ 0 < f y"
begin
lemma tail_quantile_has_deriv:
fixes t :: real
assumes t: "1 / (1 - F x0) < t"
shows "(tail_quantile F has_real_derivative
1 / (t⇧2 * f (tail_quantile F t))) (at t)"
proof -
interpret right_continuous_mono F 0 1
by fact
define T where "T = 1 / (1 - F x0)"
define U where "U = tail_quantile F"
define phi where "phi = (λs. 1 / (1 - F s))"
have smono: "F v < F w" if "x0 < v" "v < w" "F w < 1" for v w
by (rule strict_mono_of_deriv[OF Fderiv fpos that])
have s1: "1 < s" if "T < s" for s
using one_less_of_inverse_tail_less[OF F x0] that by (simp add: T_def)
have Ugt: "x0 < U s" if "T < s" for s
using t_lt_tail_quantile_of_gt_inv[OF F x0] that by (simp add: U_def T_def)
have UF: "1 - F (U s) = 1 / s" if "T < s" for s
using tail_quantile_tail_eq[OF F x0 Flim DERIV_isCont[OF Fderiv]] that
by (simp add: U_def T_def)
have UFlt: "F (U s) < 1" if "T < s" for s
using F_tail_quantile_lt_1[OF F x0 Flim DERIV_isCont[OF Fderiv]] that
by (simp add: U_def T_def)
have phi_U: "phi (U s) = s" if "T < s" for s
using UF[OF that] s1[OF that] by (simp add: phi_def)
have phi_deriv: "(phi has_real_derivative f z / (1 - F z)⇧2) (at z)"
if z: "x0 < z" "F z < 1" for z
unfolding phi_def using Fderiv[OF z] z
by (auto intro!: derivative_eq_intros simp: power2_eq_square)
have t_gt: "T < t"
using t by (simp add: T_def)
obtain w where wgt: "U t < w" and wlt1: "F w < 1"
using ex_gt_less UFlt t_gt by blast
define d where "d = min (U t - x0) (w - U t) / 2"
have d0: "0 < d"
using Ugt[OF t_gt] wgt by (simp add: d_def)
have inreg: "x0 < z" "F z < 1" if zd: "¦z - U t¦ ≤ d" for z
proof -
have dlo: "d < U t - x0" and dhi: "d < w - U t"
using Ugt[OF t_gt] wgt by (auto simp: d_def)
show "x0 < z"
using zd dlo by (simp add: abs_le_iff)
have "z < w"
using zd dhi by (simp add: abs_le_iff)
thus "F z < 1"
using monoD[OF mono, of z w] wlt1 by simp
qed
have isC: "isCont U t"
proof (subst phi_U[OF t_gt, symmetric],
rule isCont_inverse_function[where f = phi and g = U and x = "U t" and d = d,
OF d0])
fix z
assume z: "¦z - U t¦ ≤ d"
show "U (phi z) = z" "isCont phi z"
using ginv_f_eq[OF smono inreg[OF z]] inreg[OF z]
DERIV_isCont[OF phi_deriv[OF inreg[OF z]]]
by (simp_all add: U_def phi_def)
qed
have D: "(phi has_real_derivative t⇧2 * f (U t)) (at (U t))"
using UF[OF t_gt] s1[OF t_gt] phi_deriv[OF Ugt[OF t_gt] UFlt[OF t_gt]]
by (simp add: power_one_over mult.commute)
have "(U has_real_derivative inverse (t⇧2 * f (U t))) (at t)"
proof (rule DERIV_inverse_function[OF D _ t_gt less_add_one _ isC])
show "t⇧2 * f (U t) ≠ 0"
using fpos[OF Ugt[OF t_gt] UFlt[OF t_gt]] s1[OF t_gt] by simp
fix y
assume "T < y" "y < t + 1"
thus "phi (U y) = y"
by (simp add: phi_U)
qed
thus ?thesis
by (simp add: U_def inverse_eq_divide)
qed
lemma f_tail_quantile_pos:
fixes t :: real
assumes t: "1 / (1 - F x0) < t"
shows "0 < f (tail_quantile F t)"
by (intro fpos t_lt_tail_quantile_of_gt_inv[OF F x0 t]
F_tail_quantile_lt_1[OF F x0 Flim DERIV_isCont[OF Fderiv] t])
lemma tail_quantile_deriv_has_deriv:
fixes f' :: "real ⇒ real" and t :: real
assumes fderiv: "⋀x. x0 < x ⟹ F x < 1 ⟹ (f has_real_derivative f' x) (at x)"
and t: "1 / (1 - F x0) < t"
shows "((λs. 1 / (s⇧2 * f (tail_quantile F s))) has_real_derivative
- (2 * t * f (tail_quantile F t)
+ f' (tail_quantile F t) / f (tail_quantile F t))
/ (t⇧2 * f (tail_quantile F t))⇧2) (at t)"
proof -
define T where "T = 1 / (1 - F x0)"
define U where "U = tail_quantile F"
have t_gt: "T < t"
using t by (simp add: T_def)
have t1: "1 < t"
using one_less_of_inverse_tail_less[OF F x0 t] .
have Ugt: "x0 < U t"
using t_lt_tail_quantile_of_gt_inv[OF F x0 t] by (simp add: U_def)
have UFlt: "F (U t) < 1"
using F_tail_quantile_lt_1[OF F x0 Flim DERIV_isCont[OF Fderiv] t] by (simp add: U_def)
have nz: "t ≠ 0" "f (U t) ≠ 0" and nz2: "t⇧2 * f (U t) ≠ 0"
using t1 fpos[OF Ugt UFlt] by auto
have c1: "((λs. f (U s)) has_real_derivative f' (U t) * (1 / (t⇧2 * f (U t)))) (at t)"
unfolding U_def
by (rule DERIV_chain2[OF fderiv[OF Ugt UFlt, unfolded U_def]
tail_quantile_has_deriv[OF t]])
have c2: "((λs. s⇧2 * f (U s)) has_real_derivative
2 * t * f (U t) + f' (U t) / f (U t)) (at t)"
proof -
have "2 * t * f (U t) + t⇧2 * (f' (U t) * (1 / (t⇧2 * f (U t))))
= 2 * t * f (U t) + f' (U t) / f (U t)"
using nz by (simp add: field_simps)
thus ?thesis
by (auto intro!: derivative_eq_intros c1)
qed
have "((λs. 1 / (s⇧2 * f (U s))) has_real_derivative
- (2 * t * f (U t) + f' (U t) / f (U t)) / (t⇧2 * f (U t))⇧2) (at t)"
using DERIV_divide[OF DERIV_const[of 1] c2 nz2] by (simp add: power2_eq_square)
thus ?thesis
by (simp add: U_def)
qed
lemma tail_quantile_second_deriv_eq:
fixes f' u u' :: "real ⇒ real" and t :: real
assumes fderiv: "⋀x. x0 < x ⟹ F x < 1 ⟹ (f has_real_derivative f' x) (at x)"
and uderiv: "⋀s. 1 / (1 - F x0) < s
⟹ (tail_quantile F has_real_derivative u s) (at s)"
and u'deriv: "⋀s. 1 / (1 - F x0) < s ⟹ (u has_real_derivative u' s) (at s)"
and t: "1 / (1 - F x0) < t"
shows "t * u' t / u t
= - 2 - (1 - F (tail_quantile F t)) * f' (tail_quantile F t)
/ (f (tail_quantile F t))⇧2"
proof -
define T where "T = 1 / (1 - F x0)"
define U where "U = tail_quantile F"
have t_gt: "T < t"
using t by (simp add: T_def)
have s1: "1 < s" if "T < s" for s
using one_less_of_inverse_tail_less[OF F x0] that by (simp add: T_def)
have Ugt: "x0 < U s" if "T < s" for s
using t_lt_tail_quantile_of_gt_inv[OF F x0] that by (simp add: U_def T_def)
have UF: "1 - F (U s) = 1 / s" if "T < s" for s
using tail_quantile_tail_eq[OF F x0 Flim DERIV_isCont[OF Fderiv]] that
by (simp add: U_def T_def)
have UFlt: "F (U s) < 1" if "T < s" for s
using F_tail_quantile_lt_1[OF F x0 Flim DERIV_isCont[OF Fderiv]] that
by (simp add: U_def T_def)
have fUpos: "0 < f (U s)" if "T < s" for s
using f_tail_quantile_pos that by (simp add: T_def U_def)
have u_eq: "u s = 1 / (s⇧2 * f (U s))" if "T < s" for s
using DERIV_unique[OF uderiv tail_quantile_has_deriv] that
by (simp add: T_def U_def)
have hd: "((λs. 1 / (s⇧2 * f (U s))) has_real_derivative
- (2 * t * f (U t) + f' (U t) / f (U t)) / (t⇧2 * f (U t))⇧2) (at t)"
using tail_quantile_deriv_has_deriv[OF fderiv t]
by (simp add: U_def)
have uderiv': "(u has_real_derivative
- (2 * t * f (U t) + f' (U t) / f (U t)) / (t⇧2 * f (U t))⇧2) (at t)"
by(intro has_field_derivative_transform_within_open[OF hd, where S = "{T<..}"])
(auto simp: u_eq t_gt)
have Uval: "tail_quantile F t = U t"
by (simp add: U_def)
have nz': "t ≠ 0" "f (U t) ≠ 0"
using s1[OF t_gt] fUpos[OF t_gt] by auto
show ?thesis
unfolding Uval DERIV_unique[OF u'deriv[OF t] uderiv'] u_eq[OF t_gt] UF[OF t_gt]
using nz' by (simp add: field_simps power2_eq_square)
qed
context
fixes f' :: "real ⇒ real" and γ :: real
assumes fderiv: "⋀y. x0 < y ⟹ F y < 1 ⟹ (f has_real_derivative f' y) (at y)"
and f'cont: "continuous_on {y. x0 < y ∧ F y < 1} f'"
and lim: "((λy. (1 - F y) * f' y / (f y)⇧2) ⤏ - γ - 1) (endpoint_filter F)"
begin
lemma von_Mises_quantile_diff:
fixes x :: real
assumes x: "0 < x"
shows "((λt. (tail_quantile F (t * x) - tail_quantile F t)
* (t * f (tail_quantile F t)))
⤏ (if γ = 0 then ln x else (x powr γ - 1) / γ)) at_top"
proof -
define T where "T = 1 / (1 - F x0)"
define U where "U = tail_quantile F"
define u where "u = (λs. 1 / (s⇧2 * f (U s)))"
define u' where "u' = (λs. - (2 * s * f (U s) + f' (U s) / f (U s)) / (s⇧2 * f (U s))⇧2)"
have Tpos: "0 < T"
using x0 right_continuous_mono.a_le_f[OF F, of x0] by (simp add: T_def)
have s1: "1 < s" if "T < s" for s
using one_less_of_inverse_tail_less[OF F x0] that by (simp add: T_def)
have Ugt: "x0 < U s" if "T < s" for s
using t_lt_tail_quantile_of_gt_inv[OF F x0] that by (simp add: U_def T_def)
have UF: "1 - F (U s) = 1 / s" if "T < s" for s
using tail_quantile_tail_eq[OF F x0 Flim DERIV_isCont[OF Fderiv]] that
by (simp add: U_def T_def)
have UFlt: "F (U s) < 1" if "T < s" for s
using F_tail_quantile_lt_1[OF F x0 Flim DERIV_isCont[OF Fderiv]] that
by (simp add: U_def T_def)
have fUpos: "0 < f (U s)" if "T < s" for s
using f_tail_quantile_pos that by (simp add: T_def U_def)
have UderivT: "(tail_quantile F has_real_derivative u s) (at s)"
if "1 / (1 - F x0) < s" for s
using tail_quantile_has_deriv[OF that] by (simp add: u_def U_def)
have uderivT: "(u has_real_derivative u' s) (at s)" if "1 / (1 - F x0) < s" for s
using tail_quantile_deriv_has_deriv[OF fderiv that]
by (simp add: u_def u'_def U_def)
have Uderiv: "(U has_real_derivative u s) (at s)" if "T < s" for s
using UderivT that by (simp add: T_def U_def)
have uderiv: "(u has_real_derivative u' s) (at s)" if "T < s" for s
using uderivT that by (simp add: T_def)
have upos: "0 < u s" if "T < s" for s
using s1[OF that] fUpos[OF that] by (simp add: u_def)
have regopen: "open {y. x0 < y ∧ F y < 1}"
proof -
have "{y. x0 < y ∧ F y < 1} = {x0<..} ∩ {y. F y < 1}"
by auto
moreover have "open ({x0<..} ∩ {y. F y < 1})"
by (intro open_Int open_greaterThan right_continuous_mono.open_less[OF F])
ultimately show ?thesis
by simp
qed
have f'isCont: "isCont f' y" if "x0 < y" "F y < 1" for y
by (rule continuous_on_interior[OF f'cont]) (simp add: interior_open[OF regopen] that)
have u'cont: "continuous_on {T<..} u'"
proof (safe intro!: continuous_at_imp_continuous_on)
fix s
assume sT: "T < s"
show "isCont u' s"
unfolding u'_def using fUpos[OF sT] s1[OF sT]
by (intro continuous_intros
isCont_o2[OF DERIV_isCont[OF Uderiv[OF sT]]
DERIV_isCont[OF fderiv[OF Ugt[OF sT] UFlt[OF sT]]]]
isCont_o2[OF DERIV_isCont[OF Uderiv[OF sT]]
f'isCont[OF Ugt[OF sT] UFlt[OF sT]]])
auto
qed
have lim2: "((λs. s * u' s / u s) ⤏ γ - 1) at_top"
proof -
have "((λs. (1 - F (U s)) * f' (U s) / (f (U s))⇧2) ⤏ - γ - 1) at_top"
unfolding U_def
by (rule filterlim_compose[OF lim tail_quantile_tendsto_endpoint[OF F Flim]])
from tendsto_diff[OF tendsto_const[of "- 2 :: real"] this]
have "((λs. - 2 - (1 - F (U s)) * f' (U s) / (f (U s))⇧2) ⤏ γ - 1) at_top"
by simp
moreover have "∀⇩F s in at_top.
- 2 - (1 - F (U s)) * f' (U s) / (f (U s))⇧2 = s * u' s / u s"
using eventually_gt_at_top[of T]
by eventually_elim
(use tail_quantile_second_deriv_eq[OF fderiv UderivT uderivT]
in "simp add: T_def U_def")
ultimately show ?thesis
by (rule Lim_transform_eventually)
qed
have "∀⇩F s in at_top. (U (s * x) - U s) / (s * u s)
= (U (s * x) - U s) * (s * f (U s))"
using eventually_gt_at_top[of T]
by eventually_elim (use s1 fUpos in "simp add: u_def field_simps power2_eq_square")
from Lim_transform_eventually
[OF deriv_diff_ratio_regularly_varying[OF Tpos Uderiv uderiv u'cont upos lim2 x] this]
show ?thesis
by (simp add: U_def)
qed
lemma von_Mises_normalizing_ex:
shows "∃a. (∀t. 0 < a t)
∧ (∀⇩F t in at_top. a t = 1 / (t * f (tail_quantile F t)))
∧ (∀x>0. ((λt. (tail_quantile F (t * x) - tail_quantile F t) / a t)
⤏ (if γ = 0 then ln x else (x powr γ - 1) / γ)) at_top)"
proof -
define T where "T = 1 / (1 - F x0)"
define a where "a = (λt. if T < t then 1 / (t * f (tail_quantile F t)) else 1)"
have t1: "1 < t" if "T < t" for t
using one_less_of_inverse_tail_less[OF F x0] that by (simp add: T_def)
have fU: "0 < f (tail_quantile F t)" if "T < t" for t
using f_tail_quantile_pos that by (simp add: T_def)
have apos: "0 < a t" for t
by (cases "T < t") (use t1[of t] fU[of t] in "auto simp: a_def")
have aev: "∀⇩F t in at_top. a t = 1 / (t * f (tail_quantile F t))"
using eventually_gt_at_top[of T] by eventually_elim (simp add: a_def)
have "((λt. (tail_quantile F (t * x) - tail_quantile F t) / a t)
⤏ (if γ = 0 then ln x else (x powr γ - 1) / γ)) at_top" if x: "0 < x" for x
proof -
have "∀⇩F t in at_top. (tail_quantile F (t * x) - tail_quantile F t)
* (t * f (tail_quantile F t))
= (tail_quantile F (t * x) - tail_quantile F t) / a t"
using eventually_gt_at_top[of T]
by eventually_elim (use t1 fU in "simp add: a_def")
from Lim_transform_eventually[OF von_Mises_quantile_diff[OF x] this]
show ?thesis .
qed
thus ?thesis
using apos aev by blast
qed
text ‹von Mises' condition (Theorem~1.1.8 of the book by de Haan and
Ferreira~\<^cite>‹deHaanFerreira›).›
theorem von_Mises_condition: "domain_of_attraction F (EVD_cdf γ 0 1)"
unfolding MDA_iff_tail_quantile'[OF F]
using von_Mises_normalizing_ex by blast
corollary von_Mises_normalization:
fixes x :: real
shows "(λn. F (x / (real n * f (tail_quantile F (real n)))
+ tail_quantile F (real n)) ^ n) ⇢ EVD_cdf γ 0 1 x"
proof -
obtain a where apos: "⋀t. 0 < a t"
and aev: "∀⇩F t in at_top. a t = 1 / (t * f (tail_quantile F t))"
and quant: "⋀y. 0 < y ⟹ ((λt. (tail_quantile F (t * y) - tail_quantile F t) / a t)
⤏ (if γ = 0 then ln y else (y powr γ - 1) / γ)) at_top"
using von_Mises_normalizing_ex by blast
have "(λn. F (a (real n) * x + tail_quantile F (real n)) ^ n) ⇢ EVD_cdf γ 0 1 x"
proof (rule MDA_tail_quantile_witness[OF F apos zero_less_one])
fix y :: real
assume y: "0 < y"
show "((λt. (tail_quantile F (t * y) - tail_quantile F t) / a t)
⤏ (if γ = 0 then 1 * ln y + 0 else 1 * (y powr γ - 1) / γ + 0)) at_top"
by (cases "γ = 0") (use quant[OF y] in simp_all)
qed
moreover have "∀⇩F n in sequentially. F (a (real n) * x + tail_quantile F (real n)) ^ n
= F (x / (real n * f (tail_quantile F (real n))) + tail_quantile F (real n)) ^ n"
using eventually_compose_filterlim[OF aev filterlim_real_sequentially]
by eventually_elim simp
ultimately show ?thesis
by (rule Lim_transform_eventually)
qed
end
end
text ‹Relation~(1.1.35) of the book by de Haan and Ferreira~\<^cite>‹deHaanFerreira›.›
lemma tail_quantile_deriv_ratio_pos:
fixes F f u :: "real ⇒ real" and γ x0 t0 :: real
assumes F: "right_continuous_mono F 0 1"
and unbdd: "¬ bdd_support F"
and gamma: "0 < γ"
and Fderiv: "⋀x. x0 < x ⟹ (F has_real_derivative f x) (at x)"
and fpos: "⋀x. x0 < x ⟹ 0 < f x"
and uderiv: "⋀t. t0 < t ⟹ (tail_quantile F has_real_derivative u t) (at t)"
and lim: "((λt. t * f t / (1 - F t)) ⤏ 1 / γ) at_top"
shows "((λt. t * u t / tail_quantile F t) ⤏ γ) at_top"
proof -
have x0lt: "F x0 < 1"
by (rule F_lt_1_unbdd_support[OF F unbdd])
have Flim: "(F ⤏ 1) (endpoint_filter F)"
using right_continuous_mono.top[OF F] unbdd by (simp add: endpoint_filter)
have Fderiv': "(F has_real_derivative f y) (at y)" if y: "x0 < y" and "F y < 1" for y
by (rule Fderiv[OF y])
have fpos': "0 < f y" if y: "x0 < y" and "F y < 1" for y
by (rule fpos[OF y])
define T where "T = max t0 (1 / (1 - F x0))"
have t1: "1 < t" if "T < t" for t
using one_less_of_inverse_tail_less[OF F x0lt] that by (simp add: T_def)
have fU: "0 < f (tail_quantile F t)" if "T < t" for t
using f_tail_quantile_pos[OF F x0lt Flim Fderiv' fpos'] that by (simp add: T_def)
have UF: "1 - F (tail_quantile F t) = 1 / t" if "T < t" for t
using tail_quantile_tail_eq[OF F x0lt Flim DERIV_isCont[OF Fderiv']] that
by (simp add: T_def)
have u_eq: "u t = 1 / (t⇧2 * f (tail_quantile F t))" if "T < t" for t
using DERIV_unique[OF uderiv tail_quantile_has_deriv[OF F x0lt Flim Fderiv' fpos']] that
by (simp add: T_def)
note Uat = tail_quantile_at_top[OF F F_lt_1_unbdd_support[OF F unbdd]]
have "((λs. (1 - F s) / (s * f s)) ⤏ γ) at_top"
using tendsto_inverse[OF lim] gamma by simp
from filterlim_compose[OF this Uat]
have comp: "((λt. (1 - F (tail_quantile F t))
/ (tail_quantile F t * f (tail_quantile F t))) ⤏ γ) at_top" .
have evU: "∀⇩F t in at_top. 1 ≤ tail_quantile F t"
using Uat unfolding filterlim_at_top by blast
have "∀⇩F t in at_top. (1 - F (tail_quantile F t))
/ (tail_quantile F t * f (tail_quantile F t)) = t * u t / tail_quantile F t"
using eventually_gt_at_top[of T] evU
proof eventually_elim
fix t :: real
assume tT: "T < t"
and U1: "1 ≤ tail_quantile F t"
show "(1 - F (tail_quantile F t)) / (tail_quantile F t * f (tail_quantile F t))
= t * u t / tail_quantile F t"
unfolding UF[OF tT] u_eq[OF tT]
using t1[OF tT] fU[OF tT] U1 by (simp add: field_simps power2_eq_square)
qed
from Lim_transform_eventually[OF comp this]
show ?thesis .
qed
text ‹von Mises' condition for positive $\gamma$ (Theorem~1.1.11 of the book by
de Haan and Ferreira~\<^cite>‹deHaanFerreira›).›
theorem von_Mises_condition_pos:
fixes F f :: "real ⇒ real" and γ x0 :: real
assumes F: "right_continuous_mono F 0 1"
and unbdd: "¬ bdd_support F"
and gamma: "0 < γ"
and Fderiv: "⋀x. x0 < x ⟹ (F has_real_derivative f x) (at x)"
and fcont: "continuous_on {x0<..} f"
and fpos: "⋀x. x0 < x ⟹ 0 < f x"
and lim: "((λt. t * f t / (1 - F t)) ⤏ 1 / γ) at_top"
shows "domain_of_attraction F (EVD_cdf γ 0 1)"
proof -
have x0lt: "F x0 < 1"
by (rule F_lt_1_unbdd_support[OF F unbdd])
have Flim: "(F ⤏ 1) (endpoint_filter F)"
using right_continuous_mono.top[OF F] unbdd by (simp add: endpoint_filter)
have Fderiv': "(F has_real_derivative f y) (at y)" if y: "x0 < y" and "F y < 1" for y
by (rule Fderiv[OF y])
have fpos': "0 < f y" if y: "x0 < y" and "F y < 1" for y
by (rule fpos[OF y])
have fcont': "isCont f y" if "x0 < y" for y
by (rule continuous_on_interior[OF fcont]) (simp add: interior_open that)
obtain T1 where T1: "⋀t. T1 ≤ t ⟹ 1 ≤ tail_quantile F t"
using tail_quantile_at_top[OF F F_lt_1_unbdd_support[OF F unbdd]]
unfolding filterlim_at_top eventually_at_top_linorder by blast
define T where "T = max (1 / (1 - F x0)) (max T1 1)"
define u where "u = (λs. 1 / (s⇧2 * f (tail_quantile F s)))"
have Tpos: "0 < T"
by (simp add: T_def)
have t1: "1 < t" if "T < t" for t
using one_less_of_inverse_tail_less[OF F x0lt] that by (simp add: T_def)
have Upos: "0 < tail_quantile F t" if "T < t" for t
using T1[of t] that by (simp add: T_def)
have fU: "0 < f (tail_quantile F t)" if "T < t" for t
using f_tail_quantile_pos[OF F x0lt Flim Fderiv' fpos'] that by (simp add: T_def)
have Uderiv: "(tail_quantile F has_real_derivative u t) (at t)" if "T < t" for t
using tail_quantile_has_deriv[OF F x0lt Flim Fderiv' fpos'] that by (simp add: u_def T_def)
have ucont: "continuous_on {T<..} u"
proof (safe intro!: continuous_at_imp_continuous_on)
fix s
assume sT: "T < s"
show "isCont u s"
unfolding u_def using fU[OF sT] t1[OF sT]
by (intro continuous_intros
isCont_o2[OF DERIV_isCont[OF Uderiv[OF sT]]
fcont'[OF t_lt_tail_quantile_of_gt_inv[OF F x0lt, of s]]])
(use sT in "auto simp: T_def")
qed
note lim2 = tail_quantile_deriv_ratio_pos[OF F unbdd gamma Fderiv fpos Uderiv lim]
define a where "a = (λt. if T < t then γ * tail_quantile F t else 1)"
have apos: "0 < a t" for t
by (cases "T < t") (use gamma Upos in "simp_all add: a_def")
have "((λt. (tail_quantile F (t * x) - tail_quantile F t) / a t)
⤏ (if γ = 0 then ln x else (x powr γ - 1) / γ)) at_top" if x: "0 < x" for x
proof -
have "((λt. (tail_quantile F (t * x) / tail_quantile F t - 1) / γ)
⤏ (x powr γ - 1) / γ) at_top"
by (intro tendsto_divide tendsto_diff
deriv_ratio_regularly_varying[OF Tpos Uderiv ucont Upos lim2 x] tendsto_const)
(use gamma in simp_all)
moreover have "∀⇩F t in at_top. (tail_quantile F (t * x) / tail_quantile F t - 1) / γ
= (tail_quantile F (t * x) - tail_quantile F t) / a t"
using eventually_gt_at_top[of T]
proof eventually_elim
case (elim t)
show ?case
using Upos[OF elim] gamma elim by (simp add: a_def field_simps)
qed
ultimately have "((λt. (tail_quantile F (t * x) - tail_quantile F t) / a t)
⤏ (x powr γ - 1) / γ) at_top"
by (rule Lim_transform_eventually)
thus ?thesis
using gamma by simp
qed
thus ?thesis
unfolding MDA_iff_tail_quantile'[OF F] using apos by blast
qed
lemma F_tendsto_1_endpoint_of_deriv:
fixes F f :: "real ⇒ real" and x0 c :: real
assumes F: "right_continuous_mono F 0 1"
and bdd: "bdd_support F"
and x0: "x0 < x_star F"
and Fderiv: "⋀y. x0 < y ⟹ y < x_star F ⟹ (F has_real_derivative f y) (at y)"
and cpos: "0 < c"
and lim: "((λy. (x_star F - y) * f y / (1 - F y)) ⤏ c) (at_left (x_star F))"
shows "(F ⤏ 1) (endpoint_filter F)"
proof -
interpret right_continuous_mono F 0 1
by fact
define X where "X = x_star F"
define G where "G = Sup (F ` {..<X})"
have ne: "F ` {..<X} ≠ {}"
by auto
have leG: "F y ≤ G" if "y < X" for y
unfolding G_def using that by (auto intro!: cSup_upper bdd_aboveI2[of _ _ 1] f_le_b)
have G1: "G = 1"
proof (rule ccontr)
assume "G ≠ 1"
moreover have "G ≤ 1"
unfolding G_def by (auto intro!: cSup_least ne f_le_b)
ultimately have Glt: "G < 1"
by simp
define e where "e = 1 - G"
have epos: "0 < e"
using Glt by (simp add: e_def)
have tail_ge: "e ≤ 1 - F y" if "y < X" for y
using leG[OF that] by (simp add: e_def)
obtain b0 where b0X: "b0 < X"
and b0: "⋀y. b0 < y ⟹ y < X ⟹ c / 2 < (X - y) * f y / (1 - F y)"
using order_tendstoD(1)[OF lim, of "c / 2"] cpos
unfolding X_def eventually_at_left_field by auto
define B where "B = max b0 x0"
have BX: "B < X"
using b0X x0 by (simp add: B_def X_def)
have fbound: "c * e / 2 / (X - y) < f y" if yB: "B < y" and yX: "y < X" for y
proof -
have pos: "0 < 1 - F y"
using tail_ge[OF yX] epos by simp
have "c / 2 * e ≤ c / 2 * (1 - F y)"
using tail_ge[OF yX] cpos by simp
also have "… < (X - y) * f y"
using b0[of y] yB yX pos by (simp add: B_def pos_less_divide_eq)
finally show ?thesis
using yX by (simp add: pos_divide_less_eq algebra_simps)
qed
obtain s where sX: "s < X" and Fs: "G - c * e / 4 < F s"
using less_cSupD[OF ne, of "G - c * e / 4"] cpos epos by (auto simp: G_def)
define p where "p = max s ((B + X) / 2)"
have pX: "p < X" and Bp: "B < p" and sp: "s ≤ p"
using sX BX by (auto simp: p_def less_max_iff_disj)
have Fp: "G - c * e / 4 < F p"
using Fs monoD[OF mono, of s p] sp by simp
define q where "q = (p + X) / 2"
have pq: "p < q" and qX: "q < X"
using pX by (simp_all add: q_def)
have deriv: "(F has_real_derivative f y) (at y)" if "p ≤ y" "y ≤ q" for y
using that Bp qX x0 by (auto intro!: Fderiv simp: B_def X_def)
obtain z where z: "p < z" "z < q" and Fz: "F q - F p = (q - p) * f z"
using MVT2[OF pq deriv] by blast
have "c * e / 4 < (q - p) * f z"
proof -
have "c * e / 2 / (X - p) ≤ c * e / 2 / (X - z)"
using z pX qX cpos epos by (intro divide_left_mono) auto
also have "… < f z"
using fbound[of z] Bp z qX by simp
finally show ?thesis
using pX by (simp add: q_def field_simps)
qed
thus False
using Fz Fp leG[OF qX] by simp
qed
show ?thesis
unfolding endpoint_filter(1)[OF bdd] X_def[symmetric]
proof (rule order_tendstoI)
fix a :: real
assume "a < 1"
then obtain s where sX: "s < X" and Fs: "a < F s"
using less_cSupD[OF ne, of a] by (auto simp: G_def G1[symmetric])
show "∀⇩F y in at_left X. a < F y"
proof (intro eventually_at_leftI[OF _ sX])
fix y
assume "y ∈ {s<..<X}"
thus "a < F y"
using Fs monoD[OF mono, of s y] by simp
qed
qed (auto intro!: always_eventually order.strict_trans1[OF f_le_b])
qed
text ‹Relation~(1.1.38) of the book by de Haan and Ferreira~\<^cite>‹deHaanFerreira›.›
lemma tail_quantile_deriv_ratio_neg:
fixes F f u :: "real ⇒ real" and γ x0 t0 :: real
assumes F: "right_continuous_mono F 0 1"
and bdd: "bdd_support F"
and gamma: "γ < 0"
and x0: "x0 < x_star F"
and Fderiv: "⋀x. x0 < x ⟹ x < x_star F ⟹ (F has_real_derivative f x) (at x)"
and fpos: "⋀x. x0 < x ⟹ x < x_star F ⟹ 0 < f x"
and uderiv: "⋀t. t0 < t ⟹ (tail_quantile F has_real_derivative u t) (at t)"
and lim: "((λt. (x_star F - t) * f t / (1 - F t)) ⤏ - 1 / γ) (at_left (x_star F))"
shows "((λt. t * u t / (x_star F - tail_quantile F t)) ⤏ - γ) at_top"
proof -
have Flim: "(F ⤏ 1) (endpoint_filter F)"
by (intro F_tendsto_1_endpoint_of_deriv[OF F bdd x0 Fderiv _ lim])
(use gamma in "auto simp: divide_neg_neg")
have iff: "y < x_star F ⟷ F y < 1" for y
by (rule lt_x_star_iff_F_lt_1[OF F bdd])
have x0lt: "F x0 < 1"
using x0 iff by simp
have Fderiv': "(F has_real_derivative f y) (at y)" if "x0 < y" "F y < 1" for y
using that iff by (auto intro!: Fderiv)
have fpos': "0 < f y" if "x0 < y" "F y < 1" for y
using that iff by (auto intro!: fpos)
define T where "T = max t0 (1 / (1 - F x0))"
have t1: "1 < t" if "T < t" for t
using one_less_of_inverse_tail_less[OF F x0lt] that by (simp add: T_def)
have fU: "0 < f (tail_quantile F t)" if "T < t" for t
using f_tail_quantile_pos[OF F x0lt Flim Fderiv' fpos'] that by (simp add: T_def)
have UF: "1 - F (tail_quantile F t) = 1 / t" if "T < t" for t
using tail_quantile_tail_eq[OF F x0lt Flim DERIV_isCont[OF Fderiv']] that
by (simp add: T_def)
have u_eq: "u t = 1 / (t⇧2 * f (tail_quantile F t))" if "T < t" for t
using DERIV_unique[OF uderiv tail_quantile_has_deriv[OF F x0lt Flim Fderiv' fpos']] that
by (simp add: T_def)
have Uend: "filterlim (tail_quantile F) (at_left (x_star F)) at_top"
using tail_quantile_tendsto_endpoint[OF F Flim] by (simp add: endpoint_filter bdd)
have "((λs. (1 - F s) / ((x_star F - s) * f s)) ⤏ - γ) (at_left (x_star F))"
using tendsto_inverse[OF lim] gamma by simp
from filterlim_compose[OF this Uend]
have comp: "((λt. (1 - F (tail_quantile F t))
/ ((x_star F - tail_quantile F t) * f (tail_quantile F t)))
⤏ - γ) at_top" .
have evU: "∀⇩F t in at_top. tail_quantile F t < x_star F"
using eventually_gt_at_top[of "1 :: real"]
by eventually_elim (rule tail_quantile_lt_x_star[OF F bdd Flim])
have "∀⇩F t in at_top. (1 - F (tail_quantile F t))
/ ((x_star F - tail_quantile F t) * f (tail_quantile F t))
= t * u t / (x_star F - tail_quantile F t)"
using eventually_gt_at_top[of T] evU
proof eventually_elim
fix t :: real
assume tT: "T < t"
and Ult: "tail_quantile F t < x_star F"
show "(1 - F (tail_quantile F t))
/ ((x_star F - tail_quantile F t) * f (tail_quantile F t))
= t * u t / (x_star F - tail_quantile F t)"
unfolding UF[OF tT] u_eq[OF tT]
using t1[OF tT] fU[OF tT] Ult by (simp add: field_simps power2_eq_square)
qed
from Lim_transform_eventually[OF comp this]
show ?thesis .
qed
text ‹von Mises' condition for negative $\gamma$ (Theorem~1.1.13 of the book by
de Haan and Ferreira~\<^cite>‹deHaanFerreira›).›
theorem von_Mises_condition_neg:
fixes F f :: "real ⇒ real" and γ x0 :: real
assumes F: "right_continuous_mono F 0 1"
and bdd: "bdd_support F"
and gamma: "γ < 0"
and x0: "x0 < x_star F"
and Fderiv: "⋀x. x0 < x ⟹ x < x_star F ⟹ (F has_real_derivative f x) (at x)"
and fcont: "continuous_on {x0<..<x_star F} f"
and fpos: "⋀x. x0 < x ⟹ x < x_star F ⟹ 0 < f x"
and lim: "((λt. (x_star F - t) * f t / (1 - F t)) ⤏ - 1 / γ) (at_left (x_star F))"
shows "domain_of_attraction F (EVD_cdf γ 0 1)"
proof -
have Flim: "(F ⤏ 1) (endpoint_filter F)"
by (intro F_tendsto_1_endpoint_of_deriv[OF F bdd x0 Fderiv _ lim])
(use gamma in "auto simp: divide_neg_neg")
have iff: "y < x_star F ⟷ F y < 1" for y
by (rule lt_x_star_iff_F_lt_1[OF F bdd])
have x0lt: "F x0 < 1"
using x0 iff by simp
have Fderiv': "(F has_real_derivative f y) (at y)" if "x0 < y" "F y < 1" for y
using that iff by (auto intro!: Fderiv)
have fpos': "0 < f y" if "x0 < y" "F y < 1" for y
using that iff by (auto intro!: fpos)
have fcont': "isCont f y" if "x0 < y" "y < x_star F" for y
by (rule continuous_on_interior[OF fcont]) (simp add: interior_open that)
define T where "T = max (1 / (1 - F x0)) 1"
define u where "u = (λs. 1 / (s⇧2 * f (tail_quantile F s)))"
have Tpos: "0 < T"
by (simp add: T_def)
have t1: "1 < t" if "T < t" for t
using one_less_of_inverse_tail_less[OF F x0lt] that by (simp add: T_def)
have Ult: "tail_quantile F t < x_star F" if "T < t" for t
by (rule tail_quantile_lt_x_star[OF F bdd Flim t1[OF that]])
have Ugt: "x0 < tail_quantile F t" if "T < t" for t
using t_lt_tail_quantile_of_gt_inv[OF F x0lt] that by (simp add: T_def)
have fU: "0 < f (tail_quantile F t)" if "T < t" for t
by (rule fpos[OF Ugt[OF that] Ult[OF that]])
have Uderiv: "(tail_quantile F has_real_derivative u t) (at t)" if "T < t" for t
using tail_quantile_has_deriv[OF F x0lt Flim Fderiv' fpos'] that by (simp add: u_def T_def)
have ucont: "continuous_on {T<..} u"
proof (safe intro!: continuous_at_imp_continuous_on)
fix s
assume sT: "T < s"
show "isCont u s"
unfolding u_def using fU[OF sT] t1[OF sT]
by (intro continuous_intros
isCont_o2[OF DERIV_isCont[OF Uderiv[OF sT]] fcont'[OF Ugt[OF sT] Ult[OF sT]]])
auto
qed
note lim2 = tail_quantile_deriv_ratio_neg[OF F bdd gamma x0 Fderiv fpos Uderiv lim]
define a where "a = (λt. if T < t then - γ * (x_star F - tail_quantile F t) else 1)"
have apos: "0 < a t" for t
by (cases "T < t") (use gamma Ult in "simp_all add: a_def mult_neg_pos")
have "((λt. (tail_quantile F (t * x) - tail_quantile F t) / a t)
⤏ (if γ = 0 then ln x else (x powr γ - 1) / γ)) at_top" if x: "0 < x" for x
proof -
have "((λt. (1 - (x_star F - tail_quantile F (t * x))
/ (x_star F - tail_quantile F t)) / (- γ))
⤏ (1 - x powr γ) / (- γ)) at_top"
by (intro tendsto_divide tendsto_diff
deriv_ratio_regularly_varying_uminus[OF Tpos Uderiv ucont Ult lim2 x] tendsto_const)
(use gamma in simp_all)
moreover have "∀⇩F t in at_top. (1 - (x_star F - tail_quantile F (t * x))
/ (x_star F - tail_quantile F t)) / (- γ)
= (tail_quantile F (t * x) - tail_quantile F t) / a t"
using eventually_gt_at_top[of T]
proof eventually_elim
case (elim t)
show ?case
using Ult[OF elim] gamma elim by (simp add: a_def field_simps)
qed
ultimately have "((λt. (tail_quantile F (t * x) - tail_quantile F t) / a t)
⤏ (1 - x powr γ) / (- γ)) at_top"
by (rule Lim_transform_eventually)
thus ?thesis
using gamma by (simp add: minus_divide_left field_simps)
qed
thus ?thesis
unfolding MDA_iff_tail_quantile'[OF F] using apos by blast
qed
subsection ‹Relation to Regularly Varying Functions›
text ‹We formalize results for $\gamma \neq 0$.›
lemma tail_quantile_S_at_top:
fixes F :: "real ⇒ real" and ρ :: real
assumes F: "right_continuous_mono F 0 1"
and bdd: "bdd_support F"
and rv: "regularly_varying (λs. 1 - F (x_star F - 1 / s)) ρ"
and rho: "ρ < 0"
shows "filterlim (λt. 1 / (x_star F - tail_quantile F t)) at_top at_top"
proof -
interpret right_continuous_mono F 0 1
by fact
have phi_to_0: "((λs. 1 - F (x_star F - 1 / s)) ⤏ 0) at_top"
using regularly_varying_neg_at_top[OF rv rho] .
have Ult: "tail_quantile F t < x_star F"
if t1[arith]: "1 < t" for t
proof -
have ev: "∀⇩F s in at_top. 1 - F (x_star F - 1 / s) < 1 / t ∧ 0 < s"
using eventually_conj[OF order_tendstoD(2)[OF phi_to_0, of "1 / t"]
eventually_gt_at_top[of "0::real"]]
by simp
then obtain s0 where s0: "1 - F (x_star F - 1 / s0) < 1 / t" "0 < s0"
using eventually_happens'[OF trivial_limit_at_top_linorder] by blast
define z where "z = x_star F - 1 / s0"
have Fz: "1 - 1 / t < F z"
using s0 by (simp add: z_def)
have p_bounds: "0 < 1 - 1 / t" "1 - 1 / t < 1"
using t1 by simp_all
have "tail_quantile F t ≤ z"
using ginv_le_iff[OF p_bounds, of z] Fz by simp
also have "z < x_star F"
using s0(2) by (simp add: z_def)
finally show ?thesis .
qed
have main: "⋀M. 0 < M ⟹ ∀⇩F t in at_top. M ≤ 1 / (x_star F - tail_quantile F t)"
proof -
fix M :: real
assume Mpos: "0 < M"
define z0 where "z0 = x_star F - 1 / M"
have z0lt1: "F z0 < 1"
using regularly_varying_pos[OF rv, of M] Mpos by (simp add: z0_def)
show "∀⇩F t in at_top. M ≤ 1 / (x_star F - tail_quantile F t)"
using eventually_gt_at_top[of "1 / (1 - F z0)"] eventually_gt_at_top[of "1::real"]
proof eventually_elim
case (elim t)
hence t1: "1 < t" and t2: "1 / (1 - F z0) < t"
by auto
have p_bounds: "0 < 1 - 1 / t" "1 - 1 / t < 1"
using t1 by simp_all
have "F z0 < 1 - 1 / t"
using t1 t2 z0lt1 by (simp add: field_simps)
hence zlt: "z0 < tail_quantile F t"
using ginv_le_iff[OF p_bounds, of z0] by linarith
have lt: "x_star F - tail_quantile F t < 1 / M"
using zlt by (simp add: z0_def)
show ?case
using Ult[OF t1] lt Mpos by (simp add: field_simps)
qed
qed
show ?thesis
unfolding filterlim_at_top
proof
fix M :: real
show "∀⇩F t in at_top. M ≤ 1 / (x_star F - tail_quantile F t)"
using main[of "max M 1"] eventually_mono
by(cases "M ≤ 1") fastforce+
qed
qed
lemma tail_quantile_diff_scale_ratio:
fixes U a :: "real ⇒ real" and γ :: real
assumes apos: "⋀t. 0 < a t"
and gamma: "γ ≠ 0"
and quant: "⋀x. 0 < x ⟹
((λt. (U (t * x) - U t) / a t) ⤏ (x powr γ - 1) / γ) at_top"
and y: "0 < y"
shows "((λt. a (t * y) / a t) ⤏ y powr γ) at_top"
proof -
define D where "D = (λx::real. (x powr γ - 1) / γ)"
have quant': "⋀x. 0 < x ⟹ ((λt. (U (t * x) - U t) / a t) ⤏ D x) at_top"
using quant by (simp add: D_def)
have D2_ne: "D 2 ≠ 0"
using gamma by(simp add: D_def)
have R2y: "((λt. (U (t * (y * 2)) - U t) / a t) ⤏ D (y * 2)) at_top"
using quant'[of "y * 2"] y by simp
have Ry: "((λt. (U (t * y) - U t) / a t) ⤏ D y) at_top"
using quant'[of y] y by simp
have Rty2: "((λt. (U (t * y * 2) - U (t * y)) / a (t * y)) ⤏ D 2) at_top"
using filterlim_compose[OF quant'[of 2]
filterlim_tendsto_pos_mult_at_top[OF tendsto_const y filterlim_ident]]
by (simp add: mult.commute)
have eq1: "(U (t * (y * 2)) - U t) / a t - (U (t * y) - U t) / a t
= (U (t * y * 2) - U (t * y)) / a t" for t
by (simp add: mult.assoc diff_divide_distrib)
have main: "((λt. (U (t * y * 2) - U (t * y)) / a t) ⤏ D (y * 2) - D y) at_top"
using tendsto_diff[OF R2y Ry] unfolding eq1 .
note ev_ne = tendsto_imp_eventually_ne[OF Rty2 D2_ne]
have ratio_eq: "∀⇩F t in at_top.
((U (t * y * 2) - U (t * y)) / a t) / ((U (t * y * 2) - U (t * y)) / a (t * y))
= a (t * y) / a t"
using apos by(auto intro!: eventually_mono[OF ev_ne])
have ratio_tendsto: "((λt.
((U (t * y * 2) - U (t * y)) / a t) / ((U (t * y * 2) - U (t * y)) / a (t * y)))
⤏ (D (y * 2) - D y) / D 2) at_top"
by (intro tendsto_divide main Rty2 D2_ne)
have final: "((λt. a (t * y) / a t) ⤏ (D (y * 2) - D y) / D 2) at_top"
using Lim_transform_eventually[OF ratio_tendsto ratio_eq] .
have value_eq: "(D (y * 2) - D y) / D 2 = y powr γ"
using gamma y D2_ne by (simp add: D_def powr_mult field_simps)
show "((λt. a (t * y) / a t) ⤏ y powr γ) at_top"
using final value_eq by simp
qed
lemma tail_quantile_cont_ratio:
fixes F :: "real ⇒ real" and γ :: real and a :: "real ⇒ real"
assumes apos: "⋀t. 0 < a t"
and gamma: "γ ≠ 0"
and quant: "⋀x. 0 < x ⟹
((λt. (tail_quantile F (t * x) - tail_quantile F t) / a t)
⤏ (x powr γ - 1) / γ) at_top"
and Z: "1 < Z"
shows "((λt. (tail_quantile F (t * Z * Z) - tail_quantile F (t * Z))
/ (tail_quantile F (t * Z) - tail_quantile F t)) ⤏ Z powr γ) at_top"
proof -
define D where "D = (λx::real. (x powr γ - 1) / γ)"
have Zpos: "0 < Z"
using Z by simp
have quant': "⋀x. 0 < x ⟹
((λt. (tail_quantile F (t * x) - tail_quantile F t) / a t) ⤏ D x) at_top"
using quant by (simp add: D_def)
from tail_quantile_diff_scale_ratio[OF apos gamma quant]
have a_rv: "⋀y. 0 < y ⟹ ((λt. a (t * y) / a t) ⤏ y powr γ) at_top" .
have DZ_ne: "D Z ≠ 0"
using gamma Z by(auto simp: D_def)
have f_lim: "((λt. (tail_quantile F (t * Z) - tail_quantile F t) / a t) ⤏ D Z) at_top"
using quant'[of Z] Z by simp
have g_lim: "((λt. a (t * Z) / a t) ⤏ Z powr γ) at_top"
using a_rv[of Z] Z by simp
have h_lim: "((λt. (tail_quantile F (t * Z * Z)
- tail_quantile F (t * Z)) / a (t * Z)) ⤏ D Z) at_top"
using filterlim_compose[OF f_lim filterlim_tendsto_pos_mult_at_top
[OF tendsto_const Zpos filterlim_ident]]
by(simp add: mult.commute)
have ev_ne: "∀⇩F t in at_top. (tail_quantile F (t * Z) - tail_quantile F t) / a t ≠ 0"
by (intro tendsto_imp_eventually_ne[where c="D Z"] f_lim DZ_ne)
have ratio_eq: "∀⇩F t in at_top. (a (t * Z) / a t) *
(((tail_quantile F (t * Z * Z) - tail_quantile F (t * Z)) / a (t * Z))
/ ((tail_quantile F (t * Z) - tail_quantile F t) / a t))
= (tail_quantile F (t * Z * Z) - tail_quantile F (t * Z))
/ (tail_quantile F (t * Z) - tail_quantile F t)"
using apos by(intro eventually_mono[OF ev_ne])
(smt (verit) Groups.mult_ac(3) divide_divide_eq_left field_class.field_divide_inverse
nonzero_mult_divide_mult_cancel_left2
times_divide_eq_right zero_less_divide_iff)
have ratio_tendsto: "((λt.
(a (t * Z) / a t) *
(((tail_quantile F (t * Z * Z) - tail_quantile F (t * Z)) / a (t * Z))
/ ((tail_quantile F (t * Z) - tail_quantile F t) / a t))) ⤏ Z powr γ) at_top"
using tendsto_mult[OF g_lim] tendsto_divide[OF h_lim f_lim DZ_ne] DZ_ne
by fastforce
show ?thesis
using Lim_transform_eventually[OF ratio_tendsto ratio_eq] .
qed
lemma tail_quantile_diff_geometric_seq:
fixes F :: "real ⇒ real" and γ Z t0 :: real and a :: "real ⇒ real"
assumes apos: "⋀t. 0 < a t"
and gamma: "γ ≠ 0"
and quant: "⋀x. 0 < x ⟹
((λt. (tail_quantile F (t * x) - tail_quantile F t) / a t)
⤏ (x powr γ - 1) / γ) at_top"
and Z: "1 < Z" and t0: "0 < t0"
obtains N where
"⋀k. tail_quantile F (t0 * Z ^ (N + k)) < tail_quantile F (t0 * Z ^ Suc (N + k))"
and "(λk. (tail_quantile F (t0 * Z ^ Suc (N + Suc k))
- tail_quantile F (t0 * Z ^ (N + Suc k)))
/ (tail_quantile F (t0 * Z ^ Suc (N + k)) - tail_quantile F (t0 * Z ^ (N + k))))
⇢ Z powr γ"
proof -
define D where "D = (λx::real. (x powr γ - 1) / γ)"
have DZ_pos: "0 < D Z"
proof (cases "0 < γ")
case True
show ?thesis
using powr_less_mono2[OF True zero_le_one Z] True by (simp add: D_def)
next
case False
hence neg: "γ < 0"
using gamma by simp
show ?thesis
using powr_less_mono[OF neg, of Z] Z neg by (simp add: D_def divide_neg_neg)
qed
have seq_top: "filterlim (λn. t0 * Z ^ n) at_top sequentially"
using filterlim_tendsto_pos_mult_at_top[OF tendsto_const[of t0] t0
LIMSEQ_power_at_top[OF Z]] .
have f_lim: "((λt. (tail_quantile F (t * Z) - tail_quantile F t) / a t) ⤏ D Z) at_top"
using quant[of Z] Z by (simp add: D_def)
define Δ where "Δ = (λn. tail_quantile F (t0 * Z ^ Suc n) - tail_quantile F (t0 * Z ^ n))"
have Δ_ratio: "(λn. Δ (Suc n) / Δ n) ⇢ Z powr γ"
using filterlim_compose[OF tail_quantile_cont_ratio[OF apos gamma quant Z] seq_top]
by (simp add: algebra_simps Δ_def)
have Δ_over_a: "(λn. Δ n / a (t0 * Z ^ n)) ⇢ D Z"
using filterlim_compose[OF f_lim seq_top] by (simp add: algebra_simps Δ_def)
obtain N where N: "⋀n. N ≤ n ⟹ 0 < Δ n"
using order_tendstoD(1)[OF Δ_over_a DZ_pos] apos
unfolding eventually_sequentially by (auto simp: pos_less_divide_eq)
show thesis
proof (rule that)
show "tail_quantile F (t0 * Z ^ (N + k)) < tail_quantile F (t0 * Z ^ Suc (N + k))" for k
using N[of "N + k"] by (simp add: Δ_def)
show "(λk. (tail_quantile F (t0 * Z ^ Suc (N + Suc k))
- tail_quantile F (t0 * Z ^ (N + Suc k)))
/ (tail_quantile F (t0 * Z ^ Suc (N + k)) - tail_quantile F (t0 * Z ^ (N + k))))
⇢ Z powr γ"
using LIMSEQ_ignore_initial_segment[OF Δ_ratio, of N]
by (simp add: Δ_def add.commute)
qed
qed
lemma tail_quantile_neg_gap_power_ratio:
fixes F :: "real ⇒ real" and γ :: real and a :: "real ⇒ real"
assumes F: "right_continuous_mono F 0 1"
and apos: "⋀t. 0 < a t"
and gamma: "γ < 0"
and quant: "⋀x. 0 < x ⟹
((λt. (tail_quantile F (t * x) - tail_quantile F t) / a t)
⤏ (x powr γ - 1) / γ) at_top"
and Uconv: "(tail_quantile F ⤏ x_star F) at_top"
and Z: "1 < Z" and t0: "0 < t0"
shows "(λn. (x_star F - tail_quantile F (t0 * Z ^ Suc n))
/ (x_star F - tail_quantile F (t0 * Z ^ n))) ⇢ Z powr γ"
proof -
have gamma_ne: "γ ≠ 0"
using gamma by simp
have Zg_bounds: "0 < Z powr γ" "Z powr γ < 1"
using powr_less_mono[OF gamma, of Z] Z by simp_all
obtain N where
N_pos: "⋀k. tail_quantile F (t0 * Z ^ (N + k)) < tail_quantile F (t0 * Z ^ Suc (N + k))"
and N_ratio: "(λk. (tail_quantile F (t0 * Z ^ Suc (N + Suc k))
- tail_quantile F (t0 * Z ^ (N + Suc k)))
/ (tail_quantile F (t0 * Z ^ Suc (N + k))
- tail_quantile F (t0 * Z ^ (N + k)))) ⇢ Z powr γ"
using tail_quantile_diff_geometric_seq[OF apos gamma_ne quant Z t0] by blast
define d where "d = (λk. tail_quantile F (t0 * Z ^ Suc (N + k))
- tail_quantile F (t0 * Z ^ (N + k)))"
have d_pos: "0 < d k" for k
using N_pos by (simp add: d_def)
have d_eq: "d k = tail_quantile F (t0 * Z ^ Suc (N + k)) - tail_quantile F (t0 * Z ^ (N + k))"
for k
by (simp add: d_def)
have d_ratio: "(λk. d (Suc k) / d k) ⇢ Z powr γ"
using N_ratio by (simp add: d_def)
note d_summable = geometric_ratio_tailsum_summable[OF d_pos Zg_bounds d_ratio]
have d_sum_eq: "(∑k<n. d k)
= tail_quantile F (t0 * Z ^ (N + n)) - tail_quantile F (t0 * Z ^ N)" for n
by (induction n) (auto simp: d_eq)
have shift_at_top: "filterlim (λn::nat. N + n) at_top sequentially"
by (simp add: Groups.add_ac(2) filterlim_add_const_nat_at_top)
have Ns_top: "filterlim (λn. t0 * Z ^ (N + n)) at_top sequentially"
using filterlim_compose[OF filterlim_tendsto_pos_mult_at_top
[OF tendsto_const[of t0] t0 LIMSEQ_power_at_top[OF Z]] shift_at_top] .
have U_Ns_tendsto: "(λn. tail_quantile F (t0 * Z ^ (N + n))) ⇢ x_star F"
using filterlim_compose[OF Uconv Ns_top] .
have x_star_eq: "x_star F = tail_quantile F (t0 * Z ^ N) + suminf d"
proof -
have lim1: "(λn. tail_quantile F (t0 * Z ^ N) + (∑k<n. d k)) ⇢ x_star F"
using U_Ns_tendsto by (simp add: d_sum_eq)
have lim2: "(λn. tail_quantile F (t0 * Z ^ N) + (∑k<n. d k))
⇢ tail_quantile F (t0 * Z ^ N) + suminf d"
by (intro tendsto_add[OF tendsto_const] summable_LIMSEQ[OF d_summable])
show ?thesis
using LIMSEQ_unique[OF lim1 lim2] by simp
qed
have gap_eq: "x_star F - tail_quantile F (t0 * Z ^ (N + n)) = (∑k. d (k + n))" for n
proof -
have "x_star F - tail_quantile F (t0 * Z ^ (N + n)) = suminf d - (∑k<n. d k)"
using x_star_eq d_sum_eq[of n] by simp
also have "… = (∑k. d (k + n))"
using suminf_minus_initial_segment[OF d_summable, of n] by simp
finally show ?thesis .
qed
note tailsum_ratio = geometric_ratio_tailsum_ratio[OF d_pos Zg_bounds d_ratio]
have eq_fun: "⋀n. (x_star F - tail_quantile F (t0 * Z ^ (N + Suc n)))
/ (x_star F - tail_quantile F (t0 * Z ^ (N + n)))
= (∑k. d (k + Suc n)) / (∑k. d (k + n))"
proof -
fix n
have e1: "x_star F - tail_quantile F (t0 * Z ^ (N + Suc n)) = (∑k. d (k + Suc n))"
using gap_eq[of "Suc n"] .
have e2: "x_star F - tail_quantile F (t0 * Z ^ (N + n)) = (∑k. d (k + n))"
using gap_eq[of n] .
show "(x_star F - tail_quantile F (t0 * Z ^ (N + Suc n)))
/ (x_star F - tail_quantile F (t0 * Z ^ (N + n)))
= (∑k. d (k + Suc n)) / (∑k. d (k + n))"
unfolding e1 e2 ..
qed
have gap_ratio_shifted: "(λn. (x_star F - tail_quantile F (t0 * Z ^ (N + Suc n)))
/ (x_star F - tail_quantile F (t0 * Z ^ (N + n)))) ⇢ Z powr γ"
using tailsum_ratio unfolding eq_fun .
have gap_ratio_shifted': "(λn. (x_star F - tail_quantile F (t0 * Z ^ Suc (n + N)))
/ (x_star F - tail_quantile F (t0 * Z ^ (n + N)))) ⇢ Z powr γ"
using gap_ratio_shifted by (simp add: add.commute)
show ?thesis
using gap_ratio_shifted' by (rule LIMSEQ_offset)
qed
lemma tail_quantile_neg_gap_ratio_of_power_ratio:
fixes F :: "real ⇒ real" and γ :: real
assumes F: "right_continuous_mono F 0 1" and gamma: "γ < 0"
and gap_pos: "⋀t. 1 < t ⟹ 0 < x_star F - tail_quantile F t"
and gap_power_ratio: "⋀Z t0. 1 < Z ⟹ 0 < t0 ⟹
(λn. (x_star F - tail_quantile F (t0 * Z ^ Suc n))
/ (x_star F - tail_quantile F (t0 * Z ^ n))) ⇢ Z powr γ"
shows "⋀y. 0 < y ⟹
((λt. (x_star F - tail_quantile F (t * y)) / (x_star F - tail_quantile F t))
⤏ y powr γ) at_top"
proof -
define W where "W = (λt. 1 / (x_star F - tail_quantile F t))"
have Wmono: "W s ≤ W t" if s: "1 < s" and st: "s ≤ t" for s t
using gap_pos[OF s] gap_pos[OF order.strict_trans2[OF s st]]
tail_quantile_mono[OF F s st]
by(auto simp: W_def intro!: divide_left_mono)
have Wpos: "0 < W t" if t: "1 < t" for t
using gap_pos[OF t] by (simp add: W_def)
have Wpos_ev: "∀⇩F t in at_top. 0 < W t"
by(intro eventually_mono[OF eventually_gt_at_top[of "1::real"]] Wpos)
have Wratio: "(λn. W (t0 * Z ^ Suc n) / W (t0 * Z ^ n)) ⇢ Z powr (- γ)"
if Z: "1 < Z" and t0: "0 < t0" for Z t0 :: real
using tendsto_inverse[OF gap_power_ratio[OF Z t0]] Z
by(simp add: W_def powr_minus)
fix y :: real
assume y: "0 < y"
have main: "((λt. W (t * y) / W t) ⤏ y powr (- γ)) at_top"
using Wratio y gamma
by(intro monotone_geometric_ratio_imp_ratio[OF Wmono Wpos_ev]) auto
have eq: "(λt. inverse (W (t * y) / W t))
= (λt. (x_star F - tail_quantile F (t * y)) / (x_star F - tail_quantile F t))"
by(simp add: W_def)
show "((λt. (x_star F - tail_quantile F (t * y)) / (x_star F - tail_quantile F t))
⤏ y powr γ) at_top"
using tendsto_inverse[OF main] y
unfolding eq by (simp add: powr_minus)
qed
lemma tail_quantile_neg_regularly_varying:
fixes F :: "real ⇒ real" and γ :: real and a :: "real ⇒ real"
assumes F: "right_continuous_mono F 0 1"
and apos: "⋀t. 0 < a t"
and gamma: "γ < 0"
and quant: "⋀x. 0 < x ⟹
((λt. (tail_quantile F (t * x) - tail_quantile F t) / a t) ⤏ (x powr γ - 1) / γ) at_top"
shows tail_quantile_neg_bdd: "bdd_support F"
and tail_quantile_neg_tendsto: "(tail_quantile F ⤏ x_star F) at_top"
and tail_quantile_neg_ratio: "⋀y. 0 < y ⟹
((λt. (x_star F - tail_quantile F (t * y)) / (x_star F - tail_quantile F t))
⤏ y powr γ) at_top"
proof -
interpret right_continuous_mono F 0 1
by fact
have gamma_ne0: "γ ≠ 0"
using gamma by simp
have cont_ratio2: "((λt. (tail_quantile F (t * 2 * 2) - tail_quantile F (t * 2))
/ (tail_quantile F (t * 2) - tail_quantile F t)) ⤏ 2 powr γ) at_top"
using tail_quantile_cont_ratio[OF apos gamma_ne0 quant, of 2] by simp
have Zn_at_top: "filterlim (λn::nat. (2::real) ^ n) at_top sequentially"
using LIMSEQ_power_at_top[of 2] by simp
have D2_pos: "0 < (2 powr γ - 1) / γ"
using powr_less_mono[OF gamma, of 2]
by(auto intro!: divide_neg_neg gamma)
define Δ where "Δ = (λn. tail_quantile F (2 ^ Suc n) - tail_quantile F (2 ^ n))"
have Δ_ratio: "(λn. Δ (Suc n) / Δ n) ⇢ 2 powr γ"
proof -
have step: "(λn. (tail_quantile F (2 ^ n * 2 * 2) - tail_quantile F (2 ^ n * 2))
/ (tail_quantile F (2 ^ n * 2) - tail_quantile F (2 ^ n)))
⇢ 2 powr γ"
using filterlim_compose[OF cont_ratio2 Zn_at_top] .
have eq: "(tail_quantile F (2 ^ n * 2 * 2) - tail_quantile F (2 ^ n * 2))
/ (tail_quantile F (2 ^ n * 2) - tail_quantile F (2 ^ n))
= Δ (Suc n) / Δ n" for n
by (simp add: Δ_def algebra_simps)
show ?thesis
using step unfolding eq .
qed
have Δ_over_a: "(λn. Δ n / a (2 ^ n)) ⇢ (2 powr γ - 1) / γ"
proof -
have "((λt. (tail_quantile F (t * 2) - tail_quantile F t) / a t)
⤏ (2 powr γ - 1) / γ) at_top"
using quant[of 2] by simp
from filterlim_compose[OF this Zn_at_top]
show ?thesis
by (simp add: Δ_def mult.commute)
qed
have ev_Δ_pos: "∀⇩F n in sequentially. 0 < Δ n"
proof -
have "∀⇩F n in sequentially. 0 < Δ n / a (2 ^ n)"
using order_tendstoD(1)[OF Δ_over_a D2_pos] by simp
thus ?thesis
proof eventually_elim
case (elim n)
thus ?case
using apos[of "2 ^ n"] by (simp add: zero_less_divide_iff)
qed
qed
obtain N where N: "⋀n. N ≤ n ⟹ 0 < Δ n"
using ev_Δ_pos unfolding eventually_sequentially by blast
define d where "d = (λk. Δ (N + k))"
have d_pos: "0 < d k" for k
using N by (simp add: d_def)
have d_ratio: "(λk. d (Suc k) / d k) ⇢ 2 powr γ"
using LIMSEQ_ignore_initial_segment[OF Δ_ratio, of N]
by(simp add: d_def add.commute)
have L_bounds: "0 < 2 powr γ" "2 powr γ < 1"
using powr_less_mono[OF gamma, of 2] by simp_all
note d_summable = geometric_ratio_tailsum_summable[OF d_pos L_bounds d_ratio]
have d_sum_eq: "(∑k<n. d k) = tail_quantile F (2 ^ (N + n)) - tail_quantile F (2 ^ N)" for n
proof (induction n)
case (Suc n)
have "(∑k<Suc n. d k) = (∑k<n. d k) + d n"
by simp
also have "… = (tail_quantile F (2 ^ (N + n)) - tail_quantile F (2 ^ N)) + d n"
using Suc.IH by simp
also have "… = tail_quantile F (2 ^ (N + Suc n)) - tail_quantile F (2 ^ N)"
by (simp add: d_def Δ_def)
finally show ?case .
qed simp
have partial_le: "(∑k<n. d k) ≤ suminf d" for n
by(intro sum_le_suminf[OF d_summable finite_lessThan] less_imp_le[OF d_pos])
define B where "B = tail_quantile F (2 ^ N) + suminf d"
have U_2pow_le: "tail_quantile F (2 ^ (N + n)) ≤ B" for n
using partial_le[of n] unfolding d_sum_eq[of n] B_def by simp
have U_le_B: "tail_quantile F t ≤ B" if t1: "1 < t" for t
proof -
obtain n where n: "t ≤ 2 ^ (N + n)"
proof -
obtain N0 where N0: "∀k≥N0. t ≤ 2 ^ k"
using Zn_at_top unfolding filterlim_at_top eventually_sequentially by blast
have "N0 ≤ N + N0"
by simp
hence "t ≤ 2 ^ (N + N0)"
using N0 by simp
thus thesis
using that by blast
qed
have "tail_quantile F t ≤ tail_quantile F (2 ^ (N + n))"
using t1 n by (intro tail_quantile_mono[OF F]) auto
also have "… ≤ B"
by (rule U_2pow_le)
finally show ?thesis .
qed
show bdd: "bdd_support F"
proof (rule ccontr)
assume nbdd: "¬ bdd_support F"
note unbdd = F_lt_1_unbdd_support[OF F nbdd]
note U_at_top = tail_quantile_at_top[OF F unbdd]
obtain t where t: "1 < t" "B < tail_quantile F t"
proof -
have "∀⇩F t in at_top. B + 1 ≤ tail_quantile F t ∧ 1 < t"
using eventually_conj[OF U_at_top[unfolded filterlim_at_top, rule_format, of "B + 1"]
eventually_gt_at_top[of "1::real"]] .
then obtain t0 where t0: "B + 1 ≤ tail_quantile F t0" "1 < t0"
using eventually_happens'[OF trivial_limit_at_top_linorder] by blast
show thesis
using that[of t0] t0 by simp
qed
show False
using U_le_B[OF t(1)] t(2) by simp
qed
note Fxstar = F_x_star_eq_1[OF F bdd]
have U_le_xstar: "tail_quantile F t ≤ x_star F" if t1: "1 < t" for t
using t1 Fxstar by (simp add: field_simps ginv_le_iff)
show tendsto_goal: "(tail_quantile F ⤏ x_star F) at_top"
by (rule tail_quantile_tendsto_x_star[OF F bdd])
have gap_pos: "0 < x_star F - tail_quantile F t" if t1: "1 < t" for t
proof (rule ccontr)
assume "¬ 0 < x_star F - tail_quantile F t"
hence eq: "tail_quantile F t = x_star F"
using U_le_xstar[OF t1] by simp
have const: "tail_quantile F s = x_star F" if s1: "t ≤ s" for s
proof (rule antisym)
show "tail_quantile F s ≤ x_star F"
using U_le_xstar[of s] t1 s1 by simp
have "tail_quantile F t ≤ tail_quantile F s"
using tail_quantile_mono[OF F t1 s1] .
thus "x_star F ≤ tail_quantile F s"
using eq by simp
qed
have ev0: "∀⇩F s in at_top. (tail_quantile F (s * 2) - tail_quantile F s) / a s = 0"
using const t1 by (auto intro!: eventually_mono[OF eventually_ge_at_top[of t]])
have ev0': "∀⇩F s in at_top. 0 = (tail_quantile F (s * 2) - tail_quantile F s) / a s"
using ev0 by eventually_elim simp
have ratio_to_0: "((λs. (tail_quantile F (s * 2) - tail_quantile F s) / a s) ⤏ 0) at_top"
using Lim_transform_eventually[OF tendsto_const ev0'] .
have ratio_to_D2: "((λs. (tail_quantile F (s * 2) - tail_quantile F s) / a s)
⤏ (2 powr γ - 1) / γ) at_top"
using quant[of 2] by simp
have "(2 powr γ - 1) / γ = 0"
using tendsto_unique[OF trivial_limit_at_top_linorder ratio_to_D2 ratio_to_0] .
thus False
using D2_pos by simp
qed
have gap_power_ratio: "⋀Z t0. 1 < Z ⟹ 0 < t0 ⟹
(λn. (x_star F - tail_quantile F (t0 * Z ^ Suc n))
/ (x_star F - tail_quantile F (t0 * Z ^ n)))
⇢ Z powr γ"
using tail_quantile_neg_gap_power_ratio[OF F apos gamma quant tendsto_goal] .
show "⋀y. 0 < y ⟹
((λt. (x_star F - tail_quantile F (t * y)) / (x_star F - tail_quantile F t))
⤏ y powr γ) at_top"
using tail_quantile_neg_gap_ratio_of_power_ratio[OF F gamma gap_pos gap_power_ratio] .
qed
lemma tail_quantile_gap_ratio_neg_imp_tail_regularly_varying:
fixes F :: "real ⇒ real" and γ :: real
assumes F: "right_continuous_mono F 0 1" and gamma: "γ < 0"
and bdd: "bdd_support F"
and gap_rv: "⋀y. 0 < y ⟹
((λt. (x_star F - tail_quantile F (t * y)) / (x_star F - tail_quantile F t))
⤏ y powr γ) at_top"
shows "regularly_varying (λs. 1 - F (x_star F - 1 / s)) (1 / γ)"
proof -
interpret right_continuous_mono F 0 1
by fact
have phi_pos: "0 < 1 - F (x_star F - 1 / s)" if s: "0 < s" for s
using s lt_x_star_iff_F_lt_1[OF F bdd, THEN iffD1] by fastforce
note Fxstar = F_x_star_eq_1[OF F bdd]
have U_le_xstar: "tail_quantile F t ≤ x_star F" if t1: "1 < t" for t
using t1 Fxstar by (simp add: field_simps ginv_le_iff)
note Utend = tail_quantile_tendsto_x_star[OF F bdd]
have gap_pos: "0 < x_star F - tail_quantile F t" if t1: "1 < t" for t
proof (rule ccontr)
assume "¬ 0 < x_star F - tail_quantile F t"
hence eq: "tail_quantile F t = x_star F"
using U_le_xstar[OF t1] by simp
have const: "tail_quantile F u = x_star F" if u1: "t ≤ u" for u
proof (rule antisym)
show "tail_quantile F u ≤ x_star F"
using U_le_xstar[of u] t1 u1 by simp
have "tail_quantile F t ≤ tail_quantile F u"
using tail_quantile_mono[OF F t1 u1] .
thus "x_star F ≤ tail_quantile F u"
using eq by simp
qed
have ev0: "∀⇩F u in at_top.
(x_star F - tail_quantile F (u * 2)) / (x_star F - tail_quantile F u) = 0"
using const t1 by (auto intro!: eventually_mono[OF eventually_ge_at_top[of t]])
have ev0': "∀⇩F u in at_top. (0::real)
= (x_star F - tail_quantile F (u * 2)) / (x_star F - tail_quantile F u)"
using ev0 by eventually_elim simp
have ratio_to_0: "((λu.
(x_star F - tail_quantile F (u * 2)) / (x_star F - tail_quantile F u)) ⤏ 0) at_top"
using Lim_transform_eventually[OF tendsto_const ev0'] .
have ratio_to_2g: "((λu.
(x_star F - tail_quantile F (u * 2)) / (x_star F - tail_quantile F u))
⤏ 2 powr γ) at_top"
using gap_rv[of 2] by simp
have "2 powr γ = 0"
using tendsto_unique[OF trivial_limit_at_top_linorder ratio_to_2g ratio_to_0] .
thus False
by simp
qed
define W where "W = (λt::real. 1 / (x_star F - tail_quantile F t))"
define s where "s = (λw::real. 1 / (1 - F (x_star F - 1 / w)))"
have galois: "W t ≤ w ⟷ t ≤ s w" if t1: "1 < t" for t w
proof (cases "0 < w")
case True
note gpos = gap_pos[OF t1]
note phipos = phi_pos[OF True]
have p_bounds: "0 < 1 - 1 / t" "1 - 1 / t < 1"
using t1 by simp_all
have "W t ≤ w ⟷ tail_quantile F t ≤ x_star F - 1 / w"
unfolding W_def using gpos True by (simp add: field_simps)
also have "... ⟷ 1 - 1 / t ≤ F (x_star F - 1 / w)"
using ginv_le_iff[OF p_bounds, of "x_star F - 1 / w"] by simp
also have "... ⟷ t ≤ s w"
using phipos True t1 by (simp add: s_def field_simps)
finally show ?thesis .
next
case False
have "¬ (W t ≤ w)"
proof -
note gpos = gap_pos[OF t1]
hence "0 < W t"
unfolding W_def by simp
thus ?thesis
using False by linarith
qed
moreover have "¬ (t ≤ s w)"
proof -
have wle0: "w < 0 ∨ w = 0"
using False by linarith
have "1 / w ≤ 0"
using wle0 by (auto simp: divide_le_0_iff)
hence "x_star F ≤ x_star F - 1 / w"
by simp
hence "F (x_star F) ≤ F (x_star F - 1 / w)"
by (rule monoD[OF mono])
hence "F (x_star F - 1 / w) = 1"
using Fxstar right_continuous_mono.f_le_b[OF F, of "x_star F - 1 / w"] by simp
hence "s w = 0"
unfolding s_def by simp
thus ?thesis
using t1 by simp
qed
ultimately show ?thesis
by simp
qed
have Wtop: "filterlim W at_top at_top"
proof -
have gap_tend0: "((λt. x_star F - tail_quantile F t) ⤏ 0) at_top"
using tendsto_diff[OF tendsto_const[of "x_star F"] Utend] by simp
have gap_pos_ev: "∀⇩F t in at_top. 0 < x_star F - tail_quantile F t"
using eventually_gt_at_top[of "1::real"] by eventually_elim (rule gap_pos)
show ?thesis
unfolding W_def
using filterlim_inverse_at_top[OF gap_tend0 gap_pos_ev] by (simp add: inverse_eq_divide)
qed
have s_top: "filterlim s at_top at_top"
unfolding filterlim_at_top
proof
fix M :: real
define M' where "M' = max M 2"
have M'1: "1 < M'"
unfolding M'_def by simp
have WM'pos: "0 < W M'"
unfolding W_def using gap_pos[OF M'1] by simp
show "∀⇩F w in at_top. M ≤ s w"
using eventually_ge_at_top[of "W M'"]
by eventually_elim (use galois[OF M'1] in "simp add: M'_def")
qed
have Wrv: "((λt. W (t * y) / W t) ⤏ y powr (- γ)) at_top" if y: "0 < y" for y
proof -
have r1: "((λt. (x_star F - tail_quantile F (t * y)) / (x_star F - tail_quantile F t))
⤏ y powr γ) at_top"
using gap_rv[OF y] .
have ypow_ne: "y powr γ ≠ 0"
using y by simp
note r1inv = tendsto_inverse[OF r1 ypow_ne]
have ty_top: "filterlim (λt::real. t * y) at_top at_top"
using filterlim_tendsto_pos_mult_at_top[OF tendsto_const[of y] y filterlim_ident]
by(simp add: mult.commute)
have ev_ty: "∀⇩F t in at_top. 1 < t * y"
using ty_top[unfolded filterlim_at_top, rule_format, of 2] by eventually_elim simp
have eq: "∀⇩F t in at_top. inverse ((x_star F - tail_quantile F (t * y))
/ (x_star F - tail_quantile F t)) = W (t * y) / W t"
using eventually_gt_at_top[of 1] ev_ty
by eventually_elim (use gap_pos in "simp add: W_def field_simps")
have "((λt. W (t * y) / W t) ⤏ inverse (y powr γ)) at_top"
using Lim_transform_eventually[OF r1inv eq] .
thus ?thesis
by (simp add: powr_minus)
qed
have s_pos: "0 < s w" if w: "0 < w" for w
unfolding s_def using phi_pos[OF w] by simp
have s_ratio: "((λu. s (u * x) / s u) ⤏ x powr (- 1 / γ)) at_top"
if x: "0 < x" for x
using galois_inverse_ratio_tendsto[OF Wtop s_top s_pos galois _ Wrv x] gamma
by simp
have phi_ratio: "((λu. (1 - F (x_star F - 1 / (u * x))) / (1 - F (x_star F - 1 / u)))
⤏ x powr (1 / γ)) at_top" if x: "0 < x" for x
proof -
have same: "(λu. s (u * x) / s u)
= (λu. (1 - F (x_star F - 1 / u)) / (1 - F (x_star F - 1 / (u * x))))"
using phi_pos x by (auto simp: s_def)
have main: "((λu. (1 - F (x_star F - 1 / u)) / (1 - F (x_star F - 1 / (u * x))))
⤏ x powr (- 1 / γ)) at_top"
using s_ratio[OF x] unfolding same .
have xr_ne: "x powr (- 1 / γ) ≠ 0"
using x by simp
have inv: "((λu. inverse ((1 - F (x_star F - 1 / u)) / (1 - F (x_star F - 1 / (u * x)))))
⤏ inverse (x powr (- 1 / γ))) at_top"
by (intro tendsto_inverse main xr_ne)
have eq2: "(λu. inverse ((1 - F (x_star F - 1 / u)) / (1 - F (x_star F - 1 / (u * x)))))
= (λu. (1 - F (x_star F - 1 / (u * x))) / (1 - F (x_star F - 1 / u)))"
by simp
have lim: "((λu. (1 - F (x_star F - 1 / (u * x))) / (1 - F (x_star F - 1 / u)))
⤏ inverse (x powr (- 1 / γ))) at_top"
using inv unfolding eq2 .
have val_eq: "inverse (x powr (- 1 / γ)) = x powr (1 / γ)"
using x by (simp add: powr_minus)
show ?thesis
using lim unfolding val_eq .
qed
show ?thesis
proof (rule regularly_varyingI)
have Fmeas: "F ∈ borel_measurable borel"
using borel_measurable_mono[OF mono] .
have cont: "continuous_on {0<..} (λs::real. x_star F - 1 / s)"
by (intro continuous_intros) simp
have meas1: "(λs::real. x_star F - 1 / s) ∈ borel_measurable (restrict_space borel {0<..})"
using cont by (rule borel_measurable_continuous_on_restrict)
show "(λs. 1 - F (x_star F - 1 / s)) ∈ borel_measurable (restrict_space borel {0<..})"
using measurable_compose[OF meas1 Fmeas] by simp
qed(use phi_pos phi_ratio in auto)
qed
lemma tail_quantile_pos_power_ratio:
fixes F :: "real ⇒ real" and γ :: real and a :: "real ⇒ real"
assumes F: "right_continuous_mono F 0 1"
and apos: "⋀t. 0 < a t"
and gamma: "0 < γ"
and quant: "⋀x. 0 < x ⟹
((λt. (tail_quantile F (t * x) - tail_quantile F t) / a t)
⤏ (x powr γ - 1) / γ) at_top"
and Uinf: "filterlim (tail_quantile F) at_top at_top"
and Z: "1 < Z" and t0: "0 < t0"
shows "(λn. tail_quantile F (t0 * Z ^ Suc n) / tail_quantile F (t0 * Z ^ n))
⇢ Z powr γ"
proof -
have gamma_ne: "γ ≠ 0"
using gamma by simp
have Zg_gt1: "1 < Z powr γ"
using powr_less_mono2[OF gamma zero_le_one Z] by simp
have s_top: "filterlim (λn. t0 * Z ^ n) at_top sequentially"
using filterlim_tendsto_pos_mult_at_top[OF tendsto_const[of t0] t0
LIMSEQ_power_at_top[OF Z]] .
obtain N where
N_pos: "⋀k. tail_quantile F (t0 * Z ^ (N + k)) < tail_quantile F (t0 * Z ^ Suc (N + k))"
and N_ratio: "(λk. (tail_quantile F (t0 * Z ^ Suc (N + Suc k))
- tail_quantile F (t0 * Z ^ (N + Suc k)))
/ (tail_quantile F (t0 * Z ^ Suc (N + k))
- tail_quantile F (t0 * Z ^ (N + k)))) ⇢ Z powr γ"
using tail_quantile_diff_geometric_seq[OF apos gamma_ne quant Z t0] by blast
define d where "d = (λk. tail_quantile F (t0 * Z ^ Suc (N + k))
- tail_quantile F (t0 * Z ^ (N + k)))"
have d_pos: "0 < d k" for k
using N_pos by (simp add: d_def)
have d_eq: "d k = tail_quantile F (t0 * Z ^ Suc (N + k)) - tail_quantile F (t0 * Z ^ (N + k))"
for k
by (simp add: d_def)
have d_ratio: "(λk. d (Suc k) / d k) ⇢ Z powr γ"
using N_ratio by (simp add: d_def)
note d_sum_ratio = geometric_ratio_sum_ratio[OF d_pos Zg_gt1 d_ratio]
have d_sum_eq: "(∑j≤k. d j)
= tail_quantile F (t0 * Z ^ (N + Suc k)) - tail_quantile F (t0 * Z ^ N)" for k
by (induction k) (auto simp: d_eq)
define C where "C = tail_quantile F (t0 * Z ^ N)"
have PQ_ratio: "(λk. (tail_quantile F (t0 * Z ^ (N + Suc (Suc k))) - C)
/ (tail_quantile F (t0 * Z ^ (N + Suc k)) - C)) ⇢ Z powr γ"
proof -
have "(λk. (tail_quantile F (t0 * Z ^ (N + Suc k)) - tail_quantile F (t0 * Z ^ N)
+ d (Suc k))
/ (tail_quantile F (t0 * Z ^ (N + Suc k)) - tail_quantile F (t0 * Z ^ N)))
⇢ Z powr γ"
using d_sum_ratio by (simp add: d_sum_eq)
thus ?thesis
by (simp add: d_def C_def algebra_simps)
qed
have shift1_at_top: "filterlim (λk::nat. N + Suc k) at_top sequentially"
by (intro filterlim_subseq strict_monoI) simp
note P_seq_at_top = filterlim_compose[OF s_top shift1_at_top]
note P_at_top = filterlim_compose[OF Uinf P_seq_at_top]
note invP0 = tendsto_inverse_0_at_top[OF P_at_top]
have C_over_P: "(λk. C / tail_quantile F (t0 * Z ^ (N + Suc k))) ⇢ 0"
using tendsto_mult[OF tendsto_const[of C] invP0] by (simp add: divide_inverse)
have one_minus_C_over_P: "(λk. 1 - C / tail_quantile F (t0 * Z ^ (N + Suc k))) ⇢ 1"
using tendsto_diff[OF tendsto_const[of 1] C_over_P] by simp
have combo: "(λk. (tail_quantile F (t0 * Z ^ (N + Suc (Suc k))) - C)
/ (tail_quantile F (t0 * Z ^ (N + Suc k)) - C)
* (1 - C / tail_quantile F (t0 * Z ^ (N + Suc k)))
+ C / tail_quantile F (t0 * Z ^ (N + Suc k))) ⇢ Z powr γ"
using tendsto_add[OF tendsto_mult[OF PQ_ratio one_minus_C_over_P] C_over_P] by simp
have P_ge: "∀⇩F k in sequentially. ¦C¦ + 1 ≤ tail_quantile F (t0 * Z ^ (N + Suc k))"
using P_at_top[unfolded filterlim_at_top, rule_format, of "¦C¦ + 1"] by simp
have combo_eq: "∀⇩F k in sequentially. (tail_quantile F (t0 * Z ^ (N + Suc (Suc k))) - C)
/ (tail_quantile F (t0 * Z ^ (N + Suc k)) - C)
* (1 - C / tail_quantile F (t0 * Z ^ (N + Suc k)))
+ C / tail_quantile F (t0 * Z ^ (N + Suc k))
= tail_quantile F (t0 * Z ^ (N + Suc (Suc k)))
/ tail_quantile F (t0 * Z ^ (N + Suc k))"
using P_ge
proof eventually_elim
case (elim k)
have C_lt: "C < tail_quantile F (t0 * Z ^ (N + Suc k))"
using elim abs_ge_self[of C] by linarith
have P_pos: "0 < tail_quantile F (t0 * Z ^ (N + Suc k))"
using elim abs_ge_zero[of C] by linarith
have p_ne: "tail_quantile F (t0 * Z ^ (N + Suc k)) ≠ 0"
using P_pos by simp
have pc_ne: "tail_quantile F (t0 * Z ^ (N + Suc k)) - C ≠ 0"
using C_lt by simp
show ?case
using p_ne pc_ne by (simp add: field_simps)
qed
have shifted_target: "(λk. tail_quantile F (t0 * Z ^ (N + Suc (Suc k)))
/ tail_quantile F (t0 * Z ^ (N + Suc k))) ⇢ Z powr γ"
using Lim_transform_eventually[OF combo combo_eq] .
have offset_eq: "tail_quantile F (t0 * Z ^ Suc (k + (N + 1)))
/ tail_quantile F (t0 * Z ^ (k + (N + 1)))
= tail_quantile F (t0 * Z ^ (N + Suc (Suc k)))
/ tail_quantile F (t0 * Z ^ (N + Suc k))" for k
by (simp add: add.commute)
have offset_target: "(λk. tail_quantile F (t0 * Z ^ Suc (k + (N + 1)))
/ tail_quantile F (t0 * Z ^ (k + (N + 1)))) ⇢ Z powr γ"
unfolding offset_eq using shifted_target .
show ?thesis
using offset_target by (rule LIMSEQ_offset)
qed
lemma tail_quantile_pos_ratio_of_power_ratio:
fixes F :: "real ⇒ real" and γ :: real
assumes F: "right_continuous_mono F 0 1" and gamma: "0 < γ"
and Uinf: "filterlim (tail_quantile F) at_top at_top"
and power_ratio: "⋀Z t0. 1 < Z ⟹ 0 < t0 ⟹
(λn. tail_quantile F (t0 * Z ^ Suc n) / tail_quantile F (t0 * Z ^ n)) ⇢ Z powr γ"
shows "⋀y. 0 < y ⟹
((λt. tail_quantile F (t * y) / tail_quantile F t) ⤏ y powr γ) at_top"
proof -
have Upos: "∀⇩F t in at_top. 0 < tail_quantile F t"
using Uinf unfolding filterlim_at_top_dense by blast
fix y :: real
assume y: "0 < y"
show "((λt. tail_quantile F (t * y) / tail_quantile F t) ⤏ y powr γ) at_top"
using power_ratio y
by(intro monotone_geometric_ratio_imp_ratio[OF _ Upos gamma])
(auto intro: tail_quantile_mono[OF F])
qed
lemma tail_quantile_pos_regularly_varying:
fixes F :: "real ⇒ real" and γ :: real and a :: "real ⇒ real"
assumes F: "right_continuous_mono F 0 1"
and apos: "⋀t. 0 < a t"
and gamma: "0 < γ"
and quant: "⋀x. 0 < x ⟹
((λt. (tail_quantile F (t * x) - tail_quantile F t) / a t)
⤏ (x powr γ - 1) / γ) at_top"
shows tail_quantile_pos_at_top: "filterlim (tail_quantile F) at_top at_top"
and tail_quantile_pos_ratio: "⋀y. 0 < y ⟹
((λt. tail_quantile F (t * y) / tail_quantile F t) ⤏ y powr γ) at_top"
proof -
interpret right_continuous_mono F 0 1
by fact
have gamma_ne0: "γ ≠ 0"
using gamma by simp
have a_rv: "((λt. a (t * y) / a t) ⤏ y powr γ) at_top" if y: "0 < y" for y
by (rule tail_quantile_diff_scale_ratio[where U = "tail_quantile F",
OF apos gamma_ne0 quant y])
show U_at_top: "filterlim (tail_quantile F) at_top at_top"
proof -
have a_rv2: "((λt. a (t * 2) / a t) ⤏ 2 powr γ) at_top"
using a_rv[of 2] by simp
have quant2: "((λt. (tail_quantile F (t * 2) - tail_quantile F t) / a t)
⤏ (2 powr γ - 1) / γ) at_top"
using quant[of 2] by simp
define r0 :: real where "r0 = (1 + 2 powr γ) / 2"
have r0_bounds: "1 < r0" "r0 < 2 powr γ"
using gamma by (simp_all add: r0_def)
define c :: real where "c = ((2 powr γ - 1) / γ) / 2"
have c_pos: "0 < c"
using gamma by (simp add: c_def)
have c_lt_D2: "c < (2 powr γ - 1) / γ"
using gamma by(auto simp: c_def intro!: divide_strict_left_mono)
have a_ev: "∀⇩F t in at_top. r0 * a t < a (t * 2)"
using order_tendstoD(1)[OF a_rv2 r0_bounds(2)]
by eventually_elim (use apos in "simp add: field_simps")
have U_ev: "∀⇩F t in at_top. c * a t < tail_quantile F (t * 2) - tail_quantile F t"
using order_tendstoD(1)[OF quant2 c_lt_D2]
by eventually_elim (use apos in "simp add: field_simps")
obtain T1 where T1: "⋀t. T1 ≤ t ⟹ r0 * a t < a (t * 2)"
using a_ev unfolding eventually_at_top_linorder by blast
obtain T2 where T2: "⋀t. T2 ≤ t ⟹ c * a t < tail_quantile F (t * 2) - tail_quantile F t"
using U_ev unfolding eventually_at_top_linorder by blast
define T where "T = max T1 T2"
have T: "⋀t. T ≤ t ⟹ r0 * a t < a (t * 2)"
"⋀t. T ≤ t ⟹ c * a t < tail_quantile F (t * 2) - tail_quantile F t"
using T1 T2 by (auto simp: T_def)
define t0 :: real where "t0 = max T 2"
have t0_ge: "T ≤ t0" "2 ≤ t0"
by (simp_all add: t0_def)
define tn :: "nat ⇒ real" where "tn n = t0 * 2 ^ n" for n
have two_pow_ge1: "(1::real) ≤ 2 ^ n" for n
by simp
have t0_le_tn: "t0 ≤ tn n" for n
using two_pow_ge1[of n] t0_ge(2) by (simp add: tn_def mult_left_mono)
have tn_ge_T: "T ≤ tn n" for n
using t0_ge(1) t0_le_tn[of n] by simp
have tn_gt1: "1 < tn n" for n
using t0_ge(2) t0_le_tn[of n] by simp
have tn_Suc: "tn (Suc n) = tn n * 2" for n
by (simp add: tn_def)
have tn_mono: "m ≤ n ⟹ tn m ≤ tn n" for m n
using t0_ge(2) by (simp add: tn_def mult_left_mono power_increasing)
have a_grow: "r0 ^ n * a t0 ≤ a (tn n)" for n
proof (induction n)
case 0
show ?case
by (simp add: tn_def)
next
case (Suc n)
have "r0 * a (tn n) < a (tn n * 2)"
using T(1)[OF tn_ge_T[of n]] by simp
hence step: "r0 * a (tn n) < a (tn (Suc n))"
by (simp add: tn_Suc)
have "r0 ^ Suc n * a t0 = r0 * (r0 ^ n * a t0)"
by simp
also have "… ≤ r0 * a (tn n)"
using Suc.IH r0_bounds(1) by (intro mult_left_mono) auto
also have "… < a (tn (Suc n))"
by (rule step)
finally show ?case
by simp
qed
note r0n_at_top = LIMSEQ_power_at_top[OF r0_bounds(1)]
have a_tn_at_top: "filterlim (λn. a (tn n)) at_top sequentially"
proof (rule filterlim_at_top_mono)
from filterlim_tendsto_pos_mult_at_top[OF tendsto_const apos[of t0] r0n_at_top]
have "filterlim (λn. a t0 * r0 ^ n) at_top sequentially" .
thus "filterlim (λn. r0 ^ n * a t0) at_top sequentially"
by (simp add: mult.commute)
show "∀⇩F n in sequentially. r0 ^ n * a t0 ≤ a (tn n)"
using a_grow by (intro always_eventually) simp
qed
have U_mono_seq: "m ≤ n ⟹ tail_quantile F (tn m) ≤ tail_quantile F (tn n)" for m n
using tn_gt1[of m] tn_mono[of m n]
by (intro tail_quantile_mono[OF ‹right_continuous_mono F 0 1›]) auto
have not_bdd: "¬ bdd_above (range (λn. tail_quantile F (tn n)))"
proof
assume bdd: "bdd_above (range (λn. tail_quantile F (tn n)))"
have incseq: "incseq (λn. tail_quantile F (tn n))"
using U_mono_seq by (intro incseq_SucI) simp
obtain B where B: "⋀n. tail_quantile F (tn n) ≤ B"
using bdd unfolding bdd_above_def by auto
obtain L where L: "(λn. tail_quantile F (tn n)) ⇢ L"
using incseq_convergent[OF incseq, of B] B by meson
have diff0: "(λn. tail_quantile F (tn (Suc n)) - tail_quantile F (tn n)) ⇢ 0"
using tendsto_diff[OF LIMSEQ_Suc[OF L] L] by simp
have diff_gt: "∀⇩F n in sequentially. c * a (tn n)
< tail_quantile F (tn (Suc n)) - tail_quantile F (tn n)"
using T(2)[OF tn_ge_T] by (intro always_eventually) (simp add: tn_Suc)
have ge1: "∀⇩F n in sequentially. 1 ≤ c * a (tn n)"
using a_tn_at_top[unfolded filterlim_at_top, rule_format, of "1 / c"]
by eventually_elim (use c_pos in "simp add: field_simps")
have gt1_ev: "∀⇩F n in sequentially. 1
< tail_quantile F (tn (Suc n)) - tail_quantile F (tn n)"
using ge1 diff_gt
by eventually_elim simp
have lt1_ev:
"∀⇩F n in sequentially. tail_quantile F (tn (Suc n)) - tail_quantile F (tn n) < 1"
using order_tendstoD(2)[OF diff0, of 1] by simp
have "∀⇩F n::nat in sequentially. False"
using gt1_ev lt1_ev by eventually_elim linarith
thus False
by simp
qed
have tn_ex: "⋀M. ∃n. M < tail_quantile F (tn n)"
using not_bdd unfolding bdd_above_def by (auto simp: not_le)
show ?thesis
unfolding filterlim_at_top
proof
fix M :: real
obtain n where n: "M < tail_quantile F (tn n)"
using tn_ex by blast
show "∀⇩F t in at_top. M ≤ tail_quantile F t"
using eventually_ge_at_top[of "tn n"]
proof eventually_elim
case (elim t)
have "tail_quantile F (tn n) ≤ tail_quantile F t"
using tn_gt1[of n] elim
by (intro tail_quantile_mono[OF ‹right_continuous_mono F 0 1›]) auto
with n show ?case
by simp
qed
qed
qed
show "⋀y. 0 < y ⟹
((λt. tail_quantile F (t * y) / tail_quantile F t) ⤏ y powr γ) at_top"
by (intro tail_quantile_pos_ratio_of_power_ratio[OF F gamma U_at_top]
tail_quantile_pos_power_ratio[OF F apos gamma quant U_at_top])
qed
lemma tail_quantile_ratio_pos_imp_tail_regularly_varying:
fixes F :: "real ⇒ real" and γ :: real
assumes F: "right_continuous_mono F 0 1" and gamma: "0 < γ"
and Uinf: "filterlim (tail_quantile F) at_top at_top"
and Urv: "⋀y. 0 < y ⟹
((λt. tail_quantile F (t * y) / tail_quantile F t) ⤏ y powr γ) at_top"
shows "(∀x. F x < 1) ∧ regularly_varying (λx. 1 - F x) (- 1 / γ)"
proof -
interpret right_continuous_mono F 0 1
by fact
have unbdd: "¬ bdd_support F"
proof
assume bdd: "bdd_support F"
have Fx1: "F (x_star F + 1) = 1"
using bdd cSup_upper[of "x_star F + 1" "{x. F x < 1}"] f_le_b[of "x_star F + 1"]
unfolding x_star_def by fastforce
have le: "tail_quantile F t ≤ x_star F + 1" if t1: "1 < t" for t
using Fx1 t1 by (simp add: ginv_le_iff)
have "∀⇩F t in at_top. x_star F + 1 < tail_quantile F t"
using Uinf[unfolded filterlim_at_top, rule_format, of "x_star F + 2"]
by eventually_elim simp
from eventually_gt_at_top[of "1::real"] this
have "∀⇩F t in at_top. 1 < t ∧ x_star F + 1 < tail_quantile F t"
by (rule eventually_conj)
then obtain t where "1 < t" "x_star F + 1 < tail_quantile F t"
using eventually_happens'[OF trivial_limit_at_top_linorder] by blast
with le[of t] show False
by simp
qed
have Flt1: "∀x. F x < 1"
using F_lt_1_unbdd_support[OF ‹right_continuous_mono F 0 1› unbdd] by blast
define s where "s = (λt::real. 1 / (1 - F t))"
have Ftop: "(F ⤏ 1) at_top"
using top by simp
have s_top: "filterlim s at_top at_top"
proof -
have Ftend: "((λt. 1 - F t) ⤏ 0) at_top"
using tendsto_diff[OF tendsto_const[of 1] Ftop] by simp
have Fpos: "∀⇩F t in at_top. 0 < 1 - F t"
using Flt1 by (auto intro!: always_eventually)
from filterlim_inverse_at_top[OF Ftend Fpos]
show ?thesis
by (simp add: s_def inverse_eq_divide)
qed
have galois: "tail_quantile F t ≤ z ⟷ t ≤ s z" if t1: "1 < t" for t z
proof -
have p_bounds: "0 < 1 - 1 / t" "1 - 1 / t < 1"
using t1 by simp_all
have "tail_quantile F t ≤ z ⟷ 1 - 1 / t ≤ F z"
using ginv_le_iff[OF p_bounds, of z] by simp
also have "… ⟷ t ≤ s z"
using Flt1 t1 by (simp add: s_def field_simps)
finally show ?thesis .
qed
have s_pos: "0 < s w" if "0 < w" for w
using Flt1 by (simp add: s_def)
have s_ratio: "((λu. s (u * x) / s u) ⤏ x powr (1 / γ)) at_top"
if x: "0 < x" for x
using galois_inverse_ratio_tendsto[OF Uinf s_top s_pos galois gamma Urv x] .
have tail_ratio: "((λu. (1 - F (u * x)) / (1 - F u)) ⤏ x powr (- 1 / γ)) at_top"
if x: "0 < x" for x
proof -
have same: "(λu. s (u * x) / s u) = (λu. (1 - F u) / (1 - F (u * x)))"
using Flt1 by (auto simp: s_def)
have main: "((λu. (1 - F u) / (1 - F (u * x))) ⤏ x powr (1 / γ)) at_top"
using s_ratio[OF x] unfolding same .
have xr_ne: "x powr (1 / γ) ≠ 0"
using x by simp
have inv: "((λu. inverse ((1 - F u) / (1 - F (u * x))))
⤏ inverse (x powr (1 / γ))) at_top"
by (intro tendsto_inverse main xr_ne)
have eq2: "(λu. inverse ((1 - F u) / (1 - F (u * x)))) = (λu. (1 - F (u * x)) / (1 - F u))"
by simp
have lim: "((λu. (1 - F (u * x)) / (1 - F u)) ⤏ inverse (x powr (1 / γ))) at_top"
using inv unfolding eq2 .
have val_eq: "inverse (x powr (1 / γ)) = x powr (- 1 / γ)"
using x by (simp add: powr_minus)
show ?thesis
using lim unfolding val_eq .
qed
have final_rv: "regularly_varying (λx. 1 - F x) (- 1 / γ)"
using borel_measurable_mono[OF mono] Flt1 tail_ratio
by(auto intro!: regularly_varyingI measurable_restrict_space1)
show ?thesis
using Flt1 final_rv by blast
qed
theorem MDA_regularly_varying_pos:
fixes F :: "real ⇒ real" and γ :: real
assumes F: "right_continuous_mono F 0 1" and gamma[arith]: "0 < γ"
shows "domain_of_attraction F (EVD_cdf γ 0 1)
⟷ (∀x. F x < 1) ∧ regularly_varying (λx. 1 - F x) (- 1 / γ)"
proof
assume dom: "domain_of_attraction F (EVD_cdf γ 0 1)"
obtain a where apos: "⋀t. 0 < a t"
and quant: "⋀x. 0 < x ⟹
((λt. (tail_quantile F (t * x) - tail_quantile F t) / a t) ⤏ (x powr γ - 1) / γ) at_top"
using dom MDA_iff_tail_quantile'[OF F, of γ] gamma by auto
show "(∀x. F x < 1) ∧ regularly_varying (λx. 1 - F x) (- 1 / γ)"
by (intro tail_quantile_ratio_pos_imp_tail_regularly_varying[OF F gamma]
tail_quantile_pos_ratio[OF F apos gamma quant]
tail_quantile_pos_at_top[OF F apos gamma quant])
next
assume rv: "(∀x. F x < 1) ∧ regularly_varying (λx. 1 - F x) (- 1 / γ)"
hence unbdd: "⋀x. F x < 1" and rv': "regularly_varying (λx. 1 - F x) (- (1 / γ))"
by auto
have not_bdd: "¬ bdd_support F"
by (rule not_bdd_supportI'[OF unbdd])
have endpoint_eq: "endpoint_filter F = at_top"
using not_bdd by (simp add: endpoint_filter_def)
define f where "f = (λt::real. γ * max t 1)"
have f_pos: "⋀t. 0 < f t"
unfolding f_def by simp
have ratio: "((λt. (1 - F (t + x * f t)) / (1 - F t)) ⤏ - ln (EVD_cdf γ 0 1 x)) at_top"
if supp: "1 + γ * x > 0" for x
proof -
have eq1: "∀⇩F t in at_top. (1 - F (t * (1 + γ * x))) / (1 - F t)
= (1 - F (t + x * f t)) / (1 - F t)"
using eventually_ge_at_top[of "1::real"]
by eventually_elim (simp add: f_def field_simps)
have main: "((λt. (1 - F (t * (1 + γ * x))) / (1 - F t))
⤏ (1 + γ * x) powr (- (1 / γ))) at_top"
using regularly_varying_lim[OF rv', of "1 + γ * x"] supp by simp
thus ?thesis
using Lim_transform_eventually[OF main eq1]
ln_EVD_cdf_1[OF zero_less_one, of γ x 0] supp gamma
by simp
qed
have "∃f. (∀t. 0 < f t) ∧ (∀x. 1 + γ * x > 0 ⟶
((λt. (1 - F (t + x * f t)) / (1 - F t))
⤏ - ln (EVD_cdf γ 0 1 x)) (endpoint_filter F))"
using f_pos ratio endpoint_eq by (intro exI[of _ f]) simp
thus "domain_of_attraction F (EVD_cdf γ 0 1)"
using MDA_iff_divide_tail[OF F, of γ] by simp
qed
theorem MDA_regularly_varying_neg:
fixes F :: "real ⇒ real" and γ :: real
assumes F: "right_continuous_mono F 0 1" and gamma[arith]: "γ < 0"
shows "domain_of_attraction F (EVD_cdf γ 0 1)
⟷ bdd_support F ∧
regularly_varying (λs. 1 - F (x_star F - 1 / s)) (1 / γ)"
proof
assume dom: "domain_of_attraction F (EVD_cdf γ 0 1)"
obtain a where apos: "⋀t. 0 < a t"
and quant: "⋀x. 0 < x ⟹
((λt. (tail_quantile F (t * x) - tail_quantile F t) / a t)
⤏ (x powr γ - 1) / γ) at_top"
using dom MDA_iff_tail_quantile'[OF F, of γ] gamma by auto
have bdd: "bdd_support F"
by (rule tail_quantile_neg_bdd[OF F apos gamma quant])
have gap_rv: "⋀y. 0 < y ⟹
((λt. (x_star F - tail_quantile F (t * y)) / (x_star F - tail_quantile F t))
⤏ y powr γ) at_top"
by (rule tail_quantile_neg_ratio[OF F apos gamma quant])
show "bdd_support F ∧ regularly_varying (λs. 1 - F (x_star F - 1 / s)) (1 / γ)"
using bdd tail_quantile_gap_ratio_neg_imp_tail_regularly_varying[OF F gamma bdd gap_rv]
by blast
next
assume rv: "bdd_support F ∧ regularly_varying (λs. 1 - F (x_star F - 1 / s)) (1 / γ)"
hence bdd: "bdd_support F"
and rv': "regularly_varying (λs. 1 - F (x_star F - 1 / s)) (1 / γ)"
by auto
have lim:"filterlim (λt. 1 / (c - t)) at_top (at_left c)" for c :: real
proof -
have tendsto0: "((λt. c - t) ⤏ 0) (at_left c)"
by (auto intro!: tendsto_eq_intros)
show ?thesis
using filterlim_inverse_at_top[OF tendsto0 eventually_at_leftI[of "c - 1"]]
by(auto simp: inverse_eq_divide)
qed
note Slim = lim[of "x_star F"]
have endpoint_eq: "endpoint_filter F = at_left (x_star F)"
using bdd by (simp add: endpoint_filter_def)
define f where "f = (λt::real. if t < x_star F then - γ * (x_star F - t) else 1)"
have f_pos: "⋀t. 0 < f t"
unfolding f_def using gamma by (auto intro: mult_neg_pos)
have ratio: "((λt. (1 - F (t + x * f t)) / (1 - F t))
⤏ - ln (EVD_cdf γ 0 1 x)) (endpoint_filter F)"
if supp: "1 + γ * x > 0" for x
proof -
have main: "((λs. (1 - F (x_star F - 1 / (s * (1 / (1 + γ * x)))))
/ (1 - F (x_star F - 1 / s))) ⤏ (1 / (1 + γ * x)) powr (1 / γ)) at_top"
using regularly_varying_lim[OF rv', of "1 / (1 + γ * x)"] supp by simp
have comp: "((λt. (1 - F (x_star F - 1 / ((1 / (x_star F - t)) * (1 / (1 + γ * x)))))
/ (1 - F (x_star F - 1 / (1 / (x_star F - t)))))
⤏ (1 / (1 + γ * x)) powr (1 / γ)) (at_left (x_star F))"
by (rule filterlim_compose[OF main Slim])
have eq1: "∀⇩F t in at_left (x_star F).
(1 - F (x_star F - 1 / ((1 / (x_star F - t)) * (1 / (1 + γ * x)))))
/ (1 - F (x_star F - 1 / (1 / (x_star F - t))))
= (1 - F (t + x * f t)) / (1 - F t)"
proof (rule eventually_at_leftI[of "x_star F - 1"])
fix t
assume "t ∈ {x_star F - 1<..<x_star F}"
hence tlt: "t < x_star F"
by simp
have a1: "t + x * f t = x_star F - (x_star F - t) * (1 + γ * x)"
using tlt by (simp add: f_def field_simps)
have a2: "1 / (1 / (x_star F - t) * (1 / (1 + γ * x))) = (x_star F - t) * (1 + γ * x)"
using tlt supp by (simp add: field_simps)
have a3: "1 / (1 / (x_star F - t)) = x_star F - t"
using tlt by simp
show "(1 - F (x_star F - 1 / (1 / (x_star F - t) * (1 / (1 + γ * x)))))
/ (1 - F (x_star F - 1 / (1 / (x_star F - t))))
= (1 - F (t + x * f t)) / (1 - F t)"
unfolding a2 a3 a1 by simp
qed simp
have val_eq: "(1 / (1 + γ * x)) powr (1 / γ) = - ln (EVD_cdf γ 0 1 x)"
using ln_EVD_cdf_1[OF zero_less_one, of γ x 0] supp gamma
by (simp add: powr_divide powr_minus_divide)
show ?thesis
unfolding endpoint_eq
using Lim_transform_eventually[OF comp eq1] val_eq
by simp
qed
have "∃f. (∀t. 0 < f t) ∧ (∀x. 1 + γ * x > 0 ⟶
((λt. (1 - F (t + x * f t)) / (1 - F t))
⤏ - ln (EVD_cdf γ 0 1 x)) (endpoint_filter F))"
using f_pos ratio by (intro exI[of _ f]) simp
thus "domain_of_attraction F (EVD_cdf γ 0 1)"
using MDA_iff_divide_tail[OF F, of γ] by simp
qed
text ‹ Corollary 1.2.4 ›
lemma MDA_aux_fun_cong:
fixes F a a' :: "real ⇒ real" and γ :: real
assumes a: "⋀t. 0 < a t"
and quant: "⋀x. 0 < x ⟹
((λt. (tail_quantile F (t * x) - tail_quantile F t) / a t)
⤏ (if γ = 0 then ln x else (x powr γ - 1) / γ)) at_top"
and equiv: "((λt. a' t / a t) ⤏ 1) at_top"
and x: "0 < x"
shows "((λt. (tail_quantile F (t * x) - tail_quantile F t) / a' t)
⤏ (if γ = 0 then ln x else (x powr γ - 1) / γ)) at_top"
proof -
have anz: "a t ≠ 0" for t
using a[of t] by simp
show ?thesis
using equiv
by(intro asymp_equiv_tendsto_transfer[OF _ quant[OF x]])
(simp add: asymp_equivI' asymp_equiv_divide asymp_equiv_symI)
qed
lemma MDA_canonical_normalization:
fixes F :: "real ⇒ real" and γ :: real
assumes F: "right_continuous_mono F 0 1"
and dom: "domain_of_attraction F (EVD_cdf γ 0 1)"
obtains a :: "real ⇒ real"
where "⋀t. 0 < a t"
and "⋀x. 0 < x ⟹
((λt. (tail_quantile F (t * x) - tail_quantile F t) / a t)
⤏ (if γ = 0 then ln x else (x powr γ - 1) / γ)) at_top"
and "⋀x. (λn. F (a (real n) * x + tail_quantile F (real n)) ^ n) ⇢ EVD_cdf γ 0 1 x"
proof -
obtain a where apos: "⋀t. 0 < a t"
and quant: "⋀x. 0 < x ⟹
((λt. (tail_quantile F (t * x) - tail_quantile F t) / a t)
⤏ (if γ = 0 then ln x else (x powr γ - 1) / γ)) at_top"
using dom MDA_iff_tail_quantile'[OF F, of γ] by auto
have wit: "(λn. F (a (real n) * x + tail_quantile F (real n)) ^ n) ⇢ EVD_cdf γ 0 1 x" for x
proof (rule MDA_tail_quantile_witness[where b = "tail_quantile F", OF F apos zero_less_one])
fix y :: real
assume y: "0 < y"
show "((λt. (tail_quantile F (t * y) - tail_quantile F t) / a t)
⤏ (if γ = 0 then 1 * ln y + 0 else 1 * (y powr γ - 1) / γ + 0)) at_top"
using quant[OF y] by (cases "γ = 0") simp_all
qed
show thesis
by (rule that[of a]) (use apos quant wit in blast)+
qed
lemma tail_quantile_pos_aux:
fixes F :: "real ⇒ real" and γ :: real
assumes F: "right_continuous_mono F 0 1" and gamma: "0 < γ"
and dom: "domain_of_attraction F (EVD_cdf γ 0 1)"
and x: "0 < x"
shows "((λt. (tail_quantile F (t * x) - tail_quantile F t) / (γ * tail_quantile F t))
⤏ (x powr γ - 1) / γ) at_top"
proof -
obtain a where apos: "⋀t. 0 < a t"
and quant0: "⋀y. 0 < y ⟹
((λt. (tail_quantile F (t * y) - tail_quantile F t) / a t)
⤏ (if γ = 0 then ln y else (y powr γ - 1) / γ)) at_top"
using dom MDA_iff_tail_quantile'[OF F, of γ] by auto
have quant: "⋀y. 0 < y ⟹
((λt. (tail_quantile F (t * y) - tail_quantile F t) / a t)
⤏ (y powr γ - 1) / γ) at_top"
using quant0 gamma by simp
have pos: "∀⇩F t in at_top. 0 < tail_quantile F t"
using tail_quantile_pos_at_top[OF F apos gamma quant]
unfolding filterlim_at_top_dense by blast
have gnz: "γ ≠ 0"
using gamma by simp
have "((λt. (tail_quantile F (t * x) / tail_quantile F t - 1) / γ)
⤏ (x powr γ - 1) / γ) at_top"
by (intro tendsto_intros tail_quantile_pos_ratio[OF F apos gamma quant x] gnz)
moreover have "∀⇩F t in at_top.
(tail_quantile F (t * x) / tail_quantile F t - 1) / γ
= (tail_quantile F (t * x) - tail_quantile F t) / (γ * tail_quantile F t)"
using pos by eventually_elim (simp add: field_simps)
ultimately show ?thesis
by (rule Lim_transform_eventually)
qed
lemma tail_quantile_neg_gap:
fixes F :: "real ⇒ real" and γ :: real
assumes F: "right_continuous_mono F 0 1" and gamma: "γ < 0"
and dom: "domain_of_attraction F (EVD_cdf γ 0 1)"
shows tail_quantile_neg_bdd_support: "bdd_support F"
and tail_quantile_neg_gap_pos: "∀⇩F t in at_top. 0 < x_star F - tail_quantile F t"
proof -
have gnz: "γ ≠ 0"
using gamma by simp
obtain a where apos: "⋀t. 0 < a t"
and quant0: "⋀y. 0 < y ⟹
((λt. (tail_quantile F (t * y) - tail_quantile F t) / a t)
⤏ (if γ = 0 then ln y else (y powr γ - 1) / γ)) at_top"
using dom MDA_iff_tail_quantile'[OF F, of γ] by auto
have quant: "⋀y. 0 < y ⟹
((λt. (tail_quantile F (t * y) - tail_quantile F t) / a t)
⤏ (y powr γ - 1) / γ) at_top"
using quant0 gnz by simp
show bdd: "bdd_support F"
by (rule tail_quantile_neg_bdd[OF F apos gamma quant])
obtain f where fpos: "⋀t. 0 < f t"
and flim: "⋀y. 0 < 1 + γ * y ⟹
((λt. (1 - F (t + y * f t)) / (1 - F t))
⤏ - ln (EVD_cdf γ 0 1 y)) (endpoint_filter F)"
using dom MDA_iff_divide_tail[OF F, of γ] by auto
have lim': "⋀y. 0 < 1 + γ * (y - 0) / 1 ⟹
((λt. (1 - F (t + (y - 0) * f t)) / (1 - F t))
⤏ - ln (EVD_cdf γ 0 1 y)) (endpoint_filter F)"
using flim by simp
have Flim: "(F ⤏ 1) (endpoint_filter F)"
by (intro F_tendsto_1_endpoint_of_lim[OF F _ _ zero_less_one lim']) (use fpos in auto)
have gap: "0 < x_star F - tail_quantile F t" if t1: "1 < t" for t
using tail_quantile_lt_x_star[OF F bdd Flim t1] by simp
show "∀⇩F t in at_top. 0 < x_star F - tail_quantile F t"
using eventually_gt_at_top[of 1] by eventually_elim (rule gap)
qed
lemma tail_quantile_neg_aux:
fixes F :: "real ⇒ real" and γ :: real
assumes F: "right_continuous_mono F 0 1" and gamma: "γ < 0"
and dom: "domain_of_attraction F (EVD_cdf γ 0 1)"
and x: "0 < x"
shows "((λt. (tail_quantile F (t * x) - tail_quantile F t)
/ (- γ * (x_star F - tail_quantile F t)))
⤏ (x powr γ - 1) / γ) at_top"
proof -
have gnz: "γ ≠ 0" and gnz': "- γ ≠ 0"
using gamma by simp_all
obtain a where apos: "⋀t. 0 < a t"
and quant0: "⋀y. 0 < y ⟹
((λt. (tail_quantile F (t * y) - tail_quantile F t) / a t)
⤏ (if γ = 0 then ln y else (y powr γ - 1) / γ)) at_top"
using dom MDA_iff_tail_quantile'[OF F, of γ] by auto
have quant: "⋀y. 0 < y ⟹
((λt. (tail_quantile F (t * y) - tail_quantile F t) / a t)
⤏ (y powr γ - 1) / γ) at_top"
using quant0 gnz by simp
note gapev = tail_quantile_neg_gap_pos[OF F gamma dom]
have "((λt. (1 - (x_star F - tail_quantile F (t * x)) / (x_star F - tail_quantile F t))
/ (- γ))
⤏ (1 - x powr γ) / (- γ)) at_top"
by (intro tendsto_divide tendsto_diff tendsto_const gnz'
tail_quantile_neg_ratio[OF F apos gamma quant x])
moreover have "(1 - x powr γ) / (- γ) = (x powr γ - 1) / γ"
by (simp add: diff_divide_distrib)
ultimately have "((λt. (1 - (x_star F - tail_quantile F (t * x))
/ (x_star F - tail_quantile F t)) / (- γ))
⤏ (x powr γ - 1) / γ) at_top"
by simp
moreover have "∀⇩F t in at_top.
(1 - (x_star F - tail_quantile F (t * x)) / (x_star F - tail_quantile F t)) / (- γ)
= (tail_quantile F (t * x) - tail_quantile F t)
/ (- γ * (x_star F - tail_quantile F t))"
using gapev
proof eventually_elim
case (elim t)
hence ne: "x_star F - tail_quantile F t ≠ 0"
by simp
have "1 - (x_star F - tail_quantile F (t * x)) / (x_star F - tail_quantile F t)
= (tail_quantile F (t * x) - tail_quantile F t) / (x_star F - tail_quantile F t)"
using ne by (simp add: field_simps)
thus ?case
by (simp add: mult.commute)
qed
ultimately show ?thesis
by (rule Lim_transform_eventually)
qed
theorem MDA_normalization_pos:
fixes F :: "real ⇒ real" and γ x :: real
assumes F: "right_continuous_mono F 0 1" and gamma: "0 < γ"
and dom: "domain_of_attraction F (EVD_cdf γ 0 1)"
shows "(λn. F (tail_quantile F (real n) * x) ^ n)
⇢ (if 0 < x then exp (- (x powr - (1 / γ))) else 0)"
proof -
have gnz: "γ ≠ 0"
using gamma by simp
obtain a where apos: "⋀t. 0 < a t"
and quant0: "⋀y. 0 < y ⟹
((λt. (tail_quantile F (t * y) - tail_quantile F t) / a t)
⤏ (if γ = 0 then ln y else (y powr γ - 1) / γ)) at_top"
using dom MDA_iff_tail_quantile'[OF F, of γ] by auto
have quant: "⋀y. 0 < y ⟹
((λt. (tail_quantile F (t * y) - tail_quantile F t) / a t)
⤏ (y powr γ - 1) / γ) at_top"
using quant0 gnz by simp
define a' where "a' = (λt. γ * max (tail_quantile F t) 1)"
have a'pos: "⋀t. 0 < a' t"
using gamma by (simp add: a'_def)
have Uev: "∀⇩F t in at_top. 1 ≤ tail_quantile F t"
using tail_quantile_pos_at_top[OF F apos gamma quant]
unfolding filterlim_at_top by blast
have a'eq: "∀⇩F t in at_top. a' t = γ * tail_quantile F t"
using Uev by eventually_elim (simp add: a'_def)
have quant': "((λt. (tail_quantile F (t * y) - tail_quantile F t) / a' t)
⤏ (if γ = 0 then 1 * ln y + 0 else 1 * (y powr γ - 1) / γ + 0)) at_top"
if y: "0 < y" for y
proof -
have "((λt. (tail_quantile F (t * y) - tail_quantile F t) / (γ * tail_quantile F t))
⤏ (y powr γ - 1) / γ) at_top"
by (rule tail_quantile_pos_aux[OF F gamma dom y])
moreover have "∀⇩F t in at_top.
(tail_quantile F (t * y) - tail_quantile F t) / (γ * tail_quantile F t)
= (tail_quantile F (t * y) - tail_quantile F t) / a' t"
using a'eq by eventually_elim simp
ultimately show ?thesis
using gnz by (simp add: Lim_transform_eventually)
qed
have wit: "(λn. F (a' (real n) * y + tail_quantile F (real n)) ^ n) ⇢ EVD_cdf γ 0 1 y" for y
by (rule MDA_tail_quantile_witness[where b = "tail_quantile F",
OF F a'pos zero_less_one quant'])
have "∀⇩F n in sequentially.
F (a' (real n) * ((x - 1) / γ) + tail_quantile F (real n)) ^ n
= F (tail_quantile F (real n) * x) ^ n"
using eventually_compose_filterlim[OF a'eq filterlim_real_sequentially]
by eventually_elim (simp add: gnz field_simps)
with wit[of "(x - 1) / γ"]
have "(λn. F (tail_quantile F (real n) * x) ^ n) ⇢ EVD_cdf γ 0 1 ((x - 1) / γ)"
by (rule Lim_transform_eventually)
thus ?thesis
using gamma by (auto simp: EVD_cdf_def)
qed
theorem MDA_normalization_neg:
fixes F :: "real ⇒ real" and γ x :: real
assumes F: "right_continuous_mono F 0 1" and gamma: "γ < 0"
and dom: "domain_of_attraction F (EVD_cdf γ 0 1)"
shows "(λn. F ((x_star F - tail_quantile F (real n)) * x + x_star F) ^ n)
⇢ (if x < 0 then exp (- ((- x) powr - (1 / γ))) else 1)"
proof -
have gnz: "γ ≠ 0" and gpos: "0 < - γ"
using gamma by simp_all
note gapev = tail_quantile_neg_gap_pos[OF F gamma dom]
define a' where
"a' = (λt. if 0 < x_star F - tail_quantile F t
then - γ * (x_star F - tail_quantile F t) else 1)"
have a'pos: "0 < a' t" for t
using gamma by (auto simp: a'_def intro!: mult_neg_pos)
have a'eq: "∀⇩F t in at_top. a' t = - γ * (x_star F - tail_quantile F t)"
using gapev by eventually_elim (simp add: a'_def)
have quant': "((λt. (tail_quantile F (t * y) - tail_quantile F t) / a' t)
⤏ (if γ = 0 then 1 * ln y + 0 else 1 * (y powr γ - 1) / γ + 0)) at_top"
if y: "0 < y" for y
proof -
have "((λt. (tail_quantile F (t * y) - tail_quantile F t)
/ (- γ * (x_star F - tail_quantile F t)))
⤏ (y powr γ - 1) / γ) at_top"
by (rule tail_quantile_neg_aux[OF F gamma dom y])
moreover have "∀⇩F t in at_top.
(tail_quantile F (t * y) - tail_quantile F t) / (- γ * (x_star F - tail_quantile F t))
= (tail_quantile F (t * y) - tail_quantile F t) / a' t"
using a'eq by eventually_elim simp
ultimately show ?thesis
using gnz by (simp add: Lim_transform_eventually)
qed
have wit: "(λn. F (a' (real n) * y + tail_quantile F (real n)) ^ n) ⇢ EVD_cdf γ 0 1 y"
for y
by (rule MDA_tail_quantile_witness[where b = "tail_quantile F",
OF F a'pos zero_less_one quant'])
have "∀⇩F n in sequentially.
F (a' (real n) * (- (x + 1) / γ) + tail_quantile F (real n)) ^ n
= F ((x_star F - tail_quantile F (real n)) * x + x_star F) ^ n"
using eventually_compose_filterlim[OF a'eq filterlim_real_sequentially]
proof eventually_elim
case (elim n)
have "a' (real n) * (- (x + 1) / γ) + tail_quantile F (real n)
= (x_star F - tail_quantile F (real n)) * x + x_star F"
unfolding elim using gnz by (simp add: field_simps)
thus ?case
by simp
qed
with wit[of "- (x + 1) / γ"]
have "(λn. F ((x_star F - tail_quantile F (real n)) * x + x_star F) ^ n)
⇢ EVD_cdf γ 0 1 (- (x + 1) / γ)"
by (rule Lim_transform_eventually)
thus ?thesis
using gamma by(auto simp: EVD_cdf_def)
qed
lemma tail_quantile_spacing_aux:
fixes F :: "real ⇒ real" and γ c :: real
assumes F: "right_continuous_mono F 0 1"
and dom: "domain_of_attraction F (EVD_cdf γ 0 1)"
and c: "1 < c" and x: "0 < x"
shows "((λt. (tail_quantile F (t * x) - tail_quantile F t)
/ ((tail_quantile F (t * c) - tail_quantile F t)
/ (if γ = 0 then ln c else (c powr γ - 1) / γ)))
⤏ (if γ = 0 then ln x else (x powr γ - 1) / γ)) at_top"
proof -
have c0: "0 < c"
using c by simp
define D where "D = (if γ = 0 then ln c else (c powr γ - 1) / γ)"
have D_pos: "0 < D"
using powr_less_mono[of 0 γ c] powr_less_mono[of γ 0 c] c
by(cases "γ = 0"; cases "0 < γ")
(auto simp: D_def intro!: divide_pos_pos divide_neg_neg)
obtain a where apos: "⋀t. 0 < a t"
and quant: "⋀y. 0 < y ⟹
((λt. (tail_quantile F (t * y) - tail_quantile F t) / a t)
⤏ (if γ = 0 then ln y else (y powr γ - 1) / γ)) at_top"
using dom MDA_iff_tail_quantile'[OF F, of γ] by auto
have quantc: "((λt. (tail_quantile F (t * c) - tail_quantile F t) / a t) ⤏ D) at_top"
using quant[OF c0] by(simp add: D_def)
define a' where "a' t = (tail_quantile F (t * c) - tail_quantile F t) / D" for t
have equiv: "((λt. a' t / a t) ⤏ 1) at_top"
proof -
have eq: "(tail_quantile F (t * c) - tail_quantile F t) / a t / D = a' t / a t" for t
by(simp add: a'_def mult.commute)
have "((λt. (tail_quantile F (t * c) - tail_quantile F t) / a t / D) ⤏ D / D) at_top"
using D_pos by(intro tendsto_divide[OF quantc tendsto_const]) simp
thus ?thesis
using D_pos unfolding eq by simp
qed
show ?thesis
using MDA_aux_fun_cong[OF apos quant equiv x, unfolded a'_def D_def] .
qed
theorem MDA_normalization_zero_spacing:
fixes F :: "real ⇒ real" and c x :: real
assumes F: "right_continuous_mono F 0 1" and c: "1 < c"
and dom: "domain_of_attraction F (EVD_cdf 0 0 1)"
shows "(λn. F ((tail_quantile F (real n * c) - tail_quantile F (real n)) / ln c * x
+ tail_quantile F (real n)) ^ n)
⇢ EVD_cdf 0 0 1 x"
proof -
have c0: "0 < c"
using c by simp
have lnc: "0 < ln c"
using c by simp
obtain a where apos: "⋀t. 0 < a t"
and quant: "⋀y. 0 < y ⟹
((λt. (tail_quantile F (t * y) - tail_quantile F t) / a t) ⤏ ln y) at_top"
using dom MDA_iff_tail_quantile'[OF F, of 0] by auto
define a' where "a' t = (tail_quantile F (t * c) - tail_quantile F t) / ln c" for t
have spacing: "((λt. (tail_quantile F (t * y) - tail_quantile F t) / a' t) ⤏ ln y) at_top"
if y: "0 < y" for y
using tail_quantile_spacing_aux[OF F dom c y] by(simp add: a'_def)
have ev: "∀⇩F t in at_top. 0 < a' t"
proof(safe intro!: eventually_mono[OF order_tendstoD(1)[OF quant[OF c0] lnc]])
fix t
assume "0 < (tail_quantile F (t * c) - tail_quantile F t) / a t"
thus "0 < a' t"
using apos[of t] lnc by(simp add: a'_def zero_less_divide_iff)
qed
define a'' where "a'' t = (if 0 < a' t then a' t else 1)" for t
have a''_pos: "0 < a'' t" for t
by(simp add: a''_def)
have a''_eq: "∀⇩F t in at_top. a'' t = a' t"
using ev by eventually_elim (simp add: a''_def)
have quant'': "((λt. (tail_quantile F (t * y) - tail_quantile F t) / a'' t) ⤏ ln y) at_top"
if y: "0 < y" for y
proof -
have "∀⇩F t in at_top. (tail_quantile F (t * y) - tail_quantile F t) / a' t
= (tail_quantile F (t * y) - tail_quantile F t) / a'' t"
using a''_eq by eventually_elim simp
from Lim_transform_eventually[OF spacing[OF y] this]
show ?thesis .
qed
have wit: "(λn. F (a'' (real n) * x + tail_quantile F (real n)) ^ n) ⇢ EVD_cdf 0 0 1 x"
by(intro MDA_tail_quantile_witness[where γ = 0 and μ = 0 and σ = 1 and a = a''
and b = "tail_quantile F", OF F a''_pos zero_less_one])
(use quant'' in simp)
have "∀⇩F n in sequentially.
F (a'' (real n) * x + tail_quantile F (real n)) ^ n
= F ((tail_quantile F (real n * c) - tail_quantile F (real n)) / ln c * x
+ tail_quantile F (real n)) ^ n"
using eventually_compose_filterlim[OF a''_eq filterlim_real_sequentially]
by eventually_elim (simp add: a'_def)
with wit show ?thesis
by (rule Lim_transform_eventually)
qed
end