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 (* Analogous theorems for set-sums.                                          *)
 266 (* ------------------------------------------------------------------------- *)
 267
 268 let SUMS_SYM = prove
 269  (`!s t:real^N->bool.
 270         {x + y | x IN s /\ y IN t} = {y + x | y IN t /\ x IN s}`,
 271   REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN MESON_TAC[VECTOR_ADD_SYM]);;
 272
 273 let SUMS_ASSOC = prove
 274  (`!s t u:real^N->bool.
 275         {w + z | w IN {x + y | x IN s /\ y IN t} /\ z IN u} =
 276         {x + v | x IN s /\ v IN {y + z | y IN t /\ z IN u}}`,
 277   REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN MESON_TAC[VECTOR_ADD_ASSOC]);;
 278
 279 (* ------------------------------------------------------------------------- *)
 280 (* Infinitude of Euclidean space.                                            *)
 281 (* ------------------------------------------------------------------------- *)
 282
 283 let EUCLIDEAN_SPACE_INFINITE = prove
 284  (`INFINITE(:real^N)`,
 285   REWRITE_TAC[INFINITE] THEN DISCH_TAC THEN
 286   FIRST_ASSUM(MP_TAC o ISPEC `vec:num->real^N` o
 287     MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] FINITE_IMAGE_INJ)) THEN
 288   REWRITE_TAC[VEC_EQ; SET_RULE `{x | f x IN UNIV} = UNIV`] THEN
 289   REWRITE_TAC[GSYM INFINITE; num_INFINITE]);;
 290
 291 (* ------------------------------------------------------------------------- *)
 292 (* Properties of the dot product.                                            *)
 293 (* ------------------------------------------------------------------------- *)
 294
 295 let DOT_SYM = VECTOR_ARITH `!x y. x dot y = y dot x`;;
 296
 297 let DOT_LADD = VECTOR_ARITH `!x y z. (x + y) dot z = (x dot z) + (y dot z)`;;
 298
 299 let DOT_RADD = VECTOR_ARITH `!x y z. x dot (y + z) = (x dot y) + (x dot z)`;;
 300
 301 let DOT_LSUB = VECTOR_ARITH `!x y z. (x - y) dot z = (x dot z) - (y dot z)`;;
 302
 303 let DOT_RSUB = VECTOR_ARITH `!x y z. x dot (y - z) = (x dot y) - (x dot z)`;;
 304
 305 let DOT_LMUL = VECTOR_ARITH `!c x y. (c % x) dot y = c * (x dot y)`;;
 306
 307 let DOT_RMUL = VECTOR_ARITH `!c x y. x dot (c % y) = c * (x dot y)`;;
 308
 309 let DOT_LNEG = VECTOR_ARITH `!x y. (--x) dot y = --(x dot y)`;;
 310
 311 let DOT_RNEG = VECTOR_ARITH `!x y. x dot (--y) = --(x dot y)`;;
 312
 313 let DOT_LZERO = VECTOR_ARITH `!x. (vec 0) dot x = &0`;;
 314
 315 let DOT_RZERO = VECTOR_ARITH `!x. x dot (vec 0) = &0`;;
 316
 317 let DOT_POS_LE = prove
 318  (`!x. &0 <= x dot x`,
 319   SIMP_TAC[dot; SUM_POS_LE_NUMSEG; REAL_LE_SQUARE]);;
 320
 321 let DOT_EQ_0 = prove
 322  (`!x:real^N. ((x dot x = &0) <=> (x = vec 0))`,
 323   REPEAT GEN_TAC THEN EQ_TAC THENL [ALL_TAC; MESON_TAC[DOT_LZERO]] THEN
 324   SIMP_TAC[dot; CART_EQ; vec; LAMBDA_BETA] THEN DISCH_TAC THEN
 325   ONCE_REWRITE_TAC[GSYM(REWRITE_CONV[REAL_ENTIRE] `x * x = &0`)] THEN
 326   MATCH_MP_TAC SUM_POS_EQ_0_NUMSEG THEN ASM_REWRITE_TAC[REAL_LE_SQUARE]);;
 327
 328 let DOT_POS_LT = prove
 329  (`!x. (&0 < x dot x) <=> ~(x = vec 0)`,
 330   REWRITE_TAC[REAL_LT_LE; DOT_POS_LE] THEN MESON_TAC[DOT_EQ_0]);;
 331
 332 let FORALL_DOT_EQ_0 = prove
 333  (`(!y. (!x. x dot y = &0) <=> y = vec 0) /\
 334    (!x. (!y. x dot y = &0) <=> x = vec 0)`,
 335   MESON_TAC[DOT_LZERO; DOT_RZERO; DOT_EQ_0]);;
 336
 337 (* ------------------------------------------------------------------------- *)
 338 (* Introduce norms, but defer many properties till we get square roots.      *)
 339 (* ------------------------------------------------------------------------- *)
 340
 341 make_overloadable "norm" `:A->real`;;
 342 overload_interface("norm",`vector_norm:real^N->real`);;
 343
 344 let vector_norm = new_definition
 345   `norm x = sqrt(x dot x)`;;
 346
 347 (* ------------------------------------------------------------------------- *)
 348 (* Useful for the special cases of 1 dimension.                              *)
 349 (* ------------------------------------------------------------------------- *)
 350
 351 let FORALL_DIMINDEX_1 = prove
 352  (`(!i. 1 <= i /\ i <= dimindex(:1) ==> P i) <=> P 1`,
 353   MESON_TAC[DIMINDEX_1; LE_ANTISYM]);;
 354
 355 (* ------------------------------------------------------------------------- *)
 356 (* The collapse of the general concepts to the real line R^1.                *)
 357 (* ------------------------------------------------------------------------- *)
 358
 359 let VECTOR_ONE = prove
 360  (`!x:real^1. x = lambda i. x$1`,
 361   SIMP_TAC[CART_EQ; LAMBDA_BETA] THEN MESON_TAC[DIMINDEX_1; LE_ANTISYM]);;
 362
 363 let FORALL_REAL_ONE = prove
 364  (`(!x:real^1. P x) <=> (!x. P(lambda i. x))`,
 365   EQ_TAC THEN SIMP_TAC[] THEN DISCH_TAC THEN GEN_TAC THEN
 366   FIRST_X_ASSUM(MP_TAC o SPEC `(x:real^1)$1`) THEN
 367   REWRITE_TAC[GSYM VECTOR_ONE]);;
 368
 369 let NORM_REAL = prove
 370  (`!x:real^1. norm(x) = abs(x$1)`,
 371   REWRITE_TAC[vector_norm; dot; DIMINDEX_1; SUM_SING_NUMSEG;
 372               GSYM REAL_POW_2; POW_2_SQRT_ABS]);;
 373
 374 (* ------------------------------------------------------------------------- *)
 375 (* Metric function.                                                          *)
 376 (* ------------------------------------------------------------------------- *)
 377
 378 override_interface("dist",`distance:real^N#real^N->real`);;
 379
 380 let dist = new_definition
 381   `dist(x,y) = norm(x - y)`;;
 382
 383 let DIST_REAL = prove
 384  (`!x:real^1 y. dist(x,y) = abs(x$1 - y$1)`,
 385   SIMP_TAC[dist; NORM_REAL; vector_sub; LAMBDA_BETA; LE_REFL; DIMINDEX_1]);;
 386
 387 (* ------------------------------------------------------------------------- *)
 388 (* A connectedness or intermediate value lemma with several applications.    *)
 389 (* ------------------------------------------------------------------------- *)
 390
 391 let CONNECTED_REAL_LEMMA = prove
 392  (`!f:real->real^N a b e1 e2.
 393         a <= b /\ f(a) IN e1 /\ f(b) IN e2 /\
 394         (!e x. a <= x /\ x <= b /\ &0 < e
 395                ==> ?d. &0 < d /\
 396                        !y. abs(y - x) < d ==> dist(f(y),f(x)) < e) /\
 397         (!y. y IN e1 ==> ?e. &0 < e /\ !y'. dist(y',y) < e ==> y' IN e1) /\
 398         (!y. y IN e2 ==> ?e. &0 < e /\ !y'. dist(y',y) < e ==> y' IN e2) /\
 399         ~(?x. a <= x /\ x <= b /\ f(x) IN e1 /\ f(x) IN e2)
 400         ==> ?x. a <= x /\ x <= b /\ ~(f(x) IN e1) /\ ~(f(x) IN e2)`,
 401   let tac = ASM_MESON_TAC[REAL_LT_IMP_LE; REAL_LE_TOTAL; REAL_LE_ANTISYM] in
 402   REWRITE_TAC[EXTENSION; NOT_IN_EMPTY] THEN REPEAT STRIP_TAC THEN
 403   MP_TAC(SPEC `\c. !x. a <= x /\ x <= c ==> (f(x):real^N) IN e1`
 404               REAL_COMPLETE) THEN
 405   REWRITE_TAC[] THEN ANTS_TAC THENL [tac; ALL_TAC] THEN
 406   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `x:real` THEN STRIP_TAC THEN
 407   SUBGOAL_THEN `a <= x /\ x <= b` STRIP_ASSUME_TAC THENL [tac; ALL_TAC] THEN
 408   ASM_REWRITE_TAC[] THEN
 409   SUBGOAL_THEN `!z. a <= z /\ z < x ==> (f(z):real^N) IN e1` ASSUME_TAC THENL
 410    [ASM_MESON_TAC[REAL_NOT_LT; REAL_LT_IMP_LE]; ALL_TAC] THEN
 411   REPEAT STRIP_TAC THENL
 412    [SUBGOAL_THEN
 413      `?d. &0 < d /\ !y. abs(y - x) < d ==> (f(y):real^N) IN e1`
 414     STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN
 415     ASM_MESON_TAC[REAL_ARITH `z <= x + e /\ e < d ==> z < x \/ abs(z - x) < d`;
 416                   REAL_ARITH `&0 < e ==> ~(x + e <= x)`; REAL_DOWN];
 417     SUBGOAL_THEN
 418      `?d. &0 < d /\ !y. abs(y - x) < d ==> (f(y):real^N) IN e2`
 419     STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN
 420     MP_TAC(SPECL [`x - a`; `d:real`] REAL_DOWN2) THEN ANTS_TAC THENL
 421      [ASM_MESON_TAC[REAL_LT_LE; REAL_SUB_LT]; ALL_TAC] THEN
 422     ASM_MESON_TAC[REAL_ARITH `e < x - a ==> a <= x - e`;
 423                   REAL_ARITH `&0 < e /\ x <= b ==> x - e <= b`;
 424       REAL_ARITH `&0 < e /\ e < d ==> x - e < x /\ abs((x - e) - x) < d`]]);;
 425
 426 (* ------------------------------------------------------------------------- *)
 427 (* One immediately useful corollary is the existence of square roots!        *)
 428 (* ------------------------------------------------------------------------- *)
 429
 430 let SQUARE_BOUND_LEMMA = prove
 431  (`!x. x < (&1 + x) * (&1 + x)`,
 432   GEN_TAC THEN REWRITE_TAC[REAL_POW_2] THEN
 433   MAP_EVERY (fun t -> MP_TAC(SPEC t REAL_LE_SQUARE)) [`x:real`; `&1 + x`] THEN
 434   REAL_ARITH_TAC);;
 435
 436 let SQUARE_CONTINUOUS = prove
 437  (`!x e. &0 < e
 438          ==> ?d. &0 < d /\ !y. abs(y - x) < d ==> abs(y * y - x * x) < e`,
 439   REPEAT STRIP_TAC THEN ASM_CASES_TAC `x = &0` THENL
 440    [ASM_REWRITE_TAC[REAL_MUL_LZERO; REAL_SUB_RZERO] THEN
 441     EXISTS_TAC `inv(&1 + inv(e))` THEN
 442     ASM_SIMP_TAC[REAL_LT_INV_EQ; REAL_LT_ADD; REAL_LT_01] THEN
 443     REPEAT STRIP_TAC THEN MATCH_MP_TAC  REAL_LTE_TRANS THEN
 444     EXISTS_TAC `inv(&1 + inv(e)) * inv(&1 + inv(e))` THEN
 445     ASM_SIMP_TAC[REAL_ABS_MUL; REAL_LT_MUL2; REAL_ABS_POS] THEN
 446     REWRITE_TAC[GSYM REAL_INV_MUL] THEN
 447     GEN_REWRITE_TAC RAND_CONV [GSYM REAL_INV_INV] THEN
 448     MATCH_MP_TAC REAL_LE_INV2 THEN
 449     ASM_SIMP_TAC[REAL_LT_IMP_LE; SQUARE_BOUND_LEMMA; REAL_LT_INV_EQ];
 450     MP_TAC(SPECL [`abs(x)`; `e / (&3 * abs(x))`] REAL_DOWN2)THEN
 451     ASM_SIMP_TAC[GSYM REAL_ABS_NZ; REAL_LT_DIV; REAL_LT_MUL; REAL_OF_NUM_LT;
 452                  ARITH; REAL_LT_RDIV_EQ] THEN
 453     MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN
 454     STRIP_TAC THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `y:real` THEN
 455     REWRITE_TAC[REAL_ARITH `x * x - y * y = (x - y) * (x + y)`] THEN
 456     DISCH_TAC THEN MATCH_MP_TAC REAL_LET_TRANS THEN
 457     EXISTS_TAC `d * &3 * abs(x)` THEN ASM_REWRITE_TAC[REAL_ABS_MUL] THEN
 458     MATCH_MP_TAC REAL_LE_MUL2 THEN
 459     ASM_SIMP_TAC[REAL_ABS_POS; REAL_LT_IMP_LE] THEN
 460     MAP_EVERY UNDISCH_TAC [`abs (y - x) < d`; `d < abs(x)`] THEN
 461     REAL_ARITH_TAC]);;
 462
 463 let SQRT_WORKS_GEN = prove
 464  (`!x. real_sgn(sqrt x) = real_sgn x /\ sqrt(x) pow 2 = abs x`,
 465   GEN_TAC THEN REWRITE_TAC[sqrt] THEN CONV_TAC SELECT_CONV THEN
 466   SUBGOAL_THEN `!x. &0 < x ==> ?y. &0 < y /\ y pow 2 = x` ASSUME_TAC THENL
 467    [REPEAT STRIP_TAC THEN
 468     MP_TAC(ISPECL [`(\u. lambda i. u):real->real^1`; `&0`; `&1 + x`;
 469             `{u:real^1 | u$1 * u$1 < x}`; `{u:real^1 | u$1 * u$1 > x}`]
 470          CONNECTED_REAL_LEMMA) THEN
 471     SIMP_TAC[LAMBDA_BETA; LE_REFL; DIMINDEX_1; DIST_REAL; IN_ELIM_THM] THEN
 472     REWRITE_TAC[REAL_POW_2; REAL_ARITH `~(x < y) /\ ~(x > y) <=> x = y`] THEN
 473     ANTS_TAC THENL [ALL_TAC; ASM_MESON_TAC[REAL_LT_LE; REAL_ENTIRE]] THEN
 474     ASM_REWRITE_TAC[real_gt; SQUARE_BOUND_LEMMA; REAL_MUL_LZERO] THEN
 475     CONJ_TAC THENL [ASM_REAL_ARITH_TAC; REWRITE_TAC[REAL_LT_ANTISYM]] THEN
 476     MESON_TAC[SQUARE_CONTINUOUS; REAL_SUB_LT;
 477               REAL_ARITH `abs(z2 - x2) < y - x2 ==> z2 < y`;
 478               REAL_ARITH `abs(z2 - x2) < x2 - y ==> y < z2`];
 479     ASM_CASES_TAC `x = &0` THEN
 480     ASM_REWRITE_TAC[REAL_SGN_0; REAL_SGN_EQ; UNWIND_THM2] THEN
 481     CONV_TAC REAL_RAT_REDUCE_CONV THEN
 482     FIRST_X_ASSUM(MP_TAC o SPEC `abs x`) THEN
 483     ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
 484     DISCH_THEN(X_CHOOSE_THEN `y:real` STRIP_ASSUME_TAC) THEN
 485     EXISTS_TAC `real_sgn x * y` THEN
 486     ASM_REWRITE_TAC[REAL_POW_MUL; GSYM REAL_SGN_POW; REAL_SGN_POW_2] THEN
 487     REWRITE_TAC[REAL_SGN_MUL; REAL_SGN_REAL_SGN] THEN
 488     ASM_SIMP_TAC[real_sgn; REAL_ARITH `&0 < abs x <=> ~(x = &0)`] THEN
 489     REWRITE_TAC[REAL_MUL_LID; REAL_MUL_RID]]);;
 490
 491 let SQRT_UNIQUE_GEN = prove
 492  (`!x y. real_sgn y = real_sgn x /\ y pow 2 = abs x ==> sqrt x = y`,
 493   REPEAT GEN_TAC THEN
 494   MP_TAC(GSYM(SPEC `x:real` SQRT_WORKS_GEN)) THEN
 495   SIMP_TAC[REAL_RING `x pow 2 = y pow 2 <=> x:real = y \/ x = --y`] THEN
 496   DISCH_THEN(K ALL_TAC) THEN REWRITE_TAC[IMP_CONJ_ALT] THEN
 497   STRIP_TAC THEN ASM_REWRITE_TAC[REAL_SGN_NEG] THEN
 498   SIMP_TAC[REAL_ARITH `--x = x <=> x = &0`; REAL_SGN_EQ; REAL_NEG_0; SQRT_0]);;
 499
 500 let SQRT_NEG = prove
 501  (`!x. sqrt(--x) = --sqrt(x)`,
 502   GEN_TAC THEN MATCH_MP_TAC SQRT_UNIQUE_GEN THEN
 503   REWRITE_TAC[REAL_SGN_NEG; REAL_POW_NEG; REAL_ABS_NEG; ARITH] THEN
 504   REWRITE_TAC[SQRT_WORKS_GEN]);;
 505
 506 let REAL_SGN_SQRT = prove
 507  (`!x. real_sgn(sqrt x) = real_sgn x`,
 508   REWRITE_TAC[SQRT_WORKS_GEN]);;
 509
 510 let SQRT_WORKS = prove
 511  (`!x. &0 <= x ==> &0 <= sqrt(x) /\ sqrt(x) pow 2 = x`,
 512   REPEAT STRIP_TAC THEN MP_TAC(SPEC `x:real` SQRT_WORKS_GEN) THEN
 513   REWRITE_TAC[real_sgn] THEN ASM_REAL_ARITH_TAC);;
 514
 515 let SQRT_POS_LE = prove
 516  (`!x. &0 <= x ==> &0 <= sqrt(x)`,
 517   MESON_TAC[SQRT_WORKS]);;
 518
 519 let SQRT_POW_2 = prove
 520  (`!x. &0 <= x ==> sqrt(x) pow 2 = x`,
 521   MESON_TAC[SQRT_WORKS]);;
 522
 523 let SQRT_POW2 = prove
 524  (`!x. sqrt(x) pow 2 = x <=> &0 <= x`,
 525   MESON_TAC[REAL_POW_2; REAL_LE_SQUARE; SQRT_POW_2]);;
 526
 527 let SQRT_MUL = prove
 528  (`!x y. sqrt(x * y) = sqrt x * sqrt y`,
 529   REPEAT GEN_TAC THEN MATCH_MP_TAC SQRT_UNIQUE_GEN THEN
 530   REWRITE_TAC[REAL_SGN_MUL; REAL_POW_MUL; SQRT_WORKS_GEN; REAL_ABS_MUL]);;
 531
 532 let SQRT_INV = prove
 533  (`!x. sqrt (inv x) = inv(sqrt x)`,
 534   GEN_TAC THEN MATCH_MP_TAC SQRT_UNIQUE_GEN THEN
 535   REWRITE_TAC[REAL_SGN_INV; REAL_POW_INV; REAL_ABS_INV; SQRT_WORKS_GEN]);;
 536
 537 let SQRT_DIV = prove
 538  (`!x y. sqrt (x / y) = sqrt x / sqrt y`,
 539   REWRITE_TAC[real_div; SQRT_MUL; SQRT_INV]);;
 540
 541 let SQRT_LT_0 = prove
 542  (`!x. &0 < sqrt x <=> &0 < x`,
 543   REWRITE_TAC[GSYM real_gt; GSYM REAL_SGN_EQ; REAL_SGN_SQRT]);;
 544
 545 let SQRT_EQ_0 = prove
 546  (`!x. sqrt x = &0 <=> x = &0`,
 547   ONCE_REWRITE_TAC[GSYM REAL_SGN_EQ] THEN REWRITE_TAC[REAL_SGN_SQRT]);;
 548
 549 let SQRT_LE_0 = prove
 550  (`!x. &0 <= sqrt x <=> &0 <= x`,
 551   REWRITE_TAC[REAL_ARITH `&0 <= x <=> &0 < x \/ x = &0`] THEN
 552   REWRITE_TAC[SQRT_LT_0; SQRT_EQ_0]);;
 553
 554 let SQRT_MONO_LT = prove
 555  (`!x y. x < y ==> sqrt(x) < sqrt(y)`,
 556   SUBGOAL_THEN `!x y. &0 <= x /\ x < y ==> sqrt x < sqrt y` ASSUME_TAC THENL
 557    [REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_POW_LT2_REV THEN
 558     EXISTS_TAC `2` THEN ASM_REWRITE_TAC[SQRT_WORKS_GEN; SQRT_LE_0] THEN
 559     ASM_REAL_ARITH_TAC;
 560     REPEAT STRIP_TAC THEN ASM_CASES_TAC `&0 <= x` THEN ASM_SIMP_TAC[] THEN
 561     ASM_CASES_TAC `&0 <= y` THENL
 562      [MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `&0` THEN
 563       ASM_REWRITE_TAC[GSYM REAL_NOT_LE; SQRT_LE_0];
 564       FIRST_X_ASSUM(MP_TAC o SPECL [`--y:real`; `--x:real`]) THEN
 565       REWRITE_TAC[SQRT_NEG] THEN ASM_REAL_ARITH_TAC]]);;
 566
 567 let SQRT_MONO_LE = prove
 568  (`!x y. x <= y ==> sqrt(x) <= sqrt(y)`,
 569   MESON_TAC[REAL_LE_LT; SQRT_MONO_LT]);;
 570
 571 let SQRT_MONO_LT_EQ = prove
 572  (`!x y. sqrt(x) < sqrt(y) <=> x < y`,
 573   MESON_TAC[REAL_NOT_LT; SQRT_MONO_LT; SQRT_MONO_LE]);;
 574
 575 let SQRT_MONO_LE_EQ = prove
 576  (`!x y. sqrt(x) <= sqrt(y) <=> x <= y`,
 577   MESON_TAC[REAL_NOT_LT; SQRT_MONO_LT; SQRT_MONO_LE]);;
 578
 579 let SQRT_INJ = prove
 580  (`!x y. sqrt(x) = sqrt(y) <=> x = y`,
 581   SIMP_TAC[GSYM REAL_LE_ANTISYM; SQRT_MONO_LE_EQ]);;
 582
 583 let SQRT_POS_LT = prove
 584  (`!x. &0 < x ==> &0 < sqrt(x)`,
 585   MESON_TAC[REAL_LT_LE; SQRT_POS_LE; SQRT_EQ_0]);;
 586
 587 let REAL_LE_LSQRT = prove
 588  (`!x y. &0 <= y /\ x <= y pow 2 ==> sqrt(x) <= y`,
 589   MESON_TAC[SQRT_MONO_LE; REAL_POW_LE; POW_2_SQRT]);;
 590
 591 let REAL_LE_RSQRT = prove
 592  (`!x y. x pow 2 <= y ==> x <= sqrt(y)`,
 593   MESON_TAC[REAL_LE_TOTAL; SQRT_MONO_LE; SQRT_POS_LE; REAL_POW_2;
 594             REAL_LE_SQUARE; REAL_LE_TRANS; POW_2_SQRT]);;
 595
 596 let REAL_LT_LSQRT = prove
 597  (`!x y. &0 <= y /\ x < y pow 2 ==> sqrt x < y`,
 598   MESON_TAC[SQRT_MONO_LT; REAL_POW_LE; POW_2_SQRT]);;
 599
 600 let REAL_LT_RSQRT = prove
 601  (`!x y. x pow 2 < y ==> x < sqrt(y)`,
 602   REPEAT STRIP_TAC THEN MATCH_MP_TAC(REAL_ARITH `abs x < a ==> x < a`) THEN
 603   REWRITE_TAC[GSYM POW_2_SQRT_ABS] THEN MATCH_MP_TAC SQRT_MONO_LT THEN
 604   ASM_REWRITE_TAC[REAL_POW_2; REAL_LE_SQUARE]);;
 605
 606 let SQRT_EVEN_POW2 = prove
 607  (`!n. EVEN n ==> (sqrt(&2 pow n) = &2 pow (n DIV 2))`,
 608   SIMP_TAC[EVEN_EXISTS; LEFT_IMP_EXISTS_THM; DIV_MULT; ARITH_EQ] THEN
 609   MESON_TAC[SQRT_UNIQUE; REAL_POW_POW; MULT_SYM; REAL_POW_LE; REAL_POS]);;
 610
 611 let REAL_DIV_SQRT = prove
 612  (`!x. &0 <= x ==> x / sqrt(x) = sqrt(x)`,
 613   REWRITE_TAC[REAL_LE_LT] THEN REPEAT STRIP_TAC THENL
 614    [ALL_TAC; ASM_MESON_TAC[SQRT_0; real_div; REAL_MUL_LZERO]] THEN
 615   ASM_SIMP_TAC[REAL_EQ_LDIV_EQ; SQRT_POS_LT; GSYM REAL_POW_2] THEN
 616   ASM_SIMP_TAC[SQRT_POW_2; REAL_LT_IMP_LE]);;
 617
 618 let REAL_RSQRT_LE = prove
 619  (`!x y. &0 <= x /\ &0 <= y /\ x <= sqrt y ==> x pow 2 <= y`,
 620   MESON_TAC[REAL_POW_LE2; SQRT_POW_2]);;
 621
 622 let REAL_LSQRT_LE = prove
 623  (`!x y. &0 <= x /\ sqrt x <= y ==> x <= y pow 2`,
 624   MESON_TAC[REAL_POW_LE2; SQRT_POS_LE; REAL_LE_TRANS; SQRT_POW_2]);;
 625
 626 let REAL_SQRT_POW_2 = prove
 627  (`!x. sqrt x pow 2 = abs x`,
 628   REWRITE_TAC[SQRT_WORKS_GEN]);;
 629
 630 (* ------------------------------------------------------------------------- *)
 631 (* Hence derive more interesting properties of the norm.                     *)
 632 (* ------------------------------------------------------------------------- *)
 633
 634 let NORM_0 = prove
 635  (`norm(vec 0) = &0`,
 636   REWRITE_TAC[vector_norm; DOT_LZERO; SQRT_0]);;
 637
 638 let NORM_POS_LE = prove
 639  (`!x. &0 <= norm x`,
 640   GEN_TAC THEN SIMP_TAC[DOT_POS_LE; vector_norm; SQRT_POS_LE]);;
 641
 642 let NORM_NEG = prove
 643  (`!x. norm(--x) = norm x`,
 644   REWRITE_TAC[vector_norm; DOT_LNEG; DOT_RNEG; REAL_NEG_NEG]);;
 645
 646 let NORM_SUB = prove
 647  (`!x y. norm(x - y) = norm(y - x)`,
 648   MESON_TAC[NORM_NEG; VECTOR_NEG_SUB]);;
 649
 650 let NORM_MUL = prove
 651  (`!a x. norm(a % x) = abs(a) * norm x`,
 652   REWRITE_TAC[vector_norm; DOT_LMUL; DOT_RMUL; REAL_MUL_ASSOC] THEN
 653   REWRITE_TAC[SQRT_MUL; GSYM REAL_POW_2; REAL_SQRT_POW_2]);;
 654
 655 let NORM_EQ_0_DOT = prove
 656  (`!x. (norm x = &0) <=> (x dot x = &0)`,
 657   SIMP_TAC[vector_norm; SQRT_EQ_0; DOT_POS_LE]);;
 658
 659 let NORM_EQ_0 = prove
 660  (`!x. (norm x = &0) <=> (x = vec 0)`,
 661   SIMP_TAC[vector_norm; DOT_EQ_0; SQRT_EQ_0; DOT_POS_LE]);;
 662
 663 let NORM_POS_LT = prove
 664  (`!x. &0 < norm x <=> ~(x = vec 0)`,
 665   MESON_TAC[REAL_LT_LE; NORM_POS_LE; NORM_EQ_0]);;
 666
 667 let NORM_POW_2 = prove
 668  (`!x. norm(x) pow 2 = x dot x`,
 669   SIMP_TAC[vector_norm; SQRT_POW_2; DOT_POS_LE]);;
 670
 671 let NORM_EQ_0_IMP = prove
 672  (`!x. (norm x = &0) ==> (x = vec 0)`,
 673   MESON_TAC[NORM_EQ_0]);;
 674
 675 let NORM_LE_0 = prove
 676  (`!x. norm x <= &0 <=> (x = vec 0)`,
 677   MESON_TAC[REAL_LE_ANTISYM; NORM_EQ_0; NORM_POS_LE]);;
 678
 679 let VECTOR_MUL_EQ_0 = prove
 680  (`!a x. (a % x = vec 0) <=> (a = &0) \/ (x = vec 0)`,
 681   REWRITE_TAC[GSYM NORM_EQ_0; NORM_MUL; REAL_ABS_ZERO; REAL_ENTIRE]);;
 682
 683 let VECTOR_MUL_LCANCEL = prove
 684  (`!a x y. (a % x = a % y) <=> (a = &0) \/ (x = y)`,
 685   MESON_TAC[VECTOR_MUL_EQ_0; VECTOR_SUB_LDISTRIB; VECTOR_SUB_EQ]);;
 686
 687 let VECTOR_MUL_RCANCEL = prove
 688  (`!a b x. (a % x = b % x) <=> (a = b) \/ (x = vec 0)`,
 689   MESON_TAC[VECTOR_MUL_EQ_0; VECTOR_SUB_RDISTRIB; REAL_SUB_0; VECTOR_SUB_EQ]);;
 690
 691 let VECTOR_MUL_LCANCEL_IMP = prove
 692  (`!a x y. ~(a = &0) /\ (a % x = a % y) ==> (x = y)`,
 693   MESON_TAC[VECTOR_MUL_LCANCEL]);;
 694
 695 let VECTOR_MUL_RCANCEL_IMP = prove
 696  (`!a b x. ~(x = vec 0) /\ (a % x = b % x) ==> (a = b)`,
 697   MESON_TAC[VECTOR_MUL_RCANCEL]);;
 698
 699 let NORM_CAUCHY_SCHWARZ = prove
 700  (`!(x:real^N) y. x dot y <= norm(x) * norm(y)`,
 701   REPEAT STRIP_TAC THEN MAP_EVERY ASM_CASES_TAC
 702    [`norm(x:real^N) = &0`; `norm(y:real^N) = &0`] THEN
 703   ASM_SIMP_TAC[NORM_EQ_0_IMP; DOT_LZERO; DOT_RZERO;
 704                REAL_MUL_LZERO; REAL_MUL_RZERO] THEN
 705   MP_TAC(ISPEC `norm(y:real^N) % x - norm(x:real^N) % y` DOT_POS_LE) THEN
 706   REWRITE_TAC[DOT_RSUB; DOT_LSUB; DOT_LMUL; DOT_RMUL; GSYM NORM_POW_2;
 707               REAL_POW_2; REAL_LE_REFL] THEN
 708   REWRITE_TAC[DOT_SYM; REAL_ARITH
 709    `&0 <= y * (y * x * x - x * d) - x * (y * d - x * y * y) <=>
 710     x * y * d <= x * y * x * y`] THEN
 711   ASM_SIMP_TAC[REAL_LE_LMUL_EQ; REAL_LT_LE; NORM_POS_LE]);;
 712
 713 let NORM_CAUCHY_SCHWARZ_ABS = prove
 714  (`!x:real^N y. abs(x dot y) <= norm(x) * norm(y)`,
 715   REPEAT GEN_TAC THEN MP_TAC(ISPEC `x:real^N` NORM_CAUCHY_SCHWARZ) THEN
 716   DISCH_THEN(fun th -> MP_TAC(SPEC `y:real^N` th) THEN
 717         MP_TAC(SPEC `--(y:real^N)` th)) THEN
 718   REWRITE_TAC[DOT_RNEG; NORM_NEG] THEN REAL_ARITH_TAC);;
 719
 720 let REAL_ABS_NORM = prove
 721  (`!x. abs(norm x) = norm x`,
 722   REWRITE_TAC[NORM_POS_LE; REAL_ABS_REFL]);;
 723
 724 let NORM_CAUCHY_SCHWARZ_DIV = prove
 725  (`!x:real^N y. abs((x dot y) / (norm x * norm y)) <= &1`,
 726   REPEAT GEN_TAC THEN
 727   MAP_EVERY ASM_CASES_TAC [`x:real^N = vec 0`; `y:real^N = vec 0`] THEN
 728   ASM_REWRITE_TAC[NORM_0; REAL_MUL_LZERO; REAL_MUL_RZERO; real_div;
 729              REAL_INV_1; DOT_LZERO; DOT_RZERO; REAL_ABS_NUM; REAL_POS] THEN
 730   ASM_SIMP_TAC[GSYM real_div; REAL_ABS_DIV; REAL_LE_LDIV_EQ; REAL_LT_MUL;
 731      REAL_ABS_INV; NORM_POS_LT; REAL_ABS_MUL; REAL_ABS_NORM] THEN
 732   REWRITE_TAC[REAL_MUL_LID; NORM_CAUCHY_SCHWARZ_ABS]);;
 733
 734 let NORM_TRIANGLE = prove
 735  (`!x y. norm(x + y) <= norm(x) + norm(y)`,
 736   REPEAT GEN_TAC THEN REWRITE_TAC[vector_norm] THEN
 737   MATCH_MP_TAC REAL_LE_LSQRT THEN
 738   SIMP_TAC[GSYM vector_norm; DOT_POS_LE; NORM_POS_LE; REAL_LE_ADD] THEN
 739   REWRITE_TAC[DOT_LADD; DOT_RADD; REAL_POW_2; GSYM NORM_POW_2] THEN
 740   SIMP_TAC[NORM_CAUCHY_SCHWARZ; DOT_SYM; REAL_ARITH
 741    `d <= x * y ==> (x * x + d) + (d + y * y) <= (x + y) * (x + y)`]);;
 742
 743 let NORM_TRIANGLE_SUB = prove
 744  (`!x y:real^N. norm(x) <= norm(y) + norm(x - y)`,
 745   MESON_TAC[NORM_TRIANGLE; VECTOR_SUB_ADD2]);;
 746
 747 let NORM_TRIANGLE_LE = prove
 748  (`!x y. norm(x) + norm(y) <= e ==> norm(x + y) <= e`,
 749   MESON_TAC[REAL_LE_TRANS; NORM_TRIANGLE]);;
 750
 751 let NORM_TRIANGLE_LT = prove
 752  (`!x y. norm(x) + norm(y) < e ==> norm(x + y) < e`,
 753   MESON_TAC[REAL_LET_TRANS; NORM_TRIANGLE]);;
 754
 755 let COMPONENT_LE_NORM = prove
 756  (`!x:real^N i. abs(x$i) <= norm x`,
 757   REPEAT GEN_TAC THEN SUBGOAL_THEN
 758   `?k. 1 <= k /\ k <= dimindex(:N) /\ !x:real^N. x$i = x$k`
 759   STRIP_ASSUME_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN
 760   ASM_REWRITE_TAC[] THEN REWRITE_TAC[vector_norm] THEN
 761   MATCH_MP_TAC REAL_LE_RSQRT THEN REWRITE_TAC[GSYM REAL_ABS_POW] THEN
 762   REWRITE_TAC[real_abs; REAL_POW_2; REAL_LE_SQUARE] THEN
 763   SUBGOAL_THEN
 764    `x$k * (x:real^N)$k =
 765      sum(1..dimindex(:N)) (\i. if i = k then x$k * x$k else &0)`
 766   SUBST1_TAC THENL
 767    [REWRITE_TAC[SUM_DELTA] THEN ASM_REWRITE_TAC[IN_NUMSEG]; ALL_TAC] THEN
 768   REWRITE_TAC[dot] THEN MATCH_MP_TAC SUM_LE THEN
 769   REWRITE_TAC[FINITE_NUMSEG] THEN
 770   REPEAT STRIP_TAC THEN COND_CASES_TAC THEN
 771   ASM_REWRITE_TAC[REAL_LE_REFL; REAL_LE_SQUARE]);;
 772
 773 let NORM_BOUND_COMPONENT_LE = prove
 774  (`!x:real^N e. norm(x) <= e
 775                 ==> !i. 1 <= i /\ i <= dimindex(:N) ==> abs(x$i) <= e`,
 776   MESON_TAC[COMPONENT_LE_NORM; REAL_LE_TRANS]);;
 777
 778 let NORM_BOUND_COMPONENT_LT = prove
 779  (`!x:real^N e. norm(x) < e
 780                 ==> !i. 1 <= i /\ i <= dimindex(:N) ==> abs(x$i) < e`,
 781   MESON_TAC[COMPONENT_LE_NORM; REAL_LET_TRANS]);;
 782
 783 let NORM_LE_L1 = prove
 784  (`!x:real^N. norm x <= sum(1..dimindex(:N)) (\i. abs(x$i))`,
 785   REPEAT GEN_TAC THEN REWRITE_TAC[vector_norm; dot] THEN
 786   MATCH_MP_TAC REAL_LE_LSQRT THEN REWRITE_TAC[REAL_POW_2] THEN
 787   SIMP_TAC[SUM_POS_LE; FINITE_NUMSEG; REAL_LE_SQUARE; REAL_ABS_POS] THEN
 788   SPEC_TAC(`dimindex(:N)`,`n:num`) THEN INDUCT_TAC THEN
 789   REWRITE_TAC[SUM_CLAUSES_NUMSEG; ARITH_EQ; ARITH_RULE `1 <= SUC n`] THEN
 790   SIMP_TAC[REAL_MUL_LZERO; REAL_LE_REFL] THEN
 791   MATCH_MP_TAC(REAL_ARITH
 792    `a2 <= a * a /\ &0 <= a * b /\ b2 <= b * b
 793     ==> a2 + b2 <= (a + b) * (a + b)`) THEN
 794   ASM_SIMP_TAC[SUM_POS_LE; REAL_LE_MUL; REAL_ABS_POS; FINITE_NUMSEG] THEN
 795   REWRITE_TAC[GSYM REAL_ABS_MUL] THEN REAL_ARITH_TAC);;
 796
 797 let REAL_ABS_SUB_NORM = prove
 798  (`abs(norm(x) - norm(y)) <= norm(x - y)`,
 799   REWRITE_TAC[REAL_ARITH `abs(x - y) <= a <=> x <= y + a /\ y <= x + a`] THEN
 800   MESON_TAC[NORM_TRIANGLE_SUB; NORM_SUB]);;
 801
 802 let NORM_LE = prove
 803  (`!x y. norm(x) <= norm(y) <=> x dot x <= y dot y`,
 804   REWRITE_TAC[vector_norm] THEN MESON_TAC[SQRT_MONO_LE_EQ; DOT_POS_LE]);;
 805
 806 let NORM_LT = prove
 807  (`!x y. norm(x) < norm(y) <=> x dot x < y dot y`,
 808   REWRITE_TAC[vector_norm] THEN MESON_TAC[SQRT_MONO_LT_EQ; DOT_POS_LE]);;
 809
 810 let NORM_EQ = prove
 811  (`!x y. (norm x = norm y) <=> (x dot x = y dot y)`,
 812   REWRITE_TAC[GSYM REAL_LE_ANTISYM; NORM_LE]);;
 813
 814 let NORM_EQ_1 = prove
 815  (`!x. norm(x) = &1 <=> x dot x = &1`,
 816   GEN_TAC THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM SQRT_1] THEN
 817   SIMP_TAC[vector_norm; SQRT_INJ; DOT_POS_LE; REAL_POS]);;
 818
 819 let NORM_LE_COMPONENTWISE = prove
 820  (`!x:real^N y:real^N.
 821         (!i. 1 <= i /\ i <= dimindex(:N) ==> abs(x$i) <= abs(y$i))
 822         ==> norm(x) <= norm(y)`,
 823   REPEAT STRIP_TAC THEN REWRITE_TAC[NORM_LE; dot] THEN
 824   MATCH_MP_TAC SUM_LE_NUMSEG THEN
 825   ASM_SIMP_TAC[GSYM REAL_POW_2; GSYM REAL_LE_SQUARE_ABS]);;
 826
 827 let L1_LE_NORM = prove
 828  (`!x:real^N.
 829     sum(1..dimindex(:N)) (\i. abs(x$i)) <= sqrt(&(dimindex(:N))) * norm x`,
 830   let lemma = prove
 831    (`!x n. &n * sum(1..n) (\i. x i pow 2) - (sum(1..n) x) pow 2 =
 832            sum(1..n) (\i. sum(i+1..n) (\j. (x i - x j) pow 2))`,
 833     GEN_TAC THEN CONV_TAC(BINDER_CONV SYM_CONV) THEN INDUCT_TAC THEN
 834     REWRITE_TAC[SUM_CLAUSES_NUMSEG; ARITH; ARITH_RULE `1 <= SUC n`] THEN
 835     CONV_TAC REAL_RAT_REDUCE_CONV THEN
 836     SIMP_TAC[ARITH_RULE `i <= n ==> i + 1 <= SUC n`; SUM_TRIV_NUMSEG;
 837              ARITH_RULE `~(n + 1 <= n)`; ARITH_RULE `n < SUC n + 1`] THEN
 838     ASM_REWRITE_TAC[SUM_ADD_NUMSEG; REAL_ADD_RID] THEN
 839     REWRITE_TAC[REAL_ARITH
 840      `(x - y) pow 2 = (x pow 2 + y pow 2) - &2 * x * y`] THEN
 841     REWRITE_TAC[SUM_ADD_NUMSEG; SUM_SUB_NUMSEG; SUM_LMUL; SUM_RMUL;
 842                 GSYM REAL_OF_NUM_SUC; SUM_CONST_NUMSEG; ADD_SUB] THEN
 843     REAL_ARITH_TAC) in
 844   GEN_TAC THEN
 845   MATCH_MP_TAC(REAL_ARITH `&0 <= y /\ abs x <= abs y ==> x <= y`) THEN
 846   SIMP_TAC[REAL_LE_MUL; NORM_POS_LE; SQRT_POS_LE; REAL_POS] THEN
 847   REWRITE_TAC[REAL_LE_SQUARE_ABS; REAL_POW_MUL] THEN
 848   SIMP_TAC[SQRT_POW_2; REAL_POS; NORM_POW_2; dot] THEN
 849   REWRITE_TAC[GSYM REAL_POW_2] THEN
 850   GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [GSYM REAL_POW2_ABS] THEN
 851   ONCE_REWRITE_TAC[GSYM REAL_SUB_LE] THEN REWRITE_TAC[lemma] THEN
 852   SIMP_TAC[SUM_POS_LE_NUMSEG; REAL_LE_POW_2]);;
 853
 854 (* ------------------------------------------------------------------------- *)
 855 (* Squaring equations and inequalities involving norms.                      *)
 856 (* ------------------------------------------------------------------------- *)
 857
 858 let DOT_SQUARE_NORM = prove
 859  (`!x. x dot x = norm(x) pow 2`,
 860   SIMP_TAC[vector_norm; SQRT_POW_2; DOT_POS_LE]);;
 861
 862 let NORM_EQ_SQUARE = prove
 863  (`!x:real^N. norm(x) = a <=> &0 <= a /\ x dot x = a pow 2`,
 864   REWRITE_TAC[DOT_SQUARE_NORM] THEN
 865   ONCE_REWRITE_TAC[REAL_RING `x pow 2 = a pow 2 <=> x = a \/ x + a = &0`] THEN
 866   GEN_TAC THEN MP_TAC(ISPEC `x:real^N` NORM_POS_LE) THEN REAL_ARITH_TAC);;
 867
 868 let NORM_LE_SQUARE = prove
 869  (`!x:real^N. norm(x) <= a <=> &0 <= a /\ x dot x <= a pow 2`,
 870   REWRITE_TAC[DOT_SQUARE_NORM; GSYM REAL_LE_SQUARE_ABS] THEN
 871   GEN_TAC THEN MP_TAC(ISPEC `x:real^N` NORM_POS_LE) THEN REAL_ARITH_TAC);;
 872
 873 let NORM_GE_SQUARE = prove
 874  (`!x:real^N. norm(x) >= a <=> a <= &0 \/ x dot x >= a pow 2`,
 875   REWRITE_TAC[real_ge; DOT_SQUARE_NORM; GSYM REAL_LE_SQUARE_ABS] THEN
 876   GEN_TAC THEN MP_TAC(ISPEC `x:real^N` NORM_POS_LE) THEN REAL_ARITH_TAC);;
 877
 878 let NORM_LT_SQUARE = prove
 879  (`!x:real^N. norm(x) < a <=> &0 < a /\ x dot x < a pow 2`,
 880   REWRITE_TAC[REAL_ARITH `x < a <=> ~(x >= a)`; NORM_GE_SQUARE] THEN
 881   REAL_ARITH_TAC);;
 882
 883 let NORM_GT_SQUARE = prove
 884  (`!x:real^N. norm(x) > a <=> a < &0 \/ x dot x > a pow 2`,
 885   REWRITE_TAC[REAL_ARITH `x > a <=> ~(x <= a)`; NORM_LE_SQUARE] THEN
 886   REAL_ARITH_TAC);;
 887
 888 let NORM_LT_SQUARE_ALT = prove
 889  (`!x:real^N. norm(x) < a <=> &0 <= a /\ x dot x < a pow 2`,
 890   REWRITE_TAC[REAL_ARITH `x < a <=> ~(x >= a)`; NORM_GE_SQUARE] THEN
 891   REPEAT GEN_TAC THEN ASM_CASES_TAC `a = &0` THENL
 892    [ASM_REWRITE_TAC[real_ge] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN
 893     REWRITE_TAC[DOT_POS_LE];
 894     ASM_REAL_ARITH_TAC]);;
 895
 896 (* ------------------------------------------------------------------------- *)
 897 (* General linear decision procedure for normed spaces.                      *)
 898 (* ------------------------------------------------------------------------- *)
 899
 900 let NORM_ARITH =
 901   let find_normedterms =
 902     let augment_norm b tm acc =
 903       match tm with
 904         Comb(Const("vector_norm",_),v) -> insert (b,v) acc
 905       | _ -> acc in
 906     let rec find_normedterms tm acc =
 907       match tm with
 908         Comb(Comb(Const("real_add",_),l),r) ->
 909             find_normedterms l (find_normedterms r acc)
 910       | Comb(Comb(Const("real_mul",_),c),n) ->
 911             if not (is_ratconst c) then acc else
 912             augment_norm (rat_of_term c >=/ Int 0) n acc
 913       | _ -> augment_norm true tm acc in
 914     find_normedterms in
 915   let lincomb_neg t = mapf minus_num t in
 916   let lincomb_cmul c t = if c =/ Int 0 then undefined else mapf (( */ ) c) t in
 917   let lincomb_add l r = combine (+/) (fun x -> x =/ Int 0) l r in
 918   let lincomb_sub l r = lincomb_add l (lincomb_neg r) in
 919   let lincomb_eq l r = lincomb_sub l r = undefined in
 920   let rec vector_lincomb tm =
 921     match tm with
 922         Comb(Comb(Const("vector_add",_),l),r) ->
 923           lincomb_add (vector_lincomb l) (vector_lincomb r)
 924       | Comb(Comb(Const("vector_sub",_),l),r) ->
 925           lincomb_sub (vector_lincomb l) (vector_lincomb r)
 926       | Comb(Comb(Const("%",_),l),r) ->
 927           lincomb_cmul (rat_of_term l) (vector_lincomb r)
 928       | Comb(Const("vector_neg",_),t) ->
 929           lincomb_neg (vector_lincomb t)
 930       | Comb(Const("vec",_),n) when is_numeral n & dest_numeral n =/ Int 0 ->
 931           undefined
 932       | _ -> (tm |=> Int 1) in
 933   let vector_lincombs tms =
 934     itlist (fun t fns ->
 935                   if can (assoc t) fns then fns else
 936                   let f = vector_lincomb t in
 937                   try let _,f' = find (fun (_,f') -> lincomb_eq f f') fns in
 938                       (t,f')::fns
 939                   with Failure _ -> (t,f)::fns) tms [] in
 940   let rec replacenegnorms fn tm =
 941     match tm with
 942       Comb(Comb(Const("real_add",_),l),r) ->
 943           BINOP_CONV (replacenegnorms fn) tm
 944     | Comb(Comb(Const("real_mul",_),c),n) when rat_of_term c </ Int 0 ->
 945           RAND_CONV fn tm
 946     | _ -> REFL tm in
 947   let flip v eq =
 948     if defined eq v then (v |-> minus_num(apply eq v)) eq else eq in
 949   let rec allsubsets s =
 950     match s with
 951       [] -> [[]]
 952     | (a::t) -> let res = allsubsets t in
 953                 map (fun b -> a::b) res @ res in
 954   let evaluate env lin =
 955     foldr (fun x c s -> s +/ c */ apply env x) lin (Int 0) in
 956   let rec solve (vs,eqs) =
 957     match (vs,eqs) with
 958       [],[] -> (0 |=> Int 1)
 959     | _,eq::oeqs ->
 960           let v = hd(intersect vs (dom eq)) in
 961           let c = apply eq v in
 962           let vdef = lincomb_cmul (Int(-1) // c) eq in
 963           let eliminate eqn =
 964             if not(defined eqn v) then eqn else
 965             lincomb_add (lincomb_cmul (apply eqn v) vdef) eqn in
 966           let soln = solve (subtract vs [v],map eliminate oeqs) in
 967           (v |-> evaluate soln (undefine v vdef)) soln in
 968   let rec combinations k l =
 969     if k = 0 then [[]] else
 970     match l with
 971       [] -> []
 972     | h::t -> map (fun c -> h::c) (combinations (k - 1) t) @
 973               combinations k t in
 974   let vertices vs eqs =
 975     let vertex cmb =
 976       let soln = solve(vs,cmb) in
 977       map (fun v -> tryapplyd soln v (Int 0)) vs in
 978     let rawvs = mapfilter vertex (combinations (length vs) eqs) in
 979     let unset = filter (forall (fun c -> c >=/ Int 0)) rawvs in
 980     itlist (insert' (forall2 (=/))) unset [] in
 981   let subsumes l m = forall2 (fun x y -> abs_num x <=/ abs_num y) l m in
 982   let rec subsume todo dun =
 983     match todo with
 984       [] -> dun
 985     | v::ovs -> let dun' = if exists (fun w -> subsumes w v) dun then dun
 986                            else v::(filter (fun w -> not(subsumes v w)) dun) in
 987                 subsume ovs dun' in
 988   let NORM_CMUL_RULE =
 989     let MATCH_pth = (MATCH_MP o prove)
 990      (`!b x. b >= norm(x) ==> !c. abs(c) * b >= norm(c % x)`,
 991       SIMP_TAC[NORM_MUL; real_ge; REAL_LE_LMUL; REAL_ABS_POS]) in
 992     fun c th -> ISPEC(term_of_rat c) (MATCH_pth th) in
 993   let NORM_ADD_RULE =
 994     let MATCH_pth = (MATCH_MP o prove)
 995      (`!b1 b2 x1 x2. b1 >= norm(x1) /\ b2 >= norm(x2)
 996                      ==> b1 + b2 >= norm(x1 + x2)`,
 997       REWRITE_TAC[real_ge] THEN REPEAT STRIP_TAC THEN
 998       MATCH_MP_TAC NORM_TRIANGLE_LE THEN ASM_SIMP_TAC[REAL_LE_ADD2]) in
 999     fun th1 th2 -> MATCH_pth (CONJ th1 th2) in
1000   let INEQUALITY_CANON_RULE =
1001     CONV_RULE(LAND_CONV REAL_POLY_CONV) o
1002     CONV_RULE(LAND_CONV REAL_RAT_REDUCE_CONV) o
1003     GEN_REWRITE_RULE I [REAL_ARITH `s >= t <=> s - t >= &0`] in
1004   let NORM_CANON_CONV =
1005     let APPLY_pth1 = GEN_REWRITE_CONV I
1006      [VECTOR_ARITH `x:real^N = &1 % x`]
1007     and APPLY_pth2 = GEN_REWRITE_CONV I
1008      [VECTOR_ARITH `x - y:real^N = x + --y`]
1009     and APPLY_pth3 = GEN_REWRITE_CONV I
1010      [VECTOR_ARITH `--x:real^N = -- &1 % x`]
1011     and APPLY_pth4 = GEN_REWRITE_CONV I
1012      [VECTOR_ARITH `&0 % x:real^N = vec 0`;
1013       VECTOR_ARITH `c % vec 0:real^N = vec 0`]
1014     and APPLY_pth5 = GEN_REWRITE_CONV I
1015      [VECTOR_ARITH `c % (d % x) = (c * d) % x`]
1016     and APPLY_pth6 = GEN_REWRITE_CONV I
1017      [VECTOR_ARITH `c % (x + y) = c % x + c % y`]
1018     and APPLY_pth7 = GEN_REWRITE_CONV I
1019      [VECTOR_ARITH `vec 0 + x = x`;
1020       VECTOR_ARITH `x + vec 0 = x`]
1021     and APPLY_pth8 =
1022      GEN_REWRITE_CONV I [VECTOR_ARITH `c % x + d % x = (c + d) % x`] THENC
1023      LAND_CONV REAL_RAT_ADD_CONV THENC
1024      GEN_REWRITE_CONV TRY_CONV [VECTOR_ARITH `&0 % x = vec 0`]
1025     and APPLY_pth9 =
1026      GEN_REWRITE_CONV I
1027       [VECTOR_ARITH `(c % x + z) + d % x = (c + d) % x + z`;
1028        VECTOR_ARITH `c % x + (d % x + z) = (c + d) % x + z`;
1029        VECTOR_ARITH `(c % x + w) + (d % x + z) = (c + d) % x + (w + z)`] THENC
1030      LAND_CONV(LAND_CONV REAL_RAT_ADD_CONV)
1031     and APPLY_ptha =
1032      GEN_REWRITE_CONV I [VECTOR_ARITH `&0 % x + y = y`]
1033     and APPLY_pthb =
1034      GEN_REWRITE_CONV I
1035       [VECTOR_ARITH `c % x + d % y = c % x + d % y`;
1036        VECTOR_ARITH `(c % x + z) + d % y = c % x + (z + d % y)`;
1037        VECTOR_ARITH `c % x + (d % y + z) = c % x + (d % y + z)`;
1038        VECTOR_ARITH `(c % x + w) + (d % y + z) = c % x + (w + (d % y + z))`]
1039     and APPLY_pthc =
1040      GEN_REWRITE_CONV I
1041       [VECTOR_ARITH `c % x + d % y = d % y + c % x`;
1042        VECTOR_ARITH `(c % x + z) + d % y = d % y + (c % x + z)`;
1043        VECTOR_ARITH `c % x + (d % y + z) = d % y + (c % x + z)`;
1044        VECTOR_ARITH `(c % x + w) + (d % y + z) = d % y + ((c % x + w) + z)`]
1045     and APPLY_pthd =
1046      GEN_REWRITE_CONV TRY_CONV
1047       [VECTOR_ARITH `x + vec 0 = x`] in
1048     let headvector tm =
1049       match tm with
1050         Comb(Comb(Const("vector_add",_),Comb(Comb(Const("%",_),l),v)),r) -> v
1051       | Comb(Comb(Const("%",_),l),v) -> v
1052       | _ -> failwith "headvector: non-canonical term" in
1053     let rec VECTOR_CMUL_CONV tm =
1054      ((APPLY_pth5 THENC LAND_CONV REAL_RAT_MUL_CONV) ORELSEC
1055       (APPLY_pth6 THENC BINOP_CONV VECTOR_CMUL_CONV)) tm
1056     and VECTOR_ADD_CONV tm =
1057       try APPLY_pth7 tm with Failure _ ->
1058       try APPLY_pth8 tm with Failure _ ->
1059       match tm with
1060         Comb(Comb(Const("vector_add",_),lt),rt) ->
1061           let l = headvector lt and r = headvector rt in
1062           if l < r then (APPLY_pthb THENC
1063                          RAND_CONV VECTOR_ADD_CONV THENC
1064                          APPLY_pthd) tm
1065           else if r < l then (APPLY_pthc THENC
1066                               RAND_CONV VECTOR_ADD_CONV THENC
1067                               APPLY_pthd) tm else
1068           (APPLY_pth9 THENC
1069             ((APPLY_ptha THENC VECTOR_ADD_CONV) ORELSEC
1070              RAND_CONV VECTOR_ADD_CONV THENC
1071              APPLY_pthd)) tm
1072       | _ -> REFL tm in
1073     let rec VECTOR_CANON_CONV tm =
1074       match tm with
1075         Comb(Comb(Const("vector_add",_),l),r) ->
1076           let lth = VECTOR_CANON_CONV l and rth = VECTOR_CANON_CONV r in
1077           let th = MK_COMB(AP_TERM (rator(rator tm)) lth,rth) in
1078           CONV_RULE (RAND_CONV VECTOR_ADD_CONV) th
1079       | Comb(Comb(Const("%",_),l),r) ->
1080           let rth = AP_TERM (rator tm) (VECTOR_CANON_CONV r) in
1081           CONV_RULE (RAND_CONV(APPLY_pth4 ORELSEC VECTOR_CMUL_CONV)) rth
1082       | Comb(Comb(Const("vector_sub",_),l),r) ->
1083           (APPLY_pth2 THENC VECTOR_CANON_CONV) tm
1084       | Comb(Const("vector_neg",_),t) ->
1085           (APPLY_pth3 THENC VECTOR_CANON_CONV) tm
1086       | Comb(Const("vec",_),n) when is_numeral n & dest_numeral n =/ Int 0 ->
1087           REFL tm
1088       | _ -> APPLY_pth1 tm in
1089     fun tm ->
1090       match tm with
1091        Comb(Const("vector_norm",_),e) -> RAND_CONV VECTOR_CANON_CONV tm
1092       | _ -> failwith "NORM_CANON_CONV" in
1093   let REAL_VECTOR_COMBO_PROVER =
1094     let pth_zero = prove(`norm(vec 0:real^N) = &0`,REWRITE_TAC[NORM_0])
1095     and tv_n = mk_vartype "N" in
1096     fun translator (nubs,ges,gts) ->
1097       let sources = map (rand o rand o concl) nubs
1098       and rawdests = itlist (find_normedterms o lhand o concl) (ges @ gts) [] in
1099       if not (forall fst rawdests) then failwith "Sanity check" else
1100       let dests = setify (map snd rawdests) in
1101       let srcfuns = map vector_lincomb sources
1102       and destfuns = map vector_lincomb dests in
1103       let vvs = itlist (union o dom) (srcfuns @ destfuns) [] in
1104       let n = length srcfuns in
1105       let nvs = 1--n in
1106       let srccombs = zip srcfuns nvs in
1107       let consider d =
1108         let coefficients x =
1109             let inp = if defined d x then 0 |=> minus_num(apply d x)
1110                       else undefined in
1111           itlist (fun (f,v) g -> if defined f x then (v |-> apply f x) g else g)
1112                  srccombs inp in
1113         let equations = map coefficients vvs
1114         and inequalities = map (fun n -> (n |=> Int 1)) nvs in
1115         let plausiblevertices f =
1116           let flippedequations = map (itlist flip f) equations in
1117           let constraints = flippedequations @ inequalities in
1118           let rawverts = vertices nvs constraints in
1119           let check_solution v =
1120             let f = itlist2 (|->) nvs v (0 |=> Int 1) in
1121             forall (fun e -> evaluate f e =/ Int 0) flippedequations in
1122           let goodverts = filter check_solution rawverts in
1123           let signfixups = map (fun n -> if mem n f then -1 else 1) nvs in
1124           map (map2 (fun s c -> Int s */ c) signfixups) goodverts in
1125         let allverts = itlist (@) (map plausiblevertices (allsubsets nvs)) [] in
1126         subsume allverts [] in
1127       let compute_ineq v =
1128         let ths = mapfilter (fun (v,t) -> if v =/ Int 0 then fail()
1129                                           else  NORM_CMUL_RULE v t)
1130                             (zip v nubs) in
1131         INEQUALITY_CANON_RULE (end_itlist NORM_ADD_RULE ths) in
1132       let ges' = mapfilter compute_ineq (itlist ((@) o consider) destfuns []) @
1133                  map INEQUALITY_CANON_RULE nubs @ ges in
1134       let zerodests = filter
1135         (fun t -> dom(vector_lincomb t) = []) (map snd rawdests) in
1136       REAL_LINEAR_PROVER translator
1137        (map (fun t -> INST_TYPE [last(snd(dest_type(type_of t))),tv_n] pth_zero)
1138             zerodests,
1139         map (CONV_RULE(ONCE_DEPTH_CONV NORM_CANON_CONV THENC
1140                        LAND_CONV REAL_POLY_CONV)) ges',
1141         map (CONV_RULE(ONCE_DEPTH_CONV NORM_CANON_CONV THENC
1142                        LAND_CONV REAL_POLY_CONV)) gts) in
1143   let REAL_VECTOR_INEQ_PROVER =
1144     let pth = prove
1145      (`norm(x) = n ==> norm(x) >= &0 /\ n >= norm(x)`,
1146       DISCH_THEN(SUBST_ALL_TAC o SYM) THEN
1147       REWRITE_TAC[real_ge; NORM_POS_LE] THEN REAL_ARITH_TAC) in
1148     let NORM_MP = MATCH_MP pth in
1149     fun translator (ges,gts) ->
1150     let ntms = itlist find_normedterms (map (lhand o concl) (ges @ gts)) [] in
1151     let lctab = vector_lincombs (map snd (filter (not o fst) ntms)) in
1152     let asl = map (fun (t,_) ->
1153        ASSUME(mk_eq(mk_icomb(mk_const("vector_norm",[]),t),
1154                     genvar `:real`))) lctab in
1155     let replace_conv = GEN_REWRITE_CONV TRY_CONV asl in
1156     let replace_rule = CONV_RULE (LAND_CONV (replacenegnorms replace_conv)) in
1157     let ges' =
1158        itlist (fun th ths -> CONJUNCT1(NORM_MP th)::ths)
1159               asl (map replace_rule ges)
1160     and gts' = map replace_rule gts
1161     and nubs = map (CONJUNCT2 o NORM_MP) asl in
1162     let th1 = REAL_VECTOR_COMBO_PROVER translator (nubs,ges',gts') in
1163     let th2 = INST
1164      (map (fun th -> let l,r = dest_eq(concl th) in (l,r)) asl) th1 in
1165     itlist PROVE_HYP (map (REFL o lhand o concl) asl) th2 in
1166   let REAL_VECTOR_PROVER =
1167     let rawrule =
1168       GEN_REWRITE_RULE I [REAL_ARITH `x = &0 <=> x >= &0 /\ --x >= &0`] in
1169     let splitequation th acc =
1170       let th1,th2 = CONJ_PAIR(rawrule th) in
1171       th1::CONV_RULE(LAND_CONV REAL_POLY_NEG_CONV) th2::acc in
1172     fun translator (eqs,ges,gts) ->
1173       REAL_VECTOR_INEQ_PROVER translator
1174          (itlist splitequation eqs ges,gts) in
1175   let pth = prove
1176    (`(!x y:real^N. x = y <=> norm(x - y) <= &0) /\
1177      (!x y:real^N. ~(x = y) <=> ~(norm(x - y) <= &0))`,
1178     REWRITE_TAC[NORM_LE_0; VECTOR_SUB_EQ]) in
1179   let conv1 = GEN_REWRITE_CONV TRY_CONV [pth] in
1180   let conv2 tm = (conv1 tm,conv1(mk_neg tm)) in
1181   let init = GEN_REWRITE_CONV ONCE_DEPTH_CONV [DECIMAL] THENC
1182              REAL_RAT_REDUCE_CONV THENC
1183              GEN_REWRITE_CONV ONCE_DEPTH_CONV [dist] THENC
1184              GEN_NNF_CONV true (conv1,conv2)
1185   and pure = GEN_REAL_ARITH REAL_VECTOR_PROVER in
1186   fun tm -> let th = init tm in EQ_MP (SYM th) (pure(rand(concl th)));;
1187
1188 let NORM_ARITH_TAC = CONV_TAC NORM_ARITH;;
1189
1190 let ASM_NORM_ARITH_TAC =
1191   REPEAT(FIRST_X_ASSUM(MP_TAC o check (not o is_forall o concl))) THEN
1192   NORM_ARITH_TAC;;
1193
1194 (* ------------------------------------------------------------------------- *)
1195 (* Dot product in terms of the norm rather than conversely.                  *)
1196 (* ------------------------------------------------------------------------- *)
1197
1198 let DOT_NORM = prove
1199  (`!x y. x dot y = (norm(x + y) pow 2 - norm(x) pow 2 - norm(y) pow 2) / &2`,
1200   REWRITE_TAC[NORM_POW_2; DOT_LADD; DOT_RADD; DOT_SYM] THEN REAL_ARITH_TAC);;
1201
1202 let DOT_NORM_NEG = prove
1203  (`!x y. x dot y = ((norm(x) pow 2 + norm(y) pow 2) - norm(x - y) pow 2) / &2`,
1204   REWRITE_TAC[NORM_POW_2; DOT_LADD; DOT_RADD; DOT_LSUB; DOT_RSUB; DOT_SYM] THEN
1205   REAL_ARITH_TAC);;
1206
1207 let DOT_NORM_SUB = prove
1208  (`!x y. x dot y = ((norm(x) pow 2 + norm(y) pow 2) - norm(x - y) pow 2) / &2`,
1209   REWRITE_TAC[NORM_POW_2; DOT_LSUB; DOT_RSUB; DOT_SYM] THEN REAL_ARITH_TAC);;
1210
1211 (* ------------------------------------------------------------------------- *)
1212 (* Equality of vectors in terms of dot products.                             *)
1213 (* ------------------------------------------------------------------------- *)
1214
1215 let VECTOR_EQ = prove
1216  (`!x y. (x = y) <=> (x dot x = x dot y) /\ (y dot y = x dot x)`,
1217   REPEAT GEN_TAC THEN EQ_TAC THENL [SIMP_TAC[]; ALL_TAC] THEN
1218   ONCE_REWRITE_TAC[GSYM VECTOR_SUB_EQ] THEN
1219   REWRITE_TAC[GSYM DOT_EQ_0] THEN
1220   SIMP_TAC[DOT_LSUB; DOT_RSUB; DOT_SYM] THEN REAL_ARITH_TAC);;
1221
1222 (* ------------------------------------------------------------------------- *)
1223 (* Hence more metric properties.                                             *)
1224 (* ------------------------------------------------------------------------- *)
1225
1226 let DIST_REFL = prove
1227  (`!x. dist(x,x) = &0`,
1228   NORM_ARITH_TAC);;
1229
1230 let DIST_SYM = prove
1231  (`!x y. dist(x,y) = dist(y,x)`,
1232   NORM_ARITH_TAC);;
1233
1234 let DIST_POS_LE = prove
1235  (`!x y. &0 <= dist(x,y)`,
1236   NORM_ARITH_TAC);;
1237
1238 let DIST_TRIANGLE = prove
1239  (`!x:real^N y z. dist(x,z) <= dist(x,y) + dist(y,z)`,
1240   NORM_ARITH_TAC);;
1241
1242 let DIST_TRIANGLE_ALT = prove
1243  (`!x y z. dist(y,z) <= dist(x,y) + dist(x,z)`,
1244   NORM_ARITH_TAC);;
1245
1246 let DIST_EQ_0 = prove
1247  (`!x y. (dist(x,y) = &0) <=> (x = y)`,
1248   NORM_ARITH_TAC);;
1249
1250 let DIST_POS_LT = prove
1251  (`!x y. ~(x = y) ==> &0 < dist(x,y)`,
1252   NORM_ARITH_TAC);;
1253
1254 let DIST_NZ = prove
1255  (`!x y. ~(x = y) <=> &0 < dist(x,y)`,
1256   NORM_ARITH_TAC);;
1257
1258 let DIST_TRIANGLE_LE = prove
1259  (`!x y z e. dist(x,z) + dist(y,z) <= e ==> dist(x,y) <= e`,
1260   NORM_ARITH_TAC);;
1261
1262 let DIST_TRIANGLE_LT = prove
1263  (`!x y z e. dist(x,z) + dist(y,z) < e ==> dist(x,y) < e`,
1264   NORM_ARITH_TAC);;
1265
1266 let DIST_TRIANGLE_HALF_L = prove
1267  (`!x1 x2 y. dist(x1,y) < e / &2 /\ dist(x2,y) < e / &2 ==> dist(x1,x2) < e`,
1268   NORM_ARITH_TAC);;
1269
1270 let DIST_TRIANGLE_HALF_R = prove
1271  (`!x1 x2 y. dist(y,x1) < e / &2 /\ dist(y,x2) < e / &2 ==> dist(x1,x2) < e`,
1272   NORM_ARITH_TAC);;
1273
1274 let DIST_TRIANGLE_ADD = prove
1275  (`!x x' y y'. dist(x + y,x' + y') <= dist(x,x') + dist(y,y')`,
1276   NORM_ARITH_TAC);;
1277
1278 let DIST_MUL = prove
1279  (`!x y c. dist(c % x,c % y) = abs(c) * dist(x,y)`,
1280   REWRITE_TAC[dist; GSYM VECTOR_SUB_LDISTRIB; NORM_MUL]);;
1281
1282 let DIST_TRIANGLE_ADD_HALF = prove
1283  (`!x x' y y':real^N.
1284     dist(x,x') < e / &2 /\ dist(y,y') < e / &2 ==> dist(x + y,x' + y') < e`,
1285   NORM_ARITH_TAC);;
1286
1287 let DIST_LE_0 = prove
1288  (`!x y. dist(x,y) <= &0 <=> x = y`,
1289   NORM_ARITH_TAC);;
1290
1291 let DIST_EQ = prove
1292  (`!w x y z. dist(w,x) = dist(y,z) <=> dist(w,x) pow 2 = dist(y,z) pow 2`,
1293   REWRITE_TAC[dist; NORM_POW_2; NORM_EQ]);;
1294
1295 let DIST_0 = prove
1296  (`!x. dist(x,vec 0) = norm(x) /\ dist(vec 0,x) = norm(x)`,
1297   NORM_ARITH_TAC);;
1298
1299 (* ------------------------------------------------------------------------- *)
1300 (* Sums of vectors.                                                          *)
1301 (* ------------------------------------------------------------------------- *)
1302
1303 let NEUTRAL_VECTOR_ADD = prove
1304  (`neutral(+) = vec 0:real^N`,
1305   REWRITE_TAC[neutral] THEN MATCH_MP_TAC SELECT_UNIQUE THEN
1306   REWRITE_TAC[VECTOR_ARITH `x + y = y <=> x = vec 0`;
1307               VECTOR_ARITH `x + y = x <=> y = vec 0`]);;
1308
1309 let MONOIDAL_VECTOR_ADD = prove
1310  (`monoidal((+):real^N->real^N->real^N)`,
1311   REWRITE_TAC[monoidal; NEUTRAL_VECTOR_ADD] THEN
1312   REPEAT CONJ_TAC THEN VECTOR_ARITH_TAC);;
1313
1314 let vsum = new_definition
1315   `(vsum:(A->bool)->(A->real^N)->real^N) s f = lambda i. sum s (\x. f(x)$i)`;;
1316
1317 let VSUM_CLAUSES = prove
1318  (`(!f. vsum {} f = vec 0) /\
1319    (!x f s. FINITE s
1320             ==> (vsum (x INSERT s) f =
1321                  if x IN s then vsum s f else f(x) + vsum s f))`,
1322   SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA; VECTOR_ADD_COMPONENT; SUM_CLAUSES] THEN
1323   SIMP_TAC[VEC_COMPONENT] THEN REPEAT STRIP_TAC THEN
1324   COND_CASES_TAC THEN ASM_SIMP_TAC[LAMBDA_BETA; VECTOR_ADD_COMPONENT]);;
1325
1326 let VSUM = prove
1327  (`!f s. FINITE s ==> vsum s f = iterate (+) s f`,
1328   GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
1329   ASM_SIMP_TAC[VSUM_CLAUSES; ITERATE_CLAUSES; MONOIDAL_VECTOR_ADD] THEN
1330   REWRITE_TAC[NEUTRAL_VECTOR_ADD]);;
1331
1332 let VSUM_EQ_0 = prove
1333  (`!f s. (!x:A. x IN s ==> (f(x) = vec 0)) ==> (vsum s f = vec 0)`,
1334   SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA; vec; SUM_EQ_0]);;
1335
1336 let VSUM_0 = prove
1337  (`vsum s (\x. vec 0) = vec 0`,
1338   SIMP_TAC[VSUM_EQ_0]);;
1339
1340 let VSUM_LMUL = prove
1341  (`!f c s.  vsum s (\x. c % f(x)) = c % vsum s f`,
1342   SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA; VECTOR_MUL_COMPONENT; SUM_LMUL]);;
1343
1344 let VSUM_RMUL = prove
1345  (`!c s v. vsum s (\x. c x % v) = (sum s c) % v`,
1346   SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA; VECTOR_MUL_COMPONENT; SUM_RMUL]);;
1347
1348 let VSUM_ADD = prove
1349  (`!f g s. FINITE s ==> (vsum s (\x. f x + g x) = vsum s f + vsum s g)`,
1350   SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA; VECTOR_ADD_COMPONENT; SUM_ADD]);;
1351
1352 let VSUM_SUB = prove
1353  (`!f g s. FINITE s ==> (vsum s (\x. f x - g x) = vsum s f - vsum s g)`,
1354   SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA; VECTOR_SUB_COMPONENT; SUM_SUB]);;
1355
1356 let VSUM_CONST = prove
1357  (`!c s. FINITE s ==> (vsum s (\n. c) = &(CARD s) % c)`,
1358   SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA; SUM_CONST; VECTOR_MUL_COMPONENT]);;
1359
1360 let VSUM_COMPONENT = prove
1361  (`!s f i. 1 <= i /\ i <= dimindex(:N)
1362            ==> ((vsum s (f:A->real^N))$i = sum s (\x. f(x)$i))`,
1363   SIMP_TAC[vsum; LAMBDA_BETA]);;
1364
1365 let VSUM_IMAGE = prove
1366  (`!f g s. FINITE s /\ (!x y. x IN s /\ y IN s /\ (f x = f y) ==> (x = y))
1367            ==> (vsum (IMAGE f s) g = vsum s (g o f))`,
1368   SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA] THEN REPEAT STRIP_TAC THEN
1369   W(MP_TAC o PART_MATCH (lhs o rand) SUM_IMAGE o lhs o snd) THEN
1370   ASM_REWRITE_TAC[o_DEF]);;
1371
1372 let VSUM_UNION = prove
1373  (`!f s t. FINITE s /\ FINITE t /\ DISJOINT s t
1374            ==> (vsum (s UNION t) f = vsum s f + vsum t f)`,
1375   SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA; SUM_UNION; VECTOR_ADD_COMPONENT]);;
1376
1377 let VSUM_DIFF = prove
1378  (`!f s t. FINITE s /\ t SUBSET s
1379            ==> (vsum (s DIFF t) f = vsum s f - vsum t f)`,
1380   SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA; SUM_DIFF; VECTOR_SUB_COMPONENT]);;
1381
1382 let VSUM_DELETE = prove
1383  (`!f s a. FINITE s /\ a IN s
1384            ==> vsum (s DELETE a) f = vsum s f - f a`,
1385   SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA; SUM_DELETE; VECTOR_SUB_COMPONENT]);;
1386
1387 let VSUM_INCL_EXCL = prove
1388  (`!s t (f:A->real^N).
1389         FINITE s /\ FINITE t
1390         ==> vsum s f + vsum t f = vsum (s UNION t) f + vsum (s INTER t) f`,
1391   SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA; VECTOR_ADD_COMPONENT] THEN
1392   SIMP_TAC[SUM_INCL_EXCL]);;
1393
1394 let VSUM_NEG = prove
1395  (`!f s. vsum s (\x. --f x) = --vsum s f`,
1396   SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA; SUM_NEG; VECTOR_NEG_COMPONENT]);;
1397
1398 let VSUM_EQ = prove
1399  (`!f g s. (!x. x IN s ==> (f x = g x)) ==> (vsum s f = vsum s g)`,
1400   SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA] THEN
1401   REPEAT STRIP_TAC THEN MATCH_MP_TAC SUM_EQ THEN ASM_SIMP_TAC[]);;
1402
1403 let VSUM_SUPERSET = prove
1404  (`!f:A->real^N u v.
1405         u SUBSET v /\ (!x. x IN v /\ ~(x IN u) ==> (f(x) = vec 0))
1406         ==> (vsum v f = vsum u f)`,
1407   SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA; VEC_COMPONENT; SUM_SUPERSET]);;
1408
1409 let VSUM_SUPPORT = prove
1410  (`!f:A->real^N s. vsum {x | x IN s /\ ~(f x = vec 0)} f = vsum s f`,
1411   REPEAT GEN_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC VSUM_SUPERSET THEN
1412   SET_TAC[]);;
1413
1414 let VSUM_EQ_SUPERSET = prove
1415  (`!f s t:A->bool.
1416         FINITE t /\ t SUBSET s /\
1417         (!x. x IN t ==> (f x = g x)) /\
1418         (!x. x IN s /\ ~(x IN t) ==> f(x) = vec 0)
1419         ==> vsum s f = vsum t g`,
1420   MESON_TAC[VSUM_SUPERSET; VSUM_EQ]);;
1421
1422 let VSUM_UNION_RZERO = prove
1423  (`!f:A->real^N u v.
1424         (!x. x IN v /\ ~(x IN u) ==> (f(x) = vec 0))
1425         ==> (vsum (u UNION v) f = vsum u f)`,
1426   REPEAT STRIP_TAC THEN MATCH_MP_TAC VSUM_SUPERSET THEN ASM SET_TAC[]);;
1427
1428 let VSUM_UNION_LZERO = prove
1429  (`!f:A->real^N u v.
1430         (!x. x IN u /\ ~(x IN v) ==> (f(x) = vec 0))
1431         ==> (vsum (u UNION v) f = vsum v f)`,
1432   REPEAT STRIP_TAC THEN MATCH_MP_TAC VSUM_SUPERSET THEN ASM SET_TAC[]);;
1433
1434 let VSUM_RESTRICT = prove
1435  (`!f s. vsum s (\x. if x IN s then f(x) else vec 0) = vsum s f`,
1436   REPEAT GEN_TAC THEN MATCH_MP_TAC VSUM_EQ THEN SIMP_TAC[]);;
1437
1438 let VSUM_RESTRICT_SET = prove
1439  (`!P s f. vsum {x | x IN s /\ P x} f =
1440            vsum s (\x. if P x then f x else vec 0)`,
1441   SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA; VEC_COMPONENT; SUM_RESTRICT_SET;
1442            COND_COMPONENT]);;
1443
1444 let VSUM_CASES = prove
1445  (`!s P f g. FINITE s
1446              ==> vsum s (\x:A. if P x then (f x):real^N else g x) =
1447                  vsum {x | x IN s /\ P x} f + vsum {x | x IN s /\ ~P x} g`,
1448   SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA; VECTOR_ADD_COMPONENT; SUM_CASES;
1449            COND_COMPONENT]);;
1450
1451 let VSUM_SING = prove
1452  (`!f x. vsum {x} f = f(x)`,
1453   SIMP_TAC[VSUM_CLAUSES; FINITE_RULES; NOT_IN_EMPTY; VECTOR_ADD_RID]);;
1454
1455 let VSUM_NORM = prove
1456  (`!f s. FINITE s ==> norm(vsum s f) <= sum s (\x. norm(f x))`,
1457   GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
1458   SIMP_TAC[SUM_CLAUSES; VSUM_CLAUSES; NORM_0; REAL_LE_REFL] THEN
1459   NORM_ARITH_TAC);;
1460
1461 let VSUM_NORM_LE = prove
1462  (`!s f:A->real^N g.
1463         FINITE s /\ (!x. x IN s ==> norm(f x) <= g(x))
1464         ==> norm(vsum s f) <= sum s g`,
1465   REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN
1466   EXISTS_TAC `sum s (\x:A. norm(f x :real^N))` THEN
1467   ASM_SIMP_TAC[VSUM_NORM; SUM_LE]);;
1468
1469 let VSUM_NORM_TRIANGLE = prove
1470  (`!s f b. FINITE s /\ sum s (\a. norm(f a)) <= b ==> norm(vsum s f) <= b`,
1471   MESON_TAC[VSUM_NORM; REAL_LE_TRANS]);;
1472
1473 let VSUM_NORM_BOUND = prove
1474  (`!s f b. FINITE s /\ (!x:A. x IN s ==> norm(f(x)) <= b)
1475            ==> norm(vsum s f) <= &(CARD s) * b`,
1476   SIMP_TAC[GSYM SUM_CONST; VSUM_NORM_LE]);;
1477
1478 let VSUM_CLAUSES_NUMSEG = prove
1479  (`(!m. vsum(m..0) f = if m = 0 then f(0) else vec 0) /\
1480    (!m n. vsum(m..SUC n) f = if m <= SUC n then vsum(m..n) f + f(SUC n)
1481                              else vsum(m..n) f)`,
1482   REWRITE_TAC[NUMSEG_CLAUSES] THEN REPEAT STRIP_TAC THEN
1483   COND_CASES_TAC THEN
1484   ASM_SIMP_TAC[VSUM_SING; VSUM_CLAUSES; FINITE_NUMSEG; IN_NUMSEG] THEN
1485   REWRITE_TAC[ARITH_RULE `~(SUC n <= n)`; VECTOR_ADD_AC]);;
1486
1487 let VSUM_CLAUSES_RIGHT = prove
1488  (`!f m n. 0 < n /\ m <= n ==> vsum(m..n) f = vsum(m..n-1) f + (f n):real^N`,
1489   GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN
1490   SIMP_TAC[LT_REFL; VSUM_CLAUSES_NUMSEG; SUC_SUB1]);;
1491
1492 let VSUM_CMUL_NUMSEG = prove
1493  (`!f c m n. vsum (m..n) (\x. c % f x) = c % vsum (m..n) f`,
1494   SIMP_TAC[VSUM_LMUL; FINITE_NUMSEG]);;
1495
1496 let VSUM_EQ_NUMSEG = prove
1497  (`!f g m n.
1498          (!x. m <= x /\ x <= n ==> (f x = g x))
1499          ==> (vsum(m .. n) f = vsum(m .. n) g)`,
1500   REPEAT STRIP_TAC THEN MATCH_MP_TAC VSUM_EQ THEN
1501   ASM_SIMP_TAC[FINITE_NUMSEG; IN_NUMSEG]);;
1502
1503 let VSUM_IMAGE_GEN = prove
1504  (`!f:A->B g s.
1505         FINITE s
1506         ==> (vsum s g =
1507              vsum (IMAGE f s) (\y. vsum {x | x IN s /\ (f(x) = y)} g))`,
1508   SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA; SUM_IMAGE_GEN]);;
1509
1510 let VSUM_GROUP = prove
1511  (`!f:A->B g s t.
1512         FINITE s /\ IMAGE f s SUBSET t
1513         ==> vsum t (\y. vsum {x | x IN s /\ f(x) = y} g) = vsum s g`,
1514   SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA; SUM_GROUP]);;
1515
1516 let VSUM_VMUL = prove
1517  (`!f v s. (sum s f) % v = vsum s (\x. f(x) % v)`,
1518   REWRITE_TAC[VSUM_RMUL]);;
1519
1520 let VSUM_DELTA = prove
1521  (`!s a. vsum s (\x. if x = a then b else vec 0) =
1522          if a IN s then b else vec 0`,
1523   SIMP_TAC[CART_EQ; LAMBDA_BETA; VSUM_COMPONENT; COND_COMPONENT] THEN
1524   SIMP_TAC[VEC_COMPONENT; SUM_DELTA]);;
1525
1526 let VSUM_ADD_NUMSEG = prove
1527  (`!f g m n. vsum(m..n) (\i. f i + g i) = vsum(m..n) f + vsum(m..n) g`,
1528   SIMP_TAC[VSUM_ADD; FINITE_NUMSEG]);;
1529
1530 let VSUM_SUB_NUMSEG = prove
1531  (`!f g m n. vsum(m..n) (\i. f i - g i) = vsum(m..n) f - vsum(m..n) g`,
1532   SIMP_TAC[VSUM_SUB; FINITE_NUMSEG]);;
1533
1534 let VSUM_ADD_SPLIT = prove
1535  (`!f m n p.
1536        m <= n + 1 ==> vsum(m..n + p) f = vsum(m..n) f + vsum(n + 1..n + p) f`,
1537   SIMP_TAC[CART_EQ; LAMBDA_BETA; VSUM_COMPONENT; VECTOR_ADD_COMPONENT;
1538            SUM_ADD_SPLIT]);;
1539
1540 let VSUM_VSUM_PRODUCT = prove
1541  (`!s:A->bool t:A->B->bool x.
1542         FINITE s /\ (!i. i IN s ==> FINITE(t i))
1543         ==> vsum s (\i. vsum (t i) (x i)) =
1544             vsum {i,j | i IN s /\ j IN t i} (\(i,j). x i j)`,
1545   SIMP_TAC[CART_EQ; LAMBDA_BETA; VSUM_COMPONENT; COND_COMPONENT] THEN
1546   SIMP_TAC[SUM_SUM_PRODUCT] THEN REPEAT STRIP_TAC THEN AP_TERM_TAC THEN
1547   REWRITE_TAC[FUN_EQ_THM; FORALL_PAIR_THM]);;
1548
1549 let VSUM_IMAGE_NONZERO = prove
1550  (`!d:B->real^N i:A->B s.
1551     FINITE s /\
1552     (!x y. x IN s /\ y IN s /\ ~(x = y) /\ i x = i y ==> d(i x) = vec 0)
1553     ==> vsum (IMAGE i s) d = vsum s (d o i)`,
1554   GEN_TAC THEN GEN_TAC THEN ONCE_REWRITE_TAC[IMP_CONJ] THEN
1555   MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
1556   SIMP_TAC[IMAGE_CLAUSES; VSUM_CLAUSES; FINITE_IMAGE] THEN
1557   MAP_EVERY X_GEN_TAC [`a:A`; `s:A->bool`] THEN
1558   REWRITE_TAC[IN_INSERT] THEN REPEAT STRIP_TAC THEN
1559   SUBGOAL_THEN `vsum s ((d:B->real^N) o (i:A->B)) = vsum (IMAGE i s) d`
1560   SUBST1_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN
1561   COND_CASES_TAC THEN ASM_REWRITE_TAC[o_THM] THEN
1562   REWRITE_TAC[VECTOR_ARITH `a = x + a <=> x = vec 0`] THEN
1563   ASM_MESON_TAC[IN_IMAGE]);;
1564
1565 let VSUM_UNION_NONZERO = prove
1566  (`!f s t. FINITE s /\ FINITE t /\ (!x. x IN s INTER t ==> f(x) = vec 0)
1567            ==> vsum (s UNION t) f = vsum s f + vsum t f`,
1568   SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA; VECTOR_ADD_COMPONENT] THEN
1569   SIMP_TAC[VEC_COMPONENT; SUM_UNION_NONZERO]);;
1570
1571 let VSUM_UNIONS_NONZERO = prove
1572  (`!f s. FINITE s /\ (!t:A->bool. t IN s ==> FINITE t) /\
1573          (!t1 t2 x. t1 IN s /\ t2 IN s /\ ~(t1 = t2) /\ x IN t1 /\ x IN t2
1574                     ==> f x = vec 0)
1575          ==> vsum (UNIONS s) f = vsum s (\t. vsum t f)`,
1576   GEN_TAC THEN ONCE_REWRITE_TAC[IMP_CONJ] THEN
1577   MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
1578   REWRITE_TAC[UNIONS_0; UNIONS_INSERT; VSUM_CLAUSES; IN_INSERT] THEN
1579   MAP_EVERY X_GEN_TAC [`t:A->bool`; `s:(A->bool)->bool`] THEN
1580   DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN
1581   ONCE_REWRITE_TAC[IMP_CONJ] THEN ASM_SIMP_TAC[VSUM_CLAUSES] THEN
1582   ANTS_TAC THENL  [ASM_MESON_TAC[]; DISCH_THEN(SUBST_ALL_TAC o SYM)] THEN
1583   STRIP_TAC THEN MATCH_MP_TAC VSUM_UNION_NONZERO THEN
1584   ASM_SIMP_TAC[FINITE_UNIONS; IN_INTER; IN_UNIONS] THEN ASM_MESON_TAC[]);;
1585
1586 let VSUM_CLAUSES_LEFT = prove
1587  (`!f m n. m <= n ==> vsum(m..n) f = f m + vsum(m + 1..n) f`,
1588   SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA; VECTOR_ADD_COMPONENT] THEN
1589   SIMP_TAC[VEC_COMPONENT; SUM_CLAUSES_LEFT]);;
1590
1591 let VSUM_DIFFS = prove
1592  (`!m n. vsum(m..n) (\k. f(k) - f(k + 1)) =
1593           if m <= n then f(m) - f(n + 1) else vec 0`,
1594   GEN_TAC THEN INDUCT_TAC THEN ASM_SIMP_TAC[VSUM_CLAUSES_NUMSEG; LE] THEN
1595   ASM_CASES_TAC `m = SUC n` THEN
1596   ASM_REWRITE_TAC[ARITH_RULE `~(SUC n <= n)`; VECTOR_ADD_LID] THEN
1597   COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN
1598   REWRITE_TAC[GSYM ADD1] THEN VECTOR_ARITH_TAC);;
1599
1600 let VSUM_DIFFS_ALT = prove
1601  (`!m n. vsum(m..n) (\k. f(k + 1) - f(k)) =
1602           if m <= n then f(n + 1) - f(m) else vec 0`,
1603   REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM VECTOR_NEG_SUB] THEN
1604   SIMP_TAC[VSUM_NEG; VSUM_DIFFS] THEN
1605   COND_CASES_TAC THEN ASM_REWRITE_TAC[VECTOR_NEG_SUB; VECTOR_NEG_0]);;
1606
1607 let VSUM_DELETE_CASES = prove
1608  (`!x f s.
1609         FINITE(s:A->bool)
1610         ==> vsum(s DELETE x) f = if x IN s then vsum s f - f x else vsum s f`,
1611   REPEAT STRIP_TAC THEN COND_CASES_TAC THEN
1612   ASM_SIMP_TAC[SET_RULE `~(x IN s) ==> s DELETE x = s`] THEN
1613   FIRST_ASSUM(fun th -> GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV)
1614    [MATCH_MP (SET_RULE `x IN s ==> s = x INSERT (s DELETE x)`) th]) THEN
1615   ASM_SIMP_TAC[VSUM_CLAUSES; FINITE_DELETE; IN_DELETE] THEN VECTOR_ARITH_TAC);;
1616
1617 let VSUM_EQ_GENERAL = prove
1618   (`!s:A->bool t:B->bool (f:A->real^N) g h.
1619         (!y. y IN t ==> ?!x. x IN s /\ h x = y) /\
1620         (!x. x IN s ==> h x IN t /\ g(h x) = f x)
1621         ==> vsum s f = vsum t g`,
1622    SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA] THEN
1623    REPEAT STRIP_TAC THEN MATCH_MP_TAC SUM_EQ_GENERAL THEN
1624    EXISTS_TAC `h:A->B` THEN ASM_MESON_TAC[]);;
1625
1626 let VSUM_EQ_GENERAL_INVERSES = prove
1627  (`!s t (f:A->real^N) (g:B->real^N) h k.
1628         (!y. y IN t ==> k y IN s /\ h (k y) = y) /\
1629         (!x. x IN s ==> h x IN t /\ k (h x) = x /\ g (h x) = f x)
1630         ==> vsum s f = vsum t g`,
1631   SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA] THEN
1632   REPEAT STRIP_TAC THEN MATCH_MP_TAC SUM_EQ_GENERAL_INVERSES THEN
1633   MAP_EVERY EXISTS_TAC [`h:A->B`; `k:B->A`] THEN ASM_MESON_TAC[]);;
1634
1635 let VSUM_NORM_ALLSUBSETS_BOUND = prove
1636  (`!f:A->real^N p e.
1637         FINITE p /\
1638         (!q. q SUBSET p ==> norm(vsum q f) <= e)
1639         ==> sum p (\x. norm(f x)) <= &2 * &(dimindex(:N)) * e`,
1640   REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN
1641   EXISTS_TAC
1642    `sum p (\x:A. sum (1..dimindex(:N)) (\i. abs((f x:real^N)$i)))` THEN
1643   CONJ_TAC THENL
1644    [MATCH_MP_TAC SUM_LE THEN ASM_SIMP_TAC[NORM_LE_L1]; ALL_TAC] THEN
1645   W(MP_TAC o PART_MATCH (lhand o rand) SUM_SWAP o lhand o snd) THEN
1646   ASM_REWRITE_TAC[FINITE_NUMSEG] THEN DISCH_THEN SUBST1_TAC THEN
1647   ONCE_REWRITE_TAC[REAL_ARITH `&2 * &n * e = &n * &2 * e`] THEN
1648   GEN_REWRITE_TAC (RAND_CONV o LAND_CONV o RAND_CONV)
1649    [GSYM CARD_NUMSEG_1] THEN
1650   MATCH_MP_TAC SUM_BOUND THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN
1651   X_GEN_TAC `k:num` THEN STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN
1652   EXISTS_TAC `sum {x:A | x IN p /\ &0 <= (f x:real^N)$k} (\x. abs((f x)$k)) +
1653               sum {x | x IN p /\ (f x)$k < &0} (\x. abs((f x)$k))` THEN
1654   CONJ_TAC THENL
1655    [MATCH_MP_TAC(REAL_ARITH `a = b ==> b <= a`) THEN
1656     MATCH_MP_TAC SUM_UNION_EQ THEN
1657     ASM_SIMP_TAC[EXTENSION; NOT_IN_EMPTY; IN_INTER; IN_UNION; IN_ELIM_THM] THEN
1658     CONJ_TAC THEN X_GEN_TAC `x:A` THEN ASM_CASES_TAC `(x:A) IN p` THEN
1659     ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC;
1660     ALL_TAC] THEN
1661   MATCH_MP_TAC(REAL_ARITH `x <= e /\ y <= e ==> x + y <= &2 * e`) THEN
1662   GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [GSYM REAL_ABS_NEG] THEN
1663   CONJ_TAC THEN MATCH_MP_TAC(REAL_ARITH
1664    `!g. sum s g = sum s f /\ sum s g <= e ==> sum s f <= e`)
1665   THENL
1666    [EXISTS_TAC `\x. ((f:A->real^N) x)$k`;
1667     EXISTS_TAC `\x. --(((f:A->real^N) x)$k)`] THEN
1668   (CONJ_TAC THENL
1669     [MATCH_MP_TAC SUM_EQ THEN REWRITE_TAC[IN_ELIM_THM] THEN REAL_ARITH_TAC;
1670      ALL_TAC]) THEN
1671   ASM_SIMP_TAC[GSYM VSUM_COMPONENT; SUM_NEG; FINITE_RESTRICT] THEN
1672   MATCH_MP_TAC(REAL_ARITH `abs(x) <= e ==> x <= e`) THEN
1673   REWRITE_TAC[REAL_ABS_NEG] THEN
1674   MATCH_MP_TAC(REAL_ARITH
1675    `abs((vsum q f)$k) <= norm(vsum q f) /\
1676     norm(vsum q f) <= e
1677     ==> abs((vsum q f)$k) <= e`) THEN
1678   ASM_SIMP_TAC[COMPONENT_LE_NORM] THEN
1679   FIRST_X_ASSUM MATCH_MP_TAC THEN SET_TAC[]);;
1680
1681 let DOT_LSUM = prove
1682  (`!s f y. FINITE s ==> (vsum s f) dot y = sum s (\x. f(x) dot y)`,
1683   REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN
1684   MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
1685   ASM_SIMP_TAC[VSUM_CLAUSES; SUM_CLAUSES; DOT_LZERO; DOT_LADD]);;
1686
1687 let DOT_RSUM = prove
1688  (`!s f x. FINITE s ==> x dot (vsum s f) = sum s (\y. x dot f(y))`,
1689   REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN
1690   MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
1691   ASM_SIMP_TAC[VSUM_CLAUSES; SUM_CLAUSES; DOT_RZERO; DOT_RADD]);;
1692
1693 let VSUM_OFFSET = prove
1694  (`!p f m n. vsum(m + p..n + p) f = vsum(m..n) (\i. f (i + p))`,
1695   SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA; VEC_COMPONENT; SUM_OFFSET]);;
1696
1697 let VSUM_OFFSET_0 = prove
1698  (`!f m n. m <= n ==> vsum(m..n) f = vsum(0..n - m) (\i. f (i + m))`,
1699   SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA; VEC_COMPONENT; SUM_OFFSET_0]);;
1700
1701 let VSUM_TRIV_NUMSEG = prove
1702  (`!f m n. n < m ==> vsum(m..n) f = vec 0`,
1703   SIMP_TAC[GSYM NUMSEG_EMPTY; VSUM_CLAUSES]);;
1704
1705 let VSUM_CONST_NUMSEG = prove
1706  (`!c m n. vsum(m..n) (\n. c) = &((n + 1) - m) % c`,
1707   SIMP_TAC[VSUM_CONST; FINITE_NUMSEG; CARD_NUMSEG]);;
1708
1709 let VSUM_SUC = prove
1710  (`!f m n. vsum (SUC n..SUC m) f = vsum (n..m) (f o SUC)`,
1711   REPEAT GEN_TAC THEN
1712   SUBGOAL_THEN `SUC n..SUC m = IMAGE SUC (n..m)` SUBST1_TAC THENL
1713    [REWRITE_TAC [ADD1; NUMSEG_OFFSET_IMAGE] THEN
1714     REWRITE_TAC [ONE; ADD_SUC; ADD_0; ETA_AX];
1715     SIMP_TAC [VSUM_IMAGE; FINITE_NUMSEG; SUC_INJ]]);;
1716
1717 let VSUM_BIJECTION = prove
1718  (`!f:A->real^N p s:A->bool.
1719                 (!x. x IN s ==> p(x) IN s) /\
1720                 (!y. y IN s ==> ?!x. x IN s /\ p(x) = y)
1721                 ==> vsum s f = vsum s (f o p)`,
1722   REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN
1723   MATCH_MP_TAC VSUM_EQ_GENERAL THEN EXISTS_TAC `p:A->A` THEN
1724   ASM_REWRITE_TAC[o_THM]);;
1725
1726 let VSUM_PARTIAL_SUC = prove
1727  (`!f g:num->real^N m n.
1728         vsum (m..n) (\k. f(k) % (g(k + 1) - g(k))) =
1729             if m <= n then f(n + 1) % g(n + 1) - f(m) % g(m) -
1730                            vsum (m..n) (\k. (f(k + 1) - f(k)) % g(k + 1))
1731             else vec 0`,
1732   GEN_TAC THEN GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN
1733   COND_CASES_TAC THEN ASM_SIMP_TAC[VSUM_TRIV_NUMSEG; GSYM NOT_LE] THEN
1734   ASM_REWRITE_TAC[VSUM_CLAUSES_NUMSEG] THENL
1735    [COND_CASES_TAC THEN ASM_SIMP_TAC[ARITH] THENL
1736      [VECTOR_ARITH_TAC; ASM_ARITH_TAC];
1737     ALL_TAC] THEN
1738   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LE]) THEN
1739   DISCH_THEN(DISJ_CASES_THEN2 SUBST_ALL_TAC ASSUME_TAC) THEN
1740   ASM_SIMP_TAC[GSYM NOT_LT; VSUM_TRIV_NUMSEG; ARITH_RULE `n < SUC n`] THEN
1741   ASM_SIMP_TAC[GSYM ADD1; ADD_CLAUSES] THEN VECTOR_ARITH_TAC);;
1742
1743 let VSUM_PARTIAL_PRE = prove
1744  (`!f g:num->real^N m n.
1745         vsum (m..n) (\k. f(k) % (g(k) - g(k - 1))) =
1746             if m <= n then f(n + 1) % g(n) - f(m) % g(m - 1) -
1747                            vsum (m..n) (\k. (f(k + 1) - f(k)) % g(k))
1748             else vec 0`,
1749   REPEAT GEN_TAC THEN
1750   MP_TAC(ISPECL [`f:num->real`; `\k. (g:num->real^N)(k - 1)`;
1751                  `m:num`; `n:num`] VSUM_PARTIAL_SUC) THEN
1752   REWRITE_TAC[ADD_SUB] THEN DISCH_THEN SUBST1_TAC THEN
1753   COND_CASES_TAC THEN REWRITE_TAC[]);;
1754
1755 let VSUM_COMBINE_L = prove
1756  (`!f m n p.
1757         0 < n /\ m <= n /\ n <= p + 1
1758         ==> vsum(m..n - 1) f + vsum(n..p) f = vsum(m..p) f`,
1759   SIMP_TAC[CART_EQ; VECTOR_ADD_COMPONENT; VSUM_COMPONENT; SUM_COMBINE_L]);;
1760
1761 let VSUM_COMBINE_R = prove
1762  (`!f m n p.
1763         m <= n + 1 /\ n <= p
1764         ==> vsum(m..n) f + vsum(n + 1..p) f = vsum(m..p) f`,
1765   SIMP_TAC[CART_EQ; VECTOR_ADD_COMPONENT; VSUM_COMPONENT; SUM_COMBINE_R]);;
1766
1767 let VSUM_INJECTION = prove
1768  (`!f p s.
1769          FINITE s /\
1770          (!x. x IN s ==> p x IN s) /\
1771          (!x y. x IN s /\ y IN s /\ p x = p y ==> x = y)
1772          ==> vsum s (f o p) = vsum s f`,
1773   REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP SUM_INJECTION) THEN
1774   SIMP_TAC[CART_EQ; VSUM_COMPONENT; o_DEF]);;
1775
1776 let VSUM_SWAP = prove
1777  (`!f s t.
1778          FINITE s /\ FINITE t
1779          ==> vsum s (\i. vsum t (f i)) = vsum t (\j. vsum s (\i. f i j))`,
1780    SIMP_TAC[CART_EQ; VSUM_COMPONENT] THEN REPEAT STRIP_TAC THEN
1781    W(MP_TAC o PART_MATCH (lhs o rand) SUM_SWAP o lhs o snd) THEN
1782    ASM_REWRITE_TAC[]);;
1783
1784 let VSUM_SWAP_NUMSEG = prove
1785   (`!a b c d f.
1786          vsum (a..b) (\i. vsum (c..d) (f i)) =
1787          vsum (c..d) (\j. vsum (a..b) (\i. f i j))`,
1788   REPEAT GEN_TAC THEN MATCH_MP_TAC VSUM_SWAP THEN REWRITE_TAC[FINITE_NUMSEG]);;
1789
1790 let VSUM_ADD_GEN = prove
1791  (`!f g s.
1792        FINITE {x | x IN s /\ ~(f x = vec 0)} /\
1793        FINITE {x | x IN s /\ ~(g x = vec 0)}
1794        ==> vsum s (\x. f x + g x) = vsum s f + vsum s g`,
1795   REPEAT GEN_TAC THEN DISCH_TAC THEN
1796   SIMP_TAC[CART_EQ; vsum; LAMBDA_BETA; VECTOR_ADD_COMPONENT] THEN
1797   REPEAT GEN_TAC THEN DISCH_THEN(K ALL_TAC) THEN
1798   REPEAT STRIP_TAC THEN MATCH_MP_TAC SUM_ADD_GEN THEN
1799   POP_ASSUM MP_TAC THEN MATCH_MP_TAC MONO_AND THEN
1800   CONJ_TAC THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] FINITE_SUBSET) THEN
1801   REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN GEN_TAC THEN
1802   ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[DE_MORGAN_THM] THEN
1803   STRIP_TAC THEN ASM_REWRITE_TAC[VEC_COMPONENT]);;
1804
1805 let VSUM_CASES_1 = prove
1806  (`!s a. FINITE s /\ a IN s
1807          ==> vsum s (\x. if x = a then y else f(x)) = vsum s f + (y - f a)`,
1808   REPEAT STRIP_TAC THEN ASM_SIMP_TAC[VSUM_CASES] THEN
1809   ASM_SIMP_TAC[GSYM DELETE; VSUM_DELETE] THEN
1810   ASM_SIMP_TAC[SET_RULE `a IN s ==> {x | x IN s /\ x = a} = {a}`] THEN
1811   REWRITE_TAC[VSUM_SING] THEN VECTOR_ARITH_TAC);;
1812
1813 let VSUM_SING_NUMSEG = prove
1814  (`vsum(n..n) f = f n`,
1815   REWRITE_TAC[NUMSEG_SING; VSUM_SING]);;
1816
1817 let VSUM_1 = prove
1818  (`vsum(1..1) f = f(1)`,
1819   REWRITE_TAC[VSUM_SING_NUMSEG]);;
1820
1821 let VSUM_2 = prove
1822  (`!t. vsum(1..2) t = t(1) + t(2)`,
1823   REWRITE_TAC[num_CONV `2`; VSUM_CLAUSES_NUMSEG] THEN
1824   REWRITE_TAC[VSUM_SING_NUMSEG; ARITH; REAL_ADD_ASSOC]);;
1825
1826 let VSUM_3 = prove
1827  (`!t. vsum(1..3) t = t(1) + t(2) + t(3)`,
1828   REWRITE_TAC[num_CONV `3`; num_CONV `2`; VSUM_CLAUSES_NUMSEG] THEN
1829   REWRITE_TAC[VSUM_SING_NUMSEG; ARITH; VECTOR_ADD_ASSOC]);;
1830
1831 let VSUM_4 = prove
1832  (`!t. vsum(1..4) t = t(1) + t(2) + t(3) + t(4)`,
1833   SIMP_TAC[num_CONV `4`; num_CONV `3`; num_CONV `2`; VSUM_CLAUSES_NUMSEG] THEN
1834   REWRITE_TAC[VSUM_SING_NUMSEG; ARITH; VECTOR_ADD_ASSOC]);;
1835
1836 let VSUM_PAIR = prove
1837  (`!f:num->real^N m n.
1838         vsum(2*m..2*n+1) f = vsum(m..n) (\i. f(2*i) + f(2*i+1))`,
1839   SIMP_TAC[CART_EQ; VSUM_COMPONENT; VECTOR_ADD_COMPONENT; SUM_PAIR]);;
1840
1841 let VSUM_PAIR_0 = prove
1842  (`!f:num->real^N n. vsum(0..2*n+1) f = vsum(0..n) (\i. f(2*i) + f(2*i+1))`,
1843   REPEAT GEN_TAC THEN
1844   MP_TAC(ISPECL [`f:num->real^N`; `0`; `n:num`] VSUM_PAIR) THEN
1845   ASM_REWRITE_TAC[ARITH]);;
1846
1847 (* ------------------------------------------------------------------------- *)
1848 (* Add useful congruences to the simplifier.                                 *)
1849 (* ------------------------------------------------------------------------- *)
1850
1851 let th = prove
1852  (`(!f g s.   (!x. x IN s ==> f(x) = g(x))
1853               ==> vsum s (\i. f(i)) = vsum s g) /\
1854    (!f g a b. (!i. a <= i /\ i <= b ==> f(i) = g(i))
1855               ==> vsum(a..b) (\i. f(i)) = vsum(a..b) g) /\
1856    (!f g p.   (!x. p x ==> f x = g x)
1857               ==> vsum {y | p y} (\i. f(i)) = vsum {y | p y} g)`,
1858   REPEAT STRIP_TAC THEN MATCH_MP_TAC VSUM_EQ THEN
1859   ASM_SIMP_TAC[IN_ELIM_THM; IN_NUMSEG]) in
1860   extend_basic_congs (map SPEC_ALL (CONJUNCTS th));;
1861
1862 (* ------------------------------------------------------------------------- *)
1863 (* A conversion for evaluation of `vsum(m..n) f` for numerals m and n.       *)
1864 (* ------------------------------------------------------------------------- *)
1865
1866 let EXPAND_VSUM_CONV =
1867   let [pth_0; pth_1; pth_2] = (CONJUNCTS o prove)
1868    (`(n < m ==> vsum(m..n) (f:num->real^N) = vec 0) /\
1869      vsum(m..m) (f:num->real^N) = f m /\
1870      (m <= n ==> vsum (m..n) (f:num->real^N) = f m + vsum (m + 1..n) f)`,
1871     REWRITE_TAC[VSUM_CLAUSES_LEFT; VSUM_SING_NUMSEG; VSUM_TRIV_NUMSEG])
1872   and ns_tm = `..` and f_tm = `f:num->real^N`
1873   and m_tm = `m:num` and n_tm = `n:num`
1874   and n_ty = `:N` in
1875   let rec conv tm =
1876     let smn,ftm = dest_comb tm in
1877     let s,mn = dest_comb smn in
1878     if not(is_const s & fst(dest_const s) = "vsum")
1879     then failwith "EXPAND_VSUM_CONV" else
1880     let mtm,ntm = dest_binop ns_tm mn in
1881     let m = dest_numeral mtm and n = dest_numeral ntm in
1882     let nty = hd(tl(snd(dest_type(snd(dest_fun_ty(type_of ftm)))))) in
1883     let ilist = [nty,n_ty] in
1884     let ifn = inst ilist and tfn = INST_TYPE ilist in
1885     if n < m then
1886       let th1 = INST [ftm,ifn f_tm; mtm,m_tm; ntm,n_tm] (tfn pth_0) in
1887       MP th1 (EQT_ELIM(NUM_LT_CONV(lhand(concl th1))))
1888     else if n = m then CONV_RULE (RAND_CONV(TRY_CONV BETA_CONV))
1889                                  (INST [ftm,ifn f_tm; mtm,m_tm] (tfn pth_1))
1890     else
1891       let th1 = INST [ftm,ifn f_tm; mtm,m_tm; ntm,n_tm] (tfn pth_2) in
1892       let th2 = MP th1 (EQT_ELIM(NUM_LE_CONV(lhand(concl th1)))) in
1893       CONV_RULE (RAND_CONV(COMB2_CONV (RAND_CONV(TRY_CONV BETA_CONV))
1894        (LAND_CONV(LAND_CONV NUM_ADD_CONV) THENC conv))) th2 in
1895   conv;;
1896
1897 (* ------------------------------------------------------------------------- *)
1898 (* Basis vectors in coordinate directions.                                   *)
1899 (* ------------------------------------------------------------------------- *)
1900
1901 let basis = new_definition
1902   `basis k = lambda i. if i = k then &1 else &0`;;
1903
1904 let NORM_BASIS = prove
1905  (`!k. 1 <= k /\ k <= dimindex(:N)
1906        ==> (norm(basis k :real^N) = &1)`,
1907   REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[basis; dot; vector_norm] THEN
1908   GEN_REWRITE_TAC RAND_CONV [GSYM SQRT_1] THEN AP_TERM_TAC THEN
1909   MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC
1910    `sum (1..dimindex(:N)) (\i. if i = k then &1 else &0)` THEN
1911   CONJ_TAC THENL
1912    [MATCH_MP_TAC SUM_EQ_NUMSEG THEN
1913     ASM_SIMP_TAC[LAMBDA_BETA; IN_NUMSEG; EQ_SYM_EQ] THEN
1914     REPEAT STRIP_TAC THEN COND_CASES_TAC THEN REAL_ARITH_TAC;
1915     ASM_REWRITE_TAC[SUM_DELTA; IN_NUMSEG]]);;
1916
1917 let NORM_BASIS_1 = prove
1918  (`norm(basis 1) = &1`,
1919   SIMP_TAC[NORM_BASIS; ARITH_EQ; ARITH_RULE `1 <= k <=> ~(k = 0)`;
1920            DIMINDEX_NONZERO]);;
1921
1922 let VECTOR_CHOOSE_SIZE = prove
1923  (`!c. &0 <= c ==> ?x:real^N. norm(x) = c`,
1924   REPEAT STRIP_TAC THEN EXISTS_TAC `c % basis 1 :real^N` THEN
1925   ASM_REWRITE_TAC[NORM_MUL; real_abs; NORM_BASIS_1; REAL_MUL_RID]);;
1926
1927 let VECTOR_CHOOSE_DIST = prove
1928  (`!x e. &0 <= e ==> ?y:real^N. dist(x,y) = e`,
1929   REPEAT STRIP_TAC THEN
1930   SUBGOAL_THEN `?c:real^N. norm(c) = e` CHOOSE_TAC THENL
1931    [ASM_SIMP_TAC[VECTOR_CHOOSE_SIZE]; ALL_TAC] THEN
1932   EXISTS_TAC `x - c:real^N` THEN REWRITE_TAC[dist] THEN
1933   ASM_REWRITE_TAC[VECTOR_ARITH `x - (x - c) = c:real^N`]);;
1934
1935 let BASIS_INJ = prove
1936  (`!i j. 1 <= i /\ i <= dimindex(:N) /\
1937          1 <= j /\ j <= dimindex(:N) /\
1938          (basis i :real^N = basis j)
1939          ==> (i = j)`,
1940   SIMP_TAC[basis; CART_EQ; LAMBDA_BETA] THEN REPEAT GEN_TAC THEN
1941   REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `i:num`) THEN
1942   ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN
1943   ASM_SIMP_TAC[REAL_OF_NUM_EQ; ARITH_EQ]);;
1944
1945 let BASIS_INJ_EQ = prove
1946  (`!i j. 1 <= i /\ i <= dimindex(:N) /\ 1 <= j /\ j <= dimindex(:N)
1947          ==> (basis i:real^N = basis j <=> i = j)`,
1948   MESON_TAC[BASIS_INJ]);;
1949
1950 let BASIS_NE = prove
1951  (`!i j. 1 <= i /\ i <= dimindex(:N) /\
1952          1 <= j /\ j <= dimindex(:N) /\
1953          ~(i = j)
1954          ==> ~(basis i :real^N = basis j)`,
1955   MESON_TAC[BASIS_INJ]);;
1956
1957 let BASIS_COMPONENT = prove
1958  (`!k i. 1 <= i /\ i <= dimindex(:N)
1959          ==> ((basis k :real^N)$i = if i = k then &1 else &0)`,
1960   SIMP_TAC[basis; LAMBDA_BETA] THEN MESON_TAC[]);;
1961
1962 let BASIS_EXPANSION = prove
1963  (`!x:real^N. vsum(1..dimindex(:N)) (\i. x$i % basis i) = x`,
1964   SIMP_TAC[CART_EQ; VSUM_COMPONENT; VECTOR_MUL_COMPONENT; BASIS_COMPONENT] THEN
1965   ONCE_REWRITE_TAC[COND_RAND] THEN REWRITE_TAC[REAL_MUL_RZERO] THEN
1966   REPEAT STRIP_TAC THEN
1967   GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [EQ_SYM_EQ] THEN
1968   ASM_SIMP_TAC[SUM_DELTA; IN_NUMSEG; REAL_MUL_RID]);;
1969
1970 let BASIS_EXPANSION_UNIQUE = prove
1971  (`!f x:real^N. (vsum(1..dimindex(:N)) (\i. f(i) % basis i) = x) <=>
1972                 (!i. 1 <= i /\ i <= dimindex(:N) ==> f(i) = x$i)`,
1973   SIMP_TAC[CART_EQ; VSUM_COMPONENT; VECTOR_MUL_COMPONENT; BASIS_COMPONENT] THEN
1974   REPEAT GEN_TAC THEN REWRITE_TAC[COND_RAND; REAL_MUL_RZERO; REAL_MUL_RID] THEN
1975   GEN_REWRITE_TAC (LAND_CONV o BINDER_CONV o RAND_CONV o LAND_CONV o
1976                    ONCE_DEPTH_CONV) [EQ_SYM_EQ] THEN
1977   SIMP_TAC[SUM_DELTA; IN_NUMSEG]);;
1978
1979 let DOT_BASIS = prove
1980  (`!x:real^N i.
1981         1 <= i /\ i <= dimindex(:N)
1982         ==> ((basis i) dot x = x$i) /\ (x dot (basis i) = x$i)`,
1983   SIMP_TAC[dot; basis; LAMBDA_BETA] THEN
1984   REWRITE_TAC[COND_RATOR; COND_RAND] THEN
1985   REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_RZERO] THEN
1986   SIMP_TAC[SUM_DELTA; IN_NUMSEG; REAL_MUL_LID; REAL_MUL_RID]);;
1987
1988 let DOT_BASIS_BASIS = prove
1989  (`!i j. 1 <= i /\ i <= dimindex(:N) /\
1990          1 <= j /\ j <= dimindex(:N)
1991          ==> (basis i:real^N) dot (basis j) = if i = j then &1 else &0`,
1992   SIMP_TAC[DOT_BASIS; BASIS_COMPONENT]);;
1993
1994 let DOT_BASIS_BASIS_UNEQUAL = prove
1995  (`!i j. ~(i = j) ==> (basis i) dot (basis j) = &0`,
1996   SIMP_TAC[basis; dot; LAMBDA_BETA] THEN ONCE_REWRITE_TAC[COND_RAND] THEN
1997   SIMP_TAC[SUM_0; REAL_MUL_RZERO; REAL_MUL_LZERO; COND_ID]);;
1998
1999 let BASIS_EQ_0 = prove
2000  (`!i. (basis i :real^N = vec 0) <=> ~(i IN 1..dimindex(:N))`,
2001   SIMP_TAC[CART_EQ; BASIS_COMPONENT; VEC_COMPONENT; IN_NUMSEG] THEN
2002   MESON_TAC[REAL_ARITH `~(&1 = &0)`]);;
2003
2004 let BASIS_NONZERO = prove
2005  (`!k. 1 <= k /\ k <= dimindex(:N)
2006        ==> ~(basis k :real^N = vec 0)`,
2007   REWRITE_TAC[BASIS_EQ_0; IN_NUMSEG]);;
2008
2009 let VECTOR_EQ_LDOT = prove
2010  (`!y z. (!x. x dot y = x dot z) <=> y = z`,
2011   REPEAT GEN_TAC THEN EQ_TAC THEN SIMP_TAC[] THEN
2012   REWRITE_TAC[CART_EQ] THEN MESON_TAC[DOT_BASIS]);;
2013
2014 let VECTOR_EQ_RDOT = prove
2015  (`!x y. (!z. x dot z = y dot z) <=> x = y`,
2016   REPEAT GEN_TAC THEN EQ_TAC THEN SIMP_TAC[] THEN
2017   REWRITE_TAC[CART_EQ] THEN MESON_TAC[DOT_BASIS]);;
2018
2019 (* ------------------------------------------------------------------------- *)
2020 (* Orthogonality.                                                            *)
2021 (* ------------------------------------------------------------------------- *)
2022
2023 let orthogonal = new_definition
2024   `orthogonal x y <=> (x dot y = &0)`;;
2025
2026 let ORTHOGONAL_0 = prove
2027  (`!x. orthogonal (vec 0) x /\ orthogonal x (vec 0)`,
2028   REWRITE_TAC[orthogonal; DOT_LZERO; DOT_RZERO]);;
2029
2030 let ORTHOGONAL_REFL = prove
2031  (`!x. orthogonal x x <=> x = vec 0`,
2032   REWRITE_TAC[orthogonal; DOT_EQ_0]);;
2033
2034 let ORTHOGONAL_SYM = prove
2035  (`!x y. orthogonal x y <=> orthogonal y x`,
2036   REWRITE_TAC[orthogonal; DOT_SYM]);;
2037
2038 let ORTHOGONAL_LNEG = prove
2039  (`!x y. orthogonal (--x) y <=> orthogonal x y`,
2040   REWRITE_TAC[orthogonal; DOT_LNEG; REAL_NEG_EQ_0]);;
2041
2042 let ORTHOGONAL_RNEG = prove
2043  (`!x y. orthogonal x (--y) <=> orthogonal x y`,
2044   REWRITE_TAC[orthogonal; DOT_RNEG; REAL_NEG_EQ_0]);;
2045
2046 let ORTHOGONAL_MUL = prove
2047  (`(!a x y:real^N. orthogonal (a % x) y <=> a = &0 \/ orthogonal x y) /\
2048    (!a x y:real^N. orthogonal x (a % y) <=> a = &0 \/ orthogonal x y)`,
2049   REWRITE_TAC[orthogonal; DOT_LMUL; DOT_RMUL; REAL_ENTIRE]);;
2050
2051 let ORTHOGONAL_BASIS = prove
2052  (`!x:real^N i. 1 <= i /\ i <= dimindex(:N)
2053                 ==> (orthogonal (basis i) x <=> (x$i = &0))`,
2054   REPEAT STRIP_TAC THEN SIMP_TAC[orthogonal; dot; basis; LAMBDA_BETA] THEN
2055   REWRITE_TAC[COND_RAND; COND_RATOR; REAL_MUL_LZERO] THEN
2056   ASM_SIMP_TAC[SUM_DELTA; IN_NUMSEG; REAL_MUL_LID]);;
2057
2058 let ORTHOGONAL_BASIS_BASIS = prove
2059  (`!i j. 1 <= i /\ i <= dimindex(:N) /\
2060          1 <= j /\ j <= dimindex(:N)
2061          ==> (orthogonal (basis i :real^N) (basis j) <=> ~(i = j))`,
2062   ASM_SIMP_TAC[ORTHOGONAL_BASIS] THEN ASM_SIMP_TAC[BASIS_COMPONENT] THEN
2063   MESON_TAC[REAL_ARITH `~(&1 = &0)`]);;
2064
2065 let ORTHOGONAL_CLAUSES = prove
2066  (`(!a. orthogonal a (vec 0)) /\
2067    (!a x c. orthogonal a x ==> orthogonal a (c % x)) /\
2068    (!a x. orthogonal a x ==> orthogonal a (--x)) /\
2069    (!a x y. orthogonal a x /\ orthogonal a y ==> orthogonal a (x + y)) /\
2070    (!a x y. orthogonal a x /\ orthogonal a y ==> orthogonal a (x - y)) /\
2071    (!a. orthogonal (vec 0) a) /\
2072    (!a x c. orthogonal x a ==> orthogonal (c % x) a) /\
2073    (!a x. orthogonal x a ==> orthogonal (--x) a) /\
2074    (!a x y. orthogonal x a /\ orthogonal y a ==> orthogonal (x + y) a) /\
2075    (!a x y. orthogonal x a /\ orthogonal y a ==> orthogonal (x - y) a)`,
2076   REWRITE_TAC[orthogonal; DOT_RNEG; DOT_RMUL; DOT_RADD; DOT_RSUB;
2077     DOT_LZERO; DOT_RZERO; DOT_LNEG; DOT_LMUL; DOT_LADD; DOT_LSUB] THEN
2078   SIMP_TAC[] THEN REAL_ARITH_TAC);;
2079
2080 let ORTHOGONAL_RVSUM = prove
2081  (`!f:A->real^N s x.
2082         FINITE s /\
2083         (!y. y IN s ==> orthogonal x (f y))
2084         ==> orthogonal x (vsum s f)`,
2085   GEN_TAC THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM; IMP_CONJ] THEN
2086   MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
2087   SIMP_TAC[NOT_IN_EMPTY; FORALL_IN_INSERT; ORTHOGONAL_CLAUSES; VSUM_CLAUSES]);;
2088
2089 let ORTHOGONAL_LVSUM = prove
2090  (`!f:A->real^N s y.
2091         FINITE s /\
2092         (!x. x IN s ==> orthogonal (f x) y)
2093         ==> orthogonal (vsum s f) y`,
2094   GEN_TAC THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM; IMP_CONJ] THEN
2095   MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
2096   SIMP_TAC[NOT_IN_EMPTY; FORALL_IN_INSERT; ORTHOGONAL_CLAUSES; VSUM_CLAUSES]);;
2097
2098 let NORM_ADD_PYTHAGOREAN = prove
2099  (`!a b:real^N.
2100         orthogonal a b
2101         ==> norm(a + b) pow 2 = norm(a) pow 2 + norm(b) pow 2`,
2102   SIMP_TAC[NORM_POW_2; orthogonal; DOT_LADD; DOT_RADD; DOT_SYM] THEN
2103   REAL_ARITH_TAC);;
2104
2105 let NORM_VSUM_PYTHAGOREAN = prove
2106  (`!k u:A->real^N.
2107         FINITE k /\ pairwise (\i j. orthogonal (u i) (u j)) k
2108         ==> norm(vsum k u) pow 2 = sum k (\i. norm(u i) pow 2)`,
2109   ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN GEN_TAC THEN SIMP_TAC[IMP_CONJ] THEN
2110   MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
2111   SIMP_TAC[VSUM_CLAUSES; SUM_CLAUSES; NORM_0] THEN
2112   CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[PAIRWISE_INSERT] THEN
2113   REWRITE_TAC[pairwise] THEN REPEAT GEN_TAC THEN
2114   DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN
2115   DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN ASM_REWRITE_TAC[] THEN
2116   MATCH_MP_TAC NORM_ADD_PYTHAGOREAN THEN MATCH_MP_TAC ORTHOGONAL_RVSUM THEN
2117   ASM_MESON_TAC[]);;
2118
2119 (* ------------------------------------------------------------------------- *)
2120 (* Explicit vector construction from lists.                                  *)
2121 (* ------------------------------------------------------------------------- *)
2122
2123 let VECTOR_1 = prove
2124  (`(vector[x]:A^1)$1 = x`,
2125   SIMP_TAC[vector; LAMBDA_BETA; DIMINDEX_1; ARITH; LENGTH; EL; HD; TL]);;
2126
2127 let VECTOR_2 = prove
2128  (`(vector[x;y]:A^2)$1 = x /\
2129    (vector[x;y]:A^2)$2 = y`,
2130   SIMP_TAC[vector; LAMBDA_BETA; DIMINDEX_2; ARITH; LENGTH; EL] THEN
2131   REWRITE_TAC[num_CONV `1`; HD; TL; EL]);;
2132
2133 let VECTOR_3 = prove
2134  (`(vector[x;y;z]:A^3)$1 = x /\
2135    (vector[x;y;z]:A^3)$2 = y /\
2136    (vector[x;y;z]:A^3)$3 = z`,
2137   SIMP_TAC[vector; LAMBDA_BETA; DIMINDEX_3; ARITH; LENGTH; EL] THEN
2138   REWRITE_TAC[num_CONV `2`; num_CONV `1`; HD; TL; EL]);;
2139
2140 let VECTOR_4 = prove
2141  (`(vector[w;x;y;z]:A^4)$1 = w /\
2142    (vector[w;x;y;z]:A^4)$2 = x /\
2143    (vector[w;x;y;z]:A^4)$3 = y /\
2144    (vector[w;x;y;z]:A^4)$4 = z`,
2145   SIMP_TAC[vector; LAMBDA_BETA; DIMINDEX_4; ARITH; LENGTH; EL] THEN
2146   REWRITE_TAC[num_CONV `3`; num_CONV `2`; num_CONV `1`; HD; TL; EL]);;
2147
2148 let FORALL_VECTOR_1 = prove
2149  (`(!v:A^1. P v) <=> !x. P(vector[x])`,
2150   EQ_TAC THEN SIMP_TAC[] THEN REPEAT STRIP_TAC THEN
2151   FIRST_X_ASSUM(MP_TAC o SPEC `(v:A^1)$1`) THEN
2152   MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN
2153   REWRITE_TAC[CART_EQ; FORALL_1; VECTOR_1; DIMINDEX_1]);;
2154
2155 let FORALL_VECTOR_2 = prove
2156  (`(!v:A^2. P v) <=> !x y. P(vector[x;y])`,
2157   EQ_TAC THEN SIMP_TAC[] THEN REPEAT STRIP_TAC THEN
2158   FIRST_X_ASSUM(MP_TAC o SPECL [`(v:A^2)$1`; `(v:A^2)$2`]) THEN
2159   MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN
2160   REWRITE_TAC[CART_EQ; FORALL_2; VECTOR_2; DIMINDEX_2]);;
2161
2162 let FORALL_VECTOR_3 = prove
2163  (`(!v:A^3. P v) <=> !x y z. P(vector[x;y;z])`,
2164   EQ_TAC THEN SIMP_TAC[] THEN REPEAT STRIP_TAC THEN
2165   FIRST_X_ASSUM(MP_TAC o SPECL
2166     [`(v:A^3)$1`; `(v:A^3)$2`; `(v:A^3)$3`]) THEN
2167   MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN
2168   REWRITE_TAC[CART_EQ; FORALL_3; VECTOR_3; DIMINDEX_3]);;
2169
2170 let FORALL_VECTOR_4 = prove
2171  (`(!v:A^4. P v) <=> !w x y z. P(vector[w;x;y;z])`,
2172   EQ_TAC THEN SIMP_TAC[] THEN REPEAT STRIP_TAC THEN
2173   FIRST_X_ASSUM(MP_TAC o SPECL
2174     [`(v:A^4)$1`; `(v:A^4)$2`; `(v:A^4)$3`; `(v:A^4)$4`]) THEN
2175   MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN
2176   REWRITE_TAC[CART_EQ; FORALL_4; VECTOR_4; DIMINDEX_4]);;
2177
2178 let EXISTS_VECTOR_1 = prove
2179  (`(?v:A^1. P v) <=> ?x. P(vector[x])`,
2180   REWRITE_TAC[MESON[] `(?x. P x) <=> ~(!x. ~P x)`] THEN
2181   REWRITE_TAC[FORALL_VECTOR_1]);;
2182
2183 let EXISTS_VECTOR_2 = prove
2184  (`(?v:A^2. P v) <=> ?x y. P(vector[x;y])`,
2185   REWRITE_TAC[MESON[] `(?x. P x) <=> ~(!x. ~P x)`] THEN
2186   REWRITE_TAC[FORALL_VECTOR_2]);;
2187
2188 let EXISTS_VECTOR_3 = prove
2189  (`(?v:A^3. P v) <=> ?x y z. P(vector[x;y;z])`,
2190   REWRITE_TAC[MESON[] `(?x. P x) <=> ~(!x. ~P x)`] THEN
2191   REWRITE_TAC[FORALL_VECTOR_3]);;
2192
2193 let EXISTS_VECTOR_4 = prove
2194  (`(?v:A^4. P v) <=> ?w x y z. P(vector[w;x;y;z])`,
2195   REWRITE_TAC[MESON[] `(?x. P x) <=> ~(!x. ~P x)`] THEN
2196   REWRITE_TAC[FORALL_VECTOR_4]);;
2197
2198 let VECTOR_EXPAND_1 = prove
2199  (`!x:real^1. x = vector[x$1]`,
2200   SIMP_TAC[CART_EQ; DIMINDEX_1; FORALL_1; VECTOR_1]);;
2201
2202 let VECTOR_EXPAND_2 = prove
2203  (`!x:real^2. x = vector[x$1;x$2]`,
2204   SIMP_TAC[CART_EQ; DIMINDEX_2; FORALL_2; VECTOR_2]);;
2205
2206 let VECTOR_EXPAND_3 = prove
2207  (`!x:real^3. x = vector[x$1;x$2;x$3]`,
2208   SIMP_TAC[CART_EQ; DIMINDEX_3; FORALL_3; VECTOR_3]);;
2209
2210 let VECTOR_EXPAND_4 = prove
2211  (`!x:real^4. x = vector[x$1;x$2;x$3;x$4]`,
2212   SIMP_TAC[CART_EQ; DIMINDEX_4; FORALL_4; VECTOR_4]);;
2213
2214 (* ------------------------------------------------------------------------- *)
2215 (* Linear functions.                                                         *)
2216 (* ------------------------------------------------------------------------- *)
2217
2218 let linear = new_definition
2219   `linear (f:real^M->real^N) <=>
2220         (!x y. f(x + y) = f(x) + f(y)) /\
2221         (!c x. f(c % x) = c % f(x))`;;
2222
2223 let LINEAR_COMPOSE_CMUL = prove
2224  (`!f c. linear f ==> linear (\x. c % f(x))`,
2225   SIMP_TAC[linear] THEN REPEAT STRIP_TAC THEN VECTOR_ARITH_TAC);;
2226
2227 let LINEAR_COMPOSE_NEG = prove
2228  (`!f. linear f ==> linear (\x. --(f(x)))`,
2229   SIMP_TAC[linear] THEN REPEAT STRIP_TAC THEN VECTOR_ARITH_TAC);;
2230
2231 let LINEAR_COMPOSE_ADD = prove
2232  (`!f g. linear f /\ linear g ==> linear (\x. f(x) + g(x))`,
2233   SIMP_TAC[linear] THEN REPEAT STRIP_TAC THEN VECTOR_ARITH_TAC);;
2234
2235 let LINEAR_COMPOSE_SUB = prove
2236  (`!f g. linear f /\ linear g ==> linear (\x. f(x) - g(x))`,
2237   SIMP_TAC[linear] THEN REPEAT STRIP_TAC THEN VECTOR_ARITH_TAC);;
2238
2239 let LINEAR_COMPOSE = prove
2240  (`!f g. linear f /\ linear g ==> linear (g o f)`,
2241   SIMP_TAC[linear; o_THM]);;
2242
2243 let LINEAR_ID = prove
2244  (`linear (\x. x)`,
2245   REWRITE_TAC[linear]);;
2246
2247 let LINEAR_I = prove
2248  (`linear I`,
2249   REWRITE_TAC[I_DEF; LINEAR_ID]);;
2250
2251 let LINEAR_ZERO = prove
2252  (`linear (\x. vec 0)`,
2253   REWRITE_TAC[linear] THEN CONJ_TAC THEN VECTOR_ARITH_TAC);;
2254
2255 let LINEAR_NEGATION = prove
2256  (`linear(--)`,
2257   REWRITE_TAC[linear] THEN VECTOR_ARITH_TAC);;
2258
2259 let LINEAR_COMPOSE_VSUM = prove
2260  (`!f s. FINITE s /\ (!a. a IN s ==> linear(f a))
2261          ==> linear(\x. vsum s (\a. f a x))`,
2262   GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN
2263   MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
2264   SIMP_TAC[VSUM_CLAUSES; LINEAR_ZERO] THEN
2265   ASM_SIMP_TAC[ETA_AX; IN_INSERT; LINEAR_COMPOSE_ADD]);;
2266
2267 let LINEAR_VMUL_COMPONENT = prove
2268  (`!f:real^M->real^N v k.
2269      linear f /\ 1 <= k /\ k <= dimindex(:N)
2270      ==> linear (\x. f(x)$k % v)`,
2271   SIMP_TAC[linear; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT] THEN
2272   REPEAT STRIP_TAC THEN VECTOR_ARITH_TAC);;
2273
2274 let LINEAR_0 = prove
2275  (`!f. linear f ==> (f(vec 0) = vec 0)`,
2276   MESON_TAC[VECTOR_MUL_LZERO; linear]);;
2277
2278 let LINEAR_CMUL = prove
2279  (`!f c x. linear f ==> (f(c % x) = c % f(x))`,
2280   SIMP_TAC[linear]);;
2281
2282 let LINEAR_NEG = prove
2283  (`!f x. linear f ==> (f(--x) = --(f x))`,
2284   ONCE_REWRITE_TAC[VECTOR_NEG_MINUS1] THEN SIMP_TAC[LINEAR_CMUL]);;
2285
2286 let LINEAR_ADD = prove
2287  (`!f x y. linear f ==> (f(x + y) = f(x) + f(y))`,
2288   SIMP_TAC[linear]);;
2289
2290 let LINEAR_SUB = prove
2291  (`!f x y. linear f ==> (f(x - y) = f(x) - f(y))`,
2292   SIMP_TAC[VECTOR_SUB; LINEAR_ADD; LINEAR_NEG]);;
2293
2294 let LINEAR_VSUM = prove
2295  (`!f g s. linear f /\ FINITE s ==> (f(vsum s g) = vsum s (f o g))`,
2296   GEN_TAC THEN GEN_TAC THEN SIMP_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
2297   DISCH_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
2298   SIMP_TAC[VSUM_CLAUSES] THEN FIRST_ASSUM(fun th ->
2299     SIMP_TAC[MATCH_MP LINEAR_0 th; MATCH_MP LINEAR_ADD th; o_THM]));;
2300
2301 let LINEAR_VSUM_MUL = prove
2302  (`!f s c v.
2303         linear f /\ FINITE s
2304         ==> f(vsum s (\i. c i % v i)) = vsum s (\i. c(i) % f(v i))`,
2305   SIMP_TAC[LINEAR_VSUM; o_DEF; LINEAR_CMUL]);;
2306
2307 let LINEAR_INJECTIVE_0 = prove
2308  (`!f. linear f
2309        ==> ((!x y. (f(x) = f(y)) ==> (x = y)) <=>
2310             (!x. (f(x) = vec 0) ==> (x = vec 0)))`,
2311   REPEAT STRIP_TAC THEN
2312   GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [GSYM VECTOR_SUB_EQ] THEN
2313   ASM_SIMP_TAC[GSYM LINEAR_SUB] THEN MESON_TAC[VECTOR_SUB_RZERO]);;
2314
2315 let LINEAR_BOUNDED = prove
2316  (`!f:real^M->real^N. linear f ==> ?B. !x. norm(f x) <= B * norm(x)`,
2317   REPEAT STRIP_TAC THEN EXISTS_TAC
2318    `sum(1..dimindex(:M)) (\i. norm((f:real^M->real^N)(basis i)))` THEN
2319   GEN_TAC THEN
2320   GEN_REWRITE_TAC (LAND_CONV o funpow 2 RAND_CONV) [GSYM BASIS_EXPANSION] THEN
2321   ASM_SIMP_TAC[LINEAR_VSUM; FINITE_NUMSEG] THEN
2322   ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[GSYM SUM_LMUL] THEN
2323   MATCH_MP_TAC VSUM_NORM_LE THEN
2324   SIMP_TAC[FINITE_CROSS; FINITE_NUMSEG; IN_NUMSEG] THEN
2325   ASM_SIMP_TAC[o_DEF; NORM_MUL; LINEAR_CMUL] THEN
2326   ASM_SIMP_TAC[REAL_LE_RMUL; NORM_POS_LE; COMPONENT_LE_NORM]);;
2327
2328 let LINEAR_BOUNDED_POS = prove
2329  (`!f:real^M->real^N. linear f ==> ?B. &0 < B /\ !x. norm(f x) <= B * norm(x)`,
2330   REPEAT STRIP_TAC THEN
2331   FIRST_ASSUM(X_CHOOSE_TAC `B:real` o MATCH_MP LINEAR_BOUNDED) THEN
2332   EXISTS_TAC `abs(B) + &1` THEN CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN
2333   POP_ASSUM MP_TAC THEN MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN
2334   MATCH_MP_TAC(REAL_ARITH `a <= b ==> x <= a ==> x <= b`) THEN
2335   MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[NORM_POS_LE] THEN
2336   REAL_ARITH_TAC);;
2337
2338 let SYMMETRIC_LINEAR_IMAGE = prove
2339  (`!f s. (!x. x IN s ==> --x IN s) /\ linear f
2340           ==> !x. x IN (IMAGE f s) ==> --x IN (IMAGE f s)`,
2341   REWRITE_TAC[FORALL_IN_IMAGE] THEN
2342   SIMP_TAC[GSYM LINEAR_NEG] THEN SET_TAC[]);;
2343
2344 (* ------------------------------------------------------------------------- *)
2345 (* Bilinear functions.                                                       *)
2346 (* ------------------------------------------------------------------------- *)
2347
2348 let bilinear = new_definition
2349   `bilinear f <=> (!x. linear(\y. f x y)) /\ (!y. linear(\x. f x y))`;;
2350
2351 let BILINEAR_LADD = prove
2352  (`!h x y z. bilinear h ==> h (x + y) z = (h x z) + (h y z)`,
2353   SIMP_TAC[bilinear; linear]);;
2354
2355 let BILINEAR_RADD = prove
2356  (`!h x y z. bilinear h ==> h x (y + z) = (h x y) + (h x z)`,
2357   SIMP_TAC[bilinear; linear]);;
2358
2359 let BILINEAR_LMUL = prove
2360  (`!h c x y. bilinear h ==> h (c % x) y = c % (h x y)`,
2361   SIMP_TAC[bilinear; linear]);;
2362
2363 let BILINEAR_RMUL = prove
2364  (`!h c x y. bilinear h ==> h x (c % y) = c % (h x y)`,
2365   SIMP_TAC[bilinear; linear]);;
2366
2367 let BILINEAR_LNEG = prove
2368  (`!h x y. bilinear h ==> h (--x) y = --(h x y)`,
2369   ONCE_REWRITE_TAC[VECTOR_NEG_MINUS1] THEN SIMP_TAC[BILINEAR_LMUL]);;
2370
2371 let BILINEAR_RNEG = prove
2372  (`!h x y. bilinear h ==> h x (--y) = --(h x y)`,
2373   ONCE_REWRITE_TAC[VECTOR_NEG_MINUS1] THEN SIMP_TAC[BILINEAR_RMUL]);;
2374
2375 let BILINEAR_LZERO = prove
2376  (`!h x. bilinear h ==> h (vec 0) x = vec 0`,
2377   ONCE_REWRITE_TAC[VECTOR_ARITH `x = vec 0 <=> x + x = x`] THEN
2378   SIMP_TAC[GSYM BILINEAR_LADD; VECTOR_ADD_LID]);;
2379
2380 let BILINEAR_RZERO = prove
2381  (`!h x. bilinear h ==> h x (vec 0) = vec 0`,
2382   ONCE_REWRITE_TAC[VECTOR_ARITH `x = vec 0 <=> x + x = x`] THEN
2383   SIMP_TAC[GSYM BILINEAR_RADD; VECTOR_ADD_LID]);;
2384
2385 let BILINEAR_LSUB = prove
2386  (`!h x y z. bilinear h ==> h (x - y) z = (h x z) - (h y z)`,
2387   SIMP_TAC[VECTOR_SUB; BILINEAR_LNEG; BILINEAR_LADD]);;
2388
2389 let BILINEAR_RSUB = prove
2390  (`!h x y z. bilinear h ==> h x (y - z) = (h x y) - (h x z)`,
2391   SIMP_TAC[VECTOR_SUB; BILINEAR_RNEG; BILINEAR_RADD]);;
2392
2393 let BILINEAR_VSUM = prove
2394  (`!h:real^M->real^N->real^P.
2395        bilinear h /\ FINITE s /\ FINITE t
2396        ==> h (vsum s f) (vsum t g) = vsum (s CROSS t) (\(i,j). h (f i) (g j))`,
2397   REPEAT GEN_TAC THEN SIMP_TAC[bilinear; ETA_AX] THEN
2398   ONCE_REWRITE_TAC[TAUT `(a /\ b) /\ c /\ d <=> (a /\ d) /\ (b /\ c)`] THEN
2399   DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN
2400   ONCE_REWRITE_TAC[LEFT_AND_FORALL_THM] THEN DISCH_TAC THEN
2401   FIRST_ASSUM(MP_TAC o GEN_ALL o MATCH_MP LINEAR_VSUM o SPEC_ALL) THEN
2402   SIMP_TAC[] THEN ASM_SIMP_TAC[LINEAR_VSUM; o_DEF; VSUM_VSUM_PRODUCT] THEN
2403   REWRITE_TAC[GSYM CROSS]);;
2404
2405 let BILINEAR_BOUNDED = prove
2406  (`!h:real^M->real^N->real^P.
2407         bilinear h ==> ?B. !x y. norm(h x y) <= B * norm(x) * norm(y)`,
2408   REPEAT STRIP_TAC THEN
2409   EXISTS_TAC `sum ((1..dimindex(:M)) CROSS (1..dimindex(:N)))
2410                   (\(i,j). norm((h:real^M->real^N->real^P)
2411                                 (basis i) (basis j)))` THEN
2412   REPEAT GEN_TAC THEN GEN_REWRITE_TAC
2413    (LAND_CONV o RAND_CONV o BINOP_CONV) [GSYM BASIS_EXPANSION] THEN
2414   ASM_SIMP_TAC[BILINEAR_VSUM; FINITE_NUMSEG] THEN
2415   ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[GSYM SUM_LMUL] THEN
2416   MATCH_MP_TAC VSUM_NORM_LE THEN
2417   SIMP_TAC[FINITE_CROSS; FINITE_NUMSEG; FORALL_PAIR_THM; IN_CROSS] THEN
2418   REWRITE_TAC[IN_NUMSEG] THEN REPEAT STRIP_TAC THEN
2419   ASM_SIMP_TAC[BILINEAR_LMUL; NORM_MUL] THEN
2420   ASM_SIMP_TAC[BILINEAR_RMUL; NORM_MUL; REAL_MUL_ASSOC] THEN
2421   MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[NORM_POS_LE] THEN
2422   ASM_SIMP_TAC[COMPONENT_LE_NORM; REAL_ABS_POS; REAL_LE_MUL2]);;
2423
2424 let BILINEAR_BOUNDED_POS = prove
2425  (`!h. bilinear h
2426        ==> ?B. &0 < B /\ !x y. norm(h x y) <= B * norm(x) * norm(y)`,
2427   REPEAT STRIP_TAC THEN
2428   FIRST_ASSUM(X_CHOOSE_TAC `B:real` o MATCH_MP BILINEAR_BOUNDED) THEN
2429   EXISTS_TAC `abs(B) + &1` THEN CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN
2430   POP_ASSUM MP_TAC THEN REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN
2431   MATCH_MP_TAC(REAL_ARITH `a <= b ==> x <= a ==> x <= b`) THEN
2432   REPEAT(MATCH_MP_TAC REAL_LE_RMUL THEN
2433          SIMP_TAC[NORM_POS_LE; REAL_LE_MUL]) THEN
2434   REAL_ARITH_TAC);;
2435
2436 let BILINEAR_VSUM_PARTIAL_SUC = prove
2437  (`!f g h:real^M->real^N->real^P m n.
2438         bilinear h
2439         ==> vsum (m..n) (\k. h (f k) (g(k + 1) - g(k))) =
2440                 if m <= n then h (f(n + 1)) (g(n + 1)) - h (f m) (g m) -
2441                                vsum (m..n) (\k. h (f(k + 1) - f(k)) (g(k + 1)))
2442                 else vec 0`,
2443   REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN REPEAT GEN_TAC THEN DISCH_TAC THEN
2444   GEN_TAC THEN INDUCT_TAC THEN
2445   COND_CASES_TAC THEN ASM_SIMP_TAC[VSUM_TRIV_NUMSEG; GSYM NOT_LE] THEN
2446   ASM_REWRITE_TAC[VSUM_CLAUSES_NUMSEG] THENL
2447    [COND_CASES_TAC THEN ASM_SIMP_TAC[ARITH] THENL
2448      [ASM_SIMP_TAC[BILINEAR_RSUB; BILINEAR_LSUB] THEN VECTOR_ARITH_TAC;
2449       ASM_ARITH_TAC];
2450     ALL_TAC] THEN
2451   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LE]) THEN
2452   DISCH_THEN(DISJ_CASES_THEN2 SUBST_ALL_TAC ASSUME_TAC) THEN
2453   ASM_SIMP_TAC[GSYM NOT_LT; VSUM_TRIV_NUMSEG; ARITH_RULE `n < SUC n`] THEN
2454   ASM_SIMP_TAC[GSYM ADD1; ADD_CLAUSES] THEN
2455   ASM_SIMP_TAC[BILINEAR_RSUB; BILINEAR_LSUB] THEN VECTOR_ARITH_TAC);;
2456
2457 let BILINEAR_VSUM_PARTIAL_PRE = prove
2458  (`!f g h:real^M->real^N->real^P m n.
2459         bilinear h
2460         ==> vsum (m..n) (\k. h (f k) (g(k) - g(k - 1))) =
2461                 if m <= n then h (f(n + 1)) (g(n)) - h (f m) (g(m - 1)) -
2462                                vsum (m..n) (\k. h (f(k + 1) - f(k)) (g(k)))
2463                 else vec 0`,
2464   REPEAT STRIP_TAC THEN
2465   FIRST_ASSUM(MP_TAC o ISPECL [`f:num->real^M`; `\k. (g:num->real^N)(k - 1)`;
2466                  `m:num`; `n:num`] o MATCH_MP BILINEAR_VSUM_PARTIAL_SUC) THEN
2467    REWRITE_TAC[ADD_SUB] THEN DISCH_THEN SUBST1_TAC THEN
2468   COND_CASES_TAC THEN REWRITE_TAC[]);;
2469
2470 (* ------------------------------------------------------------------------- *)
2471 (* Adjoints.                                                                 *)
2472 (* ------------------------------------------------------------------------- *)
2473
2474 let adjoint = new_definition
2475  `adjoint(f:real^M->real^N) = @f'. !x y. f(x) dot y = x dot f'(y)`;;
2476
2477 let ADJOINT_WORKS = prove
2478  (`!f:real^M->real^N. linear f ==> !x y. f(x) dot y = x dot (adjoint f)(y)`,
2479   GEN_TAC THEN DISCH_TAC THEN SIMP_TAC[adjoint] THEN CONV_TAC SELECT_CONV THEN
2480   ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN ONCE_REWRITE_TAC[GSYM SKOLEM_THM] THEN
2481   X_GEN_TAC `y:real^N` THEN
2482   EXISTS_TAC `(lambda i. (f:real^M->real^N) (basis i) dot y):real^M` THEN
2483   X_GEN_TAC `x:real^M` THEN
2484   GEN_REWRITE_TAC (funpow 2 LAND_CONV o RAND_CONV) [GSYM BASIS_EXPANSION] THEN
2485   ASM_SIMP_TAC[LINEAR_VSUM; FINITE_NUMSEG] THEN
2486   SIMP_TAC[dot; LAMBDA_BETA; VSUM_COMPONENT; GSYM SUM_LMUL; GSYM SUM_RMUL] THEN
2487   GEN_REWRITE_TAC RAND_CONV [SUM_SWAP_NUMSEG] THEN
2488   ASM_SIMP_TAC[o_THM; VECTOR_MUL_COMPONENT; LINEAR_CMUL; REAL_MUL_ASSOC]);;
2489
2490 let ADJOINT_LINEAR = prove
2491  (`!f:real^M->real^N. linear f ==> linear(adjoint f)`,
2492   REPEAT STRIP_TAC THEN REWRITE_TAC[linear; GSYM VECTOR_EQ_LDOT] THEN
2493   ASM_SIMP_TAC[DOT_RMUL; DOT_RADD; GSYM ADJOINT_WORKS]);;
2494
2495 let ADJOINT_CLAUSES = prove
2496  (`!f:real^M->real^N.
2497      linear f ==> (!x y. x dot (adjoint f)(y) = f(x) dot y) /\
2498                   (!x y. (adjoint f)(y) dot x = y dot f(x))`,
2499   MESON_TAC[ADJOINT_WORKS; DOT_SYM]);;
2500
2501 let ADJOINT_ADJOINT = prove
2502  (`!f:real^M->real^N. linear f ==> adjoint(adjoint f) = f`,
2503   SIMP_TAC[FUN_EQ_THM; GSYM VECTOR_EQ_LDOT; ADJOINT_CLAUSES; ADJOINT_LINEAR]);;
2504
2505 let ADJOINT_UNIQUE = prove
2506  (`!f f'. linear f /\ (!x y. f'(x) dot y = x dot f(y))
2507           ==> f' = adjoint f`,
2508   SIMP_TAC[FUN_EQ_THM; GSYM VECTOR_EQ_RDOT; ADJOINT_CLAUSES]);;
2509
2510 let ADJOINT_COMPOSE = prove
2511  (`!f g:real^N->real^N.
2512         linear f /\ linear g ==> adjoint(f o g) = adjoint g o adjoint f`,
2513   REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC ADJOINT_UNIQUE THEN
2514   ASM_SIMP_TAC[LINEAR_COMPOSE; o_THM; ADJOINT_CLAUSES]);;
2515
2516 let SELF_ADJOINT_COMPOSE = prove
2517  (`!f g:real^N->real^N.
2518         linear f /\ linear g /\ adjoint f = f /\ adjoint g = g
2519         ==> (adjoint(f o g) = f o g <=> f o g = g o f)`,
2520   SIMP_TAC[ADJOINT_COMPOSE] THEN MESON_TAC[]);;
2521
2522 let SELF_ADJOINT_ORTHOGONAL_EIGENVECTORS = prove
2523  (`!f:real^N->real^N v w a b.
2524         linear f /\ adjoint f = f /\ f v = a % v /\ f w = b % w /\ ~(a = b)
2525         ==> orthogonal v w`,
2526   REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o SPECL [`v:real^N`; `w:real^N`] o
2527         MATCH_MP ADJOINT_WORKS) THEN
2528   ASM_REWRITE_TAC[DOT_LMUL; DOT_RMUL; orthogonal; REAL_EQ_MUL_RCANCEL]);;
2529
2530 (* ------------------------------------------------------------------------- *)
2531 (* Matrix notation. NB: an MxN matrix is of type real^N^M, not real^M^N.     *)
2532 (* We could define a special type if we're going to use them a lot.          *)
2533 (* ------------------------------------------------------------------------- *)
2534
2535 overload_interface ("--",`(matrix_neg):real^N^M->real^N^M`);;
2536 overload_interface ("+",`(matrix_add):real^N^M->real^N^M->real^N^M`);;
2537 overload_interface ("-",`(matrix_sub):real^N^M->real^N^M->real^N^M`);;
2538
2539 make_overloadable "**" `:A->B->C`;;
2540
2541 overload_interface ("**",`(matrix_mul):real^N^M->real^P^N->real^P^M`);;
2542 overload_interface ("**",`(matrix_vector_mul):real^N^M->real^N->real^M`);;
2543 overload_interface ("**",`(vector_matrix_mul):real^M->real^N^M->real^N`);;
2544
2545 parse_as_infix("%%",(21,"right"));;
2546
2547 prioritize_real();;
2548
2549 let matrix_cmul = new_definition
2550   `((%%):real->real^N^M->real^N^M) c A = lambda i j. c * A$i$j`;;
2551
2552 let matrix_neg = new_definition
2553   `!A:real^N^M. --A = lambda i j. --(A$i$j)`;;
2554
2555 let matrix_add = new_definition
2556   `!A:real^N^M B:real^N^M. A + B = lambda i j. A$i$j + B$i$j`;;
2557
2558 let matrix_sub = new_definition
2559   `!A:real^N^M B:real^N^M. A - B = lambda i j. A$i$j - B$i$j`;;
2560
2561 let matrix_mul = new_definition
2562   `!A:real^N^M B:real^P^N.
2563         A ** B =
2564           lambda i j. sum(1..dimindex(:N)) (\k. A$i$k * B$k$j)`;;
2565
2566 let matrix_vector_mul = new_definition
2567   `!A:real^N^M x:real^N.
2568         A ** x = lambda i. sum(1..dimindex(:N)) (\j. A$i$j * x$j)`;;
2569
2570 let vector_matrix_mul = new_definition
2571   `!A:real^N^M x:real^M.
2572         x ** A = lambda j. sum(1..dimindex(:M)) (\i. A$i$j * x$i)`;;
2573
2574 let mat = new_definition
2575   `(mat:num->real^N^M) k = lambda i j. if i = j then &k else &0`;;
2576
2577 let transp = new_definition
2578   `(transp:real^N^M->real^M^N) A = lambda i j. A$j$i`;;
2579
2580 let row = new_definition
2581  `(row:num->real^N^M->real^N) i A = lambda j. A$i$j`;;
2582
2583 let column = new_definition
2584  `(column:num->real^N^M->real^M) j A = lambda i. A$i$j`;;
2585
2586 let rows = new_definition
2587  `rows(A:real^N^M) = { row i A | 1 <= i /\ i <= dimindex(:M)}`;;
2588
2589 let columns = new_definition
2590  `columns(A:real^N^M) = { column i A | 1 <= i /\ i <= dimindex(:N)}`;;
2591
2592 let MATRIX_CMUL_COMPONENT = prove
2593  (`!c A:real^N^M i. (c %% A)$i$j = c * A$i$j`,
2594   REPEAT GEN_TAC THEN
2595   SUBGOAL_THEN `?k. 1 <= k /\ k <= dimindex(:M) /\ !A:real^N^M. A$i = A$k`
2596   CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN
2597   SUBGOAL_THEN `?l. 1 <= l /\ l <= dimindex(:N) /\ !z:real^N. z$j = z$l`
2598   CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN
2599   ASM_SIMP_TAC[matrix_cmul; CART_EQ; LAMBDA_BETA]);;
2600
2601 let MATRIX_ADD_COMPONENT = prove
2602  (`!A B:real^N^M i j. (A + B)$i$j = A$i$j + B$i$j`,
2603   REPEAT GEN_TAC THEN
2604   SUBGOAL_THEN `?k. 1 <= k /\ k <= dimindex(:M) /\ !A:real^N^M. A$i = A$k`
2605   CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN
2606   SUBGOAL_THEN `?l. 1 <= l /\ l <= dimindex(:N) /\ !z:real^N. z$j = z$l`
2607   CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN
2608   ASM_SIMP_TAC[matrix_add; LAMBDA_BETA]);;
2609
2610 let MATRIX_SUB_COMPONENT = prove
2611  (`!A B:real^N^M i j. (A - B)$i$j = A$i$j - B$i$j`,
2612   REPEAT GEN_TAC THEN
2613   SUBGOAL_THEN `?k. 1 <= k /\ k <= dimindex(:M) /\ !A:real^N^M. A$i = A$k`
2614   CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN
2615   SUBGOAL_THEN `?l. 1 <= l /\ l <= dimindex(:N) /\ !z:real^N. z$j = z$l`
2616   CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN
2617   ASM_SIMP_TAC[matrix_sub; LAMBDA_BETA]);;
2618
2619 let MATRIX_NEG_COMPONENT = prove
2620  (`!A:real^N^M i j. (--A)$i$j = --(A$i$j)`,
2621   REPEAT GEN_TAC THEN
2622   SUBGOAL_THEN `?k. 1 <= k /\ k <= dimindex(:M) /\ !A:real^N^M. A$i = A$k`
2623   CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN
2624   SUBGOAL_THEN `?l. 1 <= l /\ l <= dimindex(:N) /\ !z:real^N. z$j = z$l`
2625   CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN
2626   ASM_SIMP_TAC[matrix_neg; LAMBDA_BETA]);;
2627
2628 let TRANSP_COMPONENT = prove
2629  (`!A:real^N^M i j. (transp A)$i$j = A$j$i`,
2630   REPEAT GEN_TAC THEN
2631   SUBGOAL_THEN `?k. 1 <= k /\ k <= dimindex(:N) /\
2632                     (!A:real^M^N. A$i = A$k) /\ (!z:real^N. z$i = z$k)`
2633   CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE_2]; ALL_TAC] THEN
2634   SUBGOAL_THEN `?l. 1 <= l /\ l <= dimindex(:M) /\
2635                     (!A:real^N^M. A$j = A$l) /\ (!z:real^M. z$j = z$l)`
2636   CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE_2]; ALL_TAC] THEN
2637   ASM_SIMP_TAC[transp; LAMBDA_BETA]);;
2638
2639 let MAT_COMPONENT = prove
2640  (`!n i j.
2641         1 <= i /\ i <= dimindex(:M) /\
2642         1 <= j /\ j <= dimindex(:N)
2643         ==> (mat n:real^N^M)$i$j = if i = j then &n else &0`,
2644   SIMP_TAC[mat; LAMBDA_BETA]);;
2645
2646 let MAT_0_COMPONENT = prove
2647  (`!i j. (mat 0:real^N^M)$i$j = &0`,
2648   REPEAT GEN_TAC THEN
2649   SUBGOAL_THEN `?k. 1 <= k /\ k <= dimindex(:M) /\ !A:real^N^M. A$i = A$k`
2650   CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN
2651   SUBGOAL_THEN `?l. 1 <= l /\ l <= dimindex(:N) /\ !z:real^N. z$j = z$l`
2652   CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN
2653   ASM_SIMP_TAC[mat; COND_ID; LAMBDA_BETA]);;
2654
2655 let MATRIX_CMUL_ASSOC = prove
2656  (`!a b X:real^M^N. a %% (b %% X) = (a * b) %% X`,
2657   SIMP_TAC[CART_EQ; matrix_cmul; LAMBDA_BETA; REAL_MUL_ASSOC]);;
2658
2659 let MATRIX_CMUL_LID = prove
2660  (`!X:real^M^N. &1 %% X = X`,
2661   SIMP_TAC[CART_EQ; matrix_cmul; LAMBDA_BETA; REAL_MUL_LID]);;
2662
2663 let MATRIX_ADD_SYM = prove
2664  (`!A:real^N^M B. A + B = B + A`,
2665   SIMP_TAC[matrix_add; CART_EQ; LAMBDA_BETA; REAL_ADD_AC]);;
2666
2667 let MATRIX_ADD_ASSOC = prove
2668  (`!A:real^N^M B C. A + (B + C) = (A + B) + C`,
2669   SIMP_TAC[matrix_add; CART_EQ; LAMBDA_BETA; REAL_ADD_AC]);;
2670
2671 let MATRIX_ADD_LID = prove
2672  (`!A. mat 0 + A = A`,
2673   SIMP_TAC[matrix_add; mat; COND_ID; CART_EQ; LAMBDA_BETA; REAL_ADD_LID]);;
2674
2675 let MATRIX_ADD_RID = prove
2676  (`!A. A + mat 0 = A`,
2677   SIMP_TAC[matrix_add; mat; COND_ID; CART_EQ; LAMBDA_BETA; REAL_ADD_RID]);;
2678
2679 let MATRIX_ADD_LNEG = prove
2680  (`!A. --A + A = mat 0`,
2681   SIMP_TAC[matrix_neg; matrix_add; mat; COND_ID;
2682            CART_EQ; LAMBDA_BETA; REAL_ADD_LINV]);;
2683
2684 let MATRIX_ADD_RNEG = prove
2685  (`!A. A + --A = mat 0`,
2686   SIMP_TAC[matrix_neg; matrix_add; mat; COND_ID;
2687            CART_EQ; LAMBDA_BETA; REAL_ADD_RINV]);;
2688
2689 let MATRIX_SUB = prove
2690  (`!A:real^N^M B. A - B = A + --B`,
2691   SIMP_TAC[matrix_neg; matrix_add; matrix_sub; CART_EQ; LAMBDA_BETA;
2692            real_sub]);;
2693
2694 let MATRIX_SUB_REFL = prove
2695  (`!A. A - A = mat 0`,
2696   REWRITE_TAC[MATRIX_SUB; MATRIX_ADD_RNEG]);;
2697
2698 let MATRIX_ADD_LDISTRIB = prove
2699  (`!A:real^N^M B:real^P^N C. A ** (B + C) = A ** B + A ** C`,
2700   SIMP_TAC[matrix_mul; matrix_add; CART_EQ; LAMBDA_BETA;
2701            GSYM SUM_ADD_NUMSEG] THEN
2702   REPEAT STRIP_TAC THEN MATCH_MP_TAC SUM_EQ_NUMSEG THEN
2703   ASM_SIMP_TAC[LAMBDA_BETA; REAL_ADD_LDISTRIB]);;
2704
2705 let MATRIX_MUL_LID = prove
2706  (`!A:real^N^M. mat 1 ** A = A`,
2707   REWRITE_TAC[matrix_mul;
2708    GEN_REWRITE_RULE (RAND_CONV o ONCE_DEPTH_CONV) [EQ_SYM_EQ]
2709     (SPEC_ALL mat)] THEN
2710   SIMP_TAC[CART_EQ; LAMBDA_BETA] THEN REWRITE_TAC[COND_RATOR; COND_RAND] THEN
2711   SIMP_TAC[SUM_DELTA; REAL_MUL_LZERO; IN_NUMSEG; REAL_MUL_LID]);;
2712
2713 let MATRIX_MUL_RID = prove
2714  (`!A:real^N^M. A ** mat 1 = A`,
2715   REWRITE_TAC[matrix_mul; mat] THEN
2716   SIMP_TAC[CART_EQ; LAMBDA_BETA] THEN REWRITE_TAC[COND_RATOR; COND_RAND] THEN
2717   SIMP_TAC[SUM_DELTA; REAL_MUL_RZERO; IN_NUMSEG; REAL_MUL_RID]);;
2718
2719 let MATRIX_MUL_ASSOC = prove
2720  (`!A:real^N^M B:real^P^N C:real^Q^P. A ** B ** C = (A ** B) ** C`,
2721   REPEAT GEN_TAC THEN
2722   SIMP_TAC[matrix_mul; CART_EQ; LAMBDA_BETA; GSYM SUM_LMUL; GSYM SUM_RMUL] THEN
2723   REWRITE_TAC[REAL_MUL_ASSOC] THEN REPEAT STRIP_TAC THEN
2724   GEN_REWRITE_TAC RAND_CONV [SUM_SWAP_NUMSEG] THEN REWRITE_TAC[]);;
2725
2726 let MATRIX_MUL_LZERO = prove
2727  (`!A. (mat 0:real^N^M) ** (A:real^P^N) = mat 0`,
2728   SIMP_TAC[matrix_mul; mat; CART_EQ; LAMBDA_BETA; COND_ID; REAL_MUL_LZERO] THEN
2729   REWRITE_TAC[SUM_0]);;
2730
2731 let MATRIX_MUL_RZERO = prove
2732  (`!A. (A:real^N^M) ** (mat 0:real^P^N) = mat 0`,
2733   SIMP_TAC[matrix_mul; mat; CART_EQ; LAMBDA_BETA; COND_ID; REAL_MUL_RZERO] THEN
2734   REWRITE_TAC[SUM_0]);;
2735
2736 let MATRIX_ADD_RDISTRIB = prove
2737  (`!A:real^N^M B C:real^P^N. (A + B) ** C = A ** C + B ** C`,
2738   SIMP_TAC[matrix_mul; matrix_add; CART_EQ; LAMBDA_BETA] THEN
2739   REWRITE_TAC[REAL_ADD_RDISTRIB; SUM_ADD_NUMSEG]);;
2740
2741 let MATRIX_SUB_LDISTRIB = prove
2742  (`!A:real^N^M B C:real^P^N. A ** (B - C) = A ** B - A ** C`,
2743   SIMP_TAC[matrix_mul; matrix_sub; CART_EQ; LAMBDA_BETA] THEN
2744   REWRITE_TAC[REAL_SUB_LDISTRIB; SUM_SUB_NUMSEG]);;
2745
2746 let MATRIX_SUB_RDISTRIB = prove
2747  (`!A:real^N^M B C:real^P^N. (A - B) ** C = A ** C - B ** C`,
2748   SIMP_TAC[matrix_mul; matrix_sub; CART_EQ; LAMBDA_BETA] THEN
2749   REWRITE_TAC[REAL_SUB_RDISTRIB; SUM_SUB_NUMSEG]);;
2750
2751 let MATRIX_MUL_LMUL = prove
2752  (`!A:real^N^M B:real^P^N c. (c %% A) ** B = c %% (A ** B)`,
2753   SIMP_TAC[matrix_mul; matrix_cmul; CART_EQ; LAMBDA_BETA] THEN
2754   REWRITE_TAC[GSYM REAL_MUL_ASSOC; SUM_LMUL]);;
2755
2756 let MATRIX_MUL_RMUL = prove
2757  (`!A:real^N^M B:real^P^N c. A ** (c %% B) = c %% (A ** B)`,
2758   SIMP_TAC[matrix_mul; matrix_cmul; CART_EQ; LAMBDA_BETA] THEN
2759   ONCE_REWRITE_TAC[REAL_ARITH `A * c * B:real = c * A * B`] THEN
2760   REWRITE_TAC[SUM_LMUL]);;
2761
2762 let MATRIX_CMUL_ADD_LDISTRIB = prove
2763  (`!A:real^N^M B c. c %% (A + B) = c %% A + c %% B`,
2764   SIMP_TAC[matrix_cmul; matrix_add; CART_EQ; LAMBDA_BETA] THEN
2765   REWRITE_TAC[REAL_ADD_LDISTRIB]);;
2766
2767 let MATRIX_CMUL_SUB_LDISTRIB = prove
2768  (`!A:real^N^M B c. c %% (A - B) = c %% A - c %% B`,
2769   SIMP_TAC[matrix_cmul; matrix_sub; CART_EQ; LAMBDA_BETA] THEN
2770   REWRITE_TAC[REAL_SUB_LDISTRIB]);;
2771
2772 let MATRIX_CMUL_ADD_RDISTRIB = prove
2773  (`!A:real^N^M b c. (b + c) %% A = b %% A + c %% A`,
2774   SIMP_TAC[matrix_cmul; matrix_add; CART_EQ; LAMBDA_BETA] THEN
2775   REWRITE_TAC[REAL_ADD_RDISTRIB]);;
2776
2777 let MATRIX_CMUL_SUB_RDISTRIB = prove
2778  (`!A:real^N^M b c. (b - c) %% A = b %% A - c %% A`,
2779   SIMP_TAC[matrix_cmul; matrix_sub; CART_EQ; LAMBDA_BETA] THEN
2780   REWRITE_TAC[REAL_SUB_RDISTRIB]);;
2781
2782 let MATRIX_CMUL_RZERO = prove
2783  (`!c. c %% mat 0 = mat 0`,
2784   SIMP_TAC[matrix_cmul; mat; CART_EQ; LAMBDA_BETA; COND_ID; REAL_MUL_RZERO]);;
2785
2786 let MATRIX_CMUL_LZERO = prove
2787  (`!A. &0 %% A = mat 0`,
2788   SIMP_TAC[matrix_cmul; mat; CART_EQ; LAMBDA_BETA; COND_ID; REAL_MUL_LZERO]);;
2789
2790 let MATRIX_NEG_MINUS1 = prove
2791  (`!A:real^N^M. --A = --(&1) %% A`,
2792   REWRITE_TAC[matrix_cmul; matrix_neg; CART_EQ; LAMBDA_BETA] THEN
2793   REWRITE_TAC[GSYM REAL_NEG_MINUS1]);;
2794
2795 let MATRIX_ADD_AC = prove
2796  (`(A:real^N^M) + B = B + A /\
2797    (A + B) + C = A + (B + C) /\
2798    A + (B + C) = B + (A + C)`,
2799   MESON_TAC[MATRIX_ADD_ASSOC; MATRIX_ADD_SYM]);;
2800
2801 let MATRIX_NEG_ADD = prove
2802  (`!A B:real^N^M. --(A + B) = --A + --B`,
2803   SIMP_TAC[matrix_neg; matrix_add; CART_EQ; LAMBDA_BETA; REAL_NEG_ADD]);;
2804
2805 let MATRIX_NEG_SUB = prove
2806  (`!A B:real^N^M. --(A - B) = B - A`,
2807   SIMP_TAC[matrix_neg; matrix_sub; CART_EQ; LAMBDA_BETA; REAL_NEG_SUB]);;
2808
2809 let MATRIX_NEG_0 = prove
2810  (`--(mat 0) = mat 0`,
2811   SIMP_TAC[CART_EQ; mat; matrix_neg; LAMBDA_BETA; REAL_NEG_0; COND_ID]);;
2812
2813 let MATRIX_SUB_RZERO = prove
2814  (`!A:real^N^M. A - mat 0 = A`,
2815   SIMP_TAC[CART_EQ; mat; matrix_sub; LAMBDA_BETA; REAL_SUB_RZERO; COND_ID]);;
2816
2817 let MATRIX_SUB_LZERO = prove
2818  (`!A:real^N^M. mat 0 - A = --A`,
2819   SIMP_TAC[CART_EQ; mat; matrix_sub; matrix_neg;
2820            LAMBDA_BETA; REAL_SUB_LZERO; COND_ID]);;
2821
2822 let MATRIX_NEG_EQ_0 = prove
2823  (`!A:real^N^M. --A = mat 0 <=> A = mat 0`,
2824   SIMP_TAC[CART_EQ; matrix_neg; mat; LAMBDA_BETA; REAL_NEG_EQ_0; COND_ID]);;
2825
2826 let MATRIX_VECTOR_MUL_ASSOC = prove
2827  (`!A:real^N^M B:real^P^N x:real^P. A ** B ** x = (A ** B) ** x`,
2828   REPEAT GEN_TAC THEN
2829   SIMP_TAC[matrix_mul; matrix_vector_mul;
2830            CART_EQ; LAMBDA_BETA; GSYM SUM_LMUL; GSYM SUM_RMUL] THEN
2831   REWRITE_TAC[REAL_MUL_ASSOC] THEN REPEAT STRIP_TAC THEN
2832   GEN_REWRITE_TAC RAND_CONV [SUM_SWAP_NUMSEG] THEN REWRITE_TAC[]);;
2833
2834 let MATRIX_VECTOR_MUL_LID = prove
2835  (`!x:real^N. mat 1 ** x = x`,
2836   REWRITE_TAC[matrix_vector_mul;
2837    GEN_REWRITE_RULE (RAND_CONV o ONCE_DEPTH_CONV) [EQ_SYM_EQ]
2838     (SPEC_ALL mat)] THEN
2839   SIMP_TAC[CART_EQ; LAMBDA_BETA] THEN REWRITE_TAC[COND_RATOR; COND_RAND] THEN
2840   SIMP_TAC[SUM_DELTA; REAL_MUL_LZERO; IN_NUMSEG; REAL_MUL_LID]);;
2841
2842 let MATRIX_VECTOR_MUL_LZERO = prove
2843  (`!x:real^N. mat 0 ** x = vec 0`,
2844   SIMP_TAC[mat; matrix_vector_mul; CART_EQ; VEC_COMPONENT; LAMBDA_BETA;
2845            COND_ID; REAL_MUL_LZERO; SUM_0]);;
2846
2847 let MATRIX_VECTOR_MUL_RZERO = prove
2848  (`!A:real^M^N. A ** vec 0 = vec 0`,
2849   SIMP_TAC[mat; matrix_vector_mul; CART_EQ; VEC_COMPONENT; LAMBDA_BETA;
2850            COND_ID; REAL_MUL_RZERO; SUM_0]);;
2851
2852 let MATRIX_VECTOR_MUL_ADD_LDISTRIB = prove
2853  (`!A:real^M^N x:real^M y. A ** (x + y) = A ** x + A ** y`,
2854   SIMP_TAC[CART_EQ; matrix_vector_mul; VECTOR_ADD_COMPONENT; LAMBDA_BETA;
2855            SUM_ADD_NUMSEG; REAL_ADD_LDISTRIB]);;
2856
2857 let MATRIX_VECTOR_MUL_SUB_LDISTRIB = prove
2858  (`!A:real^M^N x:real^M y. A ** (x - y) = A ** x - A ** y`,
2859   SIMP_TAC[CART_EQ; matrix_vector_mul; VECTOR_SUB_COMPONENT; LAMBDA_BETA;
2860            SUM_SUB_NUMSEG; REAL_SUB_LDISTRIB]);;
2861
2862 let MATRIX_VECTOR_MUL_ADD_RDISTRIB = prove
2863  (`!A:real^M^N B x. (A + B) ** x = (A ** x) + (B ** x)`,
2864   SIMP_TAC[CART_EQ; matrix_vector_mul; matrix_add; LAMBDA_BETA;
2865            VECTOR_ADD_COMPONENT; REAL_ADD_RDISTRIB; SUM_ADD_NUMSEG]);;
2866
2867 let MATRIX_VECTOR_MUL_SUB_RDISTRIB = prove
2868  (`!A:real^M^N B x. (A - B) ** x = (A ** x) - (B ** x)`,
2869   SIMP_TAC[CART_EQ; matrix_vector_mul; matrix_sub; LAMBDA_BETA;
2870            VECTOR_SUB_COMPONENT; REAL_SUB_RDISTRIB; SUM_SUB_NUMSEG]);;
2871
2872 let MATRIX_VECTOR_MUL_RMUL = prove
2873  (`!A:real^M^N x:real^M c. A ** (c % x) = c % (A ** x)`,
2874   SIMP_TAC[CART_EQ; VECTOR_MUL_COMPONENT; matrix_vector_mul; LAMBDA_BETA] THEN
2875   REWRITE_TAC[GSYM SUM_LMUL] THEN REWRITE_TAC[REAL_MUL_AC]);;
2876
2877 let MATRIX_MUL_LNEG = prove
2878  (`!A:real^N^M B:real^P^N. (--A) ** B = --(A ** B)`,
2879   REWRITE_TAC[MATRIX_NEG_MINUS1; MATRIX_MUL_LMUL]);;
2880
2881 let MATRIX_MUL_RNEG = prove
2882  (`!A:real^N^M B:real^P^N. A ** --B = --(A ** B)`,
2883   REWRITE_TAC[MATRIX_NEG_MINUS1; MATRIX_MUL_RMUL]);;
2884
2885 let MATRIX_NEG_NEG = prove
2886  (`!A:real^N^N. --(--A) = A`,
2887   SIMP_TAC[CART_EQ; MATRIX_NEG_COMPONENT; REAL_NEG_NEG]);;
2888
2889 let MATRIX_TRANSP_MUL = prove
2890  (`!A B. transp(A ** B) = transp(B) ** transp(A)`,
2891   SIMP_TAC[matrix_mul; transp; CART_EQ; LAMBDA_BETA] THEN
2892   REWRITE_TAC[REAL_MUL_AC]);;
2893
2894 let SYMMETRIC_MATRIX_MUL = prove
2895  (`!A B:real^N^N.
2896         transp(A) = A /\ transp(B) = B
2897         ==> (transp(A ** B) = A ** B <=> A ** B = B ** A)`,
2898   SIMP_TAC[MATRIX_TRANSP_MUL] THEN MESON_TAC[]);;
2899
2900 let MATRIX_EQ = prove
2901  (`!A:real^N^M B. (A = B) = !x:real^N. A ** x = B ** x`,
2902   REPEAT GEN_TAC THEN EQ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN
2903   DISCH_THEN(MP_TAC o GEN `i:num` o SPEC `(basis i):real^N`) THEN
2904   SIMP_TAC[CART_EQ; matrix_vector_mul; LAMBDA_BETA; basis] THEN
2905   SIMP_TAC[SUM_DELTA; COND_RAND; REAL_MUL_RZERO] THEN
2906   REWRITE_TAC[TAUT `(if p then b else T) <=> p ==> b`] THEN
2907   SIMP_TAC[REAL_MUL_RID; IN_NUMSEG]);;
2908
2909 let MATRIX_VECTOR_MUL_COMPONENT = prove
2910  (`!A:real^N^M x k.
2911     1 <= k /\ k <= dimindex(:M) ==> ((A ** x)$k = (A$k) dot x)`,
2912   SIMP_TAC[matrix_vector_mul; LAMBDA_BETA; dot]);;
2913
2914 let DOT_LMUL_MATRIX = prove
2915  (`!A:real^N^M x:real^M y:real^N. (x ** A) dot y = x dot (A ** y)`,
2916   SIMP_TAC[dot; matrix_vector_mul; vector_matrix_mul; dot; LAMBDA_BETA] THEN
2917   REPEAT GEN_TAC THEN REWRITE_TAC[GSYM SUM_LMUL] THEN
2918   REWRITE_TAC[GSYM SUM_RMUL] THEN
2919   GEN_REWRITE_TAC RAND_CONV [SUM_SWAP_NUMSEG] THEN REWRITE_TAC[REAL_MUL_AC]);;
2920
2921 let TRANSP_MATRIX_CMUL = prove
2922  (`!A:real^M^N c. transp(c %% A) = c %% transp A`,
2923   SIMP_TAC[CART_EQ; transp; MATRIX_CMUL_COMPONENT; LAMBDA_BETA]);;
2924
2925 let TRANSP_MATRIX_ADD = prove
2926  (`!A B:real^N^M. transp(A + B) = transp A + transp B`,
2927   SIMP_TAC[CART_EQ; transp; LAMBDA_BETA; matrix_add]);;
2928
2929 let TRANSP_MATRIX_SUB = prove
2930  (`!A B:real^N^M. transp(A - B) = transp A - transp B`,
2931   SIMP_TAC[CART_EQ; transp; LAMBDA_BETA; matrix_sub]);;
2932
2933 let TRANSP_MATRIX_NEG = prove
2934  (`!A:real^N^M. transp(--A) = --(transp A)`,
2935   SIMP_TAC[CART_EQ; transp; LAMBDA_BETA; matrix_neg]);;
2936
2937 let TRANSP_MAT = prove
2938  (`!n. transp(mat n) = mat n`,
2939   SIMP_TAC[transp; mat; LAMBDA_BETA; CART_EQ; EQ_SYM_EQ]);;
2940
2941 let TRANSP_TRANSP = prove
2942  (`!A:real^N^M. transp(transp A) = A`,
2943   SIMP_TAC[CART_EQ; transp; LAMBDA_BETA]);;
2944
2945 let SYMMETRIX_MATRIX_CONJUGATE = prove
2946  (`!A B:real^N^N. transp B = B
2947                   ==> transp(transp A ** B ** A) = transp A ** B ** A`,
2948   SIMP_TAC[MATRIX_TRANSP_MUL; TRANSP_TRANSP; MATRIX_MUL_ASSOC]);;
2949
2950 let TRANSP_EQ = prove
2951  (`!A B:real^M^N. transp A = transp B <=> A = B`,
2952   MESON_TAC[TRANSP_TRANSP]);;
2953
2954 let ROW_TRANSP = prove
2955  (`!A:real^N^M i.
2956         1 <= i /\ i <= dimindex(:N) ==> row i (transp A) = column i A`,
2957   SIMP_TAC[row; column; transp; CART_EQ; LAMBDA_BETA]);;
2958
2959 let COLUMN_TRANSP = prove
2960  (`!A:real^N^M i.
2961         1 <= i /\ i <= dimindex(:M) ==> column i (transp A) = row i A`,
2962   SIMP_TAC[row; column; transp; CART_EQ; LAMBDA_BETA]);;
2963
2964 let ROWS_TRANSP = prove
2965  (`!A:real^N^M. rows(transp A) = columns A`,
2966   REWRITE_TAC[rows; columns; EXTENSION; IN_ELIM_THM] THEN
2967   MESON_TAC[ROW_TRANSP]);;
2968
2969 let COLUMNS_TRANSP = prove
2970  (`!A:real^N^M. columns(transp A) = rows A`,
2971   MESON_TAC[TRANSP_TRANSP; ROWS_TRANSP]);;
2972
2973 let VECTOR_MATRIX_MUL_TRANSP = prove
2974  (`!A:real^M^N x:real^N. x ** A = transp A ** x`,
2975   REWRITE_TAC[matrix_vector_mul; vector_matrix_mul; transp] THEN
2976   SIMP_TAC[LAMBDA_BETA; CART_EQ]);;
2977
2978 let MATRIX_VECTOR_MUL_TRANSP = prove
2979  (`!A:real^M^N x:real^M. A ** x = x ** transp A`,
2980   REWRITE_TAC[VECTOR_MATRIX_MUL_TRANSP; TRANSP_TRANSP]);;
2981
2982 let FINITE_ROWS = prove
2983  (`!A:real^N^M. FINITE(rows A)`,
2984   REWRITE_TAC[rows] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN
2985   SIMP_TAC[GSYM numseg; FINITE_IMAGE; FINITE_NUMSEG]);;
2986
2987 let FINITE_COLUMNS = prove
2988  (`!A:real^N^M. FINITE(columns A)`,
2989   REWRITE_TAC[columns] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN
2990   SIMP_TAC[GSYM numseg; FINITE_IMAGE; FINITE_NUMSEG]);;
2991
2992 let MATRIX_EQUAL_ROWS = prove
2993  (`!A B:real^N^M.
2994         A = B <=> !i. 1 <= i /\ i <= dimindex(:M) ==> row i A = row i B`,
2995   SIMP_TAC[row; CART_EQ; LAMBDA_BETA]);;
2996
2997 let MATRIX_EQUAL_COLUMNS = prove
2998  (`!A B:real^N^M.
2999         A = B <=> !i. 1 <= i /\ i <= dimindex(:N) ==> column i A = column i B`,
3000   SIMP_TAC[column; CART_EQ; LAMBDA_BETA] THEN MESON_TAC[]);;
3001
3002 let MATRIX_CMUL_EQ_0 = prove
3003  (`!A:real^M^N c. c %% A = mat 0 <=> c = &0 \/ A = mat 0`,
3004   SIMP_TAC[CART_EQ; MATRIX_CMUL_COMPONENT; MAT_COMPONENT; COND_ID] THEN
3005   REPEAT GEN_TAC THEN ASM_CASES_TAC `c = &0` THEN
3006   ASM_REWRITE_TAC[REAL_ENTIRE]);;
3007
3008 let MAT_EQ = prove
3009  (`!m n. mat m = mat n <=> m = n`,
3010   SIMP_TAC[CART_EQ; MAT_COMPONENT] THEN REPEAT STRIP_TAC THEN
3011   MESON_TAC[REAL_OF_NUM_EQ; DIMINDEX_GE_1; LE_REFL]);;
3012
3013 (* ------------------------------------------------------------------------- *)
3014 (* Two sometimes fruitful ways of looking at matrix-vector multiplication.   *)
3015 (* ------------------------------------------------------------------------- *)
3016
3017 let MATRIX_MUL_DOT = prove
3018  (`!A:real^N^M x. A ** x = lambda i. A$i dot x`,
3019   REWRITE_TAC[matrix_vector_mul; dot] THEN SIMP_TAC[CART_EQ; LAMBDA_BETA]);;
3020
3021 let MATRIX_MUL_VSUM = prove
3022  (`!A:real^N^M x. A ** x = vsum(1..dimindex(:N)) (\i. x$i % column i A)`,
3023   SIMP_TAC[matrix_vector_mul; CART_EQ; VSUM_COMPONENT; LAMBDA_BETA;
3024            VECTOR_MUL_COMPONENT; column; REAL_MUL_AC]);;
3025
3026 (* ------------------------------------------------------------------------- *)
3027 (* Slightly gruesome lemmas: better to define sums over vectors really...    *)
3028 (* ------------------------------------------------------------------------- *)
3029
3030 let VECTOR_COMPONENTWISE = prove
3031  (`!x:real^N.
3032     x = lambda j. sum(1..dimindex(:N))
3033                      (\i. x$i * (basis i :real^N)$j)`,
3034   SIMP_TAC[CART_EQ; LAMBDA_BETA; basis] THEN
3035   ONCE_REWRITE_TAC[ARITH_RULE `(m:num = n) <=> (n = m)`] THEN
3036   SIMP_TAC[COND_RAND; REAL_MUL_RZERO; SUM_DELTA; IN_NUMSEG] THEN
3037   REWRITE_TAC[REAL_MUL_RID; COND_ID]);;
3038
3039 let LINEAR_COMPONENTWISE_EXPANSION = prove
3040  (`!f:real^M->real^N.
3041       linear(f)
3042       ==> !x j. 1 <= j /\ j <= dimindex(:N)
3043                 ==> (f x $j =
3044                      sum(1..dimindex(:M)) (\i. x$i * f(basis i)$j))`,
3045   REWRITE_TAC[linear] THEN REPEAT STRIP_TAC THEN
3046   GEN_REWRITE_TAC (LAND_CONV o LAND_CONV o RAND_CONV)
3047    [VECTOR_COMPONENTWISE] THEN
3048   SPEC_TAC(`dimindex(:M)`,`n:num`) THEN
3049   INDUCT_TAC THEN REWRITE_TAC[SUM_CLAUSES_NUMSEG; ARITH] THENL
3050    [REWRITE_TAC[GSYM vec] THEN
3051     GEN_REWRITE_TAC (LAND_CONV o LAND_CONV o RAND_CONV)
3052      [GSYM VECTOR_MUL_LZERO] THEN
3053     ASM_REWRITE_TAC[] THEN REWRITE_TAC[VECTOR_MUL_LZERO] THEN
3054     ASM_SIMP_TAC[vec; LAMBDA_BETA];
3055     REWRITE_TAC[ARITH_RULE `1 <= SUC n`] THEN
3056     ASSUM_LIST(fun thl -> REWRITE_TAC(map GSYM thl)) THEN
3057     SIMP_TAC[GSYM VECTOR_MUL_COMPONENT;
3058              ASSUME `1 <= j`; ASSUME `j <= dimindex(:N)`] THEN
3059     ASSUM_LIST(fun thl -> REWRITE_TAC(map GSYM thl)) THEN
3060     SIMP_TAC[GSYM VECTOR_ADD_COMPONENT;
3061              ASSUME `1 <= j`; ASSUME `j <= dimindex(:N)`] THEN
3062     ASSUM_LIST(fun thl -> REWRITE_TAC(map GSYM thl)) THEN
3063     AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN
3064     ASM_SIMP_TAC[CART_EQ; VECTOR_ADD_COMPONENT; LAMBDA_BETA] THEN
3065     SIMP_TAC[VECTOR_MUL_COMPONENT]]);;
3066
3067 (* ------------------------------------------------------------------------- *)
3068 (* Inverse matrices (not necessarily square, but it's vacuous otherwise).    *)
3069 (* ------------------------------------------------------------------------- *)
3070
3071 let invertible = new_definition
3072   `invertible(A:real^N^M) <=>
3073         ?A':real^M^N. (A ** A' = mat 1) /\ (A' ** A = mat 1)`;;
3074
3075 let matrix_inv = new_definition
3076   `matrix_inv(A:real^N^M) =
3077         @A':real^M^N. (A ** A' = mat 1) /\ (A' ** A = mat 1)`;;
3078
3079 let MATRIX_INV = prove
3080  (`!A:real^N^M.
3081     invertible A ==> A ** matrix_inv A = mat 1 /\ matrix_inv A ** A = mat 1`,
3082   GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[matrix_inv; invertible] THEN
3083   CONV_TAC SELECT_CONV THEN ASM_REWRITE_TAC[GSYM invertible]);;
3084
3085 let MATRIX_INV_UNIQUE = prove
3086  (`!A:real^N^M B. A ** B = mat 1 /\ B ** A = mat 1 ==> matrix_inv A = B`,
3087   REPEAT STRIP_TAC THEN MP_TAC(ISPEC `A:real^N^M` MATRIX_INV) THEN
3088   ANTS_TAC THENL [ASM_MESON_TAC[invertible]; ALL_TAC] THEN
3089   DISCH_THEN(MP_TAC o
3090     AP_TERM `(( ** ):real^M^N->real^M^M->real^M^N) B` o CONJUNCT1) THEN
3091   ASM_REWRITE_TAC[MATRIX_MUL_ASSOC; MATRIX_MUL_LID; MATRIX_MUL_RID]);;
3092
3093 let INVERTIBLE_NEG = prove
3094  (`!A:real^N^M. invertible(--A) <=> invertible A`,
3095   REWRITE_TAC[invertible] THEN
3096   MESON_TAC[MATRIX_MUL_LNEG; MATRIX_MUL_RNEG; MATRIX_NEG_NEG]);;
3097
3098 let MATRIX_INV_I = prove
3099  (`matrix_inv(mat 1:real^N^N) = mat 1`,
3100   MATCH_MP_TAC MATRIX_INV_UNIQUE THEN
3101   REWRITE_TAC[MATRIX_MUL_LID]);;
3102
3103 (* ------------------------------------------------------------------------- *)
3104 (* Correspondence between matrices and linear operators.                     *)
3105 (* ------------------------------------------------------------------------- *)
3106
3107 let matrix = new_definition
3108   `(matrix:(real^M->real^N)->real^M^N) f = lambda i j. f(basis j)$i`;;
3109
3110 let MATRIX_VECTOR_MUL_LINEAR = prove
3111  (`!A:real^N^M. linear(\x. A ** x)`,
3112   REWRITE_TAC[linear; matrix_vector_mul] THEN
3113   SIMP_TAC[CART_EQ; LAMBDA_BETA; VECTOR_ADD_COMPONENT;
3114     VECTOR_MUL_COMPONENT] THEN
3115   REWRITE_TAC[GSYM SUM_ADD_NUMSEG; GSYM SUM_LMUL; REAL_ADD_LDISTRIB] THEN
3116   REWRITE_TAC[REAL_ADD_AC; REAL_MUL_AC]);;
3117
3118 let MATRIX_WORKS = prove
3119  (`!f:real^M->real^N. linear f ==> !x. matrix f ** x = f(x)`,
3120   REWRITE_TAC[matrix; matrix_vector_mul] THEN
3121   SIMP_TAC[CART_EQ; LAMBDA_BETA] THEN GEN_TAC THEN DISCH_TAC THEN
3122   REPEAT GEN_TAC THEN DISCH_TAC THEN
3123   ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
3124   ASM_SIMP_TAC[GSYM LINEAR_COMPONENTWISE_EXPANSION]);;
3125
3126 let MATRIX_VECTOR_MUL = prove
3127  (`!f:real^M->real^N. linear f ==> f = \x. matrix f ** x`,
3128   SIMP_TAC[FUN_EQ_THM; MATRIX_WORKS]);;
3129
3130 let MATRIX_OF_MATRIX_VECTOR_MUL = prove
3131  (`!A:real^N^M. matrix(\x. A ** x) = A`,
3132   SIMP_TAC[MATRIX_EQ; MATRIX_VECTOR_MUL_LINEAR; MATRIX_WORKS]);;
3133
3134 let MATRIX_COMPOSE = prove
3135  (`!f g. linear f /\ linear g ==> (matrix(g o f) = matrix g ** matrix f)`,
3136   SIMP_TAC[MATRIX_EQ; MATRIX_WORKS; LINEAR_COMPOSE;
3137            GSYM MATRIX_VECTOR_MUL_ASSOC; o_THM]);;
3138
3139 let MATRIX_VECTOR_COLUMN = prove
3140  (`!A:real^N^M x.
3141         A ** x = vsum(1..dimindex(:N)) (\i. x$i % (transp A)$i)`,
3142   REWRITE_TAC[matrix_vector_mul; transp] THEN
3143   SIMP_TAC[CART_EQ; LAMBDA_BETA; VSUM_COMPONENT; VECTOR_MUL_COMPONENT] THEN
3144   REWRITE_TAC[REAL_MUL_AC]);;
3145
3146 let MATRIX_MUL_COMPONENT = prove
3147  (`!i. 1 <= i /\ i <= dimindex(:N)
3148        ==> ((A:real^N^N) ** (B:real^N^N))$i = transp B ** A$i`,
3149   SIMP_TAC[matrix_mul; LAMBDA_BETA; matrix_vector_mul; vector_matrix_mul;
3150        transp; CART_EQ] THEN
3151   REPEAT STRIP_TAC THEN MATCH_MP_TAC SUM_EQ_NUMSEG THEN
3152   REWRITE_TAC[REAL_MUL_AC]);;
3153
3154 let ADJOINT_MATRIX = prove
3155  (`!A:real^N^M. adjoint(\x. A ** x) = (\x. transp A ** x)`,
3156   GEN_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC ADJOINT_UNIQUE THEN
3157   REWRITE_TAC[MATRIX_VECTOR_MUL_LINEAR] THEN REPEAT GEN_TAC THEN
3158   SIMP_TAC[transp; dot; LAMBDA_BETA; matrix_vector_mul;
3159            GSYM SUM_LMUL; GSYM SUM_RMUL] THEN
3160   GEN_REWRITE_TAC LAND_CONV [SUM_SWAP_NUMSEG] THEN REWRITE_TAC[REAL_MUL_AC]);;
3161
3162 let MATRIX_ADJOINT = prove
3163  (`!f. linear f ==> matrix(adjoint f) = transp(matrix f)`,
3164   GEN_TAC THEN DISCH_THEN
3165    (fun th -> GEN_REWRITE_TAC (LAND_CONV o funpow 2 RAND_CONV)
3166                 [MATCH_MP MATRIX_VECTOR_MUL th]) THEN
3167   REWRITE_TAC[ADJOINT_MATRIX; MATRIX_OF_MATRIX_VECTOR_MUL]);;
3168
3169 let MATRIX_ID = prove
3170  (`matrix(\x. x) = mat 1`,
3171   SIMP_TAC[MATRIX_EQ; LINEAR_ID; MATRIX_WORKS; MATRIX_VECTOR_MUL_LID]);;
3172
3173 let MATRIX_I = prove
3174  (`matrix I = mat 1`,
3175   REWRITE_TAC[I_DEF; MATRIX_ID]);;
3176
3177 let LINEAR_EQ_MATRIX = prove
3178  (`!f g. linear f /\ linear g /\ matrix f = matrix g ==> f = g`,
3179   REPEAT STRIP_TAC THEN
3180   REPEAT(FIRST_X_ASSUM(SUBST1_TAC o MATCH_MP MATRIX_VECTOR_MUL)) THEN
3181   ASM_REWRITE_TAC[]);;
3182
3183 let MATRIX_SELF_ADJOINT = prove
3184  (`!f. linear f ==> (adjoint f = f <=> transp(matrix f) = matrix f)`,
3185   SIMP_TAC[GSYM MATRIX_ADJOINT] THEN
3186   MESON_TAC[LINEAR_EQ_MATRIX; ADJOINT_LINEAR]);;
3187
3188 let LINEAR_MATRIX_EXISTS = prove
3189  (`!f:real^M->real^N. linear f <=> ?A:real^M^N. f = \x. A ** x`,
3190   GEN_TAC THEN EQ_TAC THEN
3191   SIMP_TAC[MATRIX_VECTOR_MUL_LINEAR; LEFT_IMP_EXISTS_THM] THEN
3192   DISCH_TAC THEN EXISTS_TAC `matrix(f:real^M->real^N)` THEN
3193   ASM_SIMP_TAC[GSYM MATRIX_VECTOR_MUL]);;
3194
3195 let LINEAR_1 = prove
3196  (`!f:real^1->real^1. linear f <=> ?c. f = \x. c % x`,
3197   SIMP_TAC[LINEAR_MATRIX_EXISTS; EXISTS_VECTOR_1] THEN
3198   SIMP_TAC[FUN_EQ_THM; CART_EQ; FORALL_1; DIMINDEX_1; VECTOR_1;
3199            matrix_vector_mul; SUM_1; CART_EQ; LAMBDA_BETA;
3200            VECTOR_MUL_COMPONENT]);;
3201
3202 let SYMMETRIC_MATRIX = prove
3203  (`!A:real^N^N. transp A = A <=> adjoint(\x. A ** x) = \x. A ** x`,
3204   SIMP_TAC[MATRIX_SELF_ADJOINT; MATRIX_VECTOR_MUL_LINEAR] THEN
3205   REWRITE_TAC[MATRIX_OF_MATRIX_VECTOR_MUL]);;
3206
3207 let SYMMETRIC_MATRIX_ORTHOGONAL_EIGENVECTORS = prove
3208  (`!A:real^N^N v w a b.
3209         transp A = A /\ A ** v = a % v /\ A ** w = b % w /\ ~(a = b)
3210         ==> orthogonal v w`,
3211   REPEAT GEN_TAC THEN REWRITE_TAC[SYMMETRIC_MATRIX] THEN
3212   DISCH_THEN(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ_ALT]
3213         SELF_ADJOINT_ORTHOGONAL_EIGENVECTORS)) THEN
3214   REWRITE_TAC[MATRIX_VECTOR_MUL_LINEAR]);;
3215
3216 (* ------------------------------------------------------------------------- *)
3217 (* Operator norm.                                                            *)
3218 (* ------------------------------------------------------------------------- *)
3219
3220 let onorm = new_definition
3221  `onorm (f:real^M->real^N) = sup { norm(f x) | norm(x) = &1 }`;;
3222
3223 let NORM_BOUND_GENERALIZE = prove
3224  (`!f:real^M->real^N b.
3225         linear f
3226         ==> ((!x. (norm(x) = &1) ==> norm(f x) <= b) <=>
3227              (!x. norm(f x) <= b * norm(x)))`,
3228   REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THENL
3229    [ALL_TAC; ASM_MESON_TAC[REAL_MUL_RID]] THEN
3230   X_GEN_TAC `x:real^M` THEN ASM_CASES_TAC `x:real^M = vec 0` THENL
3231    [ASM_REWRITE_TAC[NORM_0; REAL_MUL_RZERO] THEN
3232     ASM_MESON_TAC[LINEAR_0; NORM_0; REAL_LE_REFL];
3233     ALL_TAC] THEN
3234   ASM_SIMP_TAC[GSYM REAL_LE_LDIV_EQ; NORM_POS_LT; real_div] THEN
3235   MATCH_MP_TAC(REAL_ARITH `abs(a * b) <= c ==> b * a <= c`) THEN
3236   REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_NORM; GSYM NORM_MUL] THEN
3237   FIRST_ASSUM(fun th -> REWRITE_TAC[GSYM(MATCH_MP LINEAR_CMUL th)]) THEN
3238   ASM_SIMP_TAC[NORM_MUL; REAL_ABS_INV; REAL_ABS_NORM; REAL_MUL_LINV;
3239                NORM_EQ_0]);;
3240
3241 let ONORM = prove
3242  (`!f:real^M->real^N.
3243         linear f
3244         ==> (!x. norm(f x) <= onorm f * norm(x)) /\
3245             (!b. (!x. norm(f x) <= b * norm(x)) ==> onorm f <= b)`,
3246   GEN_TAC THEN DISCH_TAC THEN
3247   MP_TAC(SPEC `{ norm((f:real^M->real^N) x) | norm(x) = &1 }` SUP) THEN
3248   SIMP_TAC[IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN
3249   ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN
3250   REWRITE_TAC[LEFT_FORALL_IMP_THM; RIGHT_EXISTS_AND_THM; EXISTS_REFL] THEN
3251   ASM_SIMP_TAC[NORM_BOUND_GENERALIZE; GSYM onorm; GSYM MEMBER_NOT_EMPTY] THEN
3252   DISCH_THEN MATCH_MP_TAC THEN REWRITE_TAC[IN_ELIM_THM] THEN
3253   ASM_MESON_TAC[VECTOR_CHOOSE_SIZE; LINEAR_BOUNDED; REAL_POS]);;
3254
3255 let ONORM_POS_LE = prove
3256  (`!f. linear f ==> &0 <= onorm f`,
3257   MESON_TAC[ONORM; VECTOR_CHOOSE_SIZE; REAL_POS; REAL_MUL_RID; NORM_POS_LE;
3258             REAL_LE_TRANS]);;
3259
3260 let ONORM_EQ_0 = prove
3261  (`!f:real^M->real^N. linear f ==> ((onorm f = &0) <=> (!x. f x = vec 0))`,
3262   REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THEN
3263   MP_TAC(SPEC `f:real^M->real^N` ONORM) THEN
3264   ASM_SIMP_TAC[GSYM REAL_LE_ANTISYM; ONORM_POS_LE; NORM_0; REAL_MUL_LZERO;
3265                NORM_LE_0; REAL_LE_REFL]);;
3266
3267 let ONORM_CONST = prove
3268  (`!y:real^N. onorm(\x:real^M. y) = norm(y)`,
3269   GEN_TAC THEN REWRITE_TAC[onorm] THEN
3270   MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `sup {norm(y:real^N)}` THEN
3271   CONJ_TAC THENL
3272    [AP_TERM_TAC THEN MATCH_MP_TAC(SET_RULE
3273      `(?x. P x) ==> {f y | x | P x} = {f y}`) THEN
3274     EXISTS_TAC `basis 1 :real^M` THEN
3275     SIMP_TAC[NORM_BASIS; DIMINDEX_GE_1; LE_REFL];
3276     MATCH_MP_TAC REAL_SUP_UNIQUE THEN SET_TAC[REAL_LE_REFL]]);;
3277
3278 let ONORM_POS_LT = prove
3279  (`!f. linear f ==> (&0 < onorm f <=> ~(!x. f x = vec 0))`,
3280   SIMP_TAC[GSYM ONORM_EQ_0; ONORM_POS_LE;
3281            REAL_ARITH `(&0 < x <=> ~(x = &0)) <=> &0 <= x`]);;
3282
3283 let ONORM_COMPOSE = prove
3284  (`!f g. linear f /\ linear g ==> onorm(f o g) <= onorm f * onorm g`,
3285   MESON_TAC[ONORM; LINEAR_COMPOSE; o_THM; REAL_MUL_ASSOC; REAL_LE_TRANS; ONORM;
3286             REAL_LE_LMUL; ONORM_POS_LE]);;
3287
3288 let ONORM_NEG_LEMMA = prove
3289  (`!f. linear f ==> onorm(\x. --(f x)) <= onorm f`,
3290   REPEAT STRIP_TAC THEN
3291   FIRST_ASSUM(STRIP_ASSUME_TAC o MATCH_MP ONORM o
3292     MATCH_MP LINEAR_COMPOSE_NEG) THEN
3293   FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[NORM_NEG; ONORM]);;
3294
3295 let ONORM_NEG = prove
3296  (`!f:real^M->real^N. linear f ==> (onorm(\x. --(f x)) = onorm f)`,
3297   REPEAT STRIP_TAC THEN  REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN
3298   ASM_SIMP_TAC[ONORM_NEG_LEMMA] THEN
3299   SUBGOAL_THEN `f:real^M->real^N = \x. --(--(f x))`
3300    (fun th -> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [th]) THEN
3301   ASM_SIMP_TAC[ONORM_NEG_LEMMA; LINEAR_COMPOSE_NEG] THEN
3302   REWRITE_TAC[VECTOR_NEG_NEG; ETA_AX]);;
3303
3304 let ONORM_TRIANGLE = prove
3305  (`!f:real^M->real^N g.
3306         linear f /\ linear g ==> onorm(\x. f x + g x) <= onorm f + onorm g`,
3307   REPEAT GEN_TAC THEN DISCH_TAC THEN
3308   FIRST_ASSUM(MATCH_MP_TAC o CONJUNCT2 o MATCH_MP ONORM o MATCH_MP
3309               LINEAR_COMPOSE_ADD) THEN
3310   REWRITE_TAC[REAL_ADD_RDISTRIB] THEN
3311   ASM_MESON_TAC[REAL_LE_ADD2; REAL_LE_TRANS; NORM_TRIANGLE; ONORM]);;
3312
3313 let ONORM_TRIANGLE_LE = prove
3314  (`!f g. linear f /\ linear g /\ onorm(f) + onorm(g) <= e
3315          ==> onorm(\x. f x + g x) <= e`,
3316   MESON_TAC[REAL_LE_TRANS; ONORM_TRIANGLE]);;
3317
3318 let ONORM_TRIANGLE_LT = prove
3319  (`!f g. linear f /\ linear g /\ onorm(f) + onorm(g) < e
3320          ==> onorm(\x. f x + g x) < e`,
3321   MESON_TAC[REAL_LET_TRANS; ONORM_TRIANGLE]);;
3322
3323 let ONORM_ID = prove
3324  (`onorm(\x:real^N. x) = &1`,
3325   REWRITE_TAC[onorm] THEN
3326   SUBGOAL_THEN `{norm(x:real^N) | norm x = &1} = {&1}`
3327    (fun th -> REWRITE_TAC[th; SUP_SING]) THEN
3328   SUBGOAL_THEN `norm(basis 1:real^N) = &1` MP_TAC THENL
3329    [SIMP_TAC[NORM_BASIS; DIMINDEX_GE_1; LE_REFL]; SET_TAC[]]);;
3330
3331 let ONORM_I = prove
3332  (`onorm(I:real^N->real^N) = &1`,
3333   REWRITE_TAC[I_DEF; ONORM_ID]);;
3334
3335 (* ------------------------------------------------------------------------- *)
3336 (* It's handy to "lift" from R to R^1 and "drop" from R^1 to R.              *)
3337 (* ------------------------------------------------------------------------- *)
3338
3339 let lift = new_definition
3340  `(lift:real->real^1) x = lambda i. x`;;
3341
3342 let drop = new_definition
3343  `(drop:real^1->real) x = x$1`;;
3344
3345 let LIFT_COMPONENT = prove
3346  (`!x. (lift x)$1 = x`,
3347   SIMP_TAC[lift; LAMBDA_BETA; DIMINDEX_1; LE_ANTISYM]);;
3348
3349 let LIFT_DROP = prove
3350  (`(!x. lift(drop x) = x) /\ (!x. drop(lift x) = x)`,
3351   SIMP_TAC[lift; drop; CART_EQ; LAMBDA_BETA; DIMINDEX_1; LE_ANTISYM]);;
3352
3353 let IMAGE_LIFT_DROP = prove
3354  (`(!s. IMAGE (lift o drop) s = s) /\ (!s. IMAGE (drop o lift) s = s)`,
3355   REWRITE_TAC[o_DEF; LIFT_DROP] THEN SET_TAC[]);;
3356
3357 let IN_IMAGE_LIFT_DROP = prove
3358  (`(!x s. x IN IMAGE lift s <=> drop x IN s) /\
3359    (!x s. x IN IMAGE drop s <=> lift x IN s)`,
3360   REWRITE_TAC[IN_IMAGE] THEN MESON_TAC[LIFT_DROP]);;
3361
3362 let FORALL_LIFT = prove
3363  (`(!x. P x) = (!x. P(lift x))`,
3364   MESON_TAC[LIFT_DROP]);;
3365
3366 let EXISTS_LIFT = prove
3367  (`(?x. P x) = (?x. P(lift x))`,
3368   MESON_TAC[LIFT_DROP]);;
3369
3370 let FORALL_DROP = prove
3371  (`(!x. P x) = (!x. P(drop x))`,
3372   MESON_TAC[LIFT_DROP]);;
3373
3374 let EXISTS_DROP = prove
3375  (`(?x. P x) = (?x. P(drop x))`,
3376   MESON_TAC[LIFT_DROP]);;
3377
3378 let FORALL_LIFT_FUN = prove
3379  (`!P:(A->real^1)->bool. (!f. P f) <=> (!f. P(lift o f))`,
3380   GEN_TAC THEN EQ_TAC THEN SIMP_TAC[] THEN DISCH_TAC THEN
3381   X_GEN_TAC `f:A->real^1` THEN
3382   FIRST_X_ASSUM(MP_TAC o SPEC `drop o (f:A->real^1)`) THEN
3383   REWRITE_TAC[o_DEF; LIFT_DROP; ETA_AX]);;
3384
3385 let FORALL_DROP_FUN = prove
3386  (`!P:(A->real)->bool. (!f. P f) <=> (!f. P(drop o f))`,
3387   REWRITE_TAC[FORALL_LIFT_FUN; o_DEF; LIFT_DROP; ETA_AX]);;
3388
3389 let EXISTS_LIFT_FUN = prove
3390  (`!P:(A->real^1)->bool. (?f. P f) <=> (?f. P(lift o f))`,
3391   ONCE_REWRITE_TAC[MESON[] `(?x. P x) <=> ~(!x. ~P x)`] THEN
3392   REWRITE_TAC[FORALL_LIFT_FUN]);;
3393
3394 let EXISTS_DROP_FUN = prove
3395  (`!P:(A->real)->bool. (?f. P f) <=> (?f. P(drop o f))`,
3396   ONCE_REWRITE_TAC[MESON[] `(?x. P x) <=> ~(!x. ~P x)`] THEN
3397   REWRITE_TAC[FORALL_DROP_FUN]);;
3398
3399 let LIFT_EQ = prove
3400  (`!x y. (lift x = lift y) <=> (x = y)`,
3401   MESON_TAC[LIFT_DROP]);;
3402
3403 let DROP_EQ = prove
3404  (`!x y. (drop x = drop y) <=> (x = y)`,
3405   MESON_TAC[LIFT_DROP]);;
3406
3407 let LIFT_IN_IMAGE_LIFT = prove
3408  (`!x s. (lift x) IN (IMAGE lift s) <=> x IN s`,
3409   REWRITE_TAC[IN_IMAGE] THEN MESON_TAC[LIFT_DROP]);;
3410
3411 let FORALL_LIFT_IMAGE = prove
3412  (`!P. (!s. P s) <=> (!s. P(IMAGE lift s))`,
3413   MESON_TAC[IMAGE_LIFT_DROP; IMAGE_o]);;
3414
3415 let EXISTS_LIFT_IMAGE = prove
3416  (`!P. (?s. P s) <=> (?s. P(IMAGE lift s))`,
3417   MESON_TAC[IMAGE_LIFT_DROP; IMAGE_o]);;
3418
3419 let SUBSET_LIFT_IMAGE = prove
3420  (`!s t. IMAGE lift s SUBSET IMAGE lift t <=> s SUBSET t`,
3421   REPEAT GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[IMAGE_SUBSET] THEN
3422   DISCH_THEN(MP_TAC o ISPEC `drop` o MATCH_MP IMAGE_SUBSET) THEN
3423   REWRITE_TAC[GSYM IMAGE_o; IMAGE_LIFT_DROP]);;
3424
3425 let FORALL_DROP_IMAGE = prove
3426  (`!P. (!s. P s) <=> (!s. P(IMAGE drop s))`,
3427   MESON_TAC[IMAGE_LIFT_DROP; IMAGE_o]);;
3428
3429 let EXISTS_DROP_IMAGE = prove
3430  (`!P. (?s. P s) <=> (?s. P(IMAGE drop s))`,
3431   MESON_TAC[IMAGE_LIFT_DROP; IMAGE_o]);;
3432
3433 let SUBSET_DROP_IMAGE = prove
3434  (`!s t. IMAGE drop s SUBSET IMAGE drop t <=> s SUBSET t`,
3435   REPEAT GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[IMAGE_SUBSET] THEN
3436   DISCH_THEN(MP_TAC o ISPEC `lift` o MATCH_MP IMAGE_SUBSET) THEN
3437   REWRITE_TAC[GSYM IMAGE_o; IMAGE_LIFT_DROP]);;
3438
3439 let DROP_IN_IMAGE_DROP = prove
3440  (`!x s. (drop x) IN (IMAGE drop s) <=> x IN s`,
3441   REWRITE_TAC[IN_IMAGE] THEN MESON_TAC[LIFT_DROP]);;
3442
3443 let LIFT_NUM = prove
3444  (`!n. lift(&n) = vec n`,
3445   SIMP_TAC[CART_EQ; lift; vec; LAMBDA_BETA]);;
3446
3447 let LIFT_ADD = prove
3448  (`!x y. lift(x + y) = lift x + lift y`,
3449   SIMP_TAC[CART_EQ; lift; LAMBDA_BETA; VECTOR_ADD_COMPONENT]);;
3450
3451 let LIFT_SUB = prove
3452  (`!x y. lift(x - y) = lift x - lift y`,
3453   SIMP_TAC[CART_EQ; lift; LAMBDA_BETA; VECTOR_SUB_COMPONENT]);;
3454
3455 let LIFT_CMUL = prove
3456  (`!x c. lift(c * x) = c % lift(x)`,
3457   SIMP_TAC[CART_EQ; lift; LAMBDA_BETA; VECTOR_MUL_COMPONENT]);;
3458
3459 let LIFT_NEG = prove
3460  (`!x. lift(--x) = --(lift x)`,
3461   SIMP_TAC[CART_EQ; lift; LAMBDA_BETA; VECTOR_NEG_COMPONENT]);;
3462
3463 let LIFT_EQ_CMUL = prove
3464  (`!x. lift x = x % vec 1`,
3465   REWRITE_TAC[GSYM LIFT_NUM; GSYM LIFT_CMUL; REAL_MUL_RID]);;
3466
3467 let SUM_VSUM = prove
3468  (`!f s. sum s f = drop(vsum s(lift o f))`,
3469   SIMP_TAC[vsum; drop; LAMBDA_BETA; DIMINDEX_1; ARITH] THEN
3470   REWRITE_TAC[o_THM; GSYM drop; LIFT_DROP; ETA_AX]);;
3471
3472 let VSUM_REAL = prove
3473  (`!f s. vsum s f = lift(sum s (drop o f))`,
3474   REWRITE_TAC[o_DEF; SUM_VSUM; LIFT_DROP; ETA_AX]);;
3475
3476 let LIFT_SUM = prove
3477  (`!k x. lift(sum k x) = vsum k (lift o x)`,
3478   REWRITE_TAC[SUM_VSUM; LIFT_DROP]);;
3479
3480 let DROP_VSUM = prove
3481  (`!k x. drop(vsum k x) = sum k (drop o x)`,
3482   REWRITE_TAC[VSUM_REAL; LIFT_DROP]);;
3483
3484 let DROP_LAMBDA = prove
3485  (`!x. drop(lambda i. x i) = x 1`,
3486   SIMP_TAC[drop; LAMBDA_BETA; DIMINDEX_1; LE_REFL]);;
3487
3488 let DROP_VEC = prove
3489  (`!n. drop(vec n) = &n`,
3490   MESON_TAC[LIFT_DROP; LIFT_NUM]);;
3491
3492 let DROP_ADD = prove
3493  (`!x y. drop(x + y) = drop x + drop y`,
3494   MESON_TAC[LIFT_DROP; LIFT_ADD]);;
3495
3496 let DROP_SUB = prove
3497  (`!x y. drop(x - y) = drop x - drop y`,
3498   MESON_TAC[LIFT_DROP; LIFT_SUB]);;
3499
3500 let DROP_CMUL = prove
3501  (`!x c. drop(c % x) = c * drop(x)`,
3502   MESON_TAC[LIFT_DROP; LIFT_CMUL]);;
3503
3504 let DROP_NEG = prove
3505  (`!x. drop(--x) = --(drop x)`,
3506   MESON_TAC[LIFT_DROP; LIFT_NEG]);;
3507
3508 let NORM_1 = prove
3509  (`!x. norm x = abs(drop x)`,
3510   REWRITE_TAC[drop; NORM_REAL]);;
3511
3512 let NORM_1_POS = prove
3513  (`!x. &0 <= drop x ==> norm x = drop x`,
3514   SIMP_TAC[NORM_1; real_abs]);;
3515
3516 let NORM_LIFT = prove
3517  (`!x. norm(lift x) = abs(x)`,
3518   SIMP_TAC[lift; NORM_REAL; LIFT_COMPONENT]);;
3519
3520 let DIST_LIFT = prove
3521  (`!x y. dist(lift x,lift y) = abs(x - y)`,
3522   REWRITE_TAC[DIST_REAL; LIFT_COMPONENT]);;
3523
3524 let ABS_DROP = prove
3525  (`!x. norm x = abs(drop x)`,
3526   REWRITE_TAC[FORALL_LIFT; LIFT_DROP; NORM_LIFT]);;
3527
3528 let LINEAR_VMUL_DROP = prove
3529  (`!f v. linear f ==> linear (\x. drop(f x) % v)`,
3530   SIMP_TAC[drop; LINEAR_VMUL_COMPONENT; DIMINDEX_1; LE_REFL]);;
3531
3532 let LINEAR_FROM_REALS = prove
3533  (`!f:real^1->real^N. linear f ==> f = \x. drop x % column 1 (matrix f)`,
3534   GEN_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN
3535   DISCH_THEN(fun th -> REWRITE_TAC[GSYM(MATCH_MP MATRIX_WORKS th)]) THEN
3536   SIMP_TAC[CART_EQ; matrix_vector_mul; vector_mul; LAMBDA_BETA;
3537            DIMINDEX_1; SUM_SING_NUMSEG; drop; column] THEN
3538   REWRITE_TAC[REAL_MUL_AC]);;
3539
3540 let LINEAR_TO_REALS = prove
3541  (`!f:real^N->real^1. linear f ==> f = \x. lift(row 1 (matrix f) dot x)`,
3542   GEN_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN
3543   DISCH_THEN(fun th -> REWRITE_TAC[GSYM(MATCH_MP MATRIX_WORKS th)]) THEN
3544   SIMP_TAC[CART_EQ; matrix_vector_mul; dot; LAMBDA_BETA;
3545            DIMINDEX_1; SUM_SING_NUMSEG; lift; row; LE_ANTISYM]);;
3546
3547 let DROP_EQ_0 = prove
3548  (`!x. drop x = &0 <=> x = vec 0`,
3549   REWRITE_TAC[GSYM DROP_EQ; DROP_VEC]);;
3550
3551 let DROP_WLOG_LE = prove
3552  (`(!x y. P x y <=> P y x) /\ (!x y. drop x <= drop y ==> P x y)
3553    ==> (!x y. P x y)`,
3554   MESON_TAC[REAL_LE_TOTAL]);;
3555
3556 let IMAGE_LIFT_UNIV = prove
3557  (`IMAGE lift (:real) = (:real^1)`,
3558   REWRITE_TAC[EXTENSION; IN_IMAGE; IN_UNIV] THEN MESON_TAC[LIFT_DROP]);;
3559
3560 let IMAGE_DROP_UNIV = prove
3561  (`IMAGE drop (:real^1) = (:real)`,
3562   REWRITE_TAC[EXTENSION; IN_IMAGE; IN_UNIV] THEN MESON_TAC[LIFT_DROP]);;
3563
3564 let LINEAR_LIFT_DOT = prove
3565  (`!a. linear(\x. lift(a dot x))`,
3566   REWRITE_TAC[linear; DOT_RMUL; DOT_RADD; LIFT_ADD; LIFT_CMUL]);;
3567
3568 let LINEAR_LIFT_COMPONENT = prove
3569  (`!k. linear(\x:real^N. lift(x$k))`,
3570   REPEAT GEN_TAC THEN
3571   SUBGOAL_THEN `?j. 1 <= j /\ j <= dimindex(:N) /\ !z:real^N. z$k = z$j`
3572   CHOOSE_TAC THENL
3573    [REWRITE_TAC[FINITE_INDEX_INRANGE];
3574     MP_TAC(ISPEC `basis j:real^N` LINEAR_LIFT_DOT) THEN
3575     ASM_SIMP_TAC[DOT_BASIS]]);;
3576
3577 let BILINEAR_DROP_MUL = prove
3578  (`bilinear (\x y:real^N. drop x % y)`,
3579   REWRITE_TAC[bilinear; linear] THEN
3580   REWRITE_TAC[DROP_ADD; DROP_CMUL] THEN VECTOR_ARITH_TAC);;
3581
3582 let LINEAR_COMPONENTWISE = prove
3583  (`!f:real^M->real^N.
3584         linear f <=>
3585         !i. 1 <= i /\ i <= dimindex(:N) ==> linear(\x. lift(f(x)$i))`,
3586   REPEAT GEN_TAC THEN REWRITE_TAC[linear] THEN
3587   GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [CART_EQ] THEN
3588   SIMP_TAC[GSYM LIFT_CMUL; GSYM LIFT_ADD; LIFT_EQ] THEN
3589   REWRITE_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT] THEN
3590   MESON_TAC[]);;
3591
3592 (* ------------------------------------------------------------------------- *)
3593 (* Pasting vectors.                                                          *)
3594 (* ------------------------------------------------------------------------- *)
3595
3596 let LINEAR_FSTCART = prove
3597  (`linear fstcart`,
3598   SIMP_TAC[linear; fstcart; CART_EQ; LAMBDA_BETA; VECTOR_ADD_COMPONENT;
3599            VECTOR_MUL_COMPONENT; DIMINDEX_FINITE_SUM;
3600            ARITH_RULE `x <= a ==> x <= a + b:num`]);;
3601
3602 let LINEAR_SNDCART = prove
3603  (`linear sndcart`,
3604   SIMP_TAC[linear; sndcart; CART_EQ; LAMBDA_BETA; VECTOR_ADD_COMPONENT;
3605            VECTOR_MUL_COMPONENT; DIMINDEX_FINITE_SUM;
3606            ARITH_RULE `x <= a ==> x <= a + b:num`;
3607            ARITH_RULE `x <= b ==> x + a <= a + b:num`]);;
3608
3609 let FSTCART_VEC = prove
3610  (`!n. fstcart(vec n) = vec n`,
3611   SIMP_TAC[vec; fstcart; LAMBDA_BETA; CART_EQ; DIMINDEX_FINITE_SUM;
3612            ARITH_RULE `m <= n:num ==> m <= n + p`]);;
3613
3614 let FSTCART_ADD = prove
3615  (`!x:real^(M,N)finite_sum y. fstcart(x + y) = fstcart(x) + fstcart(y)`,
3616   REWRITE_TAC[REWRITE_RULE[linear] LINEAR_FSTCART]);;
3617
3618 let FSTCART_CMUL = prove
3619  (`!x:real^(M,N)finite_sum c. fstcart(c % x) = c % fstcart(x)`,
3620   REWRITE_TAC[REWRITE_RULE[linear] LINEAR_FSTCART]);;
3621
3622 let FSTCART_NEG = prove
3623  (`!x:real^(M,N)finite_sum. --(fstcart x) = fstcart(--x)`,
3624   ONCE_REWRITE_TAC[VECTOR_ARITH `--x = --(&1) % x`] THEN
3625   REWRITE_TAC[FSTCART_CMUL]);;
3626
3627 let FSTCART_SUB = prove
3628  (`!x:real^(M,N)finite_sum y. fstcart(x - y) = fstcart(x) - fstcart(y)`,
3629   REWRITE_TAC[VECTOR_SUB; FSTCART_NEG; FSTCART_ADD]);;
3630
3631 let FSTCART_VSUM = prove
3632  (`!k x. FINITE k ==> (fstcart(vsum k x) = vsum k (\i. fstcart(x i)))`,
3633   REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN
3634   MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
3635   SIMP_TAC[VSUM_CLAUSES; FINITE_RULES; FSTCART_ADD; FSTCART_VEC]);;
3636
3637 let SNDCART_VEC = prove
3638  (`!n. sndcart(vec n) = vec n`,
3639   SIMP_TAC[vec; sndcart; LAMBDA_BETA; CART_EQ; DIMINDEX_FINITE_SUM;
3640            ARITH_RULE `x <= a ==> x <= a + b:num`;
3641            ARITH_RULE `x <= b ==> x + a <= a + b:num`]);;
3642
3643 let SNDCART_ADD = prove
3644  (`!x:real^(M,N)finite_sum y. sndcart(x + y) = sndcart(x) + sndcart(y)`,
3645   REWRITE_TAC[REWRITE_RULE[linear] LINEAR_SNDCART]);;
3646
3647 let SNDCART_CMUL = prove
3648  (`!x:real^(M,N)finite_sum c. sndcart(c % x) = c % sndcart(x)`,
3649   REWRITE_TAC[REWRITE_RULE[linear] LINEAR_SNDCART]);;
3650
3651 let SNDCART_NEG = prove
3652  (`!x:real^(M,N)finite_sum. --(sndcart x) = sndcart(--x)`,
3653   ONCE_REWRITE_TAC[VECTOR_ARITH `--x = --(&1) % x`] THEN
3654   REWRITE_TAC[SNDCART_CMUL]);;
3655
3656 let SNDCART_SUB = prove
3657  (`!x:real^(M,N)finite_sum y. sndcart(x - y) = sndcart(x) - sndcart(y)`,
3658   REWRITE_TAC[VECTOR_SUB; SNDCART_NEG; SNDCART_ADD]);;
3659
3660 let SNDCART_VSUM = prove
3661  (`!k x. FINITE k ==> (sndcart(vsum k x) = vsum k (\i. sndcart(x i)))`,
3662   REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN
3663   MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
3664   SIMP_TAC[VSUM_CLAUSES; FINITE_RULES; SNDCART_ADD; SNDCART_VEC]);;
3665
3666 let PASTECART_VEC = prove
3667  (`!n. pastecart (vec n) (vec n) = vec n`,
3668   REWRITE_TAC[PASTECART_EQ; FSTCART_VEC; SNDCART_VEC;
3669               FSTCART_PASTECART; SNDCART_PASTECART]);;
3670
3671 let PASTECART_ADD = prove
3672  (`!x1 y1 x2:real^M y2:real^N.
3673      pastecart x1 y1 + pastecart x2 y2 = pastecart (x1 + x2) (y1 + y2)`,
3674   REWRITE_TAC[PASTECART_EQ; FSTCART_ADD; SNDCART_ADD;
3675               FSTCART_PASTECART; SNDCART_PASTECART]);;
3676
3677 let PASTECART_CMUL = prove
3678  (`!x1 y1 c. pastecart (c % x1) (c % y1) = c % pastecart x1 y1`,
3679   REWRITE_TAC[PASTECART_EQ; FSTCART_CMUL; SNDCART_CMUL;
3680               FSTCART_PASTECART; SNDCART_PASTECART]);;
3681
3682 let PASTECART_NEG = prove
3683  (`!x:real^M y:real^N. pastecart (--x) (--y) = --(pastecart x y)`,
3684   ONCE_REWRITE_TAC[VECTOR_ARITH `--x = --(&1) % x`] THEN
3685   REWRITE_TAC[PASTECART_CMUL]);;
3686
3687 let PASTECART_SUB = prove
3688  (`!x1 y1 x2:real^M y2:real^N.
3689      pastecart x1 y1 - pastecart x2 y2 = pastecart (x1 - x2) (y1 - y2)`,
3690   REWRITE_TAC[VECTOR_SUB; GSYM PASTECART_NEG; PASTECART_ADD]);;
3691
3692 let PASTECART_VSUM = prove
3693  (`!k x y. FINITE k ==> (pastecart (vsum k x) (vsum k y) =
3694                          vsum k (\i. pastecart (x i) (y i)))`,
3695   SIMP_TAC[PASTECART_EQ; FSTCART_VSUM; SNDCART_VSUM;
3696            FSTCART_PASTECART; SNDCART_PASTECART; ETA_AX]);;
3697
3698 let PASTECART_EQ_VEC = prove
3699  (`!x y n. pastecart x y = vec n <=> x = vec n /\ y = vec n`,
3700   REWRITE_TAC[PASTECART_EQ; FSTCART_VEC; SNDCART_VEC;
3701               FSTCART_PASTECART; SNDCART_PASTECART]);;
3702
3703 let NORM_FSTCART = prove
3704  (`!x. norm(fstcart x) <= norm x`,
3705   GEN_TAC THEN
3706   GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM PASTECART_FST_SND] THEN
3707   SIMP_TAC[SQRT_MONO_LE_EQ; DOT_POS_LE; vector_norm] THEN
3708   SIMP_TAC[pastecart; dot; DIMINDEX_FINITE_SUM; LAMBDA_BETA; DIMINDEX_NONZERO;
3709            SUM_ADD_SPLIT; REAL_LE_ADDR; SUM_POS_LE; FINITE_NUMSEG;
3710            REAL_LE_SQUARE; ARITH_RULE `x <= a ==> x <= a + b:num`;
3711            ARITH_RULE `~(d = 0) ==> 1 <= d + 1`]);;
3712
3713 let DIST_FSTCART = prove
3714  (`!x y. dist(fstcart x,fstcart y) <= dist(x,y)`,
3715   REWRITE_TAC[dist; GSYM FSTCART_SUB; NORM_FSTCART]);;
3716
3717 let NORM_SNDCART = prove
3718  (`!x. norm(sndcart x) <= norm x`,
3719   GEN_TAC THEN
3720   GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM PASTECART_FST_SND] THEN
3721   SIMP_TAC[SQRT_MONO_LE_EQ; DOT_POS_LE; vector_norm] THEN
3722   SIMP_TAC[pastecart; dot; DIMINDEX_FINITE_SUM; LAMBDA_BETA; DIMINDEX_NONZERO;
3723            SUM_ADD_SPLIT; ARITH_RULE `x <= a ==> x <= a + b:num`;
3724            ARITH_RULE `~(d = 0) ==> 1 <= d + 1`] THEN
3725   ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[NUMSEG_OFFSET_IMAGE] THEN
3726   SIMP_TAC[SUM_IMAGE; FINITE_NUMSEG; EQ_ADD_RCANCEL; o_DEF; ADD_SUB] THEN
3727   SIMP_TAC[ARITH_RULE `1 <= x ==> ~(x + a <= a)`; SUM_POS_LE; FINITE_NUMSEG;
3728            REAL_LE_ADDL; REAL_LE_SQUARE]);;
3729
3730 let DIST_SNDCART = prove
3731  (`!x y. dist(sndcart x,sndcart y) <= dist(x,y)`,
3732   REWRITE_TAC[dist; GSYM SNDCART_SUB; NORM_SNDCART]);;
3733
3734 let DOT_PASTECART = prove
3735  (`!x1 x2 y1 y2. (pastecart x1 x2) dot (pastecart y1 y2) =
3736                 x1 dot y1 + x2 dot y2`,
3737   SIMP_TAC[pastecart; dot; LAMBDA_BETA; DIMINDEX_FINITE_SUM] THEN
3738   SIMP_TAC[SUM_ADD_SPLIT; ARITH_RULE `~(d = 0) ==> 1 <= d + 1`;
3739            DIMINDEX_NONZERO; REAL_LE_LADD] THEN
3740   ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[NUMSEG_OFFSET_IMAGE] THEN
3741   SIMP_TAC[SUM_IMAGE; FINITE_NUMSEG; EQ_ADD_RCANCEL; o_DEF; ADD_SUB] THEN
3742   SIMP_TAC[ARITH_RULE `1 <= x ==> ~(x + a <= a)`; REAL_LE_REFL]);;
3743
3744 let SQNORM_PASTECART = prove
3745  (`!x y. norm(pastecart x y) pow 2 = norm(x) pow 2 + norm(y) pow 2`,
3746   REWRITE_TAC[NORM_POW_2; DOT_PASTECART]);;
3747
3748 let NORM_PASTECART = prove
3749  (`!x y. norm(pastecart x y) = sqrt(norm(x) pow 2 + norm(y) pow 2)`,
3750   REWRITE_TAC[NORM_EQ_SQUARE] THEN
3751   SIMP_TAC[SQRT_POS_LE; SQRT_POW_2; REAL_LE_ADD; REAL_LE_POW_2] THEN
3752   REWRITE_TAC[DOT_PASTECART; NORM_POW_2]);;
3753
3754 let NORM_PASTECART_LE = prove
3755  (`!x y. norm(pastecart x y) <= norm(x) + norm(y)`,
3756   REPEAT GEN_TAC THEN MATCH_MP_TAC TRIANGLE_LEMMA THEN
3757   REWRITE_TAC[NORM_POS_LE; NORM_POW_2; DOT_PASTECART; REAL_LE_REFL]);;
3758
3759 let NORM_LE_PASTECART = prove
3760  (`!x:real^M y:real^N.
3761     norm(x) <= norm(pastecart x y) /\
3762     norm(y) <= norm(pastecart x y)`,
3763   REPEAT GEN_TAC THEN REWRITE_TAC[NORM_PASTECART] THEN CONJ_TAC THEN
3764   MATCH_MP_TAC REAL_LE_RSQRT THEN
3765   REWRITE_TAC[REAL_LE_ADDL; REAL_LE_ADDR; REAL_LE_POW_2]);;
3766
3767 let NORM_PASTECART_0 = prove
3768  (`(!x. norm(pastecart x (vec 0)) = norm x) /\
3769    (!y. norm(pastecart (vec 0) y) = norm y)`,
3770   REWRITE_TAC[NORM_EQ_SQUARE; NORM_POW_2; NORM_POS_LE] THEN
3771   REWRITE_TAC[DOT_PASTECART; DOT_LZERO; REAL_ADD_LID; REAL_ADD_RID]);;
3772
3773 let DIST_PASTECART_CANCEL = prove
3774  (`(!x x' y. dist(pastecart x y,pastecart x' y) = dist(x,x')) /\
3775    (!x y y'. dist(pastecart x y,pastecart x y') = dist(y,y'))`,
3776   REWRITE_TAC[dist; PASTECART_SUB; VECTOR_SUB_REFL; NORM_PASTECART_0]);;
3777
3778 let LINEAR_PASTECART = prove
3779  (`!f:real^M->real^N g:real^M->real^P.
3780         linear f /\ linear g ==> linear (\x. pastecart (f x) (g x))`,
3781   SIMP_TAC[linear; PASTECART_ADD; GSYM PASTECART_CMUL]);;
3782
3783 (* ------------------------------------------------------------------------- *)
3784 (* A bit of linear algebra.                                                  *)
3785 (* ------------------------------------------------------------------------- *)
3786
3787 let subspace = new_definition
3788  `subspace s <=>
3789         vec(0) IN s /\
3790         (!x y. x IN s /\ y IN s ==> (x + y) IN s) /\
3791         (!c x. x IN s ==> (c % x) IN s)`;;
3792
3793 let span = new_definition
3794   `span s = subspace hull s`;;
3795
3796 let dependent = new_definition
3797  `dependent s <=> ?a. a IN s /\ a IN span(s DELETE a)`;;
3798
3799 let independent = new_definition
3800  `independent s <=> ~(dependent s)`;;
3801
3802 (* ------------------------------------------------------------------------- *)
3803 (* Closure properties of subspaces.                                          *)
3804 (* ------------------------------------------------------------------------- *)
3805
3806 let SUBSPACE_UNIV = prove
3807  (`subspace(UNIV:real^N->bool)`,
3808   REWRITE_TAC[subspace; IN_UNIV]);;
3809
3810 let SUBSPACE_IMP_NONEMPTY = prove
3811  (`!s. subspace s ==> ~(s = {})`,
3812   REWRITE_TAC[subspace] THEN SET_TAC[]);;
3813
3814 let SUBSPACE_0 = prove
3815  (`subspace s ==> vec(0) IN s`,
3816   SIMP_TAC[subspace]);;
3817
3818 let SUBSPACE_ADD = prove
3819  (`!x y s. subspace s /\ x IN s /\ y IN s ==> (x + y) IN s`,
3820   SIMP_TAC[subspace]);;
3821
3822 let SUBSPACE_MUL = prove
3823  (`!x c s. subspace s /\ x IN s ==> (c % x) IN s`,
3824   SIMP_TAC[subspace]);;
3825
3826 let SUBSPACE_NEG = prove
3827  (`!x s. subspace s /\ x IN s ==> (--x) IN s`,
3828   SIMP_TAC[VECTOR_ARITH `--x = --(&1) % x`; SUBSPACE_MUL]);;
3829
3830 let SUBSPACE_SUB = prove
3831  (`!x y s. subspace s /\ x IN s /\ y IN s ==> (x - y) IN s`,
3832   SIMP_TAC[VECTOR_SUB; SUBSPACE_ADD; SUBSPACE_NEG]);;
3833
3834 let SUBSPACE_VSUM = prove
3835  (`!s f t. subspace s /\ FINITE t /\ (!x. x IN t ==> f(x) IN s)
3836            ==> (vsum t f) IN s`,
3837   REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
3838   GEN_TAC THEN DISCH_TAC THEN GEN_TAC THEN
3839   MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
3840   ASM_SIMP_TAC[VSUM_CLAUSES; SUBSPACE_0; IN_INSERT; SUBSPACE_ADD]);;
3841
3842 let SUBSPACE_LINEAR_IMAGE = prove
3843  (`!f s. linear f /\ subspace s ==> subspace(IMAGE f s)`,
3844   REWRITE_TAC[subspace; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
3845   REWRITE_TAC[FORALL_IN_IMAGE] THEN REWRITE_TAC[IN_IMAGE] THEN
3846   MESON_TAC[linear; LINEAR_0]);;
3847
3848 let SUBSPACE_LINEAR_PREIMAGE = prove
3849  (`!f s. linear f /\ subspace s ==> subspace {x | f(x) IN s}`,
3850   REWRITE_TAC[subspace; IN_ELIM_THM] THEN
3851   MESON_TAC[linear; LINEAR_0]);;
3852
3853 let SUBSPACE_TRIVIAL = prove
3854  (`subspace {vec 0}`,
3855   SIMP_TAC[subspace; IN_SING] THEN CONJ_TAC THEN VECTOR_ARITH_TAC);;
3856
3857 let SUBSPACE_INTER = prove
3858  (`!s t. subspace s /\ subspace t ==> subspace (s INTER t)`,
3859   REWRITE_TAC[subspace; IN_INTER] THEN MESON_TAC[]);;
3860
3861 let SUBSPACE_INTERS = prove
3862  (`!f. (!s. s IN f ==> subspace s) ==> subspace(INTERS f)`,
3863   SIMP_TAC[subspace; IMP_CONJ; RIGHT_FORALL_IMP_THM; IN_INTERS]);;
3864
3865 let LINEAR_INJECTIVE_0_SUBSPACE = prove
3866  (`!f:real^M->real^N s.
3867         linear f /\ subspace s
3868          ==> ((!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) <=>
3869               (!x. x IN s /\ f x = vec 0 ==> x = vec 0))`,
3870   REPEAT STRIP_TAC THEN
3871   GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [GSYM VECTOR_SUB_EQ] THEN
3872   ASM_SIMP_TAC[GSYM LINEAR_SUB] THEN
3873   ASM_MESON_TAC[VECTOR_SUB_RZERO; SUBSPACE_SUB; SUBSPACE_0]);;
3874
3875 let SUBSPACE_UNION_CHAIN = prove
3876  (`!s t:real^N->bool.
3877         subspace s /\ subspace t /\ subspace(s UNION t)
3878          ==> s SUBSET t \/ t SUBSET s`,
3879   REPEAT STRIP_TAC THEN REWRITE_TAC[SET_RULE
3880    `s SUBSET t \/ t SUBSET s <=>
3881     ~(?x y. x IN s /\ ~(x IN t) /\ y IN t /\ ~(y IN s))`] THEN
3882   STRIP_TAC THEN SUBGOAL_THEN `(x + y:real^N) IN s UNION t` MP_TAC THENL
3883    [MATCH_MP_TAC SUBSPACE_ADD THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[];
3884     REWRITE_TAC[IN_UNION; DE_MORGAN_THM] THEN
3885     ASM_MESON_TAC[SUBSPACE_SUB; VECTOR_ARITH
3886      `(x + y) - x:real^N = y /\ (x + y) - y = x`]]);;
3887
3888 let SUBSPACE_PCROSS = prove
3889  (`!s:real^M->bool t:real^N->bool.
3890         subspace s /\ subspace t ==> subspace(s PCROSS t)`,
3891   REWRITE_TAC[subspace; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
3892   REWRITE_TAC[FORALL_IN_PCROSS; GSYM PASTECART_CMUL; PASTECART_ADD] THEN
3893   REWRITE_TAC[GSYM PASTECART_VEC; PASTECART_IN_PCROSS] THEN SIMP_TAC[]);;
3894
3895 let SUBSPACE_PCROSS_EQ = prove
3896  (`!s:real^M->bool t:real^N->bool.
3897         subspace(s PCROSS t) <=> subspace s /\ subspace t`,
3898   REPEAT GEN_TAC THEN
3899   ASM_CASES_TAC `s:real^M->bool = {}` THENL
3900    [ASM_MESON_TAC[PCROSS_EMPTY; SUBSPACE_IMP_NONEMPTY]; ALL_TAC] THEN
3901   ASM_CASES_TAC `t:real^N->bool = {}` THENL
3902    [ASM_MESON_TAC[PCROSS_EMPTY; SUBSPACE_IMP_NONEMPTY]; ALL_TAC] THEN
3903   EQ_TAC THEN REWRITE_TAC[SUBSPACE_PCROSS] THEN REPEAT STRIP_TAC THENL
3904    [MP_TAC(ISPECL [`fstcart:real^(M,N)finite_sum->real^M`;
3905      `(s:real^M->bool) PCROSS (t:real^N->bool)`] SUBSPACE_LINEAR_IMAGE) THEN
3906     ASM_REWRITE_TAC[LINEAR_FSTCART];
3907     MP_TAC(ISPECL [`sndcart:real^(M,N)finite_sum->real^N`;
3908      `(s:real^M->bool) PCROSS (t:real^N->bool)`] SUBSPACE_LINEAR_IMAGE) THEN
3909     ASM_REWRITE_TAC[LINEAR_SNDCART]] THEN
3910   MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN
3911   REWRITE_TAC[EXTENSION; IN_IMAGE; EXISTS_PASTECART; PASTECART_IN_PCROSS;
3912               FSTCART_PASTECART; SNDCART_PASTECART] THEN
3913   ASM SET_TAC[]);;
3914
3915 (* ------------------------------------------------------------------------- *)
3916 (* Lemmas.                                                                   *)
3917 (* ------------------------------------------------------------------------- *)
3918
3919 let SPAN_SPAN = prove
3920  (`!s. span(span s) = span s`,
3921   REWRITE_TAC[span; HULL_HULL]);;
3922
3923 let SPAN_MONO = prove
3924  (`!s t. s SUBSET t ==> span s SUBSET span t`,
3925   REWRITE_TAC[span; HULL_MONO]);;
3926
3927 let SUBSPACE_SPAN = prove
3928  (`!s. subspace(span s)`,
3929   GEN_TAC THEN REWRITE_TAC[span] THEN MATCH_MP_TAC P_HULL THEN
3930   SIMP_TAC[subspace; IN_INTERS]);;
3931
3932 let SPAN_CLAUSES = prove
3933  (`(!a s. a IN s ==> a IN span s) /\
3934    (vec(0) IN span s) /\
3935    (!x y s. x IN span s /\ y IN span s ==> (x + y) IN span s) /\
3936    (!x c s. x IN span s ==> (c % x) IN span s)`,
3937   MESON_TAC[span; HULL_SUBSET; SUBSET; SUBSPACE_SPAN; subspace]);;
3938
3939 let SPAN_INDUCT = prove
3940  (`!s h. (!x. x IN s ==> x IN h) /\ subspace h ==> !x. x IN span(s) ==> h(x)`,
3941   REWRITE_TAC[span] THEN MESON_TAC[SUBSET; HULL_MINIMAL; IN]);;
3942
3943 let SPAN_EMPTY = prove
3944  (`span {} = {vec 0}`,
3945   REWRITE_TAC[span] THEN MATCH_MP_TAC HULL_UNIQUE THEN
3946   SIMP_TAC[subspace; SUBSET; IN_SING; NOT_IN_EMPTY] THEN
3947   REPEAT STRIP_TAC THEN VECTOR_ARITH_TAC);;
3948
3949 let INDEPENDENT_EMPTY = prove
3950  (`independent {}`,
3951   REWRITE_TAC[independent; dependent; NOT_IN_EMPTY]);;
3952
3953 let INDEPENDENT_NONZERO = prove
3954  (`!s. independent s ==> ~(vec 0 IN s)`,
3955   REWRITE_TAC[independent; dependent] THEN MESON_TAC[SPAN_CLAUSES]);;
3956
3957 let INDEPENDENT_MONO = prove
3958  (`!s t. independent t /\ s SUBSET t ==> independent s`,
3959   REWRITE_TAC[independent; dependent] THEN
3960   ASM_MESON_TAC[SPAN_MONO; SUBSET; IN_DELETE]);;
3961
3962 let DEPENDENT_MONO = prove
3963  (`!s t:real^N->bool. dependent s /\ s SUBSET t ==> dependent t`,
3964   ONCE_REWRITE_TAC[TAUT `p /\ q ==> r <=> ~r /\ q ==> ~p`] THEN
3965   REWRITE_TAC[GSYM independent; INDEPENDENT_MONO]);;
3966
3967 let SPAN_SUBSPACE = prove
3968  (`!b s. b SUBSET s /\ s SUBSET (span b) /\ subspace s ==> (span b = s)`,
3969   MESON_TAC[SUBSET_ANTISYM; span; HULL_MINIMAL]);;
3970
3971 let SPAN_INDUCT_ALT = prove
3972  (`!s h. h(vec 0) /\
3973          (!c x y. x IN s /\ h(y) ==> h(c % x + y))
3974           ==> !x:real^N. x IN span(s) ==> h(x)`,
3975   REPEAT GEN_TAC THEN DISCH_TAC THEN
3976   FIRST_ASSUM(MP_TAC o prove_inductive_relations_exist o concl) THEN
3977   DISCH_THEN(X_CHOOSE_THEN `g:real^N->bool` STRIP_ASSUME_TAC) THEN
3978   SUBGOAL_THEN `!x:real^N. x IN span(s) ==> g(x)`
3979    (fun th -> ASM_MESON_TAC[th]) THEN
3980   MATCH_MP_TAC SPAN_INDUCT THEN REWRITE_TAC[subspace; IN_ELIM_THM] THEN
3981   REWRITE_TAC[IN; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
3982   ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN
3983   REPEAT CONJ_TAC THEN TRY(FIRST_X_ASSUM MATCH_MP_TAC) THEN
3984   REWRITE_TAC[VECTOR_ADD_LDISTRIB; VECTOR_MUL_ASSOC] THEN
3985   ASM_MESON_TAC[IN; VECTOR_ADD_LID; VECTOR_ADD_ASSOC; VECTOR_ADD_SYM;
3986                 VECTOR_MUL_LID; VECTOR_MUL_RZERO]);;
3987
3988 (* ------------------------------------------------------------------------- *)
3989 (* Individual closure properties.                                            *)
3990 (* ------------------------------------------------------------------------- *)
3991
3992 let SPAN_SUPERSET = prove
3993  (`!x. x IN s ==> x IN span s`,
3994   MESON_TAC[SPAN_CLAUSES]);;
3995
3996 let SPAN_INC = prove
3997  (`!s. s SUBSET span s`,
3998   REWRITE_TAC[SUBSET; SPAN_SUPERSET]);;
3999
4000 let SPAN_UNION_SUBSET = prove
4001  (`!s t. span s UNION span t SUBSET span(s UNION t)`,
4002   REWRITE_TAC[span; HULL_UNION_SUBSET]);;
4003
4004 let SPAN_UNIV = prove
4005  (`span(:real^N) = (:real^N)`,
4006   SIMP_TAC[SPAN_INC; SET_RULE `UNIV SUBSET s ==> s = UNIV`]);;
4007
4008 let SPAN_0 = prove
4009  (`vec(0) IN span s`,
4010   MESON_TAC[SUBSPACE_SPAN; SUBSPACE_0]);;
4011
4012 let SPAN_ADD = prove
4013  (`!x y s. x IN span s /\ y IN span s ==> (x + y) IN span s`,
4014   MESON_TAC[SUBSPACE_SPAN; SUBSPACE_ADD]);;
4015
4016 let SPAN_MUL = prove
4017  (`!x c s. x IN span s ==> (c % x) IN span s`,
4018   MESON_TAC[SUBSPACE_SPAN; SUBSPACE_MUL]);;
4019
4020 let SPAN_MUL_EQ = prove
4021  (`!x:real^N c s. ~(c = &0) ==> ((c % x) IN span s <=> x IN span s)`,
4022   REPEAT(STRIP_TAC ORELSE EQ_TAC) THEN ASM_SIMP_TAC[SPAN_MUL] THEN
4023   SUBGOAL_THEN `(inv(c) % c % x:real^N) IN span s` MP_TAC THENL
4024    [ASM_SIMP_TAC[SPAN_MUL];
4025     ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LINV; VECTOR_MUL_LID]]);;
4026
4027 let SPAN_NEG = prove
4028  (`!x s. x IN span s ==> (--x) IN span s`,
4029   MESON_TAC[SUBSPACE_SPAN; SUBSPACE_NEG]);;
4030
4031 let SPAN_NEG_EQ = prove
4032  (`!x s. --x IN span s <=> x IN span s`,
4033   MESON_TAC[SPAN_NEG; VECTOR_NEG_NEG]);;
4034
4035 let SPAN_SUB = prove
4036  (`!x y s. x IN span s /\ y IN span s ==> (x - y) IN span s`,
4037   MESON_TAC[SUBSPACE_SPAN; SUBSPACE_SUB]);;
4038
4039 let SPAN_VSUM = prove
4040  (`!s f t. FINITE t /\ (!x. x IN t ==> f(x) IN span(s))
4041            ==> (vsum t f) IN span(s)`,
4042   MESON_TAC[SUBSPACE_SPAN; SUBSPACE_VSUM]);;
4043
4044 let SPAN_ADD_EQ = prove
4045  (`!s x y. x IN span s ==> ((x + y) IN span s <=> y IN span s)`,
4046   MESON_TAC[SPAN_ADD; SPAN_SUB; VECTOR_ARITH `(x + y) - x:real^N = y`]);;
4047
4048 let SPAN_EQ_SELF = prove
4049  (`!s. span s = s <=> subspace s`,
4050   GEN_TAC THEN EQ_TAC THENL [MESON_TAC[SUBSPACE_SPAN]; ALL_TAC] THEN
4051   DISCH_TAC THEN MATCH_MP_TAC SPAN_SUBSPACE THEN
4052   ASM_REWRITE_TAC[SUBSET_REFL; SPAN_INC]);;
4053
4054 let SPAN_OF_SUBSPACE = prove
4055  (`!s:real^N->bool. subspace s ==> span s = s`,
4056   REWRITE_TAC[SPAN_EQ_SELF]);;
4057
4058 let SPAN_SUBSET_SUBSPACE = prove
4059  (`!s t:real^N->bool. s SUBSET t /\ subspace t ==> span s SUBSET t`,
4060   MESON_TAC[SPAN_MONO; SPAN_EQ_SELF]);;
4061
4062 let SUBSPACE_TRANSLATION_SELF = prove
4063  (`!s a. subspace s /\ a IN s ==> IMAGE (\x. a + x) s = s`,
4064   REPEAT STRIP_TAC THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN
4065   FIRST_ASSUM(SUBST1_TAC o SYM o GEN_REWRITE_RULE I [GSYM SPAN_EQ_SELF]) THEN
4066   ASM_SIMP_TAC[SPAN_ADD_EQ; SPAN_CLAUSES] THEN
4067   REWRITE_TAC[VECTOR_ARITH `a + x:real^N = y <=> x = y - a`; EXISTS_REFL]);;
4068
4069 let SUBSPACE_TRANSLATION_SELF_EQ = prove
4070  (`!s a:real^N. subspace s ==> (IMAGE (\x. a + x) s = s <=> a IN s)`,
4071   REPEAT STRIP_TAC THEN EQ_TAC THEN
4072   ASM_SIMP_TAC[SUBSPACE_TRANSLATION_SELF] THEN
4073   DISCH_THEN(MP_TAC o AP_TERM `\s. (a:real^N) IN s`) THEN
4074   REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN
4075   REWRITE_TAC[IN_IMAGE] THEN EXISTS_TAC `vec 0:real^N` THEN
4076   ASM_MESON_TAC[subspace; VECTOR_ADD_RID]);;
4077
4078 let SUBSPACE_SUMS = prove
4079  (`!s t. subspace s /\ subspace t
4080          ==> subspace {x + y | x IN s /\ y IN t}`,
4081   REWRITE_TAC[subspace; FORALL_IN_GSPEC; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
4082   REWRITE_TAC[IN_ELIM_THM] THEN REPEAT STRIP_TAC THENL
4083    [ASM_MESON_TAC[VECTOR_ADD_LID];
4084     ONCE_REWRITE_TAC[VECTOR_ARITH
4085      `(x + y) + (x' + y'):real^N = (x + x') + (y + y')`] THEN
4086     ASM_MESON_TAC[];
4087     REWRITE_TAC[VECTOR_ADD_LDISTRIB] THEN ASM_MESON_TAC[]]);;
4088
4089 let SPAN_UNION = prove
4090  (`!s t. span(s UNION t) = {x + y:real^N | x IN span s /\ y IN span t}`,
4091   REPEAT GEN_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL
4092    [MATCH_MP_TAC SPAN_SUBSET_SUBSPACE THEN
4093     SIMP_TAC[SUBSPACE_SUMS; SUBSPACE_SPAN] THEN
4094     REWRITE_TAC[SUBSET; IN_UNION; IN_ELIM_THM] THEN
4095     X_GEN_TAC `x:real^N` THEN STRIP_TAC THENL
4096      [MAP_EVERY EXISTS_TAC [`x:real^N`; `vec 0:real^N`] THEN
4097       ASM_SIMP_TAC[SPAN_SUPERSET; SPAN_0; VECTOR_ADD_RID];
4098       MAP_EVERY EXISTS_TAC [`vec 0:real^N`; `x:real^N`] THEN
4099       ASM_SIMP_TAC[SPAN_SUPERSET; SPAN_0; VECTOR_ADD_LID]];
4100     REWRITE_TAC[SUBSET; FORALL_IN_GSPEC] THEN
4101     REPEAT STRIP_TAC THEN MATCH_MP_TAC SPAN_ADD THEN
4102     ASM_MESON_TAC[SPAN_MONO; SUBSET_UNION; SUBSET]]);;
4103
4104 (* ------------------------------------------------------------------------- *)
4105 (* Mapping under linear image.                                               *)
4106 (* ------------------------------------------------------------------------- *)
4107
4108 let SPAN_LINEAR_IMAGE = prove
4109  (`!f:real^M->real^N s. linear f ==> (span(IMAGE f s) = IMAGE f (span s))`,
4110   REPEAT STRIP_TAC THEN GEN_REWRITE_TAC I [EXTENSION] THEN
4111   X_GEN_TAC `x:real^N` THEN EQ_TAC THENL
4112    [SPEC_TAC(`x:real^N`,`x:real^N`) THEN MATCH_MP_TAC SPAN_INDUCT THEN
4113     REWRITE_TAC[SET_RULE `(\x. x IN s) = s`] THEN
4114     ASM_SIMP_TAC[SUBSPACE_SPAN; SUBSPACE_LINEAR_IMAGE] THEN
4115     REWRITE_TAC[FORALL_IN_IMAGE] THEN REWRITE_TAC[IN_IMAGE] THEN
4116     MESON_TAC[SPAN_SUPERSET; SUBSET];
4117     SPEC_TAC(`x:real^N`,`x:real^N`) THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN
4118     MATCH_MP_TAC SPAN_INDUCT THEN
4119     REWRITE_TAC[SET_RULE `(\x. f x IN span(s)) = {x | f(x) IN span s}`] THEN
4120     ASM_SIMP_TAC[SUBSPACE_LINEAR_PREIMAGE; SUBSPACE_SPAN] THEN
4121     REWRITE_TAC[IN_ELIM_THM] THEN
4122     MESON_TAC[SPAN_SUPERSET; SUBSET; IN_IMAGE]]);;
4123
4124 let DEPENDENT_LINEAR_IMAGE_EQ = prove
4125  (`!f:real^M->real^N s.
4126         linear f /\ (!x y. f x = f y ==> x = y)
4127         ==> (dependent(IMAGE f s) <=> dependent s)`,
4128   REPEAT STRIP_TAC THEN REWRITE_TAC[dependent; EXISTS_IN_IMAGE] THEN
4129   AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `a:real^M` THEN
4130   ASM_CASES_TAC `(a:real^M) IN s` THEN ASM_REWRITE_TAC[] THEN
4131   MATCH_MP_TAC EQ_TRANS THEN
4132   EXISTS_TAC `(f:real^M->real^N) a IN span(IMAGE f (s DELETE a))` THEN
4133   CONJ_TAC THENL
4134    [AP_TERM_TAC THEN AP_TERM_TAC THEN ASM SET_TAC[];
4135     ASM_SIMP_TAC[SPAN_LINEAR_IMAGE] THEN ASM SET_TAC[]]);;
4136
4137 let DEPENDENT_LINEAR_IMAGE = prove
4138  (`!f:real^M->real^N s.
4139         linear f /\ (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) /\
4140         dependent(s)
4141         ==> dependent(IMAGE f s)`,
4142   REPEAT GEN_TAC THEN
4143   REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
4144   REWRITE_TAC[dependent; EXISTS_IN_IMAGE] THEN
4145   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real^M` THEN
4146   STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
4147   SUBGOAL_THEN `IMAGE (f:real^M->real^N) s DELETE f a = IMAGE f (s DELETE a)`
4148    (fun th -> ASM_SIMP_TAC[FUN_IN_IMAGE; SPAN_LINEAR_IMAGE; th]) THEN
4149   ASM SET_TAC[]);;
4150
4151 let INDEPENDENT_LINEAR_IMAGE_EQ = prove
4152  (`!f:real^M->real^N s.
4153         linear f /\ (!x y. f x = f y ==> x = y)
4154         ==> (independent(IMAGE f s) <=> independent s)`,
4155   REWRITE_TAC[independent; TAUT `(~p <=> ~q) <=> (p <=> q)`] THEN
4156   REWRITE_TAC[DEPENDENT_LINEAR_IMAGE_EQ]);;
4157
4158 (* ------------------------------------------------------------------------- *)
4159 (* The key breakdown property.                                               *)
4160 (* ------------------------------------------------------------------------- *)
4161
4162 let SPAN_BREAKDOWN = prove
4163  (`!b s a:real^N.
4164       b IN s /\ a IN span s ==> ?k. (a - k % b) IN span(s DELETE b)`,
4165   REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
4166   REPEAT GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC SPAN_INDUCT THEN
4167   REWRITE_TAC[subspace; IN_ELIM_THM] THEN CONJ_TAC THENL
4168    [GEN_TAC THEN DISCH_TAC THEN ASM_CASES_TAC `a:real^N = b`; ALL_TAC] THEN
4169   ASM_MESON_TAC[SPAN_CLAUSES; IN_DELETE; VECTOR_ARITH
4170    `(a - &1 % a = vec 0) /\ (a - &0 % b = a) /\
4171     ((x + y) - (k1 + k2) % b = (x - k1 % b) + (y - k2 % b)) /\
4172     (c % x - (c * k) % y = c % (x - k % y))`]);;
4173
4174 let SPAN_BREAKDOWN_EQ = prove
4175  (`!a:real^N s. (x IN span(a INSERT s) <=> (?k. (x - k % a) IN span s))`,
4176   REPEAT STRIP_TAC THEN EQ_TAC THENL
4177    [DISCH_THEN(MP_TAC o CONJ(SET_RULE `(a:real^N) IN (a INSERT s)`)) THEN
4178     DISCH_THEN(MP_TAC o MATCH_MP SPAN_BREAKDOWN) THEN
4179     MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:real` THEN
4180     SPEC_TAC(`x - k % a:real^N`,`y:real^N`) THEN
4181     REWRITE_TAC[GSYM SUBSET] THEN MATCH_MP_TAC SPAN_MONO THEN SET_TAC[];
4182     DISCH_THEN(X_CHOOSE_TAC `k:real`) THEN
4183     SUBST1_TAC(VECTOR_ARITH `x = (x - k % a) + k % a:real^N`) THEN
4184     MATCH_MP_TAC SPAN_ADD THEN
4185     ASM_MESON_TAC[SPAN_MONO; SUBSET; IN_INSERT; SPAN_CLAUSES]]);;
4186
4187 let SPAN_INSERT_0 = prove
4188  (`!s. span(vec 0 INSERT s) = span s`,
4189   SIMP_TAC[EXTENSION; SPAN_BREAKDOWN_EQ; VECTOR_MUL_RZERO; VECTOR_SUB_RZERO]);;
4190
4191 let SPAN_SING = prove
4192  (`!a. span {a} = {u % a | u IN (:real)}`,
4193   REWRITE_TAC[EXTENSION; IN_ELIM_THM; SPAN_BREAKDOWN_EQ; SPAN_EMPTY] THEN
4194   REWRITE_TAC[IN_UNIV; IN_SING; VECTOR_SUB_EQ]);;
4195
4196 let SPAN_2 = prove
4197  (`!a b. span {a,b} = {u % a + v % b | u IN (:real) /\ v IN (:real)}`,
4198   REWRITE_TAC[EXTENSION; IN_ELIM_THM; SPAN_BREAKDOWN_EQ; SPAN_EMPTY] THEN
4199   REWRITE_TAC[IN_UNIV; IN_SING; VECTOR_SUB_EQ] THEN
4200   REWRITE_TAC[VECTOR_ARITH `x - y:real^N = z <=> x = y + z`]);;
4201
4202 let SPAN_3 = prove
4203  (`!a b c. span {a,b,c} =
4204       {u % a + v % b + w % c | u IN (:real) /\ v IN (:real) /\ w IN (:real)}`,
4205   REWRITE_TAC[EXTENSION; IN_ELIM_THM; SPAN_BREAKDOWN_EQ; SPAN_EMPTY] THEN
4206   REWRITE_TAC[IN_UNIV; IN_SING; VECTOR_SUB_EQ] THEN
4207   REWRITE_TAC[VECTOR_ARITH `x - y:real^N = z <=> x = y + z`]);;
4208
4209 (* ------------------------------------------------------------------------- *)
4210 (* Hence some "reversal" results.                                            *)
4211 (* ------------------------------------------------------------------------- *)
4212
4213 let IN_SPAN_INSERT = prove
4214  (`!a b:real^N s.
4215         a IN span(b INSERT s) /\ ~(a IN span s) ==> b IN span(a INSERT s)`,
4216   REPEAT STRIP_TAC THEN
4217   MP_TAC(ISPECL [`b:real^N`; `(b:real^N) INSERT s`; `a:real^N`]
4218     SPAN_BREAKDOWN) THEN ASM_REWRITE_TAC[IN_INSERT] THEN
4219   DISCH_THEN(X_CHOOSE_THEN `k:real` MP_TAC) THEN ASM_CASES_TAC `k = &0` THEN
4220   ASM_REWRITE_TAC[VECTOR_ARITH `a - &0 % b = a`; DELETE_INSERT] THENL
4221    [ASM_MESON_TAC[SPAN_MONO; SUBSET; DELETE_SUBSET]; ALL_TAC] THEN
4222   DISCH_THEN(MP_TAC o SPEC `inv(k)` o MATCH_MP SPAN_MUL) THEN
4223   ASM_SIMP_TAC[VECTOR_SUB_LDISTRIB; VECTOR_MUL_ASSOC; REAL_MUL_LINV] THEN
4224   DISCH_TAC THEN SUBST1_TAC(VECTOR_ARITH
4225    `b:real^N = inv(k) % a - (inv(k) % a - &1 % b)`) THEN
4226   MATCH_MP_TAC SPAN_SUB THEN
4227   ASM_MESON_TAC[SPAN_CLAUSES; IN_INSERT; SUBSET; IN_DELETE; SPAN_MONO]);;
4228
4229 let IN_SPAN_DELETE = prove
4230  (`!a b s.
4231          a IN span s /\ ~(a IN span (s DELETE b))
4232          ==> b IN span (a INSERT (s DELETE b))`,
4233   ASM_MESON_TAC[IN_SPAN_INSERT; SPAN_MONO; SUBSET; IN_INSERT; IN_DELETE]);;
4234
4235 let EQ_SPAN_INSERT_EQ = prove
4236  (`!s x y:real^N. (x - y) IN span s ==> span(x INSERT s) = span(y INSERT s)`,
4237   REPEAT STRIP_TAC THEN REWRITE_TAC[SPAN_BREAKDOWN_EQ; EXTENSION] THEN
4238   ASM_MESON_TAC[SPAN_ADD; SPAN_SUB; SPAN_MUL;
4239                 VECTOR_ARITH `(z - k % y) - k % (x - y) = z - k % x`;
4240                 VECTOR_ARITH `(z - k % x) + k % (x - y) = z - k % y`]);;
4241
4242 (* ------------------------------------------------------------------------- *)
4243 (* Transitivity property.                                                    *)
4244 (* ------------------------------------------------------------------------- *)
4245
4246 let SPAN_TRANS = prove
4247  (`!x y:real^N s. x IN span(s) /\ y IN span(x INSERT s) ==> y IN span(s)`,
4248   REPEAT STRIP_TAC THEN
4249   MP_TAC(SPECL [`x:real^N`; `(x:real^N) INSERT s`; `y:real^N`]
4250          SPAN_BREAKDOWN) THEN
4251   ASM_REWRITE_TAC[IN_INSERT] THEN
4252   DISCH_THEN(X_CHOOSE_THEN `k:real` STRIP_ASSUME_TAC) THEN
4253   SUBST1_TAC(VECTOR_ARITH `y:real^N = (y - k % x) + k % x`) THEN
4254   MATCH_MP_TAC SPAN_ADD THEN ASM_SIMP_TAC[SPAN_MUL] THEN
4255   ASM_MESON_TAC[SPAN_MONO; SUBSET; IN_INSERT; IN_DELETE]);;
4256
4257 (* ------------------------------------------------------------------------- *)
4258 (* An explicit expansion is sometimes needed.                                *)
4259 (* ------------------------------------------------------------------------- *)
4260
4261 let SPAN_EXPLICIT = prove
4262  (`!(p:real^N -> bool).
4263         span p =
4264          {y | ?s u. FINITE s /\ s SUBSET p /\
4265                     vsum s (\v. u v % v) = y}`,
4266   GEN_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL
4267    [ALL_TAC;
4268     REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN
4269     REPEAT STRIP_TAC THEN FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN
4270     MATCH_MP_TAC SPAN_VSUM THEN ASM_REWRITE_TAC[] THEN
4271     ASM_MESON_TAC[SPAN_SUPERSET; SPAN_MUL]] THEN
4272   REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN
4273   MATCH_MP_TAC SPAN_INDUCT_ALT THEN CONJ_TAC THENL
4274    [EXISTS_TAC `{}:real^N->bool` THEN
4275     REWRITE_TAC[FINITE_RULES; VSUM_CLAUSES; EMPTY_SUBSET; NOT_IN_EMPTY];
4276     ALL_TAC] THEN
4277   MAP_EVERY X_GEN_TAC [`c:real`; `x:real^N`; `y:real^N`] THEN
4278   DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
4279   REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
4280   MAP_EVERY X_GEN_TAC [`s:real^N->bool`; `u:real^N->real`] THEN
4281   STRIP_TAC THEN EXISTS_TAC `(x:real^N) INSERT s` THEN
4282   EXISTS_TAC `\y. if y = x then (if x IN s then (u:real^N->real) y + c else c)
4283                   else u y` THEN
4284   ASM_SIMP_TAC[FINITE_INSERT; IN_INSERT; VSUM_CLAUSES] THEN
4285   CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN
4286   FIRST_X_ASSUM(SUBST_ALL_TAC o SYM) THEN
4287   COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL
4288    [FIRST_X_ASSUM(SUBST1_TAC o MATCH_MP (SET_RULE
4289      `x IN s ==> s = x INSERT (s DELETE x)`)) THEN
4290     ASM_SIMP_TAC[VSUM_CLAUSES; FINITE_INSERT; FINITE_DELETE; IN_DELETE] THEN
4291     MATCH_MP_TAC(VECTOR_ARITH
4292       `y = z ==> (c + d) % x + y = d % x + c % x + z`);
4293     AP_TERM_TAC] THEN
4294   MATCH_MP_TAC VSUM_EQ THEN ASM_MESON_TAC[IN_DELETE]);;
4295
4296 let DEPENDENT_EXPLICIT = prove
4297  (`!p. dependent (p:real^N -> bool) <=>
4298                 ?s u. FINITE s /\ s SUBSET p /\
4299                       (?v. v IN s /\ ~(u v = &0)) /\
4300                       vsum s (\v. u v % v) = vec 0`,
4301   GEN_TAC THEN REWRITE_TAC[dependent; SPAN_EXPLICIT; IN_ELIM_THM] THEN
4302   REWRITE_TAC[RIGHT_AND_EXISTS_THM; LEFT_AND_EXISTS_THM] THEN
4303   EQ_TAC THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THENL
4304    [MAP_EVERY X_GEN_TAC [`a:real^N`; `s:real^N->bool`; `u:real^N->real`] THEN
4305     STRIP_TAC THEN MAP_EVERY EXISTS_TAC
4306      [`(a:real^N) INSERT s`;
4307       `\y. if y = a then -- &1 else (u:real^N->real) y`;
4308       `a:real^N`] THEN
4309     ASM_REWRITE_TAC[IN_INSERT; INSERT_SUBSET; FINITE_INSERT] THEN
4310     CONJ_TAC THENL [ASM SET_TAC[]; CONV_TAC REAL_RAT_REDUCE_CONV] THEN
4311     ASM_SIMP_TAC[VSUM_CLAUSES] THEN
4312     COND_CASES_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
4313     REWRITE_TAC[VECTOR_ARITH `-- &1 % a + s = vec 0 <=> a = s`] THEN
4314     FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC LAND_CONV [SYM th]) THEN
4315     MATCH_MP_TAC VSUM_EQ THEN ASM SET_TAC[];
4316     MAP_EVERY X_GEN_TAC [`s:real^N->bool`; `u:real^N->real`; `a:real^N`] THEN
4317     STRIP_TAC THEN MAP_EVERY EXISTS_TAC
4318      [`a:real^N`; `s DELETE (a:real^N)`;
4319       `\i. --((u:real^N->real) i) / (u a)`] THEN
4320     ASM_SIMP_TAC[VSUM_DELETE; FINITE_DELETE] THEN
4321     REPEAT(CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN
4322     REWRITE_TAC[real_div] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
4323     ASM_REWRITE_TAC[VECTOR_MUL_LNEG; GSYM VECTOR_MUL_ASSOC; VSUM_LMUL;
4324                     VSUM_NEG; VECTOR_MUL_RNEG; VECTOR_MUL_RZERO] THEN
4325     ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LINV] THEN VECTOR_ARITH_TAC]);;
4326
4327 let DEPENDENT_FINITE = prove
4328  (`!s:real^N->bool.
4329         FINITE s
4330         ==> (dependent s <=> ?u. (?v. v IN s /\ ~(u v = &0)) /\
4331                                  vsum s (\v. u(v) % v) = vec 0)`,
4332   REPEAT STRIP_TAC THEN REWRITE_TAC[DEPENDENT_EXPLICIT] THEN EQ_TAC THEN
4333   REWRITE_TAC[LEFT_IMP_EXISTS_THM] THENL
4334    [MAP_EVERY X_GEN_TAC [`t:real^N->bool`; `u:real^N->real`] THEN
4335     DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN
4336     EXISTS_TAC `\v:real^N. if v IN t then u(v) else &0` THEN
4337     REWRITE_TAC[] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
4338     ONCE_REWRITE_TAC[COND_RAND] THEN ONCE_REWRITE_TAC[COND_RATOR] THEN
4339     ASM_SIMP_TAC[VECTOR_MUL_LZERO; GSYM VSUM_RESTRICT_SET] THEN
4340     ASM_SIMP_TAC[SET_RULE `t SUBSET s ==> {x | x IN s /\ x IN t} = t`];
4341     GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN ASSUME_TAC) THEN
4342     MAP_EVERY EXISTS_TAC [`s:real^N->bool`; `u:real^N->real`] THEN
4343     ASM_REWRITE_TAC[SUBSET_REFL]]);;
4344
4345 let SPAN_FINITE = prove
4346  (`!s:real^N->bool.
4347         FINITE s ==> span s = {y | ?u. vsum s (\v. u v % v) = y}`,
4348   REPEAT STRIP_TAC THEN REWRITE_TAC[SPAN_EXPLICIT; EXTENSION; IN_ELIM_THM] THEN
4349   X_GEN_TAC `y:real^N` THEN EQ_TAC THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THENL
4350    [MAP_EVERY X_GEN_TAC [`t:real^N->bool`; `u:real^N->real`] THEN
4351     STRIP_TAC THEN FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN
4352     EXISTS_TAC `\x:real^N. if x IN t then u(x) else &0` THEN
4353     REWRITE_TAC[COND_RAND; COND_RATOR; VECTOR_MUL_LZERO] THEN
4354     ASM_SIMP_TAC[GSYM VSUM_RESTRICT_SET] THEN
4355     ASM_SIMP_TAC[SET_RULE `t SUBSET s ==> {x | x IN s /\ x IN t} = t`];
4356     X_GEN_TAC `u:real^N->real` THEN DISCH_THEN(SUBST1_TAC o SYM) THEN
4357     MAP_EVERY EXISTS_TAC [`s:real^N->bool`; `u:real^N->real`] THEN
4358     ASM_REWRITE_TAC[SUBSET_REFL]]);;
4359
4360 (* ------------------------------------------------------------------------- *)
4361 (* Standard bases are a spanning set, and obviously finite.                  *)
4362 (* ------------------------------------------------------------------------- *)
4363
4364 let SPAN_STDBASIS = prove
4365  (`span {basis i :real^N | 1 <= i /\ i <= dimindex(:N)} = UNIV`,
4366   REWRITE_TAC[EXTENSION; IN_UNIV] THEN X_GEN_TAC `x:real^N` THEN
4367   GEN_REWRITE_TAC LAND_CONV [GSYM BASIS_EXPANSION] THEN
4368   MATCH_MP_TAC SPAN_VSUM THEN SIMP_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN
4369   REPEAT STRIP_TAC THEN MATCH_MP_TAC SPAN_MUL THEN
4370   MATCH_MP_TAC SPAN_SUPERSET THEN REWRITE_TAC[IN_ELIM_THM] THEN
4371   ASM_MESON_TAC[]);;
4372
4373 let HAS_SIZE_STDBASIS = prove
4374  (`{basis i :real^N | 1 <= i /\ i <= dimindex(:N)} HAS_SIZE
4375         dimindex(:N)`,
4376   ONCE_REWRITE_TAC[SET_RULE `{f x | P x} = IMAGE f {x | P x}`] THEN
4377   MATCH_MP_TAC HAS_SIZE_IMAGE_INJ THEN
4378   REWRITE_TAC[GSYM numseg; HAS_SIZE_NUMSEG_1; IN_NUMSEG] THEN
4379   MESON_TAC[BASIS_INJ]);;
4380
4381 let FINITE_STDBASIS = prove
4382  (`FINITE {basis i :real^N | 1 <= i /\ i <= dimindex(:N)}`,
4383   MESON_TAC[HAS_SIZE_STDBASIS; HAS_SIZE]);;
4384
4385 let CARD_STDBASIS = prove
4386  (`CARD {basis i :real^N | 1 <= i /\ i <= dimindex(:N)} =
4387         dimindex(:N)`,
4388    MESON_TAC[HAS_SIZE_STDBASIS; HAS_SIZE]);;
4389
4390 let IN_SPAN_IMAGE_BASIS = prove
4391  (`!x:real^N s.
4392         x IN span(IMAGE basis s) <=>
4393           !i. 1 <= i /\ i <= dimindex(:N) /\ ~(i IN s) ==> x$i = &0`,
4394   REPEAT GEN_TAC THEN EQ_TAC THENL
4395    [SPEC_TAC(`x:real^N`,`x:real^N`) THEN MATCH_MP_TAC SPAN_INDUCT THEN
4396     SIMP_TAC[subspace; IN_ELIM_THM; VEC_COMPONENT; VECTOR_ADD_COMPONENT;
4397              VECTOR_MUL_COMPONENT; REAL_MUL_RZERO; REAL_ADD_RID] THEN
4398     SIMP_TAC[FORALL_IN_IMAGE; BASIS_COMPONENT] THEN MESON_TAC[];
4399     DISCH_TAC THEN REWRITE_TAC[SPAN_EXPLICIT; IN_ELIM_THM] THEN
4400     EXISTS_TAC `(IMAGE basis ((1..dimindex(:N)) INTER s)):real^N->bool` THEN
4401     SIMP_TAC[FINITE_IMAGE; FINITE_INTER; FINITE_NUMSEG] THEN
4402     REWRITE_TAC[RIGHT_EXISTS_AND_THM] THEN
4403     CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN
4404     EXISTS_TAC `\v:real^N. x dot v` THEN
4405     W(MP_TAC o PART_MATCH (lhs o rand) VSUM_IMAGE o lhand o snd) THEN
4406     ANTS_TAC THENL
4407      [SIMP_TAC[FINITE_IMAGE; FINITE_INTER; FINITE_NUMSEG] THEN
4408       REWRITE_TAC[IN_INTER; IN_NUMSEG] THEN MESON_TAC[BASIS_INJ];
4409       DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[]] THEN
4410     REWRITE_TAC[o_DEF] THEN
4411     SIMP_TAC[CART_EQ; VSUM_COMPONENT; VECTOR_MUL_COMPONENT;
4412              BASIS_COMPONENT] THEN
4413     ONCE_REWRITE_TAC[COND_RAND] THEN
4414     ONCE_REWRITE_TAC[MESON[]
4415      `(if x = y then p else q) = (if y = x then p else q)`] THEN
4416     SIMP_TAC[SUM_DELTA; REAL_MUL_RZERO; IN_INTER; IN_NUMSEG; DOT_BASIS] THEN
4417     ASM_MESON_TAC[REAL_MUL_RID]]);;
4418
4419 let INDEPENDENT_STDBASIS = prove
4420  (`independent {basis i :real^N | 1 <= i /\ i <= dimindex(:N)}`,
4421   REWRITE_TAC[independent; dependent] THEN
4422   ONCE_REWRITE_TAC[SET_RULE `{f x | P x} = IMAGE f {x | P x}`] THEN
4423   REWRITE_TAC[EXISTS_IN_IMAGE] THEN REWRITE_TAC[IN_ELIM_THM] THEN
4424   DISCH_THEN(X_CHOOSE_THEN `k:num` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
4425   SUBGOAL_THEN
4426    `IMAGE basis {i | 1 <= i /\ i <= dimindex(:N)} DELETE
4427            (basis k:real^N) =
4428     IMAGE basis ({i | 1 <= i /\ i <= dimindex(:N)} DELETE k)`
4429   SUBST1_TAC THENL
4430    [REWRITE_TAC[EXTENSION; IN_IMAGE; IN_DELETE; IN_ELIM_THM] THEN
4431     GEN_TAC THEN EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
4432     ASM_MESON_TAC[BASIS_INJ];
4433     ALL_TAC] THEN
4434   REWRITE_TAC[IN_SPAN_IMAGE_BASIS] THEN DISCH_THEN(MP_TAC o SPEC `k:num`) THEN
4435   ASM_SIMP_TAC[IN_DELETE; BASIS_COMPONENT; REAL_OF_NUM_EQ; ARITH]);;
4436
4437 (* ------------------------------------------------------------------------- *)
4438 (* This is useful for building a basis step-by-step.                         *)
4439 (* ------------------------------------------------------------------------- *)
4440
4441 let INDEPENDENT_INSERT = prove
4442  (`!a:real^N s. independent(a INSERT s) <=>
4443                   if a IN s then independent s
4444                   else independent s /\ ~(a IN span s)`,
4445   REPEAT GEN_TAC THEN ASM_CASES_TAC `(a:real^N) IN s` THEN
4446   ASM_SIMP_TAC[SET_RULE `x IN s ==> (x INSERT s = s)`] THEN
4447   EQ_TAC THENL
4448    [DISCH_TAC THEN CONJ_TAC THENL
4449      [ASM_MESON_TAC[INDEPENDENT_MONO; SUBSET; IN_INSERT];
4450       POP_ASSUM MP_TAC THEN REWRITE_TAC[independent; dependent] THEN
4451       ASM_MESON_TAC[IN_INSERT; SET_RULE
4452         `~(a IN s) ==> ((a INSERT s) DELETE a = s)`]];
4453     ALL_TAC] THEN
4454   REWRITE_TAC[independent; dependent; NOT_EXISTS_THM] THEN
4455   STRIP_TAC THEN X_GEN_TAC `b:real^N` THEN
4456   REWRITE_TAC[IN_INSERT] THEN ASM_CASES_TAC `b:real^N = a` THEN
4457   ASM_SIMP_TAC[SET_RULE `~(a IN s) ==> ((a INSERT s) DELETE a = s)`] THEN
4458   ASM_SIMP_TAC[SET_RULE
4459     `~(a IN s) /\ ~(b = a)
4460      ==> ((a INSERT s) DELETE b = a INSERT (s DELETE b))`] THEN
4461   ASM_MESON_TAC[IN_SPAN_INSERT; SET_RULE
4462     `b IN s ==> (b INSERT (s DELETE b) = s)`]);;
4463
4464 (* ------------------------------------------------------------------------- *)
4465 (* The degenerate case of the Exchange Lemma.                                *)
4466 (* ------------------------------------------------------------------------- *)
4467
4468 let SPANNING_SUBSET_INDEPENDENT = prove
4469  (`!s t:real^N->bool.
4470         t SUBSET s /\ independent s /\ s SUBSET span(t) ==> (s = t)`,
4471   REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN
4472   ASM_REWRITE_TAC[] THEN REWRITE_TAC[SUBSET] THEN
4473   X_GEN_TAC `a:real^N` THEN DISCH_TAC THEN
4474   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [independent]) THEN
4475   REWRITE_TAC[dependent; NOT_EXISTS_THM] THEN
4476   DISCH_THEN(MP_TAC o SPEC `a:real^N`) THEN ASM_REWRITE_TAC[] THEN
4477   ASM_MESON_TAC[SPAN_MONO; SUBSET; IN_DELETE]);;
4478
4479 (* ------------------------------------------------------------------------- *)
4480 (* The general case of the Exchange Lemma, the key to what follows.          *)
4481 (* ------------------------------------------------------------------------- *)
4482
4483 let EXCHANGE_LEMMA = prove
4484  (`!s t:real^N->bool.
4485         FINITE t /\ independent s /\ s SUBSET span t
4486         ==> ?t'. t' HAS_SIZE (CARD t) /\
4487                  s SUBSET t' /\ t' SUBSET (s UNION t) /\ s SUBSET (span t')`,
4488   REPEAT GEN_TAC THEN
4489   WF_INDUCT_TAC `CARD(t DIFF s :real^N->bool)` THEN
4490   ASM_CASES_TAC `(s:real^N->bool) SUBSET t` THENL
4491    [ASM_MESON_TAC[HAS_SIZE; SUBSET_UNION]; ALL_TAC] THEN
4492   ASM_CASES_TAC `t SUBSET (s:real^N->bool)` THENL
4493    [ASM_MESON_TAC[SPANNING_SUBSET_INDEPENDENT; HAS_SIZE]; ALL_TAC] THEN
4494   STRIP_TAC THEN
4495   FIRST_X_ASSUM(MP_TAC o REWRITE_RULE[SUBSET] o check(is_neg o concl)) THEN
4496   REWRITE_TAC[NOT_FORALL_THM; NOT_IMP] THEN
4497   DISCH_THEN(X_CHOOSE_THEN `b:real^N` STRIP_ASSUME_TAC) THEN
4498   ASM_CASES_TAC `s SUBSET span(t DELETE (b:real^N))` THENL
4499    [FIRST_X_ASSUM(MP_TAC o
4500      SPECL [`t DELETE (b:real^N)`; `s:real^N->bool`]) THEN
4501     ASM_REWRITE_TAC[SET_RULE `s DELETE a DIFF t = (s DIFF t) DELETE a`] THEN
4502     ASM_SIMP_TAC[CARD_DELETE; FINITE_DIFF; IN_DIFF; FINITE_DELETE;
4503                  CARD_EQ_0; ARITH_RULE `n - 1 < n <=> ~(n = 0)`] THEN
4504     ANTS_TAC THENL
4505      [UNDISCH_TAC `~((s:real^N->bool) SUBSET t)` THEN ASM SET_TAC[];
4506       ALL_TAC] THEN
4507     DISCH_THEN(X_CHOOSE_THEN `u:real^N->bool` STRIP_ASSUME_TAC) THEN
4508     EXISTS_TAC `(b:real^N) INSERT u` THEN
4509     ASM_SIMP_TAC[SUBSET_INSERT; INSERT_SUBSET; IN_UNION] THEN CONJ_TAC THENL
4510      [UNDISCH_TAC `(u:real^N->bool) HAS_SIZE CARD(t:real^N->bool) - 1` THEN
4511       SIMP_TAC[HAS_SIZE; FINITE_RULES; CARD_CLAUSES] THEN STRIP_TAC THEN
4512       COND_CASES_TAC THENL
4513        [ASM_MESON_TAC[SUBSET; IN_UNION; IN_DELETE]; ALL_TAC] THEN
4514       ASM_MESON_TAC[ARITH_RULE `~(n = 0) ==> (SUC(n - 1) = n)`;
4515                     CARD_EQ_0; MEMBER_NOT_EMPTY];
4516       ALL_TAC] THEN
4517     CONJ_TAC THENL
4518      [UNDISCH_TAC `u SUBSET s UNION t DELETE (b:real^N)` THEN SET_TAC[];
4519       ASM_MESON_TAC[SUBSET; SPAN_MONO; IN_INSERT]];
4520     ALL_TAC] THEN
4521   UNDISCH_TAC `~(s SUBSET span (t DELETE (b:real^N)))` THEN
4522   GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [SUBSET] THEN
4523   REWRITE_TAC[NOT_FORALL_THM; NOT_IMP] THEN
4524   DISCH_THEN(X_CHOOSE_THEN `a:real^N` STRIP_ASSUME_TAC) THEN
4525   SUBGOAL_THEN `~(a:real^N = b)` ASSUME_TAC THENL
4526     [ASM_MESON_TAC[]; ALL_TAC] THEN
4527   SUBGOAL_THEN `~((a:real^N) IN t)` ASSUME_TAC THENL
4528    [ASM_MESON_TAC[IN_DELETE; SPAN_CLAUSES]; ALL_TAC] THEN
4529   FIRST_X_ASSUM(MP_TAC o SPECL
4530    [`(a:real^N) INSERT (t DELETE b)`; `s:real^N->bool`]) THEN
4531   ANTS_TAC THENL
4532    [ASM_SIMP_TAC[SET_RULE
4533      `a IN s ==> ((a INSERT (t DELETE b) DIFF s) = (t DIFF s) DELETE b)`] THEN
4534     ASM_SIMP_TAC[CARD_DELETE; FINITE_DELETE; FINITE_DIFF; IN_DIFF] THEN
4535     ASM_SIMP_TAC[ARITH_RULE `n - 1 < n <=> ~(n = 0)`; CARD_EQ_0;
4536                  FINITE_DIFF] THEN
4537     UNDISCH_TAC `~((s:real^N->bool) SUBSET t)` THEN ASM SET_TAC[];
4538     ALL_TAC] THEN
4539   ANTS_TAC THENL
4540    [ASM_SIMP_TAC[FINITE_RULES; FINITE_DELETE] THEN
4541     REWRITE_TAC[SUBSET] THEN X_GEN_TAC `x:real^N` THEN
4542     DISCH_TAC THEN MATCH_MP_TAC SPAN_TRANS THEN EXISTS_TAC `b:real^N` THEN
4543     ASM_MESON_TAC[IN_SPAN_DELETE; SUBSET; SPAN_MONO;
4544                   SET_RULE `t SUBSET (b INSERT (a INSERT (t DELETE b)))`];
4545     ALL_TAC] THEN
4546   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u:real^N->bool` THEN
4547   ASM_SIMP_TAC[HAS_SIZE; CARD_CLAUSES; CARD_DELETE; FINITE_DELETE; IN_DELETE;
4548                ARITH_RULE `(SUC(n - 1) = n) <=> ~(n = 0)`;
4549                CARD_EQ_0] THEN
4550   UNDISCH_TAC `(b:real^N) IN t` THEN ASM SET_TAC[]);;
4551
4552 (* ------------------------------------------------------------------------- *)
4553 (* This implies corresponding size bounds.                                   *)
4554 (* ------------------------------------------------------------------------- *)
4555
4556 let INDEPENDENT_SPAN_BOUND = prove
4557  (`!s t. FINITE t /\ independent s /\ s SUBSET span(t)
4558          ==> FINITE s /\ CARD(s) <= CARD(t)`,
4559   REPEAT GEN_TAC THEN DISCH_TAC THEN
4560   FIRST_ASSUM(MP_TAC o MATCH_MP EXCHANGE_LEMMA) THEN
4561   ASM_MESON_TAC[HAS_SIZE; CARD_SUBSET; FINITE_SUBSET]);;
4562
4563 let INDEPENDENT_BOUND = prove
4564  (`!s:real^N->bool.
4565         independent s ==> FINITE s /\ CARD(s) <= dimindex(:N)`,
4566   REPEAT GEN_TAC THEN DISCH_TAC THEN
4567   ONCE_REWRITE_TAC[GSYM CARD_STDBASIS] THEN
4568   MATCH_MP_TAC INDEPENDENT_SPAN_BOUND THEN
4569   ASM_REWRITE_TAC[FINITE_STDBASIS; SPAN_STDBASIS; SUBSET_UNIV]);;
4570
4571 let DEPENDENT_BIGGERSET = prove
4572  (`!s:real^N->bool. (FINITE s ==> CARD(s) > dimindex(:N)) ==> dependent s`,
4573   MP_TAC INDEPENDENT_BOUND THEN MATCH_MP_TAC MONO_FORALL THEN
4574   REWRITE_TAC[GT; GSYM NOT_LE; independent] THEN MESON_TAC[]);;
4575
4576 let INDEPENDENT_IMP_FINITE = prove
4577  (`!s:real^N->bool. independent s ==> FINITE s`,
4578   SIMP_TAC[INDEPENDENT_BOUND]);;
4579
4580 (* ------------------------------------------------------------------------- *)
4581 (* Explicit formulation of independence.                                     *)
4582 (* ------------------------------------------------------------------------- *)
4583
4584 let INDEPENDENT_EXPLICIT = prove
4585  (`!b:real^N->bool.
4586         independent b <=>
4587             FINITE b /\
4588             !c. vsum b (\v. c(v) % v) = vec 0 ==> !v. v IN b ==> c(v) = &0`,
4589   GEN_TAC THEN
4590   ASM_CASES_TAC `FINITE(b:real^N->bool)` THENL
4591    [ALL_TAC; ASM_MESON_TAC[INDEPENDENT_BOUND]] THEN
4592   ASM_SIMP_TAC[independent; DEPENDENT_FINITE] THEN MESON_TAC[]);;
4593
4594 let INDEPENDENT_SING = prove
4595  (`!x. independent {x} <=> ~(x = vec 0)`,
4596   REWRITE_TAC[INDEPENDENT_INSERT; NOT_IN_EMPTY; SPAN_EMPTY] THEN
4597   REWRITE_TAC[INDEPENDENT_EMPTY] THEN SET_TAC[]);;
4598
4599 let DEPENDENT_SING = prove
4600  (`!x. dependent {x} <=> x = vec 0`,
4601   MESON_TAC[independent; INDEPENDENT_SING]);;
4602
4603 let DEPENDENT_2 = prove
4604  (`!a b:real^N.
4605         dependent {a,b} <=>
4606                 if a = b then a = vec 0
4607                 else ?x y. x % a + y % b = vec 0 /\ ~(x = &0 /\ y = &0)`,
4608   REPEAT STRIP_TAC THEN COND_CASES_TAC THEN
4609   ASM_REWRITE_TAC[DEPENDENT_SING; SET_RULE `{x,x} = {x}`] THEN
4610   SIMP_TAC[DEPENDENT_FINITE; VSUM_CLAUSES; FINITE_INSERT; FINITE_EMPTY] THEN
4611   ASM_REWRITE_TAC[IN_SING; NOT_IN_EMPTY; VECTOR_ADD_RID; EXISTS_IN_INSERT] THEN
4612   EQ_TAC THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THENL
4613    [X_GEN_TAC `u:real^N->real` THEN STRIP_TAC THEN
4614     MAP_EVERY EXISTS_TAC [`(u:real^N->real) a`; `(u:real^N->real) b`] THEN
4615     ASM_REWRITE_TAC[];
4616     MAP_EVERY X_GEN_TAC [`x:real`; `y:real`] THEN DISCH_TAC THEN EXISTS_TAC
4617      `\v:real^N. if v = a then x else if v = b then y else z:real` THEN
4618     ASM_MESON_TAC[]]);;
4619
4620 let DEPENDENT_3 = prove
4621  (`!a b c:real^N.
4622         ~(a = b) /\ ~(a = c) /\ ~(b = c)
4623         ==> (dependent {a,b,c} <=>
4624              ?x y z. x % a + y % b + z % c = vec 0 /\
4625                      ~(x = &0 /\ y = &0 /\ z = &0))`,
4626   REPEAT STRIP_TAC THEN
4627   SIMP_TAC[DEPENDENT_FINITE; VSUM_CLAUSES; FINITE_INSERT; FINITE_EMPTY] THEN
4628   ASM_REWRITE_TAC[IN_SING; NOT_IN_EMPTY; VECTOR_ADD_RID; IN_INSERT] THEN
4629   EQ_TAC THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THENL
4630    [X_GEN_TAC `u:real^N->real` THEN STRIP_TAC THEN MAP_EVERY EXISTS_TAC
4631      [`(u:real^N->real) a`; `(u:real^N->real) b`; `(u:real^N->real) c`];
4632     MAP_EVERY X_GEN_TAC [`x:real`; `y:real`; `z:real`] THEN DISCH_TAC THEN
4633     EXISTS_TAC
4634      `\v:real^N. if v = a then x else if v = b then y else z:real`] THEN
4635   ASM_MESON_TAC[]);;
4636
4637 let INDEPENDENT_2 = prove
4638  (`!a b:real^N x y.
4639         independent{a,b} /\ ~(a = b)
4640         ==> (x % a + y % b = vec 0 <=> x = &0 /\ y = &0)`,
4641   SIMP_TAC[IMP_CONJ_ALT; independent; DEPENDENT_2] THEN
4642   MESON_TAC[VECTOR_MUL_LZERO; VECTOR_ADD_LID]);;
4643
4644 let INDEPENDENT_3 = prove
4645  (`!a b c:real^N x y z.
4646         independent{a,b,c} /\ ~(a = b) /\ ~(a = c) /\ ~(b = c)
4647         ==> (x % a + y % b + z % c = vec 0 <=> x = &0 /\ y = &0 /\ z = &0)`,
4648   SIMP_TAC[IMP_CONJ_ALT; independent; DEPENDENT_3] THEN
4649   MESON_TAC[VECTOR_MUL_LZERO; VECTOR_ADD_LID]);;
4650
4651 (* ------------------------------------------------------------------------- *)
4652 (* Hence we can create a maximal independent subset.                         *)
4653 (* ------------------------------------------------------------------------- *)
4654
4655 let MAXIMAL_INDEPENDENT_SUBSET_EXTEND = prove
4656  (`!s v:real^N->bool.
4657         s SUBSET v /\ independent s
4658         ==> ?b. s SUBSET b /\ b SUBSET v /\ independent b /\
4659                 v SUBSET (span b)`,
4660   REPEAT GEN_TAC THEN
4661   WF_INDUCT_TAC `dimindex(:N) - CARD(s:real^N->bool)` THEN
4662   REPEAT STRIP_TAC THEN
4663   ASM_CASES_TAC `v SUBSET (span(s:real^N->bool))` THENL
4664    [ASM_MESON_TAC[SUBSET_REFL]; ALL_TAC] THEN
4665   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [SUBSET]) THEN
4666   REWRITE_TAC[NOT_FORALL_THM; NOT_IMP] THEN
4667   DISCH_THEN(X_CHOOSE_THEN `a:real^N` STRIP_ASSUME_TAC) THEN
4668   FIRST_X_ASSUM(MP_TAC o SPEC `(a:real^N) INSERT s`) THEN
4669   REWRITE_TAC[IMP_IMP] THEN ANTS_TAC THENL
4670    [ALL_TAC; MESON_TAC[INSERT_SUBSET]] THEN
4671   SUBGOAL_THEN `independent ((a:real^N) INSERT s)` ASSUME_TAC THENL
4672    [ASM_REWRITE_TAC[INDEPENDENT_INSERT; COND_ID]; ALL_TAC] THEN
4673   ASM_REWRITE_TAC[INSERT_SUBSET] THEN
4674   MATCH_MP_TAC(ARITH_RULE `(b = a + 1) /\ b <= n ==> n - b < n - a`) THEN
4675   ASM_SIMP_TAC[CARD_CLAUSES; INDEPENDENT_BOUND] THEN
4676   ASM_MESON_TAC[SPAN_SUPERSET; ADD1]);;
4677
4678 let MAXIMAL_INDEPENDENT_SUBSET = prove
4679  (`!v:real^N->bool. ?b. b SUBSET v /\ independent b /\ v SUBSET (span b)`,
4680   MP_TAC(SPEC `EMPTY:real^N->bool` MAXIMAL_INDEPENDENT_SUBSET_EXTEND) THEN
4681   REWRITE_TAC[EMPTY_SUBSET; INDEPENDENT_EMPTY]);;
4682
4683 (* ------------------------------------------------------------------------- *)
4684 (* A kind of closed graph property for linearity.                            *)
4685 (* ------------------------------------------------------------------------- *)
4686
4687 let LINEAR_SUBSPACE_GRAPH = prove
4688  (`!f:real^M->real^N.
4689         linear f <=> subspace {pastecart x (f x) | x IN (:real^M)}`,
4690   REWRITE_TAC[linear; subspace; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
4691   REWRITE_TAC[FORALL_IN_GSPEC; GSYM(SPEC `0` PASTECART_VEC); IN_UNIV] THEN
4692   REWRITE_TAC[IN_ELIM_THM; PASTECART_INJ; UNWIND_THM1; PASTECART_ADD;
4693               GSYM PASTECART_CMUL] THEN
4694   MESON_TAC[VECTOR_MUL_LZERO]);;
4695
4696 (* ------------------------------------------------------------------------- *)
4697 (* Notion of dimension.                                                      *)
4698 (* ------------------------------------------------------------------------- *)
4699
4700 let dim = new_definition
4701   `dim v = @n. ?b. b SUBSET v /\ independent b /\ v SUBSET (span b) /\
4702                    b HAS_SIZE n`;;
4703
4704 let BASIS_EXISTS = prove
4705  (`!v. ?b. b SUBSET v /\ independent b /\ v SUBSET (span b) /\
4706            b HAS_SIZE (dim v)`,
4707   GEN_TAC THEN REWRITE_TAC[dim] THEN CONV_TAC SELECT_CONV THEN
4708   MESON_TAC[MAXIMAL_INDEPENDENT_SUBSET; HAS_SIZE; INDEPENDENT_BOUND]);;
4709
4710 let BASIS_EXISTS_FINITE = prove
4711  (`!v. ?b. FINITE b /\
4712            b SUBSET v /\
4713            independent b /\
4714            v SUBSET (span b) /\
4715            b HAS_SIZE (dim v)`,
4716   MESON_TAC[BASIS_EXISTS; INDEPENDENT_IMP_FINITE]);;
4717
4718 let BASIS_SUBSPACE_EXISTS = prove
4719  (`!s:real^N->bool.
4720         subspace s
4721         ==> ?b. FINITE b /\
4722                 b SUBSET s /\
4723                 independent b /\
4724                 span b = s /\
4725                 b HAS_SIZE dim s`,
4726   REPEAT STRIP_TAC THEN
4727   MP_TAC(ISPEC `s:real^N->bool` BASIS_EXISTS) THEN
4728   MATCH_MP_TAC MONO_EXISTS THEN REPEAT STRIP_TAC THEN
4729   ASM_REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ] THEN
4730   ASM_MESON_TAC[SPAN_EQ_SELF; SPAN_MONO; INDEPENDENT_IMP_FINITE]);;
4731
4732 (* ------------------------------------------------------------------------- *)
4733 (* Consequences of independence or spanning for cardinality.                 *)
4734 (* ------------------------------------------------------------------------- *)
4735
4736 let INDEPENDENT_CARD_LE_DIM = prove
4737  (`!v b:real^N->bool.
4738         b SUBSET v /\ independent b ==> FINITE b /\ CARD(b) <= dim v`,
4739   MESON_TAC[BASIS_EXISTS; INDEPENDENT_SPAN_BOUND; HAS_SIZE;SUBSET_TRANS]);;
4740
4741 let SPAN_CARD_GE_DIM = prove
4742  (`!v b:real^N->bool.
4743         v SUBSET (span b) /\ FINITE b ==> dim(v) <= CARD(b)`,
4744   MESON_TAC[BASIS_EXISTS; INDEPENDENT_SPAN_BOUND; HAS_SIZE;SUBSET_TRANS]);;
4745
4746 let BASIS_CARD_EQ_DIM = prove
4747  (`!v b. b SUBSET v /\ v SUBSET (span b) /\ independent b
4748          ==> FINITE b /\ (CARD b = dim v)`,
4749   MESON_TAC[LE_ANTISYM; INDEPENDENT_CARD_LE_DIM; SPAN_CARD_GE_DIM]);;
4750
4751 let BASIS_HAS_SIZE_DIM = prove
4752  (`!v b. independent b /\ span b = v ==> b HAS_SIZE (dim v)`,
4753   REPEAT STRIP_TAC THEN REWRITE_TAC[HAS_SIZE] THEN
4754   MATCH_MP_TAC BASIS_CARD_EQ_DIM THEN ASM_REWRITE_TAC[SUBSET_REFL] THEN
4755   FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN REWRITE_TAC[SPAN_INC]);;
4756
4757 let DIM_UNIQUE = prove
4758  (`!v b. b SUBSET v /\ v SUBSET (span b) /\ independent b /\ b HAS_SIZE n
4759          ==> (dim v = n)`,
4760   MESON_TAC[BASIS_CARD_EQ_DIM; HAS_SIZE]);;
4761
4762 let DIM_LE_CARD = prove
4763  (`!s. FINITE s ==> dim s <= CARD s`,
4764   GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC SPAN_CARD_GE_DIM THEN
4765   ASM_REWRITE_TAC[SPAN_INC; SUBSET_REFL]);;
4766
4767 (* ------------------------------------------------------------------------- *)
4768 (* More lemmas about dimension.                                              *)
4769 (* ------------------------------------------------------------------------- *)
4770
4771 let DIM_UNIV = prove
4772  (`dim(:real^N) = dimindex(:N)`,
4773   MATCH_MP_TAC DIM_UNIQUE THEN
4774   EXISTS_TAC `{basis i :real^N | 1 <= i /\ i <= dimindex(:N)}` THEN
4775   REWRITE_TAC[SUBSET_UNIV; SPAN_STDBASIS; HAS_SIZE_STDBASIS;
4776               INDEPENDENT_STDBASIS]);;
4777
4778 let DIM_SUBSET = prove
4779  (`!s t:real^N->bool. s SUBSET t ==> dim(s) <= dim(t)`,
4780   MESON_TAC[BASIS_EXISTS; INDEPENDENT_SPAN_BOUND; SUBSET; HAS_SIZE]);;
4781
4782 let DIM_SUBSET_UNIV = prove
4783  (`!s:real^N->bool. dim(s) <= dimindex(:N)`,
4784   GEN_TAC THEN REWRITE_TAC[GSYM DIM_UNIV] THEN
4785   MATCH_MP_TAC DIM_SUBSET THEN REWRITE_TAC[SUBSET_UNIV]);;
4786
4787 let BASIS_HAS_SIZE_UNIV = prove
4788  (`!b. independent b /\ span b = (:real^N) ==> b HAS_SIZE (dimindex(:N))`,
4789   REWRITE_TAC[GSYM DIM_UNIV; BASIS_HAS_SIZE_DIM]);;
4790
4791 (* ------------------------------------------------------------------------- *)
4792 (* Converses to those.                                                       *)
4793 (* ------------------------------------------------------------------------- *)
4794
4795 let CARD_GE_DIM_INDEPENDENT = prove
4796  (`!v b:real^N->bool.
4797         b SUBSET v /\ independent b /\ dim v <= CARD(b)
4798         ==> v SUBSET (span b)`,
4799   REPEAT STRIP_TAC THEN
4800   SUBGOAL_THEN `!a:real^N. ~(a IN v /\ ~(a IN span b))` MP_TAC THENL
4801    [ALL_TAC; SET_TAC[]] THEN
4802   X_GEN_TAC `a:real^N` THEN STRIP_TAC THEN
4803   SUBGOAL_THEN `independent((a:real^N) INSERT b)` ASSUME_TAC THENL
4804    [ASM_MESON_TAC[INDEPENDENT_INSERT]; ALL_TAC] THEN
4805   MP_TAC(ISPECL [`v:real^N->bool`; `(a:real^N) INSERT b`]
4806                 INDEPENDENT_CARD_LE_DIM) THEN
4807   ASM_SIMP_TAC[INSERT_SUBSET; CARD_CLAUSES; INDEPENDENT_BOUND] THEN
4808   ASM_MESON_TAC[SPAN_SUPERSET; SUBSET; ARITH_RULE
4809     `x <= y ==> ~(SUC y <= x)`]);;
4810
4811 let CARD_LE_DIM_SPANNING = prove
4812  (`!v b:real^N->bool.
4813         v SUBSET (span b) /\ FINITE b /\ CARD(b) <= dim v
4814         ==> independent b`,
4815   REPEAT STRIP_TAC THEN REWRITE_TAC[independent; dependent] THEN
4816   DISCH_THEN(X_CHOOSE_THEN `a:real^N` STRIP_ASSUME_TAC) THEN
4817   SUBGOAL_THEN `dim(v:real^N->bool) <= CARD(b DELETE (a:real^N))` MP_TAC THENL
4818    [ALL_TAC;
4819     ASM_SIMP_TAC[CARD_DELETE] THEN MATCH_MP_TAC
4820      (ARITH_RULE `b <= n /\ ~(b = 0) ==> ~(n <= b - 1)`) THEN
4821     ASM_SIMP_TAC[CARD_EQ_0] THEN ASM_MESON_TAC[MEMBER_NOT_EMPTY]] THEN
4822   MATCH_MP_TAC SPAN_CARD_GE_DIM THEN ASM_SIMP_TAC[FINITE_DELETE] THEN
4823   REWRITE_TAC[SUBSET] THEN REPEAT STRIP_TAC THEN
4824   MATCH_MP_TAC SPAN_TRANS THEN EXISTS_TAC `a:real^N` THEN
4825   ASM_SIMP_TAC[SET_RULE `a IN b ==> (a INSERT (b DELETE a) = b)`] THEN
4826   ASM_MESON_TAC[SUBSET]);;
4827
4828 let CARD_EQ_DIM = prove
4829  (`!v b. b SUBSET v /\ b HAS_SIZE (dim v)
4830          ==> (independent b <=> v SUBSET (span b))`,
4831   REWRITE_TAC[HAS_SIZE; GSYM LE_ANTISYM] THEN
4832   MESON_TAC[CARD_LE_DIM_SPANNING; CARD_GE_DIM_INDEPENDENT]);;
4833
4834 (* ------------------------------------------------------------------------- *)
4835 (* More general size bound lemmas.                                           *)
4836 (* ------------------------------------------------------------------------- *)
4837
4838 let INDEPENDENT_BOUND_GENERAL = prove
4839  (`!s:real^N->bool. independent s ==> FINITE s /\ CARD(s) <= dim(s)`,
4840   MESON_TAC[INDEPENDENT_CARD_LE_DIM; INDEPENDENT_BOUND; SUBSET_REFL]);;
4841
4842 let DEPENDENT_BIGGERSET_GENERAL = prove
4843  (`!s:real^N->bool. (FINITE s ==> CARD(s) > dim(s)) ==> dependent s`,
4844   MP_TAC INDEPENDENT_BOUND_GENERAL THEN MATCH_MP_TAC MONO_FORALL THEN
4845   REWRITE_TAC[GT; GSYM NOT_LE; independent] THEN MESON_TAC[]);;
4846
4847 let DIM_SPAN = prove
4848  (`!s:real^N->bool. dim(span s) = dim s`,
4849   GEN_TAC THEN REWRITE_TAC[GSYM LE_ANTISYM] THEN CONJ_TAC THENL
4850    [ALL_TAC;
4851     MATCH_MP_TAC DIM_SUBSET THEN MESON_TAC[SUBSET; SPAN_SUPERSET]] THEN
4852   MP_TAC(ISPEC `s:real^N->bool` BASIS_EXISTS) THEN
4853   REWRITE_TAC[HAS_SIZE] THEN STRIP_TAC THEN
4854   FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN
4855   MATCH_MP_TAC SPAN_CARD_GE_DIM THEN ASM_REWRITE_TAC[] THEN
4856   GEN_REWRITE_TAC RAND_CONV [GSYM SPAN_SPAN] THEN
4857   MATCH_MP_TAC SPAN_MONO THEN ASM_REWRITE_TAC[]);;
4858
4859 let DIM_INSERT_0 = prove
4860  (`!s:real^N->bool. dim(vec 0 INSERT s) = dim s`,
4861   ONCE_REWRITE_TAC[GSYM DIM_SPAN] THEN
4862   REWRITE_TAC[SPAN_INSERT_0]);;
4863
4864 let DIM_EQ_CARD = prove
4865  (`!s:real^N->bool. independent s ==> dim s = CARD s`,
4866   REPEAT STRIP_TAC THEN MP_TAC
4867    (ISPECL [`span s:real^N->bool`; `s:real^N->bool`] BASIS_CARD_EQ_DIM) THEN
4868   ASM_SIMP_TAC[SUBSET_REFL; SPAN_INC; DIM_SPAN]);;
4869
4870 let SUBSET_LE_DIM = prove
4871  (`!s t:real^N->bool. s SUBSET (span t) ==> dim s <= dim t`,
4872   MESON_TAC[DIM_SPAN; DIM_SUBSET]);;
4873
4874 let SPAN_EQ_DIM = prove
4875  (`!s t. span s = span t ==> dim s = dim t`,
4876   MESON_TAC[DIM_SPAN]);;
4877
4878 let SPANS_IMAGE = prove
4879  (`!f b v. linear f /\ v SUBSET (span b)
4880            ==> (IMAGE f v) SUBSET span(IMAGE f b)`,
4881   SIMP_TAC[SPAN_LINEAR_IMAGE; IMAGE_SUBSET]);;
4882
4883 let DIM_LINEAR_IMAGE_LE = prove
4884  (`!f:real^M->real^N s. linear f ==> dim(IMAGE f s) <= dim s`,
4885   REPEAT STRIP_TAC THEN MP_TAC(ISPEC `s:real^M->bool` BASIS_EXISTS) THEN
4886   REWRITE_TAC[HAS_SIZE] THEN STRIP_TAC THEN FIRST_ASSUM(SUBST1_TAC o SYM) THEN
4887   MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `CARD(IMAGE (f:real^M->real^N) b)` THEN
4888   ASM_SIMP_TAC[CARD_IMAGE_LE] THEN MATCH_MP_TAC SPAN_CARD_GE_DIM THEN
4889   ASM_MESON_TAC[SPAN_LINEAR_IMAGE; SPANS_IMAGE; SUBSET_IMAGE; FINITE_IMAGE]);;
4890
4891 (* ------------------------------------------------------------------------- *)
4892 (* Some stepping theorems.                                                   *)
4893 (* ------------------------------------------------------------------------- *)
4894
4895 let DIM_EMPTY = prove
4896  (`dim({}:real^N->bool) = 0`,
4897   MATCH_MP_TAC DIM_UNIQUE THEN EXISTS_TAC `{}:real^N->bool` THEN
4898   REWRITE_TAC[SUBSET_REFL; SPAN_EMPTY; INDEPENDENT_EMPTY; HAS_SIZE_0;
4899               EMPTY_SUBSET]);;
4900
4901 let DIM_INSERT = prove
4902  (`!x:real^N s. dim(x INSERT s) = if x IN span s then dim s else dim s + 1`,
4903   REPEAT GEN_TAC THEN COND_CASES_TAC THENL
4904    [MATCH_MP_TAC SPAN_EQ_DIM THEN MATCH_MP_TAC SUBSET_ANTISYM THEN
4905     ASM_MESON_TAC[SPAN_TRANS; SUBSET; SPAN_MONO; IN_INSERT];
4906     ALL_TAC] THEN
4907   X_CHOOSE_THEN `b:real^N->bool` STRIP_ASSUME_TAC
4908    (ISPEC `span s:real^N->bool` BASIS_EXISTS) THEN
4909   ONCE_REWRITE_TAC[GSYM DIM_SPAN] THEN
4910   MATCH_MP_TAC DIM_UNIQUE THEN
4911   EXISTS_TAC `(x:real^N) INSERT b` THEN REPEAT CONJ_TAC THENL
4912    [REWRITE_TAC[INSERT_SUBSET] THEN
4913     ASM_MESON_TAC[SUBSET; SPAN_MONO; IN_INSERT; SPAN_SUPERSET];
4914     REWRITE_TAC[SUBSET; SPAN_BREAKDOWN_EQ] THEN
4915     ASM_MESON_TAC[SUBSET];
4916     REWRITE_TAC[INDEPENDENT_INSERT] THEN
4917     ASM_MESON_TAC[SUBSET; SPAN_SUPERSET; SPAN_MONO; SPAN_SPAN];
4918     RULE_ASSUM_TAC(REWRITE_RULE[HAS_SIZE]) THEN
4919     ASM_SIMP_TAC[HAS_SIZE; CARD_CLAUSES; FINITE_INSERT; ADD1] THEN
4920     ASM_MESON_TAC[SUBSET; SPAN_SUPERSET; SPAN_MONO; SPAN_SPAN]]);;
4921
4922 let DIM_SING = prove
4923  (`!x. dim{x} = if x = vec 0 then 0 else 1`,
4924   REWRITE_TAC[DIM_INSERT; DIM_EMPTY; SPAN_EMPTY; IN_SING; ARITH]);;
4925
4926 let DIM_EQ_0 = prove
4927  (`!s:real^N->bool. dim s = 0 <=> s SUBSET {vec 0}`,
4928   REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THENL
4929    [MATCH_MP_TAC(SET_RULE
4930      `~(?b. ~(b = a) /\ {b} SUBSET s) ==> s SUBSET {a}`) THEN
4931     STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP DIM_SUBSET);
4932     MATCH_MP_TAC(ARITH_RULE `!m. m = 0 /\ n <= m ==> n = 0`) THEN
4933     EXISTS_TAC `dim{vec 0:real^N}` THEN ASM_SIMP_TAC[DIM_SUBSET]] THEN
4934   ASM_REWRITE_TAC[DIM_SING; ARITH]);;
4935
4936 (* ------------------------------------------------------------------------- *)
4937 (* Choosing a subspace of a given dimension.                                 *)
4938 (* ------------------------------------------------------------------------- *)
4939
4940 let CHOOSE_SUBSPACE_OF_SUBSPACE = prove
4941  (`!s:real^N->bool n.
4942         n <= dim s ==> ?t. subspace t /\ t SUBSET span s /\ dim t = n`,
4943   GEN_TAC THEN INDUCT_TAC THENL
4944    [DISCH_TAC THEN EXISTS_TAC `{vec 0:real^N}` THEN
4945     REWRITE_TAC[SUBSPACE_TRIVIAL; DIM_SING; SING_SUBSET; SPAN_0];
4946     DISCH_THEN(fun th -> POP_ASSUM MP_TAC THEN ASSUME_TAC th) THEN
4947     ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN
4948     DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) THEN
4949     ASM_CASES_TAC `span (s:real^N->bool) SUBSET span t` THENL
4950      [SUBGOAL_THEN `dim(s:real^N->bool) = dim(t:real^N->bool)` MP_TAC THENL
4951        [ALL_TAC; ASM_ARITH_TAC] THEN MATCH_MP_TAC SPAN_EQ_DIM THEN
4952       MATCH_MP_TAC SUBSET_ANTISYM THEN ASM_REWRITE_TAC[] THEN
4953       MATCH_MP_TAC SPAN_SUBSET_SUBSPACE THEN ASM_REWRITE_TAC[SUBSPACE_SPAN];
4954       FIRST_ASSUM(X_CHOOSE_THEN `y:real^N` STRIP_ASSUME_TAC o MATCH_MP(SET_RULE
4955        `~(s SUBSET t) ==> ?a. a IN s /\ ~(a IN t)`)) THEN
4956       EXISTS_TAC `span((y:real^N) INSERT t)` THEN
4957       REWRITE_TAC[SUBSPACE_SPAN] THEN CONJ_TAC THENL
4958        [MATCH_MP_TAC SPAN_SUBSET_SUBSPACE THEN
4959         ASM_REWRITE_TAC[SUBSPACE_SPAN] THEN ASM SET_TAC[];
4960         ASM_REWRITE_TAC[DIM_SPAN; DIM_INSERT; ADD1]]]]);;
4961
4962 (* ------------------------------------------------------------------------- *)
4963 (* Relation between bases and injectivity/surjectivity of map.               *)
4964 (* ------------------------------------------------------------------------- *)
4965
4966 let SPANNING_SURJECTIVE_IMAGE = prove
4967  (`!f:real^M->real^N s.
4968         UNIV SUBSET (span s) /\ linear f /\ (!y. ?x. f(x) = y)
4969         ==> UNIV SUBSET span(IMAGE f s)`,
4970   REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_TRANS THEN
4971   EXISTS_TAC `IMAGE (f:real^M->real^N) UNIV` THEN
4972   ASM_SIMP_TAC[SPANS_IMAGE] THEN
4973   REWRITE_TAC[SUBSET; IN_UNIV; IN_IMAGE] THEN ASM_MESON_TAC[]);;
4974
4975 let INDEPENDENT_INJECTIVE_IMAGE_GEN = prove
4976  (`!f:real^M->real^N s.
4977         independent s /\ linear f /\
4978         (!x y. x IN span s /\ y IN span s /\ f(x) = f(y) ==> x = y)
4979         ==> independent (IMAGE f s)`,
4980   REPEAT GEN_TAC THEN
4981   DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN
4982   ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN
4983   REWRITE_TAC[independent; DEPENDENT_EXPLICIT] THEN
4984   REWRITE_TAC[CONJ_ASSOC; FINITE_SUBSET_IMAGE] THEN
4985   REWRITE_TAC[MESON[]
4986      `(?s u. ((?t. p t /\ s = f t) /\ q s u) /\ r s u) <=>
4987       (?t u. p t /\ q (f t) u /\ r (f t) u)`] THEN
4988   REWRITE_TAC[EXISTS_IN_IMAGE; LEFT_IMP_EXISTS_THM] THEN
4989   MAP_EVERY X_GEN_TAC [`t:real^M->bool`; `u:real^N->real`] THEN
4990   DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN
4991   MAP_EVERY EXISTS_TAC
4992    [`t:real^M->bool`; `(u:real^N->real) o (f:real^M->real^N)`] THEN
4993   ASM_REWRITE_TAC[o_THM] THEN
4994   FIRST_ASSUM MATCH_MP_TAC THEN REPEAT CONJ_TAC THENL
4995    [MATCH_MP_TAC SPAN_VSUM THEN ASM_REWRITE_TAC[] THEN
4996     REPEAT STRIP_TAC THEN MATCH_MP_TAC SPAN_MUL THEN
4997     MATCH_MP_TAC SPAN_SUPERSET THEN ASM SET_TAC[];
4998     REWRITE_TAC[SPAN_0];
4999     ASM_SIMP_TAC[LINEAR_VSUM] THEN
5000     FIRST_ASSUM(SUBST1_TAC o MATCH_MP LINEAR_0) THEN
5001     FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN CONV_TAC SYM_CONV THEN
5002     W(MP_TAC o PART_MATCH (lhs o rand) VSUM_IMAGE o lhand o snd) THEN
5003     ASM_SIMP_TAC[o_DEF; LINEAR_CMUL] THEN DISCH_THEN MATCH_MP_TAC THEN
5004     ASM_MESON_TAC[SPAN_SUPERSET; SUBSET]]);;
5005
5006 let INDEPENDENT_INJECTIVE_IMAGE = prove
5007  (`!f:real^M->real^N s.
5008         independent s /\ linear f /\ (!x y. (f(x) = f(y)) ==> (x = y))
5009         ==> independent (IMAGE f s)`,
5010   REPEAT STRIP_TAC THEN MATCH_MP_TAC INDEPENDENT_INJECTIVE_IMAGE_GEN THEN
5011   ASM_MESON_TAC[]);;
5012
5013 (* ------------------------------------------------------------------------- *)
5014 (* Picking an orthogonal replacement for a spanning set.                     *)
5015 (* ------------------------------------------------------------------------- *)
5016
5017 let VECTOR_SUB_PROJECT_ORTHOGONAL = prove
5018  (`!b:real^N x. b dot (x - ((b dot x) / (b dot b)) % b) = &0`,
5019   REPEAT GEN_TAC THEN ASM_CASES_TAC `b = vec 0 :real^N` THENL
5020    [ASM_REWRITE_TAC[DOT_LZERO]; ALL_TAC] THEN
5021   ASM_SIMP_TAC[DOT_RSUB; DOT_RMUL] THEN
5022   ASM_SIMP_TAC[REAL_SUB_REFL; REAL_DIV_RMUL; DOT_EQ_0]);;
5023
5024 let BASIS_ORTHOGONAL = prove
5025  (`!b:real^N->bool.
5026         FINITE b
5027         ==> ?c. FINITE c /\ CARD c <= CARD b /\
5028                 span c = span b /\ pairwise orthogonal c`,
5029   REWRITE_TAC[pairwise; orthogonal] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
5030   CONJ_TAC THENL
5031    [EXISTS_TAC `{}:real^N->bool` THEN
5032     REWRITE_TAC[FINITE_RULES; NOT_IN_EMPTY; LE_REFL];
5033     ALL_TAC] THEN
5034   MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N->bool`] THEN
5035   DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `c:real^N->bool` STRIP_ASSUME_TAC)
5036         STRIP_ASSUME_TAC) THEN
5037   EXISTS_TAC `(a - vsum c (\x. ((x dot a) / (x dot x)) % x):real^N)
5038               INSERT c` THEN
5039   ASM_SIMP_TAC[FINITE_RULES; CARD_CLAUSES] THEN REPEAT CONJ_TAC THENL
5040    [ASM_ARITH_TAC;
5041     REWRITE_TAC[EXTENSION; SPAN_BREAKDOWN_EQ] THEN
5042     FIRST_X_ASSUM(SUBST_ALL_TAC o SYM) THEN GEN_TAC THEN
5043     AP_TERM_TAC THEN ABS_TAC THEN REWRITE_TAC[VECTOR_SUB_LDISTRIB] THEN
5044     REWRITE_TAC[VECTOR_ARITH `a - (x - y):real^N = y + (a - x)`] THEN
5045     MATCH_MP_TAC SPAN_ADD_EQ THEN MATCH_MP_TAC SPAN_MUL THEN
5046     MATCH_MP_TAC SPAN_VSUM THEN ASM_REWRITE_TAC[] THEN
5047     REPEAT STRIP_TAC THEN MATCH_MP_TAC SPAN_MUL THEN
5048     ASM_SIMP_TAC[SPAN_SUPERSET];
5049     REWRITE_TAC[IN_INSERT] THEN REPEAT STRIP_TAC THENL
5050      [ASM_MESON_TAC[];
5051       FIRST_X_ASSUM SUBST_ALL_TAC;
5052       FIRST_X_ASSUM SUBST_ALL_TAC;
5053       ASM_MESON_TAC[]] THEN
5054     REWRITE_TAC[DOT_LSUB; DOT_RSUB; REAL_SUB_0] THEN
5055     FIRST_ASSUM(SUBST1_TAC o MATCH_MP (SET_RULE
5056      `x IN s ==> s = x INSERT (s DELETE x)`)) THEN
5057     ASM_SIMP_TAC[VSUM_CLAUSES; FINITE_DELETE; IN_DELETE] THEN
5058     REWRITE_TAC[DOT_LADD; DOT_RADD; DOT_LMUL; DOT_RMUL] THEN
5059     MATCH_MP_TAC(REAL_ARITH `s = &0 /\ a = b ==> b = a + s`) THEN
5060     ASM_SIMP_TAC[DOT_LSUM; DOT_RSUM; FINITE_DELETE] THEN
5061     (CONJ_TAC THENL
5062       [MATCH_MP_TAC SUM_EQ_0 THEN
5063        ASM_SIMP_TAC[DOT_LMUL; DOT_RMUL; IN_DELETE;
5064                     REAL_MUL_RZERO; REAL_MUL_LZERO];
5065        W(MP_TAC o PART_MATCH (lhand o rand) REAL_DIV_RMUL o lhand o snd) THEN
5066        REWRITE_TAC[DOT_SYM] THEN
5067        MATCH_MP_TAC(TAUT `(p ==> q) ==> (~p ==> q) ==> q`) THEN
5068        SIMP_TAC[] THEN SIMP_TAC[DOT_EQ_0; DOT_RZERO; DOT_LZERO] THEN
5069        REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_RZERO]])]);;
5070
5071 let ORTHOGONAL_BASIS_EXISTS = prove
5072  (`!v:real^N->bool.
5073         ?b. independent b /\
5074             b SUBSET span v /\
5075             v SUBSET span b /\
5076             b HAS_SIZE dim v /\
5077             pairwise orthogonal b`,
5078   GEN_TAC THEN MP_TAC(ISPEC `v:real^N->bool` BASIS_EXISTS) THEN
5079   DISCH_THEN(X_CHOOSE_THEN `b:real^N->bool` STRIP_ASSUME_TAC) THEN
5080   MP_TAC(SPEC `b:real^N->bool` BASIS_ORTHOGONAL) THEN
5081   ANTS_TAC THENL [ASM_MESON_TAC[HAS_SIZE]; ALL_TAC] THEN
5082   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c:real^N->bool` THEN
5083   STRIP_TAC THEN ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL
5084    [MATCH_MP_TAC CARD_LE_DIM_SPANNING THEN ASM_REWRITE_TAC[] THEN
5085     EXISTS_TAC `span(v):real^N->bool` THEN CONJ_TAC THENL
5086      [ASM_MESON_TAC[SPAN_SPAN; SPAN_MONO];
5087       ASM_MESON_TAC[LE_TRANS; HAS_SIZE; DIM_SPAN]];
5088     ASM_MESON_TAC[SUBSET_TRANS; SPAN_INC; SPAN_SPAN; SPAN_MONO];
5089     RULE_ASSUM_TAC(REWRITE_RULE[HAS_SIZE]) THEN
5090     ASM_REWRITE_TAC[HAS_SIZE; GSYM LE_ANTISYM] THEN
5091     CONJ_TAC THENL [ASM_MESON_TAC[LE_TRANS]; ALL_TAC] THEN
5092     ONCE_REWRITE_TAC[GSYM DIM_SPAN] THEN MATCH_MP_TAC SPAN_CARD_GE_DIM THEN
5093     ASM_REWRITE_TAC[] THEN
5094     ASM_MESON_TAC[SPAN_SPAN; SPAN_MONO; SUBSET_TRANS; SPAN_INC]]);;
5095
5096 let SPAN_EQ = prove
5097  (`!s t. span s = span t <=> s SUBSET span t /\ t SUBSET span s`,
5098   REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ] THEN
5099   MESON_TAC[SUBSET_TRANS; SPAN_SPAN; SPAN_MONO; SPAN_INC]);;
5100
5101 let SPAN_EQ_INSERT = prove
5102  (`!s x. span(x INSERT s) = span s <=> x IN span s`,
5103   REWRITE_TAC[SPAN_EQ; INSERT_SUBSET] THEN
5104   MESON_TAC[SPAN_INC; SUBSET; SET_RULE `s SUBSET (x INSERT s)`]);;
5105
5106 let SPAN_SPECIAL_SCALE = prove
5107  (`!s a x:real^N.
5108      span((a % x) INSERT s) = if a = &0 then span s else span(x INSERT s)`,
5109   REPEAT GEN_TAC THEN COND_CASES_TAC THEN
5110   ASM_REWRITE_TAC[VECTOR_MUL_LZERO; SPAN_INSERT_0] THEN
5111   REWRITE_TAC[SPAN_EQ; SUBSET; FORALL_IN_INSERT] THEN
5112   SIMP_TAC[SPAN_MUL; SPAN_SUPERSET; IN_INSERT] THEN
5113   REWRITE_TAC[SPAN_BREAKDOWN_EQ] THEN EXISTS_TAC `inv a:real` THEN
5114   ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LINV; VECTOR_MUL_LID] THEN
5115   REWRITE_TAC[SPAN_0; VECTOR_SUB_REFL]);;
5116
5117 (* ------------------------------------------------------------------------- *)
5118 (* We can extend a linear basis-basis injection to the whole set.            *)
5119 (* ------------------------------------------------------------------------- *)
5120
5121 let LINEAR_INDEP_IMAGE_LEMMA = prove
5122  (`!f b. linear(f:real^M->real^N) /\
5123          FINITE b /\
5124          independent (IMAGE f b) /\
5125          (!x y. x IN b /\ y IN b /\ (f x = f y) ==> (x = y))
5126          ==> !x. x IN span b ==> (f(x) = vec 0) ==> (x = vec 0)`,
5127   REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
5128   GEN_TAC THEN DISCH_TAC THEN
5129   GEN_REWRITE_TAC (BINDER_CONV o RAND_CONV) [IMP_IMP] THEN
5130   MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
5131   CONJ_TAC THENL [SIMP_TAC[IN_SING; SPAN_EMPTY]; ALL_TAC] THEN
5132   MAP_EVERY X_GEN_TAC [`a:real^M`; `b:real^M->bool`] THEN STRIP_TAC THEN
5133   STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o check (is_imp o concl)) THEN
5134   ANTS_TAC THENL
5135    [ASM_MESON_TAC[INDEPENDENT_MONO; IMAGE_CLAUSES; SUBSET; IN_INSERT];
5136     ALL_TAC] THEN
5137   DISCH_TAC THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN
5138   MP_TAC(ISPECL [`a:real^M`; `(a:real^M) INSERT b`; `x:real^M`]
5139     SPAN_BREAKDOWN) THEN
5140   ASM_REWRITE_TAC[IN_INSERT] THEN
5141   SIMP_TAC[ASSUME `~((a:real^M) IN b)`; SET_RULE
5142     `~(a IN b) ==> ((a INSERT b) DELETE a = b)`] THEN
5143   DISCH_THEN(X_CHOOSE_THEN `k:real` STRIP_ASSUME_TAC) THEN DISCH_TAC THEN
5144   SUBGOAL_THEN `(f:real^M->real^N)(x - k % a) IN span(IMAGE f b)` MP_TAC THENL
5145    [ASM_MESON_TAC[SPAN_LINEAR_IMAGE; IN_IMAGE]; ALL_TAC] THEN
5146   FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP LINEAR_SUB th]) THEN
5147   FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP LINEAR_CMUL th]) THEN
5148   ASM_REWRITE_TAC[VECTOR_ARITH `vec 0 - k % x = (--k) % x`] THEN
5149   ASM_CASES_TAC `k = &0` THENL
5150    [ASM_MESON_TAC[VECTOR_ARITH `x - &0 % y = x`]; ALL_TAC] THEN
5151   DISCH_THEN(MP_TAC o SPEC `--inv(k)` o MATCH_MP SPAN_MUL) THEN
5152   REWRITE_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LNEG; REAL_MUL_RNEG] THEN
5153   SIMP_TAC[REAL_NEGNEG; REAL_MUL_LINV; ASSUME `~(k = &0)`] THEN
5154   REWRITE_TAC[VECTOR_MUL_LID] THEN
5155   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [independent]) THEN
5156   REWRITE_TAC[dependent; NOT_EXISTS_THM] THEN
5157   DISCH_THEN(MP_TAC o SPEC `(f:real^M->real^N) a`) THEN
5158   SUBGOAL_THEN
5159    `IMAGE (f:real^M->real^N) (a INSERT b) DELETE f a =
5160     IMAGE f ((a INSERT b) DELETE a)`
5161   SUBST1_TAC THENL
5162    [REWRITE_TAC[EXTENSION; IN_IMAGE; IN_DELETE; IN_INSERT] THEN
5163     ASM_MESON_TAC[IN_INSERT];
5164     ALL_TAC] THEN
5165   ASM_REWRITE_TAC[DELETE_INSERT] THEN
5166   SIMP_TAC[SET_RULE `~(a IN b) ==> (b DELETE a = b)`;
5167            ASSUME `~(a:real^M IN b)`] THEN
5168   SIMP_TAC[IMAGE_CLAUSES; IN_INSERT]);;
5169
5170 (* ------------------------------------------------------------------------- *)
5171 (* We can extend a linear mapping from basis.                                *)
5172 (* ------------------------------------------------------------------------- *)
5173
5174 let LINEAR_INDEPENDENT_EXTEND_LEMMA = prove
5175  (`!f b. FINITE b
5176          ==> independent b
5177              ==> ?g:real^M->real^N.
5178                         (!x y. x IN span b /\ y IN span b
5179                                 ==> (g(x + y) = g(x) + g(y))) /\
5180                         (!x c. x IN span b ==> (g(c % x) = c % g(x))) /\
5181                         (!x. x IN b ==> (g x = f x))`,
5182   GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
5183   REWRITE_TAC[NOT_IN_EMPTY; INDEPENDENT_INSERT] THEN CONJ_TAC THENL
5184    [REPEAT STRIP_TAC THEN EXISTS_TAC `(\x. vec 0):real^M->real^N` THEN
5185     SIMP_TAC[SPAN_EMPTY] THEN REPEAT STRIP_TAC THEN VECTOR_ARITH_TAC;
5186     ALL_TAC] THEN
5187   SIMP_TAC[] THEN MAP_EVERY X_GEN_TAC [`a:real^M`; `b:real^M->bool`] THEN
5188   DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN
5189   DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN
5190   DISCH_THEN(X_CHOOSE_THEN `g:real^M->real^N` STRIP_ASSUME_TAC) THEN
5191   ABBREV_TAC `h = \z:real^M. @k. (z - k % a) IN span b` THEN
5192   SUBGOAL_THEN `!z:real^M. z IN span(a INSERT b)
5193                     ==> (z - h(z) % a) IN span(b) /\
5194                         !k. (z - k % a) IN span(b) ==> (k = h(z))`
5195   MP_TAC THENL
5196    [GEN_TAC THEN DISCH_TAC THEN
5197     MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL
5198      [EXPAND_TAC "h" THEN CONV_TAC SELECT_CONV THEN
5199       ASM_MESON_TAC[SPAN_BREAKDOWN_EQ];
5200       ALL_TAC] THEN
5201     REWRITE_TAC[RIGHT_IMP_FORALL_THM; IMP_IMP] THEN GEN_TAC THEN
5202     DISCH_THEN(MP_TAC o MATCH_MP SPAN_SUB) THEN
5203     REWRITE_TAC[VECTOR_ARITH `(z - a % v) - (z - b % v) = (b - a) % v`] THEN
5204     ASM_CASES_TAC `k = (h:real^M->real) z` THEN ASM_REWRITE_TAC[] THEN
5205     DISCH_THEN(MP_TAC o SPEC `inv(k - (h:real^M->real) z)` o
5206                MATCH_MP SPAN_MUL) THEN
5207     ASM_SIMP_TAC[REAL_MUL_LINV; VECTOR_MUL_ASSOC; REAL_SUB_0] THEN
5208     ASM_REWRITE_TAC[VECTOR_MUL_LID];
5209     ALL_TAC] THEN
5210   REWRITE_TAC[TAUT `(a ==> b /\ c) <=> (a ==> b) /\ (a ==> c)`] THEN
5211   REWRITE_TAC[RIGHT_IMP_FORALL_THM; IMP_IMP] THEN
5212   GEN_REWRITE_TAC LAND_CONV [FORALL_AND_THM] THEN STRIP_TAC THEN
5213   EXISTS_TAC `\z:real^M. h(z) % (f:real^M->real^N)(a) + g(z - h(z) % a)` THEN
5214   REPEAT CONJ_TAC THENL
5215    [MAP_EVERY X_GEN_TAC [`x:real^M`; `y:real^M`] THEN STRIP_TAC THEN
5216     SUBGOAL_THEN `(h:real^M->real)(x + y) = h(x) + h(y)` ASSUME_TAC THENL
5217      [CONV_TAC SYM_CONV THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
5218       REWRITE_TAC[VECTOR_ARITH
5219        `(x + y) - (k + l) % a = (x - k % a) + (y - l % a)`] THEN
5220       CONJ_TAC THEN MATCH_MP_TAC SPAN_ADD THEN ASM_REWRITE_TAC[] THEN
5221       ASM_SIMP_TAC[];
5222       ALL_TAC] THEN
5223     ASM_REWRITE_TAC[VECTOR_ARITH
5224        `(x + y) - (k + l) % a = (x - k % a) + (y - l % a)`] THEN
5225     ASM_SIMP_TAC[] THEN VECTOR_ARITH_TAC;
5226     MAP_EVERY X_GEN_TAC [`x:real^M`; `c:real`] THEN STRIP_TAC THEN
5227     SUBGOAL_THEN `(h:real^M->real)(c % x) = c * h(x)` ASSUME_TAC THENL
5228      [CONV_TAC SYM_CONV THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
5229       REWRITE_TAC[VECTOR_ARITH
5230        `c % x - (c * k) % a = c % (x - k % a)`] THEN
5231       CONJ_TAC THEN MATCH_MP_TAC SPAN_MUL THEN ASM_REWRITE_TAC[] THEN
5232       ASM_SIMP_TAC[];
5233       ALL_TAC] THEN
5234     ASM_REWRITE_TAC[VECTOR_ARITH
5235        `c % x - (c * k) % a = c % (x - k % a)`] THEN
5236     ASM_SIMP_TAC[] THEN VECTOR_ARITH_TAC;
5237     ALL_TAC] THEN
5238   X_GEN_TAC `x:real^M` THEN REWRITE_TAC[IN_INSERT] THEN
5239   DISCH_THEN(DISJ_CASES_THEN2 SUBST_ALL_TAC ASSUME_TAC) THENL
5240    [SUBGOAL_THEN `&1 = h(a:real^M)` (SUBST1_TAC o SYM) THENL
5241      [FIRST_X_ASSUM MATCH_MP_TAC; ALL_TAC] THEN
5242     REWRITE_TAC[VECTOR_ARITH `a - &1 % a = vec 0`; SPAN_0] THENL
5243      [ASM_MESON_TAC[SPAN_SUPERSET; SUBSET; IN_INSERT]; ALL_TAC] THEN
5244     FIRST_X_ASSUM(MP_TAC o SPECL [`vec 0:real^M`; `vec 0:real^M`]) THEN
5245     REWRITE_TAC[SPAN_0; VECTOR_ADD_LID] THEN
5246     REWRITE_TAC[VECTOR_ARITH `(a = a + a) <=> (a = vec 0)`] THEN
5247     DISCH_THEN SUBST1_TAC THEN VECTOR_ARITH_TAC;
5248     ALL_TAC] THEN
5249   SUBGOAL_THEN `&0 = h(x:real^M)` (SUBST1_TAC o SYM) THENL
5250    [FIRST_X_ASSUM MATCH_MP_TAC; ALL_TAC] THEN
5251   REWRITE_TAC[VECTOR_ADD_LID; VECTOR_MUL_LZERO; VECTOR_SUB_RZERO] THEN
5252   ASM_MESON_TAC[SUBSET; IN_INSERT; SPAN_SUPERSET]);;
5253
5254 let LINEAR_INDEPENDENT_EXTEND = prove
5255  (`!f b. independent b
5256          ==> ?g:real^M->real^N. linear g /\ (!x. x IN b ==> (g x = f x))`,
5257   REPEAT STRIP_TAC THEN
5258   MP_TAC(ISPECL [`b:real^M->bool`; `(:real^M)`]
5259            MAXIMAL_INDEPENDENT_SUBSET_EXTEND) THEN
5260   ASM_REWRITE_TAC[SUBSET_UNIV; UNIV_SUBSET] THEN
5261   REWRITE_TAC[EXTENSION; IN_UNIV] THEN
5262   DISCH_THEN(X_CHOOSE_THEN `c:real^M->bool` STRIP_ASSUME_TAC) THEN
5263   MP_TAC(ISPECL [`f:real^M->real^N`; `c:real^M->bool`]
5264     LINEAR_INDEPENDENT_EXTEND_LEMMA) THEN
5265   ASM_SIMP_TAC[INDEPENDENT_BOUND; linear] THEN
5266   ASM_MESON_TAC[SUBSET]);;
5267
5268 (* ------------------------------------------------------------------------- *)
5269 (* Linear functions are equal on a subspace if they are on a spanning set.   *)
5270 (* ------------------------------------------------------------------------- *)
5271
5272 let SUBSPACE_KERNEL = prove
5273  (`!f. linear f ==> subspace {x | f(x) = vec 0}`,
5274   REWRITE_TAC[subspace; IN_ELIM_THM] THEN
5275   SIMP_TAC[LINEAR_ADD; LINEAR_CMUL; VECTOR_ADD_LID; VECTOR_MUL_RZERO] THEN
5276   MESON_TAC[LINEAR_0]);;
5277
5278 let LINEAR_EQ_0_SPAN = prove
5279  (`!f:real^M->real^N b.
5280         linear f /\ (!x. x IN b ==> f(x) = vec 0)
5281         ==> !x. x IN span(b) ==> f(x) = vec 0`,
5282   REPEAT GEN_TAC THEN STRIP_TAC THEN
5283   RULE_ASSUM_TAC(REWRITE_RULE[IN]) THEN
5284   MATCH_MP_TAC SPAN_INDUCT THEN ASM_REWRITE_TAC[IN] THEN
5285   MP_TAC(ISPEC `f:real^M->real^N` SUBSPACE_KERNEL) THEN
5286   ASM_REWRITE_TAC[] THEN MATCH_MP_TAC EQ_IMP THEN
5287   AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM]);;
5288
5289 let LINEAR_EQ_0 = prove
5290  (`!f b s. linear f /\ s SUBSET (span b) /\ (!x. x IN b ==> f(x) = vec 0)
5291            ==> !x. x IN s ==> f(x) = vec 0`,
5292   MESON_TAC[LINEAR_EQ_0_SPAN; SUBSET]);;
5293
5294 let LINEAR_EQ = prove
5295  (`!f g b s. linear f /\ linear g /\ s SUBSET (span b) /\
5296              (!x. x IN b ==> f(x) = g(x))
5297               ==> !x. x IN s ==> f(x) = g(x)`,
5298   REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM VECTOR_SUB_EQ] THEN
5299   STRIP_TAC THEN MATCH_MP_TAC LINEAR_EQ_0 THEN
5300   ASM_MESON_TAC[LINEAR_COMPOSE_SUB]);;
5301
5302 let LINEAR_EQ_STDBASIS = prove
5303  (`!f:real^M->real^N g.
5304         linear f /\ linear g /\
5305         (!i. 1 <= i /\ i <= dimindex(:M)
5306              ==> f(basis i) = g(basis i))
5307         ==> f = g`,
5308   REPEAT STRIP_TAC THEN
5309   SUBGOAL_THEN `!x. x IN UNIV ==> (f:real^M->real^N) x = g x`
5310    (fun th -> MP_TAC th THEN REWRITE_TAC[FUN_EQ_THM; IN_UNIV]) THEN
5311   MATCH_MP_TAC LINEAR_EQ THEN
5312   EXISTS_TAC `{basis i :real^M | 1 <= i /\ i <= dimindex(:M)}` THEN
5313   ASM_REWRITE_TAC[SPAN_STDBASIS; SUBSET_REFL; IN_ELIM_THM] THEN
5314   ASM_MESON_TAC[]);;
5315
5316 let SUBSPACE_LINEAR_FIXED_POINTS = prove
5317  (`!f:real^N->real^N. linear f ==> subspace {x | f(x) = x}`,
5318   REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM VECTOR_SUB_EQ] THEN
5319   MATCH_MP_TAC SUBSPACE_KERNEL THEN
5320   ASM_SIMP_TAC[LINEAR_COMPOSE_SUB; LINEAR_ID]);;
5321
5322 (* ------------------------------------------------------------------------- *)
5323 (* Similar results for bilinear functions.                                   *)
5324 (* ------------------------------------------------------------------------- *)
5325
5326 let BILINEAR_EQ = prove
5327  (`!f:real^M->real^N->real^P g b c s.
5328         bilinear f /\ bilinear g /\
5329         s SUBSET (span b) /\ t SUBSET (span c) /\
5330         (!x y. x IN b /\ y IN c ==> f x y = g x y)
5331          ==> !x y. x IN s /\ y IN t ==> f x y = g x y`,
5332   REPEAT STRIP_TAC THEN SUBGOAL_THEN
5333     `!x:real^M. x IN span b
5334                 ==> !y:real^N. y IN span c ==> (f x y :real^P = g x y)`
5335     (fun th -> ASM_MESON_TAC[th; SUBSET]) THEN
5336   MATCH_MP_TAC SPAN_INDUCT THEN REWRITE_TAC[subspace; IN_ELIM_THM] THEN
5337   CONJ_TAC THENL
5338    [GEN_TAC THEN DISCH_TAC;
5339     ASM_SIMP_TAC[BILINEAR_LADD; BILINEAR_LMUL] THEN
5340     ASM_MESON_TAC[BILINEAR_LZERO]] THEN
5341   MATCH_MP_TAC SPAN_INDUCT THEN REWRITE_TAC[subspace; IN_ELIM_THM] THEN
5342   ASM_SIMP_TAC[BILINEAR_RADD; BILINEAR_RMUL] THEN
5343   ASM_MESON_TAC[BILINEAR_RZERO]);;
5344
5345 let BILINEAR_EQ_STDBASIS = prove
5346  (`!f:real^M->real^N->real^P g.
5347         bilinear f /\ bilinear g /\
5348         (!i j. 1 <= i /\ i <= dimindex(:M) /\ 1 <= j /\ j <= dimindex(:N)
5349              ==> f (basis i) (basis j) = g (basis i) (basis j))
5350         ==> f = g`,
5351   REPEAT STRIP_TAC THEN SUBGOAL_THEN
5352    `!x y. x IN UNIV /\ y IN UNIV ==> (f:real^M->real^N->real^P) x y = g x y`
5353    (fun th -> MP_TAC th THEN REWRITE_TAC[FUN_EQ_THM; IN_UNIV]) THEN
5354   MATCH_MP_TAC BILINEAR_EQ THEN
5355   EXISTS_TAC `{basis i :real^M | 1 <= i /\ i <= dimindex(:M)}` THEN
5356   EXISTS_TAC `{basis i :real^N | 1 <= i /\ i <= dimindex(:N)}` THEN
5357   ASM_REWRITE_TAC[SPAN_STDBASIS; SUBSET_REFL; IN_ELIM_THM] THEN
5358   ASM_MESON_TAC[]);;
5359
5360 (* ------------------------------------------------------------------------- *)
5361 (* Detailed theorems about left and right invertibility in general case.     *)
5362 (* ------------------------------------------------------------------------- *)
5363
5364 let LEFT_INVERTIBLE_TRANSP = prove
5365  (`!A:real^N^M.
5366     (?B:real^N^M. B ** transp A = mat 1) <=> (?B:real^M^N. A ** B = mat 1)`,
5367   MESON_TAC[MATRIX_TRANSP_MUL; TRANSP_MAT; TRANSP_TRANSP]);;
5368
5369 let RIGHT_INVERTIBLE_TRANSP = prove
5370  (`!A:real^N^M.
5371     (?B:real^N^M. transp A ** B = mat 1) <=> (?B:real^M^N. B ** A = mat 1)`,
5372   MESON_TAC[MATRIX_TRANSP_MUL; TRANSP_MAT; TRANSP_TRANSP]);;
5373
5374 let INVERTIBLE_TRANSP = prove
5375  (`!A:real^N^M. invertible(transp A) <=> invertible A`,
5376   GEN_TAC THEN REWRITE_TAC[invertible] THEN
5377   GEN_REWRITE_TAC LAND_CONV [MESON[TRANSP_TRANSP]
5378     `(?A:real^M^N. P A) <=> (?A:real^N^M. P(transp A))`] THEN
5379   GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [GSYM TRANSP_MAT] THEN
5380   REWRITE_TAC[GSYM MATRIX_TRANSP_MUL; TRANSP_EQ] THEN MESON_TAC[]);;
5381
5382 let LINEAR_INJECTIVE_LEFT_INVERSE = prove
5383  (`!f:real^M->real^N.
5384         linear f /\ (!x y. f x = f y ==> x = y)
5385         ==> ?g. linear g /\ g o f = I`,
5386   REWRITE_TAC[INJECTIVE_LEFT_INVERSE] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN
5387    `?h. linear(h:real^N->real^M) /\
5388         !x. x IN IMAGE (f:real^M->real^N)
5389                {basis i | 1 <= i /\ i <= dimindex(:M)} ==> h x = g x`
5390   MP_TAC THENL
5391    [MATCH_MP_TAC LINEAR_INDEPENDENT_EXTEND THEN
5392     MATCH_MP_TAC INDEPENDENT_INJECTIVE_IMAGE THEN
5393     ASM_MESON_TAC[INJECTIVE_LEFT_INVERSE; INDEPENDENT_STDBASIS];
5394     MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `h:real^N->real^M` THEN
5395     ASM_REWRITE_TAC[FORALL_IN_IMAGE; IN_ELIM_THM] THEN STRIP_TAC THEN
5396     ASM_REWRITE_TAC[] THEN MATCH_MP_TAC LINEAR_EQ_STDBASIS THEN
5397     ASM_SIMP_TAC[I_DEF; LINEAR_COMPOSE; LINEAR_ID; o_THM] THEN
5398     ASM_MESON_TAC[]]);;
5399
5400 let LINEAR_SURJECTIVE_RIGHT_INVERSE = prove
5401  (`!f:real^M->real^N.
5402         linear f /\ (!y. ?x. f x = y) ==> ?g. linear g /\ f o g = I`,
5403   REWRITE_TAC[SURJECTIVE_RIGHT_INVERSE] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN
5404    `?h. linear(h:real^N->real^M) /\
5405         !x. x IN {basis i | 1 <= i /\ i <= dimindex(:N)} ==> h x = g x`
5406   MP_TAC THENL
5407    [MATCH_MP_TAC LINEAR_INDEPENDENT_EXTEND THEN
5408     REWRITE_TAC[INDEPENDENT_STDBASIS];
5409     MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `h:real^N->real^M` THEN
5410     ASM_REWRITE_TAC[FORALL_IN_IMAGE; IN_ELIM_THM] THEN STRIP_TAC THEN
5411     ASM_REWRITE_TAC[] THEN MATCH_MP_TAC LINEAR_EQ_STDBASIS THEN
5412     ASM_SIMP_TAC[I_DEF; LINEAR_COMPOSE; LINEAR_ID; o_THM] THEN
5413     ASM_MESON_TAC[]]);;
5414
5415 let MATRIX_LEFT_INVERTIBLE_INJECTIVE = prove
5416  (`!A:real^N^M.
5417         (?B:real^M^N. B ** A = mat 1) <=>
5418         !x y:real^N. A ** x = A ** y ==> x = y`,
5419   GEN_TAC THEN EQ_TAC THENL
5420    [STRIP_TAC THEN REPEAT GEN_TAC THEN
5421     DISCH_THEN(MP_TAC o AP_TERM `\x:real^M. (B:real^M^N) ** x`) THEN
5422     ASM_REWRITE_TAC[MATRIX_VECTOR_MUL_ASSOC; MATRIX_VECTOR_MUL_LID];
5423     DISCH_TAC THEN MP_TAC(ISPEC
5424      `\x:real^N. (A:real^N^M) ** x` LINEAR_INJECTIVE_LEFT_INVERSE) THEN
5425     ASM_REWRITE_TAC[MATRIX_VECTOR_MUL_LINEAR; FUN_EQ_THM; I_THM; o_THM] THEN
5426     DISCH_THEN(X_CHOOSE_THEN `g:real^M->real^N` STRIP_ASSUME_TAC) THEN
5427     EXISTS_TAC `matrix(g):real^M^N` THEN
5428     REWRITE_TAC[MATRIX_EQ; MATRIX_VECTOR_MUL_LID] THEN
5429     ASM_MESON_TAC[MATRIX_VECTOR_MUL_ASSOC; MATRIX_WORKS]]);;
5430
5431 let MATRIX_LEFT_INVERTIBLE_KER = prove
5432  (`!A:real^N^M.
5433         (?B:real^M^N. B ** A = mat 1) <=> !x. A ** x = vec 0 ==> x = vec 0`,
5434   GEN_TAC THEN REWRITE_TAC[MATRIX_LEFT_INVERTIBLE_INJECTIVE] THEN
5435   MATCH_MP_TAC LINEAR_INJECTIVE_0 THEN REWRITE_TAC[MATRIX_VECTOR_MUL_LINEAR]);;
5436
5437 let MATRIX_RIGHT_INVERTIBLE_SURJECTIVE = prove
5438  (`!A:real^N^M.
5439         (?B:real^M^N. A ** B = mat 1) <=> !y. ?x. A ** x = y`,
5440   GEN_TAC THEN EQ_TAC THENL
5441    [STRIP_TAC THEN X_GEN_TAC `y:real^M` THEN
5442     EXISTS_TAC `(B:real^M^N) ** (y:real^M)` THEN
5443     ASM_REWRITE_TAC[MATRIX_VECTOR_MUL_ASSOC; MATRIX_VECTOR_MUL_LID];
5444     DISCH_TAC THEN MP_TAC(ISPEC
5445      `\x:real^N. (A:real^N^M) ** x` LINEAR_SURJECTIVE_RIGHT_INVERSE) THEN
5446     ASM_REWRITE_TAC[MATRIX_VECTOR_MUL_LINEAR; FUN_EQ_THM; I_THM; o_THM] THEN
5447     DISCH_THEN(X_CHOOSE_THEN `g:real^M->real^N` STRIP_ASSUME_TAC) THEN
5448     EXISTS_TAC `matrix(g):real^M^N` THEN
5449     REWRITE_TAC[MATRIX_EQ; MATRIX_VECTOR_MUL_LID] THEN
5450     ASM_MESON_TAC[MATRIX_VECTOR_MUL_ASSOC; MATRIX_WORKS]]);;
5451
5452 let MATRIX_LEFT_INVERTIBLE_INDEPENDENT_COLUMNS = prove
5453  (`!A:real^N^M. (?B:real^M^N. B ** A = mat 1) <=>
5454                 !c. vsum(1..dimindex(:N)) (\i. c(i) % column i A) = vec 0 ==>
5455                     !i. 1 <= i /\ i <= dimindex(:N) ==> c(i) = &0`,
5456   GEN_TAC THEN REWRITE_TAC[MATRIX_LEFT_INVERTIBLE_KER; MATRIX_MUL_VSUM] THEN
5457   EQ_TAC THEN DISCH_TAC THENL
5458    [X_GEN_TAC `c:num->real` THEN DISCH_TAC THEN
5459     FIRST_X_ASSUM(MP_TAC o SPEC `(lambda i. c(i)):real^N`);
5460     X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
5461     FIRST_X_ASSUM(MP_TAC o SPEC `\i. (x:real^N)$i`)] THEN
5462   ASM_SIMP_TAC[LAMBDA_BETA; CART_EQ; VEC_COMPONENT]);;
5463
5464 let MATRIX_RIGHT_INVERTIBLE_INDEPENDENT_ROWS = prove
5465  (`!A:real^N^M. (?B:real^M^N. A ** B = mat 1) <=>
5466                 !c. vsum(1..dimindex(:M)) (\i. c(i) % row i A) = vec 0 ==>
5467                     !i. 1 <= i /\ i <= dimindex(:M) ==> c(i) = &0`,
5468   ONCE_REWRITE_TAC[GSYM LEFT_INVERTIBLE_TRANSP] THEN
5469   REWRITE_TAC[MATRIX_LEFT_INVERTIBLE_INDEPENDENT_COLUMNS] THEN
5470   SIMP_TAC[COLUMN_TRANSP]);;
5471
5472 let MATRIX_RIGHT_INVERTIBLE_SPAN_COLUMNS = prove
5473  (`!A:real^N^M. (?B:real^M^N. A ** B = mat 1) <=> span(columns A) = (:real^M)`,
5474   GEN_TAC THEN REWRITE_TAC[MATRIX_RIGHT_INVERTIBLE_SURJECTIVE] THEN
5475   REWRITE_TAC[MATRIX_MUL_VSUM; EXTENSION; IN_UNIV] THEN
5476   AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `y:real^M` THEN
5477   EQ_TAC THENL
5478    [DISCH_THEN(X_CHOOSE_THEN `x:real^N` (SUBST1_TAC o SYM)) THEN
5479     MATCH_MP_TAC SPAN_VSUM THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN
5480     X_GEN_TAC `i:num` THEN STRIP_TAC THEN MATCH_MP_TAC SPAN_MUL THEN
5481     MATCH_MP_TAC(CONJUNCT1 SPAN_CLAUSES) THEN
5482     REWRITE_TAC[columns; IN_ELIM_THM] THEN ASM_MESON_TAC[];
5483     ALL_TAC] THEN
5484   SPEC_TAC(`y:real^M`,`y:real^M`) THEN MATCH_MP_TAC SPAN_INDUCT_ALT THEN
5485   CONJ_TAC THENL
5486    [EXISTS_TAC `vec 0 :real^N` THEN
5487     SIMP_TAC[VEC_COMPONENT; VECTOR_MUL_LZERO; VSUM_0];
5488     ALL_TAC] THEN
5489   MAP_EVERY X_GEN_TAC [`c:real`; `y1:real^M`; `y2:real^M`] THEN
5490   REWRITE_TAC[columns; IN_ELIM_THM] THEN DISCH_THEN(CONJUNCTS_THEN2
5491    (X_CHOOSE_THEN `i:num` STRIP_ASSUME_TAC)
5492    (X_CHOOSE_THEN `x:real^N` (SUBST1_TAC o SYM))) THEN
5493   EXISTS_TAC `(lambda j. if j = i then c + (x:real^N)$i else x$j):real^N` THEN
5494   SUBGOAL_THEN `1..dimindex(:N) = i INSERT ((1..dimindex(:N)) DELETE i)`
5495   SUBST1_TAC THENL [ASM_MESON_TAC[INSERT_DELETE; IN_NUMSEG]; ALL_TAC] THEN
5496   SIMP_TAC[VSUM_CLAUSES; FINITE_DELETE; FINITE_NUMSEG; IN_DELETE] THEN
5497   ASM_SIMP_TAC[LAMBDA_BETA; VECTOR_ADD_RDISTRIB; VECTOR_ADD_ASSOC] THEN
5498   AP_TERM_TAC THEN MATCH_MP_TAC VSUM_EQ THEN
5499   SIMP_TAC[FINITE_DELETE; IN_DELETE; FINITE_NUMSEG; LAMBDA_BETA; IN_NUMSEG]);;
5500
5501 let MATRIX_LEFT_INVERTIBLE_SPAN_ROWS = prove
5502  (`!A:real^N^M. (?B:real^M^N. B ** A = mat 1) <=> span(rows A) = (:real^N)`,
5503   MESON_TAC[RIGHT_INVERTIBLE_TRANSP; COLUMNS_TRANSP;
5504             MATRIX_RIGHT_INVERTIBLE_SPAN_COLUMNS]);;
5505
5506 (* ------------------------------------------------------------------------- *)
5507 (* An injective map real^N->real^N is also surjective.                       *)
5508 (* ------------------------------------------------------------------------- *)
5509
5510 let LINEAR_INJECTIVE_IMP_SURJECTIVE = prove
5511  (`!f:real^N->real^N.
5512         linear f /\ (!x y. (f(x) = f(y)) ==> (x = y))
5513         ==> !y. ?x. f(x) = y`,
5514   REPEAT STRIP_TAC THEN
5515   MP_TAC(ISPEC `(:real^N)` BASIS_EXISTS) THEN
5516   REWRITE_TAC[SUBSET_UNIV; HAS_SIZE] THEN
5517   DISCH_THEN(X_CHOOSE_THEN `b:real^N->bool` STRIP_ASSUME_TAC) THEN
5518   SUBGOAL_THEN `UNIV SUBSET span(IMAGE (f:real^N->real^N) b)` MP_TAC THENL
5519    [MATCH_MP_TAC CARD_GE_DIM_INDEPENDENT THEN
5520     ASM_MESON_TAC[INDEPENDENT_INJECTIVE_IMAGE; LE_REFL;
5521                   SUBSET_UNIV; CARD_IMAGE_INJ];
5522     ASM_SIMP_TAC[SPAN_LINEAR_IMAGE] THEN
5523     ASM_MESON_TAC[SUBSET; IN_IMAGE; IN_UNIV]]);;
5524
5525 (* ------------------------------------------------------------------------- *)
5526 (* And vice versa.                                                           *)
5527 (* ------------------------------------------------------------------------- *)
5528
5529 let LINEAR_SURJECTIVE_IMP_INJECTIVE = prove
5530  (`!f:real^N->real^N.
5531         linear f /\ (!y. ?x. f(x) = y)
5532         ==> !x y. (f(x) = f(y)) ==> (x = y)`,
5533   REPEAT GEN_TAC THEN STRIP_TAC THEN
5534   MP_TAC(ISPEC `(:real^N)` BASIS_EXISTS) THEN
5535   REWRITE_TAC[SUBSET_UNIV; HAS_SIZE] THEN
5536   DISCH_THEN(X_CHOOSE_THEN `b:real^N->bool` STRIP_ASSUME_TAC) THEN
5537   SUBGOAL_THEN
5538    `!x. x IN span b ==> (f:real^N->real^N) x = vec 0 ==> x = vec 0`
5539    (fun th -> ASM_MESON_TAC[th; LINEAR_INJECTIVE_0; SUBSET; IN_UNIV]) THEN
5540   MATCH_MP_TAC LINEAR_INDEP_IMAGE_LEMMA THEN
5541   ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
5542    [MATCH_MP_TAC CARD_LE_DIM_SPANNING THEN
5543     EXISTS_TAC `(:real^N)` THEN
5544     ASM_SIMP_TAC[SUBSET_UNIV; FINITE_IMAGE; SPAN_LINEAR_IMAGE] THEN
5545     REWRITE_TAC[SUBSET; IN_UNIV; IN_IMAGE] THEN
5546     ASM_MESON_TAC[CARD_IMAGE_LE; SUBSET; IN_UNIV];
5547     ALL_TAC] THEN
5548   SUBGOAL_THEN `dim(:real^N) <= CARD(IMAGE (f:real^N->real^N) b)`
5549   MP_TAC THENL
5550    [MATCH_MP_TAC SPAN_CARD_GE_DIM THEN
5551     ASM_SIMP_TAC[SUBSET_UNIV; FINITE_IMAGE] THEN
5552     ASM_SIMP_TAC[SPAN_LINEAR_IMAGE] THEN MATCH_MP_TAC SUBSET_TRANS THEN
5553     EXISTS_TAC `IMAGE (f:real^N->real^N) UNIV` THEN
5554     ASM_SIMP_TAC[IMAGE_SUBSET] THEN
5555     ASM_REWRITE_TAC[SUBSET; IN_IMAGE; IN_UNIV] THEN ASM_MESON_TAC[];
5556     ALL_TAC] THEN
5557   FIRST_X_ASSUM(MP_TAC o ISPEC `f:real^N->real^N` o
5558                 MATCH_MP CARD_IMAGE_LE) THEN
5559   ASM_REWRITE_TAC[IMP_IMP; LE_ANTISYM] THEN DISCH_TAC THEN
5560   MP_TAC(ISPECL
5561    [`b:real^N->bool`; `IMAGE (f:real^N->real^N) b`; `f:real^N->real^N`]
5562    SURJECTIVE_IFF_INJECTIVE_GEN) THEN
5563   ASM_SIMP_TAC[FINITE_IMAGE; INDEPENDENT_BOUND; SUBSET_REFL] THEN
5564   REWRITE_TAC[FORALL_IN_IMAGE] THEN MESON_TAC[]);;
5565
5566 let LINEAR_SURJECTIVE_IFF_INJECTIVE = prove
5567  (`!f:real^N->real^N.
5568       linear f ==> ((!y. ?x. f x = y) <=> (!x y. f x = f y ==> x = y))`,
5569   MESON_TAC[LINEAR_INJECTIVE_IMP_SURJECTIVE;
5570             LINEAR_SURJECTIVE_IMP_INJECTIVE]);;
5571
5572 (* ------------------------------------------------------------------------- *)
5573 (* Hence either is enough for isomorphism.                                   *)
5574 (* ------------------------------------------------------------------------- *)
5575
5576 let LEFT_RIGHT_INVERSE_EQ = prove
5577  (`!f:A->A g h. f o g = I /\ g o h = I ==> f = h`,
5578   MESON_TAC[o_ASSOC; I_O_ID]);;
5579
5580 let ISOMORPHISM_EXPAND = prove
5581  (`!f g. f o g = I /\ g o f = I <=> (!x. f(g x) = x) /\ (!x. g(f x) = x)`,
5582   REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM]);;
5583
5584 let LINEAR_INJECTIVE_ISOMORPHISM = prove
5585  (`!f:real^N->real^N.
5586         linear f /\ (!x y. f x = f y ==> x = y)
5587         ==> ?f'. linear f' /\ (!x. f'(f x) = x) /\ (!x. f(f' x) = x)`,
5588   REPEAT STRIP_TAC THEN
5589   REWRITE_TAC[GSYM ISOMORPHISM_EXPAND] THEN
5590   MP_TAC(ISPEC `f:real^N->real^N` LINEAR_SURJECTIVE_RIGHT_INVERSE) THEN
5591   MP_TAC(ISPEC `f:real^N->real^N` LINEAR_INJECTIVE_LEFT_INVERSE) THEN
5592   MP_TAC(ISPEC `f:real^N->real^N` LINEAR_INJECTIVE_IMP_SURJECTIVE) THEN
5593   ASM_REWRITE_TAC[] THEN SIMP_TAC[] THEN MESON_TAC[LEFT_RIGHT_INVERSE_EQ]);;
5594
5595 let LINEAR_SURJECTIVE_ISOMORPHISM = prove
5596  (`!f:real^N->real^N.
5597         linear f /\ (!y. ?x. f x = y)
5598         ==> ?f'. linear f' /\ (!x. f'(f x) = x) /\ (!x. f(f' x) = x)`,
5599   REPEAT STRIP_TAC THEN
5600   REWRITE_TAC[GSYM ISOMORPHISM_EXPAND] THEN
5601   MP_TAC(ISPEC `f:real^N->real^N` LINEAR_SURJECTIVE_RIGHT_INVERSE) THEN
5602   MP_TAC(ISPEC `f:real^N->real^N` LINEAR_INJECTIVE_LEFT_INVERSE) THEN
5603   MP_TAC(ISPEC `f:real^N->real^N` LINEAR_SURJECTIVE_IMP_INJECTIVE) THEN
5604   ASM_REWRITE_TAC[] THEN SIMP_TAC[] THEN MESON_TAC[LEFT_RIGHT_INVERSE_EQ]);;
5605
5606 (* ------------------------------------------------------------------------- *)
5607 (* Left and right inverses are the same for R^N->R^N.                        *)
5608 (* ------------------------------------------------------------------------- *)
5609
5610 let LINEAR_INVERSE_LEFT = prove
5611  (`!f:real^N->real^N f'.
5612         linear f /\ linear f' ==> ((f o f' = I) <=> (f' o f = I))`,
5613   SUBGOAL_THEN
5614    `!f:real^N->real^N f'.
5615         linear f /\ linear f' /\ (f o f' = I) ==> (f' o f = I)`
5616    (fun th -> MESON_TAC[th]) THEN
5617   REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM] THEN REPEAT STRIP_TAC THEN
5618   MP_TAC(ISPEC `f:real^N->real^N` LINEAR_SURJECTIVE_ISOMORPHISM) THEN
5619   ASM_MESON_TAC[]);;
5620
5621 (* ------------------------------------------------------------------------- *)
5622 (* Moreover, a one-sided inverse is automatically linear.                    *)
5623 (* ------------------------------------------------------------------------- *)
5624
5625 let LEFT_INVERSE_LINEAR = prove
5626  (`!f g:real^N->real^N. linear f /\ (g o f = I) ==> linear g`,
5627   REPEAT GEN_TAC THEN REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM] THEN
5628   STRIP_TAC THEN SUBGOAL_THEN
5629    `?h:real^N->real^N. linear h /\ (!x. h(f x) = x) /\ (!x. f(h x) = x)`
5630   CHOOSE_TAC THENL
5631    [MATCH_MP_TAC LINEAR_INJECTIVE_ISOMORPHISM THEN ASM_MESON_TAC[];
5632     SUBGOAL_THEN `g:real^N->real^N = h` (fun th -> ASM_REWRITE_TAC[th]) THEN
5633     REWRITE_TAC[FUN_EQ_THM] THEN ASM_MESON_TAC[]]);;
5634
5635 let RIGHT_INVERSE_LINEAR = prove
5636  (`!f g:real^N->real^N. linear f /\ (f o g = I) ==> linear g`,
5637   REPEAT GEN_TAC THEN REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM] THEN
5638   STRIP_TAC THEN SUBGOAL_THEN
5639    `?h:real^N->real^N. linear h /\ (!x. h(f x) = x) /\ (!x. f(h x) = x)`
5640   CHOOSE_TAC THENL [ASM_MESON_TAC[LINEAR_SURJECTIVE_ISOMORPHISM]; ALL_TAC] THEN
5641   SUBGOAL_THEN `g:real^N->real^N = h` (fun th -> ASM_REWRITE_TAC[th]) THEN
5642   REWRITE_TAC[FUN_EQ_THM] THEN ASM_MESON_TAC[]);;
5643
5644 (* ------------------------------------------------------------------------- *)
5645 (* Without (ostensible) constraints on types, though dimensions must match.  *)
5646 (* ------------------------------------------------------------------------- *)
5647
5648 let LEFT_RIGHT_INVERSE_LINEAR = prove
5649  (`!f g:real^M->real^N.
5650         linear f /\ g o f = I /\ f o g = I ==> linear g`,
5651   REWRITE_TAC[linear; FUN_EQ_THM; o_THM; I_THM] THEN MESON_TAC[]);;
5652
5653 let LINEAR_BIJECTIVE_LEFT_RIGHT_INVERSE = prove
5654  (`!f:real^M->real^N.
5655         linear f /\ (!x y. f x = f y ==> x = y) /\ (!y. ?x. f x = y)
5656         ==> ?g. linear g /\ (!x. g(f x) = x) /\ (!y. f(g y) = y)`,
5657   GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN ASSUME_TAC) THEN
5658   FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [BIJECTIVE_LEFT_RIGHT_INVERSE]) THEN
5659   MATCH_MP_TAC MONO_EXISTS THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
5660   MATCH_MP_TAC LEFT_RIGHT_INVERSE_LINEAR THEN
5661   EXISTS_TAC `f:real^M->real^N` THEN
5662   ASM_REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM]);;
5663
5664 (* ------------------------------------------------------------------------- *)
5665 (* The same result in terms of square matrices.                              *)
5666 (* ------------------------------------------------------------------------- *)
5667
5668 let MATRIX_LEFT_RIGHT_INVERSE = prove
5669  (`!A:real^N^N A':real^N^N. (A ** A' = mat 1) <=> (A' ** A = mat 1)`,
5670   SUBGOAL_THEN
5671     `!A:real^N^N A':real^N^N. (A ** A' = mat 1) ==> (A' ** A = mat 1)`
5672     (fun th -> MESON_TAC[th]) THEN
5673   REPEAT STRIP_TAC THEN
5674   MP_TAC(ISPEC `\x:real^N. A:(real^N^N) ** x`
5675     LINEAR_SURJECTIVE_ISOMORPHISM) THEN
5676   REWRITE_TAC[MATRIX_VECTOR_MUL_LINEAR] THEN ANTS_TAC THENL
5677    [X_GEN_TAC `x:real^N` THEN EXISTS_TAC `(A':real^N^N) ** (x:real^N)` THEN
5678     ASM_REWRITE_TAC[MATRIX_VECTOR_MUL_ASSOC; MATRIX_VECTOR_MUL_LID];
5679     ALL_TAC] THEN
5680   DISCH_THEN(X_CHOOSE_THEN `f':real^N->real^N` STRIP_ASSUME_TAC) THEN
5681   SUBGOAL_THEN `matrix (f':real^N->real^N) ** (A:real^N^N) = mat 1`
5682   MP_TAC THENL
5683    [ASM_SIMP_TAC[MATRIX_EQ; MATRIX_WORKS; GSYM MATRIX_VECTOR_MUL_ASSOC;
5684                  MATRIX_VECTOR_MUL_LID];
5685     ALL_TAC] THEN
5686   DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN
5687   DISCH_THEN(MP_TAC o AP_TERM `(\m:real^N^N. m ** (A':real^N^N))`) THEN
5688   REWRITE_TAC[GSYM MATRIX_MUL_ASSOC] THEN
5689   ASM_REWRITE_TAC[MATRIX_MUL_RID; MATRIX_MUL_LID] THEN ASM_MESON_TAC[]);;
5690
5691 (* ------------------------------------------------------------------------- *)
5692 (* Invertibility of matrices and corresponding linear functions.             *)
5693 (* ------------------------------------------------------------------------- *)
5694
5695 let MATRIX_LEFT_INVERTIBLE = prove
5696  (`!f:real^M->real^N.
5697     linear f ==> ((?B:real^N^M. B ** matrix f = mat 1) <=>
5698                   (?g. linear g /\ g o f = I))`,
5699   GEN_TAC THEN DISCH_TAC THEN EQ_TAC THEN STRIP_TAC THENL
5700    [EXISTS_TAC `\y:real^N. (B:real^N^M) ** y` THEN
5701     REWRITE_TAC[MATRIX_VECTOR_MUL_LINEAR] THEN
5702     FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV)
5703                 [MATCH_MP MATRIX_VECTOR_MUL th]) THEN
5704     ASM_REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM; MATRIX_VECTOR_MUL_ASSOC;
5705                     MATRIX_VECTOR_MUL_LID];
5706     EXISTS_TAC `matrix(g:real^N->real^M)` THEN
5707     ASM_SIMP_TAC[GSYM MATRIX_COMPOSE; MATRIX_I]]);;
5708
5709 let MATRIX_RIGHT_INVERTIBLE = prove
5710  (`!f:real^M->real^N.
5711     linear f ==> ((?B:real^N^M. matrix f ** B = mat 1) <=>
5712                   (?g. linear g /\ f o g = I))`,
5713   GEN_TAC THEN DISCH_TAC THEN EQ_TAC THEN STRIP_TAC THENL
5714    [EXISTS_TAC `\y:real^N. (B:real^N^M) ** y` THEN
5715     REWRITE_TAC[MATRIX_VECTOR_MUL_LINEAR] THEN
5716     FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC (LAND_CONV o LAND_CONV)
5717                 [MATCH_MP MATRIX_VECTOR_MUL th]) THEN
5718     ASM_REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM; MATRIX_VECTOR_MUL_ASSOC;
5719                     MATRIX_VECTOR_MUL_LID];
5720     EXISTS_TAC `matrix(g:real^N->real^M)` THEN
5721     ASM_SIMP_TAC[GSYM MATRIX_COMPOSE; MATRIX_I]]);;
5722
5723 let INVERTIBLE_LEFT_INVERSE = prove
5724  (`!A:real^N^N. invertible(A) <=> ?B:real^N^N. B ** A = mat 1`,
5725   MESON_TAC[invertible; MATRIX_LEFT_RIGHT_INVERSE]);;
5726
5727 let INVERTIBLE_RIGHT_INVERSE = prove
5728  (`!A:real^N^N. invertible(A) <=> ?B:real^N^N. A ** B = mat 1`,
5729   MESON_TAC[invertible; MATRIX_LEFT_RIGHT_INVERSE]);;
5730
5731 let MATRIX_INVERTIBLE = prove
5732  (`!f:real^N->real^N.
5733         linear f
5734         ==> (invertible(matrix f) <=>
5735              ?g. linear g /\ f o g = I /\ g o f = I)`,
5736   SIMP_TAC[INVERTIBLE_LEFT_INVERSE; MATRIX_LEFT_INVERTIBLE] THEN
5737   MESON_TAC[LINEAR_INVERSE_LEFT]);;
5738
5739 let MATRIX_INV_UNIQUE_LEFT = prove
5740  (`!A:real^N^N B. A ** B = mat 1 ==> matrix_inv B = A`,
5741   REPEAT STRIP_TAC THEN MATCH_MP_TAC MATRIX_INV_UNIQUE THEN
5742   ASM_MESON_TAC[MATRIX_LEFT_RIGHT_INVERSE]);;
5743
5744 let MATRIX_INV_UNIQUE_RIGHT = prove
5745  (`!A:real^N^N B. A ** B = mat 1 ==> matrix_inv A = B`,
5746   REPEAT STRIP_TAC THEN MATCH_MP_TAC MATRIX_INV_UNIQUE THEN
5747   ASM_MESON_TAC[MATRIX_LEFT_RIGHT_INVERSE]);;
5748
5749 (* ------------------------------------------------------------------------- *)
5750 (* Left-invertible linear transformation has a lower bound.                  *)
5751 (* ------------------------------------------------------------------------- *)
5752
5753 let LINEAR_INVERTIBLE_BOUNDED_BELOW_POS = prove
5754  (`!f:real^M->real^N g.
5755         linear f /\ linear g /\ (g o f = I)
5756         ==> ?B. &0 < B /\ !x. B * norm(x) <= norm(f x)`,
5757   REPEAT STRIP_TAC THEN
5758   MP_TAC(ISPEC `g:real^N->real^M` LINEAR_BOUNDED_POS) THEN
5759   ASM_REWRITE_TAC[] THEN
5760   DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN
5761   EXISTS_TAC `inv B:real` THEN ASM_REWRITE_TAC[REAL_LT_INV_EQ] THEN
5762   X_GEN_TAC `x:real^M` THEN MATCH_MP_TAC REAL_LE_TRANS THEN
5763   EXISTS_TAC `inv(B) * norm(((g:real^N->real^M) o (f:real^M->real^N)) x)` THEN
5764   CONJ_TAC THENL [ASM_SIMP_TAC[I_THM; REAL_LE_REFL]; ALL_TAC] THEN
5765   REWRITE_TAC[REAL_ARITH `inv B * x = x / B`] THEN
5766   ASM_SIMP_TAC[o_THM; REAL_LE_LDIV_EQ] THEN
5767   ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_REWRITE_TAC[]);;
5768
5769 let LINEAR_INVERTIBLE_BOUNDED_BELOW = prove
5770  (`!f:real^M->real^N g.
5771         linear f /\ linear g /\ (g o f = I)
5772         ==> ?B. !x. B * norm(x) <= norm(f x)`,
5773   MESON_TAC[LINEAR_INVERTIBLE_BOUNDED_BELOW_POS]);;
5774
5775 let LINEAR_INJECTIVE_BOUNDED_BELOW_POS = prove
5776  (`!f:real^M->real^N.
5777         linear f /\ (!x y. f x = f y ==> x = y)
5778         ==> ?B. &0 < B /\ !x. norm(x) * B <= norm(f x)`,
5779   REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
5780   MATCH_MP_TAC LINEAR_INVERTIBLE_BOUNDED_BELOW_POS THEN
5781   ASM_MESON_TAC[LINEAR_INJECTIVE_LEFT_INVERSE]);;
5782
5783 (* ------------------------------------------------------------------------- *)
5784 (* Preservation of dimension by injective map.                               *)
5785 (* ------------------------------------------------------------------------- *)
5786
5787 let DIM_INJECTIVE_LINEAR_IMAGE = prove
5788  (`!f:real^M->real^N s.
5789         linear f /\ (!x y. f x = f y ==> x = y) ==> dim(IMAGE f s) = dim s`,
5790   REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM LE_ANTISYM] THEN
5791   CONJ_TAC THENL [ASM_MESON_TAC[DIM_LINEAR_IMAGE_LE]; ALL_TAC] THEN
5792   MP_TAC(ISPEC `f:real^M->real^N` LINEAR_INJECTIVE_LEFT_INVERSE) THEN
5793   ASM_REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM] THEN
5794   DISCH_THEN(X_CHOOSE_THEN `g:real^N->real^M` STRIP_ASSUME_TAC) THEN
5795   MATCH_MP_TAC LE_TRANS THEN
5796   EXISTS_TAC `dim(IMAGE (g:real^N->real^M) (IMAGE (f:real^M->real^N) s))` THEN
5797   CONJ_TAC THENL
5798    [ASM_REWRITE_TAC[GSYM IMAGE_o; o_DEF; IMAGE_ID; LE_REFL];
5799     MATCH_MP_TAC DIM_LINEAR_IMAGE_LE THEN ASM_REWRITE_TAC[]]);;
5800
5801 let LINEAR_INJECTIVE_DIMINDEX_LE = prove
5802  (`!f:real^M->real^N.
5803         linear f /\ (!x y. f x = f y ==> x = y)
5804         ==> dimindex(:M) <= dimindex(:N)`,
5805   REWRITE_TAC[GSYM DIM_UNIV] THEN REPEAT GEN_TAC THEN DISCH_THEN
5806    (SUBST1_TAC o SYM o SPEC `(:real^M)` o
5807     MATCH_MP DIM_INJECTIVE_LINEAR_IMAGE) THEN
5808   MATCH_MP_TAC DIM_SUBSET THEN REWRITE_TAC[SUBSET_UNIV]);;
5809
5810 let LINEAR_SURJECTIVE_DIMINDEX_LE = prove
5811  (`!f:real^M->real^N.
5812         linear f /\ (!y. ?x. f x = y)
5813         ==> dimindex(:N) <= dimindex(:M)`,
5814   REPEAT GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM
5815    (MP_TAC o MATCH_MP LINEAR_SURJECTIVE_RIGHT_INVERSE) THEN
5816   REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM; LEFT_IMP_EXISTS_THM] THEN
5817   X_GEN_TAC `g:real^N->real^M` THEN STRIP_TAC THEN
5818   MATCH_MP_TAC LINEAR_INJECTIVE_DIMINDEX_LE THEN
5819   EXISTS_TAC `g:real^N->real^M` THEN ASM_MESON_TAC[]);;
5820
5821 let LINEAR_BIJECTIVE_DIMINDEX_EQ = prove
5822  (`!f:real^M->real^N.
5823         linear f /\ (!x y. f x = f y ==> x = y) /\ (!y. ?x. f x = y)
5824         ==> dimindex(:M) = dimindex(:N)`,
5825   REWRITE_TAC[GSYM LE_ANTISYM] THEN REPEAT STRIP_TAC THENL
5826    [MATCH_MP_TAC LINEAR_INJECTIVE_DIMINDEX_LE;
5827     MATCH_MP_TAC LINEAR_SURJECTIVE_DIMINDEX_LE] THEN
5828   EXISTS_TAC `f:real^M->real^N` THEN ASM_REWRITE_TAC[]);;
5829
5830 let INVERTIBLE_IMP_SQUARE_MATRIX = prove
5831  (`!A:real^N^M. invertible A ==> dimindex(:M) = dimindex(:N)`,
5832   GEN_TAC THEN REWRITE_TAC[invertible; LEFT_IMP_EXISTS_THM] THEN
5833   X_GEN_TAC `B:real^M^N` THEN STRIP_TAC THEN
5834   MATCH_MP_TAC LINEAR_BIJECTIVE_DIMINDEX_EQ THEN
5835   EXISTS_TAC `\x:real^M. (B:real^M^N) ** x` THEN
5836   ASM_REWRITE_TAC[MATRIX_VECTOR_MUL_LINEAR;
5837                   GSYM MATRIX_LEFT_INVERTIBLE_INJECTIVE;
5838                   GSYM MATRIX_RIGHT_INVERTIBLE_SURJECTIVE] THEN
5839   ASM_MESON_TAC[]);;
5840
5841 (* ------------------------------------------------------------------------- *)
5842 (* Considering an n-element vector as an n-by-1 or 1-by-n matrix.            *)
5843 (* ------------------------------------------------------------------------- *)
5844
5845 let rowvector = new_definition
5846  `(rowvector:real^N->real^N^1) v = lambda i j. v$j`;;
5847
5848 let columnvector = new_definition
5849  `(columnvector:real^N->real^1^N) v = lambda i j. v$i`;;
5850
5851 let TRANSP_COLUMNVECTOR = prove
5852  (`!v. transp(columnvector v) = rowvector v`,
5853   SIMP_TAC[transp; columnvector; rowvector; CART_EQ; LAMBDA_BETA]);;
5854
5855 let TRANSP_ROWVECTOR = prove
5856  (`!v. transp(rowvector v) = columnvector v`,
5857   SIMP_TAC[transp; columnvector; rowvector; CART_EQ; LAMBDA_BETA]);;
5858
5859 let DOT_ROWVECTOR_COLUMNVECTOR = prove
5860  (`!A:real^N^M v:real^N. columnvector(A ** v) = A ** columnvector v`,
5861   REWRITE_TAC[rowvector; columnvector; matrix_mul; matrix_vector_mul] THEN
5862   SIMP_TAC[CART_EQ; LAMBDA_BETA]);;
5863
5864 let DOT_MATRIX_PRODUCT = prove
5865  (`!x y:real^N. x dot y = (rowvector x ** columnvector y)$1$1`,
5866   REWRITE_TAC[matrix_mul; columnvector; rowvector; dot] THEN
5867   SIMP_TAC[LAMBDA_BETA; DIMINDEX_1; LE_REFL]);;
5868
5869 let DOT_MATRIX_VECTOR_MUL = prove
5870  (`!A:real^N^N B:real^N^N x:real^N y:real^N.
5871       (A ** x) dot (B ** y) =
5872       ((rowvector x) ** (transp(A) ** B) ** (columnvector y))$1$1`,
5873   REWRITE_TAC[DOT_MATRIX_PRODUCT] THEN
5874   ONCE_REWRITE_TAC[GSYM TRANSP_COLUMNVECTOR] THEN
5875   REWRITE_TAC[DOT_ROWVECTOR_COLUMNVECTOR; MATRIX_TRANSP_MUL] THEN
5876   REWRITE_TAC[MATRIX_MUL_ASSOC]);;
5877
5878 (* ------------------------------------------------------------------------- *)
5879 (* Rank of a matrix. Equivalence of row and column rank is taken from        *)
5880 (* George Mackiw's paper, Mathematics Magazine 1995, p. 285.                 *)
5881 (* ------------------------------------------------------------------------- *)
5882
5883 let MATRIX_VECTOR_MUL_IN_COLUMNSPACE = prove
5884  (`!A:real^M^N x:real^M. (A ** x) IN span(columns A)`,
5885   REPEAT GEN_TAC THEN REWRITE_TAC[MATRIX_VECTOR_COLUMN; columns] THEN
5886   MATCH_MP_TAC SPAN_VSUM THEN
5887   SIMP_TAC[FINITE_NUMSEG; IN_NUMSEG; transp; LAMBDA_BETA] THEN
5888   X_GEN_TAC `k:num` THEN STRIP_TAC THEN MATCH_MP_TAC SPAN_MUL THEN
5889   MATCH_MP_TAC SPAN_SUPERSET THEN
5890   REWRITE_TAC[IN_ELIM_THM; column] THEN EXISTS_TAC `k:num` THEN
5891   ASM_REWRITE_TAC[]);;
5892
5893 let SUBSPACE_ORTHOGONAL_TO_VECTOR = prove
5894  (`!x. subspace {y | orthogonal x y}`,
5895   SIMP_TAC[subspace; IN_ELIM_THM; ORTHOGONAL_CLAUSES]);;
5896
5897 let SUBSPACE_ORTHOGONAL_TO_VECTORS = prove
5898  (`!s. subspace {y | (!x. x IN s ==> orthogonal x y)}`,
5899   SIMP_TAC[subspace; IN_ELIM_THM; ORTHOGONAL_CLAUSES]);;
5900
5901 let ORTHOGONAL_TO_SPAN = prove
5902  (`!s x. (!y. y IN s ==> orthogonal x y)
5903          ==> !y. y IN span(s) ==> orthogonal x y`,
5904   REPEAT GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC SPAN_INDUCT THEN
5905   REWRITE_TAC[SET_RULE `(\y. orthogonal x y) = {y | orthogonal x y}`] THEN
5906   ASM_SIMP_TAC[SUBSPACE_ORTHOGONAL_TO_VECTOR; IN_ELIM_THM]);;
5907
5908 let ORTHOGONAL_TO_SPAN_EQ = prove
5909  (`!s x. (!y. y IN span(s) ==> orthogonal x y) <=>
5910          (!y. y IN s ==> orthogonal x y)`,
5911   MESON_TAC[SPAN_SUPERSET; ORTHOGONAL_TO_SPAN]);;
5912
5913 let ORTHOGONAL_TO_SPANS_EQ = prove
5914  (`!s t. (!x y. x IN span(s) /\ y IN span(t) ==> orthogonal x y) <=>
5915          (!x y. x IN s /\ y IN t ==> orthogonal x y)`,
5916   MESON_TAC[ORTHOGONAL_TO_SPAN_EQ; ORTHOGONAL_SYM]);;
5917
5918 let ORTHOGONAL_NULLSPACE_ROWSPACE = prove
5919  (`!A:real^M^N x y:real^M.
5920         A ** x = vec 0 /\ y IN span(rows A) ==> orthogonal x y`,
5921   REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
5922   REPEAT GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC SPAN_INDUCT THEN
5923   REWRITE_TAC[SET_RULE `(\y. orthogonal x y) = {y | orthogonal x y}`] THEN
5924   REWRITE_TAC[SUBSPACE_ORTHOGONAL_TO_VECTOR; rows; FORALL_IN_GSPEC] THEN
5925   X_GEN_TAC `k:num` THEN STRIP_TAC THEN REWRITE_TAC[IN_ELIM_THM] THEN
5926   FIRST_X_ASSUM(MP_TAC o AP_TERM `\y:real^N. y$k`) THEN
5927   ASM_SIMP_TAC[MATRIX_VECTOR_MUL_COMPONENT; VEC_COMPONENT; row; dot;
5928                orthogonal; LAMBDA_BETA] THEN
5929   REWRITE_TAC[REAL_MUL_SYM]);;
5930
5931 let NULLSPACE_INTER_ROWSPACE = prove
5932  (`!A:real^M^N x:real^M. A ** x = vec 0 /\ x IN span(rows A) <=> x = vec 0`,
5933   REPEAT GEN_TAC THEN EQ_TAC THENL
5934    [MESON_TAC[ORTHOGONAL_NULLSPACE_ROWSPACE; ORTHOGONAL_REFL];
5935     SIMP_TAC[MATRIX_VECTOR_MUL_RZERO; SPAN_0]]);;
5936
5937 let MATRIX_VECTOR_MUL_INJECTIVE_ON_ROWSPACE = prove
5938  (`!A:real^M^N x y:real^M.
5939         x IN span(rows A) /\ y IN span(rows A) /\ A ** x = A ** y ==> x = y`,
5940   ONCE_REWRITE_TAC[GSYM VECTOR_SUB_EQ] THEN
5941   REWRITE_TAC[GSYM MATRIX_VECTOR_MUL_SUB_LDISTRIB] THEN
5942   REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM NULLSPACE_INTER_ROWSPACE] THEN
5943   ASM_SIMP_TAC[SPAN_SUB]);;
5944
5945 let DIM_ROWS_LE_DIM_COLUMNS = prove
5946  (`!A:real^M^N. dim(rows A) <= dim(columns A)`,
5947   REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM DIM_SPAN] THEN
5948   X_CHOOSE_THEN `b:real^M->bool` STRIP_ASSUME_TAC
5949    (ISPEC `span(rows(A:real^M^N))` BASIS_EXISTS) THEN
5950   SUBGOAL_THEN `FINITE(IMAGE (\x:real^M. (A:real^M^N) ** x) b) /\
5951                 CARD (IMAGE (\x:real^M. (A:real^M^N) ** x) b) <=
5952                 dim(span(columns A))`
5953   MP_TAC THENL
5954    [MATCH_MP_TAC INDEPENDENT_CARD_LE_DIM THEN
5955     REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; MATRIX_VECTOR_MUL_IN_COLUMNSPACE] THEN
5956     MATCH_MP_TAC INDEPENDENT_INJECTIVE_IMAGE_GEN THEN
5957     ASM_REWRITE_TAC[MATRIX_VECTOR_MUL_LINEAR] THEN
5958     SUBGOAL_THEN `span(b) = span(rows(A:real^M^N))` SUBST1_TAC THENL
5959      [ALL_TAC; ASM_MESON_TAC[MATRIX_VECTOR_MUL_INJECTIVE_ON_ROWSPACE]] THEN
5960     MATCH_MP_TAC SUBSET_ANTISYM THEN ASM_REWRITE_TAC[] THEN
5961     GEN_REWRITE_TAC RAND_CONV [GSYM SPAN_SPAN] THEN
5962     ASM_SIMP_TAC[SPAN_MONO];
5963     DISCH_THEN(MP_TAC o CONJUNCT2) THEN MATCH_MP_TAC EQ_IMP THEN
5964     AP_THM_TAC THEN AP_TERM_TAC THEN
5965     FIRST_ASSUM(CONJUNCTS_THEN2 ASSUME_TAC (SUBST1_TAC o SYM) o
5966       GEN_REWRITE_RULE I [HAS_SIZE]) THEN
5967     MATCH_MP_TAC CARD_IMAGE_INJ THEN ASM_REWRITE_TAC[] THEN
5968     REPEAT STRIP_TAC THEN MATCH_MP_TAC
5969      (ISPEC `A:real^M^N` MATRIX_VECTOR_MUL_INJECTIVE_ON_ROWSPACE) THEN
5970     ASM SET_TAC[]]);;
5971
5972 let rank = new_definition
5973  `rank(A:real^M^N) = dim(columns A)`;;
5974
5975 let RANK_ROW = prove
5976  (`!A:real^M^N. rank(A) = dim(rows A)`,
5977   GEN_TAC THEN REWRITE_TAC[rank] THEN
5978   MP_TAC(ISPEC `A:real^M^N` DIM_ROWS_LE_DIM_COLUMNS) THEN
5979   MP_TAC(ISPEC `transp(A:real^M^N)` DIM_ROWS_LE_DIM_COLUMNS) THEN
5980   REWRITE_TAC[ROWS_TRANSP; COLUMNS_TRANSP] THEN ARITH_TAC);;
5981
5982 let RANK_TRANSP = prove
5983  (`!A:real^M^N. rank(transp A) = rank A`,
5984   GEN_TAC THEN GEN_REWRITE_TAC RAND_CONV [RANK_ROW] THEN
5985   REWRITE_TAC[rank; COLUMNS_TRANSP]);;
5986
5987 let MATRIX_VECTOR_MUL_BASIS = prove
5988  (`!A:real^M^N k. 1 <= k /\ k <= dimindex(:M)
5989                  ==> A ** (basis k) = column k A`,
5990   SIMP_TAC[CART_EQ; column; MATRIX_VECTOR_MUL_COMPONENT; DOT_BASIS;
5991            LAMBDA_BETA]);;
5992
5993 let COLUMNS_IMAGE_BASIS = prove
5994  (`!A:real^M^N.
5995      columns A = IMAGE (\x. A ** x) {basis i | 1 <= i /\ i <= dimindex(:M)}`,
5996   GEN_TAC THEN REWRITE_TAC[columns] THEN
5997   ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN
5998   REWRITE_TAC[GSYM IMAGE_o; o_DEF] THEN
5999   MATCH_MP_TAC(SET_RULE
6000     `(!x. x IN s ==> f x = g x) ==> IMAGE f s = IMAGE g s`) THEN
6001   SIMP_TAC[IN_ELIM_THM; MATRIX_VECTOR_MUL_BASIS]);;
6002
6003 let RANK_DIM_IM = prove
6004  (`!A:real^M^N. rank A = dim(IMAGE (\x. A ** x) (:real^M))`,
6005   GEN_TAC THEN REWRITE_TAC[rank] THEN
6006   MATCH_MP_TAC SPAN_EQ_DIM THEN REWRITE_TAC[COLUMNS_IMAGE_BASIS] THEN
6007   SIMP_TAC[SPAN_LINEAR_IMAGE; MATRIX_VECTOR_MUL_LINEAR] THEN
6008   AP_TERM_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM SPAN_SPAN] THEN
6009   REWRITE_TAC[SPAN_STDBASIS]);;
6010
6011 let DIM_EQ_SPAN = prove
6012  (`!s t:real^N->bool. s SUBSET t /\ dim t <= dim s ==> span s = span t`,
6013   REPEAT STRIP_TAC THEN
6014   X_CHOOSE_THEN `b:real^N->bool` STRIP_ASSUME_TAC
6015    (ISPEC `span s:real^N->bool` BASIS_EXISTS) THEN
6016   MP_TAC(ISPECL [`span t:real^N->bool`; `b:real^N->bool`]
6017     CARD_GE_DIM_INDEPENDENT) THEN
6018   RULE_ASSUM_TAC(REWRITE_RULE[HAS_SIZE]) THEN
6019   ASM_REWRITE_TAC[DIM_SPAN] THEN
6020   ASM_MESON_TAC[SPAN_MONO; SPAN_SPAN; SUBSET_TRANS; SUBSET_ANTISYM]);;
6021
6022 let DIM_EQ_FULL = prove
6023  (`!s:real^N->bool. dim s = dimindex(:N) <=> span s = (:real^N)`,
6024   GEN_TAC THEN ONCE_REWRITE_TAC[GSYM DIM_SPAN] THEN EQ_TAC THEN
6025   SIMP_TAC[DIM_UNIV] THEN DISCH_TAC THEN
6026   GEN_REWRITE_TAC RAND_CONV [GSYM SPAN_UNIV] THEN MATCH_MP_TAC DIM_EQ_SPAN THEN
6027   ASM_REWRITE_TAC[SUBSET_UNIV; DIM_UNIV] THEN
6028   ASM_MESON_TAC[LE_REFL; DIM_SPAN]);;
6029
6030 let DIM_PSUBSET = prove
6031  (`!s t. (span s) PSUBSET (span t) ==> dim s < dim t`,
6032   ONCE_REWRITE_TAC[GSYM DIM_SPAN] THEN
6033   SIMP_TAC[PSUBSET; DIM_SUBSET; LT_LE] THEN
6034   MESON_TAC[EQ_IMP_LE; DIM_EQ_SPAN; SPAN_SPAN]);;
6035
6036 let RANK_BOUND = prove
6037  (`!A:real^M^N. rank(A) <= MIN (dimindex(:M)) (dimindex(:N))`,
6038   GEN_TAC THEN REWRITE_TAC[ARITH_RULE `x <= MIN a b <=> x <= a /\ x <= b`] THEN
6039   CONJ_TAC THENL
6040    [REWRITE_TAC[DIM_SUBSET_UNIV; RANK_ROW];
6041     REWRITE_TAC[DIM_SUBSET_UNIV; rank]]);;
6042
6043 let FULL_RANK_INJECTIVE = prove
6044  (`!A:real^M^N.
6045         rank A = dimindex(:M) <=>
6046         (!x y:real^M. A ** x = A ** y ==> x = y)`,
6047   REWRITE_TAC[GSYM MATRIX_LEFT_INVERTIBLE_INJECTIVE] THEN
6048   REWRITE_TAC[MATRIX_LEFT_INVERTIBLE_SPAN_ROWS] THEN
6049   REWRITE_TAC[RANK_ROW; DIM_EQ_FULL]);;
6050
6051 let FULL_RANK_SURJECTIVE = prove
6052  (`!A:real^M^N.
6053         rank A = dimindex(:N) <=> (!y:real^N. ?x:real^M. A ** x = y)`,
6054   REWRITE_TAC[GSYM MATRIX_RIGHT_INVERTIBLE_SURJECTIVE] THEN
6055   REWRITE_TAC[GSYM LEFT_INVERTIBLE_TRANSP] THEN
6056   REWRITE_TAC[MATRIX_LEFT_INVERTIBLE_INJECTIVE] THEN
6057   REWRITE_TAC[GSYM FULL_RANK_INJECTIVE; RANK_TRANSP]);;
6058
6059 let RANK_I = prove
6060  (`rank(mat 1:real^N^N) = dimindex(:N)`,
6061   REWRITE_TAC[FULL_RANK_INJECTIVE; MATRIX_VECTOR_MUL_LID]);;
6062
6063 let MATRIX_FULL_LINEAR_EQUATIONS = prove
6064  (`!A:real^M^N b:real^N.
6065         rank A = dimindex(:N) ==> ?x. A ** x = b`,
6066   SIMP_TAC[FULL_RANK_SURJECTIVE]);;
6067
6068 let MATRIX_NONFULL_LINEAR_EQUATIONS_EQ = prove
6069  (`!A:real^M^N.
6070         (?x. ~(x = vec 0) /\ A ** x = vec 0) <=> ~(rank A = dimindex(:M))`,
6071   REPEAT GEN_TAC THEN REWRITE_TAC[FULL_RANK_INJECTIVE] THEN
6072   SIMP_TAC[LINEAR_INJECTIVE_0; MATRIX_VECTOR_MUL_LINEAR] THEN
6073   MESON_TAC[]);;
6074
6075 let MATRIX_NONFULL_LINEAR_EQUATIONS = prove
6076  (`!A:real^M^N.
6077         ~(rank A = dimindex(:M)) ==> ?x. ~(x = vec 0) /\ A ** x = vec 0`,
6078   REWRITE_TAC[MATRIX_NONFULL_LINEAR_EQUATIONS_EQ]);;
6079
6080 let MATRIX_TRIVIAL_LINEAR_EQUATIONS = prove
6081  (`!A:real^M^N.
6082         dimindex(:N) < dimindex(:M)
6083         ==> ?x. ~(x = vec 0) /\ A ** x = vec 0`,
6084   REPEAT STRIP_TAC THEN MATCH_MP_TAC MATRIX_NONFULL_LINEAR_EQUATIONS THEN
6085   MATCH_MP_TAC(ARITH_RULE
6086    `!a. x <= MIN b a /\ a < b ==> ~(x = b)`) THEN
6087   EXISTS_TAC `dimindex(:N)` THEN ASM_REWRITE_TAC[RANK_BOUND]);;
6088
6089 let RANK_EQ_0 = prove
6090  (`!A:real^M^N. rank A = 0 <=> A = mat 0`,
6091   REWRITE_TAC[RANK_DIM_IM; DIM_EQ_0; SUBSET; FORALL_IN_IMAGE; IN_SING;
6092               IN_UNIV] THEN
6093   GEN_TAC THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [CART_EQ] THEN
6094   SIMP_TAC[CART_EQ; MATRIX_MUL_DOT; VEC_COMPONENT; LAMBDA_BETA; mat] THEN
6095   ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN
6096   REWRITE_TAC[RIGHT_FORALL_IMP_THM; FORALL_DOT_EQ_0; COND_ID] THEN
6097   REWRITE_TAC[CART_EQ; VEC_COMPONENT]);;
6098
6099 let RANK_0 = prove
6100  (`rank(mat 0) = 0`,
6101   REWRITE_TAC[RANK_EQ_0]);;
6102
6103 let RANK_MUL_LE_RIGHT = prove
6104  (`!A:real^N^M B:real^P^N. rank(A ** B) <= rank(B)`,
6105   REPEAT GEN_TAC THEN MATCH_MP_TAC LE_TRANS THEN
6106   EXISTS_TAC `dim(IMAGE (\y. (A:real^N^M) ** y)
6107                         (IMAGE (\x. (B:real^P^N) ** x) (:real^P)))` THEN
6108   REWRITE_TAC[RANK_DIM_IM] THEN CONJ_TAC THENL
6109    [REWRITE_TAC[GSYM IMAGE_o; o_DEF; MATRIX_VECTOR_MUL_ASSOC; LE_REFL];
6110     MATCH_MP_TAC DIM_LINEAR_IMAGE_LE THEN
6111     REWRITE_TAC[MATRIX_VECTOR_MUL_LINEAR]]);;
6112
6113 let RANK_MUL_LE_LEFT = prove
6114  (`!A:real^N^M B:real^P^N. rank(A ** B) <= rank(A)`,
6115   ONCE_REWRITE_TAC[GSYM RANK_TRANSP] THEN
6116   REWRITE_TAC[MATRIX_TRANSP_MUL] THEN
6117   REWRITE_TAC[RANK_MUL_LE_RIGHT]);;
6118
6119 (* ------------------------------------------------------------------------- *)
6120 (* Some bounds on components etc. relative to operator norm.                 *)
6121 (* ------------------------------------------------------------------------- *)
6122
6123 let NORM_COLUMN_LE_ONORM = prove
6124  (`!A:real^N^M i. norm(column i A) <= onorm(\x. A ** x)`,
6125   REPEAT STRIP_TAC THEN REWRITE_TAC[column] THEN
6126   SUBGOAL_THEN `?l. 1 <= l /\ l <= dimindex(:N) /\ !z:real^N. z$i = z$l`
6127   CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN
6128   MP_TAC(ISPEC `\x:real^N. (A:real^N^M) ** x` ONORM) THEN
6129   REWRITE_TAC[MATRIX_VECTOR_MUL_LINEAR] THEN
6130   DISCH_THEN(MP_TAC o SPEC `basis l:real^N` o CONJUNCT1) THEN
6131   ASM_SIMP_TAC[MATRIX_VECTOR_MUL_BASIS; NORM_BASIS; column; REAL_MUL_RID]);;
6132
6133 let MATRIX_COMPONENT_LE_ONORM = prove
6134  (`!A:real^N^M i j. abs(A$i$j) <= onorm(\x. A ** x)`,
6135   REPEAT GEN_TAC THEN
6136   SUBGOAL_THEN `?k. 1 <= k /\ k <= dimindex(:M) /\ !A:real^N^M. A$i = A$k`
6137   CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN
6138   SUBGOAL_THEN `?l. 1 <= l /\ l <= dimindex(:N) /\ !z:real^N. z$j = z$l`
6139   CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN
6140   ASM_REWRITE_TAC[] THEN
6141   MATCH_MP_TAC REAL_LE_TRANS THEN
6142   EXISTS_TAC `norm(column l (A:real^N^M))` THEN
6143   REWRITE_TAC[NORM_COLUMN_LE_ONORM] THEN
6144   MP_TAC(ISPECL [`column l (A:real^N^M)`; `k:num`]
6145         COMPONENT_LE_NORM) THEN
6146   MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_LE_TRANS) THEN
6147   ASM_SIMP_TAC[column; LAMBDA_BETA; REAL_LE_REFL]);;
6148
6149 let COMPONENT_LE_ONORM = prove
6150  (`!f:real^M->real^N i j. linear f ==> abs(matrix f$i$j) <= onorm f`,
6151   REPEAT STRIP_TAC THEN
6152   FIRST_ASSUM(fun th -> GEN_REWRITE_TAC (RAND_CONV o RAND_CONV)
6153         [MATCH_MP MATRIX_VECTOR_MUL th]) THEN
6154   REWRITE_TAC[MATRIX_COMPONENT_LE_ONORM]);;
6155
6156 (* ------------------------------------------------------------------------- *)
6157 (* Basic lemmas about hyperplanes and halfspaces.                            *)
6158 (* ------------------------------------------------------------------------- *)
6159
6160 let HYPERPLANE_EQ_EMPTY = prove
6161  (`!a:real^N b. {x | a dot x = b} = {} <=> a = vec 0 /\ ~(b = &0)`,
6162   REPEAT GEN_TAC THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY] THEN
6163   ASM_CASES_TAC `a:real^N = vec 0` THEN ASM_REWRITE_TAC[DOT_LZERO] THENL
6164    [MESON_TAC[];
6165     DISCH_THEN(MP_TAC o SPEC `b / (a dot a) % a:real^N`) THEN
6166     ASM_SIMP_TAC[DOT_RMUL; REAL_DIV_RMUL; DOT_EQ_0]]);;
6167
6168 let HYPERPLANE_EQ_UNIV = prove
6169  (`!a b. {x | a dot x = b} = (:real^N) <=> a = vec 0 /\ b = &0`,
6170   REPEAT GEN_TAC THEN  REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_UNIV] THEN
6171   ASM_CASES_TAC `a:real^N = vec 0` THEN ASM_REWRITE_TAC[DOT_LZERO] THENL
6172    [MESON_TAC[];
6173     DISCH_THEN(MP_TAC o SPEC `(b + &1) / (a dot a) % a:real^N`) THEN
6174     ASM_SIMP_TAC[DOT_RMUL; REAL_DIV_RMUL; DOT_EQ_0] THEN REAL_ARITH_TAC]);;
6175
6176 let HALFSPACE_EQ_EMPTY_LT = prove
6177  (`!a:real^N b. {x | a dot x < b} = {} <=> a = vec 0 /\ b <= &0`,
6178   REPEAT GEN_TAC THEN ASM_CASES_TAC `a:real^N = vec 0` THENL
6179    [ASM_SIMP_TAC[DOT_LZERO; SET_RULE `{x | p} = if p then UNIV else {}`] THEN
6180     COND_CASES_TAC THEN REWRITE_TAC[UNIV_NOT_EMPTY] THEN ASM_REAL_ARITH_TAC;
6181     ASM_REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN
6182     EXISTS_TAC `(b - &1) / (a dot a) % a:real^N` THEN
6183     ASM_SIMP_TAC[DOT_RMUL; REAL_DIV_RMUL; DOT_EQ_0] THEN
6184     REAL_ARITH_TAC]);;
6185
6186 let HALFSPACE_EQ_EMPTY_GT = prove
6187  (`!a:real^N b. {x | a dot x > b} = {} <=> a = vec 0 /\ b >= &0`,
6188   REPEAT GEN_TAC THEN
6189   MP_TAC(ISPECL [`--a:real^N`; `--b:real`] HALFSPACE_EQ_EMPTY_LT) THEN
6190   SIMP_TAC[real_gt; DOT_LNEG; REAL_LT_NEG2; VECTOR_NEG_EQ_0] THEN
6191   DISCH_TAC THEN AP_TERM_TAC THEN REAL_ARITH_TAC);;
6192
6193 let HALFSPACE_EQ_EMPTY_LE = prove
6194  (`!a:real^N b. {x | a dot x <= b} = {} <=> a = vec 0 /\ b < &0`,
6195   REPEAT GEN_TAC THEN ASM_CASES_TAC `a:real^N = vec 0` THENL
6196    [ASM_SIMP_TAC[DOT_LZERO; SET_RULE `{x | p} = if p then UNIV else {}`] THEN
6197     COND_CASES_TAC THEN REWRITE_TAC[UNIV_NOT_EMPTY] THEN ASM_REAL_ARITH_TAC;
6198     ASM_REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN
6199     EXISTS_TAC `(b - &1) / (a dot a) % a:real^N` THEN
6200     ASM_SIMP_TAC[DOT_RMUL; REAL_DIV_RMUL; DOT_EQ_0] THEN
6201     REAL_ARITH_TAC]);;
6202
6203 let HALFSPACE_EQ_EMPTY_GE = prove
6204  (`!a:real^N b. {x | a dot x >= b} = {} <=> a = vec 0 /\ b > &0`,
6205   REPEAT GEN_TAC THEN
6206   MP_TAC(ISPECL [`--a:real^N`; `--b:real`] HALFSPACE_EQ_EMPTY_LE) THEN
6207   SIMP_TAC[real_ge; DOT_LNEG; REAL_LE_NEG2; VECTOR_NEG_EQ_0] THEN
6208   DISCH_TAC THEN AP_TERM_TAC THEN REAL_ARITH_TAC);;
6209
6210 (* ------------------------------------------------------------------------- *)
6211 (* A non-injective linear function maps into a hyperplane.                   *)
6212 (* ------------------------------------------------------------------------- *)
6213
6214 let ADJOINT_INJECTIVE = prove
6215  (`!f:real^M->real^N.
6216         linear f
6217         ==> ((!x y. adjoint f x = adjoint f y ==> x = y) <=>
6218              (!y. ?x. f x = y))`,
6219   REPEAT STRIP_TAC THEN
6220   FIRST_ASSUM(ASSUME_TAC o GSYM o MATCH_MP MATRIX_WORKS o MATCH_MP
6221    ADJOINT_LINEAR) THEN
6222   FIRST_ASSUM(ASSUME_TAC o GSYM o MATCH_MP MATRIX_WORKS) THEN
6223   ASM_REWRITE_TAC[GSYM FULL_RANK_INJECTIVE; GSYM FULL_RANK_SURJECTIVE] THEN
6224   ASM_SIMP_TAC[MATRIX_ADJOINT; RANK_TRANSP]);;
6225
6226 let ADJOINT_SURJECTIVE = prove
6227  (`!f:real^M->real^N.
6228         linear f
6229         ==> ((!y. ?x. adjoint f x = y) <=> (!x y. f x = f y ==> x = y))`,
6230   REPEAT STRIP_TAC THEN
6231   FIRST_ASSUM(fun th -> GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV)
6232    [GSYM(MATCH_MP ADJOINT_ADJOINT th)]) THEN
6233   ASM_SIMP_TAC[ADJOINT_INJECTIVE; ADJOINT_LINEAR]);;
6234
6235 let ADJOINT_INJECTIVE_INJECTIVE = prove
6236  (`!f:real^N->real^N.
6237         linear f
6238         ==> ((!x y. adjoint f x = adjoint f y ==> x = y) <=>
6239              (!x y. f x = f y ==> x = y))`,
6240   SIMP_TAC[ADJOINT_INJECTIVE] THEN
6241   MESON_TAC[LINEAR_INJECTIVE_IMP_SURJECTIVE;
6242             LINEAR_SURJECTIVE_IMP_INJECTIVE]);;
6243
6244 let ADJOINT_INJECTIVE_INJECTIVE_0 = prove
6245  (`!f:real^N->real^N.
6246         linear f
6247         ==> ((!x. adjoint f x = vec 0 ==> x = vec 0) <=>
6248              (!x. f x = vec 0 ==> x = vec 0))`,
6249   REPEAT STRIP_TAC THEN
6250   FIRST_ASSUM(MP_TAC o MATCH_MP ADJOINT_INJECTIVE_INJECTIVE) THEN
6251   FIRST_ASSUM(ASSUME_TAC o MATCH_MP ADJOINT_LINEAR) THEN
6252   ASM_MESON_TAC[LINEAR_INJECTIVE_0]);;
6253
6254 let LINEAR_SINGULAR_INTO_HYPERPLANE = prove
6255  (`!f:real^N->real^N.
6256         linear f
6257         ==> (~(!x y. f(x) = f(y) ==> x = y) <=>
6258              ?a. ~(a = vec 0) /\ !x. a dot f(x) = &0)`,
6259   REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[DOT_SYM] THEN
6260   ASM_SIMP_TAC[ADJOINT_WORKS; FORALL_DOT_EQ_0] THEN
6261   REWRITE_TAC[MESON[] `(?a. ~p a /\ q a) <=> ~(!a. q a ==> p a)`] THEN
6262   ASM_SIMP_TAC[ADJOINT_INJECTIVE_INJECTIVE_0; LINEAR_INJECTIVE_0]);;
6263
6264 let LINEAR_SINGULAR_IMAGE_HYPERPLANE = prove
6265  (`!f:real^N->real^N.
6266         linear f /\ ~(!x y. f(x) = f(y) ==> x = y)
6267         ==> ?a. ~(a = vec 0) /\ !s. IMAGE f s SUBSET {x | a dot x = &0}`,
6268   GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
6269   ASM_SIMP_TAC[LINEAR_SINGULAR_INTO_HYPERPLANE] THEN
6270   SIMP_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_THM] THEN MESON_TAC[]);;
6271
6272 let LOWDIM_EXPAND_DIMENSION = prove
6273  (`!s:real^N->bool n.
6274         dim s <= n /\ n <= dimindex(:N)
6275         ==> ?t. dim(t) = n /\ span s SUBSET span t`,
6276   GEN_TAC THEN
6277   GEN_REWRITE_TAC (BINDER_CONV o LAND_CONV o LAND_CONV) [LE_EXISTS] THEN
6278   SIMP_TAC[LEFT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM; IMP_CONJ] THEN
6279   ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN
6280   REWRITE_TAC[RIGHT_FORALL_IMP_THM; LEFT_FORALL_IMP_THM; EXISTS_REFL] THEN
6281   INDUCT_TAC THENL [MESON_TAC[ADD_CLAUSES; SUBSET_REFL]; ALL_TAC] THEN
6282   REWRITE_TAC[ARITH_RULE `s + SUC d <= n <=> s + d < n`] THEN
6283   DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o check (is_imp o concl)) THEN
6284   ASM_SIMP_TAC[LT_IMP_LE; LEFT_IMP_EXISTS_THM] THEN
6285   X_GEN_TAC `t:real^N->bool` THEN STRIP_TAC THEN
6286   REWRITE_TAC[ADD_CLAUSES] THEN FIRST_X_ASSUM(SUBST_ALL_TAC o SYM) THEN
6287   SUBGOAL_THEN `~(span t = (:real^N))` MP_TAC THENL
6288    [REWRITE_TAC[GSYM DIM_EQ_FULL] THEN ASM_ARITH_TAC; ALL_TAC] THEN
6289   REWRITE_TAC[EXTENSION; IN_UNIV; NOT_FORALL_THM; LEFT_IMP_EXISTS_THM] THEN
6290   X_GEN_TAC `a:real^N` THEN DISCH_TAC THEN
6291   EXISTS_TAC `(a:real^N) INSERT t` THEN ASM_REWRITE_TAC[DIM_INSERT; ADD1] THEN
6292   MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `span(t:real^N->bool)` THEN
6293   ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SPAN_MONO THEN SET_TAC[]);;
6294
6295 let LOWDIM_EXPAND_BASIS = prove
6296  (`!s:real^N->bool n.
6297         dim s <= n /\ n <= dimindex(:N)
6298         ==> ?b. b HAS_SIZE n /\ independent b /\ span s SUBSET span b`,
6299   REPEAT GEN_TAC THEN DISCH_TAC THEN
6300   FIRST_ASSUM(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC o
6301     MATCH_MP LOWDIM_EXPAND_DIMENSION) THEN
6302   MP_TAC(ISPEC `t:real^N->bool` BASIS_EXISTS) THEN
6303   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `b:real^N->bool` THEN
6304   ASM_REWRITE_TAC[] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
6305   ASM_MESON_TAC[SPAN_SPAN; SUBSET_TRANS; SPAN_MONO]);;
6306
6307 (* ------------------------------------------------------------------------- *)
6308 (* Orthogonal bases, Gram-Schmidt process, and related theorems.             *)
6309 (* ------------------------------------------------------------------------- *)
6310
6311 let SPAN_DELETE_0 = prove
6312  (`!s:real^N->bool. span(s DELETE vec 0) = span s`,
6313   GEN_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN
6314   SIMP_TAC[DELETE_SUBSET; SPAN_MONO] THEN
6315   MATCH_MP_TAC SUBSET_TRANS THEN
6316   EXISTS_TAC `span((vec 0:real^N) INSERT (s DELETE vec 0))` THEN CONJ_TAC THENL
6317    [MATCH_MP_TAC SPAN_MONO THEN SET_TAC[];
6318     SIMP_TAC[SUBSET; SPAN_BREAKDOWN_EQ; VECTOR_MUL_RZERO; VECTOR_SUB_RZERO]]);;
6319
6320 let SPAN_IMAGE_SCALE = prove
6321  (`!c s. FINITE s /\ (!x. x IN s ==> ~(c x = &0))
6322          ==> span (IMAGE (\x:real^N. c(x) % x) s) = span s`,
6323   GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN
6324   MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
6325   SIMP_TAC[IMAGE_CLAUSES; SPAN_BREAKDOWN_EQ; EXTENSION; FORALL_IN_INSERT] THEN
6326   MAP_EVERY X_GEN_TAC [`x:real^N`; `t:real^N->bool`] THEN
6327   STRIP_TAC THEN STRIP_TAC THEN X_GEN_TAC `y:real^N` THEN
6328   REWRITE_TAC[VECTOR_MUL_ASSOC] THEN EQ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN
6329   DISCH_THEN(X_CHOOSE_TAC `k:real`) THEN
6330   EXISTS_TAC `k / (c:real^N->real) x` THEN
6331   ASM_SIMP_TAC[REAL_DIV_RMUL]);;
6332
6333 let PAIRWISE_ORTHOGONAL_INDEPENDENT = prove
6334  (`!s:real^N->bool.
6335         pairwise orthogonal s /\ ~(vec 0 IN s) ==> independent s`,
6336   REWRITE_TAC[pairwise; orthogonal] THEN REPEAT STRIP_TAC THEN
6337   REWRITE_TAC[independent; dependent] THEN
6338   DISCH_THEN(X_CHOOSE_THEN `a:real^N` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
6339   REWRITE_TAC[SPAN_EXPLICIT; IN_ELIM_THM; NOT_EXISTS_THM] THEN
6340   MAP_EVERY X_GEN_TAC [`t:real^N->bool`; `u:real^N->real`] THEN
6341   REWRITE_TAC[SUBSET; IN_DELETE] THEN STRIP_TAC THEN
6342   FIRST_X_ASSUM(MP_TAC o AP_TERM `\x:real^N. a dot x`) THEN
6343   ASM_SIMP_TAC[DOT_RSUM; DOT_RMUL; REAL_MUL_RZERO; SUM_0] THEN
6344   ASM_MESON_TAC[DOT_EQ_0]);;
6345
6346 let PAIRWISE_ORTHOGONAL_IMP_FINITE = prove
6347  (`!s:real^N->bool. pairwise orthogonal s ==> FINITE s`,
6348   REPEAT STRIP_TAC THEN
6349   SUBGOAL_THEN `independent (s DELETE (vec 0:real^N))` MP_TAC THENL
6350    [MATCH_MP_TAC PAIRWISE_ORTHOGONAL_INDEPENDENT THEN
6351     REWRITE_TAC[IN_DELETE] THEN MATCH_MP_TAC PAIRWISE_MONO THEN
6352     EXISTS_TAC `s:real^N->bool` THEN
6353     ASM_SIMP_TAC[SUBSET; IN_DELETE];
6354     DISCH_THEN(MP_TAC o MATCH_MP INDEPENDENT_IMP_FINITE) THEN
6355     REWRITE_TAC[FINITE_DELETE]]);;
6356
6357 let GRAM_SCHMIDT_STEP = prove
6358  (`!s a x.
6359         pairwise orthogonal s /\ x IN span s
6360         ==> orthogonal x (a - vsum s (\b:real^N. (b dot a) / (b dot b) % b))`,
6361   REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
6362   REWRITE_TAC[ONCE_REWRITE_RULE[ORTHOGONAL_SYM] ORTHOGONAL_TO_SPAN_EQ] THEN
6363   X_GEN_TAC `s:real^N->bool` THEN STRIP_TAC THEN
6364   MAP_EVERY X_GEN_TAC [`a:real^N`; `x:real^N`] THEN DISCH_TAC THEN
6365   FIRST_ASSUM(ASSUME_TAC o MATCH_MP PAIRWISE_ORTHOGONAL_IMP_FINITE) THEN
6366   REWRITE_TAC[orthogonal; DOT_RSUB] THEN ASM_SIMP_TAC[DOT_RSUM] THEN
6367   REWRITE_TAC[REAL_SUB_0; DOT_RMUL] THEN MATCH_MP_TAC EQ_TRANS THEN
6368   EXISTS_TAC `sum s (\y:real^N. if y = x then y dot a else &0)` THEN
6369   CONJ_TAC THENL [ASM_SIMP_TAC[SUM_DELTA; DOT_SYM]; ALL_TAC] THEN
6370   MATCH_MP_TAC SUM_EQ THEN X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN
6371   RULE_ASSUM_TAC(REWRITE_RULE[pairwise; orthogonal]) THEN
6372   ASM_CASES_TAC `x:real^N = y` THEN ASM_SIMP_TAC[DOT_LMUL; REAL_MUL_RZERO] THEN
6373   ASM_CASES_TAC `y:real^N = vec 0` THEN
6374   ASM_SIMP_TAC[REAL_DIV_RMUL; DOT_EQ_0; DOT_LZERO; REAL_MUL_RZERO]);;
6375
6376 let ORTHOGONAL_EXTENSION = prove
6377  (`!s t:real^N->bool.
6378         pairwise orthogonal s
6379         ==> ?u. pairwise orthogonal (s UNION u) /\
6380                 span (s UNION u) = span (s UNION t)`,
6381   let lemma = prove
6382    (`!t s:real^N->bool.
6383         FINITE t /\ FINITE s /\ pairwise orthogonal s
6384         ==> ?u. pairwise orthogonal (s UNION u) /\
6385                 span (s UNION u) = span (s UNION t)`,
6386     REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
6387     MATCH_MP_TAC FINITE_INDUCT_STRONG THEN CONJ_TAC THENL
6388      [REPEAT STRIP_TAC THEN EXISTS_TAC `{}:real^N->bool` THEN
6389       ASM_REWRITE_TAC[UNION_EMPTY];
6390       ALL_TAC] THEN
6391     MAP_EVERY X_GEN_TAC [`a:real^N`; `t:real^N->bool`] THEN
6392     REWRITE_TAC[pairwise; orthogonal] THEN REPEAT STRIP_TAC THEN
6393     ABBREV_TAC `a' = a - vsum s (\b:real^N. (b dot a) / (b dot b) % b)` THEN
6394     FIRST_X_ASSUM(MP_TAC o SPEC `(a':real^N) INSERT s`) THEN
6395     ASM_REWRITE_TAC[FINITE_INSERT] THEN ANTS_TAC THENL
6396      [SUBGOAL_THEN `!x:real^N. x IN s ==> a' dot x = &0`
6397        (fun th -> REWRITE_TAC[IN_INSERT] THEN ASM_MESON_TAC[DOT_SYM; th]) THEN
6398       REPEAT STRIP_TAC THEN EXPAND_TAC "a'" THEN
6399       REWRITE_TAC[GSYM orthogonal] THEN ONCE_REWRITE_TAC[ORTHOGONAL_SYM] THEN
6400       MATCH_MP_TAC GRAM_SCHMIDT_STEP THEN
6401       ASM_SIMP_TAC[pairwise; orthogonal; SPAN_CLAUSES];
6402       DISCH_THEN(X_CHOOSE_THEN `u:real^N->bool` STRIP_ASSUME_TAC) THEN
6403       EXISTS_TAC `(a':real^N) INSERT u` THEN
6404       ASM_REWRITE_TAC[SET_RULE `s UNION a INSERT u = a INSERT s UNION u`] THEN
6405       REWRITE_TAC[SET_RULE `(x INSERT s) UNION t = x INSERT (s UNION t)`] THEN
6406       MATCH_MP_TAC EQ_SPAN_INSERT_EQ THEN EXPAND_TAC "a'" THEN
6407       REWRITE_TAC[VECTOR_ARITH `a - x - a:real^N = --x`] THEN
6408       MATCH_MP_TAC SPAN_NEG THEN MATCH_MP_TAC SPAN_VSUM THEN
6409       ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN
6410       MATCH_MP_TAC SPAN_MUL THEN ASM_SIMP_TAC[SPAN_SUPERSET; IN_UNION]]) in
6411   REPEAT STRIP_TAC THEN
6412   MP_TAC(ISPEC `span t:real^N->bool` BASIS_SUBSPACE_EXISTS) THEN
6413   REWRITE_TAC[SUBSPACE_SPAN; LEFT_IMP_EXISTS_THM] THEN
6414   X_GEN_TAC `b:real^N->bool` THEN STRIP_TAC THEN
6415   MP_TAC(ISPECL [`b:real^N->bool`; `s:real^N->bool`] lemma) THEN
6416   ANTS_TAC THENL
6417    [ASM_MESON_TAC[HAS_SIZE; PAIRWISE_ORTHOGONAL_IMP_FINITE];
6418     MATCH_MP_TAC MONO_EXISTS THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
6419     ASM_REWRITE_TAC[SPAN_UNION]]);;
6420
6421 let ORTHOGONAL_EXTENSION_STRONG = prove
6422  (`!s t:real^N->bool.
6423         pairwise orthogonal s
6424         ==> ?u. DISJOINT u (vec 0 INSERT s) /\
6425                 pairwise orthogonal (s UNION u) /\
6426                 span (s UNION u) = span (s UNION t)`,
6427   REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o
6428     SPEC `t:real^N->bool` o MATCH_MP ORTHOGONAL_EXTENSION) THEN
6429   DISCH_THEN(X_CHOOSE_THEN `u:real^N->bool` STRIP_ASSUME_TAC) THEN
6430   EXISTS_TAC `u DIFF ((vec 0:real^N) INSERT s)` THEN REPEAT CONJ_TAC THENL
6431    [SET_TAC[];
6432     FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
6433         PAIRWISE_MONO)) THEN SET_TAC[];
6434     FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN
6435     GEN_REWRITE_TAC BINOP_CONV [GSYM SPAN_DELETE_0] THEN
6436     AP_TERM_TAC THEN SET_TAC[]]);;
6437
6438 let ORTHONORMAL_EXTENSION = prove
6439  (`!s t:real^N->bool.
6440         pairwise orthogonal s /\ (!x. x IN s ==> norm x = &1)
6441         ==> ?u. DISJOINT u s /\
6442                 pairwise orthogonal (s UNION u) /\
6443                 (!x. x IN u ==> norm x = &1) /\
6444                 span(s UNION u) = span(s UNION t)`,
6445   REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o
6446     SPEC `t:real^N->bool` o MATCH_MP ORTHOGONAL_EXTENSION_STRONG) THEN
6447   REWRITE_TAC[SET_RULE `DISJOINT u s <=> !x. x IN u ==> ~(x IN s)`] THEN
6448   REWRITE_TAC[IN_INSERT; DE_MORGAN_THM; pairwise] THEN
6449   DISCH_THEN(X_CHOOSE_THEN `u:real^N->bool` STRIP_ASSUME_TAC) THEN
6450   EXISTS_TAC `IMAGE (\x:real^N. inv(norm x) % x) u` THEN
6451   REWRITE_TAC[FORALL_IN_IMAGE; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
6452   REPEAT CONJ_TAC THENL
6453    [X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
6454     ASM_CASES_TAC `norm(x:real^N) = &1` THEN
6455     ASM_SIMP_TAC[REAL_INV_1; VECTOR_MUL_LID] THEN DISCH_TAC THEN
6456     FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^N`; `inv(norm x) % x:real^N`]) THEN
6457     ASM_REWRITE_TAC[IN_UNION; VECTOR_MUL_EQ_0; REAL_SUB_0; REAL_INV_EQ_1;
6458       VECTOR_ARITH `x:real^N = a % x <=> (a - &1) % x = vec 0`] THEN
6459     ASM_CASES_TAC `x:real^N = vec 0` THENL
6460      [ASM_MESON_TAC[VECTOR_MUL_RZERO];
6461       ASM_REWRITE_TAC[orthogonal; DOT_RMUL; REAL_ENTIRE; DOT_EQ_0] THEN
6462       ASM_REWRITE_TAC[REAL_INV_EQ_0; NORM_EQ_0]];
6463     REWRITE_TAC[IN_UNION; IN_IMAGE] THEN REPEAT STRIP_TAC THEN
6464     ASM_SIMP_TAC[orthogonal; DOT_LMUL; DOT_RMUL; REAL_ENTIRE; DOT_EQ_0;
6465                  REAL_INV_EQ_0; NORM_EQ_0] THEN
6466     REWRITE_TAC[GSYM orthogonal] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
6467     ASM_REWRITE_TAC[IN_UNION] THEN DISCH_THEN(SUBST_ALL_TAC o SYM) THEN
6468     ASM SET_TAC[];
6469     ASM_SIMP_TAC[NORM_MUL; REAL_MUL_LINV; NORM_EQ_0; REAL_ABS_INV;
6470                  REAL_ABS_NORM];
6471     FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN
6472     REWRITE_TAC[SPAN_EQ; UNION_SUBSET] THEN
6473     SIMP_TAC[SUBSET; FORALL_IN_IMAGE; SPAN_SUPERSET; SPAN_MUL; IN_UNION] THEN
6474     X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
6475     SUBGOAL_THEN `x:real^N = norm(x) % inv(norm x) % x`
6476      (fun th -> GEN_REWRITE_TAC LAND_CONV [th])
6477     THENL
6478      [ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_RINV; NORM_EQ_0; VECTOR_MUL_LID];
6479       MATCH_MP_TAC SPAN_MUL THEN MATCH_MP_TAC SPAN_SUPERSET THEN
6480       REWRITE_TAC[IN_UNION; IN_IMAGE] THEN ASM_MESON_TAC[]]]);;
6481
6482 let VECTOR_IN_ORTHOGONAL_SPANNINGSET = prove
6483  (`!a. ?s. a IN s /\ pairwise orthogonal s /\ span s = (:real^N)`,
6484   GEN_TAC THEN
6485   MP_TAC(ISPECL [`{a:real^N}`; `(IMAGE basis (1..dimindex(:N))):real^N->bool`]
6486                  ORTHOGONAL_EXTENSION) THEN
6487   REWRITE_TAC[PAIRWISE_SING] THEN
6488   DISCH_THEN(X_CHOOSE_THEN `u:real^N->bool` STRIP_ASSUME_TAC) THEN
6489   EXISTS_TAC `{a:real^N} UNION u` THEN ASM_REWRITE_TAC[IN_UNION; IN_SING] THEN
6490   MATCH_MP_TAC(SET_RULE `!s. s = UNIV /\ s SUBSET t ==> t = UNIV`) THEN
6491   EXISTS_TAC `span {basis i:real^N | 1 <= i /\ i <= dimindex (:N)}` THEN
6492   CONJ_TAC THENL [REWRITE_TAC[SPAN_STDBASIS]; MATCH_MP_TAC SPAN_MONO] THEN
6493   REWRITE_TAC[SUBSET; FORALL_IN_GSPEC; GSYM IN_NUMSEG] THEN SET_TAC[]);;
6494
6495 let VECTOR_IN_ORTHOGONAL_BASIS = prove
6496  (`!a. ~(a = vec 0)
6497        ==> ?s. a IN s /\ ~(vec 0 IN s) /\
6498                pairwise orthogonal s /\
6499                independent s /\
6500                s HAS_SIZE (dimindex(:N)) /\
6501                span s = (:real^N)`,
6502   REPEAT STRIP_TAC THEN
6503   MP_TAC(ISPEC `a:real^N` VECTOR_IN_ORTHOGONAL_SPANNINGSET) THEN
6504   DISCH_THEN(X_CHOOSE_THEN `s:real^N->bool` STRIP_ASSUME_TAC) THEN
6505   EXISTS_TAC `s DELETE (vec 0:real^N)` THEN ASM_REWRITE_TAC[IN_DELETE] THEN
6506   MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL
6507    [RULE_ASSUM_TAC(REWRITE_RULE[pairwise]) THEN
6508     ASM_SIMP_TAC[pairwise; IN_DELETE];
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_SIMP_TAC[IN_DELETE];
6512     DISCH_TAC] THEN
6513   MATCH_MP_TAC(TAUT `b /\ (b ==> a) ==> a /\ b`) THEN CONJ_TAC THENL
6514    [ASM_MESON_TAC[SPAN_DELETE_0];
6515     DISCH_TAC THEN ASM_SIMP_TAC[BASIS_HAS_SIZE_UNIV]]);;
6516
6517 let VECTOR_IN_ORTHONORMAL_BASIS = prove
6518  (`!a. norm a = &1
6519        ==> ?s. a IN s /\
6520                pairwise orthogonal s /\
6521                (!x. x IN s ==> norm x = &1) /\
6522                independent s /\
6523                s HAS_SIZE (dimindex(:N)) /\
6524                span s = (:real^N)`,
6525   GEN_TAC THEN ASM_CASES_TAC `a:real^N = vec 0` THEN
6526   ASM_REWRITE_TAC[NORM_0; REAL_OF_NUM_EQ; ARITH_EQ] THEN DISCH_TAC THEN
6527   FIRST_ASSUM(MP_TAC o MATCH_MP VECTOR_IN_ORTHOGONAL_BASIS) THEN
6528   DISCH_THEN(X_CHOOSE_THEN `s:real^N->bool` STRIP_ASSUME_TAC) THEN
6529   EXISTS_TAC `IMAGE (\x:real^N. inv(norm x) % x) s` THEN
6530   CONJ_TAC THENL
6531    [REWRITE_TAC[IN_IMAGE] THEN EXISTS_TAC `a:real^N` THEN
6532     ASM_REWRITE_TAC[REAL_INV_1; VECTOR_MUL_LID];
6533     ALL_TAC] THEN
6534   MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL
6535    [REWRITE_TAC[pairwise; IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN
6536     RULE_ASSUM_TAC(REWRITE_RULE[pairwise]) THEN
6537     ASM_MESON_TAC[ORTHOGONAL_CLAUSES];
6538     DISCH_TAC] THEN
6539   MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL
6540    [REWRITE_TAC[FORALL_IN_IMAGE; NORM_MUL; REAL_ABS_INV; REAL_ABS_NORM] THEN
6541     ASM_MESON_TAC[REAL_MUL_LINV; NORM_EQ_0];
6542     DISCH_TAC] THEN
6543   MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL
6544    [MATCH_MP_TAC PAIRWISE_ORTHOGONAL_INDEPENDENT THEN ASM_REWRITE_TAC[] THEN
6545     REWRITE_TAC[IN_IMAGE] THEN ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN
6546     SIMP_TAC[VECTOR_MUL_EQ_0; REAL_INV_EQ_0; NORM_EQ_0] THEN ASM_MESON_TAC[];
6547     DISCH_TAC] THEN
6548   MATCH_MP_TAC(TAUT `b /\ (b ==> a) ==> a /\ b`) THEN CONJ_TAC THENL
6549    [ALL_TAC; ASM_SIMP_TAC[BASIS_HAS_SIZE_UNIV]] THEN
6550   UNDISCH_THEN `span s = (:real^N)` (SUBST1_TAC o SYM) THEN
6551   MATCH_MP_TAC SPAN_IMAGE_SCALE THEN
6552   REWRITE_TAC[REAL_INV_EQ_0; NORM_EQ_0] THEN
6553   ASM_MESON_TAC[HAS_SIZE]);;
6554
6555 let BESSEL_INEQUALITY = prove
6556  (`!s x:real^N.
6557         pairwise orthogonal s /\ (!x. x IN s ==> norm x = &1)
6558         ==> sum s (\e. (e dot x) pow 2) <= norm(x) pow 2`,
6559   REPEAT STRIP_TAC THEN
6560   FIRST_ASSUM(ASSUME_TAC o MATCH_MP PAIRWISE_ORTHOGONAL_IMP_FINITE) THEN
6561   MP_TAC(ISPEC `x - vsum s (\e. (e dot x) % e):real^N` DOT_POS_LE) THEN
6562   REWRITE_TAC[NORM_POW_2; VECTOR_ARITH
6563    `(a - b:real^N) dot (a - b) = a dot a + b dot b - &2 * b dot a`] THEN
6564   ASM_SIMP_TAC[DOT_LSUM; REAL_POW_2; DOT_LMUL] THEN
6565   MATCH_MP_TAC(REAL_ARITH `t = s ==> &0 <= x + t - &2 * s ==> s <= x`) THEN
6566   MATCH_MP_TAC SUM_EQ THEN X_GEN_TAC `e:real^N` THEN DISCH_TAC THEN
6567   ASM_SIMP_TAC[DOT_RSUM] THEN AP_TERM_TAC THEN
6568   MATCH_MP_TAC EQ_TRANS THEN
6569   EXISTS_TAC `sum s (\k:real^N. if k = e then e dot x else &0)` THEN
6570   CONJ_TAC THENL [ALL_TAC; ASM_SIMP_TAC[SUM_DELTA]] THEN
6571   MATCH_MP_TAC SUM_EQ THEN X_GEN_TAC `k:real^N` THEN DISCH_TAC THEN
6572   REWRITE_TAC[DOT_RMUL] THEN COND_CASES_TAC THENL
6573    [ASM_REWRITE_TAC[REAL_RING `a * x = a <=> a = &0 \/ x = &1`] THEN
6574     DISJ2_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e:real^N`) THEN
6575     ASM_REWRITE_TAC[NORM_EQ_SQUARE] THEN REAL_ARITH_TAC;
6576     RULE_ASSUM_TAC(REWRITE_RULE[pairwise; orthogonal]) THEN
6577     ASM_SIMP_TAC[REAL_ENTIRE]]);;
6578
6579 (* ------------------------------------------------------------------------- *)
6580 (* Analogous theorems for existence of orthonormal basis for a subspace.     *)
6581 (* ------------------------------------------------------------------------- *)
6582
6583 let ORTHOGONAL_SPANNINGSET_SUBSPACE = prove
6584  (`!s:real^N->bool.
6585         subspace s
6586         ==> ?b. b SUBSET s /\ pairwise orthogonal b /\ span b = s`,
6587   REPEAT STRIP_TAC THEN MP_TAC(ISPEC `s:real^N->bool` BASIS_EXISTS) THEN
6588   DISCH_THEN(X_CHOOSE_THEN `b:real^N->bool` STRIP_ASSUME_TAC) THEN
6589   MP_TAC(ISPECL[`{}:real^N->bool`; `b:real^N->bool`] ORTHOGONAL_EXTENSION) THEN
6590   REWRITE_TAC[PAIRWISE_EMPTY; UNION_EMPTY] THEN
6591   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c:real^N->bool` THEN
6592   STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
6593   MATCH_MP_TAC(TAUT `b /\ (b ==> a) ==> a /\ b`) THEN CONJ_TAC THENL
6594    [MATCH_MP_TAC SPAN_SUBSPACE THEN ASM_REWRITE_TAC[];
6595     DISCH_THEN(SUBST1_TAC o SYM) THEN ASM_MESON_TAC[SPAN_INC]]);;
6596
6597 let ORTHOGONAL_BASIS_SUBSPACE = prove
6598  (`!s:real^N->bool.
6599         subspace s
6600         ==> ?b. ~(vec 0 IN b) /\
6601                 b SUBSET s /\
6602                 pairwise orthogonal b /\
6603                 independent b /\
6604                 b HAS_SIZE (dim s) /\
6605                 span b = s`,
6606   REPEAT STRIP_TAC THEN
6607   FIRST_ASSUM(MP_TAC o MATCH_MP ORTHOGONAL_SPANNINGSET_SUBSPACE) THEN
6608   DISCH_THEN(X_CHOOSE_THEN `b:real^N->bool` STRIP_ASSUME_TAC) THEN
6609   EXISTS_TAC `b DELETE (vec 0:real^N)` THEN ASM_REWRITE_TAC[IN_DELETE] THEN
6610   CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
6611   MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL
6612    [RULE_ASSUM_TAC(REWRITE_RULE[pairwise]) THEN
6613     ASM_SIMP_TAC[pairwise; IN_DELETE];
6614     DISCH_TAC] THEN
6615   MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL
6616    [MATCH_MP_TAC PAIRWISE_ORTHOGONAL_INDEPENDENT THEN ASM_SIMP_TAC[IN_DELETE];
6617     DISCH_TAC] THEN
6618   MATCH_MP_TAC(TAUT `b /\ (b ==> a) ==> a /\ b`) THEN CONJ_TAC THENL
6619    [ASM_MESON_TAC[SPAN_DELETE_0];
6620     DISCH_TAC THEN ASM_SIMP_TAC[BASIS_HAS_SIZE_DIM]]);;
6621
6622 let ORTHONORMAL_BASIS_SUBSPACE = prove
6623  (`!s:real^N->bool.
6624         subspace s
6625         ==> ?b. b SUBSET s /\
6626                 pairwise orthogonal b /\
6627                 (!x. x IN b ==> norm x = &1) /\
6628                 independent b /\
6629                 b HAS_SIZE (dim s) /\
6630                 span b = s`,
6631   REPEAT STRIP_TAC THEN
6632   FIRST_ASSUM(MP_TAC o MATCH_MP ORTHOGONAL_BASIS_SUBSPACE) THEN
6633   DISCH_THEN(X_CHOOSE_THEN `b:real^N->bool` STRIP_ASSUME_TAC) THEN
6634   EXISTS_TAC `IMAGE (\x:real^N. inv(norm x) % x) b` THEN
6635   CONJ_TAC THENL
6636    [REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN
6637     ASM_MESON_TAC[SPAN_MUL; SPAN_INC; SUBSET];
6638     ALL_TAC] THEN
6639   MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL
6640    [REWRITE_TAC[pairwise; IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN
6641     RULE_ASSUM_TAC(REWRITE_RULE[pairwise]) THEN
6642     ASM_MESON_TAC[ORTHOGONAL_CLAUSES];
6643     DISCH_TAC] THEN
6644   MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL
6645    [REWRITE_TAC[FORALL_IN_IMAGE; NORM_MUL; REAL_ABS_INV; REAL_ABS_NORM] THEN
6646     ASM_MESON_TAC[REAL_MUL_LINV; NORM_EQ_0];
6647     DISCH_TAC] THEN
6648   MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL
6649    [MATCH_MP_TAC PAIRWISE_ORTHOGONAL_INDEPENDENT THEN ASM_REWRITE_TAC[] THEN
6650     REWRITE_TAC[IN_IMAGE] THEN ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN
6651     SIMP_TAC[VECTOR_MUL_EQ_0; REAL_INV_EQ_0; NORM_EQ_0] THEN ASM_MESON_TAC[];
6652     DISCH_TAC] THEN
6653   MATCH_MP_TAC(TAUT `b /\ (b ==> a) ==> a /\ b`) THEN CONJ_TAC THENL
6654    [ALL_TAC; ASM_SIMP_TAC[BASIS_HAS_SIZE_DIM]] THEN
6655   UNDISCH_THEN `span b = (s:real^N->bool)` (SUBST1_TAC o SYM) THEN
6656   MATCH_MP_TAC SPAN_IMAGE_SCALE THEN
6657   REWRITE_TAC[REAL_INV_EQ_0; NORM_EQ_0] THEN
6658   ASM_MESON_TAC[HAS_SIZE]);;
6659
6660 let ORTHOGONAL_TO_SUBSPACE_EXISTS_GEN = prove
6661  (`!s t:real^N->bool.
6662         span s PSUBSET span t
6663         ==> ?x. ~(x = vec 0) /\ x IN span t /\
6664                 (!y. y IN span s ==> orthogonal x y)`,
6665   REPEAT STRIP_TAC THEN
6666   MP_TAC(ISPEC `span s:real^N->bool` ORTHOGONAL_BASIS_SUBSPACE) THEN
6667   REWRITE_TAC[SUBSPACE_SPAN] THEN
6668   DISCH_THEN(X_CHOOSE_THEN `b:real^N->bool` STRIP_ASSUME_TAC) THEN
6669   FIRST_X_ASSUM(SUBST_ALL_TAC o SYM) THEN
6670   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [PSUBSET_ALT]) THEN
6671   DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC
6672    (X_CHOOSE_THEN `u:real^N` STRIP_ASSUME_TAC)) THEN
6673   MP_TAC(ISPECL [`b:real^N->bool`; `{u:real^N}`] ORTHOGONAL_EXTENSION) THEN
6674   ASM_REWRITE_TAC[] THEN
6675   DISCH_THEN(X_CHOOSE_THEN `ns:real^N->bool` MP_TAC) THEN
6676   ASM_CASES_TAC `ns SUBSET (vec 0:real^N) INSERT b` THENL
6677    [DISCH_THEN(MP_TAC o AP_TERM `(IN) (u:real^N)` o CONJUNCT2) THEN
6678     SIMP_TAC[SPAN_SUPERSET; IN_UNION; IN_SING] THEN
6679     MATCH_MP_TAC(TAUT `~p ==> p ==> q`) THEN
6680     SUBGOAL_THEN `~(u IN span (b UNION {vec 0:real^N}))` MP_TAC THENL
6681      [ASM_REWRITE_TAC[SET_RULE `s UNION {a} = a INSERT s`; SPAN_INSERT_0];
6682       MATCH_MP_TAC(SET_RULE `s SUBSET t ==> ~(x IN t) ==> ~(x IN s)`) THEN
6683       MATCH_MP_TAC SPAN_MONO THEN ASM SET_TAC[]];
6684     ALL_TAC] THEN
6685   FIRST_X_ASSUM(MP_TAC o MATCH_MP (SET_RULE
6686    `~(s SUBSET t) ==> ?z. z IN s /\ ~(z IN t)`)) THEN
6687   REWRITE_TAC[LEFT_IMP_EXISTS_THM; IN_INSERT; DE_MORGAN_THM] THEN
6688   X_GEN_TAC `n:real^N` THEN STRIP_TAC THEN
6689   DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
6690   REWRITE_TAC[pairwise; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
6691   DISCH_THEN(MP_TAC o SPEC `n:real^N`) THEN ASM_REWRITE_TAC[IN_UNION] THEN
6692   REWRITE_TAC[IMP_IMP] THEN DISCH_TAC THEN EXISTS_TAC `n:real^N` THEN
6693   ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
6694    [SUBGOAL_THEN `(n:real^N) IN span (b UNION ns)` MP_TAC THENL
6695      [MATCH_MP_TAC SPAN_SUPERSET THEN ASM SET_TAC[];
6696       ASM_REWRITE_TAC[] THEN SPEC_TAC(`n:real^N`,`n:real^N`) THEN
6697       REWRITE_TAC[GSYM SUBSET] THEN
6698       MATCH_MP_TAC SPAN_SUBSET_SUBSPACE THEN REWRITE_TAC[SUBSPACE_SPAN] THEN
6699       ASM_REWRITE_TAC[SET_RULE
6700        `s UNION {a} SUBSET t <=> s SUBSET t /\ a IN t`] THEN
6701       ASM_MESON_TAC[SPAN_INC; SUBSET_TRANS]];
6702     MATCH_MP_TAC SPAN_INDUCT THEN
6703     REWRITE_TAC[SET_RULE `(\y. orthogonal n y) = {y | orthogonal n y}`] THEN
6704     REWRITE_TAC[SUBSPACE_ORTHOGONAL_TO_VECTOR] THEN ASM SET_TAC[]]);;
6705
6706 let ORTHOGONAL_TO_SUBSPACE_EXISTS = prove
6707  (`!s:real^N->bool. dim s < dimindex(:N)
6708                     ==> ?x. ~(x = vec 0) /\ !y. y IN s ==> orthogonal x y`,
6709   REPEAT STRIP_TAC THEN
6710   MP_TAC(ISPECL [`s:real^N->bool`; `(:real^N)`]
6711         ORTHOGONAL_TO_SUBSPACE_EXISTS_GEN) THEN
6712   ANTS_TAC THENL [REWRITE_TAC[PSUBSET]; MESON_TAC[SPAN_SUPERSET]] THEN
6713   REWRITE_TAC[SPAN_UNIV; SUBSET_UNIV] THEN
6714   ASM_MESON_TAC[DIM_SPAN; DIM_UNIV; LT_REFL]);;
6715
6716 let ORTHOGONAL_TO_VECTOR_EXISTS = prove
6717  (`!x:real^N. 2 <= dimindex(:N) ==> ?y. ~(y = vec 0) /\ orthogonal x y`,
6718   REPEAT STRIP_TAC THEN
6719   MP_TAC(ISPEC `{x:real^N}` ORTHOGONAL_TO_SUBSPACE_EXISTS) THEN
6720   SIMP_TAC[DIM_SING; IN_SING; LEFT_FORALL_IMP_THM; EXISTS_REFL] THEN
6721   ANTS_TAC THENL [ASM_ARITH_TAC; MESON_TAC[ORTHOGONAL_SYM]]);;
6722
6723 let SPAN_NOT_UNIV_ORTHOGONAL = prove
6724  (`!s. ~(span s = (:real^N))
6725          ==> ?a. ~(a = vec 0) /\ !x. x IN span s ==> a dot x = &0`,
6726   REWRITE_TAC[GSYM DIM_EQ_FULL; GSYM LE_ANTISYM; DIM_SUBSET_UNIV;
6727               NOT_LE] THEN
6728   REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM orthogonal] THEN
6729   MATCH_MP_TAC ORTHOGONAL_TO_SUBSPACE_EXISTS THEN ASM_REWRITE_TAC[DIM_SPAN]);;
6730
6731 let SPAN_NOT_UNIV_SUBSET_HYPERPLANE = prove
6732  (`!s. ~(span s = (:real^N))
6733        ==> ?a. ~(a = vec 0) /\ span s SUBSET {x | a dot x = &0}`,
6734   REWRITE_TAC[SUBSET; IN_ELIM_THM; SPAN_NOT_UNIV_ORTHOGONAL]);;
6735
6736 let LOWDIM_SUBSET_HYPERPLANE = prove
6737  (`!s. dim s < dimindex(:N)
6738        ==> ?a:real^N. ~(a = vec 0) /\ span s SUBSET {x | a dot x = &0}`,
6739   REPEAT STRIP_TAC THEN MATCH_MP_TAC SPAN_NOT_UNIV_SUBSET_HYPERPLANE THEN
6740   REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ; SUBSET_UNIV] THEN
6741   DISCH_THEN(MP_TAC o MATCH_MP DIM_SUBSET) THEN
6742   ASM_REWRITE_TAC[NOT_LE; DIM_SPAN; DIM_UNIV]);;
6743
6744 let VECTOR_EQ_DOT_SPAN = prove
6745  (`!b x y:real^N.
6746         (!v. v IN b ==> v dot x = v dot y) /\ x IN span b /\ y IN span b
6747         ==> x = y`,
6748   ONCE_REWRITE_TAC[GSYM REAL_SUB_0; GSYM VECTOR_SUB_EQ] THEN
6749   REWRITE_TAC[GSYM DOT_RSUB; GSYM ORTHOGONAL_REFL; GSYM orthogonal] THEN
6750   MESON_TAC[ORTHOGONAL_TO_SPAN; SPAN_SUB; ORTHOGONAL_SYM]);;
6751
6752 let ORTHONORMAL_BASIS_EXPAND = prove
6753  (`!b x:real^N.
6754         pairwise orthogonal b /\ (!v. v IN b ==> norm v = &1) /\ x IN span b
6755    ==> vsum b (\v. (v dot x) % v) = x`,
6756   REWRITE_TAC[NORM_EQ_1] THEN REPEAT STRIP_TAC THEN
6757   MATCH_MP_TAC VECTOR_EQ_DOT_SPAN THEN EXISTS_TAC `b:real^N->bool` THEN
6758   FIRST_ASSUM(ASSUME_TAC o MATCH_MP PAIRWISE_ORTHOGONAL_IMP_FINITE) THEN
6759   RULE_ASSUM_TAC(REWRITE_RULE[pairwise; orthogonal]) THEN
6760   ASM_SIMP_TAC[SPAN_VSUM; SPAN_MUL; DOT_RSUM; DOT_RMUL; SPAN_SUPERSET] THEN
6761   X_GEN_TAC `v:real^N` THEN DISCH_TAC THEN
6762   TRANS_TAC EQ_TRANS `sum b (\w:real^N. if w = v then v dot x else &0)` THEN
6763   CONJ_TAC THENL [ALL_TAC; ASM_SIMP_TAC[SUM_DELTA]] THEN
6764   MATCH_MP_TAC SUM_EQ THEN ASM_REWRITE_TAC[] THEN
6765   X_GEN_TAC `w:real^N` THEN DISCH_TAC THEN
6766   COND_CASES_TAC THEN ASM_SIMP_TAC[REAL_MUL_RID; REAL_MUL_RZERO]);;
6767
6768 (* ------------------------------------------------------------------------- *)
6769 (* Decomposing a vector into parts in orthogonal subspaces.                  *)
6770 (* ------------------------------------------------------------------------- *)
6771
6772 let ORTHOGONAL_SUBSPACE_DECOMP_UNIQUE = prove
6773  (`!s t x y x' y':real^N.
6774         (!a b. a IN s /\ b IN t ==> orthogonal a b) /\
6775         x IN span s /\ x' IN span s /\ y IN span t /\ y' IN span t /\
6776         x + y = x' + y'
6777         ==> x = x' /\ y = y'`,
6778   REWRITE_TAC[VECTOR_ARITH `x + y:real^N = x' + y' <=> x - x' = y' - y`] THEN
6779   ONCE_REWRITE_TAC[GSYM ORTHOGONAL_TO_SPANS_EQ] THEN
6780   REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[VECTOR_ARITH
6781    `x:real^N = x' /\ y:real^N = y' <=> x - x' = vec 0 /\ y' - y = vec 0`] THEN
6782   STRIP_TAC THEN ASM_REWRITE_TAC[GSYM ORTHOGONAL_REFL] THEN
6783   FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [SYM th]) THEN
6784   ASM_MESON_TAC[ORTHOGONAL_CLAUSES; ORTHOGONAL_SYM]);;
6785
6786 let ORTHOGONAL_SUBSPACE_DECOMP_EXISTS = prove
6787  (`!s x:real^N. ?y z. y IN span s /\ (!w. w IN span s ==> orthogonal z w) /\
6788                       x = y + z`,
6789   REPEAT STRIP_TAC THEN
6790   MP_TAC(ISPEC `span s:real^N->bool` ORTHOGONAL_BASIS_SUBSPACE) THEN
6791   REWRITE_TAC[SUBSPACE_SPAN; LEFT_IMP_EXISTS_THM] THEN
6792   X_GEN_TAC `t:real^N->bool` THEN STRIP_TAC THEN
6793   FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN
6794   EXISTS_TAC `vsum t (\b:real^N. (b dot x) / (b dot b) % b)` THEN
6795   EXISTS_TAC `x - vsum t (\b:real^N. (b dot x) / (b dot b) % b)` THEN
6796   REPEAT CONJ_TAC THENL
6797    [MATCH_MP_TAC SPAN_VSUM THEN
6798     ASM_SIMP_TAC[INDEPENDENT_IMP_FINITE; SPAN_CLAUSES];
6799     REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[ORTHOGONAL_SYM] THEN
6800     MATCH_MP_TAC GRAM_SCHMIDT_STEP THEN ASM_SIMP_TAC[];
6801     VECTOR_ARITH_TAC]);;
6802
6803 let ORTHOGONAL_SUBSPACE_DECOMP = prove
6804  (`!s x. ?!(y,z). y IN span s /\
6805                   z IN {z:real^N | !x. x IN span s ==> orthogonal z x} /\
6806                   x = y + z`,
6807   REWRITE_TAC[EXISTS_UNIQUE_DEF; IN_ELIM_THM] THEN
6808   REWRITE_TAC[EXISTS_PAIRED_THM; FORALL_PAIRED_THM] THEN
6809   REWRITE_TAC[FORALL_PAIR_THM; ORTHOGONAL_SUBSPACE_DECOMP_EXISTS] THEN
6810   REPEAT STRIP_TAC THEN REWRITE_TAC[PAIR_EQ] THEN
6811   MATCH_MP_TAC ORTHOGONAL_SUBSPACE_DECOMP_UNIQUE THEN
6812   MAP_EVERY EXISTS_TAC
6813    [`s:real^N->bool`; `{z:real^N | !x. x IN span s ==> orthogonal z x}`] THEN
6814   ASM_SIMP_TAC[SPAN_CLAUSES; IN_ELIM_THM] THEN
6815   ASM_MESON_TAC[SPAN_CLAUSES; ORTHOGONAL_SYM]);;
6816
6817 (* ------------------------------------------------------------------------- *)
6818 (* Existence of isometry between subspaces of same dimension.                *)
6819 (* ------------------------------------------------------------------------- *)
6820
6821 let ISOMETRY_SUBSET_SUBSPACE = prove
6822  (`!s:real^M->bool t:real^N->bool.
6823         subspace s /\ subspace t /\ dim s <= dim t
6824         ==> ?f. linear f /\ IMAGE f s SUBSET t /\
6825                 (!x. x IN s ==> norm(f x) = norm(x))`,
6826   REPEAT STRIP_TAC THEN
6827   MP_TAC(ISPEC `t:real^N->bool` ORTHONORMAL_BASIS_SUBSPACE) THEN
6828   MP_TAC(ISPEC `s:real^M->bool` ORTHONORMAL_BASIS_SUBSPACE) THEN
6829   ASM_REWRITE_TAC[HAS_SIZE] THEN
6830   DISCH_THEN(X_CHOOSE_THEN `b:real^M->bool` STRIP_ASSUME_TAC) THEN
6831   DISCH_THEN(X_CHOOSE_THEN `c:real^N->bool` STRIP_ASSUME_TAC) THEN
6832   MP_TAC(ISPECL [`b:real^M->bool`; `c:real^N->bool`] CARD_LE_INJ) THEN
6833   ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM; INJECTIVE_ON_ALT] THEN
6834   X_GEN_TAC `fb:real^M->real^N` THEN STRIP_TAC THEN
6835   MP_TAC(ISPECL [`fb:real^M->real^N`; `b:real^M->bool`]
6836     LINEAR_INDEPENDENT_EXTEND) THEN
6837   ASM_REWRITE_TAC[IMP_IMP; LEFT_AND_EXISTS_THM; INJECTIVE_ON_ALT] THEN
6838   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `f:real^M->real^N` THEN
6839   STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
6840    [REWRITE_TAC[SYM(ASSUME `span b:real^M->bool = s`)] THEN
6841     ASM_SIMP_TAC[GSYM SPAN_LINEAR_IMAGE] THEN
6842     REWRITE_TAC[SYM(ASSUME `span c:real^N->bool = t`)] THEN
6843     MATCH_MP_TAC SPAN_MONO THEN ASM SET_TAC[];
6844     UNDISCH_THEN `span b:real^M->bool = s` (SUBST1_TAC o SYM) THEN
6845     ASM_SIMP_TAC[SPAN_FINITE] THEN
6846     REWRITE_TAC[IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN
6847     MAP_EVERY X_GEN_TAC [`z:real^M`; `u:real^M->real`] THEN
6848     DISCH_THEN(SUBST1_TAC o SYM) THEN ASM_SIMP_TAC[LINEAR_VSUM] THEN
6849     REWRITE_TAC[o_DEF; NORM_EQ_SQUARE; NORM_POS_LE; GSYM NORM_POW_2] THEN
6850     ASM_SIMP_TAC[LINEAR_CMUL] THEN
6851     W(MP_TAC o PART_MATCH (lhand o rand)
6852       NORM_VSUM_PYTHAGOREAN o rand o snd) THEN
6853     W(MP_TAC o PART_MATCH (lhand o rand)
6854       NORM_VSUM_PYTHAGOREAN o lhand o rand o snd) THEN
6855     RULE_ASSUM_TAC(REWRITE_RULE[pairwise]) THEN
6856     ASM_SIMP_TAC[pairwise; ORTHOGONAL_CLAUSES] THEN ANTS_TAC THENL
6857      [REPEAT STRIP_TAC THEN REWRITE_TAC[ORTHOGONAL_MUL] THEN ASM SET_TAC[];
6858       REPEAT(DISCH_THEN SUBST1_TAC) THEN ASM_SIMP_TAC[NORM_MUL] THEN
6859       MATCH_MP_TAC SUM_EQ THEN ASM SET_TAC[]]]);;
6860
6861 let ISOMETRIES_SUBSPACES = prove
6862  (`!s:real^M->bool t:real^N->bool.
6863         subspace s /\ subspace t /\ dim s = dim t
6864         ==> ?f g. linear f /\ linear g /\
6865                   IMAGE f s = t /\ IMAGE g t = s /\
6866                   (!x. x IN s ==> norm(f x) = norm x) /\
6867                   (!y. y IN t ==> norm(g y) = norm y) /\
6868                   (!x. x IN s ==> g(f x) = x) /\
6869                   (!y. y IN t ==> f(g y) = y)`,
6870   REPEAT STRIP_TAC THEN ABBREV_TAC `n = dim(t:real^N->bool)` THEN
6871   MP_TAC(ISPEC `t:real^N->bool` ORTHONORMAL_BASIS_SUBSPACE) THEN
6872   MP_TAC(ISPEC `s:real^M->bool` ORTHONORMAL_BASIS_SUBSPACE) THEN
6873   ASM_REWRITE_TAC[] THEN
6874   DISCH_THEN(X_CHOOSE_THEN `b:real^M->bool` STRIP_ASSUME_TAC) THEN
6875   DISCH_THEN(X_CHOOSE_THEN `c:real^N->bool` STRIP_ASSUME_TAC) THEN
6876   MP_TAC(ISPECL [`b:real^M->bool`; `c:real^N->bool`] CARD_EQ_BIJECTIONS) THEN
6877   RULE_ASSUM_TAC(REWRITE_RULE[HAS_SIZE]) THEN
6878   ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
6879   MAP_EVERY X_GEN_TAC [`fb:real^M->real^N`; `gb:real^N->real^M`] THEN
6880   STRIP_TAC THEN
6881   MP_TAC(ISPECL [`gb:real^N->real^M`; `c:real^N->bool`]
6882     LINEAR_INDEPENDENT_EXTEND) THEN
6883   MP_TAC(ISPECL [`fb:real^M->real^N`; `b:real^M->bool`]
6884     LINEAR_INDEPENDENT_EXTEND) THEN
6885   ASM_REWRITE_TAC[IMP_IMP; LEFT_AND_EXISTS_THM] THEN
6886   REWRITE_TAC[RIGHT_AND_EXISTS_THM] THEN
6887   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `f:real^M->real^N` THEN
6888   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^N->real^M` THEN
6889   STRIP_TAC THEN ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL
6890    [REWRITE_TAC[SYM(ASSUME `span b:real^M->bool = s`)] THEN
6891     ASM_SIMP_TAC[GSYM SPAN_LINEAR_IMAGE] THEN
6892     REWRITE_TAC[SYM(ASSUME `span c:real^N->bool = t`)] THEN
6893     AP_TERM_TAC THEN ASM SET_TAC[];
6894     REWRITE_TAC[SYM(ASSUME `span c:real^N->bool = t`)] THEN
6895     ASM_SIMP_TAC[GSYM SPAN_LINEAR_IMAGE] THEN
6896     REWRITE_TAC[SYM(ASSUME `span b:real^M->bool = s`)] THEN
6897     AP_TERM_TAC THEN ASM SET_TAC[];
6898     UNDISCH_THEN `span b:real^M->bool = s` (SUBST1_TAC o SYM) THEN
6899     ASM_SIMP_TAC[SPAN_FINITE] THEN
6900     REWRITE_TAC[IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN
6901     MAP_EVERY X_GEN_TAC [`z:real^M`; `u:real^M->real`] THEN
6902     DISCH_THEN(SUBST1_TAC o SYM) THEN ASM_SIMP_TAC[LINEAR_VSUM] THEN
6903     REWRITE_TAC[o_DEF; NORM_EQ_SQUARE; NORM_POS_LE; GSYM NORM_POW_2] THEN
6904     ASM_SIMP_TAC[LINEAR_CMUL] THEN
6905     W(MP_TAC o PART_MATCH (lhand o rand)
6906       NORM_VSUM_PYTHAGOREAN o rand o snd) THEN
6907     W(MP_TAC o PART_MATCH (lhand o rand)
6908       NORM_VSUM_PYTHAGOREAN o lhand o rand o snd) THEN
6909     RULE_ASSUM_TAC(REWRITE_RULE[pairwise]) THEN
6910     ASM_SIMP_TAC[pairwise; ORTHOGONAL_CLAUSES] THEN ANTS_TAC THENL
6911      [REPEAT STRIP_TAC THEN REWRITE_TAC[ORTHOGONAL_MUL] THEN ASM SET_TAC[];
6912       REPEAT(DISCH_THEN SUBST1_TAC) THEN
6913       ASM_SIMP_TAC[NORM_MUL]];
6914     UNDISCH_THEN `span c:real^N->bool = t` (SUBST1_TAC o SYM) THEN
6915     ASM_SIMP_TAC[SPAN_FINITE] THEN
6916     REWRITE_TAC[IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN
6917     MAP_EVERY X_GEN_TAC [`z:real^N`; `u:real^N->real`] THEN
6918     DISCH_THEN(SUBST1_TAC o SYM) THEN ASM_SIMP_TAC[LINEAR_VSUM] THEN
6919     REWRITE_TAC[o_DEF; NORM_EQ_SQUARE; NORM_POS_LE; GSYM NORM_POW_2] THEN
6920     ASM_SIMP_TAC[LINEAR_CMUL] THEN
6921     W(MP_TAC o PART_MATCH (lhand o rand)
6922       NORM_VSUM_PYTHAGOREAN o rand o snd) THEN
6923     W(MP_TAC o PART_MATCH (lhand o rand)
6924       NORM_VSUM_PYTHAGOREAN o lhand o rand o snd) THEN
6925     RULE_ASSUM_TAC(REWRITE_RULE[pairwise]) THEN
6926     ASM_SIMP_TAC[pairwise; ORTHOGONAL_CLAUSES] THEN ANTS_TAC THENL
6927      [REPEAT STRIP_TAC THEN REWRITE_TAC[ORTHOGONAL_MUL] THEN ASM SET_TAC[];
6928       REPEAT(DISCH_THEN SUBST1_TAC) THEN
6929       ASM_SIMP_TAC[NORM_MUL]];
6930     REWRITE_TAC[SYM(ASSUME `span b:real^M->bool = s`)] THEN
6931     MATCH_MP_TAC SPAN_INDUCT THEN
6932     CONJ_TAC THENL [ASM_MESON_TAC[SUBSET; IN]; ALL_TAC] THEN
6933     REWRITE_TAC[subspace; IN] THEN ASM_MESON_TAC[linear; LINEAR_0];
6934     REWRITE_TAC[SYM(ASSUME `span c:real^N->bool = t`)] THEN
6935     MATCH_MP_TAC SPAN_INDUCT THEN
6936     CONJ_TAC THENL [ASM_MESON_TAC[SUBSET; IN]; ALL_TAC] THEN
6937     REWRITE_TAC[subspace; IN] THEN ASM_MESON_TAC[linear; LINEAR_0]]);;
6938
6939 let ISOMETRY_SUBSPACES = prove
6940  (`!s:real^M->bool t:real^N->bool.
6941         subspace s /\ subspace t /\ dim s = dim t
6942         ==> ?f:real^M->real^N. linear f /\ IMAGE f s = t /\
6943                                (!x. x IN s ==> norm(f x) = norm(x))`,
6944   REPEAT GEN_TAC THEN
6945   DISCH_THEN(MP_TAC o MATCH_MP ISOMETRIES_SUBSPACES) THEN
6946   MATCH_MP_TAC MONO_EXISTS THEN MESON_TAC[]);;
6947
6948 let ISOMETRY_UNIV_SUBSPACE = prove
6949  (`!s. subspace s /\ dimindex(:M) = dim s
6950        ==> ?f:real^M->real^N.
6951                 linear f /\ IMAGE f (:real^M) = s /\
6952                 (!x. norm(f x) = norm(x))`,
6953   REPEAT STRIP_TAC THEN
6954   MP_TAC(ISPECL [`(:real^M)`; `s:real^N->bool`] ISOMETRY_SUBSPACES) THEN
6955   ASM_REWRITE_TAC[SUBSPACE_UNIV; IN_UNIV; DIM_UNIV]);;
6956
6957 let ISOMETRY_UNIV_SUPERSET_SUBSPACE = prove
6958  (`!s. subspace s /\ dim s <= dimindex(:M) /\ dimindex(:M) <= dimindex(:N)
6959        ==> ?f:real^M->real^N.
6960                 linear f /\ s SUBSET (IMAGE f (:real^M)) /\
6961                 (!x. norm(f x) = norm(x))`,
6962   GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN ASSUME_TAC) THEN
6963   FIRST_ASSUM(MP_TAC o MATCH_MP LOWDIM_EXPAND_DIMENSION) THEN
6964   DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) THEN
6965   MP_TAC(ISPECL [`(:real^M)`; `span t:real^N->bool`] ISOMETRY_SUBSPACES) THEN
6966   ASM_REWRITE_TAC[SUBSPACE_SPAN; SUBSPACE_UNIV; DIM_UNIV; DIM_SPAN] THEN
6967   MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[IN_UNIV] THEN
6968   ASM_MESON_TAC[SUBSET; SPAN_INC]);;
6969
6970 let ISOMETRY_UNIV_UNIV = prove
6971  (`dimindex(:M) <= dimindex(:N)
6972    ==> ?f:real^M->real^N. linear f /\ (!x. norm(f x) = norm(x))`,
6973   DISCH_TAC THEN
6974   MP_TAC(ISPEC `{vec 0:real^N}`ISOMETRY_UNIV_SUPERSET_SUBSPACE) THEN
6975   ASM_REWRITE_TAC[SUBSPACE_TRIVIAL] THEN
6976   ANTS_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN
6977   MATCH_MP_TAC(ARITH_RULE `x = 0 /\ 1 <= y ==> x <= y`) THEN
6978   ASM_REWRITE_TAC[DIM_EQ_0; DIMINDEX_GE_1] THEN SET_TAC[]);;
6979
6980 let SUBSPACE_ISOMORPHISM = prove
6981  (`!s t. subspace s /\ subspace t /\ dim(s) = dim(t)
6982          ==> ?f:real^M->real^N.
6983                 linear f /\ (IMAGE f s = t) /\
6984                 (!x y. x IN s /\ y IN s /\ f x = f y ==> (x = y))`,
6985   REPEAT GEN_TAC THEN DISCH_TAC THEN
6986   FIRST_ASSUM(MP_TAC o MATCH_MP ISOMETRY_SUBSPACES) THEN
6987   MATCH_MP_TAC MONO_EXISTS THEN
6988   ASM_SIMP_TAC[LINEAR_INJECTIVE_0_SUBSPACE] THEN MESON_TAC[NORM_EQ_0]);;
6989
6990 let ISOMORPHISMS_UNIV_UNIV = prove
6991  (`dimindex(:M) = dimindex(:N)
6992    ==> ?f:real^M->real^N g.
6993             linear f /\ linear g /\
6994             (!x. norm(f x) = norm x) /\ (!y. norm(g y) = norm y) /\
6995             (!x. g(f x) = x) /\ (!y. f(g y) = y)`,
6996   REPEAT STRIP_TAC THEN
6997   EXISTS_TAC `(\x. lambda i. x$i):real^M->real^N` THEN
6998   EXISTS_TAC `(\x. lambda i. x$i):real^N->real^M` THEN
6999   SIMP_TAC[vector_norm; dot; LAMBDA_BETA] THEN
7000   SIMP_TAC[linear; CART_EQ; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT;
7001            LAMBDA_BETA] THEN
7002   FIRST_ASSUM SUBST1_TAC THEN SIMP_TAC[LAMBDA_BETA] THEN
7003   FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN SIMP_TAC[LAMBDA_BETA]);;
7004
7005 (* ------------------------------------------------------------------------- *)
7006 (* Properties of special hyperplanes.                                        *)
7007 (* ------------------------------------------------------------------------- *)
7008
7009 let SUBSPACE_HYPERPLANE = prove
7010  (`!a. subspace {x:real^N | a dot x = &0}`,
7011   SIMP_TAC[subspace; DOT_RADD; DOT_RMUL; IN_ELIM_THM; REAL_ADD_LID;
7012            REAL_MUL_RZERO; DOT_RZERO]);;
7013
7014 let SUBSPACE_SPECIAL_HYPERPLANE = prove
7015  (`!k. subspace {x:real^N | x$k = &0}`,
7016   SIMP_TAC[subspace; IN_ELIM_THM; VEC_COMPONENT;
7017            VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT] THEN REAL_ARITH_TAC);;
7018
7019 let SPECIAL_HYPERPLANE_SPAN = prove
7020  (`!k. 1 <= k /\ k <= dimindex(:N)
7021        ==> {x:real^N | x$k = &0} =
7022            span(IMAGE basis ((1..dimindex(:N)) DELETE k))`,
7023   REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC SPAN_SUBSPACE THEN
7024   ASM_SIMP_TAC[SUBSPACE_SPECIAL_HYPERPLANE] THEN CONJ_TAC THENL
7025    [REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_THM] THEN
7026     ASM_SIMP_TAC[BASIS_COMPONENT; IN_DELETE];
7027     REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN
7028     X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
7029     GEN_REWRITE_TAC LAND_CONV [GSYM BASIS_EXPANSION] THEN
7030     SIMP_TAC[SPAN_FINITE; FINITE_IMAGE; FINITE_DELETE; FINITE_NUMSEG] THEN
7031     REWRITE_TAC[IN_ELIM_THM] THEN
7032     EXISTS_TAC `\v:real^N. x dot v` THEN
7033     W(MP_TAC o PART_MATCH (lhs o rand) VSUM_IMAGE o lhs o snd) THEN
7034     ANTS_TAC THENL
7035      [REWRITE_TAC[FINITE_DELETE; FINITE_NUMSEG; IN_NUMSEG; IN_DELETE] THEN
7036       MESON_TAC[BASIS_INJ];
7037       DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[o_DEF] THEN
7038       ASM_SIMP_TAC[VSUM_DELETE; FINITE_NUMSEG; IN_NUMSEG; DOT_BASIS] THEN
7039       REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_SUB_RZERO]]]);;
7040
7041 let DIM_SPECIAL_HYPERPLANE = prove
7042  (`!k. 1 <= k /\ k <= dimindex(:N)
7043        ==> dim {x:real^N | x$k = &0} = dimindex(:N) - 1`,
7044   SIMP_TAC[SPECIAL_HYPERPLANE_SPAN] THEN REPEAT STRIP_TAC THEN
7045   MATCH_MP_TAC DIM_UNIQUE THEN
7046   EXISTS_TAC `IMAGE (basis:num->real^N) ((1..dimindex(:N)) DELETE k)` THEN
7047   REWRITE_TAC[SUBSET_REFL; SPAN_INC] THEN CONJ_TAC THENL
7048    [MATCH_MP_TAC INDEPENDENT_MONO THEN
7049     EXISTS_TAC `{basis i:real^N | 1 <= i /\ i <= dimindex(:N)}` THEN
7050     REWRITE_TAC[INDEPENDENT_STDBASIS; SUBSET; FORALL_IN_IMAGE] THEN
7051     REWRITE_TAC[IN_DELETE; IN_NUMSEG; IN_ELIM_THM] THEN MESON_TAC[];
7052     MATCH_MP_TAC HAS_SIZE_IMAGE_INJ THEN CONJ_TAC THENL
7053      [REWRITE_TAC[FINITE_DELETE; FINITE_NUMSEG; IN_NUMSEG; IN_DELETE] THEN
7054       MESON_TAC[BASIS_INJ];
7055       ASM_SIMP_TAC[HAS_SIZE; FINITE_DELETE; FINITE_NUMSEG; CARD_DELETE;
7056                    FINITE_IMAGE; IN_NUMSEG; CARD_NUMSEG_1]]]);;
7057
7058 (* ------------------------------------------------------------------------- *)
7059 (* More theorems about dimensions of different subspaces.                    *)
7060 (* ------------------------------------------------------------------------- *)
7061
7062 let DIM_IMAGE_KERNEL_GEN = prove
7063  (`!f:real^M->real^N s.
7064         linear f /\ subspace s
7065         ==> dim(IMAGE f s) + dim {x | x IN s /\  f x = vec 0} = dim(s)`,
7066   REPEAT STRIP_TAC THEN MP_TAC
7067    (ISPEC `{x | x IN s /\ (f:real^M->real^N) x = vec 0}` BASIS_EXISTS) THEN
7068   DISCH_THEN(X_CHOOSE_THEN `v:real^M->bool` STRIP_ASSUME_TAC) THEN
7069   MP_TAC(ISPECL [`v:real^M->bool`; `s:real^M->bool`]
7070     MAXIMAL_INDEPENDENT_SUBSET_EXTEND) THEN
7071   ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
7072   DISCH_THEN(X_CHOOSE_THEN `w:real^M->bool` STRIP_ASSUME_TAC) THEN
7073   SUBGOAL_THEN `span(w:real^M->bool) = s`
7074    (fun th -> GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [SYM th] THEN
7075               ASSUME_TAC th)
7076   THENL [ASM_SIMP_TAC[SPAN_SUBSPACE]; ALL_TAC] THEN
7077   SUBGOAL_THEN `subspace {x | x IN s /\ (f:real^M->real^N) x = vec 0}`
7078   ASSUME_TAC THENL
7079    [REWRITE_TAC[SET_RULE `{x | x IN s /\ P x} = s INTER {x | P x}`] THEN
7080     ASM_SIMP_TAC[SUBSPACE_INTER; SUBSPACE_KERNEL];
7081     ALL_TAC] THEN
7082   SUBGOAL_THEN `{x | x IN s /\ (f:real^M->real^N) x = vec 0} = span v`
7083   ASSUME_TAC THENL
7084    [ASM_MESON_TAC[SUBSET_ANTISYM; SPAN_SUBSET_SUBSPACE; SUBSPACE_KERNEL];
7085     ALL_TAC] THEN
7086   ASM_SIMP_TAC[DIM_SPAN; DIM_EQ_CARD] THEN
7087   SUBGOAL_THEN
7088    `!x. x IN span(w DIFF v) /\ (f:real^M->real^N) x = vec 0 ==> x = vec 0`
7089   (LABEL_TAC "*") THENL
7090    [MATCH_MP_TAC(SET_RULE
7091      `!t. s SUBSET t /\ (!x. x IN s /\ x IN t /\ P x ==> Q x)
7092           ==> (!x. x IN s /\ P x ==> Q x)`) THEN
7093     EXISTS_TAC `s:real^M->bool` THEN CONJ_TAC THENL
7094      [ASM_MESON_TAC[SPAN_MONO; SUBSET_DIFF]; ALL_TAC] THEN
7095     ASM_SIMP_TAC[SPAN_FINITE; IN_ELIM_THM; IMP_CONJ; FINITE_DIFF;
7096                  INDEPENDENT_IMP_FINITE; LEFT_IMP_EXISTS_THM] THEN
7097     GEN_TAC THEN X_GEN_TAC `u:real^M->real` THEN
7098     DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[IMP_IMP] THEN
7099     ONCE_REWRITE_TAC[SET_RULE
7100      `y IN s /\ f y = a <=> y IN {x | x IN s /\ f x = a}`] THEN
7101     ASM_REWRITE_TAC[] THEN
7102     ASM_SIMP_TAC[SPAN_FINITE; INDEPENDENT_IMP_FINITE; IN_ELIM_THM] THEN
7103     DISCH_THEN(X_CHOOSE_TAC `t:real^M->real`) THEN
7104     MP_TAC(ISPEC `w:real^M->bool` INDEPENDENT_EXPLICIT) THEN
7105     ASM_REWRITE_TAC[] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
7106     DISCH_THEN(MP_TAC o SPEC
7107      `(\x. if x IN w DIFF v then --u x else t x):real^M->real`) THEN
7108     ASM_REWRITE_TAC[COND_RAND] THEN ONCE_REWRITE_TAC[COND_RATOR] THEN
7109     ASM_SIMP_TAC[VSUM_CASES; INDEPENDENT_IMP_FINITE] THEN
7110     REWRITE_TAC[SET_RULE `{x | x IN w /\ x IN (w DIFF v)} = w DIFF v`] THEN
7111     SIMP_TAC[ASSUME `(v:real^M->bool) SUBSET w`; SET_RULE
7112      `v SUBSET w ==> {x | x IN w /\ ~(x IN (w DIFF v))} = v`] THEN
7113     ASM_REWRITE_TAC[VECTOR_MUL_LNEG; VSUM_NEG; VECTOR_ADD_LINV] THEN
7114     DISCH_THEN(fun th -> MATCH_MP_TAC VSUM_EQ_0 THEN MP_TAC th) THEN
7115     REWRITE_TAC[REAL_NEG_EQ_0; VECTOR_MUL_EQ_0; IN_DIFF] THEN MESON_TAC[];
7116     ALL_TAC] THEN
7117   SUBGOAL_THEN `!x y. x IN (w DIFF v) /\ y IN (w DIFF v) /\
7118                       (f:real^M->real^N) x = f y ==> x = y`
7119   ASSUME_TAC THENL
7120    [REMOVE_THEN "*" MP_TAC THEN
7121     ASM_SIMP_TAC[GSYM LINEAR_INJECTIVE_0_SUBSPACE; SUBSPACE_SPAN] THEN
7122     MP_TAC(ISPEC `w DIFF v:real^M->bool` SPAN_INC) THEN SET_TAC[];
7123     ALL_TAC] THEN
7124   SUBGOAL_THEN `IMAGE (f:real^M->real^N) s = span(IMAGE f (w DIFF v))`
7125   SUBST1_TAC THENL
7126    [MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL
7127      [ALL_TAC;
7128       ASM_MESON_TAC[SUBSPACE_LINEAR_IMAGE; SPAN_MONO; IMAGE_SUBSET;
7129                     SUBSET_TRANS; SUBSET_DIFF; SPAN_EQ_SELF]] THEN
7130     SIMP_TAC[SUBSET; FORALL_IN_IMAGE] THEN X_GEN_TAC `x:real^M` THEN
7131     DISCH_TAC THEN UNDISCH_TAC `span w:real^M->bool = s` THEN
7132     REWRITE_TAC[EXTENSION] THEN DISCH_THEN(MP_TAC o SPEC `x:real^M`) THEN
7133     ASM_REWRITE_TAC[] THEN
7134     REMOVE_THEN "*" (MP_TAC o SPEC `x:real^M`) THEN
7135     (CONV_TAC o GEN_SIMPLIFY_CONV TOP_DEPTH_SQCONV (basic_ss []) 4)
7136      [IN_UNIV; SPAN_FINITE; INDEPENDENT_IMP_FINITE; IN_ELIM_THM;
7137       FINITE_IMAGE; FINITE_DIFF; ASSUME `independent(w:real^M->bool)`] THEN
7138     REWRITE_TAC[IMP_CONJ; LEFT_IMP_EXISTS_THM] THEN DISCH_TAC THEN
7139     X_GEN_TAC `u:real^M->real` THEN DISCH_THEN(SUBST1_TAC o SYM) THEN
7140     FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [INJECTIVE_ON_LEFT_INVERSE]) THEN
7141     DISCH_THEN(X_CHOOSE_TAC `g:real^N->real^M`) THEN
7142     EXISTS_TAC `(u:real^M->real) o (g:real^N->real^M)` THEN
7143     W(MP_TAC o PART_MATCH (lhs o rand) VSUM_IMAGE o lhand o snd) THEN
7144     ASM_REWRITE_TAC[] THEN
7145     ASM_SIMP_TAC[FINITE_DIFF; INDEPENDENT_IMP_FINITE; LINEAR_VSUM] THEN
7146     DISCH_THEN SUBST1_TAC THEN ASM_REWRITE_TAC[o_DEF] THEN
7147     CONV_TAC SYM_CONV THEN MATCH_MP_TAC VSUM_EQ_SUPERSET THEN
7148     SIMP_TAC[SUBSET_DIFF; FINITE_DIFF; INDEPENDENT_IMP_FINITE;
7149              LINEAR_CMUL; IN_DIFF; TAUT `a /\ ~(a /\ ~b) <=> a /\ b`;
7150              ASSUME `independent(w:real^M->bool)`;
7151              ASSUME `linear(f:real^M->real^N)`] THEN
7152     REWRITE_TAC[VECTOR_MUL_EQ_0] THEN ASM SET_TAC[];
7153     SUBGOAL_THEN `independent(IMAGE (f:real^M->real^N) (w DIFF v))`
7154     ASSUME_TAC THENL
7155      [MATCH_MP_TAC INDEPENDENT_INJECTIVE_IMAGE_GEN THEN
7156       ASM_SIMP_TAC[LINEAR_INJECTIVE_0_SUBSPACE; SUBSPACE_SPAN] THEN
7157       ASM_MESON_TAC[INDEPENDENT_MONO; SUBSET_DIFF];
7158       ASM_SIMP_TAC[DIM_SPAN; DIM_EQ_CARD] THEN
7159       W(MP_TAC o PART_MATCH (lhs o rand) CARD_IMAGE_INJ o
7160         lhand o lhand o snd) THEN
7161       ASM_REWRITE_TAC[] THEN
7162       ASM_SIMP_TAC[FINITE_DIFF; CARD_DIFF; INDEPENDENT_IMP_FINITE] THEN
7163       DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC SUB_ADD THEN
7164       ASM_MESON_TAC[CARD_SUBSET; INDEPENDENT_IMP_FINITE]]]);;
7165
7166 let DIM_IMAGE_KERNEL = prove
7167  (`!f:real^M->real^N.
7168         linear f
7169         ==> dim(IMAGE f (:real^M)) + dim {x | f x = vec 0} = dimindex(:M)`,
7170   REPEAT STRIP_TAC THEN
7171   MP_TAC(ISPECL [`f:real^M->real^N`; `(:real^M)`] DIM_IMAGE_KERNEL_GEN) THEN
7172   ASM_REWRITE_TAC[SUBSPACE_UNIV; IN_UNIV; DIM_UNIV]);;
7173
7174 let DIM_SUMS_INTER = prove
7175  (`!s t:real^N->bool.
7176     subspace s /\ subspace t
7177     ==> dim {x + y | x IN s /\ y IN t} + dim(s INTER t) = dim(s) + dim(t)`,
7178   REPEAT STRIP_TAC THEN
7179   MP_TAC(ISPEC `s INTER t:real^N->bool` BASIS_EXISTS) THEN
7180   DISCH_THEN(X_CHOOSE_THEN `b:real^N->bool` STRIP_ASSUME_TAC) THEN
7181   MP_TAC(ISPECL [`b:real^N->bool`; `s:real^N->bool`]
7182     MAXIMAL_INDEPENDENT_SUBSET_EXTEND) THEN
7183   ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
7184   DISCH_THEN(X_CHOOSE_THEN `c:real^N->bool` STRIP_ASSUME_TAC) THEN
7185   MP_TAC(ISPECL [`b:real^N->bool`; `t:real^N->bool`]
7186     MAXIMAL_INDEPENDENT_SUBSET_EXTEND) THEN
7187   ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
7188   DISCH_THEN(X_CHOOSE_THEN `d:real^N->bool` STRIP_ASSUME_TAC) THEN
7189   SUBGOAL_THEN `(c:real^N->bool) INTER d = b` ASSUME_TAC THENL
7190    [MATCH_MP_TAC SUBSET_ANTISYM THEN ASM_REWRITE_TAC[SUBSET_INTER] THEN
7191     REWRITE_TAC[SUBSET; IN_INTER] THEN X_GEN_TAC `x:real^N` THEN
7192     STRIP_TAC THEN MP_TAC(ISPEC `c:real^N->bool` independent) THEN
7193     ASM_REWRITE_TAC[dependent; NOT_EXISTS_THM] THEN
7194     DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN
7195     ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN STRIP_TAC THEN
7196     REWRITE_TAC[] THEN
7197     SUBGOAL_THEN `(x:real^N) IN span b` MP_TAC THENL
7198      [ASM_MESON_TAC[SUBSET; IN_INTER; SPAN_INC];
7199       MP_TAC(ISPECL [`b:real^N->bool`; `c DELETE (x:real^N)`] SPAN_MONO) THEN
7200       ASM SET_TAC[]];
7201     ALL_TAC] THEN
7202   SUBGOAL_THEN
7203    `dim (s INTER t:real^N->bool) = CARD(b:real^N->bool) /\
7204     dim s = CARD c /\ dim t = CARD d /\
7205     dim {x + y:real^N | x IN s /\ y IN t} = CARD(c UNION d:real^N->bool)`
7206   (REPEAT_TCL CONJUNCTS_THEN SUBST1_TAC) THENL
7207    [ALL_TAC;
7208     ASM_SIMP_TAC[CARD_UNION_GEN; INDEPENDENT_IMP_FINITE] THEN
7209     MATCH_MP_TAC(ARITH_RULE `b:num <= c ==> (c + d) - b + b = c + d`) THEN
7210     ASM_SIMP_TAC[CARD_SUBSET; INDEPENDENT_IMP_FINITE]] THEN
7211   REPEAT CONJ_TAC THEN MATCH_MP_TAC DIM_UNIQUE THENL
7212    [EXISTS_TAC `b:real^N->bool`;
7213     EXISTS_TAC `c:real^N->bool`;
7214     EXISTS_TAC `d:real^N->bool`;
7215     EXISTS_TAC `c UNION d:real^N->bool`] THEN
7216   ASM_SIMP_TAC[HAS_SIZE; INDEPENDENT_IMP_FINITE; FINITE_UNION] THEN
7217   REWRITE_TAC[UNION_SUBSET; GSYM CONJ_ASSOC] THEN
7218   REWRITE_TAC[SUBSET; IN_ELIM_THM; FORALL_IN_GSPEC] THEN REPEAT CONJ_TAC THENL
7219    [X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
7220     MAP_EVERY EXISTS_TAC [`x:real^N`; `vec 0:real^N`] THEN
7221     ASM_SIMP_TAC[SUBSPACE_0; VECTOR_ADD_RID] THEN ASM SET_TAC[];
7222     X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
7223     MAP_EVERY EXISTS_TAC [`vec 0:real^N`; `x:real^N`] THEN
7224     ASM_SIMP_TAC[SUBSPACE_0; VECTOR_ADD_LID] THEN ASM SET_TAC[];
7225     MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN STRIP_TAC THEN
7226     MATCH_MP_TAC SPAN_ADD THEN CONJ_TAC THENL
7227      [MP_TAC(ISPECL[`c:real^N->bool`; `c UNION d:real^N->bool`] SPAN_MONO);
7228       MP_TAC(ISPECL[`d:real^N->bool`; `c UNION d:real^N->bool`] SPAN_MONO)] THEN
7229     REWRITE_TAC[SUBSET_UNION] THEN REWRITE_TAC[SUBSET] THEN
7230     DISCH_THEN MATCH_MP_TAC THEN ASM SET_TAC[];
7231     ALL_TAC] THEN
7232   ASM_SIMP_TAC[INDEPENDENT_EXPLICIT; FINITE_UNION; INDEPENDENT_IMP_FINITE] THEN
7233   X_GEN_TAC `a:real^N->real` THEN
7234   GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV)
7235    [SET_RULE `s UNION t = s UNION (t DIFF s)`] THEN
7236   ASM_SIMP_TAC[VSUM_UNION; SET_RULE `DISJOINT c (d DIFF c)`;
7237                INDEPENDENT_IMP_FINITE; FINITE_DIFF; FINITE_UNION] THEN
7238   DISCH_TAC THEN
7239   SUBGOAL_THEN
7240    `(vsum (d DIFF c) (\v:real^N. a v % v)) IN span b`
7241   MP_TAC THENL
7242    [FIRST_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN
7243     REWRITE_TAC[IN_INTER] THEN CONJ_TAC THENL
7244      [FIRST_X_ASSUM(SUBST1_TAC o MATCH_MP (VECTOR_ARITH
7245        `a + b = vec 0 ==> b = --a`)) THEN
7246       MATCH_MP_TAC SUBSPACE_NEG THEN ASM_REWRITE_TAC[];
7247       ALL_TAC] THEN
7248     MATCH_MP_TAC SUBSPACE_VSUM THEN
7249     ASM_SIMP_TAC[FINITE_DIFF; INDEPENDENT_IMP_FINITE] THEN
7250     REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSPACE_MUL THEN
7251     ASM_REWRITE_TAC[] THEN ASM SET_TAC[];
7252     ALL_TAC] THEN
7253   ASM_SIMP_TAC[SPAN_FINITE; INDEPENDENT_IMP_FINITE; IN_ELIM_THM] THEN
7254   DISCH_THEN(X_CHOOSE_TAC `e:real^N->real`) THEN
7255   MP_TAC(ISPEC `c:real^N->bool` INDEPENDENT_EXPLICIT) THEN
7256   ASM_REWRITE_TAC[] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC
7257    (MP_TAC o SPEC `(\x. if x IN b then a x + e x else a x):real^N->real`)) THEN
7258   REWRITE_TAC[] THEN ONCE_REWRITE_TAC[COND_RAND] THEN
7259   ONCE_REWRITE_TAC[COND_RATOR] THEN ASM_SIMP_TAC[VSUM_CASES] THEN
7260   REWRITE_TAC[VECTOR_ADD_RDISTRIB; GSYM DIFF] THEN
7261   ASM_SIMP_TAC[SET_RULE `b SUBSET c ==> {x | x IN c /\ x IN b} = b`] THEN
7262   ASM_SIMP_TAC[VSUM_ADD; INDEPENDENT_IMP_FINITE] THEN
7263   ONCE_REWRITE_TAC[VECTOR_ARITH `(a + b) + c:real^N = (a + c) + b`] THEN
7264   ASM_SIMP_TAC[GSYM VSUM_UNION; FINITE_DIFF; INDEPENDENT_IMP_FINITE;
7265                SET_RULE `DISJOINT b (c DIFF b)`] THEN
7266   ASM_SIMP_TAC[SET_RULE `b SUBSET c ==> b UNION (c DIFF b) = c`] THEN
7267   DISCH_TAC THEN
7268   SUBGOAL_THEN `!v:real^N. v IN (c DIFF b) ==> a v = &0` ASSUME_TAC THENL
7269    [ASM SET_TAC[]; ALL_TAC] THEN
7270   MP_TAC(ISPEC `d:real^N->bool` INDEPENDENT_EXPLICIT) THEN
7271   ASM_REWRITE_TAC[] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC
7272    (MP_TAC o SPEC `a:real^N->real`)) THEN
7273   SUBGOAL_THEN `d:real^N->bool = b UNION (d DIFF c)`
7274    (fun th -> GEN_REWRITE_TAC (LAND_CONV o LAND_CONV o ONCE_DEPTH_CONV) [th])
7275   THENL [ASM SET_TAC[]; ALL_TAC] THEN
7276   ANTS_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
7277   ASM_SIMP_TAC[VSUM_UNION; FINITE_DIFF; INDEPENDENT_IMP_FINITE;
7278                SET_RULE `c INTER d = b ==> DISJOINT b (d DIFF c)`] THEN
7279   SUBGOAL_THEN `vsum b (\x:real^N. a x % x) = vsum c (\x. a x % x)`
7280    (fun th -> ASM_REWRITE_TAC[th]) THEN
7281   CONV_TAC SYM_CONV THEN MATCH_MP_TAC VSUM_SUPERSET THEN
7282   ASM_SIMP_TAC[VECTOR_MUL_EQ_0] THEN ASM_MESON_TAC[]);;
7283
7284 let DIM_KERNEL_COMPOSE = prove
7285  (`!f:real^M->real^N g:real^N->real^P.
7286         linear f /\ linear g
7287         ==> dim {x | (g o f) x = vec 0} <=
7288                 dim {x | f(x) = vec 0} +
7289                 dim {y | g(y) = vec 0}`,
7290   REPEAT STRIP_TAC THEN
7291   MP_TAC(ISPEC `{x | (f:real^M->real^N) x = vec 0}` BASIS_EXISTS_FINITE) THEN
7292   DISCH_THEN(X_CHOOSE_THEN `b:real^M->bool` STRIP_ASSUME_TAC) THEN
7293   SUBGOAL_THEN
7294    `?c. FINITE c /\
7295         IMAGE f c SUBSET {y | g(y):real^P = vec 0} /\
7296         independent (IMAGE (f:real^M->real^N) c) /\
7297         IMAGE f (:real^M) INTER {y | g(y) = vec 0} SUBSET span(IMAGE f c) /\
7298         (!x y. x IN c /\ y IN c ==> (f x = f y <=> x = y)) /\
7299         (IMAGE f c) HAS_SIZE dim (IMAGE f (:real^M) INTER {y | g(y) = vec 0})`
7300   STRIP_ASSUME_TAC THENL
7301    [MP_TAC(ISPEC `IMAGE (f:real^M->real^N) (:real^M) INTER
7302                  {x | (g:real^N->real^P) x = vec 0}` BASIS_EXISTS_FINITE) THEN
7303     REWRITE_TAC[SUBSET_INTER; GSYM CONJ_ASSOC; EXISTS_FINITE_SUBSET_IMAGE] THEN
7304     DISCH_THEN(X_CHOOSE_THEN `c:real^M->bool` STRIP_ASSUME_TAC) THEN
7305     MP_TAC(ISPECL [`f:real^M->real^N`; `c:real^M->bool`]
7306         IMAGE_INJECTIVE_IMAGE_OF_SUBSET) THEN
7307     MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real^M->bool` THEN
7308     DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC
7309      (CONJUNCTS_THEN2 SUBST_ALL_TAC ASSUME_TAC)) THEN
7310     ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[FINITE_SUBSET];
7311     ALL_TAC] THEN
7312   MATCH_MP_TAC LE_TRANS THEN
7313   EXISTS_TAC `dim(span(b UNION c:real^M->bool))` THEN CONJ_TAC THENL
7314    [MATCH_MP_TAC DIM_SUBSET THEN
7315     REWRITE_TAC[SUBSET; FORALL_IN_GSPEC; o_THM] THEN
7316     X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN
7317     SUBGOAL_THEN `(f:real^M->real^N) x IN span(IMAGE f c)` MP_TAC THENL
7318      [ASM SET_TAC[]; ALL_TAC] THEN
7319     ASM_SIMP_TAC[SPAN_LINEAR_IMAGE; IN_IMAGE; LEFT_IMP_EXISTS_THM] THEN
7320     X_GEN_TAC `y:real^M` THEN STRIP_TAC THEN
7321     SUBST1_TAC(VECTOR_ARITH `x:real^M = y + (x - y)`) THEN
7322     MATCH_MP_TAC SPAN_ADD THEN CONJ_TAC THENL
7323      [ASM_MESON_TAC[SUBSET_UNION; SPAN_MONO; SUBSET]; ALL_TAC] THEN
7324     MATCH_MP_TAC(SET_RULE
7325      `!t. x IN t /\ t SUBSET s ==> x IN s`) THEN
7326     EXISTS_TAC `{x | (f:real^M->real^N) x = vec 0}` THEN CONJ_TAC THENL
7327      [REWRITE_TAC[IN_ELIM_THM] THEN ASM_MESON_TAC[LINEAR_SUB; VECTOR_SUB_EQ];
7328       ASM_MESON_TAC[SUBSET_TRANS; SUBSET_UNION; SPAN_MONO]];
7329     REWRITE_TAC[DIM_SPAN] THEN MATCH_MP_TAC LE_TRANS THEN
7330     EXISTS_TAC `CARD(b UNION c:real^M->bool)` THEN
7331     ASM_SIMP_TAC[DIM_LE_CARD; FINITE_UNION; INDEPENDENT_IMP_FINITE] THEN
7332     MATCH_MP_TAC LE_TRANS THEN
7333     EXISTS_TAC `CARD(b:real^M->bool) + CARD(c:real^M->bool)` THEN
7334     ASM_SIMP_TAC[CARD_UNION_LE] THEN MATCH_MP_TAC LE_ADD2 THEN CONJ_TAC THENL
7335      [ASM_SIMP_TAC[GSYM DIM_EQ_CARD; DIM_SUBSET]; ALL_TAC] THEN
7336     MATCH_MP_TAC LE_TRANS THEN
7337     EXISTS_TAC `dim(IMAGE (f:real^M->real^N) c)` THEN CONJ_TAC THENL
7338      [ASM_SIMP_TAC[DIM_EQ_CARD] THEN
7339       ASM_MESON_TAC[CARD_IMAGE_INJ; LE_REFL];
7340       ASM_SIMP_TAC[GSYM DIM_EQ_CARD; DIM_SUBSET]]]);;
7341
7342 let DIM_ORTHOGONAL_SUM = prove
7343  (`!s t:real^N->bool.
7344         (!x y. x IN s /\ y IN t ==> x dot y = &0)
7345         ==> dim(s UNION t) = dim(s) + dim(t)`,
7346   REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM DIM_SPAN] THEN
7347   REWRITE_TAC[SPAN_UNION] THEN
7348   SIMP_TAC[GSYM DIM_SUMS_INTER; SUBSPACE_SPAN] THEN
7349   REWRITE_TAC[ARITH_RULE `x = x + y <=> y = 0`] THEN
7350   REWRITE_TAC[DIM_EQ_0; SUBSET; IN_INTER] THEN
7351   SUBGOAL_THEN
7352    `!x:real^N. x IN span s ==> !y:real^N. y IN span t ==> x dot y = &0`
7353   MP_TAC THENL
7354    [MATCH_MP_TAC SPAN_INDUCT THEN CONJ_TAC THENL
7355      [X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN REWRITE_TAC[IN_ELIM_THM] THEN
7356       MATCH_MP_TAC SPAN_INDUCT THEN ASM_SIMP_TAC[IN_ELIM_THM] THEN
7357       SIMP_TAC[subspace; IN_ELIM_THM; DOT_RMUL; DOT_RADD; DOT_RZERO] THEN
7358       REAL_ARITH_TAC;
7359       SIMP_TAC[subspace; IN_ELIM_THM; DOT_LMUL; DOT_LADD; DOT_LZERO] THEN
7360       REAL_ARITH_TAC];
7361     REWRITE_TAC[IN_SING] THEN MESON_TAC[DOT_EQ_0]]);;
7362
7363 let DIM_SUBSPACE_ORTHOGONAL_TO_VECTORS = prove
7364  (`!s t:real^N->bool.
7365         subspace s /\ subspace t /\ s SUBSET t
7366         ==> dim {y | y IN t /\ !x. x IN s ==> orthogonal x y} + dim s = dim t`,
7367   REPEAT STRIP_TAC THEN
7368   W(MP_TAC o PART_MATCH (rand o rand) DIM_ORTHOGONAL_SUM o lhand o snd) THEN
7369   ANTS_TAC THENL
7370    [SIMP_TAC[IN_ELIM_THM; orthogonal] THEN MESON_TAC[DOT_SYM];
7371     DISCH_THEN(SUBST1_TAC o SYM)] THEN
7372   ONCE_REWRITE_TAC[GSYM DIM_SPAN] THEN AP_TERM_TAC THEN
7373   MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL
7374    [MATCH_MP_TAC SPAN_MONO THEN ASM SET_TAC[]; ALL_TAC] THEN
7375   MATCH_MP_TAC SPAN_SUBSET_SUBSPACE THEN REWRITE_TAC[SUBSPACE_SPAN] THEN
7376   REWRITE_TAC[SPAN_UNION; SUBSET; IN_ELIM_THM] THEN
7377   X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
7378   ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN
7379   MP_TAC(ISPECL [`s:real^N->bool`; `x:real^N`]
7380         ORTHOGONAL_SUBSPACE_DECOMP_EXISTS) THEN
7381   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `y:real^N` THEN
7382   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `z:real^N` THEN
7383   STRIP_TAC THEN ASM_REWRITE_TAC[VECTOR_ADD_SYM] THEN
7384   MATCH_MP_TAC SPAN_SUPERSET THEN REWRITE_TAC[IN_ELIM_THM] THEN CONJ_TAC THENL
7385    [FIRST_ASSUM(SUBST1_TAC o MATCH_MP (VECTOR_ARITH
7386      `x:real^N = y + z ==> z = x - y`)) THEN
7387     MATCH_MP_TAC SUBSPACE_SUB THEN
7388     ASM_MESON_TAC[SUBSET; SPAN_EQ_SELF];
7389     ASM_MESON_TAC[SPAN_SUPERSET; ORTHOGONAL_SYM]]);;
7390
7391 let DIM_SPECIAL_SUBSPACE = prove
7392  (`!k. dim {x:real^N |
7393             !i. 1 <= i /\ i <= dimindex(:N) /\ i IN k ==> x$i = &0} =
7394        CARD((1..dimindex(:N)) DIFF k)`,
7395   GEN_TAC THEN MATCH_MP_TAC DIM_UNIQUE THEN
7396   EXISTS_TAC `IMAGE (basis:num->real^N) ((1..dimindex(:N)) DIFF k)` THEN
7397   REPEAT CONJ_TAC THENL
7398    [REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_THM] THEN
7399     SIMP_TAC[BASIS_COMPONENT; IN_DIFF; IN_NUMSEG] THEN MESON_TAC[];
7400     REWRITE_TAC[SUBSET; FORALL_IN_GSPEC] THEN X_GEN_TAC `x:real^N` THEN
7401     DISCH_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM BASIS_EXPANSION] THEN
7402     MATCH_MP_TAC SPAN_VSUM THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN
7403     X_GEN_TAC `j:num` THEN STRIP_TAC THEN
7404     ASM_CASES_TAC `(x:real^N)$j = &0` THEN
7405     ASM_REWRITE_TAC[SPAN_0; VECTOR_MUL_LZERO] THEN
7406     MATCH_MP_TAC SPAN_MUL THEN MATCH_MP_TAC SPAN_SUPERSET THEN
7407     REWRITE_TAC[IN_IMAGE] THEN EXISTS_TAC `j:num` THEN
7408     REWRITE_TAC[IN_NUMSEG; IN_DIFF] THEN ASM_MESON_TAC[];
7409     MATCH_MP_TAC PAIRWISE_ORTHOGONAL_INDEPENDENT THEN
7410     REWRITE_TAC[pairwise; IMP_CONJ; RIGHT_FORALL_IMP_THM;
7411       SET_RULE `~(a IN IMAGE f s) <=> (!x. x IN s ==> ~(f x = a))`] THEN
7412     SIMP_TAC[FORALL_IN_IMAGE; ORTHOGONAL_BASIS_BASIS; BASIS_INJ_EQ;
7413              IN_DIFF; IN_NUMSEG; BASIS_NONZERO];
7414     SIMP_TAC[HAS_SIZE; FINITE_IMAGE; FINITE_DIFF; FINITE_NUMSEG] THEN
7415     MATCH_MP_TAC CARD_IMAGE_INJ THEN
7416     SIMP_TAC[FINITE_DIFF; FINITE_NUMSEG; IMP_CONJ; RIGHT_FORALL_IMP_THM;
7417       SET_RULE `~(a IN IMAGE f s) <=> (!x. x IN s ==> ~(f x = a))`] THEN
7418     SIMP_TAC[FORALL_IN_IMAGE; ORTHOGONAL_BASIS_BASIS; BASIS_INJ_EQ;
7419              IN_DIFF; IN_NUMSEG; BASIS_NONZERO]]);;
7420
7421 (* ------------------------------------------------------------------------- *)
7422 (* More injective/surjective versus dimension variants.                      *)
7423 (* ------------------------------------------------------------------------- *)
7424
7425 let LINEAR_INJECTIVE_IFF_DIM = prove
7426  (`!f:real^M->real^N.
7427         linear f
7428         ==> ((!x y. f x = f y ==> x = y) <=>
7429              dim(IMAGE f (:real^M)) = dimindex(:M))`,
7430   REPEAT STRIP_TAC THEN
7431   MP_TAC(ISPEC `f:real^M->real^N` DIM_IMAGE_KERNEL) THEN
7432   ASM_REWRITE_TAC[] THEN
7433   DISCH_THEN(SUBST1_TAC o MATCH_MP (ARITH_RULE
7434     `x + y:num = m ==> (x = m <=> y = 0)`)) THEN
7435   REWRITE_TAC[DIM_EQ_0; SUBSET; IN_ELIM_THM; IN_SING] THEN
7436   ASM_MESON_TAC[LINEAR_INJECTIVE_0]);;
7437
7438 let LINEAR_SURJECTIVE_IFF_DIM = prove
7439  (`!f:real^M->real^N.
7440         linear f
7441         ==> ((!y. ?x. f x = y) <=>
7442              dim(IMAGE f (:real^M)) = dimindex(:N))`,
7443   SIMP_TAC[DIM_EQ_FULL; SPAN_LINEAR_IMAGE; SPAN_UNIV] THEN SET_TAC[]);;
7444
7445 let LINEAR_SURJECTIVE_IFF_INJECTIVE_GEN = prove
7446  (`!f:real^M->real^N.
7447       dimindex(:M) = dimindex(:N) /\ linear f
7448       ==> ((!y. ?x. f x = y) <=> (!x y. f x = f y ==> x = y))`,
7449   SIMP_TAC[LINEAR_INJECTIVE_IFF_DIM; LINEAR_SURJECTIVE_IFF_DIM] THEN
7450   MESON_TAC[]);;
7451
7452 (* ------------------------------------------------------------------------- *)
7453 (* More about product spaces.                                                *)
7454 (* ------------------------------------------------------------------------- *)
7455
7456 let PASTECART_AS_ORTHOGONAL_SUM = prove
7457  (`!x:real^M y:real^N.
7458         pastecart x y = pastecart x (vec 0) + pastecart (vec 0) y`,
7459   REWRITE_TAC[PASTECART_ADD; VECTOR_ADD_LID; VECTOR_ADD_RID]);;
7460
7461 let PCROSS_AS_ORTHOGONAL_SUM = prove
7462  (`!s:real^M->bool t:real^N->bool.
7463         s PCROSS t =
7464         {u + v | u IN IMAGE (\x. pastecart x (vec 0)) s /\
7465                  v IN IMAGE (\y. pastecart (vec 0) y) t}`,
7466   REPEAT GEN_TAC THEN REWRITE_TAC[PCROSS] THEN
7467   GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV)
7468    [PASTECART_AS_ORTHOGONAL_SUM] THEN
7469   SET_TAC[]);;
7470
7471 let DIM_PCROSS = prove
7472  (`!s:real^M->bool t:real^N->bool.
7473         subspace s /\ subspace t ==> dim(s PCROSS t) = dim s + dim t`,
7474   REPEAT STRIP_TAC THEN REWRITE_TAC[PCROSS_AS_ORTHOGONAL_SUM] THEN
7475   W(MP_TAC o PART_MATCH (lhand o lhand o rand) DIM_SUMS_INTER o
7476         lhand o snd) THEN
7477   ANTS_TAC THENL
7478    [CONJ_TAC THEN MATCH_MP_TAC SUBSPACE_LINEAR_IMAGE;
7479     MATCH_MP_TAC(ARITH_RULE `c = d /\ b = 0 ==> a + b = c ==> a = d`) THEN
7480     CONJ_TAC THENL
7481      [BINOP_TAC THEN MATCH_MP_TAC DIM_INJECTIVE_LINEAR_IMAGE THEN
7482       SIMP_TAC[PASTECART_INJ];
7483       REWRITE_TAC[DIM_EQ_0; SUBSET; IN_INTER; IN_IMAGE; IN_SING] THEN
7484       REWRITE_TAC[PASTECART_EQ; FSTCART_PASTECART; SNDCART_PASTECART] THEN
7485       MESON_TAC[FSTCART_VEC; SNDCART_VEC]]] THEN
7486   ASM_REWRITE_TAC[linear; GSYM PASTECART_VEC] THEN
7487   REWRITE_TAC[PASTECART_ADD; GSYM PASTECART_CMUL; PASTECART_INJ] THEN
7488   VECTOR_ARITH_TAC);;
7489
7490 let SPAN_PCROSS_SUBSET = prove
7491  (`!s:real^M->bool t:real^N->bool.
7492         span(s PCROSS t) SUBSET (span s) PCROSS (span t)`,
7493   REPEAT GEN_TAC THEN MATCH_MP_TAC SPAN_SUBSET_SUBSPACE THEN
7494   SIMP_TAC[SUBSPACE_PCROSS; SUBSPACE_SPAN; PCROSS_MONO; SPAN_INC]);;
7495
7496 let SPAN_PCROSS = prove
7497  (`!s:real^M->bool t:real^N->bool.
7498         ~(s = {}) /\ ~(t = {}) /\ (vec 0 IN s \/ vec 0 IN t)
7499         ==> span(s PCROSS t) = (span s) PCROSS (span t)`,
7500   REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN
7501   REWRITE_TAC[SPAN_PCROSS_SUBSET] THEN
7502   REWRITE_TAC[SUBSET; FORALL_IN_PCROSS] THEN
7503   ONCE_REWRITE_TAC[PASTECART_AS_ORTHOGONAL_SUM] THEN
7504   SUBGOAL_THEN
7505    `(!x:real^M. x IN span s ==> pastecart x (vec 0) IN span(s PCROSS t)) /\
7506     (!y:real^N. y IN span t ==> pastecart (vec 0) y IN span(s PCROSS t))`
7507    (fun th -> ASM_MESON_TAC[th; SPAN_ADD]) THEN
7508   CONJ_TAC THEN MATCH_MP_TAC SPAN_INDUCT THEN REWRITE_TAC[IN_ELIM_THM] THEN
7509   (CONJ_TAC THENL
7510     [REWRITE_TAC[IN_ELIM_THM] THEN
7511      ASM_SIMP_TAC[SPAN_SUPERSET; PASTECART_IN_PCROSS];
7512      REWRITE_TAC[subspace; IN_ELIM_THM; PASTECART_VEC; SPAN_0] THEN
7513      CONJ_TAC THEN REPEAT GEN_TAC THENL
7514       [DISCH_THEN(MP_TAC o MATCH_MP SPAN_ADD) THEN
7515        REWRITE_TAC[PASTECART_ADD; VECTOR_ADD_LID];
7516        DISCH_THEN(MP_TAC o MATCH_MP SPAN_MUL) THEN
7517        SIMP_TAC[GSYM PASTECART_CMUL; VECTOR_MUL_RZERO]]])
7518   THENL
7519    [X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN
7520     UNDISCH_TAC `~(t:real^N->bool = {})` THEN
7521     REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN
7522     DISCH_THEN(X_CHOOSE_TAC `y:real^N`) THEN
7523     SUBGOAL_THEN
7524      `pastecart x (vec 0) =
7525       pastecart (x:real^M) (y:real^N) - pastecart (vec 0) y`
7526     SUBST1_TAC THENL
7527      [REWRITE_TAC[PASTECART_SUB; PASTECART_INJ] THEN VECTOR_ARITH_TAC;
7528       MATCH_MP_TAC SPAN_SUB THEN
7529       ASM_SIMP_TAC[SPAN_SUPERSET; PASTECART_IN_PCROSS]];
7530     X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN
7531     UNDISCH_TAC `~(s:real^M->bool = {})` THEN
7532     REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN
7533     DISCH_THEN(X_CHOOSE_TAC `x:real^M`) THEN
7534     SUBGOAL_THEN
7535      `pastecart (vec 0) y =
7536       pastecart (x:real^M) (y:real^N) - pastecart x (vec 0)`
7537     SUBST1_TAC THENL
7538      [REWRITE_TAC[PASTECART_SUB; PASTECART_INJ] THEN VECTOR_ARITH_TAC;
7539       MATCH_MP_TAC SPAN_SUB THEN
7540       ASM_SIMP_TAC[SPAN_SUPERSET; PASTECART_IN_PCROSS]]]);;
7541
7542 let DIM_PCROSS_STRONG = prove
7543  (`!s:real^M->bool t:real^N->bool.
7544         ~(s = {}) /\ ~(t = {}) /\ (vec 0 IN s \/ vec 0 IN t)
7545         ==> dim(s PCROSS t) = dim s + dim t`,
7546   ONCE_REWRITE_TAC[GSYM DIM_SPAN] THEN
7547   SIMP_TAC[SPAN_PCROSS; DIM_PCROSS; SUBSPACE_SPAN]);;
7548
7549 let SPAN_SUMS = prove
7550  (`!s t:real^N->bool.
7551         ~(s = {}) /\ ~(t = {}) /\ vec 0 IN (s UNION t)
7552         ==> span {x + y | x IN s /\ y IN t} =
7553             {x + y | x IN span s /\ y IN span t}`,
7554   REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM SPAN_UNION] THEN
7555   MATCH_MP_TAC SUBSET_ANTISYM THEN
7556   CONJ_TAC THEN MATCH_MP_TAC SPAN_SUBSET_SUBSPACE THEN
7557   REWRITE_TAC[SUBSPACE_SPAN; SUBSET; FORALL_IN_GSPEC] THEN
7558   SIMP_TAC[SPAN_ADD; IN_UNION; SPAN_SUPERSET] THEN
7559   X_GEN_TAC `x:real^N` THEN STRIP_TAC THEN
7560   FIRST_X_ASSUM(DISJ_CASES_TAC o GEN_REWRITE_RULE I [IN_UNION]) THENL
7561    [UNDISCH_TAC `~(t:real^N->bool = {})` THEN
7562     REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN
7563     DISCH_THEN(X_CHOOSE_TAC `y:real^N`) THEN
7564     SUBST1_TAC(VECTOR_ARITH `x:real^N = (x + y) - (vec 0 + y)`) THEN
7565     MATCH_MP_TAC SPAN_SUB THEN CONJ_TAC THEN MATCH_MP_TAC SPAN_SUPERSET THEN
7566     ASM SET_TAC[];
7567     MATCH_MP_TAC SPAN_SUPERSET THEN REWRITE_TAC[IN_ELIM_THM] THEN
7568     ASM_MESON_TAC[VECTOR_ADD_RID];
7569     MATCH_MP_TAC SPAN_SUPERSET THEN REWRITE_TAC[IN_ELIM_THM] THEN
7570     ASM_MESON_TAC[VECTOR_ADD_LID];
7571     UNDISCH_TAC `~(s:real^N->bool = {})` THEN
7572     REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN
7573     DISCH_THEN(X_CHOOSE_TAC `y:real^N`) THEN
7574     SUBST1_TAC(VECTOR_ARITH `x:real^N = (y + x) - (y + vec 0)`) THEN
7575     MATCH_MP_TAC SPAN_SUB THEN CONJ_TAC THEN MATCH_MP_TAC SPAN_SUPERSET THEN
7576     ASM SET_TAC[]]);;
7577
7578 (* ------------------------------------------------------------------------- *)
7579 (* More about rank from the rank/nullspace formula.                          *)
7580 (* ------------------------------------------------------------------------- *)
7581
7582 let RANK_NULLSPACE = prove
7583  (`!A:real^M^N. rank A + dim {x | A ** x = vec 0} = dimindex(:M)`,
7584   GEN_TAC THEN REWRITE_TAC[RANK_DIM_IM] THEN
7585   MATCH_MP_TAC DIM_IMAGE_KERNEL THEN
7586   REWRITE_TAC[MATRIX_VECTOR_MUL_LINEAR]);;
7587
7588 let RANK_SYLVESTER = prove
7589  (`!A:real^N^M B:real^P^N.
7590         rank(A) + rank(B) <= rank(A ** B) + dimindex(:N)`,
7591   REPEAT GEN_TAC THEN MATCH_MP_TAC(ARITH_RULE
7592     `!ia ib iab p:num.
7593         ra + ia = n /\
7594         rb + ib = p /\
7595         rab + iab = p /\
7596         iab <= ia + ib
7597         ==> ra + rb <= rab + n`) THEN
7598   MAP_EVERY EXISTS_TAC
7599    [`dim {x | (A:real^N^M) ** x = vec 0}`;
7600     `dim {x | (B:real^P^N) ** x = vec 0}`;
7601     `dim {x | ((A:real^N^M) ** (B:real^P^N)) ** x = vec 0}`;
7602     `dimindex(:P)`] THEN
7603   REWRITE_TAC[RANK_NULLSPACE] THEN
7604   REWRITE_TAC[GSYM MATRIX_VECTOR_MUL_ASSOC] THEN
7605   ONCE_REWRITE_TAC[ADD_SYM] THEN
7606   MATCH_MP_TAC(REWRITE_RULE[o_DEF] DIM_KERNEL_COMPOSE) THEN
7607   CONJ_TAC THEN GEN_REWRITE_TAC RAND_CONV [GSYM ETA_AX] THEN
7608   REWRITE_TAC[MATRIX_VECTOR_MUL_LINEAR]);;
7609
7610 let RANK_GRAM = prove
7611  (`!A:real^M^N. rank(transp A ** A) = rank A`,
7612   GEN_TAC THEN MATCH_MP_TAC(ARITH_RULE
7613    `!n n' k. r + n:num = k /\ r' + n' = k /\ n = n' ==> r = r'`) THEN
7614   MAP_EVERY EXISTS_TAC
7615    [`dim {x | (transp A ** (A:real^M^N)) ** x = vec 0}`;
7616     `dim {x | (A:real^M^N) ** x = vec 0}`;
7617     `dimindex(:M)`] THEN
7618   REWRITE_TAC[RANK_NULLSPACE] THEN AP_TERM_TAC THEN
7619   MATCH_MP_TAC SUBSET_ANTISYM THEN
7620   SIMP_TAC[SUBSET; IN_ELIM_THM; GSYM MATRIX_VECTOR_MUL_ASSOC;
7621            MATRIX_VECTOR_MUL_RZERO] THEN
7622   X_GEN_TAC `x:real^M` THEN
7623   DISCH_THEN(MP_TAC o AP_TERM `(dot) (x:real^M)`) THEN
7624   ONCE_REWRITE_TAC[GSYM DOT_LMUL_MATRIX] THEN
7625   REWRITE_TAC[VECTOR_MATRIX_MUL_TRANSP; TRANSP_TRANSP; DOT_RZERO] THEN
7626   REWRITE_TAC[DOT_EQ_0]);;
7627
7628 let RANK_TRIANGLE = prove
7629  (`!A B:real^M^N. rank(A + B) <= rank(A) + rank(B)`,
7630   REPEAT GEN_TAC THEN REWRITE_TAC[RANK_DIM_IM] THEN
7631   MP_TAC(ISPECL [`IMAGE (\x. (A:real^M^N) ** x) (:real^M)`;
7632                  `IMAGE (\x. (B:real^M^N) ** x) (:real^M)`]
7633                 DIM_SUMS_INTER) THEN
7634   ASM_SIMP_TAC[SUBSPACE_LINEAR_IMAGE; SUBSPACE_UNIV;
7635                MATRIX_VECTOR_MUL_LINEAR] THEN
7636   DISCH_THEN(SUBST1_TAC o SYM) THEN
7637   MATCH_MP_TAC(ARITH_RULE `x:num <= y ==> x <= y + z`) THEN
7638   MATCH_MP_TAC DIM_SUBSET THEN
7639   REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_UNIV;
7640               MATRIX_VECTOR_MUL_ADD_RDISTRIB] THEN
7641   REWRITE_TAC[IN_ELIM_THM; IN_IMAGE; IN_UNIV] THEN MESON_TAC[]);;
7642
7643 (* ------------------------------------------------------------------------- *)
7644 (* Infinity norm.                                                            *)
7645 (* ------------------------------------------------------------------------- *)
7646
7647 let infnorm = define
7648  `infnorm (x:real^N) = sup { abs(x$i) | 1 <= i /\ i <= dimindex(:N) }`;;
7649
7650 let NUMSEG_DIMINDEX_NONEMPTY = prove
7651  (`?i. i IN 1..dimindex(:N)`,
7652   REWRITE_TAC[MEMBER_NOT_EMPTY; NUMSEG_EMPTY; NOT_LT; DIMINDEX_GE_1]);;
7653
7654 let INFNORM_SET_IMAGE = prove
7655  (`{abs(x$i) | 1 <= i /\ i <= dimindex(:N)} =
7656    IMAGE (\i. abs(x$i)) (1..dimindex(:N))`,
7657   REWRITE_TAC[numseg] THEN SET_TAC[]);;
7658
7659 let INFNORM_SET_LEMMA = prove
7660  (`FINITE {abs((x:real^N)$i) | 1 <= i /\ i <= dimindex(:N)} /\
7661    ~({abs(x$i) | 1 <= i /\ i <= dimindex(:N)} = {})`,
7662   SIMP_TAC[INFNORM_SET_IMAGE; FINITE_NUMSEG; FINITE_IMAGE; IMAGE_EQ_EMPTY] THEN
7663   REWRITE_TAC[NUMSEG_EMPTY; NOT_LT; DIMINDEX_GE_1]);;
7664
7665 let INFNORM_POS_LE = prove
7666  (`!x. &0 <= infnorm x`,
7667   REWRITE_TAC[infnorm] THEN
7668   SIMP_TAC[REAL_LE_SUP_FINITE; INFNORM_SET_LEMMA] THEN
7669   REWRITE_TAC[INFNORM_SET_IMAGE; NUMSEG_DIMINDEX_NONEMPTY;
7670               EXISTS_IN_IMAGE; REAL_ABS_POS]);;
7671
7672 let INFNORM_TRIANGLE = prove
7673  (`!x y. infnorm(x + y) <= infnorm x + infnorm y`,
7674   REWRITE_TAC[infnorm] THEN
7675   SIMP_TAC[REAL_SUP_LE_FINITE; INFNORM_SET_LEMMA] THEN
7676   ONCE_REWRITE_TAC[GSYM REAL_LE_SUB_RADD] THEN
7677   SIMP_TAC[REAL_LE_SUP_FINITE; INFNORM_SET_LEMMA] THEN
7678   ONCE_REWRITE_TAC[REAL_ARITH `x - y <= z <=> x - z <= y`] THEN
7679   SIMP_TAC[REAL_LE_SUP_FINITE; INFNORM_SET_LEMMA] THEN
7680   REWRITE_TAC[INFNORM_SET_IMAGE; FORALL_IN_IMAGE; EXISTS_IN_IMAGE] THEN
7681   SIMP_TAC[VECTOR_ADD_COMPONENT; GSYM IN_NUMSEG] THEN
7682   MESON_TAC[NUMSEG_DIMINDEX_NONEMPTY;
7683             REAL_ARITH `abs(x + y) - abs(x) <= abs(y)`]);;
7684
7685 let INFNORM_EQ_0 = prove
7686  (`!x. infnorm x = &0 <=> x = vec 0`,
7687   REWRITE_TAC[GSYM REAL_LE_ANTISYM; INFNORM_POS_LE] THEN
7688   SIMP_TAC[infnorm; REAL_SUP_LE_FINITE; INFNORM_SET_LEMMA] THEN
7689   SIMP_TAC[FORALL_IN_IMAGE; INFNORM_SET_IMAGE; CART_EQ; VEC_COMPONENT] THEN
7690   REWRITE_TAC[IN_NUMSEG; REAL_ARITH `abs(x) <= &0 <=> x = &0`]);;
7691
7692 let INFNORM_0 = prove
7693  (`infnorm(vec 0) = &0`,
7694   REWRITE_TAC[INFNORM_EQ_0]);;
7695
7696 let INFNORM_NEG = prove
7697  (`!x. infnorm(--x) = infnorm x`,
7698   GEN_TAC THEN REWRITE_TAC[infnorm] THEN AP_TERM_TAC THEN
7699   REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN
7700   MESON_TAC[REAL_ABS_NEG; VECTOR_NEG_COMPONENT]);;
7701
7702 let INFNORM_SUB = prove
7703  (`!x y. infnorm(x - y) = infnorm(y - x)`,
7704   MESON_TAC[INFNORM_NEG; VECTOR_NEG_SUB]);;
7705
7706 let REAL_ABS_SUB_INFNORM = prove
7707  (`abs(infnorm x - infnorm y) <= infnorm(x - y)`,
7708   MATCH_MP_TAC(REAL_ARITH
7709     `nx <= n + ny /\ ny <= n + nx ==> abs(nx - ny) <= n`) THEN
7710   MESON_TAC[INFNORM_SUB; VECTOR_SUB_ADD2; INFNORM_TRIANGLE; VECTOR_ADD_SYM]);;
7711
7712 let REAL_ABS_INFNORM = prove
7713  (`!x. abs(infnorm x) = infnorm x`,
7714   REWRITE_TAC[real_abs; INFNORM_POS_LE]);;
7715
7716 let COMPONENT_LE_INFNORM = prove
7717  (`!x:real^N i. 1 <= i /\ i <= dimindex (:N) ==> abs(x$i) <= infnorm x`,
7718   REPEAT GEN_TAC THEN REWRITE_TAC[infnorm] THEN
7719   MP_TAC(SPEC `{ abs((x:real^N)$i) | 1 <= i /\ i <= dimindex(:N) }`
7720               SUP_FINITE) THEN
7721   REWRITE_TAC[INFNORM_SET_LEMMA] THEN
7722   SIMP_TAC[INFNORM_SET_IMAGE; FORALL_IN_IMAGE; IN_NUMSEG]);;
7723
7724 let INFNORM_MUL_LEMMA = prove
7725  (`!a x. infnorm(a % x) <= abs a * infnorm x`,
7726   REPEAT STRIP_TAC THEN GEN_REWRITE_TAC LAND_CONV [infnorm] THEN
7727   SIMP_TAC[REAL_SUP_LE_FINITE; INFNORM_SET_LEMMA] THEN
7728   REWRITE_TAC[FORALL_IN_IMAGE; INFNORM_SET_IMAGE] THEN
7729   SIMP_TAC[REAL_ABS_MUL; VECTOR_MUL_COMPONENT; IN_NUMSEG] THEN
7730   SIMP_TAC[COMPONENT_LE_INFNORM; REAL_LE_LMUL; REAL_ABS_POS]);;
7731
7732 let INFNORM_MUL = prove
7733  (`!a x:real^N. infnorm(a % x) = abs a * infnorm x`,
7734   REPEAT GEN_TAC THEN ASM_CASES_TAC `a = &0` THEN
7735   ASM_REWRITE_TAC[VECTOR_MUL_LZERO; INFNORM_0; REAL_ABS_0; REAL_MUL_LZERO] THEN
7736   REWRITE_TAC[GSYM REAL_LE_ANTISYM; INFNORM_MUL_LEMMA] THEN
7737   GEN_REWRITE_TAC (LAND_CONV o funpow 2 RAND_CONV) [GSYM VECTOR_MUL_LID] THEN
7738   FIRST_ASSUM(SUBST1_TAC o SYM o MATCH_MP REAL_MUL_LINV) THEN
7739   REWRITE_TAC[GSYM VECTOR_MUL_ASSOC] THEN
7740   MATCH_MP_TAC REAL_LE_TRANS THEN
7741   EXISTS_TAC `abs(a) * abs(inv a) * infnorm(a % x:real^N)` THEN
7742   ASM_SIMP_TAC[INFNORM_MUL_LEMMA; REAL_LE_LMUL; REAL_ABS_POS] THEN
7743   ASM_SIMP_TAC[REAL_MUL_ASSOC; GSYM REAL_ABS_MUL; REAL_MUL_RINV] THEN
7744   REAL_ARITH_TAC);;
7745
7746 let INFNORM_POS_LT = prove
7747  (`!x. &0 < infnorm x <=> ~(x = vec 0)`,
7748   MESON_TAC[REAL_LT_LE; INFNORM_POS_LE; INFNORM_EQ_0]);;
7749
7750 (* ------------------------------------------------------------------------- *)
7751 (* Prove that it differs only up to a bound from Euclidean norm.             *)
7752 (* ------------------------------------------------------------------------- *)
7753
7754 let INFNORM_LE_NORM = prove
7755  (`!x. infnorm(x) <= norm(x)`,
7756   SIMP_TAC[infnorm; REAL_SUP_LE_FINITE; INFNORM_SET_LEMMA] THEN
7757   REWRITE_TAC[IN_ELIM_THM] THEN MESON_TAC[COMPONENT_LE_NORM]);;
7758
7759 let NORM_LE_INFNORM = prove
7760  (`!x:real^N. norm(x) <= sqrt(&(dimindex(:N))) * infnorm(x)`,
7761   GEN_TAC THEN GEN_REWRITE_TAC (RAND_CONV o LAND_CONV o funpow 2 RAND_CONV)
7762    [GSYM CARD_NUMSEG_1] THEN
7763   REWRITE_TAC[vector_norm] THEN MATCH_MP_TAC REAL_LE_LSQRT THEN
7764   SIMP_TAC[DOT_POS_LE; SQRT_POS_LE; REAL_POS; REAL_LE_MUL; INFNORM_POS_LE;
7765            SQRT_POW_2; REAL_POW_MUL] THEN
7766   REWRITE_TAC[dot] THEN MATCH_MP_TAC SUM_BOUND THEN
7767   REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN REPEAT STRIP_TAC THEN
7768   REWRITE_TAC[GSYM REAL_POW_2] THEN ONCE_REWRITE_TAC[GSYM REAL_POW2_ABS] THEN
7769   MATCH_MP_TAC REAL_POW_LE2 THEN REWRITE_TAC[REAL_ABS_POS] THEN
7770   MATCH_MP_TAC(REAL_ARITH `x <= y ==> x <= abs(y)`) THEN
7771   SIMP_TAC[infnorm; REAL_LE_SUP_FINITE; INFNORM_SET_LEMMA] THEN
7772   REWRITE_TAC[IN_ELIM_THM] THEN ASM_MESON_TAC[REAL_LE_REFL]);;
7773
7774 (* ------------------------------------------------------------------------- *)
7775 (* Equality in Cauchy-Schwarz and triangle inequalities.                     *)
7776 (* ------------------------------------------------------------------------- *)
7777
7778 let NORM_CAUCHY_SCHWARZ_EQ = prove
7779  (`!x:real^N y. x dot y = norm(x) * norm(y) <=> norm(x) % y = norm(y) % x`,
7780   REPEAT STRIP_TAC THEN
7781   MAP_EVERY ASM_CASES_TAC [`x:real^N = vec 0`; `y:real^N = vec 0`] THEN
7782   ASM_REWRITE_TAC[NORM_0; REAL_MUL_LZERO; REAL_MUL_RZERO;
7783     DOT_LZERO; DOT_RZERO; VECTOR_MUL_LZERO; VECTOR_MUL_RZERO] THEN
7784   MP_TAC(ISPEC `norm(y:real^N) % x - norm(x:real^N) % y` DOT_EQ_0) THEN
7785   REWRITE_TAC[DOT_RSUB; DOT_LSUB; DOT_LMUL; DOT_RMUL; GSYM NORM_POW_2;
7786               REAL_POW_2; VECTOR_SUB_EQ] THEN
7787   REWRITE_TAC[DOT_SYM; REAL_ARITH
7788    `y * (y * x * x - x * d) - x * (y * d - x * y * y) =
7789     &2 * x * y * (x * y - d)`] THEN
7790   ASM_SIMP_TAC[REAL_ENTIRE; NORM_EQ_0; REAL_SUB_0; REAL_OF_NUM_EQ; ARITH] THEN
7791   REWRITE_TAC[EQ_SYM_EQ]);;
7792
7793 let NORM_CAUCHY_SCHWARZ_ABS_EQ = prove
7794  (`!x:real^N y. abs(x dot y) = norm(x) * norm(y) <=>
7795                 norm(x) % y = norm(y) % x \/ norm(x) % y = --norm(y) % x`,
7796   SIMP_TAC[REAL_ARITH `&0 <= a ==> (abs x = a <=> x = a \/ --x = a)`;
7797            REAL_LE_MUL; NORM_POS_LE; GSYM DOT_RNEG] THEN
7798   REPEAT GEN_TAC THEN
7799   GEN_REWRITE_TAC (LAND_CONV o funpow 3 RAND_CONV) [GSYM NORM_NEG] THEN
7800   REWRITE_TAC[NORM_CAUCHY_SCHWARZ_EQ] THEN REWRITE_TAC[NORM_NEG] THEN
7801   BINOP_TAC THEN VECTOR_ARITH_TAC);;
7802
7803 let NORM_TRIANGLE_EQ = prove
7804  (`!x y:real^N. norm(x + y) = norm(x) + norm(y) <=> norm(x) % y = norm(y) % x`,
7805   REPEAT GEN_TAC THEN REWRITE_TAC[GSYM NORM_CAUCHY_SCHWARZ_EQ] THEN
7806   MATCH_MP_TAC EQ_TRANS THEN
7807   EXISTS_TAC `norm(x + y:real^N) pow 2 = (norm(x) + norm(y)) pow 2` THEN
7808   CONJ_TAC THENL
7809    [REWRITE_TAC[REAL_RING `x pow 2 = y pow 2 <=> x = y \/ x + y = &0`] THEN
7810     MAP_EVERY (MP_TAC o C ISPEC NORM_POS_LE)
7811      [`x + y:real^N`; `x:real^N`; `y:real^N`] THEN
7812     REAL_ARITH_TAC;
7813     REWRITE_TAC[NORM_POW_2; DOT_LADD; DOT_RADD; REAL_ARITH
7814      `(x + y) pow 2 = x pow 2 + y pow 2 + &2 * x * y`] THEN
7815     REWRITE_TAC[DOT_SYM] THEN REAL_ARITH_TAC]);;
7816
7817 let DIST_TRIANGLE_EQ = prove
7818  (`!x y z. dist(x,z) = dist(x,y) + dist(y,z) <=>
7819                 norm (x - y) % (y - z) = norm (y - z) % (x - y)`,
7820   REWRITE_TAC[GSYM NORM_TRIANGLE_EQ] THEN NORM_ARITH_TAC);;
7821
7822 let NORM_CROSS_MULTIPLY = prove
7823  (`!a b x y:real^N.
7824         a % x = b % y /\ &0 < a /\ &0 < b
7825         ==> norm y % x = norm x % y`,
7826   REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN
7827   ASM_CASES_TAC `y:real^N = vec 0` THEN
7828   ASM_SIMP_TAC[VECTOR_MUL_EQ_0; REAL_LT_IMP_NZ; VECTOR_MUL_RZERO] THEN
7829   DISCH_THEN(MP_TAC o AP_TERM `\x:real^N. inv(a) % x`) THEN
7830   ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LINV; REAL_LT_IMP_NZ; VECTOR_MUL_LID;
7831                NORM_MUL; REAL_ABS_MUL; REAL_ABS_INV] THEN
7832   ASM_SIMP_TAC[real_abs; REAL_LT_IMP_LE; REAL_MUL_AC]);;
7833
7834 (* ------------------------------------------------------------------------- *)
7835 (* Collinearity.                                                             *)
7836 (* ------------------------------------------------------------------------- *)
7837
7838 let collinear = new_definition
7839  `collinear s <=> ?u. !x y. x IN s /\ y IN s ==> ?c. x - y = c % u`;;
7840
7841 let COLLINEAR_SUBSET = prove
7842  (`!s t. collinear t /\ s SUBSET t ==> collinear s`,
7843   REWRITE_TAC[collinear] THEN SET_TAC[]);;
7844
7845 let COLLINEAR_EMPTY = prove
7846  (`collinear {}`,
7847   REWRITE_TAC[collinear; NOT_IN_EMPTY]);;
7848
7849 let COLLINEAR_SING = prove
7850  (`!x. collinear {x}`,
7851   SIMP_TAC[collinear; IN_SING; VECTOR_SUB_REFL] THEN
7852   MESON_TAC[VECTOR_MUL_LZERO]);;
7853
7854 let COLLINEAR_2 = prove
7855  (`!x y:real^N. collinear {x,y}`,
7856   REPEAT GEN_TAC THEN REWRITE_TAC[collinear; IN_INSERT; NOT_IN_EMPTY] THEN
7857   EXISTS_TAC `x - y:real^N` THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THENL
7858    [EXISTS_TAC `&0`; EXISTS_TAC `&1`; EXISTS_TAC `-- &1`; EXISTS_TAC `&0`] THEN
7859   VECTOR_ARITH_TAC);;
7860
7861 let COLLINEAR_SMALL = prove
7862  (`!s. FINITE s /\ CARD s <= 2 ==> collinear s`,
7863   REWRITE_TAC[ARITH_RULE `s <= 2 <=> s = 0 \/ s = 1 \/ s = 2`] THEN
7864   REWRITE_TAC[LEFT_OR_DISTRIB; GSYM HAS_SIZE] THEN
7865   CONV_TAC(ONCE_DEPTH_CONV HAS_SIZE_CONV) THEN
7866   REPEAT STRIP_TAC THEN
7867   ASM_REWRITE_TAC[COLLINEAR_EMPTY; COLLINEAR_SING; COLLINEAR_2]);;
7868
7869 let COLLINEAR_3 = prove
7870  (`!x y z. collinear {x,y,z} <=> collinear {vec 0,x - y,z - y}`,
7871   REPEAT GEN_TAC THEN
7872   REWRITE_TAC[collinear; FORALL_IN_INSERT; IMP_CONJ; RIGHT_FORALL_IMP_THM;
7873               NOT_IN_EMPTY] THEN
7874   AP_TERM_TAC THEN ABS_TAC THEN
7875   MESON_TAC[VECTOR_ARITH `x - y = (x - y) - vec 0`;
7876             VECTOR_ARITH `y - x = vec 0 - (x - y)`;
7877             VECTOR_ARITH `x - z:real^N = (x - y) - (z - y)`]);;
7878
7879 let COLLINEAR_LEMMA = prove
7880  (`!x y:real^N. collinear {vec 0,x,y} <=>
7881                    x = vec 0 \/ y = vec 0 \/ ?c. y = c % x`,
7882   REPEAT GEN_TAC THEN
7883   MAP_EVERY ASM_CASES_TAC [`x:real^N = vec 0`; `y:real^N = vec 0`] THEN
7884   TRY(ASM_REWRITE_TAC[INSERT_AC; COLLINEAR_SING; COLLINEAR_2] THEN NO_TAC) THEN
7885   ASM_REWRITE_TAC[collinear] THEN EQ_TAC THENL
7886    [DISCH_THEN(X_CHOOSE_THEN `u:real^N`
7887      (fun th -> MP_TAC(SPECL [`x:real^N`; `vec 0:real^N`] th) THEN
7888                 MP_TAC(SPECL [`y:real^N`; `vec 0:real^N`] th))) THEN
7889     REWRITE_TAC[IN_INSERT; VECTOR_SUB_RZERO] THEN
7890     DISCH_THEN(X_CHOOSE_THEN `e:real` SUBST_ALL_TAC) THEN
7891     DISCH_THEN(X_CHOOSE_THEN `d:real` SUBST_ALL_TAC) THEN
7892     EXISTS_TAC `e / d` THEN REWRITE_TAC[VECTOR_MUL_ASSOC] THEN
7893     RULE_ASSUM_TAC(REWRITE_RULE[VECTOR_MUL_EQ_0; DE_MORGAN_THM]) THEN
7894     ASM_SIMP_TAC[REAL_DIV_RMUL];
7895     STRIP_TAC THEN EXISTS_TAC `x:real^N` THEN ASM_REWRITE_TAC[] THEN
7896     REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] THEN REPEAT STRIP_TAC THEN
7897     ASM_REWRITE_TAC[] THENL
7898      [EXISTS_TAC `&0`; EXISTS_TAC `-- &1`; EXISTS_TAC `--c`;
7899       EXISTS_TAC `&1`; EXISTS_TAC `&0`; EXISTS_TAC `&1 - c`;
7900       EXISTS_TAC `c:real`; EXISTS_TAC `c - &1`; EXISTS_TAC `&0`] THEN
7901     VECTOR_ARITH_TAC]);;
7902
7903 let COLLINEAR_LEMMA_ALT = prove
7904  (`!x y. collinear {vec 0,x,y} <=> x = vec 0 \/ ?c. y = c % x`,
7905   REWRITE_TAC[COLLINEAR_LEMMA] THEN MESON_TAC[VECTOR_MUL_LZERO]);;
7906
7907 let NORM_CAUCHY_SCHWARZ_EQUAL = prove
7908  (`!x y:real^N. abs(x dot y) = norm(x) * norm(y) <=> collinear {vec 0,x,y}`,
7909   REPEAT GEN_TAC THEN REWRITE_TAC[NORM_CAUCHY_SCHWARZ_ABS_EQ] THEN
7910   MAP_EVERY ASM_CASES_TAC [`x:real^N = vec 0`; `y:real^N = vec 0`] THEN
7911   TRY(ASM_REWRITE_TAC[INSERT_AC; COLLINEAR_SING; COLLINEAR_2; NORM_0;
7912                       VECTOR_MUL_LZERO; VECTOR_MUL_RZERO] THEN NO_TAC) THEN
7913   ASM_REWRITE_TAC[COLLINEAR_LEMMA] THEN EQ_TAC THENL
7914    [STRIP_TAC THENL
7915      [FIRST_X_ASSUM(MP_TAC o AP_TERM
7916        `(%) (inv(norm(x:real^N))):real^N->real^N`);
7917       FIRST_X_ASSUM(MP_TAC o AP_TERM
7918        `(%) (--inv(norm(x:real^N))):real^N->real^N`)] THEN
7919     ASM_REWRITE_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LNEG] THEN
7920     ASM_SIMP_TAC[REAL_MUL_LINV; NORM_EQ_0; VECTOR_MUL_LNEG; VECTOR_MUL_LID;
7921                  VECTOR_ARITH `--x = --y <=> x:real^N = y`] THEN
7922     MESON_TAC[];
7923     STRIP_TAC THEN ASM_REWRITE_TAC[NORM_MUL; VECTOR_MUL_ASSOC] THEN
7924     MATCH_MP_TAC(MESON[]
7925       `t = a \/ t = b ==> t % x = a % x \/ t % x = b % x`) THEN
7926     REWRITE_TAC[GSYM REAL_MUL_LNEG;
7927                 REAL_ARITH `x * c = d * x <=> x * (c - d) = &0`] THEN
7928     ASM_REWRITE_TAC[REAL_ENTIRE; NORM_EQ_0] THEN REAL_ARITH_TAC]);;
7929
7930 let DOT_CAUCHY_SCHWARZ_EQUAL = prove
7931  (`!x y:real^N.
7932         (x dot y) pow 2 = (x dot x) * (y dot y) <=>
7933         collinear {vec 0,x,y}`,
7934   REWRITE_TAC[GSYM NORM_CAUCHY_SCHWARZ_EQUAL] THEN
7935   REPEAT GEN_TAC THEN MATCH_MP_TAC(REAL_ARITH
7936    `&0 <= y /\ (u:real = v <=> x = abs y) ==> (u = v <=> x = y)`) THEN
7937   SIMP_TAC[NORM_POS_LE; REAL_LE_MUL] THEN
7938   REWRITE_TAC[REAL_EQ_SQUARE_ABS] THEN REWRITE_TAC[REAL_POW_MUL; NORM_POW_2]);;
7939
7940 let COLLINEAR_3_EXPAND = prove
7941  (`!a b c:real^N. collinear{a,b,c} <=> a = c \/ ?u. b = u % a + (&1 - u) % c`,
7942   REPEAT GEN_TAC THEN
7943   ONCE_REWRITE_TAC[SET_RULE `{a,b,c} = {a,c,b}`] THEN
7944   ONCE_REWRITE_TAC[COLLINEAR_3] THEN
7945   REWRITE_TAC[COLLINEAR_LEMMA; VECTOR_SUB_EQ] THEN
7946   ASM_CASES_TAC `a:real^N = c` THEN ASM_REWRITE_TAC[] THEN
7947   ASM_CASES_TAC `b:real^N = c` THEN
7948   ASM_REWRITE_TAC[VECTOR_ARITH `u % c + (&1 - u) % c = c`] THENL
7949    [EXISTS_TAC `&0` THEN VECTOR_ARITH_TAC;
7950     AP_TERM_TAC THEN ABS_TAC THEN VECTOR_ARITH_TAC]);;
7951
7952 let COLLINEAR_TRIPLES = prove
7953  (`!s a b:real^N.
7954         ~(a = b)
7955         ==> (collinear(a INSERT b INSERT s) <=>
7956              !x. x IN s ==> collinear{a,b,x})`,
7957   REPEAT STRIP_TAC THEN EQ_TAC THENL
7958    [REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
7959      (REWRITE_RULE[IMP_CONJ] COLLINEAR_SUBSET)) THEN
7960     ASM SET_TAC[];
7961     ONCE_REWRITE_TAC[SET_RULE `{a,b,x} = {a,x,b}`] THEN
7962     ASM_REWRITE_TAC[COLLINEAR_3_EXPAND] THEN DISCH_TAC THEN
7963     SUBGOAL_THEN
7964      `!x:real^N. x IN (a INSERT b INSERT s) ==> ?u. x = u % a + (&1 - u) % b`
7965     MP_TAC THENL
7966      [ASM_REWRITE_TAC[FORALL_IN_INSERT] THEN CONJ_TAC THENL
7967        [EXISTS_TAC `&1` THEN VECTOR_ARITH_TAC;
7968         EXISTS_TAC `&0` THEN VECTOR_ARITH_TAC];
7969       POP_ASSUM_LIST(K ALL_TAC) THEN DISCH_TAC THEN
7970       REWRITE_TAC[collinear] THEN EXISTS_TAC `b - a:real^N` THEN
7971       MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN STRIP_TAC THEN
7972       FIRST_X_ASSUM(fun th -> MP_TAC(SPEC `x:real^N` th) THEN MP_TAC(SPEC
7973         `y:real^N` th)) THEN
7974       ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN
7975       ASM_REWRITE_TAC[VECTOR_ARITH
7976        `(u % a + (&1 - u) % b) - (v % a + (&1 - v) % b):real^N =
7977         (v - u) % (b - a)`] THEN
7978       MESON_TAC[]]]);;
7979
7980 let COLLINEAR_4_3 = prove
7981  (`!a b c d:real^N.
7982         ~(a = b)
7983         ==> (collinear {a,b,c,d} <=> collinear{a,b,c} /\ collinear{a,b,d})`,
7984   REPEAT STRIP_TAC THEN
7985   MP_TAC(ISPECL [`{c:real^N,d}`; `a:real^N`; `b:real^N`]
7986     COLLINEAR_TRIPLES) THEN
7987   ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN
7988   REWRITE_TAC[FORALL_IN_INSERT; NOT_IN_EMPTY]);;
7989
7990 let COLLINEAR_3_TRANS = prove
7991  (`!a b c d:real^N.
7992         collinear{a,b,c} /\ collinear{b,c,d} /\ ~(b = c) ==> collinear{a,b,d}`,
7993   REPEAT STRIP_TAC THEN MATCH_MP_TAC COLLINEAR_SUBSET THEN
7994   EXISTS_TAC `{b:real^N,c,a,d}` THEN ASM_SIMP_TAC[COLLINEAR_4_3] THEN
7995   CONJ_TAC THENL [ALL_TAC; SET_TAC[]] THEN
7996   REPEAT(POP_ASSUM MP_TAC) THEN SIMP_TAC[INSERT_AC]);;
7997
7998 let ORTHOGONAL_TO_ORTHOGONAL_2D = prove
7999  (`!x y z:real^2.
8000      ~(x = vec 0) /\ orthogonal x y /\ orthogonal x z
8001      ==> collinear {vec 0,y,z}`,
8002   REWRITE_TAC[orthogonal; GSYM DOT_CAUCHY_SCHWARZ_EQUAL; GSYM DOT_EQ_0] THEN
8003   REWRITE_TAC[DOT_2] THEN CONV_TAC REAL_RING);;
8004
8005 let COLLINEAR_3_2D = prove
8006  (`!x y z:real^2. collinear{x,y,z} <=>
8007                   (z$1 - x$1) * (y$2 - x$2) = (y$1 - x$1) * (z$2 - x$2)`,
8008   ONCE_REWRITE_TAC[COLLINEAR_3] THEN
8009   REWRITE_TAC[GSYM DOT_CAUCHY_SCHWARZ_EQUAL] THEN
8010   REWRITE_TAC[DOT_2; VECTOR_SUB_COMPONENT] THEN CONV_TAC REAL_RING);;
8011
8012 let COLLINEAR_3_DOT_MULTIPLES = prove
8013  (`!a b c:real^N.
8014         collinear {a,b,c} <=>
8015         ((b - a) dot (b - a)) % (c - a) = ((c - a) dot (b - a)) % (b - a)`,
8016   REWRITE_TAC[VECTOR_SUB_RZERO] THEN
8017   REPEAT GEN_TAC THEN ASM_CASES_TAC `b:real^N = a` THENL
8018    [ASM_REWRITE_TAC[COLLINEAR_2; INSERT_AC; DOT_RZERO; VECTOR_MUL_LZERO;
8019                     VECTOR_SUB_REFL];
8020     ONCE_REWRITE_TAC[COLLINEAR_3] THEN
8021     POP_ASSUM MP_TAC THEN ONCE_REWRITE_TAC[GSYM VECTOR_SUB_EQ] THEN
8022     REWRITE_TAC[GSYM DOT_CAUCHY_SCHWARZ_EQUAL; GSYM DOT_EQ_0] THEN
8023     REWRITE_TAC[GSYM DOT_EQ_0; DOT_RSUB; DOT_LSUB; DOT_RMUL; DOT_LMUL] THEN
8024     REWRITE_TAC[DOT_SYM] THEN CONV_TAC REAL_RING]);;
8025
8026 (* ------------------------------------------------------------------------- *)
8027 (* Between-ness.                                                             *)
8028 (* ------------------------------------------------------------------------- *)
8029
8030 let between = new_definition
8031  `between x (a,b) <=> dist(a,b) = dist(a,x) + dist(x,b)`;;
8032
8033 let BETWEEN_REFL = prove
8034  (`!a b. between a (a,b) /\ between b (a,b) /\ between a (a,a)`,
8035   REWRITE_TAC[between] THEN NORM_ARITH_TAC);;
8036
8037 let BETWEEN_REFL_EQ = prove
8038  (`!a x. between x (a,a) <=> x = a`,
8039   REWRITE_TAC[between] THEN NORM_ARITH_TAC);;
8040
8041 let BETWEEN_SYM = prove
8042  (`!a b x. between x (a,b) <=> between x (b,a)`,
8043   REWRITE_TAC[between] THEN NORM_ARITH_TAC);;
8044
8045 let BETWEEN_ANTISYM = prove
8046  (`!a b c. between a (b,c) /\ between b (a,c) ==> a = b`,
8047   REWRITE_TAC[between; DIST_SYM] THEN NORM_ARITH_TAC);;
8048
8049 let BETWEEN_TRANS = prove
8050  (`!a b c d. between a (b,c) /\ between d (a,c) ==> between d (b,c)`,
8051   REWRITE_TAC[between; DIST_SYM] THEN NORM_ARITH_TAC);;
8052
8053 let BETWEEN_TRANS_2 = prove
8054  (`!a b c d. between a (b,c) /\ between d (a,b) ==> between a (c,d)`,
8055   REWRITE_TAC[between; DIST_SYM] THEN NORM_ARITH_TAC);;
8056
8057 let BETWEEN_NORM = prove
8058  (`!a b x:real^N.
8059      between x (a,b) <=> norm(x - a) % (b - x) = norm(b - x) % (x - a)`,
8060   REPEAT GEN_TAC THEN REWRITE_TAC[between; DIST_TRIANGLE_EQ] THEN
8061   REWRITE_TAC[NORM_SUB] THEN VECTOR_ARITH_TAC);;
8062
8063 let BETWEEN_DOT = prove
8064  (`!a b x:real^N.
8065      between x (a,b) <=> (x - a) dot (b - x) = norm(x - a) * norm(b - x)`,
8066   REWRITE_TAC[BETWEEN_NORM; NORM_CAUCHY_SCHWARZ_EQ]);;
8067
8068 let BETWEEN_EXISTS_EXTENSION = prove
8069  (`!a b x:real^N.
8070         between b (a,x) /\ ~(b = a) ==> ?d. &0 <= d /\ x = b + d % (b - a)`,
8071   REPEAT GEN_TAC THEN REWRITE_TAC[BETWEEN_NORM] THEN STRIP_TAC THEN
8072   EXISTS_TAC `norm(x - b:real^N) / norm(b - a)` THEN
8073   SIMP_TAC[REAL_LE_DIV; NORM_POS_LE] THEN FIRST_X_ASSUM
8074    (MP_TAC o AP_TERM `(%) (inv(norm(b - a:real^N))):real^N->real^N`) THEN
8075   ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LINV; NORM_EQ_0; VECTOR_SUB_EQ] THEN
8076   VECTOR_ARITH_TAC);;
8077
8078 let BETWEEN_IMP_COLLINEAR = prove
8079  (`!a b x:real^N. between x (a,b) ==> collinear {a,x,b}`,
8080   REPEAT GEN_TAC THEN MAP_EVERY
8081    (fun t -> ASM_CASES_TAC t THEN
8082              TRY(ASM_REWRITE_TAC[INSERT_AC; COLLINEAR_2] THEN NO_TAC))
8083    [`x:real^N = a`; `x:real^N = b`; `a:real^N = b`] THEN
8084   ONCE_REWRITE_TAC[COLLINEAR_3; BETWEEN_NORM] THEN
8085   DISCH_TAC THEN REWRITE_TAC[COLLINEAR_LEMMA] THEN
8086   REPEAT DISJ2_TAC THEN EXISTS_TAC `--(norm(b - x:real^N) / norm(x - a))` THEN
8087   MATCH_MP_TAC VECTOR_MUL_LCANCEL_IMP THEN EXISTS_TAC `norm(x - a:real^N)` THEN
8088   ASM_REWRITE_TAC[VECTOR_MUL_ASSOC; REAL_MUL_RNEG] THEN
8089   ASM_SIMP_TAC[REAL_DIV_LMUL; NORM_EQ_0; VECTOR_SUB_EQ] THEN
8090   VECTOR_ARITH_TAC);;
8091
8092 let COLLINEAR_BETWEEN_CASES = prove
8093  (`!a b c:real^N.
8094         collinear {a,b,c} <=>
8095         between a (b,c) \/ between b (c,a) \/ between c (a,b)`,
8096   REPEAT STRIP_TAC THEN EQ_TAC THENL
8097    [REWRITE_TAC[COLLINEAR_3_EXPAND] THEN
8098     ASM_CASES_TAC `c:real^N = a` THEN ASM_REWRITE_TAC[BETWEEN_REFL] THEN
8099     STRIP_TAC THEN ASM_REWRITE_TAC[between; dist] THEN
8100     REWRITE_TAC[VECTOR_ARITH `(u % a + (&1 - u) % c) - c = --u % (c - a)`;
8101       VECTOR_ARITH `(u % a + (&1 - u) % c) - a = (&1 - u) % (c - a)`;
8102       VECTOR_ARITH `c - (u % a + (&1 - u) % c) = u % (c - a)`;
8103       VECTOR_ARITH `a - (u % a + (&1 - u) % c) = (u - &1) % (c - a)`] THEN
8104     REWRITE_TAC[NORM_MUL] THEN
8105     SUBST1_TAC(NORM_ARITH `norm(a - c:real^N) = norm(c - a)`) THEN
8106     REWRITE_TAC[REAL_ARITH `a * c + c = (a + &1) * c`; GSYM REAL_ADD_RDISTRIB;
8107                 REAL_ARITH `c + a * c = (a + &1) * c`] THEN
8108     ASM_REWRITE_TAC[REAL_EQ_MUL_RCANCEL;
8109                     REAL_RING `n = x * n <=> n = &0 \/ x = &1`] THEN
8110     ASM_REWRITE_TAC[NORM_EQ_0; VECTOR_SUB_EQ] THEN REAL_ARITH_TAC;
8111     DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN (MP_TAC o MATCH_MP
8112       BETWEEN_IMP_COLLINEAR)) THEN
8113     REWRITE_TAC[INSERT_AC]]);;
8114
8115 let COLLINEAR_DIST_BETWEEN = prove
8116  (`!a b x. collinear {x,a,b} /\
8117            dist(x,a) <= dist(a,b) /\ dist(x,b) <= dist(a,b)
8118            ==> between x (a,b)`,
8119   SIMP_TAC[COLLINEAR_BETWEEN_CASES; between; DIST_SYM] THEN NORM_ARITH_TAC);;
8120
8121 let BETWEEN_COLLINEAR_DIST_EQ = prove
8122  (`!a b x:real^N.
8123         between x (a,b) <=>
8124         collinear {a, x, b} /\
8125         dist(x,a) <= dist(a,b) /\ dist(x,b) <= dist(a,b)`,
8126   REPEAT GEN_TAC THEN EQ_TAC THENL
8127    [SIMP_TAC[BETWEEN_IMP_COLLINEAR] THEN REWRITE_TAC[between] THEN
8128     NORM_ARITH_TAC;
8129     MESON_TAC[COLLINEAR_DIST_BETWEEN; INSERT_AC]]);;
8130
8131 let COLLINEAR_1 = prove
8132  (`!s:real^1->bool. collinear s`,
8133   GEN_TAC THEN MATCH_MP_TAC COLLINEAR_SUBSET THEN
8134   EXISTS_TAC `(vec 0:real^1) INSERT (vec 1) INSERT s` THEN
8135   CONJ_TAC THENL [ALL_TAC; SET_TAC[]] THEN
8136   W(MP_TAC o PART_MATCH (lhs o rand) COLLINEAR_TRIPLES o snd) THEN
8137   REWRITE_TAC[VEC_EQ; ARITH_EQ] THEN DISCH_THEN SUBST1_TAC THEN
8138   REWRITE_TAC[COLLINEAR_BETWEEN_CASES] THEN
8139   REWRITE_TAC[between; DIST_REAL; GSYM drop; DROP_VEC; REAL_ABS_NUM] THEN
8140   REAL_ARITH_TAC);;
8141
8142 (* ------------------------------------------------------------------------- *)
8143 (* Midpoint between two points.                                              *)
8144 (* ------------------------------------------------------------------------- *)
8145
8146 let midpoint = new_definition
8147  `midpoint(a,b) = inv(&2) % (a + b)`;;
8148
8149 let MIDPOINT_REFL = prove
8150  (`!x. midpoint(x,x) = x`,
8151   REWRITE_TAC[midpoint] THEN VECTOR_ARITH_TAC);;
8152
8153 let MIDPOINT_SYM = prove
8154  (`!a b. midpoint(a,b) = midpoint(b,a)`,
8155   REWRITE_TAC[midpoint; VECTOR_ADD_SYM]);;
8156
8157 let DIST_MIDPOINT = prove
8158  (`!a b. dist(a,midpoint(a,b)) = dist(a,b) / &2 /\
8159          dist(b,midpoint(a,b)) = dist(a,b) / &2 /\
8160          dist(midpoint(a,b),a) = dist(a,b) / &2 /\
8161          dist(midpoint(a,b),b) = dist(a,b) / &2`,
8162   REWRITE_TAC[midpoint] THEN NORM_ARITH_TAC);;
8163
8164 let MIDPOINT_EQ_ENDPOINT = prove
8165  (`!a b. (midpoint(a,b) = a <=> a = b) /\
8166          (midpoint(a,b) = b <=> a = b) /\
8167          (a = midpoint(a,b) <=> a = b) /\
8168          (b = midpoint(a,b) <=> a = b)`,
8169   REWRITE_TAC[midpoint] THEN NORM_ARITH_TAC);;
8170
8171 let BETWEEN_MIDPOINT = prove
8172  (`!a b. between (midpoint(a,b)) (a,b) /\ between (midpoint(a,b)) (b,a)`,
8173   REWRITE_TAC[between; midpoint] THEN NORM_ARITH_TAC);;
8174
8175 let MIDPOINT_LINEAR_IMAGE = prove
8176  (`!f a b. linear f ==> midpoint(f a,f b) = f(midpoint(a,b))`,
8177   SIMP_TAC[midpoint; LINEAR_ADD; LINEAR_CMUL]);;
8178
8179 let COLLINEAR_MIDPOINT = prove
8180  (`!a b. collinear{a,midpoint(a,b),b}`,
8181   REPEAT GEN_TAC THEN REWRITE_TAC[COLLINEAR_3_EXPAND; midpoint] THEN
8182   DISJ2_TAC THEN EXISTS_TAC `&1 / &2` THEN VECTOR_ARITH_TAC);;
8183
8184 let MIDPOINT_COLLINEAR = prove
8185  (`!a b c:real^N.
8186         ~(a = c)
8187         ==> (b = midpoint(a,c) <=> collinear{a,b,c} /\ dist(a,b) = dist(b,c))`,
8188   REPEAT STRIP_TAC THEN
8189   MATCH_MP_TAC(TAUT `(a ==> b) /\ (b ==> (a <=> c)) ==> (a <=> b /\ c)`) THEN
8190   SIMP_TAC[COLLINEAR_MIDPOINT] THEN ASM_REWRITE_TAC[COLLINEAR_3_EXPAND] THEN
8191   STRIP_TAC THEN ASM_REWRITE_TAC[midpoint; dist] THEN
8192   REWRITE_TAC
8193    [VECTOR_ARITH `a - (u % a + (&1 - u) % c) = (&1 - u) % (a - c)`;
8194     VECTOR_ARITH `(u % a + (&1 - u) % c) - c = u % (a - c)`;
8195     VECTOR_ARITH `u % a + (&1 - u) % c = inv (&2) % (a + c) <=>
8196                   (u - &1 / &2) % (a - c) = vec 0`] THEN
8197   ASM_SIMP_TAC[NORM_MUL; REAL_EQ_MUL_RCANCEL; NORM_EQ_0; VECTOR_SUB_EQ;
8198                VECTOR_MUL_EQ_0] THEN
8199   REAL_ARITH_TAC);;
8200
8201 let MIDPOINT_BETWEEN = prove
8202  (`!a b c:real^N.
8203         b = midpoint (a,c) <=> between b (a,c) /\ dist (a,b) = dist (b,c)`,
8204   REPEAT GEN_TAC THEN ASM_CASES_TAC `a:real^N = c` THENL
8205    [ASM_SIMP_TAC[BETWEEN_REFL_EQ; MIDPOINT_REFL; DIST_SYM]; ALL_TAC] THEN
8206   EQ_TAC THEN SIMP_TAC[BETWEEN_MIDPOINT; DIST_MIDPOINT] THEN
8207   ASM_MESON_TAC[MIDPOINT_COLLINEAR; BETWEEN_IMP_COLLINEAR]);;
8208
8209 (* ------------------------------------------------------------------------- *)
8210 (* General "one way" lemma for properties preserved by injective map.        *)
8211 (* ------------------------------------------------------------------------- *)
8212
8213 let WLOG_LINEAR_INJECTIVE_IMAGE_2 = prove
8214  (`!P Q. (!f s. P s /\ linear f ==> Q(IMAGE f s)) /\
8215          (!g t. Q t /\ linear g ==> P(IMAGE g t))
8216          ==> !f:real^M->real^N.
8217                 linear f /\ (!x y. f x = f y ==> x = y)
8218                 ==> !s. Q(IMAGE f s) <=> P s`,
8219   REPEAT STRIP_TAC THEN EQ_TAC THEN ASM_SIMP_TAC[] THEN DISCH_TAC THEN
8220   MP_TAC(ISPEC `f:real^M->real^N` LINEAR_INJECTIVE_LEFT_INVERSE) THEN
8221   ASM_REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM] THEN
8222   DISCH_THEN(X_CHOOSE_THEN `g:real^N->real^M` STRIP_ASSUME_TAC) THEN
8223   FIRST_X_ASSUM(MP_TAC o SPECL
8224    [`g:real^N->real^M`; `IMAGE (f:real^M->real^N) s`]) THEN
8225   ASM_REWRITE_TAC[GSYM IMAGE_o; o_DEF; IMAGE_ID]);;
8226
8227 let WLOG_LINEAR_INJECTIVE_IMAGE_2_ALT = prove
8228  (`!P Q f s. (!h u. P u /\ linear h ==> Q(IMAGE h u)) /\
8229              (!g t. Q t /\ linear g ==> P(IMAGE g t)) /\
8230              linear f /\ (!x y. f x = f y ==> x = y)
8231              ==> (Q(IMAGE f s) <=> P s)`,
8232   REPEAT GEN_TAC THEN STRIP_TAC THEN
8233   MATCH_MP_TAC(REWRITE_RULE[RIGHT_IMP_FORALL_THM; IMP_IMP]
8234      WLOG_LINEAR_INJECTIVE_IMAGE_2) THEN
8235   ASM_REWRITE_TAC[]);;
8236
8237 let WLOG_LINEAR_INJECTIVE_IMAGE = prove
8238  (`!P. (!f s. P s /\ linear f ==> P(IMAGE f s))
8239        ==> !f:real^N->real^N. linear f /\ (!x y. f x = f y ==> x = y)
8240                               ==> !s. P(IMAGE f s) <=> P s`,
8241   GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC WLOG_LINEAR_INJECTIVE_IMAGE_2 THEN
8242   ASM_REWRITE_TAC[]);;
8243
8244 let WLOG_LINEAR_INJECTIVE_IMAGE_ALT = prove
8245  (`!P f s. (!g t. P t /\ linear g ==> P(IMAGE g t)) /\
8246            linear f /\ (!x y. f x = f y ==> x = y)
8247            ==> (P(IMAGE f s) <=> P s)`,
8248   REPEAT GEN_TAC THEN STRIP_TAC THEN
8249   MATCH_MP_TAC(REWRITE_RULE[RIGHT_IMP_FORALL_THM; IMP_IMP]
8250      WLOG_LINEAR_INJECTIVE_IMAGE) THEN
8251   ASM_REWRITE_TAC[]);;
8252
8253 (* ------------------------------------------------------------------------- *)
8254 (* Inference rule to apply it conveniently.                                  *)
8255 (*                                                                           *)
8256 (*   |- !f s. P s /\ linear f ==> P(IMAGE f s)  [or /\ commuted]             *)
8257 (* ---------------------------------------------------------------           *)
8258 (*   |- !f s. linear f /\ (!x y. f x = f y ==> x = y)                        *)
8259 (*            ==> (Q(IMAGE f s) <=> P s)                                     *)
8260 (* ------------------------------------------------------------------------- *)
8261
8262 let LINEAR_INVARIANT_RULE th =
8263   let [f;s] = fst(strip_forall(concl th)) in
8264   let (rm,rn) = dest_fun_ty (type_of f) in
8265   let m = last(snd(dest_type rm)) and n = last(snd(dest_type rn)) in
8266   let th' = INST_TYPE [m,n; n,m] th in
8267   let th0 = CONJ th th' in
8268   let th1 = try MATCH_MP WLOG_LINEAR_INJECTIVE_IMAGE_2 th0
8269             with Failure _ ->
8270                 MATCH_MP WLOG_LINEAR_INJECTIVE_IMAGE_2
8271             (GEN_REWRITE_RULE (BINOP_CONV o ONCE_DEPTH_CONV) [CONJ_SYM] th0) in
8272   GEN_REWRITE_RULE BINDER_CONV [RIGHT_IMP_FORALL_THM] th1;;
8273
8274 (* ------------------------------------------------------------------------- *)
8275 (* Immediate application.                                                    *)
8276 (* ------------------------------------------------------------------------- *)
8277
8278 let SUBSPACE_LINEAR_IMAGE_EQ = prove
8279  (`!f s. linear f /\ (!x y. f x = f y ==> x = y)
8280          ==> (subspace (IMAGE f s) <=> subspace s)`,
8281   MATCH_ACCEPT_TAC(LINEAR_INVARIANT_RULE SUBSPACE_LINEAR_IMAGE));;
8282
8283 (* ------------------------------------------------------------------------- *)
8284 (* Storage of useful "invariance under linear map / translation" theorems.   *)
8285 (* ------------------------------------------------------------------------- *)
8286
8287 let invariant_under_linear = ref([]:thm list);;
8288
8289 let invariant_under_translation = ref([]:thm list);;
8290
8291 let scaling_theorems = ref([]:thm list);;
8292
8293 (* ------------------------------------------------------------------------- *)
8294 (* Scaling theorems and derivation from linear invariance.                   *)
8295 (* ------------------------------------------------------------------------- *)
8296
8297 let LINEAR_SCALING = prove
8298  (`!c. linear(\x:real^N. c % x)`,
8299   REWRITE_TAC[linear] THEN VECTOR_ARITH_TAC);;
8300
8301 let INJECTIVE_SCALING = prove
8302  (`!c. (!x y:real^N. c % x = c % y ==> x = y) <=> ~(c = &0)`,
8303   GEN_TAC THEN REWRITE_TAC[VECTOR_MUL_LCANCEL] THEN
8304   ASM_CASES_TAC `c:real = &0` THEN ASM_REWRITE_TAC[] THEN
8305   DISCH_THEN(MP_TAC o SPECL [`vec 0:real^N`; `vec 1:real^N`]) THEN
8306   REWRITE_TAC[VEC_EQ; ARITH]);;
8307
8308 let SURJECTIVE_SCALING = prove
8309  (`!c. (!y:real^N. ?x. c % x = y) <=> ~(c = &0)`,
8310   ASM_SIMP_TAC[LINEAR_SURJECTIVE_IFF_INJECTIVE; LINEAR_SCALING] THEN
8311   REWRITE_TAC[INJECTIVE_SCALING]);;
8312
8313 let SCALING_INVARIANT =
8314   let pths = (CONJUNCTS o UNDISCH o prove)
8315    (`&0 < c
8316      ==> linear(\x:real^N. c % x) /\
8317          (!x y:real^N. c % x = c % y ==> x = y) /\
8318          (!y:real^N. ?x. c % x = y)`,
8319     SIMP_TAC[REAL_LT_IMP_NZ; LINEAR_SCALING;
8320              INJECTIVE_SCALING; SURJECTIVE_SCALING])
8321   and sc_tm = `\x:real^N. c % x`
8322   and sa_tm = `&0:real < c`
8323   and c_tm = `c:real` in
8324   fun th ->
8325     let ith = BETA_RULE(ISPEC sc_tm th) in
8326     let avs,bod = strip_forall(concl ith) in
8327     let cjs = conjuncts(lhand bod) in
8328     let cths = map (fun t -> find(fun th -> aconv (concl th) t) pths) cjs in
8329     let oth = MP (SPECL avs ith) (end_itlist CONJ cths) in
8330     GEN c_tm (DISCH sa_tm (GENL avs oth));;
8331
8332 let scaling_theorems = ref([]:thm list);;
8333
8334 (* ------------------------------------------------------------------------- *)
8335 (* Augmentation of the lists. The "add_linear_invariants" also updates       *)
8336 (* the scaling theorems automatically, so only a few of those will need      *)
8337 (* to be added explicitly.                                                   *)
8338 (* ------------------------------------------------------------------------- *)
8339
8340 let add_scaling_theorems thl =
8341   (scaling_theorems := (!scaling_theorems) @ thl);;
8342
8343 let add_linear_invariants thl =
8344   ignore(mapfilter (fun th -> add_scaling_theorems[SCALING_INVARIANT th]) thl);
8345   (invariant_under_linear := (!invariant_under_linear) @ thl);;
8346
8347 let add_translation_invariants thl =
8348  (invariant_under_translation := (!invariant_under_translation) @ thl);;
8349
8350 (* ------------------------------------------------------------------------- *)
8351 (* Start with some basic set equivalences.                                   *)
8352 (* We give them all an injectivity hypothesis even if it's not necessary.    *)
8353 (* For just the intersection theorem we add surjectivity (more manageable    *)
8354 (* than assuming that the set isn't empty).                                  *)
8355 (* ------------------------------------------------------------------------- *)
8356
8357 let th_sets = prove
8358  (`!f. (!x y. f x = f y ==> x = y)
8359        ==> (if p then f x else f y) = f(if p then x else y) /\
8360            (if p then IMAGE f s else IMAGE f t) =
8361            IMAGE f (if p then s else t) /\
8362            (f x) INSERT (IMAGE f s) = IMAGE f (x INSERT s) /\
8363            (IMAGE f s) DELETE (f x) = IMAGE f (s DELETE x) /\
8364            (IMAGE f s) INTER (IMAGE f t) = IMAGE f (s INTER t) /\
8365            (IMAGE f s) UNION (IMAGE f t) = IMAGE f (s UNION t) /\
8366            UNIONS(IMAGE (IMAGE f) u) = IMAGE f (UNIONS u) /\
8367            (IMAGE f s) DIFF (IMAGE f t) = IMAGE f (s DIFF t) /\
8368            (IMAGE f s (f x) <=> s x) /\
8369            ((f x) IN (IMAGE f s) <=> x IN s) /\
8370            ((f o xs) (n:num) = f(xs n)) /\
8371            ((f o pt) (tt:real^1) = f(pt tt)) /\
8372            (DISJOINT (IMAGE f s) (IMAGE f t) <=> DISJOINT s t) /\
8373            ((IMAGE f s) SUBSET (IMAGE f t) <=> s SUBSET t) /\
8374            ((IMAGE f s) PSUBSET (IMAGE f t) <=> s PSUBSET t) /\
8375            (IMAGE f s = IMAGE f t <=> s = t) /\
8376            ((IMAGE f s) HAS_SIZE n <=> s HAS_SIZE n) /\
8377            (FINITE(IMAGE f s) <=> FINITE s) /\
8378            (INFINITE(IMAGE f s) <=> INFINITE s)`,
8379   REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[IMAGE_UNIONS] THEN
8380   REWRITE_TAC[o_THM; MESON[IN] `IMAGE f s y <=> y IN IMAGE f s`] THEN
8381   REPLICATE_TAC 2 (CONJ_TAC THENL [MESON_TAC[]; ALL_TAC]) THEN
8382   REWRITE_TAC[INFINITE; TAUT `(~p <=> ~q) <=> (p <=> q)`] THEN
8383   REPLICATE_TAC 11 (CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN
8384   REWRITE_TAC[HAS_SIZE] THEN
8385   ASM_MESON_TAC[FINITE_IMAGE_INJ_EQ; CARD_IMAGE_INJ]) in
8386 let f = `f:real^M->real^N`
8387 and imf = `IMAGE (f:real^M->real^N)`
8388 and a = `a:real^N`
8389 and ima = `IMAGE (\x:real^N. a + x)`
8390 and vth = VECTOR_ARITH `!x y. a + x:real^N = a + y ==> x = y` in
8391 let th1 = UNDISCH(ISPEC f th_sets)
8392 and th1' = UNDISCH
8393  (GEN_REWRITE_RULE LAND_CONV [INJECTIVE_IMAGE] (ISPEC imf th_sets))
8394 and th2 = MATCH_MP th_sets vth
8395 and th2' = MATCH_MP
8396   (BETA_RULE(GEN_REWRITE_RULE LAND_CONV [INJECTIVE_IMAGE] (ISPEC ima th_sets)))
8397   vth in
8398 let fn a th = GENL (a::subtract (frees(concl th)) [a]) th in
8399 add_linear_invariants(map (fn f o DISCH_ALL) (CONJUNCTS th1 @ CONJUNCTS th1')),
8400 add_translation_invariants(map (fn a) (CONJUNCTS th2 @ CONJUNCTS th2'));;
8401
8402 let th_set = prove
8403  (`!f:A->B s. (!x y. f x = f y ==> x = y) /\ (!y. ?x. f x = y)
8404               ==> INTERS (IMAGE (IMAGE f) s) = IMAGE f (INTERS s)`,
8405   REWRITE_TAC[INTERS_IMAGE] THEN SET_TAC[]) in
8406 let th_vec = prove
8407  (`!a:real^N s.
8408     INTERS (IMAGE (IMAGE (\x. a + x)) s) = IMAGE (\x. a + x) (INTERS s)`,
8409   REPEAT GEN_TAC THEN MATCH_MP_TAC th_set THEN
8410   REWRITE_TAC[VECTOR_ARITH `a + x:real^N = a + y <=> x = y`] THEN
8411   REWRITE_TAC[VECTOR_ARITH `a + x:real^N = y <=> x = y - a`; EXISTS_REFL]) in
8412 add_linear_invariants [th_set],add_translation_invariants[th_vec];;
8413
8414 (* ------------------------------------------------------------------------- *)
8415 (* Now add arithmetical equivalences.                                        *)
8416 (* ------------------------------------------------------------------------- *)
8417
8418 let PRESERVES_NORM_PRESERVES_DOT = prove
8419  (`!f:real^M->real^N x y.
8420      linear f /\ (!x. norm(f x) = norm x)
8421      ==> (f x) dot (f y) = x dot y`,
8422   REWRITE_TAC[NORM_EQ] THEN REPEAT STRIP_TAC THEN
8423   FIRST_ASSUM(MP_TAC o SPEC `x + y:real^M`) THEN
8424   FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP LINEAR_ADD th]) THEN
8425   ASM_REWRITE_TAC[DOT_LADD; DOT_RADD] THEN
8426   REWRITE_TAC[DOT_SYM] THEN REAL_ARITH_TAC);;
8427
8428 let PRESERVES_NORM_INJECTIVE = prove
8429  (`!f:real^M->real^N.
8430      linear f /\ (!x. norm(f x) = norm x)
8431      ==> !x y. f x = f y ==> x = y`,
8432   SIMP_TAC[LINEAR_INJECTIVE_0; GSYM NORM_EQ_0]);;
8433
8434 let ORTHOGONAL_LINEAR_IMAGE_EQ = prove
8435  (`!f:real^M->real^N x y.
8436      linear f /\ (!x. norm(f x) = norm x)
8437      ==> (orthogonal (f x) (f y) <=> orthogonal x y)`,
8438   SIMP_TAC[orthogonal; PRESERVES_NORM_PRESERVES_DOT]);;
8439
8440 add_linear_invariants
8441  [GSYM LINEAR_ADD;
8442   GSYM LINEAR_CMUL;
8443   GSYM LINEAR_SUB;
8444   GSYM LINEAR_NEG;
8445   MIDPOINT_LINEAR_IMAGE;
8446   MESON[] `!f:real^M->real^N x.
8447                 (!x. norm(f x) = norm x) ==> norm(f x) = norm x`;
8448   PRESERVES_NORM_PRESERVES_DOT;
8449   MESON[dist; LINEAR_SUB]
8450     `!f:real^M->real^N x y.
8451         linear f /\ (!x. norm(f x) = norm x)
8452         ==> dist(f x,f y) = dist(x,y)`;
8453   MESON[] `!f:real^M->real^N x y.
8454                 (!x y. f x = f y ==> x = y) ==> (f x = f y <=> x = y)`;
8455   SUBSPACE_LINEAR_IMAGE_EQ;
8456   ORTHOGONAL_LINEAR_IMAGE_EQ;
8457   SPAN_LINEAR_IMAGE;
8458   DEPENDENT_LINEAR_IMAGE_EQ;
8459   INDEPENDENT_LINEAR_IMAGE_EQ;
8460   DIM_INJECTIVE_LINEAR_IMAGE];;
8461
8462 add_translation_invariants
8463  [VECTOR_ARITH `!a x y. a + x:real^N = a + y <=> x = y`;
8464   NORM_ARITH `!a x y. dist(a + x,a + y) = dist(x,y)`;
8465   VECTOR_ARITH `!a x y. &1 / &2 % ((a + x) + (a + y)) = a + &1 / &2 % (x + y)`;
8466   VECTOR_ARITH `!a x y. inv(&2) % ((a + x) + (a + y)) = a + inv(&2) % (x + y)`;
8467   VECTOR_ARITH `!a x y. (a + x) - (a + y):real^N = x - y`;
8468   (EQT_ELIM o (REWRITE_CONV[midpoint] THENC(EQT_INTRO o NORM_ARITH)))
8469                `!a x y. midpoint(a + x,a + y) = a + midpoint(x,y)`;
8470   (EQT_ELIM o (REWRITE_CONV[between] THENC(EQT_INTRO o NORM_ARITH)))
8471                `!a x y z. between (a + x) (a + y,a + z) <=> between x (y,z)`];;
8472
8473 let th = prove
8474  (`!a s b c:real^N. (a + b) + c IN IMAGE (\x. a + x) s <=> (b + c) IN s`,
8475   REWRITE_TAC[IN_IMAGE; VECTOR_ARITH
8476     `(a + b) + c:real^N = a + x <=> x = b + c`] THEN
8477   MESON_TAC[]) in
8478 add_translation_invariants [th];;
8479
8480 (* ------------------------------------------------------------------------- *)
8481 (* A few for lists.                                                          *)
8482 (* ------------------------------------------------------------------------- *)
8483
8484 let MEM_TRANSLATION = prove
8485  (`!a:real^N x l. MEM (a + x) (MAP (\x. a + x) l) <=> MEM x l`,
8486   REWRITE_TAC[MEM_MAP; VECTOR_ARITH `a + x:real^N = a + y <=> x = y`] THEN
8487   MESON_TAC[]);;
8488
8489 add_translation_invariants [MEM_TRANSLATION];;
8490
8491 let MEM_LINEAR_IMAGE = prove
8492  (`!f:real^M->real^N x l.
8493         linear f /\ (!x y. f x = f y ==> x = y)
8494         ==> (MEM (f x) (MAP f l) <=> MEM x l)`,
8495   REWRITE_TAC[MEM_MAP] THEN MESON_TAC[]);;
8496
8497 add_linear_invariants [MEM_LINEAR_IMAGE];;
8498
8499 let LENGTH_TRANSLATION = prove
8500  (`!a:real^N l. LENGTH(MAP (\x. a + x) l) = LENGTH l`,
8501   REWRITE_TAC[LENGTH_MAP]) in
8502 add_translation_invariants [LENGTH_TRANSLATION];;
8503
8504 let LENGTH_LINEAR_IMAGE = prove
8505  (`!f:real^M->real^N l. linear f ==> LENGTH(MAP f l) = LENGTH l`,
8506   REWRITE_TAC[LENGTH_MAP]) in
8507 add_linear_invariants [LENGTH_LINEAR_IMAGE];;
8508
8509 let CONS_TRANSLATION = prove
8510  (`!a:real^N h t.
8511      CONS ((\x. a + x) h) (MAP (\x. a + x) t) = MAP (\x. a + x) (CONS h t)`,
8512   REWRITE_TAC[MAP]) in
8513 add_translation_invariants [CONS_TRANSLATION];;
8514
8515 let CONS_LINEAR_IMAGE = prove
8516  (`!f:real^M->real^N h t.
8517      linear f ==> CONS (f h) (MAP f t) = MAP f (CONS h t)`,
8518   REWRITE_TAC[MAP]) in
8519 add_linear_invariants [CONS_LINEAR_IMAGE];;
8520
8521 let APPEND_TRANSLATION = prove
8522  (`!a:real^N l1 l2.
8523      APPEND (MAP (\x. a + x) l1) (MAP (\x. a + x) l2) =
8524      MAP (\x. a + x) (APPEND l1 l2)`,
8525   REWRITE_TAC[MAP_APPEND]) in
8526 add_translation_invariants [APPEND_TRANSLATION];;
8527
8528 let APPEND_LINEAR_IMAGE = prove
8529  (`!f:real^M->real^N l1 l2.
8530      linear f ==> APPEND (MAP f l1) (MAP f l2) = MAP f (APPEND l1 l2)`,
8531   REWRITE_TAC[MAP_APPEND]) in
8532 add_linear_invariants [APPEND_LINEAR_IMAGE];;
8533
8534 let REVERSE_TRANSLATION = prove
8535  (`!a:real^N l. REVERSE(MAP (\x. a + x) l) = MAP (\x. a + x) (REVERSE l)`,
8536   REWRITE_TAC[MAP_REVERSE]) in
8537 add_translation_invariants [REVERSE_TRANSLATION];;
8538
8539 let REVERSE_LINEAR_IMAGE = prove
8540  (`!f:real^M->real^N l. linear f ==> REVERSE(MAP f l) = MAP f (REVERSE l)`,
8541   REWRITE_TAC[MAP_REVERSE]) in
8542 add_linear_invariants [REVERSE_LINEAR_IMAGE];;
8543
8544 (* ------------------------------------------------------------------------- *)
8545 (* A few scaling theorems that don't come from invariance theorems. Most are *)
8546 (* artificially weak with 0 < c hypotheses, so we don't bind them to names.  *)
8547 (* ------------------------------------------------------------------------- *)
8548
8549 let DOT_SCALING = prove
8550  (`!c. &0 < c ==> !x y. (c % x) dot (c % y) = c pow 2 * (x dot y)`,
8551   REWRITE_TAC[DOT_LMUL; DOT_RMUL] THEN REAL_ARITH_TAC) in
8552 add_scaling_theorems [DOT_SCALING];;
8553
8554 let DIST_SCALING = prove
8555  (`!c. &0 < c ==> !x y. dist(c % x,c % y) = c * dist(x,y)`,
8556   SIMP_TAC[DIST_MUL; REAL_ARITH `&0 < c ==> abs c = c`]) in
8557 add_scaling_theorems [DIST_SCALING];;
8558
8559 let ORTHOGONAL_SCALING = prove
8560  (`!c. &0 < c ==> !x y. orthogonal (c % x) (c % y) <=> orthogonal x y`,
8561   REWRITE_TAC[orthogonal; DOT_LMUL; DOT_RMUL] THEN CONV_TAC REAL_FIELD) in
8562 add_scaling_theorems [ORTHOGONAL_SCALING];;
8563
8564 let NORM_SCALING = prove
8565  (`!c. &0 < c ==> !x. norm(c % x) = c * norm x`,
8566   SIMP_TAC[NORM_MUL; REAL_ARITH `&0 < c ==> abs c = c`]) in
8567 add_scaling_theorems [NORM_SCALING];;
8568
8569 add_scaling_theorems
8570   [REAL_ARITH `!c. &0 < c ==> !a b. a * c * b = c * a * b`;
8571    REAL_ARITH `!c. &0 < c ==> !a b. c * a + c * b = c * (a + b)`;
8572    REAL_ARITH `!c. &0 < c ==> !a b. c * a - c * b = c * (a - b)`;
8573    REAL_FIELD `!c. &0 < c ==> !a b. c * a = c * b <=> a = b`;
8574    MESON[REAL_LT_LMUL_EQ] `!c. &0 < c ==> !a b. c * a < c * b <=> a < b`;
8575    MESON[REAL_LE_LMUL_EQ] `!c. &0 < c ==> !a b. c * a <= c * b <=> a <= b`;
8576    MESON[REAL_LT_LMUL_EQ; real_gt]
8577      `!c. &0 < c ==> !a b. c * a > c * b <=> a > b`;
8578    MESON[REAL_LE_LMUL_EQ; real_ge]
8579      `!c. &0 < c ==> !a b. c * a >= c * b <=> a >= b`;
8580    MESON[REAL_POW_MUL]
8581     `!c. &0 < c ==> !a n. (c * a) pow n = c pow n * a pow n`;
8582    REAL_ARITH `!c. &0 < c ==> !a b n. a * c pow n * b = c pow n * a * b`;
8583    REAL_ARITH
8584     `!c. &0 < c ==> !a b n. c pow n * a + c pow n * b = c pow n * (a + b)`;
8585    REAL_ARITH
8586     `!c. &0 < c ==> !a b n. c pow n * a - c pow n * b = c pow n * (a - b)`;
8587    MESON[REAL_POW_LT; REAL_EQ_LCANCEL_IMP; REAL_LT_IMP_NZ]
8588     `!c. &0 < c ==> !a b n. c pow n * a = c pow n * b <=> a = b`;
8589    MESON[REAL_LT_LMUL_EQ; REAL_POW_LT]
8590      `!c. &0 < c ==> !a b n. c pow n * a < c pow n * b <=> a < b`;
8591    MESON[REAL_LE_LMUL_EQ; REAL_POW_LT]
8592      `!c. &0 < c ==> !a b n. c pow n * a <= c pow n * b <=> a <= b`;
8593    MESON[REAL_LT_LMUL_EQ; real_gt; REAL_POW_LT]
8594      `!c. &0 < c ==> !a b n. c pow n * a > c pow n * b <=> a > b`;
8595    MESON[REAL_LE_LMUL_EQ; real_ge; REAL_POW_LT]
8596      `!c. &0 < c ==> !a b n. c pow n * a >= c pow n * b <=> a >= b`];;
8597
8598 (* ------------------------------------------------------------------------- *)
8599 (* Theorem deducing quantifier mappings from surjectivity.                   *)
8600 (* ------------------------------------------------------------------------- *)
8601
8602 let QUANTIFY_SURJECTION_THM = prove
8603  (`!f:A->B.
8604         (!y. ?x. f x = y)
8605         ==> ((!P. (!x. P x) <=> (!x. P (f x))) /\
8606              (!P. (?x. P x) <=> (?x. P (f x))) /\
8607              (!Q. (!s. Q s) <=> (!s. Q(IMAGE f s))) /\
8608              (!Q. (?s. Q s) <=> (?s. Q(IMAGE f s)))) /\
8609             (!P. {x | P x} = IMAGE f {x | P(f x)})`,
8610   GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [SURJECTIVE_RIGHT_INVERSE] THEN
8611   DISCH_THEN(X_CHOOSE_TAC `g:B->A`) THEN
8612   SUBGOAL_THEN `!s. IMAGE (f:A->B) (IMAGE g s) = s` ASSUME_TAC THENL
8613    [ASM SET_TAC[]; CONJ_TAC THENL [ASM MESON_TAC[]; ASM SET_TAC[]]]);;
8614
8615 let QUANTIFY_SURJECTION_HIGHER_THM = prove
8616  (`!f:A->B.
8617         (!y. ?x. f x = y)
8618         ==> ((!P. (!x. P x) <=> (!x. P (f x))) /\
8619              (!P. (?x. P x) <=> (?x. P (f x))) /\
8620              (!Q. (!s. Q s) <=> (!s. Q(IMAGE f s))) /\
8621              (!Q. (?s. Q s) <=> (?s. Q(IMAGE f s))) /\
8622              (!Q. (!s. Q s) <=> (!s. Q(IMAGE (IMAGE f) s))) /\
8623              (!Q. (?s. Q s) <=> (?s. Q(IMAGE (IMAGE f) s))) /\
8624              (!P. (!g:real^1->B. P g) <=> (!g. P(f o g))) /\
8625              (!P. (?g:real^1->B. P g) <=> (?g. P(f o g))) /\
8626              (!P. (!g:num->B. P g) <=> (!g. P(f o g))) /\
8627              (!P. (?g:num->B. P g) <=> (?g. P(f o g))) /\
8628              (!Q. (!l. Q l) <=> (!l. Q(MAP f l))) /\
8629              (!Q. (?l. Q l) <=> (?l. Q(MAP f l)))) /\
8630             ((!P. {x | P x} = IMAGE f {x | P(f x)}) /\
8631              (!Q. {s | Q s} = IMAGE (IMAGE f) {s | Q(IMAGE f s)}) /\
8632              (!R. {l | R l} = IMAGE (MAP f) {l | R(MAP f l)}))`,
8633   GEN_TAC THEN DISCH_TAC THEN CONV_TAC(ONCE_DEPTH_CONV SYM_CONV) THEN
8634   ASM_REWRITE_TAC[GSYM SURJECTIVE_FORALL_THM; GSYM SURJECTIVE_EXISTS_THM;
8635             GSYM SURJECTIVE_IMAGE_THM; SURJECTIVE_IMAGE; SURJECTIVE_MAP] THEN
8636   REWRITE_TAC[FUN_EQ_THM; o_THM; GSYM SKOLEM_THM] THEN ASM_MESON_TAC[]);;
8637
8638 (* ------------------------------------------------------------------------- *)
8639 (* Apply such quantifier and set expansions once per level at depth.         *)
8640 (* In the PARTIAL version, avoid expanding named variables in list.          *)
8641 (* ------------------------------------------------------------------------- *)
8642
8643 let PARTIAL_EXPAND_QUANTS_CONV avoid th =
8644   let ath,sth = CONJ_PAIR th in
8645   let conv1 = GEN_REWRITE_CONV I [ath]
8646   and conv2 = GEN_REWRITE_CONV I [sth] in
8647   let conv1' tm =
8648     let th = conv1 tm in
8649     if mem (fst(dest_var(fst(dest_abs(rand tm))))) avoid
8650     then failwith "Not going to expand this variable" else th in
8651   let rec conv tm =
8652    ((conv1' THENC BINDER_CONV conv) ORELSEC
8653     (conv2 THENC
8654      RAND_CONV(RAND_CONV(ABS_CONV(BINDER_CONV(LAND_CONV conv))))) ORELSEC
8655     SUB_CONV conv) tm in
8656   conv;;
8657
8658 let EXPAND_QUANTS_CONV = PARTIAL_EXPAND_QUANTS_CONV [];;