colo12-c703.uibk.ac.at Git - Multivariate Analysis/.git/blob - Multivariate/vectors.ml

   1 (* ========================================================================= *)
   2 (* Real vectors in Euclidean space, and elementary linear algebra.           *)
   3 (*                                                                           *)
   4 (*              (c) Copyright, John Harrison 1998-2008                       *)
   5 (* ========================================================================= *)
   6
   7 needs "Multivariate/misc.ml";;
   8
   9 (* ------------------------------------------------------------------------- *)
  10 (* Some common special cases.                                                *)
  11 (* ------------------------------------------------------------------------- *)
  12
  13 let FORALL_1 = prove
  14  (`(!i. 1 <= i /\ i <= 1 ==> P i) <=> P 1`,
  15   MESON_TAC[LE_ANTISYM]);;
  16
  17 let FORALL_2 = prove
  18  (`!P. (!i. 1 <= i /\ i <= 2 ==> P i) <=> P 1 /\ P 2`,
  19   MESON_TAC[ARITH_RULE `1 <= i /\ i <= 2 <=> i = 1 \/ i = 2`]);;
  20
  21 let FORALL_3 = prove
  22  (`!P. (!i. 1 <= i /\ i <= 3 ==> P i) <=> P 1 /\ P 2 /\ P 3`,
  23   MESON_TAC[ARITH_RULE `1 <= i /\ i <= 3 <=> i = 1 \/ i = 2 \/ i = 3`]);;
  24
  25 let FORALL_4 = prove
  26  (`!P. (!i. 1 <= i /\ i <= 4 ==> P i) <=> P 1 /\ P 2 /\ P 3 /\ P 4`,
  27   MESON_TAC[ARITH_RULE `1 <= i /\ i <= 4 <=>
  28     i = 1 \/ i = 2 \/ i = 3 \/ i = 4`]);;
  29
  30 let SUM_1 = prove
  31  (`sum(1..1) f = f(1)`,
  32   REWRITE_TAC[SUM_SING_NUMSEG]);;
  33
  34 let SUM_2 = prove
  35  (`!t. sum(1..2) t = t(1) + t(2)`,
  36   REWRITE_TAC[num_CONV `2`; SUM_CLAUSES_NUMSEG] THEN
  37   REWRITE_TAC[SUM_SING_NUMSEG; ARITH; REAL_ADD_ASSOC]);;
  38
  39 let SUM_3 = prove
  40  (`!t. sum(1..3) t = t(1) + t(2) + t(3)`,
  41   REWRITE_TAC[num_CONV `3`; num_CONV `2`; SUM_CLAUSES_NUMSEG] THEN
  42   REWRITE_TAC[SUM_SING_NUMSEG; ARITH; REAL_ADD_ASSOC]);;
  43
  44 let SUM_4 = prove
  45  (`!t. sum(1..4) t = t(1) + t(2) + t(3) + t(4)`,
  46   SIMP_TAC[num_CONV `4`; num_CONV `3`; num_CONV `2`; SUM_CLAUSES_NUMSEG] THEN
  47   REWRITE_TAC[SUM_SING_NUMSEG; ARITH; REAL_ADD_ASSOC]);;
  48
  49 (* ------------------------------------------------------------------------- *)
  50 (* Basic componentwise operations on vectors.                                *)
  51 (* ------------------------------------------------------------------------- *)
  52
  53 let vector_add = new_definition
  54   `(vector_add:real^N->real^N->real^N) x y = lambda i. x$i + y$i`;;
  55
  56 let vector_sub = new_definition
  57   `(vector_sub:real^N->real^N->real^N) x y = lambda i. x$i - y$i`;;
  58
  59 let vector_neg = new_definition
  60   `(vector_neg:real^N->real^N) x = lambda i. --(x$i)`;;
  61
  62 overload_interface ("+",`(vector_add):real^N->real^N->real^N`);;
  63 overload_interface ("-",`(vector_sub):real^N->real^N->real^N`);;
  64 overload_interface ("--",`(vector_neg):real^N->real^N`);;
  65
  66 prioritize_real();;
  67
  68 let prioritize_vector = let ty = `:real^N` in
  69   fun () -> prioritize_overload ty;;
  70
  71 (* ------------------------------------------------------------------------- *)
  72 (* Also the scalar-vector multiplication.                                    *)
  73 (* ------------------------------------------------------------------------- *)
  74
  75 parse_as_infix("%",(21,"right"));;
  76
  77 let vector_mul = new_definition
  78   `((%):real->real^N->real^N) c x = lambda i. c * x$i`;;
  79
  80 (* ------------------------------------------------------------------------- *)
  81 (* Vectors corresponding to small naturals. Perhaps should overload "&"?     *)
  82 (* ------------------------------------------------------------------------- *)
  83
  84 let vec = new_definition
  85   `(vec:num->real^N) n = lambda i. &n`;;
  86
  87 (* ------------------------------------------------------------------------- *)
  88 (* Dot products.                                                             *)
  89 (* ------------------------------------------------------------------------- *)
  90
  91 parse_as_infix("dot",(20,"right"));;
  92
  93 let dot = new_definition
  94   `(x:real^N) dot (y:real^N) = sum(1..dimindex(:N)) (\i. x$i * y$i)`;;
  95
  96 let DOT_1 = prove
  97  (`(x:real^1) dot (y:real^1) = x$1 * y$1`,
  98   REWRITE_TAC[dot; DIMINDEX_1; SUM_1]);;
  99
 100 let DOT_2 = prove
 101  (`(x:real^2) dot (y:real^2) = x$1 * y$1 + x$2 * y$2`,
 102   REWRITE_TAC[dot; DIMINDEX_2; SUM_2]);;
 103
 104 let DOT_3 = prove
 105  (`(x:real^3) dot (y:real^3) = x$1 * y$1 + x$2 * y$2 + x$3 * y$3`,
 106   REWRITE_TAC[dot; DIMINDEX_3; SUM_3]);;
 107
 108 let DOT_4 = prove
 109  (`(x:real^4) dot (y:real^4) = x$1 * y$1 + x$2 * y$2 + x$3 * y$3 + x$4 * y$4`,
 110   REWRITE_TAC[dot; DIMINDEX_4; SUM_4]);;
 111
 112 (* ------------------------------------------------------------------------- *)
 113 (* A naive proof procedure to lift really trivial arithmetic stuff from R.   *)
 114 (* ------------------------------------------------------------------------- *)
 115
 116 let VECTOR_ARITH_TAC =
 117   let RENAMED_LAMBDA_BETA th =
 118     if fst(dest_fun_ty(type_of(funpow 3 rand (concl th)))) = aty
 119     then INST_TYPE [aty,bty; bty,aty] LAMBDA_BETA else LAMBDA_BETA in
 120   POP_ASSUM_LIST(K ALL_TAC) THEN
 121   REPEAT(GEN_TAC ORELSE CONJ_TAC ORELSE DISCH_TAC ORELSE EQ_TAC) THEN
 122   REPEAT(POP_ASSUM MP_TAC) THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN
 123   REWRITE_TAC[dot; GSYM SUM_ADD_NUMSEG; GSYM SUM_SUB_NUMSEG;
 124               GSYM SUM_LMUL; GSYM SUM_RMUL; GSYM SUM_NEG] THEN
 125   (MATCH_MP_TAC SUM_EQ_NUMSEG ORELSE MATCH_MP_TAC SUM_EQ_0_NUMSEG ORELSE
 126    GEN_REWRITE_TAC ONCE_DEPTH_CONV [CART_EQ]) THEN
 127   REWRITE_TAC[AND_FORALL_THM] THEN TRY EQ_TAC THEN
 128   TRY(MATCH_MP_TAC MONO_FORALL) THEN GEN_TAC THEN
 129   REWRITE_TAC[TAUT `(a ==> b) /\ (a ==> c) <=> a ==> b /\ c`;
 130               TAUT `(a ==> b) \/ (a ==> c) <=> a ==> b \/ c`] THEN
 131   TRY(MATCH_MP_TAC(TAUT `(a ==> b ==> c) ==> (a ==> b) ==> (a ==> c)`)) THEN
 132   REWRITE_TAC[vector_add; vector_sub; vector_neg; vector_mul; vec] THEN
 133   DISCH_THEN(fun th -> REWRITE_TAC[MATCH_MP(RENAMED_LAMBDA_BETA th) th]) THEN
 134   REAL_ARITH_TAC;;
 135
 136 let VECTOR_ARITH tm = prove(tm,VECTOR_ARITH_TAC);;
 137
 138 (* ------------------------------------------------------------------------- *)
 139 (* Obvious "component-pushing".                                              *)
 140 (* ------------------------------------------------------------------------- *)
 141
 142 let VEC_COMPONENT = prove
 143  (`!k i. (vec k :real^N)$i = &k`,
 144   REPEAT GEN_TAC THEN
 145   SUBGOAL_THEN `?k. 1 <= k /\ k <= dimindex(:N) /\ !z:real^N. z$i = z$k`
 146   CHOOSE_TAC THENL
 147    [REWRITE_TAC[FINITE_INDEX_INRANGE];
 148     ASM_SIMP_TAC[vec; CART_EQ; LAMBDA_BETA]]);;
 149
 150 let VECTOR_ADD_COMPONENT = prove
 151  (`!x:real^N y i. (x + y)$i = x$i + y$i`,
 152   REPEAT GEN_TAC THEN
 153   SUBGOAL_THEN `?k. 1 <= k /\ k <= dimindex(:N) /\ !z:real^N. z$i = z$k`
 154   CHOOSE_TAC THENL
 155    [REWRITE_TAC[FINITE_INDEX_INRANGE];
 156     ASM_SIMP_TAC[vector_add; CART_EQ; LAMBDA_BETA]]);;
 157
 158 let VECTOR_SUB_COMPONENT = prove
 159  (`!x:real^N y i. (x - y)$i = x$i - y$i`,
 160   REPEAT GEN_TAC THEN
 161   SUBGOAL_THEN `?k. 1 <= k /\ k <= dimindex(:N) /\ !z:real^N. z$i = z$k`
 162   CHOOSE_TAC THENL
 163    [REWRITE_TAC[FINITE_INDEX_INRANGE];
 164     ASM_SIMP_TAC[vector_sub; CART_EQ; LAMBDA_BETA]]);;
 165
 166 let VECTOR_NEG_COMPONENT = prove
 167  (`!x:real^N i. (--x)$i = --(x$i)`,
 168   REPEAT GEN_TAC THEN
 169   SUBGOAL_THEN `?k. 1 <= k /\ k <= dimindex(:N) /\ !z:real^N. z$i = z$k`
 170   CHOOSE_TAC THENL
 171    [REWRITE_TAC[FINITE_INDEX_INRANGE];
 172     ASM_SIMP_TAC[vector_neg; CART_EQ; LAMBDA_BETA]]);;
 173
 174 let VECTOR_MUL_COMPONENT = prove
 175  (`!c x:real^N i. (c % x)$i = c * x$i`,
 176   REPEAT GEN_TAC THEN
 177   SUBGOAL_THEN `?k. 1 <= k /\ k <= dimindex(:N) /\ !z:real^N. z$i = z$k`
 178   CHOOSE_TAC THENL
 179    [REWRITE_TAC[FINITE_INDEX_INRANGE];
 180     ASM_SIMP_TAC[vector_mul; CART_EQ; LAMBDA_BETA]]);;
 181
 182 let COND_COMPONENT = prove
 183  (`(if b then x else y)$i = if b then x$i else y$i`,
 184   MESON_TAC[]);;
 185
 186 (* ------------------------------------------------------------------------- *)
 187 (* Some frequently useful arithmetic lemmas over vectors.                    *)
 188 (* ------------------------------------------------------------------------- *)
 189
 190 let VECTOR_ADD_SYM = VECTOR_ARITH `!x y:real^N. x + y = y + x`;;
 191
 192 let VECTOR_ADD_LID = VECTOR_ARITH `!x. vec 0 + x = x`;;
 193
 194 let VECTOR_ADD_RID = VECTOR_ARITH `!x. x + vec 0 = x`;;
 195
 196 let VECTOR_SUB_REFL = VECTOR_ARITH `!x. x - x = vec 0`;;
 197
 198 let VECTOR_ADD_LINV = VECTOR_ARITH `!x. --x + x = vec 0`;;
 199
 200 let VECTOR_ADD_RINV = VECTOR_ARITH `!x. x + --x = vec 0`;;
 201
 202 let VECTOR_SUB_RADD = VECTOR_ARITH `!x y. x - (x + y) = --y:real^N`;;
 203
 204 let VECTOR_NEG_SUB = VECTOR_ARITH `!x:real^N y. --(x - y) = y - x`;;
 205
 206 let VECTOR_SUB_EQ = VECTOR_ARITH `!x y. (x - y = vec 0) <=> (x = y)`;;
 207
 208 let VECTOR_MUL_ASSOC = VECTOR_ARITH `!a b x. a % (b % x) = (a * b) % x`;;
 209
 210 let VECTOR_MUL_LID = VECTOR_ARITH `!x. &1 % x = x`;;
 211
 212 let VECTOR_MUL_LZERO = VECTOR_ARITH `!x. &0 % x = vec 0`;;
 213
 214 let VECTOR_SUB_ADD = VECTOR_ARITH `(x - y) + y = x:real^N`;;
 215
 216 let VECTOR_SUB_ADD2 = VECTOR_ARITH `y + (x - y) = x:real^N`;;
 217
 218 let VECTOR_ADD_LDISTRIB = VECTOR_ARITH `c % (x + y) = c % x + c % y`;;
 219
 220 let VECTOR_SUB_LDISTRIB = VECTOR_ARITH `c % (x - y) = c % x - c % y`;;
 221
 222 let VECTOR_ADD_RDISTRIB = VECTOR_ARITH `(a + b) % x = a % x + b % x`;;
 223
 224 let VECTOR_SUB_RDISTRIB = VECTOR_ARITH `(a - b) % x = a % x - b % x`;;
 225
 226 let VECTOR_ADD_SUB = VECTOR_ARITH `(x + y:real^N) - x = y`;;
 227
 228 let VECTOR_EQ_ADDR = VECTOR_ARITH `(x + y = x) <=> (y = vec 0)`;;
 229
 230 let VECTOR_SUB = VECTOR_ARITH `x - y = x + --(y:real^N)`;;
 231
 232 let VECTOR_SUB_RZERO = VECTOR_ARITH `x - vec 0 = x`;;
 233
 234 let VECTOR_MUL_RZERO = VECTOR_ARITH `c % vec 0 = vec 0`;;
 235
 236 let VECTOR_NEG_MINUS1 = VECTOR_ARITH `--x = (--(&1)) % x`;;
 237
 238 let VECTOR_ADD_ASSOC = VECTOR_ARITH `(x:real^N) + y + z = (x + y) + z`;;
 239
 240 let VECTOR_SUB_LZERO = VECTOR_ARITH `vec 0 - x = --x`;;
 241
 242 let VECTOR_NEG_NEG = VECTOR_ARITH `--(--(x:real^N)) = x`;;
 243
 244 let VECTOR_MUL_LNEG = VECTOR_ARITH `--c % x = --(c % x)`;;
 245
 246 let VECTOR_MUL_RNEG = VECTOR_ARITH `c % --x = --(c % x)`;;
 247
 248 let VECTOR_NEG_0 = VECTOR_ARITH `--(vec 0) = vec 0`;;
 249
 250 let VECTOR_NEG_EQ_0 = VECTOR_ARITH `--x = vec 0 <=> x = vec 0`;;
 251
 252 let VECTOR_EQ_NEG2 = VECTOR_ARITH `!x y:real^N. --x = --y <=> x = y`;;
 253
 254 let VECTOR_ADD_AC = VECTOR_ARITH
 255   `(m + n = n + m:real^N) /\
 256    ((m + n) + p = m + n + p) /\
 257    (m + n + p = n + m + p)`;;
 258
 259 let VEC_EQ = prove
 260  (`!m n. (vec m = vec n) <=> (m = n)`,
 261   SIMP_TAC[CART_EQ; VEC_COMPONENT; REAL_OF_NUM_EQ] THEN
 262   MESON_TAC[LE_REFL; DIMINDEX_GE_1]);;
 263
 264 (* ------------------------------------------------------------------------- *)
 265 (* Infinitude of Euclidean space.                                            *)
 266 (* ------------------------------------------------------------------------- *)
 267
 268 let EUCLIDEAN_SPACE_INFINITE = prove
 269  (`INFINITE(:real^N)`,
 270   REWRITE_TAC[INFINITE] THEN DISCH_TAC THEN
 271   FIRST_ASSUM(MP_TAC o ISPEC `vec:num->real^N` o
 272     MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] FINITE_IMAGE_INJ)) THEN
 273   REWRITE_TAC[VEC_EQ; SET_RULE `{x | f x IN UNIV} = UNIV`] THEN
 274   REWRITE_TAC[GSYM INFINITE; num_INFINITE]);;
 275
 276 (* ------------------------------------------------------------------------- *)
 277 (* Properties of the dot product.                                            *)
 278 (* ------------------------------------------------------------------------- *)
 279
 280 let DOT_SYM = VECTOR_ARITH `!x y. x dot y = y dot x`;;
 281
 282 let DOT_LADD = VECTOR_ARITH `!x y z. (x + y) dot z = (x dot z) + (y dot z)`;;
 283
 284 let DOT_RADD = VECTOR_ARITH `!x y z. x dot (y + z) = (x dot y) + (x dot z)`;;
 285
 286 let DOT_LSUB = VECTOR_ARITH `!x y z. (x - y) dot z = (x dot z) - (y dot z)`;;
 287
 288 let DOT_RSUB = VECTOR_ARITH `!x y z. x dot (y - z) = (x dot y) - (x dot z)`;;
 289
 290 let DOT_LMUL = VECTOR_ARITH `!c x y. (c % x) dot y = c * (x dot y)`;;
 291
 292 let DOT_RMUL = VECTOR_ARITH `!c x y. x dot (c % y) = c * (x dot y)`;;
 293
 294 let DOT_LNEG = VECTOR_ARITH `!x y. (--x) dot y = --(x dot y)`;;
 295
 296 let DOT_RNEG = VECTOR_ARITH `!x y. x dot (--y) = --(x dot y)`;;
 297
 298 let DOT_LZERO = VECTOR_ARITH `!x. (vec 0) dot x = &0`;;
 299
 300 let DOT_RZERO = VECTOR_ARITH `!x. x dot (vec 0) = &0`;;
 301
 302 let DOT_POS_LE = prove
 303  (`!x. &0 <= x dot x`,
 304   SIMP_TAC[dot; SUM_POS_LE_NUMSEG; REAL_LE_SQUARE]);;
 305
 306 let DOT_EQ_0 = prove
 307  (`!x:real^N. ((x dot x = &0) <=> (x = vec 0))`,
 308   REPEAT GEN_TAC THEN EQ_TAC THENL [ALL_TAC; MESON_TAC[DOT_LZERO]] THEN
 309   SIMP_TAC[dot; CART_EQ; vec; LAMBDA_BETA] THEN DISCH_TAC THEN
 310   ONCE_REWRITE_TAC[GSYM(REWRITE_CONV[REAL_ENTIRE] `x * x = &0`)] THEN
 311   MATCH_MP_TAC SUM_POS_EQ_0_NUMSEG THEN ASM_REWRITE_TAC[REAL_LE_SQUARE]);;
 312
 313 let DOT_POS_LT = prove
 314  (`!x. (&0 < x dot x) <=> ~(x = vec 0)`,
 315   REWRITE_TAC[REAL_LT_LE; DOT_POS_LE] THEN MESON_TAC[DOT_EQ_0]);;
 316
 317 let FORALL_DOT_EQ_0 = prove
 318  (`(!y. (!x. x dot y = &0) <=> y = vec 0) /\
 319    (!x. (!y. x dot y = &0) <=> x = vec 0)`,
 320   MESON_TAC[DOT_LZERO; DOT_RZERO; DOT_EQ_0]);;
 321
 322 (* ------------------------------------------------------------------------- *)
 323 (* Introduce norms, but defer many properties till we get square roots.      *)
 324 (* ------------------------------------------------------------------------- *)
 325
 326 make_overloadable "norm" `:A->real`;;
 327 overload_interface("norm",`vector_norm:real^N->real`);;
 328
 329 let vector_norm = new_definition
 330   `norm x = sqrt(x dot x)`;;
 331
 332 (* ------------------------------------------------------------------------- *)
 333 (* Useful for the special cases of 1 dimension.                              *)
 334 (* ------------------------------------------------------------------------- *)
 335
 336 let FORALL_DIMINDEX_1 = prove
 337  (`(!i. 1 <= i /\ i <= dimindex(:1) ==> P i) <=> P 1`,
 338   MESON_TAC[DIMINDEX_1; LE_ANTISYM]);;
 339
 340 (* ------------------------------------------------------------------------- *)
 341 (* The collapse of the general concepts to the real line R^1.                *)
 342 (* ------------------------------------------------------------------------- *)
 343
 344 let VECTOR_ONE = prove
 345  (`!x:real^1. x = lambda i. x$1`,
 346   SIMP_TAC[CART_EQ; LAMBDA_BETA] THEN MESON_TAC[DIMINDEX_1; LE_ANTISYM]);;
 347
 348 let FORALL_REAL_ONE = prove
 349  (`(!x:real^1. P x) <=> (!x. P(lambda i. x))`,
 350   EQ_TAC THEN SIMP_TAC[] THEN DISCH_TAC THEN GEN_TAC THEN
 351   FIRST_X_ASSUM(MP_TAC o SPEC `(x:real^1)$1`) THEN
 352   REWRITE_TAC[GSYM VECTOR_ONE]);;
 353
 354 let NORM_REAL = prove
 355  (`!x:real^1. norm(x) = abs(x$1)`,
 356   REWRITE_TAC[vector_norm; dot; DIMINDEX_1; SUM_SING_NUMSEG;
 357               GSYM REAL_POW_2; POW_2_SQRT_ABS]);;
 358
 359 (* ------------------------------------------------------------------------- *)
 360 (* Metric function.                                                          *)
 361 (* ------------------------------------------------------------------------- *)
 362
 363 override_interface("dist",`distance:real^N#real^N->real`);;
 364
 365 let dist = new_definition
 366   `dist(x,y) = norm(x - y)`;;
 367
 368 let DIST_REAL = prove
 369  (`!x:real^1 y. dist(x,y) = abs(x$1 - y$1)`,
 370   SIMP_TAC[dist; NORM_REAL; vector_sub; LAMBDA_BETA; LE_REFL; DIMINDEX_1]);;
 371
 372 (* ------------------------------------------------------------------------- *)
 373 (* A connectedness or intermediate value lemma with several applications.    *)
 374 (* ------------------------------------------------------------------------- *)
 375
 376 let CONNECTED_REAL_LEMMA = prove
 377  (`!f:real->real^N a b e1 e2.
 378         a <= b /\ f(a) IN e1 /\ f(b) IN e2 /\
 379         (!e x. a <= x /\ x <= b /\ &0 < e
 380                ==> ?d. &0 < d /\
 381                        !y. abs(y - x) < d ==> dist(f(y),f(x)) < e) /\
 382         (!y. y IN e1 ==> ?e. &0 < e /\ !y'. dist(y',y) < e ==> y' IN e1) /\
 383         (!y. y IN e2 ==> ?e. &0 < e /\ !y'. dist(y',y) < e ==> y' IN e2) /\
 384         ~(?x. a <= x /\ x <= b /\ f(x) IN e1 /\ f(x) IN e2)
 385         ==> ?x. a <= x /\ x <= b /\ ~(f(x) IN e1) /\ ~(f(x) IN e2)`,
 386   let tac = ASM_MESON_TAC[REAL_LT_IMP_LE; REAL_LE_TOTAL; REAL_LE_ANTISYM] in
 387   REWRITE_TAC[EXTENSION; NOT_IN_EMPTY] THEN REPEAT STRIP_TAC THEN
 388   MP_TAC(SPEC `\c. !x. a <= x /\ x <= c ==> (f(x):real^N) IN e1`
 389               REAL_COMPLETE) THEN
 390   REWRITE_TAC[] THEN ANTS_TAC THENL [tac; ALL_TAC] THEN
 391   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `x:real` THEN STRIP_TAC THEN
 392   SUBGOAL_THEN `a <= x /\ x <= b` STRIP_ASSUME_TAC THENL [tac; ALL_TAC] THEN
 393   ASM_REWRITE_TAC[] THEN
 394   SUBGOAL_THEN `!z. a <= z /\ z < x ==> (f(z):real^N) IN e1` ASSUME_TAC THENL
 395    [ASM_MESON_TAC[REAL_NOT_LT; REAL_LT_IMP_LE]; ALL_TAC] THEN
 396   REPEAT STRIP_TAC THENL
 397    [SUBGOAL_THEN
 398      `?d. &0 < d /\ !y. abs(y - x) < d ==> (f(y):real^N) IN e1`
 399     STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN
 400     ASM_MESON_TAC[REAL_ARITH `z <= x + e /\ e < d ==> z < x \/ abs(z - x) < d`;
 401                   REAL_ARITH `&0 < e ==> ~(x + e <= x)`; REAL_DOWN];
 402     SUBGOAL_THEN
 403      `?d. &0 < d /\ !y. abs(y - x) < d ==> (f(y):real^N) IN e2`
 404     STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN
 405     MP_TAC(SPECL [`x - a`; `d:real`] REAL_DOWN2) THEN ANTS_TAC THENL
 406      [ASM_MESON_TAC[REAL_LT_LE; REAL_SUB_LT]; ALL_TAC] THEN
 407     ASM_MESON_TAC[REAL_ARITH `e < x - a ==> a <= x - e`;
 408                   REAL_ARITH `&0 < e /\ x <= b ==> x - e <= b`;
 409       REAL_ARITH `&0 < e /\ e < d ==> x - e < x /\ abs((x - e) - x) < d`]]);;
 410
 411 (* ------------------------------------------------------------------------- *)
 412 (* One immediately useful corollary is the existence of square roots!        *)
 413 (* ------------------------------------------------------------------------- *)
 414
 415 let SQUARE_BOUND_LEMMA = prove
 416  (`!x. x < (&1 + x) * (&1 + x)`,
 417   GEN_TAC THEN REWRITE_TAC[REAL_POW_2] THEN
 418   MAP_EVERY (fun t -> MP_TAC(SPEC t REAL_LE_SQUARE)) [`x:real`; `&1 + x`] THEN
 419   REAL_ARITH_TAC);;
 420
 421 let SQUARE_CONTINUOUS = prove
 422  (`!x e. &0 < e
 423          ==> ?d. &0 < d /\ !y. abs(y - x) < d ==> abs(y * y - x * x) < e`,
 424   REPEAT STRIP_TAC THEN ASM_CASES_TAC `x = &0` THENL
 425    [ASM_REWRITE_TAC[REAL_MUL_LZERO; REAL_SUB_RZERO] THEN
 426     EXISTS_TAC `inv(&1 + inv(e))` THEN
 427     ASM_SIMP_TAC[REAL_LT_INV_EQ; REAL_LT_ADD; REAL_LT_01] THEN
 428     REPEAT STRIP_TAC THEN MATCH_MP_TAC  REAL_LTE_TRANS THEN
 429     EXISTS_TAC `inv(&1 + inv(e)) * inv(&1 + inv(e))` THEN
 430     ASM_SIMP_TAC[REAL_ABS_MUL; REAL_LT_MUL2; REAL_ABS_POS] THEN
 431     REWRITE_TAC[GSYM REAL_INV_MUL] THEN
 432     GEN_REWRITE_TAC RAND_CONV [GSYM REAL_INV_INV] THEN
 433     MATCH_MP_TAC REAL_LE_INV2 THEN
 434     ASM_SIMP_TAC[REAL_LT_IMP_LE; SQUARE_BOUND_LEMMA; REAL_LT_INV_EQ];
 435     MP_TAC(SPECL [`abs(x)`; `e / (&3 * abs(x))`] REAL_DOWN2)THEN
 436     ASM_SIMP_TAC[GSYM REAL_ABS_NZ; REAL_LT_DIV; REAL_LT_MUL; REAL_OF_NUM_LT;
 437                  ARITH; REAL_LT_RDIV_EQ] THEN
 438     MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN
 439     STRIP_TAC THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `y:real` THEN
 440     REWRITE_TAC[REAL_ARITH `x * x - y * y = (x - y) * (x + y)`] THEN
 441     DISCH_TAC THEN MATCH_MP_TAC REAL_LET_TRANS THEN
 442     EXISTS_TAC `d * &3 * abs(x)` THEN ASM_REWRITE_TAC[REAL_ABS_MUL] THEN
 443     MATCH_MP_TAC REAL_LE_MUL2 THEN
 444     ASM_SIMP_TAC[REAL_ABS_POS; REAL_LT_IMP_LE] THEN
 445     MAP_EVERY UNDISCH_TAC [`abs (y - x) < d`; `d < abs(x)`] THEN
 446     REAL_ARITH_TAC]);;
 447
 448 let SQRT_WORKS = prove
 449  (`!x. &0 <= x ==> &0 <= sqrt(x) /\ (sqrt(x) pow 2 = x)`,
 450   GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [REAL_LE_LT] THEN STRIP_TAC THENL
 451    [ALL_TAC;
 452     ASM_MESON_TAC[SQRT_0; REAL_POW_2; REAL_LE_REFL; REAL_MUL_LZERO]] THEN
 453   REWRITE_TAC[sqrt] THEN CONV_TAC SELECT_CONV THEN
 454   MP_TAC(ISPECL [`(\u. lambda i. u):real->real^1`; `&0`; `&1 + x`;
 455             `{u:real^1 | u$1 * u$1 < x}`; `{u:real^1 | u$1 * u$1 > x}`]
 456          CONNECTED_REAL_LEMMA) THEN
 457   SIMP_TAC[LAMBDA_BETA; LE_REFL; DIMINDEX_1; DIST_REAL;
 458            EXTENSION; IN_INTER; IN_ELIM_THM; NOT_IN_EMPTY;
 459            REAL_MUL_LZERO; FORALL_REAL_ONE; real_gt] THEN
 460   ANTS_TAC THENL [ALL_TAC; ASM_MESON_TAC[REAL_POW_2; REAL_LT_TOTAL]] THEN
 461   ASM_SIMP_TAC[REAL_LT_ANTISYM; REAL_ARITH `&0 < x ==> &0 <= &1 + x`] THEN
 462   REWRITE_TAC[SQUARE_BOUND_LEMMA] THEN
 463   MESON_TAC[SQUARE_CONTINUOUS; REAL_SUB_LT;
 464             REAL_ARITH `abs(z2 - x2) < y - x2 ==> z2 < y`;
 465             REAL_ARITH `abs(z2 - x2) < x2 - y ==> y < z2`]);;
 466
 467 let SQRT_POS_LE = prove
 468  (`!x. &0 <= x ==> &0 <= sqrt(x)`,
 469   MESON_TAC[SQRT_WORKS]);;
 470
 471 let SQRT_POW_2 = prove
 472  (`!x. &0 <= x ==> (sqrt(x) pow 2 = x)`,
 473   MESON_TAC[SQRT_WORKS]);;
 474
 475 let SQRT_MUL = prove
 476  (`!x y. &0 <= x /\ &0 <= y
 477            ==> (sqrt(x * y) = sqrt x * sqrt y)`,
 478   ASM_MESON_TAC[REAL_POW_2; SQRT_WORKS; REAL_LE_MUL; SQRT_UNIQUE;
 479                 REAL_ARITH `(x * y) * (x * y) = (x * x) * y * y`]);;
 480
 481 let SQRT_INV = prove
 482  (`!x. &0 <= x ==> (sqrt (inv x) = inv(sqrt x))`,
 483   MESON_TAC[SQRT_UNIQUE; SQRT_WORKS; REAL_POW_INV; REAL_LE_INV_EQ]);;
 484
 485 let SQRT_DIV = prove
 486  (`!x y. &0 <= x /\ &0 <= y ==> (sqrt (x / y) = sqrt x / sqrt y)`,
 487   SIMP_TAC[real_div; SQRT_MUL; SQRT_INV; REAL_LE_INV_EQ]);;
 488
 489 let SQRT_POW2 = prove
 490  (`!x. (sqrt(x) pow 2 = x) <=> &0 <= x`,
 491   MESON_TAC[REAL_POW_2; REAL_LE_SQUARE; SQRT_POW_2]);;
 492
 493 let SQRT_MONO_LT = prove
 494  (`!x y. &0 <= x /\ x < y ==> sqrt(x) < sqrt(y)`,
 495   REWRITE_TAC[GSYM REAL_NOT_LE] THEN
 496   MESON_TAC[REAL_LT_IMP_LE; REAL_NOT_LE; REAL_LE_TRANS;
 497             REAL_POW_LE2; SQRT_WORKS]);;
 498
 499 let SQRT_MONO_LE = prove
 500  (`!x y. &0 <= x /\ x <= y ==> sqrt(x) <= sqrt(y)`,
 501   MESON_TAC[REAL_LE_LT; SQRT_MONO_LT]);;
 502
 503 let SQRT_MONO_LT_EQ = prove
 504  (`!x y. &0 <= x /\ &0 <= y ==> (sqrt(x) < sqrt(y) <=> x < y)`,
 505   MESON_TAC[REAL_NOT_LT; SQRT_MONO_LT; SQRT_MONO_LE]);;
 506
 507 let SQRT_MONO_LE_EQ = prove
 508  (`!x y. &0 <= x /\ &0 <= y ==> (sqrt(x) <= sqrt(y) <=> x <= y)`,
 509   MESON_TAC[REAL_NOT_LT; SQRT_MONO_LT; SQRT_MONO_LE]);;
 510
 511 let SQRT_INJ = prove
 512  (`!x y. &0 <= x /\ &0 <= y ==> ((sqrt(x) = sqrt(y)) <=> (x = y))`,
 513   SIMP_TAC[GSYM REAL_LE_ANTISYM; SQRT_MONO_LE_EQ]);;
 514
 515 let SQRT_LT_0 = prove
 516  (`!x. &0 <= x ==> (&0 < sqrt x <=> &0 < x)`,
 517   MESON_TAC[SQRT_0; REAL_LE_REFL; SQRT_MONO_LT_EQ]);;
 518
 519 let SQRT_EQ_0 = prove
 520  (`!x. &0 <= x ==> ((sqrt x = &0) <=> (x = &0))`,
 521   MESON_TAC[SQRT_INJ; SQRT_0; REAL_LE_REFL]);;
 522
 523 let SQRT_POS_LT = prove
 524  (`!x. &0 < x ==> &0 < sqrt(x)`,
 525   MESON_TAC[REAL_LT_LE; SQRT_POS_LE; SQRT_EQ_0]);;
 526
 527 let REAL_LE_LSQRT = prove
 528  (`!x y. &0 <= x /\ &0 <= y /\ x <= y pow 2 ==> sqrt(x) <= y`,
 529   MESON_TAC[SQRT_MONO_LE; REAL_POW_LE; POW_2_SQRT]);;
 530
 531 let REAL_LE_RSQRT = prove
 532  (`!x y. x pow 2 <= y ==> x <= sqrt(y)`,
 533   MESON_TAC[REAL_LE_TOTAL; SQRT_MONO_LE; SQRT_POS_LE; REAL_POW_2;
 534             REAL_LE_SQUARE; REAL_LE_TRANS; POW_2_SQRT]);;
 535
 536 let REAL_LT_LSQRT = prove
 537  (`!x y. &0 <= x /\ &0 <= y /\ x < y pow 2 ==> sqrt x < y`,
 538   MESON_TAC[SQRT_MONO_LT; REAL_POW_LE; POW_2_SQRT]);;
 539
 540 let REAL_LT_RSQRT = prove
 541  (`!x y. x pow 2 < y ==> x < sqrt(y)`,
 542   REPEAT STRIP_TAC THEN MATCH_MP_TAC(REAL_ARITH `abs x < a ==> x < a`) THEN
 543   REWRITE_TAC[GSYM POW_2_SQRT_ABS] THEN MATCH_MP_TAC SQRT_MONO_LT THEN
 544   ASM_REWRITE_TAC[REAL_POW_2; REAL_LE_SQUARE]);;
 545
 546 let SQRT_EVEN_POW2 = prove
 547  (`!n. EVEN n ==> (sqrt(&2 pow n) = &2 pow (n DIV 2))`,
 548   SIMP_TAC[EVEN_EXISTS; LEFT_IMP_EXISTS_THM; DIV_MULT; ARITH_EQ] THEN
 549   MESON_TAC[SQRT_UNIQUE; REAL_POW_POW; MULT_SYM; REAL_POW_LE; REAL_POS]);;
 550
 551 let REAL_DIV_SQRT = prove
 552  (`!x. &0 <= x ==> (x / sqrt(x) = sqrt(x))`,
 553   REWRITE_TAC[REAL_LE_LT] THEN REPEAT STRIP_TAC THENL
 554    [ALL_TAC; ASM_MESON_TAC[SQRT_0; real_div; REAL_MUL_LZERO]] THEN
 555   ASM_SIMP_TAC[REAL_EQ_LDIV_EQ; SQRT_POS_LT; GSYM REAL_POW_2] THEN
 556   ASM_SIMP_TAC[SQRT_POW_2; REAL_LT_IMP_LE]);;
 557
 558 let REAL_RSQRT_LE = prove
 559  (`!x y. &0 <= x /\ &0 <= y /\ x <= sqrt y ==> x pow 2 <= y`,
 560   MESON_TAC[REAL_POW_LE2; SQRT_POW_2]);;
 561
 562 let REAL_LSQRT_LE = prove
 563  (`!x y. &0 <= x /\ sqrt x <= y ==> x <= y pow 2`,
 564   MESON_TAC[REAL_POW_LE2; SQRT_POS_LE; REAL_LE_TRANS; SQRT_POW_2]);;
 565
 566 (* ------------------------------------------------------------------------- *)
 567 (* Hence derive more interesting properties of the norm.                     *)
 568 (* ------------------------------------------------------------------------- *)
 569
 570 let NORM_0 = prove
 571  (`norm(vec 0) = &0`,
 572   REWRITE_TAC[vector_norm; DOT_LZERO; SQRT_0]);;
 573
 574 let NORM_POS_LE = prove
 575  (`!x. &0 <= norm x`,
 576   GEN_TAC THEN SIMP_TAC[DOT_POS_LE; vector_norm; SQRT_POS_LE]);;
 577
 578 let NORM_NEG = prove
 579  (`!x. norm(--x) = norm x`,
 580   REWRITE_TAC[vector_norm; DOT_LNEG; DOT_RNEG; REAL_NEG_NEG]);;
 581
 582 let NORM_SUB = prove
 583  (`!x y. norm(x - y) = norm(y - x)`,
 584   MESON_TAC[NORM_NEG; VECTOR_NEG_SUB]);;
 585
 586 let NORM_MUL = prove
 587  (`!a x. norm(a % x) = abs(a) * norm x`,
 588   REWRITE_TAC[vector_norm; DOT_LMUL; DOT_RMUL; REAL_MUL_ASSOC] THEN
 589   SIMP_TAC[SQRT_MUL; SQRT_POS_LE; DOT_POS_LE; REAL_LE_SQUARE] THEN
 590   REWRITE_TAC[GSYM REAL_POW_2; POW_2_SQRT_ABS]);;
 591
 592 let NORM_EQ_0_DOT = prove
 593  (`!x. (norm x = &0) <=> (x dot x = &0)`,
 594   SIMP_TAC[vector_norm; SQRT_EQ_0; DOT_POS_LE]);;
 595
 596 let NORM_EQ_0 = prove
 597  (`!x. (norm x = &0) <=> (x = vec 0)`,
 598   SIMP_TAC[vector_norm; DOT_EQ_0; SQRT_EQ_0; DOT_POS_LE]);;
 599
 600 let NORM_POS_LT = prove
 601  (`!x. &0 < norm x <=> ~(x = vec 0)`,
 602   MESON_TAC[REAL_LT_LE; NORM_POS_LE; NORM_EQ_0]);;
 603
 604 let NORM_POW_2 = prove
 605  (`!x. norm(x) pow 2 = x dot x`,
 606   SIMP_TAC[vector_norm; SQRT_POW_2; DOT_POS_LE]);;
 607
 608 let NORM_EQ_0_IMP = prove
 609  (`!x. (norm x = &0) ==> (x = vec 0)`,
 610   MESON_TAC[NORM_EQ_0]);;
 611
 612 let NORM_LE_0 = prove
 613  (`!x. norm x <= &0 <=> (x = vec 0)`,
 614   MESON_TAC[REAL_LE_ANTISYM; NORM_EQ_0; NORM_POS_LE]);;
 615
 616 let VECTOR_MUL_EQ_0 = prove
 617  (`!a x. (a % x = vec 0) <=> (a = &0) \/ (x = vec 0)`,
 618   REWRITE_TAC[GSYM NORM_EQ_0; NORM_MUL; REAL_ABS_ZERO; REAL_ENTIRE]);;
 619
 620 let VECTOR_MUL_LCANCEL = prove
 621  (`!a x y. (a % x = a % y) <=> (a = &0) \/ (x = y)`,
 622   MESON_TAC[VECTOR_MUL_EQ_0; VECTOR_SUB_LDISTRIB; VECTOR_SUB_EQ]);;
 623
 624 let VECTOR_MUL_RCANCEL = prove
 625  (`!a b x. (a % x = b % x) <=> (a = b) \/ (x = vec 0)`,
 626   MESON_TAC[VECTOR_MUL_EQ_0; VECTOR_SUB_RDISTRIB; REAL_SUB_0; VECTOR_SUB_EQ]);;
 627
 628 let VECTOR_MUL_LCANCEL_IMP = prove
 629  (`!a x y. ~(a = &0) /\ (a % x = a % y) ==> (x = y)`,
 630   MESON_TAC[VECTOR_MUL_LCANCEL]);;
 631
 632 let VECTOR_MUL_RCANCEL_IMP = prove
 633  (`!a b x. ~(x = vec 0) /\ (a % x = b % x) ==> (a = b)`,
 634   MESON_TAC[VECTOR_MUL_RCANCEL]);;
 635
 636 let NORM_CAUCHY_SCHWARZ = prove
 637  (`!(x:real^N) y. x dot y <= norm(x) * norm(y)`,
 638   REPEAT STRIP_TAC THEN MAP_EVERY ASM_CASES_TAC
 639    [`norm(x:real^N) = &0`; `norm(y:real^N) = &0`] THEN
 640   ASM_SIMP_TAC[NORM_EQ_0_IMP; DOT_LZERO; DOT_RZERO;
 641                REAL_MUL_LZERO; REAL_MUL_RZERO] THEN
 642   MP_TAC(ISPEC `norm(y:real^N) % x - norm(x:real^N) % y` DOT_POS_LE) THEN
 643   REWRITE_TAC[DOT_RSUB; DOT_LSUB; DOT_LMUL; DOT_RMUL; GSYM NORM_POW_2;
 644               REAL_POW_2; REAL_LE_REFL] THEN
 645   REWRITE_TAC[DOT_SYM; REAL_ARITH
 646    `&0 <= y * (y * x * x - x * d) - x * (y * d - x * y * y) <=>
 647     x * y * d <= x * y * x * y`] THEN
 648   ASM_SIMP_TAC[REAL_LE_LMUL_EQ; REAL_LT_LE; NORM_POS_LE]);;
 649
 650 let NORM_CAUCHY_SCHWARZ_ABS = prove
 651  (`!x:real^N y. abs(x dot y) <= norm(x) * norm(y)`,
 652   REPEAT GEN_TAC THEN MP_TAC(ISPEC `x:real^N` NORM_CAUCHY_SCHWARZ) THEN
 653   DISCH_THEN(fun th -> MP_TAC(SPEC `y:real^N` th) THEN
 654         MP_TAC(SPEC `--(y:real^N)` th)) THEN
 655   REWRITE_TAC[DOT_RNEG; NORM_NEG] THEN REAL_ARITH_TAC);;
 656
 657 let REAL_ABS_NORM = prove
 658  (`!x. abs(norm x) = norm x`,
 659   REWRITE_TAC[NORM_POS_LE; REAL_ABS_REFL]);;
 660
 661 let NORM_CAUCHY_SCHWARZ_DIV = prove
 662  (`!x:real^N y. abs((x dot y) / (norm x * norm y)) <= &1`,
 663   REPEAT GEN_TAC THEN
 664   MAP_EVERY ASM_CASES_TAC [`x:real^N = vec 0`; `y:real^N = vec 0`] THEN
 665   ASM_REWRITE_TAC[NORM_0; REAL_MUL_LZERO; REAL_MUL_RZERO; real_div;
 666              REAL_INV_1; DOT_LZERO; DOT_RZERO; REAL_ABS_NUM; REAL_POS] THEN
 667   ASM_SIMP_TAC[GSYM real_div; REAL_ABS_DIV; REAL_LE_LDIV_EQ; REAL_LT_MUL;
 668      REAL_ABS_INV; NORM_POS_LT; REAL_ABS_MUL; REAL_ABS_NORM] THEN
 669   REWRITE_TAC[REAL_MUL_LID; NORM_CAUCHY_SCHWARZ_ABS]);;
 670
 671 let NORM_TRIANGLE = prove
 672  (`!x y. norm(x + y) <= norm(x) + norm(y)`,
 673   REPEAT GEN_TAC THEN REWRITE_TAC[vector_norm] THEN
 674   MATCH_MP_TAC REAL_LE_LSQRT THEN
 675   SIMP_TAC[GSYM vector_norm; DOT_POS_LE; NORM_POS_LE; REAL_LE_ADD] THEN
 676   REWRITE_TAC[DOT_LADD; DOT_RADD; REAL_POW_2; GSYM NORM_POW_2] THEN
 677   SIMP_TAC[NORM_CAUCHY_SCHWARZ; DOT_SYM; REAL_ARITH
 678    `d <= x * y ==> (x * x + d) + (d + y * y) <= (x + y) * (x + y)`]);;
 679
 680 let NORM_TRIANGLE_SUB = prove
 681  (`!x y:real^N. norm(x) <= norm(y) + norm(x - y)`,
 682   MESON_TAC[NORM_TRIANGLE; VECTOR_SUB_ADD2]);;
 683
 684 let NORM_TRIANGLE_LE = prove
 685  (`!x y. norm(x) + norm(y) <= e ==> norm(x + y) <= e`,
 686   MESON_TAC[REAL_LE_TRANS; NORM_TRIANGLE]);;
 687
 688 let NORM_TRIANGLE_LT = prove
 689  (`!x y. norm(x) + norm(y) < e ==> norm(x + y) < e`,
 690   MESON_TAC[REAL_LET_TRANS; NORM_TRIANGLE]);;
 691
 692 let COMPONENT_LE_NORM = prove
 693  (`!x:real^N i. 1 <= i /\  i <= dimindex(:N)
 694                  ==> abs(x$i) <= norm x`,
 695   REPEAT STRIP_TAC THEN REWRITE_TAC[vector_norm] THEN
 696   MATCH_MP_TAC REAL_LE_RSQRT THEN REWRITE_TAC[GSYM REAL_ABS_POW] THEN
 697   REWRITE_TAC[real_abs; REAL_POW_2; REAL_LE_SQUARE] THEN
 698   SUBGOAL_THEN
 699    `x$i * (x:real^N)$i =
 700      sum(1..dimindex(:N)) (\k. if k = i then x$i * x$i else &0)`
 701   SUBST1_TAC THENL
 702    [REWRITE_TAC[SUM_DELTA] THEN ASM_REWRITE_TAC[IN_NUMSEG]; ALL_TAC] THEN
 703   REWRITE_TAC[dot] THEN MATCH_MP_TAC SUM_LE THEN
 704   REWRITE_TAC[FINITE_NUMSEG] THEN
 705   REPEAT STRIP_TAC THEN COND_CASES_TAC THEN
 706   ASM_REWRITE_TAC[REAL_LE_REFL; REAL_LE_SQUARE]);;
 707
 708 let NORM_BOUND_COMPONENT_LE = prove
 709  (`!x:real^N e. norm(x) <= e
 710                 ==> !i. 1 <= i /\ i <= dimindex(:N) ==> abs(x$i) <= e`,
 711   MESON_TAC[COMPONENT_LE_NORM; REAL_LE_TRANS]);;
 712
 713 let NORM_BOUND_COMPONENT_LT = prove
 714  (`!x:real^N e. norm(x) < e
 715                 ==> !i. 1 <= i /\ i <= dimindex(:N) ==> abs(x$i) < e`,
 716   MESON_TAC[COMPONENT_LE_NORM; REAL_LET_TRANS]);;
 717
 718 let NORM_LE_L1 = prove
 719  (`!x:real^N. norm x <= sum(1..dimindex(:N)) (\i. abs(x$i))`,
 720   REPEAT GEN_TAC THEN REWRITE_TAC[vector_norm; dot] THEN
 721   MATCH_MP_TAC REAL_LE_LSQRT THEN REWRITE_TAC[REAL_POW_2] THEN
 722   SIMP_TAC[SUM_POS_LE; FINITE_NUMSEG; REAL_LE_SQUARE; REAL_ABS_POS] THEN
 723   SPEC_TAC(`dimindex(:N)`,`n:num`) THEN INDUCT_TAC THEN
 724   REWRITE_TAC[SUM_CLAUSES_NUMSEG; ARITH_EQ; ARITH_RULE `1 <= SUC n`] THEN
 725   SIMP_TAC[REAL_MUL_LZERO; REAL_LE_REFL] THEN
 726   MATCH_MP_TAC(REAL_ARITH
 727    `a2 <= a * a /\ &0 <= a * b /\ b2 <= b * b
 728     ==> a2 + b2 <= (a + b) * (a + b)`) THEN
 729   ASM_SIMP_TAC[SUM_POS_LE; REAL_LE_MUL; REAL_ABS_POS; FINITE_NUMSEG] THEN
 730   REWRITE_TAC[GSYM REAL_ABS_MUL] THEN REAL_ARITH_TAC);;
 731
 732 let REAL_ABS_SUB_NORM = prove
 733  (`abs(norm(x) - norm(y)) <= norm(x - y)`,
 734   REWRITE_TAC[REAL_ARITH `abs(x - y) <= a <=> x <= y + a /\ y <= x + a`] THEN
 735   MESON_TAC[NORM_TRIANGLE_SUB; NORM_SUB]);;
 736
 737 let NORM_LE = prove
 738  (`!x y. norm(x) <= norm(y) <=> x dot x <= y dot y`,
 739   REWRITE_TAC[vector_norm] THEN MESON_TAC[SQRT_MONO_LE_EQ; DOT_POS_LE]);;
 740
 741 let NORM_LT = prove
 742  (`!x y. norm(x) < norm(y) <=> x dot x < y dot y`,
 743   REWRITE_TAC[vector_norm] THEN MESON_TAC[SQRT_MONO_LT_EQ; DOT_POS_LE]);;
 744
 745 let NORM_EQ = prove
 746  (`!x y. (norm x = norm y) <=> (x dot x = y dot y)`,
 747   REWRITE_TAC[GSYM REAL_LE_ANTISYM; NORM_LE]);;
 748
 749 let NORM_EQ_1 = prove
 750  (`!x. norm(x) = &1 <=> x dot x = &1`,
 751   GEN_TAC THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM SQRT_1] THEN
 752   SIMP_TAC[vector_norm; SQRT_INJ; DOT_POS_LE; REAL_POS]);;
 753
 754 let NORM_LE_COMPONENTWISE = prove
 755  (`!x:real^N y:real^N.
 756         (!i. 1 <= i /\ i <= dimindex(:N) ==> abs(x$i) <= abs(y$i))
 757         ==> norm(x) <= norm(y)`,
 758   REPEAT STRIP_TAC THEN REWRITE_TAC[NORM_LE; dot] THEN
 759   MATCH_MP_TAC SUM_LE_NUMSEG THEN
 760   ASM_SIMP_TAC[GSYM REAL_POW_2; GSYM REAL_LE_SQUARE_ABS]);;
 761
 762 let L1_LE_NORM = prove
 763  (`!x:real^N.
 764     sum(1..dimindex(:N)) (\i. abs(x$i)) <= sqrt(&(dimindex(:N))) * norm x`,
 765   let lemma = prove
 766    (`!x n. &n * sum(1..n) (\i. x i pow 2) - (sum(1..n) x) pow 2 =
 767            sum(1..n) (\i. sum(i+1..n) (\j. (x i - x j) pow 2))`,
 768     GEN_TAC THEN CONV_TAC(BINDER_CONV SYM_CONV) THEN INDUCT_TAC THEN
 769     REWRITE_TAC[SUM_CLAUSES_NUMSEG; ARITH; ARITH_RULE `1 <= SUC n`] THEN
 770     CONV_TAC REAL_RAT_REDUCE_CONV THEN
 771     SIMP_TAC[ARITH_RULE `i <= n ==> i + 1 <= SUC n`; SUM_TRIV_NUMSEG;
 772              ARITH_RULE `~(n + 1 <= n)`; ARITH_RULE `n < SUC n + 1`] THEN
 773     ASM_REWRITE_TAC[SUM_ADD_NUMSEG; REAL_ADD_RID] THEN
 774     REWRITE_TAC[REAL_ARITH
 775      `(x - y) pow 2 = (x pow 2 + y pow 2) - &2 * x * y`] THEN
 776     REWRITE_TAC[SUM_ADD_NUMSEG; SUM_SUB_NUMSEG; SUM_LMUL; SUM_RMUL;
 777                 GSYM REAL_OF_NUM_SUC; SUM_CONST_NUMSEG; ADD_SUB] THEN
 778     REAL_ARITH_TAC) in
 779   GEN_TAC THEN
 780   MATCH_MP_TAC(REAL_ARITH `&0 <= y /\ abs x <= abs y ==> x <= y`) THEN
 781   SIMP_TAC[REAL_LE_MUL; NORM_POS_LE; SQRT_POS_LE; REAL_POS] THEN
 782   REWRITE_TAC[REAL_LE_SQUARE_ABS; REAL_POW_MUL] THEN
 783   SIMP_TAC[SQRT_POW_2; REAL_POS; NORM_POW_2; dot] THEN
 784   REWRITE_TAC[GSYM REAL_POW_2] THEN
 785   GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [GSYM REAL_POW2_ABS] THEN
 786   ONCE_REWRITE_TAC[GSYM REAL_SUB_LE] THEN REWRITE_TAC[lemma] THEN
 787   SIMP_TAC[SUM_POS_LE_NUMSEG; REAL_LE_POW_2]);;
 788
 789 (* ------------------------------------------------------------------------- *)
 790 (* Squaring equations and inequalities involving norms.                      *)
 791 (* ------------------------------------------------------------------------- *)
 792
 793 let DOT_SQUARE_NORM = prove
 794  (`!x. x dot x = norm(x) pow 2`,
 795   SIMP_TAC[vector_norm; SQRT_POW_2; DOT_POS_LE]);;
 796
 797 let NORM_EQ_SQUARE = prove
 798  (`!x:real^N. norm(x) = a <=> &0 <= a /\ x dot x = a pow 2`,
 799   REWRITE_TAC[DOT_SQUARE_NORM] THEN
 800   ONCE_REWRITE_TAC[REAL_RING `x pow 2 = a pow 2 <=> x = a \/ x + a = &0`] THEN
 801   GEN_TAC THEN MP_TAC(ISPEC `x:real^N` NORM_POS_LE) THEN REAL_ARITH_TAC);;
 802
 803 let NORM_LE_SQUARE = prove
 804  (`!x:real^N. norm(x) <= a <=> &0 <= a /\ x dot x <= a pow 2`,
 805   REWRITE_TAC[DOT_SQUARE_NORM; GSYM REAL_LE_SQUARE_ABS] THEN
 806   GEN_TAC THEN MP_TAC(ISPEC `x:real^N` NORM_POS_LE) THEN REAL_ARITH_TAC);;
 807
 808 let NORM_GE_SQUARE = prove
 809  (`!x:real^N. norm(x) >= a <=> a <= &0 \/ x dot x >= a pow 2`,
 810   REWRITE_TAC[real_ge; DOT_SQUARE_NORM; GSYM REAL_LE_SQUARE_ABS] THEN
 811   GEN_TAC THEN MP_TAC(ISPEC `x:real^N` NORM_POS_LE) THEN REAL_ARITH_TAC);;
 812
 813 let NORM_LT_SQUARE = prove
 814  (`!x:real^N. norm(x) < a <=> &0 < a /\ x dot x < a pow 2`,
 815   REWRITE_TAC[REAL_ARITH `x < a <=> ~(x >= a)`; NORM_GE_SQUARE] THEN
 816   REAL_ARITH_TAC);;
 817
 818 let NORM_GT_SQUARE = prove
 819  (`!x:real^N. norm(x) > a <=> a < &0 \/ x dot x > a pow 2`,
 820   REWRITE_TAC[REAL_ARITH `x > a <=> ~(x <= a)`; NORM_LE_SQUARE] THEN
 821   REAL_ARITH_TAC);;
 822
 823 let NORM_LT_SQUARE_ALT = prove
 824  (`!x:real^N. norm(x) < a <=> &0 <= a /\ x dot x < a pow 2`,
 825   REWRITE_TAC[REAL_ARITH `x < a <=> ~(x >= a)`; NORM_GE_SQUARE] THEN
 826   REPEAT GEN_TAC THEN ASM_CASES_TAC `a = &0` THENL
 827    [ASM_REWRITE_TAC[real_ge] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN
 828     REWRITE_TAC[DOT_POS_LE];
 829     ASM_REAL_ARITH_TAC]);;
 830
 831 (* ------------------------------------------------------------------------- *)
 832 (* General linear decision procedure for normed spaces.                      *)
 833 (* ------------------------------------------------------------------------- *)
 834
 835 let NORM_ARITH =
 836   let find_normedterms =
 837     let augment_norm b tm acc =
 838       match tm with
 839         Comb(Const("vector_norm",_),v) -> insert (b,v) acc
 840       | _ -> acc in
 841     let rec find_normedterms tm acc =
 842       match tm with
 843         Comb(Comb(Const("real_add",_),l),r) ->
 844             find_normedterms l (find_normedterms r acc)
 845       | Comb(Comb(Const("real_mul",_),c),n) ->
 846             if not (is_ratconst c) then acc else
 847             augment_norm (rat_of_term c >=/ Int 0) n acc
 848       | _ -> augment_norm true tm acc in
 849     find_normedterms in
 850   let lincomb_neg t = mapf minus_num t in
 851   let lincomb_cmul c t = if c =/ Int 0 then undefined else mapf (( */ ) c) t in
 852   let lincomb_add l r = combine (+/) (fun x -> x =/ Int 0) l r in
 853   let lincomb_sub l r = lincomb_add l (lincomb_neg r) in
 854   let lincomb_eq l r = lincomb_sub l r = undefined in
 855   let rec vector_lincomb tm =
 856     match tm with
 857         Comb(Comb(Const("vector_add",_),l),r) ->
 858           lincomb_add (vector_lincomb l) (vector_lincomb r)
 859       | Comb(Comb(Const("vector_sub",_),l),r) ->
 860           lincomb_sub (vector_lincomb l) (vector_lincomb r)
 861       | Comb(Comb(Const("%",_),l),r) ->
 862           lincomb_cmul (rat_of_term l) (vector_lincomb r)
 863       | Comb(Const("vector_neg",_),t) ->
 864           lincomb_neg (vector_lincomb t)
 865       | Comb(Const("vec",_),n) when is_numeral n & dest_numeral n =/ Int 0 ->
 866           undefined
 867       | _ -> (tm |=> Int 1) in
 868   let vector_lincombs tms =
 869     itlist (fun t fns ->
 870                   if can (assoc t) fns then fns else
 871                   let f = vector_lincomb t in
 872                   try let _,f' = find (fun (_,f') -> lincomb_eq f f') fns in
 873                       (t,f')::fns
 874                   with Failure _ -> (t,f)::fns) tms [] in
 875   let rec replacenegnorms fn tm =
 876     match tm with
 877       Comb(Comb(Const("real_add",_),l),r) ->
 878           BINOP_CONV (replacenegnorms fn) tm
 879     | Comb(Comb(Const("real_mul",_),c),n) when rat_of_term c </ Int 0 ->
 880           RAND_CONV fn tm
 881     | _ -> REFL tm in
 882   let flip v eq =
 883     if defined eq v then (v |-> minus_num(apply eq v)) eq else eq in
 884   let rec allsubsets s =
 885     match s with
 886       [] -> [[]]
 887     | (a::t) -> let res = allsubsets t in
 888                 map (fun b -> a::b) res @ res in
 889   let evaluate env lin =
 890     foldr (fun x c s -> s +/ c */ apply env x) lin (Int 0) in
 891   let rec solve (vs,eqs) =
 892     match (vs,eqs) with
 893       [],[] -> (0 |=> Int 1)
 894     | _,eq::oeqs ->
 895           let v = hd(intersect vs (dom eq)) in
 896           let c = apply eq v in
 897           let vdef = lincomb_cmul (Int(-1) // c) eq in
 898           let eliminate eqn =
 899             if not(defined eqn v) then eqn else
 900             lincomb_add (lincomb_cmul (apply eqn v) vdef) eqn in
 901           let soln = solve (subtract vs [v],map eliminate oeqs) in
 902           (v |-> evaluate soln (undefine v vdef)) soln in
 903   let rec combinations k l =
 904     if k = 0 then [[]] else
 905     match l with
 906       [] -> []
 907     | h::t -> map (fun c -> h::c) (combinations (k - 1) t) @
 908               combinations k t in
 909   let vertices vs eqs =
 910     let vertex cmb =
 911       let soln = solve(vs,cmb) in
 912       map (fun v -> tryapplyd soln v (Int 0)) vs in
 913     let rawvs = mapfilter vertex (combinations (length vs) eqs) in
 914     let unset = filter (forall (fun c -> c >=/ Int 0)) rawvs in
 915     itlist (insert' (forall2 (=/))) unset [] in
 916   let subsumes l m = forall2 (fun x y -> abs_num x <=/ abs_num y) l m in
 917   let rec subsume todo dun =
 918     match todo with
 919       [] -> dun
 920     | v::ovs -> let dun' = if exists (fun w -> subsumes w v) dun then dun
 921                            else v::(filter (fun w -> not(subsumes v w)) dun) in
 922                 subsume ovs dun' in
 923   let NORM_CMUL_RULE =
 924     let MATCH_pth = (MATCH_MP o prove)
 925      (`!b x. b >= norm(x) ==> !c. abs(c) * b >= norm(c % x)`,
 926       SIMP_TAC[NORM_MUL; real_ge; REAL_LE_LMUL; REAL_ABS_POS]) in
 927     fun c th -> ISPEC(term_of_rat c) (MATCH_pth th) in
 928   let NORM_ADD_RULE =
 929     let MATCH_pth = (MATCH_MP o prove)
 930      (`!b1 b2 x1 x2. b1 >= norm(x1) /\ b2 >= norm(x2)
 931                      ==> b1 + b2 >= norm(x1 + x2)`,
 932       REWRITE_TAC[real_ge] THEN REPEAT STRIP_TAC THEN
 933       MATCH_MP_TAC NORM_TRIANGLE_LE THEN ASM_SIMP_TAC[REAL_LE_ADD2]) in
 934     fun th1 th2 -> MATCH_pth (CONJ th1 th2) in
 935   let INEQUALITY_CANON_RULE =
 936     CONV_RULE(LAND_CONV REAL_POLY_CONV) o
 937     CONV_RULE(LAND_CONV REAL_RAT_REDUCE_CONV) o
 938     GEN_REWRITE_RULE I [REAL_ARITH `s >= t <=> s - t >= &0`] in
 939   let NORM_CANON_CONV =
 940     let APPLY_pth1 = GEN_REWRITE_CONV I
 941      [VECTOR_ARITH `x:real^N = &1 % x`]
 942     and APPLY_pth2 = GEN_REWRITE_CONV I
 943      [VECTOR_ARITH `x - y:real^N = x + --y`]
 944     and APPLY_pth3 = GEN_REWRITE_CONV I
 945      [VECTOR_ARITH `--x:real^N = -- &1 % x`]
 946     and APPLY_pth4 = GEN_REWRITE_CONV I
 947      [VECTOR_ARITH `&0 % x:real^N = vec 0`;
 948       VECTOR_ARITH `c % vec 0:real^N = vec 0`]
 949     and APPLY_pth5 = GEN_REWRITE_CONV I
 950      [VECTOR_ARITH `c % (d % x) = (c * d) % x`]
 951     and APPLY_pth6 = GEN_REWRITE_CONV I
 952      [VECTOR_ARITH `c % (x + y) = c % x + c % y`]
 953     and APPLY_pth7 = GEN_REWRITE_CONV I
 954      [VECTOR_ARITH `vec 0 + x = x`;
 955       VECTOR_ARITH `x + vec 0 = x`]
 956     and APPLY_pth8 =
 957      GEN_REWRITE_CONV I [VECTOR_ARITH `c % x + d % x = (c + d) % x`] THENC
 958      LAND_CONV REAL_RAT_ADD_CONV THENC
 959      GEN_REWRITE_CONV TRY_CONV [VECTOR_ARITH `&0 % x = vec 0`]
 960     and APPLY_pth9 =
 961      GEN_REWRITE_CONV I
 962       [VECTOR_ARITH `(c % x + z) + d % x = (c + d) % x + z`;
 963        VECTOR_ARITH `c % x + (d % x + z) = (c + d) % x + z`;
 964        VECTOR_ARITH `(c % x + w) + (d % x + z) = (c + d) % x + (w + z)`] THENC
 965      LAND_CONV(LAND_CONV REAL_RAT_ADD_CONV)
 966     and APPLY_ptha =
 967      GEN_REWRITE_CONV I [VECTOR_ARITH `&0 % x + y = y`]
 968     and APPLY_pthb =
 969      GEN_REWRITE_CONV I
 970       [VECTOR_ARITH `c % x + d % y = c % x + d % y`;
 971        VECTOR_ARITH `(c % x + z) + d % y = c % x + (z + d % y)`;
 972        VECTOR_ARITH `c % x + (d % y + z) = c % x + (d % y + z)`;
 973        VECTOR_ARITH `(c % x + w) + (d % y + z) = c % x + (w + (d % y + z))`]
 974     and APPLY_pthc =
 975      GEN_REWRITE_CONV I
 976       [VECTOR_ARITH `c % x + d % y = d % y + c % x`;
 977        VECTOR_ARITH `(c % x + z) + d % y = d % y + (c % x + z)`;
 978        VECTOR_ARITH `c % x + (d % y + z) = d % y + (c % x + z)`;
 979        VECTOR_ARITH `(c % x + w) + (d % y + z) = d % y + ((c % x + w) + z)`]
 980     and APPLY_pthd =
 981      GEN_REWRITE_CONV TRY_CONV
 982       [VECTOR_ARITH `x + vec 0 = x`] in
 983     let headvector tm =
 984       match tm with
 985         Comb(Comb(Const("vector_add",_),Comb(Comb(Const("%",_),l),v)),r) -> v
 986       | Comb(Comb(Const("%",_),l),v) -> v
 987       | _ -> failwith "headvector: non-canonical term" in
 988     let rec VECTOR_CMUL_CONV tm =
 989      ((APPLY_pth5 THENC LAND_CONV REAL_RAT_MUL_CONV) ORELSEC
 990       (APPLY_pth6 THENC BINOP_CONV VECTOR_CMUL_CONV)) tm
 991     and VECTOR_ADD_CONV tm =
 992       try APPLY_pth7 tm with Failure _ ->
 993       try APPLY_pth8 tm with Failure _ ->
 994       match tm with
 995         Comb(Comb(Const("vector_add",_),lt),rt) ->
 996           let l = headvector lt and r = headvector rt in
 997           if l < r then (APPLY_pthb THENC
 998                          RAND_CONV VECTOR_ADD_CONV THENC
 999                          APPLY_pthd) tm
1000           else if r < l then (APPLY_pthc THENC
1001                               RAND_CONV VECTOR_ADD_CONV THENC
1002                               APPLY_pthd) tm else
1003           (APPLY_pth9 THENC
1004             ((APPLY_ptha THENC VECTOR_ADD_CONV) ORELSEC
1005              RAND_CONV VECTOR_ADD_CONV THENC
1006              APPLY_pthd)) tm
1007       | _ -> REFL tm in
1008     let rec VECTOR_CANON_CONV tm =
1009       match tm with
1010         Comb(Comb(Const("vector_add",_),l),r) ->
1011           let lth = VECTOR_CANON_CONV l and rth = VECTOR_CANON_CONV r in
1012           let th = MK_COMB(AP_TERM (rator(rator tm)) lth,rth) in
1013           CONV_RULE (RAND_CONV VECTOR_ADD_CONV) th
1014       | Comb(Comb(Const("%",_),l),r) ->
1015           let rth = AP_TERM (rator tm) (VECTOR_CANON_CONV r) in
1016           CONV_RULE (RAND_CONV(APPLY_pth4 ORELSEC VECTOR_CMUL_CONV)) rth
1017       | Comb(Comb(Const("vector_sub",_),l),r) ->
1018           (APPLY_pth2 THENC VECTOR_CANON_CONV) tm
1019       | Comb(Const("vector_neg",_),t) ->
1020           (APPLY_pth3 THENC VECTOR_CANON_CONV) tm
1021       | Comb(Const("vec",_),n) when is_numeral n & dest_numeral n =/ Int 0 ->
1022           REFL tm
1023       | _ -> APPLY_pth1 tm in
1024     fun tm ->
1025       match tm with
1026        Comb(Const("vector_norm",_),e) -> RAND_CONV VECTOR_CANON_CONV tm
1027       | _ -> failwith "NORM_CANON_CONV" in
1028   let REAL_VECTOR_COMBO_PROVER =
1029     let pth_zero = prove(`norm(vec 0:real^N) = &0`,REWRITE_TAC[NORM_0])
1030     and tv_n = mk_vartype "N" in
1031     fun translator (nubs,ges,gts) ->
1032       let sources = map (rand o rand o concl) nubs
1033       and rawdests = itlist (find_normedterms o lhand o concl) (ges @ gts) [] in
1034       if not (forall fst rawdests) then failwith "Sanity check" else
1035       let dests = setify (map snd rawdests) in
1036       let srcfuns = map vector_lincomb sources
1037       and destfuns = map vector_lincomb dests in
1038       let vvs = itlist (union o dom) (srcfuns @ destfuns) [] in
1039       let n = length srcfuns in
1040       let nvs = 1--n in
1041       let srccombs = zip srcfuns nvs in
1042       let consider d =
1043         let coefficients x =
1044             let inp = if defined d x then 0 |=> minus_num(apply d x)
1045                       else undefined in
1046           itlist (fun (f,v) g -> if defined f x then (v |-> apply f x) g else g)
1047                  srccombs inp in
1048         let equations = map coefficients vvs
1049         and inequalities = map (fun n -> (n |=> Int 1)) nvs in
1050         let plausiblevertices f =
1051           let flippedequations = map (itlist flip f) equations in
1052           let constraints = flippedequations @ inequalities in
1053           let rawverts = vertices nvs constraints in
1054           let check_solution v =
1055             let f = itlist2 (|->) nvs v (0 |=> Int 1) in
1056             forall (fun e -> evaluate f e =/ Int 0) flippedequations in
1057           let goodverts = filter check_solution rawverts in
1058           let signfixups = map (fun n -> if mem n f then -1 else 1) nvs in
1059           map (map2 (fun s c -> Int s */ c) signfixups) goodverts in
1060         let allverts = itlist (@) (map plausiblevertices (allsubsets nvs)) [] in
1061         subsume allverts [] in
1062       let compute_ineq v =
1063         let ths = mapfilter (fun (v,t) -> if v =/ Int 0 then fail()
1064                                           else  NORM_CMUL_RULE v t)
1065                             (zip v nubs) in
1066         INEQUALITY_CANON_RULE (end_itlist NORM_ADD_RULE ths) in
1067       let ges' = mapfilter compute_ineq (itlist ((@) o consider) destfuns []) @
1068                  map INEQUALITY_CANON_RULE nubs @ ges in
1069       let zerodests = filter
1070         (fun t -> dom(vector_lincomb t) = []) (map snd rawdests) in
1071       REAL_LINEAR_PROVER translator
1072        (map (fun t -> INST_TYPE [last(snd(dest_type(type_of t))),tv_n] pth_zero)
1073             zerodests,
1074         map (CONV_RULE(ONCE_DEPTH_CONV NORM_CANON_CONV THENC
1075                        LAND_CONV REAL_POLY_CONV)) ges',
1076         map (CONV_RULE(ONCE_DEPTH_CONV NORM_CANON_CONV THENC
1077                        LAND_CONV REAL_POLY_CONV)) gts) in
1078   let REAL_VECTOR_INEQ_PROVER =
1079     let pth = prove
1080      (`norm(x) = n ==> norm(x) >= &0 /\ n >= norm(x)`,
1081       DISCH_THEN(SUBST_ALL_TAC o SYM) THEN
1082       REWRITE_TAC[real_ge; NORM_POS_LE] THEN REAL_ARITH_TAC) in
1083     let NORM_MP = MATCH_MP pth in
1084     fun translator (ges,gts) ->
1085     let ntms = itlist find_normedterms (map (lhand o concl) (ges @ gts)) [] in
1086     let lctab = vector_lincombs (map snd (filter (not o fst) ntms)) in
1087     let asl = map (fun (t,_) ->
1088        ASSUME(mk_eq(mk_icomb(mk_const("vector_norm",[]),t),
1089                     genvar `:real`))) lctab in
1090     let replace_conv = GEN_REWRITE_CONV TRY_CONV asl in
1091     let replace_rule = CONV_RULE (LAND_CONV (replacenegnorms replace_conv)) in
1092     let ges' =
1093        itlist (fun th ths -> CONJUNCT1(NORM_MP th)::ths)
1094               asl (map replace_rule ges)
1095     and gts' = map replace_rule gts
1096     and nubs = map (CONJUNCT2 o NORM_MP) asl in
1097     let th1 = REAL_VECTOR_COMBO_PROVER translator (nubs,ges',gts') in
1098     let th2 = INST
1099      (map (fun th -> let l,r = dest_eq(concl th) in (l,r)) asl) th1 in
1100     itlist PROVE_HYP (map (REFL o lhand o concl) asl) th2 in
1101   let REAL_VECTOR_PROVER =
1102     let rawrule =
1103       GEN_REWRITE_RULE I [REAL_ARITH `x = &0 <=> x >= &0 /\ --x >= &0`] in
1104     let splitequation th acc =
1105       let th1,th2 = CONJ_PAIR(rawrule th) in
1106       th1::CONV_RULE(LAND_CONV REAL_POLY_NEG_CONV) th2::acc in
1107     fun translator (eqs,ges,gts) ->
1108       REAL_VECTOR_INEQ_PROVER translator
1109          (itlist splitequation eqs ges,gts) in
1110   let pth = prove
1111    (`(!x y:real^N. x = y <=> norm(x - y) <= &0) /\
1112      (!x y:real^N. ~(x = y) <=> ~(norm(x - y) <= &0))`,
1113     REWRITE_TAC[NORM_LE_0; VECTOR_SUB_EQ]) in
1114   let conv1 = GEN_REWRITE_CONV TRY_CONV [pth] in
1115   let conv2 tm = (conv1 tm,conv1(mk_neg tm)) in
1116   let init = GEN_REWRITE_CONV ONCE_DEPTH_CONV [DECIMAL] THENC
1117              REAL_RAT_REDUCE_CONV THENC
1118              GEN_REWRITE_CONV ONCE_DEPTH_CONV [dist] THENC
1119              GEN_NNF_CONV true (conv1,conv2)
1120   and pure = GEN_REAL_ARITH REAL_VECTOR_PROVER in
1121   fun tm -> let th = init tm in EQ_MP (SYM th) (pure(rand(concl th)));;
1122
1123 let NORM_ARITH_TAC = CONV_TAC NORM_ARITH;;
1124
1125 let ASM_NORM_ARITH_TAC =
1126   REPEAT(FIRST_X_ASSUM(MP_TAC o check (not o is_forall o concl))) THEN
1127   NORM_ARITH_TAC;;
1128
1129 (* ------------------------------------------------------------------------- *)
1130 (* Dot product in terms of the norm rather than conversely.                  *)
1131 (* ------------------------------------------------------------------------- *)
1132
1133 let DOT_NORM = prove
1134  (`!x y. x dot y = (norm(x + y) pow 2 - norm(x) pow 2 - norm(y) pow 2) / &2`,
1135   REWRITE_TAC[NORM_POW_2; DOT_LADD; DOT_RADD; DOT_SYM] THEN REAL_ARITH_TAC);;
1136
1137 let DOT_NORM_NEG = prove
1138  (`!x y. x dot y = ((norm(x) pow 2 + norm(y) pow 2) - norm(x - y) pow 2) / &2`,
1139   REWRITE_TAC[NORM_POW_2; DOT_LADD; DOT_RADD; DOT_LSUB; DOT_RSUB; DOT_SYM] THEN
1140   REAL_ARITH_TAC);;
1141
1142 let DOT_NORM_SUB = prove
1143  (`!x y. x dot y = ((norm(x) pow 2 + norm(y) pow 2) - norm(x - y) pow 2) / &2`,
1144   REWRITE_TAC[NORM_POW_2; DOT_LSUB; DOT_RSUB; DOT_SYM] THEN REAL_ARITH_TAC);;
1145
1146 (* ------------------------------------------------------------------------- *)
1147 (* Equality of vectors in terms of dot products.                             *)
1148 (* ------------------------------------------------------------------------- *)
1149
1150 let VECTOR_EQ = prove
1151  (`!x y. (x = y) <=> (x dot x = x dot y) /\ (y dot y = x dot x)`,
1152   REPEAT GEN_TAC THEN EQ_TAC THENL [SIMP_TAC[]; ALL_TAC] THEN
1153   ONCE_REWRITE_TAC[GSYM VECTOR_SUB_EQ] THEN
1154   REWRITE_TAC[GSYM DOT_EQ_0] THEN
1155   SIMP_TAC[DOT_LSUB; DOT_RSUB; DOT_SYM] THEN REAL_ARITH_TAC);;
1156
1157 (* ------------------------------------------------------------------------- *)
1158 (* Hence more metric properties.                                             *)
1159 (* ------------------------------------------------------------------------- *)
1160
1161 let DIST_REFL = prove
1162  (`!x. dist(x,x) = &0`,
1163   NORM_ARITH_TAC);;
1164
1165 let DIST_SYM = prove
1166  (`!x y. dist(x,y) = dist(y,x)`,
1167   NORM_ARITH_TAC);;
1168
1169 let DIST_POS_LE = prove
1170  (`!x y. &0 <= dist(x,y)`,
1171   NORM_ARITH_TAC);;
1172
1173 let DIST_TRIANGLE = prove
1174  (`!x:real^N y z. dist(x,z) <= dist(x,y) + dist(y,z)`,
1175   NORM_ARITH_TAC);;
1176
1177 let DIST_TRIANGLE_ALT = prove
1178  (`!x y z. dist(y,z) <= dist(x,y) + dist(x,z)`,
1179   NORM_ARITH_TAC);;
1180
1181 let DIST_EQ_0 = prove
1182  (`!x y. (dist(x,y) = &0) <=> (x = y)`,
1183   NORM_ARITH_TAC);;
1184
1185 let DIST_POS_LT = prove
1186  (`!x y. ~(x = y) ==> &0 < dist(x,y)`,
1187   NORM_ARITH_TAC);;
1188
1189 let DIST_NZ = prove
1190  (`!x y. ~(x = y) <=> &0 < dist(x,y)`,
1191   NORM_ARITH_TAC);;
1192
1193 let DIST_TRIANGLE_LE = prove
1194  (`!x y z e. dist(x,z) + dist(y,z) <= e ==> dist(x,y) <= e`,
1195   NORM_ARITH_TAC);;
1196
1197 let DIST_TRIANGLE_LT = prove
1198  (`!x y z e. dist(x,z) + dist(y,z) < e ==> dist(x,y) < e`,
1199   NORM_ARITH_TAC);;
1200
1201 let DIST_TRIANGLE_HALF_L = prove
1202  (`!x1 x2 y. dist(x1,y) < e / &2 /\ dist(x2,y) < e / &2 ==> dist(x1,x2) < e`,
1203   NORM_ARITH_TAC);;
1204
1205 let DIST_TRIANGLE_HALF_R = prove
1206  (`!x1 x2 y. dist(y,x1) < e / &2 /\ dist(y,x2) < e / &2 ==> dist(x1,x2) < e`,
1207   NORM_ARITH_TAC);;
1208
1209 let DIST_TRIANGLE_ADD = prove
1210  (`!x x' y y'. dist(x + y,x' + y') <= dist(x,x') + dist(y,y')`,
1211   NORM_ARITH_TAC);;
1212
1213 let DIST_MUL = prove
1214  (`!x y c. dist(c % x,c % y) = abs(c) * dist(x,y)`,
1215   REWRITE_TAC[dist; GSYM VECTOR_SUB_LDISTRIB; NORM_MUL]);;
1216
1217 let DIST_TRIANGLE_ADD_HALF = prove
1218  (`!x x' y y':real^N.
1219     dist(x,x') < e / &2 /\ dist(y,y') < e / &2 ==> dist(x + y,x' + y') < e`,
1220   NORM_ARITH_TAC);;
1221
1222 let DIST_LE_0 = prove
1223  (`!x y. dist(x,y) <= &0 <=> x = y`,
1224   NORM_ARITH_TAC);;
1225
1226 let DIST_EQ = prove
1227  (`!w x y z. dist(w,x) = dist(y,z) <=> dist(w,x) pow 2 = dist(y,z) pow 2`,
1228   REWRITE_TAC[dist; NORM_POW_2; NORM_EQ]);;
1229
1230 let DIST_0 = prove
1231  (`!x. dist(x,vec 0) = norm(x) /\ dist(vec 0,x) = norm(x)`,
1232   NORM_ARITH_TAC);;
1233
1234 (* ------------------------------------------------------------------------- *)
1235 (* Sums of vectors.                                                          *)
1236 (* ------------------------------------------------------------------------- *)
1237
1238 let NEUTRAL_VECTOR_ADD = prove
1239  (`neutral(+) = vec 0:real^N`,
1240   REWRITE_TAC[neutral] THEN MATCH_MP_TAC SELECT_UNIQUE THEN
1241   REWRITE_TAC[VECTOR_ARITH `x + y = y <=> x = vec 0`;
1242               VECTOR_ARITH `x + y = x <=> y = vec 0`]);;
1243
1244 let MONOIDAL_VECTOR_ADD = prove
1245  (`monoidal((+):real^N->real^N->real^N)`,
1246   REWRITE_TAC[monoidal; NEUTRAL_VECTOR_ADD] THEN
1247   REPEAT CONJ_TAC THEN VECTOR_ARITH_TAC);;
1248
1249 let vsum = new_definition
1250   `(vsum:(A->bool)->(A->real^N)->real^N) s f = lambda i. sum s (\x. f(x)$i)`;;
1251
1252 let VSUM_CLAUSES = prove
1253  (`(!f. vsum {} f = vec 0) /\
1254    (!x f s. FINITE s
1255             ==> (vsum (x INSERT s) f =
1256                  if x IN s then vsum s f else f(x) + vsum s f))`,
1257   SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA; VECTOR_ADD_COMPONENT; SUM_CLAUSES] THEN
1258   SIMP_TAC[VEC_COMPONENT] THEN REPEAT STRIP_TAC THEN
1259   COND_CASES_TAC THEN ASM_SIMP_TAC[LAMBDA_BETA; VECTOR_ADD_COMPONENT]);;
1260
1261 let VSUM = prove
1262  (`!f s. FINITE s ==> vsum s f = iterate (+) s f`,
1263   GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
1264   ASM_SIMP_TAC[VSUM_CLAUSES; ITERATE_CLAUSES; MONOIDAL_VECTOR_ADD] THEN
1265   REWRITE_TAC[NEUTRAL_VECTOR_ADD]);;
1266
1267 let VSUM_EQ_0 = prove
1268  (`!f s. (!x:A. x IN s ==> (f(x) = vec 0)) ==> (vsum s f = vec 0)`,
1269   SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA; vec; SUM_EQ_0]);;
1270
1271 let VSUM_0 = prove
1272  (`vsum s (\x. vec 0) = vec 0`,
1273   SIMP_TAC[VSUM_EQ_0]);;
1274
1275 let VSUM_LMUL = prove
1276  (`!f c s.  vsum s (\x. c % f(x)) = c % vsum s f`,
1277   SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA; VECTOR_MUL_COMPONENT; SUM_LMUL]);;
1278
1279 let VSUM_RMUL = prove
1280  (`!c s v. vsum s (\x. c x % v) = (sum s c) % v`,
1281   SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA; VECTOR_MUL_COMPONENT; SUM_RMUL]);;
1282
1283 let VSUM_ADD = prove
1284  (`!f g s. FINITE s ==> (vsum s (\x. f x + g x) = vsum s f + vsum s g)`,
1285   SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA; VECTOR_ADD_COMPONENT; SUM_ADD]);;
1286
1287 let VSUM_SUB = prove
1288  (`!f g s. FINITE s ==> (vsum s (\x. f x - g x) = vsum s f - vsum s g)`,
1289   SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA; VECTOR_SUB_COMPONENT; SUM_SUB]);;
1290
1291 let VSUM_CONST = prove
1292  (`!c s. FINITE s ==> (vsum s (\n. c) = &(CARD s) % c)`,
1293   SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA; SUM_CONST; VECTOR_MUL_COMPONENT]);;
1294
1295 let VSUM_COMPONENT = prove
1296  (`!s f i. 1 <= i /\ i <= dimindex(:N)
1297            ==> ((vsum s (f:A->real^N))$i = sum s (\x. f(x)$i))`,
1298   SIMP_TAC[vsum; LAMBDA_BETA]);;
1299
1300 let VSUM_IMAGE = prove
1301  (`!f g s. FINITE s /\ (!x y. x IN s /\ y IN s /\ (f x = f y) ==> (x = y))
1302            ==> (vsum (IMAGE f s) g = vsum s (g o f))`,
1303   SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA] THEN REPEAT STRIP_TAC THEN
1304   W(MP_TAC o PART_MATCH (lhs o rand) SUM_IMAGE o lhs o snd) THEN
1305   ASM_REWRITE_TAC[o_DEF]);;
1306
1307 let VSUM_UNION = prove
1308  (`!f s t. FINITE s /\ FINITE t /\ DISJOINT s t
1309            ==> (vsum (s UNION t) f = vsum s f + vsum t f)`,
1310   SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA; SUM_UNION; VECTOR_ADD_COMPONENT]);;
1311
1312 let VSUM_DIFF = prove
1313  (`!f s t. FINITE s /\ t SUBSET s
1314            ==> (vsum (s DIFF t) f = vsum s f - vsum t f)`,
1315   SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA; SUM_DIFF; VECTOR_SUB_COMPONENT]);;
1316
1317 let VSUM_DELETE = prove
1318  (`!f s a. FINITE s /\ a IN s
1319            ==> vsum (s DELETE a) f = vsum s f - f a`,
1320   SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA; SUM_DELETE; VECTOR_SUB_COMPONENT]);;
1321
1322 let VSUM_INCL_EXCL = prove
1323  (`!s t (f:A->real^N).
1324         FINITE s /\ FINITE t
1325         ==> vsum s f + vsum t f = vsum (s UNION t) f + vsum (s INTER t) f`,
1326   SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA; VECTOR_ADD_COMPONENT] THEN
1327   SIMP_TAC[SUM_INCL_EXCL]);;
1328
1329 let VSUM_NEG = prove
1330  (`!f s. vsum s (\x. --f x) = --vsum s f`,
1331   SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA; SUM_NEG; VECTOR_NEG_COMPONENT]);;
1332
1333 let VSUM_EQ = prove
1334  (`!f g s. (!x. x IN s ==> (f x = g x)) ==> (vsum s f = vsum s g)`,
1335   SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA] THEN
1336   REPEAT STRIP_TAC THEN MATCH_MP_TAC SUM_EQ THEN ASM_SIMP_TAC[]);;
1337
1338 let VSUM_SUPERSET = prove
1339  (`!f:A->real^N u v.
1340         u SUBSET v /\ (!x. x IN v /\ ~(x IN u) ==> (f(x) = vec 0))
1341         ==> (vsum v f = vsum u f)`,
1342   SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA; VEC_COMPONENT; SUM_SUPERSET]);;
1343
1344 let VSUM_EQ_SUPERSET = prove
1345  (`!f s t:A->bool.
1346         FINITE t /\ t SUBSET s /\
1347         (!x. x IN t ==> (f x = g x)) /\
1348         (!x. x IN s /\ ~(x IN t) ==> f(x) = vec 0)
1349         ==> vsum s f = vsum t g`,
1350   MESON_TAC[VSUM_SUPERSET; VSUM_EQ]);;
1351
1352 let VSUM_UNION_RZERO = prove
1353  (`!f:A->real^N u v.
1354         FINITE u /\ (!x. x IN v /\ ~(x IN u) ==> (f(x) = vec 0))
1355         ==> (vsum (u UNION v) f = vsum u f)`,
1356   SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA; VEC_COMPONENT; SUM_UNION_RZERO]);;
1357
1358 let VSUM_UNION_LZERO = prove
1359  (`!f:A->real^N u v.
1360         FINITE v /\ (!x. x IN u /\ ~(x IN v) ==> (f(x) = vec 0))
1361         ==> (vsum (u UNION v) f = vsum v f)`,
1362   MESON_TAC[VSUM_UNION_RZERO; UNION_COMM]);;
1363
1364 let VSUM_RESTRICT = prove
1365  (`!f s. FINITE s
1366          ==> (vsum s (\x. if x IN s then f(x) else vec 0) = vsum s f)`,
1367   REPEAT STRIP_TAC THEN MATCH_MP_TAC VSUM_EQ THEN ASM_SIMP_TAC[]);;
1368
1369 let VSUM_RESTRICT_SET = prove
1370  (`!P s f. vsum {x | x IN s /\ P x} f =
1371            vsum s (\x. if P x then f x else vec 0)`,
1372   SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA; VEC_COMPONENT; SUM_RESTRICT_SET;
1373            COND_COMPONENT]);;
1374
1375 let VSUM_CASES = prove
1376  (`!s P f g. FINITE s
1377              ==> vsum s (\x:A. if P x then (f x):real^N else g x) =
1378                  vsum {x | x IN s /\ P x} f + vsum {x | x IN s /\ ~P x} g`,
1379   SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA; VECTOR_ADD_COMPONENT; SUM_CASES;
1380            COND_COMPONENT]);;
1381
1382 let VSUM_SING = prove
1383  (`!f x. vsum {x} f = f(x)`,
1384   SIMP_TAC[VSUM_CLAUSES; FINITE_RULES; NOT_IN_EMPTY; VECTOR_ADD_RID]);;
1385
1386 let VSUM_NORM = prove
1387  (`!f s. FINITE s ==> norm(vsum s f) <= sum s (\x. norm(f x))`,
1388   GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
1389   SIMP_TAC[SUM_CLAUSES; VSUM_CLAUSES; NORM_0; REAL_LE_REFL] THEN
1390   NORM_ARITH_TAC);;
1391
1392 let VSUM_NORM_LE = prove
1393  (`!s f:A->real^N g.
1394         FINITE s /\ (!x. x IN s ==> norm(f x) <= g(x))
1395         ==> norm(vsum s f) <= sum s g`,
1396   REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN
1397   EXISTS_TAC `sum s (\x:A. norm(f x :real^N))` THEN
1398   ASM_SIMP_TAC[VSUM_NORM; SUM_LE]);;
1399
1400 let VSUM_NORM_TRIANGLE = prove
1401  (`!s f b. FINITE s /\ sum s (\a. norm(f a)) <= b
1402            ==> norm(vsum s f) <= b`,
1403   MESON_TAC[VSUM_NORM; REAL_LE_TRANS]);;
1404
1405 let VSUM_NORM_BOUND = prove
1406  (`!s f b. FINITE s /\ (!x:A. x IN s ==> norm(f(x)) <= b)
1407            ==> norm(vsum s f) <= &(CARD s) * b`,
1408   SIMP_TAC[GSYM SUM_CONST; VSUM_NORM_LE]);;
1409
1410 let VSUM_CLAUSES_NUMSEG = prove
1411  (`(!m. vsum(m..0) f = if m = 0 then f(0) else vec 0) /\
1412    (!m n. vsum(m..SUC n) f = if m <= SUC n then vsum(m..n) f + f(SUC n)
1413                              else vsum(m..n) f)`,
1414   REWRITE_TAC[NUMSEG_CLAUSES] THEN REPEAT STRIP_TAC THEN
1415   COND_CASES_TAC THEN
1416   ASM_SIMP_TAC[VSUM_SING; VSUM_CLAUSES; FINITE_NUMSEG; IN_NUMSEG] THEN
1417   REWRITE_TAC[ARITH_RULE `~(SUC n <= n)`; VECTOR_ADD_AC]);;
1418
1419 let VSUM_CLAUSES_RIGHT = prove
1420  (`!f m n. 0 < n /\ m <= n ==> vsum(m..n) f = vsum(m..n-1) f + (f n):real^N`,
1421   GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN
1422   SIMP_TAC[LT_REFL; VSUM_CLAUSES_NUMSEG; SUC_SUB1]);;
1423
1424 let VSUM_CMUL_NUMSEG = prove
1425  (`!f c m n. vsum (m..n) (\x. c % f x) = c % vsum (m..n) f`,
1426   SIMP_TAC[VSUM_LMUL; FINITE_NUMSEG]);;
1427
1428 let VSUM_EQ_NUMSEG = prove
1429  (`!f g m n.
1430          (!x. m <= x /\ x <= n ==> (f x = g x))
1431          ==> (vsum(m .. n) f = vsum(m .. n) g)`,
1432   REPEAT STRIP_TAC THEN MATCH_MP_TAC VSUM_EQ THEN
1433   ASM_SIMP_TAC[FINITE_NUMSEG; IN_NUMSEG]);;
1434
1435 let VSUM_IMAGE_GEN = prove
1436  (`!f:A->B g s.
1437         FINITE s
1438         ==> (vsum s g =
1439              vsum (IMAGE f s) (\y. vsum {x | x IN s /\ (f(x) = y)} g))`,
1440   SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA; SUM_IMAGE_GEN]);;
1441
1442 let VSUM_GROUP = prove
1443  (`!f:A->B g s t.
1444         FINITE s /\ IMAGE f s SUBSET t
1445         ==> vsum t (\y. vsum {x | x IN s /\ f(x) = y} g) = vsum s g`,
1446   SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA; SUM_GROUP]);;
1447
1448 let VSUM_VMUL = prove
1449  (`!f v s. FINITE s ==> ((sum s f) % v = vsum s (\x. f(x) % v))`,
1450   GEN_TAC THEN GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
1451   ASM_SIMP_TAC[SUM_CLAUSES; VSUM_CLAUSES] THEN
1452   REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[VECTOR_ADD_RDISTRIB] THEN
1453   VECTOR_ARITH_TAC);;
1454
1455 let VSUM_DELTA = prove
1456  (`!s a. vsum s (\x. if x = a then b else vec 0) =
1457          if a IN s then b else vec 0`,
1458   SIMP_TAC[CART_EQ; LAMBDA_BETA; VSUM_COMPONENT; COND_COMPONENT] THEN
1459   SIMP_TAC[VEC_COMPONENT; SUM_DELTA]);;
1460
1461 let VSUM_ADD_NUMSEG = prove
1462  (`!f g m n. vsum(m..n) (\i. f i + g i) = vsum(m..n) f + vsum(m..n) g`,
1463   SIMP_TAC[VSUM_ADD; FINITE_NUMSEG]);;
1464
1465 let VSUM_SUB_NUMSEG = prove
1466  (`!f g m n. vsum(m..n) (\i. f i - g i) = vsum(m..n) f - vsum(m..n) g`,
1467   SIMP_TAC[VSUM_SUB; FINITE_NUMSEG]);;
1468
1469 let VSUM_ADD_SPLIT = prove
1470  (`!f m n p.
1471        m <= n + 1 ==> vsum(m..n + p) f = vsum(m..n) f + vsum(n + 1..n + p) f`,
1472   SIMP_TAC[CART_EQ; LAMBDA_BETA; VSUM_COMPONENT; VECTOR_ADD_COMPONENT;
1473            SUM_ADD_SPLIT]);;
1474
1475 let VSUM_VSUM_PRODUCT = prove
1476  (`!s:A->bool t:A->B->bool x.
1477         FINITE s /\ (!i. i IN s ==> FINITE(t i))
1478         ==> vsum s (\i. vsum (t i) (x i)) =
1479             vsum {i,j | i IN s /\ j IN t i} (\(i,j). x i j)`,
1480   SIMP_TAC[CART_EQ; LAMBDA_BETA; VSUM_COMPONENT; COND_COMPONENT] THEN
1481   SIMP_TAC[SUM_SUM_PRODUCT] THEN REPEAT STRIP_TAC THEN AP_TERM_TAC THEN
1482   REWRITE_TAC[FUN_EQ_THM; FORALL_PAIR_THM]);;
1483
1484 let VSUM_IMAGE_NONZERO = prove
1485  (`!d:B->real^N i:A->B s.
1486     FINITE s /\
1487     (!x y. x IN s /\ y IN s /\ ~(x = y) /\ i x = i y ==> d(i x) = vec 0)
1488     ==> vsum (IMAGE i s) d = vsum s (d o i)`,
1489   GEN_TAC THEN GEN_TAC THEN ONCE_REWRITE_TAC[IMP_CONJ] THEN
1490   MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
1491   SIMP_TAC[IMAGE_CLAUSES; VSUM_CLAUSES; FINITE_IMAGE] THEN
1492   MAP_EVERY X_GEN_TAC [`a:A`; `s:A->bool`] THEN
1493   REWRITE_TAC[IN_INSERT] THEN REPEAT STRIP_TAC THEN
1494   SUBGOAL_THEN `vsum s ((d:B->real^N) o (i:A->B)) = vsum (IMAGE i s) d`
1495   SUBST1_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN
1496   COND_CASES_TAC THEN ASM_REWRITE_TAC[o_THM] THEN
1497   REWRITE_TAC[VECTOR_ARITH `a = x + a <=> x = vec 0`] THEN
1498   ASM_MESON_TAC[IN_IMAGE]);;
1499
1500 let VSUM_UNION_NONZERO = prove
1501  (`!f s t. FINITE s /\ FINITE t /\ (!x. x IN s INTER t ==> f(x) = vec 0)
1502            ==> vsum (s UNION t) f = vsum s f + vsum t f`,
1503   SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA; VECTOR_ADD_COMPONENT] THEN
1504   SIMP_TAC[VEC_COMPONENT; SUM_UNION_NONZERO]);;
1505
1506 let VSUM_UNIONS_NONZERO = prove
1507  (`!f s. FINITE s /\ (!t:A->bool. t IN s ==> FINITE t) /\
1508          (!t1 t2 x. t1 IN s /\ t2 IN s /\ ~(t1 = t2) /\ x IN t1 /\ x IN t2
1509                     ==> f x = vec 0)
1510          ==> vsum (UNIONS s) f = vsum s (\t. vsum t f)`,
1511   GEN_TAC THEN ONCE_REWRITE_TAC[IMP_CONJ] THEN
1512   MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
1513   REWRITE_TAC[UNIONS_0; UNIONS_INSERT; VSUM_CLAUSES; IN_INSERT] THEN
1514   MAP_EVERY X_GEN_TAC [`t:A->bool`; `s:(A->bool)->bool`] THEN
1515   DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN
1516   ONCE_REWRITE_TAC[IMP_CONJ] THEN ASM_SIMP_TAC[VSUM_CLAUSES] THEN
1517   ANTS_TAC THENL  [ASM_MESON_TAC[]; DISCH_THEN(SUBST_ALL_TAC o SYM)] THEN
1518   STRIP_TAC THEN MATCH_MP_TAC VSUM_UNION_NONZERO THEN
1519   ASM_SIMP_TAC[FINITE_UNIONS; IN_INTER; IN_UNIONS] THEN ASM_MESON_TAC[]);;
1520
1521 let VSUM_CLAUSES_LEFT = prove
1522  (`!f m n. m <= n ==> vsum(m..n) f = f m + vsum(m + 1..n) f`,
1523   SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA; VECTOR_ADD_COMPONENT] THEN
1524   SIMP_TAC[VEC_COMPONENT; SUM_CLAUSES_LEFT]);;
1525
1526 let VSUM_DIFFS = prove
1527  (`!m n. vsum(m..n) (\k. f(k) - f(k + 1)) =
1528           if m <= n then f(m) - f(n + 1) else vec 0`,
1529   GEN_TAC THEN INDUCT_TAC THEN ASM_SIMP_TAC[VSUM_CLAUSES_NUMSEG; LE] THEN
1530   ASM_CASES_TAC `m = SUC n` THEN
1531   ASM_REWRITE_TAC[ARITH_RULE `~(SUC n <= n)`; VECTOR_ADD_LID] THEN
1532   COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN
1533   REWRITE_TAC[GSYM ADD1] THEN VECTOR_ARITH_TAC);;
1534
1535 let VSUM_DIFFS_ALT = prove
1536  (`!m n. vsum(m..n) (\k. f(k + 1) - f(k)) =
1537           if m <= n then f(n + 1) - f(m) else vec 0`,
1538   REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM VECTOR_NEG_SUB] THEN
1539   SIMP_TAC[VSUM_NEG; VSUM_DIFFS] THEN
1540   COND_CASES_TAC THEN ASM_REWRITE_TAC[VECTOR_NEG_SUB; VECTOR_NEG_0]);;
1541
1542 let VSUM_DELETE_CASES = prove
1543  (`!x f s.
1544         FINITE(s:A->bool)
1545         ==> vsum(s DELETE x) f = if x IN s then vsum s f - f x else vsum s f`,
1546   REPEAT STRIP_TAC THEN COND_CASES_TAC THEN
1547   ASM_SIMP_TAC[SET_RULE `~(x IN s) ==> s DELETE x = s`] THEN
1548   FIRST_ASSUM(fun th -> GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV)
1549    [MATCH_MP (SET_RULE `x IN s ==> s = x INSERT (s DELETE x)`) th]) THEN
1550   ASM_SIMP_TAC[VSUM_CLAUSES; FINITE_DELETE; IN_DELETE] THEN VECTOR_ARITH_TAC);;
1551
1552 let VSUM_EQ_GENERAL = prove
1553   (`!s:A->bool t:B->bool (f:A->real^N) g h.
1554         (!y. y IN t ==> ?!x. x IN s /\ h x = y) /\
1555         (!x. x IN s ==> h x IN t /\ g(h x) = f x)
1556         ==> vsum s f = vsum t g`,
1557    SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA] THEN
1558    REPEAT STRIP_TAC THEN MATCH_MP_TAC SUM_EQ_GENERAL THEN
1559    EXISTS_TAC `h:A->B` THEN ASM_MESON_TAC[]);;
1560
1561 let VSUM_EQ_GENERAL_INVERSES = prove
1562  (`!s t (f:A->real^N) (g:B->real^N) h k.
1563         (!y. y IN t ==> k y IN s /\ h (k y) = y) /\
1564         (!x. x IN s ==> h x IN t /\ k (h x) = x /\ g (h x) = f x)
1565         ==> vsum s f = vsum t g`,
1566   SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA] THEN
1567   REPEAT STRIP_TAC THEN MATCH_MP_TAC SUM_EQ_GENERAL_INVERSES THEN
1568   MAP_EVERY EXISTS_TAC [`h:A->B`; `k:B->A`] THEN ASM_MESON_TAC[]);;
1569
1570 let VSUM_NORM_ALLSUBSETS_BOUND = prove
1571  (`!f:A->real^N p e.
1572         FINITE p /\
1573         (!q. q SUBSET p ==> norm(vsum q f) <= e)
1574         ==> sum p (\x. norm(f x)) <= &2 * &(dimindex(:N)) * e`,
1575   REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN
1576   EXISTS_TAC
1577    `sum p (\x:A. sum (1..dimindex(:N)) (\i. abs((f x:real^N)$i)))` THEN
1578   CONJ_TAC THENL
1579    [MATCH_MP_TAC SUM_LE THEN ASM_SIMP_TAC[NORM_LE_L1]; ALL_TAC] THEN
1580   W(MP_TAC o PART_MATCH (lhand o rand) SUM_SWAP o lhand o snd) THEN
1581   ASM_REWRITE_TAC[FINITE_NUMSEG] THEN DISCH_THEN SUBST1_TAC THEN
1582   ONCE_REWRITE_TAC[REAL_ARITH `&2 * &n * e = &n * &2 * e`] THEN
1583   GEN_REWRITE_TAC (RAND_CONV o LAND_CONV o RAND_CONV)
1584    [GSYM CARD_NUMSEG_1] THEN
1585   MATCH_MP_TAC SUM_BOUND THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN
1586   X_GEN_TAC `k:num` THEN STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN
1587   EXISTS_TAC `sum {x:A | x IN p /\ &0 <= (f x:real^N)$k} (\x. abs((f x)$k)) +
1588               sum {x | x IN p /\ (f x)$k < &0} (\x. abs((f x)$k))` THEN
1589   CONJ_TAC THENL
1590    [MATCH_MP_TAC(REAL_ARITH `a = b ==> b <= a`) THEN
1591     MATCH_MP_TAC SUM_UNION_EQ THEN
1592     ASM_SIMP_TAC[EXTENSION; NOT_IN_EMPTY; IN_INTER; IN_UNION; IN_ELIM_THM] THEN
1593     CONJ_TAC THEN X_GEN_TAC `x:A` THEN ASM_CASES_TAC `(x:A) IN p` THEN
1594     ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC;
1595     ALL_TAC] THEN
1596   MATCH_MP_TAC(REAL_ARITH `x <= e /\ y <= e ==> x + y <= &2 * e`) THEN
1597   GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [GSYM REAL_ABS_NEG] THEN
1598   CONJ_TAC THEN MATCH_MP_TAC(REAL_ARITH
1599    `!g. sum s g = sum s f /\ sum s g <= e ==> sum s f <= e`)
1600   THENL
1601    [EXISTS_TAC `\x. ((f:A->real^N) x)$k`;
1602     EXISTS_TAC `\x. --(((f:A->real^N) x)$k)`] THEN
1603   (CONJ_TAC THENL
1604     [MATCH_MP_TAC SUM_EQ THEN REWRITE_TAC[IN_ELIM_THM] THEN REAL_ARITH_TAC;
1605      ALL_TAC]) THEN
1606   ASM_SIMP_TAC[GSYM VSUM_COMPONENT; SUM_NEG; FINITE_RESTRICT] THEN
1607   MATCH_MP_TAC(REAL_ARITH `abs(x) <= e ==> x <= e`) THEN
1608   REWRITE_TAC[REAL_ABS_NEG] THEN
1609   MATCH_MP_TAC(REAL_ARITH
1610    `abs((vsum q f)$k) <= norm(vsum q f) /\
1611     norm(vsum q f) <= e
1612     ==> abs((vsum q f)$k) <= e`) THEN
1613   ASM_SIMP_TAC[COMPONENT_LE_NORM] THEN
1614   FIRST_X_ASSUM MATCH_MP_TAC THEN SET_TAC[]);;
1615
1616 let DOT_LSUM = prove
1617  (`!s f y. FINITE s ==> (vsum s f) dot y = sum s (\x. f(x) dot y)`,
1618   REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN
1619   MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
1620   ASM_SIMP_TAC[VSUM_CLAUSES; SUM_CLAUSES; DOT_LZERO; DOT_LADD]);;
1621
1622 let DOT_RSUM = prove
1623  (`!s f x. FINITE s ==> x dot (vsum s f) = sum s (\y. x dot f(y))`,
1624   REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN
1625   MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
1626   ASM_SIMP_TAC[VSUM_CLAUSES; SUM_CLAUSES; DOT_RZERO; DOT_RADD]);;
1627
1628 let VSUM_OFFSET = prove
1629  (`!f m p. vsum(m + p..n + p) f = vsum(m..n) (\i. f (i + p))`,
1630   SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA; VEC_COMPONENT; SUM_OFFSET]);;
1631
1632 let VSUM_OFFSET_0 = prove
1633  (`!f m n. m <= n ==> vsum(m..n) f = vsum(0..n - m) (\i. f (i + m))`,
1634   SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA; VEC_COMPONENT; SUM_OFFSET_0]);;
1635
1636 let VSUM_TRIV_NUMSEG = prove
1637  (`!f m n. n < m ==> vsum(m..n) f = vec 0`,
1638   SIMP_TAC[GSYM NUMSEG_EMPTY; VSUM_CLAUSES]);;
1639
1640 let VSUM_CONST_NUMSEG = prove
1641  (`!c m n. vsum(m..n) (\n. c) = &((n + 1) - m) % c`,
1642   SIMP_TAC[VSUM_CONST; FINITE_NUMSEG; CARD_NUMSEG]);;
1643
1644 let VSUM_SUC = prove
1645  (`!f m n. vsum (SUC n..SUC m) f = vsum (n..m) (f o SUC)`,
1646   REPEAT GEN_TAC THEN
1647   SUBGOAL_THEN `SUC n..SUC m = IMAGE SUC (n..m)` SUBST1_TAC THENL
1648    [REWRITE_TAC [ADD1; NUMSEG_OFFSET_IMAGE] THEN
1649     REWRITE_TAC [ONE; ADD_SUC; ADD_0; ETA_AX];
1650     SIMP_TAC [VSUM_IMAGE; FINITE_NUMSEG; SUC_INJ]]);;
1651
1652 let VSUM_BIJECTION = prove
1653  (`!f:A->real^N p s:A->bool.
1654                 (!x. x IN s ==> p(x) IN s) /\
1655                 (!y. y IN s ==> ?!x. x IN s /\ p(x) = y)
1656                 ==> vsum s f = vsum s (f o p)`,
1657   REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN
1658   MATCH_MP_TAC VSUM_EQ_GENERAL THEN EXISTS_TAC `p:A->A` THEN
1659   ASM_REWRITE_TAC[o_THM]);;
1660
1661 let VSUM_PARTIAL_SUC = prove
1662  (`!f g:num->real^N m n.
1663         vsum (m..n) (\k. f(k) % (g(k + 1) - g(k))) =
1664             if m <= n then f(n + 1) % g(n + 1) - f(m) % g(m) -
1665                            vsum (m..n) (\k. (f(k + 1) - f(k)) % g(k + 1))
1666             else vec 0`,
1667   GEN_TAC THEN GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN
1668   COND_CASES_TAC THEN ASM_SIMP_TAC[VSUM_TRIV_NUMSEG; GSYM NOT_LE] THEN
1669   ASM_REWRITE_TAC[VSUM_CLAUSES_NUMSEG] THENL
1670    [COND_CASES_TAC THEN ASM_SIMP_TAC[ARITH] THENL
1671      [VECTOR_ARITH_TAC; ASM_ARITH_TAC];
1672     ALL_TAC] THEN
1673   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LE]) THEN
1674   DISCH_THEN(DISJ_CASES_THEN2 SUBST_ALL_TAC ASSUME_TAC) THEN
1675   ASM_SIMP_TAC[GSYM NOT_LT; VSUM_TRIV_NUMSEG; ARITH_RULE `n < SUC n`] THEN
1676   ASM_SIMP_TAC[GSYM ADD1; ADD_CLAUSES] THEN VECTOR_ARITH_TAC);;
1677
1678 let VSUM_PARTIAL_PRE = prove
1679  (`!f g:num->real^N m n.
1680         vsum (m..n) (\k. f(k) % (g(k) - g(k - 1))) =
1681             if m <= n then f(n + 1) % g(n) - f(m) % g(m - 1) -
1682                            vsum (m..n) (\k. (f(k + 1) - f(k)) % g(k))
1683             else vec 0`,
1684   REPEAT GEN_TAC THEN
1685   MP_TAC(ISPECL [`f:num->real`; `\k. (g:num->real^N)(k - 1)`;
1686                  `m:num`; `n:num`] VSUM_PARTIAL_SUC) THEN
1687   REWRITE_TAC[ADD_SUB] THEN DISCH_THEN SUBST1_TAC THEN
1688   COND_CASES_TAC THEN REWRITE_TAC[]);;
1689
1690 let VSUM_COMBINE_L = prove
1691  (`!f m n p.
1692         0 < n /\ m <= n /\ n <= p + 1
1693         ==> vsum(m..n - 1) f + vsum(n..p) f = vsum(m..p) f`,
1694   SIMP_TAC[CART_EQ; VECTOR_ADD_COMPONENT; VSUM_COMPONENT; SUM_COMBINE_L]);;
1695
1696 let VSUM_COMBINE_R = prove
1697  (`!f m n p.
1698         m <= n + 1 /\ n <= p
1699         ==> vsum(m..n) f + vsum(n + 1..p) f = vsum(m..p) f`,
1700   SIMP_TAC[CART_EQ; VECTOR_ADD_COMPONENT; VSUM_COMPONENT; SUM_COMBINE_R]);;
1701
1702 let VSUM_INJECTION = prove
1703  (`!f p s.
1704          FINITE s /\
1705          (!x. x IN s ==> p x IN s) /\
1706          (!x y. x IN s /\ y IN s /\ p x = p y ==> x = y)
1707          ==> vsum s (f o p) = vsum s f`,
1708   REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP SUM_INJECTION) THEN
1709   SIMP_TAC[CART_EQ; VSUM_COMPONENT; o_DEF]);;
1710
1711 let VSUM_SWAP = prove
1712  (`!f s t.
1713          FINITE s /\ FINITE t
1714          ==> vsum s (\i. vsum t (f i)) = vsum t (\j. vsum s (\i. f i j))`,
1715    SIMP_TAC[CART_EQ; VSUM_COMPONENT] THEN REPEAT STRIP_TAC THEN
1716    W(MP_TAC o PART_MATCH (lhs o rand) SUM_SWAP o lhs o snd) THEN
1717    ASM_REWRITE_TAC[]);;
1718
1719 let VSUM_SWAP_NUMSEG = prove
1720   (`!a b c d f.
1721          vsum (a..b) (\i. vsum (c..d) (f i)) =
1722          vsum (c..d) (\j. vsum (a..b) (\i. f i j))`,
1723   REPEAT GEN_TAC THEN MATCH_MP_TAC VSUM_SWAP THEN REWRITE_TAC[FINITE_NUMSEG]);;
1724
1725 let VSUM_ADD_GEN = prove
1726  (`!f g s.
1727        FINITE {x | x IN s /\ ~(f x = vec 0)} /\
1728        FINITE {x | x IN s /\ ~(g x = vec 0)}
1729        ==> vsum s (\x. f x + g x) = vsum s f + vsum s g`,
1730   REPEAT GEN_TAC THEN DISCH_TAC THEN
1731   SIMP_TAC[CART_EQ; vsum; LAMBDA_BETA; VECTOR_ADD_COMPONENT] THEN
1732   REPEAT GEN_TAC THEN DISCH_THEN(K ALL_TAC) THEN
1733   REPEAT STRIP_TAC THEN MATCH_MP_TAC SUM_ADD_GEN THEN
1734   POP_ASSUM MP_TAC THEN MATCH_MP_TAC MONO_AND THEN
1735   CONJ_TAC THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] FINITE_SUBSET) THEN
1736   REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN GEN_TAC THEN
1737   ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[DE_MORGAN_THM] THEN
1738   STRIP_TAC THEN ASM_REWRITE_TAC[VEC_COMPONENT]);;
1739
1740 let VSUM_CASES_1 = prove
1741  (`!s a. FINITE s /\ a IN s
1742          ==> vsum s (\x. if x = a then y else f(x)) = vsum s f + (y - f a)`,
1743   REPEAT STRIP_TAC THEN ASM_SIMP_TAC[VSUM_CASES] THEN
1744   ASM_SIMP_TAC[GSYM DELETE; VSUM_DELETE] THEN
1745   ASM_SIMP_TAC[SET_RULE `a IN s ==> {x | x IN s /\ x = a} = {a}`] THEN
1746   REWRITE_TAC[VSUM_SING] THEN VECTOR_ARITH_TAC);;
1747
1748 let VSUM_SING_NUMSEG = prove
1749  (`vsum(n..n) f = f n`,
1750   REWRITE_TAC[NUMSEG_SING; VSUM_SING]);;
1751
1752 let VSUM_1 = prove
1753  (`vsum(1..1) f = f(1)`,
1754   REWRITE_TAC[VSUM_SING_NUMSEG]);;
1755
1756 let VSUM_2 = prove
1757  (`!t. vsum(1..2) t = t(1) + t(2)`,
1758   REWRITE_TAC[num_CONV `2`; VSUM_CLAUSES_NUMSEG] THEN
1759   REWRITE_TAC[VSUM_SING_NUMSEG; ARITH; REAL_ADD_ASSOC]);;
1760
1761 let VSUM_3 = prove
1762  (`!t. vsum(1..3) t = t(1) + t(2) + t(3)`,
1763   REWRITE_TAC[num_CONV `3`; num_CONV `2`; VSUM_CLAUSES_NUMSEG] THEN
1764   REWRITE_TAC[VSUM_SING_NUMSEG; ARITH; VECTOR_ADD_ASSOC]);;
1765
1766 let VSUM_4 = prove
1767  (`!t. vsum(1..4) t = t(1) + t(2) + t(3) + t(4)`,
1768   SIMP_TAC[num_CONV `4`; num_CONV `3`; num_CONV `2`; VSUM_CLAUSES_NUMSEG] THEN
1769   REWRITE_TAC[VSUM_SING_NUMSEG; ARITH; VECTOR_ADD_ASSOC]);;
1770
1771 let VSUM_PAIR = prove
1772  (`!f:num->real^N m n.
1773         vsum(2*m..2*n+1) f = vsum(m..n) (\i. f(2*i) + f(2*i+1))`,
1774   SIMP_TAC[CART_EQ; VSUM_COMPONENT; VECTOR_ADD_COMPONENT; SUM_PAIR]);;
1775
1776 let VSUM_PAIR_0 = prove
1777  (`!f:num->real^N n. vsum(0..2*n+1) f = vsum(0..n) (\i. f(2*i) + f(2*i+1))`,
1778   REPEAT GEN_TAC THEN
1779   MP_TAC(ISPECL [`f:num->real^N`; `0`; `n:num`] VSUM_PAIR) THEN
1780   ASM_REWRITE_TAC[ARITH]);;
1781
1782 (* ------------------------------------------------------------------------- *)
1783 (* Add useful congruences to the simplifier.                                 *)
1784 (* ------------------------------------------------------------------------- *)
1785
1786 let th = prove
1787  (`(!f g s.   (!x. x IN s ==> f(x) = g(x))
1788               ==> vsum s (\i. f(i)) = vsum s g) /\
1789    (!f g a b. (!i. a <= i /\ i <= b ==> f(i) = g(i))
1790               ==> vsum(a..b) (\i. f(i)) = vsum(a..b) g) /\
1791    (!f g p.   (!x. p x ==> f x = g x)
1792               ==> vsum {y | p y} (\i. f(i)) = vsum {y | p y} g)`,
1793   REPEAT STRIP_TAC THEN MATCH_MP_TAC VSUM_EQ THEN
1794   ASM_SIMP_TAC[IN_ELIM_THM; IN_NUMSEG]) in
1795   extend_basic_congs (map SPEC_ALL (CONJUNCTS th));;
1796
1797 (* ------------------------------------------------------------------------- *)
1798 (* A conversion for evaluation of `vsum(m..n) f` for numerals m and n.       *)
1799 (* ------------------------------------------------------------------------- *)
1800
1801 let EXPAND_VSUM_CONV =
1802   let pth_0,pth_1 = (CONJ_PAIR o prove)
1803    (`vsum(0..0) (f:num->real^N) = f(0) /\
1804      vsum(0..SUC n) f = vsum(0..n) f + f(SUC n)`,
1805     REWRITE_TAC[VSUM_CLAUSES_NUMSEG; LE_0; VECTOR_ADD_AC]) in
1806   let conv_0 = REWR_CONV pth_0 and conv_1 = REWR_CONV pth_1 in
1807   let rec conv tm =
1808     try (LAND_CONV(RAND_CONV num_CONV) THENC conv_1 THENC
1809          NUM_REDUCE_CONV THENC LAND_CONV conv) tm
1810     with Failure _ -> conv_0 tm in
1811   conv THENC
1812   (REDEPTH_CONV BETA_CONV) THENC
1813   GEN_REWRITE_CONV TOP_DEPTH_CONV [GSYM VECTOR_ADD_ASSOC];;
1814
1815 (* ------------------------------------------------------------------------- *)
1816 (* Basis vectors in coordinate directions.                                   *)
1817 (* ------------------------------------------------------------------------- *)
1818
1819 let basis = new_definition
1820   `basis k = lambda i. if i = k then &1 else &0`;;
1821
1822 let NORM_BASIS = prove
1823  (`!k. 1 <= k /\ k <= dimindex(:N)
1824        ==> (norm(basis k :real^N) = &1)`,
1825   REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[basis; dot; vector_norm] THEN
1826   GEN_REWRITE_TAC RAND_CONV [GSYM SQRT_1] THEN AP_TERM_TAC THEN
1827   MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC
1828    `sum (1..dimindex(:N)) (\i. if i = k then &1 else &0)` THEN
1829   CONJ_TAC THENL
1830    [MATCH_MP_TAC SUM_EQ_NUMSEG THEN
1831     ASM_SIMP_TAC[LAMBDA_BETA; IN_NUMSEG; EQ_SYM_EQ] THEN
1832     REPEAT STRIP_TAC THEN COND_CASES_TAC THEN REAL_ARITH_TAC;
1833     ASM_REWRITE_TAC[SUM_DELTA; IN_NUMSEG]]);;
1834
1835 let NORM_BASIS_1 = prove
1836  (`norm(basis 1) = &1`,
1837   SIMP_TAC[NORM_BASIS; ARITH_EQ; ARITH_RULE `1 <= k <=> ~(k = 0)`;
1838            DIMINDEX_NONZERO]);;
1839
1840 let VECTOR_CHOOSE_SIZE = prove
1841  (`!c. &0 <= c ==> ?x:real^N. norm(x) = c`,
1842   REPEAT STRIP_TAC THEN EXISTS_TAC `c % basis 1 :real^N` THEN
1843   ASM_REWRITE_TAC[NORM_MUL; real_abs; NORM_BASIS_1; REAL_MUL_RID]);;
1844
1845 let VECTOR_CHOOSE_DIST = prove
1846  (`!x e. &0 <= e ==> ?y:real^N. dist(x,y) = e`,
1847   REPEAT STRIP_TAC THEN
1848   SUBGOAL_THEN `?c:real^N. norm(c) = e` CHOOSE_TAC THENL
1849    [ASM_SIMP_TAC[VECTOR_CHOOSE_SIZE]; ALL_TAC] THEN
1850   EXISTS_TAC `x - c:real^N` THEN REWRITE_TAC[dist] THEN
1851   ASM_REWRITE_TAC[VECTOR_ARITH `x - (x - c) = c:real^N`]);;
1852
1853 let BASIS_INJ = prove
1854  (`!i j. 1 <= i /\ i <= dimindex(:N) /\
1855          1 <= j /\ j <= dimindex(:N) /\
1856          (basis i :real^N = basis j)
1857          ==> (i = j)`,
1858   SIMP_TAC[basis; CART_EQ; LAMBDA_BETA] THEN REPEAT GEN_TAC THEN
1859   REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `i:num`) THEN
1860   ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN
1861   ASM_SIMP_TAC[REAL_OF_NUM_EQ; ARITH_EQ]);;
1862
1863 let BASIS_INJ_EQ = prove
1864  (`!i j. 1 <= i /\ i <= dimindex(:N) /\ 1 <= j /\ j <= dimindex(:N)
1865          ==> (basis i:real^N = basis j <=> i = j)`,
1866   MESON_TAC[BASIS_INJ]);;
1867
1868 let BASIS_NE = prove
1869  (`!i j. 1 <= i /\ i <= dimindex(:N) /\
1870          1 <= j /\ j <= dimindex(:N) /\
1871          ~(i = j)
1872          ==> ~(basis i :real^N = basis j)`,
1873   MESON_TAC[BASIS_INJ]);;
1874
1875 let BASIS_COMPONENT = prove
1876  (`!k i. 1 <= i /\ i <= dimindex(:N)
1877          ==> ((basis k :real^N)$i = if i = k then &1 else &0)`,
1878   SIMP_TAC[basis; LAMBDA_BETA] THEN MESON_TAC[]);;
1879
1880 let BASIS_EXPANSION = prove
1881  (`!x:real^N. vsum(1..dimindex(:N)) (\i. x$i % basis i) = x`,
1882   SIMP_TAC[CART_EQ; VSUM_COMPONENT; VECTOR_MUL_COMPONENT; BASIS_COMPONENT] THEN
1883   ONCE_REWRITE_TAC[COND_RAND] THEN REWRITE_TAC[REAL_MUL_RZERO] THEN
1884   REPEAT STRIP_TAC THEN
1885   GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [EQ_SYM_EQ] THEN
1886   ASM_SIMP_TAC[SUM_DELTA; IN_NUMSEG; REAL_MUL_RID]);;
1887
1888 let BASIS_EXPANSION_UNIQUE = prove
1889  (`!f x:real^N. (vsum(1..dimindex(:N)) (\i. f(i) % basis i) = x) <=>
1890                 (!i. 1 <= i /\ i <= dimindex(:N) ==> f(i) = x$i)`,
1891   SIMP_TAC[CART_EQ; VSUM_COMPONENT; VECTOR_MUL_COMPONENT; BASIS_COMPONENT] THEN
1892   REPEAT GEN_TAC THEN REWRITE_TAC[COND_RAND; REAL_MUL_RZERO; REAL_MUL_RID] THEN
1893   GEN_REWRITE_TAC (LAND_CONV o BINDER_CONV o RAND_CONV o LAND_CONV o
1894                    ONCE_DEPTH_CONV) [EQ_SYM_EQ] THEN
1895   SIMP_TAC[SUM_DELTA; IN_NUMSEG]);;
1896
1897 let DOT_BASIS = prove
1898  (`!x:real^N i.
1899         1 <= i /\ i <= dimindex(:N)
1900         ==> ((basis i) dot x = x$i) /\ (x dot (basis i) = x$i)`,
1901   SIMP_TAC[dot; basis; LAMBDA_BETA] THEN
1902   REWRITE_TAC[COND_RATOR; COND_RAND] THEN
1903   REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_RZERO] THEN
1904   SIMP_TAC[SUM_DELTA; IN_NUMSEG; REAL_MUL_LID; REAL_MUL_RID]);;
1905
1906 let DOT_BASIS_BASIS = prove
1907  (`!i j. 1 <= i /\ i <= dimindex(:N) /\
1908          1 <= j /\ j <= dimindex(:N)
1909          ==> (basis i:real^N) dot (basis j) = if i = j then &1 else &0`,
1910   SIMP_TAC[DOT_BASIS; BASIS_COMPONENT]);;
1911
1912 let DOT_BASIS_BASIS_UNEQUAL = prove
1913  (`!i j. ~(i = j) ==> (basis i) dot (basis j) = &0`,
1914   SIMP_TAC[basis; dot; LAMBDA_BETA] THEN ONCE_REWRITE_TAC[COND_RAND] THEN
1915   SIMP_TAC[SUM_0; REAL_MUL_RZERO; REAL_MUL_LZERO; COND_ID]);;
1916
1917 let BASIS_EQ_0 = prove
1918  (`!i. (basis i :real^N = vec 0) <=> ~(i IN 1..dimindex(:N))`,
1919   SIMP_TAC[CART_EQ; BASIS_COMPONENT; VEC_COMPONENT; IN_NUMSEG] THEN
1920   MESON_TAC[REAL_ARITH `~(&1 = &0)`]);;
1921
1922 let BASIS_NONZERO = prove
1923  (`!k. 1 <= k /\ k <= dimindex(:N)
1924        ==> ~(basis k :real^N = vec 0)`,
1925   REWRITE_TAC[BASIS_EQ_0; IN_NUMSEG]);;
1926
1927 let VECTOR_EQ_LDOT = prove
1928  (`!y z. (!x. x dot y = x dot z) <=> y = z`,
1929   REPEAT GEN_TAC THEN EQ_TAC THEN SIMP_TAC[] THEN
1930   REWRITE_TAC[CART_EQ] THEN MESON_TAC[DOT_BASIS]);;
1931
1932 let VECTOR_EQ_RDOT = prove
1933  (`!x y. (!z. x dot z = y dot z) <=> x = y`,
1934   REPEAT GEN_TAC THEN EQ_TAC THEN SIMP_TAC[] THEN
1935   REWRITE_TAC[CART_EQ] THEN MESON_TAC[DOT_BASIS]);;
1936
1937 (* ------------------------------------------------------------------------- *)
1938 (* Orthogonality.                                                            *)
1939 (* ------------------------------------------------------------------------- *)
1940
1941 let orthogonal = new_definition
1942   `orthogonal x y <=> (x dot y = &0)`;;
1943
1944 let ORTHOGONAL_0 = prove
1945  (`!x. orthogonal (vec 0) x /\ orthogonal x (vec 0)`,
1946   REWRITE_TAC[orthogonal; DOT_LZERO; DOT_RZERO]);;
1947
1948 let ORTHOGONAL_REFL = prove
1949  (`!x. orthogonal x x <=> x = vec 0`,
1950   REWRITE_TAC[orthogonal; DOT_EQ_0]);;
1951
1952 let ORTHOGONAL_SYM = prove
1953  (`!x y. orthogonal x y <=> orthogonal y x`,
1954   REWRITE_TAC[orthogonal; DOT_SYM]);;
1955
1956 let ORTHOGONAL_LNEG = prove
1957  (`!x y. orthogonal (--x) y <=> orthogonal x y`,
1958   REWRITE_TAC[orthogonal; DOT_LNEG; REAL_NEG_EQ_0]);;
1959
1960 let ORTHOGONAL_RNEG = prove
1961  (`!x y. orthogonal x (--y) <=> orthogonal x y`,
1962   REWRITE_TAC[orthogonal; DOT_RNEG; REAL_NEG_EQ_0]);;
1963
1964 let ORTHOGONAL_MUL = prove
1965  (`(!a x y:real^N. orthogonal (a % x) y <=> a = &0 \/ orthogonal x y) /\
1966    (!a x y:real^N. orthogonal x (a % y) <=> a = &0 \/ orthogonal x y)`,
1967   REWRITE_TAC[orthogonal; DOT_LMUL; DOT_RMUL; REAL_ENTIRE]);;
1968
1969 let ORTHOGONAL_BASIS = prove
1970  (`!x:real^N i. 1 <= i /\ i <= dimindex(:N)
1971                 ==> (orthogonal (basis i) x <=> (x$i = &0))`,
1972   REPEAT STRIP_TAC THEN SIMP_TAC[orthogonal; dot; basis; LAMBDA_BETA] THEN
1973   REWRITE_TAC[COND_RAND; COND_RATOR; REAL_MUL_LZERO] THEN
1974   ASM_SIMP_TAC[SUM_DELTA; IN_NUMSEG; REAL_MUL_LID]);;
1975
1976 let ORTHOGONAL_BASIS_BASIS = prove
1977  (`!i j. 1 <= i /\ i <= dimindex(:N) /\
1978          1 <= j /\ j <= dimindex(:N)
1979          ==> (orthogonal (basis i :real^N) (basis j) <=> ~(i = j))`,
1980   ASM_SIMP_TAC[ORTHOGONAL_BASIS] THEN ASM_SIMP_TAC[BASIS_COMPONENT] THEN
1981   MESON_TAC[REAL_ARITH `~(&1 = &0)`]);;
1982
1983 let ORTHOGONAL_CLAUSES = prove
1984  (`(!a. orthogonal a (vec 0)) /\
1985    (!a x c. orthogonal a x ==> orthogonal a (c % x)) /\
1986    (!a x. orthogonal a x ==> orthogonal a (--x)) /\
1987    (!a x y. orthogonal a x /\ orthogonal a y ==> orthogonal a (x + y)) /\
1988    (!a x y. orthogonal a x /\ orthogonal a y ==> orthogonal a (x - y)) /\
1989    (!a. orthogonal (vec 0) a) /\
1990    (!a x c. orthogonal x a ==> orthogonal (c % x) a) /\
1991    (!a x. orthogonal x a ==> orthogonal (--x) a) /\
1992    (!a x y. orthogonal x a /\ orthogonal y a ==> orthogonal (x + y) a) /\
1993    (!a x y. orthogonal x a /\ orthogonal y a ==> orthogonal (x - y) a)`,
1994   REWRITE_TAC[orthogonal; DOT_RNEG; DOT_RMUL; DOT_RADD; DOT_RSUB;
1995     DOT_LZERO; DOT_RZERO; DOT_LNEG; DOT_LMUL; DOT_LADD; DOT_LSUB] THEN
1996   SIMP_TAC[] THEN REAL_ARITH_TAC);;
1997
1998 let ORTHOGONAL_RVSUM = prove
1999  (`!f:A->real^N s x.
2000         FINITE s /\
2001         (!y. y IN s ==> orthogonal x (f y))
2002         ==> orthogonal x (vsum s f)`,
2003   GEN_TAC THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM; IMP_CONJ] THEN
2004   MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
2005   SIMP_TAC[NOT_IN_EMPTY; FORALL_IN_INSERT; ORTHOGONAL_CLAUSES; VSUM_CLAUSES]);;
2006
2007 let ORTHOGONAL_LVSUM = prove
2008  (`!f:A->real^N s y.
2009         FINITE s /\
2010         (!x. x IN s ==> orthogonal (f x) y)
2011         ==> orthogonal (vsum s f) y`,
2012   GEN_TAC THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM; IMP_CONJ] THEN
2013   MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
2014   SIMP_TAC[NOT_IN_EMPTY; FORALL_IN_INSERT; ORTHOGONAL_CLAUSES; VSUM_CLAUSES]);;
2015
2016 let NORM_ADD_PYTHAGOREAN = prove
2017  (`!a b:real^N.
2018         orthogonal a b
2019         ==> norm(a + b) pow 2 = norm(a) pow 2 + norm(b) pow 2`,
2020   SIMP_TAC[NORM_POW_2; orthogonal; DOT_LADD; DOT_RADD; DOT_SYM] THEN
2021   REAL_ARITH_TAC);;
2022
2023 let NORM_VSUM_PYTHAGOREAN = prove
2024  (`!k u:A->real^N.
2025         FINITE k /\ pairwise (\i j. orthogonal (u i) (u j)) k
2026         ==> norm(vsum k u) pow 2 = sum k (\i. norm(u i) pow 2)`,
2027   ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN GEN_TAC THEN SIMP_TAC[IMP_CONJ] THEN
2028   MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
2029   SIMP_TAC[VSUM_CLAUSES; SUM_CLAUSES; NORM_0] THEN
2030   CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[PAIRWISE_INSERT] THEN
2031   REWRITE_TAC[pairwise] THEN REPEAT GEN_TAC THEN
2032   DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN
2033   DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN ASM_REWRITE_TAC[] THEN
2034   MATCH_MP_TAC NORM_ADD_PYTHAGOREAN THEN MATCH_MP_TAC ORTHOGONAL_RVSUM THEN
2035   ASM_MESON_TAC[]);;
2036
2037 (* ------------------------------------------------------------------------- *)
2038 (* Explicit vector construction from lists.                                  *)
2039 (* ------------------------------------------------------------------------- *)
2040
2041 let VECTOR_1 = prove
2042  (`(vector[x]:A^1)$1 = x`,
2043   SIMP_TAC[vector; LAMBDA_BETA; DIMINDEX_1; ARITH; LENGTH; EL; HD; TL]);;
2044
2045 let VECTOR_2 = prove
2046  (`(vector[x;y]:A^2)$1 = x /\
2047    (vector[x;y]:A^2)$2 = y`,
2048   SIMP_TAC[vector; LAMBDA_BETA; DIMINDEX_2; ARITH; LENGTH; EL] THEN
2049   REWRITE_TAC[num_CONV `1`; HD; TL; EL]);;
2050
2051 let VECTOR_3 = prove
2052  (`(vector[x;y;z]:A^3)$1 = x /\
2053    (vector[x;y;z]:A^3)$2 = y /\
2054    (vector[x;y;z]:A^3)$3 = z`,
2055   SIMP_TAC[vector; LAMBDA_BETA; DIMINDEX_3; ARITH; LENGTH; EL] THEN
2056   REWRITE_TAC[num_CONV `2`; num_CONV `1`; HD; TL; EL]);;
2057
2058 let VECTOR_4 = prove
2059  (`(vector[w;x;y;z]:A^4)$1 = w /\
2060    (vector[w;x;y;z]:A^4)$2 = x /\
2061    (vector[w;x;y;z]:A^4)$3 = y /\
2062    (vector[w;x;y;z]:A^4)$4 = z`,
2063   SIMP_TAC[vector; LAMBDA_BETA; DIMINDEX_4; ARITH; LENGTH; EL] THEN
2064   REWRITE_TAC[num_CONV `3`; num_CONV `2`; num_CONV `1`; HD; TL; EL]);;
2065
2066 let FORALL_VECTOR_1 = prove
2067  (`(!v:A^1. P v) <=> !x. P(vector[x])`,
2068   EQ_TAC THEN SIMP_TAC[] THEN REPEAT STRIP_TAC THEN
2069   FIRST_X_ASSUM(MP_TAC o SPEC `(v:A^1)$1`) THEN
2070   MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN
2071   REWRITE_TAC[CART_EQ; FORALL_1; VECTOR_1; DIMINDEX_1]);;
2072
2073 let FORALL_VECTOR_2 = prove
2074  (`(!v:A^2. P v) <=> !x y. P(vector[x;y])`,
2075   EQ_TAC THEN SIMP_TAC[] THEN REPEAT STRIP_TAC THEN
2076   FIRST_X_ASSUM(MP_TAC o SPECL [`(v:A^2)$1`; `(v:A^2)$2`]) THEN
2077   MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN
2078   REWRITE_TAC[CART_EQ; FORALL_2; VECTOR_2; DIMINDEX_2]);;
2079
2080 let FORALL_VECTOR_3 = prove
2081  (`(!v:A^3. P v) <=> !x y z. P(vector[x;y;z])`,
2082   EQ_TAC THEN SIMP_TAC[] THEN REPEAT STRIP_TAC THEN
2083   FIRST_X_ASSUM(MP_TAC o SPECL
2084     [`(v:A^3)$1`; `(v:A^3)$2`; `(v:A^3)$3`]) THEN
2085   MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN
2086   REWRITE_TAC[CART_EQ; FORALL_3; VECTOR_3; DIMINDEX_3]);;
2087
2088 let FORALL_VECTOR_4 = prove
2089  (`(!v:A^4. P v) <=> !w x y z. P(vector[w;x;y;z])`,
2090   EQ_TAC THEN SIMP_TAC[] THEN REPEAT STRIP_TAC THEN
2091   FIRST_X_ASSUM(MP_TAC o SPECL
2092     [`(v:A^4)$1`; `(v:A^4)$2`; `(v:A^4)$3`; `(v:A^4)$4`]) THEN
2093   MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN
2094   REWRITE_TAC[CART_EQ; FORALL_4; VECTOR_4; DIMINDEX_4]);;
2095
2096 let EXISTS_VECTOR_1 = prove
2097  (`(?v:A^1. P v) <=> ?x. P(vector[x])`,
2098   REWRITE_TAC[MESON[] `(?x. P x) <=> ~(!x. ~P x)`] THEN
2099   REWRITE_TAC[FORALL_VECTOR_1]);;
2100
2101 let EXISTS_VECTOR_2 = prove
2102  (`(?v:A^2. P v) <=> ?x y. P(vector[x;y])`,
2103   REWRITE_TAC[MESON[] `(?x. P x) <=> ~(!x. ~P x)`] THEN
2104   REWRITE_TAC[FORALL_VECTOR_2]);;
2105
2106 let EXISTS_VECTOR_3 = prove
2107  (`(?v:A^3. P v) <=> ?x y z. P(vector[x;y;z])`,
2108   REWRITE_TAC[MESON[] `(?x. P x) <=> ~(!x. ~P x)`] THEN
2109   REWRITE_TAC[FORALL_VECTOR_3]);;
2110
2111 let EXISTS_VECTOR_4 = prove
2112  (`(?v:A^4. P v) <=> ?w x y z. P(vector[w;x;y;z])`,
2113   REWRITE_TAC[MESON[] `(?x. P x) <=> ~(!x. ~P x)`] THEN
2114   REWRITE_TAC[FORALL_VECTOR_4]);;
2115
2116 let VECTOR_EXPAND_1 = prove
2117  (`!x:real^1. x = vector[x$1]`,
2118   SIMP_TAC[CART_EQ; DIMINDEX_1; FORALL_1; VECTOR_1]);;
2119
2120 let VECTOR_EXPAND_2 = prove
2121  (`!x:real^2. x = vector[x$1;x$2]`,
2122   SIMP_TAC[CART_EQ; DIMINDEX_2; FORALL_2; VECTOR_2]);;
2123
2124 let VECTOR_EXPAND_3 = prove
2125  (`!x:real^3. x = vector[x$1;x$2;x$3]`,
2126   SIMP_TAC[CART_EQ; DIMINDEX_3; FORALL_3; VECTOR_3]);;
2127
2128 let VECTOR_EXPAND_4 = prove
2129  (`!x:real^4. x = vector[x$1;x$2;x$3;x$4]`,
2130   SIMP_TAC[CART_EQ; DIMINDEX_4; FORALL_4; VECTOR_4]);;
2131
2132 (* ------------------------------------------------------------------------- *)
2133 (* Linear functions.                                                         *)
2134 (* ------------------------------------------------------------------------- *)
2135
2136 let linear = new_definition
2137   `linear (f:real^M->real^N) <=>
2138         (!x y. f(x + y) = f(x) + f(y)) /\
2139         (!c x. f(c % x) = c % f(x))`;;
2140
2141 let LINEAR_COMPOSE_CMUL = prove
2142  (`!f c. linear f ==> linear (\x. c % f(x))`,
2143   SIMP_TAC[linear] THEN REPEAT STRIP_TAC THEN VECTOR_ARITH_TAC);;
2144
2145 let LINEAR_COMPOSE_NEG = prove
2146  (`!f. linear f ==> linear (\x. --(f(x)))`,
2147   SIMP_TAC[linear] THEN REPEAT STRIP_TAC THEN VECTOR_ARITH_TAC);;
2148
2149 let LINEAR_COMPOSE_ADD = prove
2150  (`!f g. linear f /\ linear g ==> linear (\x. f(x) + g(x))`,
2151   SIMP_TAC[linear] THEN REPEAT STRIP_TAC THEN VECTOR_ARITH_TAC);;
2152
2153 let LINEAR_COMPOSE_SUB = prove
2154  (`!f g. linear f /\ linear g ==> linear (\x. f(x) - g(x))`,
2155   SIMP_TAC[linear] THEN REPEAT STRIP_TAC THEN VECTOR_ARITH_TAC);;
2156
2157 let LINEAR_COMPOSE = prove
2158  (`!f g. linear f /\ linear g ==> linear (g o f)`,
2159   SIMP_TAC[linear; o_THM]);;
2160
2161 let LINEAR_ID = prove
2162  (`linear (\x. x)`,
2163   REWRITE_TAC[linear]);;
2164
2165 let LINEAR_I = prove
2166  (`linear I`,
2167   REWRITE_TAC[I_DEF; LINEAR_ID]);;
2168
2169 let LINEAR_ZERO = prove
2170  (`linear (\x. vec 0)`,
2171   REWRITE_TAC[linear] THEN CONJ_TAC THEN VECTOR_ARITH_TAC);;
2172
2173 let LINEAR_NEGATION = prove
2174  (`linear(--)`,
2175   REWRITE_TAC[linear] THEN VECTOR_ARITH_TAC);;
2176
2177 let LINEAR_COMPOSE_VSUM = prove
2178  (`!f s. FINITE s /\ (!a. a IN s ==> linear(f a))
2179          ==> linear(\x. vsum s (\a. f a x))`,
2180   GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN
2181   MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
2182   SIMP_TAC[VSUM_CLAUSES; LINEAR_ZERO] THEN
2183   ASM_SIMP_TAC[ETA_AX; IN_INSERT; LINEAR_COMPOSE_ADD]);;
2184
2185 let LINEAR_VMUL_COMPONENT = prove
2186  (`!f:real^M->real^N v k.
2187      linear f /\ 1 <= k /\ k <= dimindex(:N)
2188      ==> linear (\x. f(x)$k % v)`,
2189   SIMP_TAC[linear; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT] THEN
2190   REPEAT STRIP_TAC THEN VECTOR_ARITH_TAC);;
2191
2192 let LINEAR_0 = prove
2193  (`!f. linear f ==> (f(vec 0) = vec 0)`,
2194   MESON_TAC[VECTOR_MUL_LZERO; linear]);;
2195
2196 let LINEAR_CMUL = prove
2197  (`!f c x. linear f ==> (f(c % x) = c % f(x))`,
2198   SIMP_TAC[linear]);;
2199
2200 let LINEAR_NEG = prove
2201  (`!f x. linear f ==> (f(--x) = --(f x))`,
2202   ONCE_REWRITE_TAC[VECTOR_NEG_MINUS1] THEN SIMP_TAC[LINEAR_CMUL]);;
2203
2204 let LINEAR_ADD = prove
2205  (`!f x y. linear f ==> (f(x + y) = f(x) + f(y))`,
2206   SIMP_TAC[linear]);;
2207
2208 let LINEAR_SUB = prove
2209  (`!f x y. linear f ==> (f(x - y) = f(x) - f(y))`,
2210   SIMP_TAC[VECTOR_SUB; LINEAR_ADD; LINEAR_NEG]);;
2211
2212 let LINEAR_VSUM = prove
2213  (`!f g s. linear f /\ FINITE s ==> (f(vsum s g) = vsum s (f o g))`,
2214   GEN_TAC THEN GEN_TAC THEN SIMP_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
2215   DISCH_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
2216   SIMP_TAC[VSUM_CLAUSES] THEN FIRST_ASSUM(fun th ->
2217     SIMP_TAC[MATCH_MP LINEAR_0 th; MATCH_MP LINEAR_ADD th; o_THM]));;
2218
2219 let LINEAR_VSUM_MUL = prove
2220  (`!f s c v.
2221         linear f /\ FINITE s
2222         ==> f(vsum s (\i. c i % v i)) = vsum s (\i. c(i) % f(v i))`,
2223   SIMP_TAC[LINEAR_VSUM; o_DEF; LINEAR_CMUL]);;
2224
2225 let LINEAR_INJECTIVE_0 = prove
2226  (`!f. linear f
2227        ==> ((!x y. (f(x) = f(y)) ==> (x = y)) <=>
2228             (!x. (f(x) = vec 0) ==> (x = vec 0)))`,
2229   REPEAT STRIP_TAC THEN
2230   GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [GSYM VECTOR_SUB_EQ] THEN
2231   ASM_SIMP_TAC[GSYM LINEAR_SUB] THEN MESON_TAC[VECTOR_SUB_RZERO]);;
2232
2233 let LINEAR_BOUNDED = prove
2234  (`!f:real^M->real^N. linear f ==> ?B. !x. norm(f x) <= B * norm(x)`,
2235   REPEAT STRIP_TAC THEN EXISTS_TAC
2236    `sum(1..dimindex(:M)) (\i. norm((f:real^M->real^N)(basis i)))` THEN
2237   GEN_TAC THEN
2238   GEN_REWRITE_TAC (LAND_CONV o funpow 2 RAND_CONV) [GSYM BASIS_EXPANSION] THEN
2239   ASM_SIMP_TAC[LINEAR_VSUM; FINITE_NUMSEG] THEN
2240   ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[GSYM SUM_LMUL] THEN
2241   MATCH_MP_TAC VSUM_NORM_LE THEN
2242   SIMP_TAC[FINITE_CROSS; FINITE_NUMSEG; IN_NUMSEG] THEN
2243   ASM_SIMP_TAC[o_DEF; NORM_MUL; LINEAR_CMUL] THEN
2244   ASM_SIMP_TAC[REAL_LE_RMUL; NORM_POS_LE; COMPONENT_LE_NORM]);;
2245
2246 let LINEAR_BOUNDED_POS = prove
2247  (`!f:real^M->real^N. linear f ==> ?B. &0 < B /\ !x. norm(f x) <= B * norm(x)`,
2248   REPEAT STRIP_TAC THEN
2249   FIRST_ASSUM(X_CHOOSE_TAC `B:real` o MATCH_MP LINEAR_BOUNDED) THEN
2250   EXISTS_TAC `abs(B) + &1` THEN CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN
2251   POP_ASSUM MP_TAC THEN MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN
2252   MATCH_MP_TAC(REAL_ARITH `a <= b ==> x <= a ==> x <= b`) THEN
2253   MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[NORM_POS_LE] THEN
2254   REAL_ARITH_TAC);;
2255
2256 let SYMMETRIC_LINEAR_IMAGE = prove
2257  (`!f s. (!x. x IN s ==> --x IN s) /\ linear f
2258           ==> !x. x IN (IMAGE f s) ==> --x IN (IMAGE f s)`,
2259   REWRITE_TAC[FORALL_IN_IMAGE] THEN
2260   SIMP_TAC[GSYM LINEAR_NEG] THEN SET_TAC[]);;
2261
2262 (* ------------------------------------------------------------------------- *)
2263 (* Bilinear functions.                                                       *)
2264 (* ------------------------------------------------------------------------- *)
2265
2266 let bilinear = new_definition
2267   `bilinear f <=> (!x. linear(\y. f x y)) /\ (!y. linear(\x. f x y))`;;
2268
2269 let BILINEAR_LADD = prove
2270  (`!h x y z. bilinear h ==> h (x + y) z = (h x z) + (h y z)`,
2271   SIMP_TAC[bilinear; linear]);;
2272
2273 let BILINEAR_RADD = prove
2274  (`!h x y z. bilinear h ==> h x (y + z) = (h x y) + (h x z)`,
2275   SIMP_TAC[bilinear; linear]);;
2276
2277 let BILINEAR_LMUL = prove
2278  (`!h c x y. bilinear h ==> h (c % x) y = c % (h x y)`,
2279   SIMP_TAC[bilinear; linear]);;
2280
2281 let BILINEAR_RMUL = prove
2282  (`!h c x y. bilinear h ==> h x (c % y) = c % (h x y)`,
2283   SIMP_TAC[bilinear; linear]);;
2284
2285 let BILINEAR_LNEG = prove
2286  (`!h x y. bilinear h ==> h (--x) y = --(h x y)`,
2287   ONCE_REWRITE_TAC[VECTOR_NEG_MINUS1] THEN SIMP_TAC[BILINEAR_LMUL]);;
2288
2289 let BILINEAR_RNEG = prove
2290  (`!h x y. bilinear h ==> h x (--y) = --(h x y)`,
2291   ONCE_REWRITE_TAC[VECTOR_NEG_MINUS1] THEN SIMP_TAC[BILINEAR_RMUL]);;
2292
2293 let BILINEAR_LZERO = prove
2294  (`!h x. bilinear h ==> h (vec 0) x = vec 0`,
2295   ONCE_REWRITE_TAC[VECTOR_ARITH `x = vec 0 <=> x + x = x`] THEN
2296   SIMP_TAC[GSYM BILINEAR_LADD; VECTOR_ADD_LID]);;
2297
2298 let BILINEAR_RZERO = prove
2299  (`!h x. bilinear h ==> h x (vec 0) = vec 0`,
2300   ONCE_REWRITE_TAC[VECTOR_ARITH `x = vec 0 <=> x + x = x`] THEN
2301   SIMP_TAC[GSYM BILINEAR_RADD; VECTOR_ADD_LID]);;
2302
2303 let BILINEAR_LSUB = prove
2304  (`!h x y z. bilinear h ==> h (x - y) z = (h x z) - (h y z)`,
2305   SIMP_TAC[VECTOR_SUB; BILINEAR_LNEG; BILINEAR_LADD]);;
2306
2307 let BILINEAR_RSUB = prove
2308  (`!h x y z. bilinear h ==> h x (y - z) = (h x y) - (h x z)`,
2309   SIMP_TAC[VECTOR_SUB; BILINEAR_RNEG; BILINEAR_RADD]);;
2310
2311 let BILINEAR_VSUM = prove
2312  (`!h:real^M->real^N->real^P.
2313        bilinear h /\ FINITE s /\ FINITE t
2314        ==> h (vsum s f) (vsum t g) = vsum (s CROSS t) (\(i,j). h (f i) (g j))`,
2315   REPEAT GEN_TAC THEN SIMP_TAC[bilinear; ETA_AX] THEN
2316   ONCE_REWRITE_TAC[TAUT `(a /\ b) /\ c /\ d <=> (a /\ d) /\ (b /\ c)`] THEN
2317   DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN
2318   ONCE_REWRITE_TAC[LEFT_AND_FORALL_THM] THEN DISCH_TAC THEN
2319   FIRST_ASSUM(MP_TAC o GEN_ALL o MATCH_MP LINEAR_VSUM o SPEC_ALL) THEN
2320   SIMP_TAC[] THEN ASM_SIMP_TAC[LINEAR_VSUM; o_DEF; VSUM_VSUM_PRODUCT] THEN
2321   REWRITE_TAC[GSYM CROSS]);;
2322
2323 let BILINEAR_BOUNDED = prove
2324  (`!h:real^M->real^N->real^P.
2325         bilinear h ==> ?B. !x y. norm(h x y) <= B * norm(x) * norm(y)`,
2326   REPEAT STRIP_TAC THEN
2327   EXISTS_TAC `sum ((1..dimindex(:M)) CROSS (1..dimindex(:N)))
2328                   (\(i,j). norm((h:real^M->real^N->real^P)
2329                                 (basis i) (basis j)))` THEN
2330   REPEAT GEN_TAC THEN GEN_REWRITE_TAC
2331    (LAND_CONV o RAND_CONV o BINOP_CONV) [GSYM BASIS_EXPANSION] THEN
2332   ASM_SIMP_TAC[BILINEAR_VSUM; FINITE_NUMSEG] THEN
2333   ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[GSYM SUM_LMUL] THEN
2334   MATCH_MP_TAC VSUM_NORM_LE THEN
2335   SIMP_TAC[FINITE_CROSS; FINITE_NUMSEG; FORALL_PAIR_THM; IN_CROSS] THEN
2336   REWRITE_TAC[IN_NUMSEG] THEN REPEAT STRIP_TAC THEN
2337   ASM_SIMP_TAC[BILINEAR_LMUL; NORM_MUL] THEN
2338   ASM_SIMP_TAC[BILINEAR_RMUL; NORM_MUL; REAL_MUL_ASSOC] THEN
2339   MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[NORM_POS_LE] THEN
2340   ASM_SIMP_TAC[COMPONENT_LE_NORM; REAL_ABS_POS; REAL_LE_MUL2]);;
2341
2342 let BILINEAR_BOUNDED_POS = prove
2343  (`!h. bilinear h
2344        ==> ?B. &0 < B /\ !x y. norm(h x y) <= B * norm(x) * norm(y)`,
2345   REPEAT STRIP_TAC THEN
2346   FIRST_ASSUM(X_CHOOSE_TAC `B:real` o MATCH_MP BILINEAR_BOUNDED) THEN
2347   EXISTS_TAC `abs(B) + &1` THEN CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN
2348   POP_ASSUM MP_TAC THEN REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN
2349   MATCH_MP_TAC(REAL_ARITH `a <= b ==> x <= a ==> x <= b`) THEN
2350   REPEAT(MATCH_MP_TAC REAL_LE_RMUL THEN
2351          SIMP_TAC[NORM_POS_LE; REAL_LE_MUL]) THEN
2352   REAL_ARITH_TAC);;
2353
2354 let BILINEAR_VSUM_PARTIAL_SUC = prove
2355  (`!f g h:real^M->real^N->real^P m n.
2356         bilinear h
2357         ==> vsum (m..n) (\k. h (f k) (g(k + 1) - g(k))) =
2358                 if m <= n then h (f(n + 1)) (g(n + 1)) - h (f m) (g m) -
2359                                vsum (m..n) (\k. h (f(k + 1) - f(k)) (g(k + 1)))
2360                 else vec 0`,
2361   REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN REPEAT GEN_TAC THEN DISCH_TAC THEN
2362   GEN_TAC THEN INDUCT_TAC THEN
2363   COND_CASES_TAC THEN ASM_SIMP_TAC[VSUM_TRIV_NUMSEG; GSYM NOT_LE] THEN
2364   ASM_REWRITE_TAC[VSUM_CLAUSES_NUMSEG] THENL
2365    [COND_CASES_TAC THEN ASM_SIMP_TAC[ARITH] THENL
2366      [ASM_SIMP_TAC[BILINEAR_RSUB; BILINEAR_LSUB] THEN VECTOR_ARITH_TAC;
2367       ASM_ARITH_TAC];
2368     ALL_TAC] THEN
2369   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LE]) THEN
2370   DISCH_THEN(DISJ_CASES_THEN2 SUBST_ALL_TAC ASSUME_TAC) THEN
2371   ASM_SIMP_TAC[GSYM NOT_LT; VSUM_TRIV_NUMSEG; ARITH_RULE `n < SUC n`] THEN
2372   ASM_SIMP_TAC[GSYM ADD1; ADD_CLAUSES] THEN
2373   ASM_SIMP_TAC[BILINEAR_RSUB; BILINEAR_LSUB] THEN VECTOR_ARITH_TAC);;
2374
2375 let BILINEAR_VSUM_PARTIAL_PRE = prove
2376  (`!f g h:real^M->real^N->real^P m n.
2377         bilinear h
2378         ==> vsum (m..n) (\k. h (f k) (g(k) - g(k - 1))) =
2379                 if m <= n then h (f(n + 1)) (g(n)) - h (f m) (g(m - 1)) -
2380                                vsum (m..n) (\k. h (f(k + 1) - f(k)) (g(k)))
2381                 else vec 0`,
2382   REPEAT STRIP_TAC THEN
2383   FIRST_ASSUM(MP_TAC o ISPECL [`f:num->real^M`; `\k. (g:num->real^N)(k - 1)`;
2384                  `m:num`; `n:num`] o MATCH_MP BILINEAR_VSUM_PARTIAL_SUC) THEN
2385    REWRITE_TAC[ADD_SUB] THEN DISCH_THEN SUBST1_TAC THEN
2386   COND_CASES_TAC THEN REWRITE_TAC[]);;
2387
2388 (* ------------------------------------------------------------------------- *)
2389 (* Adjoints.                                                                 *)
2390 (* ------------------------------------------------------------------------- *)
2391
2392 let adjoint = new_definition
2393  `adjoint(f:real^M->real^N) = @f'. !x y. f(x) dot y = x dot f'(y)`;;
2394
2395 let ADJOINT_WORKS = prove
2396  (`!f:real^M->real^N. linear f ==> !x y. f(x) dot y = x dot (adjoint f)(y)`,
2397   GEN_TAC THEN DISCH_TAC THEN SIMP_TAC[adjoint] THEN CONV_TAC SELECT_CONV THEN
2398   ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN ONCE_REWRITE_TAC[GSYM SKOLEM_THM] THEN
2399   X_GEN_TAC `y:real^N` THEN
2400   EXISTS_TAC `(lambda i. (f:real^M->real^N) (basis i) dot y):real^M` THEN
2401   X_GEN_TAC `x:real^M` THEN
2402   GEN_REWRITE_TAC (funpow 2 LAND_CONV o RAND_CONV) [GSYM BASIS_EXPANSION] THEN
2403   ASM_SIMP_TAC[LINEAR_VSUM; FINITE_NUMSEG] THEN
2404   SIMP_TAC[dot; LAMBDA_BETA; VSUM_COMPONENT; GSYM SUM_LMUL; GSYM SUM_RMUL] THEN
2405   GEN_REWRITE_TAC RAND_CONV [SUM_SWAP_NUMSEG] THEN
2406   ASM_SIMP_TAC[o_THM; VECTOR_MUL_COMPONENT; LINEAR_CMUL; REAL_MUL_ASSOC]);;
2407
2408 let ADJOINT_LINEAR = prove
2409  (`!f:real^M->real^N. linear f ==> linear(adjoint f)`,
2410   REPEAT STRIP_TAC THEN REWRITE_TAC[linear; GSYM VECTOR_EQ_LDOT] THEN
2411   ASM_SIMP_TAC[DOT_RMUL; DOT_RADD; GSYM ADJOINT_WORKS]);;
2412
2413 let ADJOINT_CLAUSES = prove
2414  (`!f:real^M->real^N.
2415      linear f ==> (!x y. x dot (adjoint f)(y) = f(x) dot y) /\
2416                   (!x y. (adjoint f)(y) dot x = y dot f(x))`,
2417   MESON_TAC[ADJOINT_WORKS; DOT_SYM]);;
2418
2419 let ADJOINT_ADJOINT = prove
2420  (`!f:real^M->real^N. linear f ==> adjoint(adjoint f) = f`,
2421   SIMP_TAC[FUN_EQ_THM; GSYM VECTOR_EQ_LDOT; ADJOINT_CLAUSES; ADJOINT_LINEAR]);;
2422
2423 let ADJOINT_UNIQUE = prove
2424  (`!f f'. linear f /\ (!x y. f'(x) dot y = x dot f(y))
2425           ==> f' = adjoint f`,
2426   SIMP_TAC[FUN_EQ_THM; GSYM VECTOR_EQ_RDOT; ADJOINT_CLAUSES]);;
2427
2428 let ADJOINT_COMPOSE = prove
2429  (`!f g:real^N->real^N.
2430         linear f /\ linear g ==> adjoint(f o g) = adjoint g o adjoint f`,
2431   REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC ADJOINT_UNIQUE THEN
2432   ASM_SIMP_TAC[LINEAR_COMPOSE; o_THM; ADJOINT_CLAUSES]);;
2433
2434 let SELF_ADJOINT_COMPOSE = prove
2435  (`!f g:real^N->real^N.
2436         linear f /\ linear g /\ adjoint f = f /\ adjoint g = g
2437         ==> (adjoint(f o g) = f o g <=> f o g = g o f)`,
2438   SIMP_TAC[ADJOINT_COMPOSE] THEN MESON_TAC[]);;
2439
2440 let SELF_ADJOINT_ORTHOGONAL_EIGENVECTORS = prove
2441  (`!f:real^N->real^N v w a b.
2442         linear f /\ adjoint f = f /\ f v = a % v /\ f w = b % w /\ ~(a = b)
2443         ==> orthogonal v w`,
2444   REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o SPECL [`v:real^N`; `w:real^N`] o
2445         MATCH_MP ADJOINT_WORKS) THEN
2446   ASM_REWRITE_TAC[DOT_LMUL; DOT_RMUL; orthogonal; REAL_EQ_MUL_RCANCEL]);;
2447
2448 (* ------------------------------------------------------------------------- *)
2449 (* Matrix notation. NB: an MxN matrix is of type real^N^M, not real^M^N.     *)
2450 (* We could define a special type if we're going to use them a lot.          *)
2451 (* ------------------------------------------------------------------------- *)
2452
2453 overload_interface ("--",`(matrix_neg):real^N^M->real^N^M`);;
2454 overload_interface ("+",`(matrix_add):real^N^M->real^N^M->real^N^M`);;
2455 overload_interface ("-",`(matrix_sub):real^N^M->real^N^M->real^N^M`);;
2456
2457 make_overloadable "**" `:A->B->C`;;
2458
2459 overload_interface ("**",`(matrix_mul):real^N^M->real^P^N->real^P^M`);;
2460 overload_interface ("**",`(matrix_vector_mul):real^N^M->real^N->real^M`);;
2461 overload_interface ("**",`(vector_matrix_mul):real^M->real^N^M->real^N`);;
2462
2463 parse_as_infix("%%",(21,"right"));;
2464
2465 prioritize_real();;
2466
2467 let matrix_cmul = new_definition
2468   `((%%):real->real^N^M->real^N^M) c A = lambda i j. c * A$i$j`;;
2469
2470 let matrix_neg = new_definition
2471   `!A:real^N^M. --A = lambda i j. --(A$i$j)`;;
2472
2473 let matrix_add = new_definition
2474   `!A:real^N^M B:real^N^M. A + B = lambda i j. A$i$j + B$i$j`;;
2475
2476 let matrix_sub = new_definition
2477   `!A:real^N^M B:real^N^M. A - B = lambda i j. A$i$j - B$i$j`;;
2478
2479 let matrix_mul = new_definition
2480   `!A:real^N^M B:real^P^N.
2481         A ** B =
2482           lambda i j. sum(1..dimindex(:N)) (\k. A$i$k * B$k$j)`;;
2483
2484 let matrix_vector_mul = new_definition
2485   `!A:real^N^M x:real^N.
2486         A ** x = lambda i. sum(1..dimindex(:N)) (\j. A$i$j * x$j)`;;
2487
2488 let vector_matrix_mul = new_definition
2489   `!A:real^N^M x:real^M.
2490         x ** A = lambda j. sum(1..dimindex(:M)) (\i. A$i$j * x$i)`;;
2491
2492 let mat = new_definition
2493   `(mat:num->real^N^M) k = lambda i j. if i = j then &k else &0`;;
2494
2495 let transp = new_definition
2496   `(transp:real^N^M->real^M^N) A = lambda i j. A$j$i`;;
2497
2498 let row = new_definition
2499  `(row:num->real^N^M->real^N) i A = lambda j. A$i$j`;;
2500
2501 let column = new_definition
2502  `(column:num->real^N^M->real^M) j A = lambda i. A$i$j`;;
2503
2504 let rows = new_definition
2505  `rows(A:real^N^M) = { row i A | 1 <= i /\ i <= dimindex(:M)}`;;
2506
2507 let columns = new_definition
2508  `columns(A:real^N^M) = { column i A | 1 <= i /\ i <= dimindex(:N)}`;;
2509
2510 let MATRIX_CMUL_COMPONENT = prove
2511  (`!c A:real^N^M i. (c %% A)$i$j = c * A$i$j`,
2512   REPEAT GEN_TAC THEN
2513   SUBGOAL_THEN `?k. 1 <= k /\ k <= dimindex(:M) /\ !A:real^N^M. A$i = A$k`
2514   CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN
2515   SUBGOAL_THEN `?l. 1 <= l /\ l <= dimindex(:N) /\ !z:real^N. z$j = z$l`
2516   CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN
2517   ASM_SIMP_TAC[matrix_cmul; CART_EQ; LAMBDA_BETA]);;
2518
2519 let MATRIX_ADD_COMPONENT = prove
2520  (`!A B:real^N^M i j. (A + B)$i$j = A$i$j + B$i$j`,
2521   REPEAT GEN_TAC THEN
2522   SUBGOAL_THEN `?k. 1 <= k /\ k <= dimindex(:M) /\ !A:real^N^M. A$i = A$k`
2523   CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN
2524   SUBGOAL_THEN `?l. 1 <= l /\ l <= dimindex(:N) /\ !z:real^N. z$j = z$l`
2525   CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN
2526   ASM_SIMP_TAC[matrix_add; LAMBDA_BETA]);;
2527
2528 let MATRIX_SUB_COMPONENT = prove
2529  (`!A B:real^N^M i j. (A - B)$i$j = A$i$j - B$i$j`,
2530   REPEAT GEN_TAC THEN
2531   SUBGOAL_THEN `?k. 1 <= k /\ k <= dimindex(:M) /\ !A:real^N^M. A$i = A$k`
2532   CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN
2533   SUBGOAL_THEN `?l. 1 <= l /\ l <= dimindex(:N) /\ !z:real^N. z$j = z$l`
2534   CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN
2535   ASM_SIMP_TAC[matrix_sub; LAMBDA_BETA]);;
2536
2537 let MATRIX_NEG_COMPONENT = prove
2538  (`!A:real^N^M i j. (--A)$i$j = --(A$i$j)`,
2539   REPEAT GEN_TAC THEN
2540   SUBGOAL_THEN `?k. 1 <= k /\ k <= dimindex(:M) /\ !A:real^N^M. A$i = A$k`
2541   CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN
2542   SUBGOAL_THEN `?l. 1 <= l /\ l <= dimindex(:N) /\ !z:real^N. z$j = z$l`
2543   CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN
2544   ASM_SIMP_TAC[matrix_neg; LAMBDA_BETA]);;
2545
2546 let TRANSP_COMPONENT = prove
2547  (`!A:real^N^M i j. (transp A)$i$j = A$j$i`,
2548   REPEAT GEN_TAC THEN
2549   SUBGOAL_THEN `?k. 1 <= k /\ k <= dimindex(:N) /\
2550                     (!A:real^M^N. A$i = A$k) /\ (!z:real^N. z$i = z$k)`
2551   CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE_2]; ALL_TAC] THEN
2552   SUBGOAL_THEN `?l. 1 <= l /\ l <= dimindex(:M) /\
2553                     (!A:real^N^M. A$j = A$l) /\ (!z:real^M. z$j = z$l)`
2554   CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE_2]; ALL_TAC] THEN
2555   ASM_SIMP_TAC[transp; LAMBDA_BETA]);;
2556
2557 let MAT_COMPONENT = prove
2558  (`!n i j.
2559         1 <= i /\ i <= dimindex(:M) /\
2560         1 <= j /\ j <= dimindex(:N)
2561         ==> (mat n:real^N^M)$i$j = if i = j then &n else &0`,
2562   SIMP_TAC[mat; LAMBDA_BETA]);;
2563
2564 let MAT_0_COMPONENT = prove
2565  (`!i j. (mat 0:real^N^M)$i$j = &0`,
2566   REPEAT GEN_TAC THEN
2567   SUBGOAL_THEN `?k. 1 <= k /\ k <= dimindex(:M) /\ !A:real^N^M. A$i = A$k`
2568   CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN
2569   SUBGOAL_THEN `?l. 1 <= l /\ l <= dimindex(:N) /\ !z:real^N. z$j = z$l`
2570   CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN
2571   ASM_SIMP_TAC[mat; COND_ID; LAMBDA_BETA]);;
2572
2573 let MATRIX_CMUL_ASSOC = prove
2574  (`!a b X:real^M^N. a %% (b %% X) = (a * b) %% X`,
2575   SIMP_TAC[CART_EQ; matrix_cmul; LAMBDA_BETA; REAL_MUL_ASSOC]);;
2576
2577 let MATRIX_CMUL_LID = prove
2578  (`!X:real^M^N. &1 %% X = X`,
2579   SIMP_TAC[CART_EQ; matrix_cmul; LAMBDA_BETA; REAL_MUL_LID]);;
2580
2581 let MATRIX_ADD_SYM = prove
2582  (`!A:real^N^M B. A + B = B + A`,
2583   SIMP_TAC[matrix_add; CART_EQ; LAMBDA_BETA; REAL_ADD_AC]);;
2584
2585 let MATRIX_ADD_ASSOC = prove
2586  (`!A:real^N^M B C. A + (B + C) = (A + B) + C`,
2587   SIMP_TAC[matrix_add; CART_EQ; LAMBDA_BETA; REAL_ADD_AC]);;
2588
2589 let MATRIX_ADD_LID = prove
2590  (`!A. mat 0 + A = A`,
2591   SIMP_TAC[matrix_add; mat; COND_ID; CART_EQ; LAMBDA_BETA; REAL_ADD_LID]);;
2592
2593 let MATRIX_ADD_RID = prove
2594  (`!A. A + mat 0 = A`,
2595   SIMP_TAC[matrix_add; mat; COND_ID; CART_EQ; LAMBDA_BETA; REAL_ADD_RID]);;
2596
2597 let MATRIX_ADD_LNEG = prove
2598  (`!A. --A + A = mat 0`,
2599   SIMP_TAC[matrix_neg; matrix_add; mat; COND_ID;
2600            CART_EQ; LAMBDA_BETA; REAL_ADD_LINV]);;
2601
2602 let MATRIX_ADD_RNEG = prove
2603  (`!A. A + --A = mat 0`,
2604   SIMP_TAC[matrix_neg; matrix_add; mat; COND_ID;
2605            CART_EQ; LAMBDA_BETA; REAL_ADD_RINV]);;
2606
2607 let MATRIX_SUB = prove
2608  (`!A:real^N^M B. A - B = A + --B`,
2609   SIMP_TAC[matrix_neg; matrix_add; matrix_sub; CART_EQ; LAMBDA_BETA;
2610            real_sub]);;
2611
2612 let MATRIX_SUB_REFL = prove
2613  (`!A. A - A = mat 0`,
2614   REWRITE_TAC[MATRIX_SUB; MATRIX_ADD_RNEG]);;
2615
2616 let MATRIX_ADD_LDISTRIB = prove
2617  (`!A:real^N^M B:real^P^N C. A ** (B + C) = A ** B + A ** C`,
2618   SIMP_TAC[matrix_mul; matrix_add; CART_EQ; LAMBDA_BETA;
2619            GSYM SUM_ADD_NUMSEG] THEN
2620   REPEAT STRIP_TAC THEN MATCH_MP_TAC SUM_EQ_NUMSEG THEN
2621   ASM_SIMP_TAC[LAMBDA_BETA; REAL_ADD_LDISTRIB]);;
2622
2623 let MATRIX_MUL_LID = prove
2624  (`!A:real^N^M. mat 1 ** A = A`,
2625   REWRITE_TAC[matrix_mul;
2626    GEN_REWRITE_RULE (RAND_CONV o ONCE_DEPTH_CONV) [EQ_SYM_EQ]
2627     (SPEC_ALL mat)] THEN
2628   SIMP_TAC[CART_EQ; LAMBDA_BETA] THEN REWRITE_TAC[COND_RATOR; COND_RAND] THEN
2629   SIMP_TAC[SUM_DELTA; REAL_MUL_LZERO; IN_NUMSEG; REAL_MUL_LID]);;
2630
2631 let MATRIX_MUL_RID = prove
2632  (`!A:real^N^M. A ** mat 1 = A`,
2633   REWRITE_TAC[matrix_mul; mat] THEN
2634   SIMP_TAC[CART_EQ; LAMBDA_BETA] THEN REWRITE_TAC[COND_RATOR; COND_RAND] THEN
2635   SIMP_TAC[SUM_DELTA; REAL_MUL_RZERO; IN_NUMSEG; REAL_MUL_RID]);;
2636
2637 let MATRIX_MUL_ASSOC = prove
2638  (`!A:real^N^M B:real^P^N C:real^Q^P. A ** B ** C = (A ** B) ** C`,
2639   REPEAT GEN_TAC THEN
2640   SIMP_TAC[matrix_mul; CART_EQ; LAMBDA_BETA; GSYM SUM_LMUL; GSYM SUM_RMUL] THEN
2641   REWRITE_TAC[REAL_MUL_ASSOC] THEN REPEAT STRIP_TAC THEN
2642   GEN_REWRITE_TAC RAND_CONV [SUM_SWAP_NUMSEG] THEN REWRITE_TAC[]);;
2643
2644 let MATRIX_MUL_LZERO = prove
2645  (`!A. (mat 0:real^N^M) ** (A:real^P^N) = mat 0`,
2646   SIMP_TAC[matrix_mul; mat; CART_EQ; LAMBDA_BETA; COND_ID; REAL_MUL_LZERO] THEN
2647   REWRITE_TAC[SUM_0]);;
2648
2649 let MATRIX_MUL_RZERO = prove
2650  (`!A. (A:real^N^M) ** (mat 0:real^P^N) = mat 0`,
2651   SIMP_TAC[matrix_mul; mat; CART_EQ; LAMBDA_BETA; COND_ID; REAL_MUL_RZERO] THEN
2652   REWRITE_TAC[SUM_0]);;
2653
2654 let MATRIX_ADD_RDISTRIB = prove
2655  (`!A:real^N^M B C:real^P^N. (A + B) ** C = A ** C + B ** C`,
2656   SIMP_TAC[matrix_mul; matrix_add; CART_EQ; LAMBDA_BETA] THEN
2657   REWRITE_TAC[REAL_ADD_RDISTRIB; SUM_ADD_NUMSEG]);;
2658
2659 let MATRIX_SUB_LDISTRIB = prove
2660  (`!A:real^N^M B C:real^P^N. A ** (B - C) = A ** B - A ** C`,
2661   SIMP_TAC[matrix_mul; matrix_sub; CART_EQ; LAMBDA_BETA] THEN
2662   REWRITE_TAC[REAL_SUB_LDISTRIB; SUM_SUB_NUMSEG]);;
2663
2664 let MATRIX_SUB_RDISTRIB = prove
2665  (`!A:real^N^M B C:real^P^N. (A - B) ** C = A ** C - B ** C`,
2666   SIMP_TAC[matrix_mul; matrix_sub; CART_EQ; LAMBDA_BETA] THEN
2667   REWRITE_TAC[REAL_SUB_RDISTRIB; SUM_SUB_NUMSEG]);;
2668
2669 let MATRIX_MUL_LMUL = prove
2670  (`!A:real^N^M B:real^P^N c. (c %% A) ** B = c %% (A ** B)`,
2671   SIMP_TAC[matrix_mul; matrix_cmul; CART_EQ; LAMBDA_BETA] THEN
2672   REWRITE_TAC[GSYM REAL_MUL_ASSOC; SUM_LMUL]);;
2673
2674 let MATRIX_MUL_RMUL = prove
2675  (`!A:real^N^M B:real^P^N c. A ** (c %% B) = c %% (A ** B)`,
2676   SIMP_TAC[matrix_mul; matrix_cmul; CART_EQ; LAMBDA_BETA] THEN
2677   ONCE_REWRITE_TAC[REAL_ARITH `A * c * B:real = c * A * B`] THEN
2678   REWRITE_TAC[SUM_LMUL]);;
2679
2680 let MATRIX_CMUL_ADD_LDISTRIB = prove
2681  (`!A:real^N^M B c. c %% (A + B) = c %% A + c %% B`,
2682   SIMP_TAC[matrix_cmul; matrix_add; CART_EQ; LAMBDA_BETA] THEN
2683   REWRITE_TAC[REAL_ADD_LDISTRIB]);;
2684
2685 let MATRIX_CMUL_SUB_LDISTRIB = prove
2686  (`!A:real^N^M B c. c %% (A - B) = c %% A - c %% B`,
2687   SIMP_TAC[matrix_cmul; matrix_sub; CART_EQ; LAMBDA_BETA] THEN
2688   REWRITE_TAC[REAL_SUB_LDISTRIB]);;
2689
2690 let MATRIX_CMUL_ADD_RDISTRIB = prove
2691  (`!A:real^N^M b c. (b + c) %% A = b %% A + c %% A`,
2692   SIMP_TAC[matrix_cmul; matrix_add; CART_EQ; LAMBDA_BETA] THEN
2693   REWRITE_TAC[REAL_ADD_RDISTRIB]);;
2694
2695 let MATRIX_CMUL_SUB_RDISTRIB = prove
2696  (`!A:real^N^M b c. (b - c) %% A = b %% A - c %% A`,
2697   SIMP_TAC[matrix_cmul; matrix_sub; CART_EQ; LAMBDA_BETA] THEN
2698   REWRITE_TAC[REAL_SUB_RDISTRIB]);;
2699
2700 let MATRIX_CMUL_RZERO = prove
2701  (`!c. c %% mat 0 = mat 0`,
2702   SIMP_TAC[matrix_cmul; mat; CART_EQ; LAMBDA_BETA; COND_ID; REAL_MUL_RZERO]);;
2703
2704 let MATRIX_CMUL_LZERO = prove
2705  (`!A. &0 %% A = mat 0`,
2706   SIMP_TAC[matrix_cmul; mat; CART_EQ; LAMBDA_BETA; COND_ID; REAL_MUL_LZERO]);;
2707
2708 let MATRIX_NEG_MINUS1 = prove
2709  (`!A:real^N^M. --A = --(&1) %% A`,
2710   REWRITE_TAC[matrix_cmul; matrix_neg; CART_EQ; LAMBDA_BETA] THEN
2711   REWRITE_TAC[GSYM REAL_NEG_MINUS1]);;
2712
2713 let MATRIX_ADD_AC = prove
2714  (`(A:real^N^M) + B = B + A /\
2715    (A + B) + C = A + (B + C) /\
2716    A + (B + C) = B + (A + C)`,
2717   MESON_TAC[MATRIX_ADD_ASSOC; MATRIX_ADD_SYM]);;
2718
2719 let MATRIX_NEG_ADD = prove
2720  (`!A B:real^N^M. --(A + B) = --A + --B`,
2721   SIMP_TAC[matrix_neg; matrix_add; CART_EQ; LAMBDA_BETA; REAL_NEG_ADD]);;
2722
2723 let MATRIX_NEG_SUB = prove
2724  (`!A B:real^N^M. --(A - B) = B - A`,
2725   SIMP_TAC[matrix_neg; matrix_sub; CART_EQ; LAMBDA_BETA; REAL_NEG_SUB]);;
2726
2727 let MATRIX_NEG_0 = prove
2728  (`--(mat 0) = mat 0`,
2729   SIMP_TAC[CART_EQ; mat; matrix_neg; LAMBDA_BETA; REAL_NEG_0; COND_ID]);;
2730
2731 let MATRIX_SUB_RZERO = prove
2732  (`!A:real^N^M. A - mat 0 = A`,
2733   SIMP_TAC[CART_EQ; mat; matrix_sub; LAMBDA_BETA; REAL_SUB_RZERO; COND_ID]);;
2734
2735 let MATRIX_SUB_LZERO = prove
2736  (`!A:real^N^M. mat 0 - A = --A`,
2737   SIMP_TAC[CART_EQ; mat; matrix_sub; matrix_neg;
2738            LAMBDA_BETA; REAL_SUB_LZERO; COND_ID]);;
2739
2740 let MATRIX_NEG_EQ_0 = prove
2741  (`!A:real^N^M. --A = mat 0 <=> A = mat 0`,
2742   SIMP_TAC[CART_EQ; matrix_neg; mat; LAMBDA_BETA; REAL_NEG_EQ_0; COND_ID]);;
2743
2744 let MATRIX_VECTOR_MUL_ASSOC = prove
2745  (`!A:real^N^M B:real^P^N x:real^P. A ** B ** x = (A ** B) ** x`,
2746   REPEAT GEN_TAC THEN
2747   SIMP_TAC[matrix_mul; matrix_vector_mul;
2748            CART_EQ; LAMBDA_BETA; GSYM SUM_LMUL; GSYM SUM_RMUL] THEN
2749   REWRITE_TAC[REAL_MUL_ASSOC] THEN REPEAT STRIP_TAC THEN
2750   GEN_REWRITE_TAC RAND_CONV [SUM_SWAP_NUMSEG] THEN REWRITE_TAC[]);;
2751
2752 let MATRIX_VECTOR_MUL_LID = prove
2753  (`!x:real^N. mat 1 ** x = x`,
2754   REWRITE_TAC[matrix_vector_mul;
2755    GEN_REWRITE_RULE (RAND_CONV o ONCE_DEPTH_CONV) [EQ_SYM_EQ]
2756     (SPEC_ALL mat)] THEN
2757   SIMP_TAC[CART_EQ; LAMBDA_BETA] THEN REWRITE_TAC[COND_RATOR; COND_RAND] THEN
2758   SIMP_TAC[SUM_DELTA; REAL_MUL_LZERO; IN_NUMSEG; REAL_MUL_LID]);;
2759
2760 let MATRIX_VECTOR_MUL_LZERO = prove
2761  (`!x:real^N. mat 0 ** x = vec 0`,
2762   SIMP_TAC[mat; matrix_vector_mul; CART_EQ; VEC_COMPONENT; LAMBDA_BETA;
2763            COND_ID; REAL_MUL_LZERO; SUM_0]);;
2764
2765 let MATRIX_VECTOR_MUL_RZERO = prove
2766  (`!A:real^M^N. A ** vec 0 = vec 0`,
2767   SIMP_TAC[mat; matrix_vector_mul; CART_EQ; VEC_COMPONENT; LAMBDA_BETA;
2768            COND_ID; REAL_MUL_RZERO; SUM_0]);;
2769
2770 let MATRIX_VECTOR_MUL_ADD_LDISTRIB = prove
2771  (`!A:real^M^N x:real^M y. A ** (x + y) = A ** x + A ** y`,
2772   SIMP_TAC[CART_EQ; matrix_vector_mul; VECTOR_ADD_COMPONENT; LAMBDA_BETA;
2773            SUM_ADD_NUMSEG; REAL_ADD_LDISTRIB]);;
2774
2775 let MATRIX_VECTOR_MUL_SUB_LDISTRIB = prove
2776  (`!A:real^M^N x:real^M y. A ** (x - y) = A ** x - A ** y`,
2777   SIMP_TAC[CART_EQ; matrix_vector_mul; VECTOR_SUB_COMPONENT; LAMBDA_BETA;
2778            SUM_SUB_NUMSEG; REAL_SUB_LDISTRIB]);;
2779
2780 let MATRIX_VECTOR_MUL_ADD_RDISTRIB = prove
2781  (`!A:real^M^N B x. (A + B) ** x = (A ** x) + (B ** x)`,
2782   SIMP_TAC[CART_EQ; matrix_vector_mul; matrix_add; LAMBDA_BETA;
2783            VECTOR_ADD_COMPONENT; REAL_ADD_RDISTRIB; SUM_ADD_NUMSEG]);;
2784
2785 let MATRIX_VECTOR_MUL_SUB_RDISTRIB = prove
2786  (`!A:real^M^N B x. (A - B) ** x = (A ** x) - (B ** x)`,
2787   SIMP_TAC[CART_EQ; matrix_vector_mul; matrix_sub; LAMBDA_BETA;
2788            VECTOR_SUB_COMPONENT; REAL_SUB_RDISTRIB; SUM_SUB_NUMSEG]);;
2789
2790 let MATRIX_VECTOR_MUL_RMUL = prove
2791  (`!A:real^M^N x:real^M c. A ** (c % x) = c % (A ** x)`,
2792   SIMP_TAC[CART_EQ; VECTOR_MUL_COMPONENT; matrix_vector_mul; LAMBDA_BETA] THEN
2793   REWRITE_TAC[GSYM SUM_LMUL] THEN REWRITE_TAC[REAL_MUL_AC]);;
2794
2795 let MATRIX_MUL_LNEG = prove
2796  (`!A:real^N^M B:real^P^N. (--A) ** B = --(A ** B)`,
2797   REWRITE_TAC[MATRIX_NEG_MINUS1; MATRIX_MUL_LMUL]);;
2798
2799 let MATRIX_MUL_RNEG = prove
2800  (`!A:real^N^M B:real^P^N. A ** --B = --(A ** B)`,
2801   REWRITE_TAC[MATRIX_NEG_MINUS1; MATRIX_MUL_RMUL]);;
2802
2803 let MATRIX_NEG_NEG = prove
2804  (`!A:real^N^N. --(--A) = A`,
2805   SIMP_TAC[CART_EQ; MATRIX_NEG_COMPONENT; REAL_NEG_NEG]);;
2806
2807 let MATRIX_TRANSP_MUL = prove
2808  (`!A B. transp(A ** B) = transp(B) ** transp(A)`,
2809   SIMP_TAC[matrix_mul; transp; CART_EQ; LAMBDA_BETA] THEN
2810   REWRITE_TAC[REAL_MUL_AC]);;
2811
2812 let SYMMETRIC_MATRIX_MUL = prove
2813  (`!A B:real^N^N.
2814         transp(A) = A /\ transp(B) = B
2815         ==> (transp(A ** B) = A ** B <=> A ** B = B ** A)`,
2816   SIMP_TAC[MATRIX_TRANSP_MUL] THEN MESON_TAC[]);;
2817
2818 let MATRIX_EQ = prove
2819  (`!A:real^N^M B. (A = B) = !x:real^N. A ** x = B ** x`,
2820   REPEAT GEN_TAC THEN EQ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN
2821   DISCH_THEN(MP_TAC o GEN `i:num` o SPEC `(basis i):real^N`) THEN
2822   SIMP_TAC[CART_EQ; matrix_vector_mul; LAMBDA_BETA; basis] THEN
2823   SIMP_TAC[SUM_DELTA; COND_RAND; REAL_MUL_RZERO] THEN
2824   REWRITE_TAC[TAUT `(if p then b else T) <=> p ==> b`] THEN
2825   SIMP_TAC[REAL_MUL_RID; IN_NUMSEG]);;
2826
2827 let MATRIX_VECTOR_MUL_COMPONENT = prove
2828  (`!A:real^N^M x k.
2829     1 <= k /\ k <= dimindex(:M) ==> ((A ** x)$k = (A$k) dot x)`,
2830   SIMP_TAC[matrix_vector_mul; LAMBDA_BETA; dot]);;
2831
2832 let DOT_LMUL_MATRIX = prove
2833  (`!A:real^N^M x:real^M y:real^N. (x ** A) dot y = x dot (A ** y)`,
2834   SIMP_TAC[dot; matrix_vector_mul; vector_matrix_mul; dot; LAMBDA_BETA] THEN
2835   REPEAT GEN_TAC THEN REWRITE_TAC[GSYM SUM_LMUL] THEN
2836   REWRITE_TAC[GSYM SUM_RMUL] THEN
2837   GEN_REWRITE_TAC RAND_CONV [SUM_SWAP_NUMSEG] THEN REWRITE_TAC[REAL_MUL_AC]);;
2838
2839 let TRANSP_MATRIX_CMUL = prove
2840  (`!A:real^M^N c. transp(c %% A) = c %% transp A`,
2841   SIMP_TAC[CART_EQ; transp; MATRIX_CMUL_COMPONENT; LAMBDA_BETA]);;
2842
2843 let TRANSP_MATRIX_ADD = prove
2844  (`!A B:real^N^M. transp(A + B) = transp A + transp B`,
2845   SIMP_TAC[CART_EQ; transp; LAMBDA_BETA; matrix_add]);;
2846
2847 let TRANSP_MATRIX_SUB = prove
2848  (`!A B:real^N^M. transp(A - B) = transp A - transp B`,
2849   SIMP_TAC[CART_EQ; transp; LAMBDA_BETA; matrix_sub]);;
2850
2851 let TRANSP_MATRIX_NEG = prove
2852  (`!A:real^N^M. transp(--A) = --(transp A)`,
2853   SIMP_TAC[CART_EQ; transp; LAMBDA_BETA; matrix_neg]);;
2854
2855 let TRANSP_MAT = prove
2856  (`!n. transp(mat n) = mat n`,
2857   SIMP_TAC[transp; mat; LAMBDA_BETA; CART_EQ; EQ_SYM_EQ]);;
2858
2859 let TRANSP_TRANSP = prove
2860  (`!A:real^N^M. transp(transp A) = A`,
2861   SIMP_TAC[CART_EQ; transp; LAMBDA_BETA]);;
2862
2863 let SYMMETRIX_MATRIX_CONJUGATE = prove
2864  (`!A B:real^N^N. transp B = B
2865                   ==> transp(transp A ** B ** A) = transp A ** B ** A`,
2866   SIMP_TAC[MATRIX_TRANSP_MUL; TRANSP_TRANSP; MATRIX_MUL_ASSOC]);;
2867
2868 let TRANSP_EQ = prove
2869  (`!A B:real^M^N. transp A = transp B <=> A = B`,
2870   MESON_TAC[TRANSP_TRANSP]);;
2871
2872 let ROW_TRANSP = prove
2873  (`!A:real^N^M i.
2874         1 <= i /\ i <= dimindex(:N) ==> row i (transp A) = column i A`,
2875   SIMP_TAC[row; column; transp; CART_EQ; LAMBDA_BETA]);;
2876
2877 let COLUMN_TRANSP = prove
2878  (`!A:real^N^M i.
2879         1 <= i /\ i <= dimindex(:M) ==> column i (transp A) = row i A`,
2880   SIMP_TAC[row; column; transp; CART_EQ; LAMBDA_BETA]);;
2881
2882 let ROWS_TRANSP = prove
2883  (`!A:real^N^M. rows(transp A) = columns A`,
2884   REWRITE_TAC[rows; columns; EXTENSION; IN_ELIM_THM] THEN
2885   MESON_TAC[ROW_TRANSP]);;
2886
2887 let COLUMNS_TRANSP = prove
2888  (`!A:real^N^M. columns(transp A) = rows A`,
2889   MESON_TAC[TRANSP_TRANSP; ROWS_TRANSP]);;
2890
2891 let VECTOR_MATRIX_MUL_TRANSP = prove
2892  (`!A:real^M^N x:real^N. x ** A = transp A ** x`,
2893   REWRITE_TAC[matrix_vector_mul; vector_matrix_mul; transp] THEN
2894   SIMP_TAC[LAMBDA_BETA; CART_EQ]);;
2895
2896 let MATRIX_VECTOR_MUL_TRANSP = prove
2897  (`!A:real^M^N x:real^M. A ** x = x ** transp A`,
2898   REWRITE_TAC[VECTOR_MATRIX_MUL_TRANSP; TRANSP_TRANSP]);;
2899
2900 let FINITE_ROWS = prove
2901  (`!A:real^N^M. FINITE(rows A)`,
2902   REWRITE_TAC[rows] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN
2903   SIMP_TAC[GSYM numseg; FINITE_IMAGE; FINITE_NUMSEG]);;
2904
2905 let FINITE_COLUMNS = prove
2906  (`!A:real^N^M. FINITE(columns A)`,
2907   REWRITE_TAC[columns] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN
2908   SIMP_TAC[GSYM numseg; FINITE_IMAGE; FINITE_NUMSEG]);;
2909
2910 let MATRIX_EQUAL_ROWS = prove
2911  (`!A B:real^N^M.
2912         A = B <=> !i. 1 <= i /\ i <= dimindex(:M) ==> row i A = row i B`,
2913   SIMP_TAC[row; CART_EQ; LAMBDA_BETA]);;
2914
2915 let MATRIX_EQUAL_COLUMNS = prove
2916  (`!A B:real^N^M.
2917         A = B <=> !i. 1 <= i /\ i <= dimindex(:N) ==> column i A = column i B`,
2918   SIMP_TAC[column; CART_EQ; LAMBDA_BETA] THEN MESON_TAC[]);;
2919
2920 (* ------------------------------------------------------------------------- *)
2921 (* Two sometimes fruitful ways of looking at matrix-vector multiplication.   *)
2922 (* ------------------------------------------------------------------------- *)
2923
2924 let MATRIX_MUL_DOT = prove
2925  (`!A:real^N^M x. A ** x = lambda i. A$i dot x`,
2926   REWRITE_TAC[matrix_vector_mul; dot] THEN SIMP_TAC[CART_EQ; LAMBDA_BETA]);;
2927
2928 let MATRIX_MUL_VSUM = prove
2929  (`!A:real^N^M x. A ** x = vsum(1..dimindex(:N)) (\i. x$i % column i A)`,
2930   SIMP_TAC[matrix_vector_mul; CART_EQ; VSUM_COMPONENT; LAMBDA_BETA;
2931            VECTOR_MUL_COMPONENT; column; REAL_MUL_AC]);;
2932
2933 (* ------------------------------------------------------------------------- *)
2934 (* Slightly gruesome lemmas: better to define sums over vectors really...    *)
2935 (* ------------------------------------------------------------------------- *)
2936
2937 let VECTOR_COMPONENTWISE = prove
2938  (`!x:real^N.
2939     x = lambda j. sum(1..dimindex(:N))
2940                      (\i. x$i * (basis i :real^N)$j)`,
2941   SIMP_TAC[CART_EQ; LAMBDA_BETA; basis] THEN
2942   ONCE_REWRITE_TAC[ARITH_RULE `(m:num = n) <=> (n = m)`] THEN
2943   SIMP_TAC[COND_RAND; REAL_MUL_RZERO; SUM_DELTA; IN_NUMSEG] THEN
2944   REWRITE_TAC[REAL_MUL_RID; COND_ID]);;
2945
2946 let LINEAR_COMPONENTWISE_EXPANSION = prove
2947  (`!f:real^M->real^N.
2948       linear(f)
2949       ==> !x j. 1 <= j /\ j <= dimindex(:N)
2950                 ==> (f x $j =
2951                      sum(1..dimindex(:M)) (\i. x$i * f(basis i)$j))`,
2952   REWRITE_TAC[linear] THEN REPEAT STRIP_TAC THEN
2953   GEN_REWRITE_TAC (LAND_CONV o LAND_CONV o RAND_CONV)
2954    [VECTOR_COMPONENTWISE] THEN
2955   SPEC_TAC(`dimindex(:M)`,`n:num`) THEN
2956   INDUCT_TAC THEN REWRITE_TAC[SUM_CLAUSES_NUMSEG; ARITH] THENL
2957    [REWRITE_TAC[GSYM vec] THEN
2958     GEN_REWRITE_TAC (LAND_CONV o LAND_CONV o RAND_CONV)
2959      [GSYM VECTOR_MUL_LZERO] THEN
2960     ASM_REWRITE_TAC[] THEN REWRITE_TAC[VECTOR_MUL_LZERO] THEN
2961     ASM_SIMP_TAC[vec; LAMBDA_BETA];
2962     REWRITE_TAC[ARITH_RULE `1 <= SUC n`] THEN
2963     ASSUM_LIST(fun thl -> REWRITE_TAC(map GSYM thl)) THEN
2964     SIMP_TAC[GSYM VECTOR_MUL_COMPONENT;
2965              ASSUME `1 <= j`; ASSUME `j <= dimindex(:N)`] THEN
2966     ASSUM_LIST(fun thl -> REWRITE_TAC(map GSYM thl)) THEN
2967     SIMP_TAC[GSYM VECTOR_ADD_COMPONENT;
2968              ASSUME `1 <= j`; ASSUME `j <= dimindex(:N)`] THEN
2969     ASSUM_LIST(fun thl -> REWRITE_TAC(map GSYM thl)) THEN
2970     AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN
2971     ASM_SIMP_TAC[CART_EQ; VECTOR_ADD_COMPONENT; LAMBDA_BETA] THEN
2972     SIMP_TAC[VECTOR_MUL_COMPONENT]]);;
2973
2974 (* ------------------------------------------------------------------------- *)
2975 (* Inverse matrices (not necessarily square, but it's vacuous otherwise).    *)
2976 (* ------------------------------------------------------------------------- *)
2977
2978 let invertible = new_definition
2979   `invertible(A:real^N^M) <=>
2980         ?A':real^M^N. (A ** A' = mat 1) /\ (A' ** A = mat 1)`;;
2981
2982 let matrix_inv = new_definition
2983   `matrix_inv(A:real^N^M) =
2984         @A':real^M^N. (A ** A' = mat 1) /\ (A' ** A = mat 1)`;;
2985
2986 let MATRIX_INV = prove
2987  (`!A:real^N^M.
2988     invertible A ==> A ** matrix_inv A = mat 1 /\ matrix_inv A ** A = mat 1`,
2989   GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[matrix_inv; invertible] THEN
2990   CONV_TAC SELECT_CONV THEN ASM_REWRITE_TAC[GSYM invertible]);;
2991
2992 let MATRIX_INV_UNIQUE = prove
2993  (`!A:real^N^M B. A ** B = mat 1 /\ B ** A = mat 1 ==> matrix_inv A = B`,
2994   REPEAT STRIP_TAC THEN MP_TAC(ISPEC `A:real^N^M` MATRIX_INV) THEN
2995   ANTS_TAC THENL [ASM_MESON_TAC[invertible]; ALL_TAC] THEN
2996   DISCH_THEN(MP_TAC o
2997     AP_TERM `(( ** ):real^M^N->real^M^M->real^M^N) B` o CONJUNCT1) THEN
2998   ASM_REWRITE_TAC[MATRIX_MUL_ASSOC; MATRIX_MUL_LID; MATRIX_MUL_RID]);;
2999
3000 let INVERTIBLE_NEG = prove
3001  (`!A:real^N^M. invertible(--A) <=> invertible A`,
3002   REWRITE_TAC[invertible] THEN
3003   MESON_TAC[MATRIX_MUL_LNEG; MATRIX_MUL_RNEG; MATRIX_NEG_NEG]);;
3004
3005 let MATRIX_INV_I = prove
3006  (`matrix_inv(mat 1:real^N^N) = mat 1`,
3007   MATCH_MP_TAC MATRIX_INV_UNIQUE THEN
3008   REWRITE_TAC[MATRIX_MUL_LID]);;
3009
3010 (* ------------------------------------------------------------------------- *)
3011 (* Correspondence between matrices and linear operators.                     *)
3012 (* ------------------------------------------------------------------------- *)
3013
3014 let matrix = new_definition
3015   `(matrix:(real^M->real^N)->real^M^N) f = lambda i j. f(basis j)$i`;;
3016
3017 let MATRIX_VECTOR_MUL_LINEAR = prove
3018  (`!A:real^N^M. linear(\x. A ** x)`,
3019   REWRITE_TAC[linear; matrix_vector_mul] THEN
3020   SIMP_TAC[CART_EQ; LAMBDA_BETA; VECTOR_ADD_COMPONENT;
3021     VECTOR_MUL_COMPONENT] THEN
3022   REWRITE_TAC[GSYM SUM_ADD_NUMSEG; GSYM SUM_LMUL; REAL_ADD_LDISTRIB] THEN
3023   REWRITE_TAC[REAL_ADD_AC; REAL_MUL_AC]);;
3024
3025 let MATRIX_WORKS = prove
3026  (`!f:real^M->real^N. linear f ==> !x. matrix f ** x = f(x)`,
3027   REWRITE_TAC[matrix; matrix_vector_mul] THEN
3028   SIMP_TAC[CART_EQ; LAMBDA_BETA] THEN GEN_TAC THEN DISCH_TAC THEN
3029   REPEAT GEN_TAC THEN DISCH_TAC THEN
3030   ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
3031   ASM_SIMP_TAC[GSYM LINEAR_COMPONENTWISE_EXPANSION]);;
3032
3033 let MATRIX_VECTOR_MUL = prove
3034  (`!f:real^M->real^N. linear f ==> f = \x. matrix f ** x`,
3035   SIMP_TAC[FUN_EQ_THM; MATRIX_WORKS]);;
3036
3037 let MATRIX_OF_MATRIX_VECTOR_MUL = prove
3038  (`!A:real^N^M. matrix(\x. A ** x) = A`,
3039   SIMP_TAC[MATRIX_EQ; MATRIX_VECTOR_MUL_LINEAR; MATRIX_WORKS]);;
3040
3041 let MATRIX_COMPOSE = prove
3042  (`!f g. linear f /\ linear g ==> (matrix(g o f) = matrix g ** matrix f)`,
3043   SIMP_TAC[MATRIX_EQ; MATRIX_WORKS; LINEAR_COMPOSE;
3044            GSYM MATRIX_VECTOR_MUL_ASSOC; o_THM]);;
3045
3046 let MATRIX_VECTOR_COLUMN = prove
3047  (`!A:real^N^M x.
3048         A ** x = vsum(1..dimindex(:N)) (\i. x$i % (transp A)$i)`,
3049   REWRITE_TAC[matrix_vector_mul; transp] THEN
3050   SIMP_TAC[CART_EQ; LAMBDA_BETA; VSUM_COMPONENT; VECTOR_MUL_COMPONENT] THEN
3051   REWRITE_TAC[REAL_MUL_AC]);;
3052
3053 let MATRIX_MUL_COMPONENT = prove
3054  (`!i. 1 <= i /\ i <= dimindex(:N)
3055        ==> ((A:real^N^N) ** (B:real^N^N))$i = transp B ** A$i`,
3056   SIMP_TAC[matrix_mul; LAMBDA_BETA; matrix_vector_mul; vector_matrix_mul;
3057        transp; CART_EQ] THEN
3058   REPEAT STRIP_TAC THEN MATCH_MP_TAC SUM_EQ_NUMSEG THEN
3059   REWRITE_TAC[REAL_MUL_AC]);;
3060
3061 let ADJOINT_MATRIX = prove
3062  (`!A:real^N^M. adjoint(\x. A ** x) = (\x. transp A ** x)`,
3063   GEN_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC ADJOINT_UNIQUE THEN
3064   REWRITE_TAC[MATRIX_VECTOR_MUL_LINEAR] THEN REPEAT GEN_TAC THEN
3065   SIMP_TAC[transp; dot; LAMBDA_BETA; matrix_vector_mul;
3066            GSYM SUM_LMUL; GSYM SUM_RMUL] THEN
3067   GEN_REWRITE_TAC LAND_CONV [SUM_SWAP_NUMSEG] THEN REWRITE_TAC[REAL_MUL_AC]);;
3068
3069 let MATRIX_ADJOINT = prove
3070  (`!f. linear f ==> matrix(adjoint f) = transp(matrix f)`,
3071   GEN_TAC THEN DISCH_THEN
3072    (fun th -> GEN_REWRITE_TAC (LAND_CONV o funpow 2 RAND_CONV)
3073                 [MATCH_MP MATRIX_VECTOR_MUL th]) THEN
3074   REWRITE_TAC[ADJOINT_MATRIX; MATRIX_OF_MATRIX_VECTOR_MUL]);;
3075
3076 let MATRIX_ID = prove
3077  (`matrix(\x. x) = mat 1`,
3078   SIMP_TAC[MATRIX_EQ; LINEAR_ID; MATRIX_WORKS; MATRIX_VECTOR_MUL_LID]);;
3079
3080 let MATRIX_I = prove
3081  (`matrix I = mat 1`,
3082   REWRITE_TAC[I_DEF; MATRIX_ID]);;
3083
3084 let LINEAR_EQ_MATRIX = prove
3085  (`!f g. linear f /\ linear g /\ matrix f = matrix g ==> f = g`,
3086   REPEAT STRIP_TAC THEN
3087   REPEAT(FIRST_X_ASSUM(SUBST1_TAC o MATCH_MP MATRIX_VECTOR_MUL)) THEN
3088   ASM_REWRITE_TAC[]);;
3089
3090 let MATRIX_SELF_ADJOINT = prove
3091  (`!f. linear f ==> (adjoint f = f <=> transp(matrix f) = matrix f)`,
3092   SIMP_TAC[GSYM MATRIX_ADJOINT] THEN
3093   MESON_TAC[LINEAR_EQ_MATRIX; ADJOINT_LINEAR]);;
3094
3095 let LINEAR_MATRIX_EXISTS = prove
3096  (`!f:real^M->real^N. linear f <=> ?A:real^M^N. f = \x. A ** x`,
3097   GEN_TAC THEN EQ_TAC THEN
3098   SIMP_TAC[MATRIX_VECTOR_MUL_LINEAR; LEFT_IMP_EXISTS_THM] THEN
3099   DISCH_TAC THEN EXISTS_TAC `matrix(f:real^M->real^N)` THEN
3100   ASM_SIMP_TAC[GSYM MATRIX_VECTOR_MUL]);;
3101
3102 let LINEAR_1 = prove
3103  (`!f:real^1->real^1. linear f <=> ?c. f = \x. c % x`,
3104   SIMP_TAC[LINEAR_MATRIX_EXISTS; EXISTS_VECTOR_1] THEN
3105   SIMP_TAC[FUN_EQ_THM; CART_EQ; FORALL_1; DIMINDEX_1; VECTOR_1;
3106            matrix_vector_mul; SUM_1; CART_EQ; LAMBDA_BETA;
3107            VECTOR_MUL_COMPONENT]);;
3108
3109 let SYMMETRIC_MATRIX = prove
3110  (`!A:real^N^N. transp A = A <=> adjoint(\x. A ** x) = \x. A ** x`,
3111   SIMP_TAC[MATRIX_SELF_ADJOINT; MATRIX_VECTOR_MUL_LINEAR] THEN
3112   REWRITE_TAC[MATRIX_OF_MATRIX_VECTOR_MUL]);;
3113
3114 let SYMMETRIC_MATRIX_ORTHOGONAL_EIGENVECTORS = prove
3115  (`!A:real^N^N v w a b.
3116         transp A = A /\ A ** v = a % v /\ A ** w = b % w /\ ~(a = b)
3117         ==> orthogonal v w`,
3118   REPEAT GEN_TAC THEN REWRITE_TAC[SYMMETRIC_MATRIX] THEN
3119   DISCH_THEN(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ_ALT]
3120         SELF_ADJOINT_ORTHOGONAL_EIGENVECTORS)) THEN
3121   REWRITE_TAC[MATRIX_VECTOR_MUL_LINEAR]);;
3122
3123 (* ------------------------------------------------------------------------- *)
3124 (* Operator norm.                                                            *)
3125 (* ------------------------------------------------------------------------- *)
3126
3127 let onorm = new_definition
3128  `onorm (f:real^M->real^N) = sup { norm(f x) | norm(x) = &1 }`;;
3129
3130 let NORM_BOUND_GENERALIZE = prove
3131  (`!f:real^M->real^N b.
3132         linear f
3133         ==> ((!x. (norm(x) = &1) ==> norm(f x) <= b) <=>
3134              (!x. norm(f x) <= b * norm(x)))`,
3135   REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THENL
3136    [ALL_TAC; ASM_MESON_TAC[REAL_MUL_RID]] THEN
3137   X_GEN_TAC `x:real^M` THEN ASM_CASES_TAC `x:real^M = vec 0` THENL
3138    [ASM_REWRITE_TAC[NORM_0; REAL_MUL_RZERO] THEN
3139     ASM_MESON_TAC[LINEAR_0; NORM_0; REAL_LE_REFL];
3140     ALL_TAC] THEN
3141   ASM_SIMP_TAC[GSYM REAL_LE_LDIV_EQ; NORM_POS_LT; real_div] THEN
3142   MATCH_MP_TAC(REAL_ARITH `abs(a * b) <= c ==> b * a <= c`) THEN
3143   REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_NORM; GSYM NORM_MUL] THEN
3144   FIRST_ASSUM(fun th -> REWRITE_TAC[GSYM(MATCH_MP LINEAR_CMUL th)]) THEN
3145   ASM_SIMP_TAC[NORM_MUL; REAL_ABS_INV; REAL_ABS_NORM; REAL_MUL_LINV;
3146                NORM_EQ_0]);;
3147
3148 let ONORM = prove
3149  (`!f:real^M->real^N.
3150         linear f
3151         ==> (!x. norm(f x) <= onorm f * norm(x)) /\
3152             (!b. (!x. norm(f x) <= b * norm(x)) ==> onorm f <= b)`,
3153   GEN_TAC THEN DISCH_TAC THEN
3154   MP_TAC(SPEC `{ norm((f:real^M->real^N) x) | norm(x) = &1 }` SUP) THEN
3155   SIMP_TAC[IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN
3156   ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN
3157   REWRITE_TAC[LEFT_FORALL_IMP_THM; RIGHT_EXISTS_AND_THM; EXISTS_REFL] THEN
3158   ASM_SIMP_TAC[NORM_BOUND_GENERALIZE; GSYM onorm; GSYM MEMBER_NOT_EMPTY] THEN
3159   DISCH_THEN MATCH_MP_TAC THEN REWRITE_TAC[IN_ELIM_THM] THEN
3160   ASM_MESON_TAC[VECTOR_CHOOSE_SIZE; LINEAR_BOUNDED; REAL_POS]);;
3161
3162 let ONORM_POS_LE = prove
3163  (`!f. linear f ==> &0 <= onorm f`,
3164   MESON_TAC[ONORM; VECTOR_CHOOSE_SIZE; REAL_POS; REAL_MUL_RID; NORM_POS_LE;
3165             REAL_LE_TRANS]);;
3166
3167 let ONORM_EQ_0 = prove
3168  (`!f:real^M->real^N. linear f ==> ((onorm f = &0) <=> (!x. f x = vec 0))`,
3169   REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THEN
3170   MP_TAC(SPEC `f:real^M->real^N` ONORM) THEN
3171   ASM_SIMP_TAC[GSYM REAL_LE_ANTISYM; ONORM_POS_LE; NORM_0; REAL_MUL_LZERO;
3172                NORM_LE_0; REAL_LE_REFL]);;
3173
3174 let ONORM_CONST = prove
3175  (`!y:real^N. onorm(\x:real^M. y) = norm(y)`,
3176   GEN_TAC THEN REWRITE_TAC[onorm] THEN
3177   MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `sup {norm(y:real^N)}` THEN
3178   CONJ_TAC THENL
3179    [AP_TERM_TAC THEN MATCH_MP_TAC(SET_RULE
3180      `(?x. P x) ==> {f y | x | P x} = {f y}`) THEN
3181     EXISTS_TAC `basis 1 :real^M` THEN
3182     SIMP_TAC[NORM_BASIS; DIMINDEX_GE_1; LE_REFL];
3183     MATCH_MP_TAC REAL_SUP_UNIQUE THEN SET_TAC[REAL_LE_REFL]]);;
3184
3185 let ONORM_POS_LT = prove
3186  (`!f. linear f ==> (&0 < onorm f <=> ~(!x. f x = vec 0))`,
3187   SIMP_TAC[GSYM ONORM_EQ_0; ONORM_POS_LE;
3188            REAL_ARITH `(&0 < x <=> ~(x = &0)) <=> &0 <= x`]);;
3189
3190 let ONORM_COMPOSE = prove
3191  (`!f g. linear f /\ linear g ==> onorm(f o g) <= onorm f * onorm g`,
3192   MESON_TAC[ONORM; LINEAR_COMPOSE; o_THM; REAL_MUL_ASSOC; REAL_LE_TRANS; ONORM;
3193             REAL_LE_LMUL; ONORM_POS_LE]);;
3194
3195 let ONORM_NEG_LEMMA = prove
3196  (`!f. linear f ==> onorm(\x. --(f x)) <= onorm f`,
3197   REPEAT STRIP_TAC THEN
3198   FIRST_ASSUM(STRIP_ASSUME_TAC o MATCH_MP ONORM o
3199     MATCH_MP LINEAR_COMPOSE_NEG) THEN
3200   FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[NORM_NEG; ONORM]);;
3201
3202 let ONORM_NEG = prove
3203  (`!f:real^M->real^N. linear f ==> (onorm(\x. --(f x)) = onorm f)`,
3204   REPEAT STRIP_TAC THEN  REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN
3205   ASM_SIMP_TAC[ONORM_NEG_LEMMA] THEN
3206   SUBGOAL_THEN `f:real^M->real^N = \x. --(--(f x))`
3207    (fun th -> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [th]) THEN
3208   ASM_SIMP_TAC[ONORM_NEG_LEMMA; LINEAR_COMPOSE_NEG] THEN
3209   REWRITE_TAC[VECTOR_NEG_NEG; ETA_AX]);;
3210
3211 let ONORM_TRIANGLE = prove
3212  (`!f:real^M->real^N g.
3213         linear f /\ linear g ==> onorm(\x. f x + g x) <= onorm f + onorm g`,
3214   REPEAT GEN_TAC THEN DISCH_TAC THEN
3215   FIRST_ASSUM(MATCH_MP_TAC o CONJUNCT2 o MATCH_MP ONORM o MATCH_MP
3216               LINEAR_COMPOSE_ADD) THEN
3217   REWRITE_TAC[REAL_ADD_RDISTRIB] THEN
3218   ASM_MESON_TAC[REAL_LE_ADD2; REAL_LE_TRANS; NORM_TRIANGLE; ONORM]);;
3219
3220 let ONORM_TRIANGLE_LE = prove
3221  (`!f g. linear f /\ linear g /\ onorm(f) + onorm(g) <= e
3222          ==> onorm(\x. f x + g x) <= e`,
3223   MESON_TAC[REAL_LE_TRANS; ONORM_TRIANGLE]);;
3224
3225 let ONORM_TRIANGLE_LT = prove
3226  (`!f g. linear f /\ linear g /\ onorm(f) + onorm(g) < e
3227          ==> onorm(\x. f x + g x) < e`,
3228   MESON_TAC[REAL_LET_TRANS; ONORM_TRIANGLE]);;
3229
3230 let ONORM_ID = prove
3231  (`onorm(\x:real^N. x) = &1`,
3232   REWRITE_TAC[onorm] THEN
3233   SUBGOAL_THEN `{norm(x:real^N) | norm x = &1} = {&1}`
3234    (fun th -> REWRITE_TAC[th; SUP_SING]) THEN
3235   SUBGOAL_THEN `norm(basis 1:real^N) = &1` MP_TAC THENL
3236    [SIMP_TAC[NORM_BASIS; DIMINDEX_GE_1; LE_REFL]; SET_TAC[]]);;
3237
3238 let ONORM_I = prove
3239  (`onorm(I:real^N->real^N) = &1`,
3240   REWRITE_TAC[I_DEF; ONORM_ID]);;
3241
3242 (* ------------------------------------------------------------------------- *)
3243 (* It's handy to "lift" from R to R^1 and "drop" from R^1 to R.              *)
3244 (* ------------------------------------------------------------------------- *)
3245
3246 let lift = new_definition
3247  `(lift:real->real^1) x = lambda i. x`;;
3248
3249 let drop = new_definition
3250  `(drop:real^1->real) x = x$1`;;
3251
3252 let LIFT_COMPONENT = prove
3253  (`!x. (lift x)$1 = x`,
3254   SIMP_TAC[lift; LAMBDA_BETA; DIMINDEX_1; LE_ANTISYM]);;
3255
3256 let LIFT_DROP = prove
3257  (`(!x. lift(drop x) = x) /\ (!x. drop(lift x) = x)`,
3258   SIMP_TAC[lift; drop; CART_EQ; LAMBDA_BETA; DIMINDEX_1; LE_ANTISYM]);;
3259
3260 let IMAGE_LIFT_DROP = prove
3261  (`(!s. IMAGE (lift o drop) s = s) /\ (!s. IMAGE (drop o lift) s = s)`,
3262   REWRITE_TAC[o_DEF; LIFT_DROP] THEN SET_TAC[]);;
3263
3264 let IN_IMAGE_LIFT_DROP = prove
3265  (`(!x s. x IN IMAGE lift s <=> drop x IN s) /\
3266    (!x s. x IN IMAGE drop s <=> lift x IN s)`,
3267   REWRITE_TAC[IN_IMAGE] THEN MESON_TAC[LIFT_DROP]);;
3268
3269 let FORALL_LIFT = prove
3270  (`(!x. P x) = (!x. P(lift x))`,
3271   MESON_TAC[LIFT_DROP]);;
3272
3273 let EXISTS_LIFT = prove
3274  (`(?x. P x) = (?x. P(lift x))`,
3275   MESON_TAC[LIFT_DROP]);;
3276
3277 let FORALL_DROP = prove
3278  (`(!x. P x) = (!x. P(drop x))`,
3279   MESON_TAC[LIFT_DROP]);;
3280
3281 let EXISTS_DROP = prove
3282  (`(?x. P x) = (?x. P(drop x))`,
3283   MESON_TAC[LIFT_DROP]);;
3284
3285 let FORALL_LIFT_FUN = prove
3286  (`!P:(A->real^1)->bool. (!f. P f) <=> (!f. P(lift o f))`,
3287   GEN_TAC THEN EQ_TAC THEN SIMP_TAC[] THEN DISCH_TAC THEN
3288   X_GEN_TAC `f:A->real^1` THEN
3289   FIRST_X_ASSUM(MP_TAC o SPEC `drop o (f:A->real^1)`) THEN
3290   REWRITE_TAC[o_DEF; LIFT_DROP; ETA_AX]);;
3291
3292 let FORALL_DROP_FUN = prove
3293  (`!P:(A->real)->bool. (!f. P f) <=> (!f. P(drop o f))`,
3294   REWRITE_TAC[FORALL_LIFT_FUN; o_DEF; LIFT_DROP; ETA_AX]);;
3295
3296 let EXISTS_LIFT_FUN = prove
3297  (`!P:(A->real^1)->bool. (?f. P f) <=> (?f. P(lift o f))`,
3298   ONCE_REWRITE_TAC[MESON[] `(?x. P x) <=> ~(!x. ~P x)`] THEN
3299   REWRITE_TAC[FORALL_LIFT_FUN]);;
3300
3301 let EXISTS_DROP_FUN = prove
3302  (`!P:(A->real)->bool. (?f. P f) <=> (?f. P(drop o f))`,
3303   ONCE_REWRITE_TAC[MESON[] `(?x. P x) <=> ~(!x. ~P x)`] THEN
3304   REWRITE_TAC[FORALL_DROP_FUN]);;
3305
3306 let LIFT_EQ = prove
3307  (`!x y. (lift x = lift y) <=> (x = y)`,
3308   MESON_TAC[LIFT_DROP]);;
3309
3310 let DROP_EQ = prove
3311  (`!x y. (drop x = drop y) <=> (x = y)`,
3312   MESON_TAC[LIFT_DROP]);;
3313
3314 let LIFT_IN_IMAGE_LIFT = prove
3315  (`!x s. (lift x) IN (IMAGE lift s) <=> x IN s`,
3316   REWRITE_TAC[IN_IMAGE] THEN MESON_TAC[LIFT_DROP]);;
3317
3318 let FORALL_LIFT_IMAGE = prove
3319  (`!P. (!s. P s) <=> (!s. P(IMAGE lift s))`,
3320   MESON_TAC[IMAGE_LIFT_DROP; IMAGE_o]);;
3321
3322 let EXISTS_LIFT_IMAGE = prove
3323  (`!P. (?s. P s) <=> (?s. P(IMAGE lift s))`,
3324   MESON_TAC[IMAGE_LIFT_DROP; IMAGE_o]);;
3325
3326 let SUBSET_LIFT_IMAGE = prove
3327  (`!s t. IMAGE lift s SUBSET IMAGE lift t <=> s SUBSET t`,
3328   REPEAT GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[IMAGE_SUBSET] THEN
3329   DISCH_THEN(MP_TAC o ISPEC `drop` o MATCH_MP IMAGE_SUBSET) THEN
3330   REWRITE_TAC[GSYM IMAGE_o; IMAGE_LIFT_DROP]);;
3331
3332 let FORALL_DROP_IMAGE = prove
3333  (`!P. (!s. P s) <=> (!s. P(IMAGE drop s))`,
3334   MESON_TAC[IMAGE_LIFT_DROP; IMAGE_o]);;
3335
3336 let EXISTS_DROP_IMAGE = prove
3337  (`!P. (?s. P s) <=> (?s. P(IMAGE drop s))`,
3338   MESON_TAC[IMAGE_LIFT_DROP; IMAGE_o]);;
3339
3340 let SUBSET_DROP_IMAGE = prove
3341  (`!s t. IMAGE drop s SUBSET IMAGE drop t <=> s SUBSET t`,
3342   REPEAT GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[IMAGE_SUBSET] THEN
3343   DISCH_THEN(MP_TAC o ISPEC `lift` o MATCH_MP IMAGE_SUBSET) THEN
3344   REWRITE_TAC[GSYM IMAGE_o; IMAGE_LIFT_DROP]);;
3345
3346 let DROP_IN_IMAGE_DROP = prove
3347  (`!x s. (drop x) IN (IMAGE drop s) <=> x IN s`,
3348   REWRITE_TAC[IN_IMAGE] THEN MESON_TAC[LIFT_DROP]);;
3349
3350 let LIFT_NUM = prove
3351  (`!n. lift(&n) = vec n`,
3352   SIMP_TAC[CART_EQ; lift; vec; LAMBDA_BETA]);;
3353
3354 let LIFT_ADD = prove
3355  (`!x y. lift(x + y) = lift x + lift y`,
3356   SIMP_TAC[CART_EQ; lift; LAMBDA_BETA; VECTOR_ADD_COMPONENT]);;
3357
3358 let LIFT_SUB = prove
3359  (`!x y. lift(x - y) = lift x - lift y`,
3360   SIMP_TAC[CART_EQ; lift; LAMBDA_BETA; VECTOR_SUB_COMPONENT]);;
3361
3362 let LIFT_CMUL = prove
3363  (`!x c. lift(c * x) = c % lift(x)`,
3364   SIMP_TAC[CART_EQ; lift; LAMBDA_BETA; VECTOR_MUL_COMPONENT]);;
3365
3366 let LIFT_NEG = prove
3367  (`!x. lift(--x) = --(lift x)`,
3368   SIMP_TAC[CART_EQ; lift; LAMBDA_BETA; VECTOR_NEG_COMPONENT]);;
3369
3370 let LIFT_EQ_CMUL = prove
3371  (`!x. lift x = x % vec 1`,
3372   REWRITE_TAC[GSYM LIFT_NUM; GSYM LIFT_CMUL; REAL_MUL_RID]);;
3373
3374 let LIFT_SUM = prove
3375  (`!k x. FINITE k ==> (lift(sum k x) = vsum k (lift o x))`,
3376   REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN
3377   MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
3378   SIMP_TAC[SUM_CLAUSES; VSUM_CLAUSES; o_THM; LIFT_ADD; LIFT_NUM]);;
3379
3380 let DROP_LAMBDA = prove
3381  (`!x. drop(lambda i. x i) = x 1`,
3382   SIMP_TAC[drop; LAMBDA_BETA; DIMINDEX_1; LE_REFL]);;
3383
3384 let DROP_VEC = prove
3385  (`!n. drop(vec n) = &n`,
3386   MESON_TAC[LIFT_DROP; LIFT_NUM]);;
3387
3388 let DROP_ADD = prove
3389  (`!x y. drop(x + y) = drop x + drop y`,
3390   MESON_TAC[LIFT_DROP; LIFT_ADD]);;
3391
3392 let DROP_SUB = prove
3393  (`!x y. drop(x - y) = drop x - drop y`,
3394   MESON_TAC[LIFT_DROP; LIFT_SUB]);;
3395
3396 let DROP_CMUL = prove
3397  (`!x c. drop(c % x) = c * drop(x)`,
3398   MESON_TAC[LIFT_DROP; LIFT_CMUL]);;
3399
3400 let DROP_NEG = prove
3401  (`!x. drop(--x) = --(drop x)`,
3402   MESON_TAC[LIFT_DROP; LIFT_NEG]);;
3403
3404 let DROP_VSUM = prove
3405  (`!k x. FINITE k ==> (drop(vsum k x) = sum k (drop o x))`,
3406   REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN
3407   MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
3408   SIMP_TAC[SUM_CLAUSES; VSUM_CLAUSES; o_THM; DROP_ADD; DROP_VEC]);;
3409
3410 let NORM_1 = prove
3411  (`!x. norm x = abs(drop x)`,
3412   REWRITE_TAC[drop; NORM_REAL]);;
3413
3414 let NORM_1_POS = prove
3415  (`!x. &0 <= drop x ==> norm x = drop x`,
3416   SIMP_TAC[NORM_1; real_abs]);;
3417
3418 let NORM_LIFT = prove
3419  (`!x. norm(lift x) = abs(x)`,
3420   SIMP_TAC[lift; NORM_REAL; LIFT_COMPONENT]);;
3421
3422 let DIST_LIFT = prove
3423  (`!x y. dist(lift x,lift y) = abs(x - y)`,
3424   REWRITE_TAC[DIST_REAL; LIFT_COMPONENT]);;
3425
3426 let ABS_DROP = prove
3427  (`!x. norm x = abs(drop x)`,
3428   REWRITE_TAC[FORALL_LIFT; LIFT_DROP; NORM_LIFT]);;
3429
3430 let LINEAR_VMUL_DROP = prove
3431  (`!f v. linear f ==> linear (\x. drop(f x) % v)`,
3432   SIMP_TAC[drop; LINEAR_VMUL_COMPONENT; DIMINDEX_1; LE_REFL]);;
3433
3434 let LINEAR_FROM_REALS = prove
3435  (`!f:real^1->real^N. linear f ==> f = \x. drop x % column 1 (matrix f)`,
3436   GEN_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN
3437   DISCH_THEN(fun th -> REWRITE_TAC[GSYM(MATCH_MP MATRIX_WORKS th)]) THEN
3438   SIMP_TAC[CART_EQ; matrix_vector_mul; vector_mul; LAMBDA_BETA;
3439            DIMINDEX_1; SUM_SING_NUMSEG; drop; column] THEN
3440   REWRITE_TAC[REAL_MUL_AC]);;
3441
3442 let LINEAR_TO_REALS = prove
3443  (`!f:real^N->real^1. linear f ==> f = \x. lift(row 1 (matrix f) dot x)`,
3444   GEN_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN
3445   DISCH_THEN(fun th -> REWRITE_TAC[GSYM(MATCH_MP MATRIX_WORKS th)]) THEN
3446   SIMP_TAC[CART_EQ; matrix_vector_mul; dot; LAMBDA_BETA;
3447            DIMINDEX_1; SUM_SING_NUMSEG; lift; row; LE_ANTISYM]);;
3448
3449 let DROP_EQ_0 = prove
3450  (`!x. drop x = &0 <=> x = vec 0`,
3451   REWRITE_TAC[GSYM DROP_EQ; DROP_VEC]);;
3452
3453 let VSUM_REAL = prove
3454  (`!f s. FINITE s ==> vsum s f = lift(sum s (drop o f))`,
3455   SIMP_TAC[LIFT_SUM; o_DEF; LIFT_DROP; ETA_AX]);;
3456
3457 let DROP_WLOG_LE = prove
3458  (`(!x y. P x y <=> P y x) /\ (!x y. drop x <= drop y ==> P x y)
3459    ==> (!x y. P x y)`,
3460   MESON_TAC[REAL_LE_TOTAL]);;
3461
3462 let IMAGE_LIFT_UNIV = prove
3463  (`IMAGE lift (:real) = (:real^1)`,
3464   REWRITE_TAC[EXTENSION; IN_IMAGE; IN_UNIV] THEN MESON_TAC[LIFT_DROP]);;
3465
3466 let IMAGE_DROP_UNIV = prove
3467  (`IMAGE drop (:real^1) = (:real)`,
3468   REWRITE_TAC[EXTENSION; IN_IMAGE; IN_UNIV] THEN MESON_TAC[LIFT_DROP]);;
3469
3470 let SUM_VSUM = prove
3471  (`!f s. FINITE s ==> sum s f = drop(vsum s (lift o f))`,
3472   SIMP_TAC[VSUM_REAL; o_DEF; LIFT_DROP; ETA_AX]);;
3473
3474 let LINEAR_LIFT_DOT = prove
3475  (`!a. linear(\x. lift(a dot x))`,
3476   REWRITE_TAC[linear; DOT_RMUL; DOT_RADD; LIFT_ADD; LIFT_CMUL]);;
3477
3478 let LINEAR_LIFT_COMPONENT = prove
3479  (`!k. linear(\x:real^N. lift(x$k))`,
3480   REPEAT GEN_TAC THEN
3481   SUBGOAL_THEN `?j. 1 <= j /\ j <= dimindex(:N) /\ !z:real^N. z$k = z$j`
3482   CHOOSE_TAC THENL
3483    [REWRITE_TAC[FINITE_INDEX_INRANGE];
3484     MP_TAC(ISPEC `basis j:real^N` LINEAR_LIFT_DOT) THEN
3485     ASM_SIMP_TAC[DOT_BASIS]]);;
3486
3487 let BILINEAR_DROP_MUL = prove
3488  (`bilinear (\x y:real^N. drop x % y)`,
3489   REWRITE_TAC[bilinear; linear] THEN
3490   REWRITE_TAC[DROP_ADD; DROP_CMUL] THEN VECTOR_ARITH_TAC);;
3491
3492 let LINEAR_COMPONENTWISE = prove
3493  (`!f:real^M->real^N.
3494         linear f <=>
3495         !i. 1 <= i /\ i <= dimindex(:N) ==> linear(\x. lift(f(x)$i))`,
3496   REPEAT GEN_TAC THEN REWRITE_TAC[linear] THEN
3497   GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [CART_EQ] THEN
3498   SIMP_TAC[GSYM LIFT_CMUL; GSYM LIFT_ADD; LIFT_EQ] THEN
3499   REWRITE_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT] THEN
3500   MESON_TAC[]);;
3501
3502 (* ------------------------------------------------------------------------- *)
3503 (* Pasting vectors.                                                          *)
3504 (* ------------------------------------------------------------------------- *)
3505
3506 let LINEAR_FSTCART = prove
3507  (`linear fstcart`,
3508   SIMP_TAC[linear; fstcart; CART_EQ; LAMBDA_BETA; VECTOR_ADD_COMPONENT;
3509            VECTOR_MUL_COMPONENT; DIMINDEX_FINITE_SUM;
3510            ARITH_RULE `x <= a ==> x <= a + b:num`]);;
3511
3512 let LINEAR_SNDCART = prove
3513  (`linear sndcart`,
3514   SIMP_TAC[linear; sndcart; CART_EQ; LAMBDA_BETA; VECTOR_ADD_COMPONENT;
3515            VECTOR_MUL_COMPONENT; DIMINDEX_FINITE_SUM;
3516            ARITH_RULE `x <= a ==> x <= a + b:num`;
3517            ARITH_RULE `x <= b ==> x + a <= a + b:num`]);;
3518
3519 let FSTCART_VEC = prove
3520  (`!n. fstcart(vec n) = vec n`,
3521   SIMP_TAC[vec; fstcart; LAMBDA_BETA; CART_EQ; DIMINDEX_FINITE_SUM;
3522            ARITH_RULE `m <= n:num ==> m <= n + p`]);;
3523
3524 let FSTCART_ADD = prove
3525  (`!x:real^(M,N)finite_sum y. fstcart(x + y) = fstcart(x) + fstcart(y)`,
3526   REWRITE_TAC[REWRITE_RULE[linear] LINEAR_FSTCART]);;
3527
3528 let FSTCART_CMUL = prove
3529  (`!x:real^(M,N)finite_sum c. fstcart(c % x) = c % fstcart(x)`,
3530   REWRITE_TAC[REWRITE_RULE[linear] LINEAR_FSTCART]);;
3531
3532 let FSTCART_NEG = prove
3533  (`!x:real^(M,N)finite_sum. --(fstcart x) = fstcart(--x)`,
3534   ONCE_REWRITE_TAC[VECTOR_ARITH `--x = --(&1) % x`] THEN
3535   REWRITE_TAC[FSTCART_CMUL]);;
3536
3537 let FSTCART_SUB = prove
3538  (`!x:real^(M,N)finite_sum y. fstcart(x - y) = fstcart(x) - fstcart(y)`,
3539   REWRITE_TAC[VECTOR_SUB; FSTCART_NEG; FSTCART_ADD]);;
3540
3541 let FSTCART_VSUM = prove
3542  (`!k x. FINITE k ==> (fstcart(vsum k x) = vsum k (\i. fstcart(x i)))`,
3543   REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN
3544   MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
3545   SIMP_TAC[VSUM_CLAUSES; FINITE_RULES; FSTCART_ADD; FSTCART_VEC]);;
3546
3547 let SNDCART_VEC = prove
3548  (`!n. sndcart(vec n) = vec n`,
3549   SIMP_TAC[vec; sndcart; LAMBDA_BETA; CART_EQ; DIMINDEX_FINITE_SUM;
3550            ARITH_RULE `x <= a ==> x <= a + b:num`;
3551            ARITH_RULE `x <= b ==> x + a <= a + b:num`]);;
3552
3553 let SNDCART_ADD = prove
3554  (`!x:real^(M,N)finite_sum y. sndcart(x + y) = sndcart(x) + sndcart(y)`,
3555   REWRITE_TAC[REWRITE_RULE[linear] LINEAR_SNDCART]);;
3556
3557 let SNDCART_CMUL = prove
3558  (`!x:real^(M,N)finite_sum c. sndcart(c % x) = c % sndcart(x)`,
3559   REWRITE_TAC[REWRITE_RULE[linear] LINEAR_SNDCART]);;
3560
3561 let SNDCART_NEG = prove
3562  (`!x:real^(M,N)finite_sum. --(sndcart x) = sndcart(--x)`,
3563   ONCE_REWRITE_TAC[VECTOR_ARITH `--x = --(&1) % x`] THEN
3564   REWRITE_TAC[SNDCART_CMUL]);;
3565
3566 let SNDCART_SUB = prove
3567  (`!x:real^(M,N)finite_sum y. sndcart(x - y) = sndcart(x) - sndcart(y)`,
3568   REWRITE_TAC[VECTOR_SUB; SNDCART_NEG; SNDCART_ADD]);;
3569
3570 let SNDCART_VSUM = prove
3571  (`!k x. FINITE k ==> (sndcart(vsum k x) = vsum k (\i. sndcart(x i)))`,
3572   REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN
3573   MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
3574   SIMP_TAC[VSUM_CLAUSES; FINITE_RULES; SNDCART_ADD; SNDCART_VEC]);;
3575
3576 let PASTECART_VEC = prove
3577  (`!n. pastecart (vec n) (vec n) = vec n`,
3578   REWRITE_TAC[PASTECART_EQ; FSTCART_VEC; SNDCART_VEC;
3579               FSTCART_PASTECART; SNDCART_PASTECART]);;
3580
3581 let PASTECART_ADD = prove
3582  (`!x1 y1 x2:real^M y2:real^N.
3583      pastecart x1 y1 + pastecart x2 y2 = pastecart (x1 + x2) (y1 + y2)`,
3584   REWRITE_TAC[PASTECART_EQ; FSTCART_ADD; SNDCART_ADD;
3585               FSTCART_PASTECART; SNDCART_PASTECART]);;
3586
3587 let PASTECART_CMUL = prove
3588  (`!x1 y1 c. pastecart (c % x1) (c % y1) = c % pastecart x1 y1`,
3589   REWRITE_TAC[PASTECART_EQ; FSTCART_CMUL; SNDCART_CMUL;
3590               FSTCART_PASTECART; SNDCART_PASTECART]);;
3591
3592 let PASTECART_NEG = prove
3593  (`!x:real^M y:real^N. pastecart (--x) (--y) = --(pastecart x y)`,
3594   ONCE_REWRITE_TAC[VECTOR_ARITH `--x = --(&1) % x`] THEN
3595   REWRITE_TAC[PASTECART_CMUL]);;
3596
3597 let PASTECART_SUB = prove
3598  (`!x1 y1 x2:real^M y2:real^N.
3599      pastecart x1 y1 - pastecart x2 y2 = pastecart (x1 - x2) (y1 - y2)`,
3600   REWRITE_TAC[VECTOR_SUB; GSYM PASTECART_NEG; PASTECART_ADD]);;
3601
3602 let PASTECART_VSUM = prove
3603  (`!k x y. FINITE k ==> (pastecart (vsum k x) (vsum k y) =
3604                          vsum k (\i. pastecart (x i) (y i)))`,
3605   SIMP_TAC[PASTECART_EQ; FSTCART_VSUM; SNDCART_VSUM;
3606            FSTCART_PASTECART; SNDCART_PASTECART; ETA_AX]);;
3607
3608 let PASTECART_EQ_VEC = prove
3609  (`!x y n. pastecart x y = vec n <=> x = vec n /\ y = vec n`,
3610   REWRITE_TAC[PASTECART_EQ; FSTCART_VEC; SNDCART_VEC;
3611               FSTCART_PASTECART; SNDCART_PASTECART]);;
3612
3613 let NORM_FSTCART = prove
3614  (`!x. norm(fstcart x) <= norm x`,
3615   GEN_TAC THEN
3616   GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM PASTECART_FST_SND] THEN
3617   SIMP_TAC[SQRT_MONO_LE_EQ; DOT_POS_LE; vector_norm] THEN
3618   SIMP_TAC[pastecart; dot; DIMINDEX_FINITE_SUM; LAMBDA_BETA; DIMINDEX_NONZERO;
3619            SUM_ADD_SPLIT; REAL_LE_ADDR; SUM_POS_LE; FINITE_NUMSEG;
3620            REAL_LE_SQUARE; ARITH_RULE `x <= a ==> x <= a + b:num`;
3621            ARITH_RULE `~(d = 0) ==> 1 <= d + 1`]);;
3622
3623 let DIST_FSTCART = prove
3624  (`!x y. dist(fstcart x,fstcart y) <= dist(x,y)`,
3625   REWRITE_TAC[dist; GSYM FSTCART_SUB; NORM_FSTCART]);;
3626
3627 let NORM_SNDCART = prove
3628  (`!x. norm(sndcart x) <= norm x`,
3629   GEN_TAC THEN
3630   GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM PASTECART_FST_SND] THEN
3631   SIMP_TAC[SQRT_MONO_LE_EQ; DOT_POS_LE; vector_norm] THEN
3632   SIMP_TAC[pastecart; dot; DIMINDEX_FINITE_SUM; LAMBDA_BETA; DIMINDEX_NONZERO;
3633            SUM_ADD_SPLIT; ARITH_RULE `x <= a ==> x <= a + b:num`;
3634            ARITH_RULE `~(d = 0) ==> 1 <= d + 1`] THEN
3635   ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[NUMSEG_OFFSET_IMAGE] THEN
3636   SIMP_TAC[SUM_IMAGE; FINITE_NUMSEG; EQ_ADD_RCANCEL; o_DEF; ADD_SUB] THEN
3637   SIMP_TAC[ARITH_RULE `1 <= x ==> ~(x + a <= a)`; SUM_POS_LE; FINITE_NUMSEG;
3638            REAL_LE_ADDL; REAL_LE_SQUARE]);;
3639
3640 let DIST_SNDCART = prove
3641  (`!x y. dist(sndcart x,sndcart y) <= dist(x,y)`,
3642   REWRITE_TAC[dist; GSYM SNDCART_SUB; NORM_SNDCART]);;
3643
3644 let DOT_PASTECART = prove
3645  (`!x1 x2 y1 y2. (pastecart x1 x2) dot (pastecart y1 y2) =
3646                 x1 dot y1 + x2 dot y2`,
3647   SIMP_TAC[pastecart; dot; LAMBDA_BETA; DIMINDEX_FINITE_SUM] THEN
3648   SIMP_TAC[SUM_ADD_SPLIT; ARITH_RULE `~(d = 0) ==> 1 <= d + 1`;
3649            DIMINDEX_NONZERO; REAL_LE_LADD] THEN
3650   ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[NUMSEG_OFFSET_IMAGE] THEN
3651   SIMP_TAC[SUM_IMAGE; FINITE_NUMSEG; EQ_ADD_RCANCEL; o_DEF; ADD_SUB] THEN
3652   SIMP_TAC[ARITH_RULE `1 <= x ==> ~(x + a <= a)`; REAL_LE_REFL]);;
3653
3654 let SQNORM_PASTECART = prove
3655  (`!x y. norm(pastecart x y) pow 2 = norm(x) pow 2 + norm(y) pow 2`,
3656   REWRITE_TAC[NORM_POW_2; DOT_PASTECART]);;
3657
3658 let NORM_PASTECART = prove
3659  (`!x y. norm(pastecart x y) = sqrt(norm(x) pow 2 + norm(y) pow 2)`,
3660   REWRITE_TAC[NORM_EQ_SQUARE] THEN
3661   SIMP_TAC[SQRT_POS_LE; SQRT_POW_2; REAL_LE_ADD; REAL_LE_POW_2] THEN
3662   REWRITE_TAC[DOT_PASTECART; NORM_POW_2]);;
3663
3664 let NORM_PASTECART_LE = prove
3665  (`!x y. norm(pastecart x y) <= norm(x) + norm(y)`,
3666   REPEAT GEN_TAC THEN MATCH_MP_TAC TRIANGLE_LEMMA THEN
3667   REWRITE_TAC[NORM_POS_LE; NORM_POW_2; DOT_PASTECART; REAL_LE_REFL]);;
3668
3669 let NORM_LE_PASTECART = prove
3670  (`!x:real^M y:real^N.
3671     norm(x) <= norm(pastecart x y) /\
3672     norm(y) <= norm(pastecart x y)`,
3673   REPEAT GEN_TAC THEN REWRITE_TAC[NORM_PASTECART] THEN CONJ_TAC THEN
3674   MATCH_MP_TAC REAL_LE_RSQRT THEN
3675   REWRITE_TAC[REAL_LE_ADDL; REAL_LE_ADDR; REAL_LE_POW_2]);;
3676
3677 let NORM_PASTECART_0 = prove
3678  (`(!x. norm(pastecart x (vec 0)) = norm x) /\
3679    (!y. norm(pastecart (vec 0) y) = norm y)`,
3680   REWRITE_TAC[NORM_EQ_SQUARE; NORM_POW_2; NORM_POS_LE] THEN
3681   REWRITE_TAC[DOT_PASTECART; DOT_LZERO; REAL_ADD_LID; REAL_ADD_RID]);;
3682
3683 let DIST_PASTECART_CANCEL = prove
3684  (`(!x x' y. dist(pastecart x y,pastecart x' y) = dist(x,x')) /\
3685    (!x y y'. dist(pastecart x y,pastecart x y') = dist(y,y'))`,
3686   REWRITE_TAC[dist; PASTECART_SUB; VECTOR_SUB_REFL; NORM_PASTECART_0]);;
3687
3688 let LINEAR_PASTECART = prove
3689  (`!f:real^M->real^N g:real^M->real^P.
3690         linear f /\ linear g ==> linear (\x. pastecart (f x) (g x))`,
3691   SIMP_TAC[linear; PASTECART_ADD; GSYM PASTECART_CMUL]);;
3692
3693 (* ------------------------------------------------------------------------- *)
3694 (* A bit of linear algebra.                                                  *)
3695 (* ------------------------------------------------------------------------- *)
3696
3697 let subspace = new_definition
3698  `subspace s <=>
3699         vec(0) IN s /\
3700         (!x y. x IN s /\ y IN s ==> (x + y) IN s) /\
3701         (!c x. x IN s ==> (c % x) IN s)`;;
3702
3703 let span = new_definition
3704   `span s = subspace hull s`;;
3705
3706 let dependent = new_definition
3707  `dependent s <=> ?a. a IN s /\ a IN span(s DELETE a)`;;
3708
3709 let independent = new_definition
3710  `independent s <=> ~(dependent s)`;;
3711
3712 (* ------------------------------------------------------------------------- *)
3713 (* Closure properties of subspaces.                                          *)
3714 (* ------------------------------------------------------------------------- *)
3715
3716 let SUBSPACE_UNIV = prove
3717  (`subspace(UNIV:real^N->bool)`,
3718   REWRITE_TAC[subspace; IN_UNIV]);;
3719
3720 let SUBSPACE_IMP_NONEMPTY = prove
3721  (`!s. subspace s ==> ~(s = {})`,
3722   REWRITE_TAC[subspace] THEN SET_TAC[]);;
3723
3724 let SUBSPACE_0 = prove
3725  (`subspace s ==> vec(0) IN s`,
3726   SIMP_TAC[subspace]);;
3727
3728 let SUBSPACE_ADD = prove
3729  (`!x y s. subspace s /\ x IN s /\ y IN s ==> (x + y) IN s`,
3730   SIMP_TAC[subspace]);;
3731
3732 let SUBSPACE_MUL = prove
3733  (`!x c s. subspace s /\ x IN s ==> (c % x) IN s`,
3734   SIMP_TAC[subspace]);;
3735
3736 let SUBSPACE_NEG = prove
3737  (`!x s. subspace s /\ x IN s ==> (--x) IN s`,
3738   SIMP_TAC[VECTOR_ARITH `--x = --(&1) % x`; SUBSPACE_MUL]);;
3739
3740 let SUBSPACE_SUB = prove
3741  (`!x y s. subspace s /\ x IN s /\ y IN s ==> (x - y) IN s`,
3742   SIMP_TAC[VECTOR_SUB; SUBSPACE_ADD; SUBSPACE_NEG]);;
3743
3744 let SUBSPACE_VSUM = prove
3745  (`!s f t. subspace s /\ FINITE t /\ (!x. x IN t ==> f(x) IN s)
3746            ==> (vsum t f) IN s`,
3747   REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
3748   GEN_TAC THEN DISCH_TAC THEN GEN_TAC THEN
3749   MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
3750   ASM_SIMP_TAC[VSUM_CLAUSES; SUBSPACE_0; IN_INSERT; SUBSPACE_ADD]);;
3751
3752 let SUBSPACE_LINEAR_IMAGE = prove
3753  (`!f s. linear f /\ subspace s ==> subspace(IMAGE f s)`,
3754   REWRITE_TAC[subspace; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
3755   REWRITE_TAC[FORALL_IN_IMAGE] THEN REWRITE_TAC[IN_IMAGE] THEN
3756   MESON_TAC[linear; LINEAR_0]);;
3757
3758 let SUBSPACE_LINEAR_PREIMAGE = prove
3759  (`!f s. linear f /\ subspace s ==> subspace {x | f(x) IN s}`,
3760   REWRITE_TAC[subspace; IN_ELIM_THM] THEN
3761   MESON_TAC[linear; LINEAR_0]);;
3762
3763 let SUBSPACE_TRIVIAL = prove
3764  (`subspace {vec 0}`,
3765   SIMP_TAC[subspace; IN_SING] THEN CONJ_TAC THEN VECTOR_ARITH_TAC);;
3766
3767 let SUBSPACE_INTER = prove
3768  (`!s t. subspace s /\ subspace t ==> subspace (s INTER t)`,
3769   REWRITE_TAC[subspace; IN_INTER] THEN MESON_TAC[]);;
3770
3771 let SUBSPACE_INTERS = prove
3772  (`!f. (!s. s IN f ==> subspace s) ==> subspace(INTERS f)`,
3773   SIMP_TAC[subspace; IMP_CONJ; RIGHT_FORALL_IMP_THM; IN_INTERS]);;
3774
3775 let LINEAR_INJECTIVE_0_SUBSPACE = prove
3776  (`!f:real^M->real^N s.
3777         linear f /\ subspace s
3778          ==> ((!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) <=>
3779               (!x. x IN s /\ f x = vec 0 ==> x = vec 0))`,
3780   REPEAT STRIP_TAC THEN
3781   GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [GSYM VECTOR_SUB_EQ] THEN
3782   ASM_SIMP_TAC[GSYM LINEAR_SUB] THEN
3783   ASM_MESON_TAC[VECTOR_SUB_RZERO; SUBSPACE_SUB; SUBSPACE_0]);;
3784
3785 let SUBSPACE_UNION_CHAIN = prove
3786  (`!s t:real^N->bool.
3787         subspace s /\ subspace t /\ subspace(s UNION t)
3788          ==> s SUBSET t \/ t SUBSET s`,
3789   REPEAT STRIP_TAC THEN REWRITE_TAC[SET_RULE
3790    `s SUBSET t \/ t SUBSET s <=>
3791     ~(?x y. x IN s /\ ~(x IN t) /\ y IN t /\ ~(y IN s))`] THEN
3792   STRIP_TAC THEN SUBGOAL_THEN `(x + y:real^N) IN s UNION t` MP_TAC THENL
3793    [MATCH_MP_TAC SUBSPACE_ADD THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[];
3794     REWRITE_TAC[IN_UNION; DE_MORGAN_THM] THEN
3795     ASM_MESON_TAC[SUBSPACE_SUB; VECTOR_ARITH
3796      `(x + y) - x:real^N = y /\ (x + y) - y = x`]]);;
3797
3798 let SUBSPACE_PCROSS = prove
3799  (`!s:real^M->bool t:real^N->bool.
3800         subspace s /\ subspace t ==> subspace(s PCROSS t)`,
3801   REWRITE_TAC[subspace; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
3802   REWRITE_TAC[FORALL_IN_PCROSS; GSYM PASTECART_CMUL; PASTECART_ADD] THEN
3803   REWRITE_TAC[GSYM PASTECART_VEC; PASTECART_IN_PCROSS] THEN SIMP_TAC[]);;
3804
3805 let SUBSPACE_PCROSS_EQ = prove
3806  (`!s:real^M->bool t:real^N->bool.
3807         subspace(s PCROSS t) <=> subspace s /\ subspace t`,
3808   REPEAT GEN_TAC THEN
3809   ASM_CASES_TAC `s:real^M->bool = {}` THENL
3810    [ASM_MESON_TAC[PCROSS_EMPTY; SUBSPACE_IMP_NONEMPTY]; ALL_TAC] THEN
3811   ASM_CASES_TAC `t:real^N->bool = {}` THENL
3812    [ASM_MESON_TAC[PCROSS_EMPTY; SUBSPACE_IMP_NONEMPTY]; ALL_TAC] THEN
3813   EQ_TAC THEN REWRITE_TAC[SUBSPACE_PCROSS] THEN REPEAT STRIP_TAC THENL
3814    [MP_TAC(ISPECL [`fstcart:real^(M,N)finite_sum->real^M`;
3815      `(s:real^M->bool) PCROSS (t:real^N->bool)`] SUBSPACE_LINEAR_IMAGE) THEN
3816     ASM_REWRITE_TAC[LINEAR_FSTCART];
3817     MP_TAC(ISPECL [`sndcart:real^(M,N)finite_sum->real^N`;
3818      `(s:real^M->bool) PCROSS (t:real^N->bool)`] SUBSPACE_LINEAR_IMAGE) THEN
3819     ASM_REWRITE_TAC[LINEAR_SNDCART]] THEN
3820   MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN
3821   REWRITE_TAC[EXTENSION; IN_IMAGE; EXISTS_PASTECART; PASTECART_IN_PCROSS;
3822               FSTCART_PASTECART; SNDCART_PASTECART] THEN
3823   ASM SET_TAC[]);;
3824
3825 (* ------------------------------------------------------------------------- *)
3826 (* Lemmas.                                                                   *)
3827 (* ------------------------------------------------------------------------- *)
3828
3829 let SPAN_SPAN = prove
3830  (`!s. span(span s) = span s`,
3831   REWRITE_TAC[span; HULL_HULL]);;
3832
3833 let SPAN_MONO = prove
3834  (`!s t. s SUBSET t ==> span s SUBSET span t`,
3835   REWRITE_TAC[span; HULL_MONO]);;
3836
3837 let SUBSPACE_SPAN = prove
3838  (`!s. subspace(span s)`,
3839   GEN_TAC THEN REWRITE_TAC[span] THEN MATCH_MP_TAC P_HULL THEN
3840   SIMP_TAC[subspace; IN_INTERS]);;
3841
3842 let SPAN_CLAUSES = prove
3843  (`(!a s. a IN s ==> a IN span s) /\
3844    (vec(0) IN span s) /\
3845    (!x y s. x IN span s /\ y IN span s ==> (x + y) IN span s) /\
3846    (!x c s. x IN span s ==> (c % x) IN span s)`,
3847   MESON_TAC[span; HULL_SUBSET; SUBSET; SUBSPACE_SPAN; subspace]);;
3848
3849 let SPAN_INDUCT = prove
3850  (`!s h. (!x. x IN s ==> x IN h) /\ subspace h ==> !x. x IN span(s) ==> h(x)`,
3851   REWRITE_TAC[span] THEN MESON_TAC[SUBSET; HULL_MINIMAL; IN]);;
3852
3853 let SPAN_EMPTY = prove
3854  (`span {} = {vec 0}`,
3855   REWRITE_TAC[span] THEN MATCH_MP_TAC HULL_UNIQUE THEN
3856   SIMP_TAC[subspace; SUBSET; IN_SING; NOT_IN_EMPTY] THEN
3857   REPEAT STRIP_TAC THEN VECTOR_ARITH_TAC);;
3858
3859 let INDEPENDENT_EMPTY = prove
3860  (`independent {}`,
3861   REWRITE_TAC[independent; dependent; NOT_IN_EMPTY]);;
3862
3863 let INDEPENDENT_NONZERO = prove
3864  (`!s. independent s ==> ~(vec 0 IN s)`,
3865   REWRITE_TAC[independent; dependent] THEN MESON_TAC[SPAN_CLAUSES]);;
3866
3867 let INDEPENDENT_MONO = prove
3868  (`!s t. independent t /\ s SUBSET t ==> independent s`,
3869   REWRITE_TAC[independent; dependent] THEN
3870   ASM_MESON_TAC[SPAN_MONO; SUBSET; IN_DELETE]);;
3871
3872 let DEPENDENT_MONO = prove
3873  (`!s t:real^N->bool. dependent s /\ s SUBSET t ==> dependent t`,
3874   ONCE_REWRITE_TAC[TAUT `p /\ q ==> r <=> ~r /\ q ==> ~p`] THEN
3875   REWRITE_TAC[GSYM independent; INDEPENDENT_MONO]);;
3876
3877 let SPAN_SUBSPACE = prove
3878  (`!b s. b SUBSET s /\ s SUBSET (span b) /\ subspace s ==> (span b = s)`,
3879   MESON_TAC[SUBSET_ANTISYM; span; HULL_MINIMAL]);;
3880
3881 let SPAN_INDUCT_ALT = prove
3882  (`!s h. h(vec 0) /\
3883          (!c x y. x IN s /\ h(y) ==> h(c % x + y))
3884           ==> !x:real^N. x IN span(s) ==> h(x)`,
3885   REPEAT GEN_TAC THEN DISCH_TAC THEN
3886   FIRST_ASSUM(MP_TAC o prove_inductive_relations_exist o concl) THEN
3887   DISCH_THEN(X_CHOOSE_THEN `g:real^N->bool` STRIP_ASSUME_TAC) THEN
3888   SUBGOAL_THEN `!x:real^N. x IN span(s) ==> g(x)`
3889    (fun th -> ASM_MESON_TAC[th]) THEN
3890   MATCH_MP_TAC SPAN_INDUCT THEN REWRITE_TAC[subspace; IN_ELIM_THM] THEN
3891   REWRITE_TAC[IN; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
3892   ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN
3893   REPEAT CONJ_TAC THEN TRY(FIRST_X_ASSUM MATCH_MP_TAC) THEN
3894   REWRITE_TAC[VECTOR_ADD_LDISTRIB; VECTOR_MUL_ASSOC] THEN
3895   ASM_MESON_TAC[IN; VECTOR_ADD_LID; VECTOR_ADD_ASSOC; VECTOR_ADD_SYM;
3896                 VECTOR_MUL_LID; VECTOR_MUL_RZERO]);;
3897
3898 (* ------------------------------------------------------------------------- *)
3899 (* Individual closure properties.                                            *)
3900 (* ------------------------------------------------------------------------- *)
3901
3902 let SPAN_SUPERSET = prove
3903  (`!x. x IN s ==> x IN span s`,
3904   MESON_TAC[SPAN_CLAUSES]);;
3905
3906 let SPAN_INC = prove
3907  (`!s. s SUBSET span s`,
3908   REWRITE_TAC[SUBSET; SPAN_SUPERSET]);;
3909
3910 let SPAN_UNION_SUBSET = prove
3911  (`!s t. span s UNION span t SUBSET span(s UNION t)`,
3912   REWRITE_TAC[span; HULL_UNION_SUBSET]);;
3913
3914 let SPAN_UNIV = prove
3915  (`span(:real^N) = (:real^N)`,
3916   SIMP_TAC[SPAN_INC; SET_RULE `UNIV SUBSET s ==> s = UNIV`]);;
3917
3918 let SPAN_0 = prove
3919  (`vec(0) IN span s`,
3920   MESON_TAC[SUBSPACE_SPAN; SUBSPACE_0]);;
3921
3922 let SPAN_ADD = prove
3923  (`!x y s. x IN span s /\ y IN span s ==> (x + y) IN span s`,
3924   MESON_TAC[SUBSPACE_SPAN; SUBSPACE_ADD]);;
3925
3926 let SPAN_MUL = prove
3927  (`!x c s. x IN span s ==> (c % x) IN span s`,
3928   MESON_TAC[SUBSPACE_SPAN; SUBSPACE_MUL]);;
3929
3930 let SPAN_MUL_EQ = prove
3931  (`!x:real^N c s. ~(c = &0) ==> ((c % x) IN span s <=> x IN span s)`,
3932   REPEAT(STRIP_TAC ORELSE EQ_TAC) THEN ASM_SIMP_TAC[SPAN_MUL] THEN
3933   SUBGOAL_THEN `(inv(c) % c % x:real^N) IN span s` MP_TAC THENL
3934    [ASM_SIMP_TAC[SPAN_MUL];
3935     ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LINV; VECTOR_MUL_LID]]);;
3936
3937 let SPAN_NEG = prove
3938  (`!x s. x IN span s ==> (--x) IN span s`,
3939   MESON_TAC[SUBSPACE_SPAN; SUBSPACE_NEG]);;
3940
3941 let SPAN_NEG_EQ = prove
3942  (`!x s. --x IN span s <=> x IN span s`,
3943   MESON_TAC[SPAN_NEG; VECTOR_NEG_NEG]);;
3944
3945 let SPAN_SUB = prove
3946  (`!x y s. x IN span s /\ y IN span s ==> (x - y) IN span s`,
3947   MESON_TAC[SUBSPACE_SPAN; SUBSPACE_SUB]);;
3948
3949 let SPAN_VSUM = prove
3950  (`!s f t. FINITE t /\ (!x. x IN t ==> f(x) IN span(s))
3951            ==> (vsum t f) IN span(s)`,
3952   MESON_TAC[SUBSPACE_SPAN; SUBSPACE_VSUM]);;
3953
3954 let SPAN_ADD_EQ = prove
3955  (`!s x y. x IN span s ==> ((x + y) IN span s <=> y IN span s)`,
3956   MESON_TAC[SPAN_ADD; SPAN_SUB; VECTOR_ARITH `(x + y) - x:real^N = y`]);;
3957
3958 let SPAN_EQ_SELF = prove
3959  (`!s. span s = s <=> subspace s`,
3960   GEN_TAC THEN EQ_TAC THENL [MESON_TAC[SUBSPACE_SPAN]; ALL_TAC] THEN
3961   DISCH_TAC THEN MATCH_MP_TAC SPAN_SUBSPACE THEN
3962   ASM_REWRITE_TAC[SUBSET_REFL; SPAN_INC]);;
3963
3964 let SPAN_OF_SUBSPACE = prove
3965  (`!s:real^N->bool. subspace s ==> span s = s`,
3966   REWRITE_TAC[SPAN_EQ_SELF]);;
3967
3968 let SPAN_SUBSET_SUBSPACE = prove
3969  (`!s t:real^N->bool. s SUBSET t /\ subspace t ==> span s SUBSET t`,
3970   MESON_TAC[SPAN_MONO; SPAN_EQ_SELF]);;
3971
3972 let SUBSPACE_TRANSLATION_SELF = prove
3973  (`!s a. subspace s /\ a IN s ==> IMAGE (\x. a + x) s = s`,
3974   REPEAT STRIP_TAC THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN
3975   FIRST_ASSUM(SUBST1_TAC o SYM o GEN_REWRITE_RULE I [GSYM SPAN_EQ_SELF]) THEN
3976   ASM_SIMP_TAC[SPAN_ADD_EQ; SPAN_CLAUSES] THEN
3977   REWRITE_TAC[VECTOR_ARITH `a + x:real^N = y <=> x = y - a`; EXISTS_REFL]);;
3978
3979 let SUBSPACE_TRANSLATION_SELF_EQ = prove
3980  (`!s a:real^N. subspace s ==> (IMAGE (\x. a + x) s = s <=> a IN s)`,
3981   REPEAT STRIP_TAC THEN EQ_TAC THEN
3982   ASM_SIMP_TAC[SUBSPACE_TRANSLATION_SELF] THEN
3983   DISCH_THEN(MP_TAC o AP_TERM `\s. (a:real^N) IN s`) THEN
3984   REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN
3985   REWRITE_TAC[IN_IMAGE] THEN EXISTS_TAC `vec 0:real^N` THEN
3986   ASM_MESON_TAC[subspace; VECTOR_ADD_RID]);;
3987
3988 let SUBSPACE_SUMS = prove
3989  (`!s t. subspace s /\ subspace t
3990          ==> subspace {x + y | x IN s /\ y IN t}`,
3991   REWRITE_TAC[subspace; FORALL_IN_GSPEC; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
3992   REWRITE_TAC[IN_ELIM_THM] THEN REPEAT STRIP_TAC THENL
3993    [ASM_MESON_TAC[VECTOR_ADD_LID];
3994     ONCE_REWRITE_TAC[VECTOR_ARITH
3995      `(x + y) + (x' + y'):real^N = (x + x') + (y + y')`] THEN
3996     ASM_MESON_TAC[];
3997     REWRITE_TAC[VECTOR_ADD_LDISTRIB] THEN ASM_MESON_TAC[]]);;
3998
3999 let SPAN_UNION = prove
4000  (`!s t. span(s UNION t) = {x + y:real^N | x IN span s /\ y IN span t}`,
4001   REPEAT GEN_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL
4002    [MATCH_MP_TAC SPAN_SUBSET_SUBSPACE THEN
4003     SIMP_TAC[SUBSPACE_SUMS; SUBSPACE_SPAN] THEN
4004     REWRITE_TAC[SUBSET; IN_UNION; IN_ELIM_THM] THEN
4005     X_GEN_TAC `x:real^N` THEN STRIP_TAC THENL
4006      [MAP_EVERY EXISTS_TAC [`x:real^N`; `vec 0:real^N`] THEN
4007       ASM_SIMP_TAC[SPAN_SUPERSET; SPAN_0; VECTOR_ADD_RID];
4008       MAP_EVERY EXISTS_TAC [`vec 0:real^N`; `x:real^N`] THEN
4009       ASM_SIMP_TAC[SPAN_SUPERSET; SPAN_0; VECTOR_ADD_LID]];
4010     REWRITE_TAC[SUBSET; FORALL_IN_GSPEC] THEN
4011     REPEAT STRIP_TAC THEN MATCH_MP_TAC SPAN_ADD THEN
4012     ASM_MESON_TAC[SPAN_MONO; SUBSET_UNION; SUBSET]]);;
4013
4014 (* ------------------------------------------------------------------------- *)
4015 (* Mapping under linear image.                                               *)
4016 (* ------------------------------------------------------------------------- *)
4017
4018 let SPAN_LINEAR_IMAGE = prove
4019  (`!f:real^M->real^N s. linear f ==> (span(IMAGE f s) = IMAGE f (span s))`,
4020   REPEAT STRIP_TAC THEN GEN_REWRITE_TAC I [EXTENSION] THEN
4021   X_GEN_TAC `x:real^N` THEN EQ_TAC THENL
4022    [SPEC_TAC(`x:real^N`,`x:real^N`) THEN MATCH_MP_TAC SPAN_INDUCT THEN
4023     REWRITE_TAC[SET_RULE `(\x. x IN s) = s`] THEN
4024     ASM_SIMP_TAC[SUBSPACE_SPAN; SUBSPACE_LINEAR_IMAGE] THEN
4025     REWRITE_TAC[FORALL_IN_IMAGE] THEN REWRITE_TAC[IN_IMAGE] THEN
4026     MESON_TAC[SPAN_SUPERSET; SUBSET];
4027     SPEC_TAC(`x:real^N`,`x:real^N`) THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN
4028     MATCH_MP_TAC SPAN_INDUCT THEN
4029     REWRITE_TAC[SET_RULE `(\x. f x IN span(s)) = {x | f(x) IN span s}`] THEN
4030     ASM_SIMP_TAC[SUBSPACE_LINEAR_PREIMAGE; SUBSPACE_SPAN] THEN
4031     REWRITE_TAC[IN_ELIM_THM] THEN
4032     MESON_TAC[SPAN_SUPERSET; SUBSET; IN_IMAGE]]);;
4033
4034 let DEPENDENT_LINEAR_IMAGE_EQ = prove
4035  (`!f:real^M->real^N s.
4036         linear f /\ (!x y. f x = f y ==> x = y)
4037         ==> (dependent(IMAGE f s) <=> dependent s)`,
4038   REPEAT STRIP_TAC THEN REWRITE_TAC[dependent; EXISTS_IN_IMAGE] THEN
4039   AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `a:real^M` THEN
4040   ASM_CASES_TAC `(a:real^M) IN s` THEN ASM_REWRITE_TAC[] THEN
4041   MATCH_MP_TAC EQ_TRANS THEN
4042   EXISTS_TAC `(f:real^M->real^N) a IN span(IMAGE f (s DELETE a))` THEN
4043   CONJ_TAC THENL
4044    [AP_TERM_TAC THEN AP_TERM_TAC THEN ASM SET_TAC[];
4045     ASM_SIMP_TAC[SPAN_LINEAR_IMAGE] THEN ASM SET_TAC[]]);;
4046
4047 let DEPENDENT_LINEAR_IMAGE = prove
4048  (`!f:real^M->real^N s.
4049         linear f /\ (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) /\
4050         dependent(s)
4051         ==> dependent(IMAGE f s)`,
4052   REPEAT GEN_TAC THEN
4053   REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
4054   REWRITE_TAC[dependent; EXISTS_IN_IMAGE] THEN
4055   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real^M` THEN
4056   STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
4057   SUBGOAL_THEN `IMAGE (f:real^M->real^N) s DELETE f a = IMAGE f (s DELETE a)`
4058    (fun th -> ASM_SIMP_TAC[FUN_IN_IMAGE; SPAN_LINEAR_IMAGE; th]) THEN
4059   ASM SET_TAC[]);;
4060
4061 let INDEPENDENT_LINEAR_IMAGE_EQ = prove
4062  (`!f:real^M->real^N s.
4063         linear f /\ (!x y. f x = f y ==> x = y)
4064         ==> (independent(IMAGE f s) <=> independent s)`,
4065   REWRITE_TAC[independent; TAUT `(~p <=> ~q) <=> (p <=> q)`] THEN
4066   REWRITE_TAC[DEPENDENT_LINEAR_IMAGE_EQ]);;
4067
4068 (* ------------------------------------------------------------------------- *)
4069 (* The key breakdown property.                                               *)
4070 (* ------------------------------------------------------------------------- *)
4071
4072 let SPAN_BREAKDOWN = prove
4073  (`!b s a:real^N.
4074       b IN s /\ a IN span s ==> ?k. (a - k % b) IN span(s DELETE b)`,
4075   REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
4076   REPEAT GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC SPAN_INDUCT THEN
4077   REWRITE_TAC[subspace; IN_ELIM_THM] THEN CONJ_TAC THENL
4078    [GEN_TAC THEN DISCH_TAC THEN ASM_CASES_TAC `a:real^N = b`; ALL_TAC] THEN
4079   ASM_MESON_TAC[SPAN_CLAUSES; IN_DELETE; VECTOR_ARITH
4080    `(a - &1 % a = vec 0) /\ (a - &0 % b = a) /\
4081     ((x + y) - (k1 + k2) % b = (x - k1 % b) + (y - k2 % b)) /\
4082     (c % x - (c * k) % y = c % (x - k % y))`]);;
4083
4084 let SPAN_BREAKDOWN_EQ = prove
4085  (`!a:real^N s. (x IN span(a INSERT s) <=> (?k. (x - k % a) IN span s))`,
4086   REPEAT STRIP_TAC THEN EQ_TAC THENL
4087    [DISCH_THEN(MP_TAC o CONJ(SET_RULE `(a:real^N) IN (a INSERT s)`)) THEN
4088     DISCH_THEN(MP_TAC o MATCH_MP SPAN_BREAKDOWN) THEN
4089     MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:real` THEN
4090     SPEC_TAC(`x - k % a:real^N`,`y:real^N`) THEN
4091     REWRITE_TAC[GSYM SUBSET] THEN MATCH_MP_TAC SPAN_MONO THEN SET_TAC[];
4092     DISCH_THEN(X_CHOOSE_TAC `k:real`) THEN
4093     SUBST1_TAC(VECTOR_ARITH `x = (x - k % a) + k % a:real^N`) THEN
4094     MATCH_MP_TAC SPAN_ADD THEN
4095     ASM_MESON_TAC[SPAN_MONO; SUBSET; IN_INSERT; SPAN_CLAUSES]]);;
4096
4097 let SPAN_INSERT_0 = prove
4098  (`!s. span(vec 0 INSERT s) = span s`,
4099   SIMP_TAC[EXTENSION; SPAN_BREAKDOWN_EQ; VECTOR_MUL_RZERO; VECTOR_SUB_RZERO]);;
4100
4101 let SPAN_SING = prove
4102  (`!a. span {a} = {u % a | u IN (:real)}`,
4103   REWRITE_TAC[EXTENSION; IN_ELIM_THM; SPAN_BREAKDOWN_EQ; SPAN_EMPTY] THEN
4104   REWRITE_TAC[IN_UNIV; IN_SING; VECTOR_SUB_EQ]);;
4105
4106 let SPAN_2 = prove
4107  (`!a b. span {a,b} = {u % a + v % b | u IN (:real) /\ v IN (:real)}`,
4108   REWRITE_TAC[EXTENSION; IN_ELIM_THM; SPAN_BREAKDOWN_EQ; SPAN_EMPTY] THEN
4109   REWRITE_TAC[IN_UNIV; IN_SING; VECTOR_SUB_EQ] THEN
4110   REWRITE_TAC[VECTOR_ARITH `x - y:real^N = z <=> x = y + z`]);;
4111
4112 let SPAN_3 = prove
4113  (`!a b c. span {a,b,c} =
4114       {u % a + v % b + w % c | u IN (:real) /\ v IN (:real) /\ w IN (:real)}`,
4115   REWRITE_TAC[EXTENSION; IN_ELIM_THM; SPAN_BREAKDOWN_EQ; SPAN_EMPTY] THEN
4116   REWRITE_TAC[IN_UNIV; IN_SING; VECTOR_SUB_EQ] THEN
4117   REWRITE_TAC[VECTOR_ARITH `x - y:real^N = z <=> x = y + z`]);;
4118
4119 (* ------------------------------------------------------------------------- *)
4120 (* Hence some "reversal" results.                                            *)
4121 (* ------------------------------------------------------------------------- *)
4122
4123 let IN_SPAN_INSERT = prove
4124  (`!a b:real^N s.
4125         a IN span(b INSERT s) /\ ~(a IN span s) ==> b IN span(a INSERT s)`,
4126   REPEAT STRIP_TAC THEN
4127   MP_TAC(ISPECL [`b:real^N`; `(b:real^N) INSERT s`; `a:real^N`]
4128     SPAN_BREAKDOWN) THEN ASM_REWRITE_TAC[IN_INSERT] THEN
4129   DISCH_THEN(X_CHOOSE_THEN `k:real` MP_TAC) THEN ASM_CASES_TAC `k = &0` THEN
4130   ASM_REWRITE_TAC[VECTOR_ARITH `a - &0 % b = a`; DELETE_INSERT] THENL
4131    [ASM_MESON_TAC[SPAN_MONO; SUBSET; DELETE_SUBSET]; ALL_TAC] THEN
4132   DISCH_THEN(MP_TAC o SPEC `inv(k)` o MATCH_MP SPAN_MUL) THEN
4133   ASM_SIMP_TAC[VECTOR_SUB_LDISTRIB; VECTOR_MUL_ASSOC; REAL_MUL_LINV] THEN
4134   DISCH_TAC THEN SUBST1_TAC(VECTOR_ARITH
4135    `b:real^N = inv(k) % a - (inv(k) % a - &1 % b)`) THEN
4136   MATCH_MP_TAC SPAN_SUB THEN
4137   ASM_MESON_TAC[SPAN_CLAUSES; IN_INSERT; SUBSET; IN_DELETE; SPAN_MONO]);;
4138
4139 let IN_SPAN_DELETE = prove
4140  (`!a b s.
4141          a IN span s /\ ~(a IN span (s DELETE b))
4142          ==> b IN span (a INSERT (s DELETE b))`,
4143   ASM_MESON_TAC[IN_SPAN_INSERT; SPAN_MONO; SUBSET; IN_INSERT; IN_DELETE]);;
4144
4145 let EQ_SPAN_INSERT_EQ = prove
4146  (`!s x y:real^N. (x - y) IN span s ==> span(x INSERT s) = span(y INSERT s)`,
4147   REPEAT STRIP_TAC THEN REWRITE_TAC[SPAN_BREAKDOWN_EQ; EXTENSION] THEN
4148   ASM_MESON_TAC[SPAN_ADD; SPAN_SUB; SPAN_MUL;
4149                 VECTOR_ARITH `(z - k % y) - k % (x - y) = z - k % x`;
4150                 VECTOR_ARITH `(z - k % x) + k % (x - y) = z - k % y`]);;
4151
4152 (* ------------------------------------------------------------------------- *)
4153 (* Transitivity property.                                                    *)
4154 (* ------------------------------------------------------------------------- *)
4155
4156 let SPAN_TRANS = prove
4157  (`!x y:real^N s. x IN span(s) /\ y IN span(x INSERT s) ==> y IN span(s)`,
4158   REPEAT STRIP_TAC THEN
4159   MP_TAC(SPECL [`x:real^N`; `(x:real^N) INSERT s`; `y:real^N`]
4160          SPAN_BREAKDOWN) THEN
4161   ASM_REWRITE_TAC[IN_INSERT] THEN
4162   DISCH_THEN(X_CHOOSE_THEN `k:real` STRIP_ASSUME_TAC) THEN
4163   SUBST1_TAC(VECTOR_ARITH `y:real^N = (y - k % x) + k % x`) THEN
4164   MATCH_MP_TAC SPAN_ADD THEN ASM_SIMP_TAC[SPAN_MUL] THEN
4165   ASM_MESON_TAC[SPAN_MONO; SUBSET; IN_INSERT; IN_DELETE]);;
4166
4167 (* ------------------------------------------------------------------------- *)
4168 (* An explicit expansion is sometimes needed.                                *)
4169 (* ------------------------------------------------------------------------- *)
4170
4171 let SPAN_EXPLICIT = prove
4172  (`!(p:real^N -> bool).
4173         span p =
4174          {y | ?s u. FINITE s /\ s SUBSET p /\
4175                     vsum s (\v. u v % v) = y}`,
4176   GEN_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL
4177    [ALL_TAC;
4178     REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN
4179     REPEAT STRIP_TAC THEN FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN
4180     MATCH_MP_TAC SPAN_VSUM THEN ASM_REWRITE_TAC[] THEN
4181     ASM_MESON_TAC[SPAN_SUPERSET; SPAN_MUL]] THEN
4182   REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN
4183   MATCH_MP_TAC SPAN_INDUCT_ALT THEN CONJ_TAC THENL
4184    [EXISTS_TAC `{}:real^N->bool` THEN
4185     REWRITE_TAC[FINITE_RULES; VSUM_CLAUSES; EMPTY_SUBSET; NOT_IN_EMPTY];
4186     ALL_TAC] THEN
4187   MAP_EVERY X_GEN_TAC [`c:real`; `x:real^N`; `y:real^N`] THEN
4188   DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
4189   REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
4190   MAP_EVERY X_GEN_TAC [`s:real^N->bool`; `u:real^N->real`] THEN
4191   STRIP_TAC THEN EXISTS_TAC `(x:real^N) INSERT s` THEN
4192   EXISTS_TAC `\y. if y = x then (if x IN s then (u:real^N->real) y + c else c)
4193                   else u y` THEN
4194   ASM_SIMP_TAC[FINITE_INSERT; IN_INSERT; VSUM_CLAUSES] THEN
4195   CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN
4196   FIRST_X_ASSUM(SUBST_ALL_TAC o SYM) THEN
4197   COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL
4198    [FIRST_X_ASSUM(SUBST1_TAC o MATCH_MP (SET_RULE
4199      `x IN s ==> s = x INSERT (s DELETE x)`)) THEN
4200     ASM_SIMP_TAC[VSUM_CLAUSES; FINITE_INSERT; FINITE_DELETE; IN_DELETE] THEN
4201     MATCH_MP_TAC(VECTOR_ARITH
4202       `y = z ==> (c + d) % x + y = d % x + c % x + z`);
4203     AP_TERM_TAC] THEN
4204   MATCH_MP_TAC VSUM_EQ THEN ASM_MESON_TAC[IN_DELETE]);;
4205
4206 let DEPENDENT_EXPLICIT = prove
4207  (`!p. dependent (p:real^N -> bool) <=>
4208                 ?s u. FINITE s /\ s SUBSET p /\
4209                       (?v. v IN s /\ ~(u v = &0)) /\
4210                       vsum s (\v. u v % v) = vec 0`,
4211   GEN_TAC THEN REWRITE_TAC[dependent; SPAN_EXPLICIT; IN_ELIM_THM] THEN
4212   REWRITE_TAC[RIGHT_AND_EXISTS_THM; LEFT_AND_EXISTS_THM] THEN
4213   EQ_TAC THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THENL
4214    [MAP_EVERY X_GEN_TAC [`a:real^N`; `s:real^N->bool`; `u:real^N->real`] THEN
4215     STRIP_TAC THEN MAP_EVERY EXISTS_TAC
4216      [`(a:real^N) INSERT s`;
4217       `\y. if y = a then -- &1 else (u:real^N->real) y`;
4218       `a:real^N`] THEN
4219     ASM_REWRITE_TAC[IN_INSERT; INSERT_SUBSET; FINITE_INSERT] THEN
4220     CONJ_TAC THENL [ASM SET_TAC[]; CONV_TAC REAL_RAT_REDUCE_CONV] THEN
4221     ASM_SIMP_TAC[VSUM_CLAUSES] THEN
4222     COND_CASES_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
4223     REWRITE_TAC[VECTOR_ARITH `-- &1 % a + s = vec 0 <=> a = s`] THEN
4224     FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC LAND_CONV [SYM th]) THEN
4225     MATCH_MP_TAC VSUM_EQ THEN ASM SET_TAC[];
4226     MAP_EVERY X_GEN_TAC [`s:real^N->bool`; `u:real^N->real`; `a:real^N`] THEN
4227     STRIP_TAC THEN MAP_EVERY EXISTS_TAC
4228      [`a:real^N`; `s DELETE (a:real^N)`;
4229       `\i. --((u:real^N->real) i) / (u a)`] THEN
4230     ASM_SIMP_TAC[VSUM_DELETE; FINITE_DELETE] THEN
4231     REPEAT(CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN
4232     REWRITE_TAC[real_div] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
4233     ASM_REWRITE_TAC[VECTOR_MUL_LNEG; GSYM VECTOR_MUL_ASSOC; VSUM_LMUL;
4234                     VSUM_NEG; VECTOR_MUL_RNEG; VECTOR_MUL_RZERO] THEN
4235     ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LINV] THEN VECTOR_ARITH_TAC]);;
4236
4237 let DEPENDENT_FINITE = prove
4238  (`!s:real^N->bool.
4239         FINITE s
4240         ==> (dependent s <=> ?u. (?v. v IN s /\ ~(u v = &0)) /\
4241                                  vsum s (\v. u(v) % v) = vec 0)`,
4242   REPEAT STRIP_TAC THEN REWRITE_TAC[DEPENDENT_EXPLICIT] THEN EQ_TAC THEN
4243   REWRITE_TAC[LEFT_IMP_EXISTS_THM] THENL
4244    [MAP_EVERY X_GEN_TAC [`t:real^N->bool`; `u:real^N->real`] THEN
4245     DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN
4246     EXISTS_TAC `\v:real^N. if v IN t then u(v) else &0` THEN
4247     REWRITE_TAC[] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
4248     ONCE_REWRITE_TAC[COND_RAND] THEN ONCE_REWRITE_TAC[COND_RATOR] THEN
4249     ASM_SIMP_TAC[VECTOR_MUL_LZERO; GSYM VSUM_RESTRICT_SET] THEN
4250     ASM_SIMP_TAC[SET_RULE `t SUBSET s ==> {x | x IN s /\ x IN t} = t`];
4251     GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN ASSUME_TAC) THEN
4252     MAP_EVERY EXISTS_TAC [`s:real^N->bool`; `u:real^N->real`] THEN
4253     ASM_REWRITE_TAC[SUBSET_REFL]]);;
4254
4255 let SPAN_FINITE = prove
4256  (`!s:real^N->bool.
4257         FINITE s ==> span s = {y | ?u. vsum s (\v. u v % v) = y}`,
4258   REPEAT STRIP_TAC THEN REWRITE_TAC[SPAN_EXPLICIT; EXTENSION; IN_ELIM_THM] THEN
4259   X_GEN_TAC `y:real^N` THEN EQ_TAC THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THENL
4260    [MAP_EVERY X_GEN_TAC [`t:real^N->bool`; `u:real^N->real`] THEN
4261     STRIP_TAC THEN FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN
4262     EXISTS_TAC `\x:real^N. if x IN t then u(x) else &0` THEN
4263     REWRITE_TAC[COND_RAND; COND_RATOR; VECTOR_MUL_LZERO] THEN
4264     ASM_SIMP_TAC[GSYM VSUM_RESTRICT_SET] THEN
4265     ASM_SIMP_TAC[SET_RULE `t SUBSET s ==> {x | x IN s /\ x IN t} = t`];
4266     X_GEN_TAC `u:real^N->real` THEN DISCH_THEN(SUBST1_TAC o SYM) THEN
4267     MAP_EVERY EXISTS_TAC [`s:real^N->bool`; `u:real^N->real`] THEN
4268     ASM_REWRITE_TAC[SUBSET_REFL]]);;
4269
4270 (* ------------------------------------------------------------------------- *)
4271 (* Standard bases are a spanning set, and obviously finite.                  *)
4272 (* ------------------------------------------------------------------------- *)
4273
4274 let SPAN_STDBASIS = prove
4275  (`span {basis i :real^N | 1 <= i /\ i <= dimindex(:N)} = UNIV`,
4276   REWRITE_TAC[EXTENSION; IN_UNIV] THEN X_GEN_TAC `x:real^N` THEN
4277   GEN_REWRITE_TAC LAND_CONV [GSYM BASIS_EXPANSION] THEN
4278   MATCH_MP_TAC SPAN_VSUM THEN SIMP_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN
4279   REPEAT STRIP_TAC THEN MATCH_MP_TAC SPAN_MUL THEN
4280   MATCH_MP_TAC SPAN_SUPERSET THEN REWRITE_TAC[IN_ELIM_THM] THEN
4281   ASM_MESON_TAC[]);;
4282
4283 let HAS_SIZE_STDBASIS = prove
4284  (`{basis i :real^N | 1 <= i /\ i <= dimindex(:N)} HAS_SIZE
4285         dimindex(:N)`,
4286   ONCE_REWRITE_TAC[SET_RULE `{f x | P x} = IMAGE f {x | P x}`] THEN
4287   MATCH_MP_TAC HAS_SIZE_IMAGE_INJ THEN
4288   REWRITE_TAC[GSYM numseg; HAS_SIZE_NUMSEG_1; IN_NUMSEG] THEN
4289   MESON_TAC[BASIS_INJ]);;
4290
4291 let FINITE_STDBASIS = prove
4292  (`FINITE {basis i :real^N | 1 <= i /\ i <= dimindex(:N)}`,
4293   MESON_TAC[HAS_SIZE_STDBASIS; HAS_SIZE]);;
4294
4295 let CARD_STDBASIS = prove
4296  (`CARD {basis i :real^N | 1 <= i /\ i <= dimindex(:N)} =
4297         dimindex(:N)`,
4298    MESON_TAC[HAS_SIZE_STDBASIS; HAS_SIZE]);;
4299
4300 let IN_SPAN_IMAGE_BASIS = prove
4301  (`!x:real^N s.
4302         x IN span(IMAGE basis s) <=>
4303           !i. 1 <= i /\ i <= dimindex(:N) /\ ~(i IN s) ==> x$i = &0`,
4304   REPEAT GEN_TAC THEN EQ_TAC THENL
4305    [SPEC_TAC(`x:real^N`,`x:real^N`) THEN MATCH_MP_TAC SPAN_INDUCT THEN
4306     SIMP_TAC[subspace; IN_ELIM_THM; VEC_COMPONENT; VECTOR_ADD_COMPONENT;
4307              VECTOR_MUL_COMPONENT; REAL_MUL_RZERO; REAL_ADD_RID] THEN
4308     SIMP_TAC[FORALL_IN_IMAGE; BASIS_COMPONENT] THEN MESON_TAC[];
4309     DISCH_TAC THEN REWRITE_TAC[SPAN_EXPLICIT; IN_ELIM_THM] THEN
4310     EXISTS_TAC `(IMAGE basis ((1..dimindex(:N)) INTER s)):real^N->bool` THEN
4311     SIMP_TAC[FINITE_IMAGE; FINITE_INTER; FINITE_NUMSEG] THEN
4312     REWRITE_TAC[RIGHT_EXISTS_AND_THM] THEN
4313     CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN
4314     EXISTS_TAC `\v:real^N. x dot v` THEN
4315     W(MP_TAC o PART_MATCH (lhs o rand) VSUM_IMAGE o lhand o snd) THEN
4316     ANTS_TAC THENL
4317      [SIMP_TAC[FINITE_IMAGE; FINITE_INTER; FINITE_NUMSEG] THEN
4318       REWRITE_TAC[IN_INTER; IN_NUMSEG] THEN MESON_TAC[BASIS_INJ];
4319       DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[]] THEN
4320     REWRITE_TAC[o_DEF] THEN
4321     SIMP_TAC[CART_EQ; VSUM_COMPONENT; VECTOR_MUL_COMPONENT;
4322              BASIS_COMPONENT] THEN
4323     ONCE_REWRITE_TAC[COND_RAND] THEN
4324     ONCE_REWRITE_TAC[MESON[]
4325      `(if x = y then p else q) = (if y = x then p else q)`] THEN
4326     SIMP_TAC[SUM_DELTA; REAL_MUL_RZERO; IN_INTER; IN_NUMSEG; DOT_BASIS] THEN
4327     ASM_MESON_TAC[REAL_MUL_RID]]);;
4328
4329 let INDEPENDENT_STDBASIS = prove
4330  (`independent {basis i :real^N | 1 <= i /\ i <= dimindex(:N)}`,
4331   REWRITE_TAC[independent; dependent] THEN
4332   ONCE_REWRITE_TAC[SET_RULE `{f x | P x} = IMAGE f {x | P x}`] THEN
4333   REWRITE_TAC[EXISTS_IN_IMAGE] THEN REWRITE_TAC[IN_ELIM_THM] THEN
4334   DISCH_THEN(X_CHOOSE_THEN `k:num` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
4335   SUBGOAL_THEN
4336    `IMAGE basis {i | 1 <= i /\ i <= dimindex(:N)} DELETE
4337            (basis k:real^N) =
4338     IMAGE basis ({i | 1 <= i /\ i <= dimindex(:N)} DELETE k)`
4339   SUBST1_TAC THENL
4340    [REWRITE_TAC[EXTENSION; IN_IMAGE; IN_DELETE; IN_ELIM_THM] THEN
4341     GEN_TAC THEN EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
4342     ASM_MESON_TAC[BASIS_INJ];
4343     ALL_TAC] THEN
4344   REWRITE_TAC[IN_SPAN_IMAGE_BASIS] THEN DISCH_THEN(MP_TAC o SPEC `k:num`) THEN
4345   ASM_SIMP_TAC[IN_DELETE; BASIS_COMPONENT; REAL_OF_NUM_EQ; ARITH]);;
4346
4347 (* ------------------------------------------------------------------------- *)
4348 (* This is useful for building a basis step-by-step.                         *)
4349 (* ------------------------------------------------------------------------- *)
4350
4351 let INDEPENDENT_INSERT = prove
4352  (`!a:real^N s. independent(a INSERT s) <=>
4353                   if a IN s then independent s
4354                   else independent s /\ ~(a IN span s)`,
4355   REPEAT GEN_TAC THEN ASM_CASES_TAC `(a:real^N) IN s` THEN
4356   ASM_SIMP_TAC[SET_RULE `x IN s ==> (x INSERT s = s)`] THEN
4357   EQ_TAC THENL
4358    [DISCH_TAC THEN CONJ_TAC THENL
4359      [ASM_MESON_TAC[INDEPENDENT_MONO; SUBSET; IN_INSERT];
4360       POP_ASSUM MP_TAC THEN REWRITE_TAC[independent; dependent] THEN
4361       ASM_MESON_TAC[IN_INSERT; SET_RULE
4362         `~(a IN s) ==> ((a INSERT s) DELETE a = s)`]];
4363     ALL_TAC] THEN
4364   REWRITE_TAC[independent; dependent; NOT_EXISTS_THM] THEN
4365   STRIP_TAC THEN X_GEN_TAC `b:real^N` THEN
4366   REWRITE_TAC[IN_INSERT] THEN ASM_CASES_TAC `b:real^N = a` THEN
4367   ASM_SIMP_TAC[SET_RULE `~(a IN s) ==> ((a INSERT s) DELETE a = s)`] THEN
4368   ASM_SIMP_TAC[SET_RULE
4369     `~(a IN s) /\ ~(b = a)
4370      ==> ((a INSERT s) DELETE b = a INSERT (s DELETE b))`] THEN
4371   ASM_MESON_TAC[IN_SPAN_INSERT; SET_RULE
4372     `b IN s ==> (b INSERT (s DELETE b) = s)`]);;
4373
4374 (* ------------------------------------------------------------------------- *)
4375 (* The degenerate case of the Exchange Lemma.                                *)
4376 (* ------------------------------------------------------------------------- *)
4377
4378 let SPANNING_SUBSET_INDEPENDENT = prove
4379  (`!s t:real^N->bool.
4380         t SUBSET s /\ independent s /\ s SUBSET span(t) ==> (s = t)`,
4381   REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN
4382   ASM_REWRITE_TAC[] THEN REWRITE_TAC[SUBSET] THEN
4383   X_GEN_TAC `a:real^N` THEN DISCH_TAC THEN
4384   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [independent]) THEN
4385   REWRITE_TAC[dependent; NOT_EXISTS_THM] THEN
4386   DISCH_THEN(MP_TAC o SPEC `a:real^N`) THEN ASM_REWRITE_TAC[] THEN
4387   ASM_MESON_TAC[SPAN_MONO; SUBSET; IN_DELETE]);;
4388
4389 (* ------------------------------------------------------------------------- *)
4390 (* The general case of the Exchange Lemma, the key to what follows.          *)
4391 (* ------------------------------------------------------------------------- *)
4392
4393 let EXCHANGE_LEMMA = prove
4394  (`!s t:real^N->bool.
4395         FINITE t /\ independent s /\ s SUBSET span t
4396         ==> ?t'. t' HAS_SIZE (CARD t) /\
4397                  s SUBSET t' /\ t' SUBSET (s UNION t) /\ s SUBSET (span t')`,
4398   REPEAT GEN_TAC THEN
4399   WF_INDUCT_TAC `CARD(t DIFF s :real^N->bool)` THEN
4400   ASM_CASES_TAC `(s:real^N->bool) SUBSET t` THENL
4401    [ASM_MESON_TAC[HAS_SIZE; SUBSET_UNION]; ALL_TAC] THEN
4402   ASM_CASES_TAC `t SUBSET (s:real^N->bool)` THENL
4403    [ASM_MESON_TAC[SPANNING_SUBSET_INDEPENDENT; HAS_SIZE]; ALL_TAC] THEN
4404   STRIP_TAC THEN
4405   FIRST_X_ASSUM(MP_TAC o REWRITE_RULE[SUBSET] o check(is_neg o concl)) THEN
4406   REWRITE_TAC[NOT_FORALL_THM; NOT_IMP] THEN
4407   DISCH_THEN(X_CHOOSE_THEN `b:real^N` STRIP_ASSUME_TAC) THEN
4408   ASM_CASES_TAC `s SUBSET span(t DELETE (b:real^N))` THENL
4409    [FIRST_X_ASSUM(MP_TAC o
4410      SPECL [`t DELETE (b:real^N)`; `s:real^N->bool`]) THEN
4411     ASM_REWRITE_TAC[SET_RULE `s DELETE a DIFF t = (s DIFF t) DELETE a`] THEN
4412     ASM_SIMP_TAC[CARD_DELETE; FINITE_DIFF; IN_DIFF; FINITE_DELETE;
4413                  CARD_EQ_0; ARITH_RULE `n - 1 < n <=> ~(n = 0)`] THEN
4414     ANTS_TAC THENL
4415      [UNDISCH_TAC `~((s:real^N->bool) SUBSET t)` THEN ASM SET_TAC[];
4416       ALL_TAC] THEN
4417     DISCH_THEN(X_CHOOSE_THEN `u:real^N->bool` STRIP_ASSUME_TAC) THEN
4418     EXISTS_TAC `(b:real^N) INSERT u` THEN
4419     ASM_SIMP_TAC[SUBSET_INSERT; INSERT_SUBSET; IN_UNION] THEN CONJ_TAC THENL
4420      [UNDISCH_TAC `(u:real^N->bool) HAS_SIZE CARD(t:real^N->bool) - 1` THEN
4421       SIMP_TAC[HAS_SIZE; FINITE_RULES; CARD_CLAUSES] THEN STRIP_TAC THEN
4422       COND_CASES_TAC THENL
4423        [ASM_MESON_TAC[SUBSET; IN_UNION; IN_DELETE]; ALL_TAC] THEN
4424       ASM_MESON_TAC[ARITH_RULE `~(n = 0) ==> (SUC(n - 1) = n)`;
4425                     CARD_EQ_0; MEMBER_NOT_EMPTY];
4426       ALL_TAC] THEN
4427     CONJ_TAC THENL
4428      [UNDISCH_TAC `u SUBSET s UNION t DELETE (b:real^N)` THEN SET_TAC[];
4429       ASM_MESON_TAC[SUBSET; SPAN_MONO; IN_INSERT]];
4430     ALL_TAC] THEN
4431   UNDISCH_TAC `~(s SUBSET span (t DELETE (b:real^N)))` THEN
4432   GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [SUBSET] THEN
4433   REWRITE_TAC[NOT_FORALL_THM; NOT_IMP] THEN
4434   DISCH_THEN(X_CHOOSE_THEN `a:real^N` STRIP_ASSUME_TAC) THEN
4435   SUBGOAL_THEN `~(a:real^N = b)` ASSUME_TAC THENL
4436     [ASM_MESON_TAC[]; ALL_TAC] THEN
4437   SUBGOAL_THEN `~((a:real^N) IN t)` ASSUME_TAC THENL
4438    [ASM_MESON_TAC[IN_DELETE; SPAN_CLAUSES]; ALL_TAC] THEN
4439   FIRST_X_ASSUM(MP_TAC o SPECL
4440    [`(a:real^N) INSERT (t DELETE b)`; `s:real^N->bool`]) THEN
4441   ANTS_TAC THENL
4442    [ASM_SIMP_TAC[SET_RULE
4443      `a IN s ==> ((a INSERT (t DELETE b) DIFF s) = (t DIFF s) DELETE b)`] THEN
4444     ASM_SIMP_TAC[CARD_DELETE; FINITE_DELETE; FINITE_DIFF; IN_DIFF] THEN
4445     ASM_SIMP_TAC[ARITH_RULE `n - 1 < n <=> ~(n = 0)`; CARD_EQ_0;
4446                  FINITE_DIFF] THEN
4447     UNDISCH_TAC `~((s:real^N->bool) SUBSET t)` THEN ASM SET_TAC[];
4448     ALL_TAC] THEN
4449   ANTS_TAC THENL
4450    [ASM_SIMP_TAC[FINITE_RULES; FINITE_DELETE] THEN
4451     REWRITE_TAC[SUBSET] THEN X_GEN_TAC `x:real^N` THEN
4452     DISCH_TAC THEN MATCH_MP_TAC SPAN_TRANS THEN EXISTS_TAC `b:real^N` THEN
4453     ASM_MESON_TAC[IN_SPAN_DELETE; SUBSET; SPAN_MONO;
4454                   SET_RULE `t SUBSET (b INSERT (a INSERT (t DELETE b)))`];
4455     ALL_TAC] THEN
4456   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u:real^N->bool` THEN
4457   ASM_SIMP_TAC[HAS_SIZE; CARD_CLAUSES; CARD_DELETE; FINITE_DELETE; IN_DELETE;
4458                ARITH_RULE `(SUC(n - 1) = n) <=> ~(n = 0)`;
4459                CARD_EQ_0] THEN
4460   UNDISCH_TAC `(b:real^N) IN t` THEN ASM SET_TAC[]);;
4461
4462 (* ------------------------------------------------------------------------- *)
4463 (* This implies corresponding size bounds.                                   *)
4464 (* ------------------------------------------------------------------------- *)
4465
4466 let INDEPENDENT_SPAN_BOUND = prove
4467  (`!s t. FINITE t /\ independent s /\ s SUBSET span(t)
4468          ==> FINITE s /\ CARD(s) <= CARD(t)`,
4469   REPEAT GEN_TAC THEN DISCH_TAC THEN
4470   FIRST_ASSUM(MP_TAC o MATCH_MP EXCHANGE_LEMMA) THEN
4471   ASM_MESON_TAC[HAS_SIZE; CARD_SUBSET; FINITE_SUBSET]);;
4472
4473 let INDEPENDENT_BOUND = prove
4474  (`!s:real^N->bool.
4475         independent s ==> FINITE s /\ CARD(s) <= dimindex(:N)`,
4476   REPEAT GEN_TAC THEN DISCH_TAC THEN
4477   ONCE_REWRITE_TAC[GSYM CARD_STDBASIS] THEN
4478   MATCH_MP_TAC INDEPENDENT_SPAN_BOUND THEN
4479   ASM_REWRITE_TAC[FINITE_STDBASIS; SPAN_STDBASIS; SUBSET_UNIV]);;
4480
4481 let DEPENDENT_BIGGERSET = prove
4482  (`!s:real^N->bool. (FINITE s ==> CARD(s) > dimindex(:N)) ==> dependent s`,
4483   MP_TAC INDEPENDENT_BOUND THEN MATCH_MP_TAC MONO_FORALL THEN
4484   REWRITE_TAC[GT; GSYM NOT_LE; independent] THEN MESON_TAC[]);;
4485
4486 let INDEPENDENT_IMP_FINITE = prove
4487  (`!s:real^N->bool. independent s ==> FINITE s`,
4488   SIMP_TAC[INDEPENDENT_BOUND]);;
4489
4490 (* ------------------------------------------------------------------------- *)
4491 (* Explicit formulation of independence.                                     *)
4492 (* ------------------------------------------------------------------------- *)
4493
4494 let INDEPENDENT_EXPLICIT = prove
4495  (`!b:real^N->bool.
4496         independent b <=>
4497             FINITE b /\
4498             !c. vsum b (\v. c(v) % v) = vec 0 ==> !v. v IN b ==> c(v) = &0`,
4499   GEN_TAC THEN
4500   ASM_CASES_TAC `FINITE(b:real^N->bool)` THENL
4501    [ALL_TAC; ASM_MESON_TAC[INDEPENDENT_BOUND]] THEN
4502   ASM_SIMP_TAC[independent; DEPENDENT_FINITE] THEN MESON_TAC[]);;
4503
4504 let INDEPENDENT_SING = prove
4505  (`!x. independent {x} <=> ~(x = vec 0)`,
4506   REWRITE_TAC[INDEPENDENT_INSERT; NOT_IN_EMPTY; SPAN_EMPTY] THEN
4507   REWRITE_TAC[INDEPENDENT_EMPTY] THEN SET_TAC[]);;
4508
4509 let DEPENDENT_SING = prove
4510  (`!x. dependent {x} <=> x = vec 0`,
4511   MESON_TAC[independent; INDEPENDENT_SING]);;
4512
4513 let DEPENDENT_2 = prove
4514  (`!a b:real^N.
4515         dependent {a,b} <=>
4516                 if a = b then a = vec 0
4517                 else ?x y. x % a + y % b = vec 0 /\ ~(x = &0 /\ y = &0)`,
4518   REPEAT STRIP_TAC THEN COND_CASES_TAC THEN
4519   ASM_REWRITE_TAC[DEPENDENT_SING; SET_RULE `{x,x} = {x}`] THEN
4520   SIMP_TAC[DEPENDENT_FINITE; VSUM_CLAUSES; FINITE_INSERT; FINITE_EMPTY] THEN
4521   ASM_REWRITE_TAC[IN_SING; NOT_IN_EMPTY; VECTOR_ADD_RID; EXISTS_IN_INSERT] THEN
4522   EQ_TAC THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THENL
4523    [X_GEN_TAC `u:real^N->real` THEN STRIP_TAC THEN
4524     MAP_EVERY EXISTS_TAC [`(u:real^N->real) a`; `(u:real^N->real) b`] THEN
4525     ASM_REWRITE_TAC[];
4526     MAP_EVERY X_GEN_TAC [`x:real`; `y:real`] THEN DISCH_TAC THEN EXISTS_TAC
4527      `\v:real^N. if v = a then x else if v = b then y else z:real` THEN
4528     ASM_MESON_TAC[]]);;
4529
4530 let DEPENDENT_3 = prove
4531  (`!a b c:real^N.
4532         ~(a = b) /\ ~(a = c) /\ ~(b = c)
4533         ==> (dependent {a,b,c} <=>
4534              ?x y z. x % a + y % b + z % c = vec 0 /\
4535                      ~(x = &0 /\ y = &0 /\ z = &0))`,
4536   REPEAT STRIP_TAC THEN
4537   SIMP_TAC[DEPENDENT_FINITE; VSUM_CLAUSES; FINITE_INSERT; FINITE_EMPTY] THEN
4538   ASM_REWRITE_TAC[IN_SING; NOT_IN_EMPTY; VECTOR_ADD_RID; IN_INSERT] THEN
4539   EQ_TAC THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THENL
4540    [X_GEN_TAC `u:real^N->real` THEN STRIP_TAC THEN MAP_EVERY EXISTS_TAC
4541      [`(u:real^N->real) a`; `(u:real^N->real) b`; `(u:real^N->real) c`];
4542     MAP_EVERY X_GEN_TAC [`x:real`; `y:real`; `z:real`] THEN DISCH_TAC THEN
4543     EXISTS_TAC
4544      `\v:real^N. if v = a then x else if v = b then y else z:real`] THEN
4545   ASM_MESON_TAC[]);;
4546
4547 let INDEPENDENT_2 = prove
4548  (`!a b:real^N x y.
4549         independent{a,b} /\ ~(a = b)
4550         ==> (x % a + y % b = vec 0 <=> x = &0 /\ y = &0)`,
4551   SIMP_TAC[IMP_CONJ_ALT; independent; DEPENDENT_2] THEN
4552   MESON_TAC[VECTOR_MUL_LZERO; VECTOR_ADD_LID]);;
4553
4554 let INDEPENDENT_3 = prove
4555  (`!a b c:real^N x y z.
4556         independent{a,b,c} /\ ~(a = b) /\ ~(a = c) /\ ~(b = c)
4557         ==> (x % a + y % b + z % c = vec 0 <=> x = &0 /\ y = &0 /\ z = &0)`,
4558   SIMP_TAC[IMP_CONJ_ALT; independent; DEPENDENT_3] THEN
4559   MESON_TAC[VECTOR_MUL_LZERO; VECTOR_ADD_LID]);;
4560
4561 (* ------------------------------------------------------------------------- *)
4562 (* Hence we can create a maximal independent subset.                         *)
4563 (* ------------------------------------------------------------------------- *)
4564
4565 let MAXIMAL_INDEPENDENT_SUBSET_EXTEND = prove
4566  (`!s v:real^N->bool.
4567         s SUBSET v /\ independent s
4568         ==> ?b. s SUBSET b /\ b SUBSET v /\ independent b /\
4569                 v SUBSET (span b)`,
4570   REPEAT GEN_TAC THEN
4571   WF_INDUCT_TAC `dimindex(:N) - CARD(s:real^N->bool)` THEN
4572   REPEAT STRIP_TAC THEN
4573   ASM_CASES_TAC `v SUBSET (span(s:real^N->bool))` THENL
4574    [ASM_MESON_TAC[SUBSET_REFL]; ALL_TAC] THEN
4575   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [SUBSET]) THEN
4576   REWRITE_TAC[NOT_FORALL_THM; NOT_IMP] THEN
4577   DISCH_THEN(X_CHOOSE_THEN `a:real^N` STRIP_ASSUME_TAC) THEN
4578   FIRST_X_ASSUM(MP_TAC o SPEC `(a:real^N) INSERT s`) THEN
4579   REWRITE_TAC[IMP_IMP] THEN ANTS_TAC THENL
4580    [ALL_TAC; MESON_TAC[INSERT_SUBSET]] THEN
4581   SUBGOAL_THEN `independent ((a:real^N) INSERT s)` ASSUME_TAC THENL
4582    [ASM_REWRITE_TAC[INDEPENDENT_INSERT; COND_ID]; ALL_TAC] THEN
4583   ASM_REWRITE_TAC[INSERT_SUBSET] THEN
4584   MATCH_MP_TAC(ARITH_RULE `(b = a + 1) /\ b <= n ==> n - b < n - a`) THEN
4585   ASM_SIMP_TAC[CARD_CLAUSES; INDEPENDENT_BOUND] THEN
4586   ASM_MESON_TAC[SPAN_SUPERSET; ADD1]);;
4587
4588 let MAXIMAL_INDEPENDENT_SUBSET = prove
4589  (`!v:real^N->bool. ?b. b SUBSET v /\ independent b /\ v SUBSET (span b)`,
4590   MP_TAC(SPEC `EMPTY:real^N->bool` MAXIMAL_INDEPENDENT_SUBSET_EXTEND) THEN
4591   REWRITE_TAC[EMPTY_SUBSET; INDEPENDENT_EMPTY]);;
4592
4593 (* ------------------------------------------------------------------------- *)
4594 (* A kind of closed graph property for linearity.                            *)
4595 (* ------------------------------------------------------------------------- *)
4596
4597 let LINEAR_SUBSPACE_GRAPH = prove
4598  (`!f:real^M->real^N.
4599         linear f <=> subspace {pastecart x (f x) | x IN (:real^M)}`,
4600   REWRITE_TAC[linear; subspace; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
4601   REWRITE_TAC[FORALL_IN_GSPEC; GSYM(SPEC `0` PASTECART_VEC); IN_UNIV] THEN
4602   REWRITE_TAC[IN_ELIM_THM; PASTECART_INJ; UNWIND_THM1; PASTECART_ADD;
4603               GSYM PASTECART_CMUL] THEN
4604   MESON_TAC[VECTOR_MUL_LZERO]);;
4605
4606 (* ------------------------------------------------------------------------- *)
4607 (* Notion of dimension.                                                      *)
4608 (* ------------------------------------------------------------------------- *)
4609
4610 let dim = new_definition
4611   `dim v = @n. ?b. b SUBSET v /\ independent b /\ v SUBSET (span b) /\
4612                    b HAS_SIZE n`;;
4613
4614 let BASIS_EXISTS = prove
4615  (`!v. ?b. b SUBSET v /\ independent b /\ v SUBSET (span b) /\
4616            b HAS_SIZE (dim v)`,
4617   GEN_TAC THEN REWRITE_TAC[dim] THEN CONV_TAC SELECT_CONV THEN
4618   MESON_TAC[MAXIMAL_INDEPENDENT_SUBSET; HAS_SIZE; INDEPENDENT_BOUND]);;
4619
4620 let BASIS_EXISTS_FINITE = prove
4621  (`!v. ?b. FINITE b /\
4622            b SUBSET v /\
4623            independent b /\
4624            v SUBSET (span b) /\
4625            b HAS_SIZE (dim v)`,
4626   MESON_TAC[BASIS_EXISTS; INDEPENDENT_IMP_FINITE]);;
4627
4628 let BASIS_SUBSPACE_EXISTS = prove
4629  (`!s:real^N->bool.
4630         subspace s
4631         ==> ?b. FINITE b /\
4632                 b SUBSET s /\
4633                 independent b /\
4634                 span b = s /\
4635                 b HAS_SIZE dim s`,
4636   REPEAT STRIP_TAC THEN
4637   MP_TAC(ISPEC `s:real^N->bool` BASIS_EXISTS) THEN
4638   MATCH_MP_TAC MONO_EXISTS THEN REPEAT STRIP_TAC THEN
4639   ASM_REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ] THEN
4640   ASM_MESON_TAC[SPAN_EQ_SELF; SPAN_MONO; INDEPENDENT_IMP_FINITE]);;
4641
4642 (* ------------------------------------------------------------------------- *)
4643 (* Consequences of independence or spanning for cardinality.                 *)
4644 (* ------------------------------------------------------------------------- *)
4645
4646 let INDEPENDENT_CARD_LE_DIM = prove
4647  (`!v b:real^N->bool.
4648         b SUBSET v /\ independent b ==> FINITE b /\ CARD(b) <= dim v`,
4649   MESON_TAC[BASIS_EXISTS; INDEPENDENT_SPAN_BOUND; HAS_SIZE;SUBSET_TRANS]);;
4650
4651 let SPAN_CARD_GE_DIM = prove
4652  (`!v b:real^N->bool.
4653         v SUBSET (span b) /\ FINITE b ==> dim(v) <= CARD(b)`,
4654   MESON_TAC[BASIS_EXISTS; INDEPENDENT_SPAN_BOUND; HAS_SIZE;SUBSET_TRANS]);;
4655
4656 let BASIS_CARD_EQ_DIM = prove
4657  (`!v b. b SUBSET v /\ v SUBSET (span b) /\ independent b
4658          ==> FINITE b /\ (CARD b = dim v)`,
4659   MESON_TAC[LE_ANTISYM; INDEPENDENT_CARD_LE_DIM; SPAN_CARD_GE_DIM]);;
4660
4661 let BASIS_HAS_SIZE_DIM = prove
4662  (`!v b. independent b /\ span b = v ==> b HAS_SIZE (dim v)`,
4663   REPEAT STRIP_TAC THEN REWRITE_TAC[HAS_SIZE] THEN
4664   MATCH_MP_TAC BASIS_CARD_EQ_DIM THEN ASM_REWRITE_TAC[SUBSET_REFL] THEN
4665   FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN REWRITE_TAC[SPAN_INC]);;
4666
4667 let DIM_UNIQUE = prove
4668  (`!v b. b SUBSET v /\ v SUBSET (span b) /\ independent b /\ b HAS_SIZE n
4669          ==> (dim v = n)`,
4670   MESON_TAC[BASIS_CARD_EQ_DIM; HAS_SIZE]);;
4671
4672 let DIM_LE_CARD = prove
4673  (`!s. FINITE s ==> dim s <= CARD s`,
4674   GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC SPAN_CARD_GE_DIM THEN
4675   ASM_REWRITE_TAC[SPAN_INC; SUBSET_REFL]);;
4676
4677 (* ------------------------------------------------------------------------- *)
4678 (* More lemmas about dimension.                                              *)
4679 (* ------------------------------------------------------------------------- *)
4680
4681 let DIM_UNIV = prove
4682  (`dim(:real^N) = dimindex(:N)`,
4683   MATCH_MP_TAC DIM_UNIQUE THEN
4684   EXISTS_TAC `{basis i :real^N | 1 <= i /\ i <= dimindex(:N)}` THEN
4685   REWRITE_TAC[SUBSET_UNIV; SPAN_STDBASIS; HAS_SIZE_STDBASIS;
4686               INDEPENDENT_STDBASIS]);;
4687
4688 let DIM_SUBSET = prove
4689  (`!s t:real^N->bool. s SUBSET t ==> dim(s) <= dim(t)`,
4690   MESON_TAC[BASIS_EXISTS; INDEPENDENT_SPAN_BOUND; SUBSET; HAS_SIZE]);;
4691
4692 let DIM_SUBSET_UNIV = prove
4693  (`!s:real^N->bool. dim(s) <= dimindex(:N)`,
4694   GEN_TAC THEN REWRITE_TAC[GSYM DIM_UNIV] THEN
4695   MATCH_MP_TAC DIM_SUBSET THEN REWRITE_TAC[SUBSET_UNIV]);;
4696
4697 let BASIS_HAS_SIZE_UNIV = prove
4698  (`!b. independent b /\ span b = (:real^N) ==> b HAS_SIZE (dimindex(:N))`,
4699   REWRITE_TAC[GSYM DIM_UNIV; BASIS_HAS_SIZE_DIM]);;
4700
4701 (* ------------------------------------------------------------------------- *)
4702 (* Converses to those.                                                       *)
4703 (* ------------------------------------------------------------------------- *)
4704
4705 let CARD_GE_DIM_INDEPENDENT = prove
4706  (`!v b:real^N->bool.
4707         b SUBSET v /\ independent b /\ dim v <= CARD(b)
4708         ==> v SUBSET (span b)`,
4709   REPEAT STRIP_TAC THEN
4710   SUBGOAL_THEN `!a:real^N. ~(a IN v /\ ~(a IN span b))` MP_TAC THENL
4711    [ALL_TAC; SET_TAC[]] THEN
4712   X_GEN_TAC `a:real^N` THEN STRIP_TAC THEN
4713   SUBGOAL_THEN `independent((a:real^N) INSERT b)` ASSUME_TAC THENL
4714    [ASM_MESON_TAC[INDEPENDENT_INSERT]; ALL_TAC] THEN
4715   MP_TAC(ISPECL [`v:real^N->bool`; `(a:real^N) INSERT b`]
4716                 INDEPENDENT_CARD_LE_DIM) THEN
4717   ASM_SIMP_TAC[INSERT_SUBSET; CARD_CLAUSES; INDEPENDENT_BOUND] THEN
4718   ASM_MESON_TAC[SPAN_SUPERSET; SUBSET; ARITH_RULE
4719     `x <= y ==> ~(SUC y <= x)`]);;
4720
4721 let CARD_LE_DIM_SPANNING = prove
4722  (`!v b:real^N->bool.
4723         v SUBSET (span b) /\ FINITE b /\ CARD(b) <= dim v
4724         ==> independent b`,
4725   REPEAT STRIP_TAC THEN REWRITE_TAC[independent; dependent] THEN
4726   DISCH_THEN(X_CHOOSE_THEN `a:real^N` STRIP_ASSUME_TAC) THEN
4727   SUBGOAL_THEN `dim(v:real^N->bool) <= CARD(b DELETE (a:real^N))` MP_TAC THENL
4728    [ALL_TAC;
4729     ASM_SIMP_TAC[CARD_DELETE] THEN MATCH_MP_TAC
4730      (ARITH_RULE `b <= n /\ ~(b = 0) ==> ~(n <= b - 1)`) THEN
4731     ASM_SIMP_TAC[CARD_EQ_0] THEN ASM_MESON_TAC[MEMBER_NOT_EMPTY]] THEN
4732   MATCH_MP_TAC SPAN_CARD_GE_DIM THEN ASM_SIMP_TAC[FINITE_DELETE] THEN
4733   REWRITE_TAC[SUBSET] THEN REPEAT STRIP_TAC THEN
4734   MATCH_MP_TAC SPAN_TRANS THEN EXISTS_TAC `a:real^N` THEN
4735   ASM_SIMP_TAC[SET_RULE `a IN b ==> (a INSERT (b DELETE a) = b)`] THEN
4736   ASM_MESON_TAC[SUBSET]);;
4737
4738 let CARD_EQ_DIM = prove
4739  (`!v b. b SUBSET v /\ b HAS_SIZE (dim v)
4740          ==> (independent b <=> v SUBSET (span b))`,
4741   REWRITE_TAC[HAS_SIZE; GSYM LE_ANTISYM] THEN
4742   MESON_TAC[CARD_LE_DIM_SPANNING; CARD_GE_DIM_INDEPENDENT]);;
4743
4744 (* ------------------------------------------------------------------------- *)
4745 (* More general size bound lemmas.                                           *)
4746 (* ------------------------------------------------------------------------- *)
4747
4748 let INDEPENDENT_BOUND_GENERAL = prove
4749  (`!s:real^N->bool. independent s ==> FINITE s /\ CARD(s) <= dim(s)`,
4750   MESON_TAC[INDEPENDENT_CARD_LE_DIM; INDEPENDENT_BOUND; SUBSET_REFL]);;
4751
4752 let DEPENDENT_BIGGERSET_GENERAL = prove
4753  (`!s:real^N->bool. (FINITE s ==> CARD(s) > dim(s)) ==> dependent s`,
4754   MP_TAC INDEPENDENT_BOUND_GENERAL THEN MATCH_MP_TAC MONO_FORALL THEN
4755   REWRITE_TAC[GT; GSYM NOT_LE; independent] THEN MESON_TAC[]);;
4756
4757 let DIM_SPAN = prove
4758  (`!s:real^N->bool. dim(span s) = dim s`,
4759   GEN_TAC THEN REWRITE_TAC[GSYM LE_ANTISYM] THEN CONJ_TAC THENL
4760    [ALL_TAC;
4761     MATCH_MP_TAC DIM_SUBSET THEN MESON_TAC[SUBSET; SPAN_SUPERSET]] THEN
4762   MP_TAC(ISPEC `s:real^N->bool` BASIS_EXISTS) THEN
4763   REWRITE_TAC[HAS_SIZE] THEN STRIP_TAC THEN
4764   FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN
4765   MATCH_MP_TAC SPAN_CARD_GE_DIM THEN ASM_REWRITE_TAC[] THEN
4766   GEN_REWRITE_TAC RAND_CONV [GSYM SPAN_SPAN] THEN
4767   MATCH_MP_TAC SPAN_MONO THEN ASM_REWRITE_TAC[]);;
4768
4769 let DIM_INSERT_0 = prove
4770  (`!s:real^N->bool. dim(vec 0 INSERT s) = dim s`,
4771   ONCE_REWRITE_TAC[GSYM DIM_SPAN] THEN
4772   REWRITE_TAC[SPAN_INSERT_0]);;
4773
4774 let DIM_EQ_CARD = prove
4775  (`!s:real^N->bool. independent s ==> dim s = CARD s`,
4776   REPEAT STRIP_TAC THEN MP_TAC
4777    (ISPECL [`span s:real^N->bool`; `s:real^N->bool`] BASIS_CARD_EQ_DIM) THEN
4778   ASM_SIMP_TAC[SUBSET_REFL; SPAN_INC; DIM_SPAN]);;
4779
4780 let SUBSET_LE_DIM = prove
4781  (`!s t:real^N->bool. s SUBSET (span t) ==> dim s <= dim t`,
4782   MESON_TAC[DIM_SPAN; DIM_SUBSET]);;
4783
4784 let SPAN_EQ_DIM = prove
4785  (`!s t. span s = span t ==> dim s = dim t`,
4786   MESON_TAC[DIM_SPAN]);;
4787
4788 let SPANS_IMAGE = prove
4789  (`!f b v. linear f /\ v SUBSET (span b)
4790            ==> (IMAGE f v) SUBSET span(IMAGE f b)`,
4791   SIMP_TAC[SPAN_LINEAR_IMAGE; IMAGE_SUBSET]);;
4792
4793 let DIM_LINEAR_IMAGE_LE = prove
4794  (`!f:real^M->real^N s. linear f ==> dim(IMAGE f s) <= dim s`,
4795   REPEAT STRIP_TAC THEN MP_TAC(ISPEC `s:real^M->bool` BASIS_EXISTS) THEN
4796   REWRITE_TAC[HAS_SIZE] THEN STRIP_TAC THEN FIRST_ASSUM(SUBST1_TAC o SYM) THEN
4797   MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `CARD(IMAGE (f:real^M->real^N) b)` THEN
4798   ASM_SIMP_TAC[CARD_IMAGE_LE] THEN MATCH_MP_TAC SPAN_CARD_GE_DIM THEN
4799   ASM_MESON_TAC[SPAN_LINEAR_IMAGE; SPANS_IMAGE; SUBSET_IMAGE; FINITE_IMAGE]);;
4800
4801 (* ------------------------------------------------------------------------- *)
4802 (* Some stepping theorems.                                                   *)
4803 (* ------------------------------------------------------------------------- *)
4804
4805 let DIM_EMPTY = prove
4806  (`dim({}:real^N->bool) = 0`,
4807   MATCH_MP_TAC DIM_UNIQUE THEN EXISTS_TAC `{}:real^N->bool` THEN
4808   REWRITE_TAC[SUBSET_REFL; SPAN_EMPTY; INDEPENDENT_EMPTY; HAS_SIZE_0;
4809               EMPTY_SUBSET]);;
4810
4811 let DIM_INSERT = prove
4812  (`!x:real^N s. dim(x INSERT s) = if x IN span s then dim s else dim s + 1`,
4813   REPEAT GEN_TAC THEN COND_CASES_TAC THENL
4814    [MATCH_MP_TAC SPAN_EQ_DIM THEN MATCH_MP_TAC SUBSET_ANTISYM THEN
4815     ASM_MESON_TAC[SPAN_TRANS; SUBSET; SPAN_MONO; IN_INSERT];
4816     ALL_TAC] THEN
4817   X_CHOOSE_THEN `b:real^N->bool` STRIP_ASSUME_TAC
4818    (ISPEC `span s:real^N->bool` BASIS_EXISTS) THEN
4819   ONCE_REWRITE_TAC[GSYM DIM_SPAN] THEN
4820   MATCH_MP_TAC DIM_UNIQUE THEN
4821   EXISTS_TAC `(x:real^N) INSERT b` THEN REPEAT CONJ_TAC THENL
4822    [REWRITE_TAC[INSERT_SUBSET] THEN
4823     ASM_MESON_TAC[SUBSET; SPAN_MONO; IN_INSERT; SPAN_SUPERSET];
4824     REWRITE_TAC[SUBSET; SPAN_BREAKDOWN_EQ] THEN
4825     ASM_MESON_TAC[SUBSET];
4826     REWRITE_TAC[INDEPENDENT_INSERT] THEN
4827     ASM_MESON_TAC[SUBSET; SPAN_SUPERSET; SPAN_MONO; SPAN_SPAN];
4828     RULE_ASSUM_TAC(REWRITE_RULE[HAS_SIZE]) THEN
4829     ASM_SIMP_TAC[HAS_SIZE; CARD_CLAUSES; FINITE_INSERT; ADD1] THEN
4830     ASM_MESON_TAC[SUBSET; SPAN_SUPERSET; SPAN_MONO; SPAN_SPAN]]);;
4831
4832 let DIM_SING = prove
4833  (`!x. dim{x} = if x = vec 0 then 0 else 1`,
4834   REWRITE_TAC[DIM_INSERT; DIM_EMPTY; SPAN_EMPTY; IN_SING; ARITH]);;
4835
4836 let DIM_EQ_0 = prove
4837  (`!s:real^N->bool. dim s = 0 <=> s SUBSET {vec 0}`,
4838   REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THENL
4839    [MATCH_MP_TAC(SET_RULE
4840      `~(?b. ~(b = a) /\ {b} SUBSET s) ==> s SUBSET {a}`) THEN
4841     STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP DIM_SUBSET);
4842     MATCH_MP_TAC(ARITH_RULE `!m. m = 0 /\ n <= m ==> n = 0`) THEN
4843     EXISTS_TAC `dim{vec 0:real^N}` THEN ASM_SIMP_TAC[DIM_SUBSET]] THEN
4844   ASM_REWRITE_TAC[DIM_SING; ARITH]);;
4845
4846 (* ------------------------------------------------------------------------- *)
4847 (* Choosing a subspace of a given dimension.                                 *)
4848 (* ------------------------------------------------------------------------- *)
4849
4850 let CHOOSE_SUBSPACE_OF_SUBSPACE = prove
4851  (`!s:real^N->bool n.
4852         n <= dim s ==> ?t. subspace t /\ t SUBSET span s /\ dim t = n`,
4853   GEN_TAC THEN INDUCT_TAC THENL
4854    [DISCH_TAC THEN EXISTS_TAC `{vec 0:real^N}` THEN
4855     REWRITE_TAC[SUBSPACE_TRIVIAL; DIM_SING; SING_SUBSET; SPAN_0];
4856     DISCH_THEN(fun th -> POP_ASSUM MP_TAC THEN ASSUME_TAC th) THEN
4857     ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN
4858     DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) THEN
4859     ASM_CASES_TAC `span (s:real^N->bool) SUBSET span t` THENL
4860      [SUBGOAL_THEN `dim(s:real^N->bool) = dim(t:real^N->bool)` MP_TAC THENL
4861        [ALL_TAC; ASM_ARITH_TAC] THEN MATCH_MP_TAC SPAN_EQ_DIM THEN
4862       MATCH_MP_TAC SUBSET_ANTISYM THEN ASM_REWRITE_TAC[] THEN
4863       MATCH_MP_TAC SPAN_SUBSET_SUBSPACE THEN ASM_REWRITE_TAC[SUBSPACE_SPAN];
4864       FIRST_ASSUM(X_CHOOSE_THEN `y:real^N` STRIP_ASSUME_TAC o MATCH_MP(SET_RULE
4865        `~(s SUBSET t) ==> ?a. a IN s /\ ~(a IN t)`)) THEN
4866       EXISTS_TAC `span((y:real^N) INSERT t)` THEN
4867       REWRITE_TAC[SUBSPACE_SPAN] THEN CONJ_TAC THENL
4868        [MATCH_MP_TAC SPAN_SUBSET_SUBSPACE THEN
4869         ASM_REWRITE_TAC[SUBSPACE_SPAN] THEN ASM SET_TAC[];
4870         ASM_REWRITE_TAC[DIM_SPAN; DIM_INSERT; ADD1]]]]);;
4871
4872 (* ------------------------------------------------------------------------- *)
4873 (* Relation between bases and injectivity/surjectivity of map.               *)
4874 (* ------------------------------------------------------------------------- *)
4875
4876 let SPANNING_SURJECTIVE_IMAGE = prove
4877  (`!f:real^M->real^N s.
4878         UNIV SUBSET (span s) /\ linear f /\ (!y. ?x. f(x) = y)
4879         ==> UNIV SUBSET span(IMAGE f s)`,
4880   REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_TRANS THEN
4881   EXISTS_TAC `IMAGE (f:real^M->real^N) UNIV` THEN
4882   ASM_SIMP_TAC[SPANS_IMAGE] THEN
4883   REWRITE_TAC[SUBSET; IN_UNIV; IN_IMAGE] THEN ASM_MESON_TAC[]);;
4884
4885 let INDEPENDENT_INJECTIVE_IMAGE_GEN = prove
4886  (`!f:real^M->real^N s.
4887         independent s /\ linear f /\
4888         (!x y. x IN span s /\ y IN span s /\ f(x) = f(y) ==> x = y)
4889         ==> independent (IMAGE f s)`,
4890   REPEAT GEN_TAC THEN
4891   DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN
4892   ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN
4893   REWRITE_TAC[independent; DEPENDENT_EXPLICIT] THEN
4894   REWRITE_TAC[CONJ_ASSOC; FINITE_SUBSET_IMAGE] THEN
4895   REWRITE_TAC[MESON[]
4896      `(?s u. ((?t. p t /\ s = f t) /\ q s u) /\ r s u) <=>
4897       (?t u. p t /\ q (f t) u /\ r (f t) u)`] THEN
4898   REWRITE_TAC[EXISTS_IN_IMAGE; LEFT_IMP_EXISTS_THM] THEN
4899   MAP_EVERY X_GEN_TAC [`t:real^M->bool`; `u:real^N->real`] THEN
4900   DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN
4901   MAP_EVERY EXISTS_TAC
4902    [`t:real^M->bool`; `(u:real^N->real) o (f:real^M->real^N)`] THEN
4903   ASM_REWRITE_TAC[o_THM] THEN
4904   FIRST_ASSUM MATCH_MP_TAC THEN REPEAT CONJ_TAC THENL
4905    [MATCH_MP_TAC SPAN_VSUM THEN ASM_REWRITE_TAC[] THEN
4906     REPEAT STRIP_TAC THEN MATCH_MP_TAC SPAN_MUL THEN
4907     MATCH_MP_TAC SPAN_SUPERSET THEN ASM SET_TAC[];
4908     REWRITE_TAC[SPAN_0];
4909     ASM_SIMP_TAC[LINEAR_VSUM] THEN
4910     FIRST_ASSUM(SUBST1_TAC o MATCH_MP LINEAR_0) THEN
4911     FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN CONV_TAC SYM_CONV THEN
4912     W(MP_TAC o PART_MATCH (lhs o rand) VSUM_IMAGE o lhand o snd) THEN
4913     ASM_SIMP_TAC[o_DEF; LINEAR_CMUL] THEN DISCH_THEN MATCH_MP_TAC THEN
4914     ASM_MESON_TAC[SPAN_SUPERSET; SUBSET]]);;
4915
4916 let INDEPENDENT_INJECTIVE_IMAGE = prove
4917  (`!f:real^M->real^N s.
4918         independent s /\ linear f /\ (!x y. (f(x) = f(y)) ==> (x = y))
4919         ==> independent (IMAGE f s)`,
4920   REPEAT STRIP_TAC THEN MATCH_MP_TAC INDEPENDENT_INJECTIVE_IMAGE_GEN THEN
4921   ASM_MESON_TAC[]);;
4922
4923 (* ------------------------------------------------------------------------- *)
4924 (* Picking an orthogonal replacement for a spanning set.                     *)
4925 (* ------------------------------------------------------------------------- *)
4926
4927 let VECTOR_SUB_PROJECT_ORTHOGONAL = prove
4928  (`!b:real^N x. b dot (x - ((b dot x) / (b dot b)) % b) = &0`,
4929   REPEAT GEN_TAC THEN ASM_CASES_TAC `b = vec 0 :real^N` THENL
4930    [ASM_REWRITE_TAC[DOT_LZERO]; ALL_TAC] THEN
4931   ASM_SIMP_TAC[DOT_RSUB; DOT_RMUL] THEN
4932   ASM_SIMP_TAC[REAL_SUB_REFL; REAL_DIV_RMUL; DOT_EQ_0]);;
4933
4934 let BASIS_ORTHOGONAL = prove
4935  (`!b:real^N->bool.
4936         FINITE b
4937         ==> ?c. FINITE c /\ CARD c <= CARD b /\
4938                 span c = span b /\ pairwise orthogonal c`,
4939   REWRITE_TAC[pairwise; orthogonal] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
4940   CONJ_TAC THENL
4941    [EXISTS_TAC `{}:real^N->bool` THEN
4942     REWRITE_TAC[FINITE_RULES; NOT_IN_EMPTY; LE_REFL];
4943     ALL_TAC] THEN
4944   MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N->bool`] THEN
4945   DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `c:real^N->bool` STRIP_ASSUME_TAC)
4946         STRIP_ASSUME_TAC) THEN
4947   EXISTS_TAC `(a - vsum c (\x. ((x dot a) / (x dot x)) % x):real^N)
4948               INSERT c` THEN
4949   ASM_SIMP_TAC[FINITE_RULES; CARD_CLAUSES] THEN REPEAT CONJ_TAC THENL
4950    [ASM_ARITH_TAC;
4951     REWRITE_TAC[EXTENSION; SPAN_BREAKDOWN_EQ] THEN
4952     FIRST_X_ASSUM(SUBST_ALL_TAC o SYM) THEN GEN_TAC THEN
4953     AP_TERM_TAC THEN ABS_TAC THEN REWRITE_TAC[VECTOR_SUB_LDISTRIB] THEN
4954     REWRITE_TAC[VECTOR_ARITH `a - (x - y):real^N = y + (a - x)`] THEN
4955     MATCH_MP_TAC SPAN_ADD_EQ THEN MATCH_MP_TAC SPAN_MUL THEN
4956     MATCH_MP_TAC SPAN_VSUM THEN ASM_REWRITE_TAC[] THEN
4957     REPEAT STRIP_TAC THEN MATCH_MP_TAC SPAN_MUL THEN
4958     ASM_SIMP_TAC[SPAN_SUPERSET];
4959     REWRITE_TAC[IN_INSERT] THEN REPEAT STRIP_TAC THENL
4960      [ASM_MESON_TAC[];
4961       FIRST_X_ASSUM SUBST_ALL_TAC;
4962       FIRST_X_ASSUM SUBST_ALL_TAC;
4963       ASM_MESON_TAC[]] THEN
4964     REWRITE_TAC[DOT_LSUB; DOT_RSUB; REAL_SUB_0] THEN
4965     FIRST_ASSUM(SUBST1_TAC o MATCH_MP (SET_RULE
4966      `x IN s ==> s = x INSERT (s DELETE x)`)) THEN
4967     ASM_SIMP_TAC[VSUM_CLAUSES; FINITE_DELETE; IN_DELETE] THEN
4968     REWRITE_TAC[DOT_LADD; DOT_RADD; DOT_LMUL; DOT_RMUL] THEN
4969     MATCH_MP_TAC(REAL_ARITH `s = &0 /\ a = b ==> b = a + s`) THEN
4970     ASM_SIMP_TAC[DOT_LSUM; DOT_RSUM; FINITE_DELETE] THEN
4971     (CONJ_TAC THENL
4972       [MATCH_MP_TAC SUM_EQ_0 THEN
4973        ASM_SIMP_TAC[DOT_LMUL; DOT_RMUL; IN_DELETE;
4974                     REAL_MUL_RZERO; REAL_MUL_LZERO];
4975        W(MP_TAC o PART_MATCH (lhand o rand) REAL_DIV_RMUL o lhand o snd) THEN
4976        REWRITE_TAC[DOT_SYM] THEN
4977        MATCH_MP_TAC(TAUT `(p ==> q) ==> (~p ==> q) ==> q`) THEN
4978        SIMP_TAC[] THEN SIMP_TAC[DOT_EQ_0; DOT_RZERO; DOT_LZERO] THEN
4979        REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_RZERO]])]);;
4980
4981 let ORTHOGONAL_BASIS_EXISTS = prove
4982  (`!v:real^N->bool.
4983         ?b. independent b /\
4984             b SUBSET span v /\
4985             v SUBSET span b /\
4986             b HAS_SIZE dim v /\
4987             pairwise orthogonal b`,
4988   GEN_TAC THEN MP_TAC(ISPEC `v:real^N->bool` BASIS_EXISTS) THEN
4989   DISCH_THEN(X_CHOOSE_THEN `b:real^N->bool` STRIP_ASSUME_TAC) THEN
4990   MP_TAC(SPEC `b:real^N->bool` BASIS_ORTHOGONAL) THEN
4991   ANTS_TAC THENL [ASM_MESON_TAC[HAS_SIZE]; ALL_TAC] THEN
4992   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c:real^N->bool` THEN
4993   STRIP_TAC THEN ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL
4994    [MATCH_MP_TAC CARD_LE_DIM_SPANNING THEN ASM_REWRITE_TAC[] THEN
4995     EXISTS_TAC `span(v):real^N->bool` THEN CONJ_TAC THENL
4996      [ASM_MESON_TAC[SPAN_SPAN; SPAN_MONO];
4997       ASM_MESON_TAC[LE_TRANS; HAS_SIZE; DIM_SPAN]];
4998     ASM_MESON_TAC[SUBSET_TRANS; SPAN_INC; SPAN_SPAN; SPAN_MONO];
4999     RULE_ASSUM_TAC(REWRITE_RULE[HAS_SIZE]) THEN
5000     ASM_REWRITE_TAC[HAS_SIZE; GSYM LE_ANTISYM] THEN
5001     CONJ_TAC THENL [ASM_MESON_TAC[LE_TRANS]; ALL_TAC] THEN
5002     ONCE_REWRITE_TAC[GSYM DIM_SPAN] THEN MATCH_MP_TAC SPAN_CARD_GE_DIM THEN
5003     ASM_REWRITE_TAC[] THEN
5004     ASM_MESON_TAC[SPAN_SPAN; SPAN_MONO; SUBSET_TRANS; SPAN_INC]]);;
5005
5006 let SPAN_EQ = prove
5007  (`!s t. span s = span t <=> s SUBSET span t /\ t SUBSET span s`,
5008   REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ] THEN
5009   MESON_TAC[SUBSET_TRANS; SPAN_SPAN; SPAN_MONO; SPAN_INC]);;
5010
5011 let SPAN_EQ_INSERT = prove
5012  (`!s x. span(x INSERT s) = span s <=> x IN span s`,
5013   REWRITE_TAC[SPAN_EQ; INSERT_SUBSET] THEN
5014   MESON_TAC[SPAN_INC; SUBSET; SET_RULE `s SUBSET (x INSERT s)`]);;
5015
5016 (* ------------------------------------------------------------------------- *)
5017 (* We can extend a linear basis-basis injection to the whole set.            *)
5018 (* ------------------------------------------------------------------------- *)
5019
5020 let LINEAR_INDEP_IMAGE_LEMMA = prove
5021  (`!f b. linear(f:real^M->real^N) /\
5022          FINITE b /\
5023          independent (IMAGE f b) /\
5024          (!x y. x IN b /\ y IN b /\ (f x = f y) ==> (x = y))
5025          ==> !x. x IN span b ==> (f(x) = vec 0) ==> (x = vec 0)`,
5026   REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
5027   GEN_TAC THEN DISCH_TAC THEN
5028   GEN_REWRITE_TAC (BINDER_CONV o RAND_CONV) [IMP_IMP] THEN
5029   MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
5030   CONJ_TAC THENL [SIMP_TAC[IN_SING; SPAN_EMPTY]; ALL_TAC] THEN
5031   MAP_EVERY X_GEN_TAC [`a:real^M`; `b:real^M->bool`] THEN STRIP_TAC THEN
5032   STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o check (is_imp o concl)) THEN
5033   ANTS_TAC THENL
5034    [ASM_MESON_TAC[INDEPENDENT_MONO; IMAGE_CLAUSES; SUBSET; IN_INSERT];
5035     ALL_TAC] THEN
5036   DISCH_TAC THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN
5037   MP_TAC(ISPECL [`a:real^M`; `(a:real^M) INSERT b`; `x:real^M`]
5038     SPAN_BREAKDOWN) THEN
5039   ASM_REWRITE_TAC[IN_INSERT] THEN
5040   SIMP_TAC[ASSUME `~((a:real^M) IN b)`; SET_RULE
5041     `~(a IN b) ==> ((a INSERT b) DELETE a = b)`] THEN
5042   DISCH_THEN(X_CHOOSE_THEN `k:real` STRIP_ASSUME_TAC) THEN DISCH_TAC THEN
5043   SUBGOAL_THEN `(f:real^M->real^N)(x - k % a) IN span(IMAGE f b)` MP_TAC THENL
5044    [ASM_MESON_TAC[SPAN_LINEAR_IMAGE; IN_IMAGE]; ALL_TAC] THEN
5045   FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP LINEAR_SUB th]) THEN
5046   FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP LINEAR_CMUL th]) THEN
5047   ASM_REWRITE_TAC[VECTOR_ARITH `vec 0 - k % x = (--k) % x`] THEN
5048   ASM_CASES_TAC `k = &0` THENL
5049    [ASM_MESON_TAC[VECTOR_ARITH `x - &0 % y = x`]; ALL_TAC] THEN
5050   DISCH_THEN(MP_TAC o SPEC `--inv(k)` o MATCH_MP SPAN_MUL) THEN
5051   REWRITE_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LNEG; REAL_MUL_RNEG] THEN
5052   SIMP_TAC[REAL_NEGNEG; REAL_MUL_LINV; ASSUME `~(k = &0)`] THEN
5053   REWRITE_TAC[VECTOR_MUL_LID] THEN
5054   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [independent]) THEN
5055   REWRITE_TAC[dependent; NOT_EXISTS_THM] THEN
5056   DISCH_THEN(MP_TAC o SPEC `(f:real^M->real^N) a`) THEN
5057   SUBGOAL_THEN
5058    `IMAGE (f:real^M->real^N) (a INSERT b) DELETE f a =
5059     IMAGE f ((a INSERT b) DELETE a)`
5060   SUBST1_TAC THENL
5061    [REWRITE_TAC[EXTENSION; IN_IMAGE; IN_DELETE; IN_INSERT] THEN
5062     ASM_MESON_TAC[IN_INSERT];
5063     ALL_TAC] THEN
5064   ASM_REWRITE_TAC[DELETE_INSERT] THEN
5065   SIMP_TAC[SET_RULE `~(a IN b) ==> (b DELETE a = b)`;
5066            ASSUME `~(a:real^M IN b)`] THEN
5067   SIMP_TAC[IMAGE_CLAUSES; IN_INSERT]);;
5068
5069 (* ------------------------------------------------------------------------- *)
5070 (* We can extend a linear mapping from basis.                                *)
5071 (* ------------------------------------------------------------------------- *)
5072
5073 let LINEAR_INDEPENDENT_EXTEND_LEMMA = prove
5074  (`!f b. FINITE b
5075          ==> independent b
5076              ==> ?g:real^M->real^N.
5077                         (!x y. x IN span b /\ y IN span b
5078                                 ==> (g(x + y) = g(x) + g(y))) /\
5079                         (!x c. x IN span b ==> (g(c % x) = c % g(x))) /\
5080                         (!x. x IN b ==> (g x = f x))`,
5081   GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
5082   REWRITE_TAC[NOT_IN_EMPTY; INDEPENDENT_INSERT] THEN CONJ_TAC THENL
5083    [REPEAT STRIP_TAC THEN EXISTS_TAC `(\x. vec 0):real^M->real^N` THEN
5084     SIMP_TAC[SPAN_EMPTY] THEN REPEAT STRIP_TAC THEN VECTOR_ARITH_TAC;
5085     ALL_TAC] THEN
5086   SIMP_TAC[] THEN MAP_EVERY X_GEN_TAC [`a:real^M`; `b:real^M->bool`] THEN
5087   DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN
5088   DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN
5089   DISCH_THEN(X_CHOOSE_THEN `g:real^M->real^N` STRIP_ASSUME_TAC) THEN
5090   ABBREV_TAC `h = \z:real^M. @k. (z - k % a) IN span b` THEN
5091   SUBGOAL_THEN `!z:real^M. z IN span(a INSERT b)
5092                     ==> (z - h(z) % a) IN span(b) /\
5093                         !k. (z - k % a) IN span(b) ==> (k = h(z))`
5094   MP_TAC THENL
5095    [GEN_TAC THEN DISCH_TAC THEN
5096     MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL
5097      [EXPAND_TAC "h" THEN CONV_TAC SELECT_CONV THEN
5098       ASM_MESON_TAC[SPAN_BREAKDOWN_EQ];
5099       ALL_TAC] THEN
5100     REWRITE_TAC[RIGHT_IMP_FORALL_THM; IMP_IMP] THEN GEN_TAC THEN
5101     DISCH_THEN(MP_TAC o MATCH_MP SPAN_SUB) THEN
5102     REWRITE_TAC[VECTOR_ARITH `(z - a % v) - (z - b % v) = (b - a) % v`] THEN
5103     ASM_CASES_TAC `k = (h:real^M->real) z` THEN ASM_REWRITE_TAC[] THEN
5104     DISCH_THEN(MP_TAC o SPEC `inv(k - (h:real^M->real) z)` o
5105                MATCH_MP SPAN_MUL) THEN
5106     ASM_SIMP_TAC[REAL_MUL_LINV; VECTOR_MUL_ASSOC; REAL_SUB_0] THEN
5107     ASM_REWRITE_TAC[VECTOR_MUL_LID];
5108     ALL_TAC] THEN
5109   REWRITE_TAC[TAUT `(a ==> b /\ c) <=> (a ==> b) /\ (a ==> c)`] THEN
5110   REWRITE_TAC[RIGHT_IMP_FORALL_THM; IMP_IMP] THEN
5111   GEN_REWRITE_TAC LAND_CONV [FORALL_AND_THM] THEN STRIP_TAC THEN
5112   EXISTS_TAC `\z:real^M. h(z) % (f:real^M->real^N)(a) + g(z - h(z) % a)` THEN
5113   REPEAT CONJ_TAC THENL
5114    [MAP_EVERY X_GEN_TAC [`x:real^M`; `y:real^M`] THEN STRIP_TAC THEN
5115     SUBGOAL_THEN `(h:real^M->real)(x + y) = h(x) + h(y)` ASSUME_TAC THENL
5116      [CONV_TAC SYM_CONV THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
5117       REWRITE_TAC[VECTOR_ARITH
5118        `(x + y) - (k + l) % a = (x - k % a) + (y - l % a)`] THEN
5119       CONJ_TAC THEN MATCH_MP_TAC SPAN_ADD THEN ASM_REWRITE_TAC[] THEN
5120       ASM_SIMP_TAC[];
5121       ALL_TAC] THEN
5122     ASM_REWRITE_TAC[VECTOR_ARITH
5123        `(x + y) - (k + l) % a = (x - k % a) + (y - l % a)`] THEN
5124     ASM_SIMP_TAC[] THEN VECTOR_ARITH_TAC;
5125     MAP_EVERY X_GEN_TAC [`x:real^M`; `c:real`] THEN STRIP_TAC THEN
5126     SUBGOAL_THEN `(h:real^M->real)(c % x) = c * h(x)` ASSUME_TAC THENL
5127      [CONV_TAC SYM_CONV THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
5128       REWRITE_TAC[VECTOR_ARITH
5129        `c % x - (c * k) % a = c % (x - k % a)`] THEN
5130       CONJ_TAC THEN MATCH_MP_TAC SPAN_MUL THEN ASM_REWRITE_TAC[] THEN
5131       ASM_SIMP_TAC[];
5132       ALL_TAC] THEN
5133     ASM_REWRITE_TAC[VECTOR_ARITH
5134        `c % x - (c * k) % a = c % (x - k % a)`] THEN
5135     ASM_SIMP_TAC[] THEN VECTOR_ARITH_TAC;
5136     ALL_TAC] THEN
5137   X_GEN_TAC `x:real^M` THEN REWRITE_TAC[IN_INSERT] THEN
5138   DISCH_THEN(DISJ_CASES_THEN2 SUBST_ALL_TAC ASSUME_TAC) THENL
5139    [SUBGOAL_THEN `&1 = h(a:real^M)` (SUBST1_TAC o SYM) THENL
5140      [FIRST_X_ASSUM MATCH_MP_TAC; ALL_TAC] THEN
5141     REWRITE_TAC[VECTOR_ARITH `a - &1 % a = vec 0`; SPAN_0] THENL
5142      [ASM_MESON_TAC[SPAN_SUPERSET; SUBSET; IN_INSERT]; ALL_TAC] THEN
5143     FIRST_X_ASSUM(MP_TAC o SPECL [`vec 0:real^M`; `vec 0:real^M`]) THEN
5144     REWRITE_TAC[SPAN_0; VECTOR_ADD_LID] THEN
5145     REWRITE_TAC[VECTOR_ARITH `(a = a + a) <=> (a = vec 0)`] THEN
5146     DISCH_THEN SUBST1_TAC THEN VECTOR_ARITH_TAC;
5147     ALL_TAC] THEN
5148   SUBGOAL_THEN `&0 = h(x:real^M)` (SUBST1_TAC o SYM) THENL
5149    [FIRST_X_ASSUM MATCH_MP_TAC; ALL_TAC] THEN
5150   REWRITE_TAC[VECTOR_ADD_LID; VECTOR_MUL_LZERO; VECTOR_SUB_RZERO] THEN
5151   ASM_MESON_TAC[SUBSET; IN_INSERT; SPAN_SUPERSET]);;
5152
5153 let LINEAR_INDEPENDENT_EXTEND = prove
5154  (`!f b. independent b
5155          ==> ?g:real^M->real^N. linear g /\ (!x. x IN b ==> (g x = f x))`,
5156   REPEAT STRIP_TAC THEN
5157   MP_TAC(ISPECL [`b:real^M->bool`; `(:real^M)`]
5158            MAXIMAL_INDEPENDENT_SUBSET_EXTEND) THEN
5159   ASM_REWRITE_TAC[SUBSET_UNIV; UNIV_SUBSET] THEN
5160   REWRITE_TAC[EXTENSION; IN_UNIV] THEN
5161   DISCH_THEN(X_CHOOSE_THEN `c:real^M->bool` STRIP_ASSUME_TAC) THEN
5162   MP_TAC(ISPECL [`f:real^M->real^N`; `c:real^M->bool`]
5163     LINEAR_INDEPENDENT_EXTEND_LEMMA) THEN
5164   ASM_SIMP_TAC[INDEPENDENT_BOUND; linear] THEN
5165   ASM_MESON_TAC[SUBSET]);;
5166
5167 (* ------------------------------------------------------------------------- *)
5168 (* Linear functions are equal on a subspace if they are on a spanning set.   *)
5169 (* ------------------------------------------------------------------------- *)
5170
5171 let SUBSPACE_KERNEL = prove
5172  (`!f. linear f ==> subspace {x | f(x) = vec 0}`,
5173   REWRITE_TAC[subspace; IN_ELIM_THM] THEN
5174   SIMP_TAC[LINEAR_ADD; LINEAR_CMUL; VECTOR_ADD_LID; VECTOR_MUL_RZERO] THEN
5175   MESON_TAC[LINEAR_0]);;
5176
5177 let LINEAR_EQ_0_SPAN = prove
5178  (`!f:real^M->real^N b.
5179         linear f /\ (!x. x IN b ==> f(x) = vec 0)
5180         ==> !x. x IN span(b) ==> f(x) = vec 0`,
5181   REPEAT GEN_TAC THEN STRIP_TAC THEN
5182   RULE_ASSUM_TAC(REWRITE_RULE[IN]) THEN
5183   MATCH_MP_TAC SPAN_INDUCT THEN ASM_REWRITE_TAC[IN] THEN
5184   MP_TAC(ISPEC `f:real^M->real^N` SUBSPACE_KERNEL) THEN
5185   ASM_REWRITE_TAC[] THEN MATCH_MP_TAC EQ_IMP THEN
5186   AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM]);;
5187
5188 let LINEAR_EQ_0 = prove
5189  (`!f b s. linear f /\ s SUBSET (span b) /\ (!x. x IN b ==> f(x) = vec 0)
5190            ==> !x. x IN s ==> f(x) = vec 0`,
5191   MESON_TAC[LINEAR_EQ_0_SPAN; SUBSET]);;
5192
5193 let LINEAR_EQ = prove
5194  (`!f g b s. linear f /\ linear g /\ s SUBSET (span b) /\
5195              (!x. x IN b ==> f(x) = g(x))
5196               ==> !x. x IN s ==> f(x) = g(x)`,
5197   REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM VECTOR_SUB_EQ] THEN
5198   STRIP_TAC THEN MATCH_MP_TAC LINEAR_EQ_0 THEN
5199   ASM_MESON_TAC[LINEAR_COMPOSE_SUB]);;
5200
5201 let LINEAR_EQ_STDBASIS = prove
5202  (`!f:real^M->real^N g.
5203         linear f /\ linear g /\
5204         (!i. 1 <= i /\ i <= dimindex(:M)
5205              ==> f(basis i) = g(basis i))
5206         ==> f = g`,
5207   REPEAT STRIP_TAC THEN
5208   SUBGOAL_THEN `!x. x IN UNIV ==> (f:real^M->real^N) x = g x`
5209    (fun th -> MP_TAC th THEN REWRITE_TAC[FUN_EQ_THM; IN_UNIV]) THEN
5210   MATCH_MP_TAC LINEAR_EQ THEN
5211   EXISTS_TAC `{basis i :real^M | 1 <= i /\ i <= dimindex(:M)}` THEN
5212   ASM_REWRITE_TAC[SPAN_STDBASIS; SUBSET_REFL; IN_ELIM_THM] THEN
5213   ASM_MESON_TAC[]);;
5214
5215 let SUBSPACE_LINEAR_FIXED_POINTS = prove
5216  (`!f:real^N->real^N. linear f ==> subspace {x | f(x) = x}`,
5217   REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM VECTOR_SUB_EQ] THEN
5218   MATCH_MP_TAC SUBSPACE_KERNEL THEN
5219   ASM_SIMP_TAC[LINEAR_COMPOSE_SUB; LINEAR_ID]);;
5220
5221 (* ------------------------------------------------------------------------- *)
5222 (* Similar results for bilinear functions.                                   *)
5223 (* ------------------------------------------------------------------------- *)
5224
5225 let BILINEAR_EQ = prove
5226  (`!f:real^M->real^N->real^P g b c s.
5227         bilinear f /\ bilinear g /\
5228         s SUBSET (span b) /\ t SUBSET (span c) /\
5229         (!x y. x IN b /\ y IN c ==> f x y = g x y)
5230          ==> !x y. x IN s /\ y IN t ==> f x y = g x y`,
5231   REPEAT STRIP_TAC THEN SUBGOAL_THEN
5232     `!x:real^M. x IN span b
5233                 ==> !y:real^N. y IN span c ==> (f x y :real^P = g x y)`
5234     (fun th -> ASM_MESON_TAC[th; SUBSET]) THEN
5235   MATCH_MP_TAC SPAN_INDUCT THEN REWRITE_TAC[subspace; IN_ELIM_THM] THEN
5236   CONJ_TAC THENL
5237    [GEN_TAC THEN DISCH_TAC;
5238     ASM_SIMP_TAC[BILINEAR_LADD; BILINEAR_LMUL] THEN
5239     ASM_MESON_TAC[BILINEAR_LZERO]] THEN
5240   MATCH_MP_TAC SPAN_INDUCT THEN REWRITE_TAC[subspace; IN_ELIM_THM] THEN
5241   ASM_SIMP_TAC[BILINEAR_RADD; BILINEAR_RMUL] THEN
5242   ASM_MESON_TAC[BILINEAR_RZERO]);;
5243
5244 let BILINEAR_EQ_STDBASIS = prove
5245  (`!f:real^M->real^N->real^P g.
5246         bilinear f /\ bilinear g /\
5247         (!i j. 1 <= i /\ i <= dimindex(:M) /\ 1 <= j /\ j <= dimindex(:N)
5248              ==> f (basis i) (basis j) = g (basis i) (basis j))
5249         ==> f = g`,
5250   REPEAT STRIP_TAC THEN SUBGOAL_THEN
5251    `!x y. x IN UNIV /\ y IN UNIV ==> (f:real^M->real^N->real^P) x y = g x y`
5252    (fun th -> MP_TAC th THEN REWRITE_TAC[FUN_EQ_THM; IN_UNIV]) THEN
5253   MATCH_MP_TAC BILINEAR_EQ THEN
5254   EXISTS_TAC `{basis i :real^M | 1 <= i /\ i <= dimindex(:M)}` THEN
5255   EXISTS_TAC `{basis i :real^N | 1 <= i /\ i <= dimindex(:N)}` THEN
5256   ASM_REWRITE_TAC[SPAN_STDBASIS; SUBSET_REFL; IN_ELIM_THM] THEN
5257   ASM_MESON_TAC[]);;
5258
5259 (* ------------------------------------------------------------------------- *)
5260 (* Detailed theorems about left and right invertibility in general case.     *)
5261 (* ------------------------------------------------------------------------- *)
5262
5263 let LEFT_INVERTIBLE_TRANSP = prove
5264  (`!A:real^N^M.
5265     (?B:real^N^M. B ** transp A = mat 1) <=> (?B:real^M^N. A ** B = mat 1)`,
5266   MESON_TAC[MATRIX_TRANSP_MUL; TRANSP_MAT; TRANSP_TRANSP]);;
5267
5268 let RIGHT_INVERTIBLE_TRANSP = prove
5269  (`!A:real^N^M.
5270     (?B:real^N^M. transp A ** B = mat 1) <=> (?B:real^M^N. B ** A = mat 1)`,
5271   MESON_TAC[MATRIX_TRANSP_MUL; TRANSP_MAT; TRANSP_TRANSP]);;
5272
5273 let INVERTIBLE_TRANSP = prove
5274  (`!A:real^N^M. invertible(transp A) <=> invertible A`,
5275   GEN_TAC THEN REWRITE_TAC[invertible] THEN
5276   GEN_REWRITE_TAC LAND_CONV [MESON[TRANSP_TRANSP]
5277     `(?A:real^M^N. P A) <=> (?A:real^N^M. P(transp A))`] THEN
5278   GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [GSYM TRANSP_MAT] THEN
5279   REWRITE_TAC[GSYM MATRIX_TRANSP_MUL; TRANSP_EQ] THEN MESON_TAC[]);;
5280
5281 let LINEAR_INJECTIVE_LEFT_INVERSE = prove
5282  (`!f:real^M->real^N.
5283         linear f /\ (!x y. f x = f y ==> x = y)
5284         ==> ?g. linear g /\ g o f = I`,
5285   REWRITE_TAC[INJECTIVE_LEFT_INVERSE] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN
5286    `?h. linear(h:real^N->real^M) /\
5287         !x. x IN IMAGE (f:real^M->real^N)
5288                {basis i | 1 <= i /\ i <= dimindex(:M)} ==> h x = g x`
5289   MP_TAC THENL
5290    [MATCH_MP_TAC LINEAR_INDEPENDENT_EXTEND THEN
5291     MATCH_MP_TAC INDEPENDENT_INJECTIVE_IMAGE THEN
5292     ASM_MESON_TAC[INJECTIVE_LEFT_INVERSE; INDEPENDENT_STDBASIS];
5293     MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `h:real^N->real^M` THEN
5294     ASM_REWRITE_TAC[FORALL_IN_IMAGE; IN_ELIM_THM] THEN STRIP_TAC THEN
5295     ASM_REWRITE_TAC[] THEN MATCH_MP_TAC LINEAR_EQ_STDBASIS THEN
5296     ASM_SIMP_TAC[I_DEF; LINEAR_COMPOSE; LINEAR_ID; o_THM] THEN
5297     ASM_MESON_TAC[]]);;
5298
5299 let LINEAR_SURJECTIVE_RIGHT_INVERSE = prove
5300  (`!f:real^M->real^N.
5301         linear f /\ (!y. ?x. f x = y) ==> ?g. linear g /\ f o g = I`,
5302   REWRITE_TAC[SURJECTIVE_RIGHT_INVERSE] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN
5303    `?h. linear(h:real^N->real^M) /\
5304         !x. x IN {basis i | 1 <= i /\ i <= dimindex(:N)} ==> h x = g x`
5305   MP_TAC THENL
5306    [MATCH_MP_TAC LINEAR_INDEPENDENT_EXTEND THEN
5307     REWRITE_TAC[INDEPENDENT_STDBASIS];
5308     MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `h:real^N->real^M` THEN
5309     ASM_REWRITE_TAC[FORALL_IN_IMAGE; IN_ELIM_THM] THEN STRIP_TAC THEN
5310     ASM_REWRITE_TAC[] THEN MATCH_MP_TAC LINEAR_EQ_STDBASIS THEN
5311     ASM_SIMP_TAC[I_DEF; LINEAR_COMPOSE; LINEAR_ID; o_THM] THEN
5312     ASM_MESON_TAC[]]);;
5313
5314 let MATRIX_LEFT_INVERTIBLE_INJECTIVE = prove
5315  (`!A:real^N^M.
5316         (?B:real^M^N. B ** A = mat 1) <=>
5317         !x y:real^N. A ** x = A ** y ==> x = y`,
5318   GEN_TAC THEN EQ_TAC THENL
5319    [STRIP_TAC THEN REPEAT GEN_TAC THEN
5320     DISCH_THEN(MP_TAC o AP_TERM `\x:real^M. (B:real^M^N) ** x`) THEN
5321     ASM_REWRITE_TAC[MATRIX_VECTOR_MUL_ASSOC; MATRIX_VECTOR_MUL_LID];
5322     DISCH_TAC THEN MP_TAC(ISPEC
5323      `\x:real^N. (A:real^N^M) ** x` LINEAR_INJECTIVE_LEFT_INVERSE) THEN
5324     ASM_REWRITE_TAC[MATRIX_VECTOR_MUL_LINEAR; FUN_EQ_THM; I_THM; o_THM] THEN
5325     DISCH_THEN(X_CHOOSE_THEN `g:real^M->real^N` STRIP_ASSUME_TAC) THEN
5326     EXISTS_TAC `matrix(g):real^M^N` THEN
5327     REWRITE_TAC[MATRIX_EQ; MATRIX_VECTOR_MUL_LID] THEN
5328     ASM_MESON_TAC[MATRIX_VECTOR_MUL_ASSOC; MATRIX_WORKS]]);;
5329
5330 let MATRIX_LEFT_INVERTIBLE_KER = prove
5331  (`!A:real^N^M.
5332         (?B:real^M^N. B ** A = mat 1) <=> !x. A ** x = vec 0 ==> x = vec 0`,
5333   GEN_TAC THEN REWRITE_TAC[MATRIX_LEFT_INVERTIBLE_INJECTIVE] THEN
5334   MATCH_MP_TAC LINEAR_INJECTIVE_0 THEN REWRITE_TAC[MATRIX_VECTOR_MUL_LINEAR]);;
5335
5336 let MATRIX_RIGHT_INVERTIBLE_SURJECTIVE = prove
5337  (`!A:real^N^M.
5338         (?B:real^M^N. A ** B = mat 1) <=> !y. ?x. A ** x = y`,
5339   GEN_TAC THEN EQ_TAC THENL
5340    [STRIP_TAC THEN X_GEN_TAC `y:real^M` THEN
5341     EXISTS_TAC `(B:real^M^N) ** (y:real^M)` THEN
5342     ASM_REWRITE_TAC[MATRIX_VECTOR_MUL_ASSOC; MATRIX_VECTOR_MUL_LID];
5343     DISCH_TAC THEN MP_TAC(ISPEC
5344      `\x:real^N. (A:real^N^M) ** x` LINEAR_SURJECTIVE_RIGHT_INVERSE) THEN
5345     ASM_REWRITE_TAC[MATRIX_VECTOR_MUL_LINEAR; FUN_EQ_THM; I_THM; o_THM] THEN
5346     DISCH_THEN(X_CHOOSE_THEN `g:real^M->real^N` STRIP_ASSUME_TAC) THEN
5347     EXISTS_TAC `matrix(g):real^M^N` THEN
5348     REWRITE_TAC[MATRIX_EQ; MATRIX_VECTOR_MUL_LID] THEN
5349     ASM_MESON_TAC[MATRIX_VECTOR_MUL_ASSOC; MATRIX_WORKS]]);;
5350
5351 let MATRIX_LEFT_INVERTIBLE_INDEPENDENT_COLUMNS = prove
5352  (`!A:real^N^M. (?B:real^M^N. B ** A = mat 1) <=>
5353                 !c. vsum(1..dimindex(:N)) (\i. c(i) % column i A) = vec 0 ==>
5354                     !i. 1 <= i /\ i <= dimindex(:N) ==> c(i) = &0`,
5355   GEN_TAC THEN REWRITE_TAC[MATRIX_LEFT_INVERTIBLE_KER; MATRIX_MUL_VSUM] THEN
5356   EQ_TAC THEN DISCH_TAC THENL
5357    [X_GEN_TAC `c:num->real` THEN DISCH_TAC THEN
5358     FIRST_X_ASSUM(MP_TAC o SPEC `(lambda i. c(i)):real^N`);
5359     X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
5360     FIRST_X_ASSUM(MP_TAC o SPEC `\i. (x:real^N)$i`)] THEN
5361   ASM_SIMP_TAC[LAMBDA_BETA; CART_EQ; VEC_COMPONENT]);;
5362
5363 let MATRIX_RIGHT_INVERTIBLE_INDEPENDENT_ROWS = prove
5364  (`!A:real^N^M. (?B:real^M^N. A ** B = mat 1) <=>
5365                 !c. vsum(1..dimindex(:M)) (\i. c(i) % row i A) = vec 0 ==>
5366                     !i. 1 <= i /\ i <= dimindex(:M) ==> c(i) = &0`,
5367   ONCE_REWRITE_TAC[GSYM LEFT_INVERTIBLE_TRANSP] THEN
5368   REWRITE_TAC[MATRIX_LEFT_INVERTIBLE_INDEPENDENT_COLUMNS] THEN
5369   SIMP_TAC[COLUMN_TRANSP]);;
5370
5371 let MATRIX_RIGHT_INVERTIBLE_SPAN_COLUMNS = prove
5372  (`!A:real^N^M. (?B:real^M^N. A ** B = mat 1) <=> span(columns A) = (:real^M)`,
5373   GEN_TAC THEN REWRITE_TAC[MATRIX_RIGHT_INVERTIBLE_SURJECTIVE] THEN
5374   REWRITE_TAC[MATRIX_MUL_VSUM; EXTENSION; IN_UNIV] THEN
5375   AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `y:real^M` THEN
5376   EQ_TAC THENL
5377    [DISCH_THEN(X_CHOOSE_THEN `x:real^N` (SUBST1_TAC o SYM)) THEN
5378     MATCH_MP_TAC SPAN_VSUM THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN
5379     X_GEN_TAC `i:num` THEN STRIP_TAC THEN MATCH_MP_TAC SPAN_MUL THEN
5380     MATCH_MP_TAC(CONJUNCT1 SPAN_CLAUSES) THEN
5381     REWRITE_TAC[columns; IN_ELIM_THM] THEN ASM_MESON_TAC[];
5382     ALL_TAC] THEN
5383   SPEC_TAC(`y:real^M`,`y:real^M`) THEN MATCH_MP_TAC SPAN_INDUCT_ALT THEN
5384   CONJ_TAC THENL
5385    [EXISTS_TAC `vec 0 :real^N` THEN
5386     SIMP_TAC[VEC_COMPONENT; VECTOR_MUL_LZERO; VSUM_0];
5387     ALL_TAC] THEN
5388   MAP_EVERY X_GEN_TAC [`c:real`; `y1:real^M`; `y2:real^M`] THEN
5389   REWRITE_TAC[columns; IN_ELIM_THM] THEN DISCH_THEN(CONJUNCTS_THEN2
5390    (X_CHOOSE_THEN `i:num` STRIP_ASSUME_TAC)
5391    (X_CHOOSE_THEN `x:real^N` (SUBST1_TAC o SYM))) THEN
5392   EXISTS_TAC `(lambda j. if j = i then c + (x:real^N)$i else x$j):real^N` THEN
5393   SUBGOAL_THEN `1..dimindex(:N) = i INSERT ((1..dimindex(:N)) DELETE i)`
5394   SUBST1_TAC THENL [ASM_MESON_TAC[INSERT_DELETE; IN_NUMSEG]; ALL_TAC] THEN
5395   SIMP_TAC[VSUM_CLAUSES; FINITE_DELETE; FINITE_NUMSEG; IN_DELETE] THEN
5396   ASM_SIMP_TAC[LAMBDA_BETA; VECTOR_ADD_RDISTRIB; VECTOR_ADD_ASSOC] THEN
5397   AP_TERM_TAC THEN MATCH_MP_TAC VSUM_EQ THEN
5398   SIMP_TAC[FINITE_DELETE; IN_DELETE; FINITE_NUMSEG; LAMBDA_BETA; IN_NUMSEG]);;
5399
5400 let MATRIX_LEFT_INVERTIBLE_SPAN_ROWS = prove
5401  (`!A:real^N^M. (?B:real^M^N. B ** A = mat 1) <=> span(rows A) = (:real^N)`,
5402   MESON_TAC[RIGHT_INVERTIBLE_TRANSP; COLUMNS_TRANSP;
5403             MATRIX_RIGHT_INVERTIBLE_SPAN_COLUMNS]);;
5404
5405 (* ------------------------------------------------------------------------- *)
5406 (* An injective map real^N->real^N is also surjective.                       *)
5407 (* ------------------------------------------------------------------------- *)
5408
5409 let LINEAR_INJECTIVE_IMP_SURJECTIVE = prove
5410  (`!f:real^N->real^N.
5411         linear f /\ (!x y. (f(x) = f(y)) ==> (x = y))
5412         ==> !y. ?x. f(x) = y`,
5413   REPEAT STRIP_TAC THEN
5414   MP_TAC(ISPEC `(:real^N)` BASIS_EXISTS) THEN
5415   REWRITE_TAC[SUBSET_UNIV; HAS_SIZE] THEN
5416   DISCH_THEN(X_CHOOSE_THEN `b:real^N->bool` STRIP_ASSUME_TAC) THEN
5417   SUBGOAL_THEN `UNIV SUBSET span(IMAGE (f:real^N->real^N) b)` MP_TAC THENL
5418    [MATCH_MP_TAC CARD_GE_DIM_INDEPENDENT THEN
5419     ASM_MESON_TAC[INDEPENDENT_INJECTIVE_IMAGE; LE_REFL;
5420                   SUBSET_UNIV; CARD_IMAGE_INJ];
5421     ASM_SIMP_TAC[SPAN_LINEAR_IMAGE] THEN
5422     ASM_MESON_TAC[SUBSET; IN_IMAGE; IN_UNIV]]);;
5423
5424 (* ------------------------------------------------------------------------- *)
5425 (* And vice versa.                                                           *)
5426 (* ------------------------------------------------------------------------- *)
5427
5428 let LINEAR_SURJECTIVE_IMP_INJECTIVE = prove
5429  (`!f:real^N->real^N.
5430         linear f /\ (!y. ?x. f(x) = y)
5431         ==> !x y. (f(x) = f(y)) ==> (x = y)`,
5432   REPEAT GEN_TAC THEN STRIP_TAC THEN
5433   MP_TAC(ISPEC `(:real^N)` BASIS_EXISTS) THEN
5434   REWRITE_TAC[SUBSET_UNIV; HAS_SIZE] THEN
5435   DISCH_THEN(X_CHOOSE_THEN `b:real^N->bool` STRIP_ASSUME_TAC) THEN
5436   SUBGOAL_THEN
5437    `!x. x IN span b ==> (f:real^N->real^N) x = vec 0 ==> x = vec 0`
5438    (fun th -> ASM_MESON_TAC[th; LINEAR_INJECTIVE_0; SUBSET; IN_UNIV]) THEN
5439   MATCH_MP_TAC LINEAR_INDEP_IMAGE_LEMMA THEN
5440   ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
5441    [MATCH_MP_TAC CARD_LE_DIM_SPANNING THEN
5442     EXISTS_TAC `(:real^N)` THEN
5443     ASM_SIMP_TAC[SUBSET_UNIV; FINITE_IMAGE; SPAN_LINEAR_IMAGE] THEN
5444     REWRITE_TAC[SUBSET; IN_UNIV; IN_IMAGE] THEN
5445     ASM_MESON_TAC[CARD_IMAGE_LE; SUBSET; IN_UNIV];
5446     ALL_TAC] THEN
5447   SUBGOAL_THEN `dim(:real^N) <= CARD(IMAGE (f:real^N->real^N) b)`
5448   MP_TAC THENL
5449    [MATCH_MP_TAC SPAN_CARD_GE_DIM THEN
5450     ASM_SIMP_TAC[SUBSET_UNIV; FINITE_IMAGE] THEN
5451     ASM_SIMP_TAC[SPAN_LINEAR_IMAGE] THEN MATCH_MP_TAC SUBSET_TRANS THEN
5452     EXISTS_TAC `IMAGE (f:real^N->real^N) UNIV` THEN
5453     ASM_SIMP_TAC[IMAGE_SUBSET] THEN
5454     ASM_REWRITE_TAC[SUBSET; IN_IMAGE; IN_UNIV] THEN ASM_MESON_TAC[];
5455     ALL_TAC] THEN
5456   FIRST_X_ASSUM(MP_TAC o ISPEC `f:real^N->real^N` o
5457                 MATCH_MP CARD_IMAGE_LE) THEN
5458   ASM_REWRITE_TAC[IMP_IMP; LE_ANTISYM] THEN DISCH_TAC THEN
5459   MP_TAC(ISPECL
5460    [`b:real^N->bool`; `IMAGE (f:real^N->real^N) b`; `f:real^N->real^N`]
5461    SURJECTIVE_IFF_INJECTIVE_GEN) THEN
5462   ASM_SIMP_TAC[FINITE_IMAGE; INDEPENDENT_BOUND; SUBSET_REFL] THEN
5463   REWRITE_TAC[FORALL_IN_IMAGE] THEN MESON_TAC[]);;
5464
5465 let LINEAR_SURJECTIVE_IFF_INJECTIVE = prove
5466  (`!f:real^N->real^N.
5467       linear f ==> ((!y. ?x. f x = y) <=> (!x y. f x = f y ==> x = y))`,
5468   MESON_TAC[LINEAR_INJECTIVE_IMP_SURJECTIVE;
5469             LINEAR_SURJECTIVE_IMP_INJECTIVE]);;
5470
5471 (* ------------------------------------------------------------------------- *)
5472 (* Hence either is enough for isomorphism.                                   *)
5473 (* ------------------------------------------------------------------------- *)
5474
5475 let LEFT_RIGHT_INVERSE_EQ = prove
5476  (`!f:A->A g h. f o g = I /\ g o h = I ==> f = h`,
5477   MESON_TAC[o_ASSOC; I_O_ID]);;
5478
5479 let ISOMORPHISM_EXPAND = prove
5480  (`!f g. f o g = I /\ g o f = I <=> (!x. f(g x) = x) /\ (!x. g(f x) = x)`,
5481   REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM]);;
5482
5483 let LINEAR_INJECTIVE_ISOMORPHISM = prove
5484  (`!f:real^N->real^N.
5485         linear f /\ (!x y. f x = f y ==> x = y)
5486         ==> ?f'. linear f' /\ (!x. f'(f x) = x) /\ (!x. f(f' x) = x)`,
5487   REPEAT STRIP_TAC THEN
5488   REWRITE_TAC[GSYM ISOMORPHISM_EXPAND] THEN
5489   MP_TAC(ISPEC `f:real^N->real^N` LINEAR_SURJECTIVE_RIGHT_INVERSE) THEN
5490   MP_TAC(ISPEC `f:real^N->real^N` LINEAR_INJECTIVE_LEFT_INVERSE) THEN
5491   MP_TAC(ISPEC `f:real^N->real^N` LINEAR_INJECTIVE_IMP_SURJECTIVE) THEN
5492   ASM_REWRITE_TAC[] THEN SIMP_TAC[] THEN MESON_TAC[LEFT_RIGHT_INVERSE_EQ]);;
5493
5494 let LINEAR_SURJECTIVE_ISOMORPHISM = prove
5495  (`!f:real^N->real^N.
5496         linear f /\ (!y. ?x. f x = y)
5497         ==> ?f'. linear f' /\ (!x. f'(f x) = x) /\ (!x. f(f' x) = x)`,
5498   REPEAT STRIP_TAC THEN
5499   REWRITE_TAC[GSYM ISOMORPHISM_EXPAND] THEN
5500   MP_TAC(ISPEC `f:real^N->real^N` LINEAR_SURJECTIVE_RIGHT_INVERSE) THEN
5501   MP_TAC(ISPEC `f:real^N->real^N` LINEAR_INJECTIVE_LEFT_INVERSE) THEN
5502   MP_TAC(ISPEC `f:real^N->real^N` LINEAR_SURJECTIVE_IMP_INJECTIVE) THEN
5503   ASM_REWRITE_TAC[] THEN SIMP_TAC[] THEN MESON_TAC[LEFT_RIGHT_INVERSE_EQ]);;
5504
5505 (* ------------------------------------------------------------------------- *)
5506 (* Left and right inverses are the same for R^N->R^N.                        *)
5507 (* ------------------------------------------------------------------------- *)
5508
5509 let LINEAR_INVERSE_LEFT = prove
5510  (`!f:real^N->real^N f'.
5511         linear f /\ linear f' ==> ((f o f' = I) <=> (f' o f = I))`,
5512   SUBGOAL_THEN
5513    `!f:real^N->real^N f'.
5514         linear f /\ linear f' /\ (f o f' = I) ==> (f' o f = I)`
5515    (fun th -> MESON_TAC[th]) THEN
5516   REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM] THEN REPEAT STRIP_TAC THEN
5517   MP_TAC(ISPEC `f:real^N->real^N` LINEAR_SURJECTIVE_ISOMORPHISM) THEN
5518   ASM_MESON_TAC[]);;
5519
5520 (* ------------------------------------------------------------------------- *)
5521 (* Moreover, a one-sided inverse is automatically linear.                    *)
5522 (* ------------------------------------------------------------------------- *)
5523
5524 let LEFT_INVERSE_LINEAR = prove
5525  (`!f g:real^N->real^N. linear f /\ (g o f = I) ==> linear g`,
5526   REPEAT GEN_TAC THEN REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM] THEN
5527   STRIP_TAC THEN SUBGOAL_THEN
5528    `?h:real^N->real^N. linear h /\ (!x. h(f x) = x) /\ (!x. f(h x) = x)`
5529   CHOOSE_TAC THENL
5530    [MATCH_MP_TAC LINEAR_INJECTIVE_ISOMORPHISM THEN ASM_MESON_TAC[];
5531     SUBGOAL_THEN `g:real^N->real^N = h` (fun th -> ASM_REWRITE_TAC[th]) THEN
5532     REWRITE_TAC[FUN_EQ_THM] THEN ASM_MESON_TAC[]]);;
5533
5534 let RIGHT_INVERSE_LINEAR = prove
5535  (`!f g:real^N->real^N. linear f /\ (f o g = I) ==> linear g`,
5536   REPEAT GEN_TAC THEN REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM] THEN
5537   STRIP_TAC THEN SUBGOAL_THEN
5538    `?h:real^N->real^N. linear h /\ (!x. h(f x) = x) /\ (!x. f(h x) = x)`
5539   CHOOSE_TAC THENL [ASM_MESON_TAC[LINEAR_SURJECTIVE_ISOMORPHISM]; ALL_TAC] THEN
5540   SUBGOAL_THEN `g:real^N->real^N = h` (fun th -> ASM_REWRITE_TAC[th]) THEN
5541   REWRITE_TAC[FUN_EQ_THM] THEN ASM_MESON_TAC[]);;
5542
5543 (* ------------------------------------------------------------------------- *)
5544 (* Without (ostensible) constraints on types, though dimensions must match.  *)
5545 (* ------------------------------------------------------------------------- *)
5546
5547 let LEFT_RIGHT_INVERSE_LINEAR = prove
5548  (`!f g:real^M->real^N.
5549         linear f /\ g o f = I /\ f o g = I ==> linear g`,
5550   REWRITE_TAC[linear; FUN_EQ_THM; o_THM; I_THM] THEN MESON_TAC[]);;
5551
5552 let LINEAR_BIJECTIVE_LEFT_RIGHT_INVERSE = prove
5553  (`!f:real^M->real^N.
5554         linear f /\ (!x y. f x = f y ==> x = y) /\ (!y. ?x. f x = y)
5555         ==> ?g. linear g /\ (!x. g(f x) = x) /\ (!y. f(g y) = y)`,
5556   GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN ASSUME_TAC) THEN
5557   FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [BIJECTIVE_LEFT_RIGHT_INVERSE]) THEN
5558   MATCH_MP_TAC MONO_EXISTS THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
5559   MATCH_MP_TAC LEFT_RIGHT_INVERSE_LINEAR THEN
5560   EXISTS_TAC `f:real^M->real^N` THEN
5561   ASM_REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM]);;
5562
5563 (* ------------------------------------------------------------------------- *)
5564 (* The same result in terms of square matrices.                              *)
5565 (* ------------------------------------------------------------------------- *)
5566
5567 let MATRIX_LEFT_RIGHT_INVERSE = prove
5568  (`!A:real^N^N A':real^N^N. (A ** A' = mat 1) <=> (A' ** A = mat 1)`,
5569   SUBGOAL_THEN
5570     `!A:real^N^N A':real^N^N. (A ** A' = mat 1) ==> (A' ** A = mat 1)`
5571     (fun th -> MESON_TAC[th]) THEN
5572   REPEAT STRIP_TAC THEN
5573   MP_TAC(ISPEC `\x:real^N. A:(real^N^N) ** x`
5574     LINEAR_SURJECTIVE_ISOMORPHISM) THEN
5575   REWRITE_TAC[MATRIX_VECTOR_MUL_LINEAR] THEN ANTS_TAC THENL
5576    [X_GEN_TAC `x:real^N` THEN EXISTS_TAC `(A':real^N^N) ** (x:real^N)` THEN
5577     ASM_REWRITE_TAC[MATRIX_VECTOR_MUL_ASSOC; MATRIX_VECTOR_MUL_LID];
5578     ALL_TAC] THEN
5579   DISCH_THEN(X_CHOOSE_THEN `f':real^N->real^N` STRIP_ASSUME_TAC) THEN
5580   SUBGOAL_THEN `matrix (f':real^N->real^N) ** (A:real^N^N) = mat 1`
5581   MP_TAC THENL
5582    [ASM_SIMP_TAC[MATRIX_EQ; MATRIX_WORKS; GSYM MATRIX_VECTOR_MUL_ASSOC;
5583                  MATRIX_VECTOR_MUL_LID];
5584     ALL_TAC] THEN
5585   DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN
5586   DISCH_THEN(MP_TAC o AP_TERM `(\m:real^N^N. m ** (A':real^N^N))`) THEN
5587   REWRITE_TAC[GSYM MATRIX_MUL_ASSOC] THEN
5588   ASM_REWRITE_TAC[MATRIX_MUL_RID; MATRIX_MUL_LID] THEN ASM_MESON_TAC[]);;
5589
5590 (* ------------------------------------------------------------------------- *)
5591 (* Invertibility of matrices and corresponding linear functions.             *)
5592 (* ------------------------------------------------------------------------- *)
5593
5594 let MATRIX_LEFT_INVERTIBLE = prove
5595  (`!f:real^M->real^N.
5596     linear f ==> ((?B:real^N^M. B ** matrix f = mat 1) <=>
5597                   (?g. linear g /\ g o f = I))`,
5598   GEN_TAC THEN DISCH_TAC THEN EQ_TAC THEN STRIP_TAC THENL
5599    [EXISTS_TAC `\y:real^N. (B:real^N^M) ** y` THEN
5600     REWRITE_TAC[MATRIX_VECTOR_MUL_LINEAR] THEN
5601     FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV)
5602                 [MATCH_MP MATRIX_VECTOR_MUL th]) THEN
5603     ASM_REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM; MATRIX_VECTOR_MUL_ASSOC;
5604                     MATRIX_VECTOR_MUL_LID];
5605     EXISTS_TAC `matrix(g:real^N->real^M)` THEN
5606     ASM_SIMP_TAC[GSYM MATRIX_COMPOSE; MATRIX_I]]);;
5607
5608 let MATRIX_RIGHT_INVERTIBLE = prove
5609  (`!f:real^M->real^N.
5610     linear f ==> ((?B:real^N^M. matrix f ** B = mat 1) <=>
5611                   (?g. linear g /\ f o g = I))`,
5612   GEN_TAC THEN DISCH_TAC THEN EQ_TAC THEN STRIP_TAC THENL
5613    [EXISTS_TAC `\y:real^N. (B:real^N^M) ** y` THEN
5614     REWRITE_TAC[MATRIX_VECTOR_MUL_LINEAR] THEN
5615     FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC (LAND_CONV o LAND_CONV)
5616                 [MATCH_MP MATRIX_VECTOR_MUL th]) THEN
5617     ASM_REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM; MATRIX_VECTOR_MUL_ASSOC;
5618                     MATRIX_VECTOR_MUL_LID];
5619     EXISTS_TAC `matrix(g:real^N->real^M)` THEN
5620     ASM_SIMP_TAC[GSYM MATRIX_COMPOSE; MATRIX_I]]);;
5621
5622 let INVERTIBLE_LEFT_INVERSE = prove
5623  (`!A:real^N^N. invertible(A) <=> ?B:real^N^N. B ** A = mat 1`,
5624   MESON_TAC[invertible; MATRIX_LEFT_RIGHT_INVERSE]);;
5625
5626 let INVERTIBLE_RIGHT_INVERSE = prove
5627  (`!A:real^N^N. invertible(A) <=> ?B:real^N^N. A ** B = mat 1`,
5628   MESON_TAC[invertible; MATRIX_LEFT_RIGHT_INVERSE]);;
5629
5630 let MATRIX_INVERTIBLE = prove
5631  (`!f:real^N->real^N.
5632         linear f
5633         ==> (invertible(matrix f) <=>
5634              ?g. linear g /\ f o g = I /\ g o f = I)`,
5635   SIMP_TAC[INVERTIBLE_LEFT_INVERSE; MATRIX_LEFT_INVERTIBLE] THEN
5636   MESON_TAC[LINEAR_INVERSE_LEFT]);;
5637
5638 let MATRIX_INV_UNIQUE_LEFT = prove
5639  (`!A:real^N^N B. A ** B = mat 1 ==> matrix_inv B = A`,
5640   REPEAT STRIP_TAC THEN MATCH_MP_TAC MATRIX_INV_UNIQUE THEN
5641   ASM_MESON_TAC[MATRIX_LEFT_RIGHT_INVERSE]);;
5642
5643 let MATRIX_INV_UNIQUE_RIGHT = prove
5644  (`!A:real^N^N B. A ** B = mat 1 ==> matrix_inv A = B`,
5645   REPEAT STRIP_TAC THEN MATCH_MP_TAC MATRIX_INV_UNIQUE THEN
5646   ASM_MESON_TAC[MATRIX_LEFT_RIGHT_INVERSE]);;
5647
5648 (* ------------------------------------------------------------------------- *)
5649 (* Left-invertible linear transformation has a lower bound.                  *)
5650 (* ------------------------------------------------------------------------- *)
5651
5652 let LINEAR_INVERTIBLE_BOUNDED_BELOW_POS = prove
5653  (`!f:real^M->real^N g.
5654         linear f /\ linear g /\ (g o f = I)
5655         ==> ?B. &0 < B /\ !x. B * norm(x) <= norm(f x)`,
5656   REPEAT STRIP_TAC THEN
5657   MP_TAC(ISPEC `g:real^N->real^M` LINEAR_BOUNDED_POS) THEN
5658   ASM_REWRITE_TAC[] THEN
5659   DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN
5660   EXISTS_TAC `inv B:real` THEN ASM_REWRITE_TAC[REAL_LT_INV_EQ] THEN
5661   X_GEN_TAC `x:real^M` THEN MATCH_MP_TAC REAL_LE_TRANS THEN
5662   EXISTS_TAC `inv(B) * norm(((g:real^N->real^M) o (f:real^M->real^N)) x)` THEN
5663   CONJ_TAC THENL [ASM_SIMP_TAC[I_THM; REAL_LE_REFL]; ALL_TAC] THEN
5664   REWRITE_TAC[REAL_ARITH `inv B * x = x / B`] THEN
5665   ASM_SIMP_TAC[o_THM; REAL_LE_LDIV_EQ] THEN
5666   ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_REWRITE_TAC[]);;
5667
5668 let LINEAR_INVERTIBLE_BOUNDED_BELOW = prove
5669  (`!f:real^M->real^N g.
5670         linear f /\ linear g /\ (g o f = I)
5671         ==> ?B. !x. B * norm(x) <= norm(f x)`,
5672   MESON_TAC[LINEAR_INVERTIBLE_BOUNDED_BELOW_POS]);;
5673
5674 let LINEAR_INJECTIVE_BOUNDED_BELOW_POS = prove
5675  (`!f:real^M->real^N.
5676         linear f /\ (!x y. f x = f y ==> x = y)
5677         ==> ?B. &0 < B /\ !x. norm(x) * B <= norm(f x)`,
5678   REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
5679   MATCH_MP_TAC LINEAR_INVERTIBLE_BOUNDED_BELOW_POS THEN
5680   ASM_MESON_TAC[LINEAR_INJECTIVE_LEFT_INVERSE]);;
5681
5682 (* ------------------------------------------------------------------------- *)
5683 (* Preservation of dimension by injective map.                               *)
5684 (* ------------------------------------------------------------------------- *)
5685
5686 let DIM_INJECTIVE_LINEAR_IMAGE = prove
5687  (`!f:real^M->real^N s.
5688         linear f /\ (!x y. f x = f y ==> x = y) ==> dim(IMAGE f s) = dim s`,
5689   REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM LE_ANTISYM] THEN
5690   CONJ_TAC THENL [ASM_MESON_TAC[DIM_LINEAR_IMAGE_LE]; ALL_TAC] THEN
5691   MP_TAC(ISPEC `f:real^M->real^N` LINEAR_INJECTIVE_LEFT_INVERSE) THEN
5692   ASM_REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM] THEN
5693   DISCH_THEN(X_CHOOSE_THEN `g:real^N->real^M` STRIP_ASSUME_TAC) THEN
5694   MATCH_MP_TAC LE_TRANS THEN
5695   EXISTS_TAC `dim(IMAGE (g:real^N->real^M) (IMAGE (f:real^M->real^N) s))` THEN
5696   CONJ_TAC THENL
5697    [ASM_REWRITE_TAC[GSYM IMAGE_o; o_DEF; IMAGE_ID; LE_REFL];
5698     MATCH_MP_TAC DIM_LINEAR_IMAGE_LE THEN ASM_REWRITE_TAC[]]);;
5699
5700 let LINEAR_INJECTIVE_DIMINDEX_LE = prove
5701  (`!f:real^M->real^N.
5702         linear f /\ (!x y. f x = f y ==> x = y)
5703         ==> dimindex(:M) <= dimindex(:N)`,
5704   REWRITE_TAC[GSYM DIM_UNIV] THEN REPEAT GEN_TAC THEN DISCH_THEN
5705    (SUBST1_TAC o SYM o SPEC `(:real^M)` o
5706     MATCH_MP DIM_INJECTIVE_LINEAR_IMAGE) THEN
5707   MATCH_MP_TAC DIM_SUBSET THEN REWRITE_TAC[SUBSET_UNIV]);;
5708
5709 let LINEAR_SURJECTIVE_DIMINDEX_LE = prove
5710  (`!f:real^M->real^N.
5711         linear f /\ (!y. ?x. f x = y)
5712         ==> dimindex(:N) <= dimindex(:M)`,
5713   REPEAT GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM
5714    (MP_TAC o MATCH_MP LINEAR_SURJECTIVE_RIGHT_INVERSE) THEN
5715   REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM; LEFT_IMP_EXISTS_THM] THEN
5716   X_GEN_TAC `g:real^N->real^M` THEN STRIP_TAC THEN
5717   MATCH_MP_TAC LINEAR_INJECTIVE_DIMINDEX_LE THEN
5718   EXISTS_TAC `g:real^N->real^M` THEN ASM_MESON_TAC[]);;
5719
5720 let LINEAR_BIJECTIVE_DIMINDEX_EQ = prove
5721  (`!f:real^M->real^N.
5722         linear f /\ (!x y. f x = f y ==> x = y) /\ (!y. ?x. f x = y)
5723         ==> dimindex(:M) = dimindex(:N)`,
5724   REWRITE_TAC[GSYM LE_ANTISYM] THEN REPEAT STRIP_TAC THENL
5725    [MATCH_MP_TAC LINEAR_INJECTIVE_DIMINDEX_LE;
5726     MATCH_MP_TAC LINEAR_SURJECTIVE_DIMINDEX_LE] THEN
5727   EXISTS_TAC `f:real^M->real^N` THEN ASM_REWRITE_TAC[]);;
5728
5729 let INVERTIBLE_IMP_SQUARE_MATRIX = prove
5730  (`!A:real^N^M. invertible A ==> dimindex(:M) = dimindex(:N)`,
5731   GEN_TAC THEN REWRITE_TAC[invertible; LEFT_IMP_EXISTS_THM] THEN
5732   X_GEN_TAC `B:real^M^N` THEN STRIP_TAC THEN
5733   MATCH_MP_TAC LINEAR_BIJECTIVE_DIMINDEX_EQ THEN
5734   EXISTS_TAC `\x:real^M. (B:real^M^N) ** x` THEN
5735   ASM_REWRITE_TAC[MATRIX_VECTOR_MUL_LINEAR;
5736                   GSYM MATRIX_LEFT_INVERTIBLE_INJECTIVE;
5737                   GSYM MATRIX_RIGHT_INVERTIBLE_SURJECTIVE] THEN
5738   ASM_MESON_TAC[]);;
5739
5740 (* ------------------------------------------------------------------------- *)
5741 (* Considering an n-element vector as an n-by-1 or 1-by-n matrix.            *)
5742 (* ------------------------------------------------------------------------- *)
5743
5744 let rowvector = new_definition
5745  `(rowvector:real^N->real^N^1) v = lambda i j. v$j`;;
5746
5747 let columnvector = new_definition
5748  `(columnvector:real^N->real^1^N) v = lambda i j. v$i`;;
5749
5750 let TRANSP_COLUMNVECTOR = prove
5751  (`!v. transp(columnvector v) = rowvector v`,
5752   SIMP_TAC[transp; columnvector; rowvector; CART_EQ; LAMBDA_BETA]);;
5753
5754 let TRANSP_ROWVECTOR = prove
5755  (`!v. transp(rowvector v) = columnvector v`,
5756   SIMP_TAC[transp; columnvector; rowvector; CART_EQ; LAMBDA_BETA]);;
5757
5758 let DOT_ROWVECTOR_COLUMNVECTOR = prove
5759  (`!A:real^N^M v:real^N. columnvector(A ** v) = A ** columnvector v`,
5760   REWRITE_TAC[rowvector; columnvector; matrix_mul; matrix_vector_mul] THEN
5761   SIMP_TAC[CART_EQ; LAMBDA_BETA]);;
5762
5763 let DOT_MATRIX_PRODUCT = prove
5764  (`!x y:real^N. x dot y = (rowvector x ** columnvector y)$1$1`,
5765   REWRITE_TAC[matrix_mul; columnvector; rowvector; dot] THEN
5766   SIMP_TAC[LAMBDA_BETA; DIMINDEX_1; LE_REFL]);;
5767
5768 let DOT_MATRIX_VECTOR_MUL = prove
5769  (`!A:real^N^N B:real^N^N x:real^N y:real^N.
5770       (A ** x) dot (B ** y) =
5771       ((rowvector x) ** (transp(A) ** B) ** (columnvector y))$1$1`,
5772   REWRITE_TAC[DOT_MATRIX_PRODUCT] THEN
5773   ONCE_REWRITE_TAC[GSYM TRANSP_COLUMNVECTOR] THEN
5774   REWRITE_TAC[DOT_ROWVECTOR_COLUMNVECTOR; MATRIX_TRANSP_MUL] THEN
5775   REWRITE_TAC[MATRIX_MUL_ASSOC]);;
5776
5777 (* ------------------------------------------------------------------------- *)
5778 (* Rank of a matrix. Equivalence of row and column rank is taken from        *)
5779 (* George Mackiw's paper, Mathematics Magazine 1995, p. 285.                 *)
5780 (* ------------------------------------------------------------------------- *)
5781
5782 let MATRIX_VECTOR_MUL_IN_COLUMNSPACE = prove
5783  (`!A:real^M^N x:real^M. (A ** x) IN span(columns A)`,
5784   REPEAT GEN_TAC THEN REWRITE_TAC[MATRIX_VECTOR_COLUMN; columns] THEN
5785   MATCH_MP_TAC SPAN_VSUM THEN
5786   SIMP_TAC[FINITE_NUMSEG; IN_NUMSEG; transp; LAMBDA_BETA] THEN
5787   X_GEN_TAC `k:num` THEN STRIP_TAC THEN MATCH_MP_TAC SPAN_MUL THEN
5788   MATCH_MP_TAC SPAN_SUPERSET THEN
5789   REWRITE_TAC[IN_ELIM_THM; column] THEN EXISTS_TAC `k:num` THEN
5790   ASM_REWRITE_TAC[]);;
5791
5792 let SUBSPACE_ORTHOGONAL_TO_VECTOR = prove
5793  (`!x. subspace {y | orthogonal x y}`,
5794   SIMP_TAC[subspace; IN_ELIM_THM; ORTHOGONAL_CLAUSES]);;
5795
5796 let SUBSPACE_ORTHOGONAL_TO_VECTORS = prove
5797  (`!s. subspace {y | (!x. x IN s ==> orthogonal x y)}`,
5798   SIMP_TAC[subspace; IN_ELIM_THM; ORTHOGONAL_CLAUSES]);;
5799
5800 let ORTHOGONAL_TO_SPAN = prove
5801  (`!s x. (!y. y IN s ==> orthogonal x y)
5802          ==> !y. y IN span(s) ==> orthogonal x y`,
5803   REPEAT GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC SPAN_INDUCT THEN
5804   REWRITE_TAC[SET_RULE `(\y. orthogonal x y) = {y | orthogonal x y}`] THEN
5805   ASM_SIMP_TAC[SUBSPACE_ORTHOGONAL_TO_VECTOR; IN_ELIM_THM]);;
5806
5807 let ORTHOGONAL_TO_SPAN_EQ = prove
5808  (`!s x. (!y. y IN span(s) ==> orthogonal x y) <=>
5809          (!y. y IN s ==> orthogonal x y)`,
5810   MESON_TAC[SPAN_SUPERSET; ORTHOGONAL_TO_SPAN]);;
5811
5812 let ORTHOGONAL_TO_SPANS_EQ = prove
5813  (`!s t. (!x y. x IN span(s) /\ y IN span(t) ==> orthogonal x y) <=>
5814          (!x y. x IN s /\ y IN t ==> orthogonal x y)`,
5815   MESON_TAC[ORTHOGONAL_TO_SPAN_EQ; ORTHOGONAL_SYM]);;
5816
5817 let ORTHOGONAL_NULLSPACE_ROWSPACE = prove
5818  (`!A:real^M^N x y:real^M.
5819         A ** x = vec 0 /\ y IN span(rows A) ==> orthogonal x y`,
5820   REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
5821   REPEAT GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC SPAN_INDUCT THEN
5822   REWRITE_TAC[SET_RULE `(\y. orthogonal x y) = {y | orthogonal x y}`] THEN
5823   REWRITE_TAC[SUBSPACE_ORTHOGONAL_TO_VECTOR; rows; FORALL_IN_GSPEC] THEN
5824   X_GEN_TAC `k:num` THEN STRIP_TAC THEN REWRITE_TAC[IN_ELIM_THM] THEN
5825   FIRST_X_ASSUM(MP_TAC o AP_TERM `\y:real^N. y$k`) THEN
5826   ASM_SIMP_TAC[MATRIX_VECTOR_MUL_COMPONENT; VEC_COMPONENT; row; dot;
5827                orthogonal; LAMBDA_BETA] THEN
5828   REWRITE_TAC[REAL_MUL_SYM]);;
5829
5830 let NULLSPACE_INTER_ROWSPACE = prove
5831  (`!A:real^M^N x:real^M. A ** x = vec 0 /\ x IN span(rows A) <=> x = vec 0`,
5832   REPEAT GEN_TAC THEN EQ_TAC THENL
5833    [MESON_TAC[ORTHOGONAL_NULLSPACE_ROWSPACE; ORTHOGONAL_REFL];
5834     SIMP_TAC[MATRIX_VECTOR_MUL_RZERO; SPAN_0]]);;
5835
5836 let MATRIX_VECTOR_MUL_INJECTIVE_ON_ROWSPACE = prove
5837  (`!A:real^M^N x y:real^M.
5838         x IN span(rows A) /\ y IN span(rows A) /\ A ** x = A ** y ==> x = y`,
5839   ONCE_REWRITE_TAC[GSYM VECTOR_SUB_EQ] THEN
5840   REWRITE_TAC[GSYM MATRIX_VECTOR_MUL_SUB_LDISTRIB] THEN
5841   REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM NULLSPACE_INTER_ROWSPACE] THEN
5842   ASM_SIMP_TAC[SPAN_SUB]);;
5843
5844 let DIM_ROWS_LE_DIM_COLUMNS = prove
5845  (`!A:real^M^N. dim(rows A) <= dim(columns A)`,
5846   REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM DIM_SPAN] THEN
5847   X_CHOOSE_THEN `b:real^M->bool` STRIP_ASSUME_TAC
5848    (ISPEC `span(rows(A:real^M^N))` BASIS_EXISTS) THEN
5849   SUBGOAL_THEN `FINITE(IMAGE (\x:real^M. (A:real^M^N) ** x) b) /\
5850                 CARD (IMAGE (\x:real^M. (A:real^M^N) ** x) b) <=
5851                 dim(span(columns A))`
5852   MP_TAC THENL
5853    [MATCH_MP_TAC INDEPENDENT_CARD_LE_DIM THEN
5854     REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; MATRIX_VECTOR_MUL_IN_COLUMNSPACE] THEN
5855     MATCH_MP_TAC INDEPENDENT_INJECTIVE_IMAGE_GEN THEN
5856     ASM_REWRITE_TAC[MATRIX_VECTOR_MUL_LINEAR] THEN
5857     SUBGOAL_THEN `span(b) = span(rows(A:real^M^N))` SUBST1_TAC THENL
5858      [ALL_TAC; ASM_MESON_TAC[MATRIX_VECTOR_MUL_INJECTIVE_ON_ROWSPACE]] THEN
5859     MATCH_MP_TAC SUBSET_ANTISYM THEN ASM_REWRITE_TAC[] THEN
5860     GEN_REWRITE_TAC RAND_CONV [GSYM SPAN_SPAN] THEN
5861     ASM_SIMP_TAC[SPAN_MONO];
5862     DISCH_THEN(MP_TAC o CONJUNCT2) THEN MATCH_MP_TAC EQ_IMP THEN
5863     AP_THM_TAC THEN AP_TERM_TAC THEN
5864     FIRST_ASSUM(CONJUNCTS_THEN2 ASSUME_TAC (SUBST1_TAC o SYM) o
5865       GEN_REWRITE_RULE I [HAS_SIZE]) THEN
5866     MATCH_MP_TAC CARD_IMAGE_INJ THEN ASM_REWRITE_TAC[] THEN
5867     REPEAT STRIP_TAC THEN MATCH_MP_TAC
5868      (ISPEC `A:real^M^N` MATRIX_VECTOR_MUL_INJECTIVE_ON_ROWSPACE) THEN
5869     ASM SET_TAC[]]);;
5870
5871 let rank = new_definition
5872  `rank(A:real^M^N) = dim(columns A)`;;
5873
5874 let RANK_ROW = prove
5875  (`!A:real^M^N. rank(A) = dim(rows A)`,
5876   GEN_TAC THEN REWRITE_TAC[rank] THEN
5877   MP_TAC(ISPEC `A:real^M^N` DIM_ROWS_LE_DIM_COLUMNS) THEN
5878   MP_TAC(ISPEC `transp(A:real^M^N)` DIM_ROWS_LE_DIM_COLUMNS) THEN
5879   REWRITE_TAC[ROWS_TRANSP; COLUMNS_TRANSP] THEN ARITH_TAC);;
5880
5881 let RANK_TRANSP = prove
5882  (`!A:real^M^N. rank(transp A) = rank A`,
5883   GEN_TAC THEN GEN_REWRITE_TAC RAND_CONV [RANK_ROW] THEN
5884   REWRITE_TAC[rank; COLUMNS_TRANSP]);;
5885
5886 let MATRIX_VECTOR_MUL_BASIS = prove
5887  (`!A:real^M^N k. 1 <= k /\ k <= dimindex(:M)
5888                  ==> A ** (basis k) = column k A`,
5889   SIMP_TAC[CART_EQ; column; MATRIX_VECTOR_MUL_COMPONENT; DOT_BASIS;
5890            LAMBDA_BETA]);;
5891
5892 let COLUMNS_IMAGE_BASIS = prove
5893  (`!A:real^M^N.
5894      columns A = IMAGE (\x. A ** x) {basis i | 1 <= i /\ i <= dimindex(:M)}`,
5895   GEN_TAC THEN REWRITE_TAC[columns] THEN
5896   ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN
5897   REWRITE_TAC[GSYM IMAGE_o; o_DEF] THEN
5898   MATCH_MP_TAC(SET_RULE
5899     `(!x. x IN s ==> f x = g x) ==> IMAGE f s = IMAGE g s`) THEN
5900   SIMP_TAC[IN_ELIM_THM; MATRIX_VECTOR_MUL_BASIS]);;
5901
5902 let RANK_DIM_IM = prove
5903  (`!A:real^M^N. rank A = dim(IMAGE (\x. A ** x) (:real^M))`,
5904   GEN_TAC THEN REWRITE_TAC[rank] THEN
5905   MATCH_MP_TAC SPAN_EQ_DIM THEN REWRITE_TAC[COLUMNS_IMAGE_BASIS] THEN
5906   SIMP_TAC[SPAN_LINEAR_IMAGE; MATRIX_VECTOR_MUL_LINEAR] THEN
5907   AP_TERM_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM SPAN_SPAN] THEN
5908   REWRITE_TAC[SPAN_STDBASIS]);;
5909
5910 let DIM_EQ_SPAN = prove
5911  (`!s t:real^N->bool. s SUBSET t /\ dim t <= dim s ==> span s = span t`,
5912   REPEAT STRIP_TAC THEN
5913   X_CHOOSE_THEN `b:real^N->bool` STRIP_ASSUME_TAC
5914    (ISPEC `span s:real^N->bool` BASIS_EXISTS) THEN
5915   MP_TAC(ISPECL [`span t:real^N->bool`; `b:real^N->bool`]
5916     CARD_GE_DIM_INDEPENDENT) THEN
5917   RULE_ASSUM_TAC(REWRITE_RULE[HAS_SIZE]) THEN
5918   ASM_REWRITE_TAC[DIM_SPAN] THEN
5919   ASM_MESON_TAC[SPAN_MONO; SPAN_SPAN; SUBSET_TRANS; SUBSET_ANTISYM]);;
5920
5921 let DIM_EQ_FULL = prove
5922  (`!s:real^N->bool. dim s = dimindex(:N) <=> span s = (:real^N)`,
5923   GEN_TAC THEN ONCE_REWRITE_TAC[GSYM DIM_SPAN] THEN EQ_TAC THEN
5924   SIMP_TAC[DIM_UNIV] THEN DISCH_TAC THEN
5925   GEN_REWRITE_TAC RAND_CONV [GSYM SPAN_UNIV] THEN MATCH_MP_TAC DIM_EQ_SPAN THEN
5926   ASM_REWRITE_TAC[SUBSET_UNIV; DIM_UNIV] THEN
5927   ASM_MESON_TAC[LE_REFL; DIM_SPAN]);;
5928
5929 let DIM_PSUBSET = prove
5930  (`!s t. (span s) PSUBSET (span t) ==> dim s < dim t`,
5931   ONCE_REWRITE_TAC[GSYM DIM_SPAN] THEN
5932   SIMP_TAC[PSUBSET; DIM_SUBSET; LT_LE] THEN
5933   MESON_TAC[EQ_IMP_LE; DIM_EQ_SPAN; SPAN_SPAN]);;
5934
5935 let RANK_BOUND = prove
5936  (`!A:real^M^N. rank(A) <= MIN (dimindex(:M)) (dimindex(:N))`,
5937   GEN_TAC THEN REWRITE_TAC[ARITH_RULE `x <= MIN a b <=> x <= a /\ x <= b`] THEN
5938   CONJ_TAC THENL
5939    [REWRITE_TAC[DIM_SUBSET_UNIV; RANK_ROW];
5940     REWRITE_TAC[DIM_SUBSET_UNIV; rank]]);;
5941
5942 let FULL_RANK_INJECTIVE = prove
5943  (`!A:real^M^N.
5944         rank A = dimindex(:M) <=>
5945         (!x y:real^M. A ** x = A ** y ==> x = y)`,
5946   REWRITE_TAC[GSYM MATRIX_LEFT_INVERTIBLE_INJECTIVE] THEN
5947   REWRITE_TAC[MATRIX_LEFT_INVERTIBLE_SPAN_ROWS] THEN
5948   REWRITE_TAC[RANK_ROW; DIM_EQ_FULL]);;
5949
5950 let FULL_RANK_SURJECTIVE = prove
5951  (`!A:real^M^N.
5952         rank A = dimindex(:N) <=> (!y:real^N. ?x:real^M. A ** x = y)`,
5953   REWRITE_TAC[GSYM MATRIX_RIGHT_INVERTIBLE_SURJECTIVE] THEN
5954   REWRITE_TAC[GSYM LEFT_INVERTIBLE_TRANSP] THEN
5955   REWRITE_TAC[MATRIX_LEFT_INVERTIBLE_INJECTIVE] THEN
5956   REWRITE_TAC[GSYM FULL_RANK_INJECTIVE; RANK_TRANSP]);;
5957
5958 let RANK_I = prove
5959  (`rank(mat 1:real^N^N) = dimindex(:N)`,
5960   REWRITE_TAC[FULL_RANK_INJECTIVE; MATRIX_VECTOR_MUL_LID]);;
5961
5962 let MATRIX_FULL_LINEAR_EQUATIONS = prove
5963  (`!A:real^M^N b:real^N.
5964         rank A = dimindex(:N) ==> ?x. A ** x = b`,
5965   SIMP_TAC[FULL_RANK_SURJECTIVE]);;
5966
5967 let MATRIX_NONFULL_LINEAR_EQUATIONS_EQ = prove
5968  (`!A:real^M^N.
5969         (?x. ~(x = vec 0) /\ A ** x = vec 0) <=> ~(rank A = dimindex(:M))`,
5970   REPEAT GEN_TAC THEN REWRITE_TAC[FULL_RANK_INJECTIVE] THEN
5971   SIMP_TAC[LINEAR_INJECTIVE_0; MATRIX_VECTOR_MUL_LINEAR] THEN
5972   MESON_TAC[]);;
5973
5974 let MATRIX_NONFULL_LINEAR_EQUATIONS = prove
5975  (`!A:real^M^N.
5976         ~(rank A = dimindex(:M)) ==> ?x. ~(x = vec 0) /\ A ** x = vec 0`,
5977   REWRITE_TAC[MATRIX_NONFULL_LINEAR_EQUATIONS_EQ]);;
5978
5979 let MATRIX_TRIVIAL_LINEAR_EQUATIONS = prove
5980  (`!A:real^M^N.
5981         dimindex(:N) < dimindex(:M)
5982         ==> ?x. ~(x = vec 0) /\ A ** x = vec 0`,
5983   REPEAT STRIP_TAC THEN MATCH_MP_TAC MATRIX_NONFULL_LINEAR_EQUATIONS THEN
5984   MATCH_MP_TAC(ARITH_RULE
5985    `!a. x <= MIN b a /\ a < b ==> ~(x = b)`) THEN
5986   EXISTS_TAC `dimindex(:N)` THEN ASM_REWRITE_TAC[RANK_BOUND]);;
5987
5988 let RANK_EQ_0 = prove
5989  (`!A:real^M^N. rank A = 0 <=> A = mat 0`,
5990   REWRITE_TAC[RANK_DIM_IM; DIM_EQ_0; SUBSET; FORALL_IN_IMAGE; IN_SING;
5991               IN_UNIV] THEN
5992   GEN_TAC THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [CART_EQ] THEN
5993   SIMP_TAC[CART_EQ; MATRIX_MUL_DOT; VEC_COMPONENT; LAMBDA_BETA; mat] THEN
5994   ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN
5995   REWRITE_TAC[RIGHT_FORALL_IMP_THM; FORALL_DOT_EQ_0; COND_ID] THEN
5996   REWRITE_TAC[CART_EQ; VEC_COMPONENT]);;
5997
5998 let RANK_0 = prove
5999  (`rank(mat 0) = 0`,
6000   REWRITE_TAC[RANK_EQ_0]);;
6001
6002 let RANK_MUL_LE_RIGHT = prove
6003  (`!A:real^N^M B:real^P^N. rank(A ** B) <= rank(B)`,
6004   REPEAT GEN_TAC THEN MATCH_MP_TAC LE_TRANS THEN
6005   EXISTS_TAC `dim(IMAGE (\y. (A:real^N^M) ** y)
6006                         (IMAGE (\x. (B:real^P^N) ** x) (:real^P)))` THEN
6007   REWRITE_TAC[RANK_DIM_IM] THEN CONJ_TAC THENL
6008    [REWRITE_TAC[GSYM IMAGE_o; o_DEF; MATRIX_VECTOR_MUL_ASSOC; LE_REFL];
6009     MATCH_MP_TAC DIM_LINEAR_IMAGE_LE THEN
6010     REWRITE_TAC[MATRIX_VECTOR_MUL_LINEAR]]);;
6011
6012 let RANK_MUL_LE_LEFT = prove
6013  (`!A:real^N^M B:real^P^N. rank(A ** B) <= rank(A)`,
6014   ONCE_REWRITE_TAC[GSYM RANK_TRANSP] THEN
6015   REWRITE_TAC[MATRIX_TRANSP_MUL] THEN
6016   REWRITE_TAC[RANK_MUL_LE_RIGHT]);;
6017
6018 (* ------------------------------------------------------------------------- *)
6019 (* Basic lemmas about hyperplanes and halfspaces.                            *)
6020 (* ------------------------------------------------------------------------- *)
6021
6022 let HYPERPLANE_EQ_EMPTY = prove
6023  (`!a:real^N b. {x | a dot x = b} = {} <=> a = vec 0 /\ ~(b = &0)`,
6024   REPEAT GEN_TAC THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY] THEN
6025   ASM_CASES_TAC `a:real^N = vec 0` THEN ASM_REWRITE_TAC[DOT_LZERO] THENL
6026    [MESON_TAC[];
6027     DISCH_THEN(MP_TAC o SPEC `b / (a dot a) % a:real^N`) THEN
6028     ASM_SIMP_TAC[DOT_RMUL; REAL_DIV_RMUL; DOT_EQ_0]]);;
6029
6030 let HYPERPLANE_EQ_UNIV = prove
6031  (`!a b. {x | a dot x = b} = (:real^N) <=> a = vec 0 /\ b = &0`,
6032   REPEAT GEN_TAC THEN  REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_UNIV] THEN
6033   ASM_CASES_TAC `a:real^N = vec 0` THEN ASM_REWRITE_TAC[DOT_LZERO] THENL
6034    [MESON_TAC[];
6035     DISCH_THEN(MP_TAC o SPEC `(b + &1) / (a dot a) % a:real^N`) THEN
6036     ASM_SIMP_TAC[DOT_RMUL; REAL_DIV_RMUL; DOT_EQ_0] THEN REAL_ARITH_TAC]);;
6037
6038 let HALFSPACE_EQ_EMPTY_LT = prove
6039  (`!a:real^N b. {x | a dot x < b} = {} <=> a = vec 0 /\ b <= &0`,
6040   REPEAT GEN_TAC THEN ASM_CASES_TAC `a:real^N = vec 0` THENL
6041    [ASM_SIMP_TAC[DOT_LZERO; SET_RULE `{x | p} = if p then UNIV else {}`] THEN
6042     COND_CASES_TAC THEN REWRITE_TAC[UNIV_NOT_EMPTY] THEN ASM_REAL_ARITH_TAC;
6043     ASM_REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN
6044     EXISTS_TAC `(b - &1) / (a dot a) % a:real^N` THEN
6045     ASM_SIMP_TAC[DOT_RMUL; REAL_DIV_RMUL; DOT_EQ_0] THEN
6046     REAL_ARITH_TAC]);;
6047
6048 let HALFSPACE_EQ_EMPTY_GT = prove
6049  (`!a:real^N b. {x | a dot x > b} = {} <=> a = vec 0 /\ b >= &0`,
6050   REPEAT GEN_TAC THEN
6051   MP_TAC(ISPECL [`--a:real^N`; `--b:real`] HALFSPACE_EQ_EMPTY_LT) THEN
6052   SIMP_TAC[real_gt; DOT_LNEG; REAL_LT_NEG2; VECTOR_NEG_EQ_0] THEN
6053   DISCH_TAC THEN AP_TERM_TAC THEN REAL_ARITH_TAC);;
6054
6055 let HALFSPACE_EQ_EMPTY_LE = prove
6056  (`!a:real^N b. {x | a dot x <= b} = {} <=> a = vec 0 /\ b < &0`,
6057   REPEAT GEN_TAC THEN ASM_CASES_TAC `a:real^N = vec 0` THENL
6058    [ASM_SIMP_TAC[DOT_LZERO; SET_RULE `{x | p} = if p then UNIV else {}`] THEN
6059     COND_CASES_TAC THEN REWRITE_TAC[UNIV_NOT_EMPTY] THEN ASM_REAL_ARITH_TAC;
6060     ASM_REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN
6061     EXISTS_TAC `(b - &1) / (a dot a) % a:real^N` THEN
6062     ASM_SIMP_TAC[DOT_RMUL; REAL_DIV_RMUL; DOT_EQ_0] THEN
6063     REAL_ARITH_TAC]);;
6064
6065 let HALFSPACE_EQ_EMPTY_GE = prove
6066  (`!a:real^N b. {x | a dot x >= b} = {} <=> a = vec 0 /\ b > &0`,
6067   REPEAT GEN_TAC THEN
6068   MP_TAC(ISPECL [`--a:real^N`; `--b:real`] HALFSPACE_EQ_EMPTY_LE) THEN
6069   SIMP_TAC[real_ge; DOT_LNEG; REAL_LE_NEG2; VECTOR_NEG_EQ_0] THEN
6070   DISCH_TAC THEN AP_TERM_TAC THEN REAL_ARITH_TAC);;
6071
6072 (* ------------------------------------------------------------------------- *)
6073 (* A non-injective linear function maps into a hyperplane.                   *)
6074 (* ------------------------------------------------------------------------- *)
6075
6076 let ADJOINT_INJECTIVE = prove
6077  (`!f:real^M->real^N.
6078         linear f
6079         ==> ((!x y. adjoint f x = adjoint f y ==> x = y) <=>
6080              (!y. ?x. f x = y))`,
6081   REPEAT STRIP_TAC THEN
6082   FIRST_ASSUM(ASSUME_TAC o GSYM o MATCH_MP MATRIX_WORKS o MATCH_MP
6083    ADJOINT_LINEAR) THEN
6084   FIRST_ASSUM(ASSUME_TAC o GSYM o MATCH_MP MATRIX_WORKS) THEN
6085   ASM_REWRITE_TAC[GSYM FULL_RANK_INJECTIVE; GSYM FULL_RANK_SURJECTIVE] THEN
6086   ASM_SIMP_TAC[MATRIX_ADJOINT; RANK_TRANSP]);;
6087
6088 let ADJOINT_SURJECTIVE = prove
6089  (`!f:real^M->real^N.
6090         linear f
6091         ==> ((!y. ?x. adjoint f x = y) <=> (!x y. f x = f y ==> x = y))`,
6092   REPEAT STRIP_TAC THEN
6093   FIRST_ASSUM(fun th -> GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV)
6094    [GSYM(MATCH_MP ADJOINT_ADJOINT th)]) THEN
6095   ASM_SIMP_TAC[ADJOINT_INJECTIVE; ADJOINT_LINEAR]);;
6096
6097 let ADJOINT_INJECTIVE_INJECTIVE = prove
6098  (`!f:real^N->real^N.
6099         linear f
6100         ==> ((!x y. adjoint f x = adjoint f y ==> x = y) <=>
6101              (!x y. f x = f y ==> x = y))`,
6102   SIMP_TAC[ADJOINT_INJECTIVE] THEN
6103   MESON_TAC[LINEAR_INJECTIVE_IMP_SURJECTIVE;
6104             LINEAR_SURJECTIVE_IMP_INJECTIVE]);;
6105
6106 let ADJOINT_INJECTIVE_INJECTIVE_0 = prove
6107  (`!f:real^N->real^N.
6108         linear f
6109         ==> ((!x. adjoint f x = vec 0 ==> x = vec 0) <=>
6110              (!x. f x = vec 0 ==> x = vec 0))`,
6111   REPEAT STRIP_TAC THEN
6112   FIRST_ASSUM(MP_TAC o MATCH_MP ADJOINT_INJECTIVE_INJECTIVE) THEN
6113   FIRST_ASSUM(ASSUME_TAC o MATCH_MP ADJOINT_LINEAR) THEN
6114   ASM_MESON_TAC[LINEAR_INJECTIVE_0]);;
6115
6116 let LINEAR_SINGULAR_INTO_HYPERPLANE = prove
6117  (`!f:real^N->real^N.
6118         linear f
6119         ==> (~(!x y. f(x) = f(y) ==> x = y) <=>
6120              ?a. ~(a = vec 0) /\ !x. a dot f(x) = &0)`,
6121   REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[DOT_SYM] THEN
6122   ASM_SIMP_TAC[ADJOINT_WORKS; FORALL_DOT_EQ_0] THEN
6123   REWRITE_TAC[MESON[] `(?a. ~p a /\ q a) <=> ~(!a. q a ==> p a)`] THEN
6124   ASM_SIMP_TAC[ADJOINT_INJECTIVE_INJECTIVE_0; LINEAR_INJECTIVE_0]);;
6125
6126 let LINEAR_SINGULAR_IMAGE_HYPERPLANE = prove
6127  (`!f:real^N->real^N.
6128         linear f /\ ~(!x y. f(x) = f(y) ==> x = y)
6129         ==> ?a. ~(a = vec 0) /\ !s. IMAGE f s SUBSET {x | a dot x = &0}`,
6130   GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
6131   ASM_SIMP_TAC[LINEAR_SINGULAR_INTO_HYPERPLANE] THEN
6132   SIMP_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_THM] THEN MESON_TAC[]);;
6133
6134 let LOWDIM_EXPAND_DIMENSION = prove
6135  (`!s:real^N->bool n.
6136         dim s <= n /\ n <= dimindex(:N)
6137         ==> ?t. dim(t) = n /\ span s SUBSET span t`,
6138   GEN_TAC THEN
6139   GEN_REWRITE_TAC (BINDER_CONV o LAND_CONV o LAND_CONV) [LE_EXISTS] THEN
6140   SIMP_TAC[LEFT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM; IMP_CONJ] THEN
6141   ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN
6142   REWRITE_TAC[RIGHT_FORALL_IMP_THM; LEFT_FORALL_IMP_THM; EXISTS_REFL] THEN
6143   INDUCT_TAC THENL [MESON_TAC[ADD_CLAUSES; SUBSET_REFL]; ALL_TAC] THEN
6144   REWRITE_TAC[ARITH_RULE `s + SUC d <= n <=> s + d < n`] THEN
6145   DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o check (is_imp o concl)) THEN
6146   ASM_SIMP_TAC[LT_IMP_LE; LEFT_IMP_EXISTS_THM] THEN
6147   X_GEN_TAC `t:real^N->bool` THEN STRIP_TAC THEN
6148   REWRITE_TAC[ADD_CLAUSES] THEN FIRST_X_ASSUM(SUBST_ALL_TAC o SYM) THEN
6149   SUBGOAL_THEN `~(span t = (:real^N))` MP_TAC THENL
6150    [REWRITE_TAC[GSYM DIM_EQ_FULL] THEN ASM_ARITH_TAC; ALL_TAC] THEN
6151   REWRITE_TAC[EXTENSION; IN_UNIV; NOT_FORALL_THM; LEFT_IMP_EXISTS_THM] THEN
6152   X_GEN_TAC `a:real^N` THEN DISCH_TAC THEN
6153   EXISTS_TAC `(a:real^N) INSERT t` THEN ASM_REWRITE_TAC[DIM_INSERT; ADD1] THEN
6154   MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `span(t:real^N->bool)` THEN
6155   ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SPAN_MONO THEN SET_TAC[]);;
6156
6157 let LOWDIM_EXPAND_BASIS = prove
6158  (`!s:real^N->bool n.
6159         dim s <= n /\ n <= dimindex(:N)
6160         ==> ?b. b HAS_SIZE n /\ independent b /\ span s SUBSET span b`,
6161   REPEAT GEN_TAC THEN DISCH_TAC THEN
6162   FIRST_ASSUM(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC o
6163     MATCH_MP LOWDIM_EXPAND_DIMENSION) THEN
6164   MP_TAC(ISPEC `t:real^N->bool` BASIS_EXISTS) THEN
6165   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `b:real^N->bool` THEN
6166   ASM_REWRITE_TAC[] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
6167   ASM_MESON_TAC[SPAN_SPAN; SUBSET_TRANS; SPAN_MONO]);;
6168
6169 (* ------------------------------------------------------------------------- *)
6170 (* Orthogonal bases, Gram-Schmidt process, and related theorems.             *)
6171 (* ------------------------------------------------------------------------- *)
6172
6173 let SPAN_DELETE_0 = prove
6174  (`!s:real^N->bool. span(s DELETE vec 0) = span s`,
6175   GEN_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN
6176   SIMP_TAC[DELETE_SUBSET; SPAN_MONO] THEN
6177   MATCH_MP_TAC SUBSET_TRANS THEN
6178   EXISTS_TAC `span((vec 0:real^N) INSERT (s DELETE vec 0))` THEN CONJ_TAC THENL
6179    [MATCH_MP_TAC SPAN_MONO THEN SET_TAC[];
6180     SIMP_TAC[SUBSET; SPAN_BREAKDOWN_EQ; VECTOR_MUL_RZERO; VECTOR_SUB_RZERO]]);;
6181
6182 let SPAN_IMAGE_SCALE = prove
6183  (`!c s. FINITE s /\ (!x. x IN s ==> ~(c x = &0))
6184          ==> span (IMAGE (\x:real^N. c(x) % x) s) = span s`,
6185   GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN
6186   MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
6187   SIMP_TAC[IMAGE_CLAUSES; SPAN_BREAKDOWN_EQ; EXTENSION; FORALL_IN_INSERT] THEN
6188   MAP_EVERY X_GEN_TAC [`x:real^N`; `t:real^N->bool`] THEN
6189   STRIP_TAC THEN STRIP_TAC THEN X_GEN_TAC `y:real^N` THEN
6190   REWRITE_TAC[VECTOR_MUL_ASSOC] THEN EQ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN
6191   DISCH_THEN(X_CHOOSE_TAC `k:real`) THEN
6192   EXISTS_TAC `k / (c:real^N->real) x` THEN
6193   ASM_SIMP_TAC[REAL_DIV_RMUL]);;
6194
6195 let PAIRWISE_ORTHOGONAL_INDEPENDENT = prove
6196  (`!s:real^N->bool.
6197         pairwise orthogonal s /\ ~(vec 0 IN s) ==> independent s`,
6198   REWRITE_TAC[pairwise; orthogonal] THEN REPEAT STRIP_TAC THEN
6199   REWRITE_TAC[independent; dependent] THEN
6200   DISCH_THEN(X_CHOOSE_THEN `a:real^N` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
6201   REWRITE_TAC[SPAN_EXPLICIT; IN_ELIM_THM; NOT_EXISTS_THM] THEN
6202   MAP_EVERY X_GEN_TAC [`t:real^N->bool`; `u:real^N->real`] THEN
6203   REWRITE_TAC[SUBSET; IN_DELETE] THEN STRIP_TAC THEN
6204   FIRST_X_ASSUM(MP_TAC o AP_TERM `\x:real^N. a dot x`) THEN
6205   ASM_SIMP_TAC[DOT_RSUM; DOT_RMUL; REAL_MUL_RZERO; SUM_0] THEN
6206   ASM_MESON_TAC[DOT_EQ_0]);;
6207
6208 let PAIRWISE_ORTHOGONAL_IMP_FINITE = prove
6209  (`!s:real^N->bool. pairwise orthogonal s ==> FINITE s`,
6210   REPEAT STRIP_TAC THEN
6211   SUBGOAL_THEN `independent (s DELETE (vec 0:real^N))` MP_TAC THENL
6212    [MATCH_MP_TAC PAIRWISE_ORTHOGONAL_INDEPENDENT THEN
6213     REWRITE_TAC[IN_DELETE] THEN MATCH_MP_TAC PAIRWISE_MONO THEN
6214     EXISTS_TAC `s:real^N->bool` THEN
6215     ASM_SIMP_TAC[SUBSET; IN_DELETE];
6216     DISCH_THEN(MP_TAC o MATCH_MP INDEPENDENT_IMP_FINITE) THEN
6217     REWRITE_TAC[FINITE_DELETE]]);;
6218
6219 let GRAM_SCHMIDT_STEP = prove
6220  (`!s a x.
6221         pairwise orthogonal s /\ x IN span s
6222         ==> orthogonal x (a - vsum s (\b:real^N. (b dot a) / (b dot b) % b))`,
6223   REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
6224   REWRITE_TAC[ONCE_REWRITE_RULE[ORTHOGONAL_SYM] ORTHOGONAL_TO_SPAN_EQ] THEN
6225   X_GEN_TAC `s:real^N->bool` THEN STRIP_TAC THEN
6226   MAP_EVERY X_GEN_TAC [`a:real^N`; `x:real^N`] THEN DISCH_TAC THEN
6227   FIRST_ASSUM(ASSUME_TAC o MATCH_MP PAIRWISE_ORTHOGONAL_IMP_FINITE) THEN
6228   REWRITE_TAC[orthogonal; DOT_RSUB] THEN ASM_SIMP_TAC[DOT_RSUM] THEN
6229   REWRITE_TAC[REAL_SUB_0; DOT_RMUL] THEN MATCH_MP_TAC EQ_TRANS THEN
6230   EXISTS_TAC `sum s (\y:real^N. if y = x then y dot a else &0)` THEN
6231   CONJ_TAC THENL [ASM_SIMP_TAC[SUM_DELTA; DOT_SYM]; ALL_TAC] THEN
6232   MATCH_MP_TAC SUM_EQ THEN X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN
6233   RULE_ASSUM_TAC(REWRITE_RULE[pairwise; orthogonal]) THEN
6234   ASM_CASES_TAC `x:real^N = y` THEN ASM_SIMP_TAC[DOT_LMUL; REAL_MUL_RZERO] THEN
6235   ASM_CASES_TAC `y:real^N = vec 0` THEN
6236   ASM_SIMP_TAC[REAL_DIV_RMUL; DOT_EQ_0; DOT_LZERO; REAL_MUL_RZERO]);;
6237
6238 let ORTHOGONAL_EXTENSION = prove
6239  (`!s t:real^N->bool.
6240         pairwise orthogonal s
6241         ==> ?u. pairwise orthogonal (s UNION u) /\
6242                 span (s UNION u) = span (s UNION t)`,
6243   let lemma = prove
6244    (`!t s:real^N->bool.
6245         FINITE t /\ FINITE s /\ pairwise orthogonal s
6246         ==> ?u. pairwise orthogonal (s UNION u) /\
6247                 span (s UNION u) = span (s UNION t)`,
6248     REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
6249     MATCH_MP_TAC FINITE_INDUCT_STRONG THEN CONJ_TAC THENL
6250      [REPEAT STRIP_TAC THEN EXISTS_TAC `{}:real^N->bool` THEN
6251       ASM_REWRITE_TAC[UNION_EMPTY];
6252       ALL_TAC] THEN
6253     MAP_EVERY X_GEN_TAC [`a:real^N`; `t:real^N->bool`] THEN
6254     REWRITE_TAC[pairwise; orthogonal] THEN REPEAT STRIP_TAC THEN
6255     ABBREV_TAC `a' = a - vsum s (\b:real^N. (b dot a) / (b dot b) % b)` THEN
6256     FIRST_X_ASSUM(MP_TAC o SPEC `(a':real^N) INSERT s`) THEN
6257     ASM_REWRITE_TAC[FINITE_INSERT] THEN ANTS_TAC THENL
6258      [SUBGOAL_THEN `!x:real^N. x IN s ==> a' dot x = &0`
6259        (fun th -> REWRITE_TAC[IN_INSERT] THEN ASM_MESON_TAC[DOT_SYM; th]) THEN
6260       REPEAT STRIP_TAC THEN EXPAND_TAC "a'" THEN
6261       REWRITE_TAC[GSYM orthogonal] THEN ONCE_REWRITE_TAC[ORTHOGONAL_SYM] THEN
6262       MATCH_MP_TAC GRAM_SCHMIDT_STEP THEN
6263       ASM_SIMP_TAC[pairwise; orthogonal; SPAN_CLAUSES];
6264       DISCH_THEN(X_CHOOSE_THEN `u:real^N->bool` STRIP_ASSUME_TAC) THEN
6265       EXISTS_TAC `(a':real^N) INSERT u` THEN
6266       ASM_REWRITE_TAC[SET_RULE `s UNION a INSERT u = a INSERT s UNION u`] THEN
6267       REWRITE_TAC[SET_RULE `(x INSERT s) UNION t = x INSERT (s UNION t)`] THEN
6268       MATCH_MP_TAC EQ_SPAN_INSERT_EQ THEN EXPAND_TAC "a'" THEN
6269       REWRITE_TAC[VECTOR_ARITH `a - x - a:real^N = --x`] THEN
6270       MATCH_MP_TAC SPAN_NEG THEN MATCH_MP_TAC SPAN_VSUM THEN
6271       ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN
6272       MATCH_MP_TAC SPAN_MUL THEN ASM_SIMP_TAC[SPAN_SUPERSET; IN_UNION]]) in
6273   REPEAT STRIP_TAC THEN
6274   MP_TAC(ISPEC `span t:real^N->bool` BASIS_SUBSPACE_EXISTS) THEN
6275   REWRITE_TAC[SUBSPACE_SPAN; LEFT_IMP_EXISTS_THM] THEN
6276   X_GEN_TAC `b:real^N->bool` THEN STRIP_TAC THEN
6277   MP_TAC(ISPECL [`b:real^N->bool`; `s:real^N->bool`] lemma) THEN
6278   ANTS_TAC THENL
6279    [ASM_MESON_TAC[HAS_SIZE; PAIRWISE_ORTHOGONAL_IMP_FINITE];
6280     MATCH_MP_TAC MONO_EXISTS THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
6281     ASM_REWRITE_TAC[SPAN_UNION]]);;
6282
6283 let ORTHOGONAL_EXTENSION_STRONG = prove
6284  (`!s t:real^N->bool.
6285         pairwise orthogonal s
6286         ==> ?u. DISJOINT u (vec 0 INSERT s) /\
6287                 pairwise orthogonal (s UNION u) /\
6288                 span (s UNION u) = span (s UNION t)`,
6289   REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o
6290     SPEC `t:real^N->bool` o MATCH_MP ORTHOGONAL_EXTENSION) THEN
6291   DISCH_THEN(X_CHOOSE_THEN `u:real^N->bool` STRIP_ASSUME_TAC) THEN
6292   EXISTS_TAC `u DIFF ((vec 0:real^N) INSERT s)` THEN REPEAT CONJ_TAC THENL
6293    [SET_TAC[];
6294     FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
6295         PAIRWISE_MONO)) THEN SET_TAC[];
6296     FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN
6297     GEN_REWRITE_TAC BINOP_CONV [GSYM SPAN_DELETE_0] THEN
6298     AP_TERM_TAC THEN SET_TAC[]]);;
6299
6300 let ORTHONORMAL_EXTENSION = prove
6301  (`!s t:real^N->bool.
6302         pairwise orthogonal s /\ (!x. x IN s ==> norm x = &1)
6303         ==> ?u. DISJOINT u s /\
6304                 pairwise orthogonal (s UNION u) /\
6305                 (!x. x IN u ==> norm x = &1) /\
6306                 span(s UNION u) = span(s UNION t)`,
6307   REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o
6308     SPEC `t:real^N->bool` o MATCH_MP ORTHOGONAL_EXTENSION_STRONG) THEN
6309   REWRITE_TAC[SET_RULE `DISJOINT u s <=> !x. x IN u ==> ~(x IN s)`] THEN
6310   REWRITE_TAC[IN_INSERT; DE_MORGAN_THM; pairwise] THEN
6311   DISCH_THEN(X_CHOOSE_THEN `u:real^N->bool` STRIP_ASSUME_TAC) THEN
6312   EXISTS_TAC `IMAGE (\x:real^N. inv(norm x) % x) u` THEN
6313   REWRITE_TAC[FORALL_IN_IMAGE; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
6314   REPEAT CONJ_TAC THENL
6315    [X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
6316     ASM_CASES_TAC `norm(x:real^N) = &1` THEN
6317     ASM_SIMP_TAC[REAL_INV_1; VECTOR_MUL_LID] THEN DISCH_TAC THEN
6318     FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^N`; `inv(norm x) % x:real^N`]) THEN
6319     ASM_REWRITE_TAC[IN_UNION; VECTOR_MUL_EQ_0; REAL_SUB_0; REAL_INV_EQ_1;
6320       VECTOR_ARITH `x:real^N = a % x <=> (a - &1) % x = vec 0`] THEN
6321     ASM_CASES_TAC `x:real^N = vec 0` THENL
6322      [ASM_MESON_TAC[VECTOR_MUL_RZERO];
6323       ASM_REWRITE_TAC[orthogonal; DOT_RMUL; REAL_ENTIRE; DOT_EQ_0] THEN
6324       ASM_REWRITE_TAC[REAL_INV_EQ_0; NORM_EQ_0]];
6325     REWRITE_TAC[IN_UNION; IN_IMAGE] THEN REPEAT STRIP_TAC THEN
6326     ASM_SIMP_TAC[orthogonal; DOT_LMUL; DOT_RMUL; REAL_ENTIRE; DOT_EQ_0;
6327                  REAL_INV_EQ_0; NORM_EQ_0] THEN
6328     REWRITE_TAC[GSYM orthogonal] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
6329     ASM_REWRITE_TAC[IN_UNION] THEN DISCH_THEN(SUBST_ALL_TAC o SYM) THEN
6330     ASM SET_TAC[];
6331     ASM_SIMP_TAC[NORM_MUL; REAL_MUL_LINV; NORM_EQ_0; REAL_ABS_INV;
6332                  REAL_ABS_NORM];
6333     FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN
6334     REWRITE_TAC[SPAN_EQ; UNION_SUBSET] THEN
6335     SIMP_TAC[SUBSET; FORALL_IN_IMAGE; SPAN_SUPERSET; SPAN_MUL; IN_UNION] THEN
6336     X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
6337     SUBGOAL_THEN `x:real^N = norm(x) % inv(norm x) % x`
6338      (fun th -> GEN_REWRITE_TAC LAND_CONV [th])
6339     THENL
6340      [ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_RINV; NORM_EQ_0; VECTOR_MUL_LID];
6341       MATCH_MP_TAC SPAN_MUL THEN MATCH_MP_TAC SPAN_SUPERSET THEN
6342       REWRITE_TAC[IN_UNION; IN_IMAGE] THEN ASM_MESON_TAC[]]]);;
6343
6344 let VECTOR_IN_ORTHOGONAL_SPANNINGSET = prove
6345  (`!a. ?s. a IN s /\ pairwise orthogonal s /\ span s = (:real^N)`,
6346   GEN_TAC THEN
6347   MP_TAC(ISPECL [`{a:real^N}`; `(IMAGE basis (1..dimindex(:N))):real^N->bool`]
6348                  ORTHOGONAL_EXTENSION) THEN
6349   REWRITE_TAC[PAIRWISE_SING] THEN
6350   DISCH_THEN(X_CHOOSE_THEN `u:real^N->bool` STRIP_ASSUME_TAC) THEN
6351   EXISTS_TAC `{a:real^N} UNION u` THEN ASM_REWRITE_TAC[IN_UNION; IN_SING] THEN
6352   MATCH_MP_TAC(SET_RULE `!s. s = UNIV /\ s SUBSET t ==> t = UNIV`) THEN
6353   EXISTS_TAC `span {basis i:real^N | 1 <= i /\ i <= dimindex (:N)}` THEN
6354   CONJ_TAC THENL [REWRITE_TAC[SPAN_STDBASIS]; MATCH_MP_TAC SPAN_MONO] THEN
6355   REWRITE_TAC[SUBSET; FORALL_IN_GSPEC; GSYM IN_NUMSEG] THEN SET_TAC[]);;
6356
6357 let VECTOR_IN_ORTHOGONAL_BASIS = prove
6358  (`!a. ~(a = vec 0)
6359        ==> ?s. a IN s /\ ~(vec 0 IN s) /\
6360                pairwise orthogonal s /\
6361                independent s /\
6362                s HAS_SIZE (dimindex(:N)) /\
6363                span s = (:real^N)`,
6364   REPEAT STRIP_TAC THEN
6365   MP_TAC(ISPEC `a:real^N` VECTOR_IN_ORTHOGONAL_SPANNINGSET) THEN
6366   DISCH_THEN(X_CHOOSE_THEN `s:real^N->bool` STRIP_ASSUME_TAC) THEN
6367   EXISTS_TAC `s DELETE (vec 0:real^N)` THEN ASM_REWRITE_TAC[IN_DELETE] THEN
6368   MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL
6369    [RULE_ASSUM_TAC(REWRITE_RULE[pairwise]) THEN
6370     ASM_SIMP_TAC[pairwise; IN_DELETE];
6371     DISCH_TAC] THEN
6372   MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL
6373    [MATCH_MP_TAC PAIRWISE_ORTHOGONAL_INDEPENDENT THEN ASM_SIMP_TAC[IN_DELETE];
6374     DISCH_TAC] THEN
6375   MATCH_MP_TAC(TAUT `b /\ (b ==> a) ==> a /\ b`) THEN CONJ_TAC THENL
6376    [ASM_MESON_TAC[SPAN_DELETE_0];
6377     DISCH_TAC THEN ASM_SIMP_TAC[BASIS_HAS_SIZE_UNIV]]);;
6378
6379 let VECTOR_IN_ORTHONORMAL_BASIS = prove
6380  (`!a. norm a = &1
6381        ==> ?s. a IN s /\
6382                pairwise orthogonal s /\
6383                (!x. x IN s ==> norm x = &1) /\
6384                independent s /\
6385                s HAS_SIZE (dimindex(:N)) /\
6386                span s = (:real^N)`,
6387   GEN_TAC THEN ASM_CASES_TAC `a:real^N = vec 0` THEN
6388   ASM_REWRITE_TAC[NORM_0; REAL_OF_NUM_EQ; ARITH_EQ] THEN DISCH_TAC THEN
6389   FIRST_ASSUM(MP_TAC o MATCH_MP VECTOR_IN_ORTHOGONAL_BASIS) THEN
6390   DISCH_THEN(X_CHOOSE_THEN `s:real^N->bool` STRIP_ASSUME_TAC) THEN
6391   EXISTS_TAC `IMAGE (\x:real^N. inv(norm x) % x) s` THEN
6392   CONJ_TAC THENL
6393    [REWRITE_TAC[IN_IMAGE] THEN EXISTS_TAC `a:real^N` THEN
6394     ASM_REWRITE_TAC[REAL_INV_1; VECTOR_MUL_LID];
6395     ALL_TAC] THEN
6396   MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL
6397    [REWRITE_TAC[pairwise; IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN
6398     RULE_ASSUM_TAC(REWRITE_RULE[pairwise]) THEN
6399     ASM_MESON_TAC[ORTHOGONAL_CLAUSES];
6400     DISCH_TAC] THEN
6401   MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL
6402    [REWRITE_TAC[FORALL_IN_IMAGE; NORM_MUL; REAL_ABS_INV; REAL_ABS_NORM] THEN
6403     ASM_MESON_TAC[REAL_MUL_LINV; NORM_EQ_0];
6404     DISCH_TAC] THEN
6405   MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL
6406    [MATCH_MP_TAC PAIRWISE_ORTHOGONAL_INDEPENDENT THEN ASM_REWRITE_TAC[] THEN
6407     REWRITE_TAC[IN_IMAGE] THEN ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN
6408     SIMP_TAC[VECTOR_MUL_EQ_0; REAL_INV_EQ_0; NORM_EQ_0] THEN ASM_MESON_TAC[];
6409     DISCH_TAC] THEN
6410   MATCH_MP_TAC(TAUT `b /\ (b ==> a) ==> a /\ b`) THEN CONJ_TAC THENL
6411    [ALL_TAC; ASM_SIMP_TAC[BASIS_HAS_SIZE_UNIV]] THEN
6412   UNDISCH_THEN `span s = (:real^N)` (SUBST1_TAC o SYM) THEN
6413   MATCH_MP_TAC SPAN_IMAGE_SCALE THEN
6414   REWRITE_TAC[REAL_INV_EQ_0; NORM_EQ_0] THEN
6415   ASM_MESON_TAC[HAS_SIZE]);;
6416
6417 let BESSEL_INEQUALITY = prove
6418  (`!s x:real^N.
6419         pairwise orthogonal s /\ (!x. x IN s ==> norm x = &1)
6420         ==> sum s (\e. (e dot x) pow 2) <= norm(x) pow 2`,
6421   REPEAT STRIP_TAC THEN
6422   FIRST_ASSUM(ASSUME_TAC o MATCH_MP PAIRWISE_ORTHOGONAL_IMP_FINITE) THEN
6423   MP_TAC(ISPEC `x - vsum s (\e. (e dot x) % e):real^N` DOT_POS_LE) THEN
6424   REWRITE_TAC[NORM_POW_2; VECTOR_ARITH
6425    `(a - b:real^N) dot (a - b) = a dot a + b dot b - &2 * b dot a`] THEN
6426   ASM_SIMP_TAC[DOT_LSUM; REAL_POW_2; DOT_LMUL] THEN
6427   MATCH_MP_TAC(REAL_ARITH `t = s ==> &0 <= x + t - &2 * s ==> s <= x`) THEN
6428   MATCH_MP_TAC SUM_EQ THEN X_GEN_TAC `e:real^N` THEN DISCH_TAC THEN
6429   ASM_SIMP_TAC[DOT_RSUM] THEN AP_TERM_TAC THEN
6430   MATCH_MP_TAC EQ_TRANS THEN
6431   EXISTS_TAC `sum s (\k:real^N. if k = e then e dot x else &0)` THEN
6432   CONJ_TAC THENL [ALL_TAC; ASM_SIMP_TAC[SUM_DELTA]] THEN
6433   MATCH_MP_TAC SUM_EQ THEN X_GEN_TAC `k:real^N` THEN DISCH_TAC THEN
6434   REWRITE_TAC[DOT_RMUL] THEN COND_CASES_TAC THENL
6435    [ASM_REWRITE_TAC[REAL_RING `a * x = a <=> a = &0 \/ x = &1`] THEN
6436     DISJ2_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e:real^N`) THEN
6437     ASM_REWRITE_TAC[NORM_EQ_SQUARE] THEN REAL_ARITH_TAC;
6438     RULE_ASSUM_TAC(REWRITE_RULE[pairwise; orthogonal]) THEN
6439     ASM_SIMP_TAC[REAL_ENTIRE]]);;
6440
6441 (* ------------------------------------------------------------------------- *)
6442 (* Analogous theorems for existence of orthonormal basis for a subspace.     *)
6443 (* ------------------------------------------------------------------------- *)
6444
6445 let ORTHOGONAL_SPANNINGSET_SUBSPACE = prove
6446  (`!s:real^N->bool.
6447         subspace s
6448         ==> ?b. b SUBSET s /\ pairwise orthogonal b /\ span b = s`,
6449   REPEAT STRIP_TAC THEN MP_TAC(ISPEC `s:real^N->bool` BASIS_EXISTS) THEN
6450   DISCH_THEN(X_CHOOSE_THEN `b:real^N->bool` STRIP_ASSUME_TAC) THEN
6451   MP_TAC(ISPECL[`{}:real^N->bool`; `b:real^N->bool`] ORTHOGONAL_EXTENSION) THEN
6452   REWRITE_TAC[PAIRWISE_EMPTY; UNION_EMPTY] THEN
6453   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c:real^N->bool` THEN
6454   STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
6455   MATCH_MP_TAC(TAUT `b /\ (b ==> a) ==> a /\ b`) THEN CONJ_TAC THENL
6456    [MATCH_MP_TAC SPAN_SUBSPACE THEN ASM_REWRITE_TAC[];
6457     DISCH_THEN(SUBST1_TAC o SYM) THEN ASM_MESON_TAC[SPAN_INC]]);;
6458
6459 let ORTHOGONAL_BASIS_SUBSPACE = prove
6460  (`!s:real^N->bool.
6461         subspace s
6462         ==> ?b. ~(vec 0 IN b) /\
6463                 b SUBSET s /\
6464                 pairwise orthogonal b /\
6465                 independent b /\
6466                 b HAS_SIZE (dim s) /\
6467                 span b = s`,
6468   REPEAT STRIP_TAC THEN
6469   FIRST_ASSUM(MP_TAC o MATCH_MP ORTHOGONAL_SPANNINGSET_SUBSPACE) THEN
6470   DISCH_THEN(X_CHOOSE_THEN `b:real^N->bool` STRIP_ASSUME_TAC) THEN
6471   EXISTS_TAC `b DELETE (vec 0:real^N)` THEN ASM_REWRITE_TAC[IN_DELETE] THEN
6472   CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
6473   MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL
6474    [RULE_ASSUM_TAC(REWRITE_RULE[pairwise]) THEN
6475     ASM_SIMP_TAC[pairwise; IN_DELETE];
6476     DISCH_TAC] THEN
6477   MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL
6478    [MATCH_MP_TAC PAIRWISE_ORTHOGONAL_INDEPENDENT THEN ASM_SIMP_TAC[IN_DELETE];
6479     DISCH_TAC] THEN
6480   MATCH_MP_TAC(TAUT `b /\ (b ==> a) ==> a /\ b`) THEN CONJ_TAC THENL
6481    [ASM_MESON_TAC[SPAN_DELETE_0];
6482     DISCH_TAC THEN ASM_SIMP_TAC[BASIS_HAS_SIZE_DIM]]);;
6483
6484 let ORTHONORMAL_BASIS_SUBSPACE = prove
6485  (`!s:real^N->bool.
6486         subspace s
6487         ==> ?b. b SUBSET s /\
6488                 pairwise orthogonal b /\
6489                 (!x. x IN b ==> norm x = &1) /\
6490                 independent b /\
6491                 b HAS_SIZE (dim s) /\
6492                 span b = s`,
6493   REPEAT STRIP_TAC THEN
6494   FIRST_ASSUM(MP_TAC o MATCH_MP ORTHOGONAL_BASIS_SUBSPACE) THEN
6495   DISCH_THEN(X_CHOOSE_THEN `b:real^N->bool` STRIP_ASSUME_TAC) THEN
6496   EXISTS_TAC `IMAGE (\x:real^N. inv(norm x) % x) b` THEN
6497   CONJ_TAC THENL
6498    [REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN
6499     ASM_MESON_TAC[SPAN_MUL; SPAN_INC; SUBSET];
6500     ALL_TAC] THEN
6501   MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL
6502    [REWRITE_TAC[pairwise; IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN
6503     RULE_ASSUM_TAC(REWRITE_RULE[pairwise]) THEN
6504     ASM_MESON_TAC[ORTHOGONAL_CLAUSES];
6505     DISCH_TAC] THEN
6506   MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL
6507    [REWRITE_TAC[FORALL_IN_IMAGE; NORM_MUL; REAL_ABS_INV; REAL_ABS_NORM] THEN
6508     ASM_MESON_TAC[REAL_MUL_LINV; NORM_EQ_0];
6509     DISCH_TAC] THEN
6510   MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL
6511    [MATCH_MP_TAC PAIRWISE_ORTHOGONAL_INDEPENDENT THEN ASM_REWRITE_TAC[] THEN
6512     REWRITE_TAC[IN_IMAGE] THEN ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN
6513     SIMP_TAC[VECTOR_MUL_EQ_0; REAL_INV_EQ_0; NORM_EQ_0] THEN ASM_MESON_TAC[];
6514     DISCH_TAC] THEN
6515   MATCH_MP_TAC(TAUT `b /\ (b ==> a) ==> a /\ b`) THEN CONJ_TAC THENL
6516    [ALL_TAC; ASM_SIMP_TAC[BASIS_HAS_SIZE_DIM]] THEN
6517   UNDISCH_THEN `span b = (s:real^N->bool)` (SUBST1_TAC o SYM) THEN
6518   MATCH_MP_TAC SPAN_IMAGE_SCALE THEN
6519   REWRITE_TAC[REAL_INV_EQ_0; NORM_EQ_0] THEN
6520   ASM_MESON_TAC[HAS_SIZE]);;
6521
6522 let ORTHOGONAL_TO_SUBSPACE_EXISTS_GEN = prove
6523  (`!s t:real^N->bool.
6524         span s PSUBSET span t
6525         ==> ?x. ~(x = vec 0) /\ x IN span t /\
6526                 (!y. y IN span s ==> orthogonal x y)`,
6527   REPEAT STRIP_TAC THEN
6528   MP_TAC(ISPEC `span s:real^N->bool` ORTHOGONAL_BASIS_SUBSPACE) THEN
6529   REWRITE_TAC[SUBSPACE_SPAN] THEN
6530   DISCH_THEN(X_CHOOSE_THEN `b:real^N->bool` STRIP_ASSUME_TAC) THEN
6531   FIRST_X_ASSUM(SUBST_ALL_TAC o SYM) THEN
6532   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [PSUBSET_ALT]) THEN
6533   DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC
6534    (X_CHOOSE_THEN `u:real^N` STRIP_ASSUME_TAC)) THEN
6535   MP_TAC(ISPECL [`b:real^N->bool`; `{u:real^N}`] ORTHOGONAL_EXTENSION) THEN
6536   ASM_REWRITE_TAC[] THEN
6537   DISCH_THEN(X_CHOOSE_THEN `ns:real^N->bool` MP_TAC) THEN
6538   ASM_CASES_TAC `ns SUBSET (vec 0:real^N) INSERT b` THENL
6539    [DISCH_THEN(MP_TAC o AP_TERM `(IN) (u:real^N)` o CONJUNCT2) THEN
6540     SIMP_TAC[SPAN_SUPERSET; IN_UNION; IN_SING] THEN
6541     MATCH_MP_TAC(TAUT `~p ==> p ==> q`) THEN
6542     SUBGOAL_THEN `~(u IN span (b UNION {vec 0:real^N}))` MP_TAC THENL
6543      [ASM_REWRITE_TAC[SET_RULE `s UNION {a} = a INSERT s`; SPAN_INSERT_0];
6544       MATCH_MP_TAC(SET_RULE `s SUBSET t ==> ~(x IN t) ==> ~(x IN s)`) THEN
6545       MATCH_MP_TAC SPAN_MONO THEN ASM SET_TAC[]];
6546     ALL_TAC] THEN
6547   FIRST_X_ASSUM(MP_TAC o MATCH_MP (SET_RULE
6548    `~(s SUBSET t) ==> ?z. z IN s /\ ~(z IN t)`)) THEN
6549   REWRITE_TAC[LEFT_IMP_EXISTS_THM; IN_INSERT; DE_MORGAN_THM] THEN
6550   X_GEN_TAC `n:real^N` THEN STRIP_TAC THEN
6551   DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
6552   REWRITE_TAC[pairwise; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
6553   DISCH_THEN(MP_TAC o SPEC `n:real^N`) THEN ASM_REWRITE_TAC[IN_UNION] THEN
6554   REWRITE_TAC[IMP_IMP] THEN DISCH_TAC THEN EXISTS_TAC `n:real^N` THEN
6555   ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
6556    [SUBGOAL_THEN `(n:real^N) IN span (b UNION ns)` MP_TAC THENL
6557      [MATCH_MP_TAC SPAN_SUPERSET THEN ASM SET_TAC[];
6558       ASM_REWRITE_TAC[] THEN SPEC_TAC(`n:real^N`,`n:real^N`) THEN
6559       REWRITE_TAC[GSYM SUBSET] THEN
6560       MATCH_MP_TAC SPAN_SUBSET_SUBSPACE THEN REWRITE_TAC[SUBSPACE_SPAN] THEN
6561       ASM_REWRITE_TAC[SET_RULE
6562        `s UNION {a} SUBSET t <=> s SUBSET t /\ a IN t`] THEN
6563       ASM_MESON_TAC[SPAN_INC; SUBSET_TRANS]];
6564     MATCH_MP_TAC SPAN_INDUCT THEN
6565     REWRITE_TAC[SET_RULE `(\y. orthogonal n y) = {y | orthogonal n y}`] THEN
6566     REWRITE_TAC[SUBSPACE_ORTHOGONAL_TO_VECTOR] THEN ASM SET_TAC[]]);;
6567
6568 let ORTHOGONAL_TO_SUBSPACE_EXISTS = prove
6569  (`!s:real^N->bool. dim s < dimindex(:N)
6570                     ==> ?x. ~(x = vec 0) /\ !y. y IN s ==> orthogonal x y`,
6571   REPEAT STRIP_TAC THEN
6572   MP_TAC(ISPECL [`s:real^N->bool`; `(:real^N)`]
6573         ORTHOGONAL_TO_SUBSPACE_EXISTS_GEN) THEN
6574   ANTS_TAC THENL [REWRITE_TAC[PSUBSET]; MESON_TAC[SPAN_SUPERSET]] THEN
6575   REWRITE_TAC[SPAN_UNIV; SUBSET_UNIV] THEN
6576   ASM_MESON_TAC[DIM_SPAN; DIM_UNIV; LT_REFL]);;
6577
6578 let ORTHOGONAL_TO_VECTOR_EXISTS = prove
6579  (`!x:real^N. 2 <= dimindex(:N) ==> ?y. ~(y = vec 0) /\ orthogonal x y`,
6580   REPEAT STRIP_TAC THEN
6581   MP_TAC(ISPEC `{x:real^N}` ORTHOGONAL_TO_SUBSPACE_EXISTS) THEN
6582   SIMP_TAC[DIM_SING; IN_SING; LEFT_FORALL_IMP_THM; EXISTS_REFL] THEN
6583   ANTS_TAC THENL [ASM_ARITH_TAC; MESON_TAC[ORTHOGONAL_SYM]]);;
6584
6585 let SPAN_NOT_UNIV_ORTHOGONAL = prove
6586  (`!s. ~(span s = (:real^N))
6587          ==> ?a. ~(a = vec 0) /\ !x. x IN span s ==> a dot x = &0`,
6588   REWRITE_TAC[GSYM DIM_EQ_FULL; GSYM LE_ANTISYM; DIM_SUBSET_UNIV;
6589               NOT_LE] THEN
6590   REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM orthogonal] THEN
6591   MATCH_MP_TAC ORTHOGONAL_TO_SUBSPACE_EXISTS THEN ASM_REWRITE_TAC[DIM_SPAN]);;
6592
6593 let SPAN_NOT_UNIV_SUBSET_HYPERPLANE = prove
6594  (`!s. ~(span s = (:real^N))
6595        ==> ?a. ~(a = vec 0) /\ span s SUBSET {x | a dot x = &0}`,
6596   REWRITE_TAC[SUBSET; IN_ELIM_THM; SPAN_NOT_UNIV_ORTHOGONAL]);;
6597
6598 let LOWDIM_SUBSET_HYPERPLANE = prove
6599  (`!s. dim s < dimindex(:N)
6600        ==> ?a:real^N. ~(a = vec 0) /\ span s SUBSET {x | a dot x = &0}`,
6601   REPEAT STRIP_TAC THEN MATCH_MP_TAC SPAN_NOT_UNIV_SUBSET_HYPERPLANE THEN
6602   REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ; SUBSET_UNIV] THEN
6603   DISCH_THEN(MP_TAC o MATCH_MP DIM_SUBSET) THEN
6604   ASM_REWRITE_TAC[NOT_LE; DIM_SPAN; DIM_UNIV]);;
6605
6606 let VECTOR_EQ_DOT_SPAN = prove
6607  (`!b x y:real^N.
6608         (!v. v IN b ==> v dot x = v dot y) /\ x IN span b /\ y IN span b
6609         ==> x = y`,
6610   ONCE_REWRITE_TAC[GSYM REAL_SUB_0; GSYM VECTOR_SUB_EQ] THEN
6611   REWRITE_TAC[GSYM DOT_RSUB; GSYM ORTHOGONAL_REFL; GSYM orthogonal] THEN
6612   MESON_TAC[ORTHOGONAL_TO_SPAN; SPAN_SUB; ORTHOGONAL_SYM]);;
6613
6614 let ORTHONORMAL_BASIS_EXPAND = prove
6615  (`!b x:real^N.
6616         pairwise orthogonal b /\ (!v. v IN b ==> norm v = &1) /\ x IN span b
6617    ==> vsum b (\v. (v dot x) % v) = x`,
6618   REWRITE_TAC[NORM_EQ_1] THEN REPEAT STRIP_TAC THEN
6619   MATCH_MP_TAC VECTOR_EQ_DOT_SPAN THEN EXISTS_TAC `b:real^N->bool` THEN
6620   FIRST_ASSUM(ASSUME_TAC o MATCH_MP PAIRWISE_ORTHOGONAL_IMP_FINITE) THEN
6621   RULE_ASSUM_TAC(REWRITE_RULE[pairwise; orthogonal]) THEN
6622   ASM_SIMP_TAC[SPAN_VSUM; SPAN_MUL; DOT_RSUM; DOT_RMUL; SPAN_SUPERSET] THEN
6623   X_GEN_TAC `v:real^N` THEN DISCH_TAC THEN
6624   TRANS_TAC EQ_TRANS `sum b (\w:real^N. if w = v then v dot x else &0)` THEN
6625   CONJ_TAC THENL [ALL_TAC; ASM_SIMP_TAC[SUM_DELTA]] THEN
6626   MATCH_MP_TAC SUM_EQ THEN ASM_REWRITE_TAC[] THEN
6627   X_GEN_TAC `w:real^N` THEN DISCH_TAC THEN
6628   COND_CASES_TAC THEN ASM_SIMP_TAC[REAL_MUL_RID; REAL_MUL_RZERO]);;
6629
6630 (* ------------------------------------------------------------------------- *)
6631 (* Decomposing a vector into parts in orthogonal subspaces.                  *)
6632 (* ------------------------------------------------------------------------- *)
6633
6634 let ORTHOGONAL_SUBSPACE_DECOMP_UNIQUE = prove
6635  (`!s t x y x' y':real^N.
6636         (!a b. a IN s /\ b IN t ==> orthogonal a b) /\
6637         x IN span s /\ x' IN span s /\ y IN span t /\ y' IN span t /\
6638         x + y = x' + y'
6639         ==> x = x' /\ y = y'`,
6640   REWRITE_TAC[VECTOR_ARITH `x + y:real^N = x' + y' <=> x - x' = y' - y`] THEN
6641   ONCE_REWRITE_TAC[GSYM ORTHOGONAL_TO_SPANS_EQ] THEN
6642   REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[VECTOR_ARITH
6643    `x:real^N = x' /\ y:real^N = y' <=> x - x' = vec 0 /\ y' - y = vec 0`] THEN
6644   STRIP_TAC THEN ASM_REWRITE_TAC[GSYM ORTHOGONAL_REFL] THEN
6645   FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [SYM th]) THEN
6646   ASM_MESON_TAC[ORTHOGONAL_CLAUSES; ORTHOGONAL_SYM]);;
6647
6648 let ORTHOGONAL_SUBSPACE_DECOMP_EXISTS = prove
6649  (`!s x:real^N. ?y z. y IN span s /\ (!w. w IN span s ==> orthogonal z w) /\
6650                       x = y + z`,
6651   REPEAT STRIP_TAC THEN
6652   MP_TAC(ISPEC `span s:real^N->bool` ORTHOGONAL_BASIS_SUBSPACE) THEN
6653   REWRITE_TAC[SUBSPACE_SPAN; LEFT_IMP_EXISTS_THM] THEN
6654   X_GEN_TAC `t:real^N->bool` THEN STRIP_TAC THEN
6655   FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN
6656   EXISTS_TAC `vsum t (\b:real^N. (b dot x) / (b dot b) % b)` THEN
6657   EXISTS_TAC `x - vsum t (\b:real^N. (b dot x) / (b dot b) % b)` THEN
6658   REPEAT CONJ_TAC THENL
6659    [MATCH_MP_TAC SPAN_VSUM THEN
6660     ASM_SIMP_TAC[INDEPENDENT_IMP_FINITE; SPAN_CLAUSES];
6661     REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[ORTHOGONAL_SYM] THEN
6662     MATCH_MP_TAC GRAM_SCHMIDT_STEP THEN ASM_SIMP_TAC[];
6663     VECTOR_ARITH_TAC]);;
6664
6665 let ORTHOGONAL_SUBSPACE_DECOMP = prove
6666  (`!s x. ?!(y,z). y IN span s /\
6667                   z IN {z:real^N | !x. x IN span s ==> orthogonal z x} /\
6668                   x = y + z`,
6669   REWRITE_TAC[EXISTS_UNIQUE_DEF; IN_ELIM_THM] THEN
6670   REWRITE_TAC[EXISTS_PAIRED_THM; FORALL_PAIRED_THM] THEN
6671   REWRITE_TAC[FORALL_PAIR_THM; ORTHOGONAL_SUBSPACE_DECOMP_EXISTS] THEN
6672   REPEAT STRIP_TAC THEN REWRITE_TAC[PAIR_EQ] THEN
6673   MATCH_MP_TAC ORTHOGONAL_SUBSPACE_DECOMP_UNIQUE THEN
6674   MAP_EVERY EXISTS_TAC
6675    [`s:real^N->bool`; `{z:real^N | !x. x IN span s ==> orthogonal z x}`] THEN
6676   ASM_SIMP_TAC[SPAN_CLAUSES; IN_ELIM_THM] THEN
6677   ASM_MESON_TAC[SPAN_CLAUSES; ORTHOGONAL_SYM]);;
6678
6679 (* ------------------------------------------------------------------------- *)
6680 (* Existence of isometry between subspaces of same dimension.                *)
6681 (* ------------------------------------------------------------------------- *)
6682
6683 let ISOMETRY_SUBSET_SUBSPACE = prove
6684  (`!s:real^M->bool t:real^N->bool.
6685         subspace s /\ subspace t /\ dim s <= dim t
6686         ==> ?f. linear f /\ IMAGE f s SUBSET t /\
6687                 (!x. x IN s ==> norm(f x) = norm(x))`,
6688   REPEAT STRIP_TAC THEN
6689   MP_TAC(ISPEC `t:real^N->bool` ORTHONORMAL_BASIS_SUBSPACE) THEN
6690   MP_TAC(ISPEC `s:real^M->bool` ORTHONORMAL_BASIS_SUBSPACE) THEN
6691   ASM_REWRITE_TAC[HAS_SIZE] THEN
6692   DISCH_THEN(X_CHOOSE_THEN `b:real^M->bool` STRIP_ASSUME_TAC) THEN
6693   DISCH_THEN(X_CHOOSE_THEN `c:real^N->bool` STRIP_ASSUME_TAC) THEN
6694   MP_TAC(ISPECL [`b:real^M->bool`; `c:real^N->bool`] CARD_LE_INJ) THEN
6695   ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM; INJECTIVE_ON_ALT] THEN
6696   X_GEN_TAC `fb:real^M->real^N` THEN STRIP_TAC THEN
6697   MP_TAC(ISPECL [`fb:real^M->real^N`; `b:real^M->bool`]
6698     LINEAR_INDEPENDENT_EXTEND) THEN
6699   ASM_REWRITE_TAC[IMP_IMP; LEFT_AND_EXISTS_THM; INJECTIVE_ON_ALT] THEN
6700   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `f:real^M->real^N` THEN
6701   STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
6702    [REWRITE_TAC[SYM(ASSUME `span b:real^M->bool = s`)] THEN
6703     ASM_SIMP_TAC[GSYM SPAN_LINEAR_IMAGE] THEN
6704     REWRITE_TAC[SYM(ASSUME `span c:real^N->bool = t`)] THEN
6705     MATCH_MP_TAC SPAN_MONO THEN ASM SET_TAC[];
6706     UNDISCH_THEN `span b:real^M->bool = s` (SUBST1_TAC o SYM) THEN
6707     ASM_SIMP_TAC[SPAN_FINITE] THEN
6708     REWRITE_TAC[IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN
6709     MAP_EVERY X_GEN_TAC [`z:real^M`; `u:real^M->real`] THEN
6710     DISCH_THEN(SUBST1_TAC o SYM) THEN ASM_SIMP_TAC[LINEAR_VSUM] THEN
6711     REWRITE_TAC[o_DEF; NORM_EQ_SQUARE; NORM_POS_LE; GSYM NORM_POW_2] THEN
6712     ASM_SIMP_TAC[LINEAR_CMUL] THEN
6713     W(MP_TAC o PART_MATCH (lhand o rand)
6714       NORM_VSUM_PYTHAGOREAN o rand o snd) THEN
6715     W(MP_TAC o PART_MATCH (lhand o rand)
6716       NORM_VSUM_PYTHAGOREAN o lhand o rand o snd) THEN
6717     RULE_ASSUM_TAC(REWRITE_RULE[pairwise]) THEN
6718     ASM_SIMP_TAC[pairwise; ORTHOGONAL_CLAUSES] THEN ANTS_TAC THENL
6719      [REPEAT STRIP_TAC THEN REWRITE_TAC[ORTHOGONAL_MUL] THEN ASM SET_TAC[];
6720       REPEAT(DISCH_THEN SUBST1_TAC) THEN ASM_SIMP_TAC[NORM_MUL] THEN
6721       MATCH_MP_TAC SUM_EQ THEN ASM SET_TAC[]]]);;
6722
6723 let ISOMETRIES_SUBSPACES = prove
6724  (`!s:real^M->bool t:real^N->bool.
6725         subspace s /\ subspace t /\ dim s = dim t
6726         ==> ?f g. linear f /\ linear g /\
6727                   IMAGE f s = t /\ IMAGE g t = s /\
6728                   (!x. x IN s ==> norm(f x) = norm x) /\
6729                   (!y. y IN t ==> norm(g y) = norm y) /\
6730                   (!x. x IN s ==> g(f x) = x) /\
6731                   (!y. y IN t ==> f(g y) = y)`,
6732   REPEAT STRIP_TAC THEN ABBREV_TAC `n = dim(t:real^N->bool)` THEN
6733   MP_TAC(ISPEC `t:real^N->bool` ORTHONORMAL_BASIS_SUBSPACE) THEN
6734   MP_TAC(ISPEC `s:real^M->bool` ORTHONORMAL_BASIS_SUBSPACE) THEN
6735   ASM_REWRITE_TAC[] THEN
6736   DISCH_THEN(X_CHOOSE_THEN `b:real^M->bool` STRIP_ASSUME_TAC) THEN
6737   DISCH_THEN(X_CHOOSE_THEN `c:real^N->bool` STRIP_ASSUME_TAC) THEN
6738   MP_TAC(ISPECL [`b:real^M->bool`; `c:real^N->bool`] CARD_EQ_BIJECTIONS) THEN
6739   RULE_ASSUM_TAC(REWRITE_RULE[HAS_SIZE]) THEN
6740   ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
6741   MAP_EVERY X_GEN_TAC [`fb:real^M->real^N`; `gb:real^N->real^M`] THEN
6742   STRIP_TAC THEN
6743   MP_TAC(ISPECL [`gb:real^N->real^M`; `c:real^N->bool`]
6744     LINEAR_INDEPENDENT_EXTEND) THEN
6745   MP_TAC(ISPECL [`fb:real^M->real^N`; `b:real^M->bool`]
6746     LINEAR_INDEPENDENT_EXTEND) THEN
6747   ASM_REWRITE_TAC[IMP_IMP; LEFT_AND_EXISTS_THM] THEN
6748   REWRITE_TAC[RIGHT_AND_EXISTS_THM] THEN
6749   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `f:real^M->real^N` THEN
6750   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^N->real^M` THEN
6751   STRIP_TAC THEN ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL
6752    [REWRITE_TAC[SYM(ASSUME `span b:real^M->bool = s`)] THEN
6753     ASM_SIMP_TAC[GSYM SPAN_LINEAR_IMAGE] THEN
6754     REWRITE_TAC[SYM(ASSUME `span c:real^N->bool = t`)] THEN
6755     AP_TERM_TAC THEN ASM SET_TAC[];
6756     REWRITE_TAC[SYM(ASSUME `span c:real^N->bool = t`)] THEN
6757     ASM_SIMP_TAC[GSYM SPAN_LINEAR_IMAGE] THEN
6758     REWRITE_TAC[SYM(ASSUME `span b:real^M->bool = s`)] THEN
6759     AP_TERM_TAC THEN ASM SET_TAC[];
6760     UNDISCH_THEN `span b:real^M->bool = s` (SUBST1_TAC o SYM) THEN
6761     ASM_SIMP_TAC[SPAN_FINITE] THEN
6762     REWRITE_TAC[IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN
6763     MAP_EVERY X_GEN_TAC [`z:real^M`; `u:real^M->real`] THEN
6764     DISCH_THEN(SUBST1_TAC o SYM) THEN ASM_SIMP_TAC[LINEAR_VSUM] THEN
6765     REWRITE_TAC[o_DEF; NORM_EQ_SQUARE; NORM_POS_LE; GSYM NORM_POW_2] THEN
6766     ASM_SIMP_TAC[LINEAR_CMUL] THEN
6767     W(MP_TAC o PART_MATCH (lhand o rand)
6768       NORM_VSUM_PYTHAGOREAN o rand o snd) THEN
6769     W(MP_TAC o PART_MATCH (lhand o rand)
6770       NORM_VSUM_PYTHAGOREAN o lhand o rand o snd) THEN
6771     RULE_ASSUM_TAC(REWRITE_RULE[pairwise]) THEN
6772     ASM_SIMP_TAC[pairwise; ORTHOGONAL_CLAUSES] THEN ANTS_TAC THENL
6773      [REPEAT STRIP_TAC THEN REWRITE_TAC[ORTHOGONAL_MUL] THEN ASM SET_TAC[];
6774       REPEAT(DISCH_THEN SUBST1_TAC) THEN
6775       ASM_SIMP_TAC[NORM_MUL]];
6776     UNDISCH_THEN `span c:real^N->bool = t` (SUBST1_TAC o SYM) THEN
6777     ASM_SIMP_TAC[SPAN_FINITE] THEN
6778     REWRITE_TAC[IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN
6779     MAP_EVERY X_GEN_TAC [`z:real^N`; `u:real^N->real`] THEN
6780     DISCH_THEN(SUBST1_TAC o SYM) THEN ASM_SIMP_TAC[LINEAR_VSUM] THEN
6781     REWRITE_TAC[o_DEF; NORM_EQ_SQUARE; NORM_POS_LE; GSYM NORM_POW_2] THEN
6782     ASM_SIMP_TAC[LINEAR_CMUL] THEN
6783     W(MP_TAC o PART_MATCH (lhand o rand)
6784       NORM_VSUM_PYTHAGOREAN o rand o snd) THEN
6785     W(MP_TAC o PART_MATCH (lhand o rand)
6786       NORM_VSUM_PYTHAGOREAN o lhand o rand o snd) THEN
6787     RULE_ASSUM_TAC(REWRITE_RULE[pairwise]) THEN
6788     ASM_SIMP_TAC[pairwise; ORTHOGONAL_CLAUSES] THEN ANTS_TAC THENL
6789      [REPEAT STRIP_TAC THEN REWRITE_TAC[ORTHOGONAL_MUL] THEN ASM SET_TAC[];
6790       REPEAT(DISCH_THEN SUBST1_TAC) THEN
6791       ASM_SIMP_TAC[NORM_MUL]];
6792     REWRITE_TAC[SYM(ASSUME `span b:real^M->bool = s`)] THEN
6793     MATCH_MP_TAC SPAN_INDUCT THEN
6794     CONJ_TAC THENL [ASM_MESON_TAC[SUBSET; IN]; ALL_TAC] THEN
6795     REWRITE_TAC[subspace; IN] THEN ASM_MESON_TAC[linear; LINEAR_0];
6796     REWRITE_TAC[SYM(ASSUME `span c:real^N->bool = t`)] THEN
6797     MATCH_MP_TAC SPAN_INDUCT THEN
6798     CONJ_TAC THENL [ASM_MESON_TAC[SUBSET; IN]; ALL_TAC] THEN
6799     REWRITE_TAC[subspace; IN] THEN ASM_MESON_TAC[linear; LINEAR_0]]);;
6800
6801 let ISOMETRY_SUBSPACES = prove
6802  (`!s:real^M->bool t:real^N->bool.
6803         subspace s /\ subspace t /\ dim s = dim t
6804         ==> ?f:real^M->real^N. linear f /\ IMAGE f s = t /\
6805                                (!x. x IN s ==> norm(f x) = norm(x))`,
6806   REPEAT GEN_TAC THEN
6807   DISCH_THEN(MP_TAC o MATCH_MP ISOMETRIES_SUBSPACES) THEN
6808   MATCH_MP_TAC MONO_EXISTS THEN MESON_TAC[]);;
6809
6810 let ISOMETRY_UNIV_SUBSPACE = prove
6811  (`!s. subspace s /\ dimindex(:M) = dim s
6812        ==> ?f:real^M->real^N.
6813                 linear f /\ IMAGE f (:real^M) = s /\
6814                 (!x. norm(f x) = norm(x))`,
6815   REPEAT STRIP_TAC THEN
6816   MP_TAC(ISPECL [`(:real^M)`; `s:real^N->bool`] ISOMETRY_SUBSPACES) THEN
6817   ASM_REWRITE_TAC[SUBSPACE_UNIV; IN_UNIV; DIM_UNIV]);;
6818
6819 let ISOMETRY_UNIV_SUPERSET_SUBSPACE = prove
6820  (`!s. subspace s /\ dim s <= dimindex(:M) /\ dimindex(:M) <= dimindex(:N)
6821        ==> ?f:real^M->real^N.
6822                 linear f /\ s SUBSET (IMAGE f (:real^M)) /\
6823                 (!x. norm(f x) = norm(x))`,
6824   GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN ASSUME_TAC) THEN
6825   FIRST_ASSUM(MP_TAC o MATCH_MP LOWDIM_EXPAND_DIMENSION) THEN
6826   DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) THEN
6827   MP_TAC(ISPECL [`(:real^M)`; `span t:real^N->bool`] ISOMETRY_SUBSPACES) THEN
6828   ASM_REWRITE_TAC[SUBSPACE_SPAN; SUBSPACE_UNIV; DIM_UNIV; DIM_SPAN] THEN
6829   MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[IN_UNIV] THEN
6830   ASM_MESON_TAC[SUBSET; SPAN_INC]);;
6831
6832 let ISOMETRY_UNIV_UNIV = prove
6833  (`dimindex(:M) <= dimindex(:N)
6834    ==> ?f:real^M->real^N. linear f /\ (!x. norm(f x) = norm(x))`,
6835   DISCH_TAC THEN
6836   MP_TAC(ISPEC `{vec 0:real^N}`ISOMETRY_UNIV_SUPERSET_SUBSPACE) THEN
6837   ASM_REWRITE_TAC[SUBSPACE_TRIVIAL] THEN
6838   ANTS_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN
6839   MATCH_MP_TAC(ARITH_RULE `x = 0 /\ 1 <= y ==> x <= y`) THEN
6840   ASM_REWRITE_TAC[DIM_EQ_0; DIMINDEX_GE_1] THEN SET_TAC[]);;
6841
6842 let SUBSPACE_ISOMORPHISM = prove
6843  (`!s t. subspace s /\ subspace t /\ dim(s) = dim(t)
6844          ==> ?f:real^M->real^N.
6845                 linear f /\ (IMAGE f s = t) /\
6846                 (!x y. x IN s /\ y IN s /\ f x = f y ==> (x = y))`,
6847   REPEAT GEN_TAC THEN DISCH_TAC THEN
6848   FIRST_ASSUM(MP_TAC o MATCH_MP ISOMETRY_SUBSPACES) THEN
6849   MATCH_MP_TAC MONO_EXISTS THEN
6850   ASM_SIMP_TAC[LINEAR_INJECTIVE_0_SUBSPACE] THEN MESON_TAC[NORM_EQ_0]);;
6851
6852 let ISOMORPHISMS_UNIV_UNIV = prove
6853  (`dimindex(:M) = dimindex(:N)
6854    ==> ?f:real^M->real^N g.
6855             linear f /\ linear g /\
6856             (!x. norm(f x) = norm x) /\ (!y. norm(g y) = norm y) /\
6857             (!x. g(f x) = x) /\ (!y. f(g y) = y)`,
6858   REPEAT STRIP_TAC THEN
6859   EXISTS_TAC `(\x. lambda i. x$i):real^M->real^N` THEN
6860   EXISTS_TAC `(\x. lambda i. x$i):real^N->real^M` THEN
6861   SIMP_TAC[vector_norm; dot; LAMBDA_BETA] THEN
6862   SIMP_TAC[linear; CART_EQ; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT;
6863            LAMBDA_BETA] THEN
6864   FIRST_ASSUM SUBST1_TAC THEN SIMP_TAC[LAMBDA_BETA] THEN
6865   FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN SIMP_TAC[LAMBDA_BETA]);;
6866
6867 (* ------------------------------------------------------------------------- *)
6868 (* Properties of special hyperplanes.                                        *)
6869 (* ------------------------------------------------------------------------- *)
6870
6871 let SUBSPACE_HYPERPLANE = prove
6872  (`!a. subspace {x:real^N | a dot x = &0}`,
6873   SIMP_TAC[subspace; DOT_RADD; DOT_RMUL; IN_ELIM_THM; REAL_ADD_LID;
6874            REAL_MUL_RZERO; DOT_RZERO]);;
6875
6876 let SUBSPACE_SPECIAL_HYPERPLANE = prove
6877  (`!k. subspace {x:real^N | x$k = &0}`,
6878   SIMP_TAC[subspace; IN_ELIM_THM; VEC_COMPONENT;
6879            VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT] THEN REAL_ARITH_TAC);;
6880
6881 let SPECIAL_HYPERPLANE_SPAN = prove
6882  (`!k. 1 <= k /\ k <= dimindex(:N)
6883        ==> {x:real^N | x$k = &0} =
6884            span(IMAGE basis ((1..dimindex(:N)) DELETE k))`,
6885   REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC SPAN_SUBSPACE THEN
6886   ASM_SIMP_TAC[SUBSPACE_SPECIAL_HYPERPLANE] THEN CONJ_TAC THENL
6887    [REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_THM] THEN
6888     ASM_SIMP_TAC[BASIS_COMPONENT; IN_DELETE];
6889     REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN
6890     X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
6891     GEN_REWRITE_TAC LAND_CONV [GSYM BASIS_EXPANSION] THEN
6892     SIMP_TAC[SPAN_FINITE; FINITE_IMAGE; FINITE_DELETE; FINITE_NUMSEG] THEN
6893     REWRITE_TAC[IN_ELIM_THM] THEN
6894     EXISTS_TAC `\v:real^N. x dot v` THEN
6895     W(MP_TAC o PART_MATCH (lhs o rand) VSUM_IMAGE o lhs o snd) THEN
6896     ANTS_TAC THENL
6897      [REWRITE_TAC[FINITE_DELETE; FINITE_NUMSEG; IN_NUMSEG; IN_DELETE] THEN
6898       MESON_TAC[BASIS_INJ];
6899       DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[o_DEF] THEN
6900       ASM_SIMP_TAC[VSUM_DELETE; FINITE_NUMSEG; IN_NUMSEG; DOT_BASIS] THEN
6901       REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_SUB_RZERO]]]);;
6902
6903 let DIM_SPECIAL_HYPERPLANE = prove
6904  (`!k. 1 <= k /\ k <= dimindex(:N)
6905        ==> dim {x:real^N | x$k = &0} = dimindex(:N) - 1`,
6906   SIMP_TAC[SPECIAL_HYPERPLANE_SPAN] THEN REPEAT STRIP_TAC THEN
6907   MATCH_MP_TAC DIM_UNIQUE THEN
6908   EXISTS_TAC `IMAGE (basis:num->real^N) ((1..dimindex(:N)) DELETE k)` THEN
6909   REWRITE_TAC[SUBSET_REFL; SPAN_INC] THEN CONJ_TAC THENL
6910    [MATCH_MP_TAC INDEPENDENT_MONO THEN
6911     EXISTS_TAC `{basis i:real^N | 1 <= i /\ i <= dimindex(:N)}` THEN
6912     REWRITE_TAC[INDEPENDENT_STDBASIS; SUBSET; FORALL_IN_IMAGE] THEN
6913     REWRITE_TAC[IN_DELETE; IN_NUMSEG; IN_ELIM_THM] THEN MESON_TAC[];
6914     MATCH_MP_TAC HAS_SIZE_IMAGE_INJ THEN CONJ_TAC THENL
6915      [REWRITE_TAC[FINITE_DELETE; FINITE_NUMSEG; IN_NUMSEG; IN_DELETE] THEN
6916       MESON_TAC[BASIS_INJ];
6917       ASM_SIMP_TAC[HAS_SIZE; FINITE_DELETE; FINITE_NUMSEG; CARD_DELETE;
6918                    FINITE_IMAGE; IN_NUMSEG; CARD_NUMSEG_1]]]);;
6919
6920 (* ------------------------------------------------------------------------- *)
6921 (* More theorems about dimensions of different subspaces.                    *)
6922 (* ------------------------------------------------------------------------- *)
6923
6924 let DIM_IMAGE_KERNEL_GEN = prove
6925  (`!f:real^M->real^N s.
6926         linear f /\ subspace s
6927         ==> dim(IMAGE f s) + dim {x | x IN s /\  f x = vec 0} = dim(s)`,
6928   REPEAT STRIP_TAC THEN MP_TAC
6929    (ISPEC `{x | x IN s /\ (f:real^M->real^N) x = vec 0}` BASIS_EXISTS) THEN
6930   DISCH_THEN(X_CHOOSE_THEN `v:real^M->bool` STRIP_ASSUME_TAC) THEN
6931   MP_TAC(ISPECL [`v:real^M->bool`; `s:real^M->bool`]
6932     MAXIMAL_INDEPENDENT_SUBSET_EXTEND) THEN
6933   ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
6934   DISCH_THEN(X_CHOOSE_THEN `w:real^M->bool` STRIP_ASSUME_TAC) THEN
6935   SUBGOAL_THEN `span(w:real^M->bool) = s`
6936    (fun th -> GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [SYM th] THEN
6937               ASSUME_TAC th)
6938   THENL [ASM_SIMP_TAC[SPAN_SUBSPACE]; ALL_TAC] THEN
6939   SUBGOAL_THEN `subspace {x | x IN s /\ (f:real^M->real^N) x = vec 0}`
6940   ASSUME_TAC THENL
6941    [REWRITE_TAC[SET_RULE `{x | x IN s /\ P x} = s INTER {x | P x}`] THEN
6942     ASM_SIMP_TAC[SUBSPACE_INTER; SUBSPACE_KERNEL];
6943     ALL_TAC] THEN
6944   SUBGOAL_THEN `{x | x IN s /\ (f:real^M->real^N) x = vec 0} = span v`
6945   ASSUME_TAC THENL
6946    [ASM_MESON_TAC[SUBSET_ANTISYM; SPAN_SUBSET_SUBSPACE; SUBSPACE_KERNEL];
6947     ALL_TAC] THEN
6948   ASM_SIMP_TAC[DIM_SPAN; DIM_EQ_CARD] THEN
6949   SUBGOAL_THEN
6950    `!x. x IN span(w DIFF v) /\ (f:real^M->real^N) x = vec 0 ==> x = vec 0`
6951   (LABEL_TAC "*") THENL
6952    [MATCH_MP_TAC(SET_RULE
6953      `!t. s SUBSET t /\ (!x. x IN s /\ x IN t /\ P x ==> Q x)
6954           ==> (!x. x IN s /\ P x ==> Q x)`) THEN
6955     EXISTS_TAC `s:real^M->bool` THEN CONJ_TAC THENL
6956      [ASM_MESON_TAC[SPAN_MONO; SUBSET_DIFF]; ALL_TAC] THEN
6957     ASM_SIMP_TAC[SPAN_FINITE; IN_ELIM_THM; IMP_CONJ; FINITE_DIFF;
6958                  INDEPENDENT_IMP_FINITE; LEFT_IMP_EXISTS_THM] THEN
6959     GEN_TAC THEN X_GEN_TAC `u:real^M->real` THEN
6960     DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[IMP_IMP] THEN
6961     ONCE_REWRITE_TAC[SET_RULE
6962      `y IN s /\ f y = a <=> y IN {x | x IN s /\ f x = a}`] THEN
6963     ASM_REWRITE_TAC[] THEN
6964     ASM_SIMP_TAC[SPAN_FINITE; INDEPENDENT_IMP_FINITE; IN_ELIM_THM] THEN
6965     DISCH_THEN(X_CHOOSE_TAC `t:real^M->real`) THEN
6966     MP_TAC(ISPEC `w:real^M->bool` INDEPENDENT_EXPLICIT) THEN
6967     ASM_REWRITE_TAC[] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
6968     DISCH_THEN(MP_TAC o SPEC
6969      `(\x. if x IN w DIFF v then --u x else t x):real^M->real`) THEN
6970     ASM_REWRITE_TAC[COND_RAND] THEN ONCE_REWRITE_TAC[COND_RATOR] THEN
6971     ASM_SIMP_TAC[VSUM_CASES; INDEPENDENT_IMP_FINITE] THEN
6972     REWRITE_TAC[SET_RULE `{x | x IN w /\ x IN (w DIFF v)} = w DIFF v`] THEN
6973     SIMP_TAC[ASSUME `(v:real^M->bool) SUBSET w`; SET_RULE
6974      `v SUBSET w ==> {x | x IN w /\ ~(x IN (w DIFF v))} = v`] THEN
6975     ASM_REWRITE_TAC[VECTOR_MUL_LNEG; VSUM_NEG; VECTOR_ADD_LINV] THEN
6976     DISCH_THEN(fun th -> MATCH_MP_TAC VSUM_EQ_0 THEN MP_TAC th) THEN
6977     REWRITE_TAC[REAL_NEG_EQ_0; VECTOR_MUL_EQ_0; IN_DIFF] THEN MESON_TAC[];
6978     ALL_TAC] THEN
6979   SUBGOAL_THEN `!x y. x IN (w DIFF v) /\ y IN (w DIFF v) /\
6980                       (f:real^M->real^N) x = f y ==> x = y`
6981   ASSUME_TAC THENL
6982    [REMOVE_THEN "*" MP_TAC THEN
6983     ASM_SIMP_TAC[GSYM LINEAR_INJECTIVE_0_SUBSPACE; SUBSPACE_SPAN] THEN
6984     MP_TAC(ISPEC `w DIFF v:real^M->bool` SPAN_INC) THEN SET_TAC[];
6985     ALL_TAC] THEN
6986   SUBGOAL_THEN `IMAGE (f:real^M->real^N) s = span(IMAGE f (w DIFF v))`
6987   SUBST1_TAC THENL
6988    [MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL
6989      [ALL_TAC;
6990       ASM_MESON_TAC[SUBSPACE_LINEAR_IMAGE; SPAN_MONO; IMAGE_SUBSET;
6991                     SUBSET_TRANS; SUBSET_DIFF; SPAN_EQ_SELF]] THEN
6992     SIMP_TAC[SUBSET; FORALL_IN_IMAGE] THEN X_GEN_TAC `x:real^M` THEN
6993     DISCH_TAC THEN UNDISCH_TAC `span w:real^M->bool = s` THEN
6994     REWRITE_TAC[EXTENSION] THEN DISCH_THEN(MP_TAC o SPEC `x:real^M`) THEN
6995     ASM_REWRITE_TAC[] THEN
6996     REMOVE_THEN "*" (MP_TAC o SPEC `x:real^M`) THEN
6997     (CONV_TAC o GEN_SIMPLIFY_CONV TOP_DEPTH_SQCONV (basic_ss []) 4)
6998      [IN_UNIV; SPAN_FINITE; INDEPENDENT_IMP_FINITE; IN_ELIM_THM;
6999       FINITE_IMAGE; FINITE_DIFF; ASSUME `independent(w:real^M->bool)`] THEN
7000     REWRITE_TAC[IMP_CONJ; LEFT_IMP_EXISTS_THM] THEN DISCH_TAC THEN
7001     X_GEN_TAC `u:real^M->real` THEN DISCH_THEN(SUBST1_TAC o SYM) THEN
7002     FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [INJECTIVE_ON_LEFT_INVERSE]) THEN
7003     DISCH_THEN(X_CHOOSE_TAC `g:real^N->real^M`) THEN
7004     EXISTS_TAC `(u:real^M->real) o (g:real^N->real^M)` THEN
7005     W(MP_TAC o PART_MATCH (lhs o rand) VSUM_IMAGE o lhand o snd) THEN
7006     ASM_REWRITE_TAC[] THEN
7007     ASM_SIMP_TAC[FINITE_DIFF; INDEPENDENT_IMP_FINITE; LINEAR_VSUM] THEN
7008     DISCH_THEN SUBST1_TAC THEN ASM_REWRITE_TAC[o_DEF] THEN
7009     CONV_TAC SYM_CONV THEN MATCH_MP_TAC VSUM_EQ_SUPERSET THEN
7010     SIMP_TAC[SUBSET_DIFF; FINITE_DIFF; INDEPENDENT_IMP_FINITE;
7011              LINEAR_CMUL; IN_DIFF; TAUT `a /\ ~(a /\ ~b) <=> a /\ b`;
7012              ASSUME `independent(w:real^M->bool)`;
7013              ASSUME `linear(f:real^M->real^N)`] THEN
7014     REWRITE_TAC[VECTOR_MUL_EQ_0] THEN ASM SET_TAC[];
7015     SUBGOAL_THEN `independent(IMAGE (f:real^M->real^N) (w DIFF v))`
7016     ASSUME_TAC THENL
7017      [MATCH_MP_TAC INDEPENDENT_INJECTIVE_IMAGE_GEN THEN
7018       ASM_SIMP_TAC[LINEAR_INJECTIVE_0_SUBSPACE; SUBSPACE_SPAN] THEN
7019       ASM_MESON_TAC[INDEPENDENT_MONO; SUBSET_DIFF];
7020       ASM_SIMP_TAC[DIM_SPAN; DIM_EQ_CARD] THEN
7021       W(MP_TAC o PART_MATCH (lhs o rand) CARD_IMAGE_INJ o
7022         lhand o lhand o snd) THEN
7023       ASM_REWRITE_TAC[] THEN
7024       ASM_SIMP_TAC[FINITE_DIFF; CARD_DIFF; INDEPENDENT_IMP_FINITE] THEN
7025       DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC SUB_ADD THEN
7026       ASM_MESON_TAC[CARD_SUBSET; INDEPENDENT_IMP_FINITE]]]);;
7027
7028 let DIM_IMAGE_KERNEL = prove
7029  (`!f:real^M->real^N.
7030         linear f
7031         ==> dim(IMAGE f (:real^M)) + dim {x | f x = vec 0} = dimindex(:M)`,
7032   REPEAT STRIP_TAC THEN
7033   MP_TAC(ISPECL [`f:real^M->real^N`; `(:real^M)`] DIM_IMAGE_KERNEL_GEN) THEN
7034   ASM_REWRITE_TAC[SUBSPACE_UNIV; IN_UNIV; DIM_UNIV]);;
7035
7036 let DIM_SUMS_INTER = prove
7037  (`!s t:real^N->bool.
7038     subspace s /\ subspace t
7039     ==> dim {x + y | x IN s /\ y IN t} + dim(s INTER t) = dim(s) + dim(t)`,
7040   REPEAT STRIP_TAC THEN
7041   MP_TAC(ISPEC `s INTER t:real^N->bool` BASIS_EXISTS) THEN
7042   DISCH_THEN(X_CHOOSE_THEN `b:real^N->bool` STRIP_ASSUME_TAC) THEN
7043   MP_TAC(ISPECL [`b:real^N->bool`; `s:real^N->bool`]
7044     MAXIMAL_INDEPENDENT_SUBSET_EXTEND) THEN
7045   ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
7046   DISCH_THEN(X_CHOOSE_THEN `c:real^N->bool` STRIP_ASSUME_TAC) THEN
7047   MP_TAC(ISPECL [`b:real^N->bool`; `t:real^N->bool`]
7048     MAXIMAL_INDEPENDENT_SUBSET_EXTEND) THEN
7049   ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
7050   DISCH_THEN(X_CHOOSE_THEN `d:real^N->bool` STRIP_ASSUME_TAC) THEN
7051   SUBGOAL_THEN `(c:real^N->bool) INTER d = b` ASSUME_TAC THENL
7052    [MATCH_MP_TAC SUBSET_ANTISYM THEN ASM_REWRITE_TAC[SUBSET_INTER] THEN
7053     REWRITE_TAC[SUBSET; IN_INTER] THEN X_GEN_TAC `x:real^N` THEN
7054     STRIP_TAC THEN MP_TAC(ISPEC `c:real^N->bool` independent) THEN
7055     ASM_REWRITE_TAC[dependent; NOT_EXISTS_THM] THEN
7056     DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN
7057     ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN STRIP_TAC THEN
7058     REWRITE_TAC[] THEN
7059     SUBGOAL_THEN `(x:real^N) IN span b` MP_TAC THENL
7060      [ASM_MESON_TAC[SUBSET; IN_INTER; SPAN_INC];
7061       MP_TAC(ISPECL [`b:real^N->bool`; `c DELETE (x:real^N)`] SPAN_MONO) THEN
7062       ASM SET_TAC[]];
7063     ALL_TAC] THEN
7064   SUBGOAL_THEN
7065    `dim (s INTER t:real^N->bool) = CARD(b:real^N->bool) /\
7066     dim s = CARD c /\ dim t = CARD d /\
7067     dim {x + y:real^N | x IN s /\ y IN t} = CARD(c UNION d:real^N->bool)`
7068   (REPEAT_TCL CONJUNCTS_THEN SUBST1_TAC) THENL
7069    [ALL_TAC;
7070     ASM_SIMP_TAC[CARD_UNION_GEN; INDEPENDENT_IMP_FINITE] THEN
7071     MATCH_MP_TAC(ARITH_RULE `b:num <= c ==> (c + d) - b + b = c + d`) THEN
7072     ASM_SIMP_TAC[CARD_SUBSET; INDEPENDENT_IMP_FINITE]] THEN
7073   REPEAT CONJ_TAC THEN MATCH_MP_TAC DIM_UNIQUE THENL
7074    [EXISTS_TAC `b:real^N->bool`;
7075     EXISTS_TAC `c:real^N->bool`;
7076     EXISTS_TAC `d:real^N->bool`;
7077     EXISTS_TAC `c UNION d:real^N->bool`] THEN
7078   ASM_SIMP_TAC[HAS_SIZE; INDEPENDENT_IMP_FINITE; FINITE_UNION] THEN
7079   REWRITE_TAC[UNION_SUBSET; GSYM CONJ_ASSOC] THEN
7080   REWRITE_TAC[SUBSET; IN_ELIM_THM; FORALL_IN_GSPEC] THEN REPEAT CONJ_TAC THENL
7081    [X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
7082     MAP_EVERY EXISTS_TAC [`x:real^N`; `vec 0:real^N`] THEN
7083     ASM_SIMP_TAC[SUBSPACE_0; VECTOR_ADD_RID] THEN ASM SET_TAC[];
7084     X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
7085     MAP_EVERY EXISTS_TAC [`vec 0:real^N`; `x:real^N`] THEN
7086     ASM_SIMP_TAC[SUBSPACE_0; VECTOR_ADD_LID] THEN ASM SET_TAC[];
7087     MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN STRIP_TAC THEN
7088     MATCH_MP_TAC SPAN_ADD THEN CONJ_TAC THENL
7089      [MP_TAC(ISPECL[`c:real^N->bool`; `c UNION d:real^N->bool`] SPAN_MONO);
7090       MP_TAC(ISPECL[`d:real^N->bool`; `c UNION d:real^N->bool`] SPAN_MONO)] THEN
7091     REWRITE_TAC[SUBSET_UNION] THEN REWRITE_TAC[SUBSET] THEN
7092     DISCH_THEN MATCH_MP_TAC THEN ASM SET_TAC[];
7093     ALL_TAC] THEN
7094   ASM_SIMP_TAC[INDEPENDENT_EXPLICIT; FINITE_UNION; INDEPENDENT_IMP_FINITE] THEN
7095   X_GEN_TAC `a:real^N->real` THEN
7096   GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV)
7097    [SET_RULE `s UNION t = s UNION (t DIFF s)`] THEN
7098   ASM_SIMP_TAC[VSUM_UNION; SET_RULE `DISJOINT c (d DIFF c)`;
7099                INDEPENDENT_IMP_FINITE; FINITE_DIFF; FINITE_UNION] THEN
7100   DISCH_TAC THEN
7101   SUBGOAL_THEN
7102    `(vsum (d DIFF c) (\v:real^N. a v % v)) IN span b`
7103   MP_TAC THENL
7104    [FIRST_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN
7105     REWRITE_TAC[IN_INTER] THEN CONJ_TAC THENL
7106      [FIRST_X_ASSUM(SUBST1_TAC o MATCH_MP (VECTOR_ARITH
7107        `a + b = vec 0 ==> b = --a`)) THEN
7108       MATCH_MP_TAC SUBSPACE_NEG THEN ASM_REWRITE_TAC[];
7109       ALL_TAC] THEN
7110     MATCH_MP_TAC SUBSPACE_VSUM THEN
7111     ASM_SIMP_TAC[FINITE_DIFF; INDEPENDENT_IMP_FINITE] THEN
7112     REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSPACE_MUL THEN
7113     ASM_REWRITE_TAC[] THEN ASM SET_TAC[];
7114     ALL_TAC] THEN
7115   ASM_SIMP_TAC[SPAN_FINITE; INDEPENDENT_IMP_FINITE; IN_ELIM_THM] THEN
7116   DISCH_THEN(X_CHOOSE_TAC `e:real^N->real`) THEN
7117   MP_TAC(ISPEC `c:real^N->bool` INDEPENDENT_EXPLICIT) THEN
7118   ASM_REWRITE_TAC[] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC
7119    (MP_TAC o SPEC `(\x. if x IN b then a x + e x else a x):real^N->real`)) THEN
7120   REWRITE_TAC[] THEN ONCE_REWRITE_TAC[COND_RAND] THEN
7121   ONCE_REWRITE_TAC[COND_RATOR] THEN ASM_SIMP_TAC[VSUM_CASES] THEN
7122   REWRITE_TAC[VECTOR_ADD_RDISTRIB; GSYM DIFF] THEN
7123   ASM_SIMP_TAC[SET_RULE `b SUBSET c ==> {x | x IN c /\ x IN b} = b`] THEN
7124   ASM_SIMP_TAC[VSUM_ADD; INDEPENDENT_IMP_FINITE] THEN
7125   ONCE_REWRITE_TAC[VECTOR_ARITH `(a + b) + c:real^N = (a + c) + b`] THEN
7126   ASM_SIMP_TAC[GSYM VSUM_UNION; FINITE_DIFF; INDEPENDENT_IMP_FINITE;
7127                SET_RULE `DISJOINT b (c DIFF b)`] THEN
7128   ASM_SIMP_TAC[SET_RULE `b SUBSET c ==> b UNION (c DIFF b) = c`] THEN
7129   DISCH_TAC THEN
7130   SUBGOAL_THEN `!v:real^N. v IN (c DIFF b) ==> a v = &0` ASSUME_TAC THENL
7131    [ASM SET_TAC[]; ALL_TAC] THEN
7132   MP_TAC(ISPEC `d:real^N->bool` INDEPENDENT_EXPLICIT) THEN
7133   ASM_REWRITE_TAC[] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC
7134    (MP_TAC o SPEC `a:real^N->real`)) THEN
7135   SUBGOAL_THEN `d:real^N->bool = b UNION (d DIFF c)`
7136    (fun th -> GEN_REWRITE_TAC (LAND_CONV o LAND_CONV o ONCE_DEPTH_CONV) [th])
7137   THENL [ASM SET_TAC[]; ALL_TAC] THEN
7138   ANTS_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
7139   ASM_SIMP_TAC[VSUM_UNION; FINITE_DIFF; INDEPENDENT_IMP_FINITE;
7140                SET_RULE `c INTER d = b ==> DISJOINT b (d DIFF c)`] THEN
7141   SUBGOAL_THEN `vsum b (\x:real^N. a x % x) = vsum c (\x. a x % x)`
7142    (fun th -> ASM_REWRITE_TAC[th]) THEN
7143   CONV_TAC SYM_CONV THEN MATCH_MP_TAC VSUM_SUPERSET THEN
7144   ASM_SIMP_TAC[VECTOR_MUL_EQ_0] THEN ASM_MESON_TAC[]);;
7145
7146 let DIM_KERNEL_COMPOSE = prove
7147  (`!f:real^M->real^N g:real^N->real^P.
7148         linear f /\ linear g
7149         ==> dim {x | (g o f) x = vec 0} <=
7150                 dim {x | f(x) = vec 0} +
7151                 dim {y | g(y) = vec 0}`,
7152   REPEAT STRIP_TAC THEN
7153   MP_TAC(ISPEC `{x | (f:real^M->real^N) x = vec 0}` BASIS_EXISTS_FINITE) THEN
7154   DISCH_THEN(X_CHOOSE_THEN `b:real^M->bool` STRIP_ASSUME_TAC) THEN
7155   SUBGOAL_THEN
7156    `?c. FINITE c /\
7157         IMAGE f c SUBSET {y | g(y):real^P = vec 0} /\
7158         independent (IMAGE (f:real^M->real^N) c) /\
7159         IMAGE f (:real^M) INTER {y | g(y) = vec 0} SUBSET span(IMAGE f c) /\
7160         (!x y. x IN c /\ y IN c ==> (f x = f y <=> x = y)) /\
7161         (IMAGE f c) HAS_SIZE dim (IMAGE f (:real^M) INTER {y | g(y) = vec 0})`
7162   STRIP_ASSUME_TAC THENL
7163    [MP_TAC(ISPEC `IMAGE (f:real^M->real^N) (:real^M) INTER
7164                  {x | (g:real^N->real^P) x = vec 0}` BASIS_EXISTS_FINITE) THEN
7165     REWRITE_TAC[SUBSET_INTER; GSYM CONJ_ASSOC; EXISTS_FINITE_SUBSET_IMAGE] THEN
7166     DISCH_THEN(X_CHOOSE_THEN `c:real^M->bool` STRIP_ASSUME_TAC) THEN
7167     MP_TAC(ISPECL [`f:real^M->real^N`; `c:real^M->bool`]
7168         IMAGE_INJECTIVE_IMAGE_OF_SUBSET) THEN
7169     MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real^M->bool` THEN
7170     DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC
7171      (CONJUNCTS_THEN2 SUBST_ALL_TAC ASSUME_TAC)) THEN
7172     ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[FINITE_SUBSET];
7173     ALL_TAC] THEN
7174   MATCH_MP_TAC LE_TRANS THEN
7175   EXISTS_TAC `dim(span(b UNION c:real^M->bool))` THEN CONJ_TAC THENL
7176    [MATCH_MP_TAC DIM_SUBSET THEN
7177     REWRITE_TAC[SUBSET; FORALL_IN_GSPEC; o_THM] THEN
7178     X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN
7179     SUBGOAL_THEN `(f:real^M->real^N) x IN span(IMAGE f c)` MP_TAC THENL
7180      [ASM SET_TAC[]; ALL_TAC] THEN
7181     ASM_SIMP_TAC[SPAN_LINEAR_IMAGE; IN_IMAGE; LEFT_IMP_EXISTS_THM] THEN
7182     X_GEN_TAC `y:real^M` THEN STRIP_TAC THEN
7183     SUBST1_TAC(VECTOR_ARITH `x:real^M = y + (x - y)`) THEN
7184     MATCH_MP_TAC SPAN_ADD THEN CONJ_TAC THENL
7185      [ASM_MESON_TAC[SUBSET_UNION; SPAN_MONO; SUBSET]; ALL_TAC] THEN
7186     MATCH_MP_TAC(SET_RULE
7187      `!t. x IN t /\ t SUBSET s ==> x IN s`) THEN
7188     EXISTS_TAC `{x | (f:real^M->real^N) x = vec 0}` THEN CONJ_TAC THENL
7189      [REWRITE_TAC[IN_ELIM_THM] THEN ASM_MESON_TAC[LINEAR_SUB; VECTOR_SUB_EQ];
7190       ASM_MESON_TAC[SUBSET_TRANS; SUBSET_UNION; SPAN_MONO]];
7191     REWRITE_TAC[DIM_SPAN] THEN MATCH_MP_TAC LE_TRANS THEN
7192     EXISTS_TAC `CARD(b UNION c:real^M->bool)` THEN
7193     ASM_SIMP_TAC[DIM_LE_CARD; FINITE_UNION; INDEPENDENT_IMP_FINITE] THEN
7194     MATCH_MP_TAC LE_TRANS THEN
7195     EXISTS_TAC `CARD(b:real^M->bool) + CARD(c:real^M->bool)` THEN
7196     ASM_SIMP_TAC[CARD_UNION_LE] THEN MATCH_MP_TAC LE_ADD2 THEN CONJ_TAC THENL
7197      [ASM_SIMP_TAC[GSYM DIM_EQ_CARD; DIM_SUBSET]; ALL_TAC] THEN
7198     MATCH_MP_TAC LE_TRANS THEN
7199     EXISTS_TAC `dim(IMAGE (f:real^M->real^N) c)` THEN CONJ_TAC THENL
7200      [ASM_SIMP_TAC[DIM_EQ_CARD] THEN
7201       ASM_MESON_TAC[CARD_IMAGE_INJ; LE_REFL];
7202       ASM_SIMP_TAC[GSYM DIM_EQ_CARD; DIM_SUBSET]]]);;
7203
7204 let DIM_ORTHOGONAL_SUM = prove
7205  (`!s t:real^N->bool.
7206         (!x y. x IN s /\ y IN t ==> x dot y = &0)
7207         ==> dim(s UNION t) = dim(s) + dim(t)`,
7208   REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM DIM_SPAN] THEN
7209   REWRITE_TAC[SPAN_UNION] THEN
7210   SIMP_TAC[GSYM DIM_SUMS_INTER; SUBSPACE_SPAN] THEN
7211   REWRITE_TAC[ARITH_RULE `x = x + y <=> y = 0`] THEN
7212   REWRITE_TAC[DIM_EQ_0; SUBSET; IN_INTER] THEN
7213   SUBGOAL_THEN
7214    `!x:real^N. x IN span s ==> !y:real^N. y IN span t ==> x dot y = &0`
7215   MP_TAC THENL
7216    [MATCH_MP_TAC SPAN_INDUCT THEN CONJ_TAC THENL
7217      [X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN REWRITE_TAC[IN_ELIM_THM] THEN
7218       MATCH_MP_TAC SPAN_INDUCT THEN ASM_SIMP_TAC[IN_ELIM_THM] THEN
7219       SIMP_TAC[subspace; IN_ELIM_THM; DOT_RMUL; DOT_RADD; DOT_RZERO] THEN
7220       REAL_ARITH_TAC;
7221       SIMP_TAC[subspace; IN_ELIM_THM; DOT_LMUL; DOT_LADD; DOT_LZERO] THEN
7222       REAL_ARITH_TAC];
7223     REWRITE_TAC[IN_SING] THEN MESON_TAC[DOT_EQ_0]]);;
7224
7225 let DIM_SUBSPACE_ORTHOGONAL_TO_VECTORS = prove
7226  (`!s t:real^N->bool.
7227         subspace s /\ subspace t /\ s SUBSET t
7228         ==> dim {y | y IN t /\ !x. x IN s ==> orthogonal x y} + dim s = dim t`,
7229   REPEAT STRIP_TAC THEN
7230   W(MP_TAC o PART_MATCH (rand o rand) DIM_ORTHOGONAL_SUM o lhand o snd) THEN
7231   ANTS_TAC THENL
7232    [SIMP_TAC[IN_ELIM_THM; orthogonal] THEN MESON_TAC[DOT_SYM];
7233     DISCH_THEN(SUBST1_TAC o SYM)] THEN
7234   ONCE_REWRITE_TAC[GSYM DIM_SPAN] THEN AP_TERM_TAC THEN
7235   MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL
7236    [MATCH_MP_TAC SPAN_MONO THEN ASM SET_TAC[]; ALL_TAC] THEN
7237   MATCH_MP_TAC SPAN_SUBSET_SUBSPACE THEN REWRITE_TAC[SUBSPACE_SPAN] THEN
7238   REWRITE_TAC[SPAN_UNION; SUBSET; IN_ELIM_THM] THEN
7239   X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
7240   ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN
7241   MP_TAC(ISPECL [`s:real^N->bool`; `x:real^N`]
7242         ORTHOGONAL_SUBSPACE_DECOMP_EXISTS) THEN
7243   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `y:real^N` THEN
7244   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `z:real^N` THEN
7245   STRIP_TAC THEN ASM_REWRITE_TAC[VECTOR_ADD_SYM] THEN
7246   MATCH_MP_TAC SPAN_SUPERSET THEN REWRITE_TAC[IN_ELIM_THM] THEN CONJ_TAC THENL
7247    [FIRST_ASSUM(SUBST1_TAC o MATCH_MP (VECTOR_ARITH
7248      `x:real^N = y + z ==> z = x - y`)) THEN
7249     MATCH_MP_TAC SUBSPACE_SUB THEN
7250     ASM_MESON_TAC[SUBSET; SPAN_EQ_SELF];
7251     ASM_MESON_TAC[SPAN_SUPERSET; ORTHOGONAL_SYM]]);;
7252
7253 let DIM_SPECIAL_SUBSPACE = prove
7254  (`!k. dim {x:real^N |
7255             !i. 1 <= i /\ i <= dimindex(:N) /\ i IN k ==> x$i = &0} =
7256        CARD((1..dimindex(:N)) DIFF k)`,
7257   GEN_TAC THEN MATCH_MP_TAC DIM_UNIQUE THEN
7258   EXISTS_TAC `IMAGE (basis:num->real^N) ((1..dimindex(:N)) DIFF k)` THEN
7259   REPEAT CONJ_TAC THENL
7260    [REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_THM] THEN
7261     SIMP_TAC[BASIS_COMPONENT; IN_DIFF; IN_NUMSEG] THEN MESON_TAC[];
7262     REWRITE_TAC[SUBSET; FORALL_IN_GSPEC] THEN X_GEN_TAC `x:real^N` THEN
7263     DISCH_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM BASIS_EXPANSION] THEN
7264     MATCH_MP_TAC SPAN_VSUM THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN
7265     X_GEN_TAC `j:num` THEN STRIP_TAC THEN
7266     ASM_CASES_TAC `(x:real^N)$j = &0` THEN
7267     ASM_REWRITE_TAC[SPAN_0; VECTOR_MUL_LZERO] THEN
7268     MATCH_MP_TAC SPAN_MUL THEN MATCH_MP_TAC SPAN_SUPERSET THEN
7269     REWRITE_TAC[IN_IMAGE] THEN EXISTS_TAC `j:num` THEN
7270     REWRITE_TAC[IN_NUMSEG; IN_DIFF] THEN ASM_MESON_TAC[];
7271     MATCH_MP_TAC PAIRWISE_ORTHOGONAL_INDEPENDENT THEN
7272     REWRITE_TAC[pairwise; IMP_CONJ; RIGHT_FORALL_IMP_THM;
7273       SET_RULE `~(a IN IMAGE f s) <=> (!x. x IN s ==> ~(f x = a))`] THEN
7274     SIMP_TAC[FORALL_IN_IMAGE; ORTHOGONAL_BASIS_BASIS; BASIS_INJ_EQ;
7275              IN_DIFF; IN_NUMSEG; BASIS_NONZERO];
7276     SIMP_TAC[HAS_SIZE; FINITE_IMAGE; FINITE_DIFF; FINITE_NUMSEG] THEN
7277     MATCH_MP_TAC CARD_IMAGE_INJ THEN
7278     SIMP_TAC[FINITE_DIFF; FINITE_NUMSEG; IMP_CONJ; RIGHT_FORALL_IMP_THM;
7279       SET_RULE `~(a IN IMAGE f s) <=> (!x. x IN s ==> ~(f x = a))`] THEN
7280     SIMP_TAC[FORALL_IN_IMAGE; ORTHOGONAL_BASIS_BASIS; BASIS_INJ_EQ;
7281              IN_DIFF; IN_NUMSEG; BASIS_NONZERO]]);;
7282
7283 (* ------------------------------------------------------------------------- *)
7284 (* More about product spaces.                                                *)
7285 (* ------------------------------------------------------------------------- *)
7286
7287 let PASTECART_AS_ORTHOGONAL_SUM = prove
7288  (`!x:real^M y:real^N.
7289         pastecart x y = pastecart x (vec 0) + pastecart (vec 0) y`,
7290   REWRITE_TAC[PASTECART_ADD; VECTOR_ADD_LID; VECTOR_ADD_RID]);;
7291
7292 let PCROSS_AS_ORTHOGONAL_SUM = prove
7293  (`!s:real^M->bool t:real^N->bool.
7294         s PCROSS t =
7295         {u + v | u IN IMAGE (\x. pastecart x (vec 0)) s /\
7296                  v IN IMAGE (\y. pastecart (vec 0) y) t}`,
7297   REPEAT GEN_TAC THEN REWRITE_TAC[PCROSS] THEN
7298   GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV)
7299    [PASTECART_AS_ORTHOGONAL_SUM] THEN
7300   SET_TAC[]);;
7301
7302 let DIM_PCROSS = prove
7303  (`!s:real^M->bool t:real^N->bool.
7304         subspace s /\ subspace t ==> dim(s PCROSS t) = dim s + dim t`,
7305   REPEAT STRIP_TAC THEN REWRITE_TAC[PCROSS_AS_ORTHOGONAL_SUM] THEN
7306   W(MP_TAC o PART_MATCH (lhand o lhand o rand) DIM_SUMS_INTER o
7307         lhand o snd) THEN
7308   ANTS_TAC THENL
7309    [CONJ_TAC THEN MATCH_MP_TAC SUBSPACE_LINEAR_IMAGE;
7310     MATCH_MP_TAC(ARITH_RULE `c = d /\ b = 0 ==> a + b = c ==> a = d`) THEN
7311     CONJ_TAC THENL
7312      [BINOP_TAC THEN MATCH_MP_TAC DIM_INJECTIVE_LINEAR_IMAGE THEN
7313       SIMP_TAC[PASTECART_INJ];
7314       REWRITE_TAC[DIM_EQ_0; SUBSET; IN_INTER; IN_IMAGE; IN_SING] THEN
7315       REWRITE_TAC[PASTECART_EQ; FSTCART_PASTECART; SNDCART_PASTECART] THEN
7316       MESON_TAC[FSTCART_VEC; SNDCART_VEC]]] THEN
7317   ASM_REWRITE_TAC[linear; GSYM PASTECART_VEC] THEN
7318   REWRITE_TAC[PASTECART_ADD; GSYM PASTECART_CMUL; PASTECART_INJ] THEN
7319   VECTOR_ARITH_TAC);;
7320
7321 let SPAN_PCROSS_SUBSET = prove
7322  (`!s:real^M->bool t:real^N->bool.
7323         span(s PCROSS t) SUBSET (span s) PCROSS (span t)`,
7324   REPEAT GEN_TAC THEN MATCH_MP_TAC SPAN_SUBSET_SUBSPACE THEN
7325   SIMP_TAC[SUBSPACE_PCROSS; SUBSPACE_SPAN; PCROSS_MONO; SPAN_INC]);;
7326
7327 let SPAN_PCROSS = prove
7328  (`!s:real^M->bool t:real^N->bool.
7329         ~(s = {}) /\ ~(t = {}) /\ (vec 0 IN s \/ vec 0 IN t)
7330         ==> span(s PCROSS t) = (span s) PCROSS (span t)`,
7331   REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN
7332   REWRITE_TAC[SPAN_PCROSS_SUBSET] THEN
7333   REWRITE_TAC[SUBSET; FORALL_IN_PCROSS] THEN
7334   ONCE_REWRITE_TAC[PASTECART_AS_ORTHOGONAL_SUM] THEN
7335   SUBGOAL_THEN
7336    `(!x:real^M. x IN span s ==> pastecart x (vec 0) IN span(s PCROSS t)) /\
7337     (!y:real^N. y IN span t ==> pastecart (vec 0) y IN span(s PCROSS t))`
7338    (fun th -> ASM_MESON_TAC[th; SPAN_ADD]) THEN
7339   CONJ_TAC THEN MATCH_MP_TAC SPAN_INDUCT THEN REWRITE_TAC[IN_ELIM_THM] THEN
7340   (CONJ_TAC THENL
7341     [REWRITE_TAC[IN_ELIM_THM] THEN
7342      ASM_SIMP_TAC[SPAN_SUPERSET; PASTECART_IN_PCROSS];
7343      REWRITE_TAC[subspace; IN_ELIM_THM; PASTECART_VEC; SPAN_0] THEN
7344      CONJ_TAC THEN REPEAT GEN_TAC THENL
7345       [DISCH_THEN(MP_TAC o MATCH_MP SPAN_ADD) THEN
7346        REWRITE_TAC[PASTECART_ADD; VECTOR_ADD_LID];
7347        DISCH_THEN(MP_TAC o MATCH_MP SPAN_MUL) THEN
7348        SIMP_TAC[GSYM PASTECART_CMUL; VECTOR_MUL_RZERO]]])
7349   THENL
7350    [X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN
7351     UNDISCH_TAC `~(t:real^N->bool = {})` THEN
7352     REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN
7353     DISCH_THEN(X_CHOOSE_TAC `y:real^N`) THEN
7354     SUBGOAL_THEN
7355      `pastecart x (vec 0) =
7356       pastecart (x:real^M) (y:real^N) - pastecart (vec 0) y`
7357     SUBST1_TAC THENL
7358      [REWRITE_TAC[PASTECART_SUB; PASTECART_INJ] THEN VECTOR_ARITH_TAC;
7359       MATCH_MP_TAC SPAN_SUB THEN
7360       ASM_SIMP_TAC[SPAN_SUPERSET; PASTECART_IN_PCROSS]];
7361     X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN
7362     UNDISCH_TAC `~(s:real^M->bool = {})` THEN
7363     REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN
7364     DISCH_THEN(X_CHOOSE_TAC `x:real^M`) THEN
7365     SUBGOAL_THEN
7366      `pastecart (vec 0) y =
7367       pastecart (x:real^M) (y:real^N) - pastecart x (vec 0)`
7368     SUBST1_TAC THENL
7369      [REWRITE_TAC[PASTECART_SUB; PASTECART_INJ] THEN VECTOR_ARITH_TAC;
7370       MATCH_MP_TAC SPAN_SUB THEN
7371       ASM_SIMP_TAC[SPAN_SUPERSET; PASTECART_IN_PCROSS]]]);;
7372
7373 let DIM_PCROSS_STRONG = prove
7374  (`!s:real^M->bool t:real^N->bool.
7375         ~(s = {}) /\ ~(t = {}) /\ (vec 0 IN s \/ vec 0 IN t)
7376         ==> dim(s PCROSS t) = dim s + dim t`,
7377   ONCE_REWRITE_TAC[GSYM DIM_SPAN] THEN
7378   SIMP_TAC[SPAN_PCROSS; DIM_PCROSS; SUBSPACE_SPAN]);;
7379
7380 let SPAN_SUMS = prove
7381  (`!s t:real^N->bool.
7382         ~(s = {}) /\ ~(t = {}) /\ vec 0 IN (s UNION t)
7383         ==> span {x + y | x IN s /\ y IN t} =
7384             {x + y | x IN span s /\ y IN span t}`,
7385   REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM SPAN_UNION] THEN
7386   MATCH_MP_TAC SUBSET_ANTISYM THEN
7387   CONJ_TAC THEN MATCH_MP_TAC SPAN_SUBSET_SUBSPACE THEN
7388   REWRITE_TAC[SUBSPACE_SPAN; SUBSET; FORALL_IN_GSPEC] THEN
7389   SIMP_TAC[SPAN_ADD; IN_UNION; SPAN_SUPERSET] THEN
7390   X_GEN_TAC `x:real^N` THEN STRIP_TAC THEN
7391   FIRST_X_ASSUM(DISJ_CASES_TAC o GEN_REWRITE_RULE I [IN_UNION]) THENL
7392    [UNDISCH_TAC `~(t:real^N->bool = {})` THEN
7393     REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN
7394     DISCH_THEN(X_CHOOSE_TAC `y:real^N`) THEN
7395     SUBST1_TAC(VECTOR_ARITH `x:real^N = (x + y) - (vec 0 + y)`) THEN
7396     MATCH_MP_TAC SPAN_SUB THEN CONJ_TAC THEN MATCH_MP_TAC SPAN_SUPERSET THEN
7397     ASM SET_TAC[];
7398     MATCH_MP_TAC SPAN_SUPERSET THEN REWRITE_TAC[IN_ELIM_THM] THEN
7399     ASM_MESON_TAC[VECTOR_ADD_RID];
7400     MATCH_MP_TAC SPAN_SUPERSET THEN REWRITE_TAC[IN_ELIM_THM] THEN
7401     ASM_MESON_TAC[VECTOR_ADD_LID];
7402     UNDISCH_TAC `~(s:real^N->bool = {})` THEN
7403     REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN
7404     DISCH_THEN(X_CHOOSE_TAC `y:real^N`) THEN
7405     SUBST1_TAC(VECTOR_ARITH `x:real^N = (y + x) - (y + vec 0)`) THEN
7406     MATCH_MP_TAC SPAN_SUB THEN CONJ_TAC THEN MATCH_MP_TAC SPAN_SUPERSET THEN
7407     ASM SET_TAC[]]);;
7408
7409 (* ------------------------------------------------------------------------- *)
7410 (* More about rank from the rank/nullspace formula.                          *)
7411 (* ------------------------------------------------------------------------- *)
7412
7413 let RANK_NULLSPACE = prove
7414  (`!A:real^M^N. rank A + dim {x | A ** x = vec 0} = dimindex(:M)`,
7415   GEN_TAC THEN REWRITE_TAC[RANK_DIM_IM] THEN
7416   MATCH_MP_TAC DIM_IMAGE_KERNEL THEN
7417   REWRITE_TAC[MATRIX_VECTOR_MUL_LINEAR]);;
7418
7419 let RANK_SYLVESTER = prove
7420  (`!A:real^N^M B:real^P^N.
7421         rank(A) + rank(B) <= rank(A ** B) + dimindex(:N)`,
7422   REPEAT GEN_TAC THEN MATCH_MP_TAC(ARITH_RULE
7423     `!ia ib iab p:num.
7424         ra + ia = n /\
7425         rb + ib = p /\
7426         rab + iab = p /\
7427         iab <= ia + ib
7428         ==> ra + rb <= rab + n`) THEN
7429   MAP_EVERY EXISTS_TAC
7430    [`dim {x | (A:real^N^M) ** x = vec 0}`;
7431     `dim {x | (B:real^P^N) ** x = vec 0}`;
7432     `dim {x | ((A:real^N^M) ** (B:real^P^N)) ** x = vec 0}`;
7433     `dimindex(:P)`] THEN
7434   REWRITE_TAC[RANK_NULLSPACE] THEN
7435   REWRITE_TAC[GSYM MATRIX_VECTOR_MUL_ASSOC] THEN
7436   ONCE_REWRITE_TAC[ADD_SYM] THEN
7437   MATCH_MP_TAC(REWRITE_RULE[o_DEF] DIM_KERNEL_COMPOSE) THEN
7438   CONJ_TAC THEN GEN_REWRITE_TAC RAND_CONV [GSYM ETA_AX] THEN
7439   REWRITE_TAC[MATRIX_VECTOR_MUL_LINEAR]);;
7440
7441 let RANK_GRAM = prove
7442  (`!A:real^M^N. rank(transp A ** A) = rank A`,
7443   GEN_TAC THEN MATCH_MP_TAC(ARITH_RULE
7444    `!n n' k. r + n:num = k /\ r' + n' = k /\ n = n' ==> r = r'`) THEN
7445   MAP_EVERY EXISTS_TAC
7446    [`dim {x | (transp A ** (A:real^M^N)) ** x = vec 0}`;
7447     `dim {x | (A:real^M^N) ** x = vec 0}`;
7448     `dimindex(:M)`] THEN
7449   REWRITE_TAC[RANK_NULLSPACE] THEN AP_TERM_TAC THEN
7450   MATCH_MP_TAC SUBSET_ANTISYM THEN
7451   SIMP_TAC[SUBSET; IN_ELIM_THM; GSYM MATRIX_VECTOR_MUL_ASSOC;
7452            MATRIX_VECTOR_MUL_RZERO] THEN
7453   X_GEN_TAC `x:real^M` THEN
7454   DISCH_THEN(MP_TAC o AP_TERM `(dot) (x:real^M)`) THEN
7455   ONCE_REWRITE_TAC[GSYM DOT_LMUL_MATRIX] THEN
7456   REWRITE_TAC[VECTOR_MATRIX_MUL_TRANSP; TRANSP_TRANSP; DOT_RZERO] THEN
7457   REWRITE_TAC[DOT_EQ_0]);;
7458
7459 let RANK_TRIANGLE = prove
7460  (`!A B:real^M^N. rank(A + B) <= rank(A) + rank(B)`,
7461   REPEAT GEN_TAC THEN REWRITE_TAC[RANK_DIM_IM] THEN
7462   MP_TAC(ISPECL [`IMAGE (\x. (A:real^M^N) ** x) (:real^M)`;
7463                  `IMAGE (\x. (B:real^M^N) ** x) (:real^M)`]
7464                 DIM_SUMS_INTER) THEN
7465   ASM_SIMP_TAC[SUBSPACE_LINEAR_IMAGE; SUBSPACE_UNIV;
7466                MATRIX_VECTOR_MUL_LINEAR] THEN
7467   DISCH_THEN(SUBST1_TAC o SYM) THEN
7468   MATCH_MP_TAC(ARITH_RULE `x:num <= y ==> x <= y + z`) THEN
7469   MATCH_MP_TAC DIM_SUBSET THEN
7470   REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_UNIV;
7471               MATRIX_VECTOR_MUL_ADD_RDISTRIB] THEN
7472   REWRITE_TAC[IN_ELIM_THM; IN_IMAGE; IN_UNIV] THEN MESON_TAC[]);;
7473
7474 (* ------------------------------------------------------------------------- *)
7475 (* Infinity norm.                                                            *)
7476 (* ------------------------------------------------------------------------- *)
7477
7478 let infnorm = define
7479  `infnorm (x:real^N) = sup { abs(x$i) | 1 <= i /\ i <= dimindex(:N) }`;;
7480
7481 let NUMSEG_DIMINDEX_NONEMPTY = prove
7482  (`?i. i IN 1..dimindex(:N)`,
7483   REWRITE_TAC[MEMBER_NOT_EMPTY; NUMSEG_EMPTY; NOT_LT; DIMINDEX_GE_1]);;
7484
7485 let INFNORM_SET_IMAGE = prove
7486  (`{abs(x$i) | 1 <= i /\ i <= dimindex(:N)} =
7487    IMAGE (\i. abs(x$i)) (1..dimindex(:N))`,
7488   REWRITE_TAC[numseg] THEN SET_TAC[]);;
7489
7490 let INFNORM_SET_LEMMA = prove
7491  (`FINITE {abs((x:real^N)$i) | 1 <= i /\ i <= dimindex(:N)} /\
7492    ~({abs(x$i) | 1 <= i /\ i <= dimindex(:N)} = {})`,
7493   SIMP_TAC[INFNORM_SET_IMAGE; FINITE_NUMSEG; FINITE_IMAGE; IMAGE_EQ_EMPTY] THEN
7494   REWRITE_TAC[NUMSEG_EMPTY; NOT_LT; DIMINDEX_GE_1]);;
7495
7496 let INFNORM_POS_LE = prove
7497  (`!x. &0 <= infnorm x`,
7498   REWRITE_TAC[infnorm] THEN
7499   SIMP_TAC[REAL_LE_SUP_FINITE; INFNORM_SET_LEMMA] THEN
7500   REWRITE_TAC[INFNORM_SET_IMAGE; NUMSEG_DIMINDEX_NONEMPTY;
7501               EXISTS_IN_IMAGE; REAL_ABS_POS]);;
7502
7503 let INFNORM_TRIANGLE = prove
7504  (`!x y. infnorm(x + y) <= infnorm x + infnorm y`,
7505   REWRITE_TAC[infnorm] THEN
7506   SIMP_TAC[REAL_SUP_LE_FINITE; INFNORM_SET_LEMMA] THEN
7507   ONCE_REWRITE_TAC[GSYM REAL_LE_SUB_RADD] THEN
7508   SIMP_TAC[REAL_LE_SUP_FINITE; INFNORM_SET_LEMMA] THEN
7509   ONCE_REWRITE_TAC[REAL_ARITH `x - y <= z <=> x - z <= y`] THEN
7510   SIMP_TAC[REAL_LE_SUP_FINITE; INFNORM_SET_LEMMA] THEN
7511   REWRITE_TAC[INFNORM_SET_IMAGE; FORALL_IN_IMAGE; EXISTS_IN_IMAGE] THEN
7512   SIMP_TAC[VECTOR_ADD_COMPONENT; GSYM IN_NUMSEG] THEN
7513   MESON_TAC[NUMSEG_DIMINDEX_NONEMPTY;
7514             REAL_ARITH `abs(x + y) - abs(x) <= abs(y)`]);;
7515
7516 let INFNORM_EQ_0 = prove
7517  (`!x. infnorm x = &0 <=> x = vec 0`,
7518   REWRITE_TAC[GSYM REAL_LE_ANTISYM; INFNORM_POS_LE] THEN
7519   SIMP_TAC[infnorm; REAL_SUP_LE_FINITE; INFNORM_SET_LEMMA] THEN
7520   SIMP_TAC[FORALL_IN_IMAGE; INFNORM_SET_IMAGE; CART_EQ; VEC_COMPONENT] THEN
7521   REWRITE_TAC[IN_NUMSEG; REAL_ARITH `abs(x) <= &0 <=> x = &0`]);;
7522
7523 let INFNORM_0 = prove
7524  (`infnorm(vec 0) = &0`,
7525   REWRITE_TAC[INFNORM_EQ_0]);;
7526
7527 let INFNORM_NEG = prove
7528  (`!x. infnorm(--x) = infnorm x`,
7529   GEN_TAC THEN REWRITE_TAC[infnorm] THEN AP_TERM_TAC THEN
7530   REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN
7531   MESON_TAC[REAL_ABS_NEG; VECTOR_NEG_COMPONENT]);;
7532
7533 let INFNORM_SUB = prove
7534  (`!x y. infnorm(x - y) = infnorm(y - x)`,
7535   MESON_TAC[INFNORM_NEG; VECTOR_NEG_SUB]);;
7536
7537 let REAL_ABS_SUB_INFNORM = prove
7538  (`abs(infnorm x - infnorm y) <= infnorm(x - y)`,
7539   MATCH_MP_TAC(REAL_ARITH
7540     `nx <= n + ny /\ ny <= n + nx ==> abs(nx - ny) <= n`) THEN
7541   MESON_TAC[INFNORM_SUB; VECTOR_SUB_ADD2; INFNORM_TRIANGLE; VECTOR_ADD_SYM]);;
7542
7543 let REAL_ABS_INFNORM = prove
7544  (`!x. abs(infnorm x) = infnorm x`,
7545   REWRITE_TAC[real_abs; INFNORM_POS_LE]);;
7546
7547 let COMPONENT_LE_INFNORM = prove
7548  (`!x:real^N i. 1 <= i /\ i <= dimindex (:N) ==> abs(x$i) <= infnorm x`,
7549   REPEAT GEN_TAC THEN REWRITE_TAC[infnorm] THEN
7550   MP_TAC(SPEC `{ abs((x:real^N)$i) | 1 <= i /\ i <= dimindex(:N) }`
7551               SUP_FINITE) THEN
7552   REWRITE_TAC[INFNORM_SET_LEMMA] THEN
7553   SIMP_TAC[INFNORM_SET_IMAGE; FORALL_IN_IMAGE; IN_NUMSEG]);;
7554
7555 let INFNORM_MUL_LEMMA = prove
7556  (`!a x. infnorm(a % x) <= abs a * infnorm x`,
7557   REPEAT STRIP_TAC THEN GEN_REWRITE_TAC LAND_CONV [infnorm] THEN
7558   SIMP_TAC[REAL_SUP_LE_FINITE; INFNORM_SET_LEMMA] THEN
7559   REWRITE_TAC[FORALL_IN_IMAGE; INFNORM_SET_IMAGE] THEN
7560   SIMP_TAC[REAL_ABS_MUL; VECTOR_MUL_COMPONENT; IN_NUMSEG] THEN
7561   SIMP_TAC[COMPONENT_LE_INFNORM; REAL_LE_LMUL; REAL_ABS_POS]);;
7562
7563 let INFNORM_MUL = prove
7564  (`!a x:real^N. infnorm(a % x) = abs a * infnorm x`,
7565   REPEAT GEN_TAC THEN ASM_CASES_TAC `a = &0` THEN
7566   ASM_REWRITE_TAC[VECTOR_MUL_LZERO; INFNORM_0; REAL_ABS_0; REAL_MUL_LZERO] THEN
7567   REWRITE_TAC[GSYM REAL_LE_ANTISYM; INFNORM_MUL_LEMMA] THEN
7568   GEN_REWRITE_TAC (LAND_CONV o funpow 2 RAND_CONV) [GSYM VECTOR_MUL_LID] THEN
7569   FIRST_ASSUM(SUBST1_TAC o SYM o MATCH_MP REAL_MUL_LINV) THEN
7570   REWRITE_TAC[GSYM VECTOR_MUL_ASSOC] THEN
7571   MATCH_MP_TAC REAL_LE_TRANS THEN
7572   EXISTS_TAC `abs(a) * abs(inv a) * infnorm(a % x:real^N)` THEN
7573   ASM_SIMP_TAC[INFNORM_MUL_LEMMA; REAL_LE_LMUL; REAL_ABS_POS] THEN
7574   ASM_SIMP_TAC[REAL_MUL_ASSOC; GSYM REAL_ABS_MUL; REAL_MUL_RINV] THEN
7575   REAL_ARITH_TAC);;
7576
7577 let INFNORM_POS_LT = prove
7578  (`!x. &0 < infnorm x <=> ~(x = vec 0)`,
7579   MESON_TAC[REAL_LT_LE; INFNORM_POS_LE; INFNORM_EQ_0]);;
7580
7581 (* ------------------------------------------------------------------------- *)
7582 (* Prove that it differs only up to a bound from Euclidean norm.             *)
7583 (* ------------------------------------------------------------------------- *)
7584
7585 let INFNORM_LE_NORM = prove
7586  (`!x. infnorm(x) <= norm(x)`,
7587   SIMP_TAC[infnorm; REAL_SUP_LE_FINITE; INFNORM_SET_LEMMA] THEN
7588   REWRITE_TAC[IN_ELIM_THM] THEN MESON_TAC[COMPONENT_LE_NORM]);;
7589
7590 let NORM_LE_INFNORM = prove
7591  (`!x:real^N. norm(x) <= sqrt(&(dimindex(:N))) * infnorm(x)`,
7592   GEN_TAC THEN GEN_REWRITE_TAC (RAND_CONV o LAND_CONV o funpow 2 RAND_CONV)
7593    [GSYM CARD_NUMSEG_1] THEN
7594   REWRITE_TAC[vector_norm] THEN MATCH_MP_TAC REAL_LE_LSQRT THEN
7595   SIMP_TAC[DOT_POS_LE; SQRT_POS_LE; REAL_POS; REAL_LE_MUL; INFNORM_POS_LE;
7596            SQRT_POW_2; REAL_POW_MUL] THEN
7597   REWRITE_TAC[dot] THEN MATCH_MP_TAC SUM_BOUND THEN
7598   REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN REPEAT STRIP_TAC THEN
7599   REWRITE_TAC[GSYM REAL_POW_2] THEN ONCE_REWRITE_TAC[GSYM REAL_POW2_ABS] THEN
7600   MATCH_MP_TAC REAL_POW_LE2 THEN REWRITE_TAC[REAL_ABS_POS] THEN
7601   MATCH_MP_TAC(REAL_ARITH `x <= y ==> x <= abs(y)`) THEN
7602   SIMP_TAC[infnorm; REAL_LE_SUP_FINITE; INFNORM_SET_LEMMA] THEN
7603   REWRITE_TAC[IN_ELIM_THM] THEN ASM_MESON_TAC[REAL_LE_REFL]);;
7604
7605 (* ------------------------------------------------------------------------- *)
7606 (* Equality in Cauchy-Schwarz and triangle inequalities.                     *)
7607 (* ------------------------------------------------------------------------- *)
7608
7609 let NORM_CAUCHY_SCHWARZ_EQ = prove
7610  (`!x:real^N y. x dot y = norm(x) * norm(y) <=> norm(x) % y = norm(y) % x`,
7611   REPEAT STRIP_TAC THEN
7612   MAP_EVERY ASM_CASES_TAC [`x:real^N = vec 0`; `y:real^N = vec 0`] THEN
7613   ASM_REWRITE_TAC[NORM_0; REAL_MUL_LZERO; REAL_MUL_RZERO;
7614     DOT_LZERO; DOT_RZERO; VECTOR_MUL_LZERO; VECTOR_MUL_RZERO] THEN
7615   MP_TAC(ISPEC `norm(y:real^N) % x - norm(x:real^N) % y` DOT_EQ_0) THEN
7616   REWRITE_TAC[DOT_RSUB; DOT_LSUB; DOT_LMUL; DOT_RMUL; GSYM NORM_POW_2;
7617               REAL_POW_2; VECTOR_SUB_EQ] THEN
7618   REWRITE_TAC[DOT_SYM; REAL_ARITH
7619    `y * (y * x * x - x * d) - x * (y * d - x * y * y) =
7620     &2 * x * y * (x * y - d)`] THEN
7621   ASM_SIMP_TAC[REAL_ENTIRE; NORM_EQ_0; REAL_SUB_0; REAL_OF_NUM_EQ; ARITH] THEN
7622   REWRITE_TAC[EQ_SYM_EQ]);;
7623
7624 let NORM_CAUCHY_SCHWARZ_ABS_EQ = prove
7625  (`!x:real^N y. abs(x dot y) = norm(x) * norm(y) <=>
7626                 norm(x) % y = norm(y) % x \/ norm(x) % y = --norm(y) % x`,
7627   SIMP_TAC[REAL_ARITH `&0 <= a ==> (abs x = a <=> x = a \/ --x = a)`;
7628            REAL_LE_MUL; NORM_POS_LE; GSYM DOT_RNEG] THEN
7629   REPEAT GEN_TAC THEN
7630   GEN_REWRITE_TAC (LAND_CONV o funpow 3 RAND_CONV) [GSYM NORM_NEG] THEN
7631   REWRITE_TAC[NORM_CAUCHY_SCHWARZ_EQ] THEN REWRITE_TAC[NORM_NEG] THEN
7632   BINOP_TAC THEN VECTOR_ARITH_TAC);;
7633
7634 let NORM_TRIANGLE_EQ = prove
7635  (`!x y:real^N. norm(x + y) = norm(x) + norm(y) <=> norm(x) % y = norm(y) % x`,
7636   REPEAT GEN_TAC THEN REWRITE_TAC[GSYM NORM_CAUCHY_SCHWARZ_EQ] THEN
7637   MATCH_MP_TAC EQ_TRANS THEN
7638   EXISTS_TAC `norm(x + y:real^N) pow 2 = (norm(x) + norm(y)) pow 2` THEN
7639   CONJ_TAC THENL
7640    [REWRITE_TAC[REAL_RING `x pow 2 = y pow 2 <=> x = y \/ x + y = &0`] THEN
7641     MAP_EVERY (MP_TAC o C ISPEC NORM_POS_LE)
7642      [`x + y:real^N`; `x:real^N`; `y:real^N`] THEN
7643     REAL_ARITH_TAC;
7644     REWRITE_TAC[NORM_POW_2; DOT_LADD; DOT_RADD; REAL_ARITH
7645      `(x + y) pow 2 = x pow 2 + y pow 2 + &2 * x * y`] THEN
7646     REWRITE_TAC[DOT_SYM] THEN REAL_ARITH_TAC]);;
7647
7648 let DIST_TRIANGLE_EQ = prove
7649  (`!x y z. dist(x,z) = dist(x,y) + dist(y,z) <=>
7650                 norm (x - y) % (y - z) = norm (y - z) % (x - y)`,
7651   REWRITE_TAC[GSYM NORM_TRIANGLE_EQ] THEN NORM_ARITH_TAC);;
7652
7653 let NORM_CROSS_MULTIPLY = prove
7654  (`!a b x y:real^N.
7655         a % x = b % y /\ &0 < a /\ &0 < b
7656         ==> norm y % x = norm x % y`,
7657   REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN
7658   ASM_CASES_TAC `y:real^N = vec 0` THEN
7659   ASM_SIMP_TAC[VECTOR_MUL_EQ_0; REAL_LT_IMP_NZ; VECTOR_MUL_RZERO] THEN
7660   DISCH_THEN(MP_TAC o AP_TERM `\x:real^N. inv(a) % x`) THEN
7661   ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LINV; REAL_LT_IMP_NZ; VECTOR_MUL_LID;
7662                NORM_MUL; REAL_ABS_MUL; REAL_ABS_INV] THEN
7663   ASM_SIMP_TAC[real_abs; REAL_LT_IMP_LE; REAL_MUL_AC]);;
7664
7665 (* ------------------------------------------------------------------------- *)
7666 (* Collinearity.                                                             *)
7667 (* ------------------------------------------------------------------------- *)
7668
7669 let collinear = new_definition
7670  `collinear s <=> ?u. !x y. x IN s /\ y IN s ==> ?c. x - y = c % u`;;
7671
7672 let COLLINEAR_SUBSET = prove
7673  (`!s t. collinear t /\ s SUBSET t ==> collinear s`,
7674   REWRITE_TAC[collinear] THEN SET_TAC[]);;
7675
7676 let COLLINEAR_EMPTY = prove
7677  (`collinear {}`,
7678   REWRITE_TAC[collinear; NOT_IN_EMPTY]);;
7679
7680 let COLLINEAR_SING = prove
7681  (`!x. collinear {x}`,
7682   SIMP_TAC[collinear; IN_SING; VECTOR_SUB_REFL] THEN
7683   MESON_TAC[VECTOR_MUL_LZERO]);;
7684
7685 let COLLINEAR_2 = prove
7686  (`!x y:real^N. collinear {x,y}`,
7687   REPEAT GEN_TAC THEN REWRITE_TAC[collinear; IN_INSERT; NOT_IN_EMPTY] THEN
7688   EXISTS_TAC `x - y:real^N` THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THENL
7689    [EXISTS_TAC `&0`; EXISTS_TAC `&1`; EXISTS_TAC `-- &1`; EXISTS_TAC `&0`] THEN
7690   VECTOR_ARITH_TAC);;
7691
7692 let COLLINEAR_SMALL = prove
7693  (`!s. FINITE s /\ CARD s <= 2 ==> collinear s`,
7694   REWRITE_TAC[ARITH_RULE `s <= 2 <=> s = 0 \/ s = 1 \/ s = 2`] THEN
7695   REWRITE_TAC[LEFT_OR_DISTRIB; GSYM HAS_SIZE] THEN
7696   CONV_TAC(ONCE_DEPTH_CONV HAS_SIZE_CONV) THEN
7697   REPEAT STRIP_TAC THEN
7698   ASM_REWRITE_TAC[COLLINEAR_EMPTY; COLLINEAR_SING; COLLINEAR_2]);;
7699
7700 let COLLINEAR_3 = prove
7701  (`!x y z. collinear {x,y,z} <=> collinear {vec 0,x - y,z - y}`,
7702   REPEAT GEN_TAC THEN
7703   REWRITE_TAC[collinear; FORALL_IN_INSERT; IMP_CONJ; RIGHT_FORALL_IMP_THM;
7704               NOT_IN_EMPTY] THEN
7705   AP_TERM_TAC THEN ABS_TAC THEN
7706   MESON_TAC[VECTOR_ARITH `x - y = (x - y) - vec 0`;
7707             VECTOR_ARITH `y - x = vec 0 - (x - y)`;
7708             VECTOR_ARITH `x - z:real^N = (x - y) - (z - y)`]);;
7709
7710 let COLLINEAR_LEMMA = prove
7711  (`!x y:real^N. collinear {vec 0,x,y} <=>
7712                    x = vec 0 \/ y = vec 0 \/ ?c. y = c % x`,
7713   REPEAT GEN_TAC THEN
7714   MAP_EVERY ASM_CASES_TAC [`x:real^N = vec 0`; `y:real^N = vec 0`] THEN
7715   TRY(ASM_REWRITE_TAC[INSERT_AC; COLLINEAR_SING; COLLINEAR_2] THEN NO_TAC) THEN
7716   ASM_REWRITE_TAC[collinear] THEN EQ_TAC THENL
7717    [DISCH_THEN(X_CHOOSE_THEN `u:real^N`
7718      (fun th -> MP_TAC(SPECL [`x:real^N`; `vec 0:real^N`] th) THEN
7719                 MP_TAC(SPECL [`y:real^N`; `vec 0:real^N`] th))) THEN
7720     REWRITE_TAC[IN_INSERT; VECTOR_SUB_RZERO] THEN
7721     DISCH_THEN(X_CHOOSE_THEN `e:real` SUBST_ALL_TAC) THEN
7722     DISCH_THEN(X_CHOOSE_THEN `d:real` SUBST_ALL_TAC) THEN
7723     EXISTS_TAC `e / d` THEN REWRITE_TAC[VECTOR_MUL_ASSOC] THEN
7724     RULE_ASSUM_TAC(REWRITE_RULE[VECTOR_MUL_EQ_0; DE_MORGAN_THM]) THEN
7725     ASM_SIMP_TAC[REAL_DIV_RMUL];
7726     STRIP_TAC THEN EXISTS_TAC `x:real^N` THEN ASM_REWRITE_TAC[] THEN
7727     REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] THEN REPEAT STRIP_TAC THEN
7728     ASM_REWRITE_TAC[] THENL
7729      [EXISTS_TAC `&0`; EXISTS_TAC `-- &1`; EXISTS_TAC `--c`;
7730       EXISTS_TAC `&1`; EXISTS_TAC `&0`; EXISTS_TAC `&1 - c`;
7731       EXISTS_TAC `c:real`; EXISTS_TAC `c - &1`; EXISTS_TAC `&0`] THEN
7732     VECTOR_ARITH_TAC]);;
7733
7734 let COLLINEAR_LEMMA_ALT = prove
7735  (`!x y. collinear {vec 0,x,y} <=> x = vec 0 \/ ?c. y = c % x`,
7736   REWRITE_TAC[COLLINEAR_LEMMA] THEN MESON_TAC[VECTOR_MUL_LZERO]);;
7737
7738 let NORM_CAUCHY_SCHWARZ_EQUAL = prove
7739  (`!x y:real^N. abs(x dot y) = norm(x) * norm(y) <=> collinear {vec 0,x,y}`,
7740   REPEAT GEN_TAC THEN REWRITE_TAC[NORM_CAUCHY_SCHWARZ_ABS_EQ] THEN
7741   MAP_EVERY ASM_CASES_TAC [`x:real^N = vec 0`; `y:real^N = vec 0`] THEN
7742   TRY(ASM_REWRITE_TAC[INSERT_AC; COLLINEAR_SING; COLLINEAR_2; NORM_0;
7743                       VECTOR_MUL_LZERO; VECTOR_MUL_RZERO] THEN NO_TAC) THEN
7744   ASM_REWRITE_TAC[COLLINEAR_LEMMA] THEN EQ_TAC THENL
7745    [STRIP_TAC THENL
7746      [FIRST_X_ASSUM(MP_TAC o AP_TERM
7747        `(%) (inv(norm(x:real^N))):real^N->real^N`);
7748       FIRST_X_ASSUM(MP_TAC o AP_TERM
7749        `(%) (--inv(norm(x:real^N))):real^N->real^N`)] THEN
7750     ASM_REWRITE_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LNEG] THEN
7751     ASM_SIMP_TAC[REAL_MUL_LINV; NORM_EQ_0; VECTOR_MUL_LNEG; VECTOR_MUL_LID;
7752                  VECTOR_ARITH `--x = --y <=> x:real^N = y`] THEN
7753     MESON_TAC[];
7754     STRIP_TAC THEN ASM_REWRITE_TAC[NORM_MUL; VECTOR_MUL_ASSOC] THEN
7755     MATCH_MP_TAC(MESON[]
7756       `t = a \/ t = b ==> t % x = a % x \/ t % x = b % x`) THEN
7757     REWRITE_TAC[GSYM REAL_MUL_LNEG;
7758                 REAL_ARITH `x * c = d * x <=> x * (c - d) = &0`] THEN
7759     ASM_REWRITE_TAC[REAL_ENTIRE; NORM_EQ_0] THEN REAL_ARITH_TAC]);;
7760
7761 let DOT_CAUCHY_SCHWARZ_EQUAL = prove
7762  (`!x y:real^N.
7763         (x dot y) pow 2 = (x dot x) * (y dot y) <=>
7764         collinear {vec 0,x,y}`,
7765   REWRITE_TAC[GSYM NORM_CAUCHY_SCHWARZ_EQUAL] THEN
7766   REPEAT GEN_TAC THEN MATCH_MP_TAC(REAL_ARITH
7767    `&0 <= y /\ (u:real = v <=> x = abs y) ==> (u = v <=> x = y)`) THEN
7768   SIMP_TAC[NORM_POS_LE; REAL_LE_MUL] THEN
7769   REWRITE_TAC[REAL_EQ_SQUARE_ABS] THEN REWRITE_TAC[REAL_POW_MUL; NORM_POW_2]);;
7770
7771 let COLLINEAR_3_EXPAND = prove
7772  (`!a b c:real^N. collinear{a,b,c} <=> a = c \/ ?u. b = u % a + (&1 - u) % c`,
7773   REPEAT GEN_TAC THEN
7774   ONCE_REWRITE_TAC[SET_RULE `{a,b,c} = {a,c,b}`] THEN
7775   ONCE_REWRITE_TAC[COLLINEAR_3] THEN
7776   REWRITE_TAC[COLLINEAR_LEMMA; VECTOR_SUB_EQ] THEN
7777   ASM_CASES_TAC `a:real^N = c` THEN ASM_REWRITE_TAC[] THEN
7778   ASM_CASES_TAC `b:real^N = c` THEN
7779   ASM_REWRITE_TAC[VECTOR_ARITH `u % c + (&1 - u) % c = c`] THENL
7780    [EXISTS_TAC `&0` THEN VECTOR_ARITH_TAC;
7781     AP_TERM_TAC THEN ABS_TAC THEN VECTOR_ARITH_TAC]);;
7782
7783 let COLLINEAR_TRIPLES = prove
7784  (`!s a b:real^N.
7785         ~(a = b)
7786         ==> (collinear(a INSERT b INSERT s) <=>
7787              !x. x IN s ==> collinear{a,b,x})`,
7788   REPEAT STRIP_TAC THEN EQ_TAC THENL
7789    [REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
7790      (REWRITE_RULE[IMP_CONJ] COLLINEAR_SUBSET)) THEN
7791     ASM SET_TAC[];
7792     ONCE_REWRITE_TAC[SET_RULE `{a,b,x} = {a,x,b}`] THEN
7793     ASM_REWRITE_TAC[COLLINEAR_3_EXPAND] THEN DISCH_TAC THEN
7794     SUBGOAL_THEN
7795      `!x:real^N. x IN (a INSERT b INSERT s) ==> ?u. x = u % a + (&1 - u) % b`
7796     MP_TAC THENL
7797      [ASM_REWRITE_TAC[FORALL_IN_INSERT] THEN CONJ_TAC THENL
7798        [EXISTS_TAC `&1` THEN VECTOR_ARITH_TAC;
7799         EXISTS_TAC `&0` THEN VECTOR_ARITH_TAC];
7800       POP_ASSUM_LIST(K ALL_TAC) THEN DISCH_TAC THEN
7801       REWRITE_TAC[collinear] THEN EXISTS_TAC `b - a:real^N` THEN
7802       MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN STRIP_TAC THEN
7803       FIRST_X_ASSUM(fun th -> MP_TAC(SPEC `x:real^N` th) THEN MP_TAC(SPEC
7804         `y:real^N` th)) THEN
7805       ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN
7806       ASM_REWRITE_TAC[VECTOR_ARITH
7807        `(u % a + (&1 - u) % b) - (v % a + (&1 - v) % b):real^N =
7808         (v - u) % (b - a)`] THEN
7809       MESON_TAC[]]]);;
7810
7811 let COLLINEAR_4_3 = prove
7812  (`!a b c d:real^N.
7813         ~(a = b)
7814         ==> (collinear {a,b,c,d} <=> collinear{a,b,c} /\ collinear{a,b,d})`,
7815   REPEAT STRIP_TAC THEN
7816   MP_TAC(ISPECL [`{c:real^N,d}`; `a:real^N`; `b:real^N`]
7817     COLLINEAR_TRIPLES) THEN
7818   ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN
7819   REWRITE_TAC[FORALL_IN_INSERT; NOT_IN_EMPTY]);;
7820
7821 let COLLINEAR_3_TRANS = prove
7822  (`!a b c d:real^N.
7823         collinear{a,b,c} /\ collinear{b,c,d} /\ ~(b = c) ==> collinear{a,b,d}`,
7824   REPEAT STRIP_TAC THEN MATCH_MP_TAC COLLINEAR_SUBSET THEN
7825   EXISTS_TAC `{b:real^N,c,a,d}` THEN ASM_SIMP_TAC[COLLINEAR_4_3] THEN
7826   CONJ_TAC THENL [ALL_TAC; SET_TAC[]] THEN
7827   REPEAT(POP_ASSUM MP_TAC) THEN SIMP_TAC[INSERT_AC]);;
7828
7829 let ORTHOGONAL_TO_ORTHOGONAL_2D = prove
7830  (`!x y z:real^2.
7831      ~(x = vec 0) /\ orthogonal x y /\ orthogonal x z
7832      ==> collinear {vec 0,y,z}`,
7833   REWRITE_TAC[orthogonal; GSYM DOT_CAUCHY_SCHWARZ_EQUAL; GSYM DOT_EQ_0] THEN
7834   REWRITE_TAC[DOT_2] THEN CONV_TAC REAL_RING);;
7835
7836 let COLLINEAR_3_2D = prove
7837  (`!x y z:real^2. collinear{x,y,z} <=>
7838                   (z$1 - x$1) * (y$2 - x$2) = (y$1 - x$1) * (z$2 - x$2)`,
7839   ONCE_REWRITE_TAC[COLLINEAR_3] THEN
7840   REWRITE_TAC[GSYM DOT_CAUCHY_SCHWARZ_EQUAL] THEN
7841   REWRITE_TAC[DOT_2; VECTOR_SUB_COMPONENT] THEN CONV_TAC REAL_RING);;
7842
7843 let COLLINEAR_3_DOT_MULTIPLES = prove
7844  (`!a b c:real^N.
7845         collinear {a,b,c} <=>
7846         ((b - a) dot (b - a)) % (c - a) = ((c - a) dot (b - a)) % (b - a)`,
7847   REWRITE_TAC[VECTOR_SUB_RZERO] THEN
7848   REPEAT GEN_TAC THEN ASM_CASES_TAC `b:real^N = a` THENL
7849    [ASM_REWRITE_TAC[COLLINEAR_2; INSERT_AC; DOT_RZERO; VECTOR_MUL_LZERO;
7850                     VECTOR_SUB_REFL];
7851     ONCE_REWRITE_TAC[COLLINEAR_3] THEN
7852     POP_ASSUM MP_TAC THEN ONCE_REWRITE_TAC[GSYM VECTOR_SUB_EQ] THEN
7853     REWRITE_TAC[GSYM DOT_CAUCHY_SCHWARZ_EQUAL; GSYM DOT_EQ_0] THEN
7854     REWRITE_TAC[GSYM DOT_EQ_0; DOT_RSUB; DOT_LSUB; DOT_RMUL; DOT_LMUL] THEN
7855     REWRITE_TAC[DOT_SYM] THEN CONV_TAC REAL_RING]);;
7856
7857 (* ------------------------------------------------------------------------- *)
7858 (* Between-ness.                                                             *)
7859 (* ------------------------------------------------------------------------- *)
7860
7861 let between = new_definition
7862  `between x (a,b) <=> dist(a,b) = dist(a,x) + dist(x,b)`;;
7863
7864 let BETWEEN_REFL = prove
7865  (`!a b. between a (a,b) /\ between b (a,b) /\ between a (a,a)`,
7866   REWRITE_TAC[between] THEN NORM_ARITH_TAC);;
7867
7868 let BETWEEN_REFL_EQ = prove
7869  (`!a x. between x (a,a) <=> x = a`,
7870   REWRITE_TAC[between] THEN NORM_ARITH_TAC);;
7871
7872 let BETWEEN_SYM = prove
7873  (`!a b x. between x (a,b) <=> between x (b,a)`,
7874   REWRITE_TAC[between] THEN NORM_ARITH_TAC);;
7875
7876 let BETWEEN_ANTISYM = prove
7877  (`!a b c. between a (b,c) /\ between b (a,c) ==> a = b`,
7878   REWRITE_TAC[between; DIST_SYM] THEN NORM_ARITH_TAC);;
7879
7880 let BETWEEN_TRANS = prove
7881  (`!a b c d. between a (b,c) /\ between d (a,c) ==> between d (b,c)`,
7882   REWRITE_TAC[between; DIST_SYM] THEN NORM_ARITH_TAC);;
7883
7884 let BETWEEN_TRANS_2 = prove
7885  (`!a b c d. between a (b,c) /\ between d (a,b) ==> between a (c,d)`,
7886   REWRITE_TAC[between; DIST_SYM] THEN NORM_ARITH_TAC);;
7887
7888 let BETWEEN_NORM = prove
7889  (`!a b x:real^N.
7890      between x (a,b) <=> norm(x - a) % (b - x) = norm(b - x) % (x - a)`,
7891   REPEAT GEN_TAC THEN REWRITE_TAC[between; DIST_TRIANGLE_EQ] THEN
7892   REWRITE_TAC[NORM_SUB] THEN VECTOR_ARITH_TAC);;
7893
7894 let BETWEEN_DOT = prove
7895  (`!a b x:real^N.
7896      between x (a,b) <=> (x - a) dot (b - x) = norm(x - a) * norm(b - x)`,
7897   REWRITE_TAC[BETWEEN_NORM; NORM_CAUCHY_SCHWARZ_EQ]);;
7898
7899 let BETWEEN_EXISTS_EXTENSION = prove
7900  (`!a b x:real^N.
7901         between b (a,x) /\ ~(b = a) ==> ?d. &0 <= d /\ x = b + d % (b - a)`,
7902   REPEAT GEN_TAC THEN REWRITE_TAC[BETWEEN_NORM] THEN STRIP_TAC THEN
7903   EXISTS_TAC `norm(x - b:real^N) / norm(b - a)` THEN
7904   SIMP_TAC[REAL_LE_DIV; NORM_POS_LE] THEN FIRST_X_ASSUM
7905    (MP_TAC o AP_TERM `(%) (inv(norm(b - a:real^N))):real^N->real^N`) THEN
7906   ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LINV; NORM_EQ_0; VECTOR_SUB_EQ] THEN
7907   VECTOR_ARITH_TAC);;
7908
7909 let BETWEEN_IMP_COLLINEAR = prove
7910  (`!a b x:real^N. between x (a,b) ==> collinear {a,x,b}`,
7911   REPEAT GEN_TAC THEN MAP_EVERY
7912    (fun t -> ASM_CASES_TAC t THEN
7913              TRY(ASM_REWRITE_TAC[INSERT_AC; COLLINEAR_2] THEN NO_TAC))
7914    [`x:real^N = a`; `x:real^N = b`; `a:real^N = b`] THEN
7915   ONCE_REWRITE_TAC[COLLINEAR_3; BETWEEN_NORM] THEN
7916   DISCH_TAC THEN REWRITE_TAC[COLLINEAR_LEMMA] THEN
7917   REPEAT DISJ2_TAC THEN EXISTS_TAC `--(norm(b - x:real^N) / norm(x - a))` THEN
7918   MATCH_MP_TAC VECTOR_MUL_LCANCEL_IMP THEN EXISTS_TAC `norm(x - a:real^N)` THEN
7919   ASM_REWRITE_TAC[VECTOR_MUL_ASSOC; REAL_MUL_RNEG] THEN
7920   ASM_SIMP_TAC[REAL_DIV_LMUL; NORM_EQ_0; VECTOR_SUB_EQ] THEN
7921   VECTOR_ARITH_TAC);;
7922
7923 let COLLINEAR_BETWEEN_CASES = prove
7924  (`!a b c:real^N.
7925         collinear {a,b,c} <=>
7926         between a (b,c) \/ between b (c,a) \/ between c (a,b)`,
7927   REPEAT STRIP_TAC THEN EQ_TAC THENL
7928    [REWRITE_TAC[COLLINEAR_3_EXPAND] THEN
7929     ASM_CASES_TAC `c:real^N = a` THEN ASM_REWRITE_TAC[BETWEEN_REFL] THEN
7930     STRIP_TAC THEN ASM_REWRITE_TAC[between; dist] THEN
7931     REWRITE_TAC[VECTOR_ARITH `(u % a + (&1 - u) % c) - c = --u % (c - a)`;
7932       VECTOR_ARITH `(u % a + (&1 - u) % c) - a = (&1 - u) % (c - a)`;
7933       VECTOR_ARITH `c - (u % a + (&1 - u) % c) = u % (c - a)`;
7934       VECTOR_ARITH `a - (u % a + (&1 - u) % c) = (u - &1) % (c - a)`] THEN
7935     REWRITE_TAC[NORM_MUL] THEN
7936     SUBST1_TAC(NORM_ARITH `norm(a - c:real^N) = norm(c - a)`) THEN
7937     REWRITE_TAC[REAL_ARITH `a * c + c = (a + &1) * c`; GSYM REAL_ADD_RDISTRIB;
7938                 REAL_ARITH `c + a * c = (a + &1) * c`] THEN
7939     ASM_REWRITE_TAC[REAL_EQ_MUL_RCANCEL;
7940                     REAL_RING `n = x * n <=> n = &0 \/ x = &1`] THEN
7941     ASM_REWRITE_TAC[NORM_EQ_0; VECTOR_SUB_EQ] THEN REAL_ARITH_TAC;
7942     DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN (MP_TAC o MATCH_MP
7943       BETWEEN_IMP_COLLINEAR)) THEN
7944     REWRITE_TAC[INSERT_AC]]);;
7945
7946 let COLLINEAR_DIST_BETWEEN = prove
7947  (`!a b x. collinear {x,a,b} /\
7948            dist(x,a) <= dist(a,b) /\ dist(x,b) <= dist(a,b)
7949            ==> between x (a,b)`,
7950   SIMP_TAC[COLLINEAR_BETWEEN_CASES; between; DIST_SYM] THEN NORM_ARITH_TAC);;
7951
7952 let BETWEEN_COLLINEAR_DIST_EQ = prove
7953  (`!a b x:real^N.
7954         between x (a,b) <=>
7955         collinear {a, x, b} /\
7956         dist(x,a) <= dist(a,b) /\ dist(x,b) <= dist(a,b)`,
7957   REPEAT GEN_TAC THEN EQ_TAC THENL
7958    [SIMP_TAC[BETWEEN_IMP_COLLINEAR] THEN REWRITE_TAC[between] THEN
7959     NORM_ARITH_TAC;
7960     MESON_TAC[COLLINEAR_DIST_BETWEEN; INSERT_AC]]);;
7961
7962 let COLLINEAR_1 = prove
7963  (`!s:real^1->bool. collinear s`,
7964   GEN_TAC THEN MATCH_MP_TAC COLLINEAR_SUBSET THEN
7965   EXISTS_TAC `(vec 0:real^1) INSERT (vec 1) INSERT s` THEN
7966   CONJ_TAC THENL [ALL_TAC; SET_TAC[]] THEN
7967   W(MP_TAC o PART_MATCH (lhs o rand) COLLINEAR_TRIPLES o snd) THEN
7968   REWRITE_TAC[VEC_EQ; ARITH_EQ] THEN DISCH_THEN SUBST1_TAC THEN
7969   REWRITE_TAC[COLLINEAR_BETWEEN_CASES] THEN
7970   REWRITE_TAC[between; DIST_REAL; GSYM drop; DROP_VEC; REAL_ABS_NUM] THEN
7971   REAL_ARITH_TAC);;
7972
7973 (* ------------------------------------------------------------------------- *)
7974 (* Midpoint between two points.                                              *)
7975 (* ------------------------------------------------------------------------- *)
7976
7977 let midpoint = new_definition
7978  `midpoint(a,b) = inv(&2) % (a + b)`;;
7979
7980 let MIDPOINT_REFL = prove
7981  (`!x. midpoint(x,x) = x`,
7982   REWRITE_TAC[midpoint] THEN VECTOR_ARITH_TAC);;
7983
7984 let MIDPOINT_SYM = prove
7985  (`!a b. midpoint(a,b) = midpoint(b,a)`,
7986   REWRITE_TAC[midpoint; VECTOR_ADD_SYM]);;
7987
7988 let DIST_MIDPOINT = prove
7989  (`!a b. dist(a,midpoint(a,b)) = dist(a,b) / &2 /\
7990          dist(b,midpoint(a,b)) = dist(a,b) / &2 /\
7991          dist(midpoint(a,b),a) = dist(a,b) / &2 /\
7992          dist(midpoint(a,b),b) = dist(a,b) / &2`,
7993   REWRITE_TAC[midpoint] THEN NORM_ARITH_TAC);;
7994
7995 let MIDPOINT_EQ_ENDPOINT = prove
7996  (`!a b. (midpoint(a,b) = a <=> a = b) /\
7997          (midpoint(a,b) = b <=> a = b) /\
7998          (a = midpoint(a,b) <=> a = b) /\
7999          (b = midpoint(a,b) <=> a = b)`,
8000   REWRITE_TAC[midpoint] THEN NORM_ARITH_TAC);;
8001
8002 let BETWEEN_MIDPOINT = prove
8003  (`!a b. between (midpoint(a,b)) (a,b) /\ between (midpoint(a,b)) (b,a)`,
8004   REWRITE_TAC[between; midpoint] THEN NORM_ARITH_TAC);;
8005
8006 let MIDPOINT_LINEAR_IMAGE = prove
8007  (`!f a b. linear f ==> midpoint(f a,f b) = f(midpoint(a,b))`,
8008   SIMP_TAC[midpoint; LINEAR_ADD; LINEAR_CMUL]);;
8009
8010 let COLLINEAR_MIDPOINT = prove
8011  (`!a b. collinear{a,midpoint(a,b),b}`,
8012   REPEAT GEN_TAC THEN REWRITE_TAC[COLLINEAR_3_EXPAND; midpoint] THEN
8013   DISJ2_TAC THEN EXISTS_TAC `&1 / &2` THEN VECTOR_ARITH_TAC);;
8014
8015 let MIDPOINT_COLLINEAR = prove
8016  (`!a b c:real^N.
8017         ~(a = c)
8018         ==> (b = midpoint(a,c) <=> collinear{a,b,c} /\ dist(a,b) = dist(b,c))`,
8019   REPEAT STRIP_TAC THEN
8020   MATCH_MP_TAC(TAUT `(a ==> b) /\ (b ==> (a <=> c)) ==> (a <=> b /\ c)`) THEN
8021   SIMP_TAC[COLLINEAR_MIDPOINT] THEN ASM_REWRITE_TAC[COLLINEAR_3_EXPAND] THEN
8022   STRIP_TAC THEN ASM_REWRITE_TAC[midpoint; dist] THEN
8023   REWRITE_TAC
8024    [VECTOR_ARITH `a - (u % a + (&1 - u) % c) = (&1 - u) % (a - c)`;
8025     VECTOR_ARITH `(u % a + (&1 - u) % c) - c = u % (a - c)`;
8026     VECTOR_ARITH `u % a + (&1 - u) % c = inv (&2) % (a + c) <=>
8027                   (u - &1 / &2) % (a - c) = vec 0`] THEN
8028   ASM_SIMP_TAC[NORM_MUL; REAL_EQ_MUL_RCANCEL; NORM_EQ_0; VECTOR_SUB_EQ;
8029                VECTOR_MUL_EQ_0] THEN
8030   REAL_ARITH_TAC);;
8031
8032 let MIDPOINT_BETWEEN = prove
8033  (`!a b c:real^N.
8034         b = midpoint (a,c) <=> between b (a,c) /\ dist (a,b) = dist (b,c)`,
8035   REPEAT GEN_TAC THEN ASM_CASES_TAC `a:real^N = c` THENL
8036    [ASM_SIMP_TAC[BETWEEN_REFL_EQ; MIDPOINT_REFL; DIST_SYM]; ALL_TAC] THEN
8037   EQ_TAC THEN SIMP_TAC[BETWEEN_MIDPOINT; DIST_MIDPOINT] THEN
8038   ASM_MESON_TAC[MIDPOINT_COLLINEAR; BETWEEN_IMP_COLLINEAR]);;
8039
8040 (* ------------------------------------------------------------------------- *)
8041 (* General "one way" lemma for properties preserved by injective map.        *)
8042 (* ------------------------------------------------------------------------- *)
8043
8044 let WLOG_LINEAR_INJECTIVE_IMAGE_2 = prove
8045  (`!P Q. (!f s. P s /\ linear f ==> Q(IMAGE f s)) /\
8046          (!g t. Q t /\ linear g ==> P(IMAGE g t))
8047          ==> !f:real^M->real^N.
8048                 linear f /\ (!x y. f x = f y ==> x = y)
8049                 ==> !s. Q(IMAGE f s) <=> P s`,
8050   REPEAT STRIP_TAC THEN EQ_TAC THEN ASM_SIMP_TAC[] THEN DISCH_TAC THEN
8051   MP_TAC(ISPEC `f:real^M->real^N` LINEAR_INJECTIVE_LEFT_INVERSE) THEN
8052   ASM_REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM] THEN
8053   DISCH_THEN(X_CHOOSE_THEN `g:real^N->real^M` STRIP_ASSUME_TAC) THEN
8054   FIRST_X_ASSUM(MP_TAC o SPECL
8055    [`g:real^N->real^M`; `IMAGE (f:real^M->real^N) s`]) THEN
8056   ASM_REWRITE_TAC[GSYM IMAGE_o; o_DEF; IMAGE_ID]);;
8057
8058 let WLOG_LINEAR_INJECTIVE_IMAGE_2_ALT = prove
8059  (`!P Q f s. (!h u. P u /\ linear h ==> Q(IMAGE h u)) /\
8060              (!g t. Q t /\ linear g ==> P(IMAGE g t)) /\
8061              linear f /\ (!x y. f x = f y ==> x = y)
8062              ==> (Q(IMAGE f s) <=> P s)`,
8063   REPEAT GEN_TAC THEN STRIP_TAC THEN
8064   MATCH_MP_TAC(REWRITE_RULE[RIGHT_IMP_FORALL_THM; IMP_IMP]
8065      WLOG_LINEAR_INJECTIVE_IMAGE_2) THEN
8066   ASM_REWRITE_TAC[]);;
8067
8068 let WLOG_LINEAR_INJECTIVE_IMAGE = prove
8069  (`!P. (!f s. P s /\ linear f ==> P(IMAGE f s))
8070        ==> !f:real^N->real^N. linear f /\ (!x y. f x = f y ==> x = y)
8071                               ==> !s. P(IMAGE f s) <=> P s`,
8072   GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC WLOG_LINEAR_INJECTIVE_IMAGE_2 THEN
8073   ASM_REWRITE_TAC[]);;
8074
8075 let WLOG_LINEAR_INJECTIVE_IMAGE_ALT = prove
8076  (`!P f s. (!g t. P t /\ linear g ==> P(IMAGE g t)) /\
8077            linear f /\ (!x y. f x = f y ==> x = y)
8078            ==> (P(IMAGE f s) <=> P s)`,
8079   REPEAT GEN_TAC THEN STRIP_TAC THEN
8080   MATCH_MP_TAC(REWRITE_RULE[RIGHT_IMP_FORALL_THM; IMP_IMP]
8081      WLOG_LINEAR_INJECTIVE_IMAGE) THEN
8082   ASM_REWRITE_TAC[]);;
8083
8084 (* ------------------------------------------------------------------------- *)
8085 (* Inference rule to apply it conveniently.                                  *)
8086 (*                                                                           *)
8087 (*   |- !f s. P s /\ linear f ==> P(IMAGE f s)  [or /\ commuted]             *)
8088 (* ---------------------------------------------------------------           *)
8089 (*   |- !f s. linear f /\ (!x y. f x = f y ==> x = y)                        *)
8090 (*            ==> (Q(IMAGE f s) <=> P s)                                     *)
8091 (* ------------------------------------------------------------------------- *)
8092
8093 let LINEAR_INVARIANT_RULE th =
8094   let [f;s] = fst(strip_forall(concl th)) in
8095   let (rm,rn) = dest_fun_ty (type_of f) in
8096   let m = last(snd(dest_type rm)) and n = last(snd(dest_type rn)) in
8097   let th' = INST_TYPE [m,n; n,m] th in
8098   let th0 = CONJ th th' in
8099   let th1 = try MATCH_MP WLOG_LINEAR_INJECTIVE_IMAGE_2 th0
8100             with Failure _ ->
8101                 MATCH_MP WLOG_LINEAR_INJECTIVE_IMAGE_2
8102             (GEN_REWRITE_RULE (BINOP_CONV o ONCE_DEPTH_CONV) [CONJ_SYM] th0) in
8103   GEN_REWRITE_RULE BINDER_CONV [RIGHT_IMP_FORALL_THM] th1;;
8104
8105 (* ------------------------------------------------------------------------- *)
8106 (* Immediate application.                                                    *)
8107 (* ------------------------------------------------------------------------- *)
8108
8109 let SUBSPACE_LINEAR_IMAGE_EQ = prove
8110  (`!f s. linear f /\ (!x y. f x = f y ==> x = y)
8111          ==> (subspace (IMAGE f s) <=> subspace s)`,
8112   MATCH_ACCEPT_TAC(LINEAR_INVARIANT_RULE SUBSPACE_LINEAR_IMAGE));;
8113
8114 (* ------------------------------------------------------------------------- *)
8115 (* Storage of useful "invariance under linear map / translation" theorems.   *)
8116 (* ------------------------------------------------------------------------- *)
8117
8118 let invariant_under_linear = ref([]:thm list);;
8119
8120 let invariant_under_translation = ref([]:thm list);;
8121
8122 let scaling_theorems = ref([]:thm list);;
8123
8124 (* ------------------------------------------------------------------------- *)
8125 (* Scaling theorems and derivation from linear invariance.                   *)
8126 (* ------------------------------------------------------------------------- *)
8127
8128 let LINEAR_SCALING = prove
8129  (`!c. linear(\x:real^N. c % x)`,
8130   REWRITE_TAC[linear] THEN VECTOR_ARITH_TAC);;
8131
8132 let INJECTIVE_SCALING = prove
8133  (`!c. (!x y:real^N. c % x = c % y ==> x = y) <=> ~(c = &0)`,
8134   GEN_TAC THEN REWRITE_TAC[VECTOR_MUL_LCANCEL] THEN
8135   ASM_CASES_TAC `c:real = &0` THEN ASM_REWRITE_TAC[] THEN
8136   DISCH_THEN(MP_TAC o SPECL [`vec 0:real^N`; `vec 1:real^N`]) THEN
8137   REWRITE_TAC[VEC_EQ; ARITH]);;
8138
8139 let SURJECTIVE_SCALING = prove
8140  (`!c. (!y:real^N. ?x. c % x = y) <=> ~(c = &0)`,
8141   ASM_SIMP_TAC[LINEAR_SURJECTIVE_IFF_INJECTIVE; LINEAR_SCALING] THEN
8142   REWRITE_TAC[INJECTIVE_SCALING]);;
8143
8144 let SCALING_INVARIANT =
8145   let pths = (CONJUNCTS o UNDISCH o prove)
8146    (`&0 < c
8147      ==> linear(\x:real^N. c % x) /\
8148          (!x y:real^N. c % x = c % y ==> x = y) /\
8149          (!y:real^N. ?x. c % x = y)`,
8150     SIMP_TAC[REAL_LT_IMP_NZ; LINEAR_SCALING;
8151              INJECTIVE_SCALING; SURJECTIVE_SCALING])
8152   and sc_tm = `\x:real^N. c % x`
8153   and sa_tm = `&0:real < c`
8154   and c_tm = `c:real` in
8155   fun th ->
8156     let ith = BETA_RULE(ISPEC sc_tm th) in
8157     let avs,bod = strip_forall(concl ith) in
8158     let cjs = conjuncts(lhand bod) in
8159     let cths = map (fun t -> find(fun th -> aconv (concl th) t) pths) cjs in
8160     let oth = MP (SPECL avs ith) (end_itlist CONJ cths) in
8161     GEN c_tm (DISCH sa_tm (GENL avs oth));;
8162
8163 let scaling_theorems = ref([]:thm list);;
8164
8165 (* ------------------------------------------------------------------------- *)
8166 (* Augmentation of the lists. The "add_linear_invariants" also updates       *)
8167 (* the scaling theorems automatically, so only a few of those will need      *)
8168 (* to be added explicitly.                                                   *)
8169 (* ------------------------------------------------------------------------- *)
8170
8171 let add_scaling_theorems thl =
8172   (scaling_theorems := (!scaling_theorems) @ thl);;
8173
8174 let add_linear_invariants thl =
8175   ignore(mapfilter (fun th -> add_scaling_theorems[SCALING_INVARIANT th]) thl);
8176   (invariant_under_linear := (!invariant_under_linear) @ thl);;
8177
8178 let add_translation_invariants thl =
8179  (invariant_under_translation := (!invariant_under_translation) @ thl);;
8180
8181 (* ------------------------------------------------------------------------- *)
8182 (* Start with some basic set equivalences.                                   *)
8183 (* We give them all an injectivity hypothesis even if it's not necessary.    *)
8184 (* For just the intersection theorem we add surjectivity (more manageable    *)
8185 (* than assuming that the set isn't empty).                                  *)
8186 (* ------------------------------------------------------------------------- *)
8187
8188 let th_sets = prove
8189  (`!f. (!x y. f x = f y ==> x = y)
8190        ==> (if p then f x else f y) = f(if p then x else y) /\
8191            (if p then IMAGE f s else IMAGE f t) =
8192            IMAGE f (if p then s else t) /\
8193            (f x) INSERT (IMAGE f s) = IMAGE f (x INSERT s) /\
8194            (IMAGE f s) DELETE (f x) = IMAGE f (s DELETE x) /\
8195            (IMAGE f s) INTER (IMAGE f t) = IMAGE f (s INTER t) /\
8196            (IMAGE f s) UNION (IMAGE f t) = IMAGE f (s UNION t) /\
8197            UNIONS(IMAGE (IMAGE f) u) = IMAGE f (UNIONS u) /\
8198            (IMAGE f s) DIFF (IMAGE f t) = IMAGE f (s DIFF t) /\
8199            (IMAGE f s (f x) <=> s x) /\
8200            ((f x) IN (IMAGE f s) <=> x IN s) /\
8201            ((f o xs) (n:num) = f(xs n)) /\
8202            ((f o pt) (tt:real^1) = f(pt tt)) /\
8203            (DISJOINT (IMAGE f s) (IMAGE f t) <=> DISJOINT s t) /\
8204            ((IMAGE f s) SUBSET (IMAGE f t) <=> s SUBSET t) /\
8205            ((IMAGE f s) PSUBSET (IMAGE f t) <=> s PSUBSET t) /\
8206            (IMAGE f s = IMAGE f t <=> s = t) /\
8207            ((IMAGE f s) HAS_SIZE n <=> s HAS_SIZE n) /\
8208            (FINITE(IMAGE f s) <=> FINITE s) /\
8209            (INFINITE(IMAGE f s) <=> INFINITE s)`,
8210   REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[IMAGE_UNIONS] THEN
8211   REWRITE_TAC[o_THM; MESON[IN] `IMAGE f s y <=> y IN IMAGE f s`] THEN
8212   REPLICATE_TAC 2 (CONJ_TAC THENL [MESON_TAC[]; ALL_TAC]) THEN
8213   REWRITE_TAC[INFINITE; TAUT `(~p <=> ~q) <=> (p <=> q)`] THEN
8214   REPLICATE_TAC 11 (CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN
8215   REWRITE_TAC[HAS_SIZE] THEN
8216   ASM_MESON_TAC[FINITE_IMAGE_INJ_EQ; CARD_IMAGE_INJ]) in
8217 let f = `f:real^M->real^N`
8218 and imf = `IMAGE (f:real^M->real^N)`
8219 and a = `a:real^N`
8220 and ima = `IMAGE (\x:real^N. a + x)`
8221 and vth = VECTOR_ARITH `!x y. a + x:real^N = a + y ==> x = y` in
8222 let th1 = UNDISCH(ISPEC f th_sets)
8223 and th1' = UNDISCH
8224  (GEN_REWRITE_RULE LAND_CONV [INJECTIVE_IMAGE] (ISPEC imf th_sets))
8225 and th2 = MATCH_MP th_sets vth
8226 and th2' = MATCH_MP
8227   (BETA_RULE(GEN_REWRITE_RULE LAND_CONV [INJECTIVE_IMAGE] (ISPEC ima th_sets)))
8228   vth in
8229 let fn a th = GENL (a::subtract (frees(concl th)) [a]) th in
8230 add_linear_invariants(map (fn f o DISCH_ALL) (CONJUNCTS th1 @ CONJUNCTS th1')),
8231 add_translation_invariants(map (fn a) (CONJUNCTS th2 @ CONJUNCTS th2'));;
8232
8233 let th_set = prove
8234  (`!f:A->B s. (!x y. f x = f y ==> x = y) /\ (!y. ?x. f x = y)
8235               ==> INTERS (IMAGE (IMAGE f) s) = IMAGE f (INTERS s)`,
8236   REWRITE_TAC[INTERS_IMAGE] THEN SET_TAC[]) in
8237 let th_vec = prove
8238  (`!a:real^N s.
8239     INTERS (IMAGE (IMAGE (\x. a + x)) s) = IMAGE (\x. a + x) (INTERS s)`,
8240   REPEAT GEN_TAC THEN MATCH_MP_TAC th_set THEN
8241   REWRITE_TAC[VECTOR_ARITH `a + x:real^N = a + y <=> x = y`] THEN
8242   REWRITE_TAC[VECTOR_ARITH `a + x:real^N = y <=> x = y - a`; EXISTS_REFL]) in
8243 add_linear_invariants [th_set],add_translation_invariants[th_vec];;
8244
8245 (* ------------------------------------------------------------------------- *)
8246 (* Now add arithmetical equivalences.                                        *)
8247 (* ------------------------------------------------------------------------- *)
8248
8249 let PRESERVES_NORM_PRESERVES_DOT = prove
8250  (`!f:real^M->real^N x y.
8251      linear f /\ (!x. norm(f x) = norm x)
8252      ==> (f x) dot (f y) = x dot y`,
8253   REWRITE_TAC[NORM_EQ] THEN REPEAT STRIP_TAC THEN
8254   FIRST_ASSUM(MP_TAC o SPEC `x + y:real^M`) THEN
8255   FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP LINEAR_ADD th]) THEN
8256   ASM_REWRITE_TAC[DOT_LADD; DOT_RADD] THEN
8257   REWRITE_TAC[DOT_SYM] THEN REAL_ARITH_TAC);;
8258
8259 let PRESERVES_NORM_INJECTIVE = prove
8260  (`!f:real^M->real^N.
8261      linear f /\ (!x. norm(f x) = norm x)
8262      ==> !x y. f x = f y ==> x = y`,
8263   SIMP_TAC[LINEAR_INJECTIVE_0; GSYM NORM_EQ_0]);;
8264
8265 let ORTHOGONAL_LINEAR_IMAGE_EQ = prove
8266  (`!f:real^M->real^N x y.
8267      linear f /\ (!x. norm(f x) = norm x)
8268      ==> (orthogonal (f x) (f y) <=> orthogonal x y)`,
8269   SIMP_TAC[orthogonal; PRESERVES_NORM_PRESERVES_DOT]);;
8270
8271 add_linear_invariants
8272  [GSYM LINEAR_ADD;
8273   GSYM LINEAR_CMUL;
8274   GSYM LINEAR_SUB;
8275   GSYM LINEAR_NEG;
8276   MIDPOINT_LINEAR_IMAGE;
8277   MESON[] `!f:real^M->real^N x.
8278                 (!x. norm(f x) = norm x) ==> norm(f x) = norm x`;
8279   PRESERVES_NORM_PRESERVES_DOT;
8280   MESON[dist; LINEAR_SUB]
8281     `!f:real^M->real^N x y.
8282         linear f /\ (!x. norm(f x) = norm x)
8283         ==> dist(f x,f y) = dist(x,y)`;
8284   MESON[] `!f:real^M->real^N x y.
8285                 (!x y. f x = f y ==> x = y) ==> (f x = f y <=> x = y)`;
8286   SUBSPACE_LINEAR_IMAGE_EQ;
8287   ORTHOGONAL_LINEAR_IMAGE_EQ;
8288   SPAN_LINEAR_IMAGE;
8289   DEPENDENT_LINEAR_IMAGE_EQ;
8290   INDEPENDENT_LINEAR_IMAGE_EQ;
8291   DIM_INJECTIVE_LINEAR_IMAGE];;
8292
8293 add_translation_invariants
8294  [VECTOR_ARITH `!a x y. a + x:real^N = a + y <=> x = y`;
8295   NORM_ARITH `!a x y. dist(a + x,a + y) = dist(x,y)`;
8296   VECTOR_ARITH `!a x y. &1 / &2 % ((a + x) + (a + y)) = a + &1 / &2 % (x + y)`;
8297   VECTOR_ARITH `!a x y. inv(&2) % ((a + x) + (a + y)) = a + inv(&2) % (x + y)`;
8298   VECTOR_ARITH `!a x y. (a + x) - (a + y):real^N = x - y`;
8299   (EQT_ELIM o (REWRITE_CONV[midpoint] THENC(EQT_INTRO o NORM_ARITH)))
8300                `!a x y. midpoint(a + x,a + y) = a + midpoint(x,y)`;
8301   (EQT_ELIM o (REWRITE_CONV[between] THENC(EQT_INTRO o NORM_ARITH)))
8302                `!a x y z. between (a + x) (a + y,a + z) <=> between x (y,z)`];;
8303
8304 let th = prove
8305  (`!a s b c:real^N. (a + b) + c IN IMAGE (\x. a + x) s <=> (b + c) IN s`,
8306   REWRITE_TAC[IN_IMAGE; VECTOR_ARITH
8307     `(a + b) + c:real^N = a + x <=> x = b + c`] THEN
8308   MESON_TAC[]) in
8309 add_translation_invariants [th];;
8310
8311 (* ------------------------------------------------------------------------- *)
8312 (* A few for lists.                                                          *)
8313 (* ------------------------------------------------------------------------- *)
8314
8315 let MEM_TRANSLATION = prove
8316  (`!a:real^N x l. MEM (a + x) (MAP (\x. a + x) l) <=> MEM x l`,
8317   REWRITE_TAC[MEM_MAP; VECTOR_ARITH `a + x:real^N = a + y <=> x = y`] THEN
8318   MESON_TAC[]);;
8319
8320 add_translation_invariants [MEM_TRANSLATION];;
8321
8322 let MEM_LINEAR_IMAGE = prove
8323  (`!f:real^M->real^N x l.
8324         linear f /\ (!x y. f x = f y ==> x = y)
8325         ==> (MEM (f x) (MAP f l) <=> MEM x l)`,
8326   REWRITE_TAC[MEM_MAP] THEN MESON_TAC[]);;
8327
8328 add_linear_invariants [MEM_LINEAR_IMAGE];;
8329
8330 let LENGTH_TRANSLATION = prove
8331  (`!a:real^N l. LENGTH(MAP (\x. a + x) l) = LENGTH l`,
8332   REWRITE_TAC[LENGTH_MAP]) in
8333 add_translation_invariants [LENGTH_TRANSLATION];;
8334
8335 let LENGTH_LINEAR_IMAGE = prove
8336  (`!f:real^M->real^N l. linear f ==> LENGTH(MAP f l) = LENGTH l`,
8337   REWRITE_TAC[LENGTH_MAP]) in
8338 add_linear_invariants [LENGTH_LINEAR_IMAGE];;
8339
8340 let CONS_TRANSLATION = prove
8341  (`!a:real^N h t.
8342      CONS ((\x. a + x) h) (MAP (\x. a + x) t) = MAP (\x. a + x) (CONS h t)`,
8343   REWRITE_TAC[MAP]) in
8344 add_translation_invariants [CONS_TRANSLATION];;
8345
8346 let CONS_LINEAR_IMAGE = prove
8347  (`!f:real^M->real^N h t.
8348      linear f ==> CONS (f h) (MAP f t) = MAP f (CONS h t)`,
8349   REWRITE_TAC[MAP]) in
8350 add_linear_invariants [CONS_LINEAR_IMAGE];;
8351
8352 let APPEND_TRANSLATION = prove
8353  (`!a:real^N l1 l2.
8354      APPEND (MAP (\x. a + x) l1) (MAP (\x. a + x) l2) =
8355      MAP (\x. a + x) (APPEND l1 l2)`,
8356   REWRITE_TAC[MAP_APPEND]) in
8357 add_translation_invariants [APPEND_TRANSLATION];;
8358
8359 let APPEND_LINEAR_IMAGE = prove
8360  (`!f:real^M->real^N l1 l2.
8361      linear f ==> APPEND (MAP f l1) (MAP f l2) = MAP f (APPEND l1 l2)`,
8362   REWRITE_TAC[MAP_APPEND]) in
8363 add_linear_invariants [APPEND_LINEAR_IMAGE];;
8364
8365 let REVERSE_TRANSLATION = prove
8366  (`!a:real^N l. REVERSE(MAP (\x. a + x) l) = MAP (\x. a + x) (REVERSE l)`,
8367   REWRITE_TAC[MAP_REVERSE]) in
8368 add_translation_invariants [REVERSE_TRANSLATION];;
8369
8370 let REVERSE_LINEAR_IMAGE = prove
8371  (`!f:real^M->real^N l. linear f ==> REVERSE(MAP f l) = MAP f (REVERSE l)`,
8372   REWRITE_TAC[MAP_REVERSE]) in
8373 add_linear_invariants [REVERSE_LINEAR_IMAGE];;
8374
8375 (* ------------------------------------------------------------------------- *)
8376 (* A few scaling theorems that don't come from invariance theorems. Most are *)
8377 (* artificially weak with 0 < c hypotheses, so we don't bind them to names.  *)
8378 (* ------------------------------------------------------------------------- *)
8379
8380 let DOT_SCALING = prove
8381  (`!c. &0 < c ==> !x y. (c % x) dot (c % y) = c pow 2 * (x dot y)`,
8382   REWRITE_TAC[DOT_LMUL; DOT_RMUL] THEN REAL_ARITH_TAC) in
8383 add_scaling_theorems [DOT_SCALING];;
8384
8385 let DIST_SCALING = prove
8386  (`!c. &0 < c ==> !x y. dist(c % x,c % y) = c * dist(x,y)`,
8387   SIMP_TAC[DIST_MUL; REAL_ARITH `&0 < c ==> abs c = c`]) in
8388 add_scaling_theorems [DIST_SCALING];;
8389
8390 let ORTHOGONAL_SCALING = prove
8391  (`!c. &0 < c ==> !x y. orthogonal (c % x) (c % y) <=> orthogonal x y`,
8392   REWRITE_TAC[orthogonal; DOT_LMUL; DOT_RMUL] THEN CONV_TAC REAL_FIELD) in
8393 add_scaling_theorems [ORTHOGONAL_SCALING];;
8394
8395 let NORM_SCALING = prove
8396  (`!c. &0 < c ==> !x. norm(c % x) = c * norm x`,
8397   SIMP_TAC[NORM_MUL; REAL_ARITH `&0 < c ==> abs c = c`]) in
8398 add_scaling_theorems [NORM_SCALING];;
8399
8400 add_scaling_theorems
8401   [REAL_ARITH `!c. &0 < c ==> !a b. a * c * b = c * a * b`;
8402    REAL_ARITH `!c. &0 < c ==> !a b. c * a + c * b = c * (a + b)`;
8403    REAL_ARITH `!c. &0 < c ==> !a b. c * a - c * b = c * (a - b)`;
8404    REAL_FIELD `!c. &0 < c ==> !a b. c * a = c * b <=> a = b`;
8405    MESON[REAL_LT_LMUL_EQ] `!c. &0 < c ==> !a b. c * a < c * b <=> a < b`;
8406    MESON[REAL_LE_LMUL_EQ] `!c. &0 < c ==> !a b. c * a <= c * b <=> a <= b`;
8407    MESON[REAL_LT_LMUL_EQ; real_gt]
8408      `!c. &0 < c ==> !a b. c * a > c * b <=> a > b`;
8409    MESON[REAL_LE_LMUL_EQ; real_ge]
8410      `!c. &0 < c ==> !a b. c * a >= c * b <=> a >= b`;
8411    MESON[REAL_POW_MUL]
8412     `!c. &0 < c ==> !a n. (c * a) pow n = c pow n * a pow n`;
8413    REAL_ARITH `!c. &0 < c ==> !a b n. a * c pow n * b = c pow n * a * b`;
8414    REAL_ARITH
8415     `!c. &0 < c ==> !a b n. c pow n * a + c pow n * b = c pow n * (a + b)`;
8416    REAL_ARITH
8417     `!c. &0 < c ==> !a b n. c pow n * a - c pow n * b = c pow n * (a - b)`;
8418    MESON[REAL_POW_LT; REAL_EQ_LCANCEL_IMP; REAL_LT_IMP_NZ]
8419     `!c. &0 < c ==> !a b n. c pow n * a = c pow n * b <=> a = b`;
8420    MESON[REAL_LT_LMUL_EQ; REAL_POW_LT]
8421      `!c. &0 < c ==> !a b n. c pow n * a < c pow n * b <=> a < b`;
8422    MESON[REAL_LE_LMUL_EQ; REAL_POW_LT]
8423      `!c. &0 < c ==> !a b n. c pow n * a <= c pow n * b <=> a <= b`;
8424    MESON[REAL_LT_LMUL_EQ; real_gt; REAL_POW_LT]
8425      `!c. &0 < c ==> !a b n. c pow n * a > c pow n * b <=> a > b`;
8426    MESON[REAL_LE_LMUL_EQ; real_ge; REAL_POW_LT]
8427      `!c. &0 < c ==> !a b n. c pow n * a >= c pow n * b <=> a >= b`];;
8428
8429 (* ------------------------------------------------------------------------- *)
8430 (* Theorem deducing quantifier mappings from surjectivity.                   *)
8431 (* ------------------------------------------------------------------------- *)
8432
8433 let QUANTIFY_SURJECTION_THM = prove
8434  (`!f:A->B.
8435         (!y. ?x. f x = y)
8436         ==> ((!P. (!x. P x) <=> (!x. P (f x))) /\
8437              (!P. (?x. P x) <=> (?x. P (f x))) /\
8438              (!Q. (!s. Q s) <=> (!s. Q(IMAGE f s))) /\
8439              (!Q. (?s. Q s) <=> (?s. Q(IMAGE f s)))) /\
8440             (!P. {x | P x} = IMAGE f {x | P(f x)})`,
8441   GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [SURJECTIVE_RIGHT_INVERSE] THEN
8442   DISCH_THEN(X_CHOOSE_TAC `g:B->A`) THEN
8443   SUBGOAL_THEN `!s. IMAGE (f:A->B) (IMAGE g s) = s` ASSUME_TAC THENL
8444    [ASM SET_TAC[]; CONJ_TAC THENL [ASM MESON_TAC[]; ASM SET_TAC[]]]);;
8445
8446 let QUANTIFY_SURJECTION_HIGHER_THM = prove
8447  (`!f:A->B.
8448         (!y. ?x. f x = y)
8449         ==> ((!P. (!x. P x) <=> (!x. P (f x))) /\
8450              (!P. (?x. P x) <=> (?x. P (f x))) /\
8451              (!Q. (!s. Q s) <=> (!s. Q(IMAGE f s))) /\
8452              (!Q. (?s. Q s) <=> (?s. Q(IMAGE f s))) /\
8453              (!Q. (!s. Q s) <=> (!s. Q(IMAGE (IMAGE f) s))) /\
8454              (!Q. (?s. Q s) <=> (?s. Q(IMAGE (IMAGE f) s))) /\
8455              (!P. (!g:real^1->B. P g) <=> (!g. P(f o g))) /\
8456              (!P. (?g:real^1->B. P g) <=> (?g. P(f o g))) /\
8457              (!P. (!g:num->B. P g) <=> (!g. P(f o g))) /\
8458              (!P. (?g:num->B. P g) <=> (?g. P(f o g))) /\
8459              (!Q. (!l. Q l) <=> (!l. Q(MAP f l))) /\
8460              (!Q. (?l. Q l) <=> (?l. Q(MAP f l)))) /\
8461             ((!P. {x | P x} = IMAGE f {x | P(f x)}) /\
8462              (!Q. {s | Q s} = IMAGE (IMAGE f) {s | Q(IMAGE f s)}) /\
8463              (!R. {l | R l} = IMAGE (MAP f) {l | R(MAP f l)}))`,
8464   GEN_TAC THEN DISCH_TAC THEN CONV_TAC(ONCE_DEPTH_CONV SYM_CONV) THEN
8465   ASM_REWRITE_TAC[GSYM SURJECTIVE_FORALL_THM; GSYM SURJECTIVE_EXISTS_THM;
8466             GSYM SURJECTIVE_IMAGE_THM; SURJECTIVE_IMAGE; SURJECTIVE_MAP] THEN
8467   REWRITE_TAC[FUN_EQ_THM; o_THM; GSYM SKOLEM_THM] THEN ASM_MESON_TAC[]);;
8468
8469 (* ------------------------------------------------------------------------- *)
8470 (* Apply such quantifier and set expansions once per level at depth.         *)
8471 (* In the PARTIAL version, avoid expanding named variables in list.          *)
8472 (* ------------------------------------------------------------------------- *)
8473
8474 let PARTIAL_EXPAND_QUANTS_CONV avoid th =
8475   let ath,sth = CONJ_PAIR th in
8476   let conv1 = GEN_REWRITE_CONV I [ath]
8477   and conv2 = GEN_REWRITE_CONV I [sth] in
8478   let conv1' tm =
8479     let th = conv1 tm in
8480     if mem (fst(dest_var(fst(dest_abs(rand tm))))) avoid
8481     then failwith "Not going to expand this variable" else th in
8482   let rec conv tm =
8483    ((conv1' THENC BINDER_CONV conv) ORELSEC
8484     (conv2 THENC
8485      RAND_CONV(RAND_CONV(ABS_CONV(BINDER_CONV(LAND_CONV conv))))) ORELSEC
8486     SUB_CONV conv) tm in
8487   conv;;
8488
8489 let EXPAND_QUANTS_CONV = PARTIAL_EXPAND_QUANTS_CONV [];;