(* ========================================================================= *)
(* Multivariate calculus in Euclidean space. *)
(* *)
(* (c) Copyright, John Harrison 1998-2008 *)
(* ========================================================================= *)
needs "Multivariate/dimension.ml";;
(* ------------------------------------------------------------------------- *)
(* Derivatives. The definition is slightly tricky since we make it work over *)
(* nets of a particular form. This lets us prove theorems generally and use *)
(* "at a" or "at a within s" for restriction to a set (1-sided on R etc.) *)
(* ------------------------------------------------------------------------- *)
parse_as_infix ("has_derivative",(12,"right"));;
(* ------------------------------------------------------------------------- *)
(* These are the only cases we'll care about, probably. *)
(* ------------------------------------------------------------------------- *)
(* ------------------------------------------------------------------------- *)
(* More explicit epsilon-delta forms. *)
(* ------------------------------------------------------------------------- *)
(* ------------------------------------------------------------------------- *)
(* Combining theorems. *)
(* ------------------------------------------------------------------------- *)
(* ------------------------------------------------------------------------- *)
(* Somewhat different results for derivative of scalar multiplier. *)
(* ------------------------------------------------------------------------- *)
(* ------------------------------------------------------------------------- *)
(* Limit transformation for derivatives. *)
(* ------------------------------------------------------------------------- *)
(* ------------------------------------------------------------------------- *)
(* Differentiability. *)
(* ------------------------------------------------------------------------- *)
parse_as_infix ("differentiable",(12,"right"));;
parse_as_infix ("differentiable_on",(12,"right"));;
(* ------------------------------------------------------------------------- *)
(* Frechet derivative and Jacobian matrix. *)
(* ------------------------------------------------------------------------- *)
(* ------------------------------------------------------------------------- *)
(* Differentiability implies continuity. *)
(* ------------------------------------------------------------------------- *)
(* ------------------------------------------------------------------------- *)
(* Several results are easier using a "multiplied-out" variant. *)
(* (I got this idea from Dieudonne's proof of the chain rule). *)
(* ------------------------------------------------------------------------- *)
(* ------------------------------------------------------------------------- *)
(* The chain rule. *)
(* ------------------------------------------------------------------------- *)
(* ------------------------------------------------------------------------- *)
(* Composition rules stated just for differentiability. *)
(* ------------------------------------------------------------------------- *)
(* ------------------------------------------------------------------------- *)
(* Similarly for "differentiable_on". *)
(* ------------------------------------------------------------------------- *)
(* ------------------------------------------------------------------------- *)
(* Uniqueness of derivative. *)
(* *)
(* The general result is a bit messy because we need approachability of the *)
(* limit point from any direction. But OK for nontrivial intervals etc. *)
(* ------------------------------------------------------------------------- *)
(* ------------------------------------------------------------------------- *)
(* Component of the differential must be zero if it exists at a local *)
(* maximum or minimum for that corresponding component. Start with slightly *)
(* sharper forms that fix the sign of the derivative on the boundary. *)
(* ------------------------------------------------------------------------- *)
let DIFFERENTIAL_COMPONENT_ZERO_AT_MAXMIN = prove
(`!f:real^M->real^N f' x s k.
1 <= k /\ k <=
dimindex(:N) /\
x
IN s /\ open s /\ (f
has_derivative f') (
at x) /\
((!w. w
IN s ==> (f w)$k <= (f x)$k) \/
(!w. w
IN s ==> (f x)$k <= (f w)$k))
==> !h. (f' h)$k = &0`,
REPEAT GEN_TAC THEN
DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN
FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [
OPEN_CONTAINS_CBALL]) THEN
DISCH_THEN(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[
SUBSET] THEN
DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN
FIRST_X_ASSUM DISJ_CASES_TAC THENL
[MP_TAC(ISPECL [`f:real^M->real^N`; `f':real^M->real^N`;
`x:real^M`; `
cball(x:real^M,e)`; `k:num`; `e:real`]
DIFFERENTIAL_COMPONENT_NEG_AT_MAXIMUM);
MP_TAC(ISPECL [`f:real^M->real^N`; `f':real^M->real^N`;
`x:real^M`; `
cball(x:real^M,e)`; `k:num`; `e:real`]
DIFFERENTIAL_COMPONENT_POS_AT_MINIMUM)] THEN
ASM_SIMP_TAC[
HAS_DERIVATIVE_AT_WITHIN;
CENTRE_IN_CBALL;
CONVEX_CBALL;
REAL_LT_IMP_LE;
IN_INTER] THEN
DISCH_THEN(LABEL_TAC "*") THEN X_GEN_TAC `h:real^M` THEN
FIRST_X_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [
has_derivative_at]) THEN
(ASM_CASES_TAC `h:real^M =
vec 0` THENL
[ASM_MESON_TAC[
LINEAR_0;
VEC_COMPONENT]; ALL_TAC]) THEN
REMOVE_THEN "*" (fun
th ->
MP_TAC(SPEC `x + e /
norm h % h:real^M`
th) THEN
MP_TAC(SPEC `x - e /
norm h % h:real^M`
th)) THEN
REWRITE_TAC[
IN_CBALL; NORM_ARITH
`
dist(x:real^N,x - e) =
norm e /\
dist(x:real^N,x + e) =
norm e`] THEN
REWRITE_TAC[
NORM_MUL;
REAL_ABS_DIV;
REAL_ABS_NORM] THEN
ASM_SIMP_TAC[
real_abs;
REAL_DIV_RMUL;
NORM_EQ_0;
REAL_LT_IMP_LE;
REAL_LE_REFL] THEN
REWRITE_TAC[VECTOR_ARITH `x - e - x:real^N = --e /\ (x + e) - x = e`] THEN
FIRST_ASSUM(fun
th -> REWRITE_TAC[MATCH_MP
LINEAR_NEG th]) THEN
REWRITE_TAC[IMP_IMP; REAL_ARITH `&0 <= --x /\ &0 <= x <=> x = &0`;
VECTOR_NEG_COMPONENT; REAL_ARITH `--x <= &0 /\ x <= &0 <=> x = &0`] THEN
DISCH_THEN(MP_TAC o AP_TERM `(*) (norm(h:real^M) / e)`) THEN
REWRITE_TAC[GSYM VECTOR_MUL_COMPONENT] THEN
FIRST_ASSUM(fun th -> REWRITE_TAC[GSYM(MATCH_MP LINEAR_CMUL th)]) THEN
REWRITE_TAC[REAL_MUL_RZERO; VECTOR_MUL_ASSOC] THEN
ASM_SIMP_TAC[REAL_FIELD `~(x = &0) /\ ~(y = &0) ==> x / y * y / x = &1`;
NORM_EQ_0; REAL_LT_IMP_NZ; VECTOR_MUL_LID]);;
let DIFFERENTIAL_ZERO_MAXMIN_COMPONENT = prove
(`!f:real^M->real^N x e k.
1 <= k /\ k <= dimindex(:N) /\ &0 < e /\
((!y. y IN ball(x,e) ==> (f y)$k <= (f x)$k) \/
(!y. y IN ball(x,e) ==> (f x)$k <= (f y)$k)) /\
f differentiable (at x)
==> (jacobian f (at x) $ k = vec 0)`,
REWRITE_TAC[JACOBIAN_WORKS] THEN REPEAT STRIP_TAC THEN
MP_TAC(ISPECL
[`f:real^M->real^N`; `\h. jacobian (f:real^M->real^N) (at x) ** h`;
`x:real^M`; `ball(x:real^M,e)`; `k:num`]
DIFFERENTIAL_COMPONENT_ZERO_AT_MAXMIN) THEN
ASM_REWRITE_TAC[CENTRE_IN_BALL; OPEN_BALL] THEN
ASM_SIMP_TAC[MATRIX_VECTOR_MUL_COMPONENT; FORALL_DOT_EQ_0]);;
let DIFFERENTIAL_ZERO_MAXMIN = prove
(`!f:real^N->real^1 f' x s.
x IN s /\ open s /\ (f has_derivative f') (at x) /\
((!y. y IN s ==> drop(f y) <= drop(f x)) \/
(!y. y IN s ==> drop(f x) <= drop(f y)))
==> (f' = \v. vec 0)`,
REPEAT STRIP_TAC THEN
MP_TAC(ISPECL [`f:real^N->real^1`; `f':real^N->real^1`;
`x:real^N`; `s:real^N->bool`; `1:num`]
DIFFERENTIAL_COMPONENT_ZERO_AT_MAXMIN) THEN
ASM_REWRITE_TAC[GSYM drop; DIMINDEX_1; LE_REFL] THEN
REWRITE_TAC[GSYM LIFT_EQ; LIFT_NUM; FUN_EQ_THM; LIFT_DROP]);;
(* ------------------------------------------------------------------------- *)
(* The traditional Rolle theorem in one dimension. *)
(* ------------------------------------------------------------------------- *)
(* ------------------------------------------------------------------------- *)
(* One-dimensional mean value theorem. *)
(* ------------------------------------------------------------------------- *)
(* ------------------------------------------------------------------------- *)
(* A nice generalization (see Havin's proof of 5.19 from Rudin's book). *)
(* ------------------------------------------------------------------------- *)
(* ------------------------------------------------------------------------- *)
(* Still more general bound theorem. *)
(* ------------------------------------------------------------------------- *)
(* ------------------------------------------------------------------------- *)
(* In particular. *)
(* ------------------------------------------------------------------------- *)
(* ------------------------------------------------------------------------- *)
(* Differentiability of inverse function (most basic form). *)
(* ------------------------------------------------------------------------- *)
let HAS_DERIVATIVE_INVERSE_BASIC = prove
(`!f:real^M->real^N g f' g' t y.
(f
has_derivative f') (
at (g y)) /\
linear g' /\ (g' o f' = I) /\
g
continuous (
at y) /\
open t /\ y
IN t /\ (!z. z
IN t ==> (f(g(z)) = z))
==> (g
has_derivative g') (
at y)`,
REWRITE_TAC[
FUN_EQ_THM;
o_THM;
I_THM] THEN REPEAT STRIP_TAC THEN
FIRST_ASSUM(X_CHOOSE_TAC `C:real` o MATCH_MP
LINEAR_BOUNDED_POS) THEN
SUBGOAL_THEN
`!e. &0 < e ==> ?d. &0 < d /\
!z.
norm(z - y) < d
==>
norm((g:real^N->real^M)(z) - g(y) - g'(z - y))
<= e *
norm(g(z) - g(y))`
ASSUME_TAC THENL
[X_GEN_TAC `e:real` THEN DISCH_TAC THEN
FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [
HAS_DERIVATIVE_AT_ALT]) THEN
DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `e / C`)) THEN
ASM_SIMP_TAC[
REAL_LT_DIV] THEN
DISCH_THEN(X_CHOOSE_THEN `d0:real`
(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
DISCH_THEN(ASSUME_TAC o GEN `z:real^N` o SPEC `(g:real^N->real^M) z`) THEN
FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [
continuous_at]) THEN
DISCH_THEN(MP_TAC o SPEC `d0:real`) THEN ASM_REWRITE_TAC[
dist] THEN
DISCH_THEN(X_CHOOSE_THEN `d1:real` STRIP_ASSUME_TAC) THEN
FIRST_X_ASSUM(MP_TAC o SPEC `y:real^N` o
GEN_REWRITE_RULE I [
open_def]) THEN
ASM_REWRITE_TAC[
dist] THEN
DISCH_THEN(X_CHOOSE_THEN `d2:real` STRIP_ASSUME_TAC) THEN
MP_TAC(SPECL [`d1:real`; `d2:real`]
REAL_DOWN2) THEN
ASM_REWRITE_TAC[] THEN
MATCH_MP_TAC
MONO_EXISTS THEN X_GEN_TAC `d:real` THEN STRIP_TAC THEN
ASM_REWRITE_TAC[] THEN
X_GEN_TAC `z:real^N` THEN DISCH_TAC THEN MATCH_MP_TAC
REAL_LE_TRANS THEN
EXISTS_TAC `C * (e / C) *
norm((g:real^N->real^M) z - g y)` THEN
CONJ_TAC THENL
[ALL_TAC;
ASM_SIMP_TAC[REAL_MUL_ASSOC;
REAL_LE_RMUL;
REAL_DIV_LMUL;
REAL_EQ_IMP_LE;
REAL_LT_IMP_NZ;
NORM_POS_LE]] THEN
MATCH_MP_TAC
REAL_LE_TRANS THEN
EXISTS_TAC `C *
norm(f((g:real^N->real^M) z) - y - f'(g z - g y))` THEN
CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[
REAL_LT_TRANS;
REAL_LE_LMUL_EQ]] THEN
MATCH_MP_TAC
REAL_LE_TRANS THEN
EXISTS_TAC
`
norm(g'(f((g:real^N->real^M) z) - y - f'(g z - g y)):real^M)` THEN
ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[
LINEAR_SUB] THEN
GEN_REWRITE_TAC LAND_CONV [GSYM
NORM_NEG] THEN
REWRITE_TAC[VECTOR_ARITH
`--(gz:real^N - gy - (z - y)) = z - y - (gz - gy)`] THEN
ASM_MESON_TAC[
REAL_LE_REFL;
REAL_LT_TRANS];
ALL_TAC] THEN
SUBGOAL_THEN
`?B d. &0 < B /\ &0 < d /\
!z.
norm(z - y) < d
==>
norm((g:real^N->real^M)(z) - g(y)) <= B *
norm(z - y)`
STRIP_ASSUME_TAC THENL
[EXISTS_TAC `&2 * C` THEN
FIRST_X_ASSUM(MP_TAC o SPEC `&1 / &2`) THEN
CONV_TAC REAL_RAT_REDUCE_CONV THEN
MATCH_MP_TAC
MONO_EXISTS THEN X_GEN_TAC `d:real` THEN
ASM_SIMP_TAC[
REAL_LT_MUL;
REAL_OF_NUM_LT; ARITH] THEN
DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
MATCH_MP_TAC
MONO_FORALL THEN X_GEN_TAC `z:real^N` THEN
MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN
MATCH_MP_TAC(REAL_ARITH
`
norm(dg) <=
norm(dg') +
norm(dg - dg') /\
((&2 * (&1 - h)) *
norm(dg) = &1 *
norm(dg)) /\
norm(dg') <= c *
norm(d)
==>
norm(dg - dg') <= h *
norm(dg)
==>
norm(dg) <= (&2 * c) *
norm(d)`) THEN
CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_REWRITE_TAC[
NORM_TRIANGLE_SUB];
ALL_TAC] THEN
REWRITE_TAC[
HAS_DERIVATIVE_AT_ALT] THEN ASM_REWRITE_TAC[] THEN
X_GEN_TAC `e:real` THEN DISCH_TAC THEN
FIRST_X_ASSUM(MP_TAC o SPEC `e / B`) THEN
ASM_SIMP_TAC[
REAL_LT_DIV] THEN
DISCH_THEN(X_CHOOSE_THEN `d':real` STRIP_ASSUME_TAC) THEN
MP_TAC(SPECL [`d:real`; `d':real`]
REAL_DOWN2) THEN ASM_REWRITE_TAC[] THEN
MATCH_MP_TAC
MONO_EXISTS THEN X_GEN_TAC `k:real` THEN
STRIP_TAC THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `z:real^N` THEN
DISCH_TAC THEN MATCH_MP_TAC
REAL_LE_TRANS THEN
EXISTS_TAC `e / B *
norm ((g:real^N->real^M) z - g y)` THEN
CONJ_TAC THENL [ASM_MESON_TAC[
REAL_LT_TRANS]; ALL_TAC] THEN
ASM_SIMP_TAC[
real_div; GSYM REAL_MUL_ASSOC;
REAL_LE_LMUL_EQ] THEN
ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
ASM_SIMP_TAC[GSYM
real_div;
REAL_LE_LDIV_EQ] THEN
ASM_MESON_TAC[REAL_MUL_SYM;
REAL_LT_TRANS]);;
(* ------------------------------------------------------------------------- *)
(* Simply rewrite that based on the domain point x. *)
(* ------------------------------------------------------------------------- *)
(* ------------------------------------------------------------------------- *)
(* This is the version in Dieudonne', assuming continuity of f and g. *)
(* ------------------------------------------------------------------------- *)
(* ------------------------------------------------------------------------- *)
(* Here's the simplest way of not assuming much about g. *)
(* ------------------------------------------------------------------------- *)
(* ------------------------------------------------------------------------- *)
(* Proving surjectivity via Brouwer fixpoint theorem. *)
(* ------------------------------------------------------------------------- *)
(* ------------------------------------------------------------------------- *)
(* See Sussmann: "Multidifferential calculus", Theorem 2.1.1 *)
(* ------------------------------------------------------------------------- *)
(* ------------------------------------------------------------------------- *)
(* Hence the following eccentric variant of the inverse function theorem. *)
(* This has no continuity assumptions, but we do need the inverse function. *)
(* We could put f' o g = I but this happens to fit with the minimal linear *)
(* algebra theory I've set up so far. *)
(* ------------------------------------------------------------------------- *)
(* ------------------------------------------------------------------------- *)
(* A rewrite based on the other domain. *)
(* ------------------------------------------------------------------------- *)
(* ------------------------------------------------------------------------- *)
(* On a region. *)
(* ------------------------------------------------------------------------- *)
(* ------------------------------------------------------------------------- *)
(* Invertible derivative continous at a point implies local injectivity. *)
(* It's only for this we need continuity of the derivative, except of course *)
(* if we want the fact that the inverse derivative is also continuous. So if *)
(* we know for some other reason that the inverse function exists, it's OK. *)
(* ------------------------------------------------------------------------- *)
(* ------------------------------------------------------------------------- *)
(* Uniformly convergent sequence of derivatives. *)
(* ------------------------------------------------------------------------- *)
let HAS_DERIVATIVE_SEQUENCE_LIPSCHITZ = prove
(`!s f:num->real^M->real^N f' g'.
convex s /\
(!n x. x
IN s ==> ((f n)
has_derivative (f' n x)) (
at x
within s)) /\
(!e. &0 < e
==> ?N. !n x h. n >= N /\ x
IN s
==>
norm(f' n x h - g' x h) <= e *
norm(h))
==> !e. &0 < e
==> ?N. !m n x y. m >= N /\ n >= N /\ x
IN s /\ y
IN s
==>
norm((f m x - f n x) - (f m y - f n y))
<= e *
norm(x - y)`,
REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN
ASM_REWRITE_TAC[
REAL_HALF] THEN MATCH_MP_TAC
MONO_EXISTS THEN
X_GEN_TAC `N:num` THEN DISCH_TAC THEN
MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN
ASM_CASES_TAC `m:num >= N` THEN ASM_REWRITE_TAC[] THEN
ASM_CASES_TAC `n:num >= N` THEN ASM_REWRITE_TAC[] THEN
MATCH_MP_TAC
DIFFERENTIABLE_BOUND THEN
EXISTS_TAC `\x h. (f':num->real^M->real^M->real^N) m x h - f' n x h` THEN
ASM_SIMP_TAC[
HAS_DERIVATIVE_SUB; ETA_AX] THEN
X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN
SUBGOAL_THEN
`!h.
norm((f':num->real^M->real^M->real^N) m x h - f' n x h) <= e *
norm(h)`
MP_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[
HAS_DERIVATIVE_WITHIN_ALT]) THEN
ASM_SIMP_TAC[
ONORM;
LINEAR_COMPOSE_SUB; ETA_AX] THEN
X_GEN_TAC `h:real^M` THEN SUBST1_TAC(VECTOR_ARITH
`(f':num->real^M->real^M->real^N) m x h - f' n x h =
(f' m x h - g' x h) + --(f' n x h - g' x h)`) THEN
MATCH_MP_TAC
NORM_TRIANGLE_LE THEN
ASM_SIMP_TAC[
NORM_NEG; REAL_ARITH
`a <= e / &2 * h /\ b <= e / &2 * h ==> a + b <= e * h`]);;
let HAS_DERIVATIVE_SEQUENCE = prove
(`!s f:num->real^M->real^N f' g'.
convex s /\
(!n x. x
IN s ==> ((f n)
has_derivative (f' n x)) (
at x
within s)) /\
(!e. &0 < e
==> ?N. !n x h. n >= N /\ x
IN s
==>
norm(f' n x h - g' x h) <= e *
norm(h)) /\
(?x l. x
IN s /\ ((\n. f n x) --> l)
sequentially)
==> ?g. !x. x
IN s
==> ((\n. f n x) --> g x)
sequentially /\
(g
has_derivative g'(x)) (
at x
within s)`,
REPEAT GEN_TAC THEN
REPLICATE_TAC 2 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "O") MP_TAC) THEN
DISCH_THEN(X_CHOOSE_THEN `x0:real^M` STRIP_ASSUME_TAC) THEN
SUBGOAL_TAC "A"
`!e. &0 < e
==> ?N. !m n x y. m >= N /\ n >= N /\ x
IN s /\ y
IN s
==>
norm(((f:num->real^M->real^N) m x - f n x) -
(f m y - f n y))
<= e *
norm(x - y)`
[MATCH_MP_TAC
HAS_DERIVATIVE_SEQUENCE_LIPSCHITZ THEN
ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]] THEN
SUBGOAL_THEN
`?g:real^M->real^N. !x. x
IN s ==> ((\n. f n x) --> g x)
sequentially`
MP_TAC THENL
[REWRITE_TAC[GSYM
SKOLEM_THM;
RIGHT_EXISTS_IMP_THM] THEN
X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN
GEN_REWRITE_TAC I [
CONVERGENT_EQ_CAUCHY] THEN
FIRST_X_ASSUM(MP_TAC o MATCH_MP
CONVERGENT_IMP_CAUCHY) THEN
REWRITE_TAC[
cauchy;
dist] THEN DISCH_THEN(LABEL_TAC "B") THEN
X_GEN_TAC `e:real` THEN DISCH_TAC THEN
ASM_CASES_TAC `x:real^M = x0` THEN ASM_SIMP_TAC[] THEN
REMOVE_THEN "B" (MP_TAC o SPEC `e / &2`) THEN
ASM_REWRITE_TAC[
REAL_HALF] THEN
DISCH_THEN(X_CHOOSE_THEN `N1:num` STRIP_ASSUME_TAC) THEN
REMOVE_THEN "A" (MP_TAC o SPEC `e / &2 /
norm(x - x0:real^M)`) THEN
ASM_SIMP_TAC[
REAL_LT_DIV;
NORM_POS_LT;
REAL_HALF;
VECTOR_SUB_EQ] THEN
DISCH_THEN(X_CHOOSE_TAC `N2:num`) THEN
EXISTS_TAC `N1 + N2:num` THEN REPEAT GEN_TAC THEN
DISCH_THEN(CONJUNCTS_THEN (STRIP_ASSUME_TAC o MATCH_MP
(ARITH_RULE `m >= N1 + N2:num ==> m >= N1 /\ m >= N2`))) THEN
SUBST1_TAC(VECTOR_ARITH
`(f:num->real^M->real^N) m x - f n x =
(f m x - f n x - (f m x0 - f n x0)) + (f m x0 - f n x0)`) THEN
MATCH_MP_TAC
NORM_TRIANGLE_LT THEN
FIRST_X_ASSUM(MP_TAC o SPECL
[`m:num`; `n:num`; `x:real^M`; `x0:real^M`]) THEN
FIRST_X_ASSUM(MP_TAC o SPECL [`m:num`; `n:num`]) THEN
ASM_SIMP_TAC[
REAL_DIV_RMUL;
NORM_EQ_0;
VECTOR_SUB_EQ] THEN REAL_ARITH_TAC;
ALL_TAC] THEN
MATCH_MP_TAC
MONO_EXISTS THEN GEN_TAC THEN SIMP_TAC[] THEN
DISCH_THEN(LABEL_TAC "B") THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN
REWRITE_TAC[
HAS_DERIVATIVE_WITHIN_ALT] THEN
SUBGOAL_TAC "C"
`!e. &0 < e
==> ?N. !n x y. n >= N /\ x
IN s /\ y
IN s
==>
norm(((f:num->real^M->real^N) n x - f n y) -
(g x - g y))
<= e *
norm(x - y)`
[X_GEN_TAC `e:real` THEN DISCH_TAC THEN
REMOVE_THEN "A" (MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN
MATCH_MP_TAC
MONO_EXISTS THEN X_GEN_TAC `N:num` THEN
MATCH_MP_TAC
MONO_FORALL THEN X_GEN_TAC `n:num` THEN
DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`u:real^M`; `v:real^M`] THEN
STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN `m:num` o SPECL
[`m:num`; `u:real^M`; `v:real^M`]) THEN
DISCH_TAC THEN MATCH_MP_TAC(ISPEC `
sequentially`
LIM_NORM_UBOUND) THEN
EXISTS_TAC
`\m. ((f:num->real^M->real^N) n u - f n v) - (f m u - f m v)` THEN
REWRITE_TAC[
eventually;
TRIVIAL_LIMIT_SEQUENTIALLY] THEN
ASM_SIMP_TAC[
SEQUENTIALLY;
LIM_SUB;
LIM_CONST] THEN EXISTS_TAC `N:num` THEN
ONCE_REWRITE_TAC[VECTOR_ARITH
`(x - y) - (u - v) = (x - u) - (y - v):real^N`] THEN
ASM_MESON_TAC[
GE_REFL]] THEN
CONJ_TAC THENL
[SUBGOAL_TAC "D"
`!u. ((\n. (f':num->real^M->real^M->real^N) n x u) --> g' x u)
sequentially`
[REWRITE_TAC[
LIM_SEQUENTIALLY;
dist] THEN REPEAT STRIP_TAC THEN
ASM_CASES_TAC `u =
vec 0:real^M` THENL
[REMOVE_THEN "O" (MP_TAC o SPEC `e:real`);
REMOVE_THEN "O" (MP_TAC o SPEC `e / &2 /
norm(u:real^M)`)] THEN
ASM_SIMP_TAC[
NORM_POS_LT;
REAL_LT_DIV;
REAL_OF_NUM_LT; ARITH] THEN
MATCH_MP_TAC
MONO_EXISTS THEN GEN_TAC THEN
MATCH_MP_TAC
MONO_FORALL THEN GEN_TAC THEN
DISCH_THEN(MP_TAC o SPECL [`x:real^M`; `u:real^M`]) THEN
DISCH_THEN(fun
th -> DISCH_TAC THEN MP_TAC
th) THEN
ASM_SIMP_TAC[
GE;
NORM_0;
REAL_MUL_RZERO;
NORM_LE_0] THEN
ASM_SIMP_TAC[
REAL_DIV_RMUL;
NORM_EQ_0] THEN
UNDISCH_TAC `&0 < e` THEN REAL_ARITH_TAC] THEN
REWRITE_TAC[
linear] THEN ONCE_REWRITE_TAC[GSYM
VECTOR_SUB_EQ] THEN
CONJ_TAC THENL
[MAP_EVERY X_GEN_TAC [`u:real^M`; `v:real^M`];
MAP_EVERY X_GEN_TAC [`c:real`; `u:real^M`]] THEN
MATCH_MP_TAC(ISPEC `
sequentially`
LIM_UNIQUE) THENL
[EXISTS_TAC
`\n. (f':num->real^M->real^M->real^N) n x (u + v) -
(f' n x u + f' n x v)`;
EXISTS_TAC
`\n. (f':num->real^M->real^M->real^N) n x (c % u) -
c % f' n x u`] THEN
ASM_SIMP_TAC[
TRIVIAL_LIMIT_SEQUENTIALLY;
LIM_SUB;
LIM_ADD;
LIM_CMUL] THEN
RULE_ASSUM_TAC(REWRITE_RULE[
has_derivative_within;
linear]) THEN
ASM_SIMP_TAC[
VECTOR_SUB_REFL;
LIM_CONST];
ALL_TAC] THEN
X_GEN_TAC `e:real` THEN DISCH_TAC THEN
MAP_EVERY (fun s -> REMOVE_THEN s (MP_TAC o SPEC `e / &3`)) ["C";
"O"] THEN
ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN
DISCH_THEN(X_CHOOSE_THEN `N1:num` (LABEL_TAC "C")) THEN
DISCH_THEN(X_CHOOSE_THEN `N2:num` (LABEL_TAC "A")) THEN
REMOVE_THEN "C" (MP_TAC o GEN `y:real^M` o
SPECL [`N1 + N2:num`; `x:real^M`; `y - x:real^M`]) THEN
REMOVE_THEN "A" (MP_TAC o GEN `y:real^M` o
SPECL [`N1 + N2:num`; `y:real^M`; `x:real^M`]) THEN
FIRST_X_ASSUM(MP_TAC o SPECL [`N1 + N2:num`; `x:real^M`]) THEN
ASM_REWRITE_TAC[ARITH_RULE `m + n >= m:num /\ m + n >= n`] THEN
REWRITE_TAC[HAS_DERIVATIVE_WITHIN_ALT] THEN
DISCH_THEN(MP_TAC o SPEC `e / &3` o CONJUNCT2) THEN
ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN
DISCH_THEN(X_CHOOSE_THEN `d1:real` STRIP_ASSUME_TAC) THEN
DISCH_THEN(LABEL_TAC "D1") THEN DISCH_THEN(LABEL_TAC "D2") THEN
EXISTS_TAC `d1:real` THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `y:real^M` THEN
DISCH_TAC THEN REMOVE_THEN "D2" (MP_TAC o SPEC `y:real^M`) THEN
REMOVE_THEN "D1" (MP_TAC o SPEC `y:real^M`) THEN ANTS_TAC THENL
[ASM_MESON_TAC[REAL_LT_TRANS; NORM_SUB]; ALL_TAC] THEN
FIRST_X_ASSUM(MP_TAC o SPEC `y:real^M`) THEN ANTS_TAC THENL
[ASM_MESON_TAC[REAL_LT_TRANS; NORM_SUB]; ALL_TAC] THEN
MATCH_MP_TAC(REAL_ARITH
`d <= a + b + c
==> a <= e / &3 * n ==> b <= e / &3 * n ==> c <= e / &3 * n
==> d <= e * n`) THEN
GEN_REWRITE_TAC (funpow 2 RAND_CONV o LAND_CONV) [NORM_SUB] THEN
MATCH_MP_TAC(REAL_ARITH
`(norm(x + y + z) = norm(a)) /\
norm(x + y + z) <= norm(x) + norm(y + z) /\
norm(y + z) <= norm(y) + norm(z)
==> norm(a) <= norm(x) + norm(y) + norm(z)`) THEN
REWRITE_TAC[NORM_TRIANGLE] THEN AP_TERM_TAC THEN VECTOR_ARITH_TAC);;
(* ------------------------------------------------------------------------- *)
(* Can choose to line up antiderivatives if we want. *)
(* ------------------------------------------------------------------------- *)
let HAS_ANTIDERIVATIVE_SEQUENCE = prove
(`!s f:num->real^M->real^N f' g'.
convex s /\
(!n x. x
IN s ==> ((f n)
has_derivative (f' n x)) (
at x
within s)) /\
(!e. &0 < e
==> ?N. !n x h. n >= N /\ x
IN s
==>
norm(f' n x h - g' x h) <= e *
norm(h))
==> ?g. !x. x
IN s ==> (g
has_derivative g'(x)) (
at x
within s)`,
REPEAT STRIP_TAC THEN ASM_CASES_TAC `(s:real^M->bool) = {}` THEN
ASM_REWRITE_TAC[
NOT_IN_EMPTY] THEN
FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM
MEMBER_NOT_EMPTY]) THEN
DISCH_THEN(X_CHOOSE_TAC `a:real^M`) THEN
MP_TAC(ISPECL
[`s:real^M->bool`;
`\n x. (f:num->real^M->real^N) n x + (f 0 a - f n a)`;
`f':num->real^M->real^M->real^N`;
`g':real^M->real^M->real^N`]
HAS_DERIVATIVE_SEQUENCE) THEN
ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ALL_TAC; MESON_TAC[]] THEN
CONJ_TAC THENL
[REPEAT STRIP_TAC THEN
SUBGOAL_THEN `(f':num->real^M->real^M->real^N) n x =
\h. f' n x h +
vec 0`
SUBST1_TAC THENL [SIMP_TAC[
FUN_EQ_THM] THEN VECTOR_ARITH_TAC; ALL_TAC] THEN
MATCH_MP_TAC
HAS_DERIVATIVE_ADD THEN
ASM_SIMP_TAC[
HAS_DERIVATIVE_CONST; ETA_AX];
MAP_EVERY EXISTS_TAC [`a:real^M`; `f 0 (a:real^M) :real^N`] THEN
ASM_REWRITE_TAC[VECTOR_ARITH `a + b - a = b:real^N`;
LIM_CONST]]);;
(* ------------------------------------------------------------------------- *)
(* Differentiation of a series. *)
(* ------------------------------------------------------------------------- *)
(* ------------------------------------------------------------------------- *)
(* Derivative with composed bilinear function. *)
(* ------------------------------------------------------------------------- *)
(* ------------------------------------------------------------------------- *)
(* Considering derivative R(^1)->R^n as a vector. *)
(* ------------------------------------------------------------------------- *)
parse_as_infix ("has_vector_derivative",(12,"right"));;
(* ------------------------------------------------------------------------- *)
(* Various versions of Kachurovskii's theorem. *)
(* ------------------------------------------------------------------------- *)
let CONVEX_ON_DERIVATIVE_SECANT,CONVEX_ON_DERIVATIVES =
(CONJ_PAIR o prove)
(`(!f f' s:real^N->bool.
convex s /\
(!x. x IN s ==> ((lift o f) has_derivative (lift o f'(x)))
(at x within s))
==> (f convex_on s <=>
!x y. x IN s /\ y IN s ==> f'(x)(y - x) <= f y - f x)) /\
(!f f' s:real^N->bool.
convex s /\
(!x. x IN s ==> ((lift o f) has_derivative (lift o f'(x)))
(at x within s))
==> (f convex_on s <=>
!x y. x IN s /\ y IN s ==> f'(x)(y - x) <= f'(y)(y - x)))`,
REWRITE_TAC[AND_FORALL_THM] THEN REPEAT GEN_TAC THEN
REWRITE_TAC[TAUT `(a ==> b) /\ (a ==> c) <=> a ==> b /\ c`] THEN
STRIP_TAC THEN MATCH_MP_TAC(TAUT
`(a ==> b) /\ (b ==> c) /\ (c ==> a) ==> (a <=> b) /\ (a <=> c)`) THEN
REPEAT CONJ_TAC THENL
[REPEAT STRIP_TAC THEN MATCH_MP_TAC CONVEX_ON_DERIVATIVE_SECANT_IMP THEN
EXISTS_TAC `s:real^N->bool` THEN ASM_SIMP_TAC[ETA_AX] THEN
ASM_MESON_TAC[CONVEX_CONTAINS_SEGMENT];
DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN
STRIP_TAC THEN FIRST_X_ASSUM(fun th ->
MP_TAC(ISPECL [`x:real^N`; `y:real^N`] th) THEN
MP_TAC(ISPECL [`y:real^N`; `x:real^N`] th)) THEN
ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REAL_ARITH
`f''' = --f'' ==> f''' <= x - y ==> f' <= y - x ==> f' <= f''`) THEN
GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM VECTOR_NEG_SUB] THEN
GEN_REWRITE_TAC I [GSYM LIFT_EQ] THEN REWRITE_TAC[LIFT_NEG] THEN
SPEC_TAC(`y - x:real^N`,`z:real^N`) THEN
MATCH_MP_TAC(REWRITE_RULE[RIGHT_FORALL_IMP_THM] LINEAR_NEG) THEN
REWRITE_TAC[GSYM o_DEF] THEN REWRITE_TAC[GSYM I_DEF; I_O_ID] THEN
ASM_MESON_TAC[has_derivative];
ALL_TAC] THEN
DISCH_TAC THEN REWRITE_TAC[convex_on] THEN
MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN
ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN
REWRITE_TAC[TAUT `a /\ b /\ c /\ d /\ e <=> e /\ a /\ b /\ c /\ d`] THEN
REWRITE_TAC[IMP_CONJ; REAL_ARITH `u + v = &1 <=> u = &1 - v`] THEN
REWRITE_TAC[FORALL_UNWIND_THM2; REAL_SUB_LE] THEN X_GEN_TAC `u:real` THEN
REPEAT STRIP_TAC THEN
ASM_CASES_TAC `u = &0` THEN
ASM_SIMP_TAC[REAL_SUB_RZERO; VECTOR_MUL_LZERO; VECTOR_MUL_LID; REAL_LE_REFL;
REAL_MUL_LZERO; REAL_MUL_LID; VECTOR_ADD_RID; REAL_ADD_RID] THEN
ASM_CASES_TAC `u = &1` THEN
ASM_SIMP_TAC[REAL_SUB_REFL; VECTOR_MUL_LZERO; VECTOR_MUL_LID; REAL_LE_REFL;
REAL_MUL_LZERO; REAL_MUL_LID; VECTOR_ADD_LID; REAL_ADD_LID] THEN
SUBGOAL_THEN `&0 < u /\ u < &1` STRIP_ASSUME_TAC THENL
[ASM_REWRITE_TAC[REAL_LT_LE]; ALL_TAC] THEN
MP_TAC(ISPECL
[`lift o (f:real^N->real) o (\u. (&1 - drop u) % a + drop u % b)`;
`\x:real^1. lift o f'((&1 - drop x) % a + drop x % b) o
(\u. --(drop u) % a + drop u % b:real^N)`] MVT_VERY_SIMPLE) THEN
DISCH_THEN(fun th ->
MP_TAC(ISPECL [`vec 0:real^1`; `lift u`] th) THEN
MP_TAC(ISPECL [`lift u`; `vec 1:real^1`] th)) THEN
ASM_REWRITE_TAC[LIFT_DROP; o_THM] THEN
ASM_SIMP_TAC[DROP_VEC; VECTOR_MUL_LZERO; REAL_SUB_RZERO; REAL_LT_IMP_LE;
VECTOR_ADD_RID; VECTOR_MUL_LID; VECTOR_SUB_RZERO] THEN
MATCH_MP_TAC(TAUT
`(a1 /\ a2) /\ (b1 ==> b2 ==> c) ==> (a1 ==> b1) ==> (a2 ==> b2) ==> c`) THEN
CONJ_TAC THENL
[CONJ_TAC THEN X_GEN_TAC `v:real^1` THEN DISCH_TAC THEN
(REWRITE_TAC[o_ASSOC] THEN MATCH_MP_TAC DIFF_CHAIN_WITHIN THEN
REWRITE_TAC[] THEN CONJ_TAC THENL
[MATCH_MP_TAC HAS_DERIVATIVE_ADD THEN CONJ_TAC THENL
[ONCE_REWRITE_TAC[VECTOR_ARITH `(&1 - a) % x:real^N = x + --a % x`;
VECTOR_ARITH `--u % a:real^N = vec 0 + --u % a`] THEN
MATCH_MP_TAC HAS_DERIVATIVE_ADD THEN
REWRITE_TAC[HAS_DERIVATIVE_CONST];
ALL_TAC] THEN
MATCH_MP_TAC HAS_DERIVATIVE_LINEAR THEN
REWRITE_TAC[linear; DROP_ADD; DROP_CMUL] THEN VECTOR_ARITH_TAC;
MATCH_MP_TAC HAS_DERIVATIVE_WITHIN_SUBSET THEN
EXISTS_TAC `s:real^N->bool` THEN CONJ_TAC THENL
[FIRST_X_ASSUM MATCH_MP_TAC;
REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN GEN_TAC THEN DISCH_TAC] THEN
FIRST_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [CONVEX_ALT]) THEN
RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; LIFT_DROP; DROP_VEC]) THEN
ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC]);
REWRITE_TAC[REAL_SUB_REFL; VECTOR_MUL_LZERO; VECTOR_ADD_LID] THEN
REWRITE_TAC[EXISTS_LIFT; LIFT_DROP; IN_INTERVAL_1; DROP_VEC] THEN
REWRITE_TAC[GSYM LIFT_SUB; LIFT_EQ] THEN
REWRITE_TAC[DROP_SUB; DROP_VEC; LIFT_DROP] THEN
REWRITE_TAC[VECTOR_ARITH `--u % a + u % b:real^N = u % (b - a)`] THEN
REWRITE_TAC[LEFT_IMP_EXISTS_THM; RIGHT_IMP_FORALL_THM] THEN
MAP_EVERY X_GEN_TAC [`w:real`; `v:real`] THEN
DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN
ONCE_REWRITE_TAC[TAUT `a ==> b /\ c ==> d <=> b ==> a ==> c ==> d`] THEN
STRIP_TAC THEN REWRITE_TAC[IMP_IMP] THEN
DISCH_THEN(CONJUNCTS_THEN2 (MP_TAC o AP_TERM `(*) (u:real)`)
(MP_TAC o AP_TERM `(*) (&1 - u:real)`)) THEN
MATCH_MP_TAC(REAL_ARITH
`f1 <= f2 /\ (xa <= xb ==> a <= b)
==> xa = f1 ==> xb = f2 ==> a <= b`) THEN
CONJ_TAC THENL [ALL_TAC; REAL_ARITH_TAC] THEN
SUBGOAL_THEN
`((&1 - v) % a + v % b:real^N) IN s /\
((&1 - w) % a + w % b:real^N) IN s`
STRIP_ASSUME_TAC THENL
[CONJ_TAC THEN
FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [CONVEX_ALT]) THEN
ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC;
ALL_TAC] THEN
SUBGOAL_THEN
`linear(lift o (f'((&1 - v) % a + v % b:real^N):real^N->real)) /\
linear(lift o (f'((&1 - w) % a + w % b:real^N):real^N->real))`
MP_TAC THENL [ASM_MESON_TAC[has_derivative]; ALL_TAC] THEN
DISCH_THEN(CONJUNCTS_THEN(MP_TAC o MATCH_MP LINEAR_CMUL)) THEN
ASM_REWRITE_TAC[o_THM; GSYM LIFT_NEG; GSYM LIFT_CMUL; LIFT_EQ] THEN
REPEAT DISCH_TAC THEN ASM_REWRITE_TAC[] THEN
ONCE_REWRITE_TAC[REAL_ARITH `(&1 - u) * u * x = u * (&1 - u) * x`] THEN
REPEAT(MATCH_MP_TAC REAL_LE_LMUL THEN
CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]) THEN
FIRST_X_ASSUM(MP_TAC o SPECL
[`(&1 - v) % a + v % b:real^N`; `(&1 - w) % a + w % b:real^N`]) THEN
ASM_REWRITE_TAC[VECTOR_ARITH
`((&1 - v) % a + v % b) - ((&1 - w) % a + w % b):real^N =
(v - w) % (b - a)`] THEN
ASM_CASES_TAC `v:real = w` THEN ASM_SIMP_TAC[REAL_LE_REFL] THEN
SUBGOAL_THEN `&0 < w - v` (fun th -> SIMP_TAC[th; REAL_LE_LMUL_EQ]) THEN
ASM_REAL_ARITH_TAC]);;
let CONVEX_ON_SECANT_DERIVATIVE = prove
(`!f f' s:real^N->bool.
convex s /\
(!x. x
IN s ==> ((
lift o f)
has_derivative (
lift o f'(x)))
(
at x
within s))
==> (f
convex_on s <=>
!x y. x
IN s /\ y
IN s ==> f y - f x <= f'(y)(y - x))`,
REPEAT GEN_TAC THEN DISCH_TAC THEN
FIRST_ASSUM(SUBST1_TAC o MATCH_MP CONVEX_ON_DERIVATIVE_SECANT) THEN
GEN_REWRITE_TAC RAND_CONV [
SWAP_FORALL_THM] THEN
AP_TERM_TAC THEN GEN_REWRITE_TAC I [
FUN_EQ_THM] THEN
X_GEN_TAC `x:real^N` THEN REWRITE_TAC[] THEN
AP_TERM_TAC THEN GEN_REWRITE_TAC I [
FUN_EQ_THM] THEN
X_GEN_TAC `y:real^N` THEN REWRITE_TAC[] THEN
MAP_EVERY ASM_CASES_TAC [`(x:real^N)
IN s`; `(y:real^N)
IN s`] THEN
ASM_REWRITE_TAC[] THEN
MATCH_MP_TAC(REAL_ARITH
`f' = --f'' ==> (f' <= y - x <=> x - y <= f'')`) THEN
GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM
VECTOR_NEG_SUB] THEN
GEN_REWRITE_TAC I [GSYM
LIFT_EQ] THEN REWRITE_TAC[
LIFT_NEG] THEN
SPEC_TAC(`x - y:real^N`,`z:real^N`) THEN
MATCH_MP_TAC(REWRITE_RULE[
RIGHT_FORALL_IMP_THM]
LINEAR_NEG) THEN
REWRITE_TAC[GSYM
o_DEF] THEN
REWRITE_TAC[GSYM
I_DEF;
I_O_ID] THEN ASM_MESON_TAC[
has_derivative]);;