--- /dev/null
+(* Upadted for the latest version of HOL Light (JULY 2014) *)
+
+(* ========================================================================= *)\r
+(* A library for vectors of complex numbers. *)\r
+(* Much inspired from HOL-Light real vector library <"vectors.ml">. *)\r
+(* *)\r
+(* (c) Copyright, Sanaz Khan Afshar & Vincent Aravantinos 2011-13 *)\r
+(* Hardware Verification Group, *)\r
+(* Concordia University *)\r
+(* *)\r
+(* Contact: <s_khanaf@encs.concordia.ca> *)\r
+(* <vincent@encs.concordia.ca> *)\r
+(* *)\r
+(* Acknowledgements: *)\r
+(* - Harsh Singhal: n-dimensional dot product, utility theorems *)\r
+(* *)\r
+(* Last update: July 2013 *)\r
+(* *)\r
+(* ========================================================================= *)\r
+\r
+\r
+(* ========================================================================= *)\r
+(* ADDITIONS TO THE BASE LIBRARY *)\r
+(* ========================================================================= *)\r
+\r
+ (* ----------------------------------------------------------------------- *)\r
+ (* Additional tacticals *)\r
+ (* ----------------------------------------------------------------------- *)\r
+\r
+\r
+let SINGLE f x = f [x];;\r
+\r
+let distrib fs x = map (fun f -> f x) fs;;\r
+\r
+let DISTRIB ttacs x = EVERY (distrib ttacs x);;\r
+\r
+let REWRITE_TACS = MAP_EVERY (SINGLE REWRITE_TAC);;\r
+\r
+let GCONJUNCTS thm = map GEN_ALL (CONJUNCTS (SPEC_ALL thm));;\r
+\r
+ (* ----------------------------------------------------------------------- *)\r
+ (* Additions to the vectors library *)\r
+ (* ----------------------------------------------------------------------- *)\r
+\r
+let COMPONENT_LE_NORM_ALT = prove\r
+ (`!x:real^N i. 1 <= i /\ i <= dimindex (:N) ==> x$i <= norm x`,\r
+ MESON_TAC [REAL_ABS_LE;COMPONENT_LE_NORM;REAL_LE_TRANS]);;\r
+\r
+ (* ----------------------------------------------------------------------- *)\r
+ (* Additions to the library of complex numbers *)\r
+ (* ----------------------------------------------------------------------- *)\r
+\r
+(* Lemmas *)\r
+let RE_IM_NORM = prove\r
+ (`!x. Re x <= norm x /\ Im x <= norm x /\ abs(Re x) <= norm x\r
+ /\ abs(Im x) <= norm x`,\r
+ REWRITE_TAC[RE_DEF;IM_DEF] THEN GEN_TAC THEN REPEAT CONJ_TAC\r
+ THEN ((MATCH_MP_TAC COMPONENT_LE_NORM_ALT\r
+ THEN REWRITE_TAC[DIMINDEX_2] THEN ARITH_TAC) ORELSE SIMP_TAC [COMPONENT_LE_NORM]));;\r
+\r
+let [RE_NORM;IM_NORM;ABS_RE_NORM;ABS_IM_NORM] = GCONJUNCTS RE_IM_NORM;;\r
+\r
+let NORM_RE = prove\r
+ (`!x. &0 <= norm x + Re x /\ &0 <= norm x - Re x`, \r
+ GEN_TAC THEN MP_TAC (SPEC_ALL ABS_RE_NORM) THEN REAL_ARITH_TAC);;\r
+\r
+let [NORM_RE_ADD;NORM_RE_SUB] = GCONJUNCTS NORM_RE;;\r
+\r
+let NORM2_ADD_REAL = prove\r
+ (`!x y.\r
+ real x /\ real y ==> norm (x + ii * y) pow 2 = norm x pow 2 + norm y pow 2`,\r
+ SIMP_TAC[real;complex_norm;RE_ADD;IM_ADD;RE_MUL_II;IM_MUL_II;REAL_NEG_0;\r
+ REAL_ADD_LID;REAL_ADD_RID;REAL_POW_ZERO;ARITH_RULE `~(2=0)`;REAL_LE_POW_2;\r
+ SQRT_POW_2;REAL_LE_ADD]);;\r
+\r
+let COMPLEX_EQ_RCANCEL_IMP = GEN_ALL (MATCH_MP (MESON []\r
+ `(p <=> r \/ q) ==> (p /\ ~r ==> q) `) (SPEC_ALL COMPLEX_EQ_MUL_RCANCEL));;\r
+\r
+let COMPLEX_BALANCE_DIV_MUL = prove\r
+ (`!x y z t. ~(z=Cx(&0)) ==> (x = y/z * t <=> x*z = y * t)`,\r
+ REPEAT STRIP_TAC THEN POP_ASSUM (fun x ->\r
+ ASSUME_TAC (REWRITE_RULE[x] (SPEC_ALL COMPLEX_EQ_MUL_RCANCEL))\r
+ THEN ASSUME_TAC (REWRITE_RULE[x] (SPECL [`x:complex`;`z:complex`]\r
+ COMPLEX_DIV_RMUL)))\r
+ THEN SUBGOAL_THEN `x=y/z*t <=> x*z=(y/z*t)*z:complex` (SINGLE REWRITE_TAC)\r
+ THENL [ASM_REWRITE_TAC[];\r
+ REWRITE_TAC[SIMPLE_COMPLEX_ARITH `(y/z*t)*z=(y/z*z)*t:complex`]\r
+ THEN ASM_REWRITE_TAC[]]);;\r
+\r
+let CSQRT_MUL_LCX_LT = prove\r
+ (`!x y. &0 < x ==> csqrt(Cx x * y) = Cx(sqrt x) * csqrt y`,\r
+ REWRITE_TAC[csqrt;complex_mul;IM;RE;IM_CX;REAL_MUL_LZERO;REAL_ADD_RID;RE_CX;\r
+ REAL_SUB_RZERO]\r
+ THEN REPEAT STRIP_TAC THEN REPEAT COND_CASES_TAC\r
+ THEN FIRST_ASSUM (ASSUME_TAC o MATCH_MP REAL_LT_IMP_LE)\r
+ THEN ASM_SIMP_TAC[IM;RE;REAL_MUL_RZERO;SQRT_MUL]\r
+ THENL [\r
+ REPEAT (POP_ASSUM MP_TAC) THEN REWRITE_TAC[REAL_ENTIRE;REAL_MUL_POS_LE]\r
+ THEN REPEAT STRIP_TAC\r
+ THEN ASM_REWRITE_TAC[SQRT_0;REAL_MUL_LZERO;REAL_MUL_RZERO];\r
+ REPEAT (POP_ASSUM MP_TAC) THEN SIMP_TAC [REAL_ENTIRE]\r
+ THEN MESON_TAC [REAL_LT_IMP_NZ];\r
+ ASM_MESON_TAC [REAL_LE_MUL_EQ;REAL_ARITH `~(&0 <= y) = &0 > y`];\r
+ SIMP_TAC [REAL_NEG_RMUL] THEN REPEAT (POP_ASSUM MP_TAC)\r
+ THEN SIMP_TAC [REAL_ARITH `~(&0 <= y) = y < &0`]\r
+ THEN SIMP_TAC [GSYM REAL_NEG_GT0] THEN MESON_TAC[REAL_LT_IMP_LE;SQRT_MUL];\r
+ REPEAT (POP_ASSUM MP_TAC) THEN SIMP_TAC [REAL_ENTIRE]\r
+ THEN MESON_TAC [REAL_LT_IMP_NZ];\r
+ REPEAT (POP_ASSUM MP_TAC) THEN SIMP_TAC [REAL_ENTIRE]\r
+ THEN SIMP_TAC [DE_MORGAN_THM];\r
+ REPEAT (POP_ASSUM MP_TAC) THEN SIMP_TAC [REAL_ENTIRE]\r
+ THEN SIMP_TAC [DE_MORGAN_THM]; ALL_TAC] THENL [\r
+ SIMP_TAC [REAL_NEG_0;SQRT_0;REAL_MUL_RZERO];\r
+ ASM_MESON_TAC[REAL_ARITH `~(x<y /\ ~(x <=y))`];\r
+ ASM_MESON_TAC[REAL_ARITH `~(x<y /\ y<x)`];\r
+ ALL_TAC]\r
+ THEN REWRITE_TAC[GSYM (REWRITE_RULE[CX_DEF;complex_mul;RE;IM;\r
+ REAL_MUL_LZERO;REAL_ADD_RID;REAL_SUB_RZERO] COMPLEX_CMUL)]\r
+ THEN SIMP_TAC [NORM_MUL] THEN POP_ASSUM MP_TAC\r
+ THEN ASM_SIMP_TAC [GSYM REAL_ABS_REFL] THEN DISCH_TAC\r
+ THEN SIMP_TAC [REAL_ABS_MUL]\r
+ THEN ASM_SIMP_TAC [GSYM REAL_ABS_REFL]\r
+ THEN SIMP_TAC [GSYM REAL_ADD_LDISTRIB; GSYM REAL_SUB_LDISTRIB]\r
+ THEN SUBGOAL_THEN `(x*Im y) / (x*abs(Im y)) = Im y / abs(Im y)` ASSUME_TAC\r
+ THENL [\r
+ SIMP_TAC [real_div] THEN SIMP_TAC [REAL_INV_MUL]\r
+ THEN SIMP_TAC [GSYM REAL_MUL_ASSOC] THEN ONCE_REWRITE_TAC[REAL_MUL_AC]\r
+ THEN SUBGOAL_THEN `Im y * x * inv x * inv (abs(Im y)) =\r
+ Im y * (x * inv x) * inv (abs (Im y)) ` ASSUME_TAC\r
+ THENL [SIMP_TAC [REAL_MUL_AC]; ALL_TAC]\r
+ THEN ASM_SIMP_TAC[REAL_MUL_RINV;REAL_LT_IMP_NZ]\r
+ THEN SIMP_TAC [REAL_MUL_LID] THEN SIMP_TAC [REAL_MUL_AC];\r
+ ALL_TAC]\r
+ THEN ASM_SIMP_TAC[]\r
+ THEN SUBGOAL_THEN `sqrt x * Im y / abs(Im y) * sqrt ((norm y-Re y) / &2) =\r
+ Im y / abs (Im y) * sqrt x * sqrt ((norm y - Re y) / &2)` ASSUME_TAC\r
+ THENL [SIMP_TAC [REAL_MUL_AC]; ALL_TAC] THEN ASM_SIMP_TAC[]\r
+ THEN SUBGOAL_THEN `sqrt ((x * (norm y - Re y)) / &2) =\r
+ sqrt (x * (norm y - Re y)) / sqrt (&2)` ASSUME_TAC\r
+ THENL [\r
+ SIMP_TAC[SQRT_DIV] THEN CONJ_TAC THENL [\r
+ ASM_SIMP_TAC[REAL_LE_MUL_EQ;REAL_LT_IMP_LE] THEN SIMP_TAC[NORM_RE_SUB];\r
+ REAL_ARITH_TAC];\r
+ ALL_TAC]\r
+ THEN ASM_SIMP_TAC[] THEN SUBGOAL_THEN `sqrt ((norm y - Re y) / &2) =\r
+ sqrt (norm y - Re y) / sqrt (&2)` ASSUME_TAC\r
+ THENL [\r
+ SIMP_TAC[SQRT_DIV] THEN CONJ_TAC\r
+ THENL [SIMP_TAC [NORM_RE_SUB]; REAL_ARITH_TAC];\r
+ ALL_TAC ]\r
+ THEN ASM_SIMP_TAC[]\r
+ THEN SUBGOAL_THEN `sqrt ((x * (norm y + Re y)) / &2) =\r
+ sqrt (x * (norm y + Re y)) / sqrt (&2)` ASSUME_TAC\r
+ THENL [\r
+ SIMP_TAC[SQRT_DIV] THEN CONJ_TAC\r
+ THENL [\r
+ ASM_SIMP_TAC [REAL_LE_MUL_EQ;REAL_LT_IMP_LE]\r
+ THEN SIMP_TAC[NORM_RE_ADD];\r
+ REAL_ARITH_TAC];\r
+ ALL_TAC]\r
+ THEN SUBGOAL_THEN `sqrt ((norm y + Re y) / &2) =\r
+ sqrt (norm y + Re y) / sqrt (&2)` ASSUME_TAC\r
+ THENL [\r
+ SIMP_TAC[SQRT_DIV] THEN CONJ_TAC\r
+ THENL [SIMP_TAC[NORM_RE_ADD]; REAL_ARITH_TAC];\r
+ ALL_TAC]\r
+ THEN ASM_SIMP_TAC[] THEN SUBGOAL_THEN `&0 <= x` ASSUME_TAC\r
+ THENL [ ASM_SIMP_TAC [REAL_LT_IMP_LE]; ALL_TAC ]\r
+ THEN SIMP_TAC[COMPLEX_EQ] THEN SIMP_TAC[RE;IM] THEN CONJ_TAC\r
+ THENL [\r
+ SUBGOAL_THEN `sqrt x * sqrt (norm y + Re y) / sqrt (&2) =\r
+ (sqrt x * sqrt (norm y + Re y)) / sqrt (&2)` ASSUME_TAC\r
+ THENL [REAL_ARITH_TAC; ALL_TAC]\r
+ THEN ASM_MESON_TAC [SQRT_MUL;NORM_RE_ADD];\r
+ SUBGOAL_THEN `Im y/abs(Im y) * sqrt x * sqrt (norm y-Re y) / sqrt(&2) =\r
+ Im y/abs (Im y) * (sqrt x * sqrt (norm y - Re y))/sqrt(&2)` ASSUME_TAC\r
+ THENL [REAL_ARITH_TAC; ALL_TAC]\r
+ THEN ASM_MESON_TAC[SQRT_MUL;NORM_RE_SUB]]);;\r
+\r
+let CSQRT_MUL_LCX = prove\r
+ (`!x y. &0 <= x ==> csqrt(Cx x * y) = Cx(sqrt x) * csqrt y`,\r
+ REWRITE_TAC[REAL_LE_LT] THEN REPEAT STRIP_TAC\r
+ THEN ASM_SIMP_TAC[CSQRT_MUL_LCX_LT] THEN EXPAND_TAC "x"\r
+ THEN REWRITE_TAC[COMPLEX_MUL_LZERO;SQRT_0;CSQRT_0]);;\r
+\r
+let REAL_ADD_POW_2 = prove\r
+ (`!x y:real. (x+y) pow 2 = x pow 2 + y pow 2 + &2 * x * y`,\r
+ REAL_ARITH_TAC);;\r
+\r
+let COMPLEX_ADD_POW_2 = prove\r
+ (`!x y:complex. (x+y) pow 2 = x pow 2 + y pow 2 + Cx(&2) * x * y`,\r
+ REWRITE_TAC[COMPLEX_POW_2] THEN SIMPLE_COMPLEX_ARITH_TAC);;\r
+
+
+\r
+(* ----------------------------------------------------------------------- *)\r
+(* Additions to the topology library *)\r
+(* ----------------------------------------------------------------------- *)\r
+
+ prioritize_vector ();;
+\r
+(* Lemmas *)\r
+let FINITE_INTER_ENUM = prove\r
+ (`!s n. FINITE(s INTER (0..n))`,\r
+ MESON_TAC[FINITE_INTER;FINITE_NUMSEG]);;\r
+\r
+let NORM_PASTECART_GE1 = prove\r
+ (`!x y. norm x <= norm (pastecart x y)`,\r
+ MESON_TAC[FSTCART_PASTECART;NORM_FSTCART]);;\r
+\r
+let NORM_PASTECART_GE2 = prove\r
+ (`!x y. norm y <= norm (pastecart x y)`,\r
+ MESON_TAC[SNDCART_PASTECART;NORM_SNDCART]);;\r
+\r
+let LIM_PASTECART_EQ = prove\r
+ (`!net a b f:A->real^M g:A->real^N. (f --> a) net /\ (g --> b) net\r
+ <=> ((\x. pastecart (f x) (g x)) --> pastecart a b) net`,\r
+ REWRITE_TAC[MESON[] `(a <=> b) <=> (a ==> b) /\ (b ==> a)`;LIM_PASTECART;LIM;\r
+ MESON[]`(p\/q ==> (p \/ r) /\ (p \/ s)) <=> (~p /\ q ==> r /\ s)`;dist;\r
+ PASTECART_SUB] \r
+ THEN ASM_MESON_TAC[REAL_LET_TRANS;NORM_PASTECART_GE1;NORM_PASTECART_GE2]);;\r
+\r
+let SUMS_PASTECART = prove\r
+ (`!s f1:num->real^N f2:num->real^M l1 l2. (f1 sums l1) s /\ (f2 sums l2) s\r
+ <=> ((\x. pastecart (f1 x) (f2 x)) sums (pastecart l1 l2)) s`,\r
+ SIMP_TAC[sums;FINITE_INTER_ENUM;GSYM PASTECART_VSUM;LIM_PASTECART_EQ]);;\r
+\r
+let LINEAR_SUMS = prove(\r
+ `!s f l g. linear g ==> ((f sums l) s ==> ((g o f) sums (g l)) s)`,\r
+ SIMP_TAC[sums;FINITE_INTER_ENUM;GSYM LINEAR_VSUM;\r
+ REWRITE_RULE[o_DEF;CONTINUOUS_AT_SEQUENTIALLY] LINEAR_CONTINUOUS_AT]);; \r
+\r
+ (* ----------------------------------------------------------------------- *)\r
+ (* Embedding of reals in complex numbers *)\r
+ (* ----------------------------------------------------------------------- *)\r
+\r
+let real_of_complex = new_definition `real_of_complex c = @r. c = Cx r`;;\r
+\r
+let REAL_OF_COMPLEX = prove\r
+ (`!c. real c ==> Cx(real_of_complex c) = c`,\r
+ MESON_TAC[REAL;real_of_complex]);;\r
+\r
+let REAL_OF_COMPLEX_RE = prove\r
+ (`!c. real c ==> real_of_complex c = Re c`,\r
+ MESON_TAC[RE_CX;REAL_OF_COMPLEX]);;\r
+\r
+let REAL_OF_COMPLEX_CX = prove\r
+ (`!r. real_of_complex (Cx r) = r`,\r
+ SIMP_TAC[REAL_CX;REAL_OF_COMPLEX_RE;RE_CX]);;\r
+\r
+let REAL_OF_COMPLEX_NORM = prove\r
+ (`!c. real c ==> norm c = abs (real_of_complex c)`,\r
+ MESON_TAC[REAL_NORM;REAL_OF_COMPLEX_RE]);;\r
+\r
+let REAL_OF_COMPLEX_ADD = prove\r
+ (`!x y. real x /\ real y\r
+ ==> real_of_complex (x+y) = real_of_complex x + real_of_complex y`,\r
+ MESON_TAC[REAL_ADD;REAL_OF_COMPLEX_RE;RE_ADD]);;\r
+\r
+let REAL_MUL = prove\r
+ (`!x y. real x /\ real y ==> real (x*y)`,\r
+ REWRITE_TAC[real] THEN SIMPLE_COMPLEX_ARITH_TAC);;\r
+\r
+let REAL_OF_COMPLEX_MUL = prove(\r
+ `!x y. real x /\ real y\r
+ ==> real_of_complex (x*y) = real_of_complex x * real_of_complex y`,\r
+ MESON_TAC[REAL_MUL;REAL_OF_COMPLEX;CX_MUL;REAL_OF_COMPLEX_CX]);;\r
+\r
+let REAL_OF_COMPLEX_0 = prove(\r
+ `!x. real x ==> (real_of_complex x = &0 <=> x = Cx(&0))`,\r
+ REWRITE_TAC[REAL_EXISTS] THEN REPEAT STRIP_TAC\r
+ THEN ASM_SIMP_TAC[REAL_OF_COMPLEX_CX;CX_INJ]);;\r
+\r
+let REAL_COMPLEX_ADD_CNJ = prove(\r
+ `!x. real(cnj x + x) /\ real(x + cnj x)`,\r
+ REWRITE_TAC[COMPLEX_ADD_CNJ;REAL_CX]);;\r
+\r
+(* TODO\r
+ *let RE_EQ_NORM = prove(`!x. Re x = norm x <=> real x /\ &0 <= real_of_complex x`,\r
+ *)\r
+\r
+ (* ----------------------------------------------------------------------- *)\r
+ (* Additions to the vectors library *)\r
+ (* ----------------------------------------------------------------------- *)\r
+\r
+let vector_const = new_definition\r
+ `vector_const (k:A) :A^N = lambda i. k`;;\r
+let vector_map = new_definition\r
+ `vector_map (f:A->B) (v:A^N) :B^N = lambda i. f(v$i)`;;\r
+let vector_map2 = new_definition\r
+ `vector_map2 (f:A->B->C) (v1:A^N) (v2:B^N) :C^N =\r
+ lambda i. f (v1$i) (v2$i)`;;\r
+let vector_map3 = new_definition\r
+ `vector_map3 (f:A->B->C->D) (v1:A^N) (v2:B^N) (v3:C^N) :D^N =\r
+ lambda i. f (v1$i) (v2$i) (v3$i)`;;\r
+\r
+let FINITE_INDEX_INRANGE_2 = prove\r
+ (`!i. ?k. 1 <= k /\ k <= dimindex(:N) /\ (!x:A^N. x$i = x$k)\r
+ /\ (!x:B^N. x$i = x$k) /\ (!x:C^N. x$i = x$k) /\ (!x:D^N. x$i = x$k)`,\r
+ REWRITE_TAC[finite_index] THEN MESON_TAC[FINITE_INDEX_WORKS]);;\r
+\r
+let COMPONENT_TAC x =\r
+ REPEAT GEN_TAC THEN CHOOSE_TAC (SPEC_ALL FINITE_INDEX_INRANGE_2)\r
+ THEN ASM_SIMP_TAC[x;LAMBDA_BETA];;\r
+\r
+let VECTOR_CONST_COMPONENT = prove\r
+ (`!i k. ((vector_const k):A^N)$i = k`,\r
+ COMPONENT_TAC vector_const);;\r
+let VECTOR_MAP_COMPONENT = prove\r
+ (`!i f:A->B v:A^N. (vector_map f v)$i = f (v$i)`,\r
+ COMPONENT_TAC vector_map);;\r
+let VECTOR_MAP2_COMPONENT = prove\r
+ (`!i f:A->B->C v1:A^N v2. (vector_map2 f v1 v2)$i = f (v1$i) (v2$i)`,\r
+ COMPONENT_TAC vector_map2);;\r
+let VECTOR_MAP3_COMPONENT = prove(\r
+ `!i f:A->B->C->D v1:A^N v2 v3. (vector_map3 f v1 v2 v3)$i =\r
+ f (v1$i) (v2$i) (v3$i)`,\r
+ COMPONENT_TAC vector_map3);;\r
+\r
+let COMMON_TAC =\r
+ REWRITE_TAC[vector_const;vector_map;vector_map2;vector_map3]\r
+ THEN ONCE_REWRITE_TAC[CART_EQ] THEN SIMP_TAC[LAMBDA_BETA;o_DEF];;\r
+\r
+let VECTOR_MAP_VECTOR_CONST = prove\r
+ (`!f:A->B k. vector_map f ((vector_const k):A^N) = vector_const (f k)`,\r
+ COMMON_TAC);;\r
+\r
+let VECTOR_MAP_VECTOR_MAP = prove\r
+ (`!f:A->B g:C->A v:C^N.\r
+ vector_map f (vector_map g v) = vector_map (f o g) v`,\r
+ COMMON_TAC);;\r
+\r
+let VECTOR_MAP_VECTOR_MAP2 = prove\r
+ (`!f:A->B g:C->D->A u v:D^N.\r
+ vector_map f (vector_map2 g u v) = vector_map2 (\x y. f (g x y)) u v`,\r
+ COMMON_TAC);;\r
+\r
+let VECTOR_MAP2_LVECTOR_CONST = prove\r
+ (`!f:A->B->C k v:B^N.\r
+ vector_map2 f (vector_const k) v = vector_map (f k) v`,\r
+ COMMON_TAC);;\r
+\r
+let VECTOR_MAP2_RVECTOR_CONST = prove\r
+ (`!f:A->B->C k v:A^N.\r
+ vector_map2 f v (vector_const k) = vector_map (\x. f x k) v`,\r
+ COMMON_TAC);;\r
+\r
+let VECTOR_MAP2_LVECTOR_MAP = prove\r
+ (`!f:A->B->C g:D->A v1 v2:B^N.\r
+ vector_map2 f (vector_map g v1) v2 = vector_map2 (f o g) v1 v2`,\r
+ COMMON_TAC);;\r
+\r
+let VECTOR_MAP2_RVECTOR_MAP = prove\r
+ (`!f:A->B->C g:D->B v1 v2:D^N.\r
+ vector_map2 f v1 (vector_map g v2) = vector_map2 (\x y. f x (g y)) v1 v2`,\r
+ COMMON_TAC);;\r
+\r
+let VECTOR_MAP2_LVECTOR_MAP2 = prove\r
+ (`!f:A->B->C g:D->E->A v1 v2 v3:B^N.\r
+ vector_map2 f (vector_map2 g v1 v2) v3 =\r
+ vector_map3 (\x y. f (g x y)) v1 v2 v3`,\r
+ COMMON_TAC);;\r
+\r
+let VECTOR_MAP2_RVECTOR_MAP2 = prove(\r
+ `!f:A->B->C g:D->E->B v1 v2 v3:E^N.\r
+ vector_map2 f v1 (vector_map2 g v2 v3) =\r
+ vector_map3 (\x y z. f x (g y z)) v1 v2 v3`,\r
+ COMMON_TAC);;\r
+\r
+let VECTOR_MAP_SIMP_TAC = REWRITE_TAC[\r
+ VECTOR_MAP_VECTOR_CONST;VECTOR_MAP2_LVECTOR_CONST;\r
+ VECTOR_MAP2_RVECTOR_CONST;VECTOR_MAP_VECTOR_MAP;VECTOR_MAP2_RVECTOR_MAP;\r
+ VECTOR_MAP2_LVECTOR_MAP;VECTOR_MAP2_RVECTOR_MAP2;VECTOR_MAP2_LVECTOR_MAP2;\r
+ VECTOR_MAP_VECTOR_MAP2];;\r
+\r
+let VECTOR_MAP_PROPERTY_TAC fs prop =\r
+ REWRITE_TAC fs THEN VECTOR_MAP_SIMP_TAC THEN ONCE_REWRITE_TAC[CART_EQ]\r
+ THEN REWRITE_TAC[VECTOR_MAP_COMPONENT;VECTOR_MAP2_COMPONENT;\r
+ VECTOR_MAP3_COMPONENT;VECTOR_CONST_COMPONENT;o_DEF;prop];;\r
+\r
+let VECTOR_MAP_PROPERTY thm f prop =\r
+ prove(thm,VECTOR_MAP_PROPERTY_TAC f prop);;\r
+\r
+let COMPLEX_VECTOR_MAP = prove\r
+ (`!f:complex->complex g. f = vector_map g \r
+ <=> !z. f z = complex (g (Re z), g (Im z))`,\r
+ REWRITE_TAC[vector_map;FUN_EQ_THM;complex] THEN REPEAT (GEN_TAC ORELSE EQ_TAC)\r
+ THEN ASM_SIMP_TAC[CART_EQ;DIMINDEX_2;FORALL_2;LAMBDA_BETA;VECTOR_2;RE_DEF;IM_DEF]);;\r
+\r
+let COMPLEX_NEG_IS_A_MAP = prove\r
+ (`(--):complex->complex = vector_map ((--):real->real)`,\r
+ REWRITE_TAC[COMPLEX_VECTOR_MAP;complex_neg]);;\r
+\r
+let VECTOR_NEG_IS_A_MAP = prove\r
+ (`(--):real^N->real^N = vector_map ((--):real->real)`,\r
+ REWRITE_TAC[FUN_EQ_THM;CART_EQ;VECTOR_NEG_COMPONENT;VECTOR_MAP_COMPONENT]);;\r
+\r
+let VECTOR_MAP_VECTOR_MAP_ALT = prove\r
+ (`!f:A^N->B^N g:C^N->A^N f' g'. f = vector_map f' /\ g = vector_map g' ==>\r
+ f o g = vector_map (f' o g')`,\r
+ SIMP_TAC[o_DEF;FUN_EQ_THM;VECTOR_MAP_VECTOR_MAP]);;\r
+\r
+let COMPLEX_VECTOR_MAP2 = prove\r
+ (`!f:complex->complex->complex g. f = vector_map2 g <=>\r
+ !z1 z2. f z1 z2 = complex (g (Re z1) (Re z2), g (Im z1) (Im z2))`,\r
+ REWRITE_TAC[vector_map2;FUN_EQ_THM;complex]\r
+ THEN REPEAT (GEN_TAC ORELSE EQ_TAC)\r
+ THEN ASM_SIMP_TAC[CART_EQ;DIMINDEX_2;FORALL_2;LAMBDA_BETA;VECTOR_2;RE_DEF;\r
+ IM_DEF]);;\r
+\r
+let VECTOR_MAP2_RVECTOR_MAP_ALT = prove(\r
+ `!f:complex->complex->complex g:complex->complex f' g'.\r
+ f = vector_map2 f' /\ g = vector_map g'\r
+ ==> (\x y. f x (g y)) = vector_map2 (\x y. f' x (g' y))`,\r
+ SIMP_TAC[FUN_EQ_THM;VECTOR_MAP2_RVECTOR_MAP]);;\r
+\r
+let COMPLEX_ADD_IS_A_MAP = prove\r
+ (`(+):complex->complex->complex = vector_map2 ((+):real->real->real)`,\r
+ REWRITE_TAC[COMPLEX_VECTOR_MAP2;complex_add]);;\r
+\r
+let VECTOR_ADD_IS_A_MAP = prove\r
+ (`(+):real^N->real^N->real^N = vector_map2 ((+):real->real->real)`,\r
+ REWRITE_TAC[FUN_EQ_THM;CART_EQ;VECTOR_ADD_COMPONENT;VECTOR_MAP2_COMPONENT]);;\r
+\r
+let COMPLEX_SUB_IS_A_MAP = prove\r
+ (`(-):complex->complex->complex = vector_map2 ((-):real->real->real)`, \r
+ ONCE_REWRITE_TAC[prove(`(-) = \x y:complex. x-y`,REWRITE_TAC[FUN_EQ_THM])]\r
+ THEN ONCE_REWRITE_TAC[prove(`(-) = \x y:real. x-y`,REWRITE_TAC[FUN_EQ_THM])]\r
+ THEN REWRITE_TAC[complex_sub;real_sub]\r
+ THEN MATCH_MP_TAC VECTOR_MAP2_RVECTOR_MAP_ALT\r
+ THEN REWRITE_TAC[COMPLEX_NEG_IS_A_MAP;COMPLEX_ADD_IS_A_MAP]);;\r
+\r
+let VECTOR_SUB_IS_A_MAP = prove\r
+ (`(-):real^N->real^N->real^N = vector_map2 ((-):real->real->real)`,\r
+ REWRITE_TAC[FUN_EQ_THM;CART_EQ;VECTOR_SUB_COMPONENT;VECTOR_MAP2_COMPONENT]);;\r
+\r
+let COMMON_TAC x = \r
+ SIMP_TAC[CART_EQ;pastecart;x;LAMBDA_BETA] THEN REPEAT STRIP_TAC\r
+ THEN REPEAT COND_CASES_TAC THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[]\r
+ THEN SUBGOAL_THEN `1<= i-dimindex(:N) /\ i-dimindex(:N) <= dimindex(:M)`\r
+ ASSUME_TAC\r
+ THEN ASM_SIMP_TAC[LAMBDA_BETA]\r
+ THEN REPEAT (POP_ASSUM (MP_TAC o REWRITE_RULE[DIMINDEX_FINITE_SUM]))\r
+ THEN ARITH_TAC;;\r
+\r
+let PASTECART_VECTOR_MAP = prove\r
+ (`!f:A->B x:A^N y:A^M.\r
+ pastecart (vector_map f x) (vector_map f y) =\r
+ vector_map f (pastecart x y)`,\r
+ COMMON_TAC vector_map);;\r
+\r
+let PASTECART_VECTOR_MAP2 = prove\r
+ (`!f:A->B->C x1:A^N x2 y1:A^M y2.\r
+ pastecart (vector_map2 f x1 x2) (vector_map2 f y1 y2)\r
+ = vector_map2 f (pastecart x1 y1) (pastecart x2 y2)`,\r
+ COMMON_TAC vector_map2);;\r
+\r
+let vector_zip = new_definition\r
+ `vector_zip (v1:A^N) (v2:B^N) : (A#B)^N = lambda i. (v1$i,v2$i)`;;\r
+\r
+let VECTOR_ZIP_COMPONENT = prove\r
+ (`!i v1:A^N v2:B^N. (vector_zip v1 v2)$i = (v1$i,v2$i)`,\r
+ REPEAT GEN_TAC THEN CHOOSE_TAC (INST_TYPE [`:A#B`,`:C`] (SPEC_ALL\r
+ FINITE_INDEX_INRANGE_2)) THEN ASM_SIMP_TAC[vector_zip;LAMBDA_BETA]);;\r
+\r
+let vector_unzip = new_definition\r
+ `vector_unzip (v:(A#B)^N):(A^N)#(B^N) = vector_map FST v,vector_map SND v`;;\r
+\r
+let VECTOR_UNZIP_COMPONENT = prove\r
+ (`!i v:(A#B)^N. (FST (vector_unzip v))$i = FST (v$i)\r
+ /\ (SND (vector_unzip v))$i = SND (v$i)`,\r
+ REWRITE_TAC[vector_unzip;VECTOR_MAP_COMPONENT]);;\r
+\r
+let VECTOR_MAP2_AS_VECTOR_MAP = prove\r
+ (`!f:A->B->C v1:A^N v2:B^N.\r
+ vector_map2 f v1 v2 = vector_map (UNCURRY f) (vector_zip v1 v2)`,\r
+ REWRITE_TAC[CART_EQ;VECTOR_MAP2_COMPONENT;VECTOR_MAP_COMPONENT;\r
+ VECTOR_ZIP_COMPONENT;UNCURRY_DEF]);;\r
+\r
+\r
+\r
+(* ========================================================================= *)\r
+(* BASIC ARITHMETIC *)\r
+(* ========================================================================= *)\r
+\r
+make_overloadable "%" `:A-> B-> B`;; \r
+\r
+let prioritize_cvector () =\r
+ overload_interface("--",`(cvector_neg):complex^N->complex^N`);\r
+ overload_interface("+",`(cvector_add):complex^N->complex^N->complex^N`);\r
+ overload_interface("-",`(cvector_sub):complex^N->complex^N->complex^N`);\r
+ overload_interface("%",`(cvector_mul):complex->complex^N->complex^N`);;\r
+\r
+let cvector_zero = new_definition\r
+ `cvector_zero:complex^N = vector_const (Cx(&0))`;;\r
+\r
+let cvector_neg = new_definition\r
+ `cvector_neg :complex^N->complex^N = vector_map (--)`;;\r
+\r
+let cvector_add = new_definition\r
+ `cvector_add :complex^N->complex^N->complex^N = vector_map2 (+)`;;\r
+\r
+let cvector_sub = new_definition\r
+ `cvector_sub :complex^N->complex^N->complex^N = vector_map2 (-)`;;\r
+\r
+let cvector_mul = new_definition\r
+ `(cvector_mul:complex->complex^N->complex^N) a = vector_map (( * ) a)`;;\r
+\r
+overload_interface("%",`(%):real->real^N->real^N`);;\r
+prioritize_cvector ();;\r
+\r
+let CVECTOR_ZERO_COMPONENT = prove\r
+ (`!i. (cvector_zero:complex^N)$i = Cx(&0)`,\r
+ REWRITE_TAC[cvector_zero;VECTOR_CONST_COMPONENT]);;\r
+\r
+let CVECTOR_NON_ZERO = prove\r
+ (`!x:complex^N. ~(x=cvector_zero)\r
+ <=> ?i. 1 <= i /\ i <= dimindex(:N) /\ ~(x$i = Cx(&0))`,\r
+ GEN_TAC THEN GEN_REWRITE_TAC (RATOR_CONV o ONCE_DEPTH_CONV) [CART_EQ]\r
+ THEN REWRITE_TAC[CVECTOR_ZERO_COMPONENT] THEN MESON_TAC[]);;\r
+\r
+let CVECTOR_ADD_COMPONENT = prove\r
+ (`!X Y:complex^N i. ((X + Y)$i = X$i + Y$i)`,\r
+ REWRITE_TAC[cvector_add;VECTOR_MAP2_COMPONENT]);;\r
+\r
+let CVECTOR_SUB_COMPONENT = prove \r
+ (`!X:complex^N Y i. ((X - Y)$i = X$i - Y$i)`,\r
+ REWRITE_TAC[cvector_sub;VECTOR_MAP2_COMPONENT]);;\r
+\r
+let CVECTOR_NEG_COMPONENT = prove\r
+ (`!X:complex^N i. ((--X)$i = --(X$i))`,\r
+ REWRITE_TAC[cvector_neg;VECTOR_MAP_COMPONENT]);;\r
+\r
+let CVECTOR_MUL_COMPONENT = prove\r
+ (`!c:complex X:complex^N i. ((c % X)$i = c * X$i)`,\r
+ REWRITE_TAC[cvector_mul;VECTOR_MAP_COMPONENT]);;\r
+\r
+(* Simple generic tactic adapted from VECTOR_ARITH_TAC *)\r
+let CVECTOR_ARITH_TAC =\r
+ let RENAMED_LAMBDA_BETA th =\r
+ if fst(dest_fun_ty(type_of(funpow 3 rand (concl th)))) = aty\r
+ then INST_TYPE [aty,bty; bty,aty] LAMBDA_BETA else LAMBDA_BETA \r
+ in\r
+ POP_ASSUM_LIST(K ALL_TAC) THEN\r
+ REPEAT(GEN_TAC ORELSE CONJ_TAC ORELSE DISCH_TAC ORELSE EQ_TAC) THEN\r
+ REPEAT(POP_ASSUM MP_TAC) THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN\r
+ GEN_REWRITE_TAC ONCE_DEPTH_CONV [CART_EQ] THEN\r
+ REWRITE_TAC[AND_FORALL_THM] THEN TRY EQ_TAC THEN\r
+ TRY(MATCH_MP_TAC MONO_FORALL) THEN GEN_TAC THEN\r
+ REWRITE_TAC[TAUT `(a ==> b) /\ (a ==> c) <=> a ==> b /\ c`;\r
+ TAUT `(a ==> b) \/ (a ==> c) <=> a ==> b \/ c`] THEN\r
+ TRY(MATCH_MP_TAC(TAUT `(a ==> b ==> c) ==> (a ==> b) ==> (a ==> c)`)) THEN\r
+ REWRITE_TAC[cvector_zero;cvector_add; cvector_sub; cvector_neg; cvector_mul; vector_map;vector_map2;vector_const] THEN\r
+ DISCH_THEN(fun th -> REWRITE_TAC[MATCH_MP(RENAMED_LAMBDA_BETA th) th]) THEN\r
+ SIMPLE_COMPLEX_ARITH_TAC;;\r
+\r
+let CVECTOR_ARITH tm = prove(tm,CVECTOR_ARITH_TAC);;\r
+\r
+(* ========================================================================= *)\r
+(* VECTOR SPACE AXIOMS AND ADDITIONAL BASIC RESULTS *)\r
+(* ========================================================================= *)\r
+\r
+let CVECTOR_MAP_PROPERTY thm =\r
+ VECTOR_MAP_PROPERTY thm [cvector_zero;cvector_add;cvector_sub;cvector_neg;\r
+ cvector_mul];;\r
+\r
+let CVECTOR_ADD_SYM = CVECTOR_MAP_PROPERTY\r
+ `!x y:complex^N. x + y = y + x`\r
+ COMPLEX_ADD_SYM;;\r
+\r
+let CVECTOR_ADD_ASSOC = CVECTOR_MAP_PROPERTY\r
+ `!x y z:complex^N. x + (y + z) = (x + y) + z`\r
+ COMPLEX_ADD_ASSOC;;\r
+\r
+let CVECTOR_ADD_ID = CVECTOR_MAP_PROPERTY\r
+ `!x:complex^N. x + cvector_zero = x /\ cvector_zero + x = x`\r
+ (CONJ COMPLEX_ADD_RID COMPLEX_ADD_LID);;\r
+\r
+let [CVECTOR_ADD_RID;CVECTOR_ADD_LID] = GCONJUNCTS CVECTOR_ADD_ID;;\r
+\r
+let CVECTOR_ADD_INV = CVECTOR_MAP_PROPERTY\r
+ `!x:complex^N. x + -- x = cvector_zero /\ --x + x = cvector_zero`\r
+ (CONJ COMPLEX_ADD_RINV COMPLEX_ADD_LINV);;\r
+\r
+let CVECTOR_MUL_ASSOC = CVECTOR_MAP_PROPERTY\r
+ `!a b x:complex^N. a % (b % x) = (a * b) % x`\r
+ COMPLEX_MUL_ASSOC;;\r
+\r
+let CVECTOR_SUB_LDISTRIB = CVECTOR_MAP_PROPERTY\r
+ `!c x y:complex^N. c % (x - y) = c % x - c % y`\r
+ COMPLEX_SUB_LDISTRIB;;\r
+\r
+let CVECTOR_SCALAR_RDIST = CVECTOR_MAP_PROPERTY\r
+ `!a b x:complex^N. (a + b) % x = a % x + b % x`\r
+ COMPLEX_ADD_RDISTRIB;;\r
+\r
+let CVECTOR_MUL_ID = CVECTOR_MAP_PROPERTY\r
+ `!x:complex^N. Cx(&1) % x = x`\r
+ COMPLEX_MUL_LID;;\r
+\r
+let CVECTOR_SUB_REFL = CVECTOR_MAP_PROPERTY\r
+ `!x:complex^N. x - x = cvector_zero`\r
+ COMPLEX_SUB_REFL;;\r
+\r
+let CVECTOR_SUB_RADD = CVECTOR_MAP_PROPERTY\r
+ `!x y:complex^N. x - (x + y) = --y`\r
+ COMPLEX_ADD_SUB2;;\r
+\r
+let CVECTOR_NEG_SUB = CVECTOR_MAP_PROPERTY\r
+ `!x y:complex^N. --(x - y) = y - x`\r
+ COMPLEX_NEG_SUB;;\r
+\r
+let CVECTOR_SUB_EQ = CVECTOR_MAP_PROPERTY\r
+ `!x y:complex^N. (x - y = cvector_zero) <=> (x = y)`\r
+ COMPLEX_SUB_0;;\r
+\r
+let CVECTOR_MUL_LZERO = CVECTOR_MAP_PROPERTY\r
+ `!x. Cx(&0) % x = cvector_zero`\r
+ COMPLEX_MUL_LZERO;;\r
+\r
+let CVECTOR_SUB_ADD = CVECTOR_MAP_PROPERTY\r
+ `!x y:complex^N. (x - y) + y = x`\r
+ COMPLEX_SUB_ADD;;\r
+\r
+let CVECTOR_SUB_ADD2 = CVECTOR_MAP_PROPERTY\r
+ `!x y:complex^N. y + (x - y) = x`\r
+ COMPLEX_SUB_ADD2;;\r
+\r
+let CVECTOR_ADD_LDISTRIB = CVECTOR_MAP_PROPERTY\r
+ `!c x y:complex^N. c % (x + y) = c % x + c % y`\r
+ COMPLEX_ADD_LDISTRIB;;\r
+\r
+let CVECTOR_ADD_RDISTRIB = CVECTOR_MAP_PROPERTY\r
+ `!a b x:complex^N. (a + b) % x = a % x + b % x`\r
+ COMPLEX_ADD_RDISTRIB;;\r
+\r
+let CVECTOR_SUB_RDISTRIB = CVECTOR_MAP_PROPERTY\r
+ `!a b x:complex^N. (a - b) % x = a % x - b % x`\r
+ COMPLEX_SUB_RDISTRIB;;\r
+\r
+let CVECTOR_ADD_SUB = CVECTOR_MAP_PROPERTY\r
+ `!x y:complex^N. (x + y:complex^N) - x = y`\r
+ COMPLEX_ADD_SUB;;\r
+\r
+let CVECTOR_EQ_ADDR = CVECTOR_MAP_PROPERTY\r
+ `!x y:complex^N. (x + y = x) <=> (y = cvector_zero)`\r
+ COMPLEX_EQ_ADD_LCANCEL_0;;\r
+\r
+let CVECTOR_SUB = CVECTOR_MAP_PROPERTY\r
+ `!x y:complex^N. x - y = x + --(y:complex^N)`\r
+ complex_sub;;\r
+\r
+let CVECTOR_SUB_RZERO = CVECTOR_MAP_PROPERTY\r
+ `!x:complex^N. x - cvector_zero = x`\r
+ COMPLEX_SUB_RZERO;;\r
+\r
+let CVECTOR_MUL_RZERO = CVECTOR_MAP_PROPERTY\r
+ `!c:complex. c % cvector_zero = cvector_zero`\r
+ COMPLEX_MUL_RZERO;;\r
+\r
+let CVECTOR_MUL_LZERO = CVECTOR_MAP_PROPERTY\r
+ `!x:complex^N. Cx(&0) % x = cvector_zero`\r
+ COMPLEX_MUL_LZERO;;\r
+\r
+let CVECTOR_MUL_EQ_0 = prove\r
+ (`!a:complex x:complex^N.\r
+ (a % x = cvector_zero <=> a = Cx(&0) \/ x = cvector_zero)`,\r
+ REPEAT STRIP_TAC THEN EQ_TAC THENL [\r
+ ASM_CASES_TAC `a=Cx(&0)` THENL [\r
+ ASM_REWRITE_TAC[];\r
+ GEN_REWRITE_TAC (RATOR_CONV o DEPTH_CONV) [CART_EQ]\r
+ THEN ASM_REWRITE_TAC[CVECTOR_MUL_COMPONENT;CVECTOR_ZERO_COMPONENT;\r
+ COMPLEX_ENTIRE]\r
+ THEN GEN_REWRITE_TAC (RAND_CONV o DEPTH_CONV) [CART_EQ]\r
+ THEN REWRITE_TAC[CVECTOR_ZERO_COMPONENT];\r
+ ];\r
+ REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[CVECTOR_MUL_RZERO;CVECTOR_MUL_LZERO];\r
+ ]);;\r
+\r
+let CVECTOR_NEG_MINUS1 = CVECTOR_MAP_PROPERTY\r
+ `!x:complex^N. --x = (--(Cx(&1))) % x`\r
+ (GSYM COMPLEX_NEG_MINUS1);;\r
+\r
+let CVECTOR_SUB_LZERO = CVECTOR_MAP_PROPERTY\r
+ `!x:complex^N. cvector_zero - x = --x`\r
+ COMPLEX_SUB_LZERO;;\r
+\r
+let CVECTOR_NEG_NEG = CVECTOR_MAP_PROPERTY\r
+ `!x:complex^N. --(--(x:complex^N)) = x`\r
+ COMPLEX_NEG_NEG;;\r
+\r
+let CVECTOR_MUL_LNEG = CVECTOR_MAP_PROPERTY\r
+ `!c x:complex^N. --c % x = --(c % x)`\r
+ COMPLEX_MUL_LNEG;;\r
+\r
+let CVECTOR_MUL_RNEG = CVECTOR_MAP_PROPERTY\r
+ `!c x:complex^N. c % --x = --(c % x)`\r
+ COMPLEX_MUL_RNEG;;\r
+\r
+let CVECTOR_NEG_0 = CVECTOR_MAP_PROPERTY\r
+ `--cvector_zero = cvector_zero`\r
+ COMPLEX_NEG_0;;\r
+\r
+let CVECTOR_NEG_EQ_0 = CVECTOR_MAP_PROPERTY\r
+ `!x:complex^N. --x = cvector_zero <=> x = cvector_zero`\r
+ COMPLEX_NEG_EQ_0;;\r
+\r
+let CVECTOR_ADD_AC = prove\r
+ (`!x y z:complex^N.\r
+ (x + y = y + x) /\ ((x + y) + z = x + y + z) /\ (x + y + z = y + x + z)`,\r
+ MESON_TAC[CVECTOR_ADD_SYM;CVECTOR_ADD_ASSOC]);;\r
+\r
+let CVECTOR_MUL_LCANCEL = prove\r
+ (`!a x y:complex^N. a % x = a % y <=> a = Cx(&0) \/ x = y`,\r
+ MESON_TAC[CVECTOR_MUL_EQ_0;CVECTOR_SUB_LDISTRIB;CVECTOR_SUB_EQ]);;\r
+\r
+let CVECTOR_MUL_RCANCEL = prove\r
+ (`!a b x:complex^N. a % x = b % x <=> a = b \/ x = cvector_zero`,\r
+ MESON_TAC[CVECTOR_MUL_EQ_0;CVECTOR_SUB_RDISTRIB;COMPLEX_SUB_0;CVECTOR_SUB_EQ]);;\r
+\r
+\r
+(* ========================================================================= *)\r
+(* LINEARITY *)\r
+(* ========================================================================= *)\r
+\r
+let clinear = new_definition\r
+ `clinear (f:complex^M->complex^N)\r
+ <=> (!x y. f(x + y) = f(x) + f(y)) /\ (!c x. f(c % x) = c % f(x))`;;\r
+\r
+let COMMON_TAC additional_thms =\r
+ SIMP_TAC[clinear] THEN REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[CART_EQ]\r
+ THEN SIMP_TAC(CVECTOR_ADD_COMPONENT::CVECTOR_MUL_COMPONENT::additional_thms)\r
+ THEN SIMPLE_COMPLEX_ARITH_TAC;;\r
+\r
+let CLINEAR_COMPOSE_CMUL = prove\r
+ (`!f:complex^M->complex^N c. clinear f ==> clinear (\x. c % f x)`,\r
+ COMMON_TAC[]);;\r
+\r
+let CLINEAR_COMPOSE_NEG = prove\r
+ (`!f:complex^M->complex^N. clinear f ==> clinear (\x. --(f x))`,\r
+ COMMON_TAC[CVECTOR_NEG_COMPONENT]);;\r
+\r
+let CLINEAR_COMPOSE_ADD = prove\r
+ (`!f:complex^M->complex^N g. clinear f /\ clinear g ==> clinear (\x. f x + g x)`,\r
+ COMMON_TAC[]);;\r
+\r
+let CLINEAR_COMPOSE_SUB = prove\r
+ (`!f:complex^M->complex^N g. clinear f /\ clinear g ==> clinear (\x. f x - g x)`,\r
+ COMMON_TAC[CVECTOR_SUB_COMPONENT]);;\r
+\r
+let CLINEAR_COMPOSE = prove\r
+ (`!f:complex^M->complex^N g. clinear f /\ clinear g ==> clinear (g o f)`,\r
+ SIMP_TAC[clinear;o_THM]);;\r
+\r
+let CLINEAR_ID = prove\r
+ (`clinear (\x:complex^N. x)`,\r
+ REWRITE_TAC[clinear]);;\r
+\r
+let CLINEAR_I = prove\r
+ (`clinear (I:complex^N->complex^N)`,\r
+ REWRITE_TAC[I_DEF;CLINEAR_ID]);;\r
+\r
+let CLINEAR_ZERO = prove\r
+ (`clinear ((\x. cvector_zero):complex^M->complex^N)`,\r
+ COMMON_TAC[CVECTOR_ZERO_COMPONENT]);;\r
+\r
+let CLINEAR_NEGATION = prove\r
+ (`clinear ((--):complex^N->complex^N)`,\r
+ COMMON_TAC[CVECTOR_NEG_COMPONENT]);;\r
+\r
+let CLINEAR_VMUL_COMPONENT = prove\r
+ (`!f:complex^M->complex^N v:complex^P k.\r
+ clinear f /\ 1 <= k /\ k <= dimindex(:N) ==> clinear (\x. (f x)$k % v)`,\r
+ COMMON_TAC[]);;\r
+\r
+let CLINEAR_0 = prove\r
+ (`!f:complex^M->complex^N. clinear f ==> (f cvector_zero = cvector_zero)`,\r
+ MESON_TAC[CVECTOR_MUL_LZERO;clinear]);;\r
+\r
+let CLINEAR_CMUL = prove\r
+ (`!f:complex^M->complex^N c x. clinear f ==> (f (c % x) = c % f x)`,\r
+ SIMP_TAC[clinear]);;\r
+\r
+let CLINEAR_NEG = prove\r
+ (`!f:complex^M->complex^N x. clinear f ==> (f (--x) = --(f x))`,\r
+ ONCE_REWRITE_TAC[CVECTOR_NEG_MINUS1] THEN SIMP_TAC[CLINEAR_CMUL]);;\r
+\r
+let CLINEAR_ADD = prove\r
+ (`!f:complex^M->complex^N x y. clinear f ==> (f (x + y) = f x + f y)`,\r
+ SIMP_TAC[clinear]);;\r
+\r
+let CLINEAR_SUB = prove\r
+ (`!f:complex^M->complex^N x y. clinear f ==> (f(x - y) = f x - f y)`,\r
+ SIMP_TAC[CVECTOR_SUB;CLINEAR_ADD;CLINEAR_NEG]);;\r
+\r
+let CLINEAR_INJECTIVE_0 = prove\r
+ (`!f:complex^M->complex^N.\r
+ clinear f\r
+ ==> ((!x y. f x = f y ==> x = y)\r
+ <=> (!x. f x = cvector_zero ==> x = cvector_zero))`,\r
+ ONCE_REWRITE_TAC[GSYM CVECTOR_SUB_EQ] \r
+ THEN SIMP_TAC[CVECTOR_SUB_RZERO;GSYM CLINEAR_SUB]\r
+ THEN MESON_TAC[CVECTOR_SUB_RZERO]);;\r
+\r
+\r
+\r
+(* ========================================================================= *)\r
+(* PASTING COMPLEX VECTORS *)\r
+(* ========================================================================= *)\r
+\r
+let CLINEAR_FSTCART_SNDCART = prove\r
+ (`clinear fstcart /\ clinear sndcart`,\r
+ SIMP_TAC[clinear;fstcart;sndcart;CART_EQ;LAMBDA_BETA;CVECTOR_ADD_COMPONENT;\r
+ CVECTOR_MUL_COMPONENT; DIMINDEX_FINITE_SUM;\r
+ ARITH_RULE `x <= a ==> x <= a + b:num`;\r
+ ARITH_RULE `x <= b ==> x + a <= a + b:num`]);;\r
+\r
+let FSTCART_CLINEAR = CONJUNCT1 CLINEAR_FSTCART_SNDCART;;\r
+let SNDCART_CLINEAR = CONJUNCT2 CLINEAR_FSTCART_SNDCART;;\r
+\r
+let FSTCART_SNDCART_CVECTOR_ZERO = prove\r
+ (`fstcart cvector_zero = cvector_zero /\ sndcart cvector_zero = cvector_zero`,\r
+ SIMP_TAC[CVECTOR_ZERO_COMPONENT;fstcart;sndcart;LAMBDA_BETA;CART_EQ;\r
+ DIMINDEX_FINITE_SUM;ARITH_RULE `x <= a ==> x <= a + b:num`;\r
+ ARITH_RULE `x <= b ==> x + a <= a + b:num`]);;\r
+\r
+let FSTCART_CVECTOR_ZERO = CONJUNCT1 FSTCART_SNDCART_CVECTOR_ZERO;;\r
+let SNDCART_CVECTOR_ZERO = CONJUNCT2 FSTCART_SNDCART_CVECTOR_ZERO;;\r
+\r
+let FSTCART_SNDCART_CVECTOR_ADD = prove\r
+ (`!x:complex^(M,N)finite_sum y.\r
+ fstcart(x + y) = fstcart(x) + fstcart(y) \r
+ /\ sndcart(x + y) = sndcart(x) + sndcart(y)`,\r
+ REWRITE_TAC[REWRITE_RULE[clinear] CLINEAR_FSTCART_SNDCART]);;\r
+\r
+let FSTCART_SNDCART_CVECTOR_MUL = prove\r
+ (`!x:complex^(M,N)finite_sum c.\r
+ fstcart(c % x) = c % fstcart(x) /\ sndcart(c % x) = c % sndcart(x)`,\r
+ REWRITE_TAC[REWRITE_RULE[clinear] CLINEAR_FSTCART_SNDCART]);;\r
+\r
+let PASTECART_TAC xs =\r
+ REWRITE_TAC(PASTECART_EQ::FSTCART_PASTECART::SNDCART_PASTECART::xs);;\r
+\r
+let PASTECART_CVECTOR_ZERO = prove\r
+ (`pastecart (cvector_zero:complex^N) (cvector_zero:complex^M) = cvector_zero`,\r
+ PASTECART_TAC[FSTCART_SNDCART_CVECTOR_ZERO]);;\r
+\r
+let PASTECART_EQ_CVECTOR_ZERO = prove\r
+ (`!x:complex^N y:complex^M.\r
+ pastecart x y = cvector_zero <=> x = cvector_zero /\ y = cvector_zero`,\r
+ PASTECART_TAC [FSTCART_SNDCART_CVECTOR_ZERO]);;\r
+\r
+let PASTECART_CVECTOR_ADD = prove\r
+ (`!x1 y2 x2:complex^N y2:complex^M.\r
+ pastecart x1 y1 + pastecart x2 y2 = pastecart (x1 + x2) (y1 + y2)`,\r
+ PASTECART_TAC [FSTCART_SNDCART_CVECTOR_ADD]);;\r
+\r
+let PASTECART_CVECTOR_MUL = prove\r
+ (`!x1 x2 c:complex.\r
+ pastecart (c % x1) (c % y1) = c % pastecart x1 y1`, PASTECART_TAC [FSTCART_SNDCART_CVECTOR_MUL]);;\r
+\r
+\r
+(* ========================================================================= *)\r
+(* REAL AND IMAGINARY VECTORS *)\r
+(* ========================================================================= *)\r
+\r
+let cvector_re = new_definition\r
+ `cvector_re :complex^N -> real^N = vector_map Re`;;\r
+let cvector_im = new_definition\r
+ `cvector_im :complex^N -> real^N = vector_map Im`;;\r
+let vector_to_cvector = new_definition\r
+ `vector_to_cvector :real^N -> complex^N = vector_map Cx`;;\r
+\r
+let CVECTOR_RE_COMPONENT = prove\r
+ (`!x:complex^N i. (cvector_re x)$i = Re (x$i)`,\r
+ REWRITE_TAC[cvector_re;VECTOR_MAP_COMPONENT]);;\r
+let CVECTOR_IM_COMPONENT = prove\r
+ (`!x:complex^N i. (cvector_im x)$i = Im (x$i)`,\r
+ REWRITE_TAC[cvector_im;VECTOR_MAP_COMPONENT]);;\r
+let VECTOR_TO_CVECTOR_COMPONENT = prove\r
+ (`!x:real^N i. (vector_to_cvector x)$i = Cx(x$i)`,\r
+ REWRITE_TAC[vector_to_cvector;VECTOR_MAP_COMPONENT]);;\r
+\r
+let VECTOR_TO_CVECTOR_ZERO = prove\r
+ (`vector_to_cvector (vec 0) = cvector_zero:complex^N`,\r
+ ONCE_REWRITE_TAC[CART_EQ]\r
+ THEN REWRITE_TAC[VECTOR_TO_CVECTOR_COMPONENT;CVECTOR_ZERO_COMPONENT;\r
+ VEC_COMPONENT]);;\r
+\r
+let VECTOR_TO_CVECTOR_ZERO_EQ = prove\r
+ (`!x:real^N. vector_to_cvector x = cvector_zero <=> x = vec 0`,\r
+ GEN_TAC THEN EQ_TAC THEN SIMP_TAC[VECTOR_TO_CVECTOR_ZERO]\r
+ THEN ONCE_REWRITE_TAC[CART_EQ]\r
+ THEN SIMP_TAC[VECTOR_TO_CVECTOR_COMPONENT;CVECTOR_ZERO_COMPONENT;\r
+ VEC_COMPONENT;CX_INJ]);;\r
+\r
+let CVECTOR_ZERO_VEC0 = prove\r
+ (`!x:complex^N. x = cvector_zero <=> cvector_re x = vec 0 /\ cvector_im x = vec 0`,\r
+ ONCE_REWRITE_TAC[CART_EQ]\r
+ THEN REWRITE_TAC[CVECTOR_ZERO_COMPONENT;CVECTOR_RE_COMPONENT;\r
+ CVECTOR_IM_COMPONENT;VEC_COMPONENT;COMPLEX_EQ;RE_CX;IM_CX]\r
+ THEN MESON_TAC[]);;\r
+\r
+let VECTOR_TO_CVECTOR_MUL = prove\r
+ (`!a x:real^N. vector_to_cvector (a % x) = Cx a % vector_to_cvector x`,\r
+ ONCE_REWRITE_TAC[CART_EQ] THEN REWRITE_TAC[VECTOR_TO_CVECTOR_COMPONENT;CVECTOR_MUL_COMPONENT;VECTOR_MUL_COMPONENT;CX_MUL]);;\r
+\r
+let CVECTOR_EQ = prove\r
+ (`!x:complex^N y z.\r
+ x = vector_to_cvector y + ii % vector_to_cvector z\r
+ <=> cvector_re x = y /\ cvector_im x = z`,\r
+ ONCE_REWRITE_TAC[CART_EQ]\r
+ THEN REWRITE_TAC[CVECTOR_ADD_COMPONENT;CVECTOR_MUL_COMPONENT;\r
+ CVECTOR_RE_COMPONENT;CVECTOR_IM_COMPONENT;VECTOR_TO_CVECTOR_COMPONENT]\r
+ THEN REWRITE_TAC[COMPLEX_EQ;RE_CX;IM_CX;RE_ADD;IM_ADD;RE_MUL_II;REAL_NEG_0;\r
+ REAL_ADD_RID;REAL_ADD_LID;IM_MUL_II] THEN MESON_TAC[]);;\r
+\r
+let CVECTOR_RE_VECTOR_TO_CVECTOR = prove\r
+ (`!x:real^N. cvector_re (vector_to_cvector x) = x`,\r
+ ONCE_REWRITE_TAC[CART_EQ]\r
+ THEN REWRITE_TAC[CVECTOR_RE_COMPONENT;VECTOR_TO_CVECTOR_COMPONENT;RE_CX]);;\r
+\r
+let CVECTOR_IM_VECTOR_TO_CVECTOR = prove\r
+ (`!x:real^N. cvector_im (vector_to_cvector x) = vec 0`,\r
+ ONCE_REWRITE_TAC[CART_EQ]\r
+ THEN REWRITE_TAC[CVECTOR_IM_COMPONENT;VECTOR_TO_CVECTOR_COMPONENT;IM_CX;\r
+ VEC_COMPONENT]);;\r
+\r
+let CVECTOR_IM_VECTOR_TO_CVECTOR_IM = prove\r
+ (`!x:real^N. cvector_im (ii % vector_to_cvector x) = x`,\r
+ ONCE_REWRITE_TAC[CART_EQ]\r
+ THEN REWRITE_TAC[CVECTOR_IM_COMPONENT;VECTOR_TO_CVECTOR_COMPONENT;IM_CX;\r
+ VEC_COMPONENT;CVECTOR_MUL_COMPONENT;IM_MUL_II;RE_CX]);;\r
+\r
+let VECTOR_TO_CVECTOR_CVECTOR_RE_IM = prove\r
+ (`!x:complex^N.\r
+ vector_to_cvector (cvector_re x) + ii % vector_to_cvector (cvector_im x)\r
+ = x`,\r
+ GEN_TAC THEN MATCH_MP_TAC EQ_SYM THEN REWRITE_TAC[CVECTOR_EQ]);;\r
+\r
+let CVECTOR_IM_VECTOR_TO_CVECTOR_RE_IM = prove\r
+ (`!x y:real^N. cvector_im (vector_to_cvector x + ii % vector_to_cvector y) = y`,\r
+ ONCE_REWRITE_TAC[CART_EQ]\r
+ THEN REWRITE_TAC[CVECTOR_IM_COMPONENT;CVECTOR_ADD_COMPONENT;\r
+ CVECTOR_MUL_COMPONENT;VECTOR_TO_CVECTOR_COMPONENT;IM_ADD;IM_CX;IM_MUL_II;\r
+ RE_CX;REAL_ADD_LID]);;\r
+\r
+let CVECTOR_RE_VECTOR_TO_CVECTOR_RE_IM = prove\r
+ (`!x y:real^N. cvector_re (vector_to_cvector x + ii % vector_to_cvector y)= x`,\r
+ ONCE_REWRITE_TAC[CART_EQ]\r
+ THEN REWRITE_TAC[CVECTOR_RE_COMPONENT;CVECTOR_ADD_COMPONENT;\r
+ CVECTOR_MUL_COMPONENT;RE_ADD;VECTOR_TO_CVECTOR_COMPONENT;RE_CX;RE_MUL_CX;\r
+ RE_II;REAL_MUL_LZERO;REAL_ADD_RID]);;\r
+\r
+let CVECTOR_RE_ADD = prove\r
+ (`!x y:complex^N. cvector_re (x+y) = cvector_re x + cvector_re y`,\r
+ ONCE_REWRITE_TAC[CART_EQ] THEN REWRITE_TAC[CVECTOR_RE_COMPONENT;\r
+ VECTOR_ADD_COMPONENT;CVECTOR_ADD_COMPONENT;RE_ADD]);;\r
+\r
+let CVECTOR_IM_ADD = prove\r
+ (`!x y:complex^N. cvector_im (x+y) = cvector_im x + cvector_im y`,\r
+ ONCE_REWRITE_TAC[CART_EQ]\r
+ THEN REWRITE_TAC[CVECTOR_IM_COMPONENT;VECTOR_ADD_COMPONENT;\r
+ CVECTOR_ADD_COMPONENT;IM_ADD]);;\r
+\r
+let CVECTOR_RE_MUL = prove\r
+ (`!a x:complex^N. cvector_re (Cx a % x) = a % cvector_re x`,\r
+ ONCE_REWRITE_TAC[CART_EQ]\r
+ THEN REWRITE_TAC[CVECTOR_RE_COMPONENT;VECTOR_MUL_COMPONENT;\r
+ CVECTOR_MUL_COMPONENT;RE_MUL_CX]);;\r
+\r
+let CVECTOR_IM_MUL = prove\r
+ (`!a x:complex^N. cvector_im (Cx a % x) = a % cvector_im x`,\r
+ ONCE_REWRITE_TAC[CART_EQ]\r
+ THEN REWRITE_TAC[CVECTOR_IM_COMPONENT;VECTOR_MUL_COMPONENT;\r
+ CVECTOR_MUL_COMPONENT;IM_MUL_CX]);;\r
+\r
+let CVECTOR_RE_VECTOR_MAP = prove\r
+ (`!f v:A^N. cvector_re (vector_map f v) = vector_map (Re o f) v`,\r
+ REWRITE_TAC[cvector_re;VECTOR_MAP_VECTOR_MAP]);;\r
+\r
+let CVECTOR_IM_VECTOR_MAP = prove\r
+ (`!f v:A^N. cvector_im (vector_map f v) = vector_map (Im o f) v`,\r
+ REWRITE_TAC[cvector_im;VECTOR_MAP_VECTOR_MAP]);;\r
+\r
+let VECTOR_MAP_CVECTOR_RE = prove\r
+ (`!f:real->A v:complex^N.\r
+ vector_map f (cvector_re v) = vector_map (f o Re) v`,\r
+ REWRITE_TAC[cvector_re;VECTOR_MAP_VECTOR_MAP]);;\r
+\r
+let VECTOR_MAP_CVECTOR_IM = prove\r
+ (`!f:real->A v:complex^N.\r
+ vector_map f (cvector_im v) = vector_map (f o Im) v`,\r
+ REWRITE_TAC[cvector_im;VECTOR_MAP_VECTOR_MAP]);;\r
+\r
+let CVECTOR_RE_VECTOR_MAP2 = prove\r
+ (`!f v1:A^N v2:B^N.\r
+ cvector_re (vector_map2 f v1 v2) = vector_map2 (\x y. Re (f x y)) v1 v2`,\r
+ REWRITE_TAC[cvector_re;VECTOR_MAP_VECTOR_MAP2]);;\r
+\r
+let CVECTOR_IM_VECTOR_MAP2 = prove\r
+ (`!f v1:A^N v2:B^N.\r
+ cvector_im (vector_map2 f v1 v2) = vector_map2 (\x y. Im (f x y)) v1 v2`,\r
+ REWRITE_TAC[cvector_im;VECTOR_MAP_VECTOR_MAP2]);;\r
+\r
+\r
+(* ========================================================================= *)\r
+(* FLATTENING COMPLEX VECTORS INTO REAL VECTORS *)\r
+(* *)\r
+(* Note: *)\r
+(* Theoretically, the following could be defined more generally for matrices *)\r
+(* instead of complex vectors, but this would require a "finite_prod" type *)\r
+(* constructor, which is not available right now, and which, at first sight, *)\r
+(* would probably require dependent types. *)\r
+(* ========================================================================= *)\r
+\r
+let cvector_flatten = new_definition\r
+ `cvector_flatten (v:complex^N) :real^(N,N) finite_sum =\r
+ pastecart (cvector_re v) (cvector_im v)`;;\r
+\r
+let FLATTEN_RE_IM_COMPONENT = prove\r
+ (`!v:complex^N i.\r
+ 1 <= i /\ i <= 2 * dimindex(:N)\r
+ ==> (cvector_flatten v)$i =\r
+ if i <= dimindex(:N)\r
+ then (cvector_re v)$i\r
+ else (cvector_im v)$(i-dimindex(:N))`,\r
+ SIMP_TAC[MULT_2;GSYM DIMINDEX_FINITE_SUM;cvector_flatten;pastecart;\r
+ LAMBDA_BETA]);;\r
+\r
+let complex_vector = new_definition\r
+ `complex_vector (v1,v2) :complex^N\r
+ = vector_map2 (\x y. Cx x + ii * Cx y) v1 v2`;;\r
+\r
+let COMPLEX_VECTOR_TRANSPOSE = prove(\r
+ `!v1 v2:real^N.\r
+ complex_vector (v1,v2) = vector_to_cvector v1 + ii % vector_to_cvector v2`,\r
+ ONCE_REWRITE_TAC[CART_EQ]\r
+ THEN SIMP_TAC[complex_vector;CVECTOR_ADD_COMPONENT;CVECTOR_MUL_COMPONENT;\r
+ VECTOR_TO_CVECTOR_COMPONENT;VECTOR_MAP2_COMPONENT]);;\r
+\r
+let cvector_unflatten = new_definition\r
+ `cvector_unflatten (v:real^(N,N) finite_sum) :complex^N\r
+ = complex_vector (fstcart v, sndcart v)`;;\r
+\r
+let UNFLATTEN_FLATTEN = prove\r
+ (`cvector_unflatten o cvector_flatten = I :complex^N -> complex^N`,\r
+ REWRITE_TAC[FUN_EQ_THM;o_DEF;I_DEF;cvector_flatten;cvector_unflatten;\r
+ FSTCART_PASTECART;SNDCART_PASTECART;COMPLEX_VECTOR_TRANSPOSE;\r
+ VECTOR_TO_CVECTOR_CVECTOR_RE_IM]);;\r
+\r
+let FLATTEN_UNFLATTEN = prove\r
+ (`cvector_flatten o cvector_unflatten =\r
+ I :real^(N,N) finite_sum -> real^(N,N) finite_sum`,\r
+ REWRITE_TAC[FUN_EQ_THM;o_DEF;I_DEF;cvector_flatten;cvector_unflatten;\r
+ PASTECART_FST_SND;COMPLEX_VECTOR_TRANSPOSE;\r
+ CVECTOR_RE_VECTOR_TO_CVECTOR_RE_IM;CVECTOR_IM_VECTOR_TO_CVECTOR_RE_IM]);;\r
+\r
+let FLATTEN_CLINEAR = prove\r
+ (`!f:complex^N->complex^M.\r
+ clinear f ==> linear (cvector_flatten o f o cvector_unflatten)`,\r
+ REWRITE_TAC[clinear;linear;cvector_flatten;cvector_unflatten;o_DEF;\r
+ FSTCART_ADD;SNDCART_ADD;PASTECART_ADD;complex_vector;GSYM PASTECART_CMUL]\r
+ THEN REPEAT STRIP_TAC THEN REPEAT (AP_TERM_TAC ORELSE MK_COMB_TAC)\r
+ THEN REWRITE_TAC(map GSYM [CVECTOR_RE_ADD;CVECTOR_IM_ADD;CVECTOR_RE_MUL;\r
+ CVECTOR_IM_MUL])\r
+ THEN AP_TERM_TAC THEN ASSUM_LIST (REWRITE_TAC o map GSYM) \r
+ THEN AP_TERM_TAC THEN ONCE_REWRITE_TAC[CART_EQ]\r
+ THEN SIMP_TAC[VECTOR_MAP2_COMPONENT;VECTOR_ADD_COMPONENT;\r
+ CVECTOR_ADD_COMPONENT;CX_ADD;VECTOR_MUL_COMPONENT;CVECTOR_MUL_COMPONENT;\r
+ FSTCART_CMUL;SNDCART_CMUL;CX_MUL]\r
+ THEN SIMPLE_COMPLEX_ARITH_TAC);;\r
+\r
+let FLATTEN_MAP = prove\r
+ (`!f g.\r
+ f = vector_map g\r
+ ==> !x:complex^N.\r
+ cvector_flatten (vector_map f x) = vector_map g (cvector_flatten x)`,\r
+ SIMP_TAC[cvector_flatten;CVECTOR_RE_VECTOR_MAP;CVECTOR_IM_VECTOR_MAP;\r
+ GSYM PASTECART_VECTOR_MAP;VECTOR_MAP_CVECTOR_RE;VECTOR_MAP_CVECTOR_IM;\r
+ o_DEF;IM_DEF;RE_DEF;VECTOR_MAP_COMPONENT]);;\r
+\r
+let FLATTEN_NEG = prove\r
+ (`!x:complex^N. cvector_flatten (--x) = --(cvector_flatten x)`,\r
+ REWRITE_TAC[cvector_neg;MATCH_MP FLATTEN_MAP COMPLEX_NEG_IS_A_MAP]\r
+ THEN REWRITE_TAC[VECTOR_NEG_IS_A_MAP]);;\r
+\r
+let CVECTOR_NEG_ALT = prove\r
+ (`!x:complex^N. --x = cvector_unflatten (--(cvector_flatten x))`,\r
+ REWRITE_TAC[GSYM FLATTEN_NEG;\r
+ REWRITE_RULE[o_DEF;FUN_EQ_THM;I_DEF] UNFLATTEN_FLATTEN]);;\r
+\r
+let FLATTEN_MAP2 = prove(\r
+ `!f g.\r
+ f = vector_map2 g ==>\r
+ !x y:complex^N.\r
+ cvector_flatten (vector_map2 f x y) =\r
+ vector_map2 g (cvector_flatten x) (cvector_flatten y)`,\r
+ SIMP_TAC[cvector_flatten;CVECTOR_RE_VECTOR_MAP2;CVECTOR_IM_VECTOR_MAP2;\r
+ CVECTOR_RE_VECTOR_MAP2;GSYM PASTECART_VECTOR_MAP2]\r
+ THEN REWRITE_TAC[cvector_re;cvector_im;VECTOR_MAP2_LVECTOR_MAP;\r
+ VECTOR_MAP2_RVECTOR_MAP]\r
+ THEN REPEAT MK_COMB_TAC\r
+ THEN REWRITE_TAC[FUN_EQ_THM;IM_DEF;RE_DEF;VECTOR_MAP2_COMPONENT;o_DEF]);;\r
+\r
+let FLATTEN_ADD = prove\r
+ (`!x y:complex^N.\r
+ cvector_flatten (x+y) = cvector_flatten x + cvector_flatten y`,\r
+ REWRITE_TAC[cvector_add;MATCH_MP FLATTEN_MAP2 COMPLEX_ADD_IS_A_MAP]\r
+ THEN REWRITE_TAC[VECTOR_ADD_IS_A_MAP]);;\r
+\r
+let CVECTOR_ADD_ALT = prove\r
+ (`!x y:complex^N.\r
+ x+y = cvector_unflatten (cvector_flatten x + cvector_flatten y)`,\r
+ REWRITE_TAC[GSYM FLATTEN_ADD;\r
+ REWRITE_RULE[o_DEF;FUN_EQ_THM;I_DEF] UNFLATTEN_FLATTEN]);;\r
+\r
+let FLATTEN_SUB = prove\r
+ (`!x y:complex^N. cvector_flatten (x-y) = cvector_flatten x - cvector_flatten y`,\r
+ REWRITE_TAC[cvector_sub;MATCH_MP FLATTEN_MAP2 COMPLEX_SUB_IS_A_MAP]\r
+ THEN REWRITE_TAC[VECTOR_SUB_IS_A_MAP]);;\r
+\r
+let CVECTOR_SUB_ALT = prove\r
+ (`!x y:complex^N. x-y = cvector_unflatten (cvector_flatten x - cvector_flatten y)`,\r
+ REWRITE_TAC[GSYM FLATTEN_SUB;\r
+ REWRITE_RULE[o_DEF;FUN_EQ_THM;I_DEF] UNFLATTEN_FLATTEN]);;\r
+\r
+\r
+(* ========================================================================= *)\r
+(* CONJUGATE VECTOR. *)\r
+(* ========================================================================= *)\r
+\r
+let cvector_cnj = new_definition\r
+ `cvector_cnj : complex^N->complex^N = vector_map cnj`;;\r
+\r
+let CVECTOR_MAP_PROPERTY thm =\r
+ VECTOR_MAP_PROPERTY thm [cvector_zero;cvector_add;cvector_sub;cvector_neg;\r
+ cvector_mul;cvector_cnj;cvector_re;cvector_im];;\r
+\r
+let CVECTOR_CNJ_ADD = CVECTOR_MAP_PROPERTY\r
+ `!x y:complex^N. cvector_cnj (x+y) = cvector_cnj x + cvector_cnj y`\r
+ CNJ_ADD;;\r
+\r
+let CVECTOR_CNJ_SUB = CVECTOR_MAP_PROPERTY\r
+ `!x y:complex^N. cvector_cnj (x-y) = cvector_cnj x - cvector_cnj y`\r
+ CNJ_SUB;;\r
+\r
+let CVECTOR_CNJ_NEG = CVECTOR_MAP_PROPERTY\r
+ `!x:complex^N. cvector_cnj (--x) = --(cvector_cnj x)`\r
+ CNJ_NEG;;\r
+\r
+let CVECTOR_RE_CNJ = CVECTOR_MAP_PROPERTY\r
+ `!x:complex^N. cvector_re (cvector_cnj x) = cvector_re x`\r
+ RE_CNJ;;\r
+\r
+let CVECTOR_IM_CNJ = prove\r
+ (`!x:complex^N. cvector_im (cvector_cnj x) = --(cvector_im x)`,\r
+ VECTOR_MAP_PROPERTY_TAC[cvector_im;cvector_cnj;VECTOR_NEG_IS_A_MAP] IM_CNJ);;\r
+\r
+let CVECTOR_CNJ_CNJ = CVECTOR_MAP_PROPERTY\r
+ `!x:complex^N. cvector_cnj (cvector_cnj x) = x`\r
+ CNJ_CNJ;;\r
+\r
+\r
+(* ========================================================================= *)\r
+(* CROSS PRODUCTS IN COMPLEX^3. *)\r
+(* ========================================================================= *)\r
+\r
+prioritize_vector();;\r
+\r
+parse_as_infix("ccross",(20,"right"));;\r
+\r
+let ccross = new_definition\r
+ `((ccross):complex^3 -> complex^3 -> complex^3) x y = vector [\r
+ x$2 * y$3 - x$3 * y$2;\r
+ x$3 * y$1 - x$1 * y$3;\r
+ x$1 * y$2 - x$2 * y$1\r
+ ]`;; \r
+\r
+let CCROSS_COMPONENT = prove \r
+ (`!x y:complex^3.\r
+ (x ccross y)$1 = x$2 * y$3 - x$3 * y$2\r
+ /\ (x ccross y)$2 = x$3 * y$1 - x$1 * y$3\r
+ /\ (x ccross y)$3 = x$1 * y$2 - x$2 * y$1`,\r
+ REWRITE_TAC[ccross;VECTOR_3]);;\r
+\r
+(* simple handy instantiation of CART_EQ for dimension 3*)\r
+let CART_EQ3 = prove\r
+ (`!x y:complex^3. x = y <=> x$1 = y$1 /\ x$2 = y$2 /\ x$3 = y$3`,\r
+ GEN_REWRITE_TAC (PATH_CONV "rbrblr") [CART_EQ]\r
+ THEN REWRITE_TAC[DIMINDEX_3;FORALL_3]);;\r
+\r
+let CCROSS_TAC lemmas =\r
+ REWRITE_TAC(CART_EQ3::CCROSS_COMPONENT::lemmas)\r
+ THEN SIMPLE_COMPLEX_ARITH_TAC;;\r
+\r
+let CCROSS_LZERO = prove \r
+ (`!x:complex^3. cvector_zero ccross x = cvector_zero`,\r
+ CCROSS_TAC[CVECTOR_ZERO_COMPONENT]);;\r
+\r
+let CCROSS_RZERO = prove \r
+ (`!x:complex^3. x ccross cvector_zero = cvector_zero`,\r
+ CCROSS_TAC[CVECTOR_ZERO_COMPONENT]);;\r
+\r
+let CCROSS_SKEW = prove \r
+ (`!x y:complex^3. (x ccross y) = --(y ccross x)`,\r
+ CCROSS_TAC[CVECTOR_NEG_COMPONENT]);;\r
+\r
+let CCROSS_REFL = prove \r
+ (`!x:complex^3. x ccross x = cvector_zero`,\r
+ CCROSS_TAC[CVECTOR_ZERO_COMPONENT]);;\r
+\r
+let CCROSS_LADD = prove\r
+ (`!x y z:complex^3. (x + y) ccross z = (x ccross z) + (y ccross z)`,\r
+ CCROSS_TAC[CVECTOR_ADD_COMPONENT]);;\r
+\r
+let CCROSS_RADD = prove \r
+ (`!x y z:complex^3. x ccross(y + z) = (x ccross y) + (x ccross z)`,\r
+ CCROSS_TAC[CVECTOR_ADD_COMPONENT]);;\r
+\r
+let CCROSS_LMUL = prove \r
+ (`!c x y:complex^3. (c % x) ccross y = c % (x ccross y)`,\r
+ CCROSS_TAC[CVECTOR_MUL_COMPONENT]);;\r
+\r
+let CCROSS_RMUL = prove \r
+ (`!c x y:complex^3. x ccross (c % y) = c % (x ccross y)`,\r
+ CCROSS_TAC[CVECTOR_MUL_COMPONENT]);;\r
+\r
+let CCROSS_LNEG = prove \r
+ (`!x y:complex^3. (--x) ccross y = --(x ccross y)`,\r
+ CCROSS_TAC[CVECTOR_NEG_COMPONENT]);;\r
+\r
+let CCROSS_RNEG = prove \r
+ (`!x y:complex^3. x ccross (--y) = --(x ccross y)`,\r
+ CCROSS_TAC[CVECTOR_NEG_COMPONENT]);;\r
+\r
+let CCROSS_JACOBI = prove\r
+ (`!(x:complex^3) y z.\r
+ x ccross (y ccross z) + y ccross (z ccross x) + z ccross (x ccross y) =\r
+ cvector_zero`,\r
+ REWRITE_TAC[CART_EQ3]\r
+ THEN REWRITE_TAC[CVECTOR_ADD_COMPONENT;CCROSS_COMPONENT;\r
+ CVECTOR_ZERO_COMPONENT] THEN SIMPLE_COMPLEX_ARITH_TAC);;\r
+\r
+\r
+(* ========================================================================= *)\r
+(* DOT PRODUCTS IN COMPLEX^N *)\r
+(* *)\r
+(* Only difference with the real case: *)\r
+(* we take the conjugate of the 2nd argument *)\r
+(* ========================================================================= *)\r
+\r
+prioritize_complex();;\r
+\r
+parse_as_infix("cdot",(20,"right"));;\r
+\r
+let cdot = new_definition\r
+ `(cdot) (x:complex^N) (y:complex^N) =\r
+ vsum (1..dimindex(:N)) (\i. x$i * cnj(y$i))`;;\r
+\r
+(* The dot product is symmetric MODULO the conjugate *)\r
+let CDOT_SYM = prove\r
+ (`!x:complex^N y. x cdot y = cnj (y cdot x)`,\r
+ REWRITE_TAC[cdot]\r
+ THEN REWRITE_TAC[MATCH_MP (SPEC_ALL CNJ_VSUM) (SPEC `dimindex (:N)` (GEN_ALL\r
+ (CONJUNCT1 (SPEC_ALL (REWRITE_RULE[HAS_SIZE] HAS_SIZE_NUMSEG_1)))))]\r
+ THEN REWRITE_TAC[CNJ_MUL;CNJ_CNJ;COMPLEX_MUL_SYM]);;\r
+\r
+let REAL_CDOT_SELF = prove\r
+ (`!x:complex^N. real(x cdot x)`,\r
+ REWRITE_TAC[REAL_CNJ;GSYM CDOT_SYM]);;\r
+\r
+(* The following theorems are usual axioms of the hermitian dot product, they are proved later on.\r
+ * let CDOT_SELF_POS = prove(`!x:complex^N. &0 <= real_of_complex (x cdot x)`, ...\r
+ * let CDOT_EQ_0 = prove(`!x:complex^N. x cdot x = Cx(&0) <=> x = cvector_zero`\r
+ *)\r
+\r
+let CDOT_LADD = prove\r
+ (`!x:complex^N y z. (x + y) cdot z = (x cdot z) + (y cdot z)`,\r
+ REWRITE_TAC[cdot]\r
+ THEN REWRITE_TAC[MATCH_MP (GSYM VSUM_ADD) (SPEC `dimindex (:N)` (GEN_ALL\r
+ (CONJUNCT1 (SPEC_ALL (REWRITE_RULE[HAS_SIZE] HAS_SIZE_NUMSEG_1)))))]\r
+ THEN REPEAT GEN_TAC THEN MATCH_MP_TAC VSUM_EQ THEN GEN_TAC THEN DISCH_TAC\r
+ THEN REWRITE_TAC[FUN_EQ_THM]\r
+ THEN REWRITE_TAC[SPECL [`(x:real^2^N)$(x':num)`;`(y:real^2^N)$(x':num)`;\r
+ `cnj ((z:real^2^N)$(x':num))`] (GSYM COMPLEX_ADD_RDISTRIB)]\r
+ THEN REWRITE_TAC[CVECTOR_ADD_COMPONENT]);;\r
+\r
+let CDOT_RADD = prove\r
+ (`!x:complex^N y z. x cdot (y + z) = (x cdot y) + (x cdot z)`,\r
+ REWRITE_TAC[cdot]\r
+ THEN REWRITE_TAC[MATCH_MP (GSYM VSUM_ADD) (SPEC `dimindex (:N)` (GEN_ALL\r
+ (CONJUNCT1 (SPEC_ALL (REWRITE_RULE[HAS_SIZE] HAS_SIZE_NUMSEG_1)))))]\r
+ THEN REPEAT GEN_TAC THEN MATCH_MP_TAC VSUM_EQ THEN GEN_TAC THEN DISCH_TAC\r
+ THEN REWRITE_TAC[FUN_EQ_THM]\r
+ THEN REWRITE_TAC[SPECL [`(x:real^2^N)$(x':num)`; `cnj((y:real^2^N)$(x':num))`;\r
+ `cnj ((z:real^2^N)$(x':num))`] (GSYM COMPLEX_ADD_LDISTRIB)]\r
+ THEN REWRITE_TAC[CNJ_ADD; CVECTOR_ADD_COMPONENT]);;\r
+\r
+let CDOT_LSUB = prove\r
+ (`!x:complex^N y z. (x - y) cdot z = (x cdot z) - (y cdot z)`,\r
+ REWRITE_TAC[cdot]\r
+ THEN REWRITE_TAC[MATCH_MP (GSYM VSUM_SUB) (SPEC `dimindex (:N)` (GEN_ALL\r
+ (CONJUNCT1 (SPEC_ALL (REWRITE_RULE[HAS_SIZE] HAS_SIZE_NUMSEG_1)))))]\r
+ THEN REPEAT GEN_TAC THEN MATCH_MP_TAC VSUM_EQ THEN GEN_TAC THEN DISCH_TAC\r
+ THEN REWRITE_TAC[FUN_EQ_THM]\r
+ THEN REWRITE_TAC[SPECL [`(x:real^2^N)$(x':num)`; `(y:real^2^N)$(x':num)`;\r
+ `cnj ((z:real^2^N)$(x':num))`] (GSYM COMPLEX_SUB_RDISTRIB)]\r
+ THEN REWRITE_TAC[CVECTOR_SUB_COMPONENT]);;\r
+\r
+let CDOT_RSUB = prove\r
+ (`!x:complex^N y z. x cdot (y - z) = (x cdot y) - (x cdot z)`,\r
+ REWRITE_TAC[cdot]\r
+ THEN REWRITE_TAC[MATCH_MP (GSYM VSUM_SUB) (SPEC `dimindex (:N)` (GEN_ALL\r
+ (CONJUNCT1 (SPEC_ALL (REWRITE_RULE[HAS_SIZE] HAS_SIZE_NUMSEG_1)))))]\r
+ THEN REPEAT GEN_TAC THEN MATCH_MP_TAC VSUM_EQ THEN GEN_TAC THEN DISCH_TAC\r
+ THEN REWRITE_TAC[FUN_EQ_THM]\r
+ THEN REWRITE_TAC[SPECL [`(x:real^2^N)$(x':num)`; `cnj((y:real^2^N)$(x':num))`;\r
+ `cnj ((z:real^2^N)$(x':num))`] (GSYM COMPLEX_SUB_LDISTRIB)]\r
+ THEN REWRITE_TAC[CNJ_SUB; CVECTOR_SUB_COMPONENT]);;\r
+\r
+let CDOT_LMUL = prove\r
+ (`!c:complex x:complex^N y. (c % x) cdot y = c * (x cdot y)`,\r
+ REWRITE_TAC[cdot]\r
+ THEN REWRITE_TAC[MATCH_MP (GSYM VSUM_COMPLEX_LMUL) (SPEC `dimindex (:N)`\r
+ (GEN_ALL (CONJUNCT1 (SPEC_ALL (REWRITE_RULE[HAS_SIZE]\r
+ HAS_SIZE_NUMSEG_1)))))]\r
+ THEN REWRITE_TAC[CVECTOR_MUL_COMPONENT; GSYM COMPLEX_MUL_ASSOC]);;\r
+\r
+let CDOT_RMUL = prove\r
+ (`!c:complex x:complex^N x y. x cdot (c % y) = cnj c * (x cdot y)`,\r
+ REWRITE_TAC[cdot]\r
+ THEN REWRITE_TAC[MATCH_MP (GSYM VSUM_COMPLEX_LMUL) (SPEC `dimindex (:N)`\r
+ (GEN_ALL (CONJUNCT1 (SPEC_ALL (REWRITE_RULE[HAS_SIZE]\r
+ HAS_SIZE_NUMSEG_1)))))]\r
+ THEN REWRITE_TAC[CVECTOR_MUL_COMPONENT; CNJ_MUL; COMPLEX_MUL_AC]);;\r
+\r
+let CDOT_LNEG = prove\r
+ (`!x:complex^N y. (--x) cdot y = --(x cdot y)`,\r
+ REWRITE_TAC[cdot] THEN ONCE_REWRITE_TAC[COMPLEX_NEG_MINUS1]\r
+ THEN REWRITE_TAC[MATCH_MP (GSYM VSUM_COMPLEX_LMUL) (SPEC `dimindex (:N)`\r
+ (GEN_ALL (CONJUNCT1 (SPEC_ALL (REWRITE_RULE[HAS_SIZE]\r
+ HAS_SIZE_NUMSEG_1)))))]\r
+ THEN REWRITE_TAC[CVECTOR_NEG_COMPONENT] THEN ONCE_REWRITE_TAC[GSYM\r
+ COMPLEX_NEG_MINUS1] THEN REWRITE_TAC[COMPLEX_NEG_LMUL]);;\r
+\r
+let CDOT_RNEG = prove\r
+ (`!x:complex^N y. x cdot (--y) = --(x cdot y)`,\r
+ REWRITE_TAC[cdot] THEN ONCE_REWRITE_TAC[COMPLEX_NEG_MINUS1]\r
+ THEN REWRITE_TAC[MATCH_MP (GSYM VSUM_COMPLEX_LMUL) (SPEC `dimindex (:N)`\r
+ (GEN_ALL (CONJUNCT1 (SPEC_ALL (REWRITE_RULE[HAS_SIZE]\r
+ HAS_SIZE_NUMSEG_1)))))]\r
+ THEN ONCE_REWRITE_TAC[GSYM COMPLEX_NEG_MINUS1]\r
+ THEN REWRITE_TAC[CVECTOR_NEG_COMPONENT; CNJ_NEG; COMPLEX_NEG_RMUL]);;\r
+\r
+let CDOT_LZERO = prove\r
+ (`!x:complex^N. cvector_zero cdot x = Cx (&0)`,\r
+ REWRITE_TAC[cdot] THEN REWRITE_TAC[CVECTOR_ZERO_COMPONENT]\r
+ THEN REWRITE_TAC[COMPLEX_MUL_LZERO; GSYM COMPLEX_VEC_0; VSUM_0]);;\r
+\r
+let CNJ_ZERO = prove(\r
+ `cnj (Cx(&0)) = Cx(&0)`,\r
+ REWRITE_TAC[cnj;RE_CX;IM_CX;CX_DEF;REAL_NEG_0]);;\r
+\r
+let CDOT_RZERO = prove(\r
+ `!x:complex^N. x cdot cvector_zero = Cx (&0)`,\r
+ REWRITE_TAC[cdot] THEN REWRITE_TAC[CVECTOR_ZERO_COMPONENT]\r
+ THEN REWRITE_TAC[CNJ_ZERO]\r
+ THEN REWRITE_TAC[COMPLEX_MUL_RZERO;GSYM COMPLEX_VEC_0;VSUM_0]);;\r
+\r
+(* Cauchy Schwarz inequality: proved later on \r
+ * let CDOT_CAUCHY_SCHWARZ = prove (`!x y:complex^N. norm (x cdot y) pow 2 <= cnorm2 x * cnorm2 y`,\r
+ * let CDOT_CAUCHY_SCHWARZ_EQUAL = prove(`!x y:complex^N. norm (x cdot y) pow 2 = cnorm2 x * cnorm2 y <=> collinear_cvectors x y`,\r
+*)\r
+\r
+let CDOT3 = prove\r
+ (`!x y:complex^3.\r
+ x cdot y = (x$1 * cnj (y$1) + x$2 * cnj (y$2) + x$3 * cnj (y$3))`,\r
+ REWRITE_TAC[cdot] THEN SIMP_TAC [DIMINDEX_3] THEN REWRITE_TAC[VSUM_3]);;\r
+\r
+let ADD_CDOT_SYM = prove(\r
+ `!x y:complex^N. x cdot y + y cdot x = Cx(&2 * Re(x cdot y))`,\r
+ MESON_TAC[CDOT_SYM;COMPLEX_ADD_CNJ]);;\r
+\r
+\r
+(* ========================================================================= *)\r
+(* RELATION WITH REAL DOT AND CROSS PRODUCTS *)\r
+(* ========================================================================= *)\r
+\r
+let CCROSS_LREAL = prove\r
+ (`!r c.\r
+ (vector_to_cvector r) ccross c =\r
+ vector_to_cvector (r cross (cvector_re c)) \r
+ + ii % (vector_to_cvector (r cross (cvector_im c)))`,\r
+ REWRITE_TAC[CART_EQ3;CVECTOR_ADD_COMPONENT;CVECTOR_MUL_COMPONENT;\r
+ VECTOR_TO_CVECTOR_COMPONENT;CCROSS_COMPONENT;CROSS_COMPONENTS;\r
+ CVECTOR_RE_COMPONENT;CVECTOR_IM_COMPONENT;complex_mul;RE_CX;IM_CX;CX_DEF;\r
+ complex_sub;complex_neg;complex_add;RE;IM;RE_II;IM_II]\r
+ THEN REPEAT STRIP_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[PAIR_EQ]\r
+ THEN ARITH_TAC);;\r
+\r
+let CCROSS_RREAL = prove\r
+ (`!r c.\r
+ c ccross (vector_to_cvector r) =\r
+ vector_to_cvector ((cvector_re c) cross r)\r
+ + ii % (vector_to_cvector ((cvector_im c) cross r))`,\r
+ REWRITE_TAC[CART_EQ3;CVECTOR_ADD_COMPONENT;CVECTOR_MUL_COMPONENT;\r
+ VECTOR_TO_CVECTOR_COMPONENT;CCROSS_COMPONENT;CROSS_COMPONENTS;\r
+ CVECTOR_RE_COMPONENT;CVECTOR_IM_COMPONENT;complex_mul;RE_CX;IM_CX;CX_DEF;\r
+ complex_sub;complex_neg;complex_add;RE;IM;RE_II;IM_II]\r
+ THEN REPEAT STRIP_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[PAIR_EQ]\r
+ THEN ARITH_TAC);;\r
+\r
+let CDOT_LREAL = prove\r
+ (`!r c.\r
+ (vector_to_cvector r) cdot c =\r
+ Cx (r dot (cvector_re c)) - ii * Cx (r dot (cvector_im c))`,\r
+ REWRITE_TAC[cdot; dot; VECTOR_TO_CVECTOR_COMPONENT;CVECTOR_RE_COMPONENT;\r
+ CVECTOR_IM_COMPONENT] THEN REPEAT GEN_TAC\r
+ THEN GEN_REWRITE_TAC (RATOR_CONV o ONCE_DEPTH_CONV) [COMPLEX_EXPAND]\r
+ THEN REWRITE_TAC[MATCH_MP RE_VSUM (SPEC `dimindex (:N)` (GEN_ALL (CONJUNCT1\r
+ (SPEC_ALL (REWRITE_RULE[HAS_SIZE] HAS_SIZE_NUMSEG_1)))))]\r
+ THEN REWRITE_TAC[MATCH_MP (IM_VSUM) (SPEC `dimindex (:N)` (GEN_ALL\r
+ (CONJUNCT1 (SPEC_ALL (REWRITE_RULE[HAS_SIZE]\r
+ HAS_SIZE_NUMSEG_1)))))]\r
+ THEN REWRITE_TAC[RE_MUL_CX;RE_CNJ;IM_MUL_CX;IM_CNJ]\r
+ THEN REWRITE_TAC[COMPLEX_POLY_NEG_CLAUSES] THEN REWRITE_TAC[COMPLEX_MUL_AC]\r
+ THEN REWRITE_TAC[COMPLEX_MUL_ASSOC] THEN REWRITE_TAC[GSYM CX_MUL]\r
+ THEN REWRITE_TAC[GSYM SUM_LMUL]\r
+ THEN REWRITE_TAC[GSYM REAL_NEG_MINUS1;GSYM REAL_MUL_RNEG]);;\r
+\r
+let CDOT_RREAL = prove\r
+ (`!r c.\r
+ c cdot (vector_to_cvector r) = \r
+ Cx ((cvector_re c) dot r) + ii * Cx ((cvector_im c) dot r)`,\r
+ REWRITE_TAC[cdot; dot; VECTOR_TO_CVECTOR_COMPONENT;CVECTOR_RE_COMPONENT;\r
+ CVECTOR_IM_COMPONENT]\r
+ THEN REPEAT GEN_TAC\r
+ THEN GEN_REWRITE_TAC (RATOR_CONV o ONCE_DEPTH_CONV) [COMPLEX_EXPAND]\r
+ THEN REWRITE_TAC[MATCH_MP RE_VSUM (SPEC `dimindex (:N)` (GEN_ALL (CONJUNCT1\r
+ (SPEC_ALL (REWRITE_RULE[HAS_SIZE] HAS_SIZE_NUMSEG_1)))))]\r
+ THEN REWRITE_TAC[MATCH_MP IM_VSUM (SPEC `dimindex (:N)` (GEN_ALL (CONJUNCT1\r
+ (SPEC_ALL (REWRITE_RULE[HAS_SIZE] HAS_SIZE_NUMSEG_1)))))]\r
+ THEN REWRITE_TAC[CNJ_CX]\r
+ THEN REWRITE_TAC[RE_MUL_CX;RE_CNJ;IM_MUL_CX;IM_CNJ]);;\r
+\r
+\r
+(* ========================================================================= *)\r
+(* NORM, UNIT VECTORS. *)\r
+(* ========================================================================= *)\r
+\r
+let cnorm2 = new_definition\r
+ `cnorm2 (v:complex^N) = real_of_complex (v cdot v)`;;\r
+\r
+let CX_CNORM2 = prove\r
+ (`!v:complex^N. Cx(cnorm2 v) = v cdot v`,\r
+ SIMP_TAC[cnorm2;REAL_CDOT_SELF;REAL_OF_COMPLEX]);;\r
+\r
+let CNORM2_CVECTOR_ZERO = prove\r
+ (`cnorm2 (cvector_zero:complex^N) = &0`,\r
+ REWRITE_TAC[cnorm2;CDOT_RZERO;REAL_OF_COMPLEX_CX]);;\r
+\r
+let CNORM2_MODULUS = prove\r
+ (`!x:complex^N. cnorm2 x = (vector_map norm x) dot (vector_map norm x)`,\r
+ REWRITE_TAC[cnorm2;cdot;COMPLEX_MUL_CNJ;COMPLEX_POW_2;GSYM CX_MUL;\r
+ VSUM_CX_NUMSEG;dot;VECTOR_MAP_COMPONENT;REAL_OF_COMPLEX_CX]);;\r
+\r
+let CNORM2_EQ_0 = prove\r
+ (`!x:complex^N. cnorm2 x = &0 <=> x = cvector_zero`,\r
+ REWRITE_TAC[CNORM2_MODULUS;CX_INJ;DOT_EQ_0] THEN GEN_TAC\r
+ THEN GEN_REWRITE_TAC (RATOR_CONV o DEPTH_CONV) [CART_EQ]\r
+ THEN REWRITE_TAC[VEC_COMPONENT;VECTOR_MAP_COMPONENT;COMPLEX_NORM_ZERO]\r
+ THEN GEN_REWRITE_TAC (RAND_CONV o DEPTH_CONV) [CART_EQ]\r
+ THEN REWRITE_TAC[CVECTOR_ZERO_COMPONENT]);;\r
+\r
+let CDOT_EQ_0 = prove\r
+ (`!x:complex^N. x cdot x = Cx(&0) <=> x = cvector_zero`,\r
+ SIMP_TAC[TAUT `(p<=>q) <=> ((p==>q) /\ (q==>p))`;CDOT_LZERO]\r
+ THEN GEN_TAC THEN DISCH_THEN (MP_TAC o MATCH_MP (MESON[REAL_OF_COMPLEX_CX]\r
+ `x = Cx y ==> real_of_complex x = y`))\r
+ THEN REWRITE_TAC[GSYM cnorm2;CNORM2_EQ_0]);;\r
+\r
+let CNORM2_POS = prove\r
+ (`!x:complex^N. &0 <= cnorm2 x`, REWRITE_TAC[CNORM2_MODULUS;DOT_POS_LE]);;\r
+\r
+let CDOT_SELF_POS = prove\r
+ (`!x:complex^N. &0 <= real_of_complex (x cdot x)`,\r
+ REWRITE_TAC[GSYM cnorm2;CNORM2_POS]);;\r
+\r
+let CNORM2_MUL = prove\r
+ (`!a x:complex^N. cnorm2 (a % x) = (norm a) pow 2 * cnorm2 x`,\r
+ SIMP_TAC[cnorm2;CDOT_LMUL;CDOT_RMUL;\r
+ SIMPLE_COMPLEX_ARITH `x * cnj x * y = (x * cnj x) * y`;COMPLEX_MUL_CNJ;\r
+ REAL_OF_COMPLEX_CX;REAL_OF_COMPLEX_MUL;REAL_CX;REAL_CDOT_SELF;\r
+ GSYM CX_POW]);;\r
+\r
+let CNORM2_NORM2_2 = prove\r
+ (`!x y:real^N.\r
+ cnorm2 (vector_to_cvector x + ii % vector_to_cvector y) =\r
+ norm x pow 2 + norm y pow 2`,\r
+ REWRITE_TAC[cnorm2;vector_norm;cdot;CVECTOR_ADD_COMPONENT;\r
+ CVECTOR_MUL_COMPONENT;VECTOR_TO_CVECTOR_COMPONENT;CNJ_ADD;CNJ_CX;CNJ_MUL;\r
+ CNJ_II;COMPLEX_ADD_RDISTRIB;COMPLEX_ADD_LDISTRIB;\r
+ SIMPLE_COMPLEX_ARITH\r
+ `(x*x+x*(--ii)*y)+(ii*y)*x+(ii*y)*(--ii)*y = x*x-(ii*ii)*y*y`]\r
+ THEN REWRITE_TAC[GSYM COMPLEX_POW_2;COMPLEX_POW_II_2;\r
+ SIMPLE_COMPLEX_ARITH `x-(--Cx(&1))*y = x+y`]\r
+ THEN SIMP_TAC[MESON[CARD_NUMSEG_1;HAS_SIZE_NUMSEG_1;FINITE_HAS_SIZE]\r
+ `FINITE (1..dimindex(:N))`;VSUM_ADD;GSYM CX_POW;VSUM_CX;GSYM dot;\r
+ REAL_POW_2;GSYM dot]\r
+ THEN SIMP_TAC[GSYM CX_ADD;REAL_OF_COMPLEX_CX;GSYM REAL_POW_2;DOT_POS_LE;\r
+ SQRT_POW_2]);;\r
+\r
+let CNORM2_NORM2 = prove\r
+ (`!v:complex^N.\r
+ cnorm2 v = norm (cvector_re v) pow 2 + norm (cvector_im v) pow 2`,\r
+ GEN_TAC THEN GEN_REWRITE_TAC (RATOR_CONV o ONCE_DEPTH_CONV) [GSYM\r
+ VECTOR_TO_CVECTOR_CVECTOR_RE_IM] THEN REWRITE_TAC[CNORM2_NORM2_2]);;\r
+\r
+let CNORM2_ALT = prove\r
+ (`!x:complex^N. cnorm2 x = norm (x cdot x)`,\r
+ SIMP_TAC[cnorm2;REAL_OF_COMPLEX_NORM;REAL_CDOT_SELF;EQ_SYM_EQ;REAL_ABS_REFL;\r
+ REWRITE_RULE[cnorm2] CNORM2_POS]);;\r
+\r
+let CNORM2_SUB = prove\r
+ (`!x y:complex^N. cnorm2 (x-y) = cnorm2 (y-x)`,\r
+ REWRITE_TAC[cnorm2;CDOT_LSUB;CDOT_RSUB] THEN REPEAT GEN_TAC THEN AP_TERM_TAC\r
+ THEN SIMPLE_COMPLEX_ARITH_TAC);;\r
+\r
+let CNORM2_VECTOR_TO_CVECTOR = prove\r
+ (`!x:real^N. cnorm2 (vector_to_cvector x) = norm x pow 2`,\r
+ REWRITE_TAC[CNORM2_ALT;CDOT_RREAL;CVECTOR_RE_VECTOR_TO_CVECTOR;\r
+ CVECTOR_IM_VECTOR_TO_CVECTOR;DOT_LZERO;COMPLEX_MUL_RZERO;COMPLEX_ADD_RID;\r
+ DOT_SQUARE_NORM;CX_POW;COMPLEX_NORM_POW;COMPLEX_NORM_CX;REAL_POW2_ABS]);;\r
+\r
+let cnorm = new_definition\r
+ `cnorm :complex^N->real = sqrt o cnorm2`;;\r
+\r
+overload_interface ("norm",`cnorm:complex^N->real`);;\r
+\r
+let CNORM_CVECTOR_ZERO = prove\r
+ (`norm (cvector_zero:complex^N) = &0`,\r
+ REWRITE_TAC[cnorm;CNORM2_CVECTOR_ZERO;o_DEF;SQRT_0]);;\r
+\r
+let CNORM_POW_2 = prove\r
+ (`!x:complex^N. norm x pow 2 = cnorm2 x`, \r
+ SIMP_TAC[cnorm;o_DEF;SQRT_POW_2;CNORM2_POS]);;\r
+\r
+let CNORM_NORM_2 = prove\r
+ (`!x y:real^N.\r
+ norm (vector_to_cvector x + ii % vector_to_cvector y) =\r
+ sqrt(norm x pow 2 + norm y pow 2)`,\r
+ REWRITE_TAC[cnorm;o_DEF;CNORM2_NORM2_2]);;\r
+\r
+let CNORM_NORM = prove(\r
+ `!v:complex^N.\r
+ norm v = sqrt(norm (cvector_re v) pow 2 + norm (cvector_im v) pow 2)`,\r
+ GEN_TAC THEN GEN_REWRITE_TAC (RATOR_CONV o ONCE_DEPTH_CONV) [GSYM\r
+ VECTOR_TO_CVECTOR_CVECTOR_RE_IM] THEN REWRITE_TAC[CNORM_NORM_2]);;\r
+\r
+let CNORM_MUL = prove\r
+ (`!a x:complex^N. norm (a % x) = norm a * norm x`,\r
+ SIMP_TAC[cnorm;o_DEF;CNORM2_MUL;REAL_LE_POW_2;SQRT_MUL;CNORM2_POS;\r
+ NORM_POS_LE;POW_2_SQRT]);;\r
+\r
+let CNORM_EQ_0 = prove\r
+ (`!x:complex^N. norm x = &0 <=> x = cvector_zero`,\r
+ SIMP_TAC[cnorm;o_DEF;SQRT_EQ_0;CNORM2_POS;CNORM2_EQ_0]);;\r
+\r
+let CNORM_POS = prove\r
+ (`!x:complex^N. &0 <= norm x`,\r
+ SIMP_TAC[cnorm;o_DEF;SQRT_POS_LE;CNORM2_POS]);;\r
+\r
+let CNORM_SUB = prove\r
+ (`!x y:complex^N. norm (x-y) = norm (y-x)`,\r
+ REWRITE_TAC[cnorm;o_DEF;CNORM2_SUB]);;\r
+\r
+let CNORM_VECTOR_TO_CVECTOR = prove\r
+ (`!x:real^N. norm (vector_to_cvector x) = norm x`,\r
+ SIMP_TAC[cnorm;o_DEF;CNORM2_VECTOR_TO_CVECTOR;POW_2_SQRT;NORM_POS_LE]);;\r
+\r
+let CNORM_BASIS = prove\r
+ (`!k. 1 <= k /\ k <= dimindex(:N)\r
+ ==> norm (vector_to_cvector (basis k :real^N)) = &1`,\r
+ SIMP_TAC[NORM_BASIS;CNORM_VECTOR_TO_CVECTOR]);;\r
+\r
+let CNORM_BASIS_1 = prove\r
+ (`norm(basis 1:real^N) = &1`,\r
+ SIMP_TAC[NORM_BASIS_1;CNORM_VECTOR_TO_CVECTOR]);;\r
+\r
+let CVECTOR_CHOOSE_SIZE = prove\r
+ (`!c. &0 <= c ==> ?x:complex^N. norm(x) = c`,\r
+ MESON_TAC[VECTOR_CHOOSE_SIZE;CNORM_VECTOR_TO_CVECTOR]);;\r
+\r
+(* Triangle inequality. Proved later on using Cauchy Schwarz inequality.\r
+ * let CNORM_TRIANGLE = prove(`!x y:complex^N. norm (x+y) <= norm x + norm y`, ...\r
+ *)\r
+\r
+let cunit = new_definition\r
+ `cunit (X:complex^N) = inv(Cx(norm X))% X`;;\r
+\r
+let CUNIT_CVECTOR_ZERO = prove\r
+ (`cunit cvector_zero = cvector_zero:complex^N`, \r
+ REWRITE_TAC[cunit;CNORM_CVECTOR_ZERO;COMPLEX_INV_0;CVECTOR_MUL_LZERO]);;\r
+\r
+let CDOT_CUNIT_MUL_CUNIT = prove\r
+ (`!x:complex^N. (cunit x cdot x) % cunit x = x`,\r
+ GEN_TAC THEN ASM_CASES_TAC `x = cvector_zero:complex^N`\r
+ THEN ASM_REWRITE_TAC[CUNIT_CVECTOR_ZERO;CDOT_LZERO;CVECTOR_MUL_LZERO]\r
+ THEN SIMP_TAC[cunit;CVECTOR_MUL_ASSOC;CDOT_LMUL;\r
+ SIMPLE_COMPLEX_ARITH `(x*y)*x=(x*x)*y`;GSYM COMPLEX_INV_MUL;GSYM CX_MUL;\r
+ GSYM REAL_POW_2;cnorm;o_DEF;CNORM2_POS;SQRT_POW_2]\r
+ THEN ASM_SIMP_TAC[cnorm2;REAL_OF_COMPLEX;REAL_CDOT_SELF;CDOT_EQ_0;\r
+ CNORM2_CVECTOR_ZERO;CVECTOR_MUL_RZERO;CNORM2_EQ_0;COMPLEX_MUL_LINV;\r
+ CVECTOR_MUL_ID]);;\r
+\r
+\r
+(* ========================================================================= *)\r
+(* COLLINEARITY *)\r
+(* ========================================================================= *)\r
+\r
+(* Definition of collinearity between complex vectors.\r
+ * Note: This is different from collinearity between points (which is the one defined in HOL-Light library)\r
+ *)\r
+let collinear_cvectors = new_definition\r
+ `collinear_cvectors x (y:complex^N) <=> ?a. y = a % x \/ x = a % y`;;\r
+\r
+let COLLINEAR_CVECTORS_SYM = prove\r
+ (`!x y:complex^N. collinear_cvectors x y <=> collinear_cvectors y x`,\r
+ REWRITE_TAC[collinear_cvectors] THEN MESON_TAC[]);;\r
+\r
+let COLLINEAR_CVECTORS_0 = prove\r
+ (`!x:complex^N. collinear_cvectors x cvector_zero`,\r
+ REWRITE_TAC[collinear_cvectors] THEN GEN_TAC THEN EXISTS_TAC `Cx(&0)`\r
+ THEN REWRITE_TAC[CVECTOR_MUL_LZERO]);;\r
+\r
+let NON_NULL_COLLINEARS = prove\r
+ (`!x y:complex^N.\r
+ collinear_cvectors x y /\ ~(x=cvector_zero) /\ ~(y=cvector_zero)\r
+ ==> ?a. ~(a=Cx(&0)) /\ y = a % x`,\r
+ REWRITE_TAC[collinear_cvectors] THEN REPEAT STRIP_TAC THENL [\r
+ ASM_MESON_TAC[CVECTOR_MUL_LZERO];\r
+ SUBGOAL_THEN `~(a=Cx(&0))` ASSUME_TAC THENL [\r
+ ASM_MESON_TAC[CVECTOR_MUL_LZERO];\r
+ EXISTS_TAC `inv a :complex`\r
+ THEN ASM_REWRITE_TAC[COMPLEX_INV_EQ_0;CVECTOR_MUL_ASSOC]\r
+ THEN ASM_SIMP_TAC[COMPLEX_MUL_LINV;CVECTOR_MUL_ID]]]);;\r
+\r
+let COLLINEAR_LNONNULL = prove(\r
+ `!x y:complex^N.\r
+ collinear_cvectors x y /\ ~(x=cvector_zero) ==> ?a. y = a % x`,\r
+ REPEAT STRIP_TAC THEN ASM_CASES_TAC `y=cvector_zero:complex^N` THENL [\r
+ ASM_REWRITE_TAC[] THEN EXISTS_TAC `Cx(&0)`\r
+ THEN ASM_MESON_TAC[CVECTOR_MUL_LZERO];\r
+ ASM_MESON_TAC[NON_NULL_COLLINEARS] ]);;\r
+\r
+let COLLINEAR_RNONNULL = prove(\r
+ `!x y:complex^N.\r
+ collinear_cvectors x y /\ ~(y=cvector_zero) ==> ?a. x = a % y`,\r
+ MESON_TAC[COLLINEAR_LNONNULL;COLLINEAR_CVECTORS_SYM]);;\r
+\r
+let COLLINEAR_RUNITREAL = prove(\r
+ `!x y:real^N.\r
+ collinear_cvectors x (vector_to_cvector y) /\ norm y = &1\r
+ ==> x = (x cdot (vector_to_cvector y)) % vector_to_cvector y`,\r
+ REPEAT STRIP_TAC\r
+ THEN POP_ASSUM (DISTRIB [ASSUME_TAC; ASSUME_TAC o REWRITE_RULE[NORM_EQ_0;\r
+ GSYM VECTOR_TO_CVECTOR_ZERO_EQ] o MATCH_MP\r
+ (REAL_ARITH `!x. x= &1 ==> ~(x= &0)`)])\r
+ THEN FIRST_X_ASSUM (fun x -> FIRST_X_ASSUM (fun y ->\r
+ CHOOSE_THEN (SINGLE ONCE_REWRITE_TAC) (MATCH_MP COLLINEAR_RNONNULL\r
+ (CONJ y x))))\r
+ THEN REWRITE_TAC[CDOT_LMUL;CDOT_LREAL;CVECTOR_RE_VECTOR_TO_CVECTOR;\r
+ CVECTOR_IM_VECTOR_TO_CVECTOR;DOT_RZERO;COMPLEX_MUL_RZERO;COMPLEX_SUB_RZERO]\r
+ THEN POP_ASSUM ((fun x ->\r
+ REWRITE_TAC[x;COMPLEX_MUL_RID]) o REWRITE_RULE[NORM_EQ_1]));;\r
+\r
+let CCROSS_COLLINEAR_CVECTORS = prove\r
+ (`!x y:complex^3. x ccross y = cvector_zero <=> collinear_cvectors x y`,\r
+ REWRITE_TAC[ccross;collinear_cvectors;CART_EQ3;VECTOR_3;\r
+ CVECTOR_ZERO_COMPONENT;COMPLEX_SUB_0;CVECTOR_MUL_COMPONENT]\r
+ THEN REPEAT GEN_TAC THEN EQ_TAC\r
+ THENL [\r
+ REPEAT (POP_ASSUM MP_TAC) THEN ASM_CASES_TAC `(x:complex^3)$1 = Cx(&0)`\r
+ THENL [\r
+ ASM_CASES_TAC `(x:complex^3)$2 = Cx(&0)` THENL [\r
+ ASM_CASES_TAC `(x:complex^3)$3 = Cx(&0)` THENL [\r
+ REPEAT DISCH_TAC THEN EXISTS_TAC `Cx(&0)`\r
+ THEN ASM_REWRITE_TAC[COMPLEX_POLY_CLAUSES];\r
+ REPEAT STRIP_TAC THEN EXISTS_TAC `(y:complex^3)$3/(x:complex^3)$3`\r
+ THEN ASM_SIMP_TAC[COMPLEX_BALANCE_DIV_MUL]\r
+ THEN ASM_MESON_TAC[COMPLEX_MUL_AC];];\r
+ REPEAT STRIP_TAC THEN EXISTS_TAC `(y:complex^3)$2/(x:complex^3)$2`\r
+ THEN ASM_SIMP_TAC[COMPLEX_BALANCE_DIV_MUL]\r
+ THEN ASM_MESON_TAC[COMPLEX_MUL_AC]; ];\r
+ REPEAT STRIP_TAC THEN EXISTS_TAC `(y:complex^3)$1/(x:complex^3)$1`\r
+ THEN ASM_SIMP_TAC[COMPLEX_BALANCE_DIV_MUL]\r
+ THEN ASM_MESON_TAC[COMPLEX_MUL_AC];];\r
+ SIMPLE_COMPLEX_ARITH_TAC ]);;\r
+\r
+let CVECTOR_MUL_INV = prove\r
+ (`!a x y:complex^N. ~(a = Cx(&0)) /\ x = a % y ==> y = inv a % x`,\r
+ REPEAT STRIP_TAC THEN ASM_SIMP_TAC[CVECTOR_MUL_ASSOC;\r
+ MESON[] `(p\/q) <=> (~p ==> q)`;COMPLEX_MUL_LINV;CVECTOR_MUL_ID]);;\r
+\r
+let CVECTOR_MUL_INV2 = prove\r
+ (`!a x y:complex^N. ~(x = cvector_zero) /\ x = a % y ==> y = inv a % x`,\r
+ REPEAT STRIP_TAC THEN ASM_CASES_TAC `a=Cx(&0)`\r
+ THEN ASM_MESON_TAC[CVECTOR_MUL_LZERO;CVECTOR_MUL_INV]);;\r
+\r
+\r
+\r
+let COLLINEAR_CVECTORS_VECTOR_TO_CVECTOR = prove(\r
+ `!x y:real^N.\r
+ collinear_cvectors (vector_to_cvector x) (vector_to_cvector y)\r
+ <=> collinear {vec 0,x,y}`,\r
+ REWRITE_TAC[COLLINEAR_LEMMA_ALT;collinear_cvectors]\r
+ THEN REPEAT (STRIP_TAC ORELSE EQ_TAC) THENL [\r
+ POP_ASSUM MP_TAC THEN ONCE_REWRITE_TAC[CART_EQ]\r
+ THEN REWRITE_TAC[CVECTOR_MUL_COMPONENT;VECTOR_TO_CVECTOR_COMPONENT;\r
+ VECTOR_MUL_COMPONENT;COMPLEX_EQ;RE_CX;RE_MUL_CX]\r
+ THEN REPEAT STRIP_TAC THEN DISJ2_TAC THEN EXISTS_TAC `Re a`\r
+ THEN ASM_SIMP_TAC[];\r
+ REWRITE_TAC[MESON[]`(p\/q) <=> (~p ==> q)`]\r
+ THEN REWRITE_TAC[GSYM VECTOR_TO_CVECTOR_ZERO_EQ]\r
+ THEN DISCH_TAC\r
+ THEN SUBGOAL_TAC "" `vector_to_cvector (y:real^N) =\r
+ inv a % vector_to_cvector x` [ASM_MESON_TAC[CVECTOR_MUL_INV2]]\r
+ THEN POP_ASSUM MP_TAC THEN ONCE_REWRITE_TAC[CART_EQ]\r
+ THEN REWRITE_TAC[CVECTOR_MUL_COMPONENT;VECTOR_TO_CVECTOR_COMPONENT;\r
+ VECTOR_MUL_COMPONENT;COMPLEX_EQ;RE_CX;RE_MUL_CX]\r
+ THEN REPEAT STRIP_TAC THEN EXISTS_TAC `Re(inv a)` THEN ASM_SIMP_TAC[];\r
+ EXISTS_TAC `Cx(&0)` THEN ASM_REWRITE_TAC[VECTOR_TO_CVECTOR_ZERO;\r
+ CVECTOR_MUL_LZERO];\r
+ ASM_REWRITE_TAC[VECTOR_TO_CVECTOR_MUL] THEN EXISTS_TAC `Cx c`\r
+ THEN REWRITE_TAC[];\r
+ ]);;\r
+\r
+\r
+(* ========================================================================= *)\r
+(* ORTHOGONALITY *)\r
+(* ========================================================================= *)\r
+\r
+let corthogonal = new_definition\r
+ `corthogonal (x:complex^N) y <=> x cdot y = Cx(&0)`;;\r
+\r
+let CORTHOGONAL_SYM = prove(\r
+ `!x y:complex^N. corthogonal x y <=> corthogonal y x`,\r
+ MESON_TAC[corthogonal;CDOT_SYM;CNJ_ZERO]);;\r
+\r
+let CORTHOGONAL_0 = prove(\r
+ `!x:complex^N. corthogonal cvector_zero x /\ corthogonal x cvector_zero`,\r
+ REWRITE_TAC[corthogonal;CDOT_LZERO;CDOT_RZERO]);;\r
+\r
+let [CORTHOGONAL_LZERO;CORTHOGONAL_RZERO] = GCONJUNCTS CORTHOGONAL_0;;\r
+\r
+let CORTHOGONAL_COLLINEAR_CVECTORS = prove\r
+ (`!x y:complex^N.\r
+ collinear_cvectors x y /\ ~(x=cvector_zero) /\ ~(y=cvector_zero)\r
+ ==> ~(corthogonal x y)`,\r
+ REWRITE_TAC[collinear_cvectors;corthogonal] THEN REPEAT STRIP_TAC\r
+ THEN POP_ASSUM MP_TAC\r
+ THEN ASM_REWRITE_TAC[CDOT_RMUL;CDOT_LMUL;COMPLEX_ENTIRE;GSYM cnorm2;\r
+ CDOT_EQ_0;CNJ_EQ_0]\r
+ THEN ASM_MESON_TAC[CVECTOR_MUL_LZERO]);;\r
+ \r
+let CORTHOGONAL_MUL_CLAUSES = prove\r
+ (`!x y a.\r
+ (corthogonal x y ==> corthogonal x (a%y))\r
+ /\ (corthogonal x y \/ a = Cx(&0) <=> corthogonal x (a%y))\r
+ /\ (corthogonal x y ==> corthogonal (a%x) y)\r
+ /\ (corthogonal x y \/ a = Cx(&0) <=> corthogonal (a%x) y)`,\r
+ SIMP_TAC[corthogonal;CDOT_RMUL;CDOT_LMUL;COMPLEX_ENTIRE;CNJ_EQ_0]\r
+ THEN MESON_TAC[]);;\r
+\r
+let [CORTHOGONAL_RMUL;CORTHOGONAL_RMUL_EQ;CORTHOGONAL_LMUL;\r
+ CORTHOGONAL_LMUL_EQ] = GCONJUNCTS CORTHOGONAL_MUL_CLAUSES;;\r
+\r
+let CORTHOGONAL_LRMUL_CLAUSES = prove \r
+ (`!x y a b.\r
+ (corthogonal x y ==> corthogonal (a%x) (b%y))\r
+ /\ (corthogonal x y \/ a = Cx(&0) \/ b = Cx(&0)\r
+ <=> corthogonal (a%x) (b%y))`,\r
+ MESON_TAC[CORTHOGONAL_MUL_CLAUSES]);;\r
+\r
+let [CORTHOGONAL_LRMUL;CORTHOGONAL_LRMUL_EQ] =\r
+ GCONJUNCTS CORTHOGONAL_LRMUL_CLAUSES;;\r
+\r
+let CORTHOGONAL_REAL_CLAUSES = prove\r
+ (`!r c.\r
+ (corthogonal c (vector_to_cvector r)\r
+ <=> orthogonal (cvector_re c) r /\ orthogonal (cvector_im c) r)\r
+ /\ (corthogonal (vector_to_cvector r) c\r
+ <=> orthogonal r (cvector_re c) /\ orthogonal r (cvector_im c))`,\r
+ REWRITE_TAC[corthogonal;orthogonal;CDOT_LREAL;CDOT_RREAL;COMPLEX_SUB_0;\r
+ COMPLEX_EQ;RE_CX;IM_CX;RE_SUB;IM_SUB;RE_ADD;IM_ADD]\r
+ THEN REWRITE_TAC[RE_DEF;CX_DEF;IM_DEF;complex;complex_mul;VECTOR_2;ii]\r
+ THEN CONV_TAC REAL_FIELD);;\r
+\r
+let [CORTHOGONAL_RREAL;CORTHOGONAL_LREAL] =\r
+ GCONJUNCTS CORTHOGONAL_REAL_CLAUSES;;\r
+\r
+let CORTHOGONAL_UNIT = prove\r
+ (`!x y:complex^N.\r
+ (corthogonal x (cunit y) <=> corthogonal x y)\r
+ /\ (corthogonal (cunit x) y <=> corthogonal x y)`,\r
+ REWRITE_TAC[cunit;GSYM CORTHOGONAL_MUL_CLAUSES;COMPLEX_INV_EQ_0;CX_INJ;\r
+ CNORM_EQ_0]\r
+ THEN MESON_TAC[CORTHOGONAL_0]);;\r
+\r
+let [CORTHOGONAL_RUNIT;CORTHOGONAL_LUNIT] = GCONJUNCTS CORTHOGONAL_UNIT;;\r
+\r
+let CORTHOGONAL_PROJECTION = prove(\r
+ `!x y:complex^N. corthogonal (x - (x cdot cunit y) % cunit y) y`,\r
+ REPEAT GEN_TAC THEN ASM_CASES_TAC `y=cvector_zero:complex^N`\r
+ THEN ASM_REWRITE_TAC[corthogonal;CDOT_RZERO]\r
+ THEN REWRITE_TAC[CDOT_LSUB;cunit;CVECTOR_MUL_ASSOC;GSYM cnorm2;CDOT_LMUL;\r
+ CDOT_RMUL;REWRITE_RULE[REAL_CNJ] (MATCH_MP REAL_INV (SPEC_ALL REAL_CX))]\r
+ THEN REWRITE_TAC[COMPLEX_MUL_AC;GSYM COMPLEX_INV_MUL;GSYM COMPLEX_POW_2;\r
+ cnorm;o_DEF;CSQRT]\r
+ THEN SIMP_TAC[CNORM2_POS;CX_SQRT;cnorm2;REAL_CDOT_SELF;REAL_OF_COMPLEX;CSQRT]\r
+ THEN ASM_SIMP_TAC[CDOT_EQ_0;COMPLEX_MUL_RINV;COMPLEX_MUL_RID;\r
+ COMPLEX_SUB_REFL]);;\r
+\r
+let CDOT_PYTHAGOREAN = prove\r
+ (`!x y:complex^N. corthogonal x y ==> cnorm2 (x+y) = cnorm2 x + cnorm2 y`,\r
+ SIMP_TAC[corthogonal;cnorm2;CDOT_LADD;CDOT_RADD;COMPLEX_ADD_RID;\r
+ COMPLEX_ADD_LID;REAL_OF_COMPLEX_ADD;REAL_CDOT_SELF;\r
+ MESON[CDOT_SYM;CNJ_ZERO] `x cdot y = Cx (&0) ==> y cdot x = Cx(&0)`]);;\r
+\r
+let CDOT_CAUCHY_SCHWARZ_POW_2 = prove\r
+ (`!x y:complex^N. norm (x cdot y) pow 2 <= cnorm2 x * cnorm2 y`,\r
+ REPEAT GEN_TAC THEN ASM_CASES_TAC `y = cvector_zero:complex^N`\r
+ THEN ASM_REWRITE_TAC[CNORM2_CVECTOR_ZERO;CDOT_RZERO;COMPLEX_NORM_0;\r
+ REAL_POW_2;REAL_MUL_RZERO;REAL_OF_COMPLEX_CX;REAL_LE_REFL]\r
+ THEN ONCE_REWRITE_TAC[MATCH_MP (MESON[CVECTOR_SUB_ADD] \r
+ `(!x:complex^N y. p (x - f x y) y)\r
+ ==> cnorm2 x * z = cnorm2 (x - f x y + f x y) * z`) CORTHOGONAL_PROJECTION]\r
+ THEN MATCH_MP_TAC (GEN_ALL (MATCH_MP (MESON[] `(!x y. P x y ==> f x y = (g x y:real))\r
+ ==> P x y /\ a <= g x y * b ==> a <= f x y * b`) CDOT_PYTHAGOREAN))\r
+ THEN REWRITE_TAC[GSYM CORTHOGONAL_MUL_CLAUSES;CORTHOGONAL_RUNIT;\r
+ CORTHOGONAL_PROJECTION]\r
+ THEN SIMP_TAC[cnorm2;GSYM REAL_OF_COMPLEX_ADD;REAL_CDOT_SELF;REAL_ADD;\r
+ GSYM REAL_OF_COMPLEX_MUL]\r
+ THEN REWRITE_TACS[cunit;CDOT_RMUL;CVECTOR_MUL_ASSOC;REWRITE_RULE[REAL_CNJ]\r
+ (MATCH_MP REAL_INV (SPEC_ALL REAL_CX));COMPLEX_MUL_AC;GSYM COMPLEX_INV_MUL;\r
+ GSYM COMPLEX_POW_2;cnorm;o_DEF;CSQRT;COMPLEX_ADD_LDISTRIB;cnorm2;CDOT_RMUL;\r
+ CNJ_MUL;CDOT_LMUL;GSYM cnorm2;\r
+ REWRITE_RULE[REAL_CNJ] (MATCH_MP REAL_INV (SPEC_ALL REAL_CX))]\r
+ THEN SIMP_TAC[CX_SQRT;CNORM2_POS;CSQRT;CX_CNORM2]\r
+ THEN REWRITE_TAC[SIMPLE_COMPLEX_ARITH\r
+ `x * ((y * inv x) * x) * (z * inv x') * inv x'\r
+ = (y * z) * (x * inv x) * (x * inv x' * inv x'):complex`]\r
+ THEN ASM_SIMP_TAC[CDOT_EQ_0;COMPLEX_MUL_RINV;COMPLEX_MUL_LID;COMPLEX_MUL_CNJ;\r
+ GSYM COMPLEX_INV_MUL]\r
+ THEN ONCE_REWRITE_TAC[\r
+ GSYM (MATCH_MP REAL_OF_COMPLEX (SPEC_ALL REAL_CDOT_SELF))]\r
+ THEN SIMP_TAC[GSYM cnorm2;GSYM CX_SQRT;CNORM2_POS;GSYM CX_MUL;\r
+ GSYM COMPLEX_POW_2;GSYM CX_POW;SQRT_POW_2;GSYM CX_INV]\r
+ THEN ASM_SIMP_TAC[REAL_MUL_RINV;CNORM2_EQ_0;REAL_MUL_RID;GSYM CX_ADD;\r
+ REAL_OF_COMPLEX_CX;GSYM REAL_POW_2;REAL_LE_ADDL;REAL_LE_MUL;CNORM2_POS]);;\r
+\r
+let CDOT_CAUCHY_SCHWARZ = prove \r
+ (`!x y:complex^N. norm (x cdot y) <= norm x * norm y`,\r
+ REPEAT GEN_TAC THEN MATCH_MP_TAC (REWRITE_RULE[REAL_LE_SQUARE_ABS]\r
+ (REAL_ARITH `&0 <= x /\ &0 <= y /\ abs x <= abs y ==> x <= y`))\r
+ THEN SIMP_TAC[NORM_POS_LE;CNORM_POS;REAL_LE_MUL;REAL_POW_MUL;CNORM_POW_2;\r
+ CDOT_CAUCHY_SCHWARZ_POW_2]);;\r
+\r
+let CDOT_CAUCHY_SCHWARZ_POW_2_EQUAL = prove\r
+ (`!x y:complex^N.\r
+ norm (x cdot y) pow 2 = cnorm2 x * cnorm2 y <=> collinear_cvectors x y`,\r
+ REPEAT GEN_TAC THEN ASM_CASES_TAC `y = cvector_zero:complex^N`\r
+ THEN ASM_REWRITE_TAC[CNORM2_CVECTOR_ZERO;CDOT_RZERO;COMPLEX_NORM_0;\r
+ REAL_POW_2;REAL_MUL_RZERO;REAL_OF_COMPLEX_CX;COLLINEAR_CVECTORS_0]\r
+ THEN EQ_TAC THENL [\r
+ ONCE_REWRITE_TAC[MATCH_MP (MESON[CVECTOR_SUB_ADD] \r
+ `(!x:complex^N y. p (x - f x y) y) ==>\r
+ cnorm2 x * z = cnorm2 (x - f x y + f x y) * z`) CORTHOGONAL_PROJECTION]\r
+ THEN MATCH_MP_TAC (GEN_ALL (MATCH_MP (MESON[]\r
+ `(!x y. P x y ==> g x y = (f x y:real)) ==>\r
+ P x y /\ (a = f x y * z ==> R) ==> (a = g x y * z ==> R)`)\r
+ CDOT_PYTHAGOREAN))\r
+ THEN REWRITE_TAC[GSYM CORTHOGONAL_MUL_CLAUSES;CORTHOGONAL_RUNIT;\r
+ CORTHOGONAL_PROJECTION]\r
+ THEN SIMP_TAC[cnorm2;GSYM REAL_OF_COMPLEX_ADD;REAL_CDOT_SELF;REAL_ADD;\r
+ GSYM REAL_OF_COMPLEX_MUL]\r
+ THEN REWRITE_TACS[cunit;CDOT_RMUL;CVECTOR_MUL_ASSOC;REWRITE_RULE[REAL_CNJ]\r
+ (MATCH_MP REAL_INV (SPEC_ALL REAL_CX));COMPLEX_MUL_AC;\r
+ GSYM COMPLEX_INV_MUL;GSYM COMPLEX_POW_2;cnorm;o_DEF;CSQRT;\r
+ COMPLEX_ADD_LDISTRIB;cnorm2;CDOT_RMUL;CNJ_MUL;CDOT_LMUL;GSYM cnorm2;\r
+ REWRITE_RULE[REAL_CNJ] (MATCH_MP REAL_INV (SPEC_ALL REAL_CX))]\r
+ THEN SIMP_TAC[CX_SQRT;CNORM2_POS;CSQRT;CX_CNORM2]\r
+ THEN REWRITE_TAC[SIMPLE_COMPLEX_ARITH\r
+ `x * ((y * inv x) * x) * (z * inv x') * inv x' =\r
+ (y * z) * (x * inv x) * (x * inv x' * inv x'):complex`]\r
+ THEN ONCE_REWRITE_TAC[GSYM (MATCH_MP REAL_OF_COMPLEX\r
+ (SPEC_ALL REAL_CDOT_SELF))]\r
+ THEN SIMP_TAC[GSYM cnorm2;GSYM CX_SQRT;CNORM2_POS;GSYM CX_MUL;\r
+ GSYM COMPLEX_POW_2;GSYM CX_POW;SQRT_POW_2;GSYM CX_INV;REAL_POW_INV]\r
+ THEN ASM_SIMP_TAC[REAL_MUL_RINV;CNORM2_EQ_0;REAL_MUL_RID;GSYM CX_ADD;\r
+ REAL_OF_COMPLEX_CX;GSYM REAL_POW_2;REAL_LE_ADDL;REAL_LE_MUL;CNORM2_POS;\r
+ GSYM CX_POW;REAL_POW_ONE;COMPLEX_MUL_RID;COMPLEX_MUL_CNJ;\r
+ REAL_ARITH `x = y + x <=> y = &0`;REAL_ENTIRE;CNORM2_EQ_0;\r
+ CVECTOR_SUB_EQ;collinear_cvectors]\r
+ THEN MESON_TAC[];\r
+ REWRITE_TAC[collinear_cvectors] THEN REPEAT STRIP_TAC\r
+ THEN ASM_REWRITE_TAC[cnorm2;CDOT_LMUL;CDOT_RMUL;COMPLEX_NORM_MUL;\r
+ COMPLEX_MUL_ASSOC]\r
+ THEN SIMP_TAC[COMPLEX_MUL_CNJ;GSYM cnorm2;COMPLEX_NORM_CNJ;GSYM CX_POW;\r
+ REAL_OF_COMPLEX_MUL;REAL_CX;REAL_CDOT_SELF;REAL_OF_COMPLEX_CX;\r
+ GSYM CNORM2_ALT]\r
+ THEN SIMPLE_COMPLEX_ARITH_TAC\r
+ ]);;\r
+\r
+let CDOT_CAUCHY_SCHWARZ_EQUAL = prove\r
+ (`!x y:complex^N.\r
+ norm (x cdot y) = norm x * norm y <=> collinear_cvectors x y`,\r
+ ONCE_REWRITE_TAC[REWRITE_RULE[REAL_EQ_SQUARE_ABS] (REAL_ARITH\r
+ `x=y <=> abs x = abs y /\ (&0 <= x /\ &0 <= y \/ x < &0 /\ y < &0)`)]\r
+ THEN SIMP_TAC[NORM_POS_LE;CNORM_POS;REAL_LE_MUL;REAL_POW_MUL;CNORM_POW_2;\r
+ CDOT_CAUCHY_SCHWARZ_POW_2_EQUAL]);;\r
+\r
+let CNORM_TRIANGLE = prove\r
+ (`!x y:complex^N. norm (x+y) <= norm x + norm y`,\r
+ REPEAT GEN_TAC THEN MATCH_MP_TAC (REWRITE_RULE[REAL_LE_SQUARE_ABS]\r
+ (REAL_ARITH `abs x <= abs y /\ &0 <= x /\ &0 <= y ==> x <= y`))\r
+ THEN SIMP_TAC[CNORM_POS;REAL_LE_ADD;REAL_ADD_POW_2;CNORM_POW_2;cnorm2;\r
+ CDOT_LADD;CDOT_RADD;SIMPLE_COMPLEX_ARITH `(x+y)+z+t = x+(y+z)+t:complex`;\r
+ ADD_CDOT_SYM;REAL_OF_COMPLEX_ADD;REAL_CDOT_SELF;REAL_CX;REAL_ADD;\r
+ REAL_OF_COMPLEX_CX;REAL_ARITH `x+ &2*y+z<=x+z+ &2*t <=> y<=t:real`]\r
+ THEN MESON_TAC[CDOT_CAUCHY_SCHWARZ;RE_NORM;REAL_LE_TRANS]);;\r
+\r
+let REAL_ABS_SUB_CNORM = prove\r
+ (`!x y:complex^N. abs (norm x - norm y) <= norm (x-y)`,\r
+ let lemma =\r
+ REWRITE_RULE[CVECTOR_SUB_ADD2;REAL_ARITH `x<=y+z <=> x-y<=z:real`]\r
+ (SPECL [`x:complex^N`;`y-x:complex^N`] CNORM_TRIANGLE)\r
+ in\r
+ REPEAT GEN_TAC\r
+ THEN MATCH_MP_TAC (MATCH_MP (MESON[]\r
+ `(!x y. P x y <=> Q x y) ==> Q x y ==> P x y`) REAL_ABS_BOUNDS)\r
+ THEN ONCE_REWRITE_TAC[REAL_ARITH `--x <= y <=> --y <= x`]\r
+ THEN REWRITE_TAC[REAL_NEG_SUB]\r
+ THEN REWRITE_TAC[lemma;ONCE_REWRITE_RULE[CNORM_SUB] lemma]);;\r
+\r
+(* ========================================================================= *)\r
+(* VSUM *)\r
+(* ========================================================================= *)\r
+\r
+let cvsum = new_definition\r
+ `(cvsum:(A->bool)->(A->complex^N)->complex^N) s f = lambda i. vsum s (\x. (f x)$i)`;;\r
+\r
+\r
+(* ========================================================================= *)\r
+(* INFINITE SUM *)\r
+(* ========================================================================= *)\r
+\r
+let csummable = new_definition\r
+ `csummable (s:num->bool) (f:num->complex^N)\r
+ <=> summable s (cvector_re o f) /\ summable s (cvector_im o f)`;;\r
+\r
+let cinfsum = new_definition\r
+ `cinfsum (s:num->bool) (f:num->complex^N) :complex^N\r
+ = vector_to_cvector (infsum s (\x. cvector_re (f x)))\r
+ + ii % vector_to_cvector (infsum s (\x.cvector_im (f x)))`;;\r
+\r
+let CSUMMABLE_FLATTEN_CVECTOR = prove\r
+ (`!s (f:num->complex^N). csummable s f <=> summable s (cvector_flatten o f)`,\r
+ REWRITE_TAC[csummable;summable;cvector_flatten;o_DEF]\r
+ THEN REPEAT (STRIP_TAC ORELSE EQ_TAC)\r
+ THENL [\r
+ EXISTS_TAC `pastecart (l:real^N) (l':real^N)`\r
+ THEN ASM_SIMP_TAC[GSYM SUMS_PASTECART];\r
+ EXISTS_TAC `fstcart (l:real^(N,N) finite_sum)`\r
+ THEN MATCH_MP_TAC (GEN_ALL (MATCH_MP (TAUT `(p /\ q <=> r) ==> (r ==> p)`)\r
+ (INST_TYPE [`:N`,`:M`] (SPEC_ALL SUMS_PASTECART))))\r
+ THEN EXISTS_TAC `(cvector_im o f) :num->real^N`\r
+ THEN EXISTS_TAC `sndcart (l:real^(N,N) finite_sum)`\r
+ THEN ASM_REWRITE_TAC[ETA_AX;o_DEF;PASTECART_FST_SND];\r
+ EXISTS_TAC `sndcart (l:real^(N,N) finite_sum)`\r
+ THEN MATCH_MP_TAC (GEN_ALL (MATCH_MP (TAUT `(p /\ q <=> r) ==> (r ==> q)`)\r
+ (INST_TYPE [`:N`,`:M`] (SPEC_ALL SUMS_PASTECART))))\r
+ THEN EXISTS_TAC `(cvector_re o f) :num->real^N`\r
+ THEN EXISTS_TAC `fstcart (l:real^(N,N) finite_sum)`\r
+ THEN ASM_REWRITE_TAC[ETA_AX;o_DEF;PASTECART_FST_SND];\r
+ ]);;\r
+\r
+let FLATTEN_CINFSUM = prove\r
+ (`!s f.\r
+ csummable s f ==>\r
+ ((cinfsum s f):complex^N) =\r
+ cvector_unflatten (infsum s (cvector_flatten o f))`,\r
+ SIMP_TAC[cinfsum;cvector_unflatten;COMPLEX_VECTOR_TRANSPOSE;LINEAR_FSTCART;\r
+ LINEAR_SNDCART;CSUMMABLE_FLATTEN_CVECTOR;GSYM INFSUM_LINEAR;o_DEF;\r
+ cvector_flatten;FSTCART_PASTECART;SNDCART_PASTECART]);;\r
+\r
+let CSUMMABLE_LINEAR = prove\r
+ (`!f h:complex^N->complex^M s.\r
+ csummable s f /\ clinear h ==> csummable s (h o f)`,\r
+ REWRITE_TAC[CSUMMABLE_FLATTEN_CVECTOR] THEN REPEAT STRIP_TAC\r
+ THEN POP_ASSUM (ASSUME_TAC o MATCH_MP FLATTEN_CLINEAR)\r
+ THEN SUBGOAL_THEN\r
+ `cvector_flatten o (h:complex^N -> complex^M) o (f:num -> complex^N) =\r
+ \n. (cvector_flatten o h o cvector_unflatten) (cvector_flatten (f n))`\r
+ (SINGLE REWRITE_TAC)\r
+ THENL [\r
+ REWRITE_TAC[o_DEF;FUN_EQ_THM] THEN GEN_TAC THEN REPEAT AP_TERM_TAC\r
+ THEN REWRITE_TAC[REWRITE_RULE[o_DEF;I_DEF;FUN_EQ_THM] UNFLATTEN_FLATTEN];\r
+ MATCH_MP_TAC SUMMABLE_LINEAR THEN ASM_SIMP_TAC[GSYM o_DEF]\r
+ ]);;\r
+\r
+let CINFSUM_LINEAR = prove\r
+ (`!f (h:complex^M->complex^N) s.\r
+ csummable s f /\ clinear h ==> cinfsum s (h o f) = h (cinfsum s f)`,\r
+ REPEAT GEN_TAC\r
+ THEN DISCH_THEN (fun x -> MP_TAC (CONJ (MATCH_MP CSUMMABLE_LINEAR x) x))\r
+ THEN SIMP_TAC[FLATTEN_CINFSUM;CSUMMABLE_FLATTEN_CVECTOR]\r
+ THEN REPEAT STRIP_TAC THEN POP_ASSUM (ASSUME_TAC o MATCH_MP FLATTEN_CLINEAR)\r
+ THEN SUBGOAL_THEN\r
+ `cvector_flatten o (h:complex^M->complex^N) o (f:num->complex^M) =\r
+ \n. (cvector_flatten o h o cvector_unflatten) ((cvector_flatten o f) n)`\r
+ (SINGLE REWRITE_TAC)\r
+ THENL [\r
+ REWRITE_TAC[o_DEF;FUN_EQ_THM] THEN GEN_TAC THEN REPEAT AP_TERM_TAC\r
+ THEN REWRITE_TAC[REWRITE_RULE[o_DEF;I_DEF;FUN_EQ_THM] UNFLATTEN_FLATTEN];\r
+ FIRST_ASSUM (fun x -> FIRST_ASSUM (fun y -> REWRITE_TAC[MATCH_MP\r
+ (MATCH_MP (REWRITE_RULE[IMP_CONJ] INFSUM_LINEAR) x) y]))\r
+ THEN REWRITE_TAC[o_DEF;REWRITE_RULE[o_DEF;I_DEF;FUN_EQ_THM]\r
+ UNFLATTEN_FLATTEN]\r
+ ]);;\r
+
--- /dev/null
+
+(* Upadted for the latest version of HOL Light (JULY 2014) *)
+(* ========================================================================= *)\r
+(* Formalization of Electromagnetic Optics *)\r
+(* *)\r
+(* (c) Copyright, Sanaz Khan Afshar & Vincent Aravantinos 2011-13 *)\r
+(* Hardware Verification Group, *)\r
+(* Concordia University *)\r
+(* *)\r
+(* Contact: <s_khanaf@encs.concordia.ca> *)\r
+(* <vincent@encs.concordia.ca> *)\r
+(* *)\r
+(* This file deals with the definition and basic theorems about the *)\r
+(* electromagnetic model. *)\r
+(* ========================================================================= *)\r
+\r
+new_type_abbrev("time",`:real`);;\r
+\r
+(********************************)\r
+(* Electromagnetic fields *)\r
+(********************************)\r
+\r
+new_type_abbrev("single_field",`:point -> time -> complex^3`);;\r
+new_type_abbrev("emf", `:point -> time -> complex^3 # complex^3`);;\r
+\r
+let e_of_emf = new_definition\r
+ `e_of_emf (emf:emf) : single_field = \r t. let (e,h) = emf r t in e`;;\r
+let h_of_emf = new_definition\r
+ `h_of_emf (emf:emf) : single_field = \r t. let (e,h) = emf r t in h`;;\r
+let is_valid_emf = new_definition\r
+ `is_valid_emf emf\r
+ <=> !r t. corthogonal (h_of_emf emf r t) (e_of_emf emf r t)`;;\r
+\r
+let EMF_EQ = prove\r
+ (`!emf:emf r t e h. emf r t = e,h\r
+ <=> e_of_emf emf r t = e /\ h_of_emf emf r t = h`,\r
+ REPEAT STRIP_TAC THEN EQ_TAC\r
+ THEN SIMP_TAC[e_of_emf;h_of_emf;LET_DEFs;PAIR_EQ;LAMBDA_PAIR]\r
+ THEN MESON_TAC[PAIR]);;\r
+\r
+let emf_at_point_mul = new_definition\r
+ `emf_at_point_mul (f:complex) (emf:complex^3#complex^3) :complex^3#complex^3\r
+ = (f % FST emf, f % SND emf)`;;\r
+\r
+overload_interface("%",\r
+ `emf_at_point_mul :complex->complex^3#complex^3->complex^3#complex^3`);;\r
+\r
+let emf_add = new_definition\r
+ `emf_add (emf1:emf) (emf2:emf) :emf = \r t.\r
+ (e_of_emf emf1 r t + e_of_emf emf2 r t,\r
+ h_of_emf emf1 r t + h_of_emf emf2 r t)`;;\r
+\r
+overload_interface("+",`emf_add :emf->emf->emf`);;\r
+ \r
+\r
+(********************************)\r
+(* Plane waves *)\r
+(********************************)\r
+\r
+let plane_wave = new_definition\r
+ `plane_wave k w e h : emf = \r t. cexp (--ii * Cx(k dot r - w*t)) % (e,h)`;;\r
+\r
+let is_plane_wave = new_definition\r
+ `is_plane_wave emf <=>\r
+ is_valid_emf emf /\ ?k w e h.\r
+ &0 < w /\ ~(k = vec 0) /\ emf = plane_wave k w e h\r
+ /\ corthogonal e (vector_to_cvector k)\r
+ /\ corthogonal h (vector_to_cvector k)`;;\r
+\r
+let k_of_wave = new_definition\r
+ `k_of_wave emf = @k. ?w e h . &0 < w /\ ~(k = vec 0)\r
+ /\ emf = plane_wave k w e h\r
+ /\ corthogonal e (vector_to_cvector k)\r
+ /\ corthogonal h (vector_to_cvector k)`;;\r
+\r
+let w_of_wave = new_definition\r
+ `w_of_wave emf = @w. ?e h . &0 < w /\ emf = plane_wave (k_of_wave emf) w e h\r
+ /\ corthogonal e (vector_to_cvector (k_of_wave emf))\r
+ /\ corthogonal h (vector_to_cvector (k_of_wave emf))`;;\r
+\r
+let e_of_wave = new_definition\r
+ `e_of_wave emf = @e. ?h . emf = plane_wave (k_of_wave emf) (w_of_wave emf) e h\r
+ /\ corthogonal e (vector_to_cvector (k_of_wave emf))\r
+ /\ corthogonal h (vector_to_cvector (k_of_wave emf))`;;\r
+\r
+let h_of_wave = new_definition\r
+ `h_of_wave emf = @h.\r
+ emf = plane_wave (k_of_wave emf) (w_of_wave emf) (e_of_wave emf) h\r
+ /\ corthogonal (e_of_wave emf) (vector_to_cvector (k_of_wave emf)) \r
+ /\ corthogonal h (vector_to_cvector (k_of_wave emf))`;;\r
+\r
+let eh_of_wave = new_definition\r
+ `eh_of_wave emf = (e_of_wave emf,h_of_wave emf)`;;\r
+\r
+let scalar_of_wave = new_definition\r
+ `scalar_of_wave emf =\r
+ \r t. cexp (--ii * Cx(k_of_wave emf dot r - w_of_wave emf * t))`;;\r
+\r
+let IS_PLANE_WAVE = prove\r
+ (`!emf. is_plane_wave emf <=>\r
+ is_valid_emf emf /\ &0 < w_of_wave emf /\ ~(k_of_wave emf = vec 0)\r
+ /\ emf = plane_wave (k_of_wave emf) (w_of_wave emf) (e_of_wave emf)\r
+ (h_of_wave emf)\r
+ /\ corthogonal (e_of_wave emf) (vector_to_cvector (k_of_wave emf))\r
+ /\ corthogonal (h_of_wave emf) (vector_to_cvector (k_of_wave emf))`,\r
+ let COMMON_TAC x =\r
+ GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[is_plane_wave;x] THEN MESON_TAC[]\r
+ in\r
+ let lemma1 = prove\r
+ (`!emf. is_plane_wave emf <=> is_valid_emf emf /\ ?w e h . &0 < w\r
+ /\ ~(k_of_wave emf = vec 0) /\ emf = plane_wave (k_of_wave emf) w e h\r
+ /\ corthogonal e (vector_to_cvector (k_of_wave emf))\r
+ /\ corthogonal h (vector_to_cvector (k_of_wave emf))`,\r
+ COMMON_TAC k_of_wave)\r
+ in\r
+ let lemma2 = prove\r
+ (`!emf. is_plane_wave emf <=>\r
+ is_valid_emf emf /\ ?e h . &0 < w_of_wave emf /\ ~(k_of_wave emf = vec 0)\r
+ /\ emf = plane_wave (k_of_wave emf) (w_of_wave emf) e h\r
+ /\ corthogonal e (vector_to_cvector (k_of_wave emf))\r
+ /\ corthogonal h (vector_to_cvector (k_of_wave emf))`,\r
+ REWRITE_TAC[lemma1] THEN COMMON_TAC w_of_wave)\r
+ in\r
+ let lemma3 = prove\r
+ (`!emf. is_plane_wave emf <=>\r
+ is_valid_emf emf /\ ?h . &0 < w_of_wave emf /\ ~(k_of_wave emf = vec 0) /\\r
+ emf = plane_wave (k_of_wave emf) (w_of_wave emf) (e_of_wave emf) h\r
+ /\ corthogonal (e_of_wave emf) (vector_to_cvector (k_of_wave emf))\r
+ /\ corthogonal h (vector_to_cvector (k_of_wave emf))`,\r
+ REWRITE_TAC[lemma2] THEN COMMON_TAC e_of_wave)\r
+ in\r
+ REWRITE_TAC[lemma3] THEN COMMON_TAC h_of_wave);;\r
+\r
+let EH_OF_EMF_PLANE_WAVE = prove\r
+ (`!k w e h.\r
+ (e_of_emf (plane_wave k w e h) = \r t. cexp (--ii * Cx(k dot r - w*t)) % e )\r
+ /\ h_of_emf (plane_wave k w e h) = \r t.\r
+ cexp (--ii * Cx(k dot r - w*t)) % h`,\r
+ REWRITE_TAC[e_of_emf;h_of_emf;plane_wave;emf_at_point_mul;LET_DEFs]);;\r
+\r
+let non_null_wave = new_definition\r
+ `non_null_wave emf <=>\r
+ is_plane_wave emf /\ ~(e_of_wave emf = cvector_zero)\r
+ /\ ~(h_of_wave emf = cvector_zero)`;;\r
+\r
+\r
+(***********************************)\r
+(* Plane interface between mediums *)\r
+(***********************************)\r
+\r
+ (* A medium is characterized by its refractive index *)\r
+new_type_abbrev("medium", `:real`);;\r
+\r
+(* The real^3 vector is a normal to the plane. It is needed in order to fix an\r
+ * orientation so that we can clearly say on which side is medium 1 or 2 \r
+ * respectively. *)\r
+new_type_abbrev("interface",`:medium # medium # plane # real^3`);;\r
+\r
+let FORALL_INTERFACE_THM = prove\r
+ (`!P. (!(i:interface). P i) <=> (!n1 n2 p n. P (n1,n2,p,n))`,\r
+ MESON_TAC[PAIR_SURJECTIVE]);;\r
+\r
+let is_valid_interface = new_definition\r
+ `is_valid_interface (i:interface) <=>\r
+ let (n1,n2,p,n) = i in\r
+ &0 < n1 /\ &0 < n2 /\ plane p /\ is_normal_to_plane n p`;;\r
+\r
+let plane_of_interface = new_definition\r
+ `plane_of_interface (i:interface) = let (n1,n2,p,n) = i in p`;;\r
+let normal_of_interface = new_definition\r
+ `normal_of_interface (i:interface) = let (n1,n2,p,n) = i in n`;;\r
+let n1_of_interface = new_definition\r
+ `n1_of_interface (i:interface) = let (n1,n2,p,n) = i in n1`;;\r
+let n2_of_interface = new_definition\r
+ `n2_of_interface (i:interface) = let (n1,n2,p,n) = i in n2`;;\r
+\r
+(* Helpers *)\r
+let IS_VALID_INTERFACE_IS_NORMAL_TO_PLANE = prove\r
+ (`!i. is_valid_interface i ==>\r
+ is_normal_to_plane (normal_of_interface i) (plane_of_interface i)`,\r
+ SIMP_TAC[FORALL_INTERFACE_THM;is_valid_interface;LET_DEFs;\r
+ normal_of_interface;plane_of_interface]);;\r
+\r
+let NORMAL_OF_INTERFACE_NON_NULL = prove\r
+ (`!i. is_valid_interface i ==> ~(normal_of_interface i = vec 0)`,\r
+ SIMP_TAC[FORALL_INTERFACE_THM;is_valid_interface;is_normal_to_plane;\r
+ normal_of_interface;LET_DEFs]);;\r
+let IS_VALID_INTERFACE_PLANE = prove\r
+ (`!i. is_valid_interface i ==> plane (plane_of_interface i)`,\r
+ SIMP_TAC[FORALL_INTERFACE_THM;is_valid_interface;plane_of_interface;\r
+ LET_DEFs]);;\r
+\r
+(* [p] is the point where continuity holds; [n] is the normal to the tangent\r
+ * plane at that point. *)\r
+\r
+let boundary_conditions = new_definition\r
+ `boundary_conditions emf1 emf2 p r t <=>\r
+ !n. is_normal_to_plane n p ==>\r
+ let n_ccross = (ccross) (vector_to_cvector n) in\r
+ n_ccross (e_of_emf emf1 r t) = n_ccross (e_of_emf emf2 r t)\r
+ /\ n_ccross (h_of_emf emf1 r t) = n_ccross (h_of_emf emf2 r t)`;;\r
+\r
+let eta0 = new_specification ["eta0"] \r
+ (EXISTS (`?x. &0 < x`,`&1`) (REAL_ARITH `&0 < &1`));;\r
+let k0 = new_specification ["k0"] \r
+ (EXISTS (`?x. &0 < x`,`&1`) (REAL_ARITH `&0 < &1`));;\r
+\r
+let is_plane_wave_at_interface = new_definition\r
+ `is_plane_wave_at_interface i emf_i emf_r emf_t <=>\r
+ is_valid_interface i /\ non_null_wave emf_i /\ is_plane_wave emf_r\r
+ /\ is_plane_wave emf_t\r
+ /\ let (n1,n2,p,n) = i in\r
+ (!pt. pt IN p ==> !t. boundary_conditions (emf_i + emf_r) emf_t p pt t) /\\r
+ (let (k_i,k_r,k_t) = map_triple k_of_wave (emf_i, emf_r, emf_t) in\r
+ (k_i dot n > &0 /\ k_r dot n <= &0 /\ k_t dot n >= &0) /\\r
+ norm k_i = k0 * n1 /\ norm k_r = k0 * n1 /\ norm k_t = k0 * n2) /\\r
+ let emf_in_medium = \emf n.\r
+ h_of_wave emf = Cx(&1 / (eta0 * k0)) %\r
+ (vector_to_cvector (k_of_wave emf) ccross (e_of_wave emf))\r
+ in\r
+ emf_in_medium emf_i n1 /\ emf_in_medium emf_r n1\r
+ /\ emf_in_medium emf_t n2`;;\r
+\r
+let IS_PLANE_WAVE_AT_INTERFACE_MAGNITUDES_RELATION = prove(\r
+ `!i emf_i emf_r emf_t. is_plane_wave_at_interface i emf_i emf_r emf_t ==>\r
+ let (n1,n2,p,n) = i in\r
+ let (e_i,e_r,e_t) = map_triple (norm o e_of_wave) (emf_i,emf_r,emf_t) in\r
+ let (h_i,h_r,h_t) = map_triple (norm o h_of_wave) (emf_i,emf_r,emf_t) in\r
+ h_i = e_i * n1_of_interface i / eta0\r
+ /\ h_r = e_r * n1_of_interface i / eta0\r
+ /\ h_t = e_t * n2_of_interface i / eta0`,\r
+ SIMP_TAC[FORALL_INTERFACE_THM;LET_DEFs;map_triple;o_DEF;n1_of_interface;\r
+ n2_of_interface;is_plane_wave_at_interface;GSYM CCROSS_LMUL;\r
+ GSYM VECTOR_TO_CVECTOR_MUL;CCROSS_LREAL;CNORM_NORM_2;\r
+ REWRITE_RULE[REAL_ARITH `x+y=z <=> x=z-y:real`] NORM_CROSS_DOT;non_null_wave;\r
+ REAL_ARITH `(x-y)+(z-t)=(x+z)-(y+t):real`;REAL_POW_MUL;\r
+ GSYM REAL_ADD_LDISTRIB;IS_PLANE_WAVE;CORTHOGONAL_REAL_CLAUSES;DOT_LMUL]\r
+ THEN ONCE_REWRITE_TAC[ORTHOGONAL_SYM] THEN SIMP_TAC[orthogonal;REAL_POW_2;\r
+ REAL_MUL_RZERO;REAL_ADD_RID;REAL_SUB_RZERO]\r
+ THEN SIMP_TAC[GSYM REAL_POW_2;REAL_LE_POW_2;MESON[REAL_LE_ADD;REAL_LE_POW_2]\r
+ `!x y. &0 <= x pow 2 + y pow 2`;SQRT_MUL;CX_MUL]\r
+ THEN REWRITE_TAC[GSYM CNORM_NORM_2;VECTOR_TO_CVECTOR_CVECTOR_RE_IM]
+(* THEN SIMP_TAC[NORM_POS_LE;POW_2_SQRT;NORM_MUL;real_div;REAL_MUL_LID] *)\r
+ THEN SIMP_TAC[NORM_POS_LE;SQRT_POW_2;NORM_MUL;real_div;REAL_MUL_LID]\r
+ THEN REWRITE_TAC[MESON[REAL_LT_IMP_LE;REAL_ABS_REFL;REAL_LE_INV;REAL_LE_MUL;\r
+ eta0;k0] `abs (inv (eta0 * k0)) = inv (eta0 * k0)`]\r
+ THEN REWRITE_TAC[REAL_INV_MUL;REAL_ARITH `(x*y)*z*t=x*(y*z)*t:real`;MATCH_MP\r
+ REAL_MUL_LINV (GSYM (MATCH_MP REAL_LT_IMP_NE k0));REAL_MUL_LID]\r
+ THEN REWRITE_TAC[COMPLEX_MUL_SYM;REAL_MUL_SYM]);;\r
+\r
+(* Helpers *)\r
+let IS_PLANE_WAVE_AT_INTERFACE_BOUNDARY_CONDITIONS = prove\r
+ (`!i emf_i emf_r emf_t.\r
+ is_plane_wave_at_interface i emf_i emf_r emf_t ==>\r
+ !pt. pt IN (plane_of_interface i) ==> !t.\r
+ boundary_conditions (emf_i + emf_r) emf_t (plane_of_interface i) pt t`,\r
+ SIMP_TAC[FORALL_INTERFACE_THM;is_plane_wave_at_interface;plane_of_interface;\r
+ LET_DEFs]);;\r
+\r
+let IS_PLANE_WAVE_AT_INTERFACE_IS_NORMAL_TO_PLANE = prove\r
+ (`!i emf_i emf_r emf_t. is_plane_wave_at_interface i emf_i emf_r emf_t ==>\r
+ is_normal_to_plane (normal_of_interface i) (plane_of_interface i)`,\r
+ SIMP_TAC[is_plane_wave_at_interface;IS_VALID_INTERFACE_IS_NORMAL_TO_PLANE]);;\r
+\r
+let IS_PLANE_WAVE_AT_INTERFACE_PLANE = prove\r
+ (`!i emf_i emf_r emf_t. is_plane_wave_at_interface i emf_i emf_r emf_t ==>\r
+ plane (plane_of_interface i)`,\r
+ SIMP_TAC[is_plane_wave_at_interface;IS_VALID_INTERFACE_PLANE]);;\r
+\r
+let IS_PLANE_WAVE_AT_INTERFACE_NON_NULL_NORMAL = prove\r
+ (`!i emf_i emf_r emf_t. is_plane_wave_at_interface i emf_i emf_r emf_t ==>\r
+ ~(normal_of_interface i = vec 0)`,\r
+ SIMP_TAC[FORALL_INTERFACE_THM;is_plane_wave_at_interface;is_valid_interface;\r
+ normal_of_interface;is_normal_to_plane;LET_DEFs]);;\r
+\r
+\r
+(***********************************)\r
+(* TE and TM modes *)\r
+(***********************************)\r
+\r
+let is_mode_axis = new_definition\r
+ `is_mode_axis field (i:interface) emf_i emf_r emf_t v <=>\r
+ orthogonal v (normal_of_interface i) /\ norm v = &1 /\ !r t.\r
+ collinear_cvectors (field emf_i r t) (vector_to_cvector v)\r
+ /\ collinear_cvectors (field emf_r r t) (vector_to_cvector v)\r
+ /\ collinear_cvectors (field emf_t r t) (vector_to_cvector v)`;;\r
+\r
+let transverse_mode = new_definition\r
+ `transverse_mode field (i:interface) emf_i emf_r emf_t <=>\r
+ ?v. is_mode_axis field (i:interface) emf_i emf_r emf_t v`;;\r
+\r
+let TE_mode = new_definition `TE_mode = transverse_mode e_of_emf`;;\r
+let TM_mode = new_definition `TM_mode = transverse_mode h_of_emf`;;\r
+\r
+let mode_axis = new_definition `mode_axis field i emf_i emf_r emf_t =\r
+ @v. is_mode_axis field i emf_i emf_r emf_t v`;;\r
+\r
+let TE_mode_axis = new_definition `TE_mode_axis = mode_axis e_of_emf`;;\r
+let TM_mode_axis = new_definition `TM_mode_axis = mode_axis h_of_emf`;;\r
+\r
+let TRANSVERSE_MODE_THM = prove\r
+ (`!field i emf_i emf_r emf_t. transverse_mode field i emf_i emf_r emf_t <=>\r
+ is_mode_axis field i emf_i emf_r emf_t (mode_axis field i emf_i emf_r emf_t)`,\r
+ REWRITE_TAC[transverse_mode;mode_axis] THEN SELECT_ELIM_TAC\r
+ THEN REWRITE_TAC[]);;\r
+\r
+let TE_MODE_THM = prove\r
+ (`!i emf_i emf_r emf_t. TE_mode i emf_i emf_r emf_t <=>\r
+ is_mode_axis e_of_emf i emf_i emf_r emf_t\r
+ (TE_mode_axis i emf_i emf_r emf_t)`,\r
+ REWRITE_TAC[TE_mode;TE_mode_axis;TRANSVERSE_MODE_THM]);;\r
+\r
+let TM_MODE_THM = prove\r
+ (`!i emf_i emf_r emf_t. TM_mode i emf_i emf_r emf_t <=>\r
+ is_mode_axis h_of_emf i emf_i emf_r emf_t \r
+ (TM_mode_axis i emf_i emf_r emf_t)`,\r
+ REWRITE_TAC[TM_mode;TM_mode_axis;TRANSVERSE_MODE_THM]);;\r
+\r
+let MODE_AXIS_ORTHOGONAL_N = prove\r
+ (`!field i emf_i emf_r emf_t. transverse_mode field i emf_i emf_r emf_t ==>\r
+ orthogonal (mode_axis field i emf_i emf_r emf_t) (normal_of_interface i)`,\r
+ SIMP_TAC[TRANSVERSE_MODE_THM;is_mode_axis]);;\r
+\r
+let TE_MODE_AXIS_ORTHOGONAL_N = prove\r
+ (`!i emf_i emf_r emf_t. TE_mode i emf_i emf_r emf_t ==>\r
+ orthogonal (TE_mode_axis i emf_i emf_r emf_t) (normal_of_interface i)`,\r
+ REWRITE_TAC[TE_mode;TE_mode_axis;MODE_AXIS_ORTHOGONAL_N]);;\r
+\r
+let TM_MODE_AXIS_ORTHOGONAL_N = prove\r
+ (`!i emf_i emf_r emf_t. TM_mode i emf_i emf_r emf_t ==>\r
+ orthogonal (TM_mode_axis i emf_i emf_r emf_t) (normal_of_interface i)`,\r
+ REWRITE_TAC[TM_mode;TM_mode_axis;MODE_AXIS_ORTHOGONAL_N]);;\r
+\r
+let TRANSVERSE_MODE_PROJ = prove\r
+ (`!field i emf_i emf_r emf_t. transverse_mode field i emf_i emf_r emf_t ==>\r
+ !r t. let x = vector_to_cvector (mode_axis field i emf_i emf_r emf_t) in\r
+ field emf_i r t = (field emf_i r t cdot x) % x\r
+ /\ field emf_r r t = (field emf_r r t cdot x) % x\r
+ /\ field emf_t r t = (field emf_t r t cdot x) % x`,\r
+ REWRITE_TAC[TRANSVERSE_MODE_THM;is_mode_axis;LET_DEFs] THEN REPEAT STRIP_TAC\r
+ THEN POP_ASSUM (STRIP_ASSUME_TAC o SPEC_ALL)\r
+ THEN FIRST_ASSUM (ASSUME_TAC o REWRITE_RULE[NORM_EQ_0;GSYM \r
+ VECTOR_TO_CVECTOR_ZERO_EQ] o MATCH_MP\r
+ (REAL_ARITH `!x. x= &1 ==> ~(x= &0)`))\r
+ THEN ASM_SIMP_TAC[COLLINEAR_RUNITREAL]);;\r
+\r
+let TE_MODE_PROJ = prove\r
+ (`!i emf_i emf_r emf_t. TE_mode i emf_i emf_r emf_t ==> !r t.\r
+ let x = vector_to_cvector (TE_mode_axis i emf_i emf_r emf_t) in\r
+ e_of_emf emf_i r t = (e_of_emf emf_i r t cdot x) % x \r
+ /\ e_of_emf emf_r r t = (e_of_emf emf_r r t cdot x) % x \r
+ /\ e_of_emf emf_t r t = (e_of_emf emf_t r t cdot x) % x`,\r
+ REWRITE_TAC[TE_mode;TE_mode_axis;TRANSVERSE_MODE_PROJ]);;\r
+\r
+let TM_MODE_PROJ = prove\r
+ (`!i emf_i emf_r emf_t. TM_mode i emf_i emf_r emf_t ==> !r t.\r
+ let x = vector_to_cvector (TM_mode_axis i emf_i emf_r emf_t) in\r
+ h_of_emf emf_i r t = (h_of_emf emf_i r t cdot x) % x \r
+ /\ h_of_emf emf_r r t = (h_of_emf emf_r r t cdot x) % x \r
+ /\ h_of_emf emf_t r t = (h_of_emf emf_t r t cdot x) % x`,\r
+ REWRITE_TAC[TM_mode;TM_mode_axis;TRANSVERSE_MODE_PROJ]);;\r
+\r
+let TE_MODE_PLANEWAVE_PROJ = prove\r
+ (`!i emf_i emf_r emf_t. TE_mode i emf_i emf_r emf_t /\ is_plane_wave emf_i\r
+ /\ is_plane_wave emf_r /\ is_plane_wave emf_t ==>\r
+ let x = vector_to_cvector (TE_mode_axis i emf_i emf_r emf_t) in\r
+ e_of_wave emf_i = (e_of_wave emf_i cdot x) % x\r
+ /\ e_of_wave emf_r = (e_of_wave emf_r cdot x) % x\r
+ /\ e_of_wave emf_t = (e_of_wave emf_t cdot x) % x`,\r
+ REWRITE_TAC[IS_PLANE_WAVE] THEN REPEAT STRIP_TAC \r
+ THEN ASM_CSQ_THEN TE_MODE_PROJ (MP_TAC o REWRITE_RULE[LET_DEFs])\r
+ THEN ASSUM_LIST (REWRITE_TAC o mapfilter (REWRITE_RULE[EH_OF_EMF_PLANE_WAVE]\r
+ o MATCH_MP (MESON[] `x=y ==> e_of_emf x = e_of_emf y`)))\r
+ THEN REWRITE_TAC[CDOT_LMUL;GSYM CVECTOR_MUL_ASSOC;CVECTOR_MUL_LCANCEL;\r
+ CEXP_NZ;LET_DEFs]);;\r
+\r
+let TM_MODE_PLANEWAVE_PROJ = prove\r
+ (`!i emf_i emf_r emf_t. TM_mode i emf_i emf_r emf_t /\ is_plane_wave emf_i\r
+ /\ is_plane_wave emf_r /\ is_plane_wave emf_t ==>\r
+ let x = vector_to_cvector (TM_mode_axis i emf_i emf_r emf_t) in\r
+ h_of_wave emf_i = (h_of_wave emf_i cdot x) % x\r
+ /\ h_of_wave emf_r = (h_of_wave emf_r cdot x) % x\r
+ /\ h_of_wave emf_t = (h_of_wave emf_t cdot x) % x`,\r
+ REWRITE_TAC[IS_PLANE_WAVE] THEN REPEAT STRIP_TAC\r
+ THEN ASM_CSQ_THEN TM_MODE_PROJ (MP_TAC o REWRITE_RULE[LET_DEFs])\r
+ THEN ASSUM_LIST (REWRITE_TAC o mapfilter (REWRITE_RULE[EH_OF_EMF_PLANE_WAVE]\r
+ o MATCH_MP (MESON[] `x=y ==> h_of_emf x = h_of_emf y`)))\r
+ THEN REWRITE_TAC[CDOT_LMUL;GSYM CVECTOR_MUL_ASSOC;CVECTOR_MUL_LCANCEL;CEXP_NZ;\r
+ LET_DEFs]);;\r
+
+
--- /dev/null
+(* ========================================================================= *)\r
+(* Formalization of Electromagnetic Optics *)\r
+(* *)\r
+(* (c) Copyright, Sanaz Khan Afshar & Vincent Aravantinos 2011-13 *)\r
+(* Hardware Verification Group, *)\r
+(* Concordia University *)\r
+(* *)\r
+(* Contact: <s_khanaf@encs.concordia.ca> *)\r
+(* <vincent@encs.concordia.ca> *)\r
+(* *)\r
+(* Proving that (!x. A*e^(iax)+B*e^(ibx)=C*e^(icx)) ==> a=b=c /\ A+B=C *)\r
+(* Several versions of this result are proved that are useful in proofs. *)\r
+(* ========================================================================= *)\r
+\r
+\r
+\r
+(** DERIVATION OF FUNCTIONS WITH REAL ARGUMENTS AND COMPLEX VALUES\r
+ *\r
+ * The proof of the lemma requires derivation of functions whose argument is \r
+ * real but whose value is complex. The theoretical background to do this in\r
+ * HOL-Light is already present in the library, but the automation is not well\r
+ * developped. In addition, we need several intermediate results which are\r
+ * available only for complex derivations or only for general derivation, etc.\r
+ * Hence we need a bit of work before getting the results we want.\r
+ *)\r
+\r
+let REAL_CMUL_TO_VECTOR_MUL = prove\r
+ (`!a x. a * Cx x = x % a`,\r
+ REWRITE_TAC[complex_mul;RE_DEF;IM_DEF;CX_DEF;complex;CART_EQ;DIMINDEX_2;\r
+ FORALL_2;VECTOR_2;VECTOR_MUL_COMPONENT] THEN SIMPLE_COMPLEX_ARITH_TAC);;\r
+\r
+let LINEAR_REAL_CMUL = prove\r
+ (`!a. linear (\x. a * Cx (drop x))`,\r
+ REWRITE_TAC[REAL_CMUL_TO_VECTOR_MUL;linear;drop;VECTOR_ADD_COMPONENT;\r
+ VECTOR_MUL_COMPONENT]\r
+ THEN VECTOR_ARITH_TAC);;\r
+\r
+let HAS_VECTOR_DERIVATIVE_REAL_CMUL = prove\r
+ (`!a x. ((\x. a * Cx (drop x)) has_vector_derivative a) (at x)`,\r
+ SIMP_TAC[has_vector_derivative;GSYM REAL_CMUL_TO_VECTOR_MUL;\r
+ HAS_DERIVATIVE_LINEAR;LINEAR_REAL_CMUL]);;\r
+\r
+let HAS_COMPLEX_DERIVATIVE_MUL_CEXP = prove\r
+ (`!a z. ((\z. a * cexp z) has_complex_derivative (a * cexp z)) (at z)`,\r
+ REPEAT GEN_TAC THEN COMPLEX_DIFF_TAC THEN SIMPLE_COMPLEX_ARITH_TAC);;\r
+\r
+let HAS_VECTOR_DERIVATIVE_CEXP = prove\r
+ (`!A a x. ((\x. A * cexp(a * Cx(drop x))) has_vector_derivative (A * a *\r
+ cexp (a * Cx(drop x)))) (at x)`,\r
+ REWRITE_TAC[has_vector_derivative; GSYM (REWRITE_CONV[o_DEF] \r
+ `(\x. A * cexp x) o (\x. a * Cx(drop x))`); GSYM REAL_CMUL_TO_VECTOR_MUL]\r
+ THEN SUBGOAL_THEN\r
+ `!A a x. (\x'. (A * a * cexp (a * Cx (drop x))) * Cx (drop x')) = (\x'. A *\r
+ cexp(a * Cx(drop x)) * x') o (\x. a * Cx(drop x))` (SINGLE REWRITE_TAC)\r
+ THENL ON_FIRST_GOAL (REWRITE_TAC[o_DEF;FUN_EQ_THM]\r
+ THEN SIMPLE_COMPLEX_ARITH_TAC)\r
+ THEN REPEAT GEN_TAC THEN MATCH_MP_TAC DIFF_CHAIN_AT THEN CONJ_TAC \r
+ THENL [\r
+ REWRITE_TAC[REAL_CMUL_TO_VECTOR_MUL;GSYM has_vector_derivative]\r
+ THEN REWRITE_TAC[GSYM REAL_CMUL_TO_VECTOR_MUL;\r
+ HAS_VECTOR_DERIVATIVE_REAL_CMUL];\r
+ REWRITE_TAC[] THEN MATCH_ACCEPT_TAC (REWRITE_RULE[has_complex_derivative;\r
+ GSYM COMPLEX_MUL_ASSOC] HAS_COMPLEX_DERIVATIVE_MUL_CEXP);\r
+ ]);;\r
+\r
+let HAS_VECTOR_DERIVATIVE_SUM_CEXP = prove\r
+ (`!A B a b x. ((\x. A * cexp(a * Cx(drop x)) + B * cexp(b * Cx(drop x)))\r
+ has_vector_derivative (A * a * cexp (a * Cx(drop x)) + B * b * cexp (b *\r
+ Cx(drop x)))) (at x)`,\r
+ REPEAT GEN_TAC THEN MATCH_MP_TAC HAS_VECTOR_DERIVATIVE_ADD THEN CONJ_TAC\r
+ THEN MATCH_ACCEPT_TAC HAS_VECTOR_DERIVATIVE_CEXP);;\r
+\r
+\r
+(** MAIN RESULT *)\r
+\r
+let WAVE_SUM_EQ_CORE = prove \r
+ (`!a b c A B C. ~(A = Cx(&0)) /\ ~(B = Cx(&0)) /\ ~(C = Cx(&0))\r
+ /\ (!x. A * cexp (a * Cx x) + B * cexp (b * Cx x) = C * cexp (c * Cx x))\r
+ ==> a = b /\ b = c /\ A + B = C`,\r
+ REPEAT GEN_TAC THEN STRIP_TAC\r
+ THEN SUBGOAL_THEN\r
+ `!x. a * A * cexp (a*Cx x) + b * B * cexp (b*Cx x) = c * C * cexp (c*Cx x)`\r
+ ASSUME_TAC\r
+ THENL ON_FIRST_GOAL \r
+ (REWRITE_TAC[FORALL_DROP] THEN GEN_TAC \r
+ THEN MATCH_MP_TAC VECTOR_DERIVATIVE_UNIQUE_AT\r
+ THEN MAP_EVERY EXISTS_TAC [`\x. C * cexp (c * Cx(drop x))`;`x:real^1`]\r
+ THEN REWRITE_TAC\r
+ [MESON[COMPLEX_MUL_AC] `!A a. a * A * cexp x = A * a * cexp x`]\r
+ THEN CONJ_TAC THEN TRY (MATCH_ACCEPT_TAC HAS_VECTOR_DERIVATIVE_CEXP)\r
+ THEN POP_ASSUM (fun x -> REWRITE_TAC[GSYM x]) \r
+ THEN MATCH_ACCEPT_TAC HAS_VECTOR_DERIVATIVE_SUM_CEXP)\r
+ THEN SUBGOAL_THEN `!x. a pow 2 * A * cexp (a*Cx x) + b\r
+ pow 2 * B * cexp (b*Cx x) = c pow 2 * C * cexp (c*Cx x)` ASSUME_TAC\r
+ THENL ON_FIRST_GOAL \r
+ (REWRITE_TAC[FORALL_DROP] THEN GEN_TAC \r
+ THEN MATCH_MP_TAC VECTOR_DERIVATIVE_UNIQUE_AT\r
+ THEN MAP_EVERY EXISTS_TAC [`\x.(C * c) * cexp (c * Cx(drop x))`;`x:real^1`]\r
+ THEN REWRITE_TAC[COMPLEX_POW_2]\r
+ THEN REWRITE_TAC\r
+ [MESON[COMPLEX_MUL_AC] `!A a. (a*a) * A * cexp x = (A*a)*a*cexp x`]\r
+ THEN CONJ_TAC THEN TRY (MATCH_ACCEPT_TAC HAS_VECTOR_DERIVATIVE_CEXP)\r
+ THEN\r
+ let assoc_on_cexp =\r
+ MESON[COMPLEX_MUL_AC] `!C c. (C*c) * cexp x = c*C*cexp x`\r
+ in\r
+ REWRITE_TAC[assoc_on_cexp]\r
+ THEN POP_ASSUM (fun x -> REWRITE_TAC[GSYM x; GSYM assoc_on_cexp])\r
+ THEN REWRITE_TAC\r
+ [MESON[COMPLEX_MUL_AC] `!A a. (a*A*a) * cexp x = (A*a)*a*cexp x`]\r
+ THEN MATCH_ACCEPT_TAC HAS_VECTOR_DERIVATIVE_SUM_CEXP)\r
+ THEN RULE_ASSUM_TAC (try_or_id (REWRITE_RULE[COMPLEX_MUL_RZERO;\r
+ COMPLEX_ADD_RID;CEXP_0;COMPLEX_MUL_RID] o SPEC `&0`))\r
+ THEN SUBGOAL_THEN\r
+ `(a*A+b*B) pow 2 = a pow 2 * A pow 2 + b pow 2 * B pow 2 + Cx(&2)*a*b*A*B`\r
+ MP_TAC\r
+ THENL ON_FIRST_GOAL\r
+ (REWRITE_TAC[COMPLEX_POW_2] THEN SIMPLE_COMPLEX_ARITH_TAC)\r
+ THEN SUBGOAL_THEN\r
+ `(a*A+b*B) pow 2 = a pow 2 * A pow 2 + b pow 2 * B pow 2 + a pow 2 * A *\r
+ B + b pow 2 * A * B :complex` \r
+ (SINGLE REWRITE_TAC)\r
+ THENL ON_FIRST_GOAL \r
+ (GEN_REWRITE_TAC (RATOR_CONV o ONCE_DEPTH_CONV) [COMPLEX_POW_2]\r
+ THEN ASM\r
+ (GEN_REWRITE_TAC (RATOR_CONV o RAND_CONV o RATOR_CONV o DEPTH_CONV)) []\r
+ THEN FIND_ASSUM (SINGLE REWRITE_TAC o GSYM) `A+B=C:complex`\r
+ THEN FIND_ASSUM (SINGLE REWRITE_TAC) `a * A + b * B = c * C:complex`\r
+ THEN SUBGOAL_TAC "" `(c * (A + B)) * c * C = (A+B) * c pow 2 * C:complex`\r
+ [REWRITE_TAC[COMPLEX_POW_2] THEN SIMPLE_COMPLEX_ARITH_TAC]\r
+ THEN POP_ASSUM (SINGLE REWRITE_TAC)\r
+ THEN FIND_ASSUM (SINGLE REWRITE_TAC o GSYM)\r
+ (`a pow 2 * A + b pow 2 * B = c pow 2 * C:complex`)\r
+ THEN REWRITE_TAC[COMPLEX_POW_2] THEN SIMPLE_COMPLEX_ARITH_TAC)\r
+ THEN REWRITE_TAC[COMPLEX_EQ_ADD_LCANCEL]\r
+ THEN SUBGOAL_THEN `a pow 2 * A * B + b pow 2 * A * B = Cx (&2) * a * b * A *\r
+ B <=> (a-b) pow 2 * A * B = Cx(&0)` (SINGLE REWRITE_TAC)\r
+ THENL ON_FIRST_GOAL\r
+ (REWRITE_TAC[COMPLEX_POW_2] THEN SIMPLE_COMPLEX_ARITH_TAC)\r
+ THEN REWRITE_TAC[COMPLEX_ENTIRE]\r
+ THEN RULE_ASSUM_TAC (SINGLE PURE_REWRITE_RULE (TAUT `~p <=> (p<=>F)`))\r
+ THEN ASM_REWRITE_TAC[COMPLEX_POW_2;COMPLEX_ENTIRE;COMPLEX_SUB_0]\r
+ THEN DISCH_THEN (fun x -> REWRITE_ASSUMPTIONS[x;GSYM COMPLEX_ADD_LDISTRIB]\r
+ THEN REWRITE_TAC[x])\r
+ THEN POP_ASSUM (K ALL_TAC) THEN POP_ASSUM MP_TAC\r
+ THEN ASM_REWRITE_TAC[COMPLEX_EQ_MUL_RCANCEL]);;\r
+\r
+\r
+(** WEAKER RESULTS\r
+ * - with only two exponentials (WAVE_SUM_EQ_SINGLE)\r
+ * - with B possibly equal to zero (WAVE_SUM_EQ_WEAK1)\r
+ * - with C possibly equal to zero (WAVE_SUM_EQ_WEAK2)\r
+ *)\r
+let WAVE_SUM_EQ_SINGLE = prove \r
+ (`!a b A B.\r
+ ~(A = Cx(&0)) /\ (!x. A * cexp (a * Cx x) = B * cexp (b * Cx x))\r
+ ==> a = b /\ A = B`,\r
+ REPEAT GEN_TAC THEN STRIP_TAC THEN SUBGOAL_THEN `~(B = Cx(&0))` ASSUME_TAC\r
+ THENL ON_FIRST_GOAL (POP_ASSUM (fun x -> ASM_REWRITE_TAC[REWRITE_RULE\r
+ [COMPLEX_MUL_RZERO;CEXP_0;COMPLEX_MUL_RID] (SPEC `&0` (GSYM x))]))\r
+ THEN SUBGOAL_THEN\r
+ `!x. A * cexp (a * Cx x) + A * cexp (a * Cx x) \r
+ = (Cx(&2)*B) * cexp (b * Cx x)` \r
+ ASSUME_TAC\r
+ THENL ON_FIRST_GOAL (GEN_TAC THEN POP_ASSUM (K ALL_TAC)\r
+ THEN POP_ASSUM (MP_TAC o SPEC_ALL) THEN SIMPLE_COMPLEX_ARITH_TAC)\r
+ THEN SUBGOAL_THEN `~(Cx(&2)*B=Cx(&0))` ASSUME_TAC \r
+ THENL ON_FIRST_GOAL\r
+ (POP_ASSUM (K ALL_TAC) THEN POP_ASSUM MP_TAC THEN SIMPLE_COMPLEX_ARITH_TAC)\r
+ THEN ASM_MESON_TAC\r
+ [WAVE_SUM_EQ_CORE;SIMPLE_COMPLEX_ARITH `A + A = Cx(&2) * B <=> A = B`]);;\r
+\r
+let WAVE_SUM_EQ_WEAK1 = prove \r
+ (`!a b c A B C.\r
+ ~(A = Cx(&0)) /\ ~(C = Cx(&0))\r
+ /\ (!x. A * cexp (a * Cx x) + B * cexp (b * Cx x) = C * cexp (c * Cx x)) \r
+ ==> a = c /\ A + B = C`,\r
+ REPEAT GEN_TAC THEN ASM_CASES_TAC `B = Cx(&0)` THENL [\r
+ ASM_REWRITE_TAC[COMPLEX_MUL_LZERO;COMPLEX_ADD_RID]\r
+ THEN MESON_TAC[WAVE_SUM_EQ_SINGLE];\r
+ REPEAT STRIP_TAC\r
+ THENL ON_FIRST_GOAL (MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `b:complex`)\r
+ THEN ASM_MESON_TAC[WAVE_SUM_EQ_CORE];\r
+ ]);;\r
+\r
+let WAVE_SUM_EQ_WEAK2 = prove \r
+ (`!a b c A B C.\r
+ ~(A = Cx(&0)) /\ ~(B = Cx(&0)) \r
+ /\ (!x. A * cexp (a * Cx x) + B * cexp (b * Cx x) = C * cexp (c * Cx x)) \r
+ ==> a = b /\ A + B = C`,\r
+ REPEAT GEN_TAC THEN ASM_CASES_TAC `C = Cx(&0)` THENL [\r
+ ASM_REWRITE_TAC[COMPLEX_MUL_LZERO;COMPLEX_LNEG_UNIQ;COMPLEX_NEG_LMUL]\r
+ THEN MESON_TAC[WAVE_SUM_EQ_SINGLE;COMPLEX_NEG_EQ_0];\r
+ ASM_MESON_TAC[WAVE_SUM_EQ_CORE];\r
+ ]);;\r
+\r
+\r
+(** VECTORIAL VERSIONS OF THE ABOVE THEOREMS **)\r
+let VEC_WAVE_SUM_EQ_CORE = prove\r
+ (`!a b c A B C:complex^N.\r
+ ~(A = cvector_zero) /\ ~(B = cvector_zero) /\ ~(C = cvector_zero)\r
+ /\ (!x. cexp (a * Cx x) % A + cexp (b * Cx x) % B = cexp (c * Cx x) % C)\r
+ ==> a = b /\ b = c /\ A + B = C`,\r
+ REWRITE_TAC[CVECTOR_NON_ZERO;IMP_CONJ;\r
+ MESON[] `(a ==> b/\c/\d) <=> (a==>b/\c) /\ (b/\c==>a==>d)`]\r
+ THEN REPEAT GEN_TAC \r
+ THEN MAP_EVERY (DISCH_THEN o X_CHOOSE_TAC) [`i:num`;`j:num`;`k:num`]\r
+ THEN CONJ_TAC\r
+ THENL ON_FIRST_GOAL (MAP_EVERY ASM_CASES_TAC [`i=(j:num)`;`j=(k:num)`])\r
+ THENL\r
+ let cexp_SYM = SIMPLE_COMPLEX_ARITH `cexp x * y = y * cexp x` in\r
+ let PROJECT_ON t =\r
+ MAP_ANTECEDENT (SPEC t o ONCE_REWRITE_RULE[SWAP_FORALL_THM] o\r
+ ONCE_REWRITE_RULE[CART_EQ])\r
+ THEN ASM_REWRITE_TAC[CVECTOR_MUL_COMPONENT;CVECTOR_ADD_COMPONENT;cexp_SYM]\r
+ in\r
+ let CONJ1_FIRST = MESON[] `(a ==> b/\c) <=> ((a==>b)/\(b==>a==>c))` in\r
+ [\r
+ PROJECT_ON `i:num` THEN ASM_MESON_TAC[WAVE_SUM_EQ_CORE];\r
+ REWRITE_TAC[CONJ1_FIRST] THEN CONJ_TAC\r
+ THENL [\r
+ PROJECT_ON `i:num` THEN ASM_MESON_TAC[WAVE_SUM_EQ_WEAK2];\r
+ DISCH_THEN (fun x -> REWRITE_TAC[x;GSYM CVECTOR_ADD_LDISTRIB])\r
+ THEN PROJECT_ON `k:num` THEN ASM_MESON_TAC[WAVE_SUM_EQ_SINGLE];\r
+ ];\r
+ REWRITE_TAC[MESON[] `(a ==> b/\c) <=> ((a==>c)/\(c==>a==>b))`]\r
+ THEN CONJ_TAC\r
+ THENL [\r
+ PROJECT_ON `j:num` THEN ONCE_REWRITE_TAC[COMPLEX_ADD_SYM]\r
+ THEN ASM_MESON_TAC[WAVE_SUM_EQ_WEAK1];\r
+ DISCH_THEN (fun x -> \r
+ REWRITE_TAC[x;CVECTOR_ARITH `!x:complex^N. x +y=z <=> x=z-y`;\r
+ GSYM CVECTOR_SUB_LDISTRIB])\r
+ THEN PROJECT_ON `i:num` THEN ASM_MESON_TAC[WAVE_SUM_EQ_SINGLE];\r
+ ];\r
+ ASM_CASES_TAC `(C:complex^N)$i = Cx(&0)`\r
+ THENL [\r
+ REWRITE_TAC[CONJ1_FIRST] THEN CONJ_TAC\r
+ THENL [\r
+ PROJECT_ON `i:num`\r
+ THEN REWRITE_TAC[COMPLEX_MUL_LZERO;COMPLEX_LNEG_UNIQ;\r
+ COMPLEX_NEG_LMUL]\r
+ THEN ASM_MESON_TAC[WAVE_SUM_EQ_SINGLE];\r
+ DISCH_THEN (fun x -> REWRITE_TAC[x;GSYM CVECTOR_ADD_LDISTRIB])\r
+ THEN PROJECT_ON `k:num` THEN ASM_MESON_TAC[WAVE_SUM_EQ_SINGLE];\r
+ ];\r
+ ONCE_REWRITE_TAC[MESON[] `a=b/\b=c <=> a=c /\ (a=b/\b=c)`]\r
+ THEN REWRITE_TAC\r
+ [MESON[] `(a==>b/\c/\d) <=> (a==>b) /\ (b==>a==>c/\d)`]\r
+ THEN CONJ_TAC\r
+ THENL [\r
+ PROJECT_ON `i:num` THEN ASM_MESON_TAC[WAVE_SUM_EQ_WEAK1];\r
+ DISCH_THEN (fun x ->\r
+ REWRITE_TAC[x;CVECTOR_ARITH `!x:complex^N. x +y=z <=> y=z-x`;\r
+ GSYM CVECTOR_SUB_LDISTRIB])\r
+ THEN PROJECT_ON `j:num` THEN ASM_MESON_TAC[WAVE_SUM_EQ_SINGLE]\r
+ ];\r
+ ];\r
+ REPLICATE_TAC 2 (DISCH_THEN (SINGLE REWRITE_TAC))\r
+ THEN REWRITE_TAC\r
+ [CVECTOR_ARITH `x % X + x % Y = x % Z <=> x % (X+Y-Z) = cvector_zero`;\r
+ CVECTOR_MUL_EQ_0;CEXP_NZ]\r
+ THEN CVECTOR_ARITH_TAC\r
+ ]);;\r
+\r
+let VEC_WAVE_SUM_EQ_SINGLE = prove \r
+ (`!a b A B:complex^N.\r
+ ~(A = cvector_zero) /\ (!x. cexp (a * Cx x) % A = cexp (b * Cx x) % B) \r
+ ==> a = b /\ A = B`,\r
+ REPEAT GEN_TAC THEN STRIP_TAC\r
+ THEN SUBGOAL_THEN `~(B:complex^N = cvector_zero)` ASSUME_TAC\r
+ THENL ON_FIRST_GOAL (POP_ASSUM (fun x -> ASM_REWRITE_TAC[\r
+ REWRITE_RULE[COMPLEX_MUL_RZERO;CEXP_0;CVECTOR_MUL_ID]\r
+ (SPEC `&0` (GSYM x))]))\r
+ THEN SUBGOAL_THEN\r
+ `!x. cexp (a * Cx x) % (A:complex^N) + cexp (a * Cx x) % A\r
+ = cexp (b * Cx x) % (Cx(&2) % B)` \r
+ ASSUME_TAC\r
+ THENL ON_FIRST_GOAL (GEN_TAC THEN POP_ASSUM (K ALL_TAC)\r
+ THEN POP_ASSUM (MP_TAC o SPEC_ALL) THEN CVECTOR_ARITH_TAC)\r
+ THEN SUBGOAL_THEN `~(Cx(&2) % (B:complex^N) = cvector_zero)` ASSUME_TAC\r
+ THENL ON_FIRST_GOAL (POP_ASSUM (K ALL_TAC) THEN POP_ASSUM MP_TAC\r
+ THEN REWRITE_TAC[CVECTOR_MUL_EQ_0;SIMPLE_COMPLEX_ARITH `~(Cx(&2) = Cx(&0))`])\r
+ THEN ASM_MESON_TAC\r
+ [VEC_WAVE_SUM_EQ_CORE;CVECTOR_ARITH `A + A = Cx(&2) % B <=> A = B`]);;\r
+\r
+let VEC_WAVE_SUM_EQ_WEAK1 = prove \r
+ (`!a b c A B C:complex^N.\r
+ ~(A = cvector_zero) /\ ~(C = cvector_zero)\r
+ /\ (!x. cexp (a * Cx x) % A + cexp (b * Cx x) % B = cexp (c * Cx x) % C) \r
+ ==> a = c /\ A + B = C`,\r
+ REPEAT GEN_TAC THEN ASM_CASES_TAC `(B:complex^N) = cvector_zero` THENL [\r
+ ASM_REWRITE_TAC[CVECTOR_MUL_RZERO;CVECTOR_ADD_ID]\r
+ THEN MESON_TAC[VEC_WAVE_SUM_EQ_SINGLE];\r
+ REPEAT STRIP_TAC\r
+ THENL ON_FIRST_GOAL (MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `b:complex`)\r
+ THEN ASM_MESON_TAC[VEC_WAVE_SUM_EQ_CORE];\r
+ ]);;\r
+\r
+let VEC_WAVE_SUM_EQ_WEAK2 = prove \r
+ (`!a b c A B C:complex^N.\r
+ ~(A = cvector_zero) /\ ~(B = cvector_zero)\r
+ /\ (!x. cexp (a * Cx x) % A + cexp (b * Cx x) % B = cexp (c * Cx x) % C) \r
+ ==> a = b /\ A + B = C`,\r
+ REPEAT GEN_TAC THEN ASM_CASES_TAC `(C:complex^N) = cvector_zero` \r
+ THENL [\r
+ ASM_REWRITE_TAC[CVECTOR_MUL_RZERO;\r
+ CVECTOR_ARITH `x+y = cvector_zero <=> x= --y`;GSYM CVECTOR_MUL_RNEG]\r
+ THEN MESON_TAC[VEC_WAVE_SUM_EQ_SINGLE];\r
+ ASM_MESON_TAC[VEC_WAVE_SUM_EQ_CORE];\r
+ ]);;\r
--- /dev/null
+List.iter needs ["Multivariate/make_complex.ml";"Multivariate/geom.ml"; "Multivariate/cross.ml";"Multivariate/wlog.ml"];;\r
+needs "top.ml";;\r
--- /dev/null
+(* ========================================================================= *)\r
+(* Formalization of Electromagnetic Optics *)\r
+(* *)\r
+(* (c) Copyright, Sanaz Khan Afshar & Vincent Aravantinos 2011-14 *)\r
+(* Hardware Verification Group, *)\r
+(* Concordia University *)\r
+(* *)\r
+(* Contact: <s_khanaf@encs.concordia.ca> *)\r
+(* <vincent@encs.concordia.ca> *)\r
+(* *)\r
+(* This file deals with the non-trivial theorems called "primitive rules". *)\r
+(* ========================================================================= *)\r
+\r
+\r
+let WAVE_ORTHOGONALITY = prove\r
+ (`!emf. is_plane_wave emf ==> corthogonal (h_of_wave emf) (e_of_wave emf)`,\r
+ REWRITE_TAC[IS_PLANE_WAVE;is_valid_emf;plane_wave;emf_at_point_mul;e_of_emf;\r
+ h_of_emf;LET_DEF;LET_END_DEF]\r
+ THEN REPEAT STRIP_TAC THEN REPLICATE_TAC 2 (POP_ASSUM (K ALL_TAC))\r
+ THEN POP_ASSUM (fun x -> RULE_ASSUM_TAC (ONCE_REWRITE_RULE[x]))\r
+ THEN RULE_ASSUM_TAC (REWRITE_RULE[BETA_THM;LET_DEF;LET_END_DEF])\r
+ THEN REPEAT (POP_ASSUM MP_TAC)\r
+ THEN SIMP_TAC[corthogonal;CDOT3;CVECTOR_MUL_COMPONENT;CNJ_MUL;\r
+ SIMPLE_COMPLEX_ARITH `(x*y)*cnj z*t=(x*cnj z)*(y*t):complex`;\r
+ GSYM COMPLEX_ADD_LDISTRIB;COMPLEX_ENTIRE;CEXP_NZ;CNJ_EQ_0]);;\r
+\r
+let NON_NULL_LEMMA = prove\r
+ (`!emf v. ~(v = vec 0) /\ non_null_wave emf ==>\r
+ let v_ccross = (ccross) (vector_to_cvector v) in\r
+ ~(v_ccross (e_of_wave emf) = cvector_zero)\r
+ \/ ~(v_ccross (h_of_wave emf) = cvector_zero)`,\r
+ REPEAT GEN_TAC THEN CONV_TAC (DEPTH_CONV let_CONV)\r
+ THEN ASM_CASES_TAC `vector_to_cvector v ccross e_of_wave emf = cvector_zero`\r
+ THEN ASM_REWRITE_TAC[non_null_wave]\r
+ THEN RULE_ASSUM_TAC (REWRITE_RULE[CCROSS_COLLINEAR_CVECTORS])\r
+ THEN ASSUME_CONSEQUENCES (REWRITE_RULE[IMP_CONJ]\r
+ CORTHOGONAL_COLLINEAR_CVECTORS)\r
+ THEN REPEAT STRIP_TAC\r
+ THEN SUBGOAL_THEN `~(vector_to_cvector (v:real^3) = cvector_zero)` ASSUME_TAC\r
+ THENL ON_FIRST_GOAL \r
+ (REWRITE_TAC[CART_EQ3;CVECTOR_ZERO_COMPONENT;VECTOR_TO_CVECTOR_COMPONENT;\r
+ CX_INJ]\r
+ THEN RULE_ASSUM_TAC (REWRITE_RULE[CART_EQ;VEC_COMPONENT;DIMINDEX_3;FORALL_3])\r
+ THEN ASM_REWRITE_TAC[])\r
+ THEN SUBGOAL_THEN\r
+ `?a . ~(a=Cx(&0)) /\ vector_to_cvector v = a % e_of_wave emf` STRIP_ASSUME_TAC\r
+ THENL ON_FIRST_GOAL (ASM_MESON_TAC[NON_NULL_COLLINEARS;COLLINEAR_CVECTORS_SYM])\r
+ THEN ASSUME_CONSEQUENCES WAVE_ORTHOGONALITY\r
+ THEN POP_ASSUM MP_TAC\r
+ THEN POP_ASSUM (fun x ->\r
+ RULE_ASSUM_TAC (REWRITE_RULE[x;CCROSS_LMUL;CVECTOR_MUL_EQ_0]))\r
+ THEN POP_ASSUM (fun x ->\r
+ RULE_ASSUM_TAC (REWRITE_RULE[x;CCROSS_COLLINEAR_CVECTORS]))\r
+ THEN ASM_MESON_TAC[CORTHOGONAL_COLLINEAR_CVECTORS;CORTHOGONAL_SYM]);;\r
+\r
+let NON_NULL_LEMMA_PASTECART = prove\r
+ (`!emf v. ~(v = vec 0) /\ non_null_wave emf ==>\r
+ let v_ccross = (ccross) (vector_to_cvector v) in\r
+ ~(pastecart (v_ccross (e_of_wave emf)) (v_ccross (h_of_wave emf)) =\r
+ cvector_zero)`,\r
+ REWRITE_TAC[PASTECART_EQ_CVECTOR_ZERO;DE_MORGAN_THM;NON_NULL_LEMMA]);;\r
+\r
+let BOUNDARY_CONDITIONS_FOR_PLANE_WAVES = prove\r
+ (`!i emf_i emf_r emf_t.\r
+ is_plane_wave_at_interface i emf_i emf_r emf_t ==>\r
+ let p = plane_of_interface i in\r
+ !n. is_normal_to_plane n p ==>\r
+ let n_ccross = (ccross) (vector_to_cvector n) in\r
+ !pt. pt IN p ==> !t.\r
+ let plane_component = \f_of_wave emf. cexp (--ii * Cx((k_of_wave emf) dot\r
+ pt - w_of_wave emf*t)) % n_ccross (f_of_wave emf) in\r
+ plane_component e_of_wave emf_i + plane_component e_of_wave emf_r\r
+ = plane_component e_of_wave emf_t\r
+ /\ plane_component h_of_wave emf_i + plane_component h_of_wave emf_r\r
+ = plane_component h_of_wave emf_t`,\r
+ REWRITE_TAC[FORALL_INTERFACE_THM;plane_of_interface;LET_DEF;LET_END_DEF;\r
+ is_plane_wave_at_interface;non_null_wave;IS_PLANE_WAVE;plane_wave;\r
+ emf_at_point_mul;e_of_emf;h_of_emf;LET_DEF;LET_END_DEF;map_triple;o_DEF]\r
+ THEN REPEAT STRIP_TAC\r
+ THEN POP_ASSUM (fun x -> FIRST_X_ASSUM (fun y -> MP_TAC (MATCH_MP y x)))\r
+ THEN ASM (GEN_REWRITE_TAC (RATOR_CONV o DEPTH_CONV)) []\r
+ THEN REWRITE_TAC[boundary_conditions;emf_add;e_of_emf;h_of_emf;LET_DEF;\r
+ LET_END_DEF;CCROSS_RADD;CCROSS_RMUL]\r
+ THEN DISCH_THEN (C ASM_CSQ_THEN STRIP_ASSUME_TAC) THEN ASM_REWRITE_TAC[]);;\r
+\r
+(* We combine the E and H field as one complex^6 vector. \r
+ * Convenient for some proofs. *)\r
+let PASTECART_BOUNDARY_CONDITIONS_FOR_PLANE_WAVES = prove\r
+ (`!i emf_i emf_r emf_t. is_plane_wave_at_interface i emf_i emf_r emf_t ==>\r
+ let p = plane_of_interface i in\r
+ !n. is_normal_to_plane n p ==>\r
+ let n_ccross = (ccross) (vector_to_cvector n) in\r
+ !pt. pt IN p ==> !t.\r
+ let plane_component = \emf.\r
+ cexp (--ii * Cx((k_of_wave emf) dot pt - w_of_wave emf*t)) % pastecart\r
+ (n_ccross (e_of_wave emf)) (n_ccross (h_of_wave emf)) in\r
+ plane_component emf_i + plane_component emf_r = plane_component emf_t`,\r
+ REWRITE_TAC[LET_DEF;LET_END_DEF] THEN REPEAT STRIP_TAC\r
+ THEN ASM_CSQ_THEN (REWRITE_RULE[LET_DEF;LET_END_DEF]\r
+ BOUNDARY_CONDITIONS_FOR_PLANE_WAVES) (C ASM_CSQ_THEN (C ASM_CSQ_THEN\r
+ (MP_TAC o SPEC_ALL)))\r
+ THEN PASTECART_TAC[GSYM PASTECART_CVECTOR_MUL;PASTECART_CVECTOR_ADD]);;\r
+\r
+let EXISTS_NORMAL_OF_PLANE_INTERFACE = prove\r
+ (`!i emf_i emf_r emf_t. is_plane_wave_at_interface i emf_i emf_r emf_t ==>\r
+ ?n. is_normal_to_plane n (plane_of_interface i)`,\r
+ REWRITE_TAC[FORALL_INTERFACE_THM;LET_DEF;LET_END_DEF;\r
+ is_plane_wave_at_interface;is_valid_interface;plane_of_interface]\r
+ THEN MESON_TAC[EXISTS_NORMAL_OF_PLANE]);;\r
+\r
+let FREQUENCY_CONSERVATION = prove\r
+ (`!i emf_i emf_r emf_t. is_plane_wave_at_interface i emf_i emf_r emf_t ==>\r
+ (non_null_wave emf_r ==> w_of_wave emf_r = w_of_wave emf_i)\r
+ /\ (non_null_wave emf_t ==> w_of_wave emf_t = w_of_wave emf_i)`,\r
+ REWRITE_TAC[FORALL_INTERFACE_THM] THEN REPEAT STRIP_TAC\r
+ THEN ASM_CSQ_THEN EXISTS_NORMAL_OF_PLANE_INTERFACE STRIP_ASSUME_TAC\r
+ THEN SUBGOAL_THEN `~(n' = vec 0:real^3) /\ plane (p:plane)`\r
+ STRIP_ASSUME_TAC THEN\r
+ TRY (RULE_ASSUM_TAC (REWRITE_RULE[is_plane_wave_at_interface;LET_DEF;\r
+ LET_END_DEF;is_valid_interface;is_normal_to_plane])\r
+ THEN ASM_REWRITE_TAC[] THEN NO_TAC)\r
+ THEN ASM_CSQ_THEN PLANE_NON_EMPTY (STRIP_ASSUME_TAC o REWRITE_RULE[GSYM\r
+ MEMBER_NOT_EMPTY])\r
+ THEN ASM_CSQ_THEN (REWRITE_RULE[LET_DEF;LET_END_DEF]\r
+ PASTECART_BOUNDARY_CONDITIONS_FOR_PLANE_WAVES) (C ASM_CSQ_THEN ASSUME_TAC)\r
+ THEN RULE_ASSUM_TAC (REWRITE_RULE[plane_of_interface;LET_DEF;LET_END_DEF])\r
+ THEN POP_ASSUM (C ASM_CSQ_THEN MP_TAC)\r
+ THEN REWRITE_TAC[CX_SUB;CX_MUL;SIMPLE_COMPLEX_ARITH\r
+ `--ii*(x-y*z) = (ii*y)*z+ --ii*x`;CEXP_ADD;GSYM CVECTOR_MUL_ASSOC]\r
+ THEN ONCE_REWRITE_TAC[MESON[COMPLEX_EQ_MUL_LCANCEL;II_NZ;CX_INJ]\r
+ `x=y <=> ii * Cx x = ii * Cx y`]\r
+ THENL\r
+ (let APPLY_FREQ_EQ_TAC x =\r
+ DISCH_THEN (MP_TAC o MATCH_MP (REWRITE_RULE[MESON[]\r
+ `(A /\ B /\ C ==> D) <=> (C ==> A ==> B ==> D)`] x)) in\r
+ map APPLY_FREQ_EQ_TAC [ VEC_WAVE_SUM_EQ_WEAK2; VEC_WAVE_SUM_EQ_WEAK1])\r
+ THEN ANTS_TAC\r
+ THEN\r
+ let APPLY_NON_NULL_LEMMA = REWRITE_TAC[CVECTOR_MUL_EQ_0;CEXP_NZ]\r
+ THEN MATCH_MP_TAC (CONV_RULE (DEPTH_CONV let_CONV) NON_NULL_LEMMA_PASTECART) in\r
+ REPEAT (ANTS_TAC ORELSE APPLY_NON_NULL_LEMMA)\r
+ THEN ASM_MESON_TAC[is_plane_wave_at_interface]);;\r
+\r
+let IS_PLANE_WAVE_AT_INTERFACE_THMS =\r
+ [is_plane_wave_at_interface;LET_DEF;LET_END_DEF;map_triple;o_DEF;\r
+ is_valid_interface];;\r
+\r
+let K_PLANE_PROJECTION_CONSERVATION = prove\r
+ (`!i emf_i emf_r emf_t. is_plane_wave_at_interface i emf_i emf_r emf_t ==>\r
+ let n = unit (normal_of_interface i) in\r
+ (non_null_wave emf_r ==>\r
+ projection_on_hyperplane (k_of_wave emf_r) n =\r
+ projection_on_hyperplane (k_of_wave emf_i) n)\r
+ /\ (non_null_wave emf_t ==>\r
+ projection_on_hyperplane (k_of_wave emf_t) n =\r
+ projection_on_hyperplane (k_of_wave emf_i) n)`,\r
+ REWRITE_TAC[FORALL_INTERFACE_THM] THEN REPEAT GEN_TAC\r
+ THEN DISCH_THEN (DISTRIB [MP_TAC; LABEL_TAC "*" o MATCH_MP\r
+ PASTECART_BOUNDARY_CONDITIONS_FOR_PLANE_WAVES])\r
+ THEN REWRITE_TAC([normal_of_interface] @ IS_PLANE_WAVE_AT_INTERFACE_THMS)\r
+ THEN REPEAT STRIP_TAC\r
+ THEN REMOVE_THEN "*" (C ASM_CSQ_THEN ASSUME_TAC o\r
+ REWRITE_RULE[LET_DEF;LET_END_DEF;plane_of_interface])\r
+ THEN ASM_CSQ_THEN FORALL_PLANE_THM_2 STRIP_ASSUME_TAC\r
+ THEN POP_ASSUM (RULE_ASSUM_TAC o SINGLE REWRITE_RULE)\r
+ THEN FIRST_ASSUM (STRIP_ASSUME_TAC o CONV_RULE\r
+ (REWR_CONV is_normal_to_plane))\r
+ THEN ASM_SIMP_TAC[UNIT_THM;PROJECTION_ON_HYPERPLANE_THM]\r
+ THEN ASM_CSQ_THEN PLANE_DECOMP_DOT (C ASM_CSQ_THEN (C\r
+ ASM_CSQ_THEN ASSUME_TAC))\r
+ THEN MAP_EVERY (fun x -> REWRITE_TAC[VECTOR_ARITH x]\r
+ THEN ASSUM_LIST (GEN_REWRITE_TAC (RATOR_CONV o ONCE_DEPTH_CONV)))\r
+ [`a-b=c-d <=> a=c+b-d:real^N`;`a=c+b-d <=> c=a-b+d:real^N`]\r
+ THEN REWRITE_TAC[VECTOR_ARITH `a+b+c=(d+e+f)-f+c <=> a+b=d+e:real^N`]\r
+ THEN ASM_CSQ_THEN BASIS_NON_NULL (fun x -> FIRST_ASSUM\r
+ (STRIP_ASSUME_TAC o REWRITE_RULE[IN_INSERT;IN_SING;\r
+ MESON[] `(!x. x=a \/ x=b ==> p x) <=> p a /\ p b`;UNIT_EQ_ZERO]\r
+ o MATCH_MP x o CONJUNCT1 o CONV_RULE\r
+ (REWR_CONV is_orthogonal_plane_basis)))\r
+ THEN ASM_SIMP_TAC[UNIT_UNIT] THEN MK_COMB_TAC\r
+ THENL [AP_TERM_TAC;ALL_TAC;AP_TERM_TAC;ALL_TAC]\r
+ THEN AP_THM_TAC THEN AP_TERM_TAC \r
+ THEN ONCE_REWRITE_TAC[MESON[COMPLEX_EQ_MUL_LCANCEL;II_NZ;CX_INJ;\r
+ COMPLEX_NEG_EQ_0] `x=y <=> --ii * Cx x = --ii * Cx y`]\r
+ THEN RULE_ASSUM_TAC (REWRITE_RULE[\r
+ VECTOR_ARITH `x dot (y+a%z+b%t) = x dot y+(x dot z)*a+(x dot t)*b`;\r
+ SIMPLE_COMPLEX_ARITH `--ii * Cx ((a+b*b'+c*c')-d) = (--ii * Cx b)\r
+ * Cx b' + (--ii * Cx c) * Cx c' + --ii * Cx a + ii * Cx d`;\r
+ CEXP_ADD])\r
+ THENL (map (fun f -> FIRST_X_ASSUM (ASSUME_TAC o f)) [\r
+ funpow 2 (SPEC `&0` o ONCE_REWRITE_RULE[SWAP_FORALL_THM]);\r
+ SPEC `&0` o ONCE_REWRITE_RULE[SWAP_FORALL_THM] o SPEC `&0`;\r
+ funpow 2 (SPEC `&0` o ONCE_REWRITE_RULE[SWAP_FORALL_THM]);\r
+ SPEC `&0` o ONCE_REWRITE_RULE[SWAP_FORALL_THM] o SPEC `&0`;\r
+ ])\r
+ THEN RULE_ASSUM_TAC (REWRITE_RULE[COMPLEX_MUL_RZERO;CEXP_0;COMPLEX_MUL_RID;\r
+ REAL_MUL_RZERO;GSYM CVECTOR_MUL_ASSOC;CVECTOR_MUL_ID])\r
+ THENL\r
+ (let lemma = MESON[] `(!x y z t u v. p x y z t v u ==> q x y z /\ r t v u)\r
+ ==> (!x y z t u v. p x y z t v u ==> q x y z)` in\r
+ let APPLY_FREQ_EQ_TAC x =\r
+ POP_ASSUM (DISTRIB [ASSUME_TAC;MP_TAC o MATCH_MP (REWRITE_RULE[MESON[]\r
+ `(A /\ B /\ C ==> D) <=> (C ==> A ==> B ==> D)`](MATCH_MP lemma x))])\r
+ in\r
+ map APPLY_FREQ_EQ_TAC [VEC_WAVE_SUM_EQ_WEAK2;VEC_WAVE_SUM_EQ_WEAK2;\r
+ VEC_WAVE_SUM_EQ_WEAK1;VEC_WAVE_SUM_EQ_WEAK1])\r
+ THEN ANTS_TAC\r
+ THEN\r
+ let APPLY_NON_NULL_LEMMA =\r
+ REWRITE_TAC[CVECTOR_MUL_EQ_0;CEXP_NZ]\r
+ THEN MATCH_MP_TAC (CONV_RULE (DEPTH_CONV let_CONV)\r
+ NON_NULL_LEMMA_PASTECART)\r
+ in\r
+ REPEAT (ANTS_TAC ORELSE APPLY_NON_NULL_LEMMA)\r
+ THEN ASM_REWRITE_TAC[]);;\r
+\r
+let LAW_OF_REFLECTION = prove\r
+ (`!i emf_i emf_r emf_t. is_plane_wave_at_interface i emf_i emf_r emf_t ==>\r
+ let n = unit (normal_of_interface i) in\r
+ non_null_wave emf_r ==>\r
+ symetric_vectors_wrt (--(k_of_wave emf_r)) (k_of_wave emf_i) n`,\r
+ REWRITE_TAC[FORALL_INTERFACE_THM;LET_DEFs] THEN REPEAT STRIP_TAC\r
+ THEN ASM_CSQ_THEN (REWRITE_RULE[LET_DEFs] K_PLANE_PROJECTION_CONSERVATION)\r
+ (C ASM_CSQ_THEN MP_TAC o CONJUNCT1)\r
+ THEN ASM_CSQ_THEN (MESON[is_plane_wave_at_interface]\r
+ `is_plane_wave_at_interface i emf_i emf_r emf_t ==> is_valid_interface i`)\r
+ (DISTRIB [ASSUME_TAC; STRIP_ASSUME_TAC o\r
+ REWRITE_RULE[LET_DEFs;is_valid_interface]])\r
+ THEN ASM_SIMP_TAC[normal_of_interface;LET_DEFs;\r
+ PROJECTION_ON_HYPERPLANE_THM;symetric_vectors_wrt;\r
+ NORMAL_OF_INTERFACE_NON_NULL;UNIT_THM;UNIT_EQ_ZERO]\r
+ THEN DISCH_TAC\r
+ THEN SUBGOAL_THEN `!x:real^3. orthogonal (x - (x dot unit n) % unit n) ((x\r
+ dot unit n) % unit n)` ASSUME_TAC\r
+ THENL ON_FIRST_GOAL (ASM_MESON_TAC [ORTHOGONAL_RUNIT;ORTHOGONAL_CLAUSES;\r
+ SUB_UNIT_NORMAL_IS_ORTHOGONAL_TO_NORMAL])\r
+ THEN FIRST_ASSUM (REPEAT_TCL STRIP_THM_THEN (fun x ->\r
+ if contains_sub_term_name "k_of_wave" (concl x) then ASSUME_TAC x\r
+ else ALL_TAC)\r
+ o REWRITE_RULE[LET_DEFs;map_triple;o_DEF] o CONV_RULE (REWR_CONV\r
+ is_plane_wave_at_interface))\r
+ THEN REPLICATE_TAC 3 (POP_ASSUM (K ALL_TAC))\r
+ THEN POP_ASSUM (fun _ -> POP_ASSUM (fun x -> POP_ASSUM (fun y -> MP_TAC\r
+ (REWRITE_RULE[NORM_EQ] (TRANS x (GSYM y))))))\r
+ THEN FIRST_ASSUM (ASSUME_TAC o SPEC `k_of_wave emf`)\r
+ THEN ASM_CSQ_THEN ORTHOGONAL_SQR_NORM (SINGLE REWRITE_TAC)\r
+ THEN ASM_REWRITE_TAC[REAL_EQ_ADD_LCANCEL;DOT_LMUL;DOT_RMUL;DOT_SQUARE_NORM]\r
+ THEN SUBGOAL_TAC "" `~(n = vec 0 :real^3)` \r
+ [ASM_MESON_TAC[is_normal_to_plane]]\r
+ THEN ASM_SIMP_TAC[UNIT_THM;REAL_POW_2;REAL_MUL_RID]\r
+ THEN REWRITE_TAC[GSYM REAL_POW_2;GSYM REAL_EQ_SQUARE_ABS;real_abs]\r
+ THEN REPEAT COND_CASES_TAC THEN RULE_ASSUM_TAC (REWRITE_RULE \r
+ [real_ge;REWRITE_RULE[real_lt;MESON[] `(~p <=> ~q) <=> (p <=> q)`]\r
+ DOT_RUNIT_LT0])\r
+ THENL [\r
+ FIRST_X_ASSUM (fun x -> FIRST_X_ASSUM (ASSUME_TAC \r
+ o ONCE_REWRITE_RULE[GSYM DOT_RUNIT_EQ0] o GSYM\r
+ o CONV_RULE (REWR_CONV REAL_LE_ANTISYM) o CONJ x))\r
+ THEN ASM_REWRITE_TAC[DOT_LNEG;REAL_NEG_0;REAL_MUL_RZERO;VECTOR_MUL_LZERO;\r
+ VECTOR_ARITH `--x+y=vec 0 <=> x=y`]\r
+ THEN DISCH_THEN (RULE_ASSUM_TAC o SINGLE REWRITE_RULE o GSYM)\r
+ THEN POP_ASSUM (RULE_ASSUM_TAC o SINGLE REWRITE_RULE)\r
+ THEN RULE_ASSUM_TAC (REWRITE_RULE[VECTOR_MUL_LZERO;VECTOR_SUB_RZERO])\r
+ THEN ASM_REWRITE_TAC[];\r
+ ASM_MESON_TAC[REAL_ARITH `x > &0 ==> &0 <= x`];\r
+ DISCH_THEN (ASSUME_TAC o GSYM)\r
+ THEN FIRST_X_ASSUM (fun x -> ignore (term_match [] `x-y=z-t` (concl x));\r
+ MP_TAC x)\r
+ THEN POP_ASSUM (fun x -> REWRITE_TAC(x::[VECTOR_MUL_LNEG;DOT_LNEG;\r
+ REAL_MUL_RNEG;VECTOR_ARITH `x-y=z- --y <=> --x+z = --(&2%y)`;\r
+ VECTOR_MUL_ASSOC]));\r
+ ASM_MESON_TAC[REAL_ARITH `x > &0 ==> &0 <= x`];\r
+ ]);;\r
+\r
+let PLANE_OF_INCIDENCE_LAW = prove\r
+ (`!i emf_i emf_r emf_t.\r
+ is_plane_wave_at_interface i emf_i emf_r emf_t /\ non_null_wave emf_r\r
+ /\ non_null_wave emf_t ==>\r
+ coplanar {vec 0, k_of_wave emf_i, k_of_wave emf_r, k_of_wave emf_t,\r
+ normal_of_interface i}`,\r
+ REWRITE_TAC[FORALL_INTERFACE_THM;LET_DEFs;normal_of_interface]\r
+ THEN REPEAT STRIP_TAC\r
+ THEN REWRITE_TAC[coplanar] THEN REPEAT STRIP_TAC\r
+ THEN MAP_EVERY EXISTS_TAC [`vec 0:real^3`;`k_of_wave emf_i`;`unit n:real^3`]\r
+ THEN ASM_CSQ_THEN (MESON[is_plane_wave_at_interface]\r
+ `is_plane_wave_at_interface i emf_i emf_r emf_t ==> is_valid_interface i`)\r
+ (DISTRIB [ASSUME_TAC; STRIP_ASSUME_TAC o\r
+ REWRITE_RULE[LET_DEFs;is_valid_interface]])\r
+ THEN ASM_CSQ_THEN (REWRITE_RULE[LET_DEFs] K_PLANE_PROJECTION_CONSERVATION)\r
+ (DISTRIB (map ((o) (C ASM_CSQ_THEN ASSUME_TAC)) [CONJUNCT1;CONJUNCT2]))\r
+ THEN REWRITE_TAC[INSERT_SUBSET;SING_SUBSET] THEN REPEAT CONJ_TAC\r
+ THENL \r
+ let IN_SET_TAC = MATCH_MP_TAC HULL_INC THEN SET_TAC[] in\r
+ let COMBINATION_TAC =\r
+ POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC \r
+ THEN ASM_SIMP_TAC[AFFINE_HULL_3_ZERO;IN_ELIM_THM;UNIV;normal_of_interface;\r
+ LET_DEFs;PROJECTION_ON_HYPERPLANE_THM;symetric_vectors_wrt;\r
+ NORMAL_OF_INTERFACE_NON_NULL;UNIT_THM;UNIT_EQ_ZERO;\r
+ VECTOR_ARITH `x-a%y=z-b%y <=> x= &1%z+(a-b)%y`]\r
+ THEN MESON_TAC[]\r
+ in\r
+ [ IN_SET_TAC; IN_SET_TAC; COMBINATION_TAC; COMBINATION_TAC;\r
+ REWRITE_TAC[AFFINE_HULL_3_ZERO;IN_ELIM_THM;UNIV]\r
+ THEN MAP_EVERY EXISTS_TAC [`&0`;`norm (n:real^3)`]\r
+ THEN REWRITE_TAC[VECTOR_MUL_LZERO;VECTOR_ADD_LID]\r
+ THEN MATCH_MP_TAC UNIT_INTRO THEN ASM_MESON_TAC[is_normal_to_plane]]);;\r
+\r
+let SNELL_LAW = prove\r
+ (`!i emf_i emf_r emf_t.\r
+ is_plane_wave_at_interface i emf_i emf_r emf_t /\ non_null_wave emf_t ==>\r
+ let theta = \emf. vector_angle (k_of_wave emf) (normal_of_interface i) in\r
+ n1_of_interface i * sin (theta emf_i) =\r
+ n2_of_interface i * sin (theta emf_t)`,\r
+ REWRITE_TAC[FORALL_INTERFACE_THM;LET_DEFs;n1_of_interface;n2_of_interface;\r
+ normal_of_interface]\r
+ THEN REPEAT STRIP_TAC\r
+ THEN FIRST_ASSUM (STRIP_ASSUME_TAC o REWRITE_RULE[LET_DEFs;map_triple;o_DEF;\r
+ is_valid_interface;IS_PLANE_WAVE;non_null_wave]\r
+ o CONV_RULE (REWR_CONV is_plane_wave_at_interface))\r
+ THEN SUBGOAL_TAC ""\r
+ `~(k_of_wave emf_i = vec 0) /\ ~(k_of_wave emf_t = vec 0)` \r
+ [ASM_REWRITE_TAC[]]\r
+ THEN SUBGOAL_TAC "" `~(n = vec 0:real^3)` [ASM_MESON_TAC[is_normal_to_plane]]\r
+ THEN ASSUM_LIST (SIMP_TAC o (@) [REWRITE_RULE[DE_MORGAN_THM;\r
+ MESON[] `(p\/q==>r) <=> (p==>r) /\ (q==>r)`] (CONV_RULE (DEPTH_CONV\r
+ COND_ELIM_CONV) vector_angle)]\r
+ o filter (fun x -> not (contains_sub_term_name "norm" (concl x))))\r
+ THEN SUBGOAL_THEN\r
+ `(k_of_wave emf_i dot unit n) / (k0*n1) =\r
+ (k_of_wave emf_i dot n) / (norm (k_of_wave emf_i) * norm n)\r
+ /\ (k_of_wave emf_t dot unit n) / (k0*n2) =\r
+ (k_of_wave emf_t dot n) / (norm (k_of_wave emf_t) * norm n)`\r
+ ASSUME_TAC\r
+ THENL ON_FIRST_GOAL (ASM_REWRITE_TAC[unit;DOT_RMUL;real_div;\r
+ REAL_ARITH `(x*y)*z=y*(z*x):real`;REAL_INV_MUL])\r
+ THEN SIMP_TAC[REWRITE_RULE[REAL_ABS_BOUNDS] NORM_CAUCHY_SCHWARZ_DIV;SIN_ACS;\r
+ GSYM REAL_EQ_SQUARE_ABS]\r
+ THEN ASM_CSQ_THEN (REWRITE_RULE[LET_DEFs] K_PLANE_PROJECTION_CONSERVATION) \r
+ (C ASM_CSQ_THEN MP_TAC o CONJUNCT2)\r
+ THEN ASM_SIMP_TAC[normal_of_interface;LET_DEFs;PROJECTION_ON_HYPERPLANE_THM;\r
+ NORMAL_OF_INTERFACE_NON_NULL;UNIT_THM;UNIT_EQ_ZERO]\r
+ THEN DISCH_THEN (MP_TAC o MATCH_MP (MESON[] `x=y ==> x dot x = y dot y`))\r
+ THEN SUBGOAL_THEN `!x:real^3. orthogonal (x - (x dot unit n) % unit n) ((x\r
+ dot unit n) % unit n)` ASSUME_TAC\r
+ THENL ON_FIRST_GOAL (ASM_MESON_TAC[ORTHOGONAL_RUNIT;ORTHOGONAL_CLAUSES;\r
+ SUB_UNIT_NORMAL_IS_ORTHOGONAL_TO_NORMAL])\r
+ THEN ASM_SIMP_TAC[REWRITE_RULE[REAL_ARITH `x=y+z <=> y=x-z:real`] \r
+ ORTHOGONAL_SQR_NORM;DOT_SQUARE_NORM;NORM_MUL;UNIT_THM;REAL_MUL_RID;\r
+ REAL_POW2_ABS]\r
+ THEN SUBGOAL_TAC "" `~(k0*n2 = &0) /\ ~(k0*n1 = &0)`\r
+ [ASM_MESON_TAC[NORM_EQ_0]]\r
+ THEN SUBGOAL_THEN `&0 < inv(k0*n1)` ASSUME_TAC\r
+ THENL ON_FIRST_GOAL (ASM_REWRITE_TAC[REAL_LT_INV_EQ;REAL_LT_LE]\r
+ THEN ASM_MESON_TAC[NORM_POS_LE])\r
+ THEN SUBGOAL_THEN `~((k0*n2) pow 2 = &0) /\ ~(inv ((k0 * n2) pow 2) = &0)`\r
+ STRIP_ASSUME_TAC\r
+ THENL ON_FIRST_GOAL (REWRITE_TAC[REAL_POW_EQ_0;REAL_INV_EQ_0]\r
+ THEN ASM_ARITH_TAC)\r
+ THEN POP_ASSUM (fun x -> DISCH_THEN (MP_TAC o\r
+ ONCE_REWRITE_RULE [REWRITE_RULE[x] (GENL [`x:real`;`y:real`] (SPECL\r
+ [`x:real`;`y:real`;`inv ((k0 * n2:real) pow 2)`] (GSYM\r
+ REAL_EQ_MUL_RCANCEL)))]))\r
+ THEN ASM_SIMP_TAC[REAL_SUB_RDISTRIB;REAL_MUL_RINV;GSYM real_div;\r
+ GSYM REAL_POW_DIV;REAL_DIV_REFL;REAL_POW_ONE]\r
+ THEN DISCH_THEN (K ALL_TAC)\r
+ THEN MATCH_MP_TAC (MESON[SQRT_MUL;POW_2_SQRT;REAL_LE_POW_2]\r
+ `!x y. &0 <= x /\ &0 <= y /\ &0 <= z /\ &0 <= t /\ sqrt(x pow 2 * y) =\r
+ sqrt(z pow 2*t) ==> x * sqrt y = z * sqrt t`)\r
+ THEN REPEAT CONJ_TAC THENL [\r
+ ASM_REAL_ARITH_TAC;\r
+ REWRITE_TAC[REAL_SUB_LE;ABS_SQUARE_LE_1]\r
+ THEN ASM_MESON_TAC[NORM_CAUCHY_SCHWARZ_DIV];\r
+ ASM_REAL_ARITH_TAC;\r
+ REWRITE_TAC[REAL_POW_DIV;REAL_ARITH `x/y-z/y=(x-z)/y:real`]\r
+ THEN MATCH_MP_TAC REAL_LE_DIV THEN CONJ_TAC THENL [\r
+ REWRITE_TAC[REAL_SUB_LE] THEN MATCH_MP_TAC REAL_POW_LE2 THEN CONJ_TAC\r
+ THENL [\r
+ REWRITE_TAC[unit;DOT_RMUL] THEN MATCH_MP_TAC REAL_LE_MUL\r
+ THEN REWRITE_TAC[REAL_LE_INV_EQ;NORM_POS_LE] THEN ASM_ARITH_TAC;\r
+ FIRST_ASSUM (SINGLE ONCE_REWRITE_TAC o REWRITE_RULE[GSYM real_div]\r
+ o MATCH_MP (GSYM REAL_LE_RMUL_EQ))\r
+ THEN ASM_SIMP_TAC[REAL_DIV_REFL]\r
+ THEN ASM_MESON_TAC[REWRITE_RULE[REAL_ABS_BOUNDS] \r
+ NORM_CAUCHY_SCHWARZ_DIV]\r
+ ];\r
+ MATCH_ACCEPT_TAC REAL_LE_POW_2;\r
+ ];\r
+ AP_TERM_TAC THEN SUBGOAL_TAC "" `~(k0 = &0) /\ ~(n1 = &0) /\ ~(n2 = &0)`\r
+ [ASM_MESON_TAC[REAL_MUL_LZERO;REAL_MUL_RZERO]]\r
+ THEN ASM_SIMP_TAC[real_div;REAL_INV_MUL;\r
+ REAL_ARITH `(x*y)*inv x*inv z=(x*inv x)*y*inv z:real`;REAL_MUL_RINV;\r
+ REAL_MUL_LID;REAL_SUB_LDISTRIB;REAL_MUL_RID]\r
+ THEN ASM_SIMP_TAC[GSYM REAL_POW_MUL;\r
+ REAL_ARITH `x*y*inv x=(x*inv x)*y:real`;\r
+ REAL_ARITH `x*y*(inv z*inv x)*t=(x*inv x)*y*inv z*t:real`;\r
+ REAL_ARITH `x*y*inv z*inv x=(x*inv x)*y*inv z:real`;\r
+ REAL_MUL_RINV;REAL_MUL_LID;REAL_INV_MUL]\r
+ THEN REWRITE_TAC[REAL_ARITH `x*inv y*inv z=(inv z*x)*inv y:real`;\r
+ GSYM DOT_RMUL;unit]\r
+ ]);;\r
+\r
+let phase_shift_at_plane = new_definition\r
+ `phase_shift_at_plane p n emf =\r
+ k_of_wave emf dot (@a. a % unit n IN p) % unit n`;;\r
+\r
+let PLANE_WAVE_WITH_PHASE_SHIFT_AT_PLANE = prove\r
+ (`!emf. is_plane_wave emf ==> !p. plane p ==> !n. is_normal_to_plane n p ==>\r
+ !r. r IN p ==> !t.\r
+ emf r t = cexp (--ii * Cx(projection_on_hyperplane (k_of_wave emf) (unit n)\r
+ dot r - w_of_wave emf * t + phase_shift_at_plane p n emf))\r
+ % eh_of_wave emf`,\r
+ let tmp = DISCH_ALL (GSYM (UNDISCH (ISPECL [`k_of_wave emf`;`unit n:real^3`]\r
+ PROJECTION_ON_HYPERPLANE_DECOMPOS))) in\r
+ let tmp' = UNDISCH_ALL (IMP_TRANS (SPEC `n:real^3` (UNDISCH (SPEC `p:plane`\r
+ NORMAL_OF_PLANE_NON_NULL))) (IMP_TRANS (ISPEC `n:real^3` UNIT_THM) tmp)) in\r
+ REWRITE_TAC[LET_DEF;LET_END_DEF;IS_PLANE_WAVE;plane_wave]\r
+ THEN REPEAT STRIP_TAC\r
+ THEN FIRST_ASSUM (let thm = MESON[] `f=g ==> g x y=z ==> f x y=z` in\r
+ fun x -> MATCH_MP_TAC (MATCH_MP thm x))\r
+ THEN REWRITE_TAC[emf_at_point_mul;PAIR_EQ;FUN_EQ_THM;eh_of_wave;e_of_emf;\r
+ h_of_emf;LET_DEF;LET_END_DEF]\r
+ THEN REPEAT (FIRST[CONJ_TAC;AP_THM_TAC;AP_TERM_TAC;GEN_TAC])\r
+ THEN REWRITE_TAC[REAL_ARITH `x-y=(z-y)+t <=> x=t+z:real`]\r
+ THEN GEN_REWRITE_TAC (RATOR_CONV o ONCE_DEPTH_CONV) \r
+ [ONCE_REWRITE_RULE[VECTOR_ADD_SYM] tmp']\r
+ THEN REWRITE_TAC[DOT_LADD;REAL_EQ_ADD_RCANCEL;phase_shift_at_plane]\r
+ THEN ABBREV_TAC `a = @a. a % unit n IN (p:plane)`\r
+ THEN GEN_REWRITE_TAC (RATOR_CONV o ONCE_DEPTH_CONV) \r
+ [VECTOR_ARITH `v dot r = v dot (r - a % unit n + a % unit n:real^3)`]\r
+ THEN REWRITE_TAC[DOT_RADD;DOT_RMUL;DOT_LMUL;REAL_ADD_LDISTRIB]\r
+ THEN ASM_REWRITE_TAC[MATCH_MP (UNIT_DOT_UNIT_SELF)\r
+ (STRIP_RULE NORMAL_OF_PLANE_NON_NULL);REAL_ARITH `x+y*z* &1=z*y <=> x= &0`]\r
+ THEN REWRITE_TAC[REAL_ENTIRE;GSYM orthogonal;ORTHOGONAL_LUNIT] THEN DISJ2_TAC\r
+ THEN ONCE_REWRITE_TAC[ORTHOGONAL_SYM]\r
+ THEN MATCH_MP_TAC (GENL [`pt1:point`;`pt2:point`] \r
+ (REWRITE_RULE[GSYM IMP_CONJ] (DISCH_ALL (STRIP_RULE \r
+ NORMAL_OF_PLANE_IS_ORTHOGONAL_TO_SEGMENT))))\r
+ THEN ASM_REWRITE_TAC[]\r
+ THEN EXPAND_TAC "a" THEN SELECT_ELIM_TAC\r
+ THEN ASM_SIMP_TAC[EXISTS_MULTIPLE_OF_NORMAL_IN_PLANE]);;\r
+\r
+let PLANE_WAVE_WITH_PHASE_SHIFT_AT_INTERFACE = prove\r
+ (`!emf. is_plane_wave emf ==> !i. is_valid_interface i ==> !r.\r
+ r IN plane_of_interface i ==> !t.\r
+ let n = normal_of_interface i in\r
+ emf r t = cexp (--ii * Cx(projection_on_hyperplane (k_of_wave emf) (unit n)\r
+ dot r - w_of_wave emf * t + phase_shift_at_plane (plane_of_interface i) n emf))\r
+ % eh_of_wave emf`,\r
+ REWRITE_TAC[LET_DEFs] THEN REPEAT STRIP_TAC THEN ASM_CSQ_THEN \r
+ IS_VALID_INTERFACE_IS_NORMAL_TO_PLANE ASSUME_TAC\r
+ THEN ASM_CSQ_THEN IS_VALID_INTERFACE_PLANE ASSUME_TAC\r
+ THEN ASM_CSQS_THEN PLANE_WAVE_WITH_PHASE_SHIFT_AT_PLANE ASSUME_TAC\r
+ THEN ASM_REWRITE_TAC[]);;\r
+\r
+let magnitude_shifted_at_plane = new_definition\r
+ `magnitude_shifted_at_plane p n emf =\r
+ cexp (--ii * Cx(phase_shift_at_plane p n emf)) % eh_of_wave emf`;;\r
+\r
+let E_PRESERVED_IN_TE_MODE = prove\r
+ (`!i emf_i emf_r emf_t.\r
+ is_plane_wave_at_interface i emf_i emf_r emf_t /\ non_null_wave emf_r\r
+ /\ non_null_wave emf_t /\ TE_mode i emf_i emf_r emf_t ==>\r
+ let magnitude =\r
+ \emf. FST (magnitude_shifted_at_plane (plane_of_interface i)\r
+ (normal_of_interface i) emf) cdot (vector_to_cvector (TE_mode_axis\r
+ i emf_i emf_r emf_t))\r
+ in\r
+ magnitude emf_r + magnitude emf_i = magnitude emf_t`,\r
+ REWRITE_TAC[FORALL_INTERFACE_THM;LET_DEFs;plane_of_interface;\r
+ normal_of_interface] THEN REPEAT STRIP_TAC\r
+ THEN ASM_CSQ_THEN (GEQ_IMP is_plane_wave_at_interface) (STRIP_ASSUME_TAC o\r
+ REWRITE_RULE[LET_DEFs])\r
+ THEN FIRST_ASSUM (let tmp = MESON[non_null_wave] `!emf. non_null_wave emf\r
+ ==> is_plane_wave emf` in ASSUME_TAC o MATCH_MP tmp)\r
+ THEN ASM_CSQ_THEN (GEN_ALL (MATCH_MP EQ_IMP (SPEC_ALL is_valid_interface)))\r
+ (STRIP_ASSUME_TAC o REWRITE_RULE[LET_DEFs])\r
+ THEN ASM_CSQ_THEN PLANE_NON_EMPTY (STRIP_ASSUME_TAC o\r
+ REWRITE_RULE[GSYM MEMBER_NOT_EMPTY])\r
+ THEN FIRST_ASSUM (fun x -> FIRST_X_ASSUM (C ASM_CSQ_THEN (MP_TAC o\r
+ REWRITE_RULE[LET_DEFs] o GEN_REWRITE_RULE (RATOR_CONV o ONCE_DEPTH_CONV)\r
+ [e_of_emf] o CONJUNCT1 o SPEC `&0`) o REWRITE_RULE[boundary_conditions;\r
+ emf_add;LET_DEFs] o C MATCH_MP x))\r
+ THEN ASSUM_LIST (MAP_EVERY (C ASM_CSQS_THEN (SINGLE REWRITE_TAC o CONJUNCT1\r
+ o SPEC `&0` o REWRITE_RULE[emf_at_point_mul;eh_of_wave;FST;SND;EMF_EQ]))\r
+ o mapfilter (REWRITE_RULE[FORALL_INTERFACE_THM;LET_DEFs;plane_of_interface;\r
+ normal_of_interface;]\r
+ o MATCH_MP PLANE_WAVE_WITH_PHASE_SHIFT_AT_INTERFACE))\r
+ THEN ASM_CSQ_THEN (REWRITE_RULE[LET_DEFs] K_PLANE_PROJECTION_CONSERVATION)\r
+ (CONJUNCTS_THEN (C ASM_CSQ_THEN (SINGLE REWRITE_TAC o \r
+ SIMP_RULE[normal_of_interface;LET_DEFs])))\r
+ THEN REWRITE_TAC[REAL_ARITH `x - y * &0 = x`;CX_ADD;COMPLEX_ADD_LDISTRIB;\r
+ CEXP_ADD;GSYM CVECTOR_MUL_ASSOC;GSYM CVECTOR_ADD_LDISTRIB;\r
+ CCROSS_RMUL;CVECTOR_MUL_LCANCEL;CEXP_NZ;magnitude_shifted_at_plane;\r
+ eh_of_wave;emf_at_point_mul;GSYM CDOT_LADD]\r
+ THEN ASM_CSQS_THEN (REWRITE_RULE[IMP_CONJ;LET_DEFs] TE_MODE_PLANEWAVE_PROJ)\r
+ (GEN_REWRITE_TAC (RATOR_CONV o ONCE_DEPTH_CONV) o CONJUNCTS)\r
+ THEN REWRITE_TAC[CCROSS_RADD;CCROSS_RMUL;CVECTOR_MUL_ASSOC;\r
+ GSYM CVECTOR_ADD_RDISTRIB;CVECTOR_MUL_RCANCEL;CCROSS_COLLINEAR_CVECTORS;\r
+ GSYM CDOT_LMUL;GSYM CDOT_LADD;COLLINEAR_CVECTORS_VECTOR_TO_CVECTOR]\r
+ THEN FIRST_X_ASSUM (STRIP_ASSUME_TAC o REWRITE_RULE[is_mode_axis;\r
+ normal_of_interface;LET_DEFs] o MATCH_MP (GEQ_IMP TE_MODE_THM))\r
+ THEN FIRST_ASSUM (ASSUME_TAC o REWRITE_RULE[NORM_EQ_0] o MATCH_MP \r
+ (REAL_ARITH `!x. x= &1 ==> ~(x= &0)`))\r
+ THEN FIRST_X_ASSUM (STRIP_ASSUME_TAC o MATCH_MP (GEQ_IMP is_normal_to_plane))\r
+ THEN ASM_CSQS_THEN (ONCE_REWRITE_RULE[ORTHOGONAL_SYM] (REWRITE_RULE[IMP_CONJ]\r
+ ORTHOGONAL_NON_COLLINEAR)) (SINGLE REWRITE_TAC)\r
+ THEN REWRITE_TAC[CVECTOR_ADD_SYM]);;\r
+\r
+let H_CROSS_Z_WRT_E_IN_TE_MODE = prove\r
+ (`!i emf_i emf_r emf_t.\r
+ is_plane_wave_at_interface i emf_i emf_r emf_t\r
+ /\ TE_mode i emf_i emf_r emf_t ==>\r
+ let p = plane_of_interface i in\r
+ let n = normal_of_interface i in\r
+ let h_cross_z_wrt_e =\r
+ \emf. (h_of_wave emf) ccross (vector_to_cvector n) =\r
+ Cx ((n dot k_of_wave emf) / (eta0 * k0)) % e_of_wave emf\r
+ in\r
+ h_cross_z_wrt_e emf_i /\ h_cross_z_wrt_e emf_r /\ h_cross_z_wrt_e emf_t`,\r
+ SIMP_TAC[FORALL_INTERFACE_THM;LET_DEFs;is_plane_wave_at_interface;\r
+ plane_of_interface;non_null_wave;normal_of_interface]\r
+ THEN REPEAT STRIP_TAC THEN ASM_CSQS_THEN (REWRITE_RULE[LET_DEFs;IMP_CONJ]\r
+ TE_MODE_PLANEWAVE_PROJ) (SINGLE ONCE_REWRITE_TAC)\r
+ THEN REWRITE_TAC[CCROSS_LMUL;CCROSS_LREAL;CDOT_RREAL;CVECTOR_ADD_RDISTRIB;\r
+ GSYM CVECTOR_MUL_ASSOC;GSYM VECTOR_TO_CVECTOR_MUL;\r
+ CVECTOR_IM_VECTOR_TO_CVECTOR_RE_IM;CVECTOR_RE_VECTOR_TO_CVECTOR_RE_IM;\r
+ CCROSS_LADD;CVECTOR_ADD_LDISTRIB]\r
+ THEN REWRITE_TAC[REWRITE_RULE[VECTOR_ARITH `--x = y <=> x = --y :real^N`] \r
+ (ONCE_REWRITE_RULE[CROSS_SKEW] CROSS_LAGRANGE);\r
+ CVECTOR_RE_VECTOR_TO_CVECTOR;\r
+ CVECTOR_IM_VECTOR_TO_CVECTOR;DOT_LZERO;VECTOR_MUL_LZERO;VECTOR_SUB_RZERO;\r
+ VECTOR_NEG_0;VECTOR_TO_CVECTOR_ZERO;CVECTOR_MUL_RZERO;CVECTOR_ADD_ID;\r
+ DOT_RMUL]\r
+ THEN ASM_CSQ_THEN TE_MODE_AXIS_ORTHOGONAL_N\r
+ (SINGLE REWRITE_TAC o REWRITE_RULE[orthogonal;normal_of_interface;LET_DEFs]\r
+ o ONCE_REWRITE_RULE[ORTHOGONAL_SYM])\r
+ THEN REWRITE_TAC[REAL_MUL_RZERO;VECTOR_MUL_LZERO;VECTOR_ARITH\r
+ `--(vec 0 - x) = x`;VECTOR_NEG_0;VECTOR_TO_CVECTOR_ZERO;CVECTOR_MUL_RZERO;\r
+ CVECTOR_ADD_ID]\r
+ THEN REWRITE_TAC[MESON[CVECTOR_MUL_ASSOC;COMPLEX_MUL_SYM]\r
+ `a % ii % v = ii % a % v:complex^N`;GSYM VECTOR_TO_CVECTOR_MUL;CVECTOR_EQ;\r
+ CVECTOR_RE_VECTOR_TO_CVECTOR_RE_IM;CVECTOR_IM_VECTOR_TO_CVECTOR_RE_IM;\r
+ VECTOR_MUL_ASSOC]\r
+ THEN CONJ_TAC THEN REPEAT (AP_THM_TAC ORELSE AP_TERM_TAC)\r
+ THEN REAL_ARITH_TAC);;\r
+\r
+let NON_PROJECTED_E_RELATION_IN_TE_MODE = prove\r
+ (`!i emf_i emf_r emf_t.\r
+ is_plane_wave_at_interface i emf_i emf_r emf_t /\ non_null_wave emf_r\r
+ /\ non_null_wave emf_t /\ TE_mode i emf_i emf_r emf_t ==>\r
+ let magnitude =\r
+ \emf. FST (magnitude_shifted_at_plane (plane_of_interface i)\r
+ (normal_of_interface i) emf) cdot (vector_to_cvector (TE_mode_axis i\r
+ emf_i emf_r emf_t))\r
+ in\r
+ let n = unit (normal_of_interface i) in\r
+ Cx (n dot k_of_wave emf_i) * (magnitude emf_i - magnitude emf_r) =\r
+ Cx (n dot k_of_wave emf_t) * magnitude emf_t`,\r
+ REWRITE_TAC[FORALL_INTERFACE_THM;LET_DEFs;normal_of_interface;\r
+ plane_of_interface] THEN REPEAT STRIP_TAC \r
+ THEN ASM_CSQ_THEN (GEQ_IMP is_plane_wave_at_interface) (STRIP_ASSUME_TAC o\r
+ REWRITE_RULE[LET_DEFs])\r
+ THEN FIRST_ASSUM (let tmp = MESON[non_null_wave] `!emf. non_null_wave emf\r
+ ==> is_plane_wave emf` in ASSUME_TAC o MATCH_MP tmp)\r
+ THEN ASM_CSQ_THEN (GEN_ALL (MATCH_MP EQ_IMP (SPEC_ALL is_valid_interface)))\r
+ (STRIP_ASSUME_TAC o REWRITE_RULE[LET_DEFs])\r
+ THEN ASM_CSQ_THEN PLANE_NON_EMPTY (STRIP_ASSUME_TAC \r
+ o REWRITE_RULE[GSYM MEMBER_NOT_EMPTY])\r
+ THEN FIRST_ASSUM (fun x -> FIRST_X_ASSUM (C ASM_CSQ_THEN (MP_TAC o\r
+ REWRITE_RULE[LET_DEFs]\r
+ o GEN_REWRITE_RULE (RATOR_CONV o ONCE_DEPTH_CONV) [h_of_emf] \r
+ o CONJUNCT2 o SPEC `&0`) \r
+ o REWRITE_RULE[boundary_conditions;emf_add;LET_DEFs] o C MATCH_MP x))\r
+ THEN ASSUM_LIST (MAP_EVERY (C ASM_CSQS_THEN (SINGLE REWRITE_TAC o CONJUNCT2\r
+ o SPEC `&0` o REWRITE_RULE[emf_at_point_mul;eh_of_wave;FST;SND;EMF_EQ]))\r
+ o mapfilter (REWRITE_RULE[FORALL_INTERFACE_THM;LET_DEFs;plane_of_interface;\r
+ normal_of_interface;]\r
+ o MATCH_MP PLANE_WAVE_WITH_PHASE_SHIFT_AT_INTERFACE))\r
+ THEN ASM_CSQ_THEN (REWRITE_RULE[LET_DEFs] K_PLANE_PROJECTION_CONSERVATION)\r
+ (CONJUNCTS_THEN (C ASM_CSQ_THEN (SINGLE REWRITE_TAC\r
+ o SIMP_RULE[normal_of_interface;LET_DEFs])))\r
+ THEN REWRITE_TAC[REAL_ARITH `x - y * &0 = x`;CX_ADD;COMPLEX_ADD_LDISTRIB;\r
+ CEXP_ADD;GSYM CVECTOR_MUL_ASSOC;GSYM CVECTOR_ADD_LDISTRIB;\r
+ CCROSS_RMUL;CVECTOR_MUL_LCANCEL;CEXP_NZ;magnitude_shifted_at_plane;\r
+ eh_of_wave;emf_at_point_mul;GSYM CDOT_LADD;CCROSS_RADD]\r
+ THEN ASM_CSQS_THEN (REWRITE_RULE[IMP_CONJ;CVECTOR_ARITH\r
+ `--x=a%y <=> x = (--a)%y:complex^N`] (ONCE_REWRITE_RULE[CCROSS_SKEW]\r
+ (REWRITE_RULE[LET_DEFs] H_CROSS_Z_WRT_E_IN_TE_MODE)))\r
+ (SINGLE REWRITE_TAC \r
+ o REWRITE_RULE[LET_DEFs;plane_of_interface;normal_of_interface])\r
+ THEN REWRITE_TAC[GSYM CX_NEG;real_div;REAL_NEG_LMUL;GSYM DOT_RNEG]\r
+ THEN FIRST_ASSUM (ASSUME_TAC o ONCE_REWRITE_RULE[DOT_SYM]\r
+ o REWRITE_RULE[DOT_RUNIT_EQ] o MATCH_MP SYMETRIC_VECTORS_PROJECTION_ON_AXIS\r
+ o MATCH_MP UNIT_THM o CONJUNCT1 o MATCH_MP (GEQ_IMP is_normal_to_plane))\r
+ THEN ASM_CSQS_THEN (SIMP_RULE[LET_DEFs] LAW_OF_REFLECTION) (fun x -> \r
+ POP_ASSUM (SINGLE REWRITE_TAC o C MATCH_MP (REWRITE_RULE\r
+ [normal_of_interface;LET_DEFs] x)))\r
+ THEN REWRITE_TAC[CX_MUL;DOT_RNEG;CX_NEG;COMPLEX_MUL_LNEG;CVECTOR_ARITH\r
+ `a%(--(u*v))%x+c%(u*v)%y = d%(--(u'*v))%z\r
+ <=> v%u%(a%x-c%y) = v%u'%d%z:complex^N`]\r
+ THEN REWRITE_TAC[CVECTOR_MUL_LCANCEL;CX_INJ;REAL_INV_EQ_0;REAL_ENTIRE;\r
+ MATCH_MP REAL_LT_IMP_NZ eta0;MATCH_MP REAL_LT_IMP_NZ k0]\r
+ THEN REWRITE_TAC[unit;DOT_LMUL;CX_MUL;GSYM COMPLEX_MUL_ASSOC;\r
+ COMPLEX_EQ_MUL_LCANCEL;CX_INJ;REAL_ENTIRE;REAL_INV_EQ_0;NORM_EQ_0]\r
+ THEN ASM_CSQS_THEN NORMAL_OF_PLANE_NON_NULL (SINGLE REWRITE_TAC)\r
+ THEN ASM_CSQS_THEN (REWRITE_RULE[IMP_CONJ;LET_DEFs] TE_MODE_PLANEWAVE_PROJ)\r
+ (GEN_REWRITE_TAC (RATOR_CONV o ONCE_DEPTH_CONV) o CONJUNCTS)\r
+ THEN REWRITE_TAC[CVECTOR_MUL_ASSOC;GSYM CVECTOR_SUB_RDISTRIB;\r
+ CVECTOR_MUL_RCANCEL;VECTOR_TO_CVECTOR_ZERO_EQ;GSYM NORM_EQ_0]\r
+ THEN FIRST_ASSUM (SINGLE REWRITE_TAC o MATCH_MP (REWRITE_RULE[is_mode_axis]\r
+ (GEQ_IMP TE_MODE_THM)))\r
+ THEN SIMP_TAC[REAL_ARITH `~(&1 = &0)`;CDOT_LMUL;COMPLEX_MUL_ASSOC]);;\r
+\r
+let COMPLEX_MUL_LINV2 = prove\r
+ (`!x y. ~(x=Cx(&0)) ==> inv x * (x * y) = y`,\r
+ SIMP_TAC[COMPLEX_MUL_ASSOC;COMPLEX_MUL_LINV;COMPLEX_MUL_LID]);;\r
+\r
+let COMPLEX_BALANCE_MUL_DIV = prove\r
+ (`!x y z. ~(x=Cx(&0)) ==> (x*y=z <=> y=z/x)`,\r
+ REPEAT STRIP_TAC THEN EQ_TAC THENL [\r
+ DISCH_THEN (fun x -> ASM_SIMP_TAC[GSYM x;complex_div;SIMPLE_COMPLEX_ARITH\r
+ `(x*y)*inv x=(x*inv x)*y:complex`;COMPLEX_MUL_RINV;COMPLEX_MUL_LID]);\r
+ DISCH_THEN (fun x -> ASM_SIMP_TAC[x;COMPLEX_DIV_LMUL]);\r
+ ]);;\r
+\r
+\r
+let FRESNEL_REFLECTION_TE_MODE = prove\r
+ (`!i emf_i emf_r emf_t.\r
+ is_plane_wave_at_interface i emf_i emf_r emf_t /\ non_null_wave emf_r\r
+ /\ non_null_wave emf_t /\ TE_mode i emf_i emf_r emf_t ==>\r
+ let magnitude =\r
+ \emf. FST (magnitude_shifted_at_plane (plane_of_interface i)\r
+ (normal_of_interface i) emf) cdot (vector_to_cvector (TE_mode_axis i\r
+ emf_i emf_r emf_t))\r
+ in\r
+ let theta = \emf. Cx(vector_angle (k_of_wave emf) (normal_of_interface i)) in\r
+ let n1 = Cx(n1_of_interface i) in\r
+ let n2 = Cx(n2_of_interface i) in\r
+ magnitude emf_r = (n1 * ccos (theta emf_i) - n2 * ccos (theta emf_t)) / (n1 *\r
+ ccos (theta emf_i) + n2 * ccos (theta emf_t)) * magnitude emf_i`,\r
+ REPEAT STRIP_TAC THEN ASM_CSQS_THEN (REWRITE_RULE[IMP_CONJ]\r
+ NON_PROJECTED_E_RELATION_IN_TE_MODE) MP_TAC\r
+ THEN ASM_CSQS_THEN (REWRITE_RULE[IMP_CONJ] E_PRESERVED_IN_TE_MODE) (MP_TAC o\r
+ GSYM)\r
+ THEN LET_TAC THEN REWRITE_TAC[LET_DEFs] \r
+ THEN DISCH_THEN (fun x -> REWRITE_TAC[x;SIMPLE_COMPLEX_ARITH\r
+ `x*(y-z)=t*(z+y) <=> (x+t)*z=(x-t)*y:complex`])\r
+ THEN DISCH_THEN (MP_TAC o MATCH_MP (MATCH_MP (MESON[]\r
+ `(!x y z. p x ==> (q x y z <=> r x y z)) ==> !x y z. q x y z ==> p x\r
+ ==> r x y z`) COMPLEX_BALANCE_MUL_DIV))\r
+ THEN ANTS_TAC THENL [\r
+ REWRITE_TAC[GSYM CX_ADD;CX_INJ] THEN MATCH_MP_TAC REAL_POS_NZ\r
+ THEN MATCH_MP_TAC REAL_LTE_ADD THEN REWRITE_TAC[DOT_LUNIT_POS;DOT_LUNIT_GE0]\r
+ THEN ONCE_REWRITE_TAC[DOT_SYM] THEN REPEAT (POP_ASSUM MP_TAC)\r
+ THEN SPEC_TAC (`i:interface`,`i:interface`)\r
+ THEN SIMP_TAC[FORALL_INTERFACE_THM;is_plane_wave_at_interface;\r
+ normal_of_interface;map_triple;LET_DEFs;real_ge;real_gt];\r
+ SIMP_TAC[SIMPLE_COMPLEX_ARITH `(x*y)/z = (x/z)*y`]\r
+ THEN DISCH_THEN (K ALL_TAC) THEN AP_THM_TAC THEN AP_TERM_TAC \r
+ THEN REWRITE_TAC[GSYM CX_ADD;GSYM CX_SUB;GSYM CX_COS;GSYM CX_MUL;\r
+ GSYM CX_DIV;CX_INJ]\r
+ THEN REPEAT (POP_ASSUM MP_TAC) THEN SPEC_TAC (`i:interface`,`i:interface`)\r
+ THEN REWRITE_TAC[FORALL_INTERFACE_THM;normal_of_interface;\r
+ plane_of_interface;LET_DEFs;n1_of_interface;n2_of_interface]\r
+ THEN REPEAT STRIP_TAC\r
+ THEN ASM_CSQ_THEN (GEQ_IMP is_plane_wave_at_interface) (STRIP_ASSUME_TAC\r
+ o REWRITE_RULE[is_valid_interface;is_normal_to_plane;LET_DEFs;\r
+ map_triple])\r
+ THEN ASM_REWRITE_TAC[GSYM NORM_EQ_0]\r
+ THEN ASM_SIMP_TAC [GEN_ALL (DISCH_ALL (GSYM (MATCH_MP REAL_LT_IMP_NE\r
+ (UNDISCH_ALL (SPEC_ALL (MATCH_MP (REWRITE_RULE[IMP_CONJ] REAL_LT_MUL)\r
+ k0))))))]\r
+ THEN GEN_REWRITE_TAC (RATOR_CONV o ONCE_DEPTH_CONV) [VECTOR_ANGLE]\r
+ THEN ASM_SIMP_TAC[UNIT_THM;REAL_MUL_LID]\r
+ THEN REWRITE_TAC[GSYM REAL_MUL_ASSOC;GSYM REAL_ADD_LDISTRIB;\r
+ GSYM REAL_SUB_LDISTRIB;real_div;REAL_INV_MUL]\r
+ THEN REWRITE_TAC[REAL_ARITH `x*y*inv x*z=(x*inv x)*y*z:real`;\r
+ MATCH_MP REAL_MUL_RINV (GSYM (MATCH_MP REAL_LT_IMP_NE k0));REAL_MUL_LID]\r
+ THEN ASM_SIMP_TAC[unit;VECTOR_ANGLE_LMUL;REAL_INV_EQ_0;NORM_EQ_0;\r
+ REAL_LE_INV_EQ;NORM_POS_LE;VECTOR_ANGLE_SYM]]);;\r
+\r
+let FRESNEL_TRANSMISSION_TE_MODE = prove\r
+ (`!i emf_i emf_r emf_t.\r
+ is_plane_wave_at_interface i emf_i emf_r emf_t /\ non_null_wave emf_r \r
+ /\ non_null_wave emf_t /\ TE_mode i emf_i emf_r emf_t ==>\r
+ let magnitude =\r
+ \emf. FST (magnitude_shifted_at_plane (plane_of_interface i) \r
+ (normal_of_interface i) emf) cdot (vector_to_cvector (TE_mode_axis i\r
+ emf_i emf_r emf_t))\r
+ in\r
+ let theta =\r
+ \emf. Cx(vector_angle (k_of_wave emf) (normal_of_interface i))\r
+ in\r
+ let n1 = Cx(n1_of_interface i) in\r
+ let n2 = Cx(n2_of_interface i) in\r
+ magnitude emf_t = Cx(&2) * n1 * ccos (theta emf_i) / (n1 * ccos\r
+ (theta emf_i) + n2 * ccos (theta emf_t)) * magnitude emf_i`,\r
+ REPEAT STRIP_TAC THEN ASM_CSQS_THEN (REWRITE_RULE[IMP_CONJ] \r
+ E_PRESERVED_IN_TE_MODE) (MP_TAC o GSYM)\r
+ THEN ASM_CSQS_THEN (REWRITE_RULE[IMP_CONJ] \r
+ NON_PROJECTED_E_RELATION_IN_TE_MODE) MP_TAC THEN LET_TAC\r
+ THEN REWRITE_TAC[LET_DEFs] \r
+ THEN REWRITE_TAC[SIMPLE_COMPLEX_ARITH `x*(y-z)=t*u <=> x*z=x*y-t*u:complex`]\r
+ THEN DISCH_THEN (MP_TAC o MATCH_MP (MATCH_MP (MESON[]\r
+ `(!x y z. p x ==> (q x y z <=> r x y z)) ==> !x y z. q x y z ==> p x\r
+ ==> r x y z`) COMPLEX_BALANCE_MUL_DIV))\r
+ THEN MATCH_MP_TAC (MESON[] `p/\(p==>q==>r==>s) ==> ((p==>q)==>r==>s)`)\r
+ THEN CONJ_TAC THENL [\r
+ REWRITE_TAC[CX_INJ] THEN MATCH_MP_TAC REAL_POS_NZ\r
+ THEN REWRITE_TAC[DOT_LUNIT_POS;DOT_LUNIT_GE0]\r
+ THEN ONCE_REWRITE_TAC[DOT_SYM] THEN REPEAT (POP_ASSUM MP_TAC)\r
+ THEN SPEC_TAC (`i:interface`,`i:interface`)\r
+ THEN SIMP_TAC[FORALL_INTERFACE_THM;is_plane_wave_at_interface;\r
+ normal_of_interface;map_triple;LET_DEFs;real_gt];\r
+ DISCH_TAC THEN DISCH_THEN (fun x -> ASM_SIMP_TAC[x;SIMPLE_COMPLEX_ARITH\r
+ `t = (x*i-y*t)/x+i <=> (y/x+Cx(&1))*t = (x/x+Cx(&1))*i:complex`;\r
+ COMPLEX_DIV_REFL;SIMPLE_COMPLEX_ARITH `Cx(&1)+Cx(&1)=Cx(&2)`])\r
+ THEN ASM_CSQ_THEN COMPLEX_DIV_REFL (SINGLE REWRITE_TAC o GSYM)\r
+ THEN REWRITE_TAC[GSYM CX_ADD;GSYM CX_DIV;real_div;GSYM REAL_ADD_RDISTRIB]\r
+ THEN DISCH_THEN (MP_TAC o MATCH_MP (MATCH_MP (MESON[]\r
+ `(!x y z. p x ==> (q x y z <=> r x y z)) ==> (!x y z. q x y z ==> p x \r
+ ==> r x y z)`) COMPLEX_BALANCE_MUL_DIV))\r
+ THEN ANTS_TAC THENL [\r
+ ASM_REWRITE_TAC[CX_MUL;CX_INV;COMPLEX_ENTIRE;COMPLEX_INV_EQ_0] \r
+ THEN REWRITE_TAC[CX_INJ] THEN MATCH_MP_TAC REAL_POS_NZ \r
+ THEN MATCH_MP_TAC REAL_LET_ADD\r
+ THEN REWRITE_TAC[DOT_LUNIT_POS;DOT_LUNIT_GE0]\r
+ THEN ONCE_REWRITE_TAC[DOT_SYM] THEN REPEAT (POP_ASSUM MP_TAC)\r
+ THEN SPEC_TAC (`i:interface`,`i:interface`)\r
+ THEN SIMP_TAC[FORALL_INTERFACE_THM;is_plane_wave_at_interface;\r
+ normal_of_interface;map_triple;LET_DEFs;real_ge;real_gt];\r
+ SIMP_TAC[SIMPLE_COMPLEX_ARITH `(x*y)/z = x/z*y:complex`;GSYM CX_DIV;\r
+ real_div;REAL_INV_MUL;REAL_INV_INV] THEN DISCH_THEN (K ALL_TAC)\r
+ THEN REWRITE_TAC[GSYM CX_MUL;GSYM CX_COS;GSYM CX_ADD;GSYM CX_DIV;\r
+ COMPLEX_MUL_ASSOC;CX_INJ]\r
+ THEN AP_THM_TAC THEN AP_TERM_TAC\r
+ THEN REWRITE_TAC[CX_INJ;REAL_ARITH `&2*x = (&2*y)*z <=> x=y*z`]\r
+ THEN REPEAT (POP_ASSUM MP_TAC) THEN SPEC_TAC (`i:interface`,`i:interface`)\r
+ THEN REWRITE_TAC[FORALL_INTERFACE_THM;normal_of_interface;\r
+ plane_of_interface;LET_DEFs;n1_of_interface;n2_of_interface]\r
+ THEN REPEAT STRIP_TAC\r
+ THEN ASM_CSQ_THEN (GEQ_IMP is_plane_wave_at_interface) (STRIP_ASSUME_TAC\r
+ o REWRITE_RULE[is_valid_interface;is_normal_to_plane;LET_DEFs;map_triple])\r
+ THEN GEN_REWRITE_TAC (RATOR_CONV o ONCE_DEPTH_CONV) [VECTOR_ANGLE]\r
+ THEN ASM_SIMP_TAC[UNIT_THM;REAL_MUL_LID]\r
+ THEN REWRITE_TAC[GSYM REAL_MUL_ASSOC;GSYM REAL_ADD_LDISTRIB;\r
+ GSYM REAL_SUB_LDISTRIB;real_div;REAL_INV_MUL]\r
+ THEN REWRITE_TAC[REAL_ARITH `inv x*y*x*z=(x*inv x)*y*z:real`;\r
+ MATCH_MP REAL_MUL_RINV (GSYM (MATCH_MP REAL_LT_IMP_NE k0));\r
+ REAL_MUL_LID]\r
+ THEN ASM_SIMP_TAC[unit;VECTOR_ANGLE_LMUL;REAL_INV_EQ_0;NORM_EQ_0;\r
+ REAL_LE_INV_EQ;NORM_POS_LE]\r
+ THEN GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [VECTOR_ANGLE_SYM]\r
+ THEN REAL_ARITH_TAC]]);;\r
--- /dev/null
+(* ========================================================================= *)\r
+(* Formalization of Electromagnetic Optics *)\r
+(* *)\r
+(* (c) Copyright, Sanaz Khan Afshar & Vincent Aravantinos 2011-14 *)\r
+(* Hardware Verification Group, *)\r
+(* Concordia University *)\r
+(* *)\r
+(* Contact: <s_khanaf@encs.concordia.ca> *)\r
+(* <vincent@encs.concordia.ca> *)\r
+(* *)\r
+(* This file deals with various utilities. *)\r
+(* ========================================================================= *)\r
+\r
+Format.set_margin 154;;\r
+\r
+let CHANGED_RULE r thm =\r
+ let thm' = r thm in\r
+ if equals_thm thm thm' then failwith "CHANGED_RULE" else thm';;\r
+let MAP_ASSUMPTIONS f = REPEAT (POP_ASSUM (MP_TAC o f)) THEN REPEAT DISCH_TAC;;\r
+let REMOVE_LETS =\r
+ REPEAT LET_TAC THEN MAP_ASSUMPTIONS (repeat (CONV_RULE let_CONV));;\r
+let REWRITE_ASSUMPTIONS xs = MAP_ASSUMPTIONS (REWRITE_RULE xs);;\r
+let REWRITE_EVERYWHERE xs =\r
+ REWRITE_TAC xs THEN MAP_ASSUMPTIONS (REWRITE_RULE xs);;\r
+let ON_FIRST_GOAL ?(out_of=2) x =\r
+ let rec ( * ) n x = if n<=1 then [] else x :: (n-1) * x in\r
+ x :: out_of * ALL_TAC;;\r
+let STRIP_ASSUMPTIONS = REPEAT (POP_ASSUM MP_TAC) THEN REPEAT STRIP_TAC;;\r
+let DESTRUCT_PAIR_TAC p =\r
+ CHOOSE_THEN (CHOOSE_THEN (fun x -> PURE_REWRITE_TAC[x]))\r
+ (ISPEC p PAIR_SURJECTIVE);;\r
+let MAP_ANTECEDENT f = DISCH_THEN (MP_TAC o f);;\r
+\r
+let exn_to_bool f x = try ignore (f x); true with _ -> false;;\r
+\r
+let strip_parentheses s =\r
+ if s.[0] = '(' && s.[String.length s-1] = ')'\r
+ then String.sub s 1 (String.length s-2)\r
+ else s;;\r
+let contains_sub_term_name name t =\r
+ exn_to_bool (find_term (fun x -> ((=) name o strip_parentheses o\r
+ string_of_term) x)) t;;\r
+\r
+let REAL_SIMP_TAC thms =\r
+ ASM_REWRITE_TAC ([REAL_MUL_LZERO;REAL_MUL_RZERO;REAL_MUL_RID;REAL_MUL_LID;\r
+ REAL_ADD_LID;REAL_ADD_RID;REAL_SUB_RZERO;REAL_NEG_0] @ thms);;\r
+let COMPLEX_SIMPLIFY_TAC =\r
+ ASM_REWRITE_TAC[COMPLEX_ADD_LID;COMPLEX_MUL_LID;COMPLEX_MUL_LZERO;\r
+ COMPLEX_MUL_RZERO;COMPLEX_SUB_LZERO;COMPLEX_SUB_RZERO;COMPLEX_NEG_0 ];; \r
+\r
+let try_or_id f x = try f x with _ -> x;;\r
+\r
+let SINGLE f x = f [x];;\r
+let ASSUME_CONSEQUENCES x =\r
+ ASM (MAP_EVERY (fun y -> try ASSUME_TAC (MATCH_MP x y) with _ -> ALL_TAC))\r
+ [];;\r
+let STRIP_RULE =\r
+ repeat (CHANGED_RULE UNDISCH_ALL o try_or_id SPEC_ALL)\r
+ o REWRITE_RULE[IMP_CONJ];;\r
+\r
+let CSQS xs x = map (try_or_id (MATCH_MP x)) xs;; \r
+let CSQS_THEN xs x ttac = MAP_EVERY ttac (CSQS xs x);;\r
+let ASM_CSQS_THEN x = ASSUM_LIST o C (C CSQS_THEN x);;\r
+\r
+let ASM_CSQ_THEN ?(remove=false) ?(match_=true) x ttac =\r
+ (if remove then FIRST_X_ASSUM else FIRST_ASSUM)\r
+ (ttac o (if match_ then MATCH_MP else MP) x);;\r
+\r
+let ASM_CSQS_THEN x ttac =\r
+ (* looks absurd, eh? But needed in order to control the execution flow *)\r
+ let ttac x y = ttac x y in \r
+ REPEAT_TCL (fun y z -> ASM_CSQ_THEN z y ORELSE ttac z) ttac x;;\r
+\r
+let LET_SIMP_TAC = REWRITE_TAC[LET_DEF;LET_END_DEF];;\r
+\r
+let distrib fs x = map (fun f -> f x) fs;;\r
+\r
+let DISTRIB ttacs x = EVERY (distrib ttacs x);;\r
+let LET_DEFs = CONJ LET_DEF LET_END_DEF;;\r
+\r
+let GEQ_IMP x = GEN_ALL (MATCH_MP EQ_IMP (SPEC_ALL x));;\r
--- /dev/null
+
+needs "tacticlib.ml";; (** some general Tactics; developed to facilitate the process of formalization **)
+needs "cvectors.ml";; (** Complex Vector Analysis **)\r
+needs "vectors_ext.ml";; (** some notion in real vector analysis we need in developing EM Optics, e.g., unit vector and projection on hyper plains. **) \r
+needs "frequency_equalities.ml";; (** Proving that (!x. A*e^(iax)+B*e^(ibx)=C*e^(icx)) ==> a=b=c /\ A+B=C **)
+needs "em_model.ml";; (** Formalizaing electromagnetic models, e.g., EM fields, plane waves, interfaces. **)
+needs "primitive_rules.ml";; (** Formalizing primitive rules of Optics, e.g., Snell's law and Fresnel Equations **)
+\r
+
+\r
+
--- /dev/null
+(* ========================================================================= *)\r
+(* Formalization of Electromagnetic Optics *)\r
+(* *)\r
+(* (c) Copyright, Sanaz Khan Afshar & Vincent Aravantinos 2011-14 *)\r
+(* Hardware Verification Group, *)\r
+(* Concordia University *)\r
+(* *)\r
+(* Contact: <s_khanaf@encs.concordia.ca> *)\r
+(* <vincent@encs.concordia.ca> *)\r
+(* *)\r
+(* Extentions of the vector library. *)\r
+(* ========================================================================= *)\r
+\r
+\r
+prioritize_vector ();;\r
+\r
+(** Additions to euclidean space *)\r
+\r
+let [ORTHOGONAL_RZERO;ORTHOGONAL_RMUL;ORTHOGONAL_RNEG;ORTHOGONAL_RADD;\r
+ ORTHOGONAL_RSUB;ORTHOGONAL_LZERO;ORTHOGONAL_LMUL;ORTHOGONAL_LNEG;\r
+ ORTHOGONAL_LADD;ORTHOGONAL_LSUB] = \r
+ CONJUNCTS ORTHOGONAL_CLAUSES;;\r
+\r
+let NON_VEC0 = prove\r
+ (`!x:real^N. ~(x=vec 0) <=> ?i. 1 <= i /\ i <= dimindex(:N) /\ ~(x$i = &0)`,\r
+ GEN_TAC THEN EQ_TAC THEN SIMP_TAC[vec;CART_EQ;LAMBDA_BETA]\r
+ THEN ASM_MESON_TAC[]);;\r
+\r
+let NON_VEC0_DIM3 = prove\r
+ (`!x:real^3. ~(x=vec 0) <=> ~(x$1= &0) \/ ~(x$2= &0) \/ ~(x$3= &0)`,\r
+ REWRITE_TAC[NON_VEC0;DIMINDEX_3]\r
+ THEN MESON_TAC[ARITH_RULE `1 <= i /\ i <= 3 <=> i = 1 \/ i = 2 \/ i = 3`]);;\r
+\r
+let ORTHOGONAL_SQR_NORM = prove\r
+ (`!x y:real^N. orthogonal (x-y) y ==> x dot x = (x-y) dot (x-y) + y dot y`,\r
+ REWRITE_TAC[orthogonal] THEN REPEAT STRIP_TAC\r
+ THEN GEN_REWRITE_TAC (RATOR_CONV o ONCE_DEPTH_CONV) \r
+ [VECTOR_ARITH `x dot x = (x-y) dot (x-y) + y dot y + &2 * (x-y) dot y`]\r
+ THEN ASM_REWRITE_TAC[REAL_MUL_RZERO;REAL_ADD_RID]);;\r
+\r
+let COLLINEAR_VEC0 = prove\r
+ (`!s:real^N->bool. collinear s /\ vec 0 IN s ==> ?u. !x. x IN s\r
+ ==> ?c. x = c %u`,\r
+ REWRITE_TAC[collinear] THEN REPEAT (STRIP_TAC ORELSE EXISTS_TAC `u:real^N`)\r
+ THEN ASM_MESON_TAC[VECTOR_SUB_RZERO]);;\r
+\r
+let CROSS_NORM_ORTHOGONAL = prove\r
+ (`!x y. orthogonal x y ==> norm (x cross y) = norm x * norm y`,\r
+ ONCE_REWRITE_TAC[GSYM (REWRITE_RULE[GSYM REAL_ABS_REFL] NORM_POS_LE)]\r
+ THEN SIMP_TAC[GSYM REAL_ABS_MUL;REAL_EQ_SQUARE_ABS;GSYM NORM_CROSS_DOT;\r
+ orthogonal;REAL_POW_2]\r
+ THEN REAL_ARITH_TAC);;\r
+\r
+\r
+let COLLINEAR_DEPENDENT = prove\r
+ (`!x y:real^N. ~(x=y) /\ collinear {vec 0,x,y} ==> dependent {x,y}`,\r
+ REWRITE_TAC[collinear;dependent;IN_INSERT;IN_SING] THEN REPEAT STRIP_TAC\r
+ THEN ASM_CASES_TAC `x=vec 0:real^N`\r
+ THENL ON_FIRST_GOAL (ASM_MESON_TAC[SPAN_0])\r
+ THEN ASM_CASES_TAC `y=vec 0:real^N`\r
+ THENL ON_FIRST_GOAL (ASM_MESON_TAC[SPAN_0])\r
+ THEN SUBGOAL_THEN `?c. x = c % y :real^N` STRIP_ASSUME_TAC THENL [\r
+ FIRST_ASSUM (fun x -> MAP_EVERY (STRIP_ASSUME_TAC o\r
+ REWRITE_RULE[IN_INSERT;IN_SING;VECTOR_SUB_RZERO] o C SPECL x) [\r
+ [`x:real^N`;`vec 0:real^N`]; [`y:real^N`;`vec 0:real^N`]])\r
+ THEN ASM_REWRITE_TAC[VECTOR_MUL_ASSOC;VECTOR_MUL_RCANCEL]\r
+ THEN SUBGOAL_THEN `~(c'= &0)` ASSUME_TAC\r
+ THENL [ ASM_MESON_TAC[VECTOR_MUL_LZERO]; EXISTS_TAC `c/c':real`\r
+ THEN ASM_SIMP_TAC[REAL_DIV_RMUL] ];\r
+ SUBGOAL_TAC "" `~(y=c%y:real^N)` [ASM_MESON_TAC[]]\r
+ THEN EXISTS_TAC `c%y:real^N` \r
+ THEN ASM_REWRITE_TAC[DELETE_INSERT;EMPTY_DELETE]\r
+ THEN MESON_TAC[SUBSPACE_MUL;SUBSET;SPAN_INC;IN_SING;SUBSPACE_SPAN]\r
+ ]);;\r
+\r
+let ORTHOGONAL_DIFFERENT = prove\r
+ (`!x y:real^N. orthogonal x y /\ ~(x=vec 0) /\ ~(y=vec 0) ==> ~(x=y)`,\r
+ REWRITE_TAC[orthogonal] THEN MESON_TAC[DOT_EQ_0]);;\r
+\r
+let ORTHOGONAL_NON_COLLINEAR = prove\r
+ (`!x y:real^N. orthogonal x y /\ ~(x=vec 0) /\ ~(y=vec 0) \r
+ ==> ~(collinear {vec 0,x,y})`,\r
+ REPEAT STRIP_TAC\r
+ THEN SUBGOAL_THEN `independent {x,y:real^N}` ASSUME_TAC THENL [\r
+ MATCH_MP_TAC PAIRWISE_ORTHOGONAL_INDEPENDENT\r
+ THEN REWRITE_TAC[pairwise;IN_INSERT;IN_SING]\r
+ THEN ASM_MESON_TAC[ORTHOGONAL_SYM];\r
+ POP_ASSUM (MP_TAC o REWRITE_RULE[independent])\r
+ THEN REWRITE_TAC[] THEN MATCH_MP_TAC COLLINEAR_DEPENDENT\r
+ THEN ASM_SIMP_TAC[ORTHOGONAL_DIFFERENT]\r
+ ]);;\r
+\r
+(* NORMALIZING VECTORS *)\r
+\r
+let unit = new_definition `unit v = inv(norm v) % v`;;\r
+\r
+let UNIT_THM = prove\r
+ (`!v. ~(v = vec 0) ==> norm(unit v) = &1`,\r
+ SIMP_TAC[unit;NORM_MUL;REAL_ABS_INV;REAL_ABS_NORM;GSYM NORM_EQ_0;\r
+ REAL_MUL_LINV]);;\r
+\r
+let UNIT_INTRO = prove\r
+ (`!v. ~(v = vec 0) ==> v = norm v % unit v`,\r
+ SIMP_TAC[unit;VECTOR_MUL_ASSOC;GSYM NORM_EQ_0;REAL_MUL_RINV;\r
+ VECTOR_MUL_LID]);;\r
+\r
+let UNIT_ELIM = GSYM UNIT_INTRO;;\r
+\r
+let UNIT_ZERO = prove\r
+ (`unit(vec 0) = vec 0`, REWRITE_TAC[unit;VECTOR_MUL_RZERO]);;\r
+\r
+let UNIT_EQ_ZERO = prove\r
+ (`!v. unit v = vec 0 <=> v = vec 0`,\r
+ REWRITE_TAC[unit;VECTOR_MUL_EQ_0;REAL_INV_EQ_0;NORM_EQ_0]);;\r
+\r
+let UNIT_UNIT = prove\r
+ (`!v. ~(v = vec 0) ==> unit (unit v) = unit v`,\r
+ SIMP_TAC[unit;UNIT_THM;REAL_INV_1;VECTOR_MUL_LID]);;\r
+\r
+let UNIT_DOT_UNIT_SELF = prove\r
+ (`!v. ~(v = vec 0) ==> unit v dot unit v = &1`,\r
+ SIMP_TAC[GSYM NORM_EQ_1;UNIT_THM]);;\r
+\r
+let DOT_UNIT_SELF = prove\r
+ (`!v. ~(v=vec 0) ==> v dot unit v = norm v`,\r
+ SIMP_TAC[MESON[UNIT_INTRO] `!v. ~(v = vec 0) ==>\r
+ v dot unit v = (norm v % unit v) dot unit v`;DOT_LMUL;UNIT_DOT_UNIT_SELF;\r
+ REAL_MUL_RID]);;\r
+\r
+let ORTHOGONAL_UNIT = prove\r
+ (`!x y:real^N. (orthogonal x (unit y) <=> orthogonal x y)\r
+ /\ (orthogonal (unit x) y <=> orthogonal x y)`,\r
+ let common h =\r
+ ASM_CASES_TAC h\r
+ THENL [\r
+ RULE_ASSUM_TAC (REWRITE_RULE[NORM_EQ_0]) THEN ASM_REWRITE_TAC[UNIT_ZERO];\r
+ ASM_SIMP_TAC[unit;orthogonal;DOT_RMUL;DOT_LMUL;REAL_ENTIRE;REAL_INV_EQ_0]\r
+ ]\r
+ in\r
+ REPEAT GEN_TAC THEN CONJ_TAC\r
+ THENL [ common `norm (y:real^N) = &0`; common `norm (x:real^N) = &0` ]);;\r
+\r
+let ORTHOGONAL_RUNIT = prove\r
+ (`!x y:real^N. orthogonal x (unit y) <=> orthogonal x y`,\r
+ MESON_TAC[ORTHOGONAL_UNIT]);;\r
+\r
+let ORTHOGONAL_LUNIT = prove\r
+ (`!x y:real^N. orthogonal (unit x) y <=> orthogonal x y`,\r
+ MESON_TAC[ORTHOGONAL_UNIT]);;\r
+\r
+let ORTHOGONAL_LRUNIT = prove\r
+ (`!x y:real^N. orthogonal (unit x) (unit y) <=> orthogonal x y`,\r
+ MESON_TAC[ORTHOGONAL_UNIT]);;\r
+\r
+let COLLINEAR_UNIT = prove\r
+ (`!x y:real^N. collinear {vec 0,x,y} <=> collinear {vec 0,unit x,unit y}`,\r
+ REPEAT (STRIP_TAC ORELSE EQ_TAC) \r
+ THEN ASM_CSQ_THEN (REWRITE_RULE[GSYM IMP_IMP] COLLINEAR_VEC0) \r
+ (STRIP_ASSUME_TAC o REWRITE_RULE[IN_INSERT;IN_SING])\r
+ THEN ASM_CSQ_THEN ~remove:true (MESON[] `(!x. x=a \/ x=b \/ x=c ==> p x) ==>\r
+ p b /\ p c`) STRIP_ASSUME_TAC\r
+ THENL [\r
+ REWRITE_TAC[unit];\r
+ MAP_EVERY ASM_CASES_TAC [`x=vec 0:real^N`;`y=vec 0:real^N`]\r
+ THEN REPEAT (FIRST_X_ASSUM SUBST_VAR_TAC)\r
+ THEN REWRITE_TAC[INSERT_AC;COLLINEAR_SING;COLLINEAR_2]\r
+ THEN SUBGOAL_THEN `collinear {x:real^N, y, vec 0}\r
+ <=> collinear {norm x % unit x, norm y % unit y, vec 0}` \r
+ (SINGLE REWRITE_TAC)\r
+ THENL ON_FIRST_GOAL (ASM_SIMP_TAC[GSYM UNIT_INTRO])\r
+ ]\r
+ THEN REWRITE_TAC[collinear;IN_INSERT;IN_SING]\r
+ THEN EXISTS_TAC `u:real^N` THEN REPEAT STRIP_TAC\r
+ THEN ASM_REWRITE_TAC[VECTOR_MUL_ASSOC;VECTOR_SUB_RZERO;VECTOR_SUB_LZERO;\r
+ VECTOR_NEG_0;GSYM VECTOR_MUL_LNEG;GSYM VECTOR_SUB_RDISTRIB]\r
+ THEN MESON_TAC[VECTOR_MUL_LZERO]);;\r
+\r
+let DOT_RUNIT_POS,DOT_LUNIT_POS = CONJ_PAIR(prove\r
+ (`(!x y. &0 < x dot (unit y) <=> &0 < x dot y)\r
+ /\ (!x y. &0 < (unit x) dot y <=> &0 < x dot y)`,\r
+ REWRITE_TAC[unit;DOT_RMUL;DOT_LMUL;REAL_MUL_POS_LT;REAL_LT_INV_EQ;\r
+ NORM_POS_LT;REWRITE_RULE[REAL_INV_NEG;REAL_NEG_GT0] \r
+ (SPEC `--x:real` REAL_LT_INV_EQ);\r
+ REWRITE_RULE[REWRITE_RULE[MESON[]`(p<=> ~q) <=> (q<=> ~p)`] real_lt] \r
+ NORM_POS_LE]\r
+ THEN MESON_TAC[DOT_RZERO;DOT_LZERO;REAL_LT_REFL]));;\r
+\r
+let DOT_RUNIT_EQ0,DOT_LUNIT_EQ0 = CONJ_PAIR(prove\r
+ (`(!x y. x dot (unit y) = &0 <=> x dot y = &0) \r
+ /\ (!x y. (unit x) dot y = &0 <=> x dot y = &0)`,\r
+ REWRITE_TAC[GSYM orthogonal;ORTHOGONAL_LUNIT;ORTHOGONAL_RUNIT]));;\r
+\r
+let DOT_RUNIT_LT0,DOT_LUNIT_LT0 = CONJ_PAIR(prove\r
+ (`(!x y. x dot (unit y) < &0 <=> x dot y < &0) \r
+ /\ (!x y. (unit x) dot y < &0 <=> x dot y < &0)`,\r
+ REWRITE_TAC[real_lt;MESON[] `(~p <=> ~q) <=> (p <=> q)`] \r
+ THEN REWRITE_TAC[REAL_LE_LT]\r
+ THEN MESON_TAC[DOT_RUNIT_EQ0;DOT_LUNIT_EQ0;DOT_RUNIT_POS;DOT_LUNIT_POS]));;\r
+\r
+let DOT_RUNIT_LE0,DOT_LUNIT_LE0 = CONJ_PAIR(prove\r
+ (`(!x y. x dot (unit y) <= &0 <=> x dot y <= &0)\r
+ /\ (!x y. (unit x) dot y <= &0 <=> x dot y <= &0)`,\r
+ MESON_TAC[REAL_LE_LT;DOT_RUNIT_LT0;DOT_LUNIT_LT0;DOT_RUNIT_EQ0;\r
+ DOT_LUNIT_EQ0]));;\r
+\r
+let DOT_RUNIT_GE0,DOT_LUNIT_GE0 = CONJ_PAIR(prove\r
+ (`(!x y. &0 <= x dot (unit y) <=> &0 <= x dot y)\r
+ /\ (!x y. &0 <= (unit x) dot y <=> &0 <= x dot y)`,\r
+ REWRITE_TAC[REAL_LE_LT]\r
+ THEN MESON_TAC[DOT_RUNIT_POS;DOT_LUNIT_POS;DOT_RUNIT_EQ0;DOT_LUNIT_EQ0]));;\r
+\r
+let DOT_RUNIT_EQ = prove\r
+ (`!x y z:real^N. x dot (unit z) = y dot (unit z) <=> x dot z = y dot z`,\r
+ REPEAT GEN_TAC THEN ASM_CASES_TAC `z=vec 0:real^N`\r
+ THEN ASM_REWRITE_TAC[unit;DOT_RMUL;REAL_EQ_MUL_LCANCEL;REAL_INV_EQ_0;\r
+ NORM_EQ_0;DOT_RZERO]);;\r
+\r
+let DOT_LUNIT_EQ = prove\r
+ (`!x y z:real^N. (unit z) dot x = (unit z) dot y <=> z dot x = z dot y`,\r
+ REPEAT GEN_TAC THEN ASM_CASES_TAC `z=vec 0:real^N`\r
+ THEN ASM_REWRITE_TAC[unit;DOT_LMUL;REAL_EQ_MUL_LCANCEL;REAL_INV_EQ_0;\r
+ NORM_EQ_0;DOT_LZERO]);;\r
+\r
+\r
+(* CONNECTION BETWEEN SPANS AND PLANES *)\r
+\r
+new_type_abbrev("point",`:real^3`);;\r
+new_type_abbrev("plane",`:point->bool`);;\r
+\r
+let PLANE_NON_EMPTY = prove\r
+ (`!p:plane. plane p ==> ~(p={})`,\r
+ REWRITE_TAC[plane;GSYM MEMBER_NOT_EMPTY] THEN REPEAT STRIP_TAC \r
+ THEN EXISTS_TAC `u:point` \r
+ THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC (REWRITE_RULE[SUBSET] HULL_SUBSET) \r
+ THEN SET_TAC[]);;\r
+\r
+let is_plane_basis = new_definition\r
+ `is_plane_basis s p <=>\r
+ ?u v:real^3. s = {u,v} /\ ~(collinear {vec 0,u,v}) /\ !pt:point. pt IN p \r
+ ==> !pt':point. pt' IN p <=> ?a b:real. pt' = pt + a % u + b % v`;;\r
+\r
+(* That theorem is (one of) the last which makes use of the affine definition of `plane` *)\r
+let EXISTS_PLANE_BASIS = prove\r
+ (`!p. plane p ==> ?b. is_plane_basis b p`,\r
+ GEN_TAC\r
+ THEN DISCH_THEN (fun x -> \r
+ STRIP_ASSUME_TAC (REWRITE_RULE[plane;AFFINE_HULL_3] x)\r
+ THEN STRIP_ASSUME_TAC (MATCH_MP (REWRITE_RULE[GSYM MEMBER_NOT_EMPTY] \r
+ PLANE_NON_EMPTY) x))\r
+ THEN POP_ASSUM MP_TAC THEN ASM_REWRITE_TAC[is_plane_basis] THEN DISCH_TAC\r
+ THEN MAP_EVERY EXISTS_TAC [`{v-u,w-u:real^3}`;`v-u:real^3`; `w-u:real^3`]\r
+ THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC \r
+ THENL [\r
+ ASM_MESON_TAC[INSERT_AC;COLLINEAR_3];\r
+ POP_ASSUM MP_TAC THEN REWRITE_TAC[IN_ELIM_THM] THEN REPEAT STRIP_TAC\r
+ THEN EQ_TAC THEN STRIP_TAC\r
+ THENL [\r
+ RULE_ASSUM_TAC (REWRITE_RULE[REAL_ARITH `x+y+z= &1 <=> x= &1-y-z`])\r
+ THEN MAP_EVERY EXISTS_TAC [`v''-v':real`; `w''-w':real`] \r
+ THEN ASM_REWRITE_TAC[] THEN VECTOR_ARITH_TAC;\r
+ MAP_EVERY EXISTS_TAC [`u'-a-b:real`;`v'+a:real`;`w'+b:real`] \r
+ THEN CONJ_TAC\r
+ THENL [\r
+ ASM_ARITH_TAC;\r
+ REPLICATE_TAC 2 (POP_ASSUM MP_TAC) THEN VECTOR_ARITH_TAC]\r
+ ]]);;\r
+\r
+\r
+let BASIS_NON_NULL = prove\r
+ (`!p. plane p ==> !b. is_plane_basis b p ==> !u. u IN b ==> ~(u=vec 0)`,\r
+ REWRITE_TAC[is_plane_basis] THEN REPEAT STRIP_TAC\r
+ THEN SUBGOAL_THEN `(u':real^3) IN {u,v}` MP_TAC\r
+ THENL ON_FIRST_GOAL (ASM_MESON_TAC[])\r
+ THEN REWRITE_TAC[IN_INSERT;IN_SING]\r
+ THEN ASM_MESON_TAC[INSERT_AC;COLLINEAR_2]);;\r
+\r
+let PAIR_SETS_EQ = prove\r
+ (`!x y z t. {x,y} = {z,t} ==> (x=z /\ y=t) \/ (x=t /\ y=z)`,\r
+ SET_TAC[]);;\r
+\r
+let NON_COLLINEAR3_IMPLIES_DIFFERENT = prove\r
+ (`!x y z. ~(collinear {x,y,z}) ==> ~(x=y) /\ ~(y=z) /\ ~(x=z)`,\r
+ MESON_TAC[COLLINEAR_2;INSERT_AC]);;\r
+\r
+let BASIS_DIFFERENT = prove\r
+ (`!p. plane p ==> !u v. is_plane_basis {u,v} p ==> ~(u=v)`,\r
+ REWRITE_TAC[is_plane_basis] THEN REPEAT STRIP_TAC\r
+ THEN ASM_MESON_TAC[PAIR_SETS_EQ;NON_COLLINEAR3_IMPLIES_DIFFERENT]);;\r
+\r
+let UNIT_OF_BASIS_IS_BASIS = prove\r
+ (`!p. plane p ==> !u v. is_plane_basis {u,v} p ==> is_plane_basis {unit u,unit v} p`,\r
+ REPEAT STRIP_TAC THEN REWRITE_TAC[is_plane_basis]\r
+ THEN MAP_EVERY EXISTS_TAC [`unit u:real^3`; `unit v:real^3`]\r
+ THEN REWRITE_TAC[]\r
+ THEN POP_ASSUM \r
+ (DISTRIB [ASSUME_TAC;STRIP_ASSUME_TAC o REWRITE_RULE[is_plane_basis]])\r
+ THEN ASM_REWRITE_TAC[GSYM COLLINEAR_UNIT]\r
+ THEN ASM_CSQ_THEN ~remove:true PAIR_SETS_EQ STRIP_ASSUME_TAC\r
+ THEN REPEAT (FIRST_X_ASSUM SUBST_VAR_TAC)\r
+ THEN ASM_CSQ_THEN BASIS_NON_NULL (C ASM_CSQ_THEN (STRIP_ASSUME_TAC \r
+ o REWRITE_RULE[IN_INSERT;IN_SING;\r
+ MESON[]`(!u. u=a \/ u=b ==> p u) <=> p a /\ p b`]))\r
+ THEN GEN_TAC \r
+ THEN DISCH_THEN (fun x -> FIRST_X_ASSUM (ASSUME_TAC o C MATCH_MP x))\r
+ THEN ASM_REWRITE_TAC[unit;VECTOR_MUL_ASSOC]\r
+ THEN REPEAT (STRIP_TAC ORELSE EQ_TAC) THEN ASM_REWRITE_TAC[]\r
+ THENL [\r
+ MAP_EVERY EXISTS_TAC [`a*norm(u':real^3)`;`b*norm(v':real^3)`] \r
+ THEN RULE_ASSUM_TAC (REWRITE_RULE[GSYM NORM_EQ_0])\r
+ THEN ASM_SIMP_TAC[GSYM REAL_MUL_ASSOC;REAL_MUL_RINV] THEN VECTOR_ARITH_TAC;\r
+ MESON_TAC[];\r
+ MAP_EVERY EXISTS_TAC [`b*norm(v':real^3)`;`a*norm(u':real^3)`] \r
+ THEN RULE_ASSUM_TAC (REWRITE_RULE[GSYM NORM_EQ_0])\r
+ THEN ASM_SIMP_TAC[GSYM REAL_MUL_ASSOC;REAL_MUL_RINV] THEN VECTOR_ARITH_TAC;\r
+ MESON_TAC[VECTOR_ADD_AC];\r
+ ]);;\r
+\r
+(* This theorem makes the connection between the (affine) notion of plane and the (vector) notion of span.\r
+ * From now on, we can generally rely only on this result to reason about the spanning set of a plane.\r
+ *)\r
+let PLANE_AS_SPAN = prove\r
+ (`!p. plane p ==> !b. is_plane_basis b p ==> !pt:point. pt IN p \r
+ ==> p = { pt + y | y IN span b }`,\r
+ REWRITE_TAC[is_plane_basis] THEN REPEAT STRIP_TAC\r
+ THEN ASM_REWRITE_TAC[EXTENSION;IN_ELIM_THM;SPAN_2;UNIV]\r
+ THEN ASM_MESON_TAC[]);;\r
+\r
+let PLANE_SPAN = prove\r
+ (`!p. plane p ==> !b. is_plane_basis b p ==> !pt:point. pt IN p\r
+ ==> { pt' - pt | pt' IN p } = span b`,\r
+ REPEAT STRIP_TAC THEN ASM_CSQ_THEN PLANE_AS_SPAN (C ASM_CSQ_THEN (C\r
+ ASM_CSQ_THEN (SINGLE (GEN_REWRITE_TAC (RATOR_CONV o ONCE_DEPTH_CONV)))))\r
+ THEN REWRITE_TAC[IN_ELIM_THM;EXTENSION] THEN GEN_TAC THEN EQ_TAC\r
+ THENL [\r
+ REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[VECTOR_ARITH `(x + y)-x = y:real^N`];\r
+ DISCH_TAC THEN EXISTS_TAC `x+pt:real^3` THEN REWRITE_TAC (map VECTOR_ARITH\r
+ [`(x + y) - y = x:real^N`; `x+z=z+y <=> x=y:real^N`]) THEN ASM_MESON_TAC[]\r
+ ]);;\r
+\r
+let ALL_BASIS_SAME_SPAN = prove\r
+ (`!p. plane p ==> !b1. is_plane_basis b1 p ==> !b2. is_plane_basis b2 p\r
+ ==> span b1 = span b2`,\r
+ REPEAT STRIP_TAC\r
+ THEN ASM_CSQ_THEN PLANE_SPAN (fun x ->\r
+ ASM_CSQ_THEN ~match_:false (SPEC `b1:real^3->bool` x) ASSUME_TAC\r
+ THEN ASM_CSQ_THEN (SPEC `b2:real^3->bool` x) ASSUME_TAC)\r
+ THEN ASM_MESON_TAC[PLANE_NON_EMPTY;MEMBER_NOT_EMPTY]);;\r
+\r
+let PLANE_SUBSPACE = prove\r
+ (`!p. plane p ==> !pt:point. pt IN p ==> subspace { pt' - pt | pt' IN p }`,\r
+ REPEAT STRIP_TAC THEN ASM_CSQ_THEN EXISTS_PLANE_BASIS STRIP_ASSUME_TAC\r
+ THEN ASM_SIMP_TAC[PLANE_SPAN;SUBSPACE_SPAN]);;\r
+\r
+let PLANE_SING = prove\r
+ (`!x:real^N. ~(plane{x})`,\r
+ REWRITE_TAC[plane;NOT_EXISTS_THM;MESON[] `~(A/\B) <=> (A ==> ~B)`]\r
+ THEN REPEAT STRIP_TAC \r
+ THEN ASM_CSQ_THEN NON_COLLINEAR3_IMPLIES_DIFFERENT ASSUME_TAC\r
+ THEN MATCH_MP_TAC (SET_RULE `~(u=v:real^N) /\ u IN {x} /\ v IN {x} ==> F`) \r
+ THEN ASM_REWRITE_TAC[]\r
+ THEN CONJ_TAC THEN MATCH_MP_TAC HULL_INC THEN SET_TAC[]);;\r
+\r
+let NON_COLLINEAR_INDEPENDENT = prove\r
+ (`!x y:real^N. ~(collinear {vec 0,x,y}) ==> independent{x,y}`,\r
+ MAP_EVERY (SINGLE ONCE_REWRITE_TAC) [independent;CONTRAPOS_THM;NOT_CLAUSES]\r
+ THEN REPEAT GEN_TAC\r
+ THEN ASM_CASES_TAC `x=y:real^N` THENL [\r
+ ASM_REWRITE_TAC[INSERT_AC;COLLINEAR_2];\r
+ REWRITE_TAC[dependent;IN_INSERT;IN_SING] THEN STRIP_TAC THENL\r
+ let common main_var exist_list =\r
+ POP_ASSUM MP_TAC\r
+ THEN ASM_REWRITE_TAC[DELETE_INSERT;EMPTY_DELETE;SPAN_SING;IN_ELIM_THM;\r
+ UNIV]\r
+ THEN STRIP_TAC\r
+ THEN REWRITE_TAC[collinear;IN_INSERT;IN_SING] THEN EXISTS_TAC main_var\r
+ THEN REPEAT STRIP_TAC\r
+ THENL map (fun t ->\r
+ EXISTS_TAC t THEN ASM_REWRITE_TAC[] THEN VECTOR_ARITH_TAC) exist_list\r
+ in\r
+ [ common `y:real^N`\r
+ [`&0`;`--u:real`;`-- &1`;`u:real`;`&0`;`u- &1`;`&1`;`&1-u`;`&0`];\r
+ common `x:real^N`\r
+ [`&0`;`-- &1`;`--u:real`;`&1`;`&0`;`&1-u`;`u:real`;`u- &1`;`&0`]\r
+ ]]);;\r
+\r
+let DIM_OF_PLANE_SPAN = prove\r
+ (`!p:plane. plane p ==> !b. is_plane_basis b p ==> dim (span b) = 2`,\r
+ REWRITE_TAC[is_plane_basis] THEN REPEAT STRIP_TAC \r
+ THEN ASM_CSQ_THEN NON_COLLINEAR_INDEPENDENT ASSUME_TAC\r
+ THEN ASM_CSQ_THEN NON_COLLINEAR3_IMPLIES_DIFFERENT ASSUME_TAC\r
+ THEN SUBGOAL_THEN `{u,v:real^3} HAS_SIZE (dim (span {u,v}))` MP_TAC\r
+ THENL [\r
+ MATCH_MP_TAC BASIS_HAS_SIZE_DIM THEN ASM_REWRITE_TAC[];\r
+ ASM_SIMP_TAC[HAS_SIZE;FINITE_INSERT;FINITE_EMPTY;CARD_CLAUSES;IN_INSERT;\r
+ IN_SING;NOT_IN_EMPTY] THEN ARITH_TAC\r
+ ]);;\r
+\r
+let DIM_OF_PLANE_SUBSPACE = prove\r
+ (`!p. plane p ==> !pt:point. pt IN p ==> dim { pt' - pt | pt' IN p } = 2`,\r
+ MESON_TAC[PLANE_SPAN;DIM_OF_PLANE_SPAN;EXISTS_PLANE_BASIS]);;\r
+\r
+let PLANE_SPAN_DECOMPOS = prove\r
+ (`!p. plane p ==> !u v. is_plane_basis {u,v} p ==>\r
+ !x. x IN span {u,v} <=> ?a b. x = a % u + b % v`,\r
+ REPEAT STRIP_TAC THEN POP_ASSUM (SINGLE REWRITE_TAC o GSYM)\r
+ THEN REWRITE_TAC[SPAN_2;IN_ELIM_THM;UNIV]);;\r
+\r
+let units = new_definition `units = { x | norm x = &1 }`;;\r
+\r
+let IN_UNITS = prove\r
+ (`!x. x IN units ==> norm x = &1`,\r
+ REWRITE_TAC[units;IN_ELIM_THM]);;\r
+\r
+let is_normal_to_plane = new_definition\r
+ `is_normal_to_plane (n:real^3) (p:plane) <=> ~(n=vec 0)\r
+ /\ !b. is_plane_basis b p ==> !v. v IN (span b) ==> orthogonal v n`;;\r
+\r
+let IS_NORMAL_TO_PLANE_UNIT = prove\r
+ (`!p n. is_normal_to_plane (unit n) p <=> is_normal_to_plane n p`,\r
+ REWRITE_TAC[is_normal_to_plane;ORTHOGONAL_RUNIT;UNIT_EQ_ZERO]);;\r
+\r
+let EXISTS_NORMAL_OF_PLANE = prove\r
+ (`!p:plane. plane p ==> ?n:real^3. is_normal_to_plane n p`,\r
+ REWRITE_TAC[is_normal_to_plane] THEN REPEAT STRIP_TAC\r
+ THEN ASM_CSQ_THEN EXISTS_PLANE_BASIS (CHOOSE_THEN (fun x ->\r
+ MAP_EVERY STRIP_ASSUME_TAC [x;REWRITE_RULE[is_plane_basis] x]))\r
+ THEN EXISTS_TAC `u cross v` THEN ASM_REWRITE_TAC[CROSS_EQ_0] \r
+ THEN REPEAT STRIP_TAC THEN POP_ASSUM MP_TAC\r
+ THEN ASM_CSQ_THEN ALL_BASIS_SAME_SPAN (C (ASM_CSQ_THEN ~remove:true) (C\r
+ ASM_CSQ_THEN (SINGLE REWRITE_TAC))) \r
+ THEN ASM_REWRITE_TAC[SPAN_2;IN_ELIM_THM;UNIV]\r
+ THEN REPEAT STRIP_TAC\r
+ THEN ASM_REWRITE_TAC[orthogonal;DOT_LADD;DOT_LMUL;DOT_CROSS_SELF]\r
+ THEN SIMPLE_COMPLEX_ARITH_TAC);;\r
+\r
+let NORMAL_OF_PLANE_IS_NORMAL_TO_BASIS = prove\r
+ (`!p. plane p ==> !b. is_plane_basis b p ==> !u. u IN b ==>\r
+ !n. is_normal_to_plane n p ==> orthogonal u n`,\r
+ MESON_TAC[is_normal_to_plane;SPAN_SUPERSET;]);;\r
+\r
+let NORMAL_OF_PLANE_NON_NULL = prove\r
+ (`!p. plane p ==> !n. is_normal_to_plane n p ==> ~(n=vec 0)`,\r
+ MESON_TAC[is_normal_to_plane]);;\r
+\r
+let NORMAL_OF_PLANE_IS_ORTHOGONAL_TO_SEGMENT = prove\r
+ (`!p. plane p ==> !n. is_normal_to_plane n p \r
+ ==> !pt1 pt2. pt1 IN p /\ pt2 IN p ==> orthogonal (pt1-pt2) n`,\r
+ REWRITE_TAC[is_normal_to_plane] THEN REPEAT STRIP_TAC \r
+ THEN ASM_CSQ_THEN EXISTS_PLANE_BASIS STRIP_ASSUME_TAC\r
+ THEN POP_ASSUM\r
+ (fun x -> FIRST_X_ASSUM (MATCH_MP_TAC o C MATCH_MP x) THEN ASSUME_TAC x)\r
+ THEN FIRST_X_ASSUM (STRIP_ASSUME_TAC o CONV_RULE (REWR_CONV is_plane_basis))\r
+ THEN POP_ASSUM (C (ASM_CSQ_THEN ~remove:true) (fun x -> \r
+ FIRST_X_ASSUM (STRIP_ASSUME_TAC o CONV_RULE (REWR_CONV x))))\r
+ THEN ASM_REWRITE_TAC[SPAN_2;UNIV;IN_ELIM_THM;VECTOR_ARITH\r
+ `(x+y+z)-x = y+z:real^N`]\r
+ THEN MESON_TAC[]);;\r
+\r
+let DIM_OF_NORMAL_SPAN = prove\r
+ (`!p:plane. plane p ==> !n. is_normal_to_plane n p ==> dim (span {n}) = 1`,\r
+ REWRITE_TAC[is_normal_to_plane] THEN REPEAT STRIP_TAC \r
+ THEN SUBGOAL_THEN `{n:real^3} HAS_SIZE dim (span {n})` MP_TAC \r
+ THENL [\r
+ MATCH_MP_TAC BASIS_HAS_SIZE_DIM \r
+ THEN REWRITE_TAC[independent;dependent;NOT_EXISTS_THM;\r
+ MESON[] `~(p/\q) <=> p ==> ~q`;IN_SING]\r
+ THEN GEN_TAC THEN DISCH_TAC\r
+ THEN ASM_REWRITE_TAC[DELETE_INSERT;EMPTY_DELETE;SPAN_EMPTY;IN_SING];\r
+ ASM_SIMP_TAC[HAS_SIZE;FINITE_INSERT;FINITE_EMPTY;CARD_CLAUSES;IN_INSERT;\r
+ IN_SING;NOT_IN_EMPTY]\r
+ THEN ARITH_TAC]);;\r
+\r
+let DIM_OF_ORTHOGONAL = prove\r
+ (`!p. plane p ==> !b. is_plane_basis b p \r
+ ==> dim {z:real^3 | !x. x IN span b ==> orthogonal z x} = 1`,\r
+ REPEAT STRIP_TAC\r
+ THEN SUBGOAL_THEN\r
+ `(:real^3) = { x+y \r
+ | x IN span b /\ y IN {z:real^3 | !x. x IN span b ==> orthogonal z x}}`\r
+ (ASSUME_TAC o REWRITE_RULE[DIM_UNIV;DIMINDEX_3] o \r
+ AP_TERM `dim:(real^3->bool)->num`) \r
+ THENL ON_FIRST_GOAL \r
+ (REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ;SUBSET;UNIV;IN;IN_ELIM_THM] \r
+ THEN MESON_TAC[ORTHOGONAL_SUBSPACE_DECOMP_EXISTS;IN])\r
+ THEN SUBGOAL_THEN\r
+ `span b\r
+ INTER {z:real^3 | !x. x IN span b ==> orthogonal z x} SUBSET {vec 0}` \r
+ (ASSUME_TAC o GSYM o REWRITE_RULE[GSYM DIM_EQ_0])\r
+ THENL ON_FIRST_GOAL \r
+ (REWRITE_TAC[INTER;SUBSET;IN_SING;IN_ELIM_THM]\r
+ THEN MESON_TAC[ORTHOGONAL_REFL])\r
+ THEN ASM_CSQ_THEN DIM_OF_PLANE_SPAN (fun x ->\r
+ ASM_SIMP_TAC[ARITH_RULE `x=1 <=> 3+0=2+x`;GSYM x])\r
+ THEN MATCH_MP_TAC DIM_SUMS_INTER\r
+ THEN REWRITE_TAC[SUBSPACE_ORTHOGONAL_TO_VECTORS;ORTHOGONAL_SYM;\r
+ SUBSPACE_SPAN]\r
+ );;\r
+\r
+let NORMAL_SPAN_SUBSET_ORTHOGONAL_SUBSPACE = prove\r
+ (`!p. plane p ==> !b. is_plane_basis b p ==> !n. is_normal_to_plane n p \r
+ ==> span {n} SUBSET {z:real^3 | !x. x IN span b ==> orthogonal z x}`,\r
+ REWRITE_TAC[is_normal_to_plane] THEN REPEAT STRIP_TAC \r
+ THEN POP_ASSUM (C ASM_CSQ_THEN ASSUME_TAC)\r
+ THEN REWRITE_TAC[SUBSET;SPAN_SING;IN_ELIM_THM;UNIV] \r
+ THEN ASM_MESON_TAC[ORTHOGONAL_CLAUSES;ORTHOGONAL_SYM]);;\r
+\r
+let ORTHOGONAL_SUBSPACE_IS_NORMAL_SPAN = prove\r
+ (`!p. plane p ==> !b. is_plane_basis b p ==> !n. is_normal_to_plane n p \r
+ ==> {z:real^3 | !x. x IN span b ==> orthogonal z x} = span {n}`,\r
+ MAP_EVERY (SINGLE ONCE_REWRITE_TAC) [\r
+ ORTHOGONAL_SYM; MESON[SPAN_SPAN] `span{x}=span(span{x})`; \r
+ GSYM (REWRITE_RULE[GSYM SPAN_EQ_SELF] SUBSPACE_ORTHOGONAL_TO_VECTORS)]\r
+ THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC EQ_SYM \r
+ THEN MATCH_MP_TAC DIM_EQ_SPAN THEN ONCE_REWRITE_TAC[ORTHOGONAL_SYM]\r
+ THEN CONJ_TAC\r
+ THENL ON_FIRST_GOAL (ASM_MESON_TAC[NORMAL_SPAN_SUBSET_ORTHOGONAL_SUBSPACE])\r
+ THEN MAP_EVERY (fun x ->\r
+ ASM_CSQ_THEN x (C ASM_CSQ_THEN (SINGLE REWRITE_TAC))) \r
+ [DIM_OF_ORTHOGONAL;DIM_OF_NORMAL_SPAN]\r
+ THEN ARITH_TAC);;\r
+\r
+let PLANE_DECOMP = prove\r
+ (`!p. plane p ==> !b. is_plane_basis b p ==> !n. is_normal_to_plane n p \r
+ ==> !v. ?w x. v = w + x % n /\ w IN span b`,\r
+ REPEAT STRIP_TAC \r
+ THEN MP_TAC (ISPEC `b:real^3->bool` ORTHOGONAL_SUBSPACE_DECOMP)\r
+ THEN ASM_CSQ_THEN ORTHOGONAL_SUBSPACE_IS_NORMAL_SPAN \r
+ (C ASM_CSQ_THEN (C ASM_CSQ_THEN (SINGLE REWRITE_TAC)))\r
+ THEN REWRITE_TAC[SPAN_SING;IN_ELIM_THM;EXISTS_UNIQUE_DEF;EXISTS_PAIRED_THM]\r
+ THEN MESON_TAC[]);;\r
+\r
+let NORMAL_ORTHOGONAL_IN_PLANE_SPAN = prove\r
+ (`!p. plane p ==> !b. is_plane_basis b p ==> !n. is_normal_to_plane n p \r
+ ==> !v. orthogonal v n <=> v IN span b`,\r
+ let EQ_IMPLY =\r
+ MATCH_MP (MESON[] `(!x y. p x y <=> q x y) ==> (!x y. p x y ==> q x y)`)\r
+ in\r
+ REPEAT STRIP_TAC\r
+ THEN ASM_CSQ_THEN PLANE_DECOMP (C ASM_CSQ_THEN (C ASM_CSQ_THEN \r
+ (STRIP_ASSUME_TAC o SPEC `v:real^3`)))\r
+ THEN ASM_CSQ_THEN (EQ_IMPLY is_normal_to_plane) STRIP_ASSUME_TAC \r
+ THEN POP_ASSUM (C ASM_CSQ_THEN ASSUME_TAC) THEN EQ_TAC THEN ASM_REWRITE_TAC[]\r
+ THEN ASM_CSQ_THEN (EQ_IMPLY is_plane_basis) STRIP_ASSUME_TAC \r
+ THEN RULE_ASSUM_TAC (REWRITE_RULE[orthogonal])\r
+ THEN ASM_SIMP_TAC[orthogonal;DOT_LADD;DOT_LMUL;REAL_ADD_LID;REAL_ENTIRE;\r
+ DOT_EQ_0;VECTOR_MUL_LZERO;VECTOR_ADD_RID] THEN ASM_MESON_TAC[]);;\r
+\r
+let PLANE_DECOMP_DOT_NORMAL = prove\r
+ (`!p. plane p ==> !b. is_plane_basis b p ==> !n. is_normal_to_plane n p\r
+ ==> !v. ?w. w IN span b /\ v = w + (v dot (unit n)) % (unit n)`,\r
+ REPEAT STRIP_TAC\r
+ THEN FIRST_ASSUM (ASSUME_TAC o CONJUNCT1 o CONV_RULE (REWR_CONV \r
+ is_normal_to_plane))\r
+ THEN ASM_CSQ_THEN (GSYM NORMAL_ORTHOGONAL_IN_PLANE_SPAN) (C ASM_CSQ_THEN \r
+ (C ASM_CSQ_THEN ASSUME_TAC))\r
+ THEN EXISTS_TAC `v - (v dot unit n) % unit n :real^3` \r
+ THEN ASM_REWRITE_TAC[VECTOR_ARITH `x=x-y+z <=> y=z:real^N`] \r
+ THEN ONCE_REWRITE_TAC[GSYM ORTHOGONAL_RUNIT]\r
+ THEN REWRITE_TAC[orthogonal;DOT_LSUB;DOT_LMUL] \r
+ THEN ASM_MESON_TAC[UNIT_DOT_UNIT_SELF;REAL_MUL_RID;REAL_SUB_0]);;\r
+\r
+let SUB_UNIT_NORMAL_IS_ORTHOGONAL_TO_NORMAL = prove\r
+ (`!p. plane p ==> !n. is_normal_to_plane n p \r
+ ==> !x. orthogonal (x - (x dot unit n) % unit n) n`,\r
+ REPEAT STRIP_TAC THEN ASM_CSQ_THEN EXISTS_PLANE_BASIS STRIP_ASSUME_TAC\r
+ THEN ASM_CSQ_THEN PLANE_DECOMP_DOT_NORMAL \r
+ (C ASM_CSQ_THEN (C ASM_CSQ_THEN ASSUME_TAC))\r
+ THEN RULE_ASSUM_TAC (REWRITE_RULE[VECTOR_ARITH `x=y+z <=> x-z=y`]) \r
+ THEN ASM_MESON_TAC[NORMAL_ORTHOGONAL_IN_PLANE_SPAN]);;\r
+\r
+let is_orthogonal_plane_basis = new_definition\r
+ `is_orthogonal_plane_basis b p \r
+ <=> is_plane_basis b p /\ pairwise orthogonal b`;;\r
+\r
+let EXISTS_ORTHOGONAL_PLANE_BASIS = prove\r
+ (`!p. plane p ==> ?b. is_orthogonal_plane_basis b p`,\r
+ REWRITE_TAC[is_orthogonal_plane_basis;is_plane_basis] THEN REPEAT STRIP_TAC\r
+ THEN ASM_CSQ_THEN EXISTS_PLANE_BASIS (CHOOSE_THEN (fun x -> ASSUME_TAC x\r
+ THEN STRIP_ASSUME_TAC (REWRITE_RULE[is_plane_basis] x)))\r
+ THEN ASM_CSQ_THEN EXISTS_NORMAL_OF_PLANE (CHOOSE_THEN (fun x ->\r
+ let x' = REWRITE_RULE[is_normal_to_plane] x in\r
+ ASSUME_TAC x THEN ASM_CSQ_THEN (CONJUNCT2 x') ASSUME_TAC\r
+ THEN ASSUME_TAC (CONJUNCT1 x')))\r
+ THEN SUBGOAL_TAC "" `~((u:real^3)=vec 0)` [ASM SET_TAC[BASIS_NON_NULL]]\r
+ THEN SUBGOAL_TAC "" `orthogonal u (n:real^3)` [\r
+ FIRST_ASSUM MATCH_MP_TAC THEN MATCH_MP_TAC SPAN_SUPERSET \r
+ THEN ASM SET_TAC [SPAN_SUPERSET]\r
+ ]\r
+ THEN SUBGOAL_TAC "" `~(u cross n = vec 0)` [\r
+ ASM_SIMP_TAC[CROSS_EQ_0;ORTHOGONAL_NON_COLLINEAR] ]\r
+ THEN EXISTS_TAC `{u, u cross n}` THEN CONJ_TAC \r
+ THENL [\r
+ MAP_EVERY EXISTS_TAC [`u:real^3`;`u cross n`] THEN REWRITE_TAC[] \r
+ THEN CONJ_TAC THENL ON_FIRST_GOAL \r
+ (MATCH_MP_TAC ORTHOGONAL_NON_COLLINEAR \r
+ THEN ASM_REWRITE_TAC[orthogonal;DOT_CROSS_SELF])\r
+ THEN SUBGOAL_THEN `?a b. u cross n = a % u + b % v` STRIP_ASSUME_TAC \r
+ THENL ON_FIRST_GOAL\r
+ (ASM_MESON_TAC[GSYM PLANE_SPAN_DECOMPOS;\r
+ GSYM NORMAL_ORTHOGONAL_IN_PLANE_SPAN;orthogonal;DOT_CROSS_SELF])\r
+ THEN SUBGOAL_THEN `~(b'= &0)` (fun x -> POP_ASSUM MP_TAC THEN ASSUME_TAC x) \r
+ THENL ON_FIRST_GOAL \r
+ (ASM_CASES_TAC `a= &0` THENL [\r
+ ASM_MESON_TAC[VECTOR_MUL_LZERO;VECTOR_ADD_LID];\r
+ DISCH_THEN (fun x -> POP_ASSUM (fun y -> POP_ASSUM (MP_TAC \r
+ o REWRITE_RULE[x;VECTOR_MUL_LZERO;VECTOR_ADD_RID]) \r
+ THEN ASSUME_TAC y))\r
+ THEN DISCH_THEN (MP_TAC o AP_TERM `(dot) (u:real^3)`) \r
+ THEN REWRITE_TAC[DOT_CROSS_SELF;DOT_RMUL] \r
+ THEN ONCE_REWRITE_TAC[EQ_SYM_EQ]\r
+ THEN ASM_REWRITE_TAC[REAL_ENTIRE;DOT_EQ_0]\r
+ ])\r
+ THEN DISCH_THEN (fun x ->\r
+ ASM_SIMP_TAC[x;VECTOR_ARITH `a%x+b%(c%x+d%y)=(a+b*c)%x+(b*d)%y`])\r
+ THEN REPEAT STRIP_TAC THEN EQ_TAC THENL [\r
+ REPEAT STRIP_TAC \r
+ THEN MAP_EVERY EXISTS_TAC [`a'-b''/b'*a:real`;`b''/b':real`]\r
+ THEN ASM_SIMP_TAC[REAL_SUB_ADD;VECTOR_ARITH `x+y=x+z <=> y=z`;\r
+ REAL_DIV_RMUL];\r
+ MESON_TAC[];\r
+ ];\r
+ REWRITE_TAC[pairwise;orthogonal] THEN SET_TAC [DOT_CROSS_SELF]\r
+ ]);;\r
+\r
+let ORTHOGONAL_PLANE_BASIS_AS_PAIR = prove\r
+ (`!b p. is_orthogonal_plane_basis b p ==> ?u v. is_orthogonal_plane_basis {u,v} p`,\r
+ MESON_TAC[is_orthogonal_plane_basis;is_plane_basis]);;\r
+\r
+let BASIS_OF_PLANE_ORTHONORMAL_DECOMPOS = prove\r
+ (`!p. plane p ==> !u v. is_orthogonal_plane_basis {u,v} p ==>\r
+ !x. x IN span {u,v}\r
+ <=> x = (x dot unit u) % unit u + (x dot unit v) % unit v`,\r
+ REWRITE_TAC [is_orthogonal_plane_basis] THEN REPEAT STRIP_TAC\r
+ THEN ASM_CSQ_THEN PLANE_SPAN_DECOMPOS (C ASM_CSQ_THEN (SINGLE REWRITE_TAC))\r
+ THEN EQ_TAC THENL [\r
+ REPEAT STRIP_TAC\r
+ THEN SUBGOAL_TAC "" `~(u = vec 0:real^3) /\ ~(v = vec 0:real^3)` \r
+ [ASM_MESON_TAC[BASIS_NON_NULL;IN_INSERT]]\r
+ THEN SUBGOAL_THEN\r
+ `orthogonal (u:real^3) (unit v) /\ orthogonal v (unit u)` \r
+ (ASSUME_TAC o REWRITE_RULE[orthogonal]) \r
+ THENL ON_FIRST_GOAL \r
+ (RULE_ASSUM_TAC (REWRITE_RULE[pairwise;orthogonal])\r
+ THEN REWRITE_TAC[ORTHOGONAL_UNIT;orthogonal]\r
+ THEN SUBGOAL_TAC "" `~(u=v:real^3)` [ASM_MESON_TAC[BASIS_DIFFERENT]]\r
+ THEN CONJ_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN ASSUM_LIST SET_TAC)\r
+ THEN ASM_SIMP_TAC[DOT_LADD;DOT_LMUL;REAL_MUL_RZERO;REAL_ADD_RID;\r
+ REAL_ADD_LID;DOT_UNIT_SELF;GSYM VECTOR_MUL_ASSOC;GSYM UNIT_INTRO];\r
+ REWRITE_TAC[unit;VECTOR_MUL_ASSOC] THEN MESON_TAC[]\r
+ ]);;\r
+\r
+let PLANE_DECOMP_DOT = prove\r
+ (`!p:plane. plane p ==> !u v. is_orthogonal_plane_basis {u,v} p \r
+ ==> !n. is_normal_to_plane n p ==> !x:real^3.\r
+ x = (x dot unit u) % unit u + (x dot unit v) % unit v\r
+ + (x dot unit n) % unit n`,\r
+ REPEAT STRIP_TAC\r
+ THEN FIRST_ASSUM (STRIP_ASSUME_TAC o CONV_RULE (REWR_CONV \r
+ is_orthogonal_plane_basis))\r
+ THEN ASM_CSQ_THEN PLANE_DECOMP_DOT_NORMAL \r
+ (C ASM_CSQ_THEN (C ASM_CSQ_THEN (STRIP_ASSUME_TAC o SPEC `x:real^3`)))\r
+ THEN SUBGOAL_THEN\r
+ `(x:real^3) dot unit u = w dot unit u /\ x dot unit v = w dot unit v`\r
+ ASSUME_TAC\r
+ THENL ON_FIRST_GOAL\r
+ begin\r
+ SUBGOAL_THEN `(u:real^3) IN {u,v} /\ v IN {u,v}` STRIP_ASSUME_TAC \r
+ THENL ON_FIRST_GOAL (ASSUM_LIST SET_TAC)\r
+ THEN ASM_CSQ_THEN NORMAL_OF_PLANE_IS_NORMAL_TO_BASIS \r
+ (C ASM_CSQ_THEN ASSUME_TAC)\r
+ THEN POP_ASSUM (fun x -> ASM_CSQ_THEN ~remove:true x \r
+ (C ASM_CSQ_THEN ASSUME_TAC) \r
+ THEN ASM_CSQ_THEN x (C ASM_CSQ_THEN ASSUME_TAC))\r
+ THEN RULE_ASSUM_TAC (REWRITE_RULE[orthogonal] \r
+ o ONCE_REWRITE_RULE[GSYM ORTHOGONAL_LRUNIT]\r
+ o ONCE_REWRITE_RULE[ORTHOGONAL_SYM])\r
+ THEN ASM ONCE_REWRITE_TAC[]\r
+ THEN ASM_REWRITE_TAC[DOT_LADD;DOT_LMUL;REAL_MUL_RZERO;REAL_ADD_RID]\r
+ end\r
+ THEN ASM_CSQ_THEN (REWRITE_RULE[GSYM IMP_IMP] \r
+ BASIS_OF_PLANE_ORTHONORMAL_DECOMPOS) (C ASM_CSQ_THEN (ASSUME_TAC\r
+ o SPEC `w:real^3`))\r
+ THEN ASSUM_LIST (GEN_REWRITE_TAC (RATOR_CONV o DEPTH_CONV))\r
+ THEN ASM_REWRITE_TAC[VECTOR_ARITH `x+y=z+t+y <=> x=z+t`]\r
+ THEN ASM_MESON_TAC[]);;\r
+\r
+let UNIT_OF_ORTHOGONAL_BASIS_IS_ORTHOGONAL_BASIS = prove\r
+ (`!p. plane p ==> !u v. is_orthogonal_plane_basis {u,v} p \r
+ ==> is_orthogonal_plane_basis {unit u,unit v} p`,\r
+ SIMP_TAC[is_orthogonal_plane_basis;UNIT_OF_BASIS_IS_BASIS;pairwise;IN_INSERT;\r
+ IN_SING]\r
+ THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]\r
+ THEN ASM_MESON_TAC[ORTHOGONAL_LRUNIT]);;\r
+\r
+let EXISTS_UNIT_ORTHOGONAL_PLANE_BASIS = prove\r
+ (`!p. plane p ==> ?u v. is_orthogonal_plane_basis {unit u,unit v} p`,\r
+ REPEAT STRIP_TAC\r
+ THEN ASM_CSQ_THEN EXISTS_ORTHOGONAL_PLANE_BASIS (CHOOSE_THEN\r
+ (DISTRIB (map (fun xs -> STRIP_ASSUME_TAC o REWRITE_RULE xs) [\r
+ [];\r
+ [is_orthogonal_plane_basis];\r
+ [is_orthogonal_plane_basis;is_plane_basis]])))\r
+ THEN FIRST_X_ASSUM SUBST_VAR_TAC \r
+ THEN ASM_MESON_TAC[UNIT_OF_ORTHOGONAL_BASIS_IS_ORTHOGONAL_BASIS]);;\r
+\r
+let FORALL_PLANE_THM = prove\r
+ (`!p. plane p ==>\r
+ ?u v. is_orthogonal_plane_basis {unit u,unit v} p /\ !P pt0. pt0 IN p \r
+ ==> ((!pt. pt IN p ==> P pt)\r
+ <=> (!a b. P (pt0 + a % unit u + b % unit v)))`,\r
+ REPEAT STRIP_TAC \r
+ THEN ASM_CSQ_THEN EXISTS_UNIT_ORTHOGONAL_PLANE_BASIS (CHOOSE_THEN \r
+ (CHOOSE_THEN (DISTRIB (map (fun xs -> STRIP_ASSUME_TAC o REWRITE_RULE xs) [\r
+ [];\r
+ [is_orthogonal_plane_basis];\r
+ [is_orthogonal_plane_basis;is_plane_basis]]))))\r
+ THEN MAP_EVERY EXISTS_TAC [`u:real^3`;`v:real^3`]\r
+ THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC\r
+ THEN ASM_CSQ_THEN PAIR_SETS_EQ STRIP_ASSUME_TAC\r
+ THEN REPEAT (FIRST_X_ASSUM SUBST_VAR_TAC)\r
+ THEN ASM_CSQ_THEN PLANE_AS_SPAN (C ASM_CSQ_THEN (C ASM_CSQ_THEN (ASSUME_TAC\r
+ o REWRITE_RULE[SPAN_2;UNIV;IN_ELIM_THM]))) \r
+ THEN ASSUM_LIST SET_TAC);;\r
+\r
+let FORALL_PLANE_THM_2 = prove\r
+ (`!p. plane p ==>\r
+ ?u v pt0. is_orthogonal_plane_basis {unit u,unit v} p /\ pt0 IN p\r
+ /\ !P. (!pt. pt IN p ==> P pt)\r
+ <=> (!a b. P (pt0 + a % unit u + b % unit v))`,\r
+ REPEAT STRIP_TAC THEN ASM_CSQ_THEN FORALL_PLANE_THM STRIP_ASSUME_TAC\r
+ THEN ASM_CSQ_THEN PLANE_NON_EMPTY (STRIP_ASSUME_TAC o REWRITE_RULE[GSYM MEMBER_NOT_EMPTY]) THEN ASM_MESON_TAC[]);;\r
+\r
+(** Is u the projection of v on the hyperplane represented by the non-null vector w? *)\r
+let is_projection_on_hyperplane = new_definition\r
+ `is_projection_on_hyperplane u v (w:real^N)\r
+ <=> norm w = &1 ==> u = v - (v dot w) % w`;;\r
+\r
+let projection_on_hyperplane = new_definition\r
+ `projection_on_hyperplane v w = @u. is_projection_on_hyperplane u v w`;;\r
+\r
+let PROJECTION_ON_HYPERPLANE_THM = prove\r
+ (`!v w. norm w = &1 \r
+ ==> projection_on_hyperplane v w = v - (v dot w) % w`,\r
+ REWRITE_TAC[projection_on_hyperplane;is_projection_on_hyperplane]\r
+ THEN SELECT_ELIM_TAC THEN MESON_TAC[]);;\r
+\r
+let PROJECTION_ON_HYPERPLANE_THM_LNEG = prove\r
+ (`!v w. norm w = &1 \r
+ ==> projection_on_hyperplane (--v) w = --(projection_on_hyperplane v w)`,\r
+ SIMP_TAC[PROJECTION_ON_HYPERPLANE_THM;VECTOR_NEG_SUB;DOT_LNEG;\r
+ VECTOR_MUL_LNEG]\r
+ THEN REPEAT STRIP_TAC THEN VECTOR_ARITH_TAC);;\r
+\r
+let PROJECTION_ON_HYPERPLANE_DECOMPOS = prove\r
+ (`!v w. norm w = &1 ==> projection_on_hyperplane v w + (v dot w) % w = v`, \r
+ SIMP_TAC[projection_on_hyperplane;is_projection_on_hyperplane]\r
+ THEN REPEAT STRIP_TAC THEN VECTOR_ARITH_TAC);;\r
+\r
+let symetric_vectors_wrt = new_definition\r
+ `symetric_vectors_wrt u v (w:real^3) \r
+ <=> norm w = &1 ==> u + v = (&2 * u dot w) % w`;;\r
+\r
+let SYMETRIC_VECTORS_WRT_SYM = prove\r
+ (`!u v w. symetric_vectors_wrt u v w <=> symetric_vectors_wrt v u w`,\r
+ REWRITE_TAC[symetric_vectors_wrt] THEN REPEAT GEN_TAC THEN EQ_TAC\r
+ THEN DISCH_THEN (fun x -> DISCH_THEN (DISTRIB (map ((o) ASSUME_TAC)\r
+ [MP x; REWRITE_RULE[NORM_EQ_1]])))\r
+ THEN ASSUM_LIST (GEN_REWRITE_TAC (RAND_CONV o DEPTH_CONV)\r
+ o map (REWRITE_RULE[VECTOR_ARITH `x+y=z <=> y=z-x:real^N`]))\r
+ THEN ASM_REWRITE_TAC[DOT_LSUB;DOT_LMUL;REAL_ARITH `(&2 * x) * &1 - x = x`]\r
+ THEN ONCE_REWRITE_TAC[VECTOR_ADD_SYM] THEN ASM_REWRITE_TAC[]);;\r
+\r
+let SYMETRIC_VECTORS_PROJECTION_ON_HYPERPLANE = prove\r
+ (`!u v w. norm w = &1 ==> symetric_vectors_wrt u v w \r
+ ==> --(projection_on_hyperplane v w) = projection_on_hyperplane u w`,\r
+ ONCE_REWRITE_TAC[MATCH_MP (MESON[] `(p <=> q) ==> (p <=> p /\ q)`) \r
+ (SPEC_ALL SYMETRIC_VECTORS_WRT_SYM)]\r
+ THEN SIMP_TAC[symetric_vectors_wrt;projection_on_hyperplane;\r
+ is_projection_on_hyperplane;\r
+ VECTOR_ARITH `x = (&2 * y) % z <=> y%z = inv(&2) % x`]\r
+ THEN REPEAT STRIP_TAC THEN VECTOR_ARITH_TAC);;\r
+\r
+let SYMETRIC_VECTORS_PROJECTION_ON_AXIS = prove\r
+ (`!u v w. norm w = &1 ==> symetric_vectors_wrt u v w ==> u dot w = v dot w`,\r
+ REPEAT STRIP_TAC\r
+ THEN ASM_CSQ_THEN (GEQ_IMP SYMETRIC_VECTORS_WRT_SYM) ASSUME_TAC \r
+ THEN REPEAT (POP_ASSUM MP_TAC) THEN SIMP_TAC[symetric_vectors_wrt]\r
+ THEN REWRITE_TAC[IMP_IMP;GSYM CONJ_ASSOC;REAL_EQ_MUL_LCANCEL;\r
+ VECTOR_ARITH `u+v=w /\ v+u=x <=> u+v=x /\ x=w`;VECTOR_MUL_RCANCEL]\r
+ THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC[DOT_RZERO] THEN POP_ASSUM MP_TAC\r
+ THEN REAL_ARITH_TAC);;\r
+\r
+\r
+(** Additions to affine spaces *)\r
+\r
+let AFFINE_HULL_3_ZERO = prove\r
+ (`affine hull {vec 0, a, b} = {u % a + v % b | u IN (:real) /\ v IN(:real)}`,\r
+ REWRITE_TAC[AFFINE_HULL_3;UNIV;EXTENSION;IN_ELIM_THM;VECTOR_MUL_RZERO;\r
+ VECTOR_ADD_LID;REAL_ARITH `x+y+z=t <=> x=t-y-z:real`]\r
+ THEN MESON_TAC[]);;\r
+\r
+let LSUB_PLANE_EQ_RSUB_PLANE = prove\r
+ (`!p:plane. plane p ==> !x. x IN p ==> {y - x | y IN p} = {x - y | y IN p}`,\r
+ let COMMON_TAC t =\r
+ EXISTS_TAC t THEN CONJ_TAC THEN TRY VECTOR_ARITH_TAC\r
+ THEN SUBGOAL_TAC "" `(x':real^3) IN span b` [ASM SET_TAC []]\r
+ in\r
+ REWRITE_TAC[GSPEC;SETSPEC;FUN_EQ_THM] THEN REPEAT STRIP_TAC\r
+ THEN ASM_CSQ_THEN EXISTS_PLANE_BASIS STRIP_ASSUME_TAC\r
+ THEN ASM_CSQS_THEN PLANE_AS_SPAN ASSUME_TAC THEN EQ_TAC THENL [\r
+ ASM_CSQS_THEN PLANE_SPAN ASSUME_TAC THEN STRIP_TAC \r
+ THEN COMMON_TAC `x-x':point` THEN REWRITE_TAC[VECTOR_SUB]\r
+ THEN POP_ASSUM (ASSUME_TAC o MATCH_MP SPAN_NEG) \r
+ THEN ASSUM_LIST (FIRST o List.rev_map (CHANGED_TAC o SINGLE REWRITE_TAC)) \r
+ THEN ASSUM_LIST SET_TAC;\r
+ STRIP_TAC THEN ASM_CSQS_THEN PLANE_SPAN ASSUME_TAC \r
+ THEN COMMON_TAC `x+x':point` THEN ASSUM_LIST SET_TAC]);;\r
+\r
+let EXISTS_MULTIPLE_OF_NORMAL_IN_PLANE = prove\r
+ (`!p:plane. plane p ==> !n. is_normal_to_plane n p ==> ?a. a % unit n IN p`,\r
+ REPEAT STRIP_TAC\r
+ THEN ASM_CSQ_THEN PLANE_NON_EMPTY (STRIP_ASSUME_TAC \r
+ o REWRITE_RULE[GSYM MEMBER_NOT_EMPTY])\r
+ THEN ASM_CSQ_THEN EXISTS_PLANE_BASIS STRIP_ASSUME_TAC\r
+ THEN ASM_CSQS_THEN (GSYM PLANE_SPAN) (fun x -> \r
+ ASM_CSQS_THEN PLANE_DECOMP_DOT_NORMAL \r
+ (MP_TAC o SPEC `x:point` o REWRITE_RULE[x]))\r
+ THEN ASM_SIMP_TAC[LSUB_PLANE_EQ_RSUB_PLANE] THEN REWRITE_TAC[IN_ELIM_THM]\r
+ THEN STRIP_TAC THEN EXISTS_TAC `(x:point) dot unit n`\r
+ THEN MATCH_MP_TAC (MESON[] `(pt':point) IN p /\ pt' = y ==> y IN p`) \r
+ THEN ASM_REWRITE_TAC[] THEN REPLICATE_TAC 2 (POP_ASSUM MP_TAC)\r
+ THEN VECTOR_ARITH_TAC);;\r
+\r
+(* Additional functions *)\r
+let map_triple = new_definition `map_triple (f:A->B) (x1,x2,x3) = (f x1,f x2,f x3)`;;\r
git://colo12-c703.uibk.ac.at / Emf193/.git / commitdiff