development/thales/chaff/tmp/vectors_patch.ml

   1 (* ========================================================================= *)
   2 (* Real vectors in Euclidean space, and elementary linear algebra.           *)
   3 (*                                                                           *)
   4 (*              (c) Copyright, John Harrison 1998-2008                       *)
   5 (* ========================================================================= *)
   6
   7 (* Feb 2, 2012, patch of a file not yet committed to SVN.
   8     Sent by email by Harrison.  Delete in a few weeks after Harrison commits changes *)
   9
  10 needs "Multivariate/misc.ml";;
  11
  12 (* ------------------------------------------------------------------------- *)
  13 (* Some common special cases.                                                *)
  14 (* ------------------------------------------------------------------------- *)
  15
  16 let FORALL_1 = prove
  17  (`(!i. 1 <= i /\ i <= 1 ==> P i) <=> P 1`,
  18   MESON_TAC[LE_ANTISYM]);;
  19
  20 let FORALL_2 = prove
  21  (`!P. (!i. 1 <= i /\ i <= 2 ==> P i) <=> P 1 /\ P 2`,
  22   MESON_TAC[ARITH_RULE `1 <= i /\ i <= 2 <=> i = 1 \/ i = 2`]);;
  23
  24 let FORALL_3 = prove
  25  (`!P. (!i. 1 <= i /\ i <= 3 ==> P i) <=> P 1 /\ P 2 /\ P 3`,
  26   MESON_TAC[ARITH_RULE `1 <= i /\ i <= 3 <=> i = 1 \/ i = 2 \/ i = 3`]);;
  27
  28 let SUM_1 = prove
  29  (`sum(1..1) f = f(1)`,
  30   REWRITE_TAC[SUM_SING_NUMSEG]);;
  31
  32 let SUM_2 = prove
  33  (`!t. sum(1..2) t = t(1) + t(2)`,
  34   REWRITE_TAC[num_CONV `2`; SUM_CLAUSES_NUMSEG] THEN
  35   REWRITE_TAC[SUM_SING_NUMSEG; ARITH; REAL_ADD_ASSOC]);;
  36
  37 let SUM_3 = prove
  38  (`!t. sum(1..3) t = t(1) + t(2) + t(3)`,
  39   REWRITE_TAC[num_CONV `3`; num_CONV `2`; SUM_CLAUSES_NUMSEG] THEN
  40   REWRITE_TAC[SUM_SING_NUMSEG; ARITH; REAL_ADD_ASSOC]);;
  41
  42 (* ------------------------------------------------------------------------- *)
  43 (* Basic componentwise operations on vectors.                                *)
  44 (* ------------------------------------------------------------------------- *)
  45
  46 let vector_add = new_definition
  47   `(vector_add:real^N->real^N->real^N) x y = lambda i. x$i + y$i`;;
  48
  49 let vector_sub = new_definition
  50   `(vector_sub:real^N->real^N->real^N) x y = lambda i. x$i - y$i`;;
  51
  52 let vector_neg = new_definition
  53   `(vector_neg:real^N->real^N) x = lambda i. --(x$i)`;;
  54
  55 overload_interface ("+",`(vector_add):real^N->real^N->real^N`);;
  56 overload_interface ("-",`(vector_sub):real^N->real^N->real^N`);;
  57 overload_interface ("--",`(vector_neg):real^N->real^N`);;
  58
  59 prioritize_real();;
  60
  61 let prioritize_vector = let ty = `:real^N` in
  62   fun () -> prioritize_overload ty;;
  63
  64 (* ------------------------------------------------------------------------- *)
  65 (* Also the scalar-vector multiplication.                                    *)
  66 (* ------------------------------------------------------------------------- *)
  67
  68 parse_as_infix("%",(21,"right"));;
  69
  70 let vector_mul = new_definition
  71   `((%):real->real^N->real^N) c x = lambda i. c * x$i`;;
  72
  73 (* ------------------------------------------------------------------------- *)
  74 (* Vectors corresponding to small naturals. Perhaps should overload "&"?     *)
  75 (* ------------------------------------------------------------------------- *)
  76
  77 let vec = new_definition
  78   `(vec:num->real^N) n = lambda i. &n`;;
  79
  80 (* ------------------------------------------------------------------------- *)
  81 (* Dot products.                                                             *)
  82 (* ------------------------------------------------------------------------- *)
  83
  84 parse_as_infix("dot",(20,"right"));;
  85
  86 let dot = new_definition
  87   `(x:real^N) dot (y:real^N) = sum(1..dimindex(:N)) (\i. x$i * y$i)`;;
  88
  89 let DOT_1 = prove
  90  (`(x:real^1) dot (y:real^1) = x$1 * y$1`,
  91   REWRITE_TAC[dot; DIMINDEX_1; SUM_1]);;
  92
  93 let DOT_2 = prove
  94  (`(x:real^2) dot (y:real^2) = x$1 * y$1 + x$2 * y$2`,
  95   REWRITE_TAC[dot; DIMINDEX_2; SUM_2]);;
  96
  97 let DOT_3 = prove
  98  (`(x:real^3) dot (y:real^3) = x$1 * y$1 + x$2 * y$2 + x$3 * y$3`,
  99   REWRITE_TAC[dot; DIMINDEX_3; SUM_3]);;
 100
 101 (* ------------------------------------------------------------------------- *)
 102 (* A naive proof procedure to lift really trivial arithmetic stuff from R.   *)
 103 (* ------------------------------------------------------------------------- *)
 104
 105 let VECTOR_ARITH_TAC =
 106   let RENAMED_LAMBDA_BETA th =
 107     if fst(dest_fun_ty(type_of(funpow 3 rand (concl th)))) = aty
 108     then INST_TYPE [aty,bty; bty,aty] LAMBDA_BETA else LAMBDA_BETA in
 109   POP_ASSUM_LIST(K ALL_TAC) THEN
 110   REPEAT(GEN_TAC ORELSE CONJ_TAC ORELSE DISCH_TAC ORELSE EQ_TAC) THEN
 111   REPEAT(POP_ASSUM MP_TAC) THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN
 112   REWRITE_TAC[dot; GSYM SUM_ADD_NUMSEG; GSYM SUM_SUB_NUMSEG;
 113               GSYM SUM_LMUL; GSYM SUM_RMUL; GSYM SUM_NEG] THEN
 114   (MATCH_MP_TAC SUM_EQ_NUMSEG ORELSE MATCH_MP_TAC SUM_EQ_0_NUMSEG ORELSE
 115    GEN_REWRITE_TAC ONCE_DEPTH_CONV [CART_EQ]) THEN
 116   REWRITE_TAC[AND_FORALL_THM] THEN TRY EQ_TAC THEN
 117   TRY(MATCH_MP_TAC MONO_FORALL) THEN GEN_TAC THEN
 118   REWRITE_TAC[TAUT `(a ==> b) /\ (a ==> c) <=> a ==> b /\ c`;
 119               TAUT `(a ==> b) \/ (a ==> c) <=> a ==> b \/ c`] THEN
 120   TRY(MATCH_MP_TAC(TAUT `(a ==> b ==> c) ==> (a ==> b) ==> (a ==> c)`)) THEN
 121   REWRITE_TAC[vector_add; vector_sub; vector_neg; vector_mul; vec] THEN
 122   DISCH_THEN(fun th -> REWRITE_TAC[MATCH_MP(RENAMED_LAMBDA_BETA th) th]) THEN
 123   REAL_ARITH_TAC;;
 124
 125 let VECTOR_ARITH tm = prove(tm,VECTOR_ARITH_TAC);;
 126
 127 (* ------------------------------------------------------------------------- *)
 128 (* Obvious "component-pushing".                                              *)
 129 (* ------------------------------------------------------------------------- *)
 130
 131 let VEC_COMPONENT = prove
 132  (`!k i. (vec k :real^N)$i = &k`,
 133   REPEAT GEN_TAC THEN
 134   SUBGOAL_THEN `?k. 1 <= k /\ k <= dimindex(:N) /\ !z:real^N. z$i = z$k`
 135   CHOOSE_TAC THENL
 136    [REWRITE_TAC[FINITE_INDEX_INRANGE];
 137     ASM_SIMP_TAC[vec; CART_EQ; LAMBDA_BETA]]);;
 138
 139 let VECTOR_ADD_COMPONENT = prove
 140  (`!x:real^N y i. (x + y)$i = x$i + y$i`,
 141   REPEAT GEN_TAC THEN
 142   SUBGOAL_THEN `?k. 1 <= k /\ k <= dimindex(:N) /\ !z:real^N. z$i = z$k`
 143   CHOOSE_TAC THENL
 144    [REWRITE_TAC[FINITE_INDEX_INRANGE];
 145     ASM_SIMP_TAC[vector_add; CART_EQ; LAMBDA_BETA]]);;
 146
 147 let VECTOR_SUB_COMPONENT = prove
 148  (`!x:real^N y i. (x - y)$i = x$i - y$i`,
 149   REPEAT GEN_TAC THEN
 150   SUBGOAL_THEN `?k. 1 <= k /\ k <= dimindex(:N) /\ !z:real^N. z$i = z$k`
 151   CHOOSE_TAC THENL
 152    [REWRITE_TAC[FINITE_INDEX_INRANGE];
 153     ASM_SIMP_TAC[vector_sub; CART_EQ; LAMBDA_BETA]]);;
 154
 155 let VECTOR_NEG_COMPONENT = prove
 156  (`!x:real^N i. (--x)$i = --(x$i)`,
 157   REPEAT GEN_TAC THEN
 158   SUBGOAL_THEN `?k. 1 <= k /\ k <= dimindex(:N) /\ !z:real^N. z$i = z$k`
 159   CHOOSE_TAC THENL
 160    [REWRITE_TAC[FINITE_INDEX_INRANGE];
 161     ASM_SIMP_TAC[vector_neg; CART_EQ; LAMBDA_BETA]]);;
 162
 163 let VECTOR_MUL_COMPONENT = prove
 164  (`!c x:real^N i. (c % x)$i = c * x$i`,
 165   REPEAT GEN_TAC THEN
 166   SUBGOAL_THEN `?k. 1 <= k /\ k <= dimindex(:N) /\ !z:real^N. z$i = z$k`
 167   CHOOSE_TAC THENL
 168    [REWRITE_TAC[FINITE_INDEX_INRANGE];
 169     ASM_SIMP_TAC[vector_mul; CART_EQ; LAMBDA_BETA]]);;
 170
 171 let COND_COMPONENT = prove
 172  (`(if b then x else y)$i = if b then x$i else y$i`,
 173   MESON_TAC[]);;
 174
 175 (* ------------------------------------------------------------------------- *)
 176 (* Some frequently useful arithmetic lemmas over vectors.                    *)
 177 (* ------------------------------------------------------------------------- *)
 178
 179 let VECTOR_ADD_SYM = VECTOR_ARITH `!x y:real^N. x + y = y + x`;;
 180
 181 let VECTOR_ADD_LID = VECTOR_ARITH `!x. vec 0 + x = x`;;
 182
 183 let VECTOR_ADD_RID = VECTOR_ARITH `!x. x + vec 0 = x`;;
 184
 185 let VECTOR_SUB_REFL = VECTOR_ARITH `!x. x - x = vec 0`;;
 186
 187 let VECTOR_ADD_LINV = VECTOR_ARITH `!x. --x + x = vec 0`;;
 188
 189 let VECTOR_ADD_RINV = VECTOR_ARITH `!x. x + --x = vec 0`;;
 190
 191 let VECTOR_SUB_RADD = VECTOR_ARITH `!x y. x - (x + y) = --y:real^N`;;
 192
 193 let VECTOR_NEG_SUB = VECTOR_ARITH `!x:real^N y. --(x - y) = y - x`;;
 194
 195 let VECTOR_SUB_EQ = VECTOR_ARITH `!x y. (x - y = vec 0) <=> (x = y)`;;
 196
 197 let VECTOR_MUL_ASSOC = VECTOR_ARITH `!a b x. a % (b % x) = (a * b) % x`;;
 198
 199 let VECTOR_MUL_LID = VECTOR_ARITH `!x. &1 % x = x`;;
 200
 201 let VECTOR_MUL_LZERO = VECTOR_ARITH `!x. &0 % x = vec 0`;;
 202
 203 let VECTOR_SUB_ADD = VECTOR_ARITH `(x - y) + y = x:real^N`;;
 204
 205 let VECTOR_SUB_ADD2 = VECTOR_ARITH `y + (x - y) = x:real^N`;;
 206
 207 let VECTOR_ADD_LDISTRIB = VECTOR_ARITH `c % (x + y) = c % x + c % y`;;
 208
 209 let VECTOR_SUB_LDISTRIB = VECTOR_ARITH `c % (x - y) = c % x - c % y`;;
 210
 211 let VECTOR_ADD_RDISTRIB = VECTOR_ARITH `(a + b) % x = a % x + b % x`;;
 212
 213 let VECTOR_SUB_RDISTRIB = VECTOR_ARITH `(a - b) % x = a % x - b % x`;;
 214
 215 let VECTOR_ADD_SUB = VECTOR_ARITH `(x + y:real^N) - x = y`;;
 216
 217 let VECTOR_EQ_ADDR = VECTOR_ARITH `(x + y = x) <=> (y = vec 0)`;;
 218
 219 let VECTOR_SUB = VECTOR_ARITH `x - y = x + --(y:real^N)`;;
 220
 221 let VECTOR_SUB_RZERO = VECTOR_ARITH `x - vec 0 = x`;;
 222
 223 let VECTOR_MUL_RZERO = VECTOR_ARITH `c % vec 0 = vec 0`;;
 224
 225 let VECTOR_NEG_MINUS1 = VECTOR_ARITH `--x = (--(&1)) % x`;;
 226
 227 let VECTOR_ADD_ASSOC = VECTOR_ARITH `(x:real^N) + y + z = (x + y) + z`;;
 228
 229 let VECTOR_SUB_LZERO = VECTOR_ARITH `vec 0 - x = --x`;;
 230
 231 let VECTOR_NEG_NEG = VECTOR_ARITH `--(--(x:real^N)) = x`;;
 232
 233 let VECTOR_MUL_LNEG = VECTOR_ARITH `--c % x = --(c % x)`;;
 234
 235 let VECTOR_MUL_RNEG = VECTOR_ARITH `c % --x = --(c % x)`;;
 236
 237 let VECTOR_NEG_0 = VECTOR_ARITH `--(vec 0) = vec 0`;;
 238
 239 let VECTOR_NEG_EQ_0 = VECTOR_ARITH `--x = vec 0 <=> x = vec 0`;;
 240
 241 let VECTOR_ADD_AC = VECTOR_ARITH
 242   `(m + n = n + m:real^N) /\
 243    ((m + n) + p = m + n + p) /\
 244    (m + n + p = n + m + p)`;;
 245
 246 let VEC_EQ = prove
 247  (`!m n. (vec m = vec n) <=> (m = n)`,
 248   SIMP_TAC[CART_EQ; VEC_COMPONENT; REAL_OF_NUM_EQ] THEN
 249   MESON_TAC[LE_REFL; DIMINDEX_GE_1]);;
 250
 251 (* ------------------------------------------------------------------------- *)
 252 (* Infinitude of Euclidean space.                                            *)
 253 (* ------------------------------------------------------------------------- *)
 254
 255 let EUCLIDEAN_SPACE_INFINITE = prove
 256  (`INFINITE(:real^N)`,
 257   REWRITE_TAC[INFINITE] THEN DISCH_TAC THEN
 258   FIRST_ASSUM(MP_TAC o ISPEC `vec:num->real^N` o
 259     MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] FINITE_IMAGE_INJ)) THEN
 260   REWRITE_TAC[VEC_EQ; SET_RULE `{x | f x IN UNIV} = UNIV`] THEN
 261   REWRITE_TAC[GSYM INFINITE; num_INFINITE]);;
 262
 263 (* ------------------------------------------------------------------------- *)
 264 (* Properties of the dot product.                                            *)
 265 (* ------------------------------------------------------------------------- *)
 266
 267 let DOT_SYM = VECTOR_ARITH `!x y. x dot y = y dot x`;;
 268
 269 let DOT_LADD = VECTOR_ARITH `!x y z. (x + y) dot z = (x dot z) + (y dot z)`;;
 270
 271 let DOT_RADD = VECTOR_ARITH `!x y z. x dot (y + z) = (x dot y) + (x dot z)`;;
 272
 273 let DOT_LSUB = VECTOR_ARITH `!x y z. (x - y) dot z = (x dot z) - (y dot z)`;;
 274
 275 let DOT_RSUB = VECTOR_ARITH `!x y z. x dot (y - z) = (x dot y) - (x dot z)`;;
 276
 277 let DOT_LMUL = VECTOR_ARITH `!c x y. (c % x) dot y = c * (x dot y)`;;
 278
 279 let DOT_RMUL = VECTOR_ARITH `!c x y. x dot (c % y) = c * (x dot y)`;;
 280
 281 let DOT_LNEG = VECTOR_ARITH `!x y. (--x) dot y = --(x dot y)`;;
 282
 283 let DOT_RNEG = VECTOR_ARITH `!x y. x dot (--y) = --(x dot y)`;;
 284
 285 let DOT_LZERO = VECTOR_ARITH `!x. (vec 0) dot x = &0`;;
 286
 287 let DOT_RZERO = VECTOR_ARITH `!x. x dot (vec 0) = &0`;;
 288
 289 let DOT_POS_LE = prove
 290  (`!x. &0 <= x dot x`,
 291   SIMP_TAC[dot; SUM_POS_LE_NUMSEG; REAL_LE_SQUARE]);;
 292
 293 let DOT_EQ_0 = prove
 294  (`!x:real^N. ((x dot x = &0) <=> (x = vec 0))`,
 295   REPEAT GEN_TAC THEN EQ_TAC THENL [ALL_TAC; MESON_TAC[DOT_LZERO]] THEN
 296   SIMP_TAC[dot; CART_EQ; vec; LAMBDA_BETA] THEN DISCH_TAC THEN
 297   ONCE_REWRITE_TAC[GSYM(REWRITE_CONV[REAL_ENTIRE] `x * x = &0`)] THEN
 298   MATCH_MP_TAC SUM_POS_EQ_0_NUMSEG THEN ASM_REWRITE_TAC[REAL_LE_SQUARE]);;
 299
 300 let DOT_POS_LT = prove
 301  (`!x. (&0 < x dot x) <=> ~(x = vec 0)`,
 302   REWRITE_TAC[REAL_LT_LE; DOT_POS_LE] THEN MESON_TAC[DOT_EQ_0]);;
 303
 304 let FORALL_DOT_EQ_0 = prove
 305  (`(!y. (!x. x dot y = &0) <=> y = vec 0) /\
 306    (!x. (!y. x dot y = &0) <=> x = vec 0)`,
 307   MESON_TAC[DOT_LZERO; DOT_RZERO; DOT_EQ_0]);;
 308
 309 (* ------------------------------------------------------------------------- *)
 310 (* Introduce norms, but defer many properties till we get square roots.      *)
 311 (* ------------------------------------------------------------------------- *)
 312
 313 make_overloadable "norm" `:A->real`;;
 314 overload_interface("norm",`vector_norm:real^N->real`);;
 315
 316 let vector_norm = new_definition
 317   `norm x = sqrt(x dot x)`;;
 318
 319 (* ------------------------------------------------------------------------- *)
 320 (* Useful for the special cases of 1 dimension.                              *)
 321 (* ------------------------------------------------------------------------- *)
 322
 323 let FORALL_DIMINDEX_1 = prove
 324  (`(!i. 1 <= i /\ i <= dimindex(:1) ==> P i) <=> P 1`,
 325   MESON_TAC[DIMINDEX_1; LE_ANTISYM]);;
 326
 327 (* ------------------------------------------------------------------------- *)
 328 (* The collapse of the general concepts to the real line R^1.                *)
 329 (* ------------------------------------------------------------------------- *)
 330
 331 let VECTOR_ONE = prove
 332  (`!x:real^1. x = lambda i. x$1`,
 333   SIMP_TAC[CART_EQ; LAMBDA_BETA] THEN MESON_TAC[DIMINDEX_1; LE_ANTISYM]);;
 334
 335 let FORALL_REAL_ONE = prove
 336  (`(!x:real^1. P x) <=> (!x. P(lambda i. x))`,
 337   EQ_TAC THEN SIMP_TAC[] THEN DISCH_TAC THEN GEN_TAC THEN
 338   FIRST_X_ASSUM(MP_TAC o SPEC `(x:real^1)$1`) THEN
 339   REWRITE_TAC[GSYM VECTOR_ONE]);;
 340
 341 let NORM_REAL = prove
 342  (`!x:real^1. norm(x) = abs(x$1)`,
 343   REWRITE_TAC[vector_norm; dot; DIMINDEX_1; SUM_SING_NUMSEG;
 344               GSYM REAL_POW_2; POW_2_SQRT_ABS]);;
 345
 346 (* ------------------------------------------------------------------------- *)
 347 (* Metric function.                                                          *)
 348 (* ------------------------------------------------------------------------- *)
 349
 350 override_interface("dist",`distance:real^N#real^N->real`);;
 351
 352 let dist = new_definition
 353   `dist(x,y) = norm(x - y)`;;
 354
 355 let DIST_REAL = prove
 356  (`!x:real^1 y. dist(x,y) = abs(x$1 - y$1)`,
 357   SIMP_TAC[dist; NORM_REAL; vector_sub; LAMBDA_BETA; LE_REFL; DIMINDEX_1]);;
 358
 359 (* ------------------------------------------------------------------------- *)
 360 (* A connectedness or intermediate value lemma with several applications.    *)
 361 (* ------------------------------------------------------------------------- *)
 362
 363 let CONNECTED_REAL_LEMMA = prove
 364  (`!f:real->real^N a b e1 e2.
 365         a <= b /\ f(a) IN e1 /\ f(b) IN e2 /\
 366         (!e x. a <= x /\ x <= b /\ &0 < e
 367                ==> ?d. &0 < d /\
 368                        !y. abs(y - x) < d ==> dist(f(y),f(x)) < e) /\
 369         (!y. y IN e1 ==> ?e. &0 < e /\ !y'. dist(y',y) < e ==> y' IN e1) /\
 370         (!y. y IN e2 ==> ?e. &0 < e /\ !y'. dist(y',y) < e ==> y' IN e2) /\
 371         ~(?x. a <= x /\ x <= b /\ f(x) IN e1 /\ f(x) IN e2)
 372         ==> ?x. a <= x /\ x <= b /\ ~(f(x) IN e1) /\ ~(f(x) IN e2)`,
 373   let tac = ASM_MESON_TAC[REAL_LT_IMP_LE; REAL_LE_TOTAL; REAL_LE_ANTISYM] in
 374   REWRITE_TAC[EXTENSION; NOT_IN_EMPTY] THEN REPEAT STRIP_TAC THEN
 375   MP_TAC(SPEC `\c. !x. a <= x /\ x <= c ==> (f(x):real^N) IN e1`
 376               REAL_COMPLETE) THEN
 377   REWRITE_TAC[] THEN ANTS_TAC THENL [tac; ALL_TAC] THEN
 378   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `x:real` THEN STRIP_TAC THEN
 379   SUBGOAL_THEN `a <= x /\ x <= b` STRIP_ASSUME_TAC THENL [tac; ALL_TAC] THEN
 380   ASM_REWRITE_TAC[] THEN
 381   SUBGOAL_THEN `!z. a <= z /\ z < x ==> (f(z):real^N) IN e1` ASSUME_TAC THENL
 382    [ASM_MESON_TAC[REAL_NOT_LT; REAL_LT_IMP_LE]; ALL_TAC] THEN
 383   REPEAT STRIP_TAC THENL
 384    [SUBGOAL_THEN
 385      `?d. &0 < d /\ !y. abs(y - x) < d ==> (f(y):real^N) IN e1`
 386     STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN
 387     ASM_MESON_TAC[REAL_ARITH `z <= x + e /\ e < d ==> z < x \/ abs(z - x) < d`;
 388                   REAL_ARITH `&0 < e ==> ~(x + e <= x)`; REAL_DOWN];
 389     SUBGOAL_THEN
 390      `?d. &0 < d /\ !y. abs(y - x) < d ==> (f(y):real^N) IN e2`
 391     STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN
 392     MP_TAC(SPECL [`x - a`; `d:real`] REAL_DOWN2) THEN ANTS_TAC THENL
 393      [ASM_MESON_TAC[REAL_LT_LE; REAL_SUB_LT]; ALL_TAC] THEN
 394     ASM_MESON_TAC[REAL_ARITH `e < x - a ==> a <= x - e`;
 395                   REAL_ARITH `&0 < e /\ x <= b ==> x - e <= b`;
 396       REAL_ARITH `&0 < e /\ e < d ==> x - e < x /\ abs((x - e) - x) < d`]]);;
 397
 398 (* ------------------------------------------------------------------------- *)
 399 (* One immediately useful corollary is the existence of square roots!        *)
 400 (* ------------------------------------------------------------------------- *)
 401
 402 let SQUARE_BOUND_LEMMA = prove
 403  (`!x. x < (&1 + x) * (&1 + x)`,
 404   GEN_TAC THEN REWRITE_TAC[REAL_POW_2] THEN
 405   MAP_EVERY (fun t -> MP_TAC(SPEC t REAL_LE_SQUARE)) [`x:real`; `&1 + x`] THEN
 406   REAL_ARITH_TAC);;
 407
 408 let SQUARE_CONTINUOUS = prove
 409  (`!x e. &0 < e
 410          ==> ?d. &0 < d /\ !y. abs(y - x) < d ==> abs(y * y - x * x) < e`,
 411   REPEAT STRIP_TAC THEN ASM_CASES_TAC `x = &0` THENL
 412    [ASM_REWRITE_TAC[REAL_MUL_LZERO; REAL_SUB_RZERO] THEN
 413     EXISTS_TAC `inv(&1 + inv(e))` THEN
 414     ASM_SIMP_TAC[REAL_LT_INV_EQ; REAL_LT_ADD; REAL_LT_01] THEN
 415     REPEAT STRIP_TAC THEN MATCH_MP_TAC  REAL_LTE_TRANS THEN
 416     EXISTS_TAC `inv(&1 + inv(e)) * inv(&1 + inv(e))` THEN
 417     ASM_SIMP_TAC[REAL_ABS_MUL; REAL_LT_MUL2; REAL_ABS_POS] THEN
 418     REWRITE_TAC[GSYM REAL_INV_MUL] THEN
 419     GEN_REWRITE_TAC RAND_CONV [GSYM REAL_INV_INV] THEN
 420     MATCH_MP_TAC REAL_LE_INV2 THEN
 421     ASM_SIMP_TAC[REAL_LT_IMP_LE; SQUARE_BOUND_LEMMA; REAL_LT_INV_EQ];
 422     MP_TAC(SPECL [`abs(x)`; `e / (&3 * abs(x))`] REAL_DOWN2)THEN
 423     ASM_SIMP_TAC[GSYM REAL_ABS_NZ; REAL_LT_DIV; REAL_LT_MUL; REAL_OF_NUM_LT;
 424                  ARITH; REAL_LT_RDIV_EQ] THEN
 425     MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN
 426     STRIP_TAC THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `y:real` THEN
 427     REWRITE_TAC[REAL_ARITH `x * x - y * y = (x - y) * (x + y)`] THEN
 428     DISCH_TAC THEN MATCH_MP_TAC REAL_LET_TRANS THEN
 429     EXISTS_TAC `d * &3 * abs(x)` THEN ASM_REWRITE_TAC[REAL_ABS_MUL] THEN
 430     MATCH_MP_TAC REAL_LE_MUL2 THEN
 431     ASM_SIMP_TAC[REAL_ABS_POS; REAL_LT_IMP_LE] THEN
 432     MAP_EVERY UNDISCH_TAC [`abs (y - x) < d`; `d < abs(x)`] THEN
 433     REAL_ARITH_TAC]);;
 434
 435 let SQRT_WORKS = prove
 436  (`!x. &0 <= x ==> &0 <= sqrt(x) /\ (sqrt(x) pow 2 = x)`,
 437   GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [REAL_LE_LT] THEN STRIP_TAC THENL
 438    [ALL_TAC;
 439     ASM_MESON_TAC[SQRT_0; REAL_POW_2; REAL_LE_REFL; REAL_MUL_LZERO]] THEN
 440   REWRITE_TAC[sqrt] THEN CONV_TAC SELECT_CONV THEN
 441   MP_TAC(ISPECL [`(\u. lambda i. u):real->real^1`; `&0`; `&1 + x`;
 442             `{u:real^1 | u$1 * u$1 < x}`; `{u:real^1 | u$1 * u$1 > x}`]
 443          CONNECTED_REAL_LEMMA) THEN
 444   SIMP_TAC[LAMBDA_BETA; LE_REFL; DIMINDEX_1; DIST_REAL;
 445            EXTENSION; IN_INTER; IN_ELIM_THM; NOT_IN_EMPTY;
 446            REAL_MUL_LZERO; FORALL_REAL_ONE; real_gt] THEN
 447   ANTS_TAC THENL [ALL_TAC; ASM_MESON_TAC[REAL_POW_2; REAL_LT_TOTAL]] THEN
 448   ASM_SIMP_TAC[REAL_LT_ANTISYM; REAL_ARITH `&0 < x ==> &0 <= &1 + x`] THEN
 449   REWRITE_TAC[SQUARE_BOUND_LEMMA] THEN
 450   MESON_TAC[SQUARE_CONTINUOUS; REAL_SUB_LT;
 451             REAL_ARITH `abs(z2 - x2) < y - x2 ==> z2 < y`;
 452             REAL_ARITH `abs(z2 - x2) < x2 - y ==> y < z2`]);;
 453
 454 let SQRT_POS_LE = prove
 455  (`!x. &0 <= x ==> &0 <= sqrt(x)`,
 456   MESON_TAC[SQRT_WORKS]);;
 457
 458 let SQRT_POW_2 = prove
 459  (`!x. &0 <= x ==> (sqrt(x) pow 2 = x)`,
 460   MESON_TAC[SQRT_WORKS]);;
 461
 462 let SQRT_MUL = prove
 463  (`!x y. &0 <= x /\ &0 <= y
 464            ==> (sqrt(x * y) = sqrt x * sqrt y)`,
 465   ASM_MESON_TAC[REAL_POW_2; SQRT_WORKS; REAL_LE_MUL; SQRT_UNIQUE;
 466                 REAL_ARITH `(x * y) * (x * y) = (x * x) * y * y`]);;
 467
 468 let SQRT_INV = prove
 469  (`!x. &0 <= x ==> (sqrt (inv x) = inv(sqrt x))`,
 470   MESON_TAC[SQRT_UNIQUE; SQRT_WORKS; REAL_POW_INV; REAL_LE_INV_EQ]);;
 471
 472 let SQRT_DIV = prove
 473  (`!x y. &0 <= x /\ &0 <= y ==> (sqrt (x / y) = sqrt x / sqrt y)`,
 474   SIMP_TAC[real_div; SQRT_MUL; SQRT_INV; REAL_LE_INV_EQ]);;
 475
 476 let SQRT_POW2 = prove
 477  (`!x. (sqrt(x) pow 2 = x) <=> &0 <= x`,
 478   MESON_TAC[REAL_POW_2; REAL_LE_SQUARE; SQRT_POW_2]);;
 479
 480 let SQRT_MONO_LT = prove
 481  (`!x y. &0 <= x /\ x < y ==> sqrt(x) < sqrt(y)`,
 482   REWRITE_TAC[GSYM REAL_NOT_LE] THEN
 483   MESON_TAC[REAL_LT_IMP_LE; REAL_NOT_LE; REAL_LE_TRANS;
 484             REAL_POW_LE2; SQRT_WORKS]);;
 485
 486 let SQRT_MONO_LE = prove
 487  (`!x y. &0 <= x /\ x <= y ==> sqrt(x) <= sqrt(y)`,
 488   MESON_TAC[REAL_LE_LT; SQRT_MONO_LT]);;
 489
 490 let SQRT_MONO_LT_EQ = prove
 491  (`!x y. &0 <= x /\ &0 <= y ==> (sqrt(x) < sqrt(y) <=> x < y)`,
 492   MESON_TAC[REAL_NOT_LT; SQRT_MONO_LT; SQRT_MONO_LE]);;
 493
 494 let SQRT_MONO_LE_EQ = prove
 495  (`!x y. &0 <= x /\ &0 <= y ==> (sqrt(x) <= sqrt(y) <=> x <= y)`,
 496   MESON_TAC[REAL_NOT_LT; SQRT_MONO_LT; SQRT_MONO_LE]);;
 497
 498 let SQRT_INJ = prove
 499  (`!x y. &0 <= x /\ &0 <= y ==> ((sqrt(x) = sqrt(y)) <=> (x = y))`,
 500   SIMP_TAC[GSYM REAL_LE_ANTISYM; SQRT_MONO_LE_EQ]);;
 501
 502 let SQRT_LT_0 = prove
 503  (`!x. &0 <= x ==> (&0 < sqrt x <=> &0 < x)`,
 504   MESON_TAC[SQRT_0; REAL_LE_REFL; SQRT_MONO_LT_EQ]);;
 505
 506 let SQRT_EQ_0 = prove
 507  (`!x. &0 <= x ==> ((sqrt x = &0) <=> (x = &0))`,
 508   MESON_TAC[SQRT_INJ; SQRT_0; REAL_LE_REFL]);;
 509
 510 let SQRT_POS_LT = prove
 511  (`!x. &0 < x ==> &0 < sqrt(x)`,
 512   MESON_TAC[REAL_LT_LE; SQRT_POS_LE; SQRT_EQ_0]);;
 513
 514 let REAL_LE_LSQRT = prove
 515  (`!x y. &0 <= x /\ &0 <= y /\ x <= y pow 2 ==> sqrt(x) <= y`,
 516   MESON_TAC[SQRT_MONO_LE; REAL_POW_LE; POW_2_SQRT]);;
 517
 518 let REAL_LE_RSQRT = prove
 519  (`!x y. x pow 2 <= y ==> x <= sqrt(y)`,
 520   MESON_TAC[REAL_LE_TOTAL; SQRT_MONO_LE; SQRT_POS_LE; REAL_POW_2;
 521             REAL_LE_SQUARE; REAL_LE_TRANS; POW_2_SQRT]);;
 522
 523 let REAL_LT_RSQRT = prove
 524  (`!x y. x pow 2 < y ==> x < sqrt(y)`,
 525   REPEAT STRIP_TAC THEN MATCH_MP_TAC(REAL_ARITH `abs x < a ==> x < a`) THEN
 526   REWRITE_TAC[GSYM POW_2_SQRT_ABS] THEN MATCH_MP_TAC SQRT_MONO_LT THEN
 527   ASM_REWRITE_TAC[REAL_POW_2; REAL_LE_SQUARE]);;
 528
 529 let SQRT_EVEN_POW2 = prove
 530  (`!n. EVEN n ==> (sqrt(&2 pow n) = &2 pow (n DIV 2))`,
 531   SIMP_TAC[EVEN_EXISTS; LEFT_IMP_EXISTS_THM; DIV_MULT; ARITH_EQ] THEN
 532   MESON_TAC[SQRT_UNIQUE; REAL_POW_POW; MULT_SYM; REAL_POW_LE; REAL_POS]);;
 533
 534 let REAL_DIV_SQRT = prove
 535  (`!x. &0 <= x ==> (x / sqrt(x) = sqrt(x))`,
 536   REWRITE_TAC[REAL_LE_LT] THEN REPEAT STRIP_TAC THENL
 537    [ALL_TAC; ASM_MESON_TAC[SQRT_0; real_div; REAL_MUL_LZERO]] THEN
 538   ASM_SIMP_TAC[REAL_EQ_LDIV_EQ; SQRT_POS_LT; GSYM REAL_POW_2] THEN
 539   ASM_SIMP_TAC[SQRT_POW_2; REAL_LT_IMP_LE]);;
 540
 541 let REAL_RSQRT_LE = prove
 542  (`!x y. &0 <= x /\ &0 <= y /\ x <= sqrt y ==> x pow 2 <= y`,
 543   MESON_TAC[REAL_POW_LE2; SQRT_POW_2]);;
 544
 545 let REAL_LSQRT_LE = prove
 546  (`!x y. &0 <= x /\ sqrt x <= y ==> x <= y pow 2`,
 547   MESON_TAC[REAL_POW_LE2; SQRT_POS_LE; REAL_LE_TRANS; SQRT_POW_2]);;
 548
 549 (* ------------------------------------------------------------------------- *)
 550 (* Hence derive more interesting properties of the norm.                     *)
 551 (* ------------------------------------------------------------------------- *)
 552
 553 let NORM_0 = prove
 554  (`norm(vec 0) = &0`,
 555   REWRITE_TAC[vector_norm; DOT_LZERO; SQRT_0]);;
 556
 557 let NORM_POS_LE = prove
 558  (`!x. &0 <= norm x`,
 559   GEN_TAC THEN SIMP_TAC[DOT_POS_LE; vector_norm; SQRT_POS_LE]);;
 560
 561 let NORM_NEG = prove
 562  (`!x. norm(--x) = norm x`,
 563   REWRITE_TAC[vector_norm; DOT_LNEG; DOT_RNEG; REAL_NEG_NEG]);;
 564
 565 let NORM_SUB = prove
 566  (`!x y. norm(x - y) = norm(y - x)`,
 567   MESON_TAC[NORM_NEG; VECTOR_NEG_SUB]);;
 568
 569 let NORM_MUL = prove
 570  (`!a x. norm(a % x) = abs(a) * norm x`,
 571   REWRITE_TAC[vector_norm; DOT_LMUL; DOT_RMUL; REAL_MUL_ASSOC] THEN
 572   SIMP_TAC[SQRT_MUL; SQRT_POS_LE; DOT_POS_LE; REAL_LE_SQUARE] THEN
 573   REWRITE_TAC[GSYM REAL_POW_2; POW_2_SQRT_ABS]);;
 574
 575 let NORM_EQ_0_DOT = prove
 576  (`!x. (norm x = &0) <=> (x dot x = &0)`,
 577   SIMP_TAC[vector_norm; SQRT_EQ_0; DOT_POS_LE]);;
 578
 579 let NORM_EQ_0 = prove
 580  (`!x. (norm x = &0) <=> (x = vec 0)`,
 581   SIMP_TAC[vector_norm; DOT_EQ_0; SQRT_EQ_0; DOT_POS_LE]);;
 582
 583 let NORM_POS_LT = prove
 584  (`!x. &0 < norm x <=> ~(x = vec 0)`,
 585   MESON_TAC[REAL_LT_LE; NORM_POS_LE; NORM_EQ_0]);;
 586
 587 let NORM_POW_2 = prove
 588  (`!x. norm(x) pow 2 = x dot x`,
 589   SIMP_TAC[vector_norm; SQRT_POW_2; DOT_POS_LE]);;
 590
 591 let NORM_EQ_0_IMP = prove
 592  (`!x. (norm x = &0) ==> (x = vec 0)`,
 593   MESON_TAC[NORM_EQ_0]);;
 594
 595 let NORM_LE_0 = prove
 596  (`!x. norm x <= &0 <=> (x = vec 0)`,
 597   MESON_TAC[REAL_LE_ANTISYM; NORM_EQ_0; NORM_POS_LE]);;
 598
 599 let VECTOR_MUL_EQ_0 = prove
 600  (`!a x. (a % x = vec 0) <=> (a = &0) \/ (x = vec 0)`,
 601   REWRITE_TAC[GSYM NORM_EQ_0; NORM_MUL; REAL_ABS_ZERO; REAL_ENTIRE]);;
 602
 603 let VECTOR_MUL_LCANCEL = prove
 604  (`!a x y. (a % x = a % y) <=> (a = &0) \/ (x = y)`,
 605   MESON_TAC[VECTOR_MUL_EQ_0; VECTOR_SUB_LDISTRIB; VECTOR_SUB_EQ]);;
 606
 607 let VECTOR_MUL_RCANCEL = prove
 608  (`!a b x. (a % x = b % x) <=> (a = b) \/ (x = vec 0)`,
 609   MESON_TAC[VECTOR_MUL_EQ_0; VECTOR_SUB_RDISTRIB; REAL_SUB_0; VECTOR_SUB_EQ]);;
 610
 611 let VECTOR_MUL_LCANCEL_IMP = prove
 612  (`!a x y. ~(a = &0) /\ (a % x = a % y) ==> (x = y)`,
 613   MESON_TAC[VECTOR_MUL_LCANCEL]);;
 614
 615 let VECTOR_MUL_RCANCEL_IMP = prove
 616  (`!a b x. ~(x = vec 0) /\ (a % x = b % x) ==> (a = b)`,
 617   MESON_TAC[VECTOR_MUL_RCANCEL]);;
 618
 619 let NORM_CAUCHY_SCHWARZ = prove
 620  (`!(x:real^N) y. x dot y <= norm(x) * norm(y)`,
 621   REPEAT STRIP_TAC THEN MAP_EVERY ASM_CASES_TAC
 622    [`norm(x:real^N) = &0`; `norm(y:real^N) = &0`] THEN
 623   ASM_SIMP_TAC[NORM_EQ_0_IMP; DOT_LZERO; DOT_RZERO;
 624                REAL_MUL_LZERO; REAL_MUL_RZERO] THEN
 625   MP_TAC(ISPEC `norm(y:real^N) % x - norm(x:real^N) % y` DOT_POS_LE) THEN
 626   REWRITE_TAC[DOT_RSUB; DOT_LSUB; DOT_LMUL; DOT_RMUL; GSYM NORM_POW_2;
 627               REAL_POW_2; REAL_LE_REFL] THEN
 628   REWRITE_TAC[DOT_SYM; REAL_ARITH
 629    `&0 <= y * (y * x * x - x * d) - x * (y * d - x * y * y) <=>
 630     x * y * d <= x * y * x * y`] THEN
 631   ASM_SIMP_TAC[REAL_LE_LMUL_EQ; REAL_LT_LE; NORM_POS_LE]);;
 632
 633 let NORM_CAUCHY_SCHWARZ_ABS = prove
 634  (`!x:real^N y. abs(x dot y) <= norm(x) * norm(y)`,
 635   REPEAT GEN_TAC THEN MP_TAC(ISPEC `x:real^N` NORM_CAUCHY_SCHWARZ) THEN
 636   DISCH_THEN(fun th -> MP_TAC(SPEC `y:real^N` th) THEN
 637         MP_TAC(SPEC `--(y:real^N)` th)) THEN
 638   REWRITE_TAC[DOT_RNEG; NORM_NEG] THEN REAL_ARITH_TAC);;
 639
 640 let REAL_ABS_NORM = prove
 641  (`!x. abs(norm x) = norm x`,
 642   REWRITE_TAC[NORM_POS_LE; REAL_ABS_REFL]);;
 643
 644 let NORM_CAUCHY_SCHWARZ_DIV = prove
 645  (`!x:real^N y. abs((x dot y) / (norm x * norm y)) <= &1`,
 646   REPEAT GEN_TAC THEN
 647   MAP_EVERY ASM_CASES_TAC [`x:real^N = vec 0`; `y:real^N = vec 0`] THEN
 648   ASM_REWRITE_TAC[NORM_0; REAL_MUL_LZERO; REAL_MUL_RZERO; real_div;
 649              REAL_INV_1; DOT_LZERO; DOT_RZERO; REAL_ABS_NUM; REAL_POS] THEN
 650   ASM_SIMP_TAC[GSYM real_div; REAL_ABS_DIV; REAL_LE_LDIV_EQ; REAL_LT_MUL;
 651      REAL_ABS_INV; NORM_POS_LT; REAL_ABS_MUL; REAL_ABS_NORM] THEN
 652   REWRITE_TAC[REAL_MUL_LID; NORM_CAUCHY_SCHWARZ_ABS]);;
 653
 654 let NORM_TRIANGLE = prove
 655  (`!x y. norm(x + y) <= norm(x) + norm(y)`,
 656   REPEAT GEN_TAC THEN REWRITE_TAC[vector_norm] THEN
 657   MATCH_MP_TAC REAL_LE_LSQRT THEN
 658   SIMP_TAC[GSYM vector_norm; DOT_POS_LE; NORM_POS_LE; REAL_LE_ADD] THEN
 659   REWRITE_TAC[DOT_LADD; DOT_RADD; REAL_POW_2; GSYM NORM_POW_2] THEN
 660   SIMP_TAC[NORM_CAUCHY_SCHWARZ; DOT_SYM; REAL_ARITH
 661    `d <= x * y ==> (x * x + d) + (d + y * y) <= (x + y) * (x + y)`]);;
 662
 663 let NORM_TRIANGLE_SUB = prove
 664  (`!x y:real^N. norm(x) <= norm(y) + norm(x - y)`,
 665   MESON_TAC[NORM_TRIANGLE; VECTOR_SUB_ADD2]);;
 666
 667 let NORM_TRIANGLE_LE = prove
 668  (`!x y. norm(x) + norm(y) <= e ==> norm(x + y) <= e`,
 669   MESON_TAC[REAL_LE_TRANS; NORM_TRIANGLE]);;
 670
 671 let NORM_TRIANGLE_LT = prove
 672  (`!x y. norm(x) + norm(y) < e ==> norm(x + y) < e`,
 673   MESON_TAC[REAL_LET_TRANS; NORM_TRIANGLE]);;
 674
 675 let COMPONENT_LE_NORM = prove
 676  (`!x:real^N i. 1 <= i /\  i <= dimindex(:N)
 677                  ==> abs(x$i) <= norm x`,
 678   REPEAT STRIP_TAC THEN REWRITE_TAC[vector_norm] THEN
 679   MATCH_MP_TAC REAL_LE_RSQRT THEN REWRITE_TAC[GSYM REAL_ABS_POW] THEN
 680   REWRITE_TAC[real_abs; REAL_POW_2; REAL_LE_SQUARE] THEN
 681   SUBGOAL_THEN
 682    `x$i * (x:real^N)$i =
 683      sum(1..dimindex(:N)) (\k. if k = i then x$i * x$i else &0)`
 684   SUBST1_TAC THENL
 685    [REWRITE_TAC[SUM_DELTA] THEN ASM_REWRITE_TAC[IN_NUMSEG]; ALL_TAC] THEN
 686   REWRITE_TAC[dot] THEN MATCH_MP_TAC SUM_LE THEN
 687   REWRITE_TAC[FINITE_NUMSEG] THEN
 688   REPEAT STRIP_TAC THEN COND_CASES_TAC THEN
 689   ASM_REWRITE_TAC[REAL_LE_REFL; REAL_LE_SQUARE]);;
 690
 691 let NORM_BOUND_COMPONENT_LE = prove
 692  (`!x:real^N e. norm(x) <= e
 693                 ==> !i. 1 <= i /\ i <= dimindex(:N) ==> abs(x$i) <= e`,
 694   MESON_TAC[COMPONENT_LE_NORM; REAL_LE_TRANS]);;
 695
 696 let NORM_BOUND_COMPONENT_LT = prove
 697  (`!x:real^N e. norm(x) < e
 698                 ==> !i. 1 <= i /\ i <= dimindex(:N) ==> abs(x$i) < e`,
 699   MESON_TAC[COMPONENT_LE_NORM; REAL_LET_TRANS]);;
 700
 701 let NORM_LE_L1 = prove
 702  (`!x:real^N. norm x <= sum(1..dimindex(:N)) (\i. abs(x$i))`,
 703   REPEAT GEN_TAC THEN REWRITE_TAC[vector_norm; dot] THEN
 704   MATCH_MP_TAC REAL_LE_LSQRT THEN REWRITE_TAC[REAL_POW_2] THEN
 705   SIMP_TAC[SUM_POS_LE; FINITE_NUMSEG; REAL_LE_SQUARE; REAL_ABS_POS] THEN
 706   SPEC_TAC(`dimindex(:N)`,`n:num`) THEN INDUCT_TAC THEN
 707   REWRITE_TAC[SUM_CLAUSES_NUMSEG; ARITH_EQ; ARITH_RULE `1 <= SUC n`] THEN
 708   SIMP_TAC[REAL_MUL_LZERO; REAL_LE_REFL] THEN
 709   MATCH_MP_TAC(REAL_ARITH
 710    `a2 <= a * a /\ &0 <= a * b /\ b2 <= b * b
 711     ==> a2 + b2 <= (a + b) * (a + b)`) THEN
 712   ASM_SIMP_TAC[SUM_POS_LE; REAL_LE_MUL; REAL_ABS_POS; FINITE_NUMSEG] THEN
 713   REWRITE_TAC[GSYM REAL_ABS_MUL] THEN REAL_ARITH_TAC);;
 714
 715 let REAL_ABS_SUB_NORM = prove
 716  (`abs(norm(x) - norm(y)) <= norm(x - y)`,
 717   REWRITE_TAC[REAL_ARITH `abs(x - y) <= a <=> x <= y + a /\ y <= x + a`] THEN
 718   MESON_TAC[NORM_TRIANGLE_SUB; NORM_SUB]);;
 719
 720 let NORM_LE = prove
 721  (`!x y. norm(x) <= norm(y) <=> x dot x <= y dot y`,
 722   REWRITE_TAC[vector_norm] THEN MESON_TAC[SQRT_MONO_LE_EQ; DOT_POS_LE]);;
 723
 724 let NORM_LT = prove
 725  (`!x y. norm(x) < norm(y) <=> x dot x < y dot y`,
 726   REWRITE_TAC[vector_norm] THEN MESON_TAC[SQRT_MONO_LT_EQ; DOT_POS_LE]);;
 727
 728 let NORM_EQ = prove
 729  (`!x y. (norm x = norm y) <=> (x dot x = y dot y)`,
 730   REWRITE_TAC[GSYM REAL_LE_ANTISYM; NORM_LE]);;
 731
 732 let NORM_EQ_1 = prove
 733  (`!x. norm(x) = &1 <=> x dot x = &1`,
 734   GEN_TAC THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM SQRT_1] THEN
 735   SIMP_TAC[vector_norm; SQRT_INJ; DOT_POS_LE; REAL_POS]);;
 736
 737 let NORM_LE_COMPONENTWISE = prove
 738  (`!x:real^N y:real^N.
 739         (!i. 1 <= i /\ i <= dimindex(:N) ==> abs(x$i) <= abs(y$i))
 740         ==> norm(x) <= norm(y)`,
 741   REPEAT STRIP_TAC THEN REWRITE_TAC[NORM_LE; dot] THEN
 742   MATCH_MP_TAC SUM_LE_NUMSEG THEN
 743   ASM_SIMP_TAC[GSYM REAL_POW_2; GSYM REAL_LE_SQUARE_ABS]);;
 744
 745 (* ------------------------------------------------------------------------- *)
 746 (* Squaring equations and inequalities involving norms.                      *)
 747 (* ------------------------------------------------------------------------- *)
 748
 749 let DOT_SQUARE_NORM = prove
 750  (`!x. x dot x = norm(x) pow 2`,
 751   SIMP_TAC[vector_norm; SQRT_POW_2; DOT_POS_LE]);;
 752
 753 let NORM_EQ_SQUARE = prove
 754  (`!x:real^N. norm(x) = a <=> &0 <= a /\ x dot x = a pow 2`,
 755   REWRITE_TAC[DOT_SQUARE_NORM] THEN
 756   ONCE_REWRITE_TAC[REAL_RING `x pow 2 = a pow 2 <=> x = a \/ x + a = &0`] THEN
 757   GEN_TAC THEN MP_TAC(ISPEC `x:real^N` NORM_POS_LE) THEN REAL_ARITH_TAC);;
 758
 759 let NORM_LE_SQUARE = prove
 760  (`!x:real^N. norm(x) <= a <=> &0 <= a /\ x dot x <= a pow 2`,
 761   REWRITE_TAC[DOT_SQUARE_NORM; GSYM REAL_LE_SQUARE_ABS] THEN
 762   GEN_TAC THEN MP_TAC(ISPEC `x:real^N` NORM_POS_LE) THEN REAL_ARITH_TAC);;
 763
 764 let NORM_GE_SQUARE = prove
 765  (`!x:real^N. norm(x) >= a <=> a <= &0 \/ x dot x >= a pow 2`,
 766   REWRITE_TAC[real_ge; DOT_SQUARE_NORM; GSYM REAL_LE_SQUARE_ABS] THEN
 767   GEN_TAC THEN MP_TAC(ISPEC `x:real^N` NORM_POS_LE) THEN REAL_ARITH_TAC);;
 768
 769 let NORM_LT_SQUARE = prove
 770  (`!x:real^N. norm(x) < a <=> &0 < a /\ x dot x < a pow 2`,
 771   REWRITE_TAC[REAL_ARITH `x < a <=> ~(x >= a)`; NORM_GE_SQUARE] THEN
 772   REAL_ARITH_TAC);;
 773
 774 let NORM_GT_SQUARE = prove
 775  (`!x:real^N. norm(x) > a <=> a < &0 \/ x dot x > a pow 2`,
 776   REWRITE_TAC[REAL_ARITH `x > a <=> ~(x <= a)`; NORM_LE_SQUARE] THEN
 777   REAL_ARITH_TAC);;
 778
 779 let NORM_LT_SQUARE_ALT = prove
 780  (`!x:real^N. norm(x) < a <=> &0 <= a /\ x dot x < a pow 2`,
 781   REWRITE_TAC[REAL_ARITH `x < a <=> ~(x >= a)`; NORM_GE_SQUARE] THEN
 782   REPEAT GEN_TAC THEN ASM_CASES_TAC `a = &0` THENL
 783    [ASM_REWRITE_TAC[real_ge] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN
 784     REWRITE_TAC[DOT_POS_LE];
 785     ASM_REAL_ARITH_TAC]);;
 786
 787 (* ------------------------------------------------------------------------- *)
 788 (* General linear decision procedure for normed spaces.                      *)
 789 (* ------------------------------------------------------------------------- *)
 790
 791 let NORM_ARITH =
 792   let find_normedterms =
 793     let augment_norm b tm acc =
 794       match tm with
 795         Comb(Const("vector_norm",_),v) -> insert (b,v) acc
 796       | _ -> acc in
 797     let rec find_normedterms tm acc =
 798       match tm with
 799         Comb(Comb(Const("real_add",_),l),r) ->
 800             find_normedterms l (find_normedterms r acc)
 801       | Comb(Comb(Const("real_mul",_),c),n) ->
 802             if not (is_ratconst c) then acc else
 803             augment_norm (rat_of_term c >=/ Int 0) n acc
 804       | _ -> augment_norm true tm acc in
 805     find_normedterms in
 806   let lincomb_neg t = mapf minus_num t in
 807   let lincomb_cmul c t = if c =/ Int 0 then undefined else mapf (( */ ) c) t in
 808   let lincomb_add l r = combine (+/) (fun x -> x =/ Int 0) l r in
 809   let lincomb_sub l r = lincomb_add l (lincomb_neg r) in
 810   let lincomb_eq l r = lincomb_sub l r = undefined in
 811   let rec vector_lincomb tm =
 812     match tm with
 813         Comb(Comb(Const("vector_add",_),l),r) ->
 814           lincomb_add (vector_lincomb l) (vector_lincomb r)
 815       | Comb(Comb(Const("vector_sub",_),l),r) ->
 816           lincomb_sub (vector_lincomb l) (vector_lincomb r)
 817       | Comb(Comb(Const("%",_),l),r) ->
 818           lincomb_cmul (rat_of_term l) (vector_lincomb r)
 819       | Comb(Const("vector_neg",_),t) ->
 820           lincomb_neg (vector_lincomb t)
 821       | Comb(Const("vec",_),n) when is_numeral n & dest_numeral n =/ Int 0 ->
 822           undefined
 823       | _ -> (tm |=> Int 1) in
 824   let vector_lincombs tms =
 825     itlist (fun t fns ->
 826                   if can (assoc t) fns then fns else
 827                   let f = vector_lincomb t in
 828                   try let _,f' = find (fun (_,f') -> lincomb_eq f f') fns in
 829                       (t,f')::fns
 830                   with Failure _ -> (t,f)::fns) tms [] in
 831   let rec replacenegnorms fn tm =
 832     match tm with
 833       Comb(Comb(Const("real_add",_),l),r) ->
 834           BINOP_CONV (replacenegnorms fn) tm
 835     | Comb(Comb(Const("real_mul",_),c),n) when rat_of_term c </ Int 0 ->
 836           RAND_CONV fn tm
 837     | _ -> REFL tm in
 838   let flip v eq =
 839     if defined eq v then (v |-> minus_num(apply eq v)) eq else eq in
 840   let rec allsubsets s =
 841     match s with
 842       [] -> [[]]
 843     | (a::t) -> let res = allsubsets t in
 844                 map (fun b -> a::b) res @ res in
 845   let evaluate env lin =
 846     foldr (fun x c s -> s +/ c */ apply env x) lin (Int 0) in
 847   let rec solve (vs,eqs) =
 848     match (vs,eqs) with
 849       [],[] -> (0 |=> Int 1)
 850     | _,eq::oeqs ->
 851           let v = hd(intersect vs (dom eq)) in
 852           let c = apply eq v in
 853           let vdef = lincomb_cmul (Int(-1) // c) eq in
 854           let eliminate eqn =
 855             if not(defined eqn v) then eqn else
 856             lincomb_add (lincomb_cmul (apply eqn v) vdef) eqn in
 857           let soln = solve (subtract vs [v],map eliminate oeqs) in
 858           (v |-> evaluate soln (undefine v vdef)) soln in
 859   let rec combinations k l =
 860     if k = 0 then [[]] else
 861     match l with
 862       [] -> []
 863     | h::t -> map (fun c -> h::c) (combinations (k - 1) t) @
 864               combinations k t in
 865   let vertices vs eqs =
 866     let vertex cmb =
 867       let soln = solve(vs,cmb) in
 868       map (fun v -> tryapplyd soln v (Int 0)) vs in
 869     let rawvs = mapfilter vertex (combinations (length vs) eqs) in
 870     let unset = filter (forall (fun c -> c >=/ Int 0)) rawvs in
 871     itlist (insert' (forall2 (=/))) unset [] in
 872   let subsumes l m = forall2 (fun x y -> abs_num x <=/ abs_num y) l m in
 873   let rec subsume todo dun =
 874     match todo with
 875       [] -> dun
 876     | v::ovs -> let dun' = if exists (fun w -> subsumes w v) dun then dun
 877                            else v::(filter (fun w -> not(subsumes v w)) dun) in
 878                 subsume ovs dun' in
 879   let NORM_CMUL_RULE =
 880     let MATCH_pth = (MATCH_MP o prove)
 881      (`!b x. b >= norm(x) ==> !c. abs(c) * b >= norm(c % x)`,
 882       SIMP_TAC[NORM_MUL; real_ge; REAL_LE_LMUL; REAL_ABS_POS]) in
 883     fun c th -> ISPEC(term_of_rat c) (MATCH_pth th) in
 884   let NORM_ADD_RULE =
 885     let MATCH_pth = (MATCH_MP o prove)
 886      (`!b1 b2 x1 x2. b1 >= norm(x1) /\ b2 >= norm(x2)
 887                      ==> b1 + b2 >= norm(x1 + x2)`,
 888       REWRITE_TAC[real_ge] THEN REPEAT STRIP_TAC THEN
 889       MATCH_MP_TAC NORM_TRIANGLE_LE THEN ASM_SIMP_TAC[REAL_LE_ADD2]) in
 890     fun th1 th2 -> MATCH_pth (CONJ th1 th2) in
 891   let INEQUALITY_CANON_RULE =
 892     CONV_RULE(LAND_CONV REAL_POLY_CONV) o
 893     CONV_RULE(LAND_CONV REAL_RAT_REDUCE_CONV) o
 894     GEN_REWRITE_RULE I [REAL_ARITH `s >= t <=> s - t >= &0`] in
 895   let NORM_CANON_CONV =
 896     let APPLY_pth1 = GEN_REWRITE_CONV I
 897      [VECTOR_ARITH `x:real^N = &1 % x`]
 898     and APPLY_pth2 = GEN_REWRITE_CONV I
 899      [VECTOR_ARITH `x - y:real^N = x + --y`]
 900     and APPLY_pth3 = GEN_REWRITE_CONV I
 901      [VECTOR_ARITH `--x:real^N = -- &1 % x`]
 902     and APPLY_pth4 = GEN_REWRITE_CONV I
 903      [VECTOR_ARITH `&0 % x:real^N = vec 0`;
 904       VECTOR_ARITH `c % vec 0:real^N = vec 0`]
 905     and APPLY_pth5 = GEN_REWRITE_CONV I
 906      [VECTOR_ARITH `c % (d % x) = (c * d) % x`]
 907     and APPLY_pth6 = GEN_REWRITE_CONV I
 908      [VECTOR_ARITH `c % (x + y) = c % x + c % y`]
 909     and APPLY_pth7 = GEN_REWRITE_CONV I
 910      [VECTOR_ARITH `vec 0 + x = x`;
 911       VECTOR_ARITH `x + vec 0 = x`]
 912     and APPLY_pth8 =
 913      GEN_REWRITE_CONV I [VECTOR_ARITH `c % x + d % x = (c + d) % x`] THENC
 914      LAND_CONV REAL_RAT_ADD_CONV THENC
 915      GEN_REWRITE_CONV TRY_CONV [VECTOR_ARITH `&0 % x = vec 0`]
 916     and APPLY_pth9 =
 917      GEN_REWRITE_CONV I
 918       [VECTOR_ARITH `(c % x + z) + d % x = (c + d) % x + z`;
 919        VECTOR_ARITH `c % x + (d % x + z) = (c + d) % x + z`;
 920        VECTOR_ARITH `(c % x + w) + (d % x + z) = (c + d) % x + (w + z)`] THENC
 921      LAND_CONV(LAND_CONV REAL_RAT_ADD_CONV)
 922     and APPLY_ptha =
 923      GEN_REWRITE_CONV I [VECTOR_ARITH `&0 % x + y = y`]
 924     and APPLY_pthb =
 925      GEN_REWRITE_CONV I
 926       [VECTOR_ARITH `c % x + d % y = c % x + d % y`;
 927        VECTOR_ARITH `(c % x + z) + d % y = c % x + (z + d % y)`;
 928        VECTOR_ARITH `c % x + (d % y + z) = c % x + (d % y + z)`;
 929        VECTOR_ARITH `(c % x + w) + (d % y + z) = c % x + (w + (d % y + z))`]
 930     and APPLY_pthc =
 931      GEN_REWRITE_CONV I
 932       [VECTOR_ARITH `c % x + d % y = d % y + c % x`;
 933        VECTOR_ARITH `(c % x + z) + d % y = d % y + (c % x + z)`;
 934        VECTOR_ARITH `c % x + (d % y + z) = d % y + (c % x + z)`;
 935        VECTOR_ARITH `(c % x + w) + (d % y + z) = d % y + ((c % x + w) + z)`]
 936     and APPLY_pthd =
 937      GEN_REWRITE_CONV TRY_CONV
 938       [VECTOR_ARITH `x + vec 0 = x`] in
 939     let headvector tm =
 940       match tm with
 941         Comb(Comb(Const("vector_add",_),Comb(Comb(Const("%",_),l),v)),r) -> v
 942       | Comb(Comb(Const("%",_),l),v) -> v
 943       | _ -> failwith "headvector: non-canonical term" in
 944     let rec VECTOR_CMUL_CONV tm =
 945      ((APPLY_pth5 THENC LAND_CONV REAL_RAT_MUL_CONV) ORELSEC
 946       (APPLY_pth6 THENC BINOP_CONV VECTOR_CMUL_CONV)) tm
 947     and VECTOR_ADD_CONV tm =
 948       try APPLY_pth7 tm with Failure _ ->
 949       try APPLY_pth8 tm with Failure _ ->
 950       match tm with
 951         Comb(Comb(Const("vector_add",_),lt),rt) ->
 952           let l = headvector lt and r = headvector rt in
 953           if l < r then (APPLY_pthb THENC
 954                          RAND_CONV VECTOR_ADD_CONV THENC
 955                          APPLY_pthd) tm
 956           else if r < l then (APPLY_pthc THENC
 957                               RAND_CONV VECTOR_ADD_CONV THENC
 958                               APPLY_pthd) tm else
 959           (APPLY_pth9 THENC
 960             ((APPLY_ptha THENC VECTOR_ADD_CONV) ORELSEC
 961              RAND_CONV VECTOR_ADD_CONV THENC
 962              APPLY_pthd)) tm
 963       | _ -> REFL tm in
 964     let rec VECTOR_CANON_CONV tm =
 965       match tm with
 966         Comb(Comb(Const("vector_add",_),l),r) ->
 967           let lth = VECTOR_CANON_CONV l and rth = VECTOR_CANON_CONV r in
 968           let th = MK_COMB(AP_TERM (rator(rator tm)) lth,rth) in
 969           CONV_RULE (RAND_CONV VECTOR_ADD_CONV) th
 970       | Comb(Comb(Const("%",_),l),r) ->
 971           let rth = AP_TERM (rator tm) (VECTOR_CANON_CONV r) in
 972           CONV_RULE (RAND_CONV(APPLY_pth4 ORELSEC VECTOR_CMUL_CONV)) rth
 973       | Comb(Comb(Const("vector_sub",_),l),r) ->
 974           (APPLY_pth2 THENC VECTOR_CANON_CONV) tm
 975       | Comb(Const("vector_neg",_),t) ->
 976           (APPLY_pth3 THENC VECTOR_CANON_CONV) tm
 977       | Comb(Const("vec",_),n) when is_numeral n & dest_numeral n =/ Int 0 ->
 978           REFL tm
 979       | _ -> APPLY_pth1 tm in
 980     fun tm ->
 981       match tm with
 982        Comb(Const("vector_norm",_),e) -> RAND_CONV VECTOR_CANON_CONV tm
 983       | _ -> failwith "NORM_CANON_CONV" in
 984   let REAL_VECTOR_COMBO_PROVER =
 985     let pth_zero = prove(`norm(vec 0:real^N) = &0`,REWRITE_TAC[NORM_0])
 986     and tv_n = mk_vartype "N" in
 987     fun translator (nubs,ges,gts) ->
 988       let sources = map (rand o rand o concl) nubs
 989       and rawdests = itlist (find_normedterms o lhand o concl) (ges @ gts) [] in
 990       if not (forall fst rawdests) then failwith "Sanity check" else
 991       let dests = setify (map snd rawdests) in
 992       let srcfuns = map vector_lincomb sources
 993       and destfuns = map vector_lincomb dests in
 994       let vvs = itlist (union o dom) (srcfuns @ destfuns) [] in
 995       let n = length srcfuns in
 996       let nvs = 1--n in
 997       let srccombs = zip srcfuns nvs in
 998       let consider d =
 999         let coefficients x =
1000             let inp = if defined d x then 0 |=> minus_num(apply d x)
1001                       else undefined in
1002           itlist (fun (f,v) g -> if defined f x then (v |-> apply f x) g else g)
1003                  srccombs inp in
1004         let equations = map coefficients vvs
1005         and inequalities = map (fun n -> (n |=> Int 1)) nvs in
1006         let plausiblevertices f =
1007           let flippedequations = map (itlist flip f) equations in
1008           let constraints = flippedequations @ inequalities in
1009           let rawverts = vertices nvs constraints in
1010           let check_solution v =
1011             let f = itlist2 (|->) nvs v (0 |=> Int 1) in
1012             forall (fun e -> evaluate f e =/ Int 0) flippedequations in
1013           let goodverts = filter check_solution rawverts in
1014           let signfixups = map (fun n -> if mem n f then -1 else 1) nvs in
1015           map (map2 (fun s c -> Int s */ c) signfixups) goodverts in
1016         let allverts = itlist (@) (map plausiblevertices (allsubsets nvs)) [] in
1017         subsume allverts [] in
1018       let compute_ineq v =
1019         let ths = mapfilter (fun (v,t) -> if v =/ Int 0 then fail()
1020                                           else  NORM_CMUL_RULE v t)
1021                             (zip v nubs) in
1022         INEQUALITY_CANON_RULE (end_itlist NORM_ADD_RULE ths) in
1023       let ges' = mapfilter compute_ineq (itlist ((@) o consider) destfuns []) @
1024                  map INEQUALITY_CANON_RULE nubs @ ges in
1025       let zerodests = filter
1026         (fun t -> dom(vector_lincomb t) = []) (map snd rawdests) in
1027       REAL_LINEAR_PROVER translator
1028        (map (fun t -> INST_TYPE [last(snd(dest_type(type_of t))),tv_n] pth_zero)
1029             zerodests,
1030         map (CONV_RULE(ONCE_DEPTH_CONV NORM_CANON_CONV THENC
1031                        LAND_CONV REAL_POLY_CONV)) ges',
1032         map (CONV_RULE(ONCE_DEPTH_CONV NORM_CANON_CONV THENC
1033                        LAND_CONV REAL_POLY_CONV)) gts) in
1034   let REAL_VECTOR_INEQ_PROVER =
1035     let pth = prove
1036      (`norm(x) = n ==> norm(x) >= &0 /\ n >= norm(x)`,
1037       DISCH_THEN(SUBST_ALL_TAC o SYM) THEN
1038       REWRITE_TAC[real_ge; NORM_POS_LE] THEN REAL_ARITH_TAC) in
1039     let NORM_MP = MATCH_MP pth in
1040     fun translator (ges,gts) ->
1041     let ntms = itlist find_normedterms (map (lhand o concl) (ges @ gts)) [] in
1042     let lctab = vector_lincombs (map snd (filter (not o fst) ntms)) in
1043     let asl = map (fun (t,_) ->
1044        ASSUME(mk_eq(mk_icomb(mk_const("vector_norm",[]),t),
1045                     genvar `:real`))) lctab in
1046     let replace_conv = GEN_REWRITE_CONV TRY_CONV asl in
1047     let replace_rule = CONV_RULE (LAND_CONV (replacenegnorms replace_conv)) in
1048     let ges' =
1049        itlist (fun th ths -> CONJUNCT1(NORM_MP th)::ths)
1050               asl (map replace_rule ges)
1051     and gts' = map replace_rule gts
1052     and nubs = map (CONJUNCT2 o NORM_MP) asl in
1053     let th1 = REAL_VECTOR_COMBO_PROVER translator (nubs,ges',gts') in
1054     let th2 = INST
1055      (map (fun th -> let l,r = dest_eq(concl th) in (l,r)) asl) th1 in
1056     itlist PROVE_HYP (map (REFL o lhand o concl) asl) th2 in
1057   let REAL_VECTOR_PROVER =
1058     let rawrule =
1059       GEN_REWRITE_RULE I [REAL_ARITH `x = &0 <=> x >= &0 /\ --x >= &0`] in
1060     let splitequation th acc =
1061       let th1,th2 = CONJ_PAIR(rawrule th) in
1062       th1::CONV_RULE(LAND_CONV REAL_POLY_NEG_CONV) th2::acc in
1063     fun translator (eqs,ges,gts) ->
1064       REAL_VECTOR_INEQ_PROVER translator
1065          (itlist splitequation eqs ges,gts) in
1066   let pth = prove
1067    (`(!x y:real^N. x = y <=> norm(x - y) <= &0) /\
1068      (!x y:real^N. ~(x = y) <=> ~(norm(x - y) <= &0))`,
1069     REWRITE_TAC[NORM_LE_0; VECTOR_SUB_EQ]) in
1070   let conv1 = GEN_REWRITE_CONV TRY_CONV [pth] in
1071   let conv2 tm = (conv1 tm,conv1(mk_neg tm)) in
1072   let init = GEN_REWRITE_CONV ONCE_DEPTH_CONV [DECIMAL] THENC
1073              REAL_RAT_REDUCE_CONV THENC
1074              GEN_REWRITE_CONV ONCE_DEPTH_CONV [dist] THENC
1075              GEN_NNF_CONV true (conv1,conv2)
1076   and pure = GEN_REAL_ARITH REAL_VECTOR_PROVER in
1077   fun tm -> let th = init tm in EQ_MP (SYM th) (pure(rand(concl th)));;
1078
1079 let NORM_ARITH_TAC = CONV_TAC NORM_ARITH;;
1080
1081 let ASM_NORM_ARITH_TAC =
1082   REPEAT(FIRST_X_ASSUM(MP_TAC o check (not o is_forall o concl))) THEN
1083   NORM_ARITH_TAC;;
1084
1085 (* ------------------------------------------------------------------------- *)
1086 (* Dot product in terms of the norm rather than conversely.                  *)
1087 (* ------------------------------------------------------------------------- *)
1088
1089 let DOT_NORM = prove
1090  (`!x y. x dot y = (norm(x + y) pow 2 - norm(x) pow 2 - norm(y) pow 2) / &2`,
1091   REWRITE_TAC[NORM_POW_2; DOT_LADD; DOT_RADD; DOT_SYM] THEN REAL_ARITH_TAC);;
1092
1093 let DOT_NORM_NEG = prove
1094  (`!x y. x dot y = ((norm(x) pow 2 + norm(y) pow 2) - norm(x - y) pow 2) / &2`,
1095   REWRITE_TAC[NORM_POW_2; DOT_LADD; DOT_RADD; DOT_LSUB; DOT_RSUB; DOT_SYM] THEN
1096   REAL_ARITH_TAC);;
1097
1098 (* ------------------------------------------------------------------------- *)
1099 (* Equality of vectors in terms of dot products.                             *)
1100 (* ------------------------------------------------------------------------- *)
1101
1102 let VECTOR_EQ = prove
1103  (`!x y. (x = y) <=> (x dot x = x dot y) /\ (y dot y = x dot x)`,
1104   REPEAT GEN_TAC THEN EQ_TAC THENL [SIMP_TAC[]; ALL_TAC] THEN
1105   ONCE_REWRITE_TAC[GSYM VECTOR_SUB_EQ] THEN
1106   REWRITE_TAC[GSYM DOT_EQ_0] THEN
1107   SIMP_TAC[DOT_LSUB; DOT_RSUB; DOT_SYM] THEN REAL_ARITH_TAC);;
1108
1109 (* ------------------------------------------------------------------------- *)
1110 (* Hence more metric properties.                                             *)
1111 (* ------------------------------------------------------------------------- *)
1112
1113 let DIST_REFL = prove
1114  (`!x. dist(x,x) = &0`,
1115   NORM_ARITH_TAC);;
1116
1117 let DIST_SYM = prove
1118  (`!x y. dist(x,y) = dist(y,x)`,
1119   NORM_ARITH_TAC);;
1120
1121 let DIST_POS_LE = prove
1122  (`!x y. &0 <= dist(x,y)`,
1123   NORM_ARITH_TAC);;
1124
1125 let DIST_TRIANGLE = prove
1126  (`!x:real^N y z. dist(x,z) <= dist(x,y) + dist(y,z)`,
1127   NORM_ARITH_TAC);;
1128
1129 let DIST_TRIANGLE_ALT = prove
1130  (`!x y z. dist(y,z) <= dist(x,y) + dist(x,z)`,
1131   NORM_ARITH_TAC);;
1132
1133 let DIST_EQ_0 = prove
1134  (`!x y. (dist(x,y) = &0) <=> (x = y)`,
1135   NORM_ARITH_TAC);;
1136
1137 let DIST_POS_LT = prove
1138  (`!x y. ~(x = y) ==> &0 < dist(x,y)`,
1139   NORM_ARITH_TAC);;
1140
1141 let DIST_NZ = prove
1142  (`!x y. ~(x = y) <=> &0 < dist(x,y)`,
1143   NORM_ARITH_TAC);;
1144
1145 let DIST_TRIANGLE_LE = prove
1146  (`!x y z e. dist(x,z) + dist(y,z) <= e ==> dist(x,y) <= e`,
1147   NORM_ARITH_TAC);;
1148
1149 let DIST_TRIANGLE_LT = prove
1150  (`!x y z e. dist(x,z) + dist(y,z) < e ==> dist(x,y) < e`,
1151   NORM_ARITH_TAC);;
1152
1153 let DIST_TRIANGLE_HALF_L = prove
1154  (`!x1 x2 y. dist(x1,y) < e / &2 /\ dist(x2,y) < e / &2 ==> dist(x1,x2) < e`,
1155   NORM_ARITH_TAC);;
1156
1157 let DIST_TRIANGLE_HALF_R = prove
1158  (`!x1 x2 y. dist(y,x1) < e / &2 /\ dist(y,x2) < e / &2 ==> dist(x1,x2) < e`,
1159   NORM_ARITH_TAC);;
1160
1161 let DIST_TRIANGLE_ADD = prove
1162  (`!x x' y y'. dist(x + y,x' + y') <= dist(x,x') + dist(y,y')`,
1163   NORM_ARITH_TAC);;
1164
1165 let DIST_MUL = prove
1166  (`!x y c. dist(c % x,c % y) = abs(c) * dist(x,y)`,
1167   REWRITE_TAC[dist; GSYM VECTOR_SUB_LDISTRIB; NORM_MUL]);;
1168
1169 let DIST_TRIANGLE_ADD_HALF = prove
1170  (`!x x' y y':real^N.
1171     dist(x,x') < e / &2 /\ dist(y,y') < e / &2 ==> dist(x + y,x' + y') < e`,
1172   NORM_ARITH_TAC);;
1173
1174 let DIST_LE_0 = prove
1175  (`!x y. dist(x,y) <= &0 <=> x = y`,
1176   NORM_ARITH_TAC);;
1177
1178 let DIST_EQ = prove
1179  (`!w x y z. dist(w,x) = dist(y,z) <=> dist(w,x) pow 2 = dist(y,z) pow 2`,
1180   REWRITE_TAC[dist; NORM_POW_2; NORM_EQ]);;
1181
1182 let DIST_0 = prove
1183  (`!x. dist(x,vec 0) = norm(x) /\ dist(vec 0,x) = norm(x)`,
1184   NORM_ARITH_TAC);;
1185
1186 (* ------------------------------------------------------------------------- *)
1187 (* Sums of vectors.                                                          *)
1188 (* ------------------------------------------------------------------------- *)
1189
1190 let NEUTRAL_VECTOR_ADD = prove
1191  (`neutral(+) = vec 0:real^N`,
1192   REWRITE_TAC[neutral] THEN MATCH_MP_TAC SELECT_UNIQUE THEN
1193   REWRITE_TAC[VECTOR_ARITH `x + y = y <=> x = vec 0`;
1194               VECTOR_ARITH `x + y = x <=> y = vec 0`]);;
1195
1196 let MONOIDAL_VECTOR_ADD = prove
1197  (`monoidal((+):real^N->real^N->real^N)`,
1198   REWRITE_TAC[monoidal; NEUTRAL_VECTOR_ADD] THEN
1199   REPEAT CONJ_TAC THEN VECTOR_ARITH_TAC);;
1200
1201 let vsum = new_definition
1202   `(vsum:(A->bool)->(A->real^N)->real^N) s f = lambda i. sum s (\x. f(x)$i)`;;
1203
1204 let VSUM_CLAUSES = prove
1205  (`(!f. vsum {} f = vec 0) /\
1206    (!x f s. FINITE s
1207             ==> (vsum (x INSERT s) f =
1208                  if x IN s then vsum s f else f(x) + vsum s f))`,
1209   SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA; VECTOR_ADD_COMPONENT; SUM_CLAUSES] THEN
1210   SIMP_TAC[VEC_COMPONENT] THEN REPEAT STRIP_TAC THEN
1211   COND_CASES_TAC THEN ASM_SIMP_TAC[LAMBDA_BETA; VECTOR_ADD_COMPONENT]);;
1212
1213 let VSUM = prove
1214  (`!f s. FINITE s ==> vsum s f = iterate (+) s f`,
1215   GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
1216   ASM_SIMP_TAC[VSUM_CLAUSES; ITERATE_CLAUSES; MONOIDAL_VECTOR_ADD] THEN
1217   REWRITE_TAC[NEUTRAL_VECTOR_ADD]);;
1218
1219 let VSUM_EQ_0 = prove
1220  (`!f s. (!x:A. x IN s ==> (f(x) = vec 0)) ==> (vsum s f = vec 0)`,
1221   SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA; vec; SUM_EQ_0]);;
1222
1223 let VSUM_0 = prove
1224  (`vsum s (\x. vec 0) = vec 0`,
1225   SIMP_TAC[VSUM_EQ_0]);;
1226
1227 let VSUM_LMUL = prove
1228  (`!f c s.  vsum s (\x. c % f(x)) = c % vsum s f`,
1229   SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA; VECTOR_MUL_COMPONENT; SUM_LMUL]);;
1230
1231 let VSUM_RMUL = prove
1232  (`!c s v. vsum s (\x. c x % v) = (sum s c) % v`,
1233   SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA; VECTOR_MUL_COMPONENT; SUM_RMUL]);;
1234
1235 let VSUM_ADD = prove
1236  (`!f g s. FINITE s ==> (vsum s (\x. f x + g x) = vsum s f + vsum s g)`,
1237   SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA; VECTOR_ADD_COMPONENT; SUM_ADD]);;
1238
1239 let VSUM_SUB = prove
1240  (`!f g s. FINITE s ==> (vsum s (\x. f x - g x) = vsum s f - vsum s g)`,
1241   SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA; VECTOR_SUB_COMPONENT; SUM_SUB]);;
1242
1243 let VSUM_CONST = prove
1244  (`!c s. FINITE s ==> (vsum s (\n. c) = &(CARD s) % c)`,
1245   SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA; SUM_CONST; VECTOR_MUL_COMPONENT]);;
1246
1247 let VSUM_COMPONENT = prove
1248  (`!s f i. 1 <= i /\ i <= dimindex(:N)
1249            ==> ((vsum s (f:A->real^N))$i = sum s (\x. f(x)$i))`,
1250   SIMP_TAC[vsum; LAMBDA_BETA]);;
1251
1252 let VSUM_IMAGE = prove
1253  (`!f g s. FINITE s /\ (!x y. x IN s /\ y IN s /\ (f x = f y) ==> (x = y))
1254            ==> (vsum (IMAGE f s) g = vsum s (g o f))`,
1255   SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA] THEN REPEAT STRIP_TAC THEN
1256   W(MP_TAC o PART_MATCH (lhs o rand) SUM_IMAGE o lhs o snd) THEN
1257   ASM_REWRITE_TAC[o_DEF]);;
1258
1259 let VSUM_UNION = prove
1260  (`!f s t. FINITE s /\ FINITE t /\ DISJOINT s t
1261            ==> (vsum (s UNION t) f = vsum s f + vsum t f)`,
1262   SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA; SUM_UNION; VECTOR_ADD_COMPONENT]);;
1263
1264 let VSUM_DIFF = prove
1265  (`!f s t. FINITE s /\ t SUBSET s
1266            ==> (vsum (s DIFF t) f = vsum s f - vsum t f)`,
1267   SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA; SUM_DIFF; VECTOR_SUB_COMPONENT]);;
1268
1269 let VSUM_DELETE = prove
1270  (`!f s a. FINITE s /\ a IN s
1271            ==> vsum (s DELETE a) f = vsum s f - f a`,
1272   SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA; SUM_DELETE; VECTOR_SUB_COMPONENT]);;
1273
1274 let VSUM_INCL_EXCL = prove
1275  (`!s t (f:A->real^N).
1276         FINITE s /\ FINITE t
1277         ==> vsum s f + vsum t f = vsum (s UNION t) f + vsum (s INTER t) f`,
1278   SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA; VECTOR_ADD_COMPONENT] THEN
1279   SIMP_TAC[SUM_INCL_EXCL]);;
1280
1281 let VSUM_NEG = prove
1282  (`!f s. vsum s (\x. --f x) = --vsum s f`,
1283   SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA; SUM_NEG; VECTOR_NEG_COMPONENT]);;
1284
1285 let VSUM_EQ = prove
1286  (`!f g s. (!x. x IN s ==> (f x = g x)) ==> (vsum s f = vsum s g)`,
1287   SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA] THEN
1288   REPEAT STRIP_TAC THEN MATCH_MP_TAC SUM_EQ THEN ASM_SIMP_TAC[]);;
1289
1290 let VSUM_SUPERSET = prove
1291  (`!f:A->real^N u v.
1292         u SUBSET v /\ (!x. x IN v /\ ~(x IN u) ==> (f(x) = vec 0))
1293         ==> (vsum v f = vsum u f)`,
1294   SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA; VEC_COMPONENT; SUM_SUPERSET]);;
1295
1296 let VSUM_EQ_SUPERSET = prove
1297  (`!f s t:A->bool.
1298         FINITE t /\ t SUBSET s /\
1299         (!x. x IN t ==> (f x = g x)) /\
1300         (!x. x IN s /\ ~(x IN t) ==> f(x) = vec 0)
1301         ==> vsum s f = vsum t g`,
1302   MESON_TAC[VSUM_SUPERSET; VSUM_EQ]);;
1303
1304 let VSUM_UNION_RZERO = prove
1305  (`!f:A->real^N u v.
1306         FINITE u /\ (!x. x IN v /\ ~(x IN u) ==> (f(x) = vec 0))
1307         ==> (vsum (u UNION v) f = vsum u f)`,
1308   SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA; VEC_COMPONENT; SUM_UNION_RZERO]);;
1309
1310 let VSUM_UNION_LZERO = prove
1311  (`!f:A->real^N u v.
1312         FINITE v /\ (!x. x IN u /\ ~(x IN v) ==> (f(x) = vec 0))
1313         ==> (vsum (u UNION v) f = vsum v f)`,
1314   MESON_TAC[VSUM_UNION_RZERO; UNION_COMM]);;
1315
1316 let VSUM_RESTRICT = prove
1317  (`!f s. FINITE s
1318          ==> (vsum s (\x. if x IN s then f(x) else vec 0) = vsum s f)`,
1319   REPEAT STRIP_TAC THEN MATCH_MP_TAC VSUM_EQ THEN ASM_SIMP_TAC[]);;
1320
1321 let VSUM_RESTRICT_SET = prove
1322  (`!P s f. vsum {x | x IN s /\ P x} f =
1323            vsum s (\x. if P x then f x else vec 0)`,
1324   SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA; VEC_COMPONENT; SUM_RESTRICT_SET;
1325            COND_COMPONENT]);;
1326
1327 let VSUM_CASES = prove
1328  (`!s P f g. FINITE s
1329              ==> vsum s (\x:A. if P x then (f x):real^N else g x) =
1330                  vsum {x | x IN s /\ P x} f + vsum {x | x IN s /\ ~P x} g`,
1331   SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA; VECTOR_ADD_COMPONENT; SUM_CASES;
1332            COND_COMPONENT]);;
1333
1334 let VSUM_SING = prove
1335  (`!f x. vsum {x} f = f(x)`,
1336   SIMP_TAC[VSUM_CLAUSES; FINITE_RULES; NOT_IN_EMPTY; VECTOR_ADD_RID]);;
1337
1338 let VSUM_NORM = prove
1339  (`!f s. FINITE s ==> norm(vsum s f) <= sum s (\x. norm(f x))`,
1340   GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
1341   SIMP_TAC[SUM_CLAUSES; VSUM_CLAUSES; NORM_0; REAL_LE_REFL] THEN
1342   NORM_ARITH_TAC);;
1343
1344 let VSUM_NORM_LE = prove
1345  (`!s f:A->real^N g.
1346         FINITE s /\ (!x. x IN s ==> norm(f x) <= g(x))
1347         ==> norm(vsum s f) <= sum s g`,
1348   REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN
1349   EXISTS_TAC `sum s (\x:A. norm(f x :real^N))` THEN
1350   ASM_SIMP_TAC[VSUM_NORM; SUM_LE]);;
1351
1352 let VSUM_NORM_TRIANGLE = prove
1353  (`!s f b. FINITE s /\ sum s (\a. norm(f a)) <= b
1354            ==> norm(vsum s f) <= b`,
1355   MESON_TAC[VSUM_NORM; REAL_LE_TRANS]);;
1356
1357 let VSUM_NORM_BOUND = prove
1358  (`!s f b. FINITE s /\ (!x:A. x IN s ==> norm(f(x)) <= b)
1359            ==> norm(vsum s f) <= &(CARD s) * b`,
1360   SIMP_TAC[GSYM SUM_CONST; VSUM_NORM_LE]);;
1361
1362 let VSUM_CLAUSES_NUMSEG = prove
1363  (`(!m. vsum(m..0) f = if m = 0 then f(0) else vec 0) /\
1364    (!m n. vsum(m..SUC n) f = if m <= SUC n then vsum(m..n) f + f(SUC n)
1365                              else vsum(m..n) f)`,
1366   REWRITE_TAC[NUMSEG_CLAUSES] THEN REPEAT STRIP_TAC THEN
1367   COND_CASES_TAC THEN
1368   ASM_SIMP_TAC[VSUM_SING; VSUM_CLAUSES; FINITE_NUMSEG; IN_NUMSEG] THEN
1369   REWRITE_TAC[ARITH_RULE `~(SUC n <= n)`; VECTOR_ADD_AC]);;
1370
1371 let VSUM_CLAUSES_RIGHT = prove
1372  (`!f m n. 0 < n /\ m <= n ==> vsum(m..n) f = vsum(m..n-1) f + (f n):real^N`,
1373   GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN
1374   SIMP_TAC[LT_REFL; VSUM_CLAUSES_NUMSEG; SUC_SUB1]);;
1375
1376 let VSUM_CMUL_NUMSEG = prove
1377  (`!f c m n. vsum (m..n) (\x. c % f x) = c % vsum (m..n) f`,
1378   SIMP_TAC[VSUM_LMUL; FINITE_NUMSEG]);;
1379
1380 let VSUM_EQ_NUMSEG = prove
1381  (`!f g m n.
1382          (!x. m <= x /\ x <= n ==> (f x = g x))
1383          ==> (vsum(m .. n) f = vsum(m .. n) g)`,
1384   REPEAT STRIP_TAC THEN MATCH_MP_TAC VSUM_EQ THEN
1385   ASM_SIMP_TAC[FINITE_NUMSEG; IN_NUMSEG]);;
1386
1387 let VSUM_IMAGE_GEN = prove
1388  (`!f:A->B g s.
1389         FINITE s
1390         ==> (vsum s g =
1391              vsum (IMAGE f s) (\y. vsum {x | x IN s /\ (f(x) = y)} g))`,
1392   SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA; SUM_IMAGE_GEN]);;
1393
1394 let VSUM_GROUP = prove
1395  (`!f:A->B g s t.
1396         FINITE s /\ IMAGE f s SUBSET t
1397         ==> vsum t (\y. vsum {x | x IN s /\ f(x) = y} g) = vsum s g`,
1398   SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA; SUM_GROUP]);;
1399
1400 let VSUM_VMUL = prove
1401  (`!f v s. FINITE s ==> ((sum s f) % v = vsum s (\x. f(x) % v))`,
1402   GEN_TAC THEN GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
1403   ASM_SIMP_TAC[SUM_CLAUSES; VSUM_CLAUSES] THEN
1404   REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[VECTOR_ADD_RDISTRIB] THEN
1405   VECTOR_ARITH_TAC);;
1406
1407 let VSUM_DELTA = prove
1408  (`!s a. vsum s (\x. if x = a then b else vec 0) =
1409          if a IN s then b else vec 0`,
1410   SIMP_TAC[CART_EQ; LAMBDA_BETA; VSUM_COMPONENT; COND_COMPONENT] THEN
1411   SIMP_TAC[VEC_COMPONENT; SUM_DELTA]);;
1412
1413 let VSUM_ADD_NUMSEG = prove
1414  (`!f g m n. vsum(m..n) (\i. f i + g i) = vsum(m..n) f + vsum(m..n) g`,
1415   SIMP_TAC[VSUM_ADD; FINITE_NUMSEG]);;
1416
1417 let VSUM_SUB_NUMSEG = prove
1418  (`!f g m n. vsum(m..n) (\i. f i - g i) = vsum(m..n) f - vsum(m..n) g`,
1419   SIMP_TAC[VSUM_SUB; FINITE_NUMSEG]);;
1420
1421 let VSUM_ADD_SPLIT = prove
1422  (`!f m n p.
1423        m <= n + 1 ==> vsum(m..n + p) f = vsum(m..n) f + vsum(n + 1..n + p) f`,
1424   SIMP_TAC[CART_EQ; LAMBDA_BETA; VSUM_COMPONENT; VECTOR_ADD_COMPONENT;
1425            SUM_ADD_SPLIT]);;
1426
1427 let VSUM_VSUM_PRODUCT = prove
1428  (`!s:A->bool t:A->B->bool x.
1429         FINITE s /\ (!i. i IN s ==> FINITE(t i))
1430         ==> vsum s (\i. vsum (t i) (x i)) =
1431             vsum {i,j | i IN s /\ j IN t i} (\(i,j). x i j)`,
1432   SIMP_TAC[CART_EQ; LAMBDA_BETA; VSUM_COMPONENT; COND_COMPONENT] THEN
1433   SIMP_TAC[SUM_SUM_PRODUCT] THEN REPEAT STRIP_TAC THEN AP_TERM_TAC THEN
1434   REWRITE_TAC[FUN_EQ_THM; FORALL_PAIR_THM]);;
1435
1436 let VSUM_IMAGE_NONZERO = prove
1437  (`!d:B->real^N i:A->B s.
1438     FINITE s /\
1439     (!x y. x IN s /\ y IN s /\ ~(x = y) /\ i x = i y ==> d(i x) = vec 0)
1440     ==> vsum (IMAGE i s) d = vsum s (d o i)`,
1441   GEN_TAC THEN GEN_TAC THEN ONCE_REWRITE_TAC[IMP_CONJ] THEN
1442   MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
1443   SIMP_TAC[IMAGE_CLAUSES; VSUM_CLAUSES; FINITE_IMAGE] THEN
1444   MAP_EVERY X_GEN_TAC [`a:A`; `s:A->bool`] THEN
1445   REWRITE_TAC[IN_INSERT] THEN REPEAT STRIP_TAC THEN
1446   SUBGOAL_THEN `vsum s ((d:B->real^N) o (i:A->B)) = vsum (IMAGE i s) d`
1447   SUBST1_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN
1448   COND_CASES_TAC THEN ASM_REWRITE_TAC[o_THM] THEN
1449   REWRITE_TAC[VECTOR_ARITH `a = x + a <=> x = vec 0`] THEN
1450   ASM_MESON_TAC[IN_IMAGE]);;
1451
1452 let VSUM_UNION_NONZERO = prove
1453  (`!f s t. FINITE s /\ FINITE t /\ (!x. x IN s INTER t ==> f(x) = vec 0)
1454            ==> vsum (s UNION t) f = vsum s f + vsum t f`,
1455   SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA; VECTOR_ADD_COMPONENT] THEN
1456   SIMP_TAC[VEC_COMPONENT; SUM_UNION_NONZERO]);;
1457
1458 let VSUM_UNIONS_NONZERO = prove
1459  (`!f s. FINITE s /\ (!t:A->bool. t IN s ==> FINITE t) /\
1460          (!t1 t2 x. t1 IN s /\ t2 IN s /\ ~(t1 = t2) /\ x IN t1 /\ x IN t2
1461                     ==> f x = vec 0)
1462          ==> vsum (UNIONS s) f = vsum s (\t. vsum t f)`,
1463   GEN_TAC THEN ONCE_REWRITE_TAC[IMP_CONJ] THEN
1464   MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
1465   REWRITE_TAC[UNIONS_0; UNIONS_INSERT; VSUM_CLAUSES; IN_INSERT] THEN
1466   MAP_EVERY X_GEN_TAC [`t:A->bool`; `s:(A->bool)->bool`] THEN
1467   DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN
1468   ONCE_REWRITE_TAC[IMP_CONJ] THEN ASM_SIMP_TAC[VSUM_CLAUSES] THEN
1469   ANTS_TAC THENL  [ASM_MESON_TAC[]; DISCH_THEN(SUBST_ALL_TAC o SYM)] THEN
1470   STRIP_TAC THEN MATCH_MP_TAC VSUM_UNION_NONZERO THEN
1471   ASM_SIMP_TAC[FINITE_UNIONS; IN_INTER; IN_UNIONS] THEN ASM_MESON_TAC[]);;
1472
1473 let VSUM_CLAUSES_LEFT = prove
1474  (`!f m n. m <= n ==> vsum(m..n) f = f m + vsum(m + 1..n) f`,
1475   SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA; VECTOR_ADD_COMPONENT] THEN
1476   SIMP_TAC[VEC_COMPONENT; SUM_CLAUSES_LEFT]);;
1477
1478 let VSUM_DIFFS = prove
1479  (`!m n. vsum(m..n) (\k. f(k) - f(k + 1)) =
1480           if m <= n then f(m) - f(n + 1) else vec 0`,
1481   GEN_TAC THEN INDUCT_TAC THEN ASM_SIMP_TAC[VSUM_CLAUSES_NUMSEG; LE] THEN
1482   ASM_CASES_TAC `m = SUC n` THEN
1483   ASM_REWRITE_TAC[ARITH_RULE `~(SUC n <= n)`; VECTOR_ADD_LID] THEN
1484   COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN
1485   REWRITE_TAC[GSYM ADD1] THEN VECTOR_ARITH_TAC);;
1486
1487 let VSUM_DIFFS_ALT = prove
1488  (`!m n. vsum(m..n) (\k. f(k + 1) - f(k)) =
1489           if m <= n then f(n + 1) - f(m) else vec 0`,
1490   REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM VECTOR_NEG_SUB] THEN
1491   SIMP_TAC[VSUM_NEG; VSUM_DIFFS] THEN
1492   COND_CASES_TAC THEN ASM_REWRITE_TAC[VECTOR_NEG_SUB; VECTOR_NEG_0]);;
1493
1494 let VSUM_DELETE_CASES = prove
1495  (`!x f s.
1496         FINITE(s:A->bool)
1497         ==> vsum(s DELETE x) f = if x IN s then vsum s f - f x else vsum s f`,
1498   REPEAT STRIP_TAC THEN COND_CASES_TAC THEN
1499   ASM_SIMP_TAC[SET_RULE `~(x IN s) ==> s DELETE x = s`] THEN
1500   FIRST_ASSUM(fun th -> GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV)
1501    [MATCH_MP (SET_RULE `x IN s ==> s = x INSERT (s DELETE x)`) th]) THEN
1502   ASM_SIMP_TAC[VSUM_CLAUSES; FINITE_DELETE; IN_DELETE] THEN VECTOR_ARITH_TAC);;
1503
1504 let VSUM_EQ_GENERAL = prove
1505   (`!s:A->bool t:B->bool (f:A->real^N) g h.
1506         (!y. y IN t ==> ?!x. x IN s /\ h x = y) /\
1507         (!x. x IN s ==> h x IN t /\ g(h x) = f x)
1508         ==> vsum s f = vsum t g`,
1509    SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA] THEN
1510    REPEAT STRIP_TAC THEN MATCH_MP_TAC SUM_EQ_GENERAL THEN
1511    EXISTS_TAC `h:A->B` THEN ASM_MESON_TAC[]);;
1512
1513 let VSUM_EQ_GENERAL_INVERSES = prove
1514  (`!s t (f:A->real^N) (g:B->real^N) h k.
1515         (!y. y IN t ==> k y IN s /\ h (k y) = y) /\
1516         (!x. x IN s ==> h x IN t /\ k (h x) = x /\ g (h x) = f x)
1517         ==> vsum s f = vsum t g`,
1518   SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA] THEN
1519   REPEAT STRIP_TAC THEN MATCH_MP_TAC SUM_EQ_GENERAL_INVERSES THEN
1520   MAP_EVERY EXISTS_TAC [`h:A->B`; `k:B->A`] THEN ASM_MESON_TAC[]);;
1521
1522 let VSUM_NORM_ALLSUBSETS_BOUND = prove
1523  (`!f:A->real^N p e.
1524         FINITE p /\
1525         (!q. q SUBSET p ==> norm(vsum q f) <= e)
1526         ==> sum p (\x. norm(f x)) <= &2 * &(dimindex(:N)) * e`,
1527   REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN
1528   EXISTS_TAC
1529    `sum p (\x:A. sum (1..dimindex(:N)) (\i. abs((f x:real^N)$i)))` THEN
1530   CONJ_TAC THENL
1531    [MATCH_MP_TAC SUM_LE THEN ASM_SIMP_TAC[NORM_LE_L1]; ALL_TAC] THEN
1532   W(MP_TAC o PART_MATCH (lhand o rand) SUM_SWAP o lhand o snd) THEN
1533   ASM_REWRITE_TAC[FINITE_NUMSEG] THEN DISCH_THEN SUBST1_TAC THEN
1534   ONCE_REWRITE_TAC[REAL_ARITH `&2 * &n * e = &n * &2 * e`] THEN
1535   GEN_REWRITE_TAC (RAND_CONV o LAND_CONV o RAND_CONV)
1536    [GSYM CARD_NUMSEG_1] THEN
1537   MATCH_MP_TAC SUM_BOUND THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN
1538   X_GEN_TAC `k:num` THEN STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN
1539   EXISTS_TAC `sum {x:A | x IN p /\ &0 <= (f x:real^N)$k} (\x. abs((f x)$k)) +
1540               sum {x | x IN p /\ (f x)$k < &0} (\x. abs((f x)$k))` THEN
1541   CONJ_TAC THENL
1542    [MATCH_MP_TAC(REAL_ARITH `a = b ==> b <= a`) THEN
1543     MATCH_MP_TAC SUM_UNION_EQ THEN
1544     ASM_SIMP_TAC[EXTENSION; NOT_IN_EMPTY; IN_INTER; IN_UNION; IN_ELIM_THM] THEN
1545     CONJ_TAC THEN X_GEN_TAC `x:A` THEN ASM_CASES_TAC `(x:A) IN p` THEN
1546     ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC;
1547     ALL_TAC] THEN
1548   MATCH_MP_TAC(REAL_ARITH `x <= e /\ y <= e ==> x + y <= &2 * e`) THEN
1549   GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [GSYM REAL_ABS_NEG] THEN
1550   CONJ_TAC THEN MATCH_MP_TAC(REAL_ARITH
1551    `!g. sum s g = sum s f /\ sum s g <= e ==> sum s f <= e`)
1552   THENL
1553    [EXISTS_TAC `\x. ((f:A->real^N) x)$k`;
1554     EXISTS_TAC `\x. --(((f:A->real^N) x)$k)`] THEN
1555   (CONJ_TAC THENL
1556     [MATCH_MP_TAC SUM_EQ THEN REWRITE_TAC[IN_ELIM_THM] THEN REAL_ARITH_TAC;
1557      ALL_TAC]) THEN
1558   ASM_SIMP_TAC[GSYM VSUM_COMPONENT; SUM_NEG; FINITE_RESTRICT] THEN
1559   MATCH_MP_TAC(REAL_ARITH `abs(x) <= e ==> x <= e`) THEN
1560   REWRITE_TAC[REAL_ABS_NEG] THEN
1561   MATCH_MP_TAC(REAL_ARITH
1562    `abs((vsum q f)$k) <= norm(vsum q f) /\
1563     norm(vsum q f) <= e
1564     ==> abs((vsum q f)$k) <= e`) THEN
1565   ASM_SIMP_TAC[COMPONENT_LE_NORM] THEN
1566   FIRST_X_ASSUM MATCH_MP_TAC THEN SET_TAC[]);;
1567
1568 let DOT_LSUM = prove
1569  (`!s f y. FINITE s ==> (vsum s f) dot y = sum s (\x. f(x) dot y)`,
1570   REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN
1571   MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
1572   ASM_SIMP_TAC[VSUM_CLAUSES; SUM_CLAUSES; DOT_LZERO; DOT_LADD]);;
1573
1574 let DOT_RSUM = prove
1575  (`!s f x. FINITE s ==> x dot (vsum s f) = sum s (\y. x dot f(y))`,
1576   REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN
1577   MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
1578   ASM_SIMP_TAC[VSUM_CLAUSES; SUM_CLAUSES; DOT_RZERO; DOT_RADD]);;
1579
1580 let VSUM_OFFSET = prove
1581  (`!f m p. vsum(m + p..n + p) f = vsum(m..n) (\i. f (i + p))`,
1582   SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA; VEC_COMPONENT; SUM_OFFSET]);;
1583
1584 let VSUM_OFFSET_0 = prove
1585  (`!f m n. m <= n ==> vsum(m..n) f = vsum(0..n - m) (\i. f (i + m))`,
1586   SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA; VEC_COMPONENT; SUM_OFFSET_0]);;
1587
1588 let VSUM_TRIV_NUMSEG = prove
1589  (`!f m n. n < m ==> vsum(m..n) f = vec 0`,
1590   SIMP_TAC[GSYM NUMSEG_EMPTY; VSUM_CLAUSES]);;
1591
1592 let VSUM_CONST_NUMSEG = prove
1593  (`!c m n. vsum(m..n) (\n. c) = &((n + 1) - m) % c`,
1594   SIMP_TAC[VSUM_CONST; FINITE_NUMSEG; CARD_NUMSEG]);;
1595
1596 let VSUM_SUC = prove
1597  (`!f m n. vsum (SUC n..SUC m) f = vsum (n..m) (f o SUC)`,
1598   REPEAT GEN_TAC THEN
1599   SUBGOAL_THEN `SUC n..SUC m = IMAGE SUC (n..m)` SUBST1_TAC THENL
1600    [REWRITE_TAC [ADD1; NUMSEG_OFFSET_IMAGE] THEN
1601     REWRITE_TAC [ONE; ADD_SUC; ADD_0; ETA_AX];
1602     SIMP_TAC [VSUM_IMAGE; FINITE_NUMSEG; SUC_INJ]]);;
1603
1604 let VSUM_BIJECTION = prove
1605  (`!f:A->real^N p s:A->bool.
1606                 (!x. x IN s ==> p(x) IN s) /\
1607                 (!y. y IN s ==> ?!x. x IN s /\ p(x) = y)
1608                 ==> vsum s f = vsum s (f o p)`,
1609   REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN
1610   MATCH_MP_TAC VSUM_EQ_GENERAL THEN EXISTS_TAC `p:A->A` THEN
1611   ASM_REWRITE_TAC[o_THM]);;
1612
1613 let VSUM_PARTIAL_SUC = prove
1614  (`!f g:num->real^N m n.
1615         vsum (m..n) (\k. f(k) % (g(k + 1) - g(k))) =
1616             if m <= n then f(n + 1) % g(n + 1) - f(m) % g(m) -
1617                            vsum (m..n) (\k. (f(k + 1) - f(k)) % g(k + 1))
1618             else vec 0`,
1619   GEN_TAC THEN GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN
1620   COND_CASES_TAC THEN ASM_SIMP_TAC[VSUM_TRIV_NUMSEG; GSYM NOT_LE] THEN
1621   ASM_REWRITE_TAC[VSUM_CLAUSES_NUMSEG] THENL
1622    [COND_CASES_TAC THEN ASM_SIMP_TAC[ARITH] THENL
1623      [VECTOR_ARITH_TAC; ASM_ARITH_TAC];
1624     ALL_TAC] THEN
1625   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LE]) THEN
1626   DISCH_THEN(DISJ_CASES_THEN2 SUBST_ALL_TAC ASSUME_TAC) THEN
1627   ASM_SIMP_TAC[GSYM NOT_LT; VSUM_TRIV_NUMSEG; ARITH_RULE `n < SUC n`] THEN
1628   ASM_SIMP_TAC[GSYM ADD1; ADD_CLAUSES] THEN VECTOR_ARITH_TAC);;
1629
1630 let VSUM_PARTIAL_PRE = prove
1631  (`!f g:num->real^N m n.
1632         vsum (m..n) (\k. f(k) % (g(k) - g(k - 1))) =
1633             if m <= n then f(n + 1) % g(n) - f(m) % g(m - 1) -
1634                            vsum (m..n) (\k. (f(k + 1) - f(k)) % g(k))
1635             else vec 0`,
1636   REPEAT GEN_TAC THEN
1637   MP_TAC(ISPECL [`f:num->real`; `\k. (g:num->real^N)(k - 1)`;
1638                  `m:num`; `n:num`] VSUM_PARTIAL_SUC) THEN
1639   REWRITE_TAC[ADD_SUB] THEN DISCH_THEN SUBST1_TAC THEN
1640   COND_CASES_TAC THEN REWRITE_TAC[]);;
1641
1642 let VSUM_COMBINE_L = prove
1643  (`!f m n p.
1644         0 < n /\ m <= n /\ n <= p + 1
1645         ==> vsum(m..n - 1) f + vsum(n..p) f = vsum(m..p) f`,
1646   SIMP_TAC[CART_EQ; VECTOR_ADD_COMPONENT; VSUM_COMPONENT; SUM_COMBINE_L]);;
1647
1648 let VSUM_COMBINE_R = prove
1649  (`!f m n p.
1650         m <= n + 1 /\ n <= p
1651         ==> vsum(m..n) f + vsum(n + 1..p) f = vsum(m..p) f`,
1652   SIMP_TAC[CART_EQ; VECTOR_ADD_COMPONENT; VSUM_COMPONENT; SUM_COMBINE_R]);;
1653
1654 let VSUM_INJECTION = prove
1655  (`!f p s.
1656          FINITE s /\
1657          (!x. x IN s ==> p x IN s) /\
1658          (!x y. x IN s /\ y IN s /\ p x = p y ==> x = y)
1659          ==> vsum s (f o p) = vsum s f`,
1660   REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP SUM_INJECTION) THEN
1661   SIMP_TAC[CART_EQ; VSUM_COMPONENT; o_DEF]);;
1662
1663 let VSUM_SWAP = prove
1664  (`!f s t.
1665          FINITE s /\ FINITE t
1666          ==> vsum s (\i. vsum t (f i)) = vsum t (\j. vsum s (\i. f i j))`,
1667    SIMP_TAC[CART_EQ; VSUM_COMPONENT] THEN REPEAT STRIP_TAC THEN
1668    W(MP_TAC o PART_MATCH (lhs o rand) SUM_SWAP o lhs o snd) THEN
1669    ASM_REWRITE_TAC[]);;
1670
1671 let VSUM_SWAP_NUMSEG = prove
1672   (`!a b c d f.
1673          vsum (a..b) (\i. vsum (c..d) (f i)) =
1674          vsum (c..d) (\j. vsum (a..b) (\i. f i j))`,
1675   REPEAT GEN_TAC THEN MATCH_MP_TAC VSUM_SWAP THEN REWRITE_TAC[FINITE_NUMSEG]);;
1676
1677 let VSUM_ADD_GEN = prove
1678  (`!f g s.
1679        FINITE {x | x IN s /\ ~(f x = vec 0)} /\
1680        FINITE {x | x IN s /\ ~(g x = vec 0)}
1681        ==> vsum s (\x. f x + g x) = vsum s f + vsum s g`,
1682   REPEAT GEN_TAC THEN DISCH_TAC THEN
1683   SIMP_TAC[CART_EQ; vsum; LAMBDA_BETA; VECTOR_ADD_COMPONENT] THEN
1684   REPEAT GEN_TAC THEN DISCH_THEN(K ALL_TAC) THEN
1685   REPEAT STRIP_TAC THEN MATCH_MP_TAC SUM_ADD_GEN THEN
1686   POP_ASSUM MP_TAC THEN MATCH_MP_TAC MONO_AND THEN
1687   CONJ_TAC THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] FINITE_SUBSET) THEN
1688   REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN GEN_TAC THEN
1689   ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[DE_MORGAN_THM] THEN
1690   STRIP_TAC THEN ASM_REWRITE_TAC[VEC_COMPONENT]);;
1691
1692 let VSUM_CASES_1 = prove
1693  (`!s a. FINITE s /\ a IN s
1694          ==> vsum s (\x. if x = a then y else f(x)) = vsum s f + (y - f a)`,
1695   REPEAT STRIP_TAC THEN ASM_SIMP_TAC[VSUM_CASES] THEN
1696   ASM_SIMP_TAC[GSYM DELETE; VSUM_DELETE] THEN
1697   ASM_SIMP_TAC[SET_RULE `a IN s ==> {x | x IN s /\ x = a} = {a}`] THEN
1698   REWRITE_TAC[VSUM_SING] THEN VECTOR_ARITH_TAC);;
1699
1700 let VSUM_SING_NUMSEG = prove
1701  (`vsum(n..n) f = f n`,
1702   REWRITE_TAC[NUMSEG_SING; VSUM_SING]);;
1703
1704 let VSUM_1 = prove
1705  (`vsum(1..1) f = f(1)`,
1706   REWRITE_TAC[VSUM_SING_NUMSEG]);;
1707
1708 let VSUM_2 = prove
1709  (`!t. vsum(1..2) t = t(1) + t(2)`,
1710   REWRITE_TAC[num_CONV `2`; VSUM_CLAUSES_NUMSEG] THEN
1711   REWRITE_TAC[VSUM_SING_NUMSEG; ARITH; REAL_ADD_ASSOC]);;
1712
1713 let VSUM_3 = prove
1714  (`!t. vsum(1..3) t = t(1) + t(2) + t(3)`,
1715   REWRITE_TAC[num_CONV `3`; num_CONV `2`; VSUM_CLAUSES_NUMSEG] THEN
1716   REWRITE_TAC[VSUM_SING_NUMSEG; ARITH; VECTOR_ADD_ASSOC]);;
1717
1718 let VSUM_PAIR = prove
1719  (`!f:num->real^N m n.
1720         vsum(2*m..2*n+1) f = vsum(m..n) (\i. f(2*i) + f(2*i+1))`,
1721   SIMP_TAC[CART_EQ; VSUM_COMPONENT; VECTOR_ADD_COMPONENT; SUM_PAIR]);;
1722
1723 let VSUM_PAIR_0 = prove
1724  (`!f:num->real^N n. vsum(0..2*n+1) f = vsum(0..n) (\i. f(2*i) + f(2*i+1))`,
1725   REPEAT GEN_TAC THEN
1726   MP_TAC(ISPECL [`f:num->real^N`; `0`; `n:num`] VSUM_PAIR) THEN
1727   ASM_REWRITE_TAC[ARITH]);;
1728
1729 (* ------------------------------------------------------------------------- *)
1730 (* Add useful congruences to the simplifier.                                 *)
1731 (* ------------------------------------------------------------------------- *)
1732
1733 let th = prove
1734  (`(!f g s.   (!x. x IN s ==> f(x) = g(x))
1735               ==> vsum s (\i. f(i)) = vsum s g) /\
1736    (!f g a b. (!i. a <= i /\ i <= b ==> f(i) = g(i))
1737               ==> vsum(a..b) (\i. f(i)) = vsum(a..b) g) /\
1738    (!f g p.   (!x. p x ==> f x = g x)
1739               ==> vsum {y | p y} (\i. f(i)) = vsum {y | p y} g)`,
1740   REPEAT STRIP_TAC THEN MATCH_MP_TAC VSUM_EQ THEN
1741   ASM_SIMP_TAC[IN_ELIM_THM; IN_NUMSEG]) in
1742   extend_basic_congs (map SPEC_ALL (CONJUNCTS th));;
1743
1744 (* ------------------------------------------------------------------------- *)
1745 (* A conversion for evaluation of `vsum(m..n) f` for numerals m and n.       *)
1746 (* ------------------------------------------------------------------------- *)
1747
1748 let EXPAND_VSUM_CONV =
1749   let pth_0,pth_1 = (CONJ_PAIR o prove)
1750    (`vsum(0..0) (f:num->real^N) = f(0) /\
1751      vsum(0..SUC n) f = vsum(0..n) f + f(SUC n)`,
1752     REWRITE_TAC[VSUM_CLAUSES_NUMSEG; LE_0; VECTOR_ADD_AC]) in
1753   let conv_0 = REWR_CONV pth_0 and conv_1 = REWR_CONV pth_1 in
1754   let rec conv tm =
1755     try (LAND_CONV(RAND_CONV num_CONV) THENC conv_1 THENC
1756          NUM_REDUCE_CONV THENC LAND_CONV conv) tm
1757     with Failure _ -> conv_0 tm in
1758   conv THENC
1759   (REDEPTH_CONV BETA_CONV) THENC
1760   GEN_REWRITE_CONV TOP_DEPTH_CONV [GSYM VECTOR_ADD_ASSOC];;
1761
1762 (* ------------------------------------------------------------------------- *)
1763 (* Basis vectors in coordinate directions.                                   *)
1764 (* ------------------------------------------------------------------------- *)
1765
1766 let basis = new_definition
1767   `basis k = lambda i. if i = k then &1 else &0`;;
1768
1769 let NORM_BASIS = prove
1770  (`!k. 1 <= k /\ k <= dimindex(:N)
1771        ==> (norm(basis k :real^N) = &1)`,
1772   REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[basis; dot; vector_norm] THEN
1773   GEN_REWRITE_TAC RAND_CONV [GSYM SQRT_1] THEN AP_TERM_TAC THEN
1774   MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC
1775    `sum (1..dimindex(:N)) (\i. if i = k then &1 else &0)` THEN
1776   CONJ_TAC THENL
1777    [MATCH_MP_TAC SUM_EQ_NUMSEG THEN
1778     ASM_SIMP_TAC[LAMBDA_BETA; IN_NUMSEG; EQ_SYM_EQ] THEN
1779     REPEAT STRIP_TAC THEN COND_CASES_TAC THEN REAL_ARITH_TAC;
1780     ASM_REWRITE_TAC[SUM_DELTA; IN_NUMSEG]]);;
1781
1782 let NORM_BASIS_1 = prove
1783  (`norm(basis 1) = &1`,
1784   SIMP_TAC[NORM_BASIS; ARITH_EQ; ARITH_RULE `1 <= k <=> ~(k = 0)`;
1785            DIMINDEX_NONZERO]);;
1786
1787 let VECTOR_CHOOSE_SIZE = prove
1788  (`!c. &0 <= c ==> ?x:real^N. norm(x) = c`,
1789   REPEAT STRIP_TAC THEN EXISTS_TAC `c % basis 1 :real^N` THEN
1790   ASM_REWRITE_TAC[NORM_MUL; real_abs; NORM_BASIS_1; REAL_MUL_RID]);;
1791
1792 let VECTOR_CHOOSE_DIST = prove
1793  (`!x e. &0 <= e ==> ?y:real^N. dist(x,y) = e`,
1794   REPEAT STRIP_TAC THEN
1795   SUBGOAL_THEN `?c:real^N. norm(c) = e` CHOOSE_TAC THENL
1796    [ASM_SIMP_TAC[VECTOR_CHOOSE_SIZE]; ALL_TAC] THEN
1797   EXISTS_TAC `x - c:real^N` THEN REWRITE_TAC[dist] THEN
1798   ASM_REWRITE_TAC[VECTOR_ARITH `x - (x - c) = c:real^N`]);;
1799
1800 let BASIS_INJ = prove
1801  (`!i j. 1 <= i /\ i <= dimindex(:N) /\
1802          1 <= j /\ j <= dimindex(:N) /\
1803          (basis i :real^N = basis j)
1804          ==> (i = j)`,
1805   SIMP_TAC[basis; CART_EQ; LAMBDA_BETA] THEN REPEAT GEN_TAC THEN
1806   REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `i:num`) THEN
1807   ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN
1808   ASM_SIMP_TAC[REAL_OF_NUM_EQ; ARITH_EQ]);;
1809
1810 let BASIS_NE = prove
1811  (`!i j. 1 <= i /\ i <= dimindex(:N) /\
1812          1 <= j /\ j <= dimindex(:N) /\
1813          ~(i = j)
1814          ==> ~(basis i :real^N = basis j)`,
1815   MESON_TAC[BASIS_INJ]);;
1816
1817 let BASIS_COMPONENT = prove
1818  (`!k i. 1 <= i /\ i <= dimindex(:N)
1819          ==> ((basis k :real^N)$i = if i = k then &1 else &0)`,
1820   SIMP_TAC[basis; LAMBDA_BETA] THEN MESON_TAC[]);;
1821
1822 let BASIS_EXPANSION = prove
1823  (`!x:real^N. vsum(1..dimindex(:N)) (\i. x$i % basis i) = x`,
1824   SIMP_TAC[CART_EQ; VSUM_COMPONENT; VECTOR_MUL_COMPONENT; BASIS_COMPONENT] THEN
1825   ONCE_REWRITE_TAC[COND_RAND] THEN REWRITE_TAC[REAL_MUL_RZERO] THEN
1826   REPEAT STRIP_TAC THEN
1827   GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [EQ_SYM_EQ] THEN
1828   ASM_SIMP_TAC[SUM_DELTA; IN_NUMSEG; REAL_MUL_RID]);;
1829
1830 let BASIS_EXPANSION_UNIQUE = prove
1831  (`!f x:real^N. (vsum(1..dimindex(:N)) (\i. f(i) % basis i) = x) <=>
1832                 (!i. 1 <= i /\ i <= dimindex(:N) ==> f(i) = x$i)`,
1833   SIMP_TAC[CART_EQ; VSUM_COMPONENT; VECTOR_MUL_COMPONENT; BASIS_COMPONENT] THEN
1834   REPEAT GEN_TAC THEN REWRITE_TAC[COND_RAND; REAL_MUL_RZERO; REAL_MUL_RID] THEN
1835   GEN_REWRITE_TAC (LAND_CONV o BINDER_CONV o RAND_CONV o LAND_CONV o
1836                    ONCE_DEPTH_CONV) [EQ_SYM_EQ] THEN
1837   SIMP_TAC[SUM_DELTA; IN_NUMSEG]);;
1838
1839 let DOT_BASIS = prove
1840  (`!x:real^N i.
1841         1 <= i /\ i <= dimindex(:N)
1842         ==> ((basis i) dot x = x$i) /\ (x dot (basis i) = x$i)`,
1843   SIMP_TAC[dot; basis; LAMBDA_BETA] THEN
1844   REWRITE_TAC[COND_RATOR; COND_RAND] THEN
1845   REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_RZERO] THEN
1846   SIMP_TAC[SUM_DELTA; IN_NUMSEG; REAL_MUL_LID; REAL_MUL_RID]);;
1847
1848 let DOT_BASIS_BASIS = prove
1849  (`!i j. 1 <= i /\ i <= dimindex(:N) /\
1850          1 <= j /\ j <= dimindex(:N)
1851          ==> (basis i:real^N) dot (basis j) = if i = j then &1 else &0`,
1852   SIMP_TAC[DOT_BASIS; BASIS_COMPONENT]);;
1853
1854 let DOT_BASIS_BASIS_UNEQUAL = prove
1855  (`!i j. ~(i = j) ==> (basis i) dot (basis j) = &0`,
1856   SIMP_TAC[basis; dot; LAMBDA_BETA] THEN ONCE_REWRITE_TAC[COND_RAND] THEN
1857   SIMP_TAC[SUM_0; REAL_MUL_RZERO; REAL_MUL_LZERO; COND_ID]);;
1858
1859 let BASIS_EQ_0 = prove
1860  (`!i. (basis i :real^N = vec 0) <=> ~(i IN 1..dimindex(:N))`,
1861   SIMP_TAC[CART_EQ; BASIS_COMPONENT; VEC_COMPONENT; IN_NUMSEG] THEN
1862   MESON_TAC[REAL_ARITH `~(&1 = &0)`]);;
1863
1864 let BASIS_NONZERO = prove
1865  (`!k. 1 <= k /\ k <= dimindex(:N)
1866        ==> ~(basis k :real^N = vec 0)`,
1867   REWRITE_TAC[BASIS_EQ_0; IN_NUMSEG]);;
1868
1869 let VECTOR_EQ_LDOT = prove
1870  (`!y z. (!x. x dot y = x dot z) <=> y = z`,
1871   REPEAT GEN_TAC THEN EQ_TAC THEN SIMP_TAC[] THEN
1872   REWRITE_TAC[CART_EQ] THEN MESON_TAC[DOT_BASIS]);;
1873
1874 let VECTOR_EQ_RDOT = prove
1875  (`!x y. (!z. x dot z = y dot z) <=> x = y`,
1876   REPEAT GEN_TAC THEN EQ_TAC THEN SIMP_TAC[] THEN
1877   REWRITE_TAC[CART_EQ] THEN MESON_TAC[DOT_BASIS]);;
1878
1879 (* ------------------------------------------------------------------------- *)
1880 (* Orthogonality.                                                            *)
1881 (* ------------------------------------------------------------------------- *)
1882
1883 let orthogonal = new_definition
1884   `orthogonal x y <=> (x dot y = &0)`;;
1885
1886 let ORTHOGONAL_0 = prove
1887  (`!x. orthogonal (vec 0) x /\ orthogonal x (vec 0)`,
1888   REWRITE_TAC[orthogonal; DOT_LZERO; DOT_RZERO]);;
1889
1890 let ORTHOGONAL_REFL = prove
1891  (`!x. orthogonal x x <=> x = vec 0`,
1892   REWRITE_TAC[orthogonal; DOT_EQ_0]);;
1893
1894 let ORTHOGONAL_SYM = prove
1895  (`!x y. orthogonal x y <=> orthogonal y x`,
1896   REWRITE_TAC[orthogonal; DOT_SYM]);;
1897
1898 let ORTHOGONAL_LNEG = prove
1899  (`!x y. orthogonal (--x) y <=> orthogonal x y`,
1900   REWRITE_TAC[orthogonal; DOT_LNEG; REAL_NEG_EQ_0]);;
1901
1902 let ORTHOGONAL_RNEG = prove
1903  (`!x y. orthogonal x (--y) <=> orthogonal x y`,
1904   REWRITE_TAC[orthogonal; DOT_RNEG; REAL_NEG_EQ_0]);;
1905
1906 let ORTHOGONAL_BASIS = prove
1907  (`!x:real^N i. 1 <= i /\ i <= dimindex(:N)
1908                 ==> (orthogonal (basis i) x <=> (x$i = &0))`,
1909   REPEAT STRIP_TAC THEN SIMP_TAC[orthogonal; dot; basis; LAMBDA_BETA] THEN
1910   REWRITE_TAC[COND_RAND; COND_RATOR; REAL_MUL_LZERO] THEN
1911   ASM_SIMP_TAC[SUM_DELTA; IN_NUMSEG; REAL_MUL_LID]);;
1912
1913 let ORTHOGONAL_BASIS_BASIS = prove
1914  (`!i j. 1 <= i /\ i <= dimindex(:N) /\
1915          1 <= j /\ j <= dimindex(:N)
1916          ==> (orthogonal (basis i :real^N) (basis j) <=> ~(i = j))`,
1917   ASM_SIMP_TAC[ORTHOGONAL_BASIS] THEN ASM_SIMP_TAC[BASIS_COMPONENT] THEN
1918   MESON_TAC[REAL_ARITH `~(&1 = &0)`]);;
1919
1920 let ORTHOGONAL_CLAUSES = prove
1921  (`(!a. orthogonal a (vec 0)) /\
1922    (!a x c. orthogonal a x ==> orthogonal a (c % x)) /\
1923    (!a x. orthogonal a x ==> orthogonal a (--x)) /\
1924    (!a x y. orthogonal a x /\ orthogonal a y ==> orthogonal a (x + y)) /\
1925    (!a x y. orthogonal a x /\ orthogonal a y ==> orthogonal a (x - y)) /\
1926    (!a. orthogonal (vec 0) a) /\
1927    (!a x c. orthogonal x a ==> orthogonal (c % x) a) /\
1928    (!a x. orthogonal x a ==> orthogonal (--x) a) /\
1929    (!a x y. orthogonal x a /\ orthogonal y a ==> orthogonal (x + y) a) /\
1930    (!a x y. orthogonal x a /\ orthogonal y a ==> orthogonal (x - y) a)`,
1931   REWRITE_TAC[orthogonal; DOT_RNEG; DOT_RMUL; DOT_RADD; DOT_RSUB;
1932     DOT_LZERO; DOT_RZERO; DOT_LNEG; DOT_LMUL; DOT_LADD; DOT_LSUB] THEN
1933   SIMP_TAC[] THEN REAL_ARITH_TAC);;
1934
1935 (* ------------------------------------------------------------------------- *)
1936 (* Explicit vector construction from lists.                                  *)
1937 (* ------------------------------------------------------------------------- *)
1938
1939 let VECTOR_1 = prove
1940  (`(vector[x]:A^1)$1 = x`,
1941   SIMP_TAC[vector; LAMBDA_BETA; DIMINDEX_1; ARITH; LENGTH; EL; HD; TL]);;
1942
1943 let VECTOR_2 = prove
1944  (`(vector[x;y]:A^2)$1 = x /\
1945    (vector[x;y]:A^2)$2 = y`,
1946   SIMP_TAC[vector; LAMBDA_BETA; DIMINDEX_2; ARITH; LENGTH; EL] THEN
1947   REWRITE_TAC[num_CONV `1`; HD; TL; EL]);;
1948
1949 let VECTOR_3 = prove
1950  (`(vector[x;y;z]:A^3)$1 = x /\
1951    (vector[x;y;z]:A^3)$2 = y /\
1952    (vector[x;y;z]:A^3)$3 = z`,
1953   SIMP_TAC[vector; LAMBDA_BETA; DIMINDEX_3; ARITH; LENGTH; EL] THEN
1954   REWRITE_TAC[num_CONV `2`; num_CONV `1`; HD; TL; EL]);;
1955
1956 let FORALL_VECTOR_1 = prove
1957  (`(!v:A^1. P v) <=> !x. P(vector[x])`,
1958   EQ_TAC THEN SIMP_TAC[] THEN REPEAT STRIP_TAC THEN
1959   FIRST_X_ASSUM(MP_TAC o SPEC `(v:A^1)$1`) THEN
1960   MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN
1961   REWRITE_TAC[CART_EQ; FORALL_1; VECTOR_1; DIMINDEX_1]);;
1962
1963 let FORALL_VECTOR_2 = prove
1964  (`(!v:A^2. P v) <=> !x y. P(vector[x;y])`,
1965   EQ_TAC THEN SIMP_TAC[] THEN REPEAT STRIP_TAC THEN
1966   FIRST_X_ASSUM(MP_TAC o SPECL [`(v:A^2)$1`; `(v:A^2)$2`]) THEN
1967   MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN
1968   REWRITE_TAC[CART_EQ; FORALL_2; VECTOR_2; DIMINDEX_2]);;
1969
1970 let FORALL_VECTOR_3 = prove
1971  (`(!v:A^3. P v) <=> !x y z. P(vector[x;y;z])`,
1972   EQ_TAC THEN SIMP_TAC[] THEN REPEAT STRIP_TAC THEN
1973   FIRST_X_ASSUM(MP_TAC o SPECL
1974     [`(v:A^3)$1`; `(v:A^3)$2`; `(v:A^3)$3`]) THEN
1975   MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN
1976   REWRITE_TAC[CART_EQ; FORALL_3; VECTOR_3; DIMINDEX_3]);;
1977
1978 let EXISTS_VECTOR_1 = prove
1979  (`(?v:A^1. P v) <=> ?x. P(vector[x])`,
1980   REWRITE_TAC[MESON[] `(?x. P x) <=> ~(!x. ~P x)`] THEN
1981   REWRITE_TAC[FORALL_VECTOR_1]);;
1982
1983 let EXISTS_VECTOR_2 = prove
1984  (`(?v:A^2. P v) <=> ?x y. P(vector[x;y])`,
1985   REWRITE_TAC[MESON[] `(?x. P x) <=> ~(!x. ~P x)`] THEN
1986   REWRITE_TAC[FORALL_VECTOR_2]);;
1987
1988 let EXISTS_VECTOR_3 = prove
1989  (`(?v:A^3. P v) <=> ?x y z. P(vector[x;y;z])`,
1990   REWRITE_TAC[MESON[] `(?x. P x) <=> ~(!x. ~P x)`] THEN
1991   REWRITE_TAC[FORALL_VECTOR_3]);;
1992
1993 (* ------------------------------------------------------------------------- *)
1994 (* Linear functions.                                                         *)
1995 (* ------------------------------------------------------------------------- *)
1996
1997 let linear = new_definition
1998   `linear (f:real^M->real^N) <=>
1999         (!x y. f(x + y) = f(x) + f(y)) /\
2000         (!c x. f(c % x) = c % f(x))`;;
2001
2002 let LINEAR_COMPOSE_CMUL = prove
2003  (`!f c. linear f ==> linear (\x. c % f(x))`,
2004   SIMP_TAC[linear] THEN REPEAT STRIP_TAC THEN VECTOR_ARITH_TAC);;
2005
2006 let LINEAR_COMPOSE_NEG = prove
2007  (`!f. linear f ==> linear (\x. --(f(x)))`,
2008   SIMP_TAC[linear] THEN REPEAT STRIP_TAC THEN VECTOR_ARITH_TAC);;
2009
2010 let LINEAR_COMPOSE_ADD = prove
2011  (`!f g. linear f /\ linear g ==> linear (\x. f(x) + g(x))`,
2012   SIMP_TAC[linear] THEN REPEAT STRIP_TAC THEN VECTOR_ARITH_TAC);;
2013
2014 let LINEAR_COMPOSE_SUB = prove
2015  (`!f g. linear f /\ linear g ==> linear (\x. f(x) - g(x))`,
2016   SIMP_TAC[linear] THEN REPEAT STRIP_TAC THEN VECTOR_ARITH_TAC);;
2017
2018 let LINEAR_COMPOSE = prove
2019  (`!f g. linear f /\ linear g ==> linear (g o f)`,
2020   SIMP_TAC[linear; o_THM]);;
2021
2022 let LINEAR_ID = prove
2023  (`linear (\x. x)`,
2024   REWRITE_TAC[linear]);;
2025
2026 let LINEAR_I = prove
2027  (`linear I`,
2028   REWRITE_TAC[I_DEF; LINEAR_ID]);;
2029
2030 let LINEAR_ZERO = prove
2031  (`linear (\x. vec 0)`,
2032   REWRITE_TAC[linear] THEN CONJ_TAC THEN VECTOR_ARITH_TAC);;
2033
2034 let LINEAR_NEGATION = prove
2035  (`linear(--)`,
2036   REWRITE_TAC[linear] THEN VECTOR_ARITH_TAC);;
2037
2038 let LINEAR_COMPOSE_VSUM = prove
2039  (`!f s. FINITE s /\ (!a. a IN s ==> linear(f a))
2040          ==> linear(\x. vsum s (\a. f a x))`,
2041   GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN
2042   MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
2043   SIMP_TAC[VSUM_CLAUSES; LINEAR_ZERO] THEN
2044   ASM_SIMP_TAC[ETA_AX; IN_INSERT; LINEAR_COMPOSE_ADD]);;
2045
2046 let LINEAR_VMUL_COMPONENT = prove
2047  (`!f:real^M->real^N v k.
2048      linear f /\ 1 <= k /\ k <= dimindex(:N)
2049      ==> linear (\x. f(x)$k % v)`,
2050   SIMP_TAC[linear; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT] THEN
2051   REPEAT STRIP_TAC THEN VECTOR_ARITH_TAC);;
2052
2053 let LINEAR_0 = prove
2054  (`!f. linear f ==> (f(vec 0) = vec 0)`,
2055   MESON_TAC[VECTOR_MUL_LZERO; linear]);;
2056
2057 let LINEAR_CMUL = prove
2058  (`!f c x. linear f ==> (f(c % x) = c % f(x))`,
2059   SIMP_TAC[linear]);;
2060
2061 let LINEAR_NEG = prove
2062  (`!f x. linear f ==> (f(--x) = --(f x))`,
2063   ONCE_REWRITE_TAC[VECTOR_NEG_MINUS1] THEN SIMP_TAC[LINEAR_CMUL]);;
2064
2065 let LINEAR_ADD = prove
2066  (`!f x y. linear f ==> (f(x + y) = f(x) + f(y))`,
2067   SIMP_TAC[linear]);;
2068
2069 let LINEAR_SUB = prove
2070  (`!f x y. linear f ==> (f(x - y) = f(x) - f(y))`,
2071   SIMP_TAC[VECTOR_SUB; LINEAR_ADD; LINEAR_NEG]);;
2072
2073 let LINEAR_VSUM = prove
2074  (`!f g s. linear f /\ FINITE s ==> (f(vsum s g) = vsum s (f o g))`,
2075   GEN_TAC THEN GEN_TAC THEN SIMP_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
2076   DISCH_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
2077   SIMP_TAC[VSUM_CLAUSES] THEN FIRST_ASSUM(fun th ->
2078     SIMP_TAC[MATCH_MP LINEAR_0 th; MATCH_MP LINEAR_ADD th; o_THM]));;
2079
2080 let LINEAR_VSUM_MUL = prove
2081  (`!f s c v.
2082         linear f /\ FINITE s
2083         ==> f(vsum s (\i. c i % v i)) = vsum s (\i. c(i) % f(v i))`,
2084   SIMP_TAC[LINEAR_VSUM; o_DEF; LINEAR_CMUL]);;
2085
2086 let LINEAR_INJECTIVE_0 = prove
2087  (`!f. linear f
2088        ==> ((!x y. (f(x) = f(y)) ==> (x = y)) <=>
2089             (!x. (f(x) = vec 0) ==> (x = vec 0)))`,
2090   REPEAT STRIP_TAC THEN
2091   GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [GSYM VECTOR_SUB_EQ] THEN
2092   ASM_SIMP_TAC[GSYM LINEAR_SUB] THEN MESON_TAC[VECTOR_SUB_RZERO]);;
2093
2094 let LINEAR_BOUNDED = prove
2095  (`!f:real^M->real^N. linear f ==> ?B. !x. norm(f x) <= B * norm(x)`,
2096   REPEAT STRIP_TAC THEN EXISTS_TAC
2097    `sum(1..dimindex(:M)) (\i. norm((f:real^M->real^N)(basis i)))` THEN
2098   GEN_TAC THEN
2099   GEN_REWRITE_TAC (LAND_CONV o funpow 2 RAND_CONV) [GSYM BASIS_EXPANSION] THEN
2100   ASM_SIMP_TAC[LINEAR_VSUM; FINITE_NUMSEG] THEN
2101   ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[GSYM SUM_LMUL] THEN
2102   MATCH_MP_TAC VSUM_NORM_LE THEN
2103   SIMP_TAC[FINITE_CROSS; FINITE_NUMSEG; IN_NUMSEG] THEN
2104   ASM_SIMP_TAC[o_DEF; NORM_MUL; LINEAR_CMUL] THEN
2105   ASM_SIMP_TAC[REAL_LE_RMUL; NORM_POS_LE; COMPONENT_LE_NORM]);;
2106
2107 let LINEAR_BOUNDED_POS = prove
2108  (`!f:real^M->real^N. linear f ==> ?B. &0 < B /\ !x. norm(f x) <= B * norm(x)`,
2109   REPEAT STRIP_TAC THEN
2110   FIRST_ASSUM(X_CHOOSE_TAC `B:real` o MATCH_MP LINEAR_BOUNDED) THEN
2111   EXISTS_TAC `abs(B) + &1` THEN CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN
2112   POP_ASSUM MP_TAC THEN MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN
2113   MATCH_MP_TAC(REAL_ARITH `a <= b ==> x <= a ==> x <= b`) THEN
2114   MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[NORM_POS_LE] THEN
2115   REAL_ARITH_TAC);;
2116
2117 let SYMMETRIC_LINEAR_IMAGE = prove
2118  (`!f s. (!x. x IN s ==> --x IN s) /\ linear f
2119           ==> !x. x IN (IMAGE f s) ==> --x IN (IMAGE f s)`,
2120   REWRITE_TAC[FORALL_IN_IMAGE] THEN
2121   SIMP_TAC[GSYM LINEAR_NEG] THEN SET_TAC[]);;
2122
2123 (* ------------------------------------------------------------------------- *)
2124 (* Bilinear functions.                                                       *)
2125 (* ------------------------------------------------------------------------- *)
2126
2127 let bilinear = new_definition
2128   `bilinear f <=> (!x. linear(\y. f x y)) /\ (!y. linear(\x. f x y))`;;
2129
2130 let BILINEAR_LADD = prove
2131  (`!h x y z. bilinear h ==> h (x + y) z = (h x z) + (h y z)`,
2132   SIMP_TAC[bilinear; linear]);;
2133
2134 let BILINEAR_RADD = prove
2135  (`!h x y z. bilinear h ==> h x (y + z) = (h x y) + (h x z)`,
2136   SIMP_TAC[bilinear; linear]);;
2137
2138 let BILINEAR_LMUL = prove
2139  (`!h c x y. bilinear h ==> h (c % x) y = c % (h x y)`,
2140   SIMP_TAC[bilinear; linear]);;
2141
2142 let BILINEAR_RMUL = prove
2143  (`!h c x y. bilinear h ==> h x (c % y) = c % (h x y)`,
2144   SIMP_TAC[bilinear; linear]);;
2145
2146 let BILINEAR_LNEG = prove
2147  (`!h x y. bilinear h ==> h (--x) y = --(h x y)`,
2148   ONCE_REWRITE_TAC[VECTOR_NEG_MINUS1] THEN SIMP_TAC[BILINEAR_LMUL]);;
2149
2150 let BILINEAR_RNEG = prove
2151  (`!h x y. bilinear h ==> h x (--y) = --(h x y)`,
2152   ONCE_REWRITE_TAC[VECTOR_NEG_MINUS1] THEN SIMP_TAC[BILINEAR_RMUL]);;
2153
2154 let BILINEAR_LZERO = prove
2155  (`!h x. bilinear h ==> h (vec 0) x = vec 0`,
2156   ONCE_REWRITE_TAC[VECTOR_ARITH `x = vec 0 <=> x + x = x`] THEN
2157   SIMP_TAC[GSYM BILINEAR_LADD; VECTOR_ADD_LID]);;
2158
2159 let BILINEAR_RZERO = prove
2160  (`!h x. bilinear h ==> h x (vec 0) = vec 0`,
2161   ONCE_REWRITE_TAC[VECTOR_ARITH `x = vec 0 <=> x + x = x`] THEN
2162   SIMP_TAC[GSYM BILINEAR_RADD; VECTOR_ADD_LID]);;
2163
2164 let BILINEAR_LSUB = prove
2165  (`!h x y z. bilinear h ==> h (x - y) z = (h x z) - (h y z)`,
2166   SIMP_TAC[VECTOR_SUB; BILINEAR_LNEG; BILINEAR_LADD]);;
2167
2168 let BILINEAR_RSUB = prove
2169  (`!h x y z. bilinear h ==> h x (y - z) = (h x y) - (h x z)`,
2170   SIMP_TAC[VECTOR_SUB; BILINEAR_RNEG; BILINEAR_RADD]);;
2171
2172 let BILINEAR_VSUM = prove
2173  (`!h:real^M->real^N->real^P.
2174        bilinear h /\ FINITE s /\ FINITE t
2175        ==> h (vsum s f) (vsum t g) = vsum (s CROSS t) (\(i,j). h (f i) (g j))`,
2176   REPEAT GEN_TAC THEN SIMP_TAC[bilinear; ETA_AX] THEN
2177   ONCE_REWRITE_TAC[TAUT `(a /\ b) /\ c /\ d <=> (a /\ d) /\ (b /\ c)`] THEN
2178   DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN
2179   ONCE_REWRITE_TAC[LEFT_AND_FORALL_THM] THEN DISCH_TAC THEN
2180   FIRST_ASSUM(MP_TAC o GEN_ALL o MATCH_MP LINEAR_VSUM o SPEC_ALL) THEN
2181   SIMP_TAC[] THEN ASM_SIMP_TAC[LINEAR_VSUM; o_DEF; VSUM_VSUM_PRODUCT] THEN
2182   REWRITE_TAC[GSYM CROSS]);;
2183
2184 let BILINEAR_BOUNDED = prove
2185  (`!h:real^M->real^N->real^P.
2186         bilinear h ==> ?B. !x y. norm(h x y) <= B * norm(x) * norm(y)`,
2187   REPEAT STRIP_TAC THEN
2188   EXISTS_TAC `sum ((1..dimindex(:M)) CROSS (1..dimindex(:N)))
2189                   (\(i,j). norm((h:real^M->real^N->real^P)
2190                                 (basis i) (basis j)))` THEN
2191   REPEAT GEN_TAC THEN GEN_REWRITE_TAC
2192    (LAND_CONV o RAND_CONV o BINOP_CONV) [GSYM BASIS_EXPANSION] THEN
2193   ASM_SIMP_TAC[BILINEAR_VSUM; FINITE_NUMSEG] THEN
2194   ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[GSYM SUM_LMUL] THEN
2195   MATCH_MP_TAC VSUM_NORM_LE THEN
2196   SIMP_TAC[FINITE_CROSS; FINITE_NUMSEG; FORALL_PAIR_THM; IN_CROSS] THEN
2197   REWRITE_TAC[IN_NUMSEG] THEN REPEAT STRIP_TAC THEN
2198   ASM_SIMP_TAC[BILINEAR_LMUL; NORM_MUL] THEN
2199   ASM_SIMP_TAC[BILINEAR_RMUL; NORM_MUL; REAL_MUL_ASSOC] THEN
2200   MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[NORM_POS_LE] THEN
2201   ASM_SIMP_TAC[COMPONENT_LE_NORM; REAL_ABS_POS; REAL_LE_MUL2]);;
2202
2203 let BILINEAR_BOUNDED_POS = prove
2204  (`!h. bilinear h
2205        ==> ?B. &0 < B /\ !x y. norm(h x y) <= B * norm(x) * norm(y)`,
2206   REPEAT STRIP_TAC THEN
2207   FIRST_ASSUM(X_CHOOSE_TAC `B:real` o MATCH_MP BILINEAR_BOUNDED) THEN
2208   EXISTS_TAC `abs(B) + &1` THEN CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN
2209   POP_ASSUM MP_TAC THEN REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN
2210   MATCH_MP_TAC(REAL_ARITH `a <= b ==> x <= a ==> x <= b`) THEN
2211   REPEAT(MATCH_MP_TAC REAL_LE_RMUL THEN
2212          SIMP_TAC[NORM_POS_LE; REAL_LE_MUL]) THEN
2213   REAL_ARITH_TAC);;
2214
2215 let BILINEAR_VSUM_PARTIAL_SUC = prove
2216  (`!f g h:real^M->real^N->real^P m n.
2217         bilinear h
2218         ==> vsum (m..n) (\k. h (f k) (g(k + 1) - g(k))) =
2219                 if m <= n then h (f(n + 1)) (g(n + 1)) - h (f m) (g m) -
2220                                vsum (m..n) (\k. h (f(k + 1) - f(k)) (g(k + 1)))
2221                 else vec 0`,
2222   REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN REPEAT GEN_TAC THEN DISCH_TAC THEN
2223   GEN_TAC THEN INDUCT_TAC THEN
2224   COND_CASES_TAC THEN ASM_SIMP_TAC[VSUM_TRIV_NUMSEG; GSYM NOT_LE] THEN
2225   ASM_REWRITE_TAC[VSUM_CLAUSES_NUMSEG] THENL
2226    [COND_CASES_TAC THEN ASM_SIMP_TAC[ARITH] THENL
2227      [ASM_SIMP_TAC[BILINEAR_RSUB; BILINEAR_LSUB] THEN VECTOR_ARITH_TAC;
2228       ASM_ARITH_TAC];
2229     ALL_TAC] THEN
2230   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LE]) THEN
2231   DISCH_THEN(DISJ_CASES_THEN2 SUBST_ALL_TAC ASSUME_TAC) THEN
2232   ASM_SIMP_TAC[GSYM NOT_LT; VSUM_TRIV_NUMSEG; ARITH_RULE `n < SUC n`] THEN
2233   ASM_SIMP_TAC[GSYM ADD1; ADD_CLAUSES] THEN
2234   ASM_SIMP_TAC[BILINEAR_RSUB; BILINEAR_LSUB] THEN VECTOR_ARITH_TAC);;
2235
2236 let BILINEAR_VSUM_PARTIAL_PRE = prove
2237  (`!f g h:real^M->real^N->real^P m n.
2238         bilinear h
2239         ==> vsum (m..n) (\k. h (f k) (g(k) - g(k - 1))) =
2240                 if m <= n then h (f(n + 1)) (g(n)) - h (f m) (g(m - 1)) -
2241                                vsum (m..n) (\k. h (f(k + 1) - f(k)) (g(k)))
2242                 else vec 0`,
2243   REPEAT STRIP_TAC THEN
2244   FIRST_ASSUM(MP_TAC o ISPECL [`f:num->real^M`; `\k. (g:num->real^N)(k - 1)`;
2245                  `m:num`; `n:num`] o MATCH_MP BILINEAR_VSUM_PARTIAL_SUC) THEN
2246    REWRITE_TAC[ADD_SUB] THEN DISCH_THEN SUBST1_TAC THEN
2247   COND_CASES_TAC THEN REWRITE_TAC[]);;
2248
2249 (* ------------------------------------------------------------------------- *)
2250 (* Adjoints.                                                                 *)
2251 (* ------------------------------------------------------------------------- *)
2252
2253 let adjoint = new_definition
2254  `adjoint(f:real^M->real^N) = @f'. !x y. f(x) dot y = x dot f'(y)`;;
2255
2256 let ADJOINT_WORKS = prove
2257  (`!f:real^M->real^N. linear f ==> !x y. f(x) dot y = x dot (adjoint f)(y)`,
2258   GEN_TAC THEN DISCH_TAC THEN SIMP_TAC[adjoint] THEN CONV_TAC SELECT_CONV THEN
2259   ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN ONCE_REWRITE_TAC[GSYM SKOLEM_THM] THEN
2260   X_GEN_TAC `y:real^N` THEN
2261   EXISTS_TAC `(lambda i. (f:real^M->real^N) (basis i) dot y):real^M` THEN
2262   X_GEN_TAC `x:real^M` THEN
2263   GEN_REWRITE_TAC (funpow 2 LAND_CONV o RAND_CONV) [GSYM BASIS_EXPANSION] THEN
2264   ASM_SIMP_TAC[LINEAR_VSUM; FINITE_NUMSEG] THEN
2265   SIMP_TAC[dot; LAMBDA_BETA; VSUM_COMPONENT; GSYM SUM_LMUL; GSYM SUM_RMUL] THEN
2266   GEN_REWRITE_TAC RAND_CONV [SUM_SWAP_NUMSEG] THEN
2267   ASM_SIMP_TAC[o_THM; VECTOR_MUL_COMPONENT; LINEAR_CMUL; REAL_MUL_ASSOC]);;
2268
2269 let ADJOINT_LINEAR = prove
2270  (`!f:real^M->real^N. linear f ==> linear(adjoint f)`,
2271   REPEAT STRIP_TAC THEN REWRITE_TAC[linear; GSYM VECTOR_EQ_LDOT] THEN
2272   ASM_SIMP_TAC[DOT_RMUL; DOT_RADD; GSYM ADJOINT_WORKS]);;
2273
2274 let ADJOINT_CLAUSES = prove
2275  (`!f:real^M->real^N.
2276      linear f ==> (!x y. x dot (adjoint f)(y) = f(x) dot y) /\
2277                   (!x y. (adjoint f)(y) dot x = y dot f(x))`,
2278   MESON_TAC[ADJOINT_WORKS; DOT_SYM]);;
2279
2280 let ADJOINT_ADJOINT = prove
2281  (`!f:real^M->real^N. linear f ==> adjoint(adjoint f) = f`,
2282   SIMP_TAC[FUN_EQ_THM; GSYM VECTOR_EQ_LDOT; ADJOINT_CLAUSES; ADJOINT_LINEAR]);;
2283
2284 let ADJOINT_UNIQUE = prove
2285  (`!f f'. linear f /\ (!x y. f'(x) dot y = x dot f(y))
2286           ==> f' = adjoint f`,
2287   SIMP_TAC[FUN_EQ_THM; GSYM VECTOR_EQ_RDOT; ADJOINT_CLAUSES]);;
2288
2289 (* ------------------------------------------------------------------------- *)
2290 (* Matrix notation. NB: an MxN matrix is of type real^N^M, not real^M^N.     *)
2291 (* We could define a special type if we're going to use them a lot.          *)
2292 (* ------------------------------------------------------------------------- *)
2293
2294 overload_interface ("--",`(matrix_neg):real^N^M->real^N^M`);;
2295 overload_interface ("+",`(matrix_add):real^N^M->real^N^M->real^N^M`);;
2296 overload_interface ("-",`(matrix_sub):real^N^M->real^N^M->real^N^M`);;
2297
2298 make_overloadable "**" `:A->B->C`;;
2299
2300 overload_interface ("**",`(matrix_mul):real^N^M->real^P^N->real^P^M`);;
2301 overload_interface ("**",`(matrix_vector_mul):real^N^M->real^N->real^M`);;
2302 overload_interface ("**",`(vector_matrix_mul):real^M->real^N^M->real^N`);;
2303
2304 parse_as_infix("%%",(21,"right"));;
2305
2306 prioritize_real();;
2307
2308 let matrix_cmul = new_definition
2309   `((%%):real->real^N^M->real^N^M) c A = lambda i j. c * A$i$j`;;
2310
2311 let matrix_neg = new_definition
2312   `!A:real^N^M. --A = lambda i j. --(A$i$j)`;;
2313
2314 let matrix_add = new_definition
2315   `!A:real^N^M B:real^N^M. A + B = lambda i j. A$i$j + B$i$j`;;
2316
2317 let matrix_sub = new_definition
2318   `!A:real^N^M B:real^N^M. A - B = lambda i j. A$i$j - B$i$j`;;
2319
2320 let matrix_mul = new_definition
2321   `!A:real^N^M B:real^P^N.
2322         A ** B =
2323           lambda i j. sum(1..dimindex(:N)) (\k. A$i$k * B$k$j)`;;
2324
2325 let matrix_vector_mul = new_definition
2326   `!A:real^N^M x:real^N.
2327         A ** x = lambda i. sum(1..dimindex(:N)) (\j. A$i$j * x$j)`;;
2328
2329 let vector_matrix_mul = new_definition
2330   `!A:real^N^M x:real^M.
2331         x ** A = lambda j. sum(1..dimindex(:M)) (\i. A$i$j * x$i)`;;
2332
2333 let mat = new_definition
2334   `(mat:num->real^N^M) k = lambda i j. if i = j then &k else &0`;;
2335
2336 let transp = new_definition
2337   `(transp:real^N^M->real^M^N) A = lambda i j. A$j$i`;;
2338
2339 let row = new_definition
2340  `(row:num->real^N^M->real^N) i A = lambda j. A$i$j`;;
2341
2342 let column = new_definition
2343  `(column:num->real^N^M->real^M) j A = lambda i. A$i$j`;;
2344
2345 let rows = new_definition
2346  `rows(A:real^N^M) = { row i A | 1 <= i /\ i <= dimindex(:M)}`;;
2347
2348 let columns = new_definition
2349  `columns(A:real^N^M) = { column i A | 1 <= i /\ i <= dimindex(:N)}`;;
2350
2351 let MATRIX_CMUL_COMPONENT = prove
2352  (`!c A:real^N^M i. (c %% A)$i$j = c * A$i$j`,
2353   REPEAT GEN_TAC THEN
2354   SUBGOAL_THEN `?k. 1 <= k /\ k <= dimindex(:M) /\ !A:real^N^M. A$i = A$k`
2355   CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN
2356   SUBGOAL_THEN `?l. 1 <= l /\ l <= dimindex(:N) /\ !z:real^N. z$j = z$l`
2357   CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN
2358   ASM_SIMP_TAC[matrix_cmul; CART_EQ; LAMBDA_BETA]);;
2359
2360 let MATRIX_ADD_COMPONENT = prove
2361  (`!A B:real^N^M i j. (A + B)$i$j = A$i$j + B$i$j`,
2362   REPEAT GEN_TAC THEN
2363   SUBGOAL_THEN `?k. 1 <= k /\ k <= dimindex(:M) /\ !A:real^N^M. A$i = A$k`
2364   CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN
2365   SUBGOAL_THEN `?l. 1 <= l /\ l <= dimindex(:N) /\ !z:real^N. z$j = z$l`
2366   CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN
2367   ASM_SIMP_TAC[matrix_add; LAMBDA_BETA]);;
2368
2369 let MATRIX_SUB_COMPONENT = prove
2370  (`!A B:real^N^M i j. (A - B)$i$j = A$i$j - B$i$j`,
2371   REPEAT GEN_TAC THEN
2372   SUBGOAL_THEN `?k. 1 <= k /\ k <= dimindex(:M) /\ !A:real^N^M. A$i = A$k`
2373   CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN
2374   SUBGOAL_THEN `?l. 1 <= l /\ l <= dimindex(:N) /\ !z:real^N. z$j = z$l`
2375   CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN
2376   ASM_SIMP_TAC[matrix_sub; LAMBDA_BETA]);;
2377
2378 let MATRIX_NEG_COMPONENT = prove
2379  (`!A:real^N^M i j. (--A)$i$j = --(A$i$j)`,
2380   REPEAT GEN_TAC THEN
2381   SUBGOAL_THEN `?k. 1 <= k /\ k <= dimindex(:M) /\ !A:real^N^M. A$i = A$k`
2382   CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN
2383   SUBGOAL_THEN `?l. 1 <= l /\ l <= dimindex(:N) /\ !z:real^N. z$j = z$l`
2384   CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN
2385   ASM_SIMP_TAC[matrix_neg; LAMBDA_BETA]);;
2386
2387 let TRANSP_COMPONENT = prove
2388  (`!A:real^N^M i j. (transp A)$i$j = A$j$i`,
2389   REPEAT GEN_TAC THEN
2390   SUBGOAL_THEN `?k. 1 <= k /\ k <= dimindex(:N) /\
2391                     (!A:real^M^N. A$i = A$k) /\ (!z:real^N. z$i = z$k)`
2392   CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE_2]; ALL_TAC] THEN
2393   SUBGOAL_THEN `?l. 1 <= l /\ l <= dimindex(:M) /\
2394                     (!A:real^N^M. A$j = A$l) /\ (!z:real^M. z$j = z$l)`
2395   CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE_2]; ALL_TAC] THEN
2396   ASM_SIMP_TAC[transp; LAMBDA_BETA]);;
2397
2398 let MAT_COMPONENT = prove
2399  (`!n i j.
2400         1 <= i /\ i <= dimindex(:M) /\
2401         1 <= j /\ j <= dimindex(:N)
2402         ==> (mat n:real^N^M)$i$j = if i = j then &n else &0`,
2403   SIMP_TAC[mat; LAMBDA_BETA]);;
2404
2405 let MATRIX_CMUL_ASSOC = prove
2406  (`!a b X:real^M^N. a %% (b %% X) = (a * b) %% X`,
2407   SIMP_TAC[CART_EQ; matrix_cmul; LAMBDA_BETA; REAL_MUL_ASSOC]);;
2408
2409 let MATRIX_CMUL_LID = prove
2410  (`!X:real^M^N. &1 %% X = X`,
2411   SIMP_TAC[CART_EQ; matrix_cmul; LAMBDA_BETA; REAL_MUL_LID]);;
2412
2413 let MATRIX_ADD_SYM = prove
2414  (`!A:real^N^M B. A + B = B + A`,
2415   SIMP_TAC[matrix_add; CART_EQ; LAMBDA_BETA; REAL_ADD_AC]);;
2416
2417 let MATRIX_ADD_ASSOC = prove
2418  (`!A:real^N^M B C. A + (B + C) = (A + B) + C`,
2419   SIMP_TAC[matrix_add; CART_EQ; LAMBDA_BETA; REAL_ADD_AC]);;
2420
2421 let MATRIX_ADD_LID = prove
2422  (`!A. mat 0 + A = A`,
2423   SIMP_TAC[matrix_add; mat; COND_ID; CART_EQ; LAMBDA_BETA; REAL_ADD_LID]);;
2424
2425 let MATRIX_ADD_RID = prove
2426  (`!A. A + mat 0 = A`,
2427   SIMP_TAC[matrix_add; mat; COND_ID; CART_EQ; LAMBDA_BETA; REAL_ADD_RID]);;
2428
2429 let MATRIX_ADD_LNEG = prove
2430  (`!A. --A + A = mat 0`,
2431   SIMP_TAC[matrix_neg; matrix_add; mat; COND_ID;
2432            CART_EQ; LAMBDA_BETA; REAL_ADD_LINV]);;
2433
2434 let MATRIX_ADD_RNEG = prove
2435  (`!A. A + --A = mat 0`,
2436   SIMP_TAC[matrix_neg; matrix_add; mat; COND_ID;
2437            CART_EQ; LAMBDA_BETA; REAL_ADD_RINV]);;
2438
2439 let MATRIX_SUB = prove
2440  (`!A:real^N^M B. A - B = A + --B`,
2441   SIMP_TAC[matrix_neg; matrix_add; matrix_sub; CART_EQ; LAMBDA_BETA;
2442            real_sub]);;
2443
2444 let MATRIX_SUB_REFL = prove
2445  (`!A. A - A = mat 0`,
2446   REWRITE_TAC[MATRIX_SUB; MATRIX_ADD_RNEG]);;
2447
2448 let MATRIX_ADD_LDISTRIB = prove
2449  (`!A:real^N^M B:real^P^N C. A ** (B + C) = A ** B + A ** C`,
2450   SIMP_TAC[matrix_mul; matrix_add; CART_EQ; LAMBDA_BETA;
2451            GSYM SUM_ADD_NUMSEG] THEN
2452   REPEAT STRIP_TAC THEN MATCH_MP_TAC SUM_EQ_NUMSEG THEN
2453   ASM_SIMP_TAC[LAMBDA_BETA; REAL_ADD_LDISTRIB]);;
2454
2455 let MATRIX_MUL_LID = prove
2456  (`!A:real^N^M. mat 1 ** A = A`,
2457   REWRITE_TAC[matrix_mul;
2458    GEN_REWRITE_RULE (RAND_CONV o ONCE_DEPTH_CONV) [EQ_SYM_EQ]
2459     (SPEC_ALL mat)] THEN
2460   SIMP_TAC[CART_EQ; LAMBDA_BETA] THEN REWRITE_TAC[COND_RATOR; COND_RAND] THEN
2461   SIMP_TAC[SUM_DELTA; REAL_MUL_LZERO; IN_NUMSEG; REAL_MUL_LID]);;
2462
2463 let MATRIX_MUL_RID = prove
2464  (`!A:real^N^M. A ** mat 1 = A`,
2465   REWRITE_TAC[matrix_mul; mat] THEN
2466   SIMP_TAC[CART_EQ; LAMBDA_BETA] THEN REWRITE_TAC[COND_RATOR; COND_RAND] THEN
2467   SIMP_TAC[SUM_DELTA; REAL_MUL_RZERO; IN_NUMSEG; REAL_MUL_RID]);;
2468
2469 let MATRIX_MUL_ASSOC = prove
2470  (`!A:real^N^M B:real^P^N C:real^Q^P. A ** B ** C = (A ** B) ** C`,
2471   REPEAT GEN_TAC THEN
2472   SIMP_TAC[matrix_mul; CART_EQ; LAMBDA_BETA; GSYM SUM_LMUL; GSYM SUM_RMUL] THEN
2473   REWRITE_TAC[REAL_MUL_ASSOC] THEN REPEAT STRIP_TAC THEN
2474   GEN_REWRITE_TAC RAND_CONV [SUM_SWAP_NUMSEG] THEN REWRITE_TAC[]);;
2475
2476 let MATRIX_MUL_LZERO = prove
2477  (`!A. (mat 0:real^N^M) ** (A:real^P^N) = mat 0`,
2478   SIMP_TAC[matrix_mul; mat; CART_EQ; LAMBDA_BETA; COND_ID; REAL_MUL_LZERO] THEN
2479   REWRITE_TAC[SUM_0]);;
2480
2481 let MATRIX_MUL_RZERO = prove
2482  (`!A. (A:real^N^M) ** (mat 0:real^P^N) = mat 0`,
2483   SIMP_TAC[matrix_mul; mat; CART_EQ; LAMBDA_BETA; COND_ID; REAL_MUL_RZERO] THEN
2484   REWRITE_TAC[SUM_0]);;
2485
2486 let MATRIX_ADD_RDISTRIB = prove
2487  (`!A:real^N^M B C:real^P^N. (A + B) ** C = A ** C + B ** C`,
2488   SIMP_TAC[matrix_mul; matrix_add; CART_EQ; LAMBDA_BETA] THEN
2489   REWRITE_TAC[REAL_ADD_RDISTRIB; SUM_ADD_NUMSEG]);;
2490
2491 let MATRIX_SUB_LDISTRIB = prove
2492  (`!A:real^N^M B C:real^P^N. A ** (B - C) = A ** B - A ** C`,
2493   SIMP_TAC[matrix_mul; matrix_sub; CART_EQ; LAMBDA_BETA] THEN
2494   REWRITE_TAC[REAL_SUB_LDISTRIB; SUM_SUB_NUMSEG]);;
2495
2496 let MATRIX_SUB_RDISTRIB = prove
2497  (`!A:real^N^M B C:real^P^N. (A - B) ** C = A ** C - B ** C`,
2498   SIMP_TAC[matrix_mul; matrix_sub; CART_EQ; LAMBDA_BETA] THEN
2499   REWRITE_TAC[REAL_SUB_RDISTRIB; SUM_SUB_NUMSEG]);;
2500
2501 let MATRIX_MUL_LMUL = prove
2502  (`!A:real^N^M B:real^P^N c. (c %% A) ** B = c %% (A ** B)`,
2503   SIMP_TAC[matrix_mul; matrix_cmul; CART_EQ; LAMBDA_BETA] THEN
2504   REWRITE_TAC[GSYM REAL_MUL_ASSOC; SUM_LMUL]);;
2505
2506 let MATRIX_MUL_RMUL = prove
2507  (`!A:real^N^M B:real^P^N c. A ** (c %% B) = c %% (A ** B)`,
2508   SIMP_TAC[matrix_mul; matrix_cmul; CART_EQ; LAMBDA_BETA] THEN
2509   ONCE_REWRITE_TAC[REAL_ARITH `A * c * B:real = c * A * B`] THEN
2510   REWRITE_TAC[SUM_LMUL]);;
2511
2512 let MATRIX_CMUL_ADD_LDISTRIB = prove
2513  (`!A:real^N^M B c. c %% (A + B) = c %% A + c %% B`,
2514   SIMP_TAC[matrix_cmul; matrix_add; CART_EQ; LAMBDA_BETA] THEN
2515   REWRITE_TAC[REAL_ADD_LDISTRIB]);;
2516
2517 let MATRIX_CMUL_SUB_LDISTRIB = prove
2518  (`!A:real^N^M B c. c %% (A - B) = c %% A - c %% B`,
2519   SIMP_TAC[matrix_cmul; matrix_sub; CART_EQ; LAMBDA_BETA] THEN
2520   REWRITE_TAC[REAL_SUB_LDISTRIB]);;
2521
2522 let MATRIX_CMUL_ADD_RDISTRIB = prove
2523  (`!A:real^N^M b c. (b + c) %% A = b %% A + c %% A`,
2524   SIMP_TAC[matrix_cmul; matrix_add; CART_EQ; LAMBDA_BETA] THEN
2525   REWRITE_TAC[REAL_ADD_RDISTRIB]);;
2526
2527 let MATRIX_CMUL_SUB_RDISTRIB = prove
2528  (`!A:real^N^M b c. (b - c) %% A = b %% A - c %% A`,
2529   SIMP_TAC[matrix_cmul; matrix_sub; CART_EQ; LAMBDA_BETA] THEN
2530   REWRITE_TAC[REAL_SUB_RDISTRIB]);;
2531
2532 let MATRIX_CMUL_RZERO = prove
2533  (`!c. c %% mat 0 = mat 0`,
2534   SIMP_TAC[matrix_cmul; mat; CART_EQ; LAMBDA_BETA; COND_ID; REAL_MUL_RZERO]);;
2535
2536 let MATRIX_CMUL_LZERO = prove
2537  (`!A. &0 %% A = mat 0`,
2538   SIMP_TAC[matrix_cmul; mat; CART_EQ; LAMBDA_BETA; COND_ID; REAL_MUL_LZERO]);;
2539
2540 let MATRIX_NEG_MINUS1 = prove
2541  (`!A:real^N^M. --A = --(&1) %% A`,
2542   REWRITE_TAC[matrix_cmul; matrix_neg; CART_EQ; LAMBDA_BETA] THEN
2543   REWRITE_TAC[GSYM REAL_NEG_MINUS1]);;
2544
2545 let MATRIX_ADD_AC = prove
2546  (`(A:real^N^M) + B = B + A /\
2547    (A + B) + C = A + (B + C) /\
2548    A + (B + C) = B + (A + C)`,
2549   MESON_TAC[MATRIX_ADD_ASSOC; MATRIX_ADD_SYM]);;
2550
2551 let MATRIX_NEG_ADD = prove
2552  (`!A B:real^N^M. --(A + B) = --A + --B`,
2553   SIMP_TAC[matrix_neg; matrix_add; CART_EQ; LAMBDA_BETA; REAL_NEG_ADD]);;
2554
2555 let MATRIX_NEG_SUB = prove
2556  (`!A B:real^N^M. --(A - B) = B - A`,
2557   SIMP_TAC[matrix_neg; matrix_sub; CART_EQ; LAMBDA_BETA; REAL_NEG_SUB]);;
2558
2559 let MATRIX_NEG_0 = prove
2560  (`--(mat 0) = mat 0`,
2561   SIMP_TAC[CART_EQ; mat; matrix_neg; LAMBDA_BETA; REAL_NEG_0; COND_ID]);;
2562
2563 let MATRIX_SUB_RZERO = prove
2564  (`!A:real^N^M. A - mat 0 = A`,
2565   SIMP_TAC[CART_EQ; mat; matrix_sub; LAMBDA_BETA; REAL_SUB_RZERO; COND_ID]);;
2566
2567 let MATRIX_SUB_LZERO = prove
2568  (`!A:real^N^M. mat 0 - A = --A`,
2569   SIMP_TAC[CART_EQ; mat; matrix_sub; matrix_neg;
2570            LAMBDA_BETA; REAL_SUB_LZERO; COND_ID]);;
2571
2572 let MATRIX_NEG_EQ_0 = prove
2573  (`!A:real^N^M. --A = mat 0 <=> A = mat 0`,
2574   SIMP_TAC[CART_EQ; matrix_neg; mat; LAMBDA_BETA; REAL_NEG_EQ_0; COND_ID]);;
2575
2576 let MATRIX_VECTOR_MUL_ASSOC = prove
2577  (`!A:real^N^M B:real^P^N x:real^P. A ** B ** x = (A ** B) ** x`,
2578   REPEAT GEN_TAC THEN
2579   SIMP_TAC[matrix_mul; matrix_vector_mul;
2580            CART_EQ; LAMBDA_BETA; GSYM SUM_LMUL; GSYM SUM_RMUL] THEN
2581   REWRITE_TAC[REAL_MUL_ASSOC] THEN REPEAT STRIP_TAC THEN
2582   GEN_REWRITE_TAC RAND_CONV [SUM_SWAP_NUMSEG] THEN REWRITE_TAC[]);;
2583
2584 let MATRIX_VECTOR_MUL_LID = prove
2585  (`!x:real^N. mat 1 ** x = x`,
2586   REWRITE_TAC[matrix_vector_mul;
2587    GEN_REWRITE_RULE (RAND_CONV o ONCE_DEPTH_CONV) [EQ_SYM_EQ]
2588     (SPEC_ALL mat)] THEN
2589   SIMP_TAC[CART_EQ; LAMBDA_BETA] THEN REWRITE_TAC[COND_RATOR; COND_RAND] THEN
2590   SIMP_TAC[SUM_DELTA; REAL_MUL_LZERO; IN_NUMSEG; REAL_MUL_LID]);;
2591
2592 let MATRIX_VECTOR_MUL_LZERO = prove
2593  (`!x:real^N. mat 0 ** x = vec 0`,
2594   SIMP_TAC[mat; matrix_vector_mul; CART_EQ; VEC_COMPONENT; LAMBDA_BETA;
2595            COND_ID; REAL_MUL_LZERO; SUM_0]);;
2596
2597 let MATRIX_VECTOR_MUL_RZERO = prove
2598  (`!A:real^M^N. A ** vec 0 = vec 0`,
2599   SIMP_TAC[mat; matrix_vector_mul; CART_EQ; VEC_COMPONENT; LAMBDA_BETA;
2600            COND_ID; REAL_MUL_RZERO; SUM_0]);;
2601
2602 let MATRIX_VECTOR_MUL_ADD_LDISTRIB = prove
2603  (`!A:real^M^N x:real^M y. A ** (x + y) = A ** x + A ** y`,
2604   SIMP_TAC[CART_EQ; matrix_vector_mul; VECTOR_ADD_COMPONENT; LAMBDA_BETA;
2605            SUM_ADD_NUMSEG; REAL_ADD_LDISTRIB]);;
2606
2607 let MATRIX_VECTOR_MUL_SUB_LDISTRIB = prove
2608  (`!A:real^M^N x:real^M y. A ** (x - y) = A ** x - A ** y`,
2609   SIMP_TAC[CART_EQ; matrix_vector_mul; VECTOR_SUB_COMPONENT; LAMBDA_BETA;
2610            SUM_SUB_NUMSEG; REAL_SUB_LDISTRIB]);;
2611
2612 let MATRIX_VECTOR_MUL_ADD_RDISTRIB = prove
2613  (`!A:real^M^N B x. (A + B) ** x = (A ** x) + (B ** x)`,
2614   SIMP_TAC[CART_EQ; matrix_vector_mul; matrix_add; LAMBDA_BETA;
2615            VECTOR_ADD_COMPONENT; REAL_ADD_RDISTRIB; SUM_ADD_NUMSEG]);;
2616
2617 let MATRIX_VECTOR_MUL_SUB_RDISTRIB = prove
2618  (`!A:real^M^N B x. (A - B) ** x = (A ** x) - (B ** x)`,
2619   SIMP_TAC[CART_EQ; matrix_vector_mul; matrix_sub; LAMBDA_BETA;
2620            VECTOR_SUB_COMPONENT; REAL_SUB_RDISTRIB; SUM_SUB_NUMSEG]);;
2621
2622 let MATRIX_VECTOR_MUL_RMUL = prove
2623  (`!A:real^M^N x:real^M c. A ** (c % x) = c % (A ** x)`,
2624   SIMP_TAC[CART_EQ; VECTOR_MUL_COMPONENT; matrix_vector_mul; LAMBDA_BETA] THEN
2625   REWRITE_TAC[GSYM SUM_LMUL] THEN REWRITE_TAC[REAL_MUL_AC]);;
2626
2627 let MATRIX_TRANSP_MUL = prove
2628  (`!A B. transp(A ** B) = transp(B) ** transp(A)`,
2629   SIMP_TAC[matrix_mul; transp; CART_EQ; LAMBDA_BETA] THEN
2630   REWRITE_TAC[REAL_MUL_AC]);;
2631
2632 let MATRIX_EQ = prove
2633  (`!A:real^N^M B. (A = B) = !x:real^N. A ** x = B ** x`,
2634   REPEAT GEN_TAC THEN EQ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN
2635   DISCH_THEN(MP_TAC o GEN `i:num` o SPEC `(basis i):real^N`) THEN
2636   SIMP_TAC[CART_EQ; matrix_vector_mul; LAMBDA_BETA; basis] THEN
2637   SIMP_TAC[SUM_DELTA; COND_RAND; REAL_MUL_RZERO] THEN
2638   REWRITE_TAC[TAUT `(if p then b else T) <=> p ==> b`] THEN
2639   SIMP_TAC[REAL_MUL_RID; IN_NUMSEG]);;
2640
2641 let MATRIX_VECTOR_MUL_COMPONENT = prove
2642  (`!A:real^N^M x k.
2643     1 <= k /\ k <= dimindex(:M) ==> ((A ** x)$k = (A$k) dot x)`,
2644   SIMP_TAC[matrix_vector_mul; LAMBDA_BETA; dot]);;
2645
2646 let DOT_LMUL_MATRIX = prove
2647  (`!A:real^N^M x:real^M y:real^N. (x ** A) dot y = x dot (A ** y)`,
2648   SIMP_TAC[dot; matrix_vector_mul; vector_matrix_mul; dot; LAMBDA_BETA] THEN
2649   REPEAT GEN_TAC THEN REWRITE_TAC[GSYM SUM_LMUL] THEN
2650   REWRITE_TAC[GSYM SUM_RMUL] THEN
2651   GEN_REWRITE_TAC RAND_CONV [SUM_SWAP_NUMSEG] THEN REWRITE_TAC[REAL_MUL_AC]);;
2652
2653 let TRANSP_MATRIX_CMUL = prove
2654  (`!A:real^M^N c. transp(c %% A) = c %% transp A`,
2655   SIMP_TAC[CART_EQ; transp; MATRIX_CMUL_COMPONENT; LAMBDA_BETA]);;
2656
2657 let TRANSP_MATRIX_ADD = prove
2658  (`!A B:real^N^M. transp(A + B) = transp A + transp B`,
2659   SIMP_TAC[CART_EQ; transp; LAMBDA_BETA; matrix_add]);;
2660
2661 let TRANSP_MATRIX_SUB = prove
2662  (`!A B:real^N^M. transp(A - B) = transp A - transp B`,
2663   SIMP_TAC[CART_EQ; transp; LAMBDA_BETA; matrix_sub]);;
2664
2665 let TRANSP_MATRIX_NEG = prove
2666  (`!A:real^N^M. transp(--A) = --(transp A)`,
2667   SIMP_TAC[CART_EQ; transp; LAMBDA_BETA; matrix_neg]);;
2668
2669 let TRANSP_MAT = prove
2670  (`!n. transp(mat n) = mat n`,
2671   SIMP_TAC[transp; mat; LAMBDA_BETA; CART_EQ; EQ_SYM_EQ]);;
2672
2673 let TRANSP_TRANSP = prove
2674  (`!A:real^N^M. transp(transp A) = A`,
2675   SIMP_TAC[CART_EQ; transp; LAMBDA_BETA]);;
2676
2677 let TRANSP_EQ = prove
2678  (`!A B:real^M^N. transp A = transp B <=> A = B`,
2679   MESON_TAC[TRANSP_TRANSP]);;
2680
2681 let ROW_TRANSP = prove
2682  (`!A:real^N^M i.
2683         1 <= i /\ i <= dimindex(:N) ==> row i (transp A) = column i A`,
2684   SIMP_TAC[row; column; transp; CART_EQ; LAMBDA_BETA]);;
2685
2686 let COLUMN_TRANSP = prove
2687  (`!A:real^N^M i.
2688         1 <= i /\ i <= dimindex(:M) ==> column i (transp A) = row i A`,
2689   SIMP_TAC[row; column; transp; CART_EQ; LAMBDA_BETA]);;
2690
2691 let ROWS_TRANSP = prove
2692  (`!A:real^N^M. rows(transp A) = columns A`,
2693   REWRITE_TAC[rows; columns; EXTENSION; IN_ELIM_THM] THEN
2694   MESON_TAC[ROW_TRANSP]);;
2695
2696 let COLUMNS_TRANSP = prove
2697  (`!A:real^N^M. columns(transp A) = rows A`,
2698   MESON_TAC[TRANSP_TRANSP; ROWS_TRANSP]);;
2699
2700 let VECTOR_MATRIX_MUL_TRANSP = prove
2701  (`!A:real^M^N x:real^N. x ** A = transp A ** x`,
2702   REWRITE_TAC[matrix_vector_mul; vector_matrix_mul; transp] THEN
2703   SIMP_TAC[LAMBDA_BETA; CART_EQ]);;
2704
2705 let MATRIX_VECTOR_MUL_TRANSP = prove
2706  (`!A:real^M^N x:real^M. A ** x = x ** transp A`,
2707   REWRITE_TAC[VECTOR_MATRIX_MUL_TRANSP; TRANSP_TRANSP]);;
2708
2709 (* ------------------------------------------------------------------------- *)
2710 (* Two sometimes fruitful ways of looking at matrix-vector multiplication.   *)
2711 (* ------------------------------------------------------------------------- *)
2712
2713 let MATRIX_MUL_DOT = prove
2714  (`!A:real^N^M x. A ** x = lambda i. A$i dot x`,
2715   REWRITE_TAC[matrix_vector_mul; dot] THEN SIMP_TAC[CART_EQ; LAMBDA_BETA]);;
2716
2717 let MATRIX_MUL_VSUM = prove
2718  (`!A:real^N^M x. A ** x = vsum(1..dimindex(:N)) (\i. x$i % column i A)`,
2719   SIMP_TAC[matrix_vector_mul; CART_EQ; VSUM_COMPONENT; LAMBDA_BETA;
2720            VECTOR_MUL_COMPONENT; column; REAL_MUL_AC]);;
2721
2722 (* ------------------------------------------------------------------------- *)
2723 (* Slightly gruesome lemmas: better to define sums over vectors really...    *)
2724 (* ------------------------------------------------------------------------- *)
2725
2726 let VECTOR_COMPONENTWISE = prove
2727  (`!x:real^N.
2728     x = lambda j. sum(1..dimindex(:N))
2729                      (\i. x$i * (basis i :real^N)$j)`,
2730   SIMP_TAC[CART_EQ; LAMBDA_BETA; basis] THEN
2731   ONCE_REWRITE_TAC[ARITH_RULE `(m:num = n) <=> (n = m)`] THEN
2732   SIMP_TAC[COND_RAND; REAL_MUL_RZERO; SUM_DELTA; IN_NUMSEG] THEN
2733   REWRITE_TAC[REAL_MUL_RID; COND_ID]);;
2734
2735 let LINEAR_COMPONENTWISE = prove
2736  (`!f:real^M->real^N.
2737       linear(f)
2738       ==> !x j. 1 <= j /\ j <= dimindex(:N)
2739                 ==> (f x $j =
2740                      sum(1..dimindex(:M)) (\i. x$i * f(basis i)$j))`,
2741   REWRITE_TAC[linear] THEN REPEAT STRIP_TAC THEN
2742   GEN_REWRITE_TAC (LAND_CONV o LAND_CONV o RAND_CONV)
2743    [VECTOR_COMPONENTWISE] THEN
2744   SPEC_TAC(`dimindex(:M)`,`n:num`) THEN
2745   INDUCT_TAC THEN REWRITE_TAC[SUM_CLAUSES_NUMSEG; ARITH] THENL
2746    [REWRITE_TAC[GSYM vec] THEN
2747     GEN_REWRITE_TAC (LAND_CONV o LAND_CONV o RAND_CONV)
2748      [GSYM VECTOR_MUL_LZERO] THEN
2749     ASM_REWRITE_TAC[] THEN REWRITE_TAC[VECTOR_MUL_LZERO] THEN
2750     ASM_SIMP_TAC[vec; LAMBDA_BETA];
2751     REWRITE_TAC[ARITH_RULE `1 <= SUC n`] THEN
2752     ASSUM_LIST(fun thl -> REWRITE_TAC(map GSYM thl)) THEN
2753     SIMP_TAC[GSYM VECTOR_MUL_COMPONENT;
2754              ASSUME `1 <= j`; ASSUME `j <= dimindex(:N)`] THEN
2755     ASSUM_LIST(fun thl -> REWRITE_TAC(map GSYM thl)) THEN
2756     SIMP_TAC[GSYM VECTOR_ADD_COMPONENT;
2757              ASSUME `1 <= j`; ASSUME `j <= dimindex(:N)`] THEN
2758     ASSUM_LIST(fun thl -> REWRITE_TAC(map GSYM thl)) THEN
2759     AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN
2760     ASM_SIMP_TAC[CART_EQ; VECTOR_ADD_COMPONENT; LAMBDA_BETA] THEN
2761     SIMP_TAC[VECTOR_MUL_COMPONENT]]);;
2762
2763 (* ------------------------------------------------------------------------- *)
2764 (* Inverse matrices (not necessarily square, but it's vacuous otherwise).    *)
2765 (* ------------------------------------------------------------------------- *)
2766
2767 let invertible = new_definition
2768   `invertible(A:real^N^M) <=>
2769         ?A':real^M^N. (A ** A' = mat 1) /\ (A' ** A = mat 1)`;;
2770
2771 let matrix_inv = new_definition
2772   `matrix_inv(A:real^N^M) =
2773         @A':real^M^N. (A ** A' = mat 1) /\ (A' ** A = mat 1)`;;
2774
2775 let MATRIX_INV = prove
2776  (`!A:real^N^M.
2777     invertible A ==> A ** matrix_inv A = mat 1 /\ matrix_inv A ** A = mat 1`,
2778   GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[matrix_inv; invertible] THEN
2779   CONV_TAC SELECT_CONV THEN ASM_REWRITE_TAC[GSYM invertible]);;
2780
2781 (* ------------------------------------------------------------------------- *)
2782 (* Correspondence between matrices and linear operators.                     *)
2783 (* ------------------------------------------------------------------------- *)
2784
2785 let matrix = new_definition
2786   `(matrix:(real^M->real^N)->real^M^N) f = lambda i j. f(basis j)$i`;;
2787
2788 let MATRIX_VECTOR_MUL_LINEAR = prove
2789  (`!A:real^N^M. linear(\x. A ** x)`,
2790   REWRITE_TAC[linear; matrix_vector_mul] THEN
2791   SIMP_TAC[CART_EQ; LAMBDA_BETA; VECTOR_ADD_COMPONENT;
2792     VECTOR_MUL_COMPONENT] THEN
2793   REWRITE_TAC[GSYM SUM_ADD_NUMSEG; GSYM SUM_LMUL; REAL_ADD_LDISTRIB] THEN
2794   REWRITE_TAC[REAL_ADD_AC; REAL_MUL_AC]);;
2795
2796 let MATRIX_WORKS = prove
2797  (`!f:real^M->real^N. linear f ==> !x. matrix f ** x = f(x)`,
2798   REWRITE_TAC[matrix; matrix_vector_mul] THEN
2799   SIMP_TAC[CART_EQ; LAMBDA_BETA] THEN GEN_TAC THEN DISCH_TAC THEN
2800   REPEAT GEN_TAC THEN DISCH_TAC THEN
2801   ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
2802   ASM_SIMP_TAC[GSYM LINEAR_COMPONENTWISE]);;
2803
2804 let MATRIX_VECTOR_MUL = prove
2805  (`!f:real^M->real^N. linear f ==> f = \x. matrix f ** x`,
2806   SIMP_TAC[FUN_EQ_THM; MATRIX_WORKS]);;
2807
2808 let MATRIX_OF_MATRIX_VECTOR_MUL = prove
2809  (`!A:real^N^M. matrix(\x. A ** x) = A`,
2810   SIMP_TAC[MATRIX_EQ; MATRIX_VECTOR_MUL_LINEAR; MATRIX_WORKS]);;
2811
2812 let MATRIX_COMPOSE = prove
2813  (`!f g. linear f /\ linear g ==> (matrix(g o f) = matrix g ** matrix f)`,
2814   SIMP_TAC[MATRIX_EQ; MATRIX_WORKS; LINEAR_COMPOSE;
2815            GSYM MATRIX_VECTOR_MUL_ASSOC; o_THM]);;
2816
2817 let MATRIX_VECTOR_COLUMN = prove
2818  (`!A:real^N^M x.
2819         A ** x = vsum(1..dimindex(:N)) (\i. x$i % (transp A)$i)`,
2820   REWRITE_TAC[matrix_vector_mul; transp] THEN
2821   SIMP_TAC[CART_EQ; LAMBDA_BETA; VSUM_COMPONENT; VECTOR_MUL_COMPONENT] THEN
2822   REWRITE_TAC[REAL_MUL_AC]);;
2823
2824 let MATRIX_MUL_COMPONENT = prove
2825  (`!i. 1 <= i /\ i <= dimindex(:N)
2826        ==> ((A:real^N^N) ** (B:real^N^N))$i = transp B ** A$i`,
2827   SIMP_TAC[matrix_mul; LAMBDA_BETA; matrix_vector_mul; vector_matrix_mul;
2828        transp; CART_EQ] THEN
2829   REPEAT STRIP_TAC THEN MATCH_MP_TAC SUM_EQ_NUMSEG THEN
2830   REWRITE_TAC[REAL_MUL_AC]);;
2831
2832 let ADJOINT_MATRIX = prove
2833  (`!A:real^N^M. adjoint(\x. A ** x) = (\x. transp A ** x)`,
2834   GEN_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC ADJOINT_UNIQUE THEN
2835   REWRITE_TAC[MATRIX_VECTOR_MUL_LINEAR] THEN REPEAT GEN_TAC THEN
2836   SIMP_TAC[transp; dot; LAMBDA_BETA; matrix_vector_mul;
2837            GSYM SUM_LMUL; GSYM SUM_RMUL] THEN
2838   GEN_REWRITE_TAC LAND_CONV [SUM_SWAP_NUMSEG] THEN REWRITE_TAC[REAL_MUL_AC]);;
2839
2840 let MATRIX_ADJOINT = prove
2841  (`!f. linear f ==> matrix(adjoint f) = transp(matrix f)`,
2842   GEN_TAC THEN DISCH_THEN
2843    (fun th -> GEN_REWRITE_TAC (LAND_CONV o funpow 2 RAND_CONV)
2844                 [MATCH_MP MATRIX_VECTOR_MUL th]) THEN
2845   REWRITE_TAC[ADJOINT_MATRIX; MATRIX_OF_MATRIX_VECTOR_MUL]);;
2846
2847 let MATRIX_ID = prove
2848  (`matrix(\x. x) = mat 1`,
2849   SIMP_TAC[MATRIX_EQ; LINEAR_ID; MATRIX_WORKS; MATRIX_VECTOR_MUL_LID]);;
2850
2851 let MATRIX_I = prove
2852  (`matrix I = mat 1`,
2853   REWRITE_TAC[I_DEF; MATRIX_ID]);;
2854
2855 let LINEAR_EQ_MATRIX = prove
2856  (`!f g. linear f /\ linear g /\ matrix f = matrix g ==> f = g`,
2857   REPEAT STRIP_TAC THEN
2858   REPEAT(FIRST_X_ASSUM(SUBST1_TAC o MATCH_MP MATRIX_VECTOR_MUL)) THEN
2859   ASM_REWRITE_TAC[]);;
2860
2861 (* ------------------------------------------------------------------------- *)
2862 (* Operator norm.                                                            *)
2863 (* ------------------------------------------------------------------------- *)
2864
2865 let onorm = new_definition
2866  `onorm (f:real^M->real^N) = sup { norm(f x) | norm(x) = &1 }`;;
2867
2868 let NORM_BOUND_GENERALIZE = prove
2869  (`!f:real^M->real^N b.
2870         linear f
2871         ==> ((!x. (norm(x) = &1) ==> norm(f x) <= b) <=>
2872              (!x. norm(f x) <= b * norm(x)))`,
2873   REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THENL
2874    [ALL_TAC; ASM_MESON_TAC[REAL_MUL_RID]] THEN
2875   X_GEN_TAC `x:real^M` THEN ASM_CASES_TAC `x:real^M = vec 0` THENL
2876    [ASM_REWRITE_TAC[NORM_0; REAL_MUL_RZERO] THEN
2877     ASM_MESON_TAC[LINEAR_0; NORM_0; REAL_LE_REFL];
2878     ALL_TAC] THEN
2879   ASM_SIMP_TAC[GSYM REAL_LE_LDIV_EQ; NORM_POS_LT; real_div] THEN
2880   MATCH_MP_TAC(REAL_ARITH `abs(a * b) <= c ==> b * a <= c`) THEN
2881   REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_NORM; GSYM NORM_MUL] THEN
2882   FIRST_ASSUM(fun th -> REWRITE_TAC[GSYM(MATCH_MP LINEAR_CMUL th)]) THEN
2883   ASM_SIMP_TAC[NORM_MUL; REAL_ABS_INV; REAL_ABS_NORM; REAL_MUL_LINV;
2884                NORM_EQ_0]);;
2885
2886 let ONORM = prove
2887  (`!f:real^M->real^N.
2888         linear f
2889         ==> (!x. norm(f x) <= onorm f * norm(x)) /\
2890             (!b. (!x. norm(f x) <= b * norm(x)) ==> onorm f <= b)`,
2891   GEN_TAC THEN DISCH_TAC THEN
2892   MP_TAC(SPEC `{ norm((f:real^M->real^N) x) | norm(x) = &1 }` SUP) THEN
2893   SIMP_TAC[IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN
2894   ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN
2895   REWRITE_TAC[LEFT_FORALL_IMP_THM; RIGHT_EXISTS_AND_THM; EXISTS_REFL] THEN
2896   ASM_SIMP_TAC[NORM_BOUND_GENERALIZE; GSYM onorm; GSYM MEMBER_NOT_EMPTY] THEN
2897   DISCH_THEN MATCH_MP_TAC THEN REWRITE_TAC[IN_ELIM_THM] THEN
2898   ASM_MESON_TAC[VECTOR_CHOOSE_SIZE; LINEAR_BOUNDED; REAL_POS]);;
2899
2900 let ONORM_POS_LE = prove
2901  (`!f. linear f ==> &0 <= onorm f`,
2902   MESON_TAC[ONORM; VECTOR_CHOOSE_SIZE; REAL_POS; REAL_MUL_RID; NORM_POS_LE;
2903             REAL_LE_TRANS]);;
2904
2905 let ONORM_EQ_0 = prove
2906  (`!f:real^M->real^N. linear f ==> ((onorm f = &0) <=> (!x. f x = vec 0))`,
2907   REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THEN
2908   MP_TAC(SPEC `f:real^M->real^N` ONORM) THEN
2909   ASM_SIMP_TAC[GSYM REAL_LE_ANTISYM; ONORM_POS_LE; NORM_0; REAL_MUL_LZERO;
2910                NORM_LE_0; REAL_LE_REFL]);;
2911
2912 let ONORM_CONST = prove
2913  (`!y:real^N. onorm(\x:real^M. y) = norm(y)`,
2914   GEN_TAC THEN REWRITE_TAC[onorm] THEN
2915   MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `sup {norm(y:real^N)}` THEN
2916   CONJ_TAC THENL
2917    [AP_TERM_TAC THEN MATCH_MP_TAC(SET_RULE
2918      `(?x. P x) ==> {f y | x | P x} = {f y}`) THEN
2919     EXISTS_TAC `basis 1 :real^M` THEN
2920     SIMP_TAC[NORM_BASIS; DIMINDEX_GE_1; LE_REFL];
2921     MATCH_MP_TAC REAL_SUP_UNIQUE THEN SET_TAC[REAL_LE_REFL]]);;
2922
2923 let ONORM_POS_LT = prove
2924  (`!f. linear f ==> (&0 < onorm f <=> ~(!x. f x = vec 0))`,
2925   SIMP_TAC[GSYM ONORM_EQ_0; ONORM_POS_LE;
2926            REAL_ARITH `(&0 < x <=> ~(x = &0)) <=> &0 <= x`]);;
2927
2928 let ONORM_COMPOSE = prove
2929  (`!f g. linear f /\ linear g ==> onorm(f o g) <= onorm f * onorm g`,
2930   MESON_TAC[ONORM; LINEAR_COMPOSE; o_THM; REAL_MUL_ASSOC; REAL_LE_TRANS; ONORM;
2931             REAL_LE_LMUL; ONORM_POS_LE]);;
2932
2933 let ONORM_NEG_LEMMA = prove
2934  (`!f. linear f ==> onorm(\x. --(f x)) <= onorm f`,
2935   REPEAT STRIP_TAC THEN
2936   FIRST_ASSUM(STRIP_ASSUME_TAC o MATCH_MP ONORM o
2937     MATCH_MP LINEAR_COMPOSE_NEG) THEN
2938   FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[NORM_NEG; ONORM]);;
2939
2940 let ONORM_NEG = prove
2941  (`!f:real^M->real^N. linear f ==> (onorm(\x. --(f x)) = onorm f)`,
2942   REPEAT STRIP_TAC THEN  REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN
2943   ASM_SIMP_TAC[ONORM_NEG_LEMMA] THEN
2944   SUBGOAL_THEN `f:real^M->real^N = \x. --(--(f x))`
2945    (fun th -> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [th]) THEN
2946   ASM_SIMP_TAC[ONORM_NEG_LEMMA; LINEAR_COMPOSE_NEG] THEN
2947   REWRITE_TAC[VECTOR_NEG_NEG; ETA_AX]);;
2948
2949 let ONORM_TRIANGLE = prove
2950  (`!f:real^M->real^N g.
2951         linear f /\ linear g ==> onorm(\x. f x + g x) <= onorm f + onorm g`,
2952   REPEAT GEN_TAC THEN DISCH_TAC THEN
2953   FIRST_ASSUM(MATCH_MP_TAC o CONJUNCT2 o MATCH_MP ONORM o MATCH_MP
2954               LINEAR_COMPOSE_ADD) THEN
2955   REWRITE_TAC[REAL_ADD_RDISTRIB] THEN
2956   ASM_MESON_TAC[REAL_LE_ADD2; REAL_LE_TRANS; NORM_TRIANGLE; ONORM]);;
2957
2958 let ONORM_TRIANGLE_LE = prove
2959  (`!f g. linear f /\ linear g /\ onorm(f) + onorm(g) <= e
2960          ==> onorm(\x. f x + g x) <= e`,
2961   MESON_TAC[REAL_LE_TRANS; ONORM_TRIANGLE]);;
2962
2963 let ONORM_TRIANGLE_LT = prove
2964  (`!f g. linear f /\ linear g /\ onorm(f) + onorm(g) < e
2965          ==> onorm(\x. f x + g x) < e`,
2966   MESON_TAC[REAL_LET_TRANS; ONORM_TRIANGLE]);;
2967
2968 (* ------------------------------------------------------------------------- *)
2969 (* It's handy to "lift" from R to R^1 and "drop" from R^1 to R.              *)
2970 (* ------------------------------------------------------------------------- *)
2971
2972 let lift = new_definition
2973  `(lift:real->real^1) x = lambda i. x`;;
2974
2975 let drop = new_definition
2976  `(drop:real^1->real) x = x$1`;;
2977
2978 let LIFT_COMPONENT = prove
2979  (`!x. (lift x)$1 = x`,
2980   SIMP_TAC[lift; LAMBDA_BETA; DIMINDEX_1; LE_ANTISYM]);;
2981
2982 let LIFT_DROP = prove
2983  (`(!x. lift(drop x) = x) /\ (!x. drop(lift x) = x)`,
2984   SIMP_TAC[lift; drop; CART_EQ; LAMBDA_BETA; DIMINDEX_1; LE_ANTISYM]);;
2985
2986 let IMAGE_LIFT_DROP = prove
2987  (`(!s. IMAGE (lift o drop) s = s) /\ (!s. IMAGE (drop o lift) s = s)`,
2988   REWRITE_TAC[o_DEF; LIFT_DROP] THEN SET_TAC[]);;
2989
2990 let IN_IMAGE_LIFT_DROP = prove
2991  (`(!x s. x IN IMAGE lift s <=> drop x IN s) /\
2992    (!x s. x IN IMAGE drop s <=> lift x IN s)`,
2993   REWRITE_TAC[IN_IMAGE] THEN MESON_TAC[LIFT_DROP]);;
2994
2995 let FORALL_LIFT = prove
2996  (`(!x. P x) = (!x. P(lift x))`,
2997   MESON_TAC[LIFT_DROP]);;
2998
2999 let EXISTS_LIFT = prove
3000  (`(?x. P x) = (?x. P(lift x))`,
3001   MESON_TAC[LIFT_DROP]);;
3002
3003 let FORALL_DROP = prove
3004  (`(!x. P x) = (!x. P(drop x))`,
3005   MESON_TAC[LIFT_DROP]);;
3006
3007 let EXISTS_DROP = prove
3008  (`(?x. P x) = (?x. P(drop x))`,
3009   MESON_TAC[LIFT_DROP]);;
3010
3011 let FORALL_LIFT_FUN = prove
3012  (`!P:(A->real^1)->bool. (!f. P f) <=> (!f. P(lift o f))`,
3013   GEN_TAC THEN EQ_TAC THEN SIMP_TAC[] THEN DISCH_TAC THEN
3014   X_GEN_TAC `f:A->real^1` THEN
3015   FIRST_X_ASSUM(MP_TAC o SPEC `drop o (f:A->real^1)`) THEN
3016   REWRITE_TAC[o_DEF; LIFT_DROP; ETA_AX]);;
3017
3018 let FORALL_DROP_FUN = prove
3019  (`!P:(A->real)->bool. (!f. P f) <=> (!f. P(drop o f))`,
3020   REWRITE_TAC[FORALL_LIFT_FUN; o_DEF; LIFT_DROP; ETA_AX]);;
3021
3022 let EXISTS_LIFT_FUN = prove
3023  (`!P:(A->real^1)->bool. (?f. P f) <=> (?f. P(lift o f))`,
3024   ONCE_REWRITE_TAC[MESON[] `(?x. P x) <=> ~(!x. ~P x)`] THEN
3025   REWRITE_TAC[FORALL_LIFT_FUN]);;
3026
3027 let EXISTS_DROP_FUN = prove
3028  (`!P:(A->real)->bool. (?f. P f) <=> (?f. P(drop o f))`,
3029   ONCE_REWRITE_TAC[MESON[] `(?x. P x) <=> ~(!x. ~P x)`] THEN
3030   REWRITE_TAC[FORALL_DROP_FUN]);;
3031
3032 let LIFT_EQ = prove
3033  (`!x y. (lift x = lift y) <=> (x = y)`,
3034   MESON_TAC[LIFT_DROP]);;
3035
3036 let DROP_EQ = prove
3037  (`!x y. (drop x = drop y) <=> (x = y)`,
3038   MESON_TAC[LIFT_DROP]);;
3039
3040 let LIFT_IN_IMAGE_LIFT = prove
3041  (`!x s. (lift x) IN (IMAGE lift s) <=> x IN s`,
3042   REWRITE_TAC[IN_IMAGE] THEN MESON_TAC[LIFT_DROP]);;
3043
3044 let LIFT_NUM = prove
3045  (`!n. lift(&n) = vec n`,
3046   SIMP_TAC[CART_EQ; lift; vec; LAMBDA_BETA]);;
3047
3048 let LIFT_ADD = prove
3049  (`!x y. lift(x + y) = lift x + lift y`,
3050   SIMP_TAC[CART_EQ; lift; LAMBDA_BETA; VECTOR_ADD_COMPONENT]);;
3051
3052 let LIFT_SUB = prove
3053  (`!x y. lift(x - y) = lift x - lift y`,
3054   SIMP_TAC[CART_EQ; lift; LAMBDA_BETA; VECTOR_SUB_COMPONENT]);;
3055
3056 let LIFT_CMUL = prove
3057  (`!x c. lift(c * x) = c % lift(x)`,
3058   SIMP_TAC[CART_EQ; lift; LAMBDA_BETA; VECTOR_MUL_COMPONENT]);;
3059
3060 let LIFT_NEG = prove
3061  (`!x. lift(--x) = --(lift x)`,
3062   SIMP_TAC[CART_EQ; lift; LAMBDA_BETA; VECTOR_NEG_COMPONENT]);;
3063
3064 let LIFT_EQ_CMUL = prove
3065  (`!x. lift x = x % vec 1`,
3066   REWRITE_TAC[GSYM LIFT_NUM; GSYM LIFT_CMUL; REAL_MUL_RID]);;
3067
3068 let LIFT_SUM = prove
3069  (`!k x. FINITE k ==> (lift(sum k x) = vsum k (lift o x))`,
3070   REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN
3071   MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
3072   SIMP_TAC[SUM_CLAUSES; VSUM_CLAUSES; o_THM; LIFT_ADD; LIFT_NUM]);;
3073
3074 let DROP_LAMBDA = prove
3075  (`!x. drop(lambda i. x i) = x 1`,
3076   SIMP_TAC[drop; LAMBDA_BETA; DIMINDEX_1; LE_REFL]);;
3077
3078 let DROP_VEC = prove
3079  (`!n. drop(vec n) = &n`,
3080   MESON_TAC[LIFT_DROP; LIFT_NUM]);;
3081
3082 let DROP_ADD = prove
3083  (`!x y. drop(x + y) = drop x + drop y`,
3084   MESON_TAC[LIFT_DROP; LIFT_ADD]);;
3085
3086 let DROP_SUB = prove
3087  (`!x y. drop(x - y) = drop x - drop y`,
3088   MESON_TAC[LIFT_DROP; LIFT_SUB]);;
3089
3090 let DROP_CMUL = prove
3091  (`!x c. drop(c % x) = c * drop(x)`,
3092   MESON_TAC[LIFT_DROP; LIFT_CMUL]);;
3093
3094 let DROP_NEG = prove
3095  (`!x. drop(--x) = --(drop x)`,
3096   MESON_TAC[LIFT_DROP; LIFT_NEG]);;
3097
3098 let DROP_VSUM = prove
3099  (`!k x. FINITE k ==> (drop(vsum k x) = sum k (drop o x))`,
3100   REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN
3101   MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
3102   SIMP_TAC[SUM_CLAUSES; VSUM_CLAUSES; o_THM; DROP_ADD; DROP_VEC]);;
3103
3104 let NORM_LIFT = prove
3105  (`!x. norm(lift x) = abs(x)`,
3106   SIMP_TAC[lift; NORM_REAL; LIFT_COMPONENT]);;
3107
3108 let DIST_LIFT = prove
3109  (`!x y. dist(lift x,lift y) = abs(x - y)`,
3110   REWRITE_TAC[DIST_REAL; LIFT_COMPONENT]);;
3111
3112 let ABS_DROP = prove
3113  (`!x. norm x = abs(drop x)`,
3114   REWRITE_TAC[FORALL_LIFT; LIFT_DROP; NORM_LIFT]);;
3115
3116 let LINEAR_VMUL_DROP = prove
3117  (`!f v. linear f ==> linear (\x. drop(f x) % v)`,
3118   SIMP_TAC[drop; LINEAR_VMUL_COMPONENT; DIMINDEX_1; LE_REFL]);;
3119
3120 let LINEAR_FROM_REALS = prove
3121  (`!f:real^1->real^N. linear f ==> f = \x. drop x % column 1 (matrix f)`,
3122   GEN_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN
3123   DISCH_THEN(fun th -> REWRITE_TAC[GSYM(MATCH_MP MATRIX_WORKS th)]) THEN
3124   SIMP_TAC[CART_EQ; matrix_vector_mul; vector_mul; LAMBDA_BETA;
3125            DIMINDEX_1; SUM_SING_NUMSEG; drop; column] THEN
3126   REWRITE_TAC[REAL_MUL_AC]);;
3127
3128 let LINEAR_TO_REALS = prove
3129  (`!f:real^N->real^1. linear f ==> f = \x. lift(row 1 (matrix f) dot x)`,
3130   GEN_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN
3131   DISCH_THEN(fun th -> REWRITE_TAC[GSYM(MATCH_MP MATRIX_WORKS th)]) THEN
3132   SIMP_TAC[CART_EQ; matrix_vector_mul; dot; LAMBDA_BETA;
3133            DIMINDEX_1; SUM_SING_NUMSEG; lift; row; LE_ANTISYM]);;
3134
3135 let DROP_EQ_0 = prove
3136  (`!x. drop x = &0 <=> x = vec 0`,
3137   REWRITE_TAC[GSYM DROP_EQ; DROP_VEC]);;
3138
3139 let VSUM_REAL = prove
3140  (`!f s. FINITE s ==> vsum s f = lift(sum s (drop o f))`,
3141   SIMP_TAC[LIFT_SUM; o_DEF; LIFT_DROP; ETA_AX]);;
3142
3143 let DROP_WLOG_LE = prove
3144  (`(!x y. P x y <=> P y x) /\ (!x y. drop x <= drop y ==> P x y)
3145    ==> (!x y. P x y)`,
3146   MESON_TAC[REAL_LE_TOTAL]);;
3147
3148 let IMAGE_LIFT_UNIV = prove
3149  (`IMAGE lift (:real) = (:real^1)`,
3150   REWRITE_TAC[EXTENSION; IN_IMAGE; IN_UNIV] THEN MESON_TAC[LIFT_DROP]);;
3151
3152 let IMAGE_DROP_UNIV = prove
3153  (`IMAGE drop (:real^1) = (:real)`,
3154   REWRITE_TAC[EXTENSION; IN_IMAGE; IN_UNIV] THEN MESON_TAC[LIFT_DROP]);;
3155
3156 let SUM_VSUM = prove
3157  (`!f s. FINITE s ==> sum s f = drop(vsum s (lift o f))`,
3158   SIMP_TAC[VSUM_REAL; o_DEF; LIFT_DROP; ETA_AX]);;
3159
3160 let LINEAR_LIFT_DOT = prove
3161  (`!a. linear(\x. lift(a dot x))`,
3162   REWRITE_TAC[linear; DOT_RMUL; DOT_RADD; LIFT_ADD; LIFT_CMUL]);;
3163
3164 let LINEAR_LIFT_COMPONENT = prove
3165  (`!k. linear(\x:real^N. lift(x$k))`,
3166   REPEAT GEN_TAC THEN
3167   SUBGOAL_THEN `?j. 1 <= j /\ j <= dimindex(:N) /\ !z:real^N. z$k = z$j`
3168   CHOOSE_TAC THENL
3169    [REWRITE_TAC[FINITE_INDEX_INRANGE];
3170     MP_TAC(ISPEC `basis j:real^N` LINEAR_LIFT_DOT) THEN
3171     ASM_SIMP_TAC[DOT_BASIS]]);;
3172
3173 (* ------------------------------------------------------------------------- *)
3174 (* Pasting vectors.                                                          *)
3175 (* ------------------------------------------------------------------------- *)
3176
3177 let LINEAR_FSTCART = prove
3178  (`linear fstcart`,
3179   SIMP_TAC[linear; fstcart; CART_EQ; LAMBDA_BETA; VECTOR_ADD_COMPONENT;
3180            VECTOR_MUL_COMPONENT; DIMINDEX_FINITE_SUM;
3181            ARITH_RULE `x <= a ==> x <= a + b:num`]);;
3182
3183 let LINEAR_SNDCART = prove
3184  (`linear sndcart`,
3185   SIMP_TAC[linear; sndcart; CART_EQ; LAMBDA_BETA; VECTOR_ADD_COMPONENT;
3186            VECTOR_MUL_COMPONENT; DIMINDEX_FINITE_SUM;
3187            ARITH_RULE `x <= a ==> x <= a + b:num`;
3188            ARITH_RULE `x <= b ==> x + a <= a + b:num`]);;
3189
3190 let FSTCART_VEC = prove
3191  (`!n. fstcart(vec n) = vec n`,
3192   SIMP_TAC[vec; fstcart; LAMBDA_BETA; CART_EQ; DIMINDEX_FINITE_SUM;
3193            ARITH_RULE `m <= n:num ==> m <= n + p`]);;
3194
3195 let FSTCART_ADD = prove
3196  (`!x:real^(M,N)finite_sum y. fstcart(x + y) = fstcart(x) + fstcart(y)`,
3197   REWRITE_TAC[REWRITE_RULE[linear] LINEAR_FSTCART]);;
3198
3199 let FSTCART_CMUL = prove
3200  (`!x:real^(M,N)finite_sum c. fstcart(c % x) = c % fstcart(x)`,
3201   REWRITE_TAC[REWRITE_RULE[linear] LINEAR_FSTCART]);;
3202
3203 let FSTCART_NEG = prove
3204  (`!x:real^(M,N)finite_sum. --(fstcart x) = fstcart(--x)`,
3205   ONCE_REWRITE_TAC[VECTOR_ARITH `--x = --(&1) % x`] THEN
3206   REWRITE_TAC[FSTCART_CMUL]);;
3207
3208 let FSTCART_SUB = prove
3209  (`!x:real^(M,N)finite_sum y. fstcart(x - y) = fstcart(x) - fstcart(y)`,
3210   REWRITE_TAC[VECTOR_SUB; FSTCART_NEG; FSTCART_ADD]);;
3211
3212 let FSTCART_VSUM = prove
3213  (`!k x. FINITE k ==> (fstcart(vsum k x) = vsum k (\i. fstcart(x i)))`,
3214   REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN
3215   MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
3216   SIMP_TAC[VSUM_CLAUSES; FINITE_RULES; FSTCART_ADD; FSTCART_VEC]);;
3217
3218 let SNDCART_VEC = prove
3219  (`!n. sndcart(vec n) = vec n`,
3220   SIMP_TAC[vec; sndcart; LAMBDA_BETA; CART_EQ; DIMINDEX_FINITE_SUM;
3221            ARITH_RULE `x <= a ==> x <= a + b:num`;
3222            ARITH_RULE `x <= b ==> x + a <= a + b:num`]);;
3223
3224 let SNDCART_ADD = prove
3225  (`!x:real^(M,N)finite_sum y. sndcart(x + y) = sndcart(x) + sndcart(y)`,
3226   REWRITE_TAC[REWRITE_RULE[linear] LINEAR_SNDCART]);;
3227
3228 let SNDCART_CMUL = prove
3229  (`!x:real^(M,N)finite_sum c. sndcart(c % x) = c % sndcart(x)`,
3230   REWRITE_TAC[REWRITE_RULE[linear] LINEAR_SNDCART]);;
3231
3232 let SNDCART_NEG = prove
3233  (`!x:real^(M,N)finite_sum. --(sndcart x) = sndcart(--x)`,
3234   ONCE_REWRITE_TAC[VECTOR_ARITH `--x = --(&1) % x`] THEN
3235   REWRITE_TAC[SNDCART_CMUL]);;
3236
3237 let SNDCART_SUB = prove
3238  (`!x:real^(M,N)finite_sum y. sndcart(x - y) = sndcart(x) - sndcart(y)`,
3239   REWRITE_TAC[VECTOR_SUB; SNDCART_NEG; SNDCART_ADD]);;
3240
3241 let SNDCART_VSUM = prove
3242  (`!k x. FINITE k ==> (sndcart(vsum k x) = vsum k (\i. sndcart(x i)))`,
3243   REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN
3244   MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
3245   SIMP_TAC[VSUM_CLAUSES; FINITE_RULES; SNDCART_ADD; SNDCART_VEC]);;
3246
3247 let PASTECART_VEC = prove
3248  (`!n. pastecart (vec n) (vec n) = vec n`,
3249   REWRITE_TAC[PASTECART_EQ; FSTCART_VEC; SNDCART_VEC;
3250               FSTCART_PASTECART; SNDCART_PASTECART]);;
3251
3252 let PASTECART_ADD = prove
3253  (`!x1 y1 x2:real^M y2:real^N.
3254      pastecart x1 y1 + pastecart x2 y2 = pastecart (x1 + x2) (y1 + y2)`,
3255   REWRITE_TAC[PASTECART_EQ; FSTCART_ADD; SNDCART_ADD;
3256               FSTCART_PASTECART; SNDCART_PASTECART]);;
3257
3258 let PASTECART_CMUL = prove
3259  (`!x1 y1 c. pastecart (c % x1) (c % y1) = c % pastecart x1 y1`,
3260   REWRITE_TAC[PASTECART_EQ; FSTCART_CMUL; SNDCART_CMUL;
3261               FSTCART_PASTECART; SNDCART_PASTECART]);;
3262
3263 let PASTECART_NEG = prove
3264  (`!x:real^M y:real^N. pastecart (--x) (--y) = --(pastecart x y)`,
3265   ONCE_REWRITE_TAC[VECTOR_ARITH `--x = --(&1) % x`] THEN
3266   REWRITE_TAC[PASTECART_CMUL]);;
3267
3268 let PASTECART_SUB = prove
3269  (`!x1 y1 x2:real^M y2:real^N.
3270      pastecart x1 y1 - pastecart x2 y2 = pastecart (x1 - x2) (y1 - y2)`,
3271   REWRITE_TAC[VECTOR_SUB; GSYM PASTECART_NEG; PASTECART_ADD]);;
3272
3273 let PASTECART_VSUM = prove
3274  (`!k x y. FINITE k ==> (pastecart (vsum k x) (vsum k y) =
3275                          vsum k (\i. pastecart (x i) (y i)))`,
3276   SIMP_TAC[PASTECART_EQ; FSTCART_VSUM; SNDCART_VSUM;
3277            FSTCART_PASTECART; SNDCART_PASTECART; ETA_AX]);;
3278
3279 let PASTECART_EQ_VEC = prove
3280  (`!x y n. pastecart x y = vec n <=> x = vec n /\ y = vec n`,
3281   REWRITE_TAC[PASTECART_EQ; FSTCART_VEC; SNDCART_VEC;
3282               FSTCART_PASTECART; SNDCART_PASTECART]);;
3283
3284 let NORM_FSTCART = prove
3285  (`!x. norm(fstcart x) <= norm x`,
3286   GEN_TAC THEN
3287   GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM PASTECART_FST_SND] THEN
3288   SIMP_TAC[SQRT_MONO_LE_EQ; DOT_POS_LE; vector_norm] THEN
3289   SIMP_TAC[pastecart; dot; DIMINDEX_FINITE_SUM; LAMBDA_BETA; DIMINDEX_NONZERO;
3290            SUM_ADD_SPLIT; REAL_LE_ADDR; SUM_POS_LE; FINITE_NUMSEG;
3291            REAL_LE_SQUARE; ARITH_RULE `x <= a ==> x <= a + b:num`;
3292            ARITH_RULE `~(d = 0) ==> 1 <= d + 1`]);;
3293
3294 let DIST_FSTCART = prove
3295  (`!x y. dist(fstcart x,fstcart y) <= dist(x,y)`,
3296   REWRITE_TAC[dist; GSYM FSTCART_SUB; NORM_FSTCART]);;
3297
3298 let NORM_SNDCART = prove
3299  (`!x. norm(sndcart x) <= norm x`,
3300   GEN_TAC THEN
3301   GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM PASTECART_FST_SND] THEN
3302   SIMP_TAC[SQRT_MONO_LE_EQ; DOT_POS_LE; vector_norm] THEN
3303   SIMP_TAC[pastecart; dot; DIMINDEX_FINITE_SUM; LAMBDA_BETA; DIMINDEX_NONZERO;
3304            SUM_ADD_SPLIT; ARITH_RULE `x <= a ==> x <= a + b:num`;
3305            ARITH_RULE `~(d = 0) ==> 1 <= d + 1`] THEN
3306   ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[NUMSEG_OFFSET_IMAGE] THEN
3307   SIMP_TAC[SUM_IMAGE; FINITE_NUMSEG; EQ_ADD_RCANCEL; o_DEF; ADD_SUB] THEN
3308   SIMP_TAC[ARITH_RULE `1 <= x ==> ~(x + a <= a)`; SUM_POS_LE; FINITE_NUMSEG;
3309            REAL_LE_ADDL; REAL_LE_SQUARE]);;
3310
3311 let DIST_SNDCART = prove
3312  (`!x y. dist(sndcart x,sndcart y) <= dist(x,y)`,
3313   REWRITE_TAC[dist; GSYM SNDCART_SUB; NORM_SNDCART]);;
3314
3315 let DOT_PASTECART = prove
3316  (`!x1 x2 y1 y2. (pastecart x1 x2) dot (pastecart y1 y2) =
3317                 x1 dot y1 + x2 dot y2`,
3318   SIMP_TAC[pastecart; dot; LAMBDA_BETA; DIMINDEX_FINITE_SUM] THEN
3319   SIMP_TAC[SUM_ADD_SPLIT; ARITH_RULE `~(d = 0) ==> 1 <= d + 1`;
3320            DIMINDEX_NONZERO; REAL_LE_LADD] THEN
3321   ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[NUMSEG_OFFSET_IMAGE] THEN
3322   SIMP_TAC[SUM_IMAGE; FINITE_NUMSEG; EQ_ADD_RCANCEL; o_DEF; ADD_SUB] THEN
3323   SIMP_TAC[ARITH_RULE `1 <= x ==> ~(x + a <= a)`; REAL_LE_REFL]);;
3324
3325 let NORM_PASTECART = prove
3326  (`!x y. norm(pastecart x y) = sqrt(norm(x) pow 2 + norm(y) pow 2)`,
3327   REWRITE_TAC[NORM_EQ_SQUARE] THEN
3328   SIMP_TAC[SQRT_POS_LE; SQRT_POW_2; REAL_LE_ADD; REAL_LE_POW_2] THEN
3329   REWRITE_TAC[DOT_PASTECART; NORM_POW_2]);;
3330
3331 let NORM_PASTECART_LE = prove
3332  (`!x y. norm(pastecart x y) <= norm(x) + norm(y)`,
3333   REPEAT GEN_TAC THEN MATCH_MP_TAC TRIANGLE_LEMMA THEN
3334   REWRITE_TAC[NORM_POS_LE; NORM_POW_2; DOT_PASTECART; REAL_LE_REFL]);;
3335
3336 let NORM_LE_PASTECART = prove
3337  (`!x:real^M y:real^M.
3338     norm(x) <= norm(pastecart x y) /\
3339     norm(y) <= norm(pastecart x y)`,
3340   REPEAT GEN_TAC THEN REWRITE_TAC[NORM_PASTECART] THEN CONJ_TAC THEN
3341   MATCH_MP_TAC REAL_LE_RSQRT THEN
3342   REWRITE_TAC[REAL_LE_ADDL; REAL_LE_ADDR; REAL_LE_POW_2]);;
3343
3344 (* ------------------------------------------------------------------------- *)
3345 (* A bit of linear algebra.                                                  *)
3346 (* ------------------------------------------------------------------------- *)
3347
3348 let subspace = new_definition
3349  `subspace s <=>
3350         vec(0) IN s /\
3351         (!x y. x IN s /\ y IN s ==> (x + y) IN s) /\
3352         (!c x. x IN s ==> (c % x) IN s)`;;
3353
3354 let span = new_definition
3355   `span s = subspace hull s`;;
3356
3357 let dependent = new_definition
3358  `dependent s <=> ?a. a IN s /\ a IN span(s DELETE a)`;;
3359
3360 let independent = new_definition
3361  `independent s <=> ~(dependent s)`;;
3362
3363 (* ------------------------------------------------------------------------- *)
3364 (* Closure properties of subspaces.                                          *)
3365 (* ------------------------------------------------------------------------- *)
3366
3367 let SUBSPACE_UNIV = prove
3368  (`subspace(UNIV:real^N->bool)`,
3369   REWRITE_TAC[subspace; IN_UNIV]);;
3370
3371 let SUBSPACE_IMP_NONEMPTY = prove
3372  (`!s. subspace s ==> ~(s = {})`,
3373   REWRITE_TAC[subspace] THEN SET_TAC[]);;
3374
3375 let SUBSPACE_0 = prove
3376  (`subspace s ==> vec(0) IN s`,
3377   SIMP_TAC[subspace]);;
3378
3379 let SUBSPACE_ADD = prove
3380  (`!x y s. subspace s /\ x IN s /\ y IN s ==> (x + y) IN s`,
3381   SIMP_TAC[subspace]);;
3382
3383 let SUBSPACE_MUL = prove
3384  (`!x c s. subspace s /\ x IN s ==> (c % x) IN s`,
3385   SIMP_TAC[subspace]);;
3386
3387 let SUBSPACE_NEG = prove
3388  (`!x s. subspace s /\ x IN s ==> (--x) IN s`,
3389   SIMP_TAC[VECTOR_ARITH `--x = --(&1) % x`; SUBSPACE_MUL]);;
3390
3391 let SUBSPACE_SUB = prove
3392  (`!x y s. subspace s /\ x IN s /\ y IN s ==> (x - y) IN s`,
3393   SIMP_TAC[VECTOR_SUB; SUBSPACE_ADD; SUBSPACE_NEG]);;
3394
3395 let SUBSPACE_VSUM = prove
3396  (`!s f t. subspace s /\ FINITE t /\ (!x. x IN t ==> f(x) IN s)
3397            ==> (vsum t f) IN s`,
3398   REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
3399   GEN_TAC THEN DISCH_TAC THEN GEN_TAC THEN
3400   MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
3401   ASM_SIMP_TAC[VSUM_CLAUSES; SUBSPACE_0; IN_INSERT; SUBSPACE_ADD]);;
3402
3403 let SUBSPACE_LINEAR_IMAGE = prove
3404  (`!f s. linear f /\ subspace s ==> subspace(IMAGE f s)`,
3405   REWRITE_TAC[subspace; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
3406   REWRITE_TAC[FORALL_IN_IMAGE] THEN REWRITE_TAC[IN_IMAGE] THEN
3407   MESON_TAC[linear; LINEAR_0]);;
3408
3409 let SUBSPACE_LINEAR_PREIMAGE = prove
3410  (`!f s. linear f /\ subspace s ==> subspace {x | f(x) IN s}`,
3411   REWRITE_TAC[subspace; IN_ELIM_THM] THEN
3412   MESON_TAC[linear; LINEAR_0]);;
3413
3414 let SUBSPACE_TRIVIAL = prove
3415  (`subspace {vec 0}`,
3416   SIMP_TAC[subspace; IN_SING] THEN CONJ_TAC THEN VECTOR_ARITH_TAC);;
3417
3418 let SUBSPACE_INTER = prove
3419  (`!s t. subspace s /\ subspace t ==> subspace (s INTER t)`,
3420   REWRITE_TAC[subspace; IN_INTER] THEN MESON_TAC[]);;
3421
3422 let SUBSPACE_INTERS = prove
3423  (`!f. (!s. s IN f ==> subspace s) ==> subspace(INTERS f)`,
3424   SIMP_TAC[subspace; IMP_CONJ; RIGHT_FORALL_IMP_THM; IN_INTERS]);;
3425
3426 let LINEAR_INJECTIVE_0_SUBSPACE = prove
3427  (`!f:real^M->real^N s.
3428         linear f /\ subspace s
3429          ==> ((!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) <=>
3430               (!x. x IN s /\ f x = vec 0 ==> x = vec 0))`,
3431   REPEAT STRIP_TAC THEN
3432   GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [GSYM VECTOR_SUB_EQ] THEN
3433   ASM_SIMP_TAC[GSYM LINEAR_SUB] THEN
3434   ASM_MESON_TAC[VECTOR_SUB_RZERO; SUBSPACE_SUB; SUBSPACE_0]);;
3435
3436 let SUBSPACE_UNION_CHAIN = prove
3437  (`!s t:real^N->bool.
3438         subspace s /\ subspace t /\ subspace(s UNION t)
3439          ==> s SUBSET t \/ t SUBSET s`,
3440   REPEAT STRIP_TAC THEN REWRITE_TAC[SET_RULE
3441    `s SUBSET t \/ t SUBSET s <=>
3442     ~(?x y. x IN s /\ ~(x IN t) /\ y IN t /\ ~(y IN s))`] THEN
3443   STRIP_TAC THEN SUBGOAL_THEN `(x + y:real^N) IN s UNION t` MP_TAC THENL
3444    [MATCH_MP_TAC SUBSPACE_ADD THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[];
3445     REWRITE_TAC[IN_UNION; DE_MORGAN_THM] THEN
3446     ASM_MESON_TAC[SUBSPACE_SUB; VECTOR_ARITH
3447      `(x + y) - x:real^N = y /\ (x + y) - y = x`]]);;
3448
3449 (* ------------------------------------------------------------------------- *)
3450 (* Lemmas.                                                                   *)
3451 (* ------------------------------------------------------------------------- *)
3452
3453 let SPAN_SPAN = prove
3454  (`!s. span(span s) = span s`,
3455   REWRITE_TAC[span; HULL_HULL]);;
3456
3457 let SPAN_MONO = prove
3458  (`!s t. s SUBSET t ==> span s SUBSET span t`,
3459   REWRITE_TAC[span; HULL_MONO]);;
3460
3461 let SUBSPACE_SPAN = prove
3462  (`!s. subspace(span s)`,
3463   GEN_TAC THEN REWRITE_TAC[span] THEN MATCH_MP_TAC P_HULL THEN
3464   SIMP_TAC[subspace; IN_INTERS]);;
3465
3466 let SPAN_CLAUSES = prove
3467  (`(!a s. a IN s ==> a IN span s) /\
3468    (vec(0) IN span s) /\
3469    (!x y s. x IN span s /\ y IN span s ==> (x + y) IN span s) /\
3470    (!x c s. x IN span s ==> (c % x) IN span s)`,
3471   MESON_TAC[span; HULL_SUBSET; SUBSET; SUBSPACE_SPAN; subspace]);;
3472
3473 let SPAN_INDUCT = prove
3474  (`!s h. (!x. x IN s ==> x IN h) /\ subspace h ==> !x. x IN span(s) ==> h(x)`,
3475   REWRITE_TAC[span] THEN MESON_TAC[SUBSET; HULL_MINIMAL; IN]);;
3476
3477 let SPAN_EMPTY = prove
3478  (`span {} = {vec 0}`,
3479   REWRITE_TAC[span] THEN MATCH_MP_TAC HULL_UNIQUE THEN
3480   SIMP_TAC[subspace; SUBSET; IN_SING; NOT_IN_EMPTY] THEN
3481   REPEAT STRIP_TAC THEN VECTOR_ARITH_TAC);;
3482
3483 let INDEPENDENT_EMPTY = prove
3484  (`independent {}`,
3485   REWRITE_TAC[independent; dependent; NOT_IN_EMPTY]);;
3486
3487 let INDEPENDENT_NONZERO = prove
3488  (`!s. independent s ==> ~(vec 0 IN s)`,
3489   REWRITE_TAC[independent; dependent] THEN MESON_TAC[SPAN_CLAUSES]);;
3490
3491 let INDEPENDENT_MONO = prove
3492  (`!s t. independent t /\ s SUBSET t ==> independent s`,
3493   REWRITE_TAC[independent; dependent] THEN
3494   ASM_MESON_TAC[SPAN_MONO; SUBSET; IN_DELETE]);;
3495
3496 let DEPENDENT_MONO = prove
3497  (`!s t:real^N->bool. dependent s /\ s SUBSET t ==> dependent t`,
3498   ONCE_REWRITE_TAC[TAUT `p /\ q ==> r <=> ~r /\ q ==> ~p`] THEN
3499   REWRITE_TAC[GSYM independent; INDEPENDENT_MONO]);;
3500
3501 let SPAN_SUBSPACE = prove
3502  (`!b s. b SUBSET s /\ s SUBSET (span b) /\ subspace s ==> (span b = s)`,
3503   MESON_TAC[SUBSET_ANTISYM; span; HULL_MINIMAL]);;
3504
3505 let SPAN_INDUCT_ALT = prove
3506  (`!s h. h(vec 0) /\
3507          (!c x y. x IN s /\ h(y) ==> h(c % x + y))
3508           ==> !x:real^N. x IN span(s) ==> h(x)`,
3509   REPEAT GEN_TAC THEN DISCH_TAC THEN
3510   FIRST_ASSUM(MP_TAC o prove_inductive_relations_exist o concl) THEN
3511   DISCH_THEN(X_CHOOSE_THEN `g:real^N->bool` STRIP_ASSUME_TAC) THEN
3512   SUBGOAL_THEN `!x:real^N. x IN span(s) ==> g(x)`
3513    (fun th -> ASM_MESON_TAC[th]) THEN
3514   MATCH_MP_TAC SPAN_INDUCT THEN REWRITE_TAC[subspace; IN_ELIM_THM] THEN
3515   REWRITE_TAC[IN; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
3516   ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN
3517   REPEAT CONJ_TAC THEN TRY(FIRST_X_ASSUM MATCH_MP_TAC) THEN
3518   REWRITE_TAC[VECTOR_ADD_LDISTRIB; VECTOR_MUL_ASSOC] THEN
3519   ASM_MESON_TAC[IN; VECTOR_ADD_LID; VECTOR_ADD_ASSOC; VECTOR_ADD_SYM;
3520                 VECTOR_MUL_LID; VECTOR_MUL_RZERO]);;
3521
3522 (* ------------------------------------------------------------------------- *)
3523 (* Individual closure properties.                                            *)
3524 (* ------------------------------------------------------------------------- *)
3525
3526 let SPAN_SUPERSET = prove
3527  (`!x. x IN s ==> x IN span s`,
3528   MESON_TAC[SPAN_CLAUSES]);;
3529
3530 let SPAN_INC = prove
3531  (`!s. s SUBSET span s`,
3532   REWRITE_TAC[SUBSET; SPAN_SUPERSET]);;
3533
3534 let SPAN_UNION_SUBSET = prove
3535  (`!s t. span s UNION span t SUBSET span(s UNION t)`,
3536   REWRITE_TAC[span; HULL_UNION_SUBSET]);;
3537
3538 let SPAN_UNIV = prove
3539  (`span(:real^N) = (:real^N)`,
3540   SIMP_TAC[SPAN_INC; SET_RULE `UNIV SUBSET s ==> s = UNIV`]);;
3541
3542 let SPAN_0 = prove
3543  (`vec(0) IN span s`,
3544   MESON_TAC[SUBSPACE_SPAN; SUBSPACE_0]);;
3545
3546 let SPAN_ADD = prove
3547  (`!x y s. x IN span s /\ y IN span s ==> (x + y) IN span s`,
3548   MESON_TAC[SUBSPACE_SPAN; SUBSPACE_ADD]);;
3549
3550 let SPAN_MUL = prove
3551  (`!x c s. x IN span s ==> (c % x) IN span s`,
3552   MESON_TAC[SUBSPACE_SPAN; SUBSPACE_MUL]);;
3553
3554 let SPAN_MUL_EQ = prove
3555  (`!x:real^N c s. ~(c = &0) ==> ((c % x) IN span s <=> x IN span s)`,
3556   REPEAT(STRIP_TAC ORELSE EQ_TAC) THEN ASM_SIMP_TAC[SPAN_MUL] THEN
3557   SUBGOAL_THEN `(inv(c) % c % x:real^N) IN span s` MP_TAC THENL
3558    [ASM_SIMP_TAC[SPAN_MUL];
3559     ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LINV; VECTOR_MUL_LID]]);;
3560
3561 let SPAN_NEG = prove
3562  (`!x s. x IN span s ==> (--x) IN span s`,
3563   MESON_TAC[SUBSPACE_SPAN; SUBSPACE_NEG]);;
3564
3565 let SPAN_NEG_EQ = prove
3566  (`!x s. --x IN span s <=> x IN span s`,
3567   MESON_TAC[SPAN_NEG; VECTOR_NEG_NEG]);;
3568
3569 let SPAN_SUB = prove
3570  (`!x y s. x IN span s /\ y IN span s ==> (x - y) IN span s`,
3571   MESON_TAC[SUBSPACE_SPAN; SUBSPACE_SUB]);;
3572
3573 let SPAN_VSUM = prove
3574  (`!s f t. FINITE t /\ (!x. x IN t ==> f(x) IN span(s))
3575            ==> (vsum t f) IN span(s)`,
3576   MESON_TAC[SUBSPACE_SPAN; SUBSPACE_VSUM]);;
3577
3578 let SPAN_ADD_EQ = prove
3579  (`!s x y. x IN span s ==> ((x + y) IN span s <=> y IN span s)`,
3580   MESON_TAC[SPAN_ADD; SPAN_SUB; VECTOR_ARITH `(x + y) - x:real^N = y`]);;
3581
3582 let SPAN_EQ_SELF = prove
3583  (`!s. span s = s <=> subspace s`,
3584   GEN_TAC THEN EQ_TAC THENL [MESON_TAC[SUBSPACE_SPAN]; ALL_TAC] THEN
3585   DISCH_TAC THEN MATCH_MP_TAC SPAN_SUBSPACE THEN
3586   ASM_REWRITE_TAC[SUBSET_REFL; SPAN_INC]);;
3587
3588 let SPAN_SUBSET_SUBSPACE = prove
3589  (`!s t:real^N->bool. s SUBSET t /\ subspace t ==> span s SUBSET t`,
3590   MESON_TAC[SPAN_MONO; SPAN_EQ_SELF]);;
3591
3592 let SUBSPACE_TRANSLATION_SELF = prove
3593  (`!s a. subspace s /\ a IN s ==> IMAGE (\x. a + x) s = s`,
3594   REPEAT STRIP_TAC THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN
3595   FIRST_ASSUM(SUBST1_TAC o SYM o GEN_REWRITE_RULE I [GSYM SPAN_EQ_SELF]) THEN
3596   ASM_SIMP_TAC[SPAN_ADD_EQ; SPAN_CLAUSES] THEN
3597   REWRITE_TAC[VECTOR_ARITH `a + x:real^N = y <=> x = y - a`; EXISTS_REFL]);;
3598
3599 let SUBSPACE_TRANSLATION_SELF_EQ = prove
3600  (`!s a:real^N. subspace s ==> (IMAGE (\x. a + x) s = s <=> a IN s)`,
3601   REPEAT STRIP_TAC THEN EQ_TAC THEN
3602   ASM_SIMP_TAC[SUBSPACE_TRANSLATION_SELF] THEN
3603   DISCH_THEN(MP_TAC o AP_TERM `\s. (a:real^N) IN s`) THEN
3604   REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN
3605   REWRITE_TAC[IN_IMAGE] THEN EXISTS_TAC `vec 0:real^N` THEN
3606   ASM_MESON_TAC[subspace; VECTOR_ADD_RID]);;
3607
3608 let SUBSPACE_SUMS = prove
3609  (`!s t. subspace s /\ subspace t
3610          ==> subspace {x + y | x IN s /\ y IN t}`,
3611   REWRITE_TAC[subspace; FORALL_IN_GSPEC; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
3612   REWRITE_TAC[IN_ELIM_THM] THEN REPEAT STRIP_TAC THENL
3613    [ASM_MESON_TAC[VECTOR_ADD_LID];
3614     ONCE_REWRITE_TAC[VECTOR_ARITH
3615      `(x + y) + (x' + y'):real^N = (x + x') + (y + y')`] THEN
3616     ASM_MESON_TAC[];
3617     REWRITE_TAC[VECTOR_ADD_LDISTRIB] THEN ASM_MESON_TAC[]]);;
3618
3619 let SPAN_UNION = prove
3620  (`!s t. span(s UNION t) = {x + y:real^N | x IN span s /\ y IN span t}`,
3621   REPEAT GEN_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL
3622    [MATCH_MP_TAC SPAN_SUBSET_SUBSPACE THEN
3623     SIMP_TAC[SUBSPACE_SUMS; SUBSPACE_SPAN] THEN
3624     REWRITE_TAC[SUBSET; IN_UNION; IN_ELIM_THM] THEN
3625     X_GEN_TAC `x:real^N` THEN STRIP_TAC THENL
3626      [MAP_EVERY EXISTS_TAC [`x:real^N`; `vec 0:real^N`] THEN
3627       ASM_SIMP_TAC[SPAN_SUPERSET; SPAN_0; VECTOR_ADD_RID];
3628       MAP_EVERY EXISTS_TAC [`vec 0:real^N`; `x:real^N`] THEN
3629       ASM_SIMP_TAC[SPAN_SUPERSET; SPAN_0; VECTOR_ADD_LID]];
3630     REWRITE_TAC[SUBSET; FORALL_IN_GSPEC] THEN
3631     REPEAT STRIP_TAC THEN MATCH_MP_TAC SPAN_ADD THEN
3632     ASM_MESON_TAC[SPAN_MONO; SUBSET_UNION; SUBSET]]);;
3633
3634 (* ------------------------------------------------------------------------- *)
3635 (* Mapping under linear image.                                               *)
3636 (* ------------------------------------------------------------------------- *)
3637
3638 let SPAN_LINEAR_IMAGE = prove
3639  (`!f:real^M->real^N s. linear f ==> (span(IMAGE f s) = IMAGE f (span s))`,
3640   REPEAT STRIP_TAC THEN GEN_REWRITE_TAC I [EXTENSION] THEN
3641   X_GEN_TAC `x:real^N` THEN EQ_TAC THENL
3642    [SPEC_TAC(`x:real^N`,`x:real^N`) THEN MATCH_MP_TAC SPAN_INDUCT THEN
3643     REWRITE_TAC[SET_RULE `(\x. x IN s) = s`] THEN
3644     ASM_SIMP_TAC[SUBSPACE_SPAN; SUBSPACE_LINEAR_IMAGE] THEN
3645     REWRITE_TAC[FORALL_IN_IMAGE] THEN REWRITE_TAC[IN_IMAGE] THEN
3646     MESON_TAC[SPAN_SUPERSET; SUBSET];
3647     SPEC_TAC(`x:real^N`,`x:real^N`) THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN
3648     MATCH_MP_TAC SPAN_INDUCT THEN
3649     REWRITE_TAC[SET_RULE `(\x. f x IN span(s)) = {x | f(x) IN span s}`] THEN
3650     ASM_SIMP_TAC[SUBSPACE_LINEAR_PREIMAGE; SUBSPACE_SPAN] THEN
3651     REWRITE_TAC[IN_ELIM_THM] THEN
3652     MESON_TAC[SPAN_SUPERSET; SUBSET; IN_IMAGE]]);;
3653
3654 let DEPENDENT_LINEAR_IMAGE_EQ = prove
3655  (`!f:real^M->real^N s.
3656         linear f /\ (!x y. f x = f y ==> x = y)
3657         ==> (dependent(IMAGE f s) <=> dependent s)`,
3658   REPEAT STRIP_TAC THEN REWRITE_TAC[dependent; EXISTS_IN_IMAGE] THEN
3659   AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `a:real^M` THEN
3660   ASM_CASES_TAC `(a:real^M) IN s` THEN ASM_REWRITE_TAC[] THEN
3661   MATCH_MP_TAC EQ_TRANS THEN
3662   EXISTS_TAC `(f:real^M->real^N) a IN span(IMAGE f (s DELETE a))` THEN
3663   CONJ_TAC THENL
3664    [AP_TERM_TAC THEN AP_TERM_TAC THEN ASM SET_TAC[];
3665     ASM_SIMP_TAC[SPAN_LINEAR_IMAGE] THEN ASM SET_TAC[]]);;
3666
3667 let DEPENDENT_LINEAR_IMAGE = prove
3668  (`!f:real^M->real^N s.
3669         linear f /\ (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) /\
3670         dependent(s)
3671         ==> dependent(IMAGE f s)`,
3672   REPEAT GEN_TAC THEN
3673   REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
3674   REWRITE_TAC[dependent; EXISTS_IN_IMAGE] THEN
3675   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real^M` THEN
3676   STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
3677   SUBGOAL_THEN `IMAGE (f:real^M->real^N) s DELETE f a = IMAGE f (s DELETE a)`
3678    (fun th -> ASM_SIMP_TAC[FUN_IN_IMAGE; SPAN_LINEAR_IMAGE; th]) THEN
3679   ASM SET_TAC[]);;
3680
3681 let INDEPENDENT_LINEAR_IMAGE_EQ = prove
3682  (`!f:real^M->real^N s.
3683         linear f /\ (!x y. f x = f y ==> x = y)
3684         ==> (independent(IMAGE f s) <=> independent s)`,
3685   REWRITE_TAC[independent; TAUT `(~p <=> ~q) <=> (p <=> q)`] THEN
3686   REWRITE_TAC[DEPENDENT_LINEAR_IMAGE_EQ]);;
3687
3688 (* ------------------------------------------------------------------------- *)
3689 (* The key breakdown property.                                               *)
3690 (* ------------------------------------------------------------------------- *)
3691
3692 let SPAN_BREAKDOWN = prove
3693  (`!b s a:real^N.
3694       b IN s /\ a IN span s ==> ?k. (a - k % b) IN span(s DELETE b)`,
3695   REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
3696   REPEAT GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC SPAN_INDUCT THEN
3697   REWRITE_TAC[subspace; IN_ELIM_THM] THEN CONJ_TAC THENL
3698    [GEN_TAC THEN DISCH_TAC THEN ASM_CASES_TAC `a:real^N = b`; ALL_TAC] THEN
3699   ASM_MESON_TAC[SPAN_CLAUSES; IN_DELETE; VECTOR_ARITH
3700    `(a - &1 % a = vec 0) /\ (a - &0 % b = a) /\
3701     ((x + y) - (k1 + k2) % b = (x - k1 % b) + (y - k2 % b)) /\
3702     (c % x - (c * k) % y = c % (x - k % y))`]);;
3703
3704 let SPAN_BREAKDOWN_EQ = prove
3705  (`!a:real^N s. (x IN span(a INSERT s) <=> (?k. (x - k % a) IN span s))`,
3706   REPEAT STRIP_TAC THEN EQ_TAC THENL
3707    [DISCH_THEN(MP_TAC o CONJ(SET_RULE `(a:real^N) IN (a INSERT s)`)) THEN
3708     DISCH_THEN(MP_TAC o MATCH_MP SPAN_BREAKDOWN) THEN
3709     MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:real` THEN
3710     SPEC_TAC(`x - k % a:real^N`,`y:real^N`) THEN
3711     REWRITE_TAC[GSYM SUBSET] THEN MATCH_MP_TAC SPAN_MONO THEN SET_TAC[];
3712     DISCH_THEN(X_CHOOSE_TAC `k:real`) THEN
3713     SUBST1_TAC(VECTOR_ARITH `x = (x - k % a) + k % a:real^N`) THEN
3714     MATCH_MP_TAC SPAN_ADD THEN
3715     ASM_MESON_TAC[SPAN_MONO; SUBSET; IN_INSERT; SPAN_CLAUSES]]);;
3716
3717 let SPAN_INSERT_0 = prove
3718  (`!s. span(vec 0 INSERT s) = span s`,
3719   SIMP_TAC[EXTENSION; SPAN_BREAKDOWN_EQ; VECTOR_MUL_RZERO; VECTOR_SUB_RZERO]);;
3720
3721 let SPAN_SING = prove
3722  (`!a. span {a} = {u % a | u IN (:real)}`,
3723   REWRITE_TAC[EXTENSION; IN_ELIM_THM; SPAN_BREAKDOWN_EQ; SPAN_EMPTY] THEN
3724   REWRITE_TAC[IN_UNIV; IN_SING; VECTOR_SUB_EQ]);;
3725
3726 let SPAN_2 = prove
3727  (`!a b. span {a,b} = {u % a + v % b | u IN (:real) /\ v IN (:real)}`,
3728   REWRITE_TAC[EXTENSION; IN_ELIM_THM; SPAN_BREAKDOWN_EQ; SPAN_EMPTY] THEN
3729   REWRITE_TAC[IN_UNIV; IN_SING; VECTOR_SUB_EQ] THEN
3730   REWRITE_TAC[VECTOR_ARITH `x - y:real^N = z <=> x = y + z`]);;
3731
3732 let SPAN_3 = prove
3733  (`!a b c. span {a,b,c} =
3734       {u % a + v % b + w % c | u IN (:real) /\ v IN (:real) /\ w IN (:real)}`,
3735   REWRITE_TAC[EXTENSION; IN_ELIM_THM; SPAN_BREAKDOWN_EQ; SPAN_EMPTY] THEN
3736   REWRITE_TAC[IN_UNIV; IN_SING; VECTOR_SUB_EQ] THEN
3737   REWRITE_TAC[VECTOR_ARITH `x - y:real^N = z <=> x = y + z`]);;
3738
3739 (* ------------------------------------------------------------------------- *)
3740 (* Hence some "reversal" results.                                            *)
3741 (* ------------------------------------------------------------------------- *)
3742
3743 let IN_SPAN_INSERT = prove
3744  (`!a b:real^N s.
3745         a IN span(b INSERT s) /\ ~(a IN span s) ==> b IN span(a INSERT s)`,
3746   REPEAT STRIP_TAC THEN
3747   MP_TAC(ISPECL [`b:real^N`; `(b:real^N) INSERT s`; `a:real^N`]
3748     SPAN_BREAKDOWN) THEN ASM_REWRITE_TAC[IN_INSERT] THEN
3749   DISCH_THEN(X_CHOOSE_THEN `k:real` MP_TAC) THEN ASM_CASES_TAC `k = &0` THEN
3750   ASM_REWRITE_TAC[VECTOR_ARITH `a - &0 % b = a`; DELETE_INSERT] THENL
3751    [ASM_MESON_TAC[SPAN_MONO; SUBSET; DELETE_SUBSET]; ALL_TAC] THEN
3752   DISCH_THEN(MP_TAC o SPEC `inv(k)` o MATCH_MP SPAN_MUL) THEN
3753   ASM_SIMP_TAC[VECTOR_SUB_LDISTRIB; VECTOR_MUL_ASSOC; REAL_MUL_LINV] THEN
3754   DISCH_TAC THEN SUBST1_TAC(VECTOR_ARITH
3755    `b:real^N = inv(k) % a - (inv(k) % a - &1 % b)`) THEN
3756   MATCH_MP_TAC SPAN_SUB THEN
3757   ASM_MESON_TAC[SPAN_CLAUSES; IN_INSERT; SUBSET; IN_DELETE; SPAN_MONO]);;
3758
3759 let IN_SPAN_DELETE = prove
3760  (`!a b s.
3761          a IN span s /\ ~(a IN span (s DELETE b))
3762          ==> b IN span (a INSERT (s DELETE b))`,
3763   ASM_MESON_TAC[IN_SPAN_INSERT; SPAN_MONO; SUBSET; IN_INSERT; IN_DELETE]);;
3764
3765 let EQ_SPAN_INSERT_EQ = prove
3766  (`!s x y:real^N. (x - y) IN span s ==> span(x INSERT s) = span(y INSERT s)`,
3767   REPEAT STRIP_TAC THEN REWRITE_TAC[SPAN_BREAKDOWN_EQ; EXTENSION] THEN
3768   ASM_MESON_TAC[SPAN_ADD; SPAN_SUB; SPAN_MUL;
3769                 VECTOR_ARITH `(z - k % y) - k % (x - y) = z - k % x`;
3770                 VECTOR_ARITH `(z - k % x) + k % (x - y) = z - k % y`]);;
3771
3772 (* ------------------------------------------------------------------------- *)
3773 (* Transitivity property.                                                    *)
3774 (* ------------------------------------------------------------------------- *)
3775
3776 let SPAN_TRANS = prove
3777  (`!x y:real^N s. x IN span(s) /\ y IN span(x INSERT s) ==> y IN span(s)`,
3778   REPEAT STRIP_TAC THEN
3779   MP_TAC(SPECL [`x:real^N`; `(x:real^N) INSERT s`; `y:real^N`]
3780          SPAN_BREAKDOWN) THEN
3781   ASM_REWRITE_TAC[IN_INSERT] THEN
3782   DISCH_THEN(X_CHOOSE_THEN `k:real` STRIP_ASSUME_TAC) THEN
3783   SUBST1_TAC(VECTOR_ARITH `y:real^N = (y - k % x) + k % x`) THEN
3784   MATCH_MP_TAC SPAN_ADD THEN ASM_SIMP_TAC[SPAN_MUL] THEN
3785   ASM_MESON_TAC[SPAN_MONO; SUBSET; IN_INSERT; IN_DELETE]);;
3786
3787 (* ------------------------------------------------------------------------- *)
3788 (* An explicit expansion is sometimes needed.                                *)
3789 (* ------------------------------------------------------------------------- *)
3790
3791 let SPAN_EXPLICIT = prove
3792  (`!(p:real^N -> bool).
3793         span p =
3794          {y | ?s u. FINITE s /\ s SUBSET p /\
3795                     vsum s (\v. u v % v) = y}`,
3796   GEN_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL
3797    [ALL_TAC;
3798     REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN
3799     REPEAT STRIP_TAC THEN FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN
3800     MATCH_MP_TAC SPAN_VSUM THEN ASM_REWRITE_TAC[] THEN
3801     ASM_MESON_TAC[SPAN_SUPERSET; SPAN_MUL]] THEN
3802   REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN
3803   MATCH_MP_TAC SPAN_INDUCT_ALT THEN CONJ_TAC THENL
3804    [EXISTS_TAC `{}:real^N->bool` THEN
3805     REWRITE_TAC[FINITE_RULES; VSUM_CLAUSES; EMPTY_SUBSET; NOT_IN_EMPTY];
3806     ALL_TAC] THEN
3807   MAP_EVERY X_GEN_TAC [`c:real`; `x:real^N`; `y:real^N`] THEN
3808   DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
3809   REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
3810   MAP_EVERY X_GEN_TAC [`s:real^N->bool`; `u:real^N->real`] THEN
3811   STRIP_TAC THEN EXISTS_TAC `(x:real^N) INSERT s` THEN
3812   EXISTS_TAC `\y. if y = x then (if x IN s then (u:real^N->real) y + c else c)
3813                   else u y` THEN
3814   ASM_SIMP_TAC[FINITE_INSERT; IN_INSERT; VSUM_CLAUSES] THEN
3815   CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN
3816   FIRST_X_ASSUM(SUBST_ALL_TAC o SYM) THEN
3817   COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL
3818    [FIRST_X_ASSUM(SUBST1_TAC o MATCH_MP (SET_RULE
3819      `x IN s ==> s = x INSERT (s DELETE x)`)) THEN
3820     ASM_SIMP_TAC[VSUM_CLAUSES; FINITE_INSERT; FINITE_DELETE; IN_DELETE] THEN
3821     MATCH_MP_TAC(VECTOR_ARITH
3822       `y = z ==> (c + d) % x + y = d % x + c % x + z`);
3823     AP_TERM_TAC] THEN
3824   MATCH_MP_TAC VSUM_EQ THEN ASM_MESON_TAC[IN_DELETE]);;
3825
3826 let DEPENDENT_EXPLICIT = prove
3827  (`!p. dependent (p:real^N -> bool) <=>
3828                 ?s u. FINITE s /\ s SUBSET p /\
3829                       (?v. v IN s /\ ~(u v = &0)) /\
3830                       vsum s (\v. u v % v) = vec 0`,
3831   GEN_TAC THEN REWRITE_TAC[dependent; SPAN_EXPLICIT; IN_ELIM_THM] THEN
3832   REWRITE_TAC[RIGHT_AND_EXISTS_THM; LEFT_AND_EXISTS_THM] THEN
3833   EQ_TAC THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THENL
3834    [MAP_EVERY X_GEN_TAC [`a:real^N`; `s:real^N->bool`; `u:real^N->real`] THEN
3835     STRIP_TAC THEN MAP_EVERY EXISTS_TAC
3836      [`(a:real^N) INSERT s`;
3837       `\y. if y = a then -- &1 else (u:real^N->real) y`;
3838       `a:real^N`] THEN
3839     ASM_REWRITE_TAC[IN_INSERT; INSERT_SUBSET; FINITE_INSERT] THEN
3840     CONJ_TAC THENL [ASM SET_TAC[]; CONV_TAC REAL_RAT_REDUCE_CONV] THEN
3841     ASM_SIMP_TAC[VSUM_CLAUSES] THEN
3842     COND_CASES_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
3843     REWRITE_TAC[VECTOR_ARITH `-- &1 % a + s = vec 0 <=> a = s`] THEN
3844     FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC LAND_CONV [SYM th]) THEN
3845     MATCH_MP_TAC VSUM_EQ THEN ASM SET_TAC[];
3846     MAP_EVERY X_GEN_TAC [`s:real^N->bool`; `u:real^N->real`; `a:real^N`] THEN
3847     STRIP_TAC THEN MAP_EVERY EXISTS_TAC
3848      [`a:real^N`; `s DELETE (a:real^N)`;
3849       `\i. --((u:real^N->real) i) / (u a)`] THEN
3850     ASM_SIMP_TAC[VSUM_DELETE; FINITE_DELETE] THEN
3851     REPEAT(CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN
3852     REWRITE_TAC[real_div] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
3853     ASM_REWRITE_TAC[VECTOR_MUL_LNEG; GSYM VECTOR_MUL_ASSOC; VSUM_LMUL;
3854                     VSUM_NEG; VECTOR_MUL_RNEG; VECTOR_MUL_RZERO] THEN
3855     ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LINV] THEN VECTOR_ARITH_TAC]);;
3856
3857 let DEPENDENT_FINITE = prove
3858  (`!s:real^N->bool.
3859         FINITE s
3860         ==> (dependent s <=> ?u. (?v. v IN s /\ ~(u v = &0)) /\
3861                                  vsum s (\v. u(v) % v) = vec 0)`,
3862   REPEAT STRIP_TAC THEN REWRITE_TAC[DEPENDENT_EXPLICIT] THEN EQ_TAC THEN
3863   REWRITE_TAC[LEFT_IMP_EXISTS_THM] THENL
3864    [MAP_EVERY X_GEN_TAC [`t:real^N->bool`; `u:real^N->real`] THEN
3865     DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN
3866     EXISTS_TAC `\v:real^N. if v IN t then u(v) else &0` THEN
3867     REWRITE_TAC[] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
3868     ONCE_REWRITE_TAC[COND_RAND] THEN ONCE_REWRITE_TAC[COND_RATOR] THEN
3869     ASM_SIMP_TAC[VECTOR_MUL_LZERO; GSYM VSUM_RESTRICT_SET] THEN
3870     ASM_SIMP_TAC[SET_RULE `t SUBSET s ==> {x | x IN s /\ x IN t} = t`];
3871     GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN ASSUME_TAC) THEN
3872     MAP_EVERY EXISTS_TAC [`s:real^N->bool`; `u:real^N->real`] THEN
3873     ASM_REWRITE_TAC[SUBSET_REFL]]);;
3874
3875 let SPAN_FINITE = prove
3876  (`!s:real^N->bool.
3877         FINITE s ==> span s = {y | ?u. vsum s (\v. u v % v) = y}`,
3878   REPEAT STRIP_TAC THEN REWRITE_TAC[SPAN_EXPLICIT; EXTENSION; IN_ELIM_THM] THEN
3879   X_GEN_TAC `y:real^N` THEN EQ_TAC THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THENL
3880    [MAP_EVERY X_GEN_TAC [`t:real^N->bool`; `u:real^N->real`] THEN
3881     STRIP_TAC THEN FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN
3882     EXISTS_TAC `\x:real^N. if x IN t then u(x) else &0` THEN
3883     REWRITE_TAC[COND_RAND; COND_RATOR; VECTOR_MUL_LZERO] THEN
3884     ASM_SIMP_TAC[GSYM VSUM_RESTRICT_SET] THEN
3885     ASM_SIMP_TAC[SET_RULE `t SUBSET s ==> {x | x IN s /\ x IN t} = t`];
3886     X_GEN_TAC `u:real^N->real` THEN DISCH_THEN(SUBST1_TAC o SYM) THEN
3887     MAP_EVERY EXISTS_TAC [`s:real^N->bool`; `u:real^N->real`] THEN
3888     ASM_REWRITE_TAC[SUBSET_REFL]]);;
3889
3890 (* ------------------------------------------------------------------------- *)
3891 (* Standard bases are a spanning set, and obviously finite.                  *)
3892 (* ------------------------------------------------------------------------- *)
3893
3894 let SPAN_STDBASIS = prove
3895  (`span {basis i :real^N | 1 <= i /\ i <= dimindex(:N)} = UNIV`,
3896   REWRITE_TAC[EXTENSION; IN_UNIV] THEN X_GEN_TAC `x:real^N` THEN
3897   GEN_REWRITE_TAC LAND_CONV [GSYM BASIS_EXPANSION] THEN
3898   MATCH_MP_TAC SPAN_VSUM THEN SIMP_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN
3899   REPEAT STRIP_TAC THEN MATCH_MP_TAC SPAN_MUL THEN
3900   MATCH_MP_TAC SPAN_SUPERSET THEN REWRITE_TAC[IN_ELIM_THM] THEN
3901   ASM_MESON_TAC[]);;
3902
3903 let HAS_SIZE_STDBASIS = prove
3904  (`{basis i :real^N | 1 <= i /\ i <= dimindex(:N)} HAS_SIZE
3905         dimindex(:N)`,
3906   ONCE_REWRITE_TAC[SET_RULE `{f x | P x} = IMAGE f {x | P x}`] THEN
3907   MATCH_MP_TAC HAS_SIZE_IMAGE_INJ THEN
3908   REWRITE_TAC[GSYM numseg; HAS_SIZE_NUMSEG_1; IN_NUMSEG] THEN
3909   MESON_TAC[BASIS_INJ]);;
3910
3911 let FINITE_STDBASIS = prove
3912  (`FINITE {basis i :real^N | 1 <= i /\ i <= dimindex(:N)}`,
3913   MESON_TAC[HAS_SIZE_STDBASIS; HAS_SIZE]);;
3914
3915 let CARD_STDBASIS = prove
3916  (`CARD {basis i :real^N | 1 <= i /\ i <= dimindex(:N)} =
3917         dimindex(:N)`,
3918    MESON_TAC[HAS_SIZE_STDBASIS; HAS_SIZE]);;
3919
3920 let IN_SPAN_IMAGE_BASIS = prove
3921  (`!x:real^N s.
3922         x IN span(IMAGE basis s) <=>
3923           !i. 1 <= i /\ i <= dimindex(:N) /\ ~(i IN s) ==> x$i = &0`,
3924   REPEAT GEN_TAC THEN EQ_TAC THENL
3925    [SPEC_TAC(`x:real^N`,`x:real^N`) THEN MATCH_MP_TAC SPAN_INDUCT THEN
3926     SIMP_TAC[subspace; IN_ELIM_THM; VEC_COMPONENT; VECTOR_ADD_COMPONENT;
3927              VECTOR_MUL_COMPONENT; REAL_MUL_RZERO; REAL_ADD_RID] THEN
3928     SIMP_TAC[FORALL_IN_IMAGE; BASIS_COMPONENT] THEN MESON_TAC[];
3929     DISCH_TAC THEN REWRITE_TAC[SPAN_EXPLICIT; IN_ELIM_THM] THEN
3930     EXISTS_TAC `(IMAGE basis ((1..dimindex(:N)) INTER s)):real^N->bool` THEN
3931     SIMP_TAC[FINITE_IMAGE; FINITE_INTER; FINITE_NUMSEG] THEN
3932     REWRITE_TAC[RIGHT_EXISTS_AND_THM] THEN
3933     CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN
3934     EXISTS_TAC `\v:real^N. x dot v` THEN
3935     W(MP_TAC o PART_MATCH (lhs o rand) VSUM_IMAGE o lhand o snd) THEN
3936     ANTS_TAC THENL
3937      [SIMP_TAC[FINITE_IMAGE; FINITE_INTER; FINITE_NUMSEG] THEN
3938       REWRITE_TAC[IN_INTER; IN_NUMSEG] THEN MESON_TAC[BASIS_INJ];
3939       DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[]] THEN
3940     REWRITE_TAC[o_DEF] THEN
3941     SIMP_TAC[CART_EQ; VSUM_COMPONENT; VECTOR_MUL_COMPONENT;
3942              BASIS_COMPONENT] THEN
3943     ONCE_REWRITE_TAC[COND_RAND] THEN
3944     ONCE_REWRITE_TAC[MESON[]
3945      `(if x = y then p else q) = (if y = x then p else q)`] THEN
3946     SIMP_TAC[SUM_DELTA; REAL_MUL_RZERO; IN_INTER; IN_NUMSEG; DOT_BASIS] THEN
3947     ASM_MESON_TAC[REAL_MUL_RID]]);;
3948
3949 let INDEPENDENT_STDBASIS = prove
3950  (`independent {basis i :real^N | 1 <= i /\ i <= dimindex(:N)}`,
3951   REWRITE_TAC[independent; dependent] THEN
3952   ONCE_REWRITE_TAC[SET_RULE `{f x | P x} = IMAGE f {x | P x}`] THEN
3953   REWRITE_TAC[EXISTS_IN_IMAGE] THEN REWRITE_TAC[IN_ELIM_THM] THEN
3954   DISCH_THEN(X_CHOOSE_THEN `k:num` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
3955   SUBGOAL_THEN
3956    `IMAGE basis {i | 1 <= i /\ i <= dimindex(:N)} DELETE
3957            (basis k:real^N) =
3958     IMAGE basis ({i | 1 <= i /\ i <= dimindex(:N)} DELETE k)`
3959   SUBST1_TAC THENL
3960    [REWRITE_TAC[EXTENSION; IN_IMAGE; IN_DELETE; IN_ELIM_THM] THEN
3961     GEN_TAC THEN EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
3962     ASM_MESON_TAC[BASIS_INJ];
3963     ALL_TAC] THEN
3964   REWRITE_TAC[IN_SPAN_IMAGE_BASIS] THEN DISCH_THEN(MP_TAC o SPEC `k:num`) THEN
3965   ASM_SIMP_TAC[IN_DELETE; BASIS_COMPONENT; REAL_OF_NUM_EQ; ARITH]);;
3966
3967 (* ------------------------------------------------------------------------- *)
3968 (* This is useful for building a basis step-by-step.                         *)
3969 (* ------------------------------------------------------------------------- *)
3970
3971 let INDEPENDENT_INSERT = prove
3972  (`!a:real^N s. independent(a INSERT s) <=>
3973                   if a IN s then independent s
3974                   else independent s /\ ~(a IN span s)`,
3975   REPEAT GEN_TAC THEN ASM_CASES_TAC `(a:real^N) IN s` THEN
3976   ASM_SIMP_TAC[SET_RULE `x IN s ==> (x INSERT s = s)`] THEN
3977   EQ_TAC THENL
3978    [DISCH_TAC THEN CONJ_TAC THENL
3979      [ASM_MESON_TAC[INDEPENDENT_MONO; SUBSET; IN_INSERT];
3980       POP_ASSUM MP_TAC THEN REWRITE_TAC[independent; dependent] THEN
3981       ASM_MESON_TAC[IN_INSERT; SET_RULE
3982         `~(a IN s) ==> ((a INSERT s) DELETE a = s)`]];
3983     ALL_TAC] THEN
3984   REWRITE_TAC[independent; dependent; NOT_EXISTS_THM] THEN
3985   STRIP_TAC THEN X_GEN_TAC `b:real^N` THEN
3986   REWRITE_TAC[IN_INSERT] THEN ASM_CASES_TAC `b:real^N = a` THEN
3987   ASM_SIMP_TAC[SET_RULE `~(a IN s) ==> ((a INSERT s) DELETE a = s)`] THEN
3988   ASM_SIMP_TAC[SET_RULE
3989     `~(a IN s) /\ ~(b = a)
3990      ==> ((a INSERT s) DELETE b = a INSERT (s DELETE b))`] THEN
3991   ASM_MESON_TAC[IN_SPAN_INSERT; SET_RULE
3992     `b IN s ==> (b INSERT (s DELETE b) = s)`]);;
3993
3994 (* ------------------------------------------------------------------------- *)
3995 (* The degenerate case of the Exchange Lemma.                                *)
3996 (* ------------------------------------------------------------------------- *)
3997
3998 let SPANNING_SUBSET_INDEPENDENT = prove
3999  (`!s t:real^N->bool.
4000         t SUBSET s /\ independent s /\ s SUBSET span(t) ==> (s = t)`,
4001   REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN
4002   ASM_REWRITE_TAC[] THEN REWRITE_TAC[SUBSET] THEN
4003   X_GEN_TAC `a:real^N` THEN DISCH_TAC THEN
4004   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [independent]) THEN
4005   REWRITE_TAC[dependent; NOT_EXISTS_THM] THEN
4006   DISCH_THEN(MP_TAC o SPEC `a:real^N`) THEN ASM_REWRITE_TAC[] THEN
4007   ASM_MESON_TAC[SPAN_MONO; SUBSET; IN_DELETE]);;
4008
4009 (* ------------------------------------------------------------------------- *)
4010 (* The general case of the Exchange Lemma, the key to what follows.          *)
4011 (* ------------------------------------------------------------------------- *)
4012
4013 let EXCHANGE_LEMMA = prove
4014  (`!s t:real^N->bool.
4015         FINITE t /\ independent s /\ s SUBSET span t
4016         ==> ?t'. t' HAS_SIZE (CARD t) /\
4017                  s SUBSET t' /\ t' SUBSET (s UNION t) /\ s SUBSET (span t')`,
4018   REPEAT GEN_TAC THEN
4019   WF_INDUCT_TAC `CARD(t DIFF s :real^N->bool)` THEN
4020   ASM_CASES_TAC `(s:real^N->bool) SUBSET t` THENL
4021    [ASM_MESON_TAC[HAS_SIZE; SUBSET_UNION]; ALL_TAC] THEN
4022   ASM_CASES_TAC `t SUBSET (s:real^N->bool)` THENL
4023    [ASM_MESON_TAC[SPANNING_SUBSET_INDEPENDENT; HAS_SIZE]; ALL_TAC] THEN
4024   STRIP_TAC THEN
4025   FIRST_X_ASSUM(MP_TAC o REWRITE_RULE[SUBSET] o check(is_neg o concl)) THEN
4026   REWRITE_TAC[NOT_FORALL_THM; NOT_IMP] THEN
4027   DISCH_THEN(X_CHOOSE_THEN `b:real^N` STRIP_ASSUME_TAC) THEN
4028   ASM_CASES_TAC `s SUBSET span(t DELETE (b:real^N))` THENL
4029    [FIRST_X_ASSUM(MP_TAC o
4030      SPECL [`t DELETE (b:real^N)`; `s:real^N->bool`]) THEN
4031     ASM_REWRITE_TAC[SET_RULE `s DELETE a DIFF t = (s DIFF t) DELETE a`] THEN
4032     ASM_SIMP_TAC[CARD_DELETE; FINITE_DIFF; IN_DIFF; FINITE_DELETE;
4033                  CARD_EQ_0; ARITH_RULE `n - 1 < n <=> ~(n = 0)`] THEN
4034     ANTS_TAC THENL
4035      [UNDISCH_TAC `~((s:real^N->bool) SUBSET t)` THEN ASM SET_TAC[];
4036       ALL_TAC] THEN
4037     DISCH_THEN(X_CHOOSE_THEN `u:real^N->bool` STRIP_ASSUME_TAC) THEN
4038     EXISTS_TAC `(b:real^N) INSERT u` THEN
4039     ASM_SIMP_TAC[SUBSET_INSERT; INSERT_SUBSET; IN_UNION] THEN CONJ_TAC THENL
4040      [UNDISCH_TAC `(u:real^N->bool) HAS_SIZE CARD(t:real^N->bool) - 1` THEN
4041       SIMP_TAC[HAS_SIZE; FINITE_RULES; CARD_CLAUSES] THEN STRIP_TAC THEN
4042       COND_CASES_TAC THENL
4043        [ASM_MESON_TAC[SUBSET; IN_UNION; IN_DELETE]; ALL_TAC] THEN
4044       ASM_MESON_TAC[ARITH_RULE `~(n = 0) ==> (SUC(n - 1) = n)`;
4045                     CARD_EQ_0; MEMBER_NOT_EMPTY];
4046       ALL_TAC] THEN
4047     CONJ_TAC THENL
4048      [UNDISCH_TAC `u SUBSET s UNION t DELETE (b:real^N)` THEN SET_TAC[];
4049       ASM_MESON_TAC[SUBSET; SPAN_MONO; IN_INSERT]];
4050     ALL_TAC] THEN
4051   UNDISCH_TAC `~(s SUBSET span (t DELETE (b:real^N)))` THEN
4052   GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [SUBSET] THEN
4053   REWRITE_TAC[NOT_FORALL_THM; NOT_IMP] THEN
4054   DISCH_THEN(X_CHOOSE_THEN `a:real^N` STRIP_ASSUME_TAC) THEN
4055   SUBGOAL_THEN `~(a:real^N = b)` ASSUME_TAC THENL
4056     [ASM_MESON_TAC[]; ALL_TAC] THEN
4057   SUBGOAL_THEN `~((a:real^N) IN t)` ASSUME_TAC THENL
4058    [ASM_MESON_TAC[IN_DELETE; SPAN_CLAUSES]; ALL_TAC] THEN
4059   FIRST_X_ASSUM(MP_TAC o SPECL
4060    [`(a:real^N) INSERT (t DELETE b)`; `s:real^N->bool`]) THEN
4061   ANTS_TAC THENL
4062    [ASM_SIMP_TAC[SET_RULE
4063      `a IN s ==> ((a INSERT (t DELETE b) DIFF s) = (t DIFF s) DELETE b)`] THEN
4064     ASM_SIMP_TAC[CARD_DELETE; FINITE_DELETE; FINITE_DIFF; IN_DIFF] THEN
4065     ASM_SIMP_TAC[ARITH_RULE `n - 1 < n <=> ~(n = 0)`; CARD_EQ_0;
4066                  FINITE_DIFF] THEN
4067     UNDISCH_TAC `~((s:real^N->bool) SUBSET t)` THEN ASM SET_TAC[];
4068     ALL_TAC] THEN
4069   ANTS_TAC THENL
4070    [ASM_SIMP_TAC[FINITE_RULES; FINITE_DELETE] THEN
4071     REWRITE_TAC[SUBSET] THEN X_GEN_TAC `x:real^N` THEN
4072     DISCH_TAC THEN MATCH_MP_TAC SPAN_TRANS THEN EXISTS_TAC `b:real^N` THEN
4073     ASM_MESON_TAC[IN_SPAN_DELETE; SUBSET; SPAN_MONO;
4074                   SET_RULE `t SUBSET (b INSERT (a INSERT (t DELETE b)))`];
4075     ALL_TAC] THEN
4076   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u:real^N->bool` THEN
4077   ASM_SIMP_TAC[HAS_SIZE; CARD_CLAUSES; CARD_DELETE; FINITE_DELETE; IN_DELETE;
4078                ARITH_RULE `(SUC(n - 1) = n) <=> ~(n = 0)`;
4079                CARD_EQ_0] THEN
4080   UNDISCH_TAC `(b:real^N) IN t` THEN ASM SET_TAC[]);;
4081
4082 (* ------------------------------------------------------------------------- *)
4083 (* This implies corresponding size bounds.                                   *)
4084 (* ------------------------------------------------------------------------- *)
4085
4086 let INDEPENDENT_SPAN_BOUND = prove
4087  (`!s t. FINITE t /\ independent s /\ s SUBSET span(t)
4088          ==> FINITE s /\ CARD(s) <= CARD(t)`,
4089   REPEAT GEN_TAC THEN DISCH_TAC THEN
4090   FIRST_ASSUM(MP_TAC o MATCH_MP EXCHANGE_LEMMA) THEN
4091   ASM_MESON_TAC[HAS_SIZE; CARD_SUBSET; FINITE_SUBSET]);;
4092
4093 let INDEPENDENT_BOUND = prove
4094  (`!s:real^N->bool.
4095         independent s ==> FINITE s /\ CARD(s) <= dimindex(:N)`,
4096   REPEAT GEN_TAC THEN DISCH_TAC THEN
4097   ONCE_REWRITE_TAC[GSYM CARD_STDBASIS] THEN
4098   MATCH_MP_TAC INDEPENDENT_SPAN_BOUND THEN
4099   ASM_REWRITE_TAC[FINITE_STDBASIS; SPAN_STDBASIS; SUBSET_UNIV]);;
4100
4101 let DEPENDENT_BIGGERSET = prove
4102  (`!s:real^N->bool. (FINITE s ==> CARD(s) > dimindex(:N)) ==> dependent s`,
4103   MP_TAC INDEPENDENT_BOUND THEN MATCH_MP_TAC MONO_FORALL THEN
4104   REWRITE_TAC[GT; GSYM NOT_LE; independent] THEN MESON_TAC[]);;
4105
4106 let INDEPENDENT_IMP_FINITE = prove
4107  (`!s:real^N->bool. independent s ==> FINITE s`,
4108   SIMP_TAC[INDEPENDENT_BOUND]);;
4109
4110 (* ------------------------------------------------------------------------- *)
4111 (* Explicit formulation of independence.                                     *)
4112 (* ------------------------------------------------------------------------- *)
4113
4114 let INDEPENDENT_EXPLICIT = prove
4115  (`!b:real^N->bool.
4116         independent b <=>
4117             FINITE b /\
4118             !c. vsum b (\v. c(v) % v) = vec 0 ==> !v. v IN b ==> c(v) = &0`,
4119   GEN_TAC THEN
4120   ASM_CASES_TAC `FINITE(b:real^N->bool)` THENL
4121    [ALL_TAC; ASM_MESON_TAC[INDEPENDENT_BOUND]] THEN
4122   ASM_SIMP_TAC[independent; DEPENDENT_FINITE] THEN MESON_TAC[]);;
4123
4124 let INDEPENDENT_2 = prove
4125  (`!a b:real^N x y.
4126         independent{a,b} /\ ~(a = b)
4127         ==> (x % a + y % b = vec 0 <=> x = &0 /\ y = &0)`,
4128   REWRITE_TAC[INDEPENDENT_EXPLICIT] THEN REPEAT STRIP_TAC THEN EQ_TAC THEN
4129   SIMP_TAC[VECTOR_MUL_LZERO; VECTOR_ADD_LID] THEN DISCH_TAC THEN
4130   FIRST_X_ASSUM(MP_TAC o SPEC `\c:real^N. if c = a then x else y:real`) THEN
4131   SIMP_TAC[VSUM_CLAUSES; FINITE_INSERT; FINITE_EMPTY] THEN
4132   ASM_REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY; VECTOR_ADD_RID] THEN
4133   DISCH_THEN(fun th ->
4134     MP_TAC(SPEC `a:real^N` th) THEN MP_TAC(SPEC `b:real^N` th)) THEN
4135   ASM_SIMP_TAC[]);;
4136
4137 let INDEPENDENT_3 = prove
4138  (`!a b c:real^N x y z.
4139         independent{a,b,c} /\ ~(a = b) /\ ~(a = c) /\ ~(b = c)
4140         ==> (x % a + y % b + z % c = vec 0 <=> x = &0 /\ y = &0 /\ z = &0)`,
4141   REWRITE_TAC[INDEPENDENT_EXPLICIT] THEN REPEAT STRIP_TAC THEN EQ_TAC THEN
4142   SIMP_TAC[VECTOR_MUL_LZERO; VECTOR_ADD_LID] THEN DISCH_TAC THEN
4143   FIRST_X_ASSUM(MP_TAC o SPEC
4144    `\v:real^N. if v = a then x else if v = b then y else z:real`) THEN
4145   SIMP_TAC[VSUM_CLAUSES; FINITE_INSERT; FINITE_EMPTY] THEN
4146   ASM_REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY; VECTOR_ADD_RID] THEN
4147   DISCH_THEN(fun th ->
4148     MP_TAC(SPEC `a:real^N` th) THEN MP_TAC(SPEC `b:real^N` th) THEN
4149     MP_TAC(SPEC `c:real^N` th)) THEN
4150   ASM_SIMP_TAC[]);;
4151
4152 (* ------------------------------------------------------------------------- *)
4153 (* Hence we can create a maximal independent subset.                         *)
4154 (* ------------------------------------------------------------------------- *)
4155
4156 let MAXIMAL_INDEPENDENT_SUBSET_EXTEND = prove
4157  (`!s v:real^N->bool.
4158         s SUBSET v /\ independent s
4159         ==> ?b. s SUBSET b /\ b SUBSET v /\ independent b /\
4160                 v SUBSET (span b)`,
4161   REPEAT GEN_TAC THEN
4162   WF_INDUCT_TAC `dimindex(:N) - CARD(s:real^N->bool)` THEN
4163   REPEAT STRIP_TAC THEN
4164   ASM_CASES_TAC `v SUBSET (span(s:real^N->bool))` THENL
4165    [ASM_MESON_TAC[SUBSET_REFL]; ALL_TAC] THEN
4166   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [SUBSET]) THEN
4167   REWRITE_TAC[NOT_FORALL_THM; NOT_IMP] THEN
4168   DISCH_THEN(X_CHOOSE_THEN `a:real^N` STRIP_ASSUME_TAC) THEN
4169   FIRST_X_ASSUM(MP_TAC o SPEC `(a:real^N) INSERT s`) THEN
4170   REWRITE_TAC[IMP_IMP] THEN ANTS_TAC THENL
4171    [ALL_TAC; MESON_TAC[INSERT_SUBSET]] THEN
4172   SUBGOAL_THEN `independent ((a:real^N) INSERT s)` ASSUME_TAC THENL
4173    [ASM_REWRITE_TAC[INDEPENDENT_INSERT; COND_ID]; ALL_TAC] THEN
4174   ASM_REWRITE_TAC[INSERT_SUBSET] THEN
4175   MATCH_MP_TAC(ARITH_RULE `(b = a + 1) /\ b <= n ==> n - b < n - a`) THEN
4176   ASM_SIMP_TAC[CARD_CLAUSES; INDEPENDENT_BOUND] THEN
4177   ASM_MESON_TAC[SPAN_SUPERSET; ADD1]);;
4178
4179 let MAXIMAL_INDEPENDENT_SUBSET = prove
4180  (`!v:real^N->bool. ?b. b SUBSET v /\ independent b /\ v SUBSET (span b)`,
4181   MP_TAC(SPEC `EMPTY:real^N->bool` MAXIMAL_INDEPENDENT_SUBSET_EXTEND) THEN
4182   REWRITE_TAC[EMPTY_SUBSET; INDEPENDENT_EMPTY]);;
4183
4184 (* ------------------------------------------------------------------------- *)
4185 (* Notion of dimension.                                                      *)
4186 (* ------------------------------------------------------------------------- *)
4187
4188 let dim = new_definition
4189   `dim v = @n. ?b. b SUBSET v /\ independent b /\ v SUBSET (span b) /\
4190                    b HAS_SIZE n`;;
4191
4192 let BASIS_EXISTS = prove
4193  (`!v. ?b. b SUBSET v /\ independent b /\ v SUBSET (span b) /\
4194            b HAS_SIZE (dim v)`,
4195   GEN_TAC THEN REWRITE_TAC[dim] THEN CONV_TAC SELECT_CONV THEN
4196   MESON_TAC[MAXIMAL_INDEPENDENT_SUBSET; HAS_SIZE; INDEPENDENT_BOUND]);;
4197
4198 let BASIS_EXISTS_FINITE = prove
4199  (`!v. ?b. FINITE b /\
4200            b SUBSET v /\
4201            independent b /\
4202            v SUBSET (span b) /\
4203            b HAS_SIZE (dim v)`,
4204   MESON_TAC[BASIS_EXISTS; INDEPENDENT_IMP_FINITE]);;
4205
4206 let BASIS_SUBSPACE_EXISTS = prove
4207  (`!s:real^N->bool.
4208         subspace s
4209         ==> ?b. FINITE b /\
4210                 b SUBSET s /\
4211                 independent b /\
4212                 span b = s /\
4213                 b HAS_SIZE dim s`,
4214   REPEAT STRIP_TAC THEN
4215   MP_TAC(ISPEC `s:real^N->bool` BASIS_EXISTS) THEN
4216   MATCH_MP_TAC MONO_EXISTS THEN REPEAT STRIP_TAC THEN
4217   ASM_REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ] THEN
4218   ASM_MESON_TAC[SPAN_EQ_SELF; SPAN_MONO; INDEPENDENT_IMP_FINITE]);;
4219
4220 (* ------------------------------------------------------------------------- *)
4221 (* Consequences of independence or spanning for cardinality.                 *)
4222 (* ------------------------------------------------------------------------- *)
4223
4224 let INDEPENDENT_CARD_LE_DIM = prove
4225  (`!v b:real^N->bool.
4226         b SUBSET v /\ independent b ==> FINITE b /\ CARD(b) <= dim v`,
4227   MESON_TAC[BASIS_EXISTS; INDEPENDENT_SPAN_BOUND; HAS_SIZE;SUBSET_TRANS]);;
4228
4229 let SPAN_CARD_GE_DIM = prove
4230  (`!v b:real^N->bool.
4231         v SUBSET (span b) /\ FINITE b ==> dim(v) <= CARD(b)`,
4232   MESON_TAC[BASIS_EXISTS; INDEPENDENT_SPAN_BOUND; HAS_SIZE;SUBSET_TRANS]);;
4233
4234 let BASIS_CARD_EQ_DIM = prove
4235  (`!v b. b SUBSET v /\ v SUBSET (span b) /\ independent b
4236          ==> FINITE b /\ (CARD b = dim v)`,
4237   MESON_TAC[LE_ANTISYM; INDEPENDENT_CARD_LE_DIM; SPAN_CARD_GE_DIM]);;
4238
4239 let BASIS_HAS_SIZE_DIM = prove
4240  (`!v b. independent b /\ span b = v ==> b HAS_SIZE (dim v)`,
4241   REPEAT STRIP_TAC THEN REWRITE_TAC[HAS_SIZE] THEN
4242   MATCH_MP_TAC BASIS_CARD_EQ_DIM THEN ASM_REWRITE_TAC[SUBSET_REFL] THEN
4243   FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN REWRITE_TAC[SPAN_INC]);;
4244
4245 let DIM_UNIQUE = prove
4246  (`!v b. b SUBSET v /\ v SUBSET (span b) /\ independent b /\ b HAS_SIZE n
4247          ==> (dim v = n)`,
4248   MESON_TAC[BASIS_CARD_EQ_DIM; HAS_SIZE]);;
4249
4250 let DIM_LE_CARD = prove
4251  (`!s. FINITE s ==> dim s <= CARD s`,
4252   GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC SPAN_CARD_GE_DIM THEN
4253   ASM_REWRITE_TAC[SPAN_INC; SUBSET_REFL]);;
4254
4255 (* ------------------------------------------------------------------------- *)
4256 (* More lemmas about dimension.                                              *)
4257 (* ------------------------------------------------------------------------- *)
4258
4259 let DIM_UNIV = prove
4260  (`dim(:real^N) = dimindex(:N)`,
4261   MATCH_MP_TAC DIM_UNIQUE THEN
4262   EXISTS_TAC `{basis i :real^N | 1 <= i /\ i <= dimindex(:N)}` THEN
4263   REWRITE_TAC[SUBSET_UNIV; SPAN_STDBASIS; HAS_SIZE_STDBASIS;
4264               INDEPENDENT_STDBASIS]);;
4265
4266 let DIM_SUBSET = prove
4267  (`!s t:real^N->bool. s SUBSET t ==> dim(s) <= dim(t)`,
4268   MESON_TAC[BASIS_EXISTS; INDEPENDENT_SPAN_BOUND; SUBSET; HAS_SIZE]);;
4269
4270 let DIM_SUBSET_UNIV = prove
4271  (`!s:real^N->bool. dim(s) <= dimindex(:N)`,
4272   GEN_TAC THEN REWRITE_TAC[GSYM DIM_UNIV] THEN
4273   MATCH_MP_TAC DIM_SUBSET THEN REWRITE_TAC[SUBSET_UNIV]);;
4274
4275 let BASIS_HAS_SIZE_UNIV = prove
4276  (`!b. independent b /\ span b = (:real^N) ==> b HAS_SIZE (dimindex(:N))`,
4277   REWRITE_TAC[GSYM DIM_UNIV; BASIS_HAS_SIZE_DIM]);;
4278
4279 (* ------------------------------------------------------------------------- *)
4280 (* Converses to those.                                                       *)
4281 (* ------------------------------------------------------------------------- *)
4282
4283 let CARD_GE_DIM_INDEPENDENT = prove
4284  (`!v b:real^N->bool.
4285         b SUBSET v /\ independent b /\ dim v <= CARD(b)
4286         ==> v SUBSET (span b)`,
4287   REPEAT STRIP_TAC THEN
4288   SUBGOAL_THEN `!a:real^N. ~(a IN v /\ ~(a IN span b))` MP_TAC THENL
4289    [ALL_TAC; SET_TAC[]] THEN
4290   X_GEN_TAC `a:real^N` THEN STRIP_TAC THEN
4291   SUBGOAL_THEN `independent((a:real^N) INSERT b)` ASSUME_TAC THENL
4292    [ASM_MESON_TAC[INDEPENDENT_INSERT]; ALL_TAC] THEN
4293   MP_TAC(ISPECL [`v:real^N->bool`; `(a:real^N) INSERT b`]
4294                 INDEPENDENT_CARD_LE_DIM) THEN
4295   ASM_SIMP_TAC[INSERT_SUBSET; CARD_CLAUSES; INDEPENDENT_BOUND] THEN
4296   ASM_MESON_TAC[SPAN_SUPERSET; SUBSET; ARITH_RULE
4297     `x <= y ==> ~(SUC y <= x)`]);;
4298
4299 let CARD_LE_DIM_SPANNING = prove
4300  (`!v b:real^N->bool.
4301         v SUBSET (span b) /\ FINITE b /\ CARD(b) <= dim v
4302         ==> independent b`,
4303   REPEAT STRIP_TAC THEN REWRITE_TAC[independent; dependent] THEN
4304   DISCH_THEN(X_CHOOSE_THEN `a:real^N` STRIP_ASSUME_TAC) THEN
4305   SUBGOAL_THEN `dim(v:real^N->bool) <= CARD(b DELETE (a:real^N))` MP_TAC THENL
4306    [ALL_TAC;
4307     ASM_SIMP_TAC[CARD_DELETE] THEN MATCH_MP_TAC
4308      (ARITH_RULE `b <= n /\ ~(b = 0) ==> ~(n <= b - 1)`) THEN
4309     ASM_SIMP_TAC[CARD_EQ_0] THEN ASM_MESON_TAC[MEMBER_NOT_EMPTY]] THEN
4310   MATCH_MP_TAC SPAN_CARD_GE_DIM THEN ASM_SIMP_TAC[FINITE_DELETE] THEN
4311   REWRITE_TAC[SUBSET] THEN REPEAT STRIP_TAC THEN
4312   MATCH_MP_TAC SPAN_TRANS THEN EXISTS_TAC `a:real^N` THEN
4313   ASM_SIMP_TAC[SET_RULE `a IN b ==> (a INSERT (b DELETE a) = b)`] THEN
4314   ASM_MESON_TAC[SUBSET]);;
4315
4316 let CARD_EQ_DIM = prove
4317  (`!v b. b SUBSET v /\ b HAS_SIZE (dim v)
4318          ==> (independent b <=> v SUBSET (span b))`,
4319   REWRITE_TAC[HAS_SIZE; GSYM LE_ANTISYM] THEN
4320   MESON_TAC[CARD_LE_DIM_SPANNING; CARD_GE_DIM_INDEPENDENT]);;
4321
4322 (* ------------------------------------------------------------------------- *)
4323 (* More general size bound lemmas.                                           *)
4324 (* ------------------------------------------------------------------------- *)
4325
4326 let INDEPENDENT_BOUND_GENERAL = prove
4327  (`!s:real^N->bool. independent s ==> FINITE s /\ CARD(s) <= dim(s)`,
4328   MESON_TAC[INDEPENDENT_CARD_LE_DIM; INDEPENDENT_BOUND; SUBSET_REFL]);;
4329
4330 let DEPENDENT_BIGGERSET_GENERAL = prove
4331  (`!s:real^N->bool. (FINITE s ==> CARD(s) > dim(s)) ==> dependent s`,
4332   MP_TAC INDEPENDENT_BOUND_GENERAL THEN MATCH_MP_TAC MONO_FORALL THEN
4333   REWRITE_TAC[GT; GSYM NOT_LE; independent] THEN MESON_TAC[]);;
4334
4335 let DIM_SPAN = prove
4336  (`!s:real^N->bool. dim(span s) = dim s`,
4337   GEN_TAC THEN REWRITE_TAC[GSYM LE_ANTISYM] THEN CONJ_TAC THENL
4338    [ALL_TAC;
4339     MATCH_MP_TAC DIM_SUBSET THEN MESON_TAC[SUBSET; SPAN_SUPERSET]] THEN
4340   MP_TAC(ISPEC `s:real^N->bool` BASIS_EXISTS) THEN
4341   REWRITE_TAC[HAS_SIZE] THEN STRIP_TAC THEN
4342   FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN
4343   MATCH_MP_TAC SPAN_CARD_GE_DIM THEN ASM_REWRITE_TAC[] THEN
4344   GEN_REWRITE_TAC RAND_CONV [GSYM SPAN_SPAN] THEN
4345   MATCH_MP_TAC SPAN_MONO THEN ASM_REWRITE_TAC[]);;
4346
4347 let DIM_INSERT_0 = prove
4348  (`!s:real^N->bool. dim(vec 0 INSERT s) = dim s`,
4349   ONCE_REWRITE_TAC[GSYM DIM_SPAN] THEN
4350   REWRITE_TAC[SPAN_INSERT_0]);;
4351
4352 let DIM_EQ_CARD = prove
4353  (`!s:real^N->bool. independent s ==> dim s = CARD s`,
4354   REPEAT STRIP_TAC THEN MP_TAC
4355    (ISPECL [`span s:real^N->bool`; `s:real^N->bool`] BASIS_CARD_EQ_DIM) THEN
4356   ASM_SIMP_TAC[SUBSET_REFL; SPAN_INC; DIM_SPAN]);;
4357
4358 let SUBSET_LE_DIM = prove
4359  (`!s t:real^N->bool. s SUBSET (span t) ==> dim s <= dim t`,
4360   MESON_TAC[DIM_SPAN; DIM_SUBSET]);;
4361
4362 let SPAN_EQ_DIM = prove
4363  (`!s t. span s = span t ==> dim s = dim t`,
4364   MESON_TAC[DIM_SPAN]);;
4365
4366 let SPANS_IMAGE = prove
4367  (`!f b v. linear f /\ v SUBSET (span b)
4368            ==> (IMAGE f v) SUBSET span(IMAGE f b)`,
4369   SIMP_TAC[SPAN_LINEAR_IMAGE; IMAGE_SUBSET]);;
4370
4371 let DIM_LINEAR_IMAGE_LE = prove
4372  (`!f:real^M->real^N s. linear f ==> dim(IMAGE f s) <= dim s`,
4373   REPEAT STRIP_TAC THEN MP_TAC(ISPEC `s:real^M->bool` BASIS_EXISTS) THEN
4374   REWRITE_TAC[HAS_SIZE] THEN STRIP_TAC THEN FIRST_ASSUM(SUBST1_TAC o SYM) THEN
4375   MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `CARD(IMAGE (f:real^M->real^N) b)` THEN
4376   ASM_SIMP_TAC[CARD_IMAGE_LE] THEN MATCH_MP_TAC SPAN_CARD_GE_DIM THEN
4377   ASM_MESON_TAC[SPAN_LINEAR_IMAGE; SPANS_IMAGE; SUBSET_IMAGE; FINITE_IMAGE]);;
4378
4379 (* ------------------------------------------------------------------------- *)
4380 (* Some stepping theorems.                                                   *)
4381 (* ------------------------------------------------------------------------- *)
4382
4383 let DIM_EMPTY = prove
4384  (`dim({}:real^N->bool) = 0`,
4385   MATCH_MP_TAC DIM_UNIQUE THEN EXISTS_TAC `{}:real^N->bool` THEN
4386   REWRITE_TAC[SUBSET_REFL; SPAN_EMPTY; INDEPENDENT_EMPTY; HAS_SIZE_0;
4387               EMPTY_SUBSET]);;
4388
4389 let DIM_INSERT = prove
4390  (`!x:real^N s. dim(x INSERT s) = if x IN span s then dim s else dim s + 1`,
4391   REPEAT GEN_TAC THEN COND_CASES_TAC THENL
4392    [MATCH_MP_TAC SPAN_EQ_DIM THEN MATCH_MP_TAC SUBSET_ANTISYM THEN
4393     ASM_MESON_TAC[SPAN_TRANS; SUBSET; SPAN_MONO; IN_INSERT];
4394     ALL_TAC] THEN
4395   X_CHOOSE_THEN `b:real^N->bool` STRIP_ASSUME_TAC
4396    (ISPEC `span s:real^N->bool` BASIS_EXISTS) THEN
4397   ONCE_REWRITE_TAC[GSYM DIM_SPAN] THEN
4398   MATCH_MP_TAC DIM_UNIQUE THEN
4399   EXISTS_TAC `(x:real^N) INSERT b` THEN REPEAT CONJ_TAC THENL
4400    [REWRITE_TAC[INSERT_SUBSET] THEN
4401     ASM_MESON_TAC[SUBSET; SPAN_MONO; IN_INSERT; SPAN_SUPERSET];
4402     REWRITE_TAC[SUBSET; SPAN_BREAKDOWN_EQ] THEN
4403     ASM_MESON_TAC[SUBSET];
4404     REWRITE_TAC[INDEPENDENT_INSERT] THEN
4405     ASM_MESON_TAC[SUBSET; SPAN_SUPERSET; SPAN_MONO; SPAN_SPAN];
4406     RULE_ASSUM_TAC(REWRITE_RULE[HAS_SIZE]) THEN
4407     ASM_SIMP_TAC[HAS_SIZE; CARD_CLAUSES; FINITE_INSERT; ADD1] THEN
4408     ASM_MESON_TAC[SUBSET; SPAN_SUPERSET; SPAN_MONO; SPAN_SPAN]]);;
4409
4410 let DIM_SING = prove
4411  (`!x. dim{x} = if x = vec 0 then 0 else 1`,
4412   REWRITE_TAC[DIM_INSERT; DIM_EMPTY; SPAN_EMPTY; IN_SING; ARITH]);;
4413
4414 let DIM_EQ_0 = prove
4415  (`!s:real^N->bool. dim s = 0 <=> s SUBSET {vec 0}`,
4416   REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THENL
4417    [MATCH_MP_TAC(SET_RULE
4418      `~(?b. ~(b = a) /\ {b} SUBSET s) ==> s SUBSET {a}`) THEN
4419     STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP DIM_SUBSET);
4420     MATCH_MP_TAC(ARITH_RULE `!m. m = 0 /\ n <= m ==> n = 0`) THEN
4421     EXISTS_TAC `dim{vec 0:real^N}` THEN ASM_SIMP_TAC[DIM_SUBSET]] THEN
4422   ASM_REWRITE_TAC[DIM_SING; ARITH]);;
4423
4424 (* ------------------------------------------------------------------------- *)
4425 (* Relation between bases and injectivity/surjectivity of map.               *)
4426 (* ------------------------------------------------------------------------- *)
4427
4428 let SPANNING_SURJECTIVE_IMAGE = prove
4429  (`!f:real^M->real^N s.
4430         UNIV SUBSET (span s) /\ linear f /\ (!y. ?x. f(x) = y)
4431         ==> UNIV SUBSET span(IMAGE f s)`,
4432   REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_TRANS THEN
4433   EXISTS_TAC `IMAGE (f:real^M->real^N) UNIV` THEN
4434   ASM_SIMP_TAC[SPANS_IMAGE] THEN
4435   REWRITE_TAC[SUBSET; IN_UNIV; IN_IMAGE] THEN ASM_MESON_TAC[]);;
4436
4437 let INDEPENDENT_INJECTIVE_IMAGE_GEN = prove
4438  (`!f:real^M->real^N s.
4439         independent s /\ linear f /\
4440         (!x y. x IN span s /\ y IN span s /\ f(x) = f(y) ==> x = y)
4441         ==> independent (IMAGE f s)`,
4442   REPEAT GEN_TAC THEN
4443   DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN
4444   ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN
4445   REWRITE_TAC[independent; DEPENDENT_EXPLICIT] THEN
4446   REWRITE_TAC[CONJ_ASSOC; FINITE_SUBSET_IMAGE] THEN
4447   REWRITE_TAC[MESON[]
4448      `(?s u. ((?t. p t /\ s = f t) /\ q s u) /\ r s u) <=>
4449       (?t u. p t /\ q (f t) u /\ r (f t) u)`] THEN
4450   REWRITE_TAC[EXISTS_IN_IMAGE; LEFT_IMP_EXISTS_THM] THEN
4451   MAP_EVERY X_GEN_TAC [`t:real^M->bool`; `u:real^N->real`] THEN
4452   DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN
4453   MAP_EVERY EXISTS_TAC
4454    [`t:real^M->bool`; `(u:real^N->real) o (f:real^M->real^N)`] THEN
4455   ASM_REWRITE_TAC[o_THM] THEN
4456   FIRST_ASSUM MATCH_MP_TAC THEN REPEAT CONJ_TAC THENL
4457    [MATCH_MP_TAC SPAN_VSUM THEN ASM_REWRITE_TAC[] THEN
4458     REPEAT STRIP_TAC THEN MATCH_MP_TAC SPAN_MUL THEN
4459     MATCH_MP_TAC SPAN_SUPERSET THEN ASM SET_TAC[];
4460     REWRITE_TAC[SPAN_0];
4461     ASM_SIMP_TAC[LINEAR_VSUM] THEN
4462     FIRST_ASSUM(SUBST1_TAC o MATCH_MP LINEAR_0) THEN
4463     FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN CONV_TAC SYM_CONV THEN
4464     W(MP_TAC o PART_MATCH (lhs o rand) VSUM_IMAGE o lhand o snd) THEN
4465     ASM_SIMP_TAC[o_DEF; LINEAR_CMUL] THEN DISCH_THEN MATCH_MP_TAC THEN
4466     ASM_MESON_TAC[SPAN_SUPERSET; SUBSET]]);;
4467
4468 let INDEPENDENT_INJECTIVE_IMAGE = prove
4469  (`!f:real^M->real^N s.
4470         independent s /\ linear f /\ (!x y. (f(x) = f(y)) ==> (x = y))
4471         ==> independent (IMAGE f s)`,
4472   REPEAT STRIP_TAC THEN MATCH_MP_TAC INDEPENDENT_INJECTIVE_IMAGE_GEN THEN
4473   ASM_MESON_TAC[]);;
4474
4475 (* ------------------------------------------------------------------------- *)
4476 (* Picking an orthogonal replacement for a spanning set.                     *)
4477 (* ------------------------------------------------------------------------- *)
4478
4479 let VECTOR_SUB_PROJECT_ORTHOGONAL = prove
4480  (`!b:real^N x. b dot (x - ((b dot x) / (b dot b)) % b) = &0`,
4481   REPEAT GEN_TAC THEN ASM_CASES_TAC `b = vec 0 :real^N` THENL
4482    [ASM_REWRITE_TAC[DOT_LZERO]; ALL_TAC] THEN
4483   ASM_SIMP_TAC[DOT_RSUB; DOT_RMUL] THEN
4484   ASM_SIMP_TAC[REAL_SUB_REFL; REAL_DIV_RMUL; DOT_EQ_0]);;
4485
4486 let BASIS_ORTHOGONAL = prove
4487  (`!b:real^N->bool.
4488         FINITE b
4489         ==> ?c. FINITE c /\ CARD c <= CARD b /\
4490                 span c = span b /\ pairwise orthogonal c`,
4491   REWRITE_TAC[pairwise; orthogonal] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
4492   CONJ_TAC THENL
4493    [EXISTS_TAC `{}:real^N->bool` THEN
4494     REWRITE_TAC[FINITE_RULES; NOT_IN_EMPTY; LE_REFL];
4495     ALL_TAC] THEN
4496   MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N->bool`] THEN
4497   DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `c:real^N->bool` STRIP_ASSUME_TAC)
4498         STRIP_ASSUME_TAC) THEN
4499   EXISTS_TAC `(a - vsum c (\x. ((x dot a) / (x dot x)) % x):real^N)
4500               INSERT c` THEN
4501   ASM_SIMP_TAC[FINITE_RULES; CARD_CLAUSES] THEN REPEAT CONJ_TAC THENL
4502    [ASM_ARITH_TAC;
4503     REWRITE_TAC[EXTENSION; SPAN_BREAKDOWN_EQ] THEN
4504     FIRST_X_ASSUM(SUBST_ALL_TAC o SYM) THEN GEN_TAC THEN
4505     AP_TERM_TAC THEN ABS_TAC THEN REWRITE_TAC[VECTOR_SUB_LDISTRIB] THEN
4506     REWRITE_TAC[VECTOR_ARITH `a - (x - y):real^N = y + (a - x)`] THEN
4507     MATCH_MP_TAC SPAN_ADD_EQ THEN MATCH_MP_TAC SPAN_MUL THEN
4508     MATCH_MP_TAC SPAN_VSUM THEN ASM_REWRITE_TAC[] THEN
4509     REPEAT STRIP_TAC THEN MATCH_MP_TAC SPAN_MUL THEN
4510     ASM_SIMP_TAC[SPAN_SUPERSET];
4511     REWRITE_TAC[IN_INSERT] THEN REPEAT STRIP_TAC THENL
4512      [ASM_MESON_TAC[];
4513       FIRST_X_ASSUM SUBST_ALL_TAC;
4514       FIRST_X_ASSUM SUBST_ALL_TAC;
4515       ASM_MESON_TAC[]] THEN
4516     REWRITE_TAC[DOT_LSUB; DOT_RSUB; REAL_SUB_0] THEN
4517     FIRST_ASSUM(SUBST1_TAC o MATCH_MP (SET_RULE
4518      `x IN s ==> s = x INSERT (s DELETE x)`)) THEN
4519     ASM_SIMP_TAC[VSUM_CLAUSES; FINITE_DELETE; IN_DELETE] THEN
4520     REWRITE_TAC[DOT_LADD; DOT_RADD; DOT_LMUL; DOT_RMUL] THEN
4521     MATCH_MP_TAC(REAL_ARITH `s = &0 /\ a = b ==> b = a + s`) THEN
4522     ASM_SIMP_TAC[DOT_LSUM; DOT_RSUM; FINITE_DELETE] THEN
4523     (CONJ_TAC THENL
4524       [MATCH_MP_TAC SUM_EQ_0 THEN
4525        ASM_SIMP_TAC[DOT_LMUL; DOT_RMUL; IN_DELETE;
4526                     REAL_MUL_RZERO; REAL_MUL_LZERO];
4527        W(MP_TAC o PART_MATCH (lhand o rand) REAL_DIV_RMUL o lhand o snd) THEN
4528        REWRITE_TAC[DOT_SYM] THEN
4529        MATCH_MP_TAC(TAUT `(p ==> q) ==> (~p ==> q) ==> q`) THEN
4530        SIMP_TAC[] THEN SIMP_TAC[DOT_EQ_0; DOT_RZERO; DOT_LZERO] THEN
4531        REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_RZERO]])]);;
4532
4533 let ORTHOGONAL_BASIS_EXISTS = prove
4534  (`!v:real^N->bool.
4535         ?b. independent b /\
4536             b SUBSET span v /\
4537             v SUBSET span b /\
4538             b HAS_SIZE dim v /\
4539             pairwise orthogonal b`,
4540   GEN_TAC THEN MP_TAC(ISPEC `v:real^N->bool` BASIS_EXISTS) THEN
4541   DISCH_THEN(X_CHOOSE_THEN `b:real^N->bool` STRIP_ASSUME_TAC) THEN
4542   MP_TAC(SPEC `b:real^N->bool` BASIS_ORTHOGONAL) THEN
4543   ANTS_TAC THENL [ASM_MESON_TAC[HAS_SIZE]; ALL_TAC] THEN
4544   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c:real^N->bool` THEN
4545   STRIP_TAC THEN ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL
4546    [MATCH_MP_TAC CARD_LE_DIM_SPANNING THEN ASM_REWRITE_TAC[] THEN
4547     EXISTS_TAC `span(v):real^N->bool` THEN CONJ_TAC THENL
4548      [ASM_MESON_TAC[SPAN_SPAN; SPAN_MONO];
4549       ASM_MESON_TAC[LE_TRANS; HAS_SIZE; DIM_SPAN]];
4550     ASM_MESON_TAC[SUBSET_TRANS; SPAN_INC; SPAN_SPAN; SPAN_MONO];
4551     RULE_ASSUM_TAC(REWRITE_RULE[HAS_SIZE]) THEN
4552     ASM_REWRITE_TAC[HAS_SIZE; GSYM LE_ANTISYM] THEN
4553     CONJ_TAC THENL [ASM_MESON_TAC[LE_TRANS]; ALL_TAC] THEN
4554     ONCE_REWRITE_TAC[GSYM DIM_SPAN] THEN MATCH_MP_TAC SPAN_CARD_GE_DIM THEN
4555     ASM_REWRITE_TAC[] THEN
4556     ASM_MESON_TAC[SPAN_SPAN; SPAN_MONO; SUBSET_TRANS; SPAN_INC]]);;
4557
4558 let SPAN_EQ = prove
4559  (`!s t. span s = span t <=> s SUBSET span t /\ t SUBSET span s`,
4560   REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ] THEN
4561   MESON_TAC[SUBSET_TRANS; SPAN_SPAN; SPAN_MONO; SPAN_INC]);;
4562
4563 (* ------------------------------------------------------------------------- *)
4564 (* We can extend a linear basis-basis injection to the whole set.            *)
4565 (* ------------------------------------------------------------------------- *)
4566
4567 let LINEAR_INDEP_IMAGE_LEMMA = prove
4568  (`!f b. linear(f:real^M->real^N) /\
4569          FINITE b /\
4570          independent (IMAGE f b) /\
4571          (!x y. x IN b /\ y IN b /\ (f x = f y) ==> (x = y))
4572          ==> !x. x IN span b ==> (f(x) = vec 0) ==> (x = vec 0)`,
4573   REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
4574   GEN_TAC THEN DISCH_TAC THEN
4575   GEN_REWRITE_TAC (BINDER_CONV o RAND_CONV) [IMP_IMP] THEN
4576   MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
4577   CONJ_TAC THENL [SIMP_TAC[IN_SING; SPAN_EMPTY]; ALL_TAC] THEN
4578   MAP_EVERY X_GEN_TAC [`a:real^M`; `b:real^M->bool`] THEN STRIP_TAC THEN
4579   STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o check (is_imp o concl)) THEN
4580   ANTS_TAC THENL
4581    [ASM_MESON_TAC[INDEPENDENT_MONO; IMAGE_CLAUSES; SUBSET; IN_INSERT];
4582     ALL_TAC] THEN
4583   DISCH_TAC THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN
4584   MP_TAC(ISPECL [`a:real^M`; `(a:real^M) INSERT b`; `x:real^M`]
4585     SPAN_BREAKDOWN) THEN
4586   ASM_REWRITE_TAC[IN_INSERT] THEN
4587   SIMP_TAC[ASSUME `~((a:real^M) IN b)`; SET_RULE
4588     `~(a IN b) ==> ((a INSERT b) DELETE a = b)`] THEN
4589   DISCH_THEN(X_CHOOSE_THEN `k:real` STRIP_ASSUME_TAC) THEN DISCH_TAC THEN
4590   SUBGOAL_THEN `(f:real^M->real^N)(x - k % a) IN span(IMAGE f b)` MP_TAC THENL
4591    [ASM_MESON_TAC[SPAN_LINEAR_IMAGE; IN_IMAGE]; ALL_TAC] THEN
4592   FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP LINEAR_SUB th]) THEN
4593   FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP LINEAR_CMUL th]) THEN
4594   ASM_REWRITE_TAC[VECTOR_ARITH `vec 0 - k % x = (--k) % x`] THEN
4595   ASM_CASES_TAC `k = &0` THENL
4596    [ASM_MESON_TAC[VECTOR_ARITH `x - &0 % y = x`]; ALL_TAC] THEN
4597   DISCH_THEN(MP_TAC o SPEC `--inv(k)` o MATCH_MP SPAN_MUL) THEN
4598   REWRITE_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LNEG; REAL_MUL_RNEG] THEN
4599   SIMP_TAC[REAL_NEGNEG; REAL_MUL_LINV; ASSUME `~(k = &0)`] THEN
4600   REWRITE_TAC[VECTOR_MUL_LID] THEN
4601   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [independent]) THEN
4602   REWRITE_TAC[dependent; NOT_EXISTS_THM] THEN
4603   DISCH_THEN(MP_TAC o SPEC `(f:real^M->real^N) a`) THEN
4604   SUBGOAL_THEN
4605    `IMAGE (f:real^M->real^N) (a INSERT b) DELETE f a =
4606     IMAGE f ((a INSERT b) DELETE a)`
4607   SUBST1_TAC THENL
4608    [REWRITE_TAC[EXTENSION; IN_IMAGE; IN_DELETE; IN_INSERT] THEN
4609     ASM_MESON_TAC[IN_INSERT];
4610     ALL_TAC] THEN
4611   ASM_REWRITE_TAC[DELETE_INSERT] THEN
4612   SIMP_TAC[SET_RULE `~(a IN b) ==> (b DELETE a = b)`;
4613            ASSUME `~(a:real^M IN b)`] THEN
4614   SIMP_TAC[IMAGE_CLAUSES; IN_INSERT]);;
4615
4616 (* ------------------------------------------------------------------------- *)
4617 (* We can extend a linear mapping from basis.                                *)
4618 (* ------------------------------------------------------------------------- *)
4619
4620 let LINEAR_INDEPENDENT_EXTEND_LEMMA = prove
4621  (`!f b. FINITE b
4622          ==> independent b
4623              ==> ?g:real^M->real^N.
4624                         (!x y. x IN span b /\ y IN span b
4625                                 ==> (g(x + y) = g(x) + g(y))) /\
4626                         (!x c. x IN span b ==> (g(c % x) = c % g(x))) /\
4627                         (!x. x IN b ==> (g x = f x))`,
4628   GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
4629   REWRITE_TAC[NOT_IN_EMPTY; INDEPENDENT_INSERT] THEN CONJ_TAC THENL
4630    [REPEAT STRIP_TAC THEN EXISTS_TAC `(\x. vec 0):real^M->real^N` THEN
4631     SIMP_TAC[SPAN_EMPTY] THEN REPEAT STRIP_TAC THEN VECTOR_ARITH_TAC;
4632     ALL_TAC] THEN
4633   SIMP_TAC[] THEN MAP_EVERY X_GEN_TAC [`a:real^M`; `b:real^M->bool`] THEN
4634   DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN
4635   DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN
4636   DISCH_THEN(X_CHOOSE_THEN `g:real^M->real^N` STRIP_ASSUME_TAC) THEN
4637   ABBREV_TAC `h = \z:real^M. @k. (z - k % a) IN span b` THEN
4638   SUBGOAL_THEN `!z:real^M. z IN span(a INSERT b)
4639                     ==> (z - h(z) % a) IN span(b) /\
4640                         !k. (z - k % a) IN span(b) ==> (k = h(z))`
4641   MP_TAC THENL
4642    [GEN_TAC THEN DISCH_TAC THEN
4643     MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL
4644      [EXPAND_TAC "h" THEN CONV_TAC SELECT_CONV THEN
4645       ASM_MESON_TAC[SPAN_BREAKDOWN_EQ];
4646       ALL_TAC] THEN
4647     REWRITE_TAC[RIGHT_IMP_FORALL_THM; IMP_IMP] THEN GEN_TAC THEN
4648     DISCH_THEN(MP_TAC o MATCH_MP SPAN_SUB) THEN
4649     REWRITE_TAC[VECTOR_ARITH `(z - a % v) - (z - b % v) = (b - a) % v`] THEN
4650     ASM_CASES_TAC `k = (h:real^M->real) z` THEN ASM_REWRITE_TAC[] THEN
4651     DISCH_THEN(MP_TAC o SPEC `inv(k - (h:real^M->real) z)` o
4652                MATCH_MP SPAN_MUL) THEN
4653     ASM_SIMP_TAC[REAL_MUL_LINV; VECTOR_MUL_ASSOC; REAL_SUB_0] THEN
4654     ASM_REWRITE_TAC[VECTOR_MUL_LID];
4655     ALL_TAC] THEN
4656   REWRITE_TAC[TAUT `(a ==> b /\ c) <=> (a ==> b) /\ (a ==> c)`] THEN
4657   REWRITE_TAC[RIGHT_IMP_FORALL_THM; IMP_IMP] THEN
4658   GEN_REWRITE_TAC LAND_CONV [FORALL_AND_THM] THEN STRIP_TAC THEN
4659   EXISTS_TAC `\z:real^M. h(z) % (f:real^M->real^N)(a) + g(z - h(z) % a)` THEN
4660   REPEAT CONJ_TAC THENL
4661    [MAP_EVERY X_GEN_TAC [`x:real^M`; `y:real^M`] THEN STRIP_TAC THEN
4662     SUBGOAL_THEN `(h:real^M->real)(x + y) = h(x) + h(y)` ASSUME_TAC THENL
4663      [CONV_TAC SYM_CONV THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
4664       REWRITE_TAC[VECTOR_ARITH
4665        `(x + y) - (k + l) % a = (x - k % a) + (y - l % a)`] THEN
4666       CONJ_TAC THEN MATCH_MP_TAC SPAN_ADD THEN ASM_REWRITE_TAC[] THEN
4667       ASM_SIMP_TAC[];
4668       ALL_TAC] THEN
4669     ASM_REWRITE_TAC[VECTOR_ARITH
4670        `(x + y) - (k + l) % a = (x - k % a) + (y - l % a)`] THEN
4671     ASM_SIMP_TAC[] THEN VECTOR_ARITH_TAC;
4672     MAP_EVERY X_GEN_TAC [`x:real^M`; `c:real`] THEN STRIP_TAC THEN
4673     SUBGOAL_THEN `(h:real^M->real)(c % x) = c * h(x)` ASSUME_TAC THENL
4674      [CONV_TAC SYM_CONV THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
4675       REWRITE_TAC[VECTOR_ARITH
4676        `c % x - (c * k) % a = c % (x - k % a)`] THEN
4677       CONJ_TAC THEN MATCH_MP_TAC SPAN_MUL THEN ASM_REWRITE_TAC[] THEN
4678       ASM_SIMP_TAC[];
4679       ALL_TAC] THEN
4680     ASM_REWRITE_TAC[VECTOR_ARITH
4681        `c % x - (c * k) % a = c % (x - k % a)`] THEN
4682     ASM_SIMP_TAC[] THEN VECTOR_ARITH_TAC;
4683     ALL_TAC] THEN
4684   X_GEN_TAC `x:real^M` THEN REWRITE_TAC[IN_INSERT] THEN
4685   DISCH_THEN(DISJ_CASES_THEN2 SUBST_ALL_TAC ASSUME_TAC) THENL
4686    [SUBGOAL_THEN `&1 = h(a:real^M)` (SUBST1_TAC o SYM) THENL
4687      [FIRST_X_ASSUM MATCH_MP_TAC; ALL_TAC] THEN
4688     REWRITE_TAC[VECTOR_ARITH `a - &1 % a = vec 0`; SPAN_0] THENL
4689      [ASM_MESON_TAC[SPAN_SUPERSET; SUBSET; IN_INSERT]; ALL_TAC] THEN
4690     FIRST_X_ASSUM(MP_TAC o SPECL [`vec 0:real^M`; `vec 0:real^M`]) THEN
4691     REWRITE_TAC[SPAN_0; VECTOR_ADD_LID] THEN
4692     REWRITE_TAC[VECTOR_ARITH `(a = a + a) <=> (a = vec 0)`] THEN
4693     DISCH_THEN SUBST1_TAC THEN VECTOR_ARITH_TAC;
4694     ALL_TAC] THEN
4695   SUBGOAL_THEN `&0 = h(x:real^M)` (SUBST1_TAC o SYM) THENL
4696    [FIRST_X_ASSUM MATCH_MP_TAC; ALL_TAC] THEN
4697   REWRITE_TAC[VECTOR_ADD_LID; VECTOR_MUL_LZERO; VECTOR_SUB_RZERO] THEN
4698   ASM_MESON_TAC[SUBSET; IN_INSERT; SPAN_SUPERSET]);;
4699
4700 let LINEAR_INDEPENDENT_EXTEND = prove
4701  (`!f b. independent b
4702          ==> ?g:real^M->real^N. linear g /\ (!x. x IN b ==> (g x = f x))`,
4703   REPEAT STRIP_TAC THEN
4704   MP_TAC(ISPECL [`b:real^M->bool`; `(:real^M)`]
4705            MAXIMAL_INDEPENDENT_SUBSET_EXTEND) THEN
4706   ASM_REWRITE_TAC[SUBSET_UNIV; UNIV_SUBSET] THEN
4707   REWRITE_TAC[EXTENSION; IN_UNIV] THEN
4708   DISCH_THEN(X_CHOOSE_THEN `c:real^M->bool` STRIP_ASSUME_TAC) THEN
4709   MP_TAC(ISPECL [`f:real^M->real^N`; `c:real^M->bool`]
4710     LINEAR_INDEPENDENT_EXTEND_LEMMA) THEN
4711   ASM_SIMP_TAC[INDEPENDENT_BOUND; linear] THEN
4712   ASM_MESON_TAC[SUBSET]);;
4713
4714 (* ------------------------------------------------------------------------- *)
4715 (* Linear functions are equal on a subspace if they are on a spanning set.   *)
4716 (* ------------------------------------------------------------------------- *)
4717
4718 let SUBSPACE_KERNEL = prove
4719  (`!f. linear f ==> subspace {x | f(x) = vec 0}`,
4720   REWRITE_TAC[subspace; IN_ELIM_THM] THEN
4721   SIMP_TAC[LINEAR_ADD; LINEAR_CMUL; VECTOR_ADD_LID; VECTOR_MUL_RZERO] THEN
4722   MESON_TAC[LINEAR_0]);;
4723
4724 let LINEAR_EQ_0_SPAN = prove
4725  (`!f:real^M->real^N b.
4726         linear f /\ (!x. x IN b ==> f(x) = vec 0)
4727         ==> !x. x IN span(b) ==> f(x) = vec 0`,
4728   REPEAT GEN_TAC THEN STRIP_TAC THEN
4729   RULE_ASSUM_TAC(REWRITE_RULE[IN]) THEN
4730   MATCH_MP_TAC SPAN_INDUCT THEN ASM_REWRITE_TAC[IN] THEN
4731   MP_TAC(ISPEC `f:real^M->real^N` SUBSPACE_KERNEL) THEN
4732   ASM_REWRITE_TAC[] THEN MATCH_MP_TAC EQ_IMP THEN
4733   AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM]);;
4734
4735 let LINEAR_EQ_0 = prove
4736  (`!f b s. linear f /\ s SUBSET (span b) /\ (!x. x IN b ==> f(x) = vec 0)
4737            ==> !x. x IN s ==> f(x) = vec 0`,
4738   MESON_TAC[LINEAR_EQ_0_SPAN; SUBSET]);;
4739
4740 let LINEAR_EQ = prove
4741  (`!f g b s. linear f /\ linear g /\ s SUBSET (span b) /\
4742              (!x. x IN b ==> f(x) = g(x))
4743               ==> !x. x IN s ==> f(x) = g(x)`,
4744   REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM VECTOR_SUB_EQ] THEN
4745   STRIP_TAC THEN MATCH_MP_TAC LINEAR_EQ_0 THEN
4746   ASM_MESON_TAC[LINEAR_COMPOSE_SUB]);;
4747
4748 let LINEAR_EQ_STDBASIS = prove
4749  (`!f:real^M->real^N g.
4750         linear f /\ linear g /\
4751         (!i. 1 <= i /\ i <= dimindex(:M)
4752              ==> f(basis i) = g(basis i))
4753         ==> f = g`,
4754   REPEAT STRIP_TAC THEN
4755   SUBGOAL_THEN `!x. x IN UNIV ==> (f:real^M->real^N) x = g x`
4756    (fun th -> MP_TAC th THEN REWRITE_TAC[FUN_EQ_THM; IN_UNIV]) THEN
4757   MATCH_MP_TAC LINEAR_EQ THEN
4758   EXISTS_TAC `{basis i :real^M | 1 <= i /\ i <= dimindex(:M)}` THEN
4759   ASM_REWRITE_TAC[SPAN_STDBASIS; SUBSET_REFL; IN_ELIM_THM] THEN
4760   ASM_MESON_TAC[]);;
4761
4762 (* ------------------------------------------------------------------------- *)
4763 (* Similar results for bilinear functions.                                   *)
4764 (* ------------------------------------------------------------------------- *)
4765
4766 let BILINEAR_EQ = prove
4767  (`!f:real^M->real^N->real^P g b c s.
4768         bilinear f /\ bilinear g /\
4769         s SUBSET (span b) /\ t SUBSET (span c) /\
4770         (!x y. x IN b /\ y IN c ==> f x y = g x y)
4771          ==> !x y. x IN s /\ y IN t ==> f x y = g x y`,
4772   REPEAT STRIP_TAC THEN SUBGOAL_THEN
4773     `!x:real^M. x IN span b
4774                 ==> !y:real^N. y IN span c ==> (f x y :real^P = g x y)`
4775     (fun th -> ASM_MESON_TAC[th; SUBSET]) THEN
4776   MATCH_MP_TAC SPAN_INDUCT THEN REWRITE_TAC[subspace; IN_ELIM_THM] THEN
4777   CONJ_TAC THENL
4778    [GEN_TAC THEN DISCH_TAC;
4779     ASM_SIMP_TAC[BILINEAR_LADD; BILINEAR_LMUL] THEN
4780     ASM_MESON_TAC[BILINEAR_LZERO]] THEN
4781   MATCH_MP_TAC SPAN_INDUCT THEN REWRITE_TAC[subspace; IN_ELIM_THM] THEN
4782   ASM_SIMP_TAC[BILINEAR_RADD; BILINEAR_RMUL] THEN
4783   ASM_MESON_TAC[BILINEAR_RZERO]);;
4784
4785 let BILINEAR_EQ_STDBASIS = prove
4786  (`!f:real^M->real^N->real^P g.
4787         bilinear f /\ bilinear g /\
4788         (!i j. 1 <= i /\ i <= dimindex(:M) /\ 1 <= j /\ j <= dimindex(:N)
4789              ==> f (basis i) (basis j) = g (basis i) (basis j))
4790         ==> f = g`,
4791   REPEAT STRIP_TAC THEN SUBGOAL_THEN
4792    `!x y. x IN UNIV /\ y IN UNIV ==> (f:real^M->real^N->real^P) x y = g x y`
4793    (fun th -> MP_TAC th THEN REWRITE_TAC[FUN_EQ_THM; IN_UNIV]) THEN
4794   MATCH_MP_TAC BILINEAR_EQ THEN
4795   EXISTS_TAC `{basis i :real^M | 1 <= i /\ i <= dimindex(:M)}` THEN
4796   EXISTS_TAC `{basis i :real^N | 1 <= i /\ i <= dimindex(:N)}` THEN
4797   ASM_REWRITE_TAC[SPAN_STDBASIS; SUBSET_REFL; IN_ELIM_THM] THEN
4798   ASM_MESON_TAC[]);;
4799
4800 (* ------------------------------------------------------------------------- *)
4801 (* Detailed theorems about left and right invertibility in general case.     *)
4802 (* ------------------------------------------------------------------------- *)
4803
4804 let LEFT_INVERTIBLE_TRANSP = prove
4805  (`!A:real^N^M.
4806     (?B:real^N^M. B ** transp A = mat 1) <=> (?B:real^M^N. A ** B = mat 1)`,
4807   MESON_TAC[MATRIX_TRANSP_MUL; TRANSP_MAT; TRANSP_TRANSP]);;
4808
4809 let RIGHT_INVERTIBLE_TRANSP = prove
4810  (`!A:real^N^M.
4811     (?B:real^N^M. transp A ** B = mat 1) <=> (?B:real^M^N. B ** A = mat 1)`,
4812   MESON_TAC[MATRIX_TRANSP_MUL; TRANSP_MAT; TRANSP_TRANSP]);;
4813
4814 let LINEAR_INJECTIVE_LEFT_INVERSE = prove
4815  (`!f:real^M->real^N.
4816         linear f /\ (!x y. f x = f y ==> x = y)
4817         ==> ?g. linear g /\ g o f = I`,
4818   REWRITE_TAC[INJECTIVE_LEFT_INVERSE] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN
4819    `?h. linear(h:real^N->real^M) /\
4820         !x. x IN IMAGE (f:real^M->real^N)
4821                {basis i | 1 <= i /\ i <= dimindex(:M)} ==> h x = g x`
4822   MP_TAC THENL
4823    [MATCH_MP_TAC LINEAR_INDEPENDENT_EXTEND THEN
4824     MATCH_MP_TAC INDEPENDENT_INJECTIVE_IMAGE THEN
4825     ASM_MESON_TAC[INJECTIVE_LEFT_INVERSE; INDEPENDENT_STDBASIS];
4826     MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `h:real^N->real^M` THEN
4827     ASM_REWRITE_TAC[FORALL_IN_IMAGE; IN_ELIM_THM] THEN STRIP_TAC THEN
4828     ASM_REWRITE_TAC[] THEN MATCH_MP_TAC LINEAR_EQ_STDBASIS THEN
4829     ASM_SIMP_TAC[I_DEF; LINEAR_COMPOSE; LINEAR_ID; o_THM] THEN
4830     ASM_MESON_TAC[]]);;
4831
4832 let LINEAR_SURJECTIVE_RIGHT_INVERSE = prove
4833  (`!f:real^M->real^N.
4834         linear f /\ (!y. ?x. f x = y) ==> ?g. linear g /\ f o g = I`,
4835   REWRITE_TAC[SURJECTIVE_RIGHT_INVERSE] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN
4836    `?h. linear(h:real^N->real^M) /\
4837         !x. x IN {basis i | 1 <= i /\ i <= dimindex(:N)} ==> h x = g x`
4838   MP_TAC THENL
4839    [MATCH_MP_TAC LINEAR_INDEPENDENT_EXTEND THEN
4840     REWRITE_TAC[INDEPENDENT_STDBASIS];
4841     MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `h:real^N->real^M` THEN
4842     ASM_REWRITE_TAC[FORALL_IN_IMAGE; IN_ELIM_THM] THEN STRIP_TAC THEN
4843     ASM_REWRITE_TAC[] THEN MATCH_MP_TAC LINEAR_EQ_STDBASIS THEN
4844     ASM_SIMP_TAC[I_DEF; LINEAR_COMPOSE; LINEAR_ID; o_THM] THEN
4845     ASM_MESON_TAC[]]);;
4846
4847 let MATRIX_LEFT_INVERTIBLE_INJECTIVE = prove
4848  (`!A:real^N^M.
4849         (?B:real^M^N. B ** A = mat 1) <=>
4850         !x y:real^N. A ** x = A ** y ==> x = y`,
4851   GEN_TAC THEN EQ_TAC THENL
4852    [STRIP_TAC THEN REPEAT GEN_TAC THEN
4853     DISCH_THEN(MP_TAC o AP_TERM `\x:real^M. (B:real^M^N) ** x`) THEN
4854     ASM_REWRITE_TAC[MATRIX_VECTOR_MUL_ASSOC; MATRIX_VECTOR_MUL_LID];
4855     DISCH_TAC THEN MP_TAC(ISPEC
4856      `\x:real^N. (A:real^N^M) ** x` LINEAR_INJECTIVE_LEFT_INVERSE) THEN
4857     ASM_REWRITE_TAC[MATRIX_VECTOR_MUL_LINEAR; FUN_EQ_THM; I_THM; o_THM] THEN
4858     DISCH_THEN(X_CHOOSE_THEN `g:real^M->real^N` STRIP_ASSUME_TAC) THEN
4859     EXISTS_TAC `matrix(g):real^M^N` THEN
4860     REWRITE_TAC[MATRIX_EQ; MATRIX_VECTOR_MUL_LID] THEN
4861     ASM_MESON_TAC[MATRIX_VECTOR_MUL_ASSOC; MATRIX_WORKS]]);;
4862
4863 let MATRIX_LEFT_INVERTIBLE_KER = prove
4864  (`!A:real^N^M.
4865         (?B:real^M^N. B ** A = mat 1) <=> !x. A ** x = vec 0 ==> x = vec 0`,
4866   GEN_TAC THEN REWRITE_TAC[MATRIX_LEFT_INVERTIBLE_INJECTIVE] THEN
4867   MATCH_MP_TAC LINEAR_INJECTIVE_0 THEN REWRITE_TAC[MATRIX_VECTOR_MUL_LINEAR]);;
4868
4869 let MATRIX_RIGHT_INVERTIBLE_SURJECTIVE = prove
4870  (`!A:real^N^M.
4871         (?B:real^M^N. A ** B = mat 1) <=> !y. ?x. A ** x = y`,
4872   GEN_TAC THEN EQ_TAC THENL
4873    [STRIP_TAC THEN X_GEN_TAC `y:real^M` THEN
4874     EXISTS_TAC `(B:real^M^N) ** (y:real^M)` THEN
4875     ASM_REWRITE_TAC[MATRIX_VECTOR_MUL_ASSOC; MATRIX_VECTOR_MUL_LID];
4876     DISCH_TAC THEN MP_TAC(ISPEC
4877      `\x:real^N. (A:real^N^M) ** x` LINEAR_SURJECTIVE_RIGHT_INVERSE) THEN
4878     ASM_REWRITE_TAC[MATRIX_VECTOR_MUL_LINEAR; FUN_EQ_THM; I_THM; o_THM] THEN
4879     DISCH_THEN(X_CHOOSE_THEN `g:real^M->real^N` STRIP_ASSUME_TAC) THEN
4880     EXISTS_TAC `matrix(g):real^M^N` THEN
4881     REWRITE_TAC[MATRIX_EQ; MATRIX_VECTOR_MUL_LID] THEN
4882     ASM_MESON_TAC[MATRIX_VECTOR_MUL_ASSOC; MATRIX_WORKS]]);;
4883
4884 let MATRIX_LEFT_INVERTIBLE_INDEPENDENT_COLUMNS = prove
4885  (`!A:real^N^M. (?B:real^M^N. B ** A = mat 1) <=>
4886                 !c. vsum(1..dimindex(:N)) (\i. c(i) % column i A) = vec 0 ==>
4887                     !i. 1 <= i /\ i <= dimindex(:N) ==> c(i) = &0`,
4888   GEN_TAC THEN REWRITE_TAC[MATRIX_LEFT_INVERTIBLE_KER; MATRIX_MUL_VSUM] THEN
4889   EQ_TAC THEN DISCH_TAC THENL
4890    [X_GEN_TAC `c:num->real` THEN DISCH_TAC THEN
4891     FIRST_X_ASSUM(MP_TAC o SPEC `(lambda i. c(i)):real^N`);
4892     X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
4893     FIRST_X_ASSUM(MP_TAC o SPEC `\i. (x:real^N)$i`)] THEN
4894   ASM_SIMP_TAC[LAMBDA_BETA; CART_EQ; VEC_COMPONENT]);;
4895
4896 let MATRIX_RIGHT_INVERTIBLE_INDEPENDENT_ROWS = prove
4897  (`!A:real^N^M. (?B:real^M^N. A ** B = mat 1) <=>
4898                 !c. vsum(1..dimindex(:M)) (\i. c(i) % row i A) = vec 0 ==>
4899                     !i. 1 <= i /\ i <= dimindex(:M) ==> c(i) = &0`,
4900   ONCE_REWRITE_TAC[GSYM LEFT_INVERTIBLE_TRANSP] THEN
4901   REWRITE_TAC[MATRIX_LEFT_INVERTIBLE_INDEPENDENT_COLUMNS] THEN
4902   SIMP_TAC[COLUMN_TRANSP]);;
4903
4904 let MATRIX_RIGHT_INVERTIBLE_SPAN_COLUMNS = prove
4905  (`!A:real^N^M. (?B:real^M^N. A ** B = mat 1) <=> span(columns A) = (:real^M)`,
4906   GEN_TAC THEN REWRITE_TAC[MATRIX_RIGHT_INVERTIBLE_SURJECTIVE] THEN
4907   REWRITE_TAC[MATRIX_MUL_VSUM; EXTENSION; IN_UNIV] THEN
4908   AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `y:real^M` THEN
4909   EQ_TAC THENL
4910    [DISCH_THEN(X_CHOOSE_THEN `x:real^N` (SUBST1_TAC o SYM)) THEN
4911     MATCH_MP_TAC SPAN_VSUM THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN
4912     X_GEN_TAC `i:num` THEN STRIP_TAC THEN MATCH_MP_TAC SPAN_MUL THEN
4913     MATCH_MP_TAC(CONJUNCT1 SPAN_CLAUSES) THEN
4914     REWRITE_TAC[columns; IN_ELIM_THM] THEN ASM_MESON_TAC[];
4915     ALL_TAC] THEN
4916   SPEC_TAC(`y:real^M`,`y:real^M`) THEN MATCH_MP_TAC SPAN_INDUCT_ALT THEN
4917   CONJ_TAC THENL
4918    [EXISTS_TAC `vec 0 :real^N` THEN
4919     SIMP_TAC[VEC_COMPONENT; VECTOR_MUL_LZERO; VSUM_0];
4920     ALL_TAC] THEN
4921   MAP_EVERY X_GEN_TAC [`c:real`; `y1:real^M`; `y2:real^M`] THEN
4922   REWRITE_TAC[columns; IN_ELIM_THM] THEN DISCH_THEN(CONJUNCTS_THEN2
4923    (X_CHOOSE_THEN `i:num` STRIP_ASSUME_TAC)
4924    (X_CHOOSE_THEN `x:real^N` (SUBST1_TAC o SYM))) THEN
4925   EXISTS_TAC `(lambda j. if j = i then c + (x:real^N)$i else x$j):real^N` THEN
4926   SUBGOAL_THEN `1..dimindex(:N) = i INSERT ((1..dimindex(:N)) DELETE i)`
4927   SUBST1_TAC THENL [ASM_MESON_TAC[INSERT_DELETE; IN_NUMSEG]; ALL_TAC] THEN
4928   SIMP_TAC[VSUM_CLAUSES; FINITE_DELETE; FINITE_NUMSEG; IN_DELETE] THEN
4929   ASM_SIMP_TAC[LAMBDA_BETA; VECTOR_ADD_RDISTRIB; VECTOR_ADD_ASSOC] THEN
4930   AP_TERM_TAC THEN MATCH_MP_TAC VSUM_EQ THEN
4931   SIMP_TAC[FINITE_DELETE; IN_DELETE; FINITE_NUMSEG; LAMBDA_BETA; IN_NUMSEG]);;
4932
4933 let MATRIX_LEFT_INVERTIBLE_SPAN_ROWS = prove
4934  (`!A:real^N^M. (?B:real^M^N. B ** A = mat 1) <=> span(rows A) = (:real^N)`,
4935   MESON_TAC[RIGHT_INVERTIBLE_TRANSP; COLUMNS_TRANSP;
4936             MATRIX_RIGHT_INVERTIBLE_SPAN_COLUMNS]);;
4937
4938 (* ------------------------------------------------------------------------- *)
4939 (* An injective map real^N->real^N is also surjective.                       *)
4940 (* ------------------------------------------------------------------------- *)
4941
4942 let LINEAR_INJECTIVE_IMP_SURJECTIVE = prove
4943  (`!f:real^N->real^N.
4944         linear f /\ (!x y. (f(x) = f(y)) ==> (x = y))
4945         ==> !y. ?x. f(x) = y`,
4946   REPEAT STRIP_TAC THEN
4947   MP_TAC(ISPEC `(:real^N)` BASIS_EXISTS) THEN
4948   REWRITE_TAC[SUBSET_UNIV; HAS_SIZE] THEN
4949   DISCH_THEN(X_CHOOSE_THEN `b:real^N->bool` STRIP_ASSUME_TAC) THEN
4950   SUBGOAL_THEN `UNIV SUBSET span(IMAGE (f:real^N->real^N) b)` MP_TAC THENL
4951    [MATCH_MP_TAC CARD_GE_DIM_INDEPENDENT THEN
4952     ASM_MESON_TAC[INDEPENDENT_INJECTIVE_IMAGE; LE_REFL;
4953                   SUBSET_UNIV; CARD_IMAGE_INJ];
4954     ASM_SIMP_TAC[SPAN_LINEAR_IMAGE] THEN
4955     ASM_MESON_TAC[SUBSET; IN_IMAGE; IN_UNIV]]);;
4956
4957 (* ------------------------------------------------------------------------- *)
4958 (* And vice versa.                                                           *)
4959 (* ------------------------------------------------------------------------- *)
4960
4961 let LINEAR_SURJECTIVE_IMP_INJECTIVE = prove
4962  (`!f:real^N->real^N.
4963         linear f /\ (!y. ?x. f(x) = y)
4964         ==> !x y. (f(x) = f(y)) ==> (x = y)`,
4965   REPEAT GEN_TAC THEN STRIP_TAC THEN
4966   MP_TAC(ISPEC `(:real^N)` BASIS_EXISTS) THEN
4967   REWRITE_TAC[SUBSET_UNIV; HAS_SIZE] THEN
4968   DISCH_THEN(X_CHOOSE_THEN `b:real^N->bool` STRIP_ASSUME_TAC) THEN
4969   SUBGOAL_THEN
4970    `!x. x IN span b ==> (f:real^N->real^N) x = vec 0 ==> x = vec 0`
4971    (fun th -> ASM_MESON_TAC[th; LINEAR_INJECTIVE_0; SUBSET; IN_UNIV]) THEN
4972   MATCH_MP_TAC LINEAR_INDEP_IMAGE_LEMMA THEN
4973   ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
4974    [MATCH_MP_TAC CARD_LE_DIM_SPANNING THEN
4975     EXISTS_TAC `(:real^N)` THEN
4976     ASM_SIMP_TAC[SUBSET_UNIV; FINITE_IMAGE; SPAN_LINEAR_IMAGE] THEN
4977     REWRITE_TAC[SUBSET; IN_UNIV; IN_IMAGE] THEN
4978     ASM_MESON_TAC[CARD_IMAGE_LE; SUBSET; IN_UNIV];
4979     ALL_TAC] THEN
4980   SUBGOAL_THEN `dim(:real^N) <= CARD(IMAGE (f:real^N->real^N) b)`
4981   MP_TAC THENL
4982    [MATCH_MP_TAC SPAN_CARD_GE_DIM THEN
4983     ASM_SIMP_TAC[SUBSET_UNIV; FINITE_IMAGE] THEN
4984     ASM_SIMP_TAC[SPAN_LINEAR_IMAGE] THEN MATCH_MP_TAC SUBSET_TRANS THEN
4985     EXISTS_TAC `IMAGE (f:real^N->real^N) UNIV` THEN
4986     ASM_SIMP_TAC[IMAGE_SUBSET] THEN
4987     ASM_REWRITE_TAC[SUBSET; IN_IMAGE; IN_UNIV] THEN ASM_MESON_TAC[];
4988     ALL_TAC] THEN
4989   FIRST_X_ASSUM(MP_TAC o ISPEC `f:real^N->real^N` o
4990                 MATCH_MP CARD_IMAGE_LE) THEN
4991   ASM_REWRITE_TAC[IMP_IMP; LE_ANTISYM] THEN DISCH_TAC THEN
4992   MP_TAC(ISPECL
4993    [`b:real^N->bool`; `IMAGE (f:real^N->real^N) b`; `f:real^N->real^N`]
4994    SURJECTIVE_IFF_INJECTIVE_GEN) THEN
4995   ASM_SIMP_TAC[FINITE_IMAGE; INDEPENDENT_BOUND; SUBSET_REFL] THEN
4996   REWRITE_TAC[FORALL_IN_IMAGE] THEN MESON_TAC[]);;
4997
4998 let LINEAR_SURJECTIVE_IFF_INJECTIVE = prove
4999  (`!f:real^N->real^N.
5000       linear f ==> ((!y. ?x. f x = y) <=> (!x y. f x = f y ==> x = y))`,
5001   MESON_TAC[LINEAR_INJECTIVE_IMP_SURJECTIVE;
5002             LINEAR_SURJECTIVE_IMP_INJECTIVE]);;
5003
5004 (* ------------------------------------------------------------------------- *)
5005 (* Hence either is enough for isomorphism.                                   *)
5006 (* ------------------------------------------------------------------------- *)
5007
5008 let LEFT_RIGHT_INVERSE_EQ = prove
5009  (`!f:A->A g h. f o g = I /\ g o h = I ==> f = h`,
5010   MESON_TAC[o_ASSOC; I_O_ID]);;
5011
5012 let ISOMORPHISM_EXPAND = prove
5013  (`!f g. f o g = I /\ g o f = I <=> (!x. f(g x) = x) /\ (!x. g(f x) = x)`,
5014   REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM]);;
5015
5016 let LINEAR_INJECTIVE_ISOMORPHISM = prove
5017  (`!f:real^N->real^N.
5018         linear f /\ (!x y. f x = f y ==> x = y)
5019         ==> ?f'. linear f' /\ (!x. f'(f x) = x) /\ (!x. f(f' x) = x)`,
5020   REPEAT STRIP_TAC THEN
5021   REWRITE_TAC[GSYM ISOMORPHISM_EXPAND] THEN
5022   MP_TAC(ISPEC `f:real^N->real^N` LINEAR_SURJECTIVE_RIGHT_INVERSE) THEN
5023   MP_TAC(ISPEC `f:real^N->real^N` LINEAR_INJECTIVE_LEFT_INVERSE) THEN
5024   MP_TAC(ISPEC `f:real^N->real^N` LINEAR_INJECTIVE_IMP_SURJECTIVE) THEN
5025   ASM_REWRITE_TAC[] THEN SIMP_TAC[] THEN MESON_TAC[LEFT_RIGHT_INVERSE_EQ]);;
5026
5027 let LINEAR_SURJECTIVE_ISOMORPHISM = prove
5028  (`!f:real^N->real^N.
5029         linear f /\ (!y. ?x. f x = y)
5030         ==> ?f'. linear f' /\ (!x. f'(f x) = x) /\ (!x. f(f' x) = x)`,
5031   REPEAT STRIP_TAC THEN
5032   REWRITE_TAC[GSYM ISOMORPHISM_EXPAND] THEN
5033   MP_TAC(ISPEC `f:real^N->real^N` LINEAR_SURJECTIVE_RIGHT_INVERSE) THEN
5034   MP_TAC(ISPEC `f:real^N->real^N` LINEAR_INJECTIVE_LEFT_INVERSE) THEN
5035   MP_TAC(ISPEC `f:real^N->real^N` LINEAR_SURJECTIVE_IMP_INJECTIVE) THEN
5036   ASM_REWRITE_TAC[] THEN SIMP_TAC[] THEN MESON_TAC[LEFT_RIGHT_INVERSE_EQ]);;
5037
5038 (* ------------------------------------------------------------------------- *)
5039 (* Left and right inverses are the same for R^N->R^N.                        *)
5040 (* ------------------------------------------------------------------------- *)
5041
5042 let LINEAR_INVERSE_LEFT = prove
5043  (`!f:real^N->real^N f'.
5044         linear f /\ linear f' ==> ((f o f' = I) <=> (f' o f = I))`,
5045   SUBGOAL_THEN
5046    `!f:real^N->real^N f'.
5047         linear f /\ linear f' /\ (f o f' = I) ==> (f' o f = I)`
5048    (fun th -> MESON_TAC[th]) THEN
5049   REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM] THEN REPEAT STRIP_TAC THEN
5050   MP_TAC(ISPEC `f:real^N->real^N` LINEAR_SURJECTIVE_ISOMORPHISM) THEN
5051   ASM_MESON_TAC[]);;
5052
5053 (* ------------------------------------------------------------------------- *)
5054 (* Moreover, a one-sided inverse is automatically linear.                    *)
5055 (* ------------------------------------------------------------------------- *)
5056
5057 let LEFT_INVERSE_LINEAR = prove
5058  (`!f g:real^N->real^N. linear f /\ (g o f = I) ==> linear g`,
5059   REPEAT GEN_TAC THEN REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM] THEN
5060   STRIP_TAC THEN SUBGOAL_THEN
5061    `?h:real^N->real^N. linear h /\ (!x. h(f x) = x) /\ (!x. f(h x) = x)`
5062   CHOOSE_TAC THENL
5063    [MATCH_MP_TAC LINEAR_INJECTIVE_ISOMORPHISM THEN ASM_MESON_TAC[];
5064     SUBGOAL_THEN `g:real^N->real^N = h` (fun th -> ASM_REWRITE_TAC[th]) THEN
5065     REWRITE_TAC[FUN_EQ_THM] THEN ASM_MESON_TAC[]]);;
5066
5067 let RIGHT_INVERSE_LINEAR = prove
5068  (`!f g:real^N->real^N. linear f /\ (f o g = I) ==> linear g`,
5069   REPEAT GEN_TAC THEN REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM] THEN
5070   STRIP_TAC THEN SUBGOAL_THEN
5071    `?h:real^N->real^N. linear h /\ (!x. h(f x) = x) /\ (!x. f(h x) = x)`
5072   CHOOSE_TAC THENL [ASM_MESON_TAC[LINEAR_SURJECTIVE_ISOMORPHISM]; ALL_TAC] THEN
5073   SUBGOAL_THEN `g:real^N->real^N = h` (fun th -> ASM_REWRITE_TAC[th]) THEN
5074   REWRITE_TAC[FUN_EQ_THM] THEN ASM_MESON_TAC[]);;
5075
5076 (* ------------------------------------------------------------------------- *)
5077 (* Without (ostensible) constraints on types, though dimensions must match.  *)
5078 (* ------------------------------------------------------------------------- *)
5079
5080 let LEFT_RIGHT_INVERSE_LINEAR = prove
5081  (`!f g:real^M->real^N.
5082         linear f /\ g o f = I /\ f o g = I ==> linear g`,
5083   REWRITE_TAC[linear; FUN_EQ_THM; o_THM; I_THM] THEN MESON_TAC[]);;
5084
5085 let LINEAR_BIJECTIVE_LEFT_RIGHT_INVERSE = prove
5086  (`!f:real^M->real^N.
5087         linear f /\ (!x y. f x = f y ==> x = y) /\ (!y. ?x. f x = y)
5088         ==> ?g. linear g /\ (!x. g(f x) = x) /\ (!y. f(g y) = y)`,
5089   GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN ASSUME_TAC) THEN
5090   FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [BIJECTIVE_LEFT_RIGHT_INVERSE]) THEN
5091   MATCH_MP_TAC MONO_EXISTS THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
5092   MATCH_MP_TAC LEFT_RIGHT_INVERSE_LINEAR THEN
5093   EXISTS_TAC `f:real^M->real^N` THEN
5094   ASM_REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM]);;
5095
5096 (* ------------------------------------------------------------------------- *)
5097 (* The same result in terms of square matrices.                              *)
5098 (* ------------------------------------------------------------------------- *)
5099
5100 let MATRIX_LEFT_RIGHT_INVERSE = prove
5101  (`!A:real^N^N A':real^N^N. (A ** A' = mat 1) <=> (A' ** A = mat 1)`,
5102   SUBGOAL_THEN
5103     `!A:real^N^N A':real^N^N. (A ** A' = mat 1) ==> (A' ** A = mat 1)`
5104     (fun th -> MESON_TAC[th]) THEN
5105   REPEAT STRIP_TAC THEN
5106   MP_TAC(ISPEC `\x:real^N. A:(real^N^N) ** x`
5107     LINEAR_SURJECTIVE_ISOMORPHISM) THEN
5108   REWRITE_TAC[MATRIX_VECTOR_MUL_LINEAR] THEN ANTS_TAC THENL
5109    [X_GEN_TAC `x:real^N` THEN EXISTS_TAC `(A':real^N^N) ** (x:real^N)` THEN
5110     ASM_REWRITE_TAC[MATRIX_VECTOR_MUL_ASSOC; MATRIX_VECTOR_MUL_LID];
5111     ALL_TAC] THEN
5112   DISCH_THEN(X_CHOOSE_THEN `f':real^N->real^N` STRIP_ASSUME_TAC) THEN
5113   SUBGOAL_THEN `matrix (f':real^N->real^N) ** (A:real^N^N) = mat 1`
5114   MP_TAC THENL
5115    [ASM_SIMP_TAC[MATRIX_EQ; MATRIX_WORKS; GSYM MATRIX_VECTOR_MUL_ASSOC;
5116                  MATRIX_VECTOR_MUL_LID];
5117     ALL_TAC] THEN
5118   DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN
5119   DISCH_THEN(MP_TAC o AP_TERM `(\m:real^N^N. m ** (A':real^N^N))`) THEN
5120   REWRITE_TAC[GSYM MATRIX_MUL_ASSOC] THEN
5121   ASM_REWRITE_TAC[MATRIX_MUL_RID; MATRIX_MUL_LID] THEN ASM_MESON_TAC[]);;
5122
5123 (* ------------------------------------------------------------------------- *)
5124 (* Invertibility of matrices and corresponding linear functions.             *)
5125 (* ------------------------------------------------------------------------- *)
5126
5127 let MATRIX_LEFT_INVERTIBLE = prove
5128  (`!f:real^M->real^N.
5129     linear f ==> ((?B:real^N^M. B ** matrix f = mat 1) <=>
5130                   (?g. linear g /\ g o f = I))`,
5131   GEN_TAC THEN DISCH_TAC THEN EQ_TAC THEN STRIP_TAC THENL
5132    [EXISTS_TAC `\y:real^N. (B:real^N^M) ** y` THEN
5133     REWRITE_TAC[MATRIX_VECTOR_MUL_LINEAR] THEN
5134     FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV)
5135                 [MATCH_MP MATRIX_VECTOR_MUL th]) THEN
5136     ASM_REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM; MATRIX_VECTOR_MUL_ASSOC;
5137                     MATRIX_VECTOR_MUL_LID];
5138     EXISTS_TAC `matrix(g:real^N->real^M)` THEN
5139     ASM_SIMP_TAC[GSYM MATRIX_COMPOSE; MATRIX_I]]);;
5140
5141 let MATRIX_RIGHT_INVERTIBLE = prove
5142  (`!f:real^M->real^N.
5143     linear f ==> ((?B:real^N^M. matrix f ** B = mat 1) <=>
5144                   (?g. linear g /\ f o g = I))`,
5145   GEN_TAC THEN DISCH_TAC THEN EQ_TAC THEN STRIP_TAC THENL
5146    [EXISTS_TAC `\y:real^N. (B:real^N^M) ** y` THEN
5147     REWRITE_TAC[MATRIX_VECTOR_MUL_LINEAR] THEN
5148     FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC (LAND_CONV o LAND_CONV)
5149                 [MATCH_MP MATRIX_VECTOR_MUL th]) THEN
5150     ASM_REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM; MATRIX_VECTOR_MUL_ASSOC;
5151                     MATRIX_VECTOR_MUL_LID];
5152     EXISTS_TAC `matrix(g:real^N->real^M)` THEN
5153     ASM_SIMP_TAC[GSYM MATRIX_COMPOSE; MATRIX_I]]);;
5154
5155 let INVERTIBLE_LEFT_INVERSE = prove
5156  (`!A:real^N^N. invertible(A) <=> ?B:real^N^N. B ** A = mat 1`,
5157   MESON_TAC[invertible; MATRIX_LEFT_RIGHT_INVERSE]);;
5158
5159 let INVERTIBLE_RIGHT_INVERSE = prove
5160  (`!A:real^N^N. invertible(A) <=> ?B:real^N^N. A ** B = mat 1`,
5161   MESON_TAC[invertible; MATRIX_LEFT_RIGHT_INVERSE]);;
5162
5163 let MATRIX_INVERTIBLE = prove
5164  (`!f:real^N->real^N.
5165         linear f
5166         ==> (invertible(matrix f) <=>
5167              ?g. linear g /\ f o g = I /\ g o f = I)`,
5168   SIMP_TAC[INVERTIBLE_LEFT_INVERSE; MATRIX_LEFT_INVERTIBLE] THEN
5169   MESON_TAC[LINEAR_INVERSE_LEFT]);;
5170
5171 (* ------------------------------------------------------------------------- *)
5172 (* Left-invertible linear transformation has a lower bound.                  *)
5173 (* ------------------------------------------------------------------------- *)
5174
5175 let LINEAR_INVERTIBLE_BOUNDED_BELOW_POS = prove
5176  (`!f:real^M->real^N g.
5177         linear f /\ linear g /\ (g o f = I)
5178         ==> ?B. &0 < B /\ !x. B * norm(x) <= norm(f x)`,
5179   REPEAT STRIP_TAC THEN
5180   MP_TAC(ISPEC `g:real^N->real^M` LINEAR_BOUNDED_POS) THEN
5181   ASM_REWRITE_TAC[] THEN
5182   DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN
5183   EXISTS_TAC `inv B:real` THEN ASM_REWRITE_TAC[REAL_LT_INV_EQ] THEN
5184   X_GEN_TAC `x:real^M` THEN MATCH_MP_TAC REAL_LE_TRANS THEN
5185   EXISTS_TAC `inv(B) * norm(((g:real^N->real^M) o (f:real^M->real^N)) x)` THEN
5186   CONJ_TAC THENL [ASM_SIMP_TAC[I_THM; REAL_LE_REFL]; ALL_TAC] THEN
5187   REWRITE_TAC[REAL_ARITH `inv B * x = x / B`] THEN
5188   ASM_SIMP_TAC[o_THM; REAL_LE_LDIV_EQ] THEN
5189   ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_REWRITE_TAC[]);;
5190
5191 let LINEAR_INVERTIBLE_BOUNDED_BELOW = prove
5192  (`!f:real^M->real^N g.
5193         linear f /\ linear g /\ (g o f = I)
5194         ==> ?B. !x. B * norm(x) <= norm(f x)`,
5195   MESON_TAC[LINEAR_INVERTIBLE_BOUNDED_BELOW_POS]);;
5196
5197 let LINEAR_INJECTIVE_BOUNDED_BELOW_POS = prove
5198  (`!f:real^M->real^N.
5199         linear f /\ (!x y. f x = f y ==> x = y)
5200         ==> ?B. &0 < B /\ !x. norm(x) * B <= norm(f x)`,
5201   REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
5202   MATCH_MP_TAC LINEAR_INVERTIBLE_BOUNDED_BELOW_POS THEN
5203   ASM_MESON_TAC[LINEAR_INJECTIVE_LEFT_INVERSE]);;
5204
5205 (* ------------------------------------------------------------------------- *)
5206 (* Preservation of dimension by injective map.                               *)
5207 (* ------------------------------------------------------------------------- *)
5208
5209 let DIM_INJECTIVE_LINEAR_IMAGE = prove
5210  (`!f:real^M->real^N s.
5211         linear f /\ (!x y. f x = f y ==> x = y) ==> dim(IMAGE f s) = dim s`,
5212   REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM LE_ANTISYM] THEN
5213   CONJ_TAC THENL [ASM_MESON_TAC[DIM_LINEAR_IMAGE_LE]; ALL_TAC] THEN
5214   MP_TAC(ISPEC `f:real^M->real^N` LINEAR_INJECTIVE_LEFT_INVERSE) THEN
5215   ASM_REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM] THEN
5216   DISCH_THEN(X_CHOOSE_THEN `g:real^N->real^M` STRIP_ASSUME_TAC) THEN
5217   MATCH_MP_TAC LE_TRANS THEN
5218   EXISTS_TAC `dim(IMAGE (g:real^N->real^M) (IMAGE (f:real^M->real^N) s))` THEN
5219   CONJ_TAC THENL
5220    [ASM_REWRITE_TAC[GSYM IMAGE_o; o_DEF; IMAGE_ID; LE_REFL];
5221     MATCH_MP_TAC DIM_LINEAR_IMAGE_LE THEN ASM_REWRITE_TAC[]]);;
5222
5223 (* ------------------------------------------------------------------------- *)
5224 (* Considering an n-element vector as an n-by-1 or 1-by-n matrix.            *)
5225 (* ------------------------------------------------------------------------- *)
5226
5227 let rowvector = new_definition
5228  `(rowvector:real^N->real^N^1) v = lambda i j. v$j`;;
5229
5230 let columnvector = new_definition
5231  `(columnvector:real^N->real^1^N) v = lambda i j. v$i`;;
5232
5233 let TRANSP_COLUMNVECTOR = prove
5234  (`!v. transp(columnvector v) = rowvector v`,
5235   SIMP_TAC[transp; columnvector; rowvector; CART_EQ; LAMBDA_BETA]);;
5236
5237 let TRANSP_ROWVECTOR = prove
5238  (`!v. transp(rowvector v) = columnvector v`,
5239   SIMP_TAC[transp; columnvector; rowvector; CART_EQ; LAMBDA_BETA]);;
5240
5241 let DOT_ROWVECTOR_COLUMNVECTOR = prove
5242  (`!A:real^N^M v:real^N. columnvector(A ** v) = A ** columnvector v`,
5243   REWRITE_TAC[rowvector; columnvector; matrix_mul; matrix_vector_mul] THEN
5244   SIMP_TAC[CART_EQ; LAMBDA_BETA]);;
5245
5246 let DOT_MATRIX_PRODUCT = prove
5247  (`!x y:real^N. x dot y = (rowvector x ** columnvector y)$1$1`,
5248   REWRITE_TAC[matrix_mul; columnvector; rowvector; dot] THEN
5249   SIMP_TAC[LAMBDA_BETA; DIMINDEX_1; LE_REFL]);;
5250
5251 let DOT_MATRIX_VECTOR_MUL = prove
5252  (`!A:real^N^N B:real^N^N x:real^N y:real^N.
5253       (A ** x) dot (B ** y) =
5254       ((rowvector x) ** (transp(A) ** B) ** (columnvector y))$1$1`,
5255   REWRITE_TAC[DOT_MATRIX_PRODUCT] THEN
5256   ONCE_REWRITE_TAC[GSYM TRANSP_COLUMNVECTOR] THEN
5257   REWRITE_TAC[DOT_ROWVECTOR_COLUMNVECTOR; MATRIX_TRANSP_MUL] THEN
5258   REWRITE_TAC[MATRIX_MUL_ASSOC]);;
5259
5260 (* ------------------------------------------------------------------------- *)
5261 (* Rank of a matrix. Equivalence of row and column rank is taken from        *)
5262 (* George Mackiw's paper, Mathematics Magazine 1995, p. 285.                 *)
5263 (* ------------------------------------------------------------------------- *)
5264
5265 let MATRIX_VECTOR_MUL_IN_COLUMNSPACE = prove
5266  (`!A:real^M^N x:real^M. (A ** x) IN span(columns A)`,
5267   REPEAT GEN_TAC THEN REWRITE_TAC[MATRIX_VECTOR_COLUMN; columns] THEN
5268   MATCH_MP_TAC SPAN_VSUM THEN
5269   SIMP_TAC[FINITE_NUMSEG; IN_NUMSEG; transp; LAMBDA_BETA] THEN
5270   X_GEN_TAC `k:num` THEN STRIP_TAC THEN MATCH_MP_TAC SPAN_MUL THEN
5271   MATCH_MP_TAC SPAN_SUPERSET THEN
5272   REWRITE_TAC[IN_ELIM_THM; column] THEN EXISTS_TAC `k:num` THEN
5273   ASM_REWRITE_TAC[]);;
5274
5275 let SUBSPACE_ORTHOGONAL_TO_VECTOR = prove
5276  (`!x. subspace {y | orthogonal x y}`,
5277   SIMP_TAC[subspace; IN_ELIM_THM; ORTHOGONAL_CLAUSES]);;
5278
5279 let SUBSPACE_ORTHOGONAL_TO_VECTORS = prove
5280  (`!s. subspace {y | (!x. x IN s ==> orthogonal x y)}`,
5281   SIMP_TAC[subspace; IN_ELIM_THM; ORTHOGONAL_CLAUSES]);;
5282
5283 let ORTHOGONAL_TO_SPAN = prove
5284  (`!s x. (!y. y IN s ==> orthogonal x y)
5285          ==> !y. y IN span(s) ==> orthogonal x y`,
5286   REPEAT GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC SPAN_INDUCT THEN
5287   REWRITE_TAC[SET_RULE `(\y. orthogonal x y) = {y | orthogonal x y}`] THEN
5288   ASM_SIMP_TAC[SUBSPACE_ORTHOGONAL_TO_VECTOR; IN_ELIM_THM]);;
5289
5290 let ORTHOGONAL_TO_SPAN_EQ = prove
5291  (`!s x. (!y. y IN span(s) ==> orthogonal x y) <=>
5292          (!y. y IN s ==> orthogonal x y)`,
5293   MESON_TAC[SPAN_SUPERSET; ORTHOGONAL_TO_SPAN]);;
5294
5295 let ORTHOGONAL_TO_SPANS_EQ = prove
5296  (`!s t. (!x y. x IN span(s) /\ y IN span(t) ==> orthogonal x y) <=>
5297          (!x y. x IN s /\ y IN t ==> orthogonal x y)`,
5298   MESON_TAC[ORTHOGONAL_TO_SPAN_EQ; ORTHOGONAL_SYM]);;
5299
5300 let ORTHOGONAL_NULLSPACE_ROWSPACE = prove
5301  (`!A:real^M^N x y:real^M.
5302         A ** x = vec 0 /\ y IN span(rows A) ==> orthogonal x y`,
5303   REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
5304   REPEAT GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC SPAN_INDUCT THEN
5305   REWRITE_TAC[SET_RULE `(\y. orthogonal x y) = {y | orthogonal x y}`] THEN
5306   REWRITE_TAC[SUBSPACE_ORTHOGONAL_TO_VECTOR; rows; FORALL_IN_GSPEC] THEN
5307   X_GEN_TAC `k:num` THEN STRIP_TAC THEN REWRITE_TAC[IN_ELIM_THM] THEN
5308   FIRST_X_ASSUM(MP_TAC o AP_TERM `\y:real^N. y$k`) THEN
5309   ASM_SIMP_TAC[MATRIX_VECTOR_MUL_COMPONENT; VEC_COMPONENT; row; dot;
5310                orthogonal; LAMBDA_BETA] THEN
5311   REWRITE_TAC[REAL_MUL_SYM]);;
5312
5313 let NULLSPACE_INTER_ROWSPACE = prove
5314  (`!A:real^M^N x:real^M. A ** x = vec 0 /\ x IN span(rows A) <=> x = vec 0`,
5315   REPEAT GEN_TAC THEN EQ_TAC THENL
5316    [MESON_TAC[ORTHOGONAL_NULLSPACE_ROWSPACE; ORTHOGONAL_REFL];
5317     SIMP_TAC[MATRIX_VECTOR_MUL_RZERO; SPAN_0]]);;
5318
5319 let MATRIX_VECTOR_MUL_INJECTIVE_ON_ROWSPACE = prove
5320  (`!A:real^M^N x y:real^M.
5321         x IN span(rows A) /\ y IN span(rows A) /\ A ** x = A ** y ==> x = y`,
5322   ONCE_REWRITE_TAC[GSYM VECTOR_SUB_EQ] THEN
5323   REWRITE_TAC[GSYM MATRIX_VECTOR_MUL_SUB_LDISTRIB] THEN
5324   REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM NULLSPACE_INTER_ROWSPACE] THEN
5325   ASM_SIMP_TAC[SPAN_SUB]);;
5326
5327 let DIM_ROWS_LE_DIM_COLUMNS = prove
5328  (`!A:real^M^N. dim(rows A) <= dim(columns A)`,
5329   REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM DIM_SPAN] THEN
5330   X_CHOOSE_THEN `b:real^M->bool` STRIP_ASSUME_TAC
5331    (ISPEC `span(rows(A:real^M^N))` BASIS_EXISTS) THEN
5332   SUBGOAL_THEN `FINITE(IMAGE (\x:real^M. (A:real^M^N) ** x) b) /\
5333                 CARD (IMAGE (\x:real^M. (A:real^M^N) ** x) b) <=
5334                 dim(span(columns A))`
5335   MP_TAC THENL
5336    [MATCH_MP_TAC INDEPENDENT_CARD_LE_DIM THEN
5337     REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; MATRIX_VECTOR_MUL_IN_COLUMNSPACE] THEN
5338     MATCH_MP_TAC INDEPENDENT_INJECTIVE_IMAGE_GEN THEN
5339     ASM_REWRITE_TAC[MATRIX_VECTOR_MUL_LINEAR] THEN
5340     SUBGOAL_THEN `span(b) = span(rows(A:real^M^N))` SUBST1_TAC THENL
5341      [ALL_TAC; ASM_MESON_TAC[MATRIX_VECTOR_MUL_INJECTIVE_ON_ROWSPACE]] THEN
5342     MATCH_MP_TAC SUBSET_ANTISYM THEN ASM_REWRITE_TAC[] THEN
5343     GEN_REWRITE_TAC RAND_CONV [GSYM SPAN_SPAN] THEN
5344     ASM_SIMP_TAC[SPAN_MONO];
5345     DISCH_THEN(MP_TAC o CONJUNCT2) THEN MATCH_MP_TAC EQ_IMP THEN
5346     AP_THM_TAC THEN AP_TERM_TAC THEN
5347     FIRST_ASSUM(CONJUNCTS_THEN2 ASSUME_TAC (SUBST1_TAC o SYM) o
5348       GEN_REWRITE_RULE I [HAS_SIZE]) THEN
5349     MATCH_MP_TAC CARD_IMAGE_INJ THEN ASM_REWRITE_TAC[] THEN
5350     REPEAT STRIP_TAC THEN MATCH_MP_TAC
5351      (ISPEC `A:real^M^N` MATRIX_VECTOR_MUL_INJECTIVE_ON_ROWSPACE) THEN
5352     ASM SET_TAC[]]);;
5353
5354 let rank = new_definition
5355  `rank(A:real^M^N) = dim(columns A)`;;
5356
5357 let RANK_ROW = prove
5358  (`!A:real^M^N. rank(A) = dim(rows A)`,
5359   GEN_TAC THEN REWRITE_TAC[rank] THEN
5360   MP_TAC(ISPEC `A:real^M^N` DIM_ROWS_LE_DIM_COLUMNS) THEN
5361   MP_TAC(ISPEC `transp(A:real^M^N)` DIM_ROWS_LE_DIM_COLUMNS) THEN
5362   REWRITE_TAC[ROWS_TRANSP; COLUMNS_TRANSP] THEN ARITH_TAC);;
5363
5364 let RANK_TRANSP = prove
5365  (`!A:real^M^N. rank(transp A) = rank A`,
5366   GEN_TAC THEN GEN_REWRITE_TAC RAND_CONV [RANK_ROW] THEN
5367   REWRITE_TAC[rank; COLUMNS_TRANSP]);;
5368
5369 let MATRIX_VECTOR_MUL_BASIS = prove
5370  (`!A:real^M^N k. 1 <= k /\ k <= dimindex(:M)
5371                  ==> A ** (basis k) = column k A`,
5372   SIMP_TAC[CART_EQ; column; MATRIX_VECTOR_MUL_COMPONENT; DOT_BASIS;
5373            LAMBDA_BETA]);;
5374
5375 let COLUMNS_IMAGE_BASIS = prove
5376  (`!A:real^M^N.
5377      columns A = IMAGE (\x. A ** x) {basis i | 1 <= i /\ i <= dimindex(:M)}`,
5378   GEN_TAC THEN REWRITE_TAC[columns] THEN
5379   ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN
5380   REWRITE_TAC[GSYM IMAGE_o; o_DEF] THEN
5381   MATCH_MP_TAC(SET_RULE
5382     `(!x. x IN s ==> f x = g x) ==> IMAGE f s = IMAGE g s`) THEN
5383   SIMP_TAC[IN_ELIM_THM; MATRIX_VECTOR_MUL_BASIS]);;
5384
5385 let RANK_DIM_IM = prove
5386  (`!A:real^M^N. rank A = dim(IMAGE (\x. A ** x) (:real^M))`,
5387   GEN_TAC THEN REWRITE_TAC[rank] THEN
5388   MATCH_MP_TAC SPAN_EQ_DIM THEN REWRITE_TAC[COLUMNS_IMAGE_BASIS] THEN
5389   SIMP_TAC[SPAN_LINEAR_IMAGE; MATRIX_VECTOR_MUL_LINEAR] THEN
5390   AP_TERM_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM SPAN_SPAN] THEN
5391   REWRITE_TAC[SPAN_STDBASIS]);;
5392
5393 let DIM_EQ_SPAN = prove
5394  (`!s t:real^N->bool. s SUBSET t /\ dim t <= dim s ==> span s = span t`,
5395   REPEAT STRIP_TAC THEN
5396   X_CHOOSE_THEN `b:real^N->bool` STRIP_ASSUME_TAC
5397    (ISPEC `span s:real^N->bool` BASIS_EXISTS) THEN
5398   MP_TAC(ISPECL [`span t:real^N->bool`; `b:real^N->bool`]
5399     CARD_GE_DIM_INDEPENDENT) THEN
5400   RULE_ASSUM_TAC(REWRITE_RULE[HAS_SIZE]) THEN
5401   ASM_REWRITE_TAC[DIM_SPAN] THEN
5402   ASM_MESON_TAC[SPAN_MONO; SPAN_SPAN; SUBSET_TRANS; SUBSET_ANTISYM]);;
5403
5404 let DIM_EQ_FULL = prove
5405  (`!s:real^N->bool. dim s = dimindex(:N) <=> span s = (:real^N)`,
5406   GEN_TAC THEN ONCE_REWRITE_TAC[GSYM DIM_SPAN] THEN EQ_TAC THEN
5407   SIMP_TAC[DIM_UNIV] THEN DISCH_TAC THEN
5408   GEN_REWRITE_TAC RAND_CONV [GSYM SPAN_UNIV] THEN MATCH_MP_TAC DIM_EQ_SPAN THEN
5409   ASM_REWRITE_TAC[SUBSET_UNIV; DIM_UNIV] THEN
5410   ASM_MESON_TAC[LE_REFL; DIM_SPAN]);;
5411
5412 let DIM_PSUBSET = prove
5413  (`!s t. (span s) PSUBSET (span t) ==> dim s < dim t`,
5414   ONCE_REWRITE_TAC[GSYM DIM_SPAN] THEN
5415   SIMP_TAC[PSUBSET; DIM_SUBSET; LT_LE] THEN
5416   MESON_TAC[EQ_IMP_LE; DIM_EQ_SPAN; SPAN_SPAN]);;
5417
5418 let RANK_BOUND = prove
5419  (`!A:real^M^N. rank(A) <= MIN (dimindex(:M)) (dimindex(:N))`,
5420   GEN_TAC THEN REWRITE_TAC[ARITH_RULE `x <= MIN a b <=> x <= a /\ x <= b`] THEN
5421   CONJ_TAC THENL
5422    [REWRITE_TAC[DIM_SUBSET_UNIV; RANK_ROW];
5423     REWRITE_TAC[DIM_SUBSET_UNIV; rank]]);;
5424
5425 let FULL_RANK_INJECTIVE = prove
5426  (`!A:real^M^N.
5427         rank A = dimindex(:M) <=>
5428         (!x y:real^M. A ** x = A ** y ==> x = y)`,
5429   REWRITE_TAC[GSYM MATRIX_LEFT_INVERTIBLE_INJECTIVE] THEN
5430   REWRITE_TAC[MATRIX_LEFT_INVERTIBLE_SPAN_ROWS] THEN
5431   REWRITE_TAC[RANK_ROW; DIM_EQ_FULL]);;
5432
5433 let FULL_RANK_SURJECTIVE = prove
5434  (`!A:real^M^N.
5435         rank A = dimindex(:N) <=> (!y:real^N. ?x:real^M. A ** x = y)`,
5436   REWRITE_TAC[GSYM MATRIX_RIGHT_INVERTIBLE_SURJECTIVE] THEN
5437   REWRITE_TAC[GSYM LEFT_INVERTIBLE_TRANSP] THEN
5438   REWRITE_TAC[MATRIX_LEFT_INVERTIBLE_INJECTIVE] THEN
5439   REWRITE_TAC[GSYM FULL_RANK_INJECTIVE; RANK_TRANSP]);;
5440
5441 let MATRIX_FULL_LINEAR_EQUATIONS = prove
5442  (`!A:real^M^N b:real^N.
5443         rank A = dimindex(:N) ==> ?x. A ** x = b`,
5444   SIMP_TAC[FULL_RANK_SURJECTIVE]);;
5445
5446 let MATRIX_NONFULL_LINEAR_EQUATIONS_EQ = prove
5447  (`!A:real^M^N.
5448         (?x. ~(x = vec 0) /\ A ** x = vec 0) <=> ~(rank A = dimindex(:M))`,
5449   REPEAT GEN_TAC THEN REWRITE_TAC[FULL_RANK_INJECTIVE] THEN
5450   SIMP_TAC[LINEAR_INJECTIVE_0; MATRIX_VECTOR_MUL_LINEAR] THEN
5451   MESON_TAC[]);;
5452
5453 let MATRIX_NONFULL_LINEAR_EQUATIONS = prove
5454  (`!A:real^M^N.
5455         ~(rank A = dimindex(:M)) ==> ?x. ~(x = vec 0) /\ A ** x = vec 0`,
5456   REWRITE_TAC[MATRIX_NONFULL_LINEAR_EQUATIONS_EQ]);;
5457
5458 let MATRIX_TRIVIAL_LINEAR_EQUATIONS = prove
5459  (`!A:real^M^N.
5460         dimindex(:N) < dimindex(:M)
5461         ==> ?x. ~(x = vec 0) /\ A ** x = vec 0`,
5462   REPEAT STRIP_TAC THEN MATCH_MP_TAC MATRIX_NONFULL_LINEAR_EQUATIONS THEN
5463   MATCH_MP_TAC(ARITH_RULE
5464    `!a. x <= MIN b a /\ a < b ==> ~(x = b)`) THEN
5465   EXISTS_TAC `dimindex(:N)` THEN ASM_REWRITE_TAC[RANK_BOUND]);;
5466
5467 let RANK_EQ_0 = prove
5468  (`!A:real^M^N. rank A = 0 <=> A = mat 0`,
5469   REWRITE_TAC[RANK_DIM_IM; DIM_EQ_0; SUBSET; FORALL_IN_IMAGE; IN_SING;
5470               IN_UNIV] THEN
5471   GEN_TAC THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [CART_EQ] THEN
5472   SIMP_TAC[CART_EQ; MATRIX_MUL_DOT; VEC_COMPONENT; LAMBDA_BETA; mat] THEN
5473   ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN
5474   REWRITE_TAC[RIGHT_FORALL_IMP_THM; FORALL_DOT_EQ_0; COND_ID] THEN
5475   REWRITE_TAC[CART_EQ; VEC_COMPONENT]);;
5476
5477 let RANK_0 = prove
5478  (`rank(mat 0) = 0`,
5479   REWRITE_TAC[RANK_EQ_0]);;
5480
5481 let RANK_MUL_LE_RIGHT = prove
5482  (`!A:real^N^M B:real^P^N. rank(A ** B) <= rank(B)`,
5483   REPEAT GEN_TAC THEN MATCH_MP_TAC LE_TRANS THEN
5484   EXISTS_TAC `dim(IMAGE (\y. (A:real^N^M) ** y)
5485                         (IMAGE (\x. (B:real^P^N) ** x) (:real^P)))` THEN
5486   REWRITE_TAC[RANK_DIM_IM] THEN CONJ_TAC THENL
5487    [REWRITE_TAC[GSYM IMAGE_o; o_DEF; MATRIX_VECTOR_MUL_ASSOC; LE_REFL];
5488     MATCH_MP_TAC DIM_LINEAR_IMAGE_LE THEN
5489     REWRITE_TAC[MATRIX_VECTOR_MUL_LINEAR]]);;
5490
5491 let RANK_MUL_LE_LEFT = prove
5492  (`!A:real^N^M B:real^P^N. rank(A ** B) <= rank(A)`,
5493   ONCE_REWRITE_TAC[GSYM RANK_TRANSP] THEN
5494   REWRITE_TAC[MATRIX_TRANSP_MUL] THEN
5495   REWRITE_TAC[RANK_MUL_LE_RIGHT]);;
5496
5497 (* ------------------------------------------------------------------------- *)
5498 (* A non-injective linear function maps into a hyperplane.                   *)
5499 (* ------------------------------------------------------------------------- *)
5500
5501 let ADJOINT_INJECTIVE = prove
5502  (`!f:real^M->real^N.
5503         linear f
5504         ==> ((!x y. adjoint f x = adjoint f y ==> x = y) <=>
5505              (!y. ?x. f x = y))`,
5506   REPEAT STRIP_TAC THEN
5507   FIRST_ASSUM(ASSUME_TAC o GSYM o MATCH_MP MATRIX_WORKS o MATCH_MP
5508    ADJOINT_LINEAR) THEN
5509   FIRST_ASSUM(ASSUME_TAC o GSYM o MATCH_MP MATRIX_WORKS) THEN
5510   ASM_REWRITE_TAC[GSYM FULL_RANK_INJECTIVE; GSYM FULL_RANK_SURJECTIVE] THEN
5511   ASM_SIMP_TAC[MATRIX_ADJOINT; RANK_TRANSP]);;
5512
5513 let ADJOINT_SURJECTIVE = prove
5514  (`!f:real^M->real^N.
5515         linear f
5516         ==> ((!y. ?x. adjoint f x = y) <=> (!x y. f x = f y ==> x = y))`,
5517   REPEAT STRIP_TAC THEN
5518   FIRST_ASSUM(fun th -> GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV)
5519    [GSYM(MATCH_MP ADJOINT_ADJOINT th)]) THEN
5520   ASM_SIMP_TAC[ADJOINT_INJECTIVE; ADJOINT_LINEAR]);;
5521
5522 let ADJOINT_INJECTIVE_INJECTIVE = prove
5523  (`!f:real^N->real^N.
5524         linear f
5525         ==> ((!x y. adjoint f x = adjoint f y ==> x = y) <=>
5526              (!x y. f x = f y ==> x = y))`,
5527   SIMP_TAC[ADJOINT_INJECTIVE] THEN
5528   MESON_TAC[LINEAR_INJECTIVE_IMP_SURJECTIVE;
5529             LINEAR_SURJECTIVE_IMP_INJECTIVE]);;
5530
5531 let ADJOINT_INJECTIVE_INJECTIVE_0 = prove
5532  (`!f:real^N->real^N.
5533         linear f
5534         ==> ((!x. adjoint f x = vec 0 ==> x = vec 0) <=>
5535              (!x. f x = vec 0 ==> x = vec 0))`,
5536   REPEAT STRIP_TAC THEN
5537   FIRST_ASSUM(MP_TAC o MATCH_MP ADJOINT_INJECTIVE_INJECTIVE) THEN
5538   FIRST_ASSUM(ASSUME_TAC o MATCH_MP ADJOINT_LINEAR) THEN
5539   ASM_MESON_TAC[LINEAR_INJECTIVE_0]);;
5540
5541 let LINEAR_SINGULAR_INTO_HYPERPLANE = prove
5542  (`!f:real^N->real^N.
5543         linear f
5544         ==> (~(!x y. f(x) = f(y) ==> x = y) <=>
5545              ?a. ~(a = vec 0) /\ !x. a dot f(x) = &0)`,
5546   REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[DOT_SYM] THEN
5547   ASM_SIMP_TAC[ADJOINT_WORKS; FORALL_DOT_EQ_0] THEN
5548   REWRITE_TAC[MESON[] `(?a. ~p a /\ q a) <=> ~(!a. q a ==> p a)`] THEN
5549   ASM_SIMP_TAC[ADJOINT_INJECTIVE_INJECTIVE_0; LINEAR_INJECTIVE_0]);;
5550
5551 let LINEAR_SINGULAR_IMAGE_HYPERPLANE = prove
5552  (`!f:real^N->real^N.
5553         linear f /\ ~(!x y. f(x) = f(y) ==> x = y)
5554         ==> ?a. ~(a = vec 0) /\ !s. IMAGE f s SUBSET {x | a dot x = &0}`,
5555   GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
5556   ASM_SIMP_TAC[LINEAR_SINGULAR_INTO_HYPERPLANE] THEN
5557   SIMP_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_THM] THEN MESON_TAC[]);;
5558
5559 let LOWDIM_EXPAND_DIMENSION = prove
5560  (`!s:real^N->bool n.
5561         dim s <= n /\ n <= dimindex(:N)
5562         ==> ?t. dim(t) = n /\ span s SUBSET span t`,
5563   GEN_TAC THEN
5564   GEN_REWRITE_TAC (BINDER_CONV o LAND_CONV o LAND_CONV) [LE_EXISTS] THEN
5565   SIMP_TAC[LEFT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM; IMP_CONJ] THEN
5566   ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN
5567   REWRITE_TAC[RIGHT_FORALL_IMP_THM; LEFT_FORALL_IMP_THM; EXISTS_REFL] THEN
5568   INDUCT_TAC THENL [MESON_TAC[ADD_CLAUSES; SUBSET_REFL]; ALL_TAC] THEN
5569   REWRITE_TAC[ARITH_RULE `s + SUC d <= n <=> s + d < n`] THEN
5570   DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o check (is_imp o concl)) THEN
5571   ASM_SIMP_TAC[LT_IMP_LE; LEFT_IMP_EXISTS_THM] THEN
5572   X_GEN_TAC `t:real^N->bool` THEN STRIP_TAC THEN
5573   REWRITE_TAC[ADD_CLAUSES] THEN FIRST_X_ASSUM(SUBST_ALL_TAC o SYM) THEN
5574   SUBGOAL_THEN `~(span t = (:real^N))` MP_TAC THENL
5575    [REWRITE_TAC[GSYM DIM_EQ_FULL] THEN ASM_ARITH_TAC; ALL_TAC] THEN
5576   REWRITE_TAC[EXTENSION; IN_UNIV; NOT_FORALL_THM; LEFT_IMP_EXISTS_THM] THEN
5577   X_GEN_TAC `a:real^N` THEN DISCH_TAC THEN
5578   EXISTS_TAC `(a:real^N) INSERT t` THEN ASM_REWRITE_TAC[DIM_INSERT; ADD1] THEN
5579   MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `span(t:real^N->bool)` THEN
5580   ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SPAN_MONO THEN SET_TAC[]);;
5581
5582 let LOWDIM_EXPAND_BASIS = prove
5583  (`!s:real^N->bool n.
5584         dim s <= n /\ n <= dimindex(:N)
5585         ==> ?b. b HAS_SIZE n /\ independent b /\ span s SUBSET span b`,
5586   REPEAT GEN_TAC THEN DISCH_TAC THEN
5587   FIRST_ASSUM(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC o
5588     MATCH_MP LOWDIM_EXPAND_DIMENSION) THEN
5589   MP_TAC(ISPEC `t:real^N->bool` BASIS_EXISTS) THEN
5590   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `b:real^N->bool` THEN
5591   ASM_REWRITE_TAC[] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
5592   ASM_MESON_TAC[SPAN_SPAN; SUBSET_TRANS; SPAN_MONO]);;
5593
5594 (* ------------------------------------------------------------------------- *)
5595 (* Orthogonal bases, Gram-Schmidt process, and related theorems.             *)
5596 (* ------------------------------------------------------------------------- *)
5597
5598 let SPAN_DELETE_0 = prove
5599  (`!s:real^N->bool. span(s DELETE vec 0) = span s`,
5600   GEN_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN
5601   SIMP_TAC[DELETE_SUBSET; SPAN_MONO] THEN
5602   MATCH_MP_TAC SUBSET_TRANS THEN
5603   EXISTS_TAC `span((vec 0:real^N) INSERT (s DELETE vec 0))` THEN CONJ_TAC THENL
5604    [MATCH_MP_TAC SPAN_MONO THEN SET_TAC[];
5605     SIMP_TAC[SUBSET; SPAN_BREAKDOWN_EQ; VECTOR_MUL_RZERO; VECTOR_SUB_RZERO]]);;
5606
5607 let SPAN_IMAGE_SCALE = prove
5608  (`!c s. FINITE s /\ (!x. x IN s ==> ~(c x = &0))
5609          ==> span (IMAGE (\x:real^N. c(x) % x) s) = span s`,
5610   GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN
5611   MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
5612   SIMP_TAC[IMAGE_CLAUSES; SPAN_BREAKDOWN_EQ; EXTENSION; FORALL_IN_INSERT] THEN
5613   MAP_EVERY X_GEN_TAC [`x:real^N`; `t:real^N->bool`] THEN
5614   STRIP_TAC THEN STRIP_TAC THEN X_GEN_TAC `y:real^N` THEN
5615   REWRITE_TAC[VECTOR_MUL_ASSOC] THEN EQ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN
5616   DISCH_THEN(X_CHOOSE_TAC `k:real`) THEN
5617   EXISTS_TAC `k / (c:real^N->real) x` THEN
5618   ASM_SIMP_TAC[REAL_DIV_RMUL]);;
5619
5620 let PAIRWISE_ORTHOGONAL_INDEPENDENT = prove
5621  (`!s:real^N->bool.
5622         pairwise orthogonal s /\ ~(vec 0 IN s) ==> independent s`,
5623   REWRITE_TAC[pairwise; orthogonal] THEN REPEAT STRIP_TAC THEN
5624   REWRITE_TAC[independent; dependent] THEN
5625   DISCH_THEN(X_CHOOSE_THEN `a:real^N` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
5626   REWRITE_TAC[SPAN_EXPLICIT; IN_ELIM_THM; NOT_EXISTS_THM] THEN
5627   MAP_EVERY X_GEN_TAC [`t:real^N->bool`; `u:real^N->real`] THEN
5628   REWRITE_TAC[SUBSET; IN_DELETE] THEN STRIP_TAC THEN
5629   FIRST_X_ASSUM(MP_TAC o AP_TERM `\x:real^N. a dot x`) THEN
5630   ASM_SIMP_TAC[DOT_RSUM; DOT_RMUL; REAL_MUL_RZERO; SUM_0] THEN
5631   ASM_MESON_TAC[DOT_EQ_0]);;
5632
5633 let PAIRWISE_ORTHOGONAL_IMP_FINITE = prove
5634  (`!s:real^N->bool. pairwise orthogonal s ==> FINITE s`,
5635   REPEAT STRIP_TAC THEN
5636   SUBGOAL_THEN `independent (s DELETE (vec 0:real^N))` MP_TAC THENL
5637    [MATCH_MP_TAC PAIRWISE_ORTHOGONAL_INDEPENDENT THEN
5638     REWRITE_TAC[IN_DELETE] THEN MATCH_MP_TAC PAIRWISE_MONO THEN
5639     EXISTS_TAC `s:real^N->bool` THEN
5640     ASM_SIMP_TAC[SUBSET; IN_DELETE];
5641     DISCH_THEN(MP_TAC o MATCH_MP INDEPENDENT_IMP_FINITE) THEN
5642     REWRITE_TAC[FINITE_DELETE]]);;
5643
5644 let GRAM_SCHMIDT_STEP = prove
5645  (`!s a x.
5646         pairwise orthogonal s /\ x IN span s
5647         ==> orthogonal x (a - vsum s (\b:real^N. (b dot a) / (b dot b) % b))`,
5648   REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
5649   REWRITE_TAC[ONCE_REWRITE_RULE[ORTHOGONAL_SYM] ORTHOGONAL_TO_SPAN_EQ] THEN
5650   X_GEN_TAC `s:real^N->bool` THEN STRIP_TAC THEN
5651   MAP_EVERY X_GEN_TAC [`a:real^N`; `x:real^N`] THEN DISCH_TAC THEN
5652   FIRST_ASSUM(ASSUME_TAC o MATCH_MP PAIRWISE_ORTHOGONAL_IMP_FINITE) THEN
5653   REWRITE_TAC[orthogonal; DOT_RSUB] THEN ASM_SIMP_TAC[DOT_RSUM] THEN
5654   REWRITE_TAC[REAL_SUB_0; DOT_RMUL] THEN MATCH_MP_TAC EQ_TRANS THEN
5655   EXISTS_TAC `sum s (\y:real^N. if y = x then y dot a else &0)` THEN
5656   CONJ_TAC THENL [ASM_SIMP_TAC[SUM_DELTA; DOT_SYM]; ALL_TAC] THEN
5657   MATCH_MP_TAC SUM_EQ THEN X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN
5658   RULE_ASSUM_TAC(REWRITE_RULE[pairwise; orthogonal]) THEN
5659   ASM_CASES_TAC `x:real^N = y` THEN ASM_SIMP_TAC[DOT_LMUL; REAL_MUL_RZERO] THEN
5660   ASM_CASES_TAC `y:real^N = vec 0` THEN
5661   ASM_SIMP_TAC[REAL_DIV_RMUL; DOT_EQ_0; DOT_LZERO; REAL_MUL_RZERO]);;
5662
5663 let ORTHOGONAL_EXTENSION = prove
5664  (`!t s:real^N->bool.
5665         FINITE t /\ FINITE s /\ pairwise orthogonal s
5666         ==> ?u. pairwise orthogonal (s UNION u) /\
5667                 span (s UNION u) = span (s UNION t)`,
5668   REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
5669   MATCH_MP_TAC FINITE_INDUCT_STRONG THEN CONJ_TAC THENL
5670    [REPEAT STRIP_TAC THEN EXISTS_TAC `{}:real^N->bool` THEN
5671     ASM_REWRITE_TAC[UNION_EMPTY];
5672     ALL_TAC] THEN
5673   MAP_EVERY X_GEN_TAC [`a:real^N`; `t:real^N->bool`] THEN
5674   REWRITE_TAC[pairwise; orthogonal] THEN REPEAT STRIP_TAC THEN
5675   ABBREV_TAC `a' = a - vsum s (\b:real^N. (b dot a) / (b dot b) % b)` THEN
5676   FIRST_X_ASSUM(MP_TAC o SPEC `(a':real^N) INSERT s`) THEN
5677   ASM_REWRITE_TAC[FINITE_INSERT] THEN ANTS_TAC THENL
5678    [SUBGOAL_THEN `!x:real^N. x IN s ==> a' dot x = &0`
5679      (fun th -> REWRITE_TAC[IN_INSERT] THEN ASM_MESON_TAC[DOT_SYM; th]) THEN
5680     REPEAT STRIP_TAC THEN EXPAND_TAC "a'" THEN
5681     REWRITE_TAC[GSYM orthogonal] THEN ONCE_REWRITE_TAC[ORTHOGONAL_SYM] THEN
5682     MATCH_MP_TAC GRAM_SCHMIDT_STEP THEN
5683     ASM_SIMP_TAC[pairwise; orthogonal; SPAN_CLAUSES];
5684     DISCH_THEN(X_CHOOSE_THEN `u:real^N->bool` STRIP_ASSUME_TAC) THEN
5685     EXISTS_TAC `(a':real^N) INSERT u` THEN
5686     ASM_REWRITE_TAC[SET_RULE `s UNION a INSERT u = a INSERT s UNION u`] THEN
5687     REWRITE_TAC[SET_RULE `(x INSERT s) UNION t = x INSERT (s UNION t)`] THEN
5688     MATCH_MP_TAC EQ_SPAN_INSERT_EQ THEN EXPAND_TAC "a'" THEN
5689     REWRITE_TAC[VECTOR_ARITH `a - x - a:real^N = --x`] THEN
5690     MATCH_MP_TAC SPAN_NEG THEN MATCH_MP_TAC SPAN_VSUM THEN
5691     ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN
5692     MATCH_MP_TAC SPAN_MUL THEN ASM_SIMP_TAC[SPAN_SUPERSET; IN_UNION]]);;
5693
5694 let VECTOR_IN_ORTHOGONAL_SPANNINGSET = prove
5695  (`!a. ?s. a IN s /\ pairwise orthogonal s /\ span s = (:real^N)`,
5696   GEN_TAC THEN
5697   MP_TAC(ISPECL [`(IMAGE basis (1..dimindex(:N))):real^N->bool`;
5698                  `{a:real^N}`] ORTHOGONAL_EXTENSION) THEN
5699   SIMP_TAC[FINITE_SING; PAIRWISE_SING; FINITE_IMAGE; FINITE_NUMSEG] THEN
5700   DISCH_THEN(X_CHOOSE_THEN `u:real^N->bool` STRIP_ASSUME_TAC) THEN
5701   EXISTS_TAC `{a:real^N} UNION u` THEN ASM_REWRITE_TAC[IN_UNION; IN_SING] THEN
5702   MATCH_MP_TAC(SET_RULE `!s. s = UNIV /\ s SUBSET t ==> t = UNIV`) THEN
5703   EXISTS_TAC `span {basis i:real^N | 1 <= i /\ i <= dimindex (:N)}` THEN
5704   CONJ_TAC THENL [REWRITE_TAC[SPAN_STDBASIS]; MATCH_MP_TAC SPAN_MONO] THEN
5705   REWRITE_TAC[SUBSET; FORALL_IN_GSPEC; GSYM IN_NUMSEG] THEN SET_TAC[]);;
5706
5707 let VECTOR_IN_ORTHOGONAL_BASIS = prove
5708  (`!a. ~(a = vec 0)
5709        ==> ?s. a IN s /\ ~(vec 0 IN s) /\
5710                pairwise orthogonal s /\
5711                independent s /\
5712                s HAS_SIZE (dimindex(:N)) /\
5713                span s = (:real^N)`,
5714   REPEAT STRIP_TAC THEN
5715   MP_TAC(ISPEC `a:real^N` VECTOR_IN_ORTHOGONAL_SPANNINGSET) THEN
5716   DISCH_THEN(X_CHOOSE_THEN `s:real^N->bool` STRIP_ASSUME_TAC) THEN
5717   EXISTS_TAC `s DELETE (vec 0:real^N)` THEN ASM_REWRITE_TAC[IN_DELETE] THEN
5718   MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL
5719    [RULE_ASSUM_TAC(REWRITE_RULE[pairwise]) THEN
5720     ASM_SIMP_TAC[pairwise; IN_DELETE];
5721     DISCH_TAC] THEN
5722   MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL
5723    [MATCH_MP_TAC PAIRWISE_ORTHOGONAL_INDEPENDENT THEN ASM_SIMP_TAC[IN_DELETE];
5724     DISCH_TAC] THEN
5725   MATCH_MP_TAC(TAUT `b /\ (b ==> a) ==> a /\ b`) THEN CONJ_TAC THENL
5726    [ASM_MESON_TAC[SPAN_DELETE_0];
5727     DISCH_TAC THEN ASM_SIMP_TAC[BASIS_HAS_SIZE_UNIV]]);;
5728
5729 let VECTOR_IN_ORTHONORMAL_BASIS = prove
5730  (`!a. norm a = &1
5731        ==> ?s. a IN s /\
5732                pairwise orthogonal s /\
5733                (!x. x IN s ==> norm x = &1) /\
5734                independent s /\
5735                s HAS_SIZE (dimindex(:N)) /\
5736                span s = (:real^N)`,
5737   GEN_TAC THEN ASM_CASES_TAC `a:real^N = vec 0` THEN
5738   ASM_REWRITE_TAC[NORM_0; REAL_OF_NUM_EQ; ARITH_EQ] THEN DISCH_TAC THEN
5739   FIRST_ASSUM(MP_TAC o MATCH_MP VECTOR_IN_ORTHOGONAL_BASIS) THEN
5740   DISCH_THEN(X_CHOOSE_THEN `s:real^N->bool` STRIP_ASSUME_TAC) THEN
5741   EXISTS_TAC `IMAGE (\x:real^N. inv(norm x) % x) s` THEN
5742   CONJ_TAC THENL
5743    [REWRITE_TAC[IN_IMAGE] THEN EXISTS_TAC `a:real^N` THEN
5744     ASM_REWRITE_TAC[REAL_INV_1; VECTOR_MUL_LID];
5745     ALL_TAC] THEN
5746   MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL
5747    [REWRITE_TAC[pairwise; IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN
5748     RULE_ASSUM_TAC(REWRITE_RULE[pairwise]) THEN
5749     ASM_MESON_TAC[ORTHOGONAL_CLAUSES];
5750     DISCH_TAC] THEN
5751   MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL
5752    [REWRITE_TAC[FORALL_IN_IMAGE; NORM_MUL; REAL_ABS_INV; REAL_ABS_NORM] THEN
5753     ASM_MESON_TAC[REAL_MUL_LINV; NORM_EQ_0];
5754     DISCH_TAC] THEN
5755   MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL
5756    [MATCH_MP_TAC PAIRWISE_ORTHOGONAL_INDEPENDENT THEN ASM_REWRITE_TAC[] THEN
5757     REWRITE_TAC[IN_IMAGE] THEN ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN
5758     SIMP_TAC[VECTOR_MUL_EQ_0; REAL_INV_EQ_0; NORM_EQ_0] THEN ASM_MESON_TAC[];
5759     DISCH_TAC] THEN
5760   MATCH_MP_TAC(TAUT `b /\ (b ==> a) ==> a /\ b`) THEN CONJ_TAC THENL
5761    [ALL_TAC; ASM_SIMP_TAC[BASIS_HAS_SIZE_UNIV]] THEN
5762   UNDISCH_THEN `span s = (:real^N)` (SUBST1_TAC o SYM) THEN
5763   MATCH_MP_TAC SPAN_IMAGE_SCALE THEN
5764   REWRITE_TAC[REAL_INV_EQ_0; NORM_EQ_0] THEN
5765   ASM_MESON_TAC[HAS_SIZE]);;
5766
5767 (* ------------------------------------------------------------------------- *)
5768 (* Analogous theorems for existence of orthonormal basis for a subspace.     *)
5769 (* ------------------------------------------------------------------------- *)
5770
5771 let ORTHOGONAL_SPANNINGSET_SUBSPACE = prove
5772  (`!s:real^N->bool.
5773         subspace s
5774         ==> ?b. b SUBSET s /\ pairwise orthogonal b /\ span b = s`,
5775   REPEAT STRIP_TAC THEN MP_TAC(ISPEC `s:real^N->bool` BASIS_EXISTS) THEN
5776   DISCH_THEN(X_CHOOSE_THEN `b:real^N->bool` STRIP_ASSUME_TAC) THEN
5777   MP_TAC(ISPECL[`b:real^N->bool`; `{}:real^N->bool`] ORTHOGONAL_EXTENSION) THEN
5778   RULE_ASSUM_TAC(REWRITE_RULE[HAS_SIZE]) THEN
5779   ASM_REWRITE_TAC[FINITE_EMPTY; PAIRWISE_EMPTY; UNION_EMPTY] THEN
5780   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c:real^N->bool` THEN
5781   STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
5782   MATCH_MP_TAC(TAUT `b /\ (b ==> a) ==> a /\ b`) THEN CONJ_TAC THENL
5783    [MATCH_MP_TAC SPAN_SUBSPACE THEN ASM_REWRITE_TAC[];
5784     DISCH_THEN(SUBST1_TAC o SYM) THEN ASM_MESON_TAC[SPAN_INC]]);;
5785
5786 let ORTHOGONAL_BASIS_SUBSPACE = prove
5787  (`!s:real^N->bool.
5788         subspace s
5789         ==> ?b. ~(vec 0 IN b) /\
5790                 b SUBSET s /\
5791                 pairwise orthogonal b /\
5792                 independent b /\
5793                 b HAS_SIZE (dim s) /\
5794                 span b = s`,
5795   REPEAT STRIP_TAC THEN
5796   FIRST_ASSUM(MP_TAC o MATCH_MP ORTHOGONAL_SPANNINGSET_SUBSPACE) THEN
5797   DISCH_THEN(X_CHOOSE_THEN `b:real^N->bool` STRIP_ASSUME_TAC) THEN
5798   EXISTS_TAC `b DELETE (vec 0:real^N)` THEN ASM_REWRITE_TAC[IN_DELETE] THEN
5799   CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
5800   MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL
5801    [RULE_ASSUM_TAC(REWRITE_RULE[pairwise]) THEN
5802     ASM_SIMP_TAC[pairwise; IN_DELETE];
5803     DISCH_TAC] THEN
5804   MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL
5805    [MATCH_MP_TAC PAIRWISE_ORTHOGONAL_INDEPENDENT THEN ASM_SIMP_TAC[IN_DELETE];
5806     DISCH_TAC] THEN
5807   MATCH_MP_TAC(TAUT `b /\ (b ==> a) ==> a /\ b`) THEN CONJ_TAC THENL
5808    [ASM_MESON_TAC[SPAN_DELETE_0];
5809     DISCH_TAC THEN ASM_SIMP_TAC[BASIS_HAS_SIZE_DIM]]);;
5810
5811 let ORTHONORMAL_BASIS_SUBSPACE = prove
5812  (`!s:real^N->bool.
5813         subspace s
5814         ==> ?b. b SUBSET span s /\
5815                 pairwise orthogonal b /\
5816                 (!x. x IN b ==> norm x = &1) /\
5817                 independent b /\
5818                 b HAS_SIZE (dim s) /\
5819                 span b = s`,
5820   REPEAT STRIP_TAC THEN
5821   FIRST_ASSUM(MP_TAC o MATCH_MP ORTHOGONAL_BASIS_SUBSPACE) THEN
5822   DISCH_THEN(X_CHOOSE_THEN `b:real^N->bool` STRIP_ASSUME_TAC) THEN
5823   EXISTS_TAC `IMAGE (\x:real^N. inv(norm x) % x) b` THEN
5824   CONJ_TAC THENL
5825    [REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN
5826     ASM_MESON_TAC[SPAN_MUL; SPAN_INC; SUBSET];
5827     ALL_TAC] THEN
5828   MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL
5829    [REWRITE_TAC[pairwise; IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN
5830     RULE_ASSUM_TAC(REWRITE_RULE[pairwise]) THEN
5831     ASM_MESON_TAC[ORTHOGONAL_CLAUSES];
5832     DISCH_TAC] THEN
5833   MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL
5834    [REWRITE_TAC[FORALL_IN_IMAGE; NORM_MUL; REAL_ABS_INV; REAL_ABS_NORM] THEN
5835     ASM_MESON_TAC[REAL_MUL_LINV; NORM_EQ_0];
5836     DISCH_TAC] THEN
5837   MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL
5838    [MATCH_MP_TAC PAIRWISE_ORTHOGONAL_INDEPENDENT THEN ASM_REWRITE_TAC[] THEN
5839     REWRITE_TAC[IN_IMAGE] THEN ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN
5840     SIMP_TAC[VECTOR_MUL_EQ_0; REAL_INV_EQ_0; NORM_EQ_0] THEN ASM_MESON_TAC[];
5841     DISCH_TAC] THEN
5842   MATCH_MP_TAC(TAUT `b /\ (b ==> a) ==> a /\ b`) THEN CONJ_TAC THENL
5843    [ALL_TAC; ASM_SIMP_TAC[BASIS_HAS_SIZE_DIM]] THEN
5844   UNDISCH_THEN `span b = (s:real^N->bool)` (SUBST1_TAC o SYM) THEN
5845   MATCH_MP_TAC SPAN_IMAGE_SCALE THEN
5846   REWRITE_TAC[REAL_INV_EQ_0; NORM_EQ_0] THEN
5847   ASM_MESON_TAC[HAS_SIZE]);;
5848
5849 let ORTHOGONAL_TO_SUBSPACE_EXISTS_GEN = prove
5850  (`!s t:real^N->bool.
5851         span s PSUBSET span t
5852         ==> ?x. ~(x = vec 0) /\ x IN span t /\
5853                 (!y. y IN span s ==> orthogonal x y)`,
5854   REPEAT STRIP_TAC THEN
5855   MP_TAC(ISPEC `span s:real^N->bool` ORTHOGONAL_BASIS_SUBSPACE) THEN
5856   REWRITE_TAC[SUBSPACE_SPAN] THEN
5857   DISCH_THEN(X_CHOOSE_THEN `b:real^N->bool` STRIP_ASSUME_TAC) THEN
5858   FIRST_X_ASSUM(SUBST_ALL_TAC o SYM) THEN
5859   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [PSUBSET_ALT]) THEN
5860   DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC
5861    (X_CHOOSE_THEN `u:real^N` STRIP_ASSUME_TAC)) THEN
5862   MP_TAC(ISPECL [`{u:real^N}`; `b:real^N->bool`] ORTHOGONAL_EXTENSION) THEN
5863   ANTS_TAC THENL [ASM_MESON_TAC[FINITE_SING; HAS_SIZE]; ALL_TAC] THEN
5864   DISCH_THEN(X_CHOOSE_THEN `ns:real^N->bool` MP_TAC) THEN
5865   ASM_CASES_TAC `ns SUBSET (vec 0:real^N) INSERT b` THENL
5866    [DISCH_THEN(MP_TAC o AP_TERM `(IN) (u:real^N)` o CONJUNCT2) THEN
5867     SIMP_TAC[SPAN_SUPERSET; IN_UNION; IN_SING] THEN
5868     MATCH_MP_TAC(TAUT `~p ==> p ==> q`) THEN
5869     SUBGOAL_THEN `~(u IN span (b UNION {vec 0:real^N}))` MP_TAC THENL
5870      [ASM_REWRITE_TAC[SET_RULE `s UNION {a} = a INSERT s`; SPAN_INSERT_0];
5871       MATCH_MP_TAC(SET_RULE `s SUBSET t ==> ~(x IN t) ==> ~(x IN s)`) THEN
5872       MATCH_MP_TAC SPAN_MONO THEN ASM SET_TAC[]];
5873     ALL_TAC] THEN
5874   FIRST_X_ASSUM(MP_TAC o MATCH_MP (SET_RULE
5875    `~(s SUBSET t) ==> ?z. z IN s /\ ~(z IN t)`)) THEN
5876   REWRITE_TAC[LEFT_IMP_EXISTS_THM; IN_INSERT; DE_MORGAN_THM] THEN
5877   X_GEN_TAC `n:real^N` THEN STRIP_TAC THEN
5878   DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
5879   REWRITE_TAC[pairwise; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
5880   DISCH_THEN(MP_TAC o SPEC `n:real^N`) THEN ASM_REWRITE_TAC[IN_UNION] THEN
5881   REWRITE_TAC[IMP_IMP] THEN DISCH_TAC THEN EXISTS_TAC `n:real^N` THEN
5882   ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
5883    [SUBGOAL_THEN `(n:real^N) IN span (b UNION ns)` MP_TAC THENL
5884      [MATCH_MP_TAC SPAN_SUPERSET THEN ASM SET_TAC[];
5885       ASM_REWRITE_TAC[] THEN SPEC_TAC(`n:real^N`,`n:real^N`) THEN
5886       REWRITE_TAC[GSYM SUBSET] THEN
5887       MATCH_MP_TAC SPAN_SUBSET_SUBSPACE THEN REWRITE_TAC[SUBSPACE_SPAN] THEN
5888       ASM_REWRITE_TAC[SET_RULE
5889        `s UNION {a} SUBSET t <=> s SUBSET t /\ a IN t`] THEN
5890       ASM_MESON_TAC[SPAN_INC; SUBSET_TRANS]];
5891     MATCH_MP_TAC SPAN_INDUCT THEN
5892     REWRITE_TAC[SET_RULE `(\y. orthogonal n y) = {y | orthogonal n y}`] THEN
5893     REWRITE_TAC[SUBSPACE_ORTHOGONAL_TO_VECTOR] THEN ASM SET_TAC[]]);;
5894
5895 let ORTHOGONAL_TO_SUBSPACE_EXISTS = prove
5896  (`!s:real^N->bool. dim s < dimindex(:N)
5897                     ==> ?x. ~(x = vec 0) /\ !y. y IN s ==> orthogonal x y`,
5898   REPEAT STRIP_TAC THEN
5899   MP_TAC(ISPECL [`s:real^N->bool`; `(:real^N)`]
5900         ORTHOGONAL_TO_SUBSPACE_EXISTS_GEN) THEN
5901   ANTS_TAC THENL [REWRITE_TAC[PSUBSET]; MESON_TAC[SPAN_SUPERSET]] THEN
5902   REWRITE_TAC[SPAN_UNIV; SUBSET_UNIV] THEN
5903   ASM_MESON_TAC[DIM_SPAN; DIM_UNIV; LT_REFL]);;
5904
5905 let ORTHOGONAL_TO_VECTOR_EXISTS = prove
5906  (`!x:real^N. 2 <= dimindex(:N) ==> ?y. ~(y = vec 0) /\ orthogonal x y`,
5907   REPEAT STRIP_TAC THEN
5908   MP_TAC(ISPEC `{x:real^N}` ORTHOGONAL_TO_SUBSPACE_EXISTS) THEN
5909   SIMP_TAC[DIM_SING; IN_SING; LEFT_FORALL_IMP_THM; EXISTS_REFL] THEN
5910   ANTS_TAC THENL [ASM_ARITH_TAC; MESON_TAC[ORTHOGONAL_SYM]]);;
5911
5912 let SPAN_NOT_UNIV_ORTHOGONAL = prove
5913  (`!s. ~(span s = (:real^N))
5914          ==> ?a. ~(a = vec 0) /\ !x. x IN span s ==> a dot x = &0`,
5915   REWRITE_TAC[GSYM DIM_EQ_FULL; GSYM LE_ANTISYM; DIM_SUBSET_UNIV;
5916               NOT_LE] THEN
5917   REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM orthogonal] THEN
5918   MATCH_MP_TAC ORTHOGONAL_TO_SUBSPACE_EXISTS THEN ASM_REWRITE_TAC[DIM_SPAN]);;
5919
5920 let SPAN_NOT_UNIV_SUBSET_HYPERPLANE = prove
5921  (`!s. ~(span s = (:real^N))
5922        ==> ?a. ~(a = vec 0) /\ span s SUBSET {x | a dot x = &0}`,
5923   REWRITE_TAC[SUBSET; IN_ELIM_THM; SPAN_NOT_UNIV_ORTHOGONAL]);;
5924
5925 let LOWDIM_SUBSET_HYPERPLANE = prove
5926  (`!s. dim s < dimindex(:N)
5927        ==> ?a:real^N. ~(a = vec 0) /\ span s SUBSET {x | a dot x = &0}`,
5928   REPEAT STRIP_TAC THEN MATCH_MP_TAC SPAN_NOT_UNIV_SUBSET_HYPERPLANE THEN
5929   REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ; SUBSET_UNIV] THEN
5930   DISCH_THEN(MP_TAC o MATCH_MP DIM_SUBSET) THEN
5931   ASM_REWRITE_TAC[NOT_LE; DIM_SPAN; DIM_UNIV]);;
5932
5933 (* ------------------------------------------------------------------------- *)
5934 (* Decomposing a vector into parts in orthogonal subspaces.                  *)
5935 (* ------------------------------------------------------------------------- *)
5936
5937 let ORTHOGONAL_SUBSPACE_DECOMP_UNIQUE = prove
5938  (`!s t x y x' y':real^N.
5939         (!a b. a IN s /\ b IN t ==> orthogonal a b) /\
5940         x IN span s /\ x' IN span s /\ y IN span t /\ y' IN span t /\
5941         x + y = x' + y'
5942         ==> x = x' /\ y = y'`,
5943   REWRITE_TAC[VECTOR_ARITH `x + y:real^N = x' + y' <=> x - x' = y' - y`] THEN
5944   ONCE_REWRITE_TAC[GSYM ORTHOGONAL_TO_SPANS_EQ] THEN
5945   REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[VECTOR_ARITH
5946    `x:real^N = x' /\ y:real^N = y' <=> x - x' = vec 0 /\ y' - y = vec 0`] THEN
5947   STRIP_TAC THEN ASM_REWRITE_TAC[GSYM ORTHOGONAL_REFL] THEN
5948   FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [SYM th]) THEN
5949   ASM_MESON_TAC[ORTHOGONAL_CLAUSES; ORTHOGONAL_SYM]);;
5950
5951 let ORTHOGONAL_SUBSPACE_DECOMP_EXISTS = prove
5952  (`!s x:real^N. ?y z. y IN span s /\ (!w. w IN span s ==> orthogonal z w) /\
5953                       x = y + z`,
5954   REPEAT STRIP_TAC THEN
5955   MP_TAC(ISPEC `span s:real^N->bool` ORTHOGONAL_BASIS_SUBSPACE) THEN
5956   REWRITE_TAC[SUBSPACE_SPAN; LEFT_IMP_EXISTS_THM] THEN
5957   X_GEN_TAC `t:real^N->bool` THEN STRIP_TAC THEN
5958   FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN
5959   EXISTS_TAC `vsum t (\b:real^N. (b dot x) / (b dot b) % b)` THEN
5960   EXISTS_TAC `x - vsum t (\b:real^N. (b dot x) / (b dot b) % b)` THEN
5961   REPEAT CONJ_TAC THENL
5962    [MATCH_MP_TAC SPAN_VSUM THEN
5963     ASM_SIMP_TAC[INDEPENDENT_IMP_FINITE; SPAN_CLAUSES];
5964     REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[ORTHOGONAL_SYM] THEN
5965     MATCH_MP_TAC GRAM_SCHMIDT_STEP THEN ASM_SIMP_TAC[];
5966     VECTOR_ARITH_TAC]);;
5967
5968 let ORTHOGONAL_SUBSPACE_DECOMP = prove
5969  (`!s x. ?!(y,z). y IN span s /\
5970                   z IN {z:real^N | !x. x IN span s ==> orthogonal z x} /\
5971                   x = y + z`,
5972   REWRITE_TAC[EXISTS_UNIQUE_DEF; IN_ELIM_THM] THEN
5973   REWRITE_TAC[EXISTS_PAIRED_THM; FORALL_PAIRED_THM] THEN
5974   REWRITE_TAC[FORALL_PAIR_THM; ORTHOGONAL_SUBSPACE_DECOMP_EXISTS] THEN
5975   REPEAT STRIP_TAC THEN REWRITE_TAC[PAIR_EQ] THEN
5976   MATCH_MP_TAC ORTHOGONAL_SUBSPACE_DECOMP_UNIQUE THEN
5977   MAP_EVERY EXISTS_TAC
5978    [`s:real^N->bool`; `{z:real^N | !x. x IN span s ==> orthogonal z x}`] THEN
5979   ASM_SIMP_TAC[SPAN_CLAUSES; IN_ELIM_THM] THEN
5980   ASM_MESON_TAC[SPAN_CLAUSES; ORTHOGONAL_SYM]);;
5981
5982 (* ------------------------------------------------------------------------- *)
5983 (* Existence of isometry between subspaces of same dimension.                *)
5984 (* ------------------------------------------------------------------------- *)
5985
5986 let ISOMETRY_SUBSPACES = prove
5987  (`!s:real^M->bool t:real^N->bool.
5988         subspace s /\ subspace t /\ dim s = dim t
5989         ==> ?f:real^M->real^N. linear f /\ IMAGE f s = t /\
5990                                (!x. x IN s ==> norm(f x) = norm(x))`,
5991   REPEAT STRIP_TAC THEN ABBREV_TAC `n = dim(t:real^N->bool)` THEN
5992   MP_TAC(ISPEC `t:real^N->bool` ORTHONORMAL_BASIS_SUBSPACE) THEN
5993   MP_TAC(ISPEC `s:real^M->bool` ORTHONORMAL_BASIS_SUBSPACE) THEN
5994   ASM_REWRITE_TAC[] THEN
5995   DISCH_THEN(X_CHOOSE_THEN `b:real^M->bool` STRIP_ASSUME_TAC) THEN
5996   DISCH_THEN(X_CHOOSE_THEN `c:real^N->bool` STRIP_ASSUME_TAC) THEN
5997   MP_TAC(ISPECL [`b:real^M->bool`; `c:real^N->bool`] CARD_EQ_BIJECTIONS) THEN
5998   RULE_ASSUM_TAC(REWRITE_RULE[HAS_SIZE]) THEN
5999   ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
6000   MAP_EVERY X_GEN_TAC [`f:real^M->real^N`; `g:real^N->real^M`] THEN
6001   STRIP_TAC THEN
6002   MP_TAC(ISPECL [`f:real^M->real^N`; `b:real^M->bool`]
6003     LINEAR_INDEPENDENT_EXTEND) THEN
6004   ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN
6005   X_GEN_TAC `h:real^M->real^N` THEN
6006   STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
6007    [REWRITE_TAC[SYM(ASSUME `span(b:real^M->bool) = s`);
6008                 SYM(ASSUME `span(c:real^N->bool) = t`)] THEN
6009     MATCH_MP_TAC SUBSET_ANTISYM THEN
6010     REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN
6011     CONJ_TAC THEN MATCH_MP_TAC SPAN_INDUCT THEN REWRITE_TAC[IN_ELIM_THM] THENL
6012      [GEN_REWRITE_TAC (RAND_CONV o RAND_CONV)
6013        [SET_RULE `(\x. p x) = {x | p x}`] THEN
6014       ASM_SIMP_TAC[SUBSPACE_LINEAR_PREIMAGE] THEN
6015       ASM_MESON_TAC[SPAN_INC; SUBSET];
6016       ONCE_REWRITE_TAC[SET_RULE `(\x. x IN s) = s`] THEN
6017       ASM_SIMP_TAC[SUBSPACE_LINEAR_IMAGE; SUBSPACE_SPAN] THEN
6018       X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN REWRITE_TAC[IN_IMAGE] THEN
6019       ASM_MESON_TAC[SPAN_INC; SUBSET]];
6020     X_GEN_TAC `x:real^M` THEN
6021     REWRITE_TAC[SYM(ASSUME `span(b:real^M->bool) = s`)] THEN
6022     SIMP_TAC[SPAN_FINITE; ASSUME `FINITE(b:real^M->bool) /\ CARD b = n`] THEN
6023     REWRITE_TAC[IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN
6024     X_GEN_TAC `u:real^M->real` THEN DISCH_THEN(SUBST1_TAC o SYM) THEN
6025     ASM_SIMP_TAC[LINEAR_VSUM; NORM_EQ] THEN
6026     ASM_SIMP_TAC[o_DEF; LINEAR_CMUL] THEN
6027     ASM_SIMP_TAC[DOT_LSUM; DOT_RSUM; DOT_RMUL; DOT_LMUL] THEN
6028     MATCH_MP_TAC SUM_EQ THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN
6029     REWRITE_TAC[] THEN MATCH_MP_TAC SUM_EQ THEN X_GEN_TAC `y:real^M` THEN
6030     DISCH_TAC THEN REWRITE_TAC[] THEN AP_TERM_TAC THEN AP_TERM_TAC THEN
6031     RULE_ASSUM_TAC(REWRITE_RULE[pairwise; orthogonal]) THEN
6032     ASM_CASES_TAC `x:real^M = y` THEN ASM_REWRITE_TAC[GSYM NORM_EQ] THEN
6033     ASM SET_TAC[]]);;
6034
6035 let ISOMETRY_UNIV_SUBSPACE = prove
6036  (`!s. subspace s /\ dimindex(:M) = dim s
6037        ==> ?f:real^M->real^N.
6038                 linear f /\ IMAGE f (:real^M) = s /\
6039                 (!x. norm(f x) = norm(x))`,
6040   REPEAT STRIP_TAC THEN
6041   MP_TAC(ISPECL [`(:real^M)`; `s:real^N->bool`] ISOMETRY_SUBSPACES) THEN
6042   ASM_REWRITE_TAC[SUBSPACE_UNIV; IN_UNIV; DIM_UNIV]);;
6043
6044 let ISOMETRY_UNIV_SUPERSET_SUBSPACE = prove
6045  (`!s. subspace s /\ dim s <= dimindex(:M) /\ dimindex(:M) <= dimindex(:N)
6046        ==> ?f:real^M->real^N.
6047                 linear f /\ s SUBSET (IMAGE f (:real^M)) /\
6048                 (!x. norm(f x) = norm(x))`,
6049   GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN ASSUME_TAC) THEN
6050   FIRST_ASSUM(MP_TAC o MATCH_MP LOWDIM_EXPAND_DIMENSION) THEN
6051   DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) THEN
6052   MP_TAC(ISPECL [`(:real^M)`; `span t:real^N->bool`] ISOMETRY_SUBSPACES) THEN
6053   ASM_REWRITE_TAC[SUBSPACE_SPAN; SUBSPACE_UNIV; DIM_UNIV; DIM_SPAN] THEN
6054   MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[IN_UNIV] THEN
6055   ASM_MESON_TAC[SUBSET; SPAN_INC]);;
6056
6057 let ISOMETRY_UNIV_UNIV = prove
6058  (`dimindex(:M) <= dimindex(:N)
6059    ==> ?f:real^M->real^N. linear f /\ (!x. norm(f x) = norm(x))`,
6060   DISCH_TAC THEN
6061   MP_TAC(ISPEC `{vec 0:real^N}`ISOMETRY_UNIV_SUPERSET_SUBSPACE) THEN
6062   ASM_REWRITE_TAC[SUBSPACE_TRIVIAL] THEN
6063   ANTS_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN
6064   MATCH_MP_TAC(ARITH_RULE `x = 0 /\ 1 <= y ==> x <= y`) THEN
6065   ASM_REWRITE_TAC[DIM_EQ_0; DIMINDEX_GE_1] THEN SET_TAC[]);;
6066
6067 let SUBSPACE_ISOMORPHISM = prove
6068  (`!s t. subspace s /\ subspace t /\ dim(s) = dim(t)
6069          ==> ?f:real^M->real^N.
6070                 linear f /\ (IMAGE f s = t) /\
6071                 (!x y. x IN s /\ y IN s /\ f x = f y ==> (x = y))`,
6072   REPEAT GEN_TAC THEN DISCH_TAC THEN
6073   FIRST_ASSUM(MP_TAC o MATCH_MP ISOMETRY_SUBSPACES) THEN
6074   MATCH_MP_TAC MONO_EXISTS THEN
6075   ASM_SIMP_TAC[LINEAR_INJECTIVE_0_SUBSPACE] THEN MESON_TAC[NORM_EQ_0]);;
6076
6077 let ISOMORPHISMS_UNIV_UNIV = prove
6078  (`dimindex(:M) = dimindex(:N)
6079    ==> ?f:real^M->real^N g.
6080             linear f /\ linear g /\
6081             (!x. norm(f x) = norm x) /\ (!y. norm(g y) = norm y) /\
6082             (!x. g(f x) = x) /\ (!y. f(g y) = y)`,
6083   REPEAT STRIP_TAC THEN
6084   EXISTS_TAC `(\x. lambda i. x$i):real^M->real^N` THEN
6085   EXISTS_TAC `(\x. lambda i. x$i):real^N->real^M` THEN
6086   SIMP_TAC[vector_norm; dot; LAMBDA_BETA] THEN
6087   SIMP_TAC[linear; CART_EQ; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT;
6088            LAMBDA_BETA] THEN
6089   FIRST_ASSUM SUBST1_TAC THEN SIMP_TAC[LAMBDA_BETA] THEN
6090   FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN SIMP_TAC[LAMBDA_BETA]);;
6091
6092 (* ------------------------------------------------------------------------- *)
6093 (* Properties of special hyperplanes.                                        *)
6094 (* ------------------------------------------------------------------------- *)
6095
6096 let SUBSPACE_HYPERPLANE = prove
6097  (`!a. subspace {x:real^N | a dot x = &0}`,
6098   SIMP_TAC[subspace; DOT_RADD; DOT_RMUL; IN_ELIM_THM; REAL_ADD_LID;
6099            REAL_MUL_RZERO; DOT_RZERO]);;
6100
6101 let SUBSPACE_SPECIAL_HYPERPLANE = prove
6102  (`!k. subspace {x:real^N | x$k = &0}`,
6103   SIMP_TAC[subspace; IN_ELIM_THM; VEC_COMPONENT;
6104            VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT] THEN REAL_ARITH_TAC);;
6105
6106 let SPECIAL_HYPERPLANE_SPAN = prove
6107  (`!k. 1 <= k /\ k <= dimindex(:N)
6108        ==> {x:real^N | x$k = &0} =
6109            span(IMAGE basis ((1..dimindex(:N)) DELETE k))`,
6110   REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC SPAN_SUBSPACE THEN
6111   ASM_SIMP_TAC[SUBSPACE_SPECIAL_HYPERPLANE] THEN CONJ_TAC THENL
6112    [REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_THM] THEN
6113     ASM_SIMP_TAC[BASIS_COMPONENT; IN_DELETE];
6114     REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN
6115     X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
6116     GEN_REWRITE_TAC LAND_CONV [GSYM BASIS_EXPANSION] THEN
6117     SIMP_TAC[SPAN_FINITE; FINITE_IMAGE; FINITE_DELETE; FINITE_NUMSEG] THEN
6118     REWRITE_TAC[IN_ELIM_THM] THEN
6119     EXISTS_TAC `\v:real^N. x dot v` THEN
6120     W(MP_TAC o PART_MATCH (lhs o rand) VSUM_IMAGE o lhs o snd) THEN
6121     ANTS_TAC THENL
6122      [REWRITE_TAC[FINITE_DELETE; FINITE_NUMSEG; IN_NUMSEG; IN_DELETE] THEN
6123       MESON_TAC[BASIS_INJ];
6124       DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[o_DEF] THEN
6125       ASM_SIMP_TAC[VSUM_DELETE; FINITE_NUMSEG; IN_NUMSEG; DOT_BASIS] THEN
6126       REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_SUB_RZERO]]]);;
6127
6128 let DIM_SPECIAL_HYPERPLANE = prove
6129  (`!k. 1 <= k /\ k <= dimindex(:N)
6130        ==> dim {x:real^N | x$k = &0} = dimindex(:N) - 1`,
6131   SIMP_TAC[SPECIAL_HYPERPLANE_SPAN] THEN REPEAT STRIP_TAC THEN
6132   MATCH_MP_TAC DIM_UNIQUE THEN
6133   EXISTS_TAC `IMAGE (basis:num->real^N) ((1..dimindex(:N)) DELETE k)` THEN
6134   REWRITE_TAC[SUBSET_REFL; SPAN_INC] THEN CONJ_TAC THENL
6135    [MATCH_MP_TAC INDEPENDENT_MONO THEN
6136     EXISTS_TAC `{basis i:real^N | 1 <= i /\ i <= dimindex(:N)}` THEN
6137     REWRITE_TAC[INDEPENDENT_STDBASIS; SUBSET; FORALL_IN_IMAGE] THEN
6138     REWRITE_TAC[IN_DELETE; IN_NUMSEG; IN_ELIM_THM] THEN MESON_TAC[];
6139     MATCH_MP_TAC HAS_SIZE_IMAGE_INJ THEN CONJ_TAC THENL
6140      [REWRITE_TAC[FINITE_DELETE; FINITE_NUMSEG; IN_NUMSEG; IN_DELETE] THEN
6141       MESON_TAC[BASIS_INJ];
6142       ASM_SIMP_TAC[HAS_SIZE; FINITE_DELETE; FINITE_NUMSEG; CARD_DELETE;
6143                    FINITE_IMAGE; IN_NUMSEG; CARD_NUMSEG_1]]]);;
6144
6145 (* ------------------------------------------------------------------------- *)
6146 (* More theorems about dimensions of different subspaces.                    *)
6147 (* ------------------------------------------------------------------------- *)
6148
6149 let DIM_IMAGE_KERNEL_GEN = prove
6150  (`!f:real^M->real^N s.
6151         linear f /\ subspace s
6152         ==> dim(IMAGE f s) + dim {x | x IN s /\  f x = vec 0} = dim(s)`,
6153   REPEAT STRIP_TAC THEN MP_TAC
6154    (ISPEC `{x | x IN s /\ (f:real^M->real^N) x = vec 0}` BASIS_EXISTS) THEN
6155   DISCH_THEN(X_CHOOSE_THEN `v:real^M->bool` STRIP_ASSUME_TAC) THEN
6156   MP_TAC(ISPECL [`v:real^M->bool`; `s:real^M->bool`]
6157     MAXIMAL_INDEPENDENT_SUBSET_EXTEND) THEN
6158   ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
6159   DISCH_THEN(X_CHOOSE_THEN `w:real^M->bool` STRIP_ASSUME_TAC) THEN
6160   SUBGOAL_THEN `span(w:real^M->bool) = s`
6161    (fun th -> GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [SYM th] THEN
6162               ASSUME_TAC th)
6163   THENL [ASM_SIMP_TAC[SPAN_SUBSPACE]; ALL_TAC] THEN
6164   SUBGOAL_THEN `subspace {x | x IN s /\ (f:real^M->real^N) x = vec 0}`
6165   ASSUME_TAC THENL
6166    [REWRITE_TAC[SET_RULE `{x | x IN s /\ P x} = s INTER {x | P x}`] THEN
6167     ASM_SIMP_TAC[SUBSPACE_INTER; SUBSPACE_KERNEL];
6168     ALL_TAC] THEN
6169   SUBGOAL_THEN `{x | x IN s /\ (f:real^M->real^N) x = vec 0} = span v`
6170   ASSUME_TAC THENL
6171    [ASM_MESON_TAC[SUBSET_ANTISYM; SPAN_SUBSET_SUBSPACE; SUBSPACE_KERNEL];
6172     ALL_TAC] THEN
6173   ASM_SIMP_TAC[DIM_SPAN; DIM_EQ_CARD] THEN
6174   SUBGOAL_THEN
6175    `!x. x IN span(w DIFF v) /\ (f:real^M->real^N) x = vec 0 ==> x = vec 0`
6176   (LABEL_TAC "*") THENL
6177    [MATCH_MP_TAC(SET_RULE
6178      `!t. s SUBSET t /\ (!x. x IN s /\ x IN t /\ P x ==> Q x)
6179           ==> (!x. x IN s /\ P x ==> Q x)`) THEN
6180     EXISTS_TAC `s:real^M->bool` THEN CONJ_TAC THENL
6181      [ASM_MESON_TAC[SPAN_MONO; SUBSET_DIFF]; ALL_TAC] THEN
6182     ASM_SIMP_TAC[SPAN_FINITE; IN_ELIM_THM; IMP_CONJ; FINITE_DIFF;
6183                  INDEPENDENT_IMP_FINITE; LEFT_IMP_EXISTS_THM] THEN
6184     GEN_TAC THEN X_GEN_TAC `u:real^M->real` THEN
6185     DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[IMP_IMP] THEN
6186     ONCE_REWRITE_TAC[SET_RULE
6187      `y IN s /\ f y = a <=> y IN {x | x IN s /\ f x = a}`] THEN
6188     ASM_REWRITE_TAC[] THEN
6189     ASM_SIMP_TAC[SPAN_FINITE; INDEPENDENT_IMP_FINITE; IN_ELIM_THM] THEN
6190     DISCH_THEN(X_CHOOSE_TAC `t:real^M->real`) THEN
6191     MP_TAC(ISPEC `w:real^M->bool` INDEPENDENT_EXPLICIT) THEN
6192     ASM_REWRITE_TAC[] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
6193     DISCH_THEN(MP_TAC o SPEC
6194      `(\x. if x IN w DIFF v then --u x else t x):real^M->real`) THEN
6195     ASM_REWRITE_TAC[COND_RAND] THEN ONCE_REWRITE_TAC[COND_RATOR] THEN
6196     ASM_SIMP_TAC[VSUM_CASES; INDEPENDENT_IMP_FINITE] THEN
6197     REWRITE_TAC[SET_RULE `{x | x IN w /\ x IN (w DIFF v)} = w DIFF v`] THEN
6198     SIMP_TAC[ASSUME `(v:real^M->bool) SUBSET w`; SET_RULE
6199      `v SUBSET w ==> {x | x IN w /\ ~(x IN (w DIFF v))} = v`] THEN
6200     ASM_REWRITE_TAC[VECTOR_MUL_LNEG; VSUM_NEG; VECTOR_ADD_LINV] THEN
6201     DISCH_THEN(fun th -> MATCH_MP_TAC VSUM_EQ_0 THEN MP_TAC th) THEN
6202     REWRITE_TAC[REAL_NEG_EQ_0; VECTOR_MUL_EQ_0; IN_DIFF] THEN MESON_TAC[];
6203     ALL_TAC] THEN
6204   SUBGOAL_THEN `!x y. x IN (w DIFF v) /\ y IN (w DIFF v) /\
6205                       (f:real^M->real^N) x = f y ==> x = y`
6206   ASSUME_TAC THENL
6207    [REMOVE_THEN "*" MP_TAC THEN
6208     ASM_SIMP_TAC[GSYM LINEAR_INJECTIVE_0_SUBSPACE; SUBSPACE_SPAN] THEN
6209     MP_TAC(ISPEC `w DIFF v:real^M->bool` SPAN_INC) THEN SET_TAC[];
6210     ALL_TAC] THEN
6211   SUBGOAL_THEN `IMAGE (f:real^M->real^N) s = span(IMAGE f (w DIFF v))`
6212   SUBST1_TAC THENL
6213    [MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL
6214      [ALL_TAC;
6215       ASM_MESON_TAC[SUBSPACE_LINEAR_IMAGE; SPAN_MONO; IMAGE_SUBSET;
6216                     SUBSET_TRANS; SUBSET_DIFF; SPAN_EQ_SELF]] THEN
6217     SIMP_TAC[SUBSET; FORALL_IN_IMAGE] THEN X_GEN_TAC `x:real^M` THEN
6218     DISCH_TAC THEN UNDISCH_TAC `span w:real^M->bool = s` THEN
6219     REWRITE_TAC[EXTENSION] THEN DISCH_THEN(MP_TAC o SPEC `x:real^M`) THEN
6220     ASM_REWRITE_TAC[] THEN
6221     REMOVE_THEN "*" (MP_TAC o SPEC `x:real^M`) THEN
6222     (CONV_TAC o GEN_SIMPLIFY_CONV TOP_DEPTH_SQCONV (basic_ss []) 4)
6223      [IN_UNIV; SPAN_FINITE; INDEPENDENT_IMP_FINITE; IN_ELIM_THM;
6224       FINITE_IMAGE; FINITE_DIFF; ASSUME `independent(w:real^M->bool)`] THEN
6225     REWRITE_TAC[IMP_CONJ; LEFT_IMP_EXISTS_THM] THEN DISCH_TAC THEN
6226     X_GEN_TAC `u:real^M->real` THEN DISCH_THEN(SUBST1_TAC o SYM) THEN
6227     FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [INJECTIVE_ON_LEFT_INVERSE]) THEN
6228     DISCH_THEN(X_CHOOSE_TAC `g:real^N->real^M`) THEN
6229     EXISTS_TAC `(u:real^M->real) o (g:real^N->real^M)` THEN
6230     W(MP_TAC o PART_MATCH (lhs o rand) VSUM_IMAGE o lhand o snd) THEN
6231     ASM_REWRITE_TAC[] THEN
6232     ASM_SIMP_TAC[FINITE_DIFF; INDEPENDENT_IMP_FINITE; LINEAR_VSUM] THEN
6233     DISCH_THEN SUBST1_TAC THEN ASM_REWRITE_TAC[o_DEF] THEN
6234     CONV_TAC SYM_CONV THEN MATCH_MP_TAC VSUM_EQ_SUPERSET THEN
6235     SIMP_TAC[SUBSET_DIFF; FINITE_DIFF; INDEPENDENT_IMP_FINITE;
6236              LINEAR_CMUL; IN_DIFF; TAUT `a /\ ~(a /\ ~b) <=> a /\ b`;
6237              ASSUME `independent(w:real^M->bool)`;
6238              ASSUME `linear(f:real^M->real^N)`] THEN
6239     REWRITE_TAC[VECTOR_MUL_EQ_0] THEN ASM SET_TAC[];
6240     SUBGOAL_THEN `independent(IMAGE (f:real^M->real^N) (w DIFF v))`
6241     ASSUME_TAC THENL
6242      [MATCH_MP_TAC INDEPENDENT_INJECTIVE_IMAGE_GEN THEN
6243       ASM_SIMP_TAC[LINEAR_INJECTIVE_0_SUBSPACE; SUBSPACE_SPAN] THEN
6244       ASM_MESON_TAC[INDEPENDENT_MONO; SUBSET_DIFF];
6245       ASM_SIMP_TAC[DIM_SPAN; DIM_EQ_CARD] THEN
6246       W(MP_TAC o PART_MATCH (lhs o rand) CARD_IMAGE_INJ o
6247         lhand o lhand o snd) THEN
6248       ASM_REWRITE_TAC[] THEN
6249       ASM_SIMP_TAC[FINITE_DIFF; CARD_DIFF; INDEPENDENT_IMP_FINITE] THEN
6250       DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC SUB_ADD THEN
6251       ASM_MESON_TAC[CARD_SUBSET; INDEPENDENT_IMP_FINITE]]]);;
6252
6253 let DIM_IMAGE_KERNEL = prove
6254  (`!f:real^M->real^N.
6255         linear f
6256         ==> dim(IMAGE f (:real^M)) + dim {x | f x = vec 0} = dimindex(:M)`,
6257   REPEAT STRIP_TAC THEN
6258   MP_TAC(ISPECL [`f:real^M->real^N`; `(:real^M)`] DIM_IMAGE_KERNEL_GEN) THEN
6259   ASM_REWRITE_TAC[SUBSPACE_UNIV; IN_UNIV; DIM_UNIV]);;
6260
6261 let DIM_SUMS_INTER = prove
6262  (`!s t:real^N->bool.
6263     subspace s /\ subspace t
6264     ==> dim {x + y | x IN s /\ y IN t} + dim(s INTER t) = dim(s) + dim(t)`,
6265   REPEAT STRIP_TAC THEN
6266   MP_TAC(ISPEC `s INTER t:real^N->bool` BASIS_EXISTS) THEN
6267   DISCH_THEN(X_CHOOSE_THEN `b:real^N->bool` STRIP_ASSUME_TAC) THEN
6268   MP_TAC(ISPECL [`b:real^N->bool`; `s:real^N->bool`]
6269     MAXIMAL_INDEPENDENT_SUBSET_EXTEND) THEN
6270   ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
6271   DISCH_THEN(X_CHOOSE_THEN `c:real^N->bool` STRIP_ASSUME_TAC) THEN
6272   MP_TAC(ISPECL [`b:real^N->bool`; `t:real^N->bool`]
6273     MAXIMAL_INDEPENDENT_SUBSET_EXTEND) THEN
6274   ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
6275   DISCH_THEN(X_CHOOSE_THEN `d:real^N->bool` STRIP_ASSUME_TAC) THEN
6276   SUBGOAL_THEN `(c:real^N->bool) INTER d = b` ASSUME_TAC THENL
6277    [MATCH_MP_TAC SUBSET_ANTISYM THEN ASM_REWRITE_TAC[SUBSET_INTER] THEN
6278     REWRITE_TAC[SUBSET; IN_INTER] THEN X_GEN_TAC `x:real^N` THEN
6279     STRIP_TAC THEN MP_TAC(ISPEC `c:real^N->bool` independent) THEN
6280     ASM_REWRITE_TAC[dependent; NOT_EXISTS_THM] THEN
6281     DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN
6282     ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN STRIP_TAC THEN
6283     REWRITE_TAC[] THEN
6284     SUBGOAL_THEN `(x:real^N) IN span b` MP_TAC THENL
6285      [ASM_MESON_TAC[SUBSET; IN_INTER; SPAN_INC];
6286       MP_TAC(ISPECL [`b:real^N->bool`; `c DELETE (x:real^N)`] SPAN_MONO) THEN
6287       ASM SET_TAC[]];
6288     ALL_TAC] THEN
6289   SUBGOAL_THEN
6290    `dim (s INTER t:real^N->bool) = CARD(b:real^N->bool) /\
6291     dim s = CARD c /\ dim t = CARD d /\
6292     dim {x + y:real^N | x IN s /\ y IN t} = CARD(c UNION d:real^N->bool)`
6293   (REPEAT_TCL CONJUNCTS_THEN SUBST1_TAC) THENL
6294    [ALL_TAC;
6295     ASM_SIMP_TAC[CARD_UNION_GEN; INDEPENDENT_IMP_FINITE] THEN
6296     MATCH_MP_TAC(ARITH_RULE `b:num <= c ==> (c + d) - b + b = c + d`) THEN
6297     ASM_SIMP_TAC[CARD_SUBSET; INDEPENDENT_IMP_FINITE]] THEN
6298   REPEAT CONJ_TAC THEN MATCH_MP_TAC DIM_UNIQUE THENL
6299    [EXISTS_TAC `b:real^N->bool`;
6300     EXISTS_TAC `c:real^N->bool`;
6301     EXISTS_TAC `d:real^N->bool`;
6302     EXISTS_TAC `c UNION d:real^N->bool`] THEN
6303   ASM_SIMP_TAC[HAS_SIZE; INDEPENDENT_IMP_FINITE; FINITE_UNION] THEN
6304   REWRITE_TAC[UNION_SUBSET; GSYM CONJ_ASSOC] THEN
6305   REWRITE_TAC[SUBSET; IN_ELIM_THM; FORALL_IN_GSPEC] THEN REPEAT CONJ_TAC THENL
6306    [X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
6307     MAP_EVERY EXISTS_TAC [`x:real^N`; `vec 0:real^N`] THEN
6308     ASM_SIMP_TAC[SUBSPACE_0; VECTOR_ADD_RID] THEN ASM SET_TAC[];
6309     X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
6310     MAP_EVERY EXISTS_TAC [`vec 0:real^N`; `x:real^N`] THEN
6311     ASM_SIMP_TAC[SUBSPACE_0; VECTOR_ADD_LID] THEN ASM SET_TAC[];
6312     MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN STRIP_TAC THEN
6313     MATCH_MP_TAC SPAN_ADD THEN CONJ_TAC THENL
6314      [MP_TAC(ISPECL[`c:real^N->bool`; `c UNION d:real^N->bool`] SPAN_MONO);
6315       MP_TAC(ISPECL[`d:real^N->bool`; `c UNION d:real^N->bool`] SPAN_MONO)] THEN
6316     REWRITE_TAC[SUBSET_UNION] THEN REWRITE_TAC[SUBSET] THEN
6317     DISCH_THEN MATCH_MP_TAC THEN ASM SET_TAC[];
6318     ALL_TAC] THEN
6319   ASM_SIMP_TAC[INDEPENDENT_EXPLICIT; FINITE_UNION; INDEPENDENT_IMP_FINITE] THEN
6320   X_GEN_TAC `a:real^N->real` THEN
6321   GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV)
6322    [SET_RULE `s UNION t = s UNION (t DIFF s)`] THEN
6323   ASM_SIMP_TAC[VSUM_UNION; SET_RULE `DISJOINT c (d DIFF c)`;
6324                INDEPENDENT_IMP_FINITE; FINITE_DIFF; FINITE_UNION] THEN
6325   DISCH_TAC THEN
6326   SUBGOAL_THEN
6327    `(vsum (d DIFF c) (\v:real^N. a v % v)) IN span b`
6328   MP_TAC THENL
6329    [FIRST_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN
6330     REWRITE_TAC[IN_INTER] THEN CONJ_TAC THENL
6331      [FIRST_X_ASSUM(SUBST1_TAC o MATCH_MP (VECTOR_ARITH
6332        `a + b = vec 0 ==> b = --a`)) THEN
6333       MATCH_MP_TAC SUBSPACE_NEG THEN ASM_REWRITE_TAC[];
6334       ALL_TAC] THEN
6335     MATCH_MP_TAC SUBSPACE_VSUM THEN
6336     ASM_SIMP_TAC[FINITE_DIFF; INDEPENDENT_IMP_FINITE] THEN
6337     REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSPACE_MUL THEN
6338     ASM_REWRITE_TAC[] THEN ASM SET_TAC[];
6339     ALL_TAC] THEN
6340   ASM_SIMP_TAC[SPAN_FINITE; INDEPENDENT_IMP_FINITE; IN_ELIM_THM] THEN
6341   DISCH_THEN(X_CHOOSE_TAC `e:real^N->real`) THEN
6342   MP_TAC(ISPEC `c:real^N->bool` INDEPENDENT_EXPLICIT) THEN
6343   ASM_REWRITE_TAC[] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC
6344    (MP_TAC o SPEC `(\x. if x IN b then a x + e x else a x):real^N->real`)) THEN
6345   REWRITE_TAC[] THEN ONCE_REWRITE_TAC[COND_RAND] THEN
6346   ONCE_REWRITE_TAC[COND_RATOR] THEN ASM_SIMP_TAC[VSUM_CASES] THEN
6347   REWRITE_TAC[VECTOR_ADD_RDISTRIB; GSYM DIFF] THEN
6348   ASM_SIMP_TAC[SET_RULE `b SUBSET c ==> {x | x IN c /\ x IN b} = b`] THEN
6349   ASM_SIMP_TAC[VSUM_ADD; INDEPENDENT_IMP_FINITE] THEN
6350   ONCE_REWRITE_TAC[VECTOR_ARITH `(a + b) + c:real^N = (a + c) + b`] THEN
6351   ASM_SIMP_TAC[GSYM VSUM_UNION; FINITE_DIFF; INDEPENDENT_IMP_FINITE;
6352                SET_RULE `DISJOINT b (c DIFF b)`] THEN
6353   ASM_SIMP_TAC[SET_RULE `b SUBSET c ==> b UNION (c DIFF b) = c`] THEN
6354   DISCH_TAC THEN
6355   SUBGOAL_THEN `!v:real^N. v IN (c DIFF b) ==> a v = &0` ASSUME_TAC THENL
6356    [ASM SET_TAC[]; ALL_TAC] THEN
6357   MP_TAC(ISPEC `d:real^N->bool` INDEPENDENT_EXPLICIT) THEN
6358   ASM_REWRITE_TAC[] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC
6359    (MP_TAC o SPEC `a:real^N->real`)) THEN
6360   SUBGOAL_THEN `d:real^N->bool = b UNION (d DIFF c)`
6361    (fun th -> GEN_REWRITE_TAC (LAND_CONV o LAND_CONV o ONCE_DEPTH_CONV) [th])
6362   THENL [ASM SET_TAC[]; ALL_TAC] THEN
6363   ANTS_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
6364   ASM_SIMP_TAC[VSUM_UNION; FINITE_DIFF; INDEPENDENT_IMP_FINITE;
6365                SET_RULE `c INTER d = b ==> DISJOINT b (d DIFF c)`] THEN
6366   SUBGOAL_THEN `vsum b (\x:real^N. a x % x) = vsum c (\x. a x % x)`
6367    (fun th -> ASM_REWRITE_TAC[th]) THEN
6368   CONV_TAC SYM_CONV THEN MATCH_MP_TAC VSUM_SUPERSET THEN
6369   ASM_SIMP_TAC[VECTOR_MUL_EQ_0] THEN ASM_MESON_TAC[]);;
6370
6371 let DIM_KERNEL_COMPOSE = prove
6372  (`!f:real^M->real^N g:real^N->real^P.
6373         linear f /\ linear g
6374         ==> dim {x | (g o f) x = vec 0} <=
6375                 dim {x | f(x) = vec 0} +
6376                 dim {y | g(y) = vec 0}`,
6377   REPEAT STRIP_TAC THEN
6378   MP_TAC(ISPEC `{x | (f:real^M->real^N) x = vec 0}` BASIS_EXISTS_FINITE) THEN
6379   DISCH_THEN(X_CHOOSE_THEN `b:real^M->bool` STRIP_ASSUME_TAC) THEN
6380   SUBGOAL_THEN
6381    `?c. FINITE c /\
6382         IMAGE f c SUBSET {y | g(y):real^P = vec 0} /\
6383         independent (IMAGE (f:real^M->real^N) c) /\
6384         IMAGE f (:real^M) INTER {y | g(y) = vec 0} SUBSET span(IMAGE f c) /\
6385         (!x y. x IN c /\ y IN c ==> (f x = f y <=> x = y)) /\
6386         (IMAGE f c) HAS_SIZE dim (IMAGE f (:real^M) INTER {y | g(y) = vec 0})`
6387   STRIP_ASSUME_TAC THENL
6388    [MP_TAC(ISPEC `IMAGE (f:real^M->real^N) (:real^M) INTER
6389                  {x | (g:real^N->real^P) x = vec 0}` BASIS_EXISTS_FINITE) THEN
6390     REWRITE_TAC[SUBSET_INTER; GSYM CONJ_ASSOC; EXISTS_FINITE_SUBSET_IMAGE] THEN
6391     DISCH_THEN(X_CHOOSE_THEN `c:real^M->bool` STRIP_ASSUME_TAC) THEN
6392     MP_TAC(ISPECL [`f:real^M->real^N`; `c:real^M->bool`]
6393         IMAGE_INJECTIVE_IMAGE_OF_SUBSET) THEN
6394     MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real^M->bool` THEN
6395     DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC
6396      (CONJUNCTS_THEN2 SUBST_ALL_TAC ASSUME_TAC)) THEN
6397     ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[FINITE_SUBSET];
6398     ALL_TAC] THEN
6399   MATCH_MP_TAC LE_TRANS THEN
6400   EXISTS_TAC `dim(span(b UNION c:real^M->bool))` THEN CONJ_TAC THENL
6401    [MATCH_MP_TAC DIM_SUBSET THEN
6402     REWRITE_TAC[SUBSET; FORALL_IN_GSPEC; o_THM] THEN
6403     X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN
6404     SUBGOAL_THEN `(f:real^M->real^N) x IN span(IMAGE f c)` MP_TAC THENL
6405      [ASM SET_TAC[]; ALL_TAC] THEN
6406     ASM_SIMP_TAC[SPAN_LINEAR_IMAGE; IN_IMAGE; LEFT_IMP_EXISTS_THM] THEN
6407     X_GEN_TAC `y:real^M` THEN STRIP_TAC THEN
6408     SUBST1_TAC(VECTOR_ARITH `x:real^M = y + (x - y)`) THEN
6409     MATCH_MP_TAC SPAN_ADD THEN CONJ_TAC THENL
6410      [ASM_MESON_TAC[SUBSET_UNION; SPAN_MONO; SUBSET]; ALL_TAC] THEN
6411     MATCH_MP_TAC(SET_RULE
6412      `!t. x IN t /\ t SUBSET s ==> x IN s`) THEN
6413     EXISTS_TAC `{x | (f:real^M->real^N) x = vec 0}` THEN CONJ_TAC THENL
6414      [REWRITE_TAC[IN_ELIM_THM] THEN ASM_MESON_TAC[LINEAR_SUB; VECTOR_SUB_EQ];
6415       ASM_MESON_TAC[SUBSET_TRANS; SUBSET_UNION; SPAN_MONO]];
6416     REWRITE_TAC[DIM_SPAN] THEN MATCH_MP_TAC LE_TRANS THEN
6417     EXISTS_TAC `CARD(b UNION c:real^M->bool)` THEN
6418     ASM_SIMP_TAC[DIM_LE_CARD; FINITE_UNION; INDEPENDENT_IMP_FINITE] THEN
6419     MATCH_MP_TAC LE_TRANS THEN
6420     EXISTS_TAC `CARD(b:real^M->bool) + CARD(c:real^M->bool)` THEN
6421     ASM_SIMP_TAC[CARD_UNION_LE] THEN MATCH_MP_TAC LE_ADD2 THEN CONJ_TAC THENL
6422      [ASM_SIMP_TAC[GSYM DIM_EQ_CARD; DIM_SUBSET]; ALL_TAC] THEN
6423     MATCH_MP_TAC LE_TRANS THEN
6424     EXISTS_TAC `dim(IMAGE (f:real^M->real^N) c)` THEN CONJ_TAC THENL
6425      [ASM_SIMP_TAC[DIM_EQ_CARD] THEN
6426       ASM_MESON_TAC[CARD_IMAGE_INJ; LE_REFL];
6427       ASM_SIMP_TAC[GSYM DIM_EQ_CARD; DIM_SUBSET]]]);;
6428
6429 let DIM_ORTHOGONAL_SUM = prove
6430  (`!s t:real^N->bool.
6431         (!x y. x IN s /\ y IN t ==> x dot y = &0)
6432         ==> dim(s UNION t) = dim(s) + dim(t)`,
6433   REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM DIM_SPAN] THEN
6434   REWRITE_TAC[SPAN_UNION] THEN
6435   SIMP_TAC[GSYM DIM_SUMS_INTER; SUBSPACE_SPAN] THEN
6436   REWRITE_TAC[ARITH_RULE `x = x + y <=> y = 0`] THEN
6437   REWRITE_TAC[DIM_EQ_0; SUBSET; IN_INTER] THEN
6438   SUBGOAL_THEN
6439    `!x:real^N. x IN span s ==> !y:real^N. y IN span t ==> x dot y = &0`
6440   MP_TAC THENL
6441    [MATCH_MP_TAC SPAN_INDUCT THEN CONJ_TAC THENL
6442      [X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN REWRITE_TAC[IN_ELIM_THM] THEN
6443       MATCH_MP_TAC SPAN_INDUCT THEN ASM_SIMP_TAC[IN_ELIM_THM] THEN
6444       SIMP_TAC[subspace; IN_ELIM_THM; DOT_RMUL; DOT_RADD; DOT_RZERO] THEN
6445       REAL_ARITH_TAC;
6446       SIMP_TAC[subspace; IN_ELIM_THM; DOT_LMUL; DOT_LADD; DOT_LZERO] THEN
6447       REAL_ARITH_TAC];
6448     REWRITE_TAC[IN_SING] THEN MESON_TAC[DOT_EQ_0]]);;
6449
6450 (* ------------------------------------------------------------------------- *)
6451 (* More about rank from the rank/nullspace formula.                          *)
6452 (* ------------------------------------------------------------------------- *)
6453
6454 let RANK_NULLSPACE = prove
6455  (`!A:real^M^N. rank A + dim {x | A ** x = vec 0} = dimindex(:M)`,
6456   GEN_TAC THEN REWRITE_TAC[RANK_DIM_IM] THEN
6457   MATCH_MP_TAC DIM_IMAGE_KERNEL THEN
6458   REWRITE_TAC[MATRIX_VECTOR_MUL_LINEAR]);;
6459
6460 let RANK_SYLVESTER = prove
6461  (`!A:real^N^M B:real^P^N.
6462         rank(A) + rank(B) <= rank(A ** B) + dimindex(:N)`,
6463   REPEAT GEN_TAC THEN MATCH_MP_TAC(ARITH_RULE
6464     `!ia ib iab p:num.
6465         ra + ia = n /\
6466         rb + ib = p /\
6467         rab + iab = p /\
6468         iab <= ia + ib
6469         ==> ra + rb <= rab + n`) THEN
6470   MAP_EVERY EXISTS_TAC
6471    [`dim {x | (A:real^N^M) ** x = vec 0}`;
6472     `dim {x | (B:real^P^N) ** x = vec 0}`;
6473     `dim {x | ((A:real^N^M) ** (B:real^P^N)) ** x = vec 0}`;
6474     `dimindex(:P)`] THEN
6475   REWRITE_TAC[RANK_NULLSPACE] THEN
6476   REWRITE_TAC[GSYM MATRIX_VECTOR_MUL_ASSOC] THEN
6477   ONCE_REWRITE_TAC[ADD_SYM] THEN
6478   MATCH_MP_TAC(REWRITE_RULE[o_DEF] DIM_KERNEL_COMPOSE) THEN
6479   CONJ_TAC THEN GEN_REWRITE_TAC RAND_CONV [GSYM ETA_AX] THEN
6480   REWRITE_TAC[MATRIX_VECTOR_MUL_LINEAR]);;
6481
6482 let RANK_GRAM = prove
6483  (`!A:real^M^N. rank(transp A ** A) = rank A`,
6484   GEN_TAC THEN MATCH_MP_TAC(ARITH_RULE
6485    `!n n' k. r + n:num = k /\ r' + n' = k /\ n = n' ==> r = r'`) THEN
6486   MAP_EVERY EXISTS_TAC
6487    [`dim {x | (transp A ** (A:real^M^N)) ** x = vec 0}`;
6488     `dim {x | (A:real^M^N) ** x = vec 0}`;
6489     `dimindex(:M)`] THEN
6490   REWRITE_TAC[RANK_NULLSPACE] THEN AP_TERM_TAC THEN
6491   MATCH_MP_TAC SUBSET_ANTISYM THEN
6492   SIMP_TAC[SUBSET; IN_ELIM_THM; GSYM MATRIX_VECTOR_MUL_ASSOC;
6493            MATRIX_VECTOR_MUL_RZERO] THEN
6494   X_GEN_TAC `x:real^M` THEN
6495   DISCH_THEN(MP_TAC o AP_TERM `(dot) (x:real^M)`) THEN
6496   ONCE_REWRITE_TAC[GSYM DOT_LMUL_MATRIX] THEN
6497   REWRITE_TAC[VECTOR_MATRIX_MUL_TRANSP; TRANSP_TRANSP; DOT_RZERO] THEN
6498   REWRITE_TAC[DOT_EQ_0]);;
6499
6500 let RANK_TRIANGLE = prove
6501  (`!A B:real^M^N. rank(A + B) <= rank(A) + rank(B)`,
6502   REPEAT GEN_TAC THEN REWRITE_TAC[RANK_DIM_IM] THEN
6503   MP_TAC(ISPECL [`IMAGE (\x. (A:real^M^N) ** x) (:real^M)`;
6504                  `IMAGE (\x. (B:real^M^N) ** x) (:real^M)`]
6505                 DIM_SUMS_INTER) THEN
6506   ASM_SIMP_TAC[SUBSPACE_LINEAR_IMAGE; SUBSPACE_UNIV;
6507                MATRIX_VECTOR_MUL_LINEAR] THEN
6508   DISCH_THEN(SUBST1_TAC o SYM) THEN
6509   MATCH_MP_TAC(ARITH_RULE `x:num <= y ==> x <= y + z`) THEN
6510   MATCH_MP_TAC DIM_SUBSET THEN
6511   REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_UNIV;
6512               MATRIX_VECTOR_MUL_ADD_RDISTRIB] THEN
6513   REWRITE_TAC[IN_ELIM_THM; IN_IMAGE; IN_UNIV] THEN MESON_TAC[]);;
6514
6515 (* ------------------------------------------------------------------------- *)
6516 (* Infinity norm.                                                            *)
6517 (* ------------------------------------------------------------------------- *)
6518
6519 let infnorm = define
6520  `infnorm (x:real^N) = sup { abs(x$i) | 1 <= i /\ i <= dimindex(:N) }`;;
6521
6522 let NUMSEG_DIMINDEX_NONEMPTY = prove
6523  (`?i. i IN 1..dimindex(:N)`,
6524   REWRITE_TAC[MEMBER_NOT_EMPTY; NUMSEG_EMPTY; NOT_LT; DIMINDEX_GE_1]);;
6525
6526 let INFNORM_SET_IMAGE = prove
6527  (`{abs(x$i) | 1 <= i /\ i <= dimindex(:N)} =
6528    IMAGE (\i. abs(x$i)) (1..dimindex(:N))`,
6529   REWRITE_TAC[numseg] THEN SET_TAC[]);;
6530
6531 let INFNORM_SET_LEMMA = prove
6532  (`FINITE {abs((x:real^N)$i) | 1 <= i /\ i <= dimindex(:N)} /\
6533    ~({abs(x$i) | 1 <= i /\ i <= dimindex(:N)} = {})`,
6534   SIMP_TAC[INFNORM_SET_IMAGE; FINITE_NUMSEG; FINITE_IMAGE; IMAGE_EQ_EMPTY] THEN
6535   REWRITE_TAC[NUMSEG_EMPTY; NOT_LT; DIMINDEX_GE_1]);;
6536
6537 let INFNORM_POS_LE = prove
6538  (`!x. &0 <= infnorm x`,
6539   REWRITE_TAC[infnorm] THEN
6540   SIMP_TAC[REAL_LE_SUP_FINITE; INFNORM_SET_LEMMA] THEN
6541   REWRITE_TAC[INFNORM_SET_IMAGE; NUMSEG_DIMINDEX_NONEMPTY;
6542               EXISTS_IN_IMAGE; REAL_ABS_POS]);;
6543
6544 let INFNORM_TRIANGLE = prove
6545  (`!x y. infnorm(x + y) <= infnorm x + infnorm y`,
6546   REWRITE_TAC[infnorm] THEN
6547   SIMP_TAC[REAL_SUP_LE_FINITE; INFNORM_SET_LEMMA] THEN
6548   ONCE_REWRITE_TAC[GSYM REAL_LE_SUB_RADD] THEN
6549   SIMP_TAC[REAL_LE_SUP_FINITE; INFNORM_SET_LEMMA] THEN
6550   ONCE_REWRITE_TAC[REAL_ARITH `x - y <= z <=> x - z <= y`] THEN
6551   SIMP_TAC[REAL_LE_SUP_FINITE; INFNORM_SET_LEMMA] THEN
6552   REWRITE_TAC[INFNORM_SET_IMAGE; FORALL_IN_IMAGE; EXISTS_IN_IMAGE] THEN
6553   SIMP_TAC[VECTOR_ADD_COMPONENT; GSYM IN_NUMSEG] THEN
6554   MESON_TAC[NUMSEG_DIMINDEX_NONEMPTY;
6555             REAL_ARITH `abs(x + y) - abs(x) <= abs(y)`]);;
6556
6557 let INFNORM_EQ_0 = prove
6558  (`!x. infnorm x = &0 <=> x = vec 0`,
6559   REWRITE_TAC[GSYM REAL_LE_ANTISYM; INFNORM_POS_LE] THEN
6560   SIMP_TAC[infnorm; REAL_SUP_LE_FINITE; INFNORM_SET_LEMMA] THEN
6561   SIMP_TAC[FORALL_IN_IMAGE; INFNORM_SET_IMAGE; CART_EQ; VEC_COMPONENT] THEN
6562   REWRITE_TAC[IN_NUMSEG; REAL_ARITH `abs(x) <= &0 <=> x = &0`]);;
6563
6564 let INFNORM_0 = prove
6565  (`infnorm(vec 0) = &0`,
6566   REWRITE_TAC[INFNORM_EQ_0]);;
6567
6568 let INFNORM_NEG = prove
6569  (`!x. infnorm(--x) = infnorm x`,
6570   GEN_TAC THEN REWRITE_TAC[infnorm] THEN AP_TERM_TAC THEN
6571   REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN
6572   MESON_TAC[REAL_ABS_NEG; VECTOR_NEG_COMPONENT]);;
6573
6574 let INFNORM_SUB = prove
6575  (`!x y. infnorm(x - y) = infnorm(y - x)`,
6576   MESON_TAC[INFNORM_NEG; VECTOR_NEG_SUB]);;
6577
6578 let REAL_ABS_SUB_INFNORM = prove
6579  (`abs(infnorm x - infnorm y) <= infnorm(x - y)`,
6580   MATCH_MP_TAC(REAL_ARITH
6581     `nx <= n + ny /\ ny <= n + nx ==> abs(nx - ny) <= n`) THEN
6582   MESON_TAC[INFNORM_SUB; VECTOR_SUB_ADD2; INFNORM_TRIANGLE; VECTOR_ADD_SYM]);;
6583
6584 let REAL_ABS_INFNORM = prove
6585  (`!x. abs(infnorm x) = infnorm x`,
6586   REWRITE_TAC[real_abs; INFNORM_POS_LE]);;
6587
6588 let COMPONENT_LE_INFNORM = prove
6589  (`!x:real^N i. 1 <= i /\ i <= dimindex (:N) ==> abs(x$i) <= infnorm x`,
6590   REPEAT GEN_TAC THEN REWRITE_TAC[infnorm] THEN
6591   MP_TAC(SPEC `{ abs((x:real^N)$i) | 1 <= i /\ i <= dimindex(:N) }`
6592               SUP_FINITE) THEN
6593   REWRITE_TAC[INFNORM_SET_LEMMA] THEN
6594   SIMP_TAC[INFNORM_SET_IMAGE; FORALL_IN_IMAGE; IN_NUMSEG]);;
6595
6596 let INFNORM_MUL_LEMMA = prove
6597  (`!a x. infnorm(a % x) <= abs a * infnorm x`,
6598   REPEAT STRIP_TAC THEN GEN_REWRITE_TAC LAND_CONV [infnorm] THEN
6599   SIMP_TAC[REAL_SUP_LE_FINITE; INFNORM_SET_LEMMA] THEN
6600   REWRITE_TAC[FORALL_IN_IMAGE; INFNORM_SET_IMAGE] THEN
6601   SIMP_TAC[REAL_ABS_MUL; VECTOR_MUL_COMPONENT; IN_NUMSEG] THEN
6602   SIMP_TAC[COMPONENT_LE_INFNORM; REAL_LE_LMUL; REAL_ABS_POS]);;
6603
6604 let INFNORM_MUL = prove
6605  (`!a x:real^N. infnorm(a % x) = abs a * infnorm x`,
6606   REPEAT GEN_TAC THEN ASM_CASES_TAC `a = &0` THEN
6607   ASM_REWRITE_TAC[VECTOR_MUL_LZERO; INFNORM_0; REAL_ABS_0; REAL_MUL_LZERO] THEN
6608   REWRITE_TAC[GSYM REAL_LE_ANTISYM; INFNORM_MUL_LEMMA] THEN
6609   GEN_REWRITE_TAC (LAND_CONV o funpow 2 RAND_CONV) [GSYM VECTOR_MUL_LID] THEN
6610   FIRST_ASSUM(SUBST1_TAC o SYM o MATCH_MP REAL_MUL_LINV) THEN
6611   REWRITE_TAC[GSYM VECTOR_MUL_ASSOC] THEN
6612   MATCH_MP_TAC REAL_LE_TRANS THEN
6613   EXISTS_TAC `abs(a) * abs(inv a) * infnorm(a % x:real^N)` THEN
6614   ASM_SIMP_TAC[INFNORM_MUL_LEMMA; REAL_LE_LMUL; REAL_ABS_POS] THEN
6615   ASM_SIMP_TAC[REAL_MUL_ASSOC; GSYM REAL_ABS_MUL; REAL_MUL_RINV] THEN
6616   REAL_ARITH_TAC);;
6617
6618 let INFNORM_POS_LT = prove
6619  (`!x. &0 < infnorm x <=> ~(x = vec 0)`,
6620   MESON_TAC[REAL_LT_LE; INFNORM_POS_LE; INFNORM_EQ_0]);;
6621
6622 (* ------------------------------------------------------------------------- *)
6623 (* Prove that it differs only up to a bound from Euclidean norm.             *)
6624 (* ------------------------------------------------------------------------- *)
6625
6626 let INFNORM_LE_NORM = prove
6627  (`!x. infnorm(x) <= norm(x)`,
6628   SIMP_TAC[infnorm; REAL_SUP_LE_FINITE; INFNORM_SET_LEMMA] THEN
6629   REWRITE_TAC[IN_ELIM_THM] THEN MESON_TAC[COMPONENT_LE_NORM]);;
6630
6631 let NORM_LE_INFNORM = prove
6632  (`!x:real^N. norm(x) <= sqrt(&(dimindex(:N))) * infnorm(x)`,
6633   GEN_TAC THEN GEN_REWRITE_TAC (RAND_CONV o LAND_CONV o funpow 2 RAND_CONV)
6634    [GSYM CARD_NUMSEG_1] THEN
6635   REWRITE_TAC[vector_norm] THEN MATCH_MP_TAC REAL_LE_LSQRT THEN
6636   SIMP_TAC[DOT_POS_LE; SQRT_POS_LE; REAL_POS; REAL_LE_MUL; INFNORM_POS_LE;
6637            SQRT_POW_2; REAL_POW_MUL] THEN
6638   REWRITE_TAC[dot] THEN MATCH_MP_TAC SUM_BOUND THEN
6639   REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN REPEAT STRIP_TAC THEN
6640   REWRITE_TAC[GSYM REAL_POW_2] THEN ONCE_REWRITE_TAC[GSYM REAL_POW2_ABS] THEN
6641   MATCH_MP_TAC REAL_POW_LE2 THEN REWRITE_TAC[REAL_ABS_POS] THEN
6642   MATCH_MP_TAC(REAL_ARITH `x <= y ==> x <= abs(y)`) THEN
6643   SIMP_TAC[infnorm; REAL_LE_SUP_FINITE; INFNORM_SET_LEMMA] THEN
6644   REWRITE_TAC[IN_ELIM_THM] THEN ASM_MESON_TAC[REAL_LE_REFL]);;
6645
6646 (* ------------------------------------------------------------------------- *)
6647 (* Equality in Cauchy-Schwarz and triangle inequalities.                     *)
6648 (* ------------------------------------------------------------------------- *)
6649
6650 let NORM_CAUCHY_SCHWARZ_EQ = prove
6651  (`!x:real^N y. x dot y = norm(x) * norm(y) <=> norm(x) % y = norm(y) % x`,
6652   REPEAT STRIP_TAC THEN
6653   MAP_EVERY ASM_CASES_TAC [`x:real^N = vec 0`; `y:real^N = vec 0`] THEN
6654   ASM_REWRITE_TAC[NORM_0; REAL_MUL_LZERO; REAL_MUL_RZERO;
6655     DOT_LZERO; DOT_RZERO; VECTOR_MUL_LZERO; VECTOR_MUL_RZERO] THEN
6656   MP_TAC(ISPEC `norm(y:real^N) % x - norm(x:real^N) % y` DOT_EQ_0) THEN
6657   REWRITE_TAC[DOT_RSUB; DOT_LSUB; DOT_LMUL; DOT_RMUL; GSYM NORM_POW_2;
6658               REAL_POW_2; VECTOR_SUB_EQ] THEN
6659   REWRITE_TAC[DOT_SYM; REAL_ARITH
6660    `y * (y * x * x - x * d) - x * (y * d - x * y * y) =
6661     &2 * x * y * (x * y - d)`] THEN
6662   ASM_SIMP_TAC[REAL_ENTIRE; NORM_EQ_0; REAL_SUB_0; REAL_OF_NUM_EQ; ARITH] THEN
6663   REWRITE_TAC[EQ_SYM_EQ]);;
6664
6665 let NORM_CAUCHY_SCHWARZ_ABS_EQ = prove
6666  (`!x:real^N y. abs(x dot y) = norm(x) * norm(y) <=>
6667                 norm(x) % y = norm(y) % x \/ norm(x) % y = --norm(y) % x`,
6668   SIMP_TAC[REAL_ARITH `&0 <= a ==> (abs x = a <=> x = a \/ --x = a)`;
6669            REAL_LE_MUL; NORM_POS_LE; GSYM DOT_RNEG] THEN
6670   REPEAT GEN_TAC THEN
6671   GEN_REWRITE_TAC (LAND_CONV o funpow 3 RAND_CONV) [GSYM NORM_NEG] THEN
6672   REWRITE_TAC[NORM_CAUCHY_SCHWARZ_EQ] THEN REWRITE_TAC[NORM_NEG] THEN
6673   BINOP_TAC THEN VECTOR_ARITH_TAC);;
6674
6675 let NORM_TRIANGLE_EQ = prove
6676  (`!x y:real^N. norm(x + y) = norm(x) + norm(y) <=> norm(x) % y = norm(y) % x`,
6677   REPEAT GEN_TAC THEN REWRITE_TAC[GSYM NORM_CAUCHY_SCHWARZ_EQ] THEN
6678   MATCH_MP_TAC EQ_TRANS THEN
6679   EXISTS_TAC `norm(x + y:real^N) pow 2 = (norm(x) + norm(y)) pow 2` THEN
6680   CONJ_TAC THENL
6681    [REWRITE_TAC[REAL_RING `x pow 2 = y pow 2 <=> x = y \/ x + y = &0`] THEN
6682     MAP_EVERY (MP_TAC o C ISPEC NORM_POS_LE)
6683      [`x + y:real^N`; `x:real^N`; `y:real^N`] THEN
6684     REAL_ARITH_TAC;
6685     REWRITE_TAC[NORM_POW_2; DOT_LADD; DOT_RADD; REAL_ARITH
6686      `(x + y) pow 2 = x pow 2 + y pow 2 + &2 * x * y`] THEN
6687     REWRITE_TAC[DOT_SYM] THEN REAL_ARITH_TAC]);;
6688
6689 let DIST_TRIANGLE_EQ = prove
6690  (`!x y z. dist(x,z) = dist(x,y) + dist(y,z) <=>
6691                 norm (x - y) % (y - z) = norm (y - z) % (x - y)`,
6692   REWRITE_TAC[GSYM NORM_TRIANGLE_EQ] THEN NORM_ARITH_TAC);;
6693
6694 let NORM_CROSS_MULTIPLY = prove
6695  (`!a b x y:real^N.
6696         a % x = b % y /\ &0 < a /\ &0 < b
6697         ==> norm y % x = norm x % y`,
6698   REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN
6699   ASM_CASES_TAC `y:real^N = vec 0` THEN
6700   ASM_SIMP_TAC[VECTOR_MUL_EQ_0; REAL_LT_IMP_NZ; VECTOR_MUL_RZERO] THEN
6701   DISCH_THEN(MP_TAC o AP_TERM `\x:real^N. inv(a) % x`) THEN
6702   ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LINV; REAL_LT_IMP_NZ; VECTOR_MUL_LID;
6703                NORM_MUL; REAL_ABS_MUL; REAL_ABS_INV] THEN
6704   ASM_SIMP_TAC[real_abs; REAL_LT_IMP_LE; REAL_MUL_AC]);;
6705
6706 (* ------------------------------------------------------------------------- *)
6707 (* Collinearity.                                                             *)
6708 (* ------------------------------------------------------------------------- *)
6709
6710 let collinear = new_definition
6711  `collinear s <=> ?u. !x y. x IN s /\ y IN s ==> ?c. x - y = c % u`;;
6712
6713 let COLLINEAR_SUBSET = prove
6714  (`!s t. collinear t /\ s SUBSET t ==> collinear s`,
6715   REWRITE_TAC[collinear] THEN SET_TAC[]);;
6716
6717 let COLLINEAR_EMPTY = prove
6718  (`collinear {}`,
6719   REWRITE_TAC[collinear; NOT_IN_EMPTY]);;
6720
6721 let COLLINEAR_SING = prove
6722  (`!x. collinear {x}`,
6723   SIMP_TAC[collinear; IN_SING; VECTOR_SUB_REFL] THEN
6724   MESON_TAC[VECTOR_MUL_LZERO]);;
6725
6726 let COLLINEAR_2 = prove
6727  (`!x y:real^N. collinear {x,y}`,
6728   REPEAT GEN_TAC THEN REWRITE_TAC[collinear; IN_INSERT; NOT_IN_EMPTY] THEN
6729   EXISTS_TAC `x - y:real^N` THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THENL
6730    [EXISTS_TAC `&0`; EXISTS_TAC `&1`; EXISTS_TAC `-- &1`; EXISTS_TAC `&0`] THEN
6731   VECTOR_ARITH_TAC);;
6732
6733 let COLLINEAR_SMALL = prove
6734  (`!s. FINITE s /\ CARD s <= 2 ==> collinear s`,
6735   REWRITE_TAC[ARITH_RULE `s <= 2 <=> s = 0 \/ s = 1 \/ s = 2`] THEN
6736   REWRITE_TAC[LEFT_OR_DISTRIB; GSYM HAS_SIZE] THEN
6737   CONV_TAC(ONCE_DEPTH_CONV HAS_SIZE_CONV) THEN
6738   REPEAT STRIP_TAC THEN
6739   ASM_REWRITE_TAC[COLLINEAR_EMPTY; COLLINEAR_SING; COLLINEAR_2]);;
6740
6741 let COLLINEAR_3 = prove
6742  (`!x y z. collinear {x,y,z} <=> collinear {vec 0,x - y,z - y}`,
6743   REPEAT GEN_TAC THEN
6744   REWRITE_TAC[collinear; FORALL_IN_INSERT; IMP_CONJ; RIGHT_FORALL_IMP_THM;
6745               NOT_IN_EMPTY] THEN
6746   AP_TERM_TAC THEN ABS_TAC THEN
6747   MESON_TAC[VECTOR_ARITH `x - y = (x - y) - vec 0`;
6748             VECTOR_ARITH `y - x = vec 0 - (x - y)`;
6749             VECTOR_ARITH `x - z:real^N = (x - y) - (z - y)`]);;
6750
6751 let COLLINEAR_LEMMA = prove
6752  (`!x y:real^N. collinear {vec 0,x,y} <=>
6753                    x = vec 0 \/ y = vec 0 \/ ?c. y = c % x`,
6754   REPEAT GEN_TAC THEN
6755   MAP_EVERY ASM_CASES_TAC [`x:real^N = vec 0`; `y:real^N = vec 0`] THEN
6756   TRY(ASM_REWRITE_TAC[INSERT_AC; COLLINEAR_SING; COLLINEAR_2] THEN NO_TAC) THEN
6757   ASM_REWRITE_TAC[collinear] THEN EQ_TAC THENL
6758    [DISCH_THEN(X_CHOOSE_THEN `u:real^N`
6759      (fun th -> MP_TAC(SPECL [`x:real^N`; `vec 0:real^N`] th) THEN
6760                 MP_TAC(SPECL [`y:real^N`; `vec 0:real^N`] th))) THEN
6761     REWRITE_TAC[IN_INSERT; VECTOR_SUB_RZERO] THEN
6762     DISCH_THEN(X_CHOOSE_THEN `e:real` SUBST_ALL_TAC) THEN
6763     DISCH_THEN(X_CHOOSE_THEN `d:real` SUBST_ALL_TAC) THEN
6764     EXISTS_TAC `e / d` THEN REWRITE_TAC[VECTOR_MUL_ASSOC] THEN
6765     RULE_ASSUM_TAC(REWRITE_RULE[VECTOR_MUL_EQ_0; DE_MORGAN_THM]) THEN
6766     ASM_SIMP_TAC[REAL_DIV_RMUL];
6767     STRIP_TAC THEN EXISTS_TAC `x:real^N` THEN ASM_REWRITE_TAC[] THEN
6768     REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] THEN REPEAT STRIP_TAC THEN
6769     ASM_REWRITE_TAC[] THENL
6770      [EXISTS_TAC `&0`; EXISTS_TAC `-- &1`; EXISTS_TAC `--c`;
6771       EXISTS_TAC `&1`; EXISTS_TAC `&0`; EXISTS_TAC `&1 - c`;
6772       EXISTS_TAC `c:real`; EXISTS_TAC `c - &1`; EXISTS_TAC `&0`] THEN
6773     VECTOR_ARITH_TAC]);;
6774
6775 let COLLINEAR_LEMMA_ALT = prove
6776  (`!x y. collinear {vec 0,x,y} <=> x = vec 0 \/ ?c. y = c % x`,
6777   REWRITE_TAC[COLLINEAR_LEMMA] THEN MESON_TAC[VECTOR_MUL_LZERO]);;
6778
6779 let NORM_CAUCHY_SCHWARZ_EQUAL = prove
6780  (`!x y:real^N. abs(x dot y) = norm(x) * norm(y) <=> collinear {vec 0,x,y}`,
6781   REPEAT GEN_TAC THEN REWRITE_TAC[NORM_CAUCHY_SCHWARZ_ABS_EQ] THEN
6782   MAP_EVERY ASM_CASES_TAC [`x:real^N = vec 0`; `y:real^N = vec 0`] THEN
6783   TRY(ASM_REWRITE_TAC[INSERT_AC; COLLINEAR_SING; COLLINEAR_2; NORM_0;
6784                       VECTOR_MUL_LZERO; VECTOR_MUL_RZERO] THEN NO_TAC) THEN
6785   ASM_REWRITE_TAC[COLLINEAR_LEMMA] THEN EQ_TAC THENL
6786    [STRIP_TAC THENL
6787      [FIRST_X_ASSUM(MP_TAC o AP_TERM
6788        `(%) (inv(norm(x:real^N))):real^N->real^N`);
6789       FIRST_X_ASSUM(MP_TAC o AP_TERM
6790        `(%) (--inv(norm(x:real^N))):real^N->real^N`)] THEN
6791     ASM_REWRITE_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LNEG] THEN
6792     ASM_SIMP_TAC[REAL_MUL_LINV; NORM_EQ_0; VECTOR_MUL_LNEG; VECTOR_MUL_LID;
6793                  VECTOR_ARITH `--x = --y <=> x:real^N = y`] THEN
6794     MESON_TAC[];
6795     STRIP_TAC THEN ASM_REWRITE_TAC[NORM_MUL; VECTOR_MUL_ASSOC] THEN
6796     MATCH_MP_TAC(MESON[]
6797       `t = a \/ t = b ==> t % x = a % x \/ t % x = b % x`) THEN
6798     REWRITE_TAC[GSYM REAL_MUL_LNEG;
6799                 REAL_ARITH `x * c = d * x <=> x * (c - d) = &0`] THEN
6800     ASM_REWRITE_TAC[REAL_ENTIRE; NORM_EQ_0] THEN REAL_ARITH_TAC]);;
6801
6802 let DOT_CAUCHY_SCHWARZ_EQUAL = prove
6803  (`!x y:real^N.
6804         (x dot y) pow 2 = (x dot x) * (y dot y) <=>
6805         collinear {vec 0,x,y}`,
6806   REWRITE_TAC[GSYM NORM_CAUCHY_SCHWARZ_EQUAL] THEN
6807   REPEAT GEN_TAC THEN MATCH_MP_TAC(REAL_ARITH
6808    `&0 <= y /\ (u:real = v <=> x = abs y) ==> (u = v <=> x = y)`) THEN
6809   SIMP_TAC[NORM_POS_LE; REAL_LE_MUL] THEN
6810   REWRITE_TAC[REAL_EQ_SQUARE_ABS] THEN REWRITE_TAC[REAL_POW_MUL; NORM_POW_2]);;
6811
6812 let COLLINEAR_3_EXPAND = prove
6813  (`!a b c:real^N. collinear{a,b,c} <=> a = c \/ ?u. b = u % a + (&1 - u) % c`,
6814   REPEAT GEN_TAC THEN
6815   ONCE_REWRITE_TAC[SET_RULE `{a,b,c} = {a,c,b}`] THEN
6816   ONCE_REWRITE_TAC[COLLINEAR_3] THEN
6817   REWRITE_TAC[COLLINEAR_LEMMA; VECTOR_SUB_EQ] THEN
6818   ASM_CASES_TAC `a:real^N = c` THEN ASM_REWRITE_TAC[] THEN
6819   ASM_CASES_TAC `b:real^N = c` THEN
6820   ASM_REWRITE_TAC[VECTOR_ARITH `u % c + (&1 - u) % c = c`] THENL
6821    [EXISTS_TAC `&0` THEN VECTOR_ARITH_TAC;
6822     AP_TERM_TAC THEN ABS_TAC THEN VECTOR_ARITH_TAC]);;
6823
6824 let COLLINEAR_TRIPLES = prove
6825  (`!s a b:real^N.
6826         ~(a = b)
6827         ==> (collinear(a INSERT b INSERT s) <=>
6828              !x. x IN s ==> collinear{a,b,x})`,
6829   REPEAT STRIP_TAC THEN EQ_TAC THENL
6830    [REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
6831      (REWRITE_RULE[IMP_CONJ] COLLINEAR_SUBSET)) THEN
6832     ASM SET_TAC[];
6833     ONCE_REWRITE_TAC[SET_RULE `{a,b,x} = {a,x,b}`] THEN
6834     ASM_REWRITE_TAC[COLLINEAR_3_EXPAND] THEN DISCH_TAC THEN
6835     SUBGOAL_THEN
6836      `!x:real^N. x IN (a INSERT b INSERT s) ==> ?u. x = u % a + (&1 - u) % b`
6837     MP_TAC THENL
6838      [ASM_REWRITE_TAC[FORALL_IN_INSERT] THEN CONJ_TAC THENL
6839        [EXISTS_TAC `&1` THEN VECTOR_ARITH_TAC;
6840         EXISTS_TAC `&0` THEN VECTOR_ARITH_TAC];
6841       POP_ASSUM_LIST(K ALL_TAC) THEN DISCH_TAC THEN
6842       REWRITE_TAC[collinear] THEN EXISTS_TAC `b - a:real^N` THEN
6843       MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN STRIP_TAC THEN
6844       FIRST_X_ASSUM(fun th -> MP_TAC(SPEC `x:real^N` th) THEN MP_TAC(SPEC
6845         `y:real^N` th)) THEN
6846       ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN
6847       ASM_REWRITE_TAC[VECTOR_ARITH
6848        `(u % a + (&1 - u) % b) - (v % a + (&1 - v) % b):real^N =
6849         (v - u) % (b - a)`] THEN
6850       MESON_TAC[]]]);;
6851
6852 let COLLINEAR_4_3 = prove
6853  (`!a b c d:real^N.
6854         ~(a = b)
6855         ==> (collinear {a,b,c,d} <=> collinear{a,b,c} /\ collinear{a,b,d})`,
6856   REPEAT STRIP_TAC THEN
6857   MP_TAC(ISPECL [`{c:real^N,d}`; `a:real^N`; `b:real^N`]
6858     COLLINEAR_TRIPLES) THEN
6859   ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN
6860   REWRITE_TAC[FORALL_IN_INSERT; NOT_IN_EMPTY]);;
6861
6862 let COLLINEAR_3_TRANS = prove
6863  (`!a b c d:real^N.
6864         collinear{a,b,c} /\ collinear{b,c,d} /\ ~(b = c) ==> collinear{a,b,d}`,
6865   REPEAT STRIP_TAC THEN MATCH_MP_TAC COLLINEAR_SUBSET THEN
6866   EXISTS_TAC `{b:real^N,c,a,d}` THEN ASM_SIMP_TAC[COLLINEAR_4_3] THEN
6867   CONJ_TAC THENL [ALL_TAC; SET_TAC[]] THEN
6868   REPEAT(POP_ASSUM MP_TAC) THEN SIMP_TAC[INSERT_AC]);;
6869
6870 let ORTHOGONAL_TO_ORTHOGONAL_2D = prove
6871  (`!x y z:real^2.
6872      ~(x = vec 0) /\ orthogonal x y /\ orthogonal x z
6873      ==> collinear {vec 0,y,z}`,
6874   REWRITE_TAC[orthogonal; GSYM DOT_CAUCHY_SCHWARZ_EQUAL; GSYM DOT_EQ_0] THEN
6875   REWRITE_TAC[DOT_2] THEN CONV_TAC REAL_RING);;
6876
6877 let COLLINEAR_3_2D = prove
6878  (`!x y z:real^2. collinear{x,y,z} <=>
6879                   (z$1 - x$1) * (y$2 - x$2) = (y$1 - x$1) * (z$2 - x$2)`,
6880   ONCE_REWRITE_TAC[COLLINEAR_3] THEN
6881   REWRITE_TAC[GSYM DOT_CAUCHY_SCHWARZ_EQUAL] THEN
6882   REWRITE_TAC[DOT_2; VECTOR_SUB_COMPONENT] THEN CONV_TAC REAL_RING);;
6883
6884 (* ------------------------------------------------------------------------- *)
6885 (* Between-ness.                                                             *)
6886 (* ------------------------------------------------------------------------- *)
6887
6888 let between = new_definition
6889  `between x (a,b) <=> dist(a,b) = dist(a,x) + dist(x,b)`;;
6890
6891 let BETWEEN_REFL = prove
6892  (`!a b. between a (a,b) /\ between b (a,b) /\ between a (a,a)`,
6893   REWRITE_TAC[between] THEN NORM_ARITH_TAC);;
6894
6895 let BETWEEN_REFL_EQ = prove
6896  (`!a x. between x (a,a) <=> x = a`,
6897   REWRITE_TAC[between] THEN NORM_ARITH_TAC);;
6898
6899 let BETWEEN_SYM = prove
6900  (`!a b x. between x (a,b) <=> between x (b,a)`,
6901   REWRITE_TAC[between] THEN NORM_ARITH_TAC);;
6902
6903 let BETWEEN_ANTISYM = prove
6904  (`!a b c. between a (b,c) /\ between b (a,c) ==> a = b`,
6905   REWRITE_TAC[between; DIST_SYM] THEN NORM_ARITH_TAC);;
6906
6907 let BETWEEN_TRANS = prove
6908  (`!a b c d. between a (b,c) /\ between d (a,c) ==> between d (b,c)`,
6909   REWRITE_TAC[between; DIST_SYM] THEN NORM_ARITH_TAC);;
6910
6911 let BETWEEN_TRANS_2 = prove
6912  (`!a b c d. between a (b,c) /\ between d (a,b) ==> between a (c,d)`,
6913   REWRITE_TAC[between; DIST_SYM] THEN NORM_ARITH_TAC);;
6914
6915 let BETWEEN_NORM = prove
6916  (`!a b x:real^N.
6917      between x (a,b) <=> norm(x - a) % (b - x) = norm(b - x) % (x - a)`,
6918   REPEAT GEN_TAC THEN REWRITE_TAC[between; DIST_TRIANGLE_EQ] THEN
6919   REWRITE_TAC[NORM_SUB] THEN VECTOR_ARITH_TAC);;
6920
6921 let BETWEEN_DOT = prove
6922  (`!a b x:real^N.
6923      between x (a,b) <=> (x - a) dot (b - x) = norm(x - a) * norm(b - x)`,
6924   REWRITE_TAC[BETWEEN_NORM; NORM_CAUCHY_SCHWARZ_EQ]);;
6925
6926 let BETWEEN_IMP_COLLINEAR = prove
6927  (`!a b x:real^N. between x (a,b) ==> collinear {a,x,b}`,
6928   REPEAT GEN_TAC THEN MAP_EVERY
6929    (fun t -> ASM_CASES_TAC t THEN
6930              TRY(ASM_REWRITE_TAC[INSERT_AC; COLLINEAR_2] THEN NO_TAC))
6931    [`x:real^N = a`; `x:real^N = b`; `a:real^N = b`] THEN
6932   ONCE_REWRITE_TAC[COLLINEAR_3; BETWEEN_NORM] THEN
6933   DISCH_TAC THEN REWRITE_TAC[COLLINEAR_LEMMA] THEN
6934   REPEAT DISJ2_TAC THEN EXISTS_TAC `--(norm(b - x:real^N) / norm(x - a))` THEN
6935   MATCH_MP_TAC VECTOR_MUL_LCANCEL_IMP THEN EXISTS_TAC `norm(x - a:real^N)` THEN
6936   ASM_REWRITE_TAC[VECTOR_MUL_ASSOC; REAL_MUL_RNEG] THEN
6937   ASM_SIMP_TAC[REAL_DIV_LMUL; NORM_EQ_0; VECTOR_SUB_EQ] THEN
6938   VECTOR_ARITH_TAC);;
6939
6940 let COLLINEAR_BETWEEN_CASES = prove
6941  (`!a b c:real^N.
6942         collinear {a,b,c} <=>
6943         between a (b,c) \/ between b (c,a) \/ between c (a,b)`,
6944   REPEAT STRIP_TAC THEN EQ_TAC THENL
6945    [REWRITE_TAC[COLLINEAR_3_EXPAND] THEN
6946     ASM_CASES_TAC `c:real^N = a` THEN ASM_REWRITE_TAC[BETWEEN_REFL] THEN
6947     STRIP_TAC THEN ASM_REWRITE_TAC[between; dist] THEN
6948     REWRITE_TAC[VECTOR_ARITH `(u % a + (&1 - u) % c) - c = --u % (c - a)`;
6949       VECTOR_ARITH `(u % a + (&1 - u) % c) - a = (&1 - u) % (c - a)`;
6950       VECTOR_ARITH `c - (u % a + (&1 - u) % c) = u % (c - a)`;
6951       VECTOR_ARITH `a - (u % a + (&1 - u) % c) = (u - &1) % (c - a)`] THEN
6952     REWRITE_TAC[NORM_MUL] THEN
6953     SUBST1_TAC(NORM_ARITH `norm(a - c:real^N) = norm(c - a)`) THEN
6954     REWRITE_TAC[REAL_ARITH `a * c + c = (a + &1) * c`; GSYM REAL_ADD_RDISTRIB;
6955                 REAL_ARITH `c + a * c = (a + &1) * c`] THEN
6956     ASM_REWRITE_TAC[REAL_EQ_MUL_RCANCEL;
6957                     REAL_RING `n = x * n <=> n = &0 \/ x = &1`] THEN
6958     ASM_REWRITE_TAC[NORM_EQ_0; VECTOR_SUB_EQ] THEN REAL_ARITH_TAC;
6959     DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN (MP_TAC o MATCH_MP
6960       BETWEEN_IMP_COLLINEAR)) THEN
6961     REWRITE_TAC[INSERT_AC]]);;
6962
6963 let COLLINEAR_DIST_BETWEEN = prove
6964  (`!a b x. collinear {x,a,b} /\
6965            dist(x,a) <= dist(a,b) /\ dist(x,b) <= dist(a,b)
6966            ==> between x (a,b)`,
6967   SIMP_TAC[COLLINEAR_BETWEEN_CASES; between; DIST_SYM] THEN NORM_ARITH_TAC);;
6968
6969 let COLLINEAR_1 = prove
6970  (`!s:real^1->bool. collinear s`,
6971   GEN_TAC THEN MATCH_MP_TAC COLLINEAR_SUBSET THEN
6972   EXISTS_TAC `(vec 0:real^1) INSERT (vec 1) INSERT s` THEN
6973   CONJ_TAC THENL [ALL_TAC; SET_TAC[]] THEN
6974   W(MP_TAC o PART_MATCH (lhs o rand) COLLINEAR_TRIPLES o snd) THEN
6975   REWRITE_TAC[VEC_EQ; ARITH_EQ] THEN DISCH_THEN SUBST1_TAC THEN
6976   REWRITE_TAC[COLLINEAR_BETWEEN_CASES] THEN
6977   REWRITE_TAC[between; DIST_REAL; GSYM drop; DROP_VEC; REAL_ABS_NUM] THEN
6978   REAL_ARITH_TAC);;
6979
6980 (* ------------------------------------------------------------------------- *)
6981 (* Midpoint between two points.                                              *)
6982 (* ------------------------------------------------------------------------- *)
6983
6984 let midpoint = new_definition
6985  `midpoint(a,b) = inv(&2) % (a + b)`;;
6986
6987 let MIDPOINT_REFL = prove
6988  (`!x. midpoint(x,x) = x`,
6989   REWRITE_TAC[midpoint] THEN VECTOR_ARITH_TAC);;
6990
6991 let MIDPOINT_SYM = prove
6992  (`!a b. midpoint(a,b) = midpoint(b,a)`,
6993   REWRITE_TAC[midpoint; VECTOR_ADD_SYM]);;
6994
6995 let DIST_MIDPOINT = prove
6996  (`!a b. dist(a,midpoint(a,b)) = dist(a,b) / &2 /\
6997          dist(b,midpoint(a,b)) = dist(a,b) / &2 /\
6998          dist(midpoint(a,b),a) = dist(a,b) / &2 /\
6999          dist(midpoint(a,b),b) = dist(a,b) / &2`,
7000   REWRITE_TAC[midpoint] THEN NORM_ARITH_TAC);;
7001
7002 let MIDPOINT_EQ_ENDPOINT = prove
7003  (`!a b. (midpoint(a,b) = a <=> a = b) /\
7004          (midpoint(a,b) = b <=> a = b) /\
7005          (a = midpoint(a,b) <=> a = b) /\
7006          (b = midpoint(a,b) <=> a = b)`,
7007   REWRITE_TAC[midpoint] THEN NORM_ARITH_TAC);;
7008
7009 let BETWEEN_MIDPOINT = prove
7010  (`!a b. between (midpoint(a,b)) (a,b) /\ between (midpoint(a,b)) (b,a)`,
7011   REWRITE_TAC[between; midpoint] THEN NORM_ARITH_TAC);;
7012
7013 let MIDPOINT_LINEAR_IMAGE = prove
7014  (`!f a b. linear f ==> midpoint(f a,f b) = f(midpoint(a,b))`,
7015   SIMP_TAC[midpoint; LINEAR_ADD; LINEAR_CMUL]);;
7016
7017 let COLLINEAR_MIDPOINT = prove
7018  (`!a b. collinear{a,midpoint(a,b),b}`,
7019   REPEAT GEN_TAC THEN REWRITE_TAC[COLLINEAR_3_EXPAND; midpoint] THEN
7020   DISJ2_TAC THEN EXISTS_TAC `&1 / &2` THEN VECTOR_ARITH_TAC);;
7021
7022 let MIDPOINT_COLLINEAR = prove
7023  (`!a b c:real^N.
7024         ~(a = c)
7025         ==> (b = midpoint(a,c) <=> collinear{a,b,c} /\ dist(a,b) = dist(b,c))`,
7026   REPEAT STRIP_TAC THEN
7027   MATCH_MP_TAC(TAUT `(a ==> b) /\ (b ==> (a <=> c)) ==> (a <=> b /\ c)`) THEN
7028   SIMP_TAC[COLLINEAR_MIDPOINT] THEN ASM_REWRITE_TAC[COLLINEAR_3_EXPAND] THEN
7029   STRIP_TAC THEN ASM_REWRITE_TAC[midpoint; dist] THEN
7030   REWRITE_TAC
7031    [VECTOR_ARITH `a - (u % a + (&1 - u) % c) = (&1 - u) % (a - c)`;
7032     VECTOR_ARITH `(u % a + (&1 - u) % c) - c = u % (a - c)`;
7033     VECTOR_ARITH `u % a + (&1 - u) % c = inv (&2) % (a + c) <=>
7034                   (u - &1 / &2) % (a - c) = vec 0`] THEN
7035   ASM_SIMP_TAC[NORM_MUL; REAL_EQ_MUL_RCANCEL; NORM_EQ_0; VECTOR_SUB_EQ;
7036                VECTOR_MUL_EQ_0] THEN
7037   REAL_ARITH_TAC);;
7038
7039 (* ------------------------------------------------------------------------- *)
7040 (* General "one way" lemma for properties preserved by injective map.        *)
7041 (* ------------------------------------------------------------------------- *)
7042
7043 let WLOG_LINEAR_INJECTIVE_IMAGE_2 = prove
7044  (`!P Q. (!f s. P s /\ linear f ==> Q(IMAGE f s)) /\
7045          (!g t. Q t /\ linear g ==> P(IMAGE g t))
7046          ==> !f:real^M->real^N.
7047                 linear f /\ (!x y. f x = f y ==> x = y)
7048                 ==> !s. Q(IMAGE f s) <=> P s`,
7049   REPEAT STRIP_TAC THEN EQ_TAC THEN ASM_SIMP_TAC[] THEN DISCH_TAC THEN
7050   MP_TAC(ISPEC `f:real^M->real^N` LINEAR_INJECTIVE_LEFT_INVERSE) THEN
7051   ASM_REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM] THEN
7052   DISCH_THEN(X_CHOOSE_THEN `g:real^N->real^M` STRIP_ASSUME_TAC) THEN
7053   FIRST_X_ASSUM(MP_TAC o SPECL
7054    [`g:real^N->real^M`; `IMAGE (f:real^M->real^N) s`]) THEN
7055   ASM_REWRITE_TAC[GSYM IMAGE_o; o_DEF; IMAGE_ID]);;
7056
7057 let WLOG_LINEAR_INJECTIVE_IMAGE_2_ALT = prove
7058  (`!P Q f s. (!h u. P u /\ linear h ==> Q(IMAGE h u)) /\
7059              (!g t. Q t /\ linear g ==> P(IMAGE g t)) /\
7060              linear f /\ (!x y. f x = f y ==> x = y)
7061              ==> (Q(IMAGE f s) <=> P s)`,
7062   REPEAT GEN_TAC THEN STRIP_TAC THEN
7063   MATCH_MP_TAC(REWRITE_RULE[RIGHT_IMP_FORALL_THM; IMP_IMP]
7064      WLOG_LINEAR_INJECTIVE_IMAGE_2) THEN
7065   ASM_REWRITE_TAC[]);;
7066
7067 let WLOG_LINEAR_INJECTIVE_IMAGE = prove
7068  (`!P. (!f s. P s /\ linear f ==> P(IMAGE f s))
7069        ==> !f:real^N->real^N. linear f /\ (!x y. f x = f y ==> x = y)
7070                               ==> !s. P(IMAGE f s) <=> P s`,
7071   GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC WLOG_LINEAR_INJECTIVE_IMAGE_2 THEN
7072   ASM_REWRITE_TAC[]);;
7073
7074 let WLOG_LINEAR_INJECTIVE_IMAGE_ALT = prove
7075  (`!P f s. (!g t. P t /\ linear g ==> P(IMAGE g t)) /\
7076            linear f /\ (!x y. f x = f y ==> x = y)
7077            ==> (P(IMAGE f s) <=> P s)`,
7078   REPEAT GEN_TAC THEN STRIP_TAC THEN
7079   MATCH_MP_TAC(REWRITE_RULE[RIGHT_IMP_FORALL_THM; IMP_IMP]
7080      WLOG_LINEAR_INJECTIVE_IMAGE) THEN
7081   ASM_REWRITE_TAC[]);;
7082
7083 (* ------------------------------------------------------------------------- *)
7084 (* Inference rule to apply it conveniently.                                  *)
7085 (*                                                                           *)
7086 (*   |- !f s. P s /\ linear f ==> P(IMAGE f s)  [or /\ commuted]             *)
7087 (* ---------------------------------------------------------------           *)
7088 (*   |- !f s. linear f /\ (!x y. f x = f y ==> x = y)                        *)
7089 (*            ==> (Q(IMAGE f s) <=> P s)                                     *)
7090 (* ------------------------------------------------------------------------- *)
7091
7092 let LINEAR_INVARIANT_RULE th =
7093   let [f;s] = fst(strip_forall(concl th)) in
7094   let (rm,rn) = dest_fun_ty (type_of f) in
7095   let m = last(snd(dest_type rm)) and n = last(snd(dest_type rn)) in
7096   let th' = INST_TYPE [m,n; n,m] th in
7097   let th0 = CONJ th th' in
7098   let th1 = try MATCH_MP WLOG_LINEAR_INJECTIVE_IMAGE_2 th0
7099             with Failure _ ->
7100                 MATCH_MP WLOG_LINEAR_INJECTIVE_IMAGE_2
7101             (GEN_REWRITE_RULE (BINOP_CONV o ONCE_DEPTH_CONV) [CONJ_SYM] th0) in
7102   GEN_REWRITE_RULE BINDER_CONV [RIGHT_IMP_FORALL_THM] th1;;
7103
7104 (* ------------------------------------------------------------------------- *)
7105 (* Immediate application.                                                    *)
7106 (* ------------------------------------------------------------------------- *)
7107
7108 let SUBSPACE_LINEAR_IMAGE_EQ = prove
7109  (`!f s. linear f /\ (!x y. f x = f y ==> x = y)
7110          ==> (subspace (IMAGE f s) <=> subspace s)`,
7111   MATCH_ACCEPT_TAC(LINEAR_INVARIANT_RULE SUBSPACE_LINEAR_IMAGE));;
7112
7113 (* ------------------------------------------------------------------------- *)
7114 (* Storage of useful "invariance under linear map / translation" theorems.   *)
7115 (* ------------------------------------------------------------------------- *)
7116
7117 let invariant_under_linear = ref([]:thm list);;
7118
7119 let invariant_under_translation = ref([]:thm list);;
7120
7121 let scaling_theorems = ref([]:thm list);;
7122
7123 (* ------------------------------------------------------------------------- *)
7124 (* Scaling theorems and derivation from linear invariance.                   *)
7125 (* ------------------------------------------------------------------------- *)
7126
7127 let LINEAR_SCALING = prove
7128  (`!c. linear(\x:real^N. c % x)`,
7129   REWRITE_TAC[linear] THEN VECTOR_ARITH_TAC);;
7130
7131 let INJECTIVE_SCALING = prove
7132  (`!c. (!x y:real^N. c % x = c % y ==> x = y) <=> ~(c = &0)`,
7133   GEN_TAC THEN REWRITE_TAC[VECTOR_MUL_LCANCEL] THEN
7134   ASM_CASES_TAC `c:real = &0` THEN ASM_REWRITE_TAC[] THEN
7135   DISCH_THEN(MP_TAC o SPECL [`vec 0:real^N`; `vec 1:real^N`]) THEN
7136   REWRITE_TAC[VEC_EQ; ARITH]);;
7137
7138 let SURJECTIVE_SCALING = prove
7139  (`!c. (!y:real^N. ?x. c % x = y) <=> ~(c = &0)`,
7140   ASM_SIMP_TAC[LINEAR_SURJECTIVE_IFF_INJECTIVE; LINEAR_SCALING] THEN
7141   REWRITE_TAC[INJECTIVE_SCALING]);;
7142
7143 let SCALING_INVARIANT =
7144   let pths = (CONJUNCTS o UNDISCH o prove)
7145    (`&0 < c
7146      ==> linear(\x:real^N. c % x) /\
7147          (!x y:real^N. c % x = c % y ==> x = y) /\
7148          (!y:real^N. ?x. c % x = y)`,
7149     SIMP_TAC[REAL_LT_IMP_NZ; LINEAR_SCALING;
7150              INJECTIVE_SCALING; SURJECTIVE_SCALING])
7151   and sc_tm = `\x:real^N. c % x`
7152   and sa_tm = `&0:real < c`
7153   and c_tm = `c:real` in
7154   fun th ->
7155     let ith = BETA_RULE(ISPEC sc_tm th) in
7156     let avs,bod = strip_forall(concl ith) in
7157     let cjs = conjuncts(lhand bod) in
7158     let cths = map (fun t -> find(fun th -> aconv (concl th) t) pths) cjs in
7159     let oth = MP (SPECL avs ith) (end_itlist CONJ cths) in
7160     GEN c_tm (DISCH sa_tm (GENL avs oth));;
7161
7162 let scaling_theorems = ref([]:thm list);;
7163
7164 (* ------------------------------------------------------------------------- *)
7165 (* Augmentation of the lists. The "add_linear_invariants" also updates       *)
7166 (* the scaling theorems automatically, so only a few of those will need      *)
7167 (* to be added explicitly.                                                   *)
7168 (* ------------------------------------------------------------------------- *)
7169
7170 let add_scaling_theorems thl =
7171   (scaling_theorems := (!scaling_theorems) @ thl);;
7172
7173 let add_linear_invariants thl =
7174   ignore(mapfilter (fun th -> add_scaling_theorems[SCALING_INVARIANT th]) thl);
7175   (invariant_under_linear := (!invariant_under_linear) @ thl);;
7176
7177 let add_translation_invariants thl =
7178  (invariant_under_translation := (!invariant_under_translation) @ thl);;
7179
7180 (* ------------------------------------------------------------------------- *)
7181 (* Start with some basic set equivalences.                                   *)
7182 (* We give them all an injectivity hypothesis even if it's not necessary.    *)
7183 (* For just the intersection theorem we add surjectivity (more manageable    *)
7184 (* than assuming that the set isn't empty).                                  *)
7185 (* ------------------------------------------------------------------------- *)
7186
7187 let th_sets = prove
7188  (`!f. (!x y. f x = f y ==> x = y)
7189        ==> (if p then f x else f y) = f(if p then x else y) /\
7190            (if p then IMAGE f s else IMAGE f t) =
7191            IMAGE f (if p then s else t) /\
7192            (f x) INSERT (IMAGE f s) = IMAGE f (x INSERT s) /\
7193            (IMAGE f s) DELETE (f x) = IMAGE f (s DELETE x) /\
7194            (IMAGE f s) INTER (IMAGE f t) = IMAGE f (s INTER t) /\
7195            (IMAGE f s) UNION (IMAGE f t) = IMAGE f (s UNION t) /\
7196            UNIONS(IMAGE (IMAGE f) u) = IMAGE f (UNIONS u) /\
7197            (IMAGE f s) DIFF (IMAGE f t) = IMAGE f (s DIFF t) /\
7198            ((f x) IN (IMAGE f s) <=> x IN s) /\
7199            ((f o xs) (n:num) = f(xs n)) /\
7200            ((f o pt) (tt:real^1) = f(pt tt)) /\
7201            (DISJOINT (IMAGE f s) (IMAGE f t) <=> DISJOINT s t) /\
7202            ((IMAGE f s) SUBSET (IMAGE f t) <=> s SUBSET t) /\
7203            ((IMAGE f s) PSUBSET (IMAGE f t) <=> s PSUBSET t) /\
7204            (IMAGE f s = IMAGE f t <=> s = t) /\
7205            ((IMAGE f s) HAS_SIZE n <=> s HAS_SIZE n) /\
7206            (FINITE(IMAGE f s) <=> FINITE s) /\
7207            (INFINITE(IMAGE f s) <=> INFINITE s)`,
7208   REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[IMAGE_UNIONS] THEN
7209   REWRITE_TAC[o_THM] THEN
7210   REPLICATE_TAC 2 (CONJ_TAC THENL [MESON_TAC[]; ALL_TAC]) THEN
7211   REWRITE_TAC[INFINITE; TAUT `(~p <=> ~q) <=> (p <=> q)`] THEN
7212   REPLICATE_TAC 10 (CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN
7213   REWRITE_TAC[HAS_SIZE] THEN
7214   ASM_MESON_TAC[FINITE_IMAGE_INJ_EQ; CARD_IMAGE_INJ]) in
7215 let f = `f:real^M->real^N`
7216 and imf = `IMAGE (f:real^M->real^N)`
7217 and a = `a:real^N`
7218 and ima = `IMAGE (\x:real^N. a + x)`
7219 and vth = VECTOR_ARITH `!x y. a + x:real^N = a + y ==> x = y` in
7220 let th1 = UNDISCH(ISPEC f th_sets)
7221 and th1' = UNDISCH
7222  (GEN_REWRITE_RULE LAND_CONV [INJECTIVE_IMAGE] (ISPEC imf th_sets))
7223 and th2 = MATCH_MP th_sets vth
7224 and th2' = MATCH_MP
7225   (BETA_RULE(GEN_REWRITE_RULE LAND_CONV [INJECTIVE_IMAGE] (ISPEC ima th_sets)))
7226   vth in
7227 let fn a th = GENL (a::subtract (frees(concl th)) [a]) th in
7228 add_linear_invariants(map (fn f o DISCH_ALL) (CONJUNCTS th1 @ CONJUNCTS th1')),
7229 add_translation_invariants(map (fn a) (CONJUNCTS th2 @ CONJUNCTS th2'));;
7230
7231 let th_set = prove
7232  (`!f:A->B s. (!x y. f x = f y ==> x = y) /\ (!y. ?x. f x = y)
7233               ==> INTERS (IMAGE (IMAGE f) s) = IMAGE f (INTERS s)`,
7234   REWRITE_TAC[INTERS_IMAGE] THEN SET_TAC[]) in
7235 let th_vec = prove
7236  (`!a:real^N s.
7237     INTERS (IMAGE (IMAGE (\x. a + x)) s) = IMAGE (\x. a + x) (INTERS s)`,
7238   REPEAT GEN_TAC THEN MATCH_MP_TAC th_set THEN
7239   REWRITE_TAC[VECTOR_ARITH `a + x:real^N = a + y <=> x = y`] THEN
7240   REWRITE_TAC[VECTOR_ARITH `a + x:real^N = y <=> x = y - a`; EXISTS_REFL]) in
7241 add_linear_invariants [th_set],add_translation_invariants[th_vec];;
7242
7243 (* ------------------------------------------------------------------------- *)
7244 (* Now add arithmetical equivalences.                                        *)
7245 (* ------------------------------------------------------------------------- *)
7246
7247 let PRESERVES_NORM_PRESERVES_DOT = prove
7248  (`!f:real^M->real^N x y.
7249      linear f /\ (!x. norm(f x) = norm x)
7250      ==> (f x) dot (f y) = x dot y`,
7251   REWRITE_TAC[NORM_EQ] THEN REPEAT STRIP_TAC THEN
7252   FIRST_ASSUM(MP_TAC o SPEC `x + y:real^M`) THEN
7253   FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP LINEAR_ADD th]) THEN
7254   ASM_REWRITE_TAC[DOT_LADD; DOT_RADD] THEN
7255   REWRITE_TAC[DOT_SYM] THEN REAL_ARITH_TAC);;
7256
7257 let PRESERVES_NORM_INJECTIVE = prove
7258  (`!f:real^M->real^N.
7259      linear f /\ (!x. norm(f x) = norm x)
7260      ==> !x y. f x = f y ==> x = y`,
7261   SIMP_TAC[LINEAR_INJECTIVE_0; GSYM NORM_EQ_0]);;
7262
7263 let ORTHOGONAL_LINEAR_IMAGE_EQ = prove
7264  (`!f:real^M->real^N x y.
7265      linear f /\ (!x. norm(f x) = norm x)
7266      ==> (orthogonal (f x) (f y) <=> orthogonal x y)`,
7267   SIMP_TAC[orthogonal; PRESERVES_NORM_PRESERVES_DOT]);;
7268
7269 add_linear_invariants
7270  [GSYM LINEAR_ADD;
7271   GSYM LINEAR_CMUL;
7272   GSYM LINEAR_SUB;
7273   GSYM LINEAR_NEG;
7274   MIDPOINT_LINEAR_IMAGE;
7275   MESON[] `!f:real^M->real^N x.
7276                 (!x. norm(f x) = norm x) ==> norm(f x) = norm x`;
7277   PRESERVES_NORM_PRESERVES_DOT;
7278   MESON[dist; LINEAR_SUB]
7279     `!f:real^M->real^N x y.
7280         linear f /\ (!x. norm(f x) = norm x)
7281         ==> dist(f x,f y) = dist(x,y)`;
7282   MESON[] `!f:real^M->real^N x y.
7283                 (!x y. f x = f y ==> x = y) ==> (f x = f y <=> x = y)`;
7284   SUBSPACE_LINEAR_IMAGE_EQ;
7285   ORTHOGONAL_LINEAR_IMAGE_EQ;
7286   SPAN_LINEAR_IMAGE;
7287   DEPENDENT_LINEAR_IMAGE_EQ;
7288   INDEPENDENT_LINEAR_IMAGE_EQ;
7289   DIM_INJECTIVE_LINEAR_IMAGE];;
7290
7291 add_translation_invariants
7292  [VECTOR_ARITH `!a x y. a + x:real^N = a + y <=> x = y`;
7293   NORM_ARITH `!a x y. dist(a + x,a + y) = dist(x,y)`;
7294   VECTOR_ARITH `!a x y. &1 / &2 % ((a + x) + (a + y)) = a + &1 / &2 % (x + y)`;
7295   VECTOR_ARITH `!a x y. inv(&2) % ((a + x) + (a + y)) = a + inv(&2) % (x + y)`;
7296   VECTOR_ARITH `!a x y. (a + x) - (a + y):real^N = x - y`;
7297   (EQT_ELIM o (REWRITE_CONV[midpoint] THENC(EQT_INTRO o NORM_ARITH)))
7298                `!a x y. midpoint(a + x,a + y) = a + midpoint(x,y)`;
7299   (EQT_ELIM o (REWRITE_CONV[between] THENC(EQT_INTRO o NORM_ARITH)))
7300                `!a x y z. between (a + x) (a + y,a + z) <=> between x (y,z)`];;
7301
7302 (* ------------------------------------------------------------------------- *)
7303 (* A few for lists.                                                          *)
7304 (* ------------------------------------------------------------------------- *)
7305
7306 let MEM_TRANSLATION = prove
7307  (`!a:real^N x l. MEM (a + x) (MAP (\x. a + x) l) <=> MEM x l`,
7308   REWRITE_TAC[MEM_MAP; VECTOR_ARITH `a + x:real^N = a + y <=> x = y`] THEN
7309   MESON_TAC[]);;
7310
7311 add_translation_invariants [MEM_TRANSLATION];;
7312
7313 let MEM_LINEAR_IMAGE = prove
7314  (`!f:real^M->real^N x l.
7315         linear f /\ (!x y. f x = f y ==> x = y)
7316         ==> (MEM (f x) (MAP f l) <=> MEM x l)`,
7317   REWRITE_TAC[MEM_MAP] THEN MESON_TAC[]);;
7318
7319 add_linear_invariants [MEM_LINEAR_IMAGE];;
7320
7321 let LENGTH_TRANSLATION = prove
7322  (`!a:real^N l. LENGTH(MAP (\x. a + x) l) = LENGTH l`,
7323   REWRITE_TAC[LENGTH_MAP]) in
7324 add_translation_invariants [LENGTH_TRANSLATION];;
7325
7326 let LENGTH_LINEAR_IMAGE = prove
7327  (`!f:real^M->real^N l. linear f ==> LENGTH(MAP f l) = LENGTH l`,
7328   REWRITE_TAC[LENGTH_MAP]) in
7329 add_linear_invariants [LENGTH_LINEAR_IMAGE];;
7330
7331 let CONS_TRANSLATION = prove
7332  (`!a:real^N h t.
7333      CONS ((\x. a + x) h) (MAP (\x. a + x) t) = MAP (\x. a + x) (CONS h t)`,
7334   REWRITE_TAC[MAP]) in
7335 add_translation_invariants [CONS_TRANSLATION];;
7336
7337 let CONS_LINEAR_IMAGE = prove
7338  (`!f:real^M->real^N h t.
7339      linear f ==> CONS (f h) (MAP f t) = MAP f (CONS h t)`,
7340   REWRITE_TAC[MAP]) in
7341 add_linear_invariants [CONS_LINEAR_IMAGE];;
7342
7343 let APPEND_TRANSLATION = prove
7344  (`!a:real^N l1 l2.
7345      APPEND (MAP (\x. a + x) l1) (MAP (\x. a + x) l2) =
7346      MAP (\x. a + x) (APPEND l1 l2)`,
7347   REWRITE_TAC[MAP_APPEND]) in
7348 add_translation_invariants [APPEND_TRANSLATION];;
7349
7350 let APPEND_LINEAR_IMAGE = prove
7351  (`!f:real^M->real^N l1 l2.
7352      linear f ==> APPEND (MAP f l1) (MAP f l2) = MAP f (APPEND l1 l2)`,
7353   REWRITE_TAC[MAP_APPEND]) in
7354 add_linear_invariants [APPEND_LINEAR_IMAGE];;
7355
7356 let REVERSE_TRANSLATION = prove
7357  (`!a:real^N l. REVERSE(MAP (\x. a + x) l) = MAP (\x. a + x) (REVERSE l)`,
7358   REWRITE_TAC[MAP_REVERSE]) in
7359 add_translation_invariants [REVERSE_TRANSLATION];;
7360
7361 let REVERSE_LINEAR_IMAGE = prove
7362  (`!f:real^M->real^N l. linear f ==> REVERSE(MAP f l) = MAP f (REVERSE l)`,
7363   REWRITE_TAC[MAP_REVERSE]) in
7364 add_linear_invariants [REVERSE_LINEAR_IMAGE];;
7365
7366 (* ------------------------------------------------------------------------- *)
7367 (* A few scaling theorems that don't come from invariance theorems. Most are *)
7368 (* artificially weak with 0 < c hypotheses, so we don't bind them to names.  *)
7369 (* ------------------------------------------------------------------------- *)
7370
7371 let DOT_SCALING = prove
7372  (`!c. &0 < c ==> !x y. (c % x) dot (c % y) = c pow 2 * (x dot y)`,
7373   REWRITE_TAC[DOT_LMUL; DOT_RMUL] THEN REAL_ARITH_TAC) in
7374 add_scaling_theorems [DOT_SCALING];;
7375
7376 let DIST_SCALING = prove
7377  (`!c. &0 < c ==> !x y. dist(c % x,c % y) = c * dist(x,y)`,
7378   SIMP_TAC[DIST_MUL; REAL_ARITH `&0 < c ==> abs c = c`]) in
7379 add_scaling_theorems [DIST_SCALING];;
7380
7381 let ORTHOGONAL_SCALING = prove
7382  (`!c. &0 < c ==> !x y. orthogonal (c % x) (c % y) <=> orthogonal x y`,
7383   REWRITE_TAC[orthogonal; DOT_LMUL; DOT_RMUL] THEN CONV_TAC REAL_FIELD) in
7384 add_scaling_theorems [ORTHOGONAL_SCALING];;
7385
7386 let NORM_SCALING = prove
7387  (`!c. &0 < c ==> !x. norm(c % x) = c * norm x`,
7388   SIMP_TAC[NORM_MUL; REAL_ARITH `&0 < c ==> abs c = c`]) in
7389 add_scaling_theorems [NORM_SCALING];;
7390
7391 add_scaling_theorems
7392   [REAL_ARITH `!c. &0 < c ==> !a b. a * c * b = c * a * b`;
7393    REAL_ARITH `!c. &0 < c ==> !a b. c * a + c * b = c * (a + b)`;
7394    REAL_ARITH `!c. &0 < c ==> !a b. c * a - c * b = c * (a - b)`;
7395    REAL_FIELD `!c. &0 < c ==> !a b. c * a = c * b <=> a = b`;
7396    MESON[REAL_LT_LMUL_EQ] `!c. &0 < c ==> !a b. c * a < c * b <=> a < b`;
7397    MESON[REAL_LE_LMUL_EQ] `!c. &0 < c ==> !a b. c * a <= c * b <=> a <= b`;
7398    MESON[REAL_LT_LMUL_EQ; real_gt]
7399      `!c. &0 < c ==> !a b. c * a > c * b <=> a > b`;
7400    MESON[REAL_LE_LMUL_EQ; real_ge]
7401      `!c. &0 < c ==> !a b. c * a >= c * b <=> a >= b`;
7402    MESON[REAL_POW_MUL]
7403     `!c. &0 < c ==> !a n. (c * a) pow n = c pow n * a pow n`;
7404    REAL_ARITH `!c. &0 < c ==> !a b n. a * c pow n * b = c pow n * a * b`;
7405    REAL_ARITH
7406     `!c. &0 < c ==> !a b n. c pow n * a + c pow n * b = c pow n * (a + b)`;
7407    REAL_ARITH
7408     `!c. &0 < c ==> !a b n. c pow n * a - c pow n * b = c pow n * (a - b)`;
7409    MESON[REAL_POW_LT; REAL_EQ_LCANCEL_IMP; REAL_LT_IMP_NZ]
7410     `!c. &0 < c ==> !a b n. c pow n * a = c pow n * b <=> a = b`;
7411    MESON[REAL_LT_LMUL_EQ; REAL_POW_LT]
7412      `!c. &0 < c ==> !a b n. c pow n * a < c pow n * b <=> a < b`;
7413    MESON[REAL_LE_LMUL_EQ; REAL_POW_LT]
7414      `!c. &0 < c ==> !a b n. c pow n * a <= c pow n * b <=> a <= b`;
7415    MESON[REAL_LT_LMUL_EQ; real_gt; REAL_POW_LT]
7416      `!c. &0 < c ==> !a b n. c pow n * a > c pow n * b <=> a > b`;
7417    MESON[REAL_LE_LMUL_EQ; real_ge; REAL_POW_LT]
7418      `!c. &0 < c ==> !a b n. c pow n * a >= c pow n * b <=> a >= b`];;
7419
7420 (* ------------------------------------------------------------------------- *)
7421 (* Theorem deducing quantifier mappings from surjectivity.                   *)
7422 (* ------------------------------------------------------------------------- *)
7423
7424 let QUANTIFY_SURJECTION_THM = prove
7425  (`!f:A->B.
7426         (!y. ?x. f x = y)
7427         ==> ((!P. (!x. P x) <=> (!x. P (f x))) /\
7428              (!P. (?x. P x) <=> (?x. P (f x))) /\
7429              (!Q. (!s. Q s) <=> (!s. Q(IMAGE f s))) /\
7430              (!Q. (?s. Q s) <=> (?s. Q(IMAGE f s)))) /\
7431             (!P. {x | P x} = IMAGE f {x | P(f x)})`,
7432   GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [SURJECTIVE_RIGHT_INVERSE] THEN
7433   DISCH_THEN(X_CHOOSE_TAC `g:B->A`) THEN
7434   SUBGOAL_THEN `!s. IMAGE (f:A->B) (IMAGE g s) = s` ASSUME_TAC THENL
7435    [ASM SET_TAC[]; CONJ_TAC THENL [ASM MESON_TAC[]; ASM SET_TAC[]]]);;
7436
7437 let QUANTIFY_SURJECTION_HIGHER_THM = prove
7438  (`!f:A->B.
7439         (!y. ?x. f x = y)
7440         ==> ((!P. (!x. P x) <=> (!x. P (f x))) /\
7441              (!P. (?x. P x) <=> (?x. P (f x))) /\
7442              (!Q. (!s. Q s) <=> (!s. Q(IMAGE f s))) /\
7443              (!Q. (?s. Q s) <=> (?s. Q(IMAGE f s))) /\
7444              (!Q. (!s. Q s) <=> (!s. Q(IMAGE (IMAGE f) s))) /\
7445              (!Q. (?s. Q s) <=> (?s. Q(IMAGE (IMAGE f) s))) /\
7446              (!P. (!g:real^1->B. P g) <=> (!g. P(f o g))) /\
7447              (!P. (?g:real^1->B. P g) <=> (?g. P(f o g))) /\
7448              (!P. (!g:num->B. P g) <=> (!g. P(f o g))) /\
7449              (!P. (?g:num->B. P g) <=> (?g. P(f o g))) /\
7450              (!Q. (!l. Q l) <=> (!l. Q(MAP f l))) /\
7451              (!Q. (?l. Q l) <=> (?l. Q(MAP f l)))) /\
7452             ((!P. {x | P x} = IMAGE f {x | P(f x)}) /\
7453              (!Q. {s | Q s} = IMAGE (IMAGE f) {s | Q(IMAGE f s)}) /\
7454              (!R. {l | R l} = IMAGE (MAP f) {l | R(MAP f l)}))`,
7455   GEN_TAC THEN DISCH_TAC THEN CONV_TAC(ONCE_DEPTH_CONV SYM_CONV) THEN
7456   ASM_REWRITE_TAC[GSYM SURJECTIVE_FORALL_THM; GSYM SURJECTIVE_EXISTS_THM;
7457             GSYM SURJECTIVE_IMAGE_THM; SURJECTIVE_IMAGE; SURJECTIVE_MAP] THEN
7458   REWRITE_TAC[FUN_EQ_THM; o_THM; GSYM SKOLEM_THM] THEN ASM_MESON_TAC[]);;
7459
7460 (* ------------------------------------------------------------------------- *)
7461 (* Apply such quantifier and set expansions once per level at depth.         *)
7462 (* In the PARTIAL version, avoid expanding named variables in list.          *)
7463 (* ------------------------------------------------------------------------- *)
7464
7465 let PARTIAL_EXPAND_QUANTS_CONV avoid th =
7466   let ath,sth = CONJ_PAIR th in
7467   let conv1 = GEN_REWRITE_CONV I [ath]
7468   and conv2 = GEN_REWRITE_CONV I [sth] in
7469   let conv1' tm =
7470     let th = conv1 tm in
7471     if mem (fst(dest_var(fst(dest_abs(rand tm))))) avoid
7472     then failwith "Not going to expand this variable" else th in
7473   let rec conv tm =
7474    ((conv1' THENC BINDER_CONV conv) ORELSEC
7475     (conv2 THENC
7476      RAND_CONV(RAND_CONV(ABS_CONV(BINDER_CONV(LAND_CONV conv))))) ORELSEC
7477     SUB_CONV conv) tm in
7478   conv;;
7479
7480 let EXPAND_QUANTS_CONV = PARTIAL_EXPAND_QUANTS_CONV [];;