legacy/oldfan/LEMMA.hl

   1
   2 module Lemma_fan  = struct
   3
   4 open Sphere;;
   5 open Fan_defs;;
   6 open Tactic_fan;;
   7
   8
   9 (* ========================================================================== *)
  10 (*                   COLLINEAR                          *)
  11 (* ========================================================================== *)
  12
  13 let th3a12=prove(`!x v u.(~ collinear {x,v,u} ==> DISJOINT {x,u} {v})`,
  14    (let th=prove(`{x,v,u}={x,v,u}`, SET_TAC[]) in
  15 REPEAT GEN_TAC THEN REWRITE_TAC[th;IN_DISJOINT] THEN MATCH_MP_TAC MONO_NOT THEN
  16 REWRITE_TAC[COLLINEAR_3;COLLINEAR_LEMMA; VECTOR_ARITH` a-b= vec 0 <=> a = b`; IN_SING] THEN STRIP_TAC
  17   THEN REPEAT(POP_ASSUM MP_TAC) THEN DISCH_THEN(LABEL_TAC "a") THEN DISCH_TAC THEN REMOVE_THEN "a" MP_TAC
  18 THEN ASM_REWRITE_TAC[] THEN SET_TAC[]));;
  19
  20
  21 let th3a=prove(`!x v u.(~ collinear {x,v,u} ==> DISJOINT {x,v} {u})`,
  22    (let th=prove(`{x,v,u}={x,u,v}`, SET_TAC[]) in
  23 REPEAT GEN_TAC THEN REWRITE_TAC[th;IN_DISJOINT] THEN MATCH_MP_TAC MONO_NOT THEN
  24 REWRITE_TAC[COLLINEAR_3;COLLINEAR_LEMMA; VECTOR_ARITH` a-b= vec 0 <=> a = b`; IN_SING] THEN STRIP_TAC
  25   THEN REPEAT(POP_ASSUM MP_TAC) THEN DISCH_THEN(LABEL_TAC "a") THEN DISCH_TAC THEN REMOVE_THEN "a" MP_TAC
  26 THEN ASM_REWRITE_TAC[] THEN SET_TAC[]));;
  27    let th3b=prove(`!x v u. ~ collinear {x,v,u} ==> ~(x=v) `,
  28 REPEAT GEN_TAC THEN REWRITE_TAC[COLLINEAR_3;COLLINEAR_LEMMA; VECTOR_ARITH` a-b= vec 0 <=> a = b`; DE_MORGAN_THM] THEN SET_TAC[]);;
  29 let th3b1=prove(`!x v u. ~ collinear {x,v,u} ==> ~(x=u) `,
  30 (let th=prove(`{x,v,u}={x,u,v}`, SET_TAC[]) in
  31 REWRITE_TAC[th;th3b]));;
  32
  33    let th3c= prove(`!x v u. ~ collinear {x,v,u} ==> ~(u IN aff {x,v})`,
  34 REPEAT GEN_TAC THEN MATCH_MP_TAC MONO_NOT
  35 THEN REWRITE_TAC[aff; AFFINE_HULL_2; IN_ELIM_THM;COLLINEAR_3;COLLINEAR_LEMMA; VECTOR_ARITH` a-b= vec 0 <=> a = b`; DE_MORGAN_THM]
  36 THEN STRIP_TAC THEN REPEAT(POP_ASSUM MP_TAC) THEN REWRITE_TAC[REAL_ARITH `u'+v'= &1 <=> v'= &1 -u'`]
  37   THEN DISCH_TAC THEN ASM_REWRITE_TAC[]
  38 THEN REWRITE_TAC[VECTOR_ARITH`(u = u' % x + (&1 - u') % v) <=> (u - v = u' % (x-v))`] THEN SET_TAC[]);;
  39
  40
  41 let th3d=prove(`!x v u. ~(x=v)/\ ~(x=u) ==> DISJOINT {x} {v,u}`,
  42 SET_TAC[]);;
  43
  44 let th3=prove(`!x v u. ~ collinear {x,v,u} ==> ~ (x=v) /\ ~(x=u) /\ DISJOINT {x,v} {u}/\ DISJOINT {x,u} {v} /\DISJOINT {x} {v,u} /\ ~(u IN aff {x,v})`,
  45 MESON_TAC[th3a;th3b;th3b1;th3c;th3d;th3a12]);;
  46
  47
  48 let collinear1_fan=prove(`!x v u. ~ collinear {x,u,v} <=> ~(u IN aff {x,v})/\ ~ (x=v)`,
  49 (let lem=prove(`!x v u. {x,v,u}= {x,u,v}`,SET_TAC[]) in
  50 REPEAT GEN_TAC THEN EQ_TAC
  51 THENL[
  52 MESON_TAC[th3;lem];
  53 REWRITE_TAC[SET_RULE`~(t1) /\ ~ t2<=> ~(t2\/ t1)`;COLLINEAR_3_EXPAND;aff; AFFINE_HULL_2;IN_ELIM_THM]
  54 THEN MATCH_MP_TAC MONO_NOT  THEN MATCH_MP_TAC MONO_OR THEN STRIP_TAC
  55 THENL[
  56 REWRITE_TAC[];
  57
  58 STRIP_TAC THEN EXISTS_TAC`u':real` THEN EXISTS_TAC`&1- (u':real)` THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC]]));;
  59
  60
  61 let collinear_fan=prove(`!x v u. ~ collinear {x,v,u} <=> ~(u IN aff {x,v})/\ ~ (x=v)`,
  62 (let lem=prove(`!x v u. {x,v,u}= {x,u,v}`,SET_TAC[]) in
  63 MESON_TAC[collinear1_fan;lem]));;
  64
  65
  66
  67
  68 let properties_inside_collinear0_fan=prove(`!(x:real^3)  (u:real^3) (w:real^3) a:real.
  69 &0 <a /\ a< &1
  70 /\ ~collinear{x,w,u}
  71 ==> ~collinear{x,(&1 - a) % u + a % w,u}`,
  72
  73 REPEAT STRIP_TAC
  74 THEN POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC
  75 THEN REWRITE_TAC[collinear1_fan]
  76 THEN STRIP_TAC THEN ASM_REWRITE_TAC[]
  77 THEN REMOVE_ASSUM_TAC
  78 THEN POP_ASSUM MP_TAC
  79 THEN MATCH_MP_TAC MONO_NOT
  80 THEN REWRITE_TAC[aff; AFFINE_HULL_2;IN_ELIM_THM]
  81 THEN STRIP_TAC
  82 THEN POP_ASSUM MP_TAC
  83 THEN REWRITE_TAC[VECTOR_ARITH`(&1 - a) % u + a % w = u' % x + v % u
  84 <=> a % w = u' % x + (v+a- &1) % u`]
  85 THEN MP_TAC(REAL_ARITH`&0< a ==> ~(a= &0)`)
  86 THEN RESA_TAC
  87 THEN MRESA1_TAC REAL_MUL_LINV`a:real`
  88 THEN STRIP_TAC
  89 THEN MP_TAC(SET_RULE`
  90 a % w = u' % x + (v+a- &1) % u:real^3
  91 ==> (inv ( a))%(a % w) = (inv (a))%(u' % x + (v+a- &1) % u)
  92 `)
  93 THEN POP_ASSUM (fun th->GEN_REWRITE_TAC(LAND_CONV o LAND_CONV o ONCE_DEPTH_CONV)[th])
  94 THEN ASM_REWRITE_TAC[VECTOR_ARITH`A%B%C= (A*B)%C`;VECTOR_ARITH`A%(B+C)=A%B+A%C`]
  95 THEN REDUCE_VECTOR_TAC
  96 THEN STRIP_TAC
  97 THEN EXISTS_TAC `(inv a * (u':real))`
  98 THEN EXISTS_TAC `(inv a * (v +a - &1 :real))`
  99 THEN ASM_REWRITE_TAC[REAL_ARITH`inv a * (u') + inv a * (v +a - &1)=inv a* (a+ (u'+v) - &1)`;REAL_ARITH`t3'+ &1 - &1=t3'`]);;
 100
 101
 102 let properties_inside_collinear1_fan=prove(`!(x:real^3)  (u:real^3) (w:real^3) a:real.
 103 &0 <a /\ a< &1
 104 /\ ~collinear{x,w,u}
 105 ==>  ~collinear{x,(&1 - a) % u + a % w,w}`,
 106 REPEAT STRIP_TAC THEN
 107 MRESAL_TAC properties_inside_collinear0_fan[`(x:real^3)`;` (w:real^3)`;`(u:real^3)`;`&1-a:real`][VECTOR_ARITH`(&1 - (&1 - a)) % w + (&1 - a) % u=(&1 - a) % u + a % w`;]
 108 THENL[ ASM_TAC THEN REAL_ARITH_TAC;
 109 STRIP_TAC THENL[ASM_TAC THEN REAL_ARITH_TAC;
 110 ONCE_REWRITE_TAC[SET_RULE`{A,B,C}={A,C,B}`]
 111 THEN ASM_REWRITE_TAC[]]]);;
 112
 113
 114
 115 let properties_inside_collinear_fan=prove(`!(x:real^3)  (u:real^3) (w:real^3) a:real.
 116 &0 <a /\ a< &1
 117 /\ ~collinear{x,u,w}
 118 ==>  ~collinear{x,(&1 - a) % u + a % w,u}
 119 /\  ~collinear{x,(&1 - a) % u + a % w,w}`,
 120
 121 MESON_TAC[SET_RULE`{A,B,C}={A,C,B}`;properties_inside_collinear0_fan;properties_inside_collinear1_fan]
 122 );;
 123
 124
 125 let notcoplanar_imp_notcollinear_fan=prove(`!x:real^3 v:real^3 u:real^3 w:real^3.
 126 ~coplanar {x,v,u,w}==> ~collinear {x,u,w} /\  ~collinear {x,v,u}
 127 /\ ~collinear {x,v,w}`,
 128 REPEAT GEN_TAC THEN STRIP_TAC
 129 THEN MRESA_TAC NOT_COPLANAR_NOT_COLLINEAR [`x:real^3`;`v:real^3`;`u:real^3`;`w:real^3`]
 130 THEN MRESA_TAC NOT_COPLANAR_NOT_COLLINEAR [`x:real^3`;`u:real^3`;`w:real^3`;`v:real^3`]
 131 THEN POP_ASSUM MP_TAC THEN ONCE_REWRITE_TAC[SET_RULE`{A,B,C,D}={A,D,B,C}`]
 132 THEN RESA_TAC
 133 THEN MRESAL_TAC NOT_COPLANAR_NOT_COLLINEAR [`x:real^3`;`v:real^3`;`w:real^3`;`u:real^3`][SET_RULE`{A,B,C,D}={A,B,D,C}`]);;
 134
 135
 136
 137
 138 (* ========================================================================== *)
 139 (*                   COLLINEAR and CONTINUOUS                         *)
 140 (* ========================================================================== *)
 141
 142
 143
 144 let collinear_continuous_fan=prove(`!x:real^3 v:real^3 u:real^3 w:real^3 c:real.
 145 (\(t:real^1). (&1- drop(t))%u + drop(t) %w - (&1 -c)%x - c% v) continuous_on (:real^1)`,
 146   SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_AT;OPEN_UNIV;DIMINDEX_1]
 147 THEN REPEAT STRIP_TAC
 148 THEN REWRITE_TAC[drop]
 149 THEN MATCH_MP_TAC CONTINUOUS_ADD
 150 THEN STRIP_TAC
 151 THENL[
 152  MATCH_MP_TAC CONTINUOUS_VMUL
 153 THEN REWRITE_TAC[GSYM REAL_CONTINUOUS_CONTINUOUS1]
 154 THEN MATCH_MP_TAC REAL_CONTINUOUS_SUB
 155 THEN SIMP_TAC[REAL_CONTINUOUS_CONST;REAL_CONTINUOUS_AT_COMPONENT; DIMINDEX_1; ARITH];
 156 REPEAT(MATCH_MP_TAC CONTINUOUS_SUB
 157 THEN SIMP_TAC[CONTINUOUS_CONST])
 158 THEN MATCH_MP_TAC CONTINUOUS_VMUL
 159 THEN REWRITE_TAC[GSYM REAL_CONTINUOUS_CONTINUOUS1]
 160 THEN SIMP_TAC[REAL_CONTINUOUS_AT_COMPONENT; DIMINDEX_1; ARITH]]);;
 161
 162
 163
 164 let collinear1_continuous_fan=prove(`!u:real^3 w:real^3 t:real^1.
 165 (\(t:real^1). (&1- drop(t))%u + drop(t) %w) continuous at t`,
 166 REPEAT STRIP_TAC
 167 THEN REWRITE_TAC[drop]
 168 THEN MATCH_MP_TAC CONTINUOUS_ADD
 169 THEN STRIP_TAC
 170 THENL[
 171  MATCH_MP_TAC CONTINUOUS_VMUL
 172 THEN REWRITE_TAC[GSYM REAL_CONTINUOUS_CONTINUOUS1]
 173 THEN MATCH_MP_TAC REAL_CONTINUOUS_SUB
 174 THEN SIMP_TAC[REAL_CONTINUOUS_CONST;REAL_CONTINUOUS_AT_COMPONENT; DIMINDEX_1; ARITH];
 175  MATCH_MP_TAC CONTINUOUS_VMUL
 176 THEN REWRITE_TAC[GSYM REAL_CONTINUOUS_CONTINUOUS1]
 177 THEN SIMP_TAC[REAL_CONTINUOUS_CONST;REAL_CONTINUOUS_AT_COMPONENT; DIMINDEX_1; ARITH]]);;
 178
 179
 180
 181 let CONTINUOUS_CLOSED_PREIMAGE_CONSTANT = prove
 182  (`!f:real^M->real^N s a.
 183       f continuous_on s /\ closed s ==> closed {x | x IN s /\ f(x) = a}`,
 184   REPEAT STRIP_TAC THEN
 185   ASM_CASES_TAC `{x | x IN s /\ (f:real^M->real^N)(x) = a} = {}` THEN
 186   ASM_REWRITE_TAC[CLOSED_EMPTY] THEN ONCE_REWRITE_TAC[SET_RULE
 187    `{x | x IN s /\ f(x) = a} = {x | x IN s /\ f(x) IN {a}}`] THEN
 188   MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE THEN
 189   ASM_REWRITE_TAC[CLOSED_SING] THEN  SET_TAC[]);;
 190
 191 let open_collinear_fan=prove(`!x:real^3 v:real^3 u:real^3 w:real^3 c:real.
 192 open{t| ~((\(t:real^1). (&1- drop(t))%u + drop(t) %w - (&1 -c)%x - c% v)(t)= vec 0)}`,
 193 REPEAT STRIP_TAC
 194 THEN REWRITE_TAC[OPEN_CLOSED;DIFF; IN_ELIM_THM;]
 195 THEN MP_TAC(ISPECL[`(\(t:real^1). (&1- drop(t))%u + drop(t) %w - (&1 -c)%x - c% v:real^3)`;`(:real^1)`;
 196 `((vec 0):real^3)`]CONTINUOUS_CLOSED_PREIMAGE_CONSTANT)
 197 THEN SIMP_TAC[CLOSED_UNIV; DIMINDEX_1; collinear_continuous_fan]);;
 198
 199
 200 let open_vector_angle_fan=prove(`!x:real^3 v:real^3 u:real^3 w:real^3 c:real a:real.
 201 (!t. ~((&1 - t) % u + t % w = x))
 202 ==>
 203 open{t|  ~((\(t:real^1). vector_angle (v - x) (((&1 - drop(t)) % u + drop(t) % w) - x))(t) = a)}`,
 204 REPEAT STRIP_TAC
 205 THEN REWRITE_TAC[OPEN_CLOSED;DIFF; IN_ELIM_THM;]
 206 THEN MP_TAC(ISPECL[`lift o (\(t:real^1). vector_angle (v - x:real^3) (((&1 - drop(t)) % u + drop(t) % w) - x))`;`(:real^1)`;
 207 `lift (a:real)`]CONTINUOUS_CLOSED_PREIMAGE_CONSTANT)
 208 THEN REWRITE_TAC[o_DEF;LIFT_EQ]
 209 THEN DISCH_TAC
 210 THEN POP_ASSUM MATCH_MP_TAC
 211 THEN SIMP_TAC[CLOSED_UNIV; DIMINDEX_1;]
 212 THEN REWRITE_TAC[GSYM o_DEF]
 213 THEN REWRITE_TAC[GSYM FORALL_LIFT_FUN]
 214 THEN MP_TAC(ISPECL[`x:real^3 `;`v:real^3 `;`u:real^3`;` w:real^3`;` &0`]collinear_continuous_fan)
 215 THEN REDUCE_ARITH_TAC
 216 THEN REDUCE_VECTOR_TAC
 217 THEN SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_AT;OPEN_UNIV;DIMINDEX_1]
 218 THEN MATCH_MP_TAC MONO_FORALL
 219 THEN GEN_TAC
 220 THEN DISCH_THEN (LABEL_TAC"MA")
 221 THEN STRIP_TAC
 222 THEN REMOVE_THEN "MA" MP_TAC
 223 THEN ASM_REWRITE_TAC[]
 224 THEN DISCH_TAC
 225 THEN MP_TAC(ISPECL[`(\(t:real^1). ((&1- drop(t))%(u:real^3) + drop(t) %(w:real^3)) - (x:real^3) )`;`(\(t:real^3). lift (vector_angle ((v:real^3)-(x:real^3)) t))`;`x':real^1`] CONTINUOUS_AT_COMPOSE)
 226 THEN ASM_REWRITE_TAC[GSYM o_ASSOC]
 227 THEN REWRITE_TAC[o_DEF]
 228 THEN DISCH_TAC
 229 THEN POP_ASSUM MATCH_MP_TAC
 230 THEN ASM_REWRITE_TAC[VECTOR_ARITH`(A+B)-C=A+B-C:real^3`;GSYM(o_DEF)]
 231 THEN REWRITE_TAC[GSYM(REAL_CONTINUOUS_CONTINUOUS1);GSYM(I_DEF);I_O_ID]
 232 THEN MATCH_MP_TAC(ISPECL[`(v:real^3)-(x:real^3)`;`(&1 - drop x') % u + drop x' % w - x:real^3
 233 `]REAL_CONTINUOUS_AT_VECTOR_ANGLE)
 234 THEN ASM_REWRITE_TAC[VECTOR_ARITH`A+B-C= vec 0<=> A+B=C:real^3`]);;
 235
 236
 237
 238
 239
 240 (* ========================================================================== *)
 241 (*                   CYCLIC SET                     *)
 242 (* ========================================================================== *)
 243
 244 let subset_cyclic_set_fan=prove(`!x:real^3 v:real^3 V:real^3->bool W:real^3->bool.
 245 V SUBSET W /\ cyclic_set W x v ==> cyclic_set V x v`,
 246
 247 REPEAT GEN_TAC THEN REWRITE_TAC[cyclic_set] THEN STRIP_TAC THEN ASM_REWRITE_TAC[]
 248   THEN MP_TAC(ISPECL[`V:real^3->bool`;`W:real^3->bool`]FINITE_SUBSET) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN ASM_TAC THEN SET_TAC[]);;
 249
 250
 251
 252 let property_of_cyclic_set=prove(`!x:real^3 v:real^3 u:real^3 w1:real^3 w2:real^3.
 253  cyclic_set {u, w1, w2} x v
 254 ==> ~(v=x) /\ ~(u=x)/\ ~collinear {vec 0, v-x, u-x}`,
 255
 256 (let th= prove(`!x:real^3 v:real^3 u:real^3 w1:real^3 w2:real^3.
 257 x IN {x,w1,w2}`, SET_TAC[]) in
 258
 259 (let th1=prove(`!x:real^3 v:real^3 u:real^3 w1:real^3 w2:real^3.
 260 x IN  affine hull {x,v}
 261 `,REPEAT GEN_TAC THEN REWRITE_TAC[AFFINE_HULL_2;INTER; IN_ELIM_THM] THEN EXISTS_TAC`&1` THEN EXISTS_TAC `&0` THEN
 262  MESON_TAC[REAL_ARITH`&1+ &0= &1`; VECTOR_ARITH`x= &1 % x + &0 % v`])
 263 in
 264
 265 (let th2=prove(`!x:real^3 v:real^3 u:real^3 w1:real^3 w2:real^3.
 266 x IN {x,w1,w2} INTER affine hull {x,v}
 267 `, REWRITE_TAC[INTER;IN_ELIM_THM] THEN REWRITE_TAC[th;th1]) in
 268
 269
 270 REPEAT GEN_TAC THEN
 271 REWRITE_TAC[COLLINEAR_LEMMA;DE_MORGAN_THM;VECTOR_ARITH`a-b=vec 0 <=> a=b`;cyclic_set;] THEN STRIP_TAC
 272   THEN ASM_REWRITE_TAC[VECTOR_ARITH`(v:real^3)=(x:real^3) <=> x=v`] THEN STRIP_TAC
 273 THENL[ STRIP_TAC  THEN
 274   POP_ASSUM MP_TAC  THEN POP_ASSUM MP_TAC THEN DISCH_THEN(LABEL_TAC"a")  THEN DISCH_TAC
 275 THEN REMOVE_THEN "a" MP_TAC THEN ASM_REWRITE_TAC[] THEN MP_TAC(ISPECL[`x:real^3`; `v:real^3`; `u:real^3`; `w1:real^3`; `w2:real^3`] th2) THEN ASM_TAC THEN SET_TAC[];
 276
 277 STRIP_TAC THENL[
 278
 279 STRIP_TAC  THEN
 280   POP_ASSUM MP_TAC  THEN POP_ASSUM MP_TAC THEN DISCH_THEN(LABEL_TAC"a")  THEN DISCH_TAC
 281 THEN REMOVE_THEN "a" MP_TAC THEN ASM_REWRITE_TAC[] THEN MP_TAC(ISPECL[`x:real^3`; `v:real^3`; `u:real^3`; `w1:real^3`; `w2:real^3`] th2) THEN ASM_TAC THEN SET_TAC[];
 282
 283 STRIP_TAC
 284 THEN POP_ASSUM MP_TAC
 285 THEN POP_ASSUM MP_TAC
 286 THEN DISCH_THEN(LABEL_TAC"a")
 287 THEN DISCH_TAC
 288 THEN REMOVE_THEN "a" MP_TAC
 289 THEN POP_ASSUM MP_TAC
 290 THEN REWRITE_TAC[VECTOR_ARITH`(c:real) % ((v:real^3)-(x:real^3))=(u:real^3)-x <=> u =  (&1 - c) % x+c % v`]
 291 THEN DISCH_TAC
 292 THEN SUBGOAL_THEN `(u:real^3) IN affine hull {(x:real^3),(v:real^3)}` ASSUME_TAC
 293 THENL[
 294 REWRITE_TAC[AFFINE_HULL_2; IN_ELIM_THM]
 295 THEN EXISTS_TAC `&1 - (c:real)`
 296 THEN EXISTS_TAC`c:real`
 297 THEN ASM_REWRITE_TAC[REAL_ARITH`&1 - (c:real) +c= &1`;];
 298
 299 MP_TAC(ISPECL[`u:real^3`; `v:real^3`; `u:real^3`; `w1:real^3`; `w2:real^3`]th)
 300 THEN DISCH_TAC
 301 THEN ASM_TAC
 302 THEN SET_TAC[INTER]
 303 ]]]))));;
 304
 305 let property_of_cyclic_set1=prove(`!x:real^3 v:real^3 u:real^3 w1:real^3 w2:real^3.
 306  cyclic_set {u, w1, w2} x v ==> ~collinear {x, v, w1}`,
 307
 308 (let th=prove(`{u,w1,w2}={w1,u,w2}`,SET_TAC[]) in
 309
 310 REPEAT GEN_TAC THEN DISCH_TAC
 311 THEN MP_TAC (SPECL [`x:real^3`; `v:real^3`; `w1:real^3`;`u:real^3`; `w2:real^3`] property_of_cyclic_set) THEN ASM_REWRITE_TAC[th] THEN STRIP_TAC THEN ASM_REWRITE_TAC[COLLINEAR_3]));;
 312
 313 let property_of_cyclic_set2=prove(`!x:real^3 v:real^3 u:real^3 w1:real^3 w2:real^3.
 314  cyclic_set {u, w1, w2} x v
 315 ==> ~collinear {x, v, w2}`,
 316 ( let th=prove(`{u,w1,w2}={w2,w1,u}`,SET_TAC[]) in
 317 ( let th1=prove(`{u,w1,w2}={w1,w2,u}`,SET_TAC[]) in
 318
 319 REPEAT GEN_TAC THEN DISCH_TAC
 320 THEN MP_TAC (SPECL [`x:real^3`; `v:real^3`; `w2:real^3`;`w1:real^3`; `u:real^3`] property_of_cyclic_set)
 321 THEN ASM_REWRITE_TAC[th] THEN STRIP_TAC THEN POP_ASSUM MP_TAC THEN MESON_TAC[th1;COLLINEAR_3])));;
 322
 323 let property_of_cyclic_set3=prove(`!x:real^3 v:real^3 u:real^3 w1:real^3 w2:real^3.
 324  cyclic_set {u, w1, w2} x v
 325 ==> ~ collinear {x, v, u}`,
 326 ( let th=prove(`{u,w1,w2}={w1,u,w2}`,SET_TAC[]) in
 327
 328 REPEAT GEN_TAC THEN DISCH_TAC
 329 THEN MP_TAC (SPECL [`x:real^3`; `v:real^3`; `u:real^3`;`w1:real^3`; `w2:real^3`] property_of_cyclic_set)
 330 THEN ASM_REWRITE_TAC[]
 331 THEN STRIP_TAC THEN POP_ASSUM MP_TAC THEN ASM_MESON_TAC[COLLINEAR_3;th]));;
 332
 333
 334
 335 let properties_of_cyclic_set=prove(`!x:real^3 v:real^3 u:real^3 w1:real^3 w2:real^3.
 336  cyclic_set {u, w1, w2} x v
 337 ==> ~(v=x) /\ ~(u=x)/\ ~collinear {vec 0, v-x, u-x}
 338 /\ ~collinear {x, v, u}
 339 /\ ~collinear {x, v, w1}
 340 /\  ~collinear {x, v, w2}`,
 341
 342 MESON_TAC[property_of_cyclic_set;property_of_cyclic_set2;property_of_cyclic_set1;property_of_cyclic_set3]);;
 343
 344
 345
 346
 347
 348
 349
 350 (* ========================================================================== *)
 351 (*                   the properties in normal vector                    *)
 352 (* ========================================================================== *)
 353
 354
 355
 356 let imp_norm_not_zero_fan=prove(`!v:real^3 x:real^3. ~(v = x) ==> ~(norm ( v - x) = &0)`,
 357 REPEAT GEN_TAC THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `(v:real^3)-(x:real^3)= vec 0` ASSUME_TAC THENL
 358                    [POP_ASSUM MP_TAC THEN MESON_TAC[NORM_EQ_0];
 359                     SUBGOAL_THEN `(v:real^3) = (x:real^3)` ASSUME_TAC THENL
 360                      [POP_ASSUM MP_TAC THEN VECTOR_ARITH_TAC;
 361                      ASM_TAC THEN SET_TAC[]]]);;
 362
 363
 364 let imp_norm_gl_zero_fan=prove(`!v:real^3 x:real^3. ~(v = x) ==> inv(norm ( v - x)) > &0`,
 365 REPEAT GEN_TAC THEN STRIP_TAC THEN SUBGOAL_THEN `~(norm ( (v:real^3) - (x:real^3)) = &0)` ASSUME_TAC THENL
 366   [ASM_MESON_TAC[imp_norm_not_zero_fan];
 367    MP_TAC (ISPEC `(v:real^3)-(x:real^3)` NORM_POS_LE) THEN DISCH_TAC THEN
 368    SUBGOAL_THEN `norm((v:real^3)-(x:real^3))> &0` ASSUME_TAC THENL
 369      [POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN REAL_ARITH_TAC;
 370       MP_TAC (ISPEC `norm((v:real^3)-(x:real^3))` REAL_LT_INV_EQ) THEN POP_ASSUM MP_TAC
 371 THEN REAL_ARITH_TAC]]);;
 372
 373
 374 let imp_inv_norm_not_zero_fan=prove(`!v:real^3 x:real^3. ~(v = x) ==> ~(inv(norm ( v - x)) = &0)`,
 375 REPEAT GEN_TAC THEN DISCH_TAC THEN SUBGOAL_THEN `inv(norm ((v:real^3) - (x:real^3))) > &0` ASSUME_TAC
 376 THENL
 377   [ASM_MESON_TAC[imp_norm_gl_zero_fan];
 378    POP_ASSUM MP_TAC THEN REAL_ARITH_TAC]);;
 379
 380
 381 let imp_norm_ge_zero_fan=prove(`!v:real^3 x:real^3. ~(v = x) ==> inv(norm ( v - x)) >= &0`,
 382 REPEAT GEN_TAC THEN STRIP_TAC THEN SUBGOAL_THEN `~(norm ( (v:real^3) - (x:real^3)) = &0)` ASSUME_TAC THENL
 383   [ASM_MESON_TAC[imp_norm_not_zero_fan];
 384    MP_TAC (ISPEC `(v:real^3)-(x:real^3)` NORM_POS_LE) THEN DISCH_TAC THEN
 385    SUBGOAL_THEN `norm((v:real^3)-(x:real^3))> &0` ASSUME_TAC THENL
 386      [POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN REAL_ARITH_TAC;
 387       MP_TAC (ISPEC `norm((v:real^3)-(x:real^3))` REAL_LT_INV_EQ) THEN POP_ASSUM MP_TAC THEN REAL_ARITH_TAC]]);;
 388
 389 let norm_of_normal_vector_is_unit_fan=prove(`!v:real^3 x:real^3. ~(v = x) ==> norm(inv(norm ( v - x))% (v-x))= &1`,
 390 REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[NORM_MUL] THEN SUBGOAL_THEN ` inv(norm ( (v:real^3) - (x:real^3))) >= &0` ASSUME_TAC THENL[ ASM_MESON_TAC[imp_norm_ge_zero_fan];
 391                 SUBGOAL_THEN ` ~(norm ( (v:real^3) - (x:real^3))= &0)` ASSUME_TAC THENL
 392                    [ASM_MESON_TAC[imp_norm_not_zero_fan];
 393                     SUBGOAL_THEN ` abs(inv(norm ( (v:real^3) - (x:real^3))))= inv(norm ( (v:real^3) - (x:real^3)))` ASSUME_TAC THENL
 394                        [ASM_MESON_TAC[REAL_ABS_REFL;REAL_ARITH `(a:real)>= &0 <=> &0 <= a`; ];
 395                         MP_TAC(ISPEC `norm ( (v:real^3) - (x:real^3))` REAL_MUL_LINV)THEN ASM_REWRITE_TAC[]]]]);;
 396
 397
 398
 399 let norm_origin_fan=prove(`!x:real^3.
 400  (\(y:real^3). lift(norm(y-x))) continuous_on (:real^3) `,
 401 GEN_TAC
 402 THEN MP_TAC(ISPECL[`(\(y:real^3). y-(x:real^3))`;`(\(y:real^3). lift(norm(y)))`;`(:real^3)`]CONTINUOUS_ON_COMPOSE)
 403 THEN REWRITE_TAC[o_DEF]
 404 THEN DISCH_TAC
 405 THEN POP_ASSUM MATCH_MP_TAC
 406 THEN REWRITE_TAC[CONTINUOUS_ON_LIFT_NORM;GSYM(o_DEF)]
 407 THEN MATCH_MP_TAC CONTINUOUS_ON_SUB
 408 THEN SIMP_TAC[CONTINUOUS_ON_CONST;CONTINUOUS_ON_ID]);;
 409
 410 let REAL_ABS_SUB_NORM = prove
 411  (`!x y. abs(norm(x) - norm(y)) <= norm(x - y)`,
 412   REWRITE_TAC[REAL_ARITH `abs(x - y) <= a <=> x <= y + a /\ y <= x + a`] THEN
 413   MESON_TAC[NORM_TRIANGLE_SUB; NORM_SUB]);;
 414
 415
 416
 417 let IMP_NORM_FAN=prove(`!va:real^3 vb:real^3. ~(va = vb)
 418 ==> ~(norm (va-vb) = &0) /\ &0 <= norm (va-vb) /\ &0 < norm (va-vb) /\ &0 <= inv (norm (va-vb))
 419 /\ &0 < inv (norm (va-vb)) /\ inv (norm (va-vb)) * norm (va-vb) = &1`,
 420 REPEAT GEN_TAC
 421 THEN DISCH_TAC
 422 THEN MRESA_TAC imp_norm_not_zero_fan[`va:real^3`;`vb:real^3`]
 423 THEN ASSUME_TAC(ISPEC`va-vb:real^3`NORM_POS_LE)
 424 THEN MP_TAC(REAL_ARITH`~(norm(va-vb:real^3)= &0) /\ &0 <= norm(va-vb:real^3)==> &0 <norm(va-vb:real^3)`)
 425 THEN RESA_TAC
 426 THEN MRESA1_TAC REAL_LE_INV `norm(va-vb:real^3)`
 427 THEN MRESA1_TAC REAL_LT_INV `norm(va-vb:real^3)`
 428 THEN MRESA1_TAC REAL_MUL_LINV `norm(va-vb:real^3)`
 429 THEN ASM_REWRITE_TAC[]);;
 430
 431
 432
 433
 434
 435 (* ========================================================================== *)
 436 (*   the normal coordinate is the definiton of frame in flyspeck                 *)
 437 (* ========================================================================== *)
 438
 439
 440 let e3_fan=new_definition`e3_fan  (x:real^3) (v:real^3) (u:real^3) = inv(norm((v:real^3)-(x:real^3))) % ((v:real^3)-(x:real^3))`;;
 441
 442
 443
 444
 445   let e2_fan=new_definition`e2_fan (x:real^3) (v:real^3) (u:real^3) = inv(norm((e3_fan (x:real^3) (v:real^3) (u:real^3)) cross ((u:real^3)-(x:real^3)))) % ((e3_fan (x:real^3) (v:real^3) (u:real^3)) cross ((u:real^3)-(x:real^3))) `;;
 446
 447 let e1_fan=new_definition`e1_fan (x:real^3) (v:real^3) (u:real^3)=(e2_fan (x:real^3) (v:real^3) (u:real^3)) cross (e3_fan (x:real^3) (v:real^3) (u:real^3))`;;
 448
 449
 450
 451   let e3_mul_dist_fan=prove(`!x:real^3 v:real^3 u:real^3. ~(v=x) ==> dist (v,x) % e3_fan x v u = v - x`,
 452 REPEAT GEN_TAC THEN REWRITE_TAC[e3_fan; dist; VECTOR_ARITH `(a:real) % (b:real)% (v:real^3)=(a*b)%v`] THEN
 453 MESON_TAC[imp_norm_not_zero_fan; REAL_MUL_RINV; VECTOR_ARITH `&1 %(v:real^3)=v`]);;
 454
 455 let norm_dot_fan=prove(`!x:real^3. norm x = &1 ==> x dot x = &1`,
 456  ASM_MESON_TAC[NORM_POW_2; REAL_ARITH `&1 pow 2= &1`]);;
 457
 458
 459   let e3_is_normal_fan=prove(`!x:real^3 v:real^3 u:real^3. ~(v=x) ==> e3_fan x v u dot e3_fan x v u = &1`,
 460 REPEAT GEN_TAC THEN REWRITE_TAC[e3_fan]THEN DISCH_TAC
 461 THEN SUBGOAL_THEN `norm(inv(norm((v:real^3)-(x:real^3))) %(v-x)) pow 2= &1 pow 2` ASSUME_TAC THENL
 462  [ASM_MESON_TAC[norm_of_normal_vector_is_unit_fan] ;
 463 ASM_MESON_TAC[NORM_POW_2; REAL_ARITH `&1 pow 2= &1`]]);;
 464
 465   let e2_is_normal_fan= prove(`!x:real^3 v:real^3 u:real^3. ~(v=x) /\ ~(u=x) /\ ~(collinear {vec 0, v-x, u-x}) ==> e2_fan x v u dot e2_fan x v u = &1`,
 466 REPEAT GEN_TAC THEN STRIP_TAC THEN SUBGOAL_THEN `~((e3_fan (x:real^3) (v:real^3) (u:real^3)) cross ((u:real^3)-(x:real^3))= vec 0)` ASSUME_TAC
 467 THENL[
 468 POP_ASSUM MP_TAC THEN MATCH_MP_TAC MONO_NOT THEN REWRITE_TAC[e3_fan;CROSS_LMUL]
 469 THEN DISCH_TAC THEN MP_TAC(ISPECL [`v:real^3`; `x:real^3`] imp_inv_norm_not_zero_fan)
 470 THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
 471 MP_TAC(ISPECL [`inv(norm((v:real^3)-(x:real^3)))`; `((v:real^3) -(x:real^3)) cross ((u:real^3)-(x:real^3))`; `(vec 0):real^3`] VECTOR_MUL_LCANCEL_IMP)
 472 THEN ASM_REWRITE_TAC[VECTOR_MUL_RZERO;CROSS_EQ_0 ];
 473
 474 MP_TAC(ISPECL [`(e3_fan (x:real^3) (v:real^3) (u:real^3)) cross ((u:real^3)-(x:real^3))`; `((vec 0):real^3)`] norm_of_normal_vector_is_unit_fan) THEN
 475 ASM_REWRITE_TAC[] THEN REWRITE_TAC[e2_fan; VECTOR_ARITH`(v:real^3)- vec 0 = v`] THEN MESON_TAC[norm_dot_fan]]);;
 476
 477   let e2_orthogonal_e3_fan=prove(`!x:real^3 v:real^3 u:real^3.
 478 ~(v=x) /\ ~(u=x) /\ ~(collinear {vec 0, v-x, u-x}) ==> (e2_fan x v u) dot (e3_fan x v u)= &0`,
 479 REPEAT GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC[e2_fan;e3_fan;CROSS_LMUL;DOT_RMUL;] THEN VEC3_TAC);;
 480
 481
 482
 483   let e1_is_normal_fan=prove(`!x:real^3 v:real^3 u:real^3.
 484 ~(v=x) /\ ~(u=x) /\ ~(collinear {vec 0, v-x, u-x}) ==> e1_fan x v u dot e1_fan x v u = &1`,
 485 REPEAT GEN_TAC THEN STRIP_TAC THEN
 486 REWRITE_TAC[e1_fan;DOT_CROSS] THEN
 487 MP_TAC (ISPECL [`x:real^3`; `v:real^3`; `u:real^3` ] e2_orthogonal_e3_fan)
 488 THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
 489 MP_TAC (ISPECL [`x:real^3`; `v:real^3`; `u:real^3` ] e2_is_normal_fan)
 490 THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
 491 MP_TAC (ISPECL [`x:real^3`; `v:real^3`; `u:real^3` ] e3_is_normal_fan)
 492 THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC);;
 493
 494   let e1_orthogonal_e3_fan=prove(`!x:real^3 v:real^3 u:real^3. ~(v=x) /\ ~(u=x) /\ ~(collinear {vec 0, v-x, u-x})
 495 ==> (e1_fan x v u) dot (e3_fan x v u)= &0`,
 496 REPEAT GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC[e1_fan;DOT_CROSS_SELF] );;
 497
 498
 499   let e1_orthogonal_e2_fan=prove(`!x:real^3 v:real^3 u:real^3. ~(v=x) /\ ~(u=x) /\ ~(collinear {vec 0, v-x, u-x})
 500 ==> (e1_fan x v u) dot (e2_fan x v u)= &0`,
 501 REPEAT GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC[e1_fan;DOT_CROSS_SELF] );;
 502
 503
 504   let e1_cross_e2_dot_e3_fan=prove(`!x:real^3 v:real^3 u:real^3. ~(v=x) /\ ~(u=x) /\ ~(collinear {vec 0, v-x, u-x}) ==>
 505 &0 < (e1_fan x v u cross e2_fan x v u) dot e3_fan x v u`,
 506 REPEAT GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC[e1_fan;CROSS_TRIPLE]
 507 THEN MP_TAC (ISPECL [`x:real^3`; `v:real^3`; `u:real^3` ] e1_is_normal_fan)
 508 THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[e1_fan] THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC);;
 509
 510
 511
 512   let orthonormal_e1_e2_e3_fan=prove(`!x:real^3 v:real^3 u:real^3. ~(v=x) /\ ~(u=x) /\ ~(collinear {vec 0, v-x, u-x}) ==>
 513 (orthonormal (e1_fan x v u) (e2_fan x v u) (e3_fan x v u))`,
 514 REPEAT GEN_TAC THEN REWRITE_TAC[orthonormal] THEN DISCH_TAC THEN
 515 ASM_MESON_TAC[e1_is_normal_fan;e2_is_normal_fan;e3_is_normal_fan;e1_orthogonal_e2_fan;
 516 e1_orthogonal_e3_fan;e2_orthogonal_e3_fan;e1_cross_e2_dot_e3_fan]);;
 517
 518
 519
 520   let dot_e2_fan=prove(`!x:real^3 v:real^3 u:real^3. ~(v=x) /\ ~(u=x) /\ ~(collinear {vec 0, v-x, u-x})
 521 ==> (u-x) dot e2_fan x v u = &0`,
 522 REPEAT GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC[e2_fan;DOT_RMUL;DOT_CROSS_SELF] THEN REAL_ARITH_TAC);;
 523
 524 let vdot_e2_fan=prove(`!x:real^3 v:real^3 u:real^3. ~(v=x) /\ ~(u=x) /\ ~(collinear {vec 0, v-x, u-x})
 525 ==> (v-x) dot e2_fan x v u = &0`,
 526 REPEAT GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC[e2_fan;e3_fan;CROSS_LMUL;DOT_RMUL;DOT_CROSS_SELF] THEN REAL_ARITH_TAC);;
 527
 528 let vcross_e3_fan=prove(`!x:real^3 v:real^3 u:real^3. ~(v=x) /\ ~(u=x) /\ ~(collinear {vec 0, v-x, u-x})
 529 ==>
 530 (v - x) cross (e3_fan x v u) = vec 0`,
 531
 532 REPEAT GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC[e3_fan;CROSS_RMUL;CROSS_REFL] THEN VECTOR_ARITH_TAC);;
 533
 534 let udot_e1_fan=prove(`!x:real^3 v:real^3 u:real^3.
 535 ~(v=x) /\ ~(u=x) /\ ~(collinear {vec 0, v-x, u-x})
 536 ==> &0 < (u - x) dot e1_fan x v u `,
 537 REPEAT GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC[e1_fan; e2_fan;CROSS_LMUL;DOT_RMUL;DOT_SYM;DOT_LMUL;CROSS_TRIPLE]
 538 THEN SUBGOAL_THEN `~((e3_fan (x:real^3) (v:real^3) (u:real^3)) cross ((u:real^3)-(x:real^3))= vec 0)` ASSUME_TAC
 539 THENL[
 540 POP_ASSUM MP_TAC THEN MATCH_MP_TAC MONO_NOT THEN REWRITE_TAC[e3_fan;CROSS_LMUL]
 541 THEN DISCH_TAC THEN MP_TAC(ISPECL [`v:real^3`; `x:real^3`] imp_inv_norm_not_zero_fan)
 542 THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
 543 MP_TAC(ISPECL [`inv(norm((v:real^3)-(x:real^3)))`; `((v:real^3) -(x:real^3)) cross ((u:real^3)-(x:real^3))`; `(vec 0):real^3`] VECTOR_MUL_LCANCEL_IMP)
 544 THEN ASM_REWRITE_TAC[VECTOR_MUL_RZERO;CROSS_EQ_0 ];
 545 MP_TAC(ISPECL [`(e3_fan (x:real^3) (v:real^3) (u:real^3)) cross ((u:real^3)-(x:real^3))`; `((vec 0):real^3)`]imp_norm_gl_zero_fan) THEN
 546 ASM_REWRITE_TAC[REAL_ARITH`(a:real)> &0 <=> &0 < (a:real)`;VECTOR_ARITH `(a:real^3)- vec 0=a`] THEN DISCH_TAC
 547   THEN MP_TAC(ISPEC `e3_fan (x:real^3) (v:real^3) (u:real^3) cross (u-x)`DOT_POS_LT) THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[REAL_LT_MUL]]);;
 548
 549 let udot_e1_fan1=prove(`!x:real^3 v:real^3 u:real^3.
 550 ~(v=x) /\ ~(u=x) /\ ~(collinear {vec 0, v-x, u-x})
 551 ==> &0 <= (u - x) dot e1_fan x v u `,
 552 REPEAT GEN_TAC THEN STRIP_TAC THEN
 553 MP_TAC(ISPECL[`x:real^3` ;`v:real^3` ;`u:real^3`]udot_e1_fan) THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC);;
 554
 555 let vdot_e1_fan=prove(`!x:real^3 v:real^3 u:real^3.
 556 ~(v=x) /\ ~(u=x) /\ ~(collinear {vec 0, v-x, u-x})
 557 ==>  (v - x) dot e1_fan x v u = &0`,
 558 REPEAT STRIP_TAC THEN MP_TAC(ISPECL[`x:real^3`;`v:real^3`;`u:real^3`]e3_mul_dist_fan) THEN RES_TAC THEN SYM_ASSUM_TAC THEN
 559 REWRITE_TAC[DOT_SYM;DOT_LMUL] THEN MP_TAC(ISPECL[`x:real^3`;`v:real^3`;`u:real^3`]e1_orthogonal_e3_fan) THEN RESA_TAC THEN
 560 REAL_ARITH_TAC);;
 561
 562
 563
 564
 565
 566
 567 let properties_coordinate=prove(`!x:real^3 v:real^3 u:real^3.
 568 ~(collinear {x, v, u})
 569 ==> (orthonormal (e1_fan x v u) (e2_fan x v u) (e3_fan x v u))
 570 /\ dist (v,x) % e3_fan x v u = v - x
 571 /\ ((v - x) cross (e3_fan x v u) = vec 0)
 572 /\  (v-x) dot e2_fan x v u = &0
 573 /\ ((u-x) dot e2_fan x v u = &0)
 574 /\  &0 <= (u - x) dot e1_fan x v u
 575 /\ &0 < (u - x) dot e1_fan x v u
 576 /\ (v - x) dot e1_fan x v u = &0`,
 577 (       let lem=prove(`!a b c. {a,b,c}={b,a,c}`,SET_TAC[]) in
 578 REPEAT GEN_TAC THEN DISCH_THEN(LABEL_TAC "a") THEN MP_TAC(ISPECL[`x:real^3`;`v:real^3`;`u:real^3`]th3)
 579   THEN RED_TAC THEN REMOVE_THEN "a" MP_TAC THEN REWRITE_TAC[lem;] THEN GEN_REWRITE_TAC(LAND_CONV o RAND_CONV o ONCE_DEPTH_CONV)[COLLINEAR_3]
 580 THEN
 581 ASM_MESON_TAC[orthonormal_e1_e2_e3_fan;e3_mul_dist_fan; dot_e2_fan;vdot_e2_fan;vcross_e3_fan;udot_e1_fan;udot_e1_fan1;vdot_e1_fan]));;
 582
 583
 584 let module_of_vector =prove(`!x:real^3 v:real^3 u:real^3 w:real^3 r:real psi:real h:real.
 585  ~(v=x) /\ ~(u=x) /\ ~(collinear {vec 0, v-x, u-x})
 586 /\ (&0 < r) /\ (w=(r * cos psi) % e1_fan x v u + (r * sin psi) % e2_fan x v u + h % (v-x))
 587 ==>
 588 sqrt(((w cross (e3_fan x v u)) dot e1_fan x v u) pow 2 + ((w cross (e3_fan x v u)) dot e2_fan x v u) pow 2) = r`,
 589 REPEAT GEN_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[CROSS_LADD;CROSS_LMUL;] THEN
 590 MP_TAC(ISPECL [`x:real^3`; `v:real^3`; `u:real^3` ] orthonormal_e1_e2_e3_fan) THEN ASM_REWRITE_TAC[]
 591   THEN DISCH_THEN (LABEL_TAC "a") THEN
 592 MP_TAC (ISPECL [`e1_fan (x:real^3) (v:real^3) (u:real^3)`;`e2_fan (x:real^3) (v:real^3) (u:real^3)`;
 593 `e3_fan (x:real^3) (v:real^3) (u:real^3)`]ORTHONORMAL_CROSS) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC
 594   THEN ASM_REWRITE_TAC[]
 595 THEN MP_TAC(ISPECL [`x:real^3`; `v:real^3`; `u:real^3` ]vcross_e3_fan) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC
 596   THEN ASM_REWRITE_TAC[]
 597 THEN MP_TAC(ISPECL[`e1_fan (x:real^3) (v:real^3) (u:real^3)`;`e3_fan (x:real^3) (v:real^3) (u:real^3)`]CROSS_SKEW)
 598   THEN DISCH_TAC THEN ASM_REWRITE_TAC[]
 599   THEN REWRITE_TAC[DOT_LADD;DOT_LMUL;DOT_LZERO;DOT_LNEG]
 600   THEN REMOVE_THEN "a" MP_TAC THEN REWRITE_TAC[orthonormal] THEN  DISCH_TAC THEN ASM_REWRITE_TAC[DOT_SYM]
 601   THEN REWRITE_TAC[REAL_ARITH `-- &0 = &0`; REAL_ARITH`(a:real)* &0 = &0`; REAL_ARITH `(a:real) * &1 = a`;
 602 REAL_ARITH `(a:real) + &0 = a`;REAL_ARITH `&0 + (a:real) = a`;REAL_POW_MUL; REAL_ARITH `-- &1 pow 2 = &1`;
 603 REAL_ARITH `(d:real) * (b:real) + d * (c:real) = d * ( b + c)`;SIN_CIRCLE; sqrt] THEN MATCH_MP_TAC SELECT_UNIQUE
 604 THEN REWRITE_TAC[BETA_THM] THEN GEN_TAC THEN EQ_TAC
 605
 606            THENL[
 607               STRIP_TAC THEN SUBGOAL_THEN `((y:real) - (r:real))* (y + r) = &0` ASSUME_TAC
 608                THENL[
 609                  REWRITE_TAC[REAL_ADD_LDISTRIB; REAL_ARITH `((a:real)- (b:real)) * (c:real)= a *c - b * c`;
 610 REAL_ARITH`(y:real) * (r:real)= r * y`; REAL_ARITH `((a:real) +(b:real)) - ((b:real) + (c:real))= a - c`;
 611 REAL_ARITH `(a:real)- (c:real)= &0 <=> a = c`]
 612                    THEN POP_ASSUM MP_TAC THEN REAL_ARITH_TAC;
 613                  MP_TAC (ISPECL [`(y:real)- (r:real)`; `(y:real)+(r:real)` ]REAL_ENTIRE) THEN ASM_REWRITE_TAC[]
 614                    THEN STRIP_TAC
 615                    THENL
 616                      [POP_ASSUM MP_TAC THEN REAL_ARITH_TAC;
 617                      REPEAT (POP_ASSUM MP_TAC) THEN REAL_ARITH_TAC]];
 618
 619              DISCH_TAC THEN ASM_REWRITE_TAC[]
 620                THEN REPEAT (POP_ASSUM MP_TAC) THEN REAL_ARITH_TAC]);;
 621
 622
 623 (* ========================================================================== *)
 624 (*                          COPLANAR   (^_^)                *)
 625 (* ========================================================================== *)
 626
 627
 628
 629 let azim_line_fan=prove(`!x:real^3 v:real^3 u:real^3 w:real^3 t:real^1.
 630 ~coplanar {x,v,u,(&1-drop(t))%u+drop(t)%w}
 631 ==> (\(t:real^1). azim x v u ((&1 - drop(t)) % u + drop(t) % w)) real_continuous at t`,
 632 REPEAT STRIP_TAC
 633 THEN REWRITE_TAC[REAL_CONTINUOUS_CONTINUOUS1; o_DEF; CONTINUOUS_AT_LIFT_COMPONENT]
 634 THEN MP_TAC(ISPECL[`(\(t:real^1). ((&1 - drop(t)) % (u:real^3) + drop(t) %(w:real^3)))`;`(\(w:real^3). lift(azim (x:real^3) (v:real^3) (u:real^3) w))`;`t:real^1`] CONTINUOUS_AT_COMPOSE)
 635 THEN REWRITE_TAC[o_DEF]
 636 THEN DISCH_TAC
 637 THEN POP_ASSUM MATCH_MP_TAC
 638 THEN REWRITE_TAC[ISPECL[`u:real^3`;`w:real^3`;`t:real^1`]collinear1_continuous_fan]
 639 THEN MP_TAC(ISPECL[`x:real^3`;`v:real^3`;`u:real^3`;`((&1 - drop(t)) % (u:real^3) + drop(t) %(w:real^3))`]REAL_CONTINUOUS_AT_AZIM)
 640 THEN REWRITE_TAC[REAL_CONTINUOUS_CONTINUOUS1; o_DEF; CONTINUOUS_AT_LIFT_COMPONENT]
 641 THEN ASM_MESON_TAC[]);;
 642
 643
 644
 645
 646
 647
 648
 649 let continuous_coplanar_fan=prove(`!x:real^3  v:real^3 u:real^3 w:real^3.
 650  ~(coplanar{x,v,u,w})
 651 ==>(!t:real.  ~(t= &0) ==> ~coplanar {x,v,u,(&1-t)%u+t%w} )`,
 652 REPEAT STRIP_TAC
 653 THEN POP_ASSUM MP_TAC
 654 THEN REWRITE_TAC[]
 655 THEN FIND_ASSUM MP_TAC`~(coplanar{x,v,u,w:real^3})`
 656 THEN MATCH_MP_TAC MONO_NOT
 657 THEN REWRITE_TAC[COPLANAR_DET_EQ_0;VECTOR_ARITH`((&1 - t) % u + t % w) - x=(&1 - t) % (u-x) + t % (w - x):real^3`;DET_3;VECTOR_3;VECTOR_ADD_COMPONENT;VECTOR_MUL_COMPONENT
 658 ;REAL_ARITH`(v - x)$1 * (u - x)$2 * ((&1 - t) * (u - x)$3 + t * (w - x)$3) +
 659  (v - x)$2 * (u - x)$3 * ((&1 - t) * (u - x)$1 + t * (w - x)$1) +
 660  (v - x)$3 * (u - x)$1 * ((&1 - t) * (u - x)$2 + t * (w - x)$2) -
 661  (v - x)$1 * (u - x)$3 * ((&1 - t) * (u - x)$2 + t * (w - x)$2) -
 662  (v - x)$2 * (u - x)$1 * ((&1 - t) * (u - x)$3 + t * (w - x)$3) -
 663  (v - x)$3 * (u - x)$2 * ((&1 - t) * (u - x)$1 + t * (w - x)$1)=
 664 t*((v - x)$1 * (u - x)$2 * ((w - x)$3) +
 665  (v - x)$2 * (u - x)$3 * ( (w - x)$1) +
 666  (v - x)$3 * (u - x)$1 * ((w - x)$2) -
 667  (v - x)$1 * (u - x)$3 * ((w - x)$2) -
 668  (v - x)$2 * (u - x)$1 * ( (w - x)$3) -
 669  (v - x)$3 * (u - x)$2 * ( (w - x)$1)):real`;REAL_ENTIRE]
 670 THEN ASM_TAC
 671 THEN REAL_ARITH_TAC);;
 672
 673
 674
 675
 676
 677 let open_is_not_zero_fan=prove(`open{y:real^1 | ?x. ~(x = &0) /\ y = lift x}`,
 678 (let equality_real_fan=prove(`{y:real^1 | ?x. ~(x = &0) /\ y = lift x}={y:real^1 | ~(drop y = &0)}`,
 679 REWRITE_TAC[EXTENSION;IN_ELIM_THM]
 680 THEN GEN_TAC
 681 THEN EQ_TAC
 682 THENL[
 683 STRIP_TAC
 684 THEN ASM_REWRITE_TAC[LIFT_DROP];
 685 STRIP_TAC
 686 THEN EXISTS_TAC`drop (x:real^1)`
 687 THEN ASM_REWRITE_TAC[LIFT_DROP]])in
 688 (let ngu=prove(`{x | x IN (:real^1) /\ x = vec 0}={x | x IN (:real^1) /\ x$1 = &0}`,
 689 REWRITE_TAC[EXTENSION;IN_ELIM_THM]
 690 THEN GEN_TAC
 691 THEN EQ_TAC
 692 THENL[STRIP_TAC
 693 THEN ASM_REWRITE_TAC[VEC_COMPONENT];
 694 SIMP_TAC[IN_UNIV;CART_EQ;LAMBDA_BETA;VEC_COMPONENT;DIMINDEX_1;ARITH_RULE`1<=i /\ i<=1<=>i=1`]])
 695 in
 696 REWRITE_TAC[equality_real_fan]
 697 THEN REWRITE_TAC[OPEN_CLOSED;DIFF; IN_ELIM_THM;]
 698 THEN MP_TAC(ISPECL[`(\(t:real^1). t)`;`(:real^1)`;`(vec 0):real^1`]CONTINUOUS_CLOSED_PREIMAGE_CONSTANT)
 699 THEN MP_TAC(ISPECL[`0`;`1`]VEC_COMPONENT)
 700 THEN SIMP_TAC[CONTINUOUS_ON_ID;CLOSED_UNIV; DIMINDEX_1;drop;ngu])));;
 701
 702
 703
 704
 705
 706
 707
 708
 709
 710
 711
 712 let azim_continuous_when_not_coplanar=prove(`!x:real^3 v:real^3 u:real^3 w:real^3.
 713 ~coplanar {x,v,u,w}
 714 ==> (\(t:real). azim x v u ((&1 - t) % u + t % w)) real_continuous_on {t:real| ~(t= &0)}`,
 715 REWRITE_TAC[REAL_CONTINUOUS_ON;o_DEF;IMAGE;IN_ELIM_THM]
 716 THEN REPEAT STRIP_TAC
 717 THEN ASSUME_TAC(open_is_not_zero_fan)
 718 THEN MRESA_TAC CONTINUOUS_ON_EQ_CONTINUOUS_AT[`(\t:real^1. lift (azim x v u ((&1 - drop t) % u + drop t % w))):real^1->real^1`;`{y:real^1| ?x. ~(x = &0) /\ y = lift x}`]
 719 THEN REWRITE_TAC[IN_ELIM_THM]
 720 THEN REPEAT STRIP_TAC
 721 THEN ASM_REWRITE_TAC[LIFT_DROP]
 722 THEN MRESAL_TAC azim_line_fan[`x:real^3`;` v:real^3`;` u:real^3`;` w:real^3`;` (lift x''):real^1`][REAL_CONTINUOUS_CONTINUOUS1; o_DEF;LIFT_DROP]
 723 THEN POP_ASSUM MATCH_MP_TAC
 724 THEN MRESA_TAC continuous_coplanar_fan[`x:real^3 `;` v:real^3`;` u:real^3`;` w:real^3`]
 725 THEN POP_ASSUM (fun th-> MRESA1_TAC th `x'':real`));;
 726
 727
 728 let injective_azim_coplanar=prove(`!x:real^3 v:real^3 u:real^3 w:real^3.
 729 ~coplanar {x,v,u,w}
 730 ==>
 731 !a:real b:real. ~(a= &0) /\ ~(b= &0)/\ (\(t:real). azim x v u ((&1 - t) % u + t % w))a=(\(t:real). azim x v u ((&1 - t) % u + t % w))b==>a=b`,
 732 REWRITE_TAC[]
 733 THEN REPEAT STRIP_TAC
 734 THEN MRESA_TAC continuous_coplanar_fan[`x:real^3`;`v:real^3`;`u:real^3`;`w:real^3`]
 735 THEN POP_ASSUM(fun th -> MP_TAC(ISPEC`a:real`th)THEN ASSUME_TAC(th))
 736 THEN POP_ASSUM(fun th -> MP_TAC(ISPEC`b:real`th))
 737 THEN ONCE_REWRITE_TAC[SET_RULE`{A,B,C,D}={A,B,D,C}`]
 738 THEN ASM_REWRITE_TAC[]
 739 THEN REPEAT STRIP_TAC
 740 THEN MRESA_TAC NOT_COPLANAR_NOT_COLLINEAR[`x:real^3`;`v:real^3`;`u:real^3`;`w:real^3`]
 741 THEN MRESA_TAC NOT_COPLANAR_NOT_COLLINEAR[`x:real^3`;`v:real^3`;`(&1 - a) % u + a % w:real^3`;`u:real^3`]
 742 THEN MRESA_TAC NOT_COPLANAR_NOT_COLLINEAR[`x:real^3`;`v:real^3`;`(&1 - b) % u + b % w:real^3`;`u:real^3`]
 743 THEN MRESA_TAC AZIM_EQ [`x:real^3`;`v:real^3`;`u:real^3`;`(&1 - b) % u + b % w:real^3`;`(&1 - a) % u + a % w:real^3`;]
 744 THEN MRESA_TAC AZIM_EQ_0 [`x:real^3`;`v:real^3`;`(&1 - a) % u + a % w:real^3`;`(&1 - b) % u + b % w:real^3`;]
 745 THEN MRESA_TAC AZIM_EQ_0_PI_IMP_COPLANAR [`x:real^3`;`v:real^3`;`(&1 - a) % u + a % w:real^3`;`(&1 - b) % u + b % w:real^3`;]
 746 THEN POP_ASSUM MP_TAC
 747 THEN FIND_ASSUM MP_TAC`~coplanar {x,v,u,w:real^3}`
 748 THEN REWRITE_TAC[COPLANAR_DET_EQ_0;VECTOR_ARITH`((&1 - t) % u + t % w) - x=(&1 - t) % (u-x) + t % (w - x):real^3`;DET_3;VECTOR_3;VECTOR_ADD_COMPONENT;VECTOR_MUL_COMPONENT]
 749 THEN STRIP_TAC
 750 THEN REWRITE_TAC[REAL_ARITH`(v - x)$1 *
 751  ((&1 - a) * (u - x)$2 + a * (w - x)$2) *
 752  ((&1 - b) * (u - x)$3 + b * (w - x)$3) +
 753  (v - x)$2 *
 754  ((&1 - a) * (u - x)$3 + a * (w - x)$3) *
 755  ((&1 - b) * (u - x)$1 + b * (w - x)$1) +
 756  (v - x)$3 *
 757  ((&1 - a) * (u - x)$1 + a * (w - x)$1) *
 758  ((&1 - b) * (u - x)$2 + b * (w - x)$2) -
 759  (v - x)$1 *
 760  ((&1 - a) * (u - x)$3 + a * (w - x)$3) *
 761  ((&1 - b) * (u - x)$2 + b * (w - x)$2) -
 762  (v - x)$2 *
 763  ((&1 - a) * (u - x)$1 + a * (w - x)$1) *
 764  ((&1 - b) * (u - x)$3 + b * (w - x)$3) -
 765  (v - x)$3 *
 766  ((&1 - a) * (u - x)$2 + a * (w - x)$2) *
 767  ((&1 - b) * (u - x)$1 + b * (w - x)$1)=
 768 (b-a)*((v - x)$1 * (u - x)$2 * (w - x)$3 +
 769    (v - x)$2 * (u - x)$3 * (w - x)$1 +
 770    (v - x)$3 * (u - x)$1 * (w - x)$2 -
 771    (v - x)$1 * (u - x)$3 * (w - x)$2 -
 772    (v - x)$2 * (u - x)$1 * (w - x)$3 -
 773    (v - x)$3 * (u - x)$2 * (w - x)$1)`;REAL_ENTIRE]
 774 THEN ASM_REWRITE_TAC[]
 775 THEN REAL_ARITH_TAC);;
 776
 777
 778
 779
 780
 781
 782
 783
 784
 785
 786
 787
 788
 789
 790 (* ========================================================================== *)
 791 (*   the sphere coordinate is the definiton of frame in flyspeck                 *)
 792 (* ========================================================================== *)
 793
 794
 795 let SINCOS_PRINCIPAL_VALUE_FAN = prove(
 796 `!x:real. ?y:real. (&0<= y /\ y < &2* pi) /\ (sin(y) = sin(x) /\ cos(y) = cos(x))`,
 797   GEN_TAC THEN MP_TAC(SPECL [`x:real`] SINCOS_PRINCIPAL_VALUE) THEN STRIP_TAC THEN
 798 DISJ_CASES_TAC(REAL_ARITH`((y:real) < &0)\/ (&0 <= y)`) THENL
 799 [ EXISTS_TAC `(y:real)+ &2 * pi` THEN ASSUME_TAC(PI_POS)
 800 THEN ASM_REWRITE_TAC[SIN_PERIODIC;COS_PERIODIC] THEN REPEAT(POP_ASSUM MP_TAC) THEN REAL_ARITH_TAC;
 801  EXISTS_TAC `(y:real)` THEN ASSUME_TAC(PI_POS)
 802 THEN ASM_REWRITE_TAC[] THEN REPEAT(POP_ASSUM MP_TAC) THEN REAL_ARITH_TAC]);;
 803
 804 let sin_of_u_fan=prove(`!x:real^3 v:real^3 u:real^3 r1:real psi:real h1:real.
 805   ~collinear {u,x,v} /\ ~(v=x) /\ ~(u=x)/\ ~collinear {vec 0, v-x, u-x} /\ &0 < r1
 806 /\ u - x = (r1 * cos psi) % (e1_fan x v u) + (r1 * sin psi) % (e2_fan x v u) + h1 % (v-x)
 807 ==> sin psi = &0`,
 808 REPEAT GEN_TAC THEN STRIP_TAC THEN  MP_TAC (ISPECL [`x:real^3`; `v:real^3`; `u:real^3`] dot_e2_fan)
 809           THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[DOT_LADD;DOT_LMUL]
 810           THEN MP_TAC (ISPECL [`x:real^3`; `v:real^3`; `u:real^3`] vdot_e2_fan) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC
 811           THEN MP_TAC (ISPECL [`x:real^3`; `v:real^3`; `u:real^3`] e2_is_normal_fan) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC
 812           THEN MP_TAC (ISPECL [`x:real^3`; `v:real^3`; `u:real^3`] e1_orthogonal_e2_fan)
 813           THEN ASM_REWRITE_TAC[] THEN DISCH_TAC
 814           THEN ASM_REWRITE_TAC[]
 815           THEN REWRITE_TAC[REAL_ARITH`(a:real)* &0 = &0`; REAL_ARITH`(a:real)+ &0= a`; REAL_ARITH`&0 + (a:real)= a`;
 816                REAL_ARITH`(a:real) * &1= a`]
 817           THEN DISCH_TAC
 818           THEN MATCH_MP_TAC(ISPECL [`sin (psi:real)`;`&0`; `r1:real`] REAL_EQ_LCANCEL_IMP)  THEN ASM_REWRITE_TAC[]
 819           THEN REPEAT(POP_ASSUM MP_TAC) THEN REAL_ARITH_TAC);;
 820
 821 let cos_of_u_fan=prove(`!x:real^3 v:real^3 u:real^3 r1:real psi:real h1:real.
 822   ~collinear {u,x,v} /\ ~(v=x) /\ ~(u=x)/\ ~collinear {vec 0, v-x, u-x} /\ &0 < r1
 823 /\ u - x = (r1 * cos psi) % (e1_fan x v u) + (r1 * sin psi) % (e2_fan x v u) + h1 % (v-x)
 824 ==> cos psi = &1`,
 825 REPEAT GEN_TAC THEN STRIP_TAC
 826 THEN MP_TAC(ISPECL[`x:real^3`; `v:real^3`; `u:real^3`; `(u:real^3)-(x:real^3)`; `r1:real`; `psi:real`; `h1:real`]module_of_vector) THEN ASM_REWRITE_TAC[] THEN
 827  POP_ASSUM (fun th-> REWRITE_TAC[SYM(th)] THEN ASSUME_TAC(th))
 828 THEN POP_ASSUM MP_TAC
 829   THEN MP_TAC(ISPECL[`(u:real^3)-(x:real^3)`; `e3_fan (x:real^3) (v:real^3)(u:real^3)`;`e1_fan (x:real^3) (v:real^3)(u:real^3)`]CROSS_TRIPLE) THEN DISCH_TAC THEN POP_ASSUM (fun th-> REWRITE_TAC[th])
 830 THEN MP_TAC(ISPECL[`(u:real^3)-(x:real^3)`; `e3_fan (x:real^3) (v:real^3)(u:real^3)`;`e2_fan (x:real^3) (v:real^3)(u:real^3)`]CROSS_TRIPLE) THEN DISCH_TAC THEN POP_ASSUM (fun th-> REWRITE_TAC[th])
 831  THEN MP_TAC (ISPECL [`x:real^3`; `v:real^3`; `u:real^3`] orthonormal_e1_e2_e3_fan) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC
 832   THEN
 833 MP_TAC(ISPECL[`e1_fan (x:real^3) (v:real^3)(u:real^3)`; `e2_fan (x:real^3) (v:real^3)(u:real^3)`;`e3_fan (x:real^3) (v:real^3)(u:real^3)`]ORTHONORMAL_CROSS )THEN POP_ASSUM (fun th-> REWRITE_TAC[th]) THEN STRIP_TAC THEN
 834 POP_ASSUM (fun th-> REWRITE_TAC[th]) THEN POP_ASSUM (fun th-> REWRITE_TAC[th]) THEN
 835 POP_ASSUM (fun th-> REWRITE_TAC[CROSS_SKEW;th])
 836   THEN MP_TAC(ISPECL[`x:real^3`; `v:real^3`; `u:real^3`] dot_e2_fan)THEN ASM_REWRITE_TAC[]
 837 THEN DISCH_TAC THEN MP_TAC(ISPECL[ `e2_fan (x:real^3) (v:real^3)(u:real^3)`;`(u:real^3)-(x:real^3)`]DOT_SYM) THEN DISCH_TAC THEN ASM_REWRITE_TAC[REAL_ARITH`&0 pow 2 +(a:real)=a`] THEN
 838 MP_TAC (ISPECL [`x:real^3`; `v:real^3`; `u:real^3`] udot_e1_fan1) THEN ASM_REWRITE_TAC[DOT_LNEG;] THEN DISCH_TAC
 839   THEN  MP_TAC(ISPECL[ `e1_fan (x:real^3) (v:real^3)(u:real^3)`;`(u:real^3)-(x:real^3)`]DOT_SYM) THEN DISCH_TAC THEN
 840 POP_ASSUM (fun th-> REWRITE_TAC[th]) THEN REWRITE_TAC[POW_2_SQRT_ABS;REAL_ABS_NEG] THEN
 841  MP_TAC(ISPECL[ `((u:real^3)-(x:real^3)) dot e1_fan (x:real^3) (v:real^3)(u:real^3)`]
 842   REAL_ABS_REFL) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN ASM_REWRITE_TAC[]
 843   THEN DISCH_THEN (LABEL_TAC "a") THEN DISCH_TAC
 844 THEN
 845  MP_TAC(ISPECL[`x:real^3`; `v:real^3`; `u:real^3`; `r1:real`; `psi:real`; `h1:real`] sin_of_u_fan) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN REMOVE_THEN "a" MP_TAC THEN ASM_REWRITE_TAC[VECTOR_ARITH`
 846  (r1 * cos psi) % e1_fan x v u + (r1 * &0) % e2_fan x v u + h1 % (v - x)=
 847  (r1 * cos psi) % e1_fan x v u + h1 % (v - x)`] THEN DISCH_TAC THEN
 848   SUBGOAL_THEN`((u:real^3) - (x:real^3)) dot e1_fan x (v:real^3) u = (((r1:real) * cos (psi:real)) % e1_fan x v u + (h1:real) % (v - x)) dot e1_fan x v u` ASSUME_TAC
 849
 850 THENL[ASM_MESON_TAC[];
 851
 852 POP_ASSUM MP_TAC THEN REWRITE_TAC[DOT_LADD;DOT_LMUL] THEN POP_ASSUM MP_TAC THEN  MP_TAC(ISPECL[`x:real^3`;`v:real^3`;`u:real^3`]e3_mul_dist_fan) THEN ASM_REWRITE_TAC[]
 853   THEN DISCH_TAC
 854 THEN POP_ASSUM (fun th-> REWRITE_TAC[SYM(th)])
 855 THEN MP_TAC(ISPECL[`x:real^3`;`v:real^3`;`u:real^3`]
 856 e1_orthogonal_e3_fan) THEN ASM_REWRITE_TAC[]
 857   THEN DISCH_TAC THEN ASM_REWRITE_TAC[DOT_LMUL;DOT_SYM]
 858 THEN MP_TAC(ISPECL[`x:real^3`;`v:real^3`;`u:real^3`]
 859 e1_is_normal_fan) THEN ASM_REWRITE_TAC[]
 860   THEN DISCH_TAC THEN ASM_REWRITE_TAC[REAL_ARITH`(a:real)* &1+ (b:real)*(c:real)* &0= a`] THEN REPEAT DISCH_TAC
 861   THEN MP_TAC(ISPECL[`&1`;`cos (psi:real)`; `r1:real`]REAL_EQ_LCANCEL_IMP) THEN REWRITE_TAC[REAL_ARITH`(a:real)* &1=a`; REAL_ARITH`&1 = (a:real) <=> a= &1`] THEN DISCH_TAC THEN POP_ASSUM MATCH_MP_TAC THEN REPEAT(POP_ASSUM MP_TAC) THEN REAL_ARITH_TAC]);;
 862
 863
 864
 865
 866 let sincos_of_u_fan=prove(`!x:real^3 v:real^3 u:real^3 r1:real psi:real h1:real.
 867   ~collinear {u,x,v} /\ ~(v=x) /\ ~(u=x)/\ ~collinear {vec 0, v-x, u-x} /\ &0 < r1
 868 /\ u - x = (r1 * cos psi) % (e1_fan x v u) + (r1 * sin psi) % (e2_fan x v u) + h1 % (v-x)
 869 ==>  sin psi = &0 /\ cos psi = &1`,
 870 MESON_TAC[cos_of_u_fan;sin_of_u_fan]);;
 871
 872
 873
 874
 875 let sincos1_of_u_fan=prove(`!x:real^3 v:real^3 u:real^3 r1:real psi:real h1:real.
 876   ~collinear {x,v,u} /\ &0 < r1
 877 /\ u - x = (r1 * cos psi) % (e1_fan x v u) + (r1 * sin psi) % (e2_fan x v u) + h1 % (v-x)
 878 ==>  sin psi = &0 /\ cos psi = &1`,
 879
 880 REPEAT STRIP_TAC
 881 THEN FIND_ASSUM MP_TAC`~collinear {x,v,u:real^3}`
 882 THEN ONCE_REWRITE_TAC[SET_RULE`{X,V,U}={U,X,V}`]
 883 THEN DISCH_TAC
 884 THEN FIND_ASSUM MP_TAC`~collinear {x,v,u:real^3}`
 885 THEN ONCE_REWRITE_TAC[SET_RULE`{X,V,U}={V,X,U}`]
 886 THEN ONCE_REWRITE_TAC[COLLINEAR_3]
 887 THEN DISCH_TAC
 888 THEN MRESA_TAC th3[`(x:real^3)`;` (v:real^3)`;` (u:real^3)`]
 889 THEN MRESA_TAC sincos_of_u_fan[`(x:real^3)`;`(v:real^3)`;` (u:real^3)`;`r1:real`; `psi:real`; `h1:real`])
 890 ;;
 891
 892
 893
 894
 895
 896
 897
 898
 899
 900 (*------------------------------------------------------------*)
 901 (* change spherical coordinate in fan                         *)
 902 (*------------------------------------------------------------*)
 903
 904
 905
 906 let change_spherical_coordinate_fan= new_definition`change_spherical_coordinate_fan (x:real^3) (v:real^3) (u:real^3) = ((\t. let r = t$1 and theta = t$2 and phi = t$3 in
 907            x +(r * cos theta * sin phi) % e1_fan x v u +
 908            (r * sin theta * sin phi) % e2_fan x v u +
 909            (r * cos phi) % e3_fan x v u):real^3->real^3) ` ;;
 910
 911
 912
 913
 914
 915 (*---------------------------------------------------------------------------------------*)
 916 (* the function of change coordinate is(spherecial) continuous                     *)
 917 (*---------------------------------------------------------------------------------------*)
 918
 919
 920 let REAL_CONTINUOUS_AT_COMPONENT = prove
 921    (`!i a. 1 <= i /\ i <= dimindex(:N)
 922            ==> (\x:real^N. x$i) real_continuous at a`,
 923     REWRITE_TAC[REAL_CONTINUOUS_CONTINUOUS1; o_DEF;
 924                 CONTINUOUS_AT_LIFT_COMPONENT]);;
 925
 926
 927   let continuous_change_spherical_coordinate_fan = prove
 928    (`!x':real^3 v:real^3 u:real^3 x:real^3.
 929 ((\t. let r = t$1 and theta = t$2 and phi = t$3 in
 930            (r * cos theta * sin phi) % e1_fan x' v u +
 931            (r * sin theta * sin phi) % e2_fan x' v u +
 932            (r * cos phi) % e3_fan x' v u))
 933      continuous at x`,
 934 REPEAT STRIP_TAC THEN
 935 CONV_TAC(TOP_DEPTH_CONV let_CONV) THEN
 936     REPEAT(MATCH_MP_TAC CONTINUOUS_ADD THEN CONJ_TAC) THEN
 937     MATCH_MP_TAC CONTINUOUS_VMUL THEN
 938     REWRITE_TAC[GSYM REAL_CONTINUOUS_CONTINUOUS1] THEN
 939     REPEAT(MATCH_MP_TAC REAL_CONTINUOUS_MUL THEN CONJ_TAC) THEN
 940     SIMP_TAC[REAL_CONTINUOUS_AT_COMPONENT; DIMINDEX_3; ARITH] THEN
 941     MATCH_MP_TAC(REWRITE_RULE[o_DEF] REAL_CONTINUOUS_AT_COMPOSE) THEN
 942     SIMP_TAC[REAL_CONTINUOUS_AT_COMPONENT; DIMINDEX_3; ARITH] THEN
 943     REWRITE_TAC[REAL_CONTINUOUS_WITHIN_SIN; REAL_CONTINUOUS_WITHIN_COS]);;
 944
 945
 946
 947 (* ========================================================================== *)
 948 (*                        AFFINE                    *)
 949 (* ========================================================================== *)
 950
 951 (* local definitions *)
 952
 953 let complement_set= new_definition`complement_set {x:real^3, v:real^3} = {y:real^3| ~(y IN aff {x,v})} `;;
 954
 955
 956
 957 let AFF_GT_1_1 = prove
 958  (`!x v.
 959         DISJOINT {x} {v}
 960         ==> aff_gt {x} {v} =
 961              {y | ?t1 t2.
 962                      &0 < t2 /\
 963                      t1 + t2 = &1 /\
 964                      y = t1 % x + t2 % v}`,
 965   AFF_TAC);;
 966
 967
 968 let AFF_LT_2_1 = prove
 969  (`!x v w.
 970         DISJOINT {x,v} {w}
 971         ==> aff_lt {x,v} {w} =
 972              {y | ?t1 t2 t3.
 973                       t3 < &0 /\
 974                      t1 + t2 + t3 = &1 /\
 975                      y = t1 % x + t2 % v + t3 % w}`,
 976   AFF_TAC);;
 977
 978
 979
 980 let AFF_GE_2_1 = prove
 981  (`!x v w.
 982         DISJOINT {x,v} {w}
 983         ==> aff_ge {x,v} {w} =
 984              {y | ?t1 t2 t3.
 985                      &0 <= t3 /\
 986                      t1 + t2 + t3 = &1 /\
 987                      y = t1 % x + t2 % v + t3 % w}`,
 988   AFF_TAC);;
 989
 990 let AFF_GE_1_2 = prove
 991  (`!x v w.
 992         DISJOINT {x} {v,w}
 993         ==> aff_ge {x} {v,w} =
 994              {y | ?t1 t2 t3.
 995                      &0 <= t2 /\ &0 <= t3 /\
 996                      t1 + t2 + t3 = &1 /\
 997                      y = t1 % x + t2 % v + t3 % w}`,
 998   AFF_TAC);;
 999
1000
1001 let AFF_GT_1_2=prove(`!x v w.
1002          DISJOINT {x} {v, w}
1003          ==> aff_gt {x} {v, w} =
1004              {y | ?t1 t2 t3.
1005                       &0 < t2 /\
1006                       &0 < t3 /\
1007                       t1 + t2 + t3 = &1 /\
1008                       y = t1 % x + t2 % v + t3 % w}`,
1009 AFF_TAC);;
1010
1011 let AFF_GT_2_2=prove(`!x u v w.
1012          DISJOINT {x,  u} {v, w}
1013          ==> aff_gt {x, u} {v, w} =
1014              {y | ?t1 t2 t3 t4.
1015                       &0 < t3 /\
1016                       &0 < t4 /\
1017                       t1 + t2 + t3 +t4= &1 /\
1018                       y = t1 % x + t2 %u + t3 % v + t4 % w}`,
1019 AFF_TAC);;
1020
1021
1022
1023 let AFF_GE_1_10 = prove
1024  (`!x v w.
1025         DISJOINT {x} {v}
1026         ==> aff_ge {x} {v} =
1027              {y | ?t1 t2.
1028                      &0 <= t2 /\
1029                      t1 + t2 = &1 /\
1030                      y = t1 % x + t2 % v }`,
1031   AFF_TAC);;
1032
1033 let AFF_GE_1_1=prove(`!x:real^3 v:real^3.
1034 ~(x=v)
1035 ==> aff_ge {x} {v} = {y:real^3 | ?t1:real t2:real. (&0 <= t2 ) /\ (t1 + t2 = &1) /\ (y = t1 % x + t2 % v )}`,
1036 (let lemma=prove(`!x v.  ~(x=v) <=> DISJOINT {x} {v} `,
1037
1038 REWRITE_TAC[DISJOINT; INTER; IN_SING; EXTENSION; EMPTY; IN_ELIM_THM] THEN ASM_SET_TAC[]) in
1039
1040 REWRITE_TAC[lemma] THEN AFF_TAC));;
1041
1042
1043
1044
1045
1046 let affine_hull_2_fan= prove(`(!x:real^3 v:real^3. aff {x , v} = {y:real^3| ?t1:real t2:real. (t1 + t2 = &1 )/\ (y = t1 % x + t2 % v )})`,
1047 REWRITE_TAC[aff;AFFINE_HULL_2] THEN ASM_SET_TAC[]);;
1048
1049
1050
1051
1052 let aff_subset_aff_ge=prove(`!x:real^3 v:real^3 w:real^3.
1053 DISJOINT {x,v} {w}
1054 ==> aff {x,v} SUBSET aff_ge {x,v} {w}`,
1055
1056 REPEAT GEN_TAC THEN STRIP_TAC THEN
1057 MP_TAC(ISPECL[`(x:real^3) `;` (v:real^3)`;` (w:real^3)`]AFF_GE_2_1) THEN ASM_REWRITE_TAC[]
1058   THEN DISCH_TAC
1059 THEN ASM_REWRITE_TAC[aff; AFFINE_HULL_2; SUBSET; AFF_GE_2_1; IN_ELIM_THM]
1060   THEN GEN_TAC THEN STRIP_TAC
1061   THEN EXISTS_TAC`u:real` THEN EXISTS_TAC`v':real` THEN EXISTS_TAC`&0`
1062   THEN ASM_REWRITE_TAC[VECTOR_ARITH`a=b +c + &0 % d<=>a=b+c`]
1063   THEN REPEAT (POP_ASSUM MP_TAC) THEN REAL_ARITH_TAC);;
1064
1065
1066
1067
1068 let COMPLEMENT_SET_FAN=prove(`!x:real^3 v:real^3 u:real^3 y:real^3 w:real^3 t1:real t2:real t3:real.
1069 ~( w IN aff {x, v}) /\ ~(t3 = &0) /\ (t1 + t2 + t3 = &1)
1070 ==> t1 % x + t2 % v + t3 % w IN
1071  complement_set {x, v}`,
1072  REPEAT GEN_TAC THEN ASSUME_TAC(affine_hull_2_fan) THEN STRIP_TAC THEN
1073 REWRITE_TAC[complement_set; IN_ELIM_THM] THEN ASM_REWRITE_TAC[] THEN
1074 REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN REPEAT(POP_ASSUM MP_TAC) THEN DISCH_TAC THEN ASM_REWRITE_TAC[]
1075   THEN REWRITE_TAC[IN_ELIM_THM] THEN REPEAT DISCH_TAC THEN
1076   SUBGOAL_THEN  ` (t3:real) % w =((t1':real)- (t1:real)) % (x:real^3) + ((t2':real)- (t2:real)) % (v:real^3) ` ASSUME_TAC
1077  THENL
1078   [POP_ASSUM MP_TAC THEN VECTOR_ARITH_TAC;
1079    REPEAT(POP_ASSUM MP_TAC) THEN DISCH_THEN(LABEL_TAC "b") THEN DISCH_THEN(LABEL_TAC "c") THEN DISCH_THEN(LABEL_TAC "d")
1080      THEN REPEAT STRIP_TAC THEN USE_THEN "c" MP_TAC THEN REWRITE_TAC[CONTRAPOS_THM] THEN
1081      EXISTS_TAC `((t1':real) - (t1:real))/(t3:real)` THEN EXISTS_TAC `((t2':real) - (t2:real))/(t3:real)`
1082      THEN SUBGOAL_THEN  `((t1':real) - (t1:real))/(t3:real)+ ((t2':real) - (t2:real))/(t3:real) = &1` ASSUME_TAC  THENL
1083         [REWRITE_TAC[real_div] THEN REWRITE_TAC[REAL_ARITH `a*b+c*b=(a+c)*b`] THEN
1084         SUBGOAL_THEN `(t1':real) - (t1:real) + (t2':real) - (t2:real) - (t3:real) = &0` ASSUME_TAC THENL
1085            [REPEAT (POP_ASSUM MP_TAC) THEN REAL_ARITH_TAC;
1086             SUBGOAL_THEN `(t1':real) - (t1:real) + (t2':real) - (t2:real) = (t3:real)` ASSUME_TAC THENL
1087               [POP_ASSUM MP_TAC THEN REAL_ARITH_TAC;
1088                ASM_MESON_TAC[REAL_MUL_RINV]]];
1089        ASM_REWRITE_TAC[] THEN REWRITE_TAC[real_div] THEN
1090        REWRITE_TAC[VECTOR_ARITH ` (((t1':real) - (t1:real)) * inv (t3:real)) % (x:real^3) + (((t2':real) - (t2:real)) * inv t3) % (v:real^3) = inv t3 % ((t1' - t1) % x + (t2' - t2) % v)`] THEN
1091        SUBGOAL_THEN `(t3:real) % (w:real^3) = t3 %( inv t3 % (((t1':real) - (t1:real)) % (x:real^3) + ((t2':real) - (t2:real)) % (v:real^3)))` ASSUME_TAC  THENL
1092                   [REWRITE_TAC[VECTOR_ARITH ` (t3:real) % (inv t3 % (((t1':real) - (t1:real)) % (x:real^3) + ((t2':real) - (t2:real)) % (v:real^3)))= (t3 * inv t3) % ((t1' - t1) % x + (t2' - t2)  % v) `] THEN
1093                    SUBGOAL_THEN `((t3:real) * inv (t3:real) = &1) ` ASSUME_TAC THENL
1094                                   [ASM_MESON_TAC[REAL_MUL_RINV];
1095                                     ASM_REWRITE_TAC[]  THEN VECTOR_ARITH_TAC];
1096                  ASM_MESON_TAC[VECTOR_MUL_LCANCEL_IMP]]]]);;
1097
1098
1099
1100 let aff_ge_inter_aff_ge=prove(`!(x:real^3) (v:real^3) (w:real^3).
1101 ~collinear {x,v,w}
1102 ==>
1103 aff_ge {x} {v , w} = aff_ge {x , v} {w} INTER aff_ge {x , w} {v}`,
1104
1105  REPEAT STRIP_TAC THEN MRESA_TAC th3 [`x:real^3`;`v:real^3`;`w:real^3`]
1106    THEN MP_TAC(ISPECL[`x:real^3`;`v:real^3`;`w:real^3`]AFF_GE_1_2)
1107                 THEN ASM_REWRITE_TAC[] THEN DISCH_TAC
1108                 THEN MP_TAC(ISPECL[`x:real^3`;`v:real^3`;`w:real^3`]AFF_GE_2_1)
1109                 THEN ASM_REWRITE_TAC[] THEN DISCH_TAC
1110                 THEN MP_TAC(ISPECL[`x:real^3`;`w:real^3`;`v:real^3`]AFF_GE_2_1)
1111                 THEN ASM_REWRITE_TAC[] THEN DISCH_TAC
1112    THEN ASM_REWRITE_TAC[INTER;IN_ELIM_THM;EXTENSION]THEN GEN_TAC THEN EQ_TAC
1113 THENL(*1*)[
1114 STRIP_TAC THEN STRIP_TAC
1115 THENL(*2*)[
1116     EXISTS_TAC `t1:real` THEN EXISTS_TAC `t2:real` THEN EXISTS_TAC `t3:real` THEN ASM_MESON_TAC[];
1117 EXISTS_TAC `(t1:real)` THEN
1118          EXISTS_TAC `(t3:real)` THEN EXISTS_TAC `(t2:real)`
1119 THEN
1120          ASM_MESON_TAC[REAL_ARITH `(t1:real)+ (t3:real) +(t2:real)=t1 + t2 + t3`;VECTOR_ARITH ` t1 % x + t2 % v + t3 % w = (t1:real) % (x:real^3) + (t3:real) % (w:real^3) + (t2:real) % (v:real^3)`]](*2*);
1121
1122          STRIP_TAC THEN POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC
1123            THEN POP_ASSUM(fun th-> GEN_REWRITE_TAC(PATH_CONV "rrlr" o ONCE_DEPTH_CONV )[th] THEN ASSUME_TAC(th)) THEN POP_ASSUM MP_TAC
1124            THEN POP_ASSUM(fun th-> GEN_REWRITE_TAC(PATH_CONV "rrlr" o ONCE_DEPTH_CONV )[SYM(th)] THEN ASSUME_TAC(th))
1125 THEN DISJ_CASES_TAC(SET_RULE`t3 - t2' = &0 \/ ~((t3:real) - (t2':real) = &0) `)
1126 THENL[POP_ASSUM MP_TAC
1127 THEN REWRITE_TAC[REAL_ARITH`A-B= &0 <=> A=B`]
1128 THEN REPEAT STRIP_TAC
1129 THEN EXISTS_TAC`t1':real`
1130 THEN EXISTS_TAC`t3':real`
1131 THEN EXISTS_TAC`t2':real`
1132 THEN ASM_REWRITE_TAC[VECTOR_ARITH`t1' % x + t2' % w + t3' % v = t1' % x + t3' % v + t2' % w`;
1133 REAL_ARITH`t1' + t3' + t2'=t1' + t2' + t3'`]
1134 THEN ASM_TAC THEN REAL_ARITH_TAC;
1135
1136 REWRITE_TAC[VECTOR_ARITH
1137  `a % x + b % y + c % z= a1 % x + b1 % z + c1 % y <=> (c-b1) % z = (a1-a) % x + (c1-b)% y`]
1138            THEN REWRITE_TAC[REAL_ARITH`a+b+c=a1+b1+c1<=> c1-b=(a-a1)+(c-b1)`]
1139 THEN MRESA1_TAC REAL_MUL_LINV`t3 - t2'`
1140            THEN DISCH_TAC THEN DISCH_TAC           THEN DISCH_TAC THEN DISCH_TAC
1141 THEN MP_TAC(SET_RULE`
1142 (t3 - t2') % w = (t1' - t1) % x + (t3' - t2) %  v:real^3
1143 ==> (inv (t3 - t2'))%((t3 - t2') % w ) = (inv (t3 - t2'))%((t1' - t1) % x + (t3' - t2) %  v:real^3)`)
1144 THEN POP_ASSUM (fun th->GEN_REWRITE_TAC(LAND_CONV o LAND_CONV o ONCE_DEPTH_CONV)[th])
1145 THEN POP_ASSUM(fun th-> ASM_REWRITE_TAC[VECTOR_ARITH`A%B%C= (A*B)%C`;VECTOR_ARITH`&1 %A=A`;VECTOR_ARITH`A%(B+C)=A%B+A%C`] THEN ASSUME_TAC(SYM(th)))
1146 THEN STRIP_TAC
1147 THEN SUBGOAL_THEN`w IN aff{(x:real^3),v}` ASSUME_TAC
1148 THENL[REWRITE_TAC[aff;AFFINE_HULL_2;IN_ELIM_THM;] THEN EXISTS_TAC`inv(t3-t2') *(t1'-t1)`
1149 THEN EXISTS_TAC`inv(t3-t2') *(t3'-t2)` THEN ASM_REWRITE_TAC[REAL_ARITH`A*B+A*C=A*(B+C)`];
1150
1151 ASM_SET_TAC[]]]]);;
1152
1153
1154 let SCALE_AFF_TAC th=REPEAT GEN_TAC
1155 THEN DISCH_TAC
1156 THEN REPEAT GEN_TAC
1157 THEN MRESAL_TAC  th[`x:real^3`;`v:real^3`;`u:real^3`][IN_ELIM_THM]
1158 THEN STRIP_TAC
1159 THEN EXISTS_TAC`&1 - a* t2- a* t3:real`
1160 THEN EXISTS_TAC`a* t2:real`
1161 THEN EXISTS_TAC`a* t3:real`
1162 THEN ONCE_REWRITE_TAC[TAUT`A/\B/\C/\D<=>D/\ A/\B/\C`]
1163 THEN STRIP_TAC
1164 THENL[
1165 ASM_REWRITE_TAC[]
1166 THEN FIND_ASSUM MP_TAC `t1+t2+t3= &1:real`
1167 THEN REWRITE_TAC[REAL_ARITH`A+B+C= &1<=>A= &1- B -C:real`]
1168 THEN DISCH_TAC
1169 THEN ASM_REWRITE_TAC[]
1170 THEN VECTOR_ARITH_TAC;
1171
1172 MP_TAC(ISPECL[`a:real`;`(t2:real)`]REAL_LT_MUL)
1173 THEN RESA_TAC
1174 THEN MRESA_TAC REAL_LT_MUL[`a:real`;`(t3:real)`]
1175 THEN MRESA_TAC REAL_LE_MUL[`a:real`;`(t2:real)`]
1176 THEN MRESA_TAC REAL_LE_MUL[`a:real`;`(t3:real)`]
1177 THEN ASM_TAC
1178 THEN REAL_ARITH_TAC];;
1179
1180
1181 let scale_aff_ge_fan=prove(`!x:real^3 v:real^3 u:real^3.
1182      DISJOINT {x} {v,u}
1183 ==>
1184 (!y:real^3 a:real. y IN  aff_ge {x} {v,u} /\ &0 <= a==> a%(y-x)+x IN aff_ge{x} {v,u})`,
1185 SCALE_AFF_TAC AFF_GE_1_2);;
1186
1187 let scale_aff_gt_fan=prove(`!x:real^3 v:real^3 u:real^3.
1188      DISJOINT {x} {v,u}
1189 ==>
1190 (!y:real^3 a:real. y IN  aff_gt {x} {v,u} /\ &0 < a==> a%(y-x)+x IN aff_gt{x} {v,u})`,
1191 SCALE_AFF_TAC AFF_GT_1_2);;
1192
1193
1194
1195 let origin_is_not_aff_gt_fan=prove(`!x:real^3 v:real^3 u:real^3.
1196    ~(u IN aff {x,v}) /\ DISJOINT {x} {v,u}==> ~(x IN  aff_gt {x} {v,u})`,
1197 REPEAT GEN_TAC
1198 THEN STRIP_TAC
1199 THEN MRESAL_TAC  AFF_GT_1_2[`x:real^3`;`v:real^3`;`u:real^3`][IN_ELIM_THM]
1200 THEN REWRITE_TAC[GSYM FORALL_NOT_THM;DE_MORGAN_THM]
1201 THEN REPEAT STRIP_TAC
1202 THEN DISJ_CASES_TAC(REAL_ARITH`~( &0< (t2:real))\/ ( &0< (t2:real))`)
1203 THENL[ASM_MESON_TAC[];
1204 DISJ_CASES_TAC(REAL_ARITH`~( &0< (t3:real))\/ ( &0< (t3:real))`)
1205 THENL[ASM_MESON_TAC[];
1206 DISJ_CASES_TAC(REAL_ARITH`~( t1+t2+(t3:real)= &1)\/ (  t1+t2+(t3:real)= &1)`)
1207 THENL[ASM_MESON_TAC[];
1208 ASM_REWRITE_TAC[]
1209 THEN POP_ASSUM MP_TAC
1210 THEN REWRITE_TAC[REAL_ARITH`A+B+C= &1<=>A= &1- B -C:real`]
1211 THEN DISCH_TAC
1212 THEN MP_TAC(REAL_ARITH`&0<t3:real==> ~(t3= &0)`)
1213 THEN RESA_TAC
1214 THEN MP_TAC(ISPEC`(t3:real)`REAL_MUL_LINV)
1215 THEN RESA_TAC
1216 THEN ASM_REWRITE_TAC[]
1217 THEN REWRITE_TAC[VECTOR_ARITH`A=( &1-B-C) %A+B%E+C%D <=> C%(D-A)= (--B)%(E-A)`]
1218 THEN STRIP_TAC
1219 THEN MP_TAC(SET_RULE`t3 % (u - x) = (--t2) % (v - x):real^3 ==> (inv (t3))%(t3 % (u - x)) = (inv (t3))%((--t2) % (v - x))`)
1220 THEN POP_ASSUM (fun th->GEN_REWRITE_TAC(LAND_CONV o LAND_CONV o ONCE_DEPTH_CONV)[th])
1221 THEN ASM_REWRITE_TAC[VECTOR_ARITH`A%B%C=(A*B)%C`]
1222 THEN REDUCE_VECTOR_TAC
1223 THEN REWRITE_TAC[VECTOR_ARITH`A-B=C%(V-B)<=>A=( &1-C)%B+C%V`]
1224 THEN FIND_ASSUM MP_TAC `~(u IN aff {x,v}:real^3->bool)`
1225 THEN MATCH_MP_TAC MONO_NOT
1226 THEN STRIP_TAC
1227 THEN REWRITE_TAC[aff; AFFINE_HULL_2; IN_ELIM_THM]
1228 THEN EXISTS_TAC`&1 - inv t3 * --t2:real`
1229 THEN EXISTS_TAC`inv t3 * --t2:real`
1230 THEN ASM_REWRITE_TAC[]
1231 THEN REAL_ARITH_TAC]]]);;
1232
1233
1234
1235
1236
1237
1238
1239 let properties_of_collinear4_points_fan=prove(`!x:real^3  v:real^3 u:real^3 v1:real^3.
1240 ~collinear{x,v,u}
1241 /\ v1 IN aff_gt {x} {v,u}
1242 ==> ~collinear{x,v1,v}`,
1243 REPEAT STRIP_TAC
1244 THEN POP_ASSUM MP_TAC
1245 THEN REWRITE_TAC[]
1246 THEN POP_ASSUM MP_TAC
1247 THEN MRESA_TAC th3[`(x:real^3)` ;` (v:real^3)`;`(u:real^3) `;]
1248 THEN MRESA_TAC AFF_GT_1_2[`(x:real^3)` ;` (v:real^3)`;`(u:real^3) `;]
1249 THEN POP_ASSUM(fun th-> REWRITE_TAC[th;IN_ELIM_THM])
1250 THEN STRIP_TAC
1251 THEN ASM_REWRITE_TAC[collinear1_fan;]
1252 THEN FIND_ASSUM MP_TAC`~(u IN aff {x, v:real^3})`
1253 THEN MATCH_MP_TAC MONO_NOT
1254 THEN REWRITE_TAC[aff;AFFINE_HULL_2;IN_ELIM_THM]
1255 THEN STRIP_TAC
1256 THEN POP_ASSUM MP_TAC
1257 THEN ASM_REWRITE_TAC[VECTOR_ARITH`t1 % x + t2 % v + t3 % u = u' % x + v' % v <=> t3 % u = (u'-t1) % x + (v'-t2) % v`;]
1258 THEN MP_TAC (REAL_ARITH`&0< t3==> ~(t3= &0)`) THEN RESA_TAC
1259 THEN MRESA1_TAC REAL_MUL_LINV `(t3:real)`
1260 THEN STRIP_TAC
1261 THEN MP_TAC(SET_RULE`t3 % u = (u'-t1) % x + (v'-t2) % v ==> (inv (t3)) % (t3) % ( u) = (inv (t3)) % ( (u'-t1) % x + (v'-t2) % v:real^3)`)
1262 THEN POP_ASSUM (fun th->GEN_REWRITE_TAC(LAND_CONV o LAND_CONV o ONCE_DEPTH_CONV)[th]
1263 THEN ASM_REWRITE_TAC[VECTOR_ARITH`(A%B%C=(A*B)%C:real^3)`;VECTOR_ARITH`A%(B+C)=A%B+A%C`])
1264 THEN REDUCE_VECTOR_TAC
1265 THEN STRIP_TAC
1266 THEN EXISTS_TAC`inv t3 * ((u' - t1):real)`
1267 THEN EXISTS_TAC`inv t3 * ((v' - t2):real)`
1268 THEN ASM_REWRITE_TAC[REAL_ARITH`inv t3 * (u' - t1) + inv t3 * (v' - t2)=inv t3 *(t3+ (u'+v') -( t1+ t2+t3))`;REAL_ARITH`A+ &1- &1=A`]);;
1269
1270
1271
1272
1273 let properties_of_coplanar=prove(`!x:real^3 v:real^3 u:real^3 v1:real^3.
1274 ~collinear{x,v,u}
1275 /\ v1 IN aff_gt {x} {v,u}
1276 ==> coplanar{x,v1,v,u}`,
1277 REPEAT STRIP_TAC
1278 THEN REWRITE_TAC[coplanar]
1279 THEN POP_ASSUM MP_TAC
1280 THEN MRESA_TAC th3[`(x:real^3)` ;` (v:real^3)`;`(u:real^3) `;]
1281 THEN MRESA_TAC AFF_GT_1_2[`(x:real^3)` ;` (v:real^3)`;`(u:real^3) `;]
1282 THEN POP_ASSUM(fun th-> REWRITE_TAC[th;IN_ELIM_THM])
1283 THEN STRIP_TAC
1284 THEN EXISTS_TAC`x:real^3`
1285 THEN EXISTS_TAC`v:real^3`
1286 THEN EXISTS_TAC`u:real^3`
1287 THEN SUBGOAL_THEN`(x:real^3)IN affine hull {x,v,u:real^3}` ASSUME_TAC
1288 THENL[REWRITE_TAC[ AFFINE_HULL_3;IN_ELIM_THM]
1289 THEN EXISTS_TAC`&1`
1290 THEN EXISTS_TAC`&0`
1291 THEN EXISTS_TAC`&0`
1292 THEN REDUCE_ARITH_TAC
1293 THEN VECTOR_ARITH_TAC;
1294 SUBGOAL_THEN`(v:real^3)IN affine hull {x,v,u:real^3}` ASSUME_TAC
1295 THENL[ REWRITE_TAC[ AFFINE_HULL_3;IN_ELIM_THM]
1296 THEN EXISTS_TAC`&0`
1297 THEN EXISTS_TAC`&1`
1298 THEN EXISTS_TAC`&0`
1299 THEN REDUCE_ARITH_TAC
1300 THEN VECTOR_ARITH_TAC;
1301 SUBGOAL_THEN`(u:real^3)IN affine hull {x,v,u:real^3}` ASSUME_TAC
1302 THENL[
1303 REWRITE_TAC[ AFFINE_HULL_3;IN_ELIM_THM]
1304 THEN EXISTS_TAC`&0`
1305 THEN EXISTS_TAC`&0`
1306 THEN EXISTS_TAC`&1`
1307 THEN REDUCE_ARITH_TAC
1308 THEN VECTOR_ARITH_TAC;
1309 SUBGOAL_THEN`(v1:real^3)IN affine hull {x,v,u:real^3}` ASSUME_TAC
1310 THENL[
1311 REWRITE_TAC[ AFFINE_HULL_3;IN_ELIM_THM]
1312 THEN EXISTS_TAC`t1:real`
1313 THEN EXISTS_TAC`t2:real`
1314 THEN EXISTS_TAC`t3:real`
1315 THEN ASM_REWRITE_TAC[];
1316 ASM_TAC
1317 THEN SET_TAC[]]]]]);;
1318
1319
1320
1321
1322 let aff_gt_subset_aff_ge=prove(`!x:real^3 v:real^3 u:real^3.
1323 DISJOINT {x} {v,u}
1324 ==>
1325 aff_gt {x} {v,u} SUBSET aff_ge {x} {v,u}`,
1326 REPEAT STRIP_TAC
1327 THEN MRESAL_TAC  AFF_GE_1_2[`x:real^3`;`v:real^3`;`u:real^3`][IN_ELIM_THM]
1328 THEN MRESAL_TAC  AFF_GT_1_2[`x:real^3`;`v:real^3`;`u:real^3`][IN_ELIM_THM;SUBSET]
1329 THEN REPEAT STRIP_TAC
1330 THEN EXISTS_TAC`t1:real`
1331 THEN EXISTS_TAC`t2:real`
1332 THEN EXISTS_TAC`t3:real`
1333 THEN ASM_REWRITE_TAC[]
1334 THEN ASM_TAC
1335 THEN REAL_ARITH_TAC);;
1336
1337
1338
1339 let aff_gt1_subset_aff_ge=prove(`!x:real^3 v:real^3 u:real^3 v1:real^3.
1340 DISJOINT {x} {v,u} /\ ~collinear {x,v1,u}
1341 /\ v1 IN aff_ge {x} {v,u}
1342 ==>
1343 aff_gt {x} {v1,u} SUBSET aff_ge {x} {v,u}`,
1344
1345 REPEAT STRIP_TAC
1346 THEN POP_ASSUM MP_TAC
1347 THEN MRESA_TAC th3[`x:real^3`;`v1:real^3`;`u:real^3`]
1348 THEN MRESAL_TAC  AFF_GE_1_2[`x:real^3`;`v:real^3`;`u:real^3`][IN_ELIM_THM]
1349 THEN MRESAL_TAC  AFF_GT_1_2[`x:real^3`;`v1:real^3`;`u:real^3`][IN_ELIM_THM;SUBSET]
1350 THEN REPEAT STRIP_TAC
1351 THEN POP_ASSUM MP_TAC
1352 THEN ASM_REWRITE_TAC[VECTOR_ARITH`t1' % x + t2' % (t1 % x + t2 % v + t3 % u) + t3' % u
1353 =(t1'+ t2'*t1) % x + (t2'* t2) % v + (t2' * t3  + t3') % u:real^3`]
1354 THEN STRIP_TAC
1355 THEN EXISTS_TAC`t1' + t2' * t1:real`
1356 THEN EXISTS_TAC`t2' * t2:real`
1357 THEN EXISTS_TAC`t2' * t3 +t3':real`
1358 THEN MP_TAC(REAL_ARITH`&0<t2'==> &0<= t2'`)
1359 THEN RESA_TAC
1360 THEN MRESA_TAC REAL_LE_MUL[`t2':real`;`t2:real`]
1361 THEN MRESA_TAC REAL_LE_MUL[`t2':real`;`t3:real`]
1362 THEN ASM_REWRITE_TAC[REAL_ARITH`(t1' + t2' * t1) + t2' * t2 + t2' * t3 + t3'=
1363 t1'+t2'*(t1+t2+t3)+t3'`; REAL_ARITH`A* &1=A`]
1364 THEN ASM_TAC
1365 THEN REAL_ARITH_TAC);;
1366
1367
1368 let aff_gt12_subset_aff_ge=prove(`!x:real^3 v:real^3 u:real^3 v1:real^3.
1369 DISJOINT {x} {v,u} /\ ~collinear {x,v1,v}
1370 /\ v1 IN aff_ge {x} {v,u}
1371 ==>
1372 aff_gt {x} {v1,v} SUBSET aff_ge {x} {v,u}`,
1373
1374 REPEAT STRIP_TAC
1375 THEN POP_ASSUM MP_TAC
1376 THEN MRESA_TAC th3[`x:real^3`;`v1:real^3`;`v:real^3`]
1377 THEN MRESAL_TAC  AFF_GE_1_2[`x:real^3`;`v:real^3`;`u:real^3`][IN_ELIM_THM]
1378 THEN MRESAL_TAC  AFF_GT_1_2[`x:real^3`;`v1:real^3`;`v:real^3`][IN_ELIM_THM;SUBSET]
1379 THEN REPEAT STRIP_TAC
1380 THEN POP_ASSUM MP_TAC
1381 THEN ASM_REWRITE_TAC[VECTOR_ARITH`t1' % x + t2' % (t1 % x + t2 % v + t3 % u) + t3' % v
1382 =(t1'+ t2'*t1) % x + (t2'* t2+t3') % v + (t2' * t3 ) % u:real^3`]
1383 THEN STRIP_TAC
1384 THEN EXISTS_TAC`t1' + t2' * t1:real`
1385 THEN EXISTS_TAC`t2' * t2 +t3':real`
1386 THEN EXISTS_TAC`t2' * t3 :real`
1387 THEN MP_TAC(REAL_ARITH`&0<t2'==> &0<= t2'`)
1388 THEN RESA_TAC
1389 THEN MRESA_TAC REAL_LE_MUL[`t2':real`;`t2:real`]
1390 THEN MRESA_TAC REAL_LE_MUL[`t2':real`;`t3:real`]
1391 THEN ASM_REWRITE_TAC[REAL_ARITH`(t1' + t2' * t1) + (t2' * t2 +t3')+ t2' * t3 =
1392 t1'+t2'*(t1+t2+t3)+t3'`; REAL_ARITH`A* &1=A`]
1393 THEN ASM_TAC
1394 THEN REAL_ARITH_TAC);;
1395
1396
1397 let aff_gt2_subset_aff_ge=prove(`!x:real^3 v:real^3 u:real^3 v1:real^3.
1398 DISJOINT {x} {v,u} /\ ~collinear {x,v1,u} /\ ~collinear {x,v1,v}
1399 /\ v1 IN aff_gt {x} {v,u}
1400 ==>
1401 azim x v1 v u= pi`,
1402
1403 REPEAT STRIP_TAC
1404 THEN POP_ASSUM MP_TAC
1405 THEN MRESA_TAC th3[`x:real^3`;`v1:real^3`;`u:real^3`]
1406 THEN MRESAL_TAC  AFF_GT_1_2[`x:real^3`;`v:real^3`;`u:real^3`][IN_ELIM_THM]
1407 THEN MRESA_TAC  AZIM_EQ_PI[`x:real^3`;`v1:real^3`;`v:real^3`;`u:real^3`]
1408 THEN REPEAT STRIP_TAC
1409 THEN POP_ASSUM MP_TAC
1410 THEN ASM_REWRITE_TAC[VECTOR_ARITH`v1 = t1 % x + t2 % v + t3 % u
1411 <=> t2 % v = (--t1) % x + v1 + (--t3) % u`]
1412 THEN MP_TAC(REAL_ARITH`&0<t2==> ~( t2= &0)`)
1413 THEN RESA_TAC
1414 THEN MP_TAC(REAL_ARITH`&0<t3==> -- t3< &0`)
1415 THEN RESA_TAC
1416 THEN MRESA1_TAC REAL_MUL_LINV`t2:real`
1417 THEN MRESA1_TAC REAL_LT_INV`t2:real`
1418 THEN MRESAL_TAC REAL_LT_LMUL[`inv t2:real`;`-- t3:real`;`&0`][REAL_ARITH`A * &0= &0`]
1419 THEN STRIP_TAC
1420 THEN MP_TAC(SET_RULE`t2 % v = --t1 % x + v1 + --t3 % u:real^3 ==> (inv (t2))%(t2 % v ) = (inv (t2))%( --t1 % x + v1 + --t3 % u)`)
1421 THEN POP_ASSUM (fun th->GEN_REWRITE_TAC(LAND_CONV o LAND_CONV o ONCE_DEPTH_CONV)[th])
1422 THEN ASM_REWRITE_TAC[VECTOR_ARITH`A%B%C=(A*B)%C`; VECTOR_ARITH`A%(B+C+D)=A%B+A%C+A%D`]
1423 THEN REDUCE_VECTOR_TAC
1424 THEN STRIP_TAC
1425 THEN MRESAL_TAC  AFF_LT_2_1[`x:real^3`;`v1:real^3`;`u:real^3`][IN_ELIM_THM;SUBSET]
1426 THEN EXISTS_TAC`(inv t2 * --t1):real`
1427 THEN EXISTS_TAC`inv t2:real`
1428 THEN EXISTS_TAC`(inv t2 * --t3):real`
1429 THEN ASM_REWRITE_TAC[REAL_ARITH`inv t2 * (--t1) + inv t2 + inv t2 * (--t3)=
1430 inv t2 * (t2+ &1 -(t1 +t2 +t3))`; REAL_ARITH`A+ &1- &1=A`]);;
1431
1432
1433
1434 let remove_variable_fan=prove(`!x:real^3 v:real^3 u:real^3 w:real^3 t1:real t2:real t3:real.
1435  &0 < t3
1436 /\ w = t1 % x + t2 % v + t3 % u
1437 ==> u= inv(t3) % w - (inv(t3)*t1) % x- (inv(t3) * t2) % v`,
1438 REPEAT STRIP_TAC
1439 THEN POP_ASSUM MP_TAC
1440 THEN GEN_REWRITE_TAC(LAND_CONV o ONCE_DEPTH_CONV)[VECTOR_ARITH`w = t1'' % x + t2'' % v + t3'' % u <=> t3'' % u = w-t1'' % x - t2'' % (v:real^3)`]
1441 THEN MP_TAC(REAL_ARITH `&0 < (t3:real) ==>  ~(t3 = &0)`)
1442 THEN MP_TAC(ISPEC`(t3:real)`REAL_LT_INV)
1443 THEN POP_ASSUM(fun th-> REWRITE_TAC[th] THEN ASSUME_TAC(th))
1444 THEN STRIP_TAC THEN STRIP_TAC
1445 THEN MP_TAC(ISPEC`(t3:real)`REAL_MUL_LINV)
1446 THEN POP_ASSUM(fun th-> REWRITE_TAC[th] THEN ASSUME_TAC(th))
1447 THEN STRIP_TAC
1448 THEN STRIP_TAC
1449 THEN MP_TAC(SET_RULE`
1450 t3 % u = w-t1 % x - t2 % v:real^3
1451 ==> (inv (t3))%(t3 % u) = (inv (t3))%( w-t1 % x - t2 % v:real^3)`)
1452 THEN POP_ASSUM (fun th->GEN_REWRITE_TAC(LAND_CONV o LAND_CONV o ONCE_DEPTH_CONV)[th])
1453 THEN POP_ASSUM(fun th-> REWRITE_TAC[th;VECTOR_ARITH`A%B%C= (A*B)%C`;VECTOR_ARITH`&1 %A=A`;VECTOR_ARITH`A%(B-C-D)=A%B-A%C-A%D`] THEN ASSUME_TAC(th)));;
1454
1455
1456
1457 let aff_gt_inter_aff_gt=prove(`!(x:real^3) (v:real^3) (w:real^3).
1458 ~collinear {x,v,w}
1459 ==>
1460 aff_gt {x} {v , w} = aff_gt {x , v} {w} INTER aff_gt {x , w} {v}`,
1461
1462  REPEAT STRIP_TAC THEN MRESA_TAC th3 [`x:real^3`;`v:real^3`;`w:real^3`]
1463    THEN MP_TAC(ISPECL[`x:real^3`;`v:real^3`;`w:real^3`]AFF_GT_1_2)
1464                 THEN ASM_REWRITE_TAC[] THEN DISCH_TAC
1465                 THEN MP_TAC(ISPECL[`x:real^3`;`v:real^3`;`w:real^3`]AFF_GT_2_1)
1466                 THEN ASM_REWRITE_TAC[] THEN DISCH_TAC
1467                 THEN MP_TAC(ISPECL[`x:real^3`;`w:real^3`;`v:real^3`]AFF_GT_2_1)
1468                 THEN ASM_REWRITE_TAC[] THEN DISCH_TAC
1469    THEN ASM_REWRITE_TAC[INTER;IN_ELIM_THM;EXTENSION]THEN GEN_TAC THEN EQ_TAC
1470 THENL(*1*)[
1471 STRIP_TAC THEN STRIP_TAC
1472 THENL(*2*)[
1473     EXISTS_TAC `t1:real` THEN EXISTS_TAC `t2:real` THEN EXISTS_TAC `t3:real` THEN ASM_MESON_TAC[];
1474 EXISTS_TAC `(t1:real)` THEN
1475          EXISTS_TAC `(t3:real)` THEN EXISTS_TAC `(t2:real)`
1476 THEN
1477          ASM_MESON_TAC[REAL_ARITH `(t1:real)+ (t3:real) +(t2:real)=t1 + t2 + t3`;VECTOR_ARITH ` t1 % x + t2 % v + t3 % w = (t1:real) % (x:real^3) + (t3:real) % (w:real^3) + (t2:real) % (v:real^3)`]](*2*);
1478
1479          STRIP_TAC THEN POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC
1480            THEN POP_ASSUM(fun th-> GEN_REWRITE_TAC(PATH_CONV "rrlr" o ONCE_DEPTH_CONV )[th] THEN ASSUME_TAC(th)) THEN POP_ASSUM MP_TAC
1481            THEN POP_ASSUM(fun th-> GEN_REWRITE_TAC(PATH_CONV "rrlr" o ONCE_DEPTH_CONV )[SYM(th)] THEN ASSUME_TAC(th))
1482 THEN DISJ_CASES_TAC(SET_RULE`t3 - t2' = &0 \/ ~((t3:real) - (t2':real) = &0) `)
1483 THENL[POP_ASSUM MP_TAC
1484 THEN REWRITE_TAC[REAL_ARITH`A-B= &0 <=> A=B`]
1485 THEN REPEAT STRIP_TAC
1486 THEN EXISTS_TAC`t1':real`
1487 THEN EXISTS_TAC`t3':real`
1488 THEN EXISTS_TAC`t2':real`
1489 THEN ASM_REWRITE_TAC[VECTOR_ARITH`t1' % x + t2' % w + t3' % v = t1' % x + t3' % v + t2' % w`;
1490 REAL_ARITH`t1' + t3' + t2'=t1' + t2' + t3'`]
1491 THEN ASM_TAC THEN REAL_ARITH_TAC;
1492
1493 REWRITE_TAC[VECTOR_ARITH
1494  `a % x + b % y + c % z= a1 % x + b1 % z + c1 % y <=> (c-b1) % z = (a1-a) % x + (c1-b)% y`]
1495            THEN REWRITE_TAC[REAL_ARITH`a+b+c=a1+b1+c1<=> c1-b=(a-a1)+(c-b1)`]
1496 THEN MRESA1_TAC REAL_MUL_LINV`t3 - t2'`
1497            THEN DISCH_TAC THEN DISCH_TAC           THEN DISCH_TAC THEN DISCH_TAC
1498 THEN MP_TAC(SET_RULE`
1499 (t3 - t2') % w = (t1' - t1) % x + (t3' - t2) %  v:real^3
1500 ==> (inv (t3 - t2'))%((t3 - t2') % w ) = (inv (t3 - t2'))%((t1' - t1) % x + (t3' - t2) %  v:real^3)`)
1501 THEN POP_ASSUM (fun th->GEN_REWRITE_TAC(LAND_CONV o LAND_CONV o ONCE_DEPTH_CONV)[th])
1502 THEN POP_ASSUM(fun th-> ASM_REWRITE_TAC[VECTOR_ARITH`A%B%C= (A*B)%C`;VECTOR_ARITH`&1 %A=A`;VECTOR_ARITH`A%(B+C)=A%B+A%C`] THEN ASSUME_TAC(SYM(th)))
1503 THEN STRIP_TAC
1504 THEN SUBGOAL_THEN`w IN aff{(x:real^3),v}` ASSUME_TAC
1505 THENL[REWRITE_TAC[aff;AFFINE_HULL_2;IN_ELIM_THM;] THEN EXISTS_TAC`inv(t3-t2') *(t1'-t1)`
1506 THEN EXISTS_TAC`inv(t3-t2') *(t3'-t2)` THEN ASM_REWRITE_TAC[REAL_ARITH`A*B+A*C=A*(B+C)`];
1507
1508 ASM_SET_TAC[]]]]);;
1509
1510
1511
1512 let aff_gt3_subset_aff_gt=prove(`!x:real^3 v:real^3 u:real^3 v1:real^3.
1513 DISJOINT {x} {v,u} /\ ~collinear{x,v,v1}
1514 /\ v1 IN aff_gt {x} {v,u}
1515 ==>
1516 aff_gt {x} {v,v1} SUBSET aff_gt {x} {v,u}`,
1517 REPEAT STRIP_TAC
1518 THEN POP_ASSUM MP_TAC
1519 THEN MRESA_TAC th3[`x:real^3`;`v:real^3`;`v1:real^3`]
1520 THEN MRESAL_TAC  AFF_GT_1_2[`x:real^3`;`v:real^3`;`u:real^3`][IN_ELIM_THM]
1521 THEN MRESAL_TAC  AFF_GT_1_2[`x:real^3`;`v:real^3`;`v1:real^3`][IN_ELIM_THM;SUBSET]
1522 THEN REPEAT STRIP_TAC
1523 THEN POP_ASSUM MP_TAC
1524 THEN ASM_REWRITE_TAC[VECTOR_ARITH`t1' % x + t2' % v + t3' % (t1 % x + t2 % v + t3 % u)
1525 =(t1'+ t3'*t1) % x + (t2'+ t3' * t2) % v + (t3' * t3) % u:real^3`]
1526 THEN STRIP_TAC
1527 THEN EXISTS_TAC`t1' + t3' * t1:real`
1528 THEN EXISTS_TAC`t2' + t3' * t2:real`
1529 THEN EXISTS_TAC`t3' * t3:real`
1530 THEN MRESA_TAC REAL_LT_MUL[`t3':real`;`t2:real`]
1531 THEN MRESA_TAC REAL_LT_MUL[`t3':real`;`t3:real`]
1532 THEN ASM_REWRITE_TAC[REAL_ARITH`(t1' + t3' * t1) + (t2' + t3' * t2) + t3' * t3=
1533 t1'+ t2' + t3'*(t1+t2+t3)`; REAL_ARITH`A* &1=A`]
1534 THEN ASM_TAC
1535 THEN REAL_ARITH_TAC);;
1536
1537
1538
1539
1540 let aff_ge1_subset_aff_ge=prove(`!x:real^3 v:real^3 u:real^3 v1:real^3.
1541 DISJOINT {x} {v,u} /\ ~collinear{x,v1,u}
1542 /\ v1 IN aff_ge {x} {v,u}
1543 ==>
1544 aff_ge {x} {v1,u} SUBSET aff_ge {x} {v,u}`,
1545
1546 REPEAT STRIP_TAC
1547 THEN POP_ASSUM MP_TAC
1548 THEN MRESA_TAC th3[`x:real^3`;`v1:real^3`;`u:real^3`]
1549 THEN MRESAL_TAC  AFF_GE_1_2[`x:real^3`;`v:real^3`;`u:real^3`][IN_ELIM_THM]
1550 THEN MRESAL_TAC  AFF_GE_1_2[`x:real^3`;`v1:real^3`;`u:real^3`][IN_ELIM_THM;SUBSET]
1551 THEN REPEAT STRIP_TAC
1552 THEN POP_ASSUM MP_TAC
1553 THEN ASM_REWRITE_TAC[VECTOR_ARITH`t1' % x + t2' % (t1 % x + t2 % v + t3 % u) + t3' % u
1554 =(t1'+ t2'*t1) % x + (t2'* t2) % v + (t2' * t3  + t3') % u:real^3`]
1555 THEN STRIP_TAC
1556 THEN EXISTS_TAC`t1' + t2' * t1:real`
1557 THEN EXISTS_TAC`t2' * t2:real`
1558 THEN EXISTS_TAC`t2' * t3 +t3':real`
1559 THEN MP_TAC(REAL_ARITH`&0<t2'==> &0<= t2'`)
1560 THEN RESA_TAC
1561 THEN MRESA_TAC REAL_LE_MUL[`t2':real`;`t2:real`]
1562 THEN MRESA_TAC REAL_LE_MUL[`t2':real`;`t3:real`]
1563 THEN ASM_REWRITE_TAC[REAL_ARITH`(t1' + t2' * t1) + t2' * t2 + t2' * t3 + t3'=
1564 t1'+t2'*(t1+t2+t3)+t3'`; REAL_ARITH`A* &1=A`]
1565 THEN ASM_TAC
1566 THEN REAL_ARITH_TAC);;
1567
1568
1569 let aff_ge_1_1_subset_aff_ge_fan=prove(`!x:real^3 v:real^3 u:real^3 v1:real^3.
1570 DISJOINT {x} {v,u} /\ ~(x=v1)
1571 /\ v1 IN aff_ge {x} {v,u}
1572 ==>
1573 aff_ge {x} {v1} SUBSET aff_ge {x} {v,u}`,
1574
1575 REPEAT STRIP_TAC
1576 THEN POP_ASSUM MP_TAC
1577 THEN MRESAL_TAC  AFF_GE_1_2[`x:real^3`;`v:real^3`;`u:real^3`][IN_ELIM_THM]
1578 THEN MRESAL_TAC  AFF_GE_1_1[`x:real^3`;`v1:real^3`][IN_ELIM_THM;SUBSET]
1579 THEN REPEAT STRIP_TAC
1580 THEN POP_ASSUM MP_TAC
1581 THEN ASM_REWRITE_TAC[VECTOR_ARITH`t1' % x + t2' % (t1 % x + t2 % v + t3 % u)
1582 =(t1'+ t2'*t1) % x + (t2'* t2) % v + (t2' * t3 ) % u:real^3`]
1583 THEN STRIP_TAC
1584 THEN EXISTS_TAC`t1' + t2' * t1:real`
1585 THEN EXISTS_TAC`t2' * t2:real`
1586 THEN EXISTS_TAC`t2' * t3 :real`
1587 THEN MP_TAC(REAL_ARITH`&0<t2'==> &0<= t2'`)
1588 THEN RESA_TAC
1589 THEN MRESA_TAC REAL_LE_MUL[`t2':real`;`t2:real`]
1590 THEN MRESA_TAC REAL_LE_MUL[`t2':real`;`t3:real`]
1591 THEN ASM_REWRITE_TAC[REAL_ARITH`(t1' + t2' * t1) + t2' * t2 + t2' * t3 =
1592 t1'+t2'*(t1+t2+t3)`; REAL_ARITH`A* &1=A`]);;
1593
1594
1595
1596 let decomposition_planar_by_angle_fan=prove(`!x:real^3 v:real^3 u:real^3 w:real^3.
1597 ~ collinear {x,v,u} /\ ~collinear {x,v,w}
1598 /\ w IN aff_ge {x,v} {u}
1599 ==> u IN aff_gt {x} {v,w} \/ w IN aff_ge {x} {v,u}`,
1600 REPEAT STRIP_TAC
1601 THEN MRESAL_TAC aff_ge_inter_aff_ge[`(x:real^3)`;`(v:real^3)`;`(u:real^3)`][INTER; IN_ELIM_THM]
1602 THEN REMOVE_ASSUM_TAC
1603 THEN POP_ASSUM MP_TAC
1604 THEN MRESA_TAC AZIM_EQ_0_GE[`x:real^3`;`v:real^3`;`w:real^3`; `u:real^3`]
1605 THEN POP_ASSUM(fun th-> REWRITE_TAC[SYM(th)])
1606 THEN MRESA_TAC AZIM_EQ_0_ALT[`x:real^3`;`v:real^3`;`w:real^3`; `u:real^3`]
1607 THEN MRESA_TAC th3[`x:real^3`;`v:real^3`;`w:real^3`]
1608 THEN MRESAL_TAC  AFF_GT_2_1[`x:real^3`;`v:real^3`;`w:real^3`][IN_ELIM_THM]
1609 THEN REPEAT STRIP_TAC
1610 THEN DISJ_CASES_TAC(REAL_ARITH`(&0 < t2) \/   &0 <= --(t2:real)`)
1611 THENL[
1612 SUBGOAL_THEN `u IN aff_gt {x} {v,w:real^3}` ASSUME_TAC
1613 THENL[
1614 MRESAL_TAC  AFF_GT_1_2[`x:real^3`;`v:real^3`;`w:real^3`][IN_ELIM_THM]
1615 THEN EXISTS_TAC`t1:real`
1616 THEN EXISTS_TAC`t2:real`
1617 THEN EXISTS_TAC`t3:real`
1618 THEN MP_TAC(REAL_ARITH`&0< t3==> &0 <= t3:real`)
1619 THEN ASM_REWRITE_TAC[];
1620 POP_ASSUM MP_TAC THEN SET_TAC[]];
1621 MRESA_TAC remove_variable_fan[`x:real^3`; `v:real^3`; `w:real^3`;`u:real^3`;`t1:real`;`t2:real`;`t3:real`]
1622 THEN POP_ASSUM MP_TAC
1623 THEN POP_ASSUM MP_TAC
1624 THEN POP_ASSUM(fun th-> REWRITE_TAC[SYM(th);])
1625 THEN DISCH_TAC
1626 THEN REWRITE_TAC[VECTOR_ARITH`inv t3 % u - (inv t3 * t1) % x - (inv t3 * t2) % v
1627 =(--inv t3 * t1) % x + inv t3 % u + (inv t3 * (--t2)) % v`]
1628 THEN MP_TAC(REAL_ARITH`&0<t3==> ~( t3= &0)`)
1629 THEN RESA_TAC
1630 THEN MRESA1_TAC REAL_MUL_LINV`t3:real`
1631 THEN MRESA1_TAC REAL_LT_INV`t3:real`
1632 THEN MP_TAC(REAL_ARITH`&0< inv t3==> &0 <= inv t3`)
1633 THEN RESA_TAC
1634 THEN MRESA_TAC REAL_LE_MUL[`inv t3:real`;`-- (t2:real)`]
1635 THEN DISCH_TAC
1636 THEN SUBGOAL_THEN `w IN aff_ge {x, u} {v:real^3}` ASSUME_TAC
1637 THENL[
1638 MRESA_TAC th3[`x:real^3`;`v:real^3`;`u:real^3`]
1639 THEN MRESAL_TAC  AFF_GE_2_1[`x:real^3`;`u:real^3`;`v:real^3`][IN_ELIM_THM]
1640 THEN EXISTS_TAC`(--inv t3 * t1):real`
1641 THEN EXISTS_TAC`inv t3:real`
1642 THEN EXISTS_TAC`(inv t3 * --t2):real`
1643 THEN ASM_REWRITE_TAC[REAL_ARITH`--inv t3 * t1 + inv t3 + inv t3 * --t2=
1644 inv t3 * (t3+ &1- (t1 +t2 + t3))`; REAL_ARITH`a + &1 - &1 =a`];
1645 POP_ASSUM MP_TAC THEN SET_TAC[]]]);;
1646
1647
1648 let point_in_aff_ge=prove(`!(x:real^3) (v:real^3) (w:real^3).
1649 ~collinear {x,v,w}
1650 ==>
1651 x IN aff_ge {x} {v,w}
1652 /\ v IN aff_ge {x} {v,w}
1653 /\ w IN aff_ge {x} {v,w}`,
1654
1655 REPEAT GEN_TAC THEN STRIP_TAC THEN MRESA_TAC th3 [`x:real^3`;`v:real^3`;`w:real^3`]
1656   THEN MP_TAC(ISPECL[`x:real^3`;`v:real^3`;`w:real^3`]AFF_GE_1_2)
1657 THEN RESA_TAC
1658                 THEN ASM_REWRITE_TAC[IN_ELIM_THM]
1659 THEN STRIP_TAC
1660 THENL[ EXISTS_TAC`&1:real`
1661 THEN EXISTS_TAC`&0:real`
1662 THEN EXISTS_TAC`&0:real`
1663 THEN REDUCE_VECTOR_TAC
1664 THEN REAL_ARITH_TAC;
1665 STRIP_TAC
1666 THENL[ EXISTS_TAC`&0:real`
1667 THEN EXISTS_TAC`&1:real`
1668 THEN EXISTS_TAC`&0:real`
1669 THEN REDUCE_VECTOR_TAC
1670 THEN REAL_ARITH_TAC;
1671
1672 EXISTS_TAC`&0:real`
1673 THEN EXISTS_TAC`&0:real`
1674 THEN EXISTS_TAC`&1:real`
1675 THEN REDUCE_VECTOR_TAC
1676 THEN REAL_ARITH_TAC]]);;
1677
1678
1679 let aff_ge_subset_aff_gt_union_aff_ge=prove(`!(x:real^3) (v:real^3) (w:real^3).
1680 ~collinear {x,v,w}
1681 ==>
1682 aff_ge {x} {v , w} SUBSET  (aff_gt {x , v} {w}) UNION (aff_ge {x} {v})`,
1683 REPEAT STRIP_TAC THEN MRESA_TAC th3 [`x:real^3`;`v:real^3`;`w:real^3`]
1684   THEN MP_TAC(ISPECL[`x:real^3`;`v:real^3`;`w:real^3`]AFF_GE_1_2)
1685                 THEN ASM_REWRITE_TAC[] THEN DISCH_TAC
1686                 THEN MP_TAC(ISPECL[`x:real^3`;`v:real^3`;`w:real^3`]AFF_GT_2_1)
1687                 THEN ASM_REWRITE_TAC[] THEN DISCH_TAC
1688                 THEN MP_TAC(ISPECL[`x:real^3`;`v:real^3`]AFF_GE_1_1)
1689                 THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN ASM_REWRITE_TAC[SUBSET; UNION;IN_ELIM_THM]
1690   THEN GEN_TAC THEN
1691 REWRITE_TAC[REAL_ARITH `(&0 <= (t3:real)) <=> (&0 < t3) \/ ( t3 = &0)`; TAUT `(a \/ b) /\ (c \/ d) /\ e /\ f <=> ((a \/ b)/\ c /\ e /\ f) \/ ((a \/ b) /\ d /\ e /\ f)`; EXISTS_OR_THM] THEN
1692 MATCH_MP_TAC MONO_OR THEN
1693 SUBGOAL_THEN `((?t1:real t2:real t3:real.
1694        (&0 < t2 \/ t2 = &0) /\
1695         &0< t3 /\
1696        t1 + t2 + t3 = &1 /\
1697        (x':real^3) = t1 % x + t2 % v + t3 % w)
1698   ==> (?t1 t2 t3.
1699             &0< t3 /\ t1 + t2 + t3 = &1 /\ x' = t1 % x + t2 % v + t3 % w))` ASSUME_TAC
1700 THENL
1701 [MESON_TAC[];
1702      ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN
1703      REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN GEN_TAC THEN
1704      REWRITE_TAC[REAL_ARITH `(&0< (t2:real) \/ (t2 = &0)) <=> ( &0<= t2)`] THEN STRIP_TAC THEN POP_ASSUM MP_TAC THEN
1705      POP_ASSUM MP_TAC THEN ASM_REWRITE_TAC[] THEN
1706      REWRITE_TAC [REAL_ARITH `(a:real)+ &0 = a`; VECTOR_ARITH  `&0 % (w:real^3) = vec 0`;
1707      VECTOR_ARITH `  ((x':real^3) = (t1:real) % (x:real^3) + (t2:real) % (v:real^3) + vec 0)<=> ( x' = t1 % x + t2 % v )` ]
1708        THEN MESON_TAC[]]);;
1709
1710 let pos_in_aff_ge_fan=prove(`!x:real^3 v:real^3 u:real^3 a:real.
1711 DISJOINT {x} {v,u}
1712 /\ &0<a /\ a< &1
1713 ==>
1714 (&1-a)%v + a % u IN aff_ge {x} {v,u:real^3}`,
1715
1716 REPEAT STRIP_TAC
1717 THEN MRESAL_TAC AFF_GE_1_2[`x:real^3`;`v:real^3`;`u:real^3`][IN_ELIM_THM]
1718 THEN EXISTS_TAC`&0`
1719 THEN EXISTS_TAC`&1 -a:real`
1720 THEN EXISTS_TAC`a:real`
1721 THEN MP_TAC(REAL_ARITH`&0< a /\ a  < &1 ==> &0 <= &1 - a /\ &0 <= a`)
1722 THEN RESA_TAC
1723 THEN ASM_REWRITE_TAC[]
1724 THEN REDUCE_VECTOR_TAC
1725 THEN REAL_ARITH_TAC);;
1726
1727
1728
1729 let aff_gt1_subset_aff_gt=prove(`!x:real^3 v:real^3 u:real^3 v1:real^3.
1730 DISJOINT {x} {v,u} /\ ~collinear {x,v1,u}
1731 /\ v1 IN aff_gt {x} {v,u}
1732 ==>
1733 aff_gt {x} {v1,u} SUBSET aff_gt {x} {v,u}`,
1734
1735 REPEAT STRIP_TAC
1736 THEN POP_ASSUM MP_TAC
1737 THEN MRESA_TAC th3[`x:real^3`;`v1:real^3`;`u:real^3`]
1738 THEN MRESAL_TAC  AFF_GT_1_2[`x:real^3`;`v:real^3`;`u:real^3`][IN_ELIM_THM]
1739 THEN MRESAL_TAC  AFF_GT_1_2[`x:real^3`;`v1:real^3`;`u:real^3`][IN_ELIM_THM;SUBSET]
1740 THEN REPEAT STRIP_TAC
1741 THEN POP_ASSUM MP_TAC
1742 THEN ASM_REWRITE_TAC[VECTOR_ARITH`t1' % x + t2' % (t1 % x + t2 % v + t3 % u) + t3' % u
1743 =(t1'+ t2'*t1) % x + (t2'* t2) % v + (t2' * t3  + t3') % u:real^3`]
1744 THEN STRIP_TAC
1745 THEN EXISTS_TAC`t1' + t2' * t1:real`
1746 THEN EXISTS_TAC`t2' * t2:real`
1747 THEN EXISTS_TAC`t2' * t3 +t3':real`
1748 THEN MP_TAC(REAL_ARITH`&0<t2'==> &0<= t2'`)
1749 THEN RESA_TAC
1750 THEN MRESA_TAC REAL_LT_MUL[`t2':real`;`t2:real`]
1751 THEN MRESA_TAC REAL_LT_MUL[`t2':real`;`t3:real`]
1752 THEN ASM_REWRITE_TAC[REAL_ARITH`(t1' + t2' * t1) + t2' * t2 + t2' * t3 + t3'=
1753 t1'+t2'*(t1+t2+t3)+t3'`; REAL_ARITH`A* &1=A`]
1754 THEN ASM_TAC
1755 THEN REAL_ARITH_TAC);;
1756
1757
1758 let aff_ge_eq_aff_gt_union_aff_ge=prove(`!(x:real^3) (v:real^3) (w:real^3).
1759 ~collinear {x,v,w}
1760 ==>
1761 aff_ge {x} {v , w} =  (aff_gt {x} {v,w}) UNION (aff_ge {x} {v}) UNION (aff_ge {x} {w})`,
1762
1763 REPEAT STRIP_TAC THEN MRESA_TAC th3 [`x:real^3`;`v:real^3`;`w:real^3`]
1764   THEN MP_TAC(ISPECL[`x:real^3`;`v:real^3`;`w:real^3`]AFF_GE_1_2)
1765                 THEN ASM_REWRITE_TAC[] THEN DISCH_TAC
1766                 THEN MP_TAC(ISPECL[`x:real^3`;`v:real^3`;`w:real^3`]AFF_GT_1_2)
1767                 THEN ASM_REWRITE_TAC[] THEN DISCH_TAC
1768                 THEN MP_TAC(ISPECL[`x:real^3`;`v:real^3`]AFF_GE_1_1)
1769                 THEN MP_TAC(ISPECL[`x:real^3`;`w:real^3`]AFF_GE_1_1) THEN RESA_TAC THEN RESA_TAC
1770                 THEN ASM_REWRITE_TAC[EXTENSION;UNION;IN_ELIM_THM]
1771 THEN GEN_TAC THEN EQ_TAC
1772 THENL[STRIP_TAC
1773 THEN MP_TAC(REAL_ARITH`&0<= t2/\ &0<=t3==> (t2= &0)\/ (t3= &0)\/ (&0<t2 /\ &0<t3)`)
1774 THEN RESA_TAC
1775 THENL[
1776 SUBGOAL_THEN `(?t1' t2'.
1777       &0 <= t2' /\
1778       t1' + t2' = &1 /\
1779       t1 % x + &0 % v + t3 % w = t1' % x + t2' % w:real^3)`ASSUME_TAC
1780 THENL[
1781 EXISTS_TAC`t1:real`
1782 THEN EXISTS_TAC`t3:real`
1783 THEN REDUCE_VECTOR_TAC
1784 THEN ASM_REWRITE_TAC[]
1785 THEN ASM_TAC THEN REAL_ARITH_TAC;
1786 POP_ASSUM MP_TAC THEN SET_TAC[]];
1787
1788 SUBGOAL_THEN `(?t1' t2'.
1789       &0 <= t2' /\
1790       t1' + t2' = &1 /\
1791       t1 % x + t2 % v + &0 % w = t1' % x + t2' % v:real^3)`ASSUME_TAC
1792 THENL[
1793 EXISTS_TAC`t1:real`
1794 THEN EXISTS_TAC`t2:real`
1795 THEN REDUCE_VECTOR_TAC
1796 THEN ASM_REWRITE_TAC[]
1797 THEN ASM_TAC THEN REAL_ARITH_TAC;
1798 POP_ASSUM MP_TAC THEN SET_TAC[]];
1799
1800 SUBGOAL_THEN `(?t1' t2' t3'.
1801       &0 < t2' /\
1802       &0 < t3' /\
1803       t1' + t2' + t3' = &1 /\
1804       t1 % x + t2 % v + t3 % w = t1' % x + t2' % v + t3' % w:real^3)`ASSUME_TAC
1805 THENL[
1806 EXISTS_TAC`t1:real`
1807 THEN EXISTS_TAC`t2:real`
1808 THEN EXISTS_TAC`t3:real`
1809 THEN REDUCE_VECTOR_TAC
1810 THEN ASM_REWRITE_TAC[]
1811 THEN ASM_TAC THEN REAL_ARITH_TAC;
1812 POP_ASSUM MP_TAC THEN SET_TAC[]]];
1813
1814 STRIP_TAC
1815 THENL[
1816 EXISTS_TAC`t1:real`
1817 THEN EXISTS_TAC`t2:real`
1818 THEN EXISTS_TAC`t3:real`
1819 THEN REDUCE_VECTOR_TAC
1820 THEN ASM_REWRITE_TAC[]
1821 THEN ASM_TAC THEN REAL_ARITH_TAC;
1822 EXISTS_TAC`t1:real`
1823 THEN EXISTS_TAC`t2:real`
1824 THEN EXISTS_TAC`&0:real`
1825 THEN REDUCE_VECTOR_TAC
1826 THEN ASM_REWRITE_TAC[]
1827 THEN ASM_TAC THEN REAL_ARITH_TAC;
1828 EXISTS_TAC`t1:real`
1829 THEN EXISTS_TAC`&0:real`
1830 THEN EXISTS_TAC`t2:real`
1831 THEN REDUCE_VECTOR_TAC
1832 THEN ASM_REWRITE_TAC[]
1833 THEN ASM_TAC THEN REAL_ARITH_TAC]]);;
1834
1835 let AFFINE_HULL_1=prove(`!a. affine hull {a} ={u % a| u = &1}`,
1836   SIMP_TAC[AFFINE_HULL_FINITE; FINITE_INSERT; FINITE_RULES] THEN
1837   SIMP_TAC[AFFINE_HULL_FINITE_STEP; FINITE_INSERT; FINITE_RULES] THEN
1838   REWRITE_TAC[REAL_ARITH `x - y = z:real <=> x = y + z`;
1839               VECTOR_ARITH `x - y = z:real^N <=> x = y + z`] THEN
1840   REWRITE_TAC[VECTOR_ADD_RID; REAL_ADD_RID] THEN SET_TAC[]);;
1841
1842
1843 let aff_ge1_1_subset_aff_ge=prove(`!x:real^3 v:real^3 u:real^3 v1:real^3.
1844 DISJOINT {x} {v,u} /\ ~(x=v1)
1845 /\ v1 IN aff_ge {x} {v,u}
1846 ==>
1847 aff_ge {x} {v1} SUBSET aff_ge {x} {v,u}`,
1848 REPEAT STRIP_TAC
1849 THEN POP_ASSUM MP_TAC
1850 THEN MRESAL_TAC  AFF_GE_1_2[`x:real^3`;`v:real^3`;`u:real^3`][IN_ELIM_THM]
1851 THEN MRESAL_TAC  AFF_GE_1_1[`x:real^3`;`v1:real^3`;][IN_ELIM_THM;SUBSET]
1852 THEN REPEAT STRIP_TAC
1853 THEN POP_ASSUM MP_TAC
1854 THEN ASM_REWRITE_TAC[VECTOR_ARITH`t1' % x + t2' % (t1 % x + t2 % v + t3 % u)
1855 =(t1'+ t2'*t1) % x + (t2'* t2) % v + (t2' * t3 ) % u:real^3`]
1856 THEN STRIP_TAC
1857 THEN EXISTS_TAC`t1' + t2' * t1:real`
1858 THEN EXISTS_TAC`t2' * t2:real`
1859 THEN EXISTS_TAC`t2' * t3:real`
1860 THEN MP_TAC(REAL_ARITH`&0<t2'==> &0<= t2'`)
1861 THEN RESA_TAC
1862 THEN MRESA_TAC REAL_LE_MUL[`t2':real`;`t2:real`]
1863 THEN MRESA_TAC REAL_LE_MUL[`t2':real`;`t3:real`]
1864 THEN ASM_REWRITE_TAC[REAL_ARITH`(t1' + t2' * t1) + t2' * t2 + t2' * t3 =
1865 t1'+t2'*(t1+t2+t3)`; REAL_ARITH`A* &1=A`]
1866 THEN ASM_TAC
1867 THEN REAL_ARITH_TAC);;
1868
1869
1870
1871 let properties1_inside_fan=prove(`!x:real^3 u:real^3 w:real^3.
1872 DISJOINT {x} {u,w}
1873 /\ &0<a /\ a< &1
1874 ==> (&1-a)%u+ a%w IN aff_ge {x} {u,w:real^3}`,
1875 REPEAT STRIP_TAC
1876 THEN  MRESAL_TAC AFF_GE_1_2[`x:real^3`;`u:real^3`;`w:real^3`][IN_ELIM_THM]
1877 THEN EXISTS_TAC`&0`
1878 THEN EXISTS_TAC`&1 -a:real`
1879 THEN EXISTS_TAC`a:real`
1880 THEN MP_TAC(REAL_ARITH`&0< a /\ a  < &1 ==> &0 <= &1 - a /\ &0 <= a`)
1881 THEN RESA_TAC
1882 THEN ASM_REWRITE_TAC[]
1883 THEN REDUCE_VECTOR_TAC
1884 THEN REAL_ARITH_TAC);;
1885
1886
1887
1888
1889 let properties_inside_collinear1_fan=prove(`!x:real^3 u:real^3 w:real^3.
1890 ~collinear{x,u,w}
1891 /\ &0<a /\ a< &1
1892 ==>  aff_ge {x} {u} INTER aff_ge {x} {(&1-a)%u+ a%w,w:real^3} SUBSET aff_ge {x} {}`,
1893
1894 REPEAT STRIP_TAC
1895 THEN MRESA_TAC properties_inside_collinear_fan[`(x:real^3)`;`(u:real^3)`;`(w:real^3)`;`a:real`]
1896 THEN MRESA_TAC th3[`(x:real^3)`;`((&1-a)%u+ a%w:real^3)`;`(w:real^3)`]
1897 THEN MRESA_TAC th3[`(x:real^3)`;`u:real^3`;`(w:real^3)`]
1898 THEN  MRESAL_TAC AFF_GE_1_2[`x:real^3`;`(&1-a)%u+ a%w:real^3`;`w:real^3`][IN_ELIM_THM]
1899 THEN  MRESAL_TAC AFF_GE_1_1[`x:real^3`;`u:real^3`][IN_ELIM_THM;INTER;SUBSET;AFF_GE_EQ_AFFINE_HULL;AFFINE_HULL_1]
1900 THEN REPEAT STRIP_TAC
1901 THEN EXISTS_TAC`&1`
1902 THEN REDUCE_VECTOR_TAC
1903 THEN POP_ASSUM MP_TAC
1904 THEN ASM_REWRITE_TAC[]
1905 THEN POP_ASSUM MP_TAC
1906 THEN MP_TAC(REAL_ARITH`&0<= t2' /\ &0 <= t3==> (t2'= &0 /\ t3 = &0)\/ (&0< t2' \/ &0 <t3)  `)
1907 THEN RESA_TAC
1908 THENL[REDUCE_ARITH_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC[]
1909 THEN REDUCE_VECTOR_TAC;
1910 STRIP_TAC THEN
1911 REWRITE_TAC[VECTOR_ARITH`t1 % x + t2 % u = t1' % x + t2' % ((&1 - a) % u + a % w) + t3 % w
1912 <=>  (t2'* a + t3) % w = (t1-t1') % x +( t2-t2' * (&1-a))% u   :real^3`]
1913 THEN MRESA_TAC REAL_LT_MUL[`t2':real`;`a:real`]
1914 THEN MP_TAC(REAL_ARITH` &0< t2'*(a) /\ &0<= t3 ==> &0 < t2'*(a)+t3 /\ ~(t2'*(a)+t3:real= &0)`) THEN RESA_TAC
1915 THEN MRESA1_TAC REAL_MUL_LINV`t2'*(a)+t3:real`
1916 THEN MRESA1_TAC REAL_LT_INV`t2'*(a)+t3:real`
1917 THEN STRIP_TAC
1918 THEN MP_TAC(SET_RULE`(t2'* a + t3) % w = (t1-t1') % x +( t2-t2' * (&1-a))% u:real^3
1919  ==> (inv (t2' * a+t3))%((t2'* a + t3) % w) = (inv (t2' * a+t3))%( (t1-t1') % x +( t2-t2' * (&1-a))% u)`)
1920 THEN POP_ASSUM (fun th->GEN_REWRITE_TAC(LAND_CONV o LAND_CONV o ONCE_DEPTH_CONV)[th])
1921 THEN ASM_REWRITE_TAC[VECTOR_ARITH`A%B%C=(A*B)%C`; VECTOR_ARITH`A%(B+C)=A%B+A%C`]
1922 THEN REDUCE_VECTOR_TAC
1923 THEN STRIP_TAC
1924 THEN SUBGOAL_THEN`w IN aff {x,u:real^3}`ASSUME_TAC
1925 THENL[REWRITE_TAC[aff;AFFINE_HULL_2;IN_ELIM_THM]
1926 THEN EXISTS_TAC`(inv (t2' * a+t3)) * (t1 - t1'):real`
1927 THEN EXISTS_TAC`(inv (t2' *  a+t3) * (t2 - t2' *(&1- a))):real`
1928 THEN ASM_REWRITE_TAC[REAL_ARITH`inv (t2' * a + t3) * (t1 - t1') + inv (t2' * a + t3) * (t2 - t2' * (&1 - a))
1929 = inv (t2' * a + t3) * ((t2'*a +t3)+(t1 + t2) -(t1'+ t2' +t3) ):real`; REAL_ARITH`A+ &1- &1= A`];
1930 ASM_MESON_TAC[]];
1931
1932 STRIP_TAC THEN
1933 REWRITE_TAC[VECTOR_ARITH`t1 % x + t2 % u = t1' % x + t2' % ((&1 - a) % u + a % w) + t3 % w
1934 <=>  (t2'* a + t3) % w = (t1-t1') % x +( t2-t2' * (&1-a))% u   :real^3`]
1935 THEN MP_TAC(REAL_ARITH`&0<a==> &0<=a`) THEN RESA_TAC
1936 THEN MRESA_TAC REAL_LE_MUL[`t2':real`;`a:real`]
1937 THEN MP_TAC(REAL_ARITH` &0<= t2'*(a) /\ &0< t3 ==> &0 < t2'*(a)+t3 /\ ~(t2'*(a)+t3:real= &0)`) THEN RESA_TAC
1938 THEN MRESA1_TAC REAL_MUL_LINV`t2'*(a)+t3:real`
1939 THEN MRESA1_TAC REAL_LT_INV`t2'*(a)+t3:real`
1940 THEN STRIP_TAC
1941 THEN MP_TAC(SET_RULE`(t2'* a + t3) % w = (t1-t1') % x +( t2-t2' * (&1-a))% u:real^3
1942  ==> (inv (t2' * a+t3))%((t2'* a + t3) % w) = (inv (t2' * a+t3))%( (t1-t1') % x +( t2-t2' * (&1-a))% u)`)
1943 THEN POP_ASSUM (fun th->GEN_REWRITE_TAC(LAND_CONV o LAND_CONV o ONCE_DEPTH_CONV)[th])
1944 THEN ASM_REWRITE_TAC[VECTOR_ARITH`A%B%C=(A*B)%C`; VECTOR_ARITH`A%(B+C)=A%B+A%C`]
1945 THEN REDUCE_VECTOR_TAC
1946 THEN STRIP_TAC
1947 THEN SUBGOAL_THEN`w IN aff {x,u:real^3}`ASSUME_TAC
1948 THENL[
1949 REWRITE_TAC[aff;AFFINE_HULL_2;IN_ELIM_THM]
1950 THEN EXISTS_TAC`(inv (t2' * a+t3)) * (t1 - t1'):real`
1951 THEN EXISTS_TAC`(inv (t2' *  a+t3) * (t2 - t2' *(&1- a))):real`
1952 THEN ASM_REWRITE_TAC[REAL_ARITH`inv (t2' * a + t3) * (t1 - t1') + inv (t2' * a + t3) * (t2 - t2' * (&1 - a))
1953 = inv (t2' * a + t3) * ((t2'*a +t3)+(t1 + t2) -(t1'+ t2' +t3) ):real`; REAL_ARITH`A+ &1- &1= A`];
1954 ASM_MESON_TAC[]]]);;
1955
1956
1957
1958
1959
1960 let exists_in_aff_gt=prove(`!x:real^3  v:real^3 u:real^3.
1961 ~collinear {x,v,u} ==> ?y:real^3. y IN aff_gt {x} {v, u}`,
1962 REPEAT STRIP_TAC
1963 THEN MRESA_TAC th3[`x:real^3`;`v:real^3`;`u:real^3`]
1964 THEN MRESAL_TAC  AFF_GT_1_2[`x:real^3`;`v:real^3`;`u:real^3`][IN_ELIM_THM]
1965 THEN EXISTS_TAC`&0 % x+ &1 / &2 % v+ &1/ &2 %u:real^3 `
1966 THEN EXISTS_TAC`&0`
1967 THEN EXISTS_TAC`&1/ &2`
1968 THEN EXISTS_TAC`&1/ &2`
1969 THEN ASM_REWRITE_TAC[]
1970 THEN REAL_ARITH_TAC);;
1971
1972
1973
1974 let in_aff_2_2_fan=prove(`!x:real^3 v:real^3 u:real^3 w:real^3.
1975 ~coplanar {x,v,u,w}
1976 ==>
1977 (!t:real. &0< t /\ t< &1
1978 ==> (!t1:real t2:real t3:real. &0<t3  /\ t1+t2+t3= &1
1979 ==>t1 % x + t2 % v + t3 % ((&1 - t) % u + t % w) IN aff_gt {x,v} {u,w}))`,
1980
1981
1982 REPEAT STRIP_TAC
1983 THEN MRESA_TAC notcoplanar_imp_notcollinear_fan[`x:real^3`;`v:real^3`;`u:real^3`;`w:real^3`]
1984 THEN MRESA_TAC th3[`x:real^3`;`v:real^3`;`u:real^3`]
1985 THEN MRESA_TAC th3[`x:real^3`;`u:real^3`;`w:real^3`]
1986 THEN MRESA_TAC th3[`x:real^3`;`v:real^3`;`w:real^3`]
1987 THEN SUBGOAL_THEN `DISJOINT {x,v:real^3} {u,w:real^3}` ASSUME_TAC
1988 THENL[
1989 REWRITE_TAC[DISJOINT_SYM;SET_RULE`{v:real^3,w:real^3}= {v} UNION {w}`;DISJOINT_UNION]
1990 THEN REWRITE_TAC[SET_RULE`{v} UNION {w}={v:real^3,w:real^3}`]
1991 THEN ONCE_REWRITE_TAC[DISJOINT_SYM]
1992 THEN ASM_REWRITE_TAC[];
1993 MRESAL_TAC AFF_GT_2_2[`x:real^3`;`v:real^3`;`u:real^3`;`w:real^3`][IN_ELIM_THM]
1994 THEN EXISTS_TAC`t1:real`
1995 THEN EXISTS_TAC`t2:real`
1996 THEN EXISTS_TAC`t3*(&1-t):real`
1997 THEN EXISTS_TAC`t3*(t):real`
1998 THEN ASM_REWRITE_TAC[REAL_ARITH`t1 +t2+  t3 * (&1 - t) + t3 * t = t1+t2+t3:real`;VECTOR_ARITH`t1 % x + t2 % v + t3 % ((&1 - t) % u + t % w) =
1999  t1 % x + t2 % v + (t3 * (&1 - t)) % u  + (t3 * t) % w:real^3`]
2000 THEN STRIP_TAC THEN MATCH_MP_TAC REAL_LT_MUL
2001 THEN ASM_TAC
2002 THEN REAL_ARITH_TAC]);;
2003
2004
2005
2006
2007
2008
2009
2010 let condition_to_in_aff_gt_by_angle=prove(`!x:real^3 v:real^3 u:real^3 s1:real.
2011 ~collinear {x,v,u} /\  &0< (v - x) dot (u - x) /\ &0< s1
2012 /\ s1< atn ((norm ((v - x) cross (u - x))) * inv((v - x) dot (u - x)))
2013 ==>
2014 sin s1 % e1_fan x v u + cos s1 % e3_fan x v u + x IN aff_gt {x} {v, u}`,
2015 REPEAT STRIP_TAC
2016 THEN ASSUME_TAC(ISPEC`(norm ((v - x) cross (u - x)) * inv ((v - x) dot (u - x))):real`ATN_BOUNDS)
2017 THEN MP_TAC (REAL_ARITH`s1< atn ((norm ((v - x) cross (u - x))) * inv((v - x) dot (u - x)))
2018 /\ atn ((norm ((v - x) cross (u - x))) * inv((v - x) dot (u - x))) < pi/ &2
2019 ==> s1< pi / &2`) THEN RESA_TAC
2020 THEN MRESA_TAC th3[`x:real^3`;`v:real^3`;`u:real^3`]
2021 THEN MRESAL_TAC AFF_GT_1_2[`x:real^3`;`v:real^3`;`u:real^3`][IN_ELIM_THM]
2022 THEN REWRITE_TAC[VECTOR_ARITH`sin s1 % e1_fan x v u + cos s1 % e3_fan x v u + x =
2023      t1 % x + t2 % v + t3 % u
2024 <=> sin s1 % e1_fan x v u + cos s1 % e3_fan x v u  =
2025      (t1- &1) % x + t2 % v + t3 % u`;e1_fan;e2_fan;e3_fan;CROSS_LMUL;CROSS_RMUL]
2026 THEN ONCE_REWRITE_TAC[CROSS_SKEW;]
2027 THEN REWRITE_TAC[CROSS_LAGRANGE;VECTOR_ARITH`-- (A-B) = B-A:real^3`]
2028 THEN SUBGOAL_THEN`~(norm((v:real^3)-(x:real^3))= &0)` ASSUME_TAC
2029 THENL[
2030 ASM_REWRITE_TAC[NORM_EQ_0;VECTOR_ARITH`v-x=vec 0<=> x=v`];
2031 MP_TAC(ISPEC`norm((v:real^3)-(x:real^3))`REAL_MUL_LINV)
2032 THEN RESA_TAC
2033 THEN REWRITE_TAC[VECTOR_ARITH`A%B%C=(A*B)%C`; REAL_ARITH`(((A*B)*D)*D)=A*B*(D pow 2)`;]
2034 THEN ONCE_REWRITE_TAC[VECTOR_ARITH`A%(B-C)=A%B-A%C`]
2035 THEN ASM_REWRITE_TAC[VECTOR_ARITH`A%B%C=(A*B)%C`;DOT_SQUARE_NORM;REAL_ARITH`(A*B*C pow 2) * D pow 2=A*B*(C*D) pow 2`;REAL_ARITH`A* &1 pow 2=A`;NORM_MUL;REAL_ABS_INV;REAL_ABS_NORM;REAL_INV_MUL;REAL_INV_INV
2036 ; ]
2037 THEN ASM_REWRITE_TAC[REAL_ARITH`A*(B*C) * D pow 2= A*C * D*(D*B)`;REAL_ARITH`A*B* &1= A*B`;VECTOR_ARITH`A-B+C%D-C%E=A-B+C%(D-E)`;VECTOR_ARITH`A-C%D+B%D=A+(B-C)%D`;
2038 REAL_ARITH`A*B-(C*D*B)*E=B*(A-C*D*E)`]
2039 THEN ONCE_REWRITE_TAC[GSYM CROSS_SKEW]
2040 THEN SUBGOAL_THEN`~(norm((v - x) cross (u - x:real^3))= &0)` ASSUME_TAC
2041 THENL[
2042 ASM_REWRITE_TAC[NORM_EQ_0]
2043 THEN MP_TAC(ISPECL[`v-x:real^3`;`u-x:real^3`]CROSS_EQ_0)
2044 THEN ONCE_REWRITE_TAC[GSYM COLLINEAR_3;]
2045 THEN RESA_TAC
2046 THEN ONCE_REWRITE_TAC[SET_RULE`{A,B,C}={B,A,C}`]
2047 THEN ASM_REWRITE_TAC[];
2048 MP_TAC(ISPEC`norm((v - x) cross (u - x:real^3))`REAL_MUL_LINV)
2049 THEN RESA_TAC
2050 THEN ASSUME_TAC(ISPEC`(v - x) cross (u - x:real^3)`NORM_POS_LE)
2051 THEN MP_TAC(REAL_ARITH`~(norm ((v - x) cross (u - x:real^3)) = &0)/\ &0 <= norm ((v - x) cross (u - x:real^3))==> &0< norm ((v - x) cross (u - x:real^3)) `)
2052 THEN RESA_TAC
2053 THEN MRESA1_TAC REAL_LT_INV`norm((v - x) cross (u - x:real^3))`
2054
2055 THEN ASSUME_TAC(ISPEC`(v - x:real^3)`NORM_POS_LE)
2056 THEN MP_TAC(REAL_ARITH`~(norm ((v - x:real^3)) = &0)/\ &0 <= norm ((v - x:real^3))==> &0< norm ((v - x:real^3)) `)
2057 THEN RESA_TAC
2058 THEN MRESA1_TAC REAL_LT_INV`norm((v - x:real^3))`
2059 THEN MRESA1_TAC COS_POS_PI2`s1:real`
2060 THEN MRESA1_TAC SIN_POS_PI2`s1:real`
2061 THEN EXISTS_TAC`&1-(sin s1 * norm (v - x) * inv (norm ((v - x) cross (u - x))))
2062 -(inv (norm (v - x)) *
2063       (cos s1 -
2064        sin s1 * inv (norm ((v - x) cross (u - x))) * ((v - x) dot (u - x:real^3))))`
2065 THEN EXISTS_TAC `(inv (norm (v - x)) *
2066       (cos s1 -
2067        sin s1 * inv (norm ((v - x) cross (u - x))) * ((v - x) dot (u - x:real^3))))`
2068 THEN EXISTS_TAC`(sin s1 * norm (v - x) * inv (norm ((v - x) cross (u - x:real^3))))`
2069 THEN STRIP_TAC
2070 THENL[
2071 MATCH_MP_TAC REAL_LT_MUL
2072 THEN ASM_REWRITE_TAC[REAL_ARITH`&0<A-B<=> B<A`]
2073 THEN ASSUME_TAC(PI_WORKS)
2074 THEN MP_TAC(REAL_ARITH`&0< pi /\ &0< s1 ==> --(pi / &2) < s1`)
2075 THEN RESA_TAC
2076 THEN MRESAL_TAC  TAN_MONO_LT[`s1:real`;`atn (norm ((v - x) cross (u - x)) * inv ((v - x) dot (u - x))):real`][ATN_TAN]
2077 THEN MRESAL_TAC REAL_LT_LMUL[`inv (norm ((v - x) cross (u - x:real^3)))`;`tan s1:real`;`norm ((v - x) cross (u - x)) * inv ((v - x) dot (u - x:real^3))`][REAL_ARITH`A*B*C=(A*B)*C`;REAL_ARITH`&1*A=A`]
2078 THEN MP_TAC(REAL_ARITH`&0<(v - x) dot (u - x:real^3)==> ~((v - x) dot (u - x:real^3)= &0)`)
2079 THEN RESA_TAC
2080 THEN MP_TAC(ISPEC`(v - x) dot (u - x:real^3)`REAL_MUL_LINV)
2081 THEN RESA_TAC
2082 THEN MP_TAC(REAL_ARITH`&0<cos s1 ==> ~(cos s1= &0)`)
2083 THEN RESA_TAC
2084 THEN MP_TAC(ISPEC`cos s1`REAL_MUL_LINV)
2085 THEN RESA_TAC
2086 THEN MRESAL_TAC REAL_LT_RMUL[`inv (norm ((v - x) cross (u - x:real^3)))* tan s1:real`;`inv ((v - x) dot (u - x:real^3))`;`(v - x) dot (u - x:real^3)`][REAL_ARITH`(A*B)*C=A*C*B`;tan]
2087
2088 THEN MRESAL_TAC REAL_LT_RMUL[`inv (norm ((v - x) cross (u - x:real^3)))* ((v - x) dot (u - x:real^3))* sin s1 / cos s1`;`&1`;`cos s1`][REAL_ARITH`&1* A=A`;real_div;REAL_ARITH`(A*B*C*D)*E=(C*A*B)*(D*E)`;REAL_ARITH`A* &1=A`]
2089 THEN ASM_TAC THEN REAL_ARITH_TAC;
2090 STRIP_TAC
2091 THENL[
2092 MATCH_MP_TAC REAL_LT_MUL
2093 THEN ASM_REWRITE_TAC[]
2094 THEN MATCH_MP_TAC REAL_LT_MUL
2095 THEN ASM_REWRITE_TAC[];
2096
2097 STRIP_TAC
2098 THENL[
2099 REAL_ARITH_TAC;
2100 VECTOR_ARITH_TAC]]]]]);;
2101
2102
2103
2104
2105
2106
2107
2108
2109 let condition1_to_in_aff_gt_by_angle=prove(`!x:real^3 v:real^3 u:real^3 s1:real.
2110 ~collinear {x,v,u} /\ &0< s1 /\ s1< pi/ &2
2111 /\ (v - x) dot (u - x:real^3) <= &0
2112 ==>
2113 sin s1 % e1_fan x v u + cos s1 % e3_fan x v u + x IN aff_gt {x} {v, u}`,
2114
2115 REPEAT STRIP_TAC
2116 THEN MRESA_TAC th3[`x:real^3`;`v:real^3`;`u:real^3`]
2117 THEN MRESAL_TAC AFF_GT_1_2[`x:real^3`;`v:real^3`;`u:real^3`][IN_ELIM_THM]
2118 THEN REWRITE_TAC[VECTOR_ARITH`sin s1 % e1_fan x v u + cos s1 % e3_fan x v u + x =
2119      t1 % x + t2 % v + t3 % u
2120 <=> sin s1 % e1_fan x v u + cos s1 % e3_fan x v u  =
2121      (t1- &1) % x + t2 % v + t3 % u`;e1_fan;e2_fan;e3_fan;CROSS_LMUL;CROSS_RMUL]
2122 THEN ONCE_REWRITE_TAC[CROSS_SKEW;]
2123 THEN REWRITE_TAC[CROSS_LAGRANGE;VECTOR_ARITH`-- (A-B) = B-A:real^3`]
2124 THEN SUBGOAL_THEN`~(norm((v:real^3)-(x:real^3))= &0)` ASSUME_TAC
2125 THENL[
2126 ASM_REWRITE_TAC[NORM_EQ_0;VECTOR_ARITH`v-x=vec 0<=> x=v`];
2127 MP_TAC(ISPEC`norm((v:real^3)-(x:real^3))`REAL_MUL_LINV)
2128 THEN RESA_TAC
2129 THEN REWRITE_TAC[VECTOR_ARITH`A%B%C=(A*B)%C`; REAL_ARITH`(((A*B)*D)*D)=A*B*(D pow 2)`;]
2130 THEN ONCE_REWRITE_TAC[VECTOR_ARITH`A%(B-C)=A%B-A%C`]
2131 THEN ASM_REWRITE_TAC[VECTOR_ARITH`A%B%C=(A*B)%C`;DOT_SQUARE_NORM;REAL_ARITH`(A*B*C pow 2) * D pow 2=A*B*(C*D) pow 2`;REAL_ARITH`A* &1 pow 2=A`;NORM_MUL;REAL_ABS_INV;REAL_ABS_NORM;REAL_INV_MUL;REAL_INV_INV
2132 ; ]
2133 THEN ASM_REWRITE_TAC[REAL_ARITH`A*(B*C) * D pow 2= A*C * D*(D*B)`;REAL_ARITH`A*B* &1= A*B`;VECTOR_ARITH`A-B+C%D-C%E=A-B+C%(D-E)`;VECTOR_ARITH`A-C%D+B%D=A+(B-C)%D`;
2134 REAL_ARITH`A*B-(C*D*B)*E=B*(A-C*D*E)`]
2135 THEN ONCE_REWRITE_TAC[GSYM CROSS_SKEW]
2136 THEN SUBGOAL_THEN`~(norm((v - x) cross (u - x:real^3))= &0)` ASSUME_TAC
2137 THENL[
2138 ASM_REWRITE_TAC[NORM_EQ_0]
2139 THEN MP_TAC(ISPECL[`v-x:real^3`;`u-x:real^3`]CROSS_EQ_0)
2140 THEN ONCE_REWRITE_TAC[GSYM COLLINEAR_3;]
2141 THEN RESA_TAC
2142 THEN ONCE_REWRITE_TAC[SET_RULE`{A,B,C}={B,A,C}`]
2143 THEN ASM_REWRITE_TAC[];
2144 MP_TAC(ISPEC`norm((v - x) cross (u - x:real^3))`REAL_MUL_LINV)
2145 THEN RESA_TAC
2146 THEN ASSUME_TAC(ISPEC`(v - x) cross (u - x:real^3)`NORM_POS_LE)
2147 THEN MP_TAC(REAL_ARITH`~(norm ((v - x) cross (u - x:real^3)) = &0)/\ &0 <= norm ((v - x) cross (u - x:real^3))==> &0< norm ((v - x) cross (u - x:real^3)) `)
2148 THEN RESA_TAC
2149 THEN MRESA1_TAC REAL_LT_INV`norm((v - x) cross (u - x:real^3))`
2150
2151 THEN ASSUME_TAC(ISPEC`(v - x:real^3)`NORM_POS_LE)
2152 THEN MP_TAC(REAL_ARITH`~(norm ((v - x:real^3)) = &0)/\ &0 <= norm ((v - x:real^3))==> &0< norm ((v - x:real^3)) `)
2153 THEN RESA_TAC
2154 THEN MRESA1_TAC REAL_LT_INV`norm((v - x:real^3))`
2155 THEN MRESA1_TAC COS_POS_PI2`s1:real`
2156 THEN MRESA1_TAC SIN_POS_PI2`s1:real`
2157 THEN EXISTS_TAC`&1-(sin s1 * norm (v - x) * inv (norm ((v - x) cross (u - x))))
2158 -(inv (norm (v - x)) *
2159       (cos s1 -
2160        sin s1 * inv (norm ((v - x) cross (u - x))) * ((v - x) dot (u - x:real^3))))`
2161 THEN EXISTS_TAC `(inv (norm (v - x)) *
2162       (cos s1 -
2163        sin s1 * inv (norm ((v - x) cross (u - x))) * ((v - x) dot (u - x:real^3))))`
2164 THEN EXISTS_TAC`(sin s1 * norm (v - x) * inv (norm ((v - x) cross (u - x:real^3))))`
2165 THEN STRIP_TAC
2166 THENL[
2167 MATCH_MP_TAC REAL_LT_MUL
2168 THEN ASM_REWRITE_TAC[REAL_ARITH`&0<A-B<=> B<A`]
2169 THEN MATCH_MP_TAC(REAL_ARITH`&0< cos s1 /\ sin s1 * inv (norm ((v - x) cross (u - x))) * ((v - x) dot (u - x)) <= &0==> sin s1 * inv (norm ((v - x) cross (u - x))) * ((v - x) dot (u - x)) < cos s1`)
2170 THEN ASM_REWRITE_TAC[REAL_ARITH`A *B *C<= &0<=> &0<= A*B*(-- C)`]
2171 THEN MATCH_MP_TAC REAL_LE_MUL
2172 THEN MP_TAC(REAL_ARITH`&0< sin s1==> &0<= sin s1`) THEN RESA_TAC
2173 THEN ASM_REWRITE_TAC[]
2174 THEN MATCH_MP_TAC REAL_LE_MUL
2175 THEN MP_TAC(REAL_ARITH`&0< inv (norm ((v - x) cross (u - x)))==> &0<= inv (norm ((v - x) cross (u - x)))`) THEN RESA_TAC
2176 THEN ASM_REWRITE_TAC[]
2177 THEN ASM_TAC THEN REAL_ARITH_TAC;
2178 STRIP_TAC
2179 THENL[
2180 MATCH_MP_TAC REAL_LT_MUL
2181 THEN ASM_REWRITE_TAC[]
2182 THEN MATCH_MP_TAC REAL_LT_MUL
2183 THEN ASM_REWRITE_TAC[];
2184 STRIP_TAC
2185 THENL[
2186 REAL_ARITH_TAC;
2187 VECTOR_ARITH_TAC]]]]]);;
2188
2189
2190
2191
2192
2193
2194 let scale_in_edges_fan=prove(`!(x:real^3) (v:real^3) (u:real^3) (w:real^3).
2195 DISJOINT {x} {v,u}
2196 /\ w IN aff_gt {x} {v,u}
2197 ==>
2198 (?a t:real. &0<a /\ &0<t /\ t< &1
2199 /\ a%(w-x) = (&1-t)% v+ t%u-x)`,
2200
2201 REPEAT STRIP_TAC
2202 THEN POP_ASSUM MP_TAC
2203 THEN MRESAL_TAC AFF_GT_1_2[`x:real^3`;`v:real^3`;`u:real^3`][IN_ELIM_THM]
2204 THEN STRIP_TAC
2205 THEN POP_ASSUM MP_TAC
2206 THEN ONCE_REWRITE_TAC[VECTOR_ARITH`w = t1 % x + t2 % v + t3 % u
2207 <=> w-x = ((t1+t2+t3)- &1) % x + (((t1+t2+t3) -t1)- t3)% (v-x) + t3 % (u-x):real^3`]
2208 THEN ASM_REWRITE_TAC[REAL_ARITH`&1- &1= &0`] THEN REDUCE_VECTOR_TAC
2209 THEN MP_TAC(REAL_ARITH`&0< t2 /\ &0< t3 /\ t1+t2+t3= &1 ==> ~(&1-t1= &0)/\ &0< &1- t1`)
2210 THEN RESA_TAC
2211 THEN MRESA1_TAC REAL_MUL_LINV `(&1-t1:real)`
2212 THEN MRESA1_TAC REAL_LT_INV `(&1-t1:real)`
2213 THEN MRESA_TAC REAL_LT_MUL [`inv(&1-t1:real)`;`t3:real`]
2214 THEN MRESA_TAC REAL_LT_MUL [`inv(&1-t1:real)`;`t2:real`]
2215 THEN POP_ASSUM MP_TAC
2216 THEN ONCE_REWRITE_TAC[REAL_ARITH`inv (&1 - t1) * t2=inv (&1 - t1) * ((t1+t2+t3)-t1)- inv(&1-t1)*t3:real`]
2217 THEN RESA_TAC
2218 THEN STRIP_TAC
2219 THEN MP_TAC(SET_RULE`
2220 w - x = (&1 - t1 - t3) % (v - x) + t3 % (u - x):real^3
2221 ==> (inv (&1- t1))%(w - x ) = (inv (&1-t1))%((&1 - t1 - t3) % (v - x) + t3 % (u - x))
2222 `)
2223 THEN POP_ASSUM (fun th->GEN_REWRITE_TAC(LAND_CONV o LAND_CONV o ONCE_DEPTH_CONV)[th])
2224 THEN ASM_REWRITE_TAC[VECTOR_ARITH`A%B%C= (A*B)%C`;VECTOR_ARITH`A%(B+C)=A%B+A%C`;REAL_ARITH`inv (&1 - t1) * (&1 - t1 - t3)=inv (&1 - t1) * (&1 - t1) - inv (&1 - t1) * (t3)`;VECTOR_ARITH`(&1-A)%(U-X)+A%(V-X)=(&1-A)%U+A%V-X`]
2225 THEN REDUCE_VECTOR_TAC
2226 THEN STRIP_TAC
2227 THEN EXISTS_TAC`inv(&1- t1:real)`
2228 THEN EXISTS_TAC`inv(&1-t1) *t3:real`
2229 THEN ASM_REWRITE_TAC[REAL_ARITH`A< &1<=> &0< &1- A`]);;
2230
2231
2232
2233
2234 let aff_gt_imp_not_collinear=prove(`!x u v w:real^3.
2235 ~collinear{x,v,u}/\ w IN aff_gt{x,v} {u}==> ~collinear{x,v,w}`,
2236 REPEAT STRIP_TAC
2237 THEN POP_ASSUM MP_TAC
2238 THEN POP_ASSUM MP_TAC
2239 THEN MRESA_TAC th3[`(x:real^3)` ;` (v:real^3)`;`(u:real^3) `;]
2240 THEN POP_ASSUM MP_TAC
2241 THEN MRESAL_TAC  AFF_GT_2_1[`x:real^3`;`v:real^3`;`u:real^3`][IN_ELIM_THM]
2242 THEN ASM_REWRITE_TAC[collinear_fan;aff;AFFINE_HULL_2;IN_ELIM_THM;]
2243 THEN DISCH_THEN(LABEL_TAC"A")
2244 THEN REPEAT STRIP_TAC
2245 THEN REMOVE_THEN "A" MP_TAC
2246 THEN ASM_REWRITE_TAC[]
2247 THEN POP_ASSUM MP_TAC
2248 THEN ASM_REWRITE_TAC[VECTOR_ARITH`t1 % x + t2 % v + t3 % u = u' % x + v' % v<=>
2249 t3 % u = (u'-t1) % x + (v'-t2) % v`]
2250 THEN MP_TAC(REAL_ARITH`&0<t3==> ~(t3= &0)`) THEN RESA_TAC
2251 THEN MRESA1_TAC REAL_MUL_LINV`t3:real`
2252 THEN STRIP_TAC
2253 THEN MP_TAC(SET_RULE`t3 % u = (u' - t1) % x + (v' - t2) % v:real^3
2254  ==> (inv (t3))%(t3 % u ) = (inv (t3))%( (u' - t1) % x + (v' - t2) % v)`)
2255 THEN POP_ASSUM (fun th->GEN_REWRITE_TAC(LAND_CONV o LAND_CONV o ONCE_DEPTH_CONV)[th])
2256 THEN ASM_REWRITE_TAC[VECTOR_ARITH`A%B%C=(A*B)%C`; VECTOR_ARITH`A%(B+C)=A%B+A%C`]
2257 THEN REDUCE_VECTOR_TAC
2258 THEN STRIP_TAC
2259 THEN EXISTS_TAC`(inv (t3)) * (u' - t1):real`
2260 THEN EXISTS_TAC`(inv (t3)) * (v' -t2):real`
2261 THEN ASM_REWRITE_TAC[REAL_ARITH`inv (t3) * (u' - t1) + inv (t3) * (v'- t2)
2262 = inv (t3) * (t3+ (u'+v')- (t1 + t2 +t3)):real`; REAL_ARITH`A+ &1- &1= A`]);;
2263
2264
2265 let aff_gt_1_2_scale_fan=prove(`!x:real^3 v:real^3 u:real^3 w:real^3 a:real.
2266 &0< a /\ a % (u-x)= w-x /\ ~collinear {x,w,v}
2267 ==> aff_gt {x} {u,v} =aff_gt {x} {w,v}`,
2268 REPEAT GEN_TAC
2269 THEN GEOM_ORIGIN_TAC `x:real^3`
2270 THEN REDUCE_VECTOR_TAC
2271 THEN REPEAT STRIP_TAC
2272 THEN MP_TAC(REAL_ARITH`&0<a:real==> ~(a= &0)`) THEN RESA_TAC
2273 THEN MRESA1_TAC REAL_MUL_LINV `a:real`
2274 THEN MRESA1_TAC REAL_LT_INV`a:real`
2275 THEN FIND_ASSUM(MP_TAC)`a %u=w:real^3`
2276 THEN STRIP_TAC
2277 THEN MP_TAC(SET_RULE`
2278 a%u=w:real^3
2279 ==> (inv (a))%(a%u) = (inv (a))%(w)`)
2280 THEN ASM_REWRITE_TAC[VECTOR_ARITH`A%B%C=(A*B)%C:real^3`]
2281 THEN REWRITE_TAC[VECTOR_ARITH`&1 % u= inv a % w<=> inv a % w= u`]
2282 THEN STRIP_TAC
2283 THEN MRESA_TAC COLLINEAR_SPECIAL_SCALE[`a:real`;`u:real^3`;`v:real^3`]
2284 THEN MRESA_TAC th3[`((vec 0):real^3)` ;` (u:real^3)`;`(v:real^3) `;]
2285 THEN MRESA_TAC th3[`((vec 0):real^3)` ;` (w:real^3)`;`(v:real^3) `;]
2286 THEN MRESAL_TAC  AFF_GT_1_2[`(vec 0):real^3`;`u:real^3`;`v:real^3`][IN_ELIM_THM;EXTENSION]
2287 THEN MRESAL_TAC  AFF_GT_1_2[`(vec 0):real^3`;`w:real^3`;`v:real^3`][IN_ELIM_THM]
2288 THEN REDUCE_VECTOR_TAC
2289 THEN GEN_TAC THEN EQ_TAC
2290 THENL[ STRIP_TAC
2291 THEN EXISTS_TAC`&1- inv a * t2-t3:real`
2292 THEN EXISTS_TAC `inv a * t2:real`
2293 THEN EXISTS_TAC `t3:real`
2294 THEN ASM_REWRITE_TAC[REAL_ARITH`&1 - inv a * t2 - t3 + inv a * t2 + t3 = &1`;VECTOR_ARITH`(A*B)%C=B%(A%C)`]
2295 THEN MATCH_MP_TAC REAL_LT_MUL
2296 THEN ASM_REWRITE_TAC[];
2297 STRIP_TAC
2298 THEN EXISTS_TAC`&1- a * t2-t3:real`
2299 THEN EXISTS_TAC `a * t2:real`
2300 THEN EXISTS_TAC `t3:real`
2301 THEN ASM_REWRITE_TAC[REAL_ARITH`&1 - a * t2 - t3 + a * t2 + t3 = &1`;VECTOR_ARITH`(A*B)%C=B%(A%C)`]
2302 THEN MATCH_MP_TAC REAL_LT_MUL
2303 THEN ASM_REWRITE_TAC[]]);;
2304
2305
2306
2307
2308 let in_aff_gt_1_2=prove(`!x:real^3 v:real^3 u:real^3 t:real.
2309 DISJOINT {x} {v,u} /\ &0< t /\ t< &1==>  (&1-t)% v+ t% u IN aff_gt {x} {v,u}`,
2310 REPEAT STRIP_TAC
2311 THEN MRESAL_TAC  AFF_GT_1_2[`x:real^3`;`v:real^3`;`u:real^3`][IN_ELIM_THM;]
2312 THEN EXISTS_TAC`&0`
2313 THEN EXISTS_TAC`&1 - t:real`
2314 THEN EXISTS_TAC`t:real`
2315 THEN ASM_REWRITE_TAC[REAL_ARITH`&0< &1 - t<=> t< &1`;REAL_ARITH`&0 + &1 - t + t= &1`]
2316 THEN VECTOR_ARITH_TAC);;
2317
2318
2319 let sym_line1_fan=prove(`!x y z:real^N. x IN aff {y, z} /\ ~(x=y)
2320 ==> z IN aff {x,y}`,
2321 REPEAT GEN_TAC
2322 THEN REWRITE_TAC[aff;AFFINE_HULL_2;IN_ELIM_THM]
2323 THEN STRIP_TAC
2324 THEN ASM_TAC
2325 THEN DISJ_CASES_TAC(REAL_ARITH`(v= &0)\/ ~(v= &0)`)
2326 THENL[ ASM_REWRITE_TAC[]
2327 THEN REDUCE_ARITH_TAC
2328 THEN RESA_TAC
2329 THEN REDUCE_VECTOR_TAC
2330 THEN RESA_TAC
2331 THEN SET_TAC[];
2332 MP_TAC(ISPEC`(v:real)`REAL_MUL_LINV)
2333 THEN RESA_TAC
2334 THEN REPEAT STRIP_TAC
2335 THEN EXISTS_TAC`inv(v:real)`
2336 THEN EXISTS_TAC`-- inv(v:real) *u`
2337 THEN ASM_REWRITE_TAC[REAL_ARITH` inv v + --inv v * u = inv v * (v+ &1- (u+v)) `;REAL_ARITH`A+ &1 - &1= A`;VECTOR_ARITH`inv v % (u % y + v % z) + (--inv v * u) % y=(inv v * v) % z `]
2338 THEN REDUCE_VECTOR_TAC]);;
2339
2340
2341
2342 let POINT_IN_LINE=prove(`!x y:real^N. x IN  aff {x,y}`,
2343 REPEAT GEN_TAC
2344 THEN REWRITE_TAC[aff;AFFINE_HULL_2;IN_ELIM_THM]
2345 THEN EXISTS_TAC`&1`
2346 THEN EXISTS_TAC`&0`
2347 THEN REDUCE_VECTOR_TAC
2348 THEN REAL_ARITH_TAC);;
2349
2350 let POINT_IN_LINE1=prove(`!x y:real^N. y IN  aff {x,y}`,
2351 REPEAT GEN_TAC
2352 THEN REWRITE_TAC[aff;AFFINE_HULL_2;IN_ELIM_THM]
2353 THEN EXISTS_TAC`&0`
2354 THEN EXISTS_TAC`&1`
2355 THEN REDUCE_VECTOR_TAC
2356 THEN REAL_ARITH_TAC);;
2357
2358
2359 let AFFINE_HULL_AFFINE_EQ =prove(`!s:real^N->bool. affine hull (affine hull s)= affine  hull s`,
2360 STRIP_TAC THEN MATCH_MP_TAC AFFINE_HULLS_EQ
2361 THEN ASSUME_TAC(ISPEC `s:real^N->bool` AFFINE_AFFINE_HULL)
2362 THEN MRESA1_TAC AFFINE_HULL_EQ`affine hull s:real^N->bool`
2363 THEN MRESA_TAC HULL_SUBSET[`affine:(real^N->bool)->bool`;` s:real^N->bool`;]
2364 THEN SET_TAC[]);;
2365
2366 let sym_line0_fan=prove( `!x y z:real^N. x IN aff {y, z} /\ DISJOINT {x} {y,z}
2367 ==> aff {x,z} SUBSET aff {x,y}`,
2368 REPEAT GEN_TAC
2369 THEN STRIP_TAC
2370 THEN MP_TAC(SET_RULE`DISJOINT {x} {y,z}==> ~(x=y:real^N)`)
2371 THEN RESA_TAC
2372 THEN MRESA_TAC sym_line1_fan[`x:real^N`;`y:real^N`;`z:real^N`]
2373 THEN MP_TAC(SET_RULE`x IN aff {x, y} /\ z IN aff {x, y} ==> {x, z:real^N} SUBSET aff {x, y}`)
2374 THEN REWRITE_TAC[POINT_IN_LINE;]
2375 THEN RESA_TAC
2376 THEN MRESA_TAC HULL_MONO[`affine:(real^N->bool)->bool`;` {x, z:real^N}`;`aff {x, y:real^N}`]
2377 THEN POP_ASSUM MP_TAC
2378 THEN REWRITE_TAC[aff;AFFINE_HULL_AFFINE_EQ ]);;
2379
2380
2381 let sym_line_fan=prove(`!x y z:real^N. x IN aff {y, z} /\ DISJOINT {x} {y,z}
2382 ==> aff {x,z} = aff {x,y}`,
2383 REPEAT STRIP_TAC
2384 THEN MRESA_TAC sym_line0_fan[`x:real^N`;`y:real^N`;`z:real^N`]
2385 THEN MRESA_TAC sym_line0_fan[`x:real^N`;`z:real^N`;`y:real^N`]
2386 THEN POP_ASSUM MP_TAC
2387 THEN ONCE_REWRITE_TAC[SET_RULE`{A,B}={B,A}`]
2388 THEN ASM_REWRITE_TAC[]
2389 THEN ONCE_REWRITE_TAC[SET_RULE`{A,B}={B,A}`]
2390 THEN POP_ASSUM MP_TAC
2391 THEN SET_TAC[]);;
2392
2393 let sym_line01_fan=prove(`!x y z:real^N. x IN aff {y, z} /\ DISJOINT {y} {x,z}
2394 ==> aff {y,x} SUBSET aff {y,z}`,
2395 REPEAT GEN_TAC
2396 THEN STRIP_TAC
2397 THEN MP_TAC(SET_RULE`y IN aff {y, z} /\ x IN aff {y, z} ==> {y,x:real^N} SUBSET aff {y,z}`)
2398 THEN ASM_REWRITE_TAC[POINT_IN_LINE;]
2399 THEN STRIP_TAC
2400 THEN MRESA_TAC HULL_MONO[`affine:(real^N->bool)->bool`;` {y,x:real^N}`;`aff { y,z:real^N}`]
2401 THEN POP_ASSUM MP_TAC
2402 THEN REWRITE_TAC[aff;AFFINE_HULL_AFFINE_EQ ]);;
2403
2404
2405 let sym_line02_fan=prove(`!x y z:real^N. x IN aff {y, z} /\ DISJOINT {y} {x,z}
2406 ==> aff {y,z} SUBSET aff {y,x}`,
2407 REPEAT GEN_TAC
2408 THEN STRIP_TAC
2409 THEN MP_TAC(SET_RULE`DISJOINT {y} {x,z}==> ~(x=y:real^N)`)
2410 THEN RESA_TAC
2411 THEN MRESA_TAC sym_line1_fan[`x:real^N`;`y:real^N`;`z:real^N`]
2412 THEN MP_TAC(SET_RULE`y IN aff {y, x} /\ z IN aff {y, x} ==> {y,z:real^N} SUBSET aff {y,x}`)
2413 THEN ASM_REWRITE_TAC[POINT_IN_LINE;]
2414 THEN STRIP_TAC
2415 THEN MRESA_TAC HULL_MONO[`affine:(real^N->bool)->bool`;` {y,z:real^N}`;`aff { y,x:real^N}`]
2416 THEN POP_ASSUM MP_TAC
2417 THEN REWRITE_TAC[aff;AFFINE_HULL_AFFINE_EQ ]
2418 THEN POP_ASSUM MP_TAC
2419 THEN ASSUME_TAC(SET_RULE`{y,x}={x,y}`)
2420 THEN POP_ASSUM (fun th-> ASM_REWRITE_TAC[th;])
2421 THEN REWRITE_TAC[aff]
2422 THEN RESA_TAC);;
2423
2424
2425
2426 let sym_line_fan0=prove(`!x y z:real^N. x IN aff {y, z} /\ DISJOINT {x} {y,z} /\ DISJOINT {y} {x,z}
2427 ==> aff {x,z} = aff {y,z}`,
2428 REPEAT STRIP_TAC
2429 THEN MRESA_TAC sym_line_fan[`x:real^N`;`y:real^N`;`z:real^N`]
2430 THEN SUBGOAL_THEN `y IN aff {x,z:real^N}` ASSUME_TAC
2431 THENL[ASM_REWRITE_TAC[POINT_IN_LINE1];
2432 MRESA_TAC sym_line_fan[`y:real^N`;`x:real^N`;`z:real^N`]
2433 THEN ASSUME_TAC(SET_RULE`{x,y}={y,x:real^N}`)
2434 THEN ASM_REWRITE_TAC[]]);;
2435
2436
2437 let sym_line_fan1=prove(`!x y z:real^N. x IN aff {y, z} /\ DISJOINT {y} {x,z}
2438 ==> aff {y,z} = aff {y,x}`,
2439 REPEAT STRIP_TAC
2440 THEN MRESA_TAC sym_line01_fan[`x:real^N`;`y:real^N`;`z:real^N`]
2441 THEN MRESA_TAC sym_line02_fan[`x:real^N`;`y:real^N`;`z:real^N`]
2442 THEN POP_ASSUM MP_TAC
2443 THEN POP_ASSUM MP_TAC
2444 THEN SET_TAC[]);;
2445
2446
2447 let aff_ge_1_1_subset_aff_fan=prove(`!x y z:real^3. ~(y=z) /\ x IN aff_ge {y} {z} ==> x IN aff {y,z} `,
2448 REPEAT STRIP_TAC
2449 THEN POP_ASSUM MP_TAC
2450 THEN MRESAL_TAC AFF_GE_1_1[`y:real^3`;`z:real^3`][IN_ELIM_THM]
2451 THEN REWRITE_TAC[aff;AFFINE_HULL_2;IN_ELIM_THM]
2452 THEN STRIP_TAC
2453 THEN EXISTS_TAC`t1:real`
2454 THEN EXISTS_TAC`t2:real`
2455 THEN ASM_REWRITE_TAC[]);;
2456
2457
2458 let place_there_point_line_fan=prove(`!x:real^3 y:real^3 z:real^3.
2459 ~(x=y)/\ z IN aff {x,y}==> ?t:real. &0<t /\ t< &1 /\ (&1-t)%y+t % z IN aff_ge {x} {y}`,
2460 REPEAT GEN_TAC
2461 THEN REWRITE_TAC[aff; AFFINE_HULL_2;IN_ELIM_THM]
2462 THEN RESA_TAC
2463 THEN MRESAL_TAC AFF_GE_1_1[`x:real^3`;`y:real^3`][IN_ELIM_THM]
2464 THEN DISJ_CASES_TAC(REAL_ARITH`&0<= v \/ v< &0`)
2465 THENL[EXISTS_TAC`&1/ &2`
2466 THEN ASM_REWRITE_TAC[REAL_ARITH`&0< &1/ &2 /\ &1/ &2< &1`]
2467 THEN EXISTS_TAC`&1/ &2 *u`
2468 THEN EXISTS_TAC`&1/ &2*(&1+v)`
2469 THEN ASM_REWRITE_TAC[REAL_ARITH`&1/ &2 *u + &1/ &2 * (&1 + v)= &1/ &2 *(&1 +(u+v))`;REAL_ARITH`&1 / &2 * (&1 + &1) = &1`;VECTOR_ARITH`(&1 - &1 / &2) % y + &1 / &2 % (u % x + v % y) =
2470  (&1 / &2 * u) % x + (&1 / &2 * (&1 + v)) % y`]
2471 THEN MATCH_MP_TAC REAL_LE_MUL
2472 THEN ASM_REWRITE_TAC[REAL_ARITH`&0<= &1/ &2`]
2473 THEN MATCH_MP_TAC REAL_LE_ADD
2474 THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC;
2475 EXISTS_TAC`inv u`
2476 THEN POP_ASSUM MP_TAC
2477 THEN ASM_REWRITE_TAC[REAL_ARITH`v< &0 <=> (u+v)< u `]
2478 THEN STRIP_TAC
2479 THEN MP_TAC(REAL_ARITH`&1< u==> &0< u /\ ~(u= &0)`)
2480 THEN RESA_TAC
2481 THEN MRESA1_TAC REAL_LT_INV `u:real`
2482 THEN MRESA1_TAC REAL_INV_LT_1 `u:real`
2483 THEN MRESA1_TAC REAL_MUL_LINV `u:real`
2484 THEN EXISTS_TAC`&1`
2485 THEN EXISTS_TAC `&0`
2486 THEN ASM_REWRITE_TAC[REAL_ARITH`&0<= &0 /\ &1 + &0 = &1/\ u+ &1 - &1 =u`;VECTOR_ARITH`(&1 - inv u) % y + inv u % (u % x + v % y)=(&1 - inv u*(u+ &1- (u+v))) % y + (inv u * u) % x /\ (&1 - &1) % y + &1 % x = &1 % x + &0 % y`]]);;
2487
2488
2489
2490
2491 let permutes_4points_collinear=prove(`!x y z w:real^N.
2492 ~(x=y)/\ ~(x=z) /\ y IN aff {x,z}/\ ~collinear{x,y,w}==> ~collinear{x,z,w}`,
2493 REWRITE_TAC[collinear_fan]
2494 THEN REPEAT STRIP_TAC
2495 THEN ASM_REWRITE_TAC[]
2496 THEN POP_ASSUM MP_TAC
2497 THEN MP_TAC(SET_RULE`~(x=y)/\ ~(x=z) ==> DISJOINT {x} {y, z:real^N}`)
2498 THEN RESA_TAC
2499 THEN MRESA_TAC sym_line_fan1[`y:real^N`;`x:real^N`;`z:real^N`]);;
2500
2501
2502 let permutes_4points_collinear1=prove(`!x y z w:real^N.
2503 ~(x=y)/\ ~(x=z) /\  y IN aff {x,z}/\ ~collinear{x,z,w}==> ~collinear{x,y,w}`,
2504 REWRITE_TAC[collinear_fan]
2505 THEN REPEAT STRIP_TAC
2506 THEN ASM_REWRITE_TAC[]
2507 THEN POP_ASSUM MP_TAC
2508 THEN MP_TAC(SET_RULE`~(x=y)/\ ~(x=z) ==>DISJOINT {x} {y, z:real^N}`)
2509 THEN RESA_TAC
2510 THEN MRESA_TAC sym_line01_fan[`y:real^N`;`x:real^N`;`z:real^N`]
2511 THEN ASM_TAC  THEN SET_TAC[]);;
2512
2513
2514 let in_aff_gt_eq_azim=prove(`!x y z w0 w1:real^3.
2515 ~(x=z) /\ y IN aff_gt {x} {z}==> azim x y w0 w1=azim x z w0 w1`,
2516 REPEAT STRIP_TAC
2517 THEN POP_ASSUM MP_TAC
2518 THEN MRESAL_TAC AFF_GT_1_1[`x:real^3`;`z:real^3`][IN_ELIM_THM;SET_RULE`DISJOINT {x} {z}<=> ~(x=z)`]
2519 THEN ASM_TAC
2520 THEN GEOM_ORIGIN_TAC `x:real^3`
2521 THEN REPEAT STRIP_TAC
2522 THEN POP_ASSUM MP_TAC
2523 THEN ASM_REWRITE_TAC[VECTOR_ARITH`u % (x + vec 0) + v%(x+ z)= (u+v)%x+v %z`;VECTOR_ARITH`(x + y = &1 % x + v % z)<=> y = v % z`]
2524 THEN RESA_TAC
2525 THEN ASM_TAC THEN SET_TAC[AZIM_SPECIAL_SCALE]);;
2526
2527 let no_origin_aff_ge_is_aff_gt=prove(`!x y z:real^3.
2528 ~(x=y) /\ ~(x=z) /\ z IN aff_ge {x} {y}==> z IN aff_gt {x} {y}`,
2529 REPEAT STRIP_TAC
2530 THEN POP_ASSUM MP_TAC
2531 THEN MRESAL_TAC AFF_GT_1_1[`x:real^3`;`y:real^3`][IN_ELIM_THM;SET_RULE`DISJOINT {x} {z}<=> ~(x=z)`]
2532 THEN MRESAL_TAC AFF_GE_1_1[`x:real^3`;`y:real^3`][IN_ELIM_THM;SET_RULE`DISJOINT {x} {z}<=> ~(x=z)`]
2533 THEN STRIP_TAC
2534 THEN POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC
2535 THEN MP_TAC(REAL_ARITH`&0<= t2==> t2= &0 \/ &0< t2`)
2536 THEN RESA_TAC
2537 THEN REDUCE_ARITH_TAC
2538 THEN RESA_TAC
2539 THEN REDUCE_VECTOR_TAC
2540 THEN ASM_REWRITE_TAC[]
2541 THEN STRIP_TAC
2542 THEN EXISTS_TAC`t1:real`
2543 THEN EXISTS_TAC`t2:real`
2544 THEN ASM_REWRITE_TAC[]);;
2545
2546
2547
2548
2549 let aff_ge_2_1_is_exists_point_inaff_ge_1_2=prove(`!x:real^3 y:real^3 z:real^3 w:real^3.
2550 DISJOINT {x} {y,w} /\ DISJOINT {x,y} {w}/\ z IN aff_ge {x,y} {w}==> ?t. &0<t /\ t< &1 /\ (&1-t) %y+ t%z IN aff_ge {x} {y,w}`,
2551
2552 REPEAT STRIP_TAC
2553 THEN POP_ASSUM MP_TAC
2554 THEN MRESAL_TAC AFF_GE_2_1[`x:real^3`;`y:real^3`;`w:real^3`][IN_ELIM_THM]
2555 THEN STRIP_TAC
2556 THEN MRESAL_TAC AFF_GE_1_2[`x:real^3`;`y:real^3`;`w:real^3`][IN_ELIM_THM]
2557 THEN DISJ_CASES_TAC(REAL_ARITH`&0<= t2 \/ t2 < &0`)
2558 THENL[EXISTS_TAC`&1/ &2`
2559 THEN ASM_REWRITE_TAC[REAL_ARITH`&0< &1/ &2/\ &1/ &2 < &1`]
2560 THEN EXISTS_TAC`&1/ &2 * t1:real`
2561 THEN EXISTS_TAC`&1/ &2 * (t2+ &1):real`
2562 THEN EXISTS_TAC`&1/ &2 * t3:real`
2563 THEN ASM_REWRITE_TAC[REAL_ARITH`&1 / &2 * t1 + &1 / &2 * (t2 + &1) + &1 / &2 * t3 = &1/ &2 *(&1 +(t1+t2+t3))`;VECTOR_ARITH`(&1 - &1 / &2) % y + &1 / &2 % (t1 % x + t2 % y + t3 % w) =
2564  (&1 / &2 * t1) % x + (&1 / &2 * (t2 + &1)) % y + (&1 / &2 * t3) % w`;REAL_ARITH`&1/ &2 *(&1 + &1)= &1`]
2565 THEN STRIP_TAC
2566 THEN MATCH_MP_TAC REAL_LE_MUL
2567 THEN ASM_REWRITE_TAC[REAL_ARITH`&0<= &1/ &2`]
2568 THEN POP_ASSUM MP_TAC
2569 THEN REAL_ARITH_TAC;
2570
2571 EXISTS_TAC`inv(&1 - t2):real`
2572 THEN MP_TAC(REAL_ARITH`t2< &0 ==> &0< &1 -t2 /\ &1< &1 -t2 /\ &0<= &1 -t2 /\ ~(&1- t2= &0) `)
2573 THEN RESA_TAC
2574 THEN MRESA1_TAC REAL_LT_INV`&1-t2`
2575 THEN MRESA1_TAC REAL_LE_INV`&1-t2`
2576 THEN MRESA1_TAC REAL_MUL_LINV `&1- t2:real`
2577 THEN MRESA1_TAC REAL_INV_LT_1`&1- t2`
2578 THEN EXISTS_TAC`inv(&1 - t2)* t1:real`
2579 THEN EXISTS_TAC`inv(&1 - t2)* t2 + &1 - inv(&1 - t2):real`
2580 THEN EXISTS_TAC`inv(&1 - t2)* t3`
2581 THEN ASM_REWRITE_TAC[REAL_ARITH`inv (&1 - t2) * t1 +
2582  (inv (&1 - t2) * t2 + &1 - inv (&1 - t2)) +
2583  inv (&1 - t2) * t3= inv (&1 - t2) * (t1 +t2+t3)+ &1 - inv (&1 - t2) /\ inv (&1 - t2) * &1 + &1 - inv (&1 - t2) = &1`;VECTOR_ARITH`(&1 - inv (&1 - t2)) % y + inv (&1 - t2) % (t1 % x + t2 % y + t3 % w) =
2584  (inv (&1 - t2) * t1) % x +
2585  (inv (&1 - t2) * t2 + &1 - inv (&1 - t2)) % y +
2586  (inv (&1 - t2) * t3) % w`;REAL_ARITH`inv (&1 - t2) * t2 + &1 - inv (&1 - t2)= &1 - inv (&1 - t2) *(&1-t2)`;REAL_ARITH`&0<= &1 - &1`]
2587 THEN MATCH_MP_TAC REAL_LE_MUL
2588 THEN ASM_REWRITE_TAC[]]);;
2589
2590
2591
2592
2593 let point_in_aff_gt_2_1_change_point_in_aff_gt_1_2=prove(` !x:real^3 v:real^3 u:real^3 y:real^3.
2594  ~collinear {x,v,u}
2595 /\  y IN aff_gt {x} {v,u}
2596 ==> u IN aff_gt {x,v} {y}`,
2597 REPEAT STRIP_TAC
2598 THEN POP_ASSUM MP_TAC
2599 THEN DISCH_THEN(LABEL_TAC"YEU")
2600 THEN MRESA_TAC properties_of_collinear4_points_fan[`x:real^3`;`v:real^3`;`u:real^3`;`y:real^3`]
2601 THEN REMOVE_THEN "YEU" MP_TAC
2602 THEN MRESA_TAC th3[`x:real^3`;`v:real^3`;`u:real^3`;]
2603 THEN MRESA_TAC th3[`x:real^3`;`y:real^3`;`v:real^3`;]
2604 THEN MRESA_TAC AFF_GT_1_2[`x:real^3`;`v:real^3`;`u:real^3`;]
2605 THEN MRESAL_TAC AFF_GT_2_1[`x:real^3`;`v:real^3`;`y:real^3`;][IN_ELIM_THM]
2606 THEN RESA_TAC
2607 THEN MP_TAC(REAL_ARITH`&0< t3==> ~(t3= &0)`)
2608 THEN RESA_TAC
2609 THEN MRESA1_TAC REAL_LT_INV`t3:real`
2610 THEN MRESA1_TAC REAL_MUL_LINV`t3:real`
2611 THEN EXISTS_TAC`-- inv t3 * t1:real`
2612 THEN EXISTS_TAC`-- inv t3 * t2:real`
2613 THEN EXISTS_TAC`inv t3 :real`
2614 THEN ASM_REWRITE_TAC[REAL_ARITH`--inv t3 * t1 + --inv t3 * t2 + inv t3= inv t3 *( t3 + &1- (t1+t2+t3))`;REAL_ARITH`A+ &1- &1 =A`;VECTOR_ARITH`(--inv t3 * t1) % x +
2615  (--inv t3 * t2) % v +
2616  inv t3 % (t1 % x + t2 % v + t3 % u)= (inv t3 * t3) % u`]
2617 THEN VECTOR_ARITH_TAC);;
2618
2619 let pos_in_aff_gt_fan=prove(`!x:real^3 v:real^3 u:real^3 a:real.
2620 DISJOINT {x} {v,u}
2621 /\ &0<a /\ a< &1
2622 ==>
2623 (&1-a)%v + a % u IN aff_gt {x} {v,u:real^3}`,
2624
2625 REPEAT STRIP_TAC
2626 THEN MRESAL_TAC AFF_GT_1_2[`x:real^3`;`v:real^3`;`u:real^3`][IN_ELIM_THM]
2627 THEN EXISTS_TAC`&0`
2628 THEN EXISTS_TAC`&1 -a:real`
2629 THEN EXISTS_TAC`a:real`
2630 THEN MP_TAC(REAL_ARITH`&0< a /\ a  < &1 ==> &0 < &1 - a /\ &0 < a`)
2631 THEN RESA_TAC
2632 THEN ASM_REWRITE_TAC[]
2633 THEN REDUCE_VECTOR_TAC
2634 THEN REAL_ARITH_TAC);;
2635
2636
2637 let pos_in_aff_gt_2_1_fan=prove(`!x:real^3 v:real^3 u:real^3 a:real.
2638 DISJOINT {x,v} {u}
2639 /\ &0<a /\ a< &1
2640 ==>
2641 (&1-a)%v + a % u IN aff_gt {x,v} {u:real^3}`,
2642
2643 REPEAT STRIP_TAC
2644 THEN MRESAL_TAC AFF_GT_2_1[`x:real^3`;`v:real^3`;`u:real^3`][IN_ELIM_THM]
2645 THEN EXISTS_TAC`&0`
2646 THEN EXISTS_TAC`&1 -a:real`
2647 THEN EXISTS_TAC`a:real`
2648 THEN MP_TAC(REAL_ARITH`&0< a /\ a  < &1 ==> &0 < &1 - a /\ &0 < a`)
2649 THEN RESA_TAC
2650 THEN ASM_REWRITE_TAC[]
2651 THEN REDUCE_VECTOR_TAC
2652 THEN REAL_ARITH_TAC);;
2653
2654
2655
2656
2657
2658
2659 (* ========================================================================== *)
2660 (*                        SEGMENT       (^_^)              *)
2661 (* ========================================================================== *)
2662
2663
2664 let segment_in_segment=prove(`!x y z:real^N. z IN segment [x,y]==>  (!t. &0<= t /\ t<= &1 ==> (&1-t) %z +t %y IN segment[x,y])`,
2665 REWRITE_TAC[segment;IN_ELIM_THM]
2666 THEN REPEAT STRIP_TAC
2667 THEN ASM_REWRITE_TAC[]
2668 THEN EXISTS_TAC`(&1- t)* u+t:real`
2669 THEN REWRITE_TAC[VECTOR_ARITH`(&1 - t) % ((&1 - u) % x + u % y) + t % y =
2670  (&1 - ((&1 - t) * u + t)) % x + ((&1 - t) * u + t) % y:real^N`]
2671 THEN STRIP_TAC
2672 THENL[MATCH_MP_TAC REAL_LE_ADD
2673 THEN ASM_REWRITE_TAC[]
2674 THEN MATCH_MP_TAC REAL_LE_MUL
2675 THEN ASM_REWRITE_TAC[REAL_ARITH`&0<= &1- t<=> t<= &1`];
2676
2677 REWRITE_TAC[REAL_ARITH`(&1 - t) * u + t <= &1<=> &0<= (&1 - t) * (&1-u)`]
2678 THEN MATCH_MP_TAC REAL_LE_MUL
2679 THEN ASM_REWRITE_TAC[REAL_ARITH`&0<= &1- t<=> t<= &1`]]);;
2680
2681 let segmentsubset_aff_gt=prove(`!x y z w:real^N.
2682 DISJOINT {x} {y,z}/\ w IN aff_gt {x} {y,z}
2683 ==> !t. &0<= t /\ t< &1 ==> (&1-t) %w+t%z IN aff_gt {x} {y,z}`,
2684 REPEAT GEN_TAC THEN STRIP_TAC
2685 THEN POP_ASSUM MP_TAC
2686 THEN MRESAL_TAC AFF_GT_1_2[`x:real^N`;`y:real^N`;`z:real^N`][IN_ELIM_THM]
2687 THEN REPEAT STRIP_TAC
2688 THEN ASM_REWRITE_TAC[]
2689 THEN EXISTS_TAC`(&1-t)*t1:real`
2690 THEN EXISTS_TAC`(&1-t)*t2:real`
2691 THEN EXISTS_TAC`(&1-t)*t3+t:real`
2692 THEN ASM_REWRITE_TAC[VECTOR_ARITH`(&1 - t) % (t1 % x + t2 % y + t3 % z) + t % z =
2693  ((&1 - t) * t1) % x + ((&1 - t) * t2) % y + ((&1 - t) * t3 + t) % z:real^N`;REAL_ARITH`(&1 - t) * t1 + (&1 - t) * t2 + (&1 - t) * t3 + t=(&1 - t) * (t1 + t2 +t3) + t/\ (&1 - t) * &1 + t = &1`]
2694 THEN STRIP_TAC
2695 THENL[MATCH_MP_TAC REAL_LT_MUL
2696 THEN ASM_REWRITE_TAC[REAL_ARITH`&0< &1- t<=> t< &1`];
2697
2698 MATCH_MP_TAC (REAL_ARITH`&0<A /\ &0<=B==> &0< A+B`)
2699 THEN ASM_REWRITE_TAC[]
2700 THEN MATCH_MP_TAC REAL_LT_MUL
2701 THEN ASM_REWRITE_TAC[REAL_ARITH`&0< &1- t<=> t< &1`]]);;
2702
2703 (* ========================================================================== *)
2704 (*                        SOME LINEAR FUNCTIONS       (^_^)              *)
2705 (* ========================================================================== *)
2706
2707
2708 let linear_aff_fan=prove(`!x:real^3 v:real^3 u:real^3.
2709 linear (\(t:real^2). t$1 %(v-x)+t$2 %(u-x))`,
2710 REPEAT STRIP_TAC
2711 THEN MATCH_MP_TAC LINEAR_COMPOSE_ADD
2712 THEN STRIP_TAC
2713 THEN MATCH_MP_TAC LINEAR_VMUL_COMPONENT
2714 THEN SIMP_TAC[LINEAR_ID; DIMINDEX_2; ARITH]);;
2715
2716 let linear1_aff_fan=prove(`!x:real^3 v:real^3 u:real^3 w:real^3.
2717 linear (\(t:real^3). t$1 %(v-x)+t$2 %(u-x)+t$3 %(w-u))`,
2718 REPEAT STRIP_TAC
2719 THEN REPEAT(MATCH_MP_TAC LINEAR_COMPOSE_ADD THEN STRIP_TAC)
2720 THEN MATCH_MP_TAC LINEAR_VMUL_COMPONENT
2721 THEN SIMP_TAC[LINEAR_ID; DIMINDEX_3; ARITH]);;
2722
2723
2724
2725
2726
2727 let linear_inj_fan=prove(`!x:real^3 v:real^3 u:real^3.
2728 ~collinear{x,v,u}
2729 ==>(!(a:real^2) (b:real^2). (\(t:real^2). t$1 %(v-x)+t$2 %(u-x))(a)=(\(t:real^2). t$1 %(v-x)+t$2 %(u-x))(b) ==>a=b)`,
2730
2731 REPEAT GEN_TAC
2732 THEN DISCH_TAC
2733 THEN ASSUME_TAC(ISPECL[`x:real^3`;` v:real^3`;`u:real^3`]linear_aff_fan)
2734 THEN MP_TAC(ISPEC`(\(t:real^2). t$1 %(v-x)+t$2 %(u-x):real^3)`LINEAR_INJECTIVE_0)
2735 THEN RESP_TAC
2736 THEN REMOVE_ASSUM_TAC
2737 THEN GEN_TAC
2738 THEN DISJ_CASES_TAC(REAL_ARITH`(a:real^2)$2= &0 \/ ~(a$2= &0)`)
2739 THENL[
2740 ASM_REWRITE_TAC[]
2741 THEN REDUCE_VECTOR_TAC
2742 THEN REWRITE_TAC[VECTOR_MUL_EQ_0;VECTOR_ARITH`A-B=vec 0<=> B=A`]
2743 THEN MP_TAC(ISPECL[`x:real^3`;` v:real^3`;`u:real^3`]th3)
2744 THEN RESA_TAC
2745 THEN ASM_TAC
2746 THEN SIMP_TAC[ LAMBDA_BETA;CART_EQ; DIMINDEX_2; FORALL_2; VEC_COMPONENT; ARITH];
2747
2748 REWRITE_TAC[VECTOR_ARITH`A+B=vec 0<=>B= --A`]
2749 THEN STRIP_TAC
2750 THEN MP_TAC(SET_RULE`a$2 % (u - x) = --((a:real^2)$1 % (v - x:real^3)) ==> (inv (a$2)) % a$2 % (u - x) = (inv (a$2)) % (--(a$1 % (v - x)))`)
2751 THEN POP_ASSUM (fun th->GEN_REWRITE_TAC(LAND_CONV o LAND_CONV o ONCE_DEPTH_CONV)[th]
2752 THEN ASM_REWRITE_TAC[VECTOR_ARITH`(A%B%C=(A*B)%C:real^3)`])
2753 THEN MP_TAC(ISPEC`(a:real^2)$2`REAL_MUL_LINV)
2754 THEN RESA_TAC
2755 THEN REDUCE_VECTOR_TAC
2756 THEN REWRITE_TAC[VECTOR_ARITH`A-B=C%(--(D%(U-B)))<=> A= (&1+C*D)%B+(--C*D)%U:real^3`]
2757 THEN MP_TAC(ISPECL[`x:real^3`;` v:real^3`;`u:real^3`]th3)
2758 THEN RESA_TAC
2759 THEN POP_ASSUM MP_TAC
2760 THEN REWRITE_TAC[aff; AFFINE_HULL_2;IN_ELIM_THM]
2761 THEN DISCH_THEN(LABEL_TAC"A")
2762 THEN DISCH_TAC
2763 THEN SUBGOAL_THEN `F`ASSUME_TAC
2764 THENL[
2765 REMOVE_THEN "A" MP_TAC
2766 THEN ASM_REWRITE_TAC[]
2767 THEN EXISTS_TAC`(&1 + inv ((a:real^2)$2) * a$1)`
2768 THEN EXISTS_TAC`(--inv ((a:real^2)$2) * a$1)`
2769 THEN ASM_REWRITE_TAC[]
2770 THEN REAL_ARITH_TAC;
2771 ASM_MESON_TAC[]]]);;
2772
2773
2774
2775
2776
2777 (* ========================================================================== *)
2778 (*                        AFFINE AND DOT                   *)
2779 (* ========================================================================== *)
2780
2781
2782 let exp_aff_ge_by_dot=prove(`!x:real^3 v:real^3 u:real^3.
2783 ~collinear {x,v,u}
2784 ==> aff_ge {x,v} {u}={w:real^3| (w-x) dot (e2_fan x v u)= &0 /\ &0 <= (w-x) dot (e1_fan x v u)  }`,
2785 (let CROSS_LAGRANGE1 = prove
2786  (`!x y z. (x cross y) cross z = (x dot z) % y - (z dot y) % x`,
2787   VEC3_TAC) in
2788
2789 REPEAT STRIP_TAC THEN MP_TAC(ISPECL[`x:real^3`;`v:real^3`;`u:real^3`]th3) THEN RES_TAC
2790   THEN MP_TAC(ISPECL[`x:real^3`;`v:real^3`;`u:real^3`]AFF_GE_2_1) THEN RESA_TAC
2791   THEN MP_TAC(ISPECL[`x:real^3`;`v:real^3`;`u:real^3`]properties_coordinate) THEN RESA_TAC
2792   THEN REWRITE_TAC[EXTENSION;IN_ELIM_THM] THEN GEN_TAC THEN EQ_TAC
2793 THENL[
2794 STRIP_TAC THEN ASM_REWRITE_TAC[VECTOR_ARITH`(a % x + b +c) -x= (a- &1)% x + b + c `] THEN
2795 REMOVE_ASSUM_TAC THEN SYM_ASSUM_TAC THEN REWRITE_TAC[VECTOR_ARITH`((a-(a+b+c)) % x + b % v +c % u)=  b % (v-x) + c % (u-x)`]
2796 THEN ASM_REWRITE_TAC[DOT_LADD;DOT_LMUL]
2797    THEN REDUCE_ARITH_TAC
2798   THEN ASM_MESON_TAC[REAL_LE_MUL] ;
2799
2800 STRIP_TAC THEN POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN DISCH_THEN(LABEL_TAC"a")
2801   THEN DISCH_THEN(LABEL_TAC"b")
2802 THEN MP_TAC(ISPECL[`e1_fan (x:real^3) (v:real^3) (u:real^3)`;`e2_fan (x:real^3)( v:real^3) (u:real^3)`;
2803 `e3_fan (x:real^3) (v:real^3) (u:real^3)`;]ORTHONORMAL_IMP_SPANNING) THEN ASM_REWRITE_TAC[SPAN_3;EXTENSION]
2804   THEN DISCH_TAC THEN POP_ASSUM(fun th-> MP_TAC(ISPEC`(x':real^3)-(x:real^3)`th)) THEN REWRITE_TAC[SET_RULE`(a:real^3) IN (:real^3)`;IN_ELIM_THM] THEN RES_TAC THEN REMOVE_THEN "a" MP_TAC THEN ASM_REWRITE_TAC[DOT_LADD;DOT_LMUL]
2805   THEN POP_ASSUM MP_TAC THEN DISCH_THEN(LABEL_TAC"c")
2806   THEN FIND_ASSUM(MP_TAC)`orthonormal (e1_fan (x:real^3) (v:real^3) (u:real^3)) (e2_fan x v u) (e3_fan x v u)`
2807   THEN REWRITE_TAC[orthonormal] THEN STRIP_TAC THEN ASM_REWRITE_TAC[]  THEN ASM_REWRITE_TAC[DOT_SYM]
2808   THEN REDUCE_ARITH_TAC
2809   THEN DISCH_TAC THEN REMOVE_THEN "c" MP_TAC THEN ASM_REWRITE_TAC[] THEN REDUCE_VECTOR_TAC THEN DISCH_THEN (LABEL_TAC"a")
2810   THEN REMOVE_THEN "b" MP_TAC THEN ASM_REWRITE_TAC[DOT_LADD;DOT_LMUL;] THEN REWRITE_TAC[DOT_SYM] THEN ASM_REWRITE_TAC[]
2811   THEN REDUCE_ARITH_TAC
2812   THEN DISCH_TAC THEN REMOVE_THEN "a" MP_TAC
2813   THEN ASM_REWRITE_TAC[e1_fan;e2_fan;CROSS_LMUL;VECTOR_ARITH`a% b% v=(a*b)%v`;CROSS_LAGRANGE1]
2814   THEN REDUCE_VECTOR_TAC THEN REWRITE_TAC[VECTOR_ARITH`a%(x- b % v)+ c % v=(c- a* b) % v+  a % x `;
2815 e3_fan;VECTOR_ARITH`a% b% v=(a*b)%v`]
2816   THEN STRIP_TAC THEN
2817 EXISTS_TAC
2818 `&1 - ((((w:real) -
2819    ((u':real) * inv (norm (inv (norm ((v:real^3) - (x:real^3))) % (v - x) cross ((u:real^3) - x)))) *
2820    (inv (norm (v - x)) % (v - x) dot (u - x))) *
2821   inv (norm (v - x)))+
2822 ((u':real) * inv (norm (e3_fan (x:real^3) (v:real^3) (u:real^3) cross (u - x)))))`
2823   THEN EXISTS_TAC
2824 `(((w:real) -
2825    ((u':real) * inv (norm (inv (norm ((v:real^3) - (x:real^3))) % (v - x) cross ((u:real^3) - x)))) *
2826    (inv (norm (v - x)) % (v - x) dot (u - x))) *
2827   inv (norm (v - x)))`
2828   THEN EXISTS_TAC
2829 ` ((u':real) * inv (norm (e3_fan (x:real^3) (v:real^3) (u:real^3) cross (u - x))))`
2830 THEN
2831 STRIP_TAC
2832 THENL[
2833
2834 SUBGOAL_THEN `~(collinear {vec 0, v-x, u-x})==> ~((e3_fan (x:real^3) (v:real^3) (u:real^3)) cross ((u:real^3)-(x:real^3))= vec 0)` ASSUME_TAC
2835 THENL[
2836  MATCH_MP_TAC MONO_NOT THEN REWRITE_TAC[e3_fan;CROSS_LMUL]
2837 THEN DISCH_TAC THEN MP_TAC(ISPECL [`v:real^3`; `x:real^3`] imp_inv_norm_not_zero_fan)
2838 THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
2839 MP_TAC(ISPECL [`inv(norm((v:real^3)-(x:real^3)))`; `((v:real^3) -(x:real^3)) cross ((u:real^3)-(x:real^3))`; `(vec 0):real^3`] VECTOR_MUL_LCANCEL_IMP)
2840 THEN ASM_REWRITE_TAC[VECTOR_MUL_RZERO;CROSS_EQ_0 ];
2841
2842 POP_ASSUM MP_TAC THEN REWRITE_TAC[GSYM COLLINEAR_3]
2843 THEN GEN_REWRITE_TAC(LAND_CONV o LAND_CONV o RAND_CONV o ONCE_DEPTH_CONV)[SET_RULE`{a,b,c}={b,a,c}`] THEN RED_TAC
2844 THEN
2845 MP_TAC(ISPECL [`(e3_fan (x:real^3) (v:real^3) (u:real^3)) cross ((u:real^3)-(x:real^3))`; `((vec 0):real^3)`] imp_norm_ge_zero_fan)
2846   THEN REDUCE_VECTOR_TAC THEN RES_TAC THEN
2847 MP_TAC(ISPECL[`u':real`;`inv (norm ((e3_fan (x:real^3) (v:real^3) (u:real^3)) cross ((u:real^3)-(x:real^3))))`]
2848 REAL_LE_MUL) THEN RES_TAC THEN POP_ASSUM MATCH_MP_TAC THEN POP_ASSUM MP_TAC
2849  THEN REAL_ARITH_TAC];
2850
2851 STRIP_TAC THENL[REAL_ARITH_TAC;
2852 REWRITE_TAC[e3_fan] THEN POP_ASSUM MP_TAC THEN VECTOR_ARITH_TAC]]]));;
2853
2854
2855
2856
2857
2858
2859 let exp_aff_ge_by_dot_1_1=prove(`!x:real^3 v:real^3 u:real^3.
2860 ~collinear {x,v,u}
2861 ==>
2862 aff_ge {x} {v}={w:real^3| (w-x) dot (e2_fan x v u)= &0 /\ &0 <= (w-x) dot (e3_fan x v u)
2863 /\ (w-x) dot (e1_fan x v u)= &0 }`,
2864
2865 REPEAT STRIP_TAC THEN MP_TAC(ISPECL[`x:real^3`;`v:real^3`;`u:real^3`]th3)
2866   THEN RES_TAC THEN MP_TAC(ISPECL[`x:real^3`;`v:real^3`]AFF_GE_1_1) THEN RESA_TAC
2867   THEN MP_TAC(ISPECL[`x:real^3`;`v:real^3`;`u:real^3`]properties_coordinate) THEN RESA_TAC
2868   THEN REWRITE_TAC[EXTENSION;IN_ELIM_THM] THEN GEN_TAC THEN EQ_TAC
2869 THENL[
2870 STRIP_TAC THEN ASM_REWRITE_TAC[VECTOR_ARITH`(a % x + b) -x= (a- &1)% x + b  `]
2871 THEN
2872 REMOVE_ASSUM_TAC THEN SYM_ASSUM_TAC THEN REWRITE_TAC[VECTOR_ARITH`((a-(a+b)) % x + b % v)=  b % (v-x)`]
2873 THEN ASM_REWRITE_TAC[DOT_LADD;DOT_LMUL]
2874    THEN REDUCE_ARITH_TAC THEN POP_ASSUM MP_TAC
2875   THEN FIND_ASSUM(fun th-> REWRITE_TAC[SYM(th)])`dist (v,x) % e3_fan x v u = v- x:real^3`
2876   THEN REWRITE_TAC[DOT_LMUL]
2877     THEN FIND_ASSUM(MP_TAC)`orthonormal (e1_fan (x:real^3) (v:real^3) (u:real^3)) (e2_fan x v u) (e3_fan x v u)`
2878   THEN REWRITE_TAC[orthonormal] THEN RESA_TAC THEN REDUCE_ARITH_TAC THEN MP_TAC(ISPECL[`v:real^3`;`x:real^3`]DIST_POS_LE)
2879   THEN MESON_TAC[REAL_LE_MUL];
2880
2881 STRIP_TAC THEN POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN DISCH_THEN(LABEL_TAC"a")
2882   THEN DISCH_THEN(LABEL_TAC"b") THEN DISCH_THEN (LABEL_TAC "c")
2883 THEN MP_TAC(ISPECL[`e1_fan (x:real^3) (v:real^3) (u:real^3)`;`e2_fan (x:real^3)( v:real^3) (u:real^3)`;
2884 `e3_fan (x:real^3) (v:real^3) (u:real^3)`;]ORTHONORMAL_IMP_SPANNING) THEN ASM_REWRITE_TAC[SPAN_3;EXTENSION]
2885   THEN DISCH_TAC THEN POP_ASSUM(fun th-> MP_TAC(ISPEC`(x':real^3)-(x:real^3)`th)) THEN REWRITE_TAC[SET_RULE`(a:real^3) IN (:real^3)`;IN_ELIM_THM] THEN RES_TAC THEN REMOVE_THEN "a" MP_TAC THEN ASM_REWRITE_TAC[DOT_LADD;DOT_LMUL]
2886   THEN POP_ASSUM MP_TAC THEN DISCH_THEN(LABEL_TAC"d")
2887   THEN FIND_ASSUM(MP_TAC)`orthonormal (e1_fan (x:real^3) (v:real^3) (u:real^3)) (e2_fan x v u) (e3_fan x v u)`
2888   THEN REWRITE_TAC[orthonormal] THEN STRIP_TAC THEN ASM_REWRITE_TAC[]  THEN ASM_REWRITE_TAC[DOT_SYM]
2889   THEN REDUCE_ARITH_TAC
2890   THEN REMOVE_THEN "c" MP_TAC THEN ASM_REWRITE_TAC[DOT_LADD;DOT_LMUL]
2891   THEN ASM_REWRITE_TAC[DOT_SYM]
2892   THEN REDUCE_ARITH_TAC THEN DISCH_TAC
2893   THEN DISCH_TAC THEN REMOVE_THEN "d" MP_TAC THEN ASM_REWRITE_TAC[] THEN REDUCE_VECTOR_TAC
2894   THEN  DISCH_TAC
2895   THEN REMOVE_THEN "b" MP_TAC THEN ASM_REWRITE_TAC[DOT_LADD;DOT_LMUL;] THEN REWRITE_TAC[DOT_SYM] THEN ASM_REWRITE_TAC[]
2896   THEN REDUCE_ARITH_TAC THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[e3_fan;VECTOR_ARITH`a% b% v=(a*b)%v`;
2897 VECTOR_ARITH`a-b=c %(v-b)<=> a= (&1-c) % b + c % v`] THEN DISCH_THEN (LABEL_TAC"a")
2898   THEN STRIP_TAC THEN
2899 EXISTS_TAC
2900 `&1 - (w:real) * (inv (norm ((v:real^3) - (x:real^3))))`
2901   THEN EXISTS_TAC
2902 `(w:real) * (inv (norm ((v:real^3) - (x:real^3))))`
2903 THEN
2904 STRIP_TAC
2905 THENL[
2906 MP_TAC(ISPECL[`v:real^3`;`x:real^3`]imp_norm_ge_zero_fan) THEN RES_TAC THEN MATCH_MP_TAC REAL_LE_MUL
2907 THEN ASM_REWRITE_TAC[]  THEN POP_ASSUM MP_TAC THEN REAL_ARITH_TAC;
2908 STRIP_TAC THENL[REAL_ARITH_TAC;
2909 ASM_REWRITE_TAC[]]]]);;
2910
2911
2912
2913
2914
2915
2916
2917
2918 (****************************************************************************)
2919 (*        the conditions to add azim                  *)
2920 (****************************************************************************)
2921
2922
2923
2924
2925
2926 let sum1_azim_fan=prove(`!x:real^3 v:real^3 u:real^3 w1:real^3 w2:real^3.
2927  cyclic_set {u, w1, w2} x v /\ (azim x v u w1 + azim x v w1 w2) < &2 * pi
2928 ==>
2929 azim x v u w2 = azim x v u w1+ azim x v w1 w2
2930 `,
2931 ( let th=prove(`!x v u. {v,x,u}={x,v,u}/\{v,x,u}={u,x,v}`,SET_TAC[]) in
2932
2933
2934 REPEAT GEN_TAC THEN STRIP_TAC
2935 THEN MP_TAC (SPECL [`x:real^3`; `v:real^3`; `u:real^3`;`w1:real^3`; `w2:real^3`] property_of_cyclic_set)
2936 THEN ASM_REWRITE_TAC[] THEN DISCH_TAC
2937 THEN
2938 MP_TAC (SPECL [`x:real^3`; `v:real^3`; `u:real^3`;`w1:real^3`; `w2:real^3`] property_of_cyclic_set1)
2939 THEN ASM_REWRITE_TAC[] THEN DISCH_TAC
2940   THEN MP_TAC (SPECL [`x:real^3`; `v:real^3`; `u:real^3`;`w1:real^3`; `w2:real^3`] property_of_cyclic_set2)
2941 THEN ASM_REWRITE_TAC[] THEN DISCH_TAC
2942   THEN MP_TAC(ISPECL[`v:real^3`; `x:real^3`; `u:real^3`]COLLINEAR_3) THEN ASM_REWRITE_TAC[] THEN
2943 DISCH_TAC THEN  SUBGOAL_THEN `~collinear {(x:real^3),(v:real^3),(u:real^3)}/\ ~collinear {(u:real^3),(x:real^3),(v:real^3)}` ASSUME_TAC
2944 THENL[ASM_MESON_TAC[th];
2945
2946 MP_TAC (SPECL [`x:real^3`; `v:real^3`; `w1:real^3`; `w2:real^3`] azim)
2947   THEN STRIP_TAC
2948 THEN POP_ASSUM(MP_TAC o SPECL [`e1_fan (x:real^3) (v:real^3) (u:real^3)`;`e2_fan (x:real^3) (v:real^3) (u:real^3)`;`e3_fan (x:real^3) (v:real^3) (u:real^3)`])
2949   THEN MP_TAC(ISPECL[`(x:real^3)`; `(v:real^3)`; `(u:real^3)`] orthonormal_e1_e2_e3_fan)
2950 THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
2951 MP_TAC(ISPECL[`(x:real^3)`; `(v:real^3)`; `(u:real^3)`] e3_mul_dist_fan) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC
2952   THEN ASM_REWRITE_TAC[] THEN STRIP_TAC
2953   THEN MP_TAC(SPEC `psi:real` SINCOS_PRINCIPAL_VALUE_FAN ) THEN STRIP_TAC THEN
2954 MP_TAC(ISPECL[`x:real^3`;`v:real^3`;`u:real^3`;`u:real^3`]AZIM_EXISTS) THEN STRIP_TAC
2955 THEN
2956 POP_ASSUM (fun th-> MP_TAC (ISPECL[`e1_fan (x:real^3) (v:real^3) (u:real^3)`;`e2_fan (x:real^3) (v:real^3) (u:real^3)`;`e3_fan (x:real^3) (v:real^3) (u:real^3)`]th)) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC
2957 THEN POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN ASM_REWRITE_TAC[] THEN REPEAT DISCH_TAC
2958   THEN MP_TAC(ISPECL[`x:real^3`; `v:real^3`; `u:real^3` ;`r1':real`; `psi':real`; `h1':real`]sincos_of_u_fan)
2959   THEN ASM_REWRITE_TAC[] THEN DISCH_TAC
2960
2961 THEN MP_TAC (ISPECL [`x:real^3`; `v:real^3`; `u:real^3`; `w1:real^3`; `h1':real`; `h1:real`; `r1':real`; `r1:real`;
2962 `e1_fan (x:real^3) (v:real^3) (u:real^3)`;`e2_fan (x:real^3) (v:real^3) (u:real^3)`;`e3_fan (x:real^3) (v:real^3) (u:real^3)`; `psi':real`; `y:real`  ] AZIM_UNIQUE)
2963   THEN ASM_REWRITE_TAC[COS_ADD;SIN_ADD;REAL_ARITH` &1 * (a:real) - &0 * (b:real)=a`;REAL_ARITH`&0 * (a:real) + &1 * (b:real)=b`]
2964 THEN DISCH_TAC THEN MP_TAC (ISPECL [`x:real^3`; `v:real^3`; `u:real^3`; `w2:real^3`; `h1':real`; `h2:real`; `r1':real`; `r2:real`;
2965 `e1_fan (x:real^3) (v:real^3) (u:real^3)`;`e2_fan (x:real^3) (v:real^3) (u:real^3)`;`e3_fan (x:real^3) (v:real^3) (u:real^3)`; `psi':real`; `azim (x:real^3) (v:real^3) (u:real^3) (w1:real^3) + azim x v w1 (w2:real^3)`  ] AZIM_UNIQUE)
2966 THEN DISCH_TAC THEN POP_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN STRIP_TAC
2967 THENL[ ASM_MESON_TAC[REAL_LE_ADD];
2968
2969
2970 ASM_REWRITE_TAC[COS_ADD;SIN_ADD;REAL_ARITH` &1 * (a:real) - &0 * (b:real)=a`;REAL_ARITH`&0 * (a:real) + &1 * (b:real)=b`]
2971      ]]));;
2972
2973
2974
2975
2976
2977
2978
2979 let sum3_azim_fan=prove(`!x:real^3 v:real^3 u:real^3 w1:real^3 w2:real^3.
2980 ((azim x v u w1 + azim x v w1 w2) < &2 * pi)
2981 /\
2982 (~collinear {(x:real^3),(v:real^3),(w1:real^3)})
2983 /\(~collinear {(x:real^3),(v:real^3),(w2:real^3)})
2984 /\ (~collinear {(x:real^3),(v:real^3),(u:real^3)})
2985 ==>
2986 azim x v u w2 = azim x v u w1+ azim x v w1 w2
2987 `, (let th=prove(`!x v u. {x,v,u}={v,x,u}`,SET_TAC[]) in
2988  (let th1=prove(`!x v u. {x,v,u}={u,x,v}`,SET_TAC[]) in
2989
2990 REPEAT GEN_TAC THEN STRIP_TAC  THEN POP_ASSUM MP_TAC THEN DISCH_THEN(LABEL_TAC "a")
2991
2992 THEN USE_THEN "a" MP_TAC THEN GEN_REWRITE_TAC ( LAND_CONV  o ONCE_DEPTH_CONV)[th] THEN DISCH_THEN(LABEL_TAC "b")
2993
2994 THEN USE_THEN "a" MP_TAC THEN GEN_REWRITE_TAC ( LAND_CONV  o ONCE_DEPTH_CONV)[th1] THEN DISCH_TAC
2995
2996 THEN USE_THEN "b" MP_TAC THEN
2997 GEN_REWRITE_TAC ( LAND_CONV  o ONCE_DEPTH_CONV)[COLLINEAR_3] THEN STRIP_TAC
2998 THEN
2999 MP_TAC(ISPECL[`x:real^3`;`v:real^3`;`u:real^3`]th3) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
3000 MP_TAC (SPECL [`x:real^3`; `v:real^3`; `w1:real^3`; `w2:real^3`] azim)
3001   THEN STRIP_TAC
3002 THEN POP_ASSUM(MP_TAC o SPECL [`e1_fan (x:real^3) (v:real^3) (u:real^3)`;`e2_fan (x:real^3) (v:real^3) (u:real^3)`;`e3_fan (x:real^3) (v:real^3) (u:real^3)`])
3003   THEN MP_TAC(ISPECL[`(x:real^3)`; `(v:real^3)`; `(u:real^3)`] orthonormal_e1_e2_e3_fan)
3004 THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
3005 MP_TAC(ISPECL[`(x:real^3)`; `(v:real^3)`; `(u:real^3)`] e3_mul_dist_fan) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC
3006   THEN ASM_REWRITE_TAC[] THEN STRIP_TAC
3007   THEN MP_TAC(SPEC `psi:real` SINCOS_PRINCIPAL_VALUE_FAN ) THEN STRIP_TAC THEN
3008 MP_TAC(ISPECL[`x:real^3`;`v:real^3`;`u:real^3`;`u:real^3`]AZIM_EXISTS) THEN STRIP_TAC
3009 THEN
3010 POP_ASSUM (fun th-> MP_TAC (ISPECL[`e1_fan (x:real^3) (v:real^3) (u:real^3)`;`e2_fan (x:real^3) (v:real^3) (u:real^3)`;`e3_fan (x:real^3) (v:real^3) (u:real^3)`]th)) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC
3011 THEN POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN ASM_REWRITE_TAC[] THEN REPEAT DISCH_TAC
3012   THEN MP_TAC(ISPECL[`x:real^3`; `v:real^3`; `u:real^3` ;`r1':real`; `psi':real`; `h1':real`]sincos_of_u_fan)
3013   THEN ASM_REWRITE_TAC[] THEN DISCH_TAC
3014
3015 THEN MP_TAC (ISPECL [`x:real^3`; `v:real^3`; `u:real^3`; `w1:real^3`; `h1':real`; `h1:real`; `r1':real`; `r1:real`;
3016 `e1_fan (x:real^3) (v:real^3) (u:real^3)`;`e2_fan (x:real^3) (v:real^3) (u:real^3)`;`e3_fan (x:real^3) (v:real^3) (u:real^3)`; `psi':real`; `y:real`  ] AZIM_UNIQUE)
3017   THEN ASM_REWRITE_TAC[COS_ADD;SIN_ADD;REAL_ARITH` &1 * (a:real) - &0 * (b:real)=a`;REAL_ARITH`&0 * (a:real) + &1 * (b:real)=b`]
3018 THEN DISCH_TAC THEN MP_TAC (ISPECL [`x:real^3`; `v:real^3`; `u:real^3`; `w2:real^3`; `h1':real`; `h2:real`; `r1':real`; `r2:real`;
3019 `e1_fan (x:real^3) (v:real^3) (u:real^3)`;`e2_fan (x:real^3) (v:real^3) (u:real^3)`;`e3_fan (x:real^3) (v:real^3) (u:real^3)`; `psi':real`; `azim (x:real^3) (v:real^3) (u:real^3) (w1:real^3) + azim x v w1 (w2:real^3)`  ] AZIM_UNIQUE)
3020 THEN DISCH_TAC THEN POP_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN STRIP_TAC
3021 THENL[
3022  ASM_MESON_TAC[REAL_LE_ADD];
3023
3024 ASM_REWRITE_TAC[COS_ADD;SIN_ADD;REAL_ARITH` &1 * (a:real) - &0 * (b:real)=a`;REAL_ARITH`&0 * (a:real) + &1 * (b:real)=b`]])));;
3025
3026
3027
3028 let sum2_azim_fan=prove(`!x:real^3 v:real^3 u:real^3 w1:real^3 w2:real^3.
3029  cyclic_set {u, w1, w2} x v /\ azim x v u w1 <= azim x v u w2
3030 ==>
3031 azim x v u w2 = azim x v u w1 + azim x v w1 w2
3032 `,
3033
3034 (let th=prove(`!x v u. {v,x,u}={x,v,u}/\{v,x,u}={u,x,v}`,SET_TAC[]) in
3035
3036 REWRITE_TAC[REAL_ARITH`(a:real)=(b:real)+(c:real) <=> c=a-b`] THEN
3037 REPEAT GEN_TAC THEN STRIP_TAC
3038 THEN MP_TAC (SPECL [`x:real^3`; `v:real^3`; `u:real^3`;`w1:real^3`; `w2:real^3`] property_of_cyclic_set)
3039 THEN ASM_REWRITE_TAC[] THEN DISCH_TAC
3040 THEN
3041 MP_TAC (SPECL [`x:real^3`; `v:real^3`; `u:real^3`;`w1:real^3`; `w2:real^3`] property_of_cyclic_set1)
3042 THEN ASM_REWRITE_TAC[] THEN DISCH_TAC
3043   THEN MP_TAC (SPECL [`x:real^3`; `v:real^3`; `u:real^3`;`w1:real^3`; `w2:real^3`] property_of_cyclic_set2)
3044 THEN ASM_REWRITE_TAC[] THEN DISCH_TAC
3045   THEN MP_TAC(ISPECL[`v:real^3`; `x:real^3`; `u:real^3`]COLLINEAR_3) THEN ASM_REWRITE_TAC[] THEN
3046 DISCH_TAC THEN  SUBGOAL_THEN `~collinear {(x:real^3),(v:real^3),(u:real^3)}/\ ~collinear {(u:real^3),(x:real^3),(v:real^3)}` ASSUME_TAC
3047 THENL[ASM_MESON_TAC[th];
3048 MP_TAC (SPECL [`x:real^3`; `v:real^3`; `u:real^3`; `w1:real^3`] azim)
3049   THEN STRIP_TAC
3050 THEN POP_ASSUM(MP_TAC o SPECL [`e1_fan (x:real^3) (v:real^3) (u:real^3)`;`e2_fan (x:real^3) (v:real^3) (u:real^3)`;`e3_fan (x:real^3) (v:real^3) (u:real^3)`])
3051 THEN MP_TAC (SPECL [`x:real^3`; `v:real^3`; `u:real^3`; `w2:real^3`] azim) THEN STRIP_TAC
3052 THEN POP_ASSUM(MP_TAC o SPECL [`e1_fan (x:real^3) (v:real^3) (u:real^3)`;`e2_fan (x:real^3) (v:real^3) (u:real^3)`;`e3_fan (x:real^3) (v:real^3) (u:real^3)`])
3053 THEN MP_TAC(ISPECL[`(x:real^3)`; `(v:real^3)`; `(u:real^3)`] orthonormal_e1_e2_e3_fan)
3054 THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
3055 MP_TAC(ISPECL[`(x:real^3)`; `(v:real^3)`; `(u:real^3)`] e3_mul_dist_fan) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC
3056   THEN ASM_REWRITE_TAC[]
3057 THEN STRIP_TAC THEN POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC
3058   THEN DISCH_THEN (LABEL_TAC"a") THEN DISCH_THEN (LABEL_TAC"b")
3059 THEN REPEAT STRIP_TAC
3060    THEN POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC
3061   THEN DISCH_THEN (LABEL_TAC"c") THEN REPEAT STRIP_TAC
3062   THEN MP_TAC(ISPECL[`x:real^3`; `v:real^3`; `u:real^3` ;`r1:real`; `psi:real`; `h1':real`]sincos_of_u_fan)
3063   THEN ASM_REWRITE_TAC[] THEN DISCH_TAC
3064 THEN MP_TAC(ISPECL[`x:real^3`; `v:real^3`; `u:real^3` ;`r1':real`; `psi':real`; `h1:real`]sincos_of_u_fan)
3065   THEN REMOVE_THEN "a" MP_TAC THEN ASM_REWRITE_TAC[] THEN  DISCH_TAC THEN DISCH_TAC
3066   THEN REMOVE_THEN "b" MP_TAC THEN REMOVE_THEN "c" MP_TAC
3067   THEN ASM_REWRITE_TAC[COS_ADD;SIN_ADD;REAL_ARITH` &1 * (a:real) - &0 * (b:real)=a`;REAL_ARITH`&0 * (a:real) + &1 * (b:real)=b`]
3068   THEN REPEAT STRIP_TAC
3069   THEN MP_TAC (ISPECL [`x:real^3`; `v:real^3`; `w1:real^3`; `w2:real^3`; `h2:real`; `h2':real`; `r2':real`; `r2:real`;
3070 `e1_fan (x:real^3) (v:real^3) (u:real^3)`;`e2_fan (x:real^3) (v:real^3) (u:real^3)`;`e3_fan (x:real^3) (v:real^3) (u:real^3)`; `azim (x:real^3) (v:real^3) (u:real^3) (w1:real^3)`; `azim (x:real^3) (v:real^3) (u:real^3) (w2:real^3) - azim x v u (w1:real^3)`  ] AZIM_UNIQUE)
3071 THEN DISCH_TAC THEN POP_ASSUM MATCH_MP_TAC
3072 THEN ASM_REWRITE_TAC[REAL_ARITH`(a:real)+(b:real)-a=b`; REAL_ARITH`(&0 <= (a:real)-(b:real))<=> b<= a`] THEN MP_TAC(ISPEC `azim (x:real^3) (v:real^3) (u:real^3) (w1:real^3)` REAL_NEG_LE0)
3073 THEN ASM_REWRITE_TAC[] THEN DISCH_TAC
3074 THEN MP_TAC(ISPECL[`azim (x:real^3) (v:real^3) (u:real^3) (w2:real^3)`;`&2 * pi`;`--azim (x:real^3) (v:real^3) (u:real^3) (w1:real^3)`;`&0`]REAL_LTE_ADD2 )
3075 THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC]));;
3076
3077
3078
3079
3080 let sum4_azim_fan=prove(`!x:real^3 v:real^3 u:real^3 w1:real^3 w2:real^3.
3081  azim x v u w1 <= azim x v u w2
3082 /\ (~collinear {(x:real^3),(v:real^3),(w1:real^3)})
3083 /\(~collinear {(x:real^3),(v:real^3),(w2:real^3)})
3084 /\ (~collinear {(x:real^3),(v:real^3),(u:real^3)})
3085
3086 ==>
3087 azim x v u w2 = azim x v u w1 + azim x v w1 w2
3088 `,(let th=prove(`!x v u. {x,v,u}={v,x,u}`,SET_TAC[]) in
3089 (let th1=prove(`!x v u. {x,v,u}={u,x,v}`,SET_TAC[]) in
3090
3091 REWRITE_TAC[REAL_ARITH`(a:real)=(b:real)+(c:real) <=> c=a-b`] THEN
3092
3093 REPEAT GEN_TAC THEN STRIP_TAC  THEN POP_ASSUM MP_TAC THEN DISCH_THEN(LABEL_TAC "a1")
3094
3095 THEN USE_THEN "a1" MP_TAC THEN GEN_REWRITE_TAC ( LAND_CONV  o ONCE_DEPTH_CONV)[th] THEN DISCH_THEN(LABEL_TAC "b1")
3096
3097 THEN USE_THEN "a1" MP_TAC THEN GEN_REWRITE_TAC ( LAND_CONV  o ONCE_DEPTH_CONV)[th1] THEN DISCH_TAC
3098
3099 THEN USE_THEN "b1" MP_TAC THEN
3100 GEN_REWRITE_TAC ( LAND_CONV  o ONCE_DEPTH_CONV)[COLLINEAR_3] THEN STRIP_TAC
3101 THEN
3102 MP_TAC(ISPECL[`x:real^3`;`v:real^3`;`u:real^3`]th3) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
3103 MP_TAC (SPECL [`x:real^3`; `v:real^3`; `u:real^3`; `w1:real^3`] azim)
3104   THEN STRIP_TAC
3105 THEN POP_ASSUM(MP_TAC o SPECL [`e1_fan (x:real^3) (v:real^3) (u:real^3)`;`e2_fan (x:real^3) (v:real^3) (u:real^3)`;`e3_fan (x:real^3) (v:real^3) (u:real^3)`])
3106 THEN MP_TAC (SPECL [`x:real^3`; `v:real^3`; `u:real^3`; `w2:real^3`] azim) THEN STRIP_TAC
3107 THEN POP_ASSUM(MP_TAC o SPECL [`e1_fan (x:real^3) (v:real^3) (u:real^3)`;`e2_fan (x:real^3) (v:real^3) (u:real^3)`;`e3_fan (x:real^3) (v:real^3) (u:real^3)`])
3108 THEN MP_TAC(ISPECL[`(x:real^3)`; `(v:real^3)`; `(u:real^3)`] orthonormal_e1_e2_e3_fan)
3109 THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
3110 MP_TAC(ISPECL[`(x:real^3)`; `(v:real^3)`; `(u:real^3)`] e3_mul_dist_fan) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC
3111   THEN ASM_REWRITE_TAC[]
3112 THEN STRIP_TAC THEN POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC
3113   THEN DISCH_THEN (LABEL_TAC"a") THEN DISCH_THEN (LABEL_TAC"b")
3114 THEN REPEAT STRIP_TAC
3115    THEN POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC
3116   THEN DISCH_THEN (LABEL_TAC"c") THEN REPEAT STRIP_TAC
3117   THEN MP_TAC(ISPECL[`x:real^3`; `v:real^3`; `u:real^3` ;`r1:real`; `psi:real`; `h1':real`]sincos_of_u_fan)
3118   THEN ASM_REWRITE_TAC[] THEN DISCH_TAC
3119 THEN MP_TAC(ISPECL[`x:real^3`; `v:real^3`; `u:real^3` ;`r1':real`; `psi':real`; `h1:real`]sincos_of_u_fan)
3120   THEN REMOVE_THEN "a" MP_TAC THEN ASM_REWRITE_TAC[] THEN  DISCH_TAC THEN DISCH_TAC
3121   THEN REMOVE_THEN "b" MP_TAC THEN REMOVE_THEN "c" MP_TAC
3122   THEN ASM_REWRITE_TAC[COS_ADD;SIN_ADD;REAL_ARITH` &1 * (a:real) - &0 * (b:real)=a`;REAL_ARITH`&0 * (a:real) + &1 * (b:real)=b`]
3123   THEN REPEAT STRIP_TAC
3124   THEN MP_TAC (ISPECL [`x:real^3`; `v:real^3`; `w1:real^3`; `w2:real^3`; `h2:real`; `h2':real`; `r2':real`; `r2:real`;
3125 `e1_fan (x:real^3) (v:real^3) (u:real^3)`;`e2_fan (x:real^3) (v:real^3) (u:real^3)`;`e3_fan (x:real^3) (v:real^3) (u:real^3)`; `azim (x:real^3) (v:real^3) (u:real^3) (w1:real^3)`; `azim (x:real^3) (v:real^3) (u:real^3) (w2:real^3) - azim x v u (w1:real^3)`  ] AZIM_UNIQUE)
3126 THEN DISCH_TAC
3127 THEN POP_ASSUM MATCH_MP_TAC
3128 THEN ASM_REWRITE_TAC[REAL_ARITH`(a:real)+(b:real)-a=b`; REAL_ARITH`(&0 <= (a:real)-(b:real))<=> b<= a`] THEN MP_TAC(ISPEC `azim (x:real^3) (v:real^3) (u:real^3) (w1:real^3)` REAL_NEG_LE0)
3129 THEN ASM_REWRITE_TAC[] THEN DISCH_TAC
3130 THEN MP_TAC(ISPECL[`azim (x:real^3) (v:real^3) (u:real^3) (w2:real^3)`;`&2 * pi`;`--azim (x:real^3) (v:real^3) (u:real^3) (w1:real^3)`;`&0`]REAL_LTE_ADD2 )
3131 THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC
3132 )));;
3133
3134
3135
3136
3137 let sum5_azim_fan=prove(`!x:real^3 v:real^3 u:real^3 w1:real^3 w2:real^3.
3138   azim x v  w1 w2 <= azim x v u w2
3139 /\ (~collinear {(x:real^3),(v:real^3),(w1:real^3)})
3140 /\(~collinear {(x:real^3),(v:real^3),(w2:real^3)})
3141 /\ (~collinear {(x:real^3),(v:real^3),(u:real^3)})
3142
3143 ==>
3144 azim x v u w2 = azim x v u w1 + azim x v w1 w2
3145 `,
3146 REPEAT STRIP_TAC THEN REPEAT (POP_ASSUM MP_TAC) THEN DISCH_THEN(LABEL_TAC"1") THEN REPEAT STRIP_TAC
3147   THEN DISJ_CASES_TAC(REAL_ARITH`(azim x v u w2)= &0 \/ ~(azim x v u w2 = &0)`)
3148 THENL(*1*)[
3149 SUBGOAL_THEN`azim x v w1 w2 = &0` ASSUME_TAC
3150 THENL(*2*)[
3151 REPEAT(POP_ASSUM MP_TAC) THEN MP_TAC(ISPECL[`x:real^3`;`v:real^3`;`w1:real^3`;`w2:real^3`]azim) THEN REAL_ARITH_TAC;
3152 (*2*)
3153 MP_TAC(ISPECL[`x:real^3`;`v:real^3`;`w1:real^3`;`w2:real^3`]AZIM_EQ_0_SYM) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC
3154 THEN
3155 MP_TAC(ISPECL[`x:real^3`;`v:real^3`;`u:real^3`;`w2:real^3`]AZIM_EQ_0_SYM) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC
3156 THEN
3157 SUBGOAL_THEN`azim x v w2 w1 = azim x v w2 u` ASSUME_TAC
3158 THENL(*3*)[ASM_MESON_TAC[];(*3*)
3159 REWRITE_TAC[REAL_ARITH`&0 = a + &0 <=> a= &0`] THEN
3160 MP_TAC(ISPECL[`x:real^3`;`v:real^3`;`w2:real^3`;`u:real^3`;`w1:real^3`]AZIM_EQ_ALT) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC
3161   THEN MP_TAC(ISPECL[`x:real^3`;`v:real^3`;`u:real^3`;`w1:real^3`]AZIM_EQ_0) THEN ASM_REWRITE_TAC[]]];
3162  DISJ_CASES_TAC(REAL_ARITH`(azim x v w1 w2)= &0 \/ ~(azim x v w1 w2 = &0)`)
3163 THENL(*4*)[
3164 ASM_REWRITE_TAC[REAL_ARITH`b = a + &0 <=> b= a`] THEN
3165 MP_TAC(ISPECL[`x:real^3`;`v:real^3`;`w1:real^3`;`w2:real^3`]AZIM_EQ_0_ALT) THEN ASM_REWRITE_TAC[]THEN ASM_MESON_TAC[AZIM_EQ_ALT]  ;(*4*)
3166 REMOVE_THEN"1" MP_TAC THEN
3167 MP_TAC(ISPECL[`x:real^3`;`v:real^3`;`w1:real^3`;`w2:real^3`]AZIM_COMPL
3168 ) THEN ASM_REWRITE_TAC[]
3169   THEN MP_TAC(ISPECL[`x:real^3`;`v:real^3`;`u:real^3`;`w2:real^3`]AZIM_COMPL
3170 ) THEN ASM_REWRITE_TAC[REAL_ARITH`a=b-c <=> c= b-a`] THEN DISCH_TAC THEN DISCH_TAC
3171   THEN ASM_REWRITE_TAC[REAL_ARITH`a-b=c+a-d<=> d=b+c`;REAL_ARITH`a-b<=a-d<=> d<=b`] THEN ASM_MESON_TAC[sum4_azim_fan]]
3172 ]);;
3173
3174
3175
3176
3177 (* ========================================================================== *)
3178 (*                   AZIM                          *)
3179 (* ========================================================================== *)
3180
3181
3182
3183
3184 let th = prove
3185  (`!x:real^3 v:real^3 u:real^3 w:real^3.
3186         ~collinear {x,v,u} /\ ~collinear{x,v,w}
3187         ==> {y:real^3 | ~collinear {x,v,y} /\ azim x v u w = azim x v u y} =
3188             aff_gt {x , v} {w}`,
3189   GEOM_ORIGIN_TAC `x:real^3` THEN
3190   GEOM_BASIS_MULTIPLE_TAC 3 `v:real^3` THEN
3191   X_GEN_TAC `v:real` THEN ASM_CASES_TAC `v = &0` THENL
3192    [ASM_REWRITE_TAC[VECTOR_MUL_LZERO; INSERT_AC; COLLINEAR_2]; ALL_TAC] THEN
3193   ASM_REWRITE_TAC[VECTOR_MUL_LZERO; REAL_LE_LT] THEN DISCH_TAC THEN
3194   MAP_EVERY X_GEN_TAC [`u:real^3`; `w:real^3`] THEN
3195   ASM_CASES_TAC `w:real^3 = vec 0` THENL
3196    [ASM_REWRITE_TAC[INSERT_AC; COLLINEAR_2]; ALL_TAC] THEN
3197   ASM_CASES_TAC `w:real^3 = v % basis 3` THENL
3198    [ASM_REWRITE_TAC[INSERT_AC; COLLINEAR_2]; ALL_TAC] THEN
3199   ASM_SIMP_TAC[AZIM_SPECIAL_SCALE; COLLINEAR_SPECIAL_SCALE] THEN
3200   ASM_CASES_TAC `w:real^3 = basis 3` THENL
3201    [ASM_REWRITE_TAC[INSERT_AC; COLLINEAR_2]; ALL_TAC] THEN
3202   ASM_SIMP_TAC[AFF_GT_SPECIAL_SCALE; IN_SING; FINITE_INSERT; FINITE_EMPTY] THEN
3203   POP_ASSUM_LIST(K ALL_TAC) THEN REWRITE_TAC[COLLINEAR_BASIS_3; AZIM_ARG] THEN
3204   DISCH_TAC THEN MATCH_MP_TAC EQ_TRANS THEN
3205   EXISTS_TAC `{y:real^3 | (dropout 3 y:real^2) IN
3206                           aff_gt {vec 0} {dropout 3 (w:real^3)}}` THEN
3207   CONJ_TAC THENL
3208    [REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN X_GEN_TAC `y:real^3` THEN
3209     POP_ASSUM MP_TAC THEN
3210     MAP_EVERY SPEC_TAC
3211      [`(dropout 3:real^3->real^2) u`,`u:real^2`;
3212       `(dropout 3:real^3->real^2) v`,`v:real^2`;
3213       `(dropout 3:real^3->real^2) w`,`w:real^2`;
3214       `(dropout 3:real^3->real^2) y`,`y:real^2`] THEN
3215     SIMP_TAC[AFF_GT_1_1; SET_RULE `DISJOINT {x} {y} <=> ~(x = y)`] THEN
3216     REWRITE_TAC[VECTOR_MUL_RZERO; VECTOR_ADD_LID; IN_ELIM_THM] THEN
3217     REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN
3218     ONCE_REWRITE_TAC[TAUT `a /\ b /\ c <=> a /\ c /\ b`] THEN
3219     REWRITE_TAC[REAL_ARITH `t1 + t2 = &1 <=> t1 = &1 - t2`] THEN
3220     REWRITE_TAC[RIGHT_EXISTS_AND_THM; EXISTS_REFL] THEN
3221     ASM_CASES_TAC `y:real^2 = vec 0` THEN ASM_REWRITE_TAC[] THENL
3222      [ASM_MESON_TAC[VECTOR_MUL_EQ_0; REAL_LT_IMP_NZ]; ALL_TAC] THEN
3223     RULE_ASSUM_TAC(REWRITE_RULE[COMPLEX_VEC_0]) THEN
3224     GEN_REWRITE_TAC LAND_CONV [EQ_SYM_EQ] THEN
3225     ASM_SIMP_TAC[ARG_EQ; COMPLEX_CMUL; COMPLEX_FIELD
3226      `~(w = Cx(&0)) /\ ~(z = Cx(&0)) ==> ~(w / z = Cx(&0))`] THEN
3227     ASM_SIMP_TAC[COMPLEX_FIELD
3228      `~(u = Cx(&0)) ==> (w / u = x * y / u <=> w = x * y)`];
3229     SUBGOAL_THEN `~(w:real^3 = vec 0) /\ ~(w = basis 3)` ASSUME_TAC THENL
3230      [ASM_MESON_TAC[DROPOUT_BASIS_3; DROPOUT_0]; ALL_TAC] THEN
3231     ASM_SIMP_TAC[AFF_GT_1_1; AFF_GT_2_1; DISJOINT_INSERT; IN_INSERT;
3232                  DISJOINT_EMPTY; NOT_IN_EMPTY] THEN
3233     REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN X_GEN_TAC `y:real^3` THEN
3234     REWRITE_TAC[VECTOR_MUL_RZERO; VECTOR_ADD_LID] THEN
3235     ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN
3236     GEN_REWRITE_TAC (RAND_CONV o BINDER_CONV) [SWAP_EXISTS_THM] THEN
3237     ONCE_REWRITE_TAC[TAUT `a /\ b /\ c <=> a /\ c /\ b`] THEN
3238     REWRITE_TAC[REAL_ARITH `t1 + t2 = &1 <=> t1 = &1 - t2`] THEN
3239     REWRITE_TAC[RIGHT_EXISTS_AND_THM; EXISTS_REFL] THEN
3240     SIMP_TAC[CART_EQ; DIMINDEX_3; FORALL_3; VECTOR_ADD_COMPONENT;
3241              VECTOR_MUL_COMPONENT; BASIS_COMPONENT; ARITH; DIMINDEX_2;
3242              DROPOUT_BASIS_3; FORALL_2; dropout; LAMBDA_BETA] THEN
3243     ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN
3244     REWRITE_TAC[REAL_MUL_RZERO; REAL_ADD_LID; RIGHT_EXISTS_AND_THM] THEN
3245     REWRITE_TAC[REAL_ARITH `y = t * &1 + s <=> t = y - s`; EXISTS_REFL]]);;
3246
3247
3248
3249 let th1=prove(`(!x:real^3 v:real^3 u:real^3 w:real^3 t1:real t2:real t3:real. (t3 > &0) /\ (t1 + t2 + t3 = &1)
3250 /\ DISJOINT {x,v} {w} /\ ~collinear {x,v,u}/\ ~collinear {x,v,w}
3251  ==> azim x v u w =
3252  azim x v u (t1 % x + t2 % v + t3 % w))`,
3253 REPEAT GEN_TAC THEN STRIP_TAC THEN ASSUME_TAC(AFF_GT_2_1)
3254 THEN POP_ASSUM(MP_TAC o ISPECL [`x:real^3`;`v:real^3`;`w:real^3`])
3255   THEN ASM_REWRITE_TAC[] THEN DISCH_TAC
3256 THEN ABBREV_TAC `(y:real^3)= (t1:real)  % (x:real^3) + (t2:real) % (v:real^3) + (t3:real) % (w:real^3)`
3257       THEN SUBGOAL_THEN `(y:real^3) IN aff_gt {(x:real^3),(v:real^3)} {w:real^3}` ASSUME_TAC
3258 THENL[
3259 ASM_REWRITE_TAC[IN_ELIM_THM] THEN EXISTS_TAC `t1:real`
3260 THEN EXISTS_TAC `t2:real` THEN EXISTS_TAC `t3:real`
3261 THEN EXPAND_TAC "y" THEN ASM_MESON_TAC[REAL_ARITH`(a:real)> &0 <=> &0 < a ` ];
3262
3263  POP_ASSUM MP_TAC THEN
3264 ASSUME_TAC(th) THEN POP_ASSUM(MP_TAC o ISPECL [`x:real^3`;`v:real^3`;`u:real^3`;`w:real^3`])
3265   THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN POP_ASSUM (fun th-> REWRITE_TAC[SYM(th)])
3266 THEN REWRITE_TAC[IN_ELIM_THM] THEN ASM_SET_TAC[]]);;
3267
3268   let th2= prove(`!x:real^3 v:real^3 w:real^3. ~(x=v)==>  (w IN complement_set {x,v}==> ~ collinear {x,v,w})`,
3269 REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[CONTRAPOS_THM; COLLINEAR_3;COLLINEAR_LEMMA; complement_set; IN_ELIM_THM;affine_hull_2_fan] THEN STRIP_TAC
3270 THENL[
3271 ASM_MESON_TAC[VECTOR_ARITH`(x-v= vec 0)<=> (x=v)`];
3272  EXISTS_TAC `&0` THEN EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_ARITH`&0+ &1 = &1`; VECTOR_ARITH`&0 % x= vec 0`; VECTOR_ARITH`w=vec 0 + &1 % v <=> w - v = vec 0`] THEN ASM_SET_TAC[];
3273 EXISTS_TAC `c:real` THEN EXISTS_TAC `&1 - (c:real)` THEN REWRITE_TAC[REAL_ARITH`c+ &1 - c = &1`; VECTOR_ARITH`w=c % x  + (&1 - c) % v <=> w - v = c % (x-v)`] THEN ASM_SET_TAC[]]);;
3274
3275
3276
3277
3278 (* ========================================================================== *)
3279 (*                   CARD                         *)
3280 (* ========================================================================== *)
3281
3282
3283 let CARD_SING=prove(`!x:real^3 s:real^3->bool.
3284  FINITE s
3285 /\ s={x}
3286 ==>
3287 CARD s = 1`,
3288 REPEAT STRIP_TAC THEN
3289 MP_TAC(SET_RULE`(s:real^3->bool)={(x:real^3)} ==> ~(s={}) /\ x IN s /\ s DELETE x ={}`)
3290   THEN ASM_REWRITE_TAC[] THEN DISCH_TAC
3291   THEN MP_TAC(ISPEC`s:real^3->bool`CARD_EQ_0) THEN ASM_REWRITE_TAC[]
3292   THEN MP_TAC(ISPECL[`x:real^3`;`s:real^3->bool`]CARD_DELETE) THEN ASM_REWRITE_TAC[CARD_CLAUSES]
3293   THEN ARITH_TAC);;
3294
3295
3296
3297 (* ========================================================================== *)
3298 (*                   CLOSED AFF                         *)
3299 (* ========================================================================== *)
3300
3301
3302
3303
3304
3305
3306
3307 let closed_aff_ge_2_1=prove(`!x:real^3 v:real^3 u:real^3.
3308 ~collinear {x,v,u}
3309 ==>
3310 closed (aff_ge {x,v} {u})`,
3311 (let lemma=prove(`!x:real^3 v:real^3 u:real^3.
3312 {w:real^3| (w-x) dot (e2_fan x v u)= &0 /\ &0 <= (w-x) dot (e1_fan x v u)  }
3313 ={w:real^3| (w-x) dot (e2_fan x v u)= &0} INTER {w:real^3| (w-x) dot (e1_fan x v u) >= &0 }`,
3314 REWRITE_TAC[INTER; IN_ELIM_THM;REAL_ARITH`&0<=a <=> a >= &0`]) in
3315 (
3316 let lemma1=prove(`!x:real^3 v:real^3 u:real^3.
3317 closed {w:real^3| (w-x) dot (e2_fan x v u)= &0}`,
3318 REWRITE_TAC[ DOT_SYM] THEN REWRITE_TAC[DOT_RSUB;REAL_ARITH`a-b= &0<=> a=b`;]
3319  THEN REPEAT GEN_TAC THEN MP_TAC(ISPECL[`e2_fan (x:real^3) (v:real^3) (u:real^3)`;
3320 ` e2_fan (x:real^3) (v:real^3) (u:real^3) dot x`]CLOSED_HYPERPLANE) THEN ASM_SET_TAC[]) in
3321  (
3322 let lemma2=prove(`!x:real^3 v:real^3 u:real^3.
3323 closed {w:real^3| (w-x) dot (e1_fan x v u) >= &0 }`,
3324 REWRITE_TAC[ DOT_SYM] THEN REWRITE_TAC[DOT_RSUB;REAL_ARITH`a-b>= &0<=> a>=b`;]
3325  THEN REPEAT GEN_TAC THEN MP_TAC(ISPECL[`e1_fan (x:real^3) (v:real^3) (u:real^3)`;
3326 ` e1_fan (x:real^3) (v:real^3) (u:real^3) dot x`]CLOSED_HALFSPACE_GE) THEN ASM_SET_TAC[]) in
3327
3328 REPEAT STRIP_TAC THEN
3329 ASM_MESON_TAC[exp_aff_ge_by_dot;lemma;lemma1;lemma2;CLOSED_INTER]))));;
3330
3331
3332
3333
3334
3335 let closed_aff_ge_1_2=prove(`!(x:real^3)  (v:real^3) (w:real^3).
3336 ~collinear {x, v, w}
3337 ==>
3338 closed (aff_ge {x} {v , w})`,
3339 REPEAT STRIP_TAC
3340 THEN POP_ASSUM (fun th-> MP_TAC (th) THEN ONCE_REWRITE_TAC[SET_RULE`{A,B,C}={A,C,B}`] THEN ASSUME_TAC(th))
3341 THEN MRESA_TAC aff_ge_inter_aff_ge[`x:real^3`;`v:real^3`;`w:real^3`]
3342 THEN  MRESA_TAC closed_aff_ge_2_1[`x:real^3`;`w:real^3`;`v:real^3`]
3343 THEN  MRESA_TAC closed_aff_ge_2_1[`x:real^3`;`v:real^3`;`w:real^3`]
3344 THEN ASM_MESON_TAC[CLOSED_INTER]);;
3345
3346
3347
3348
3349
3350 let closed_halfline_fan=prove(`!(x:real^3) (v:real^3) (u:real^3).
3351 ~collinear {x,v,u}
3352 ==>
3353 closed (aff_ge {x} { v})`,
3354
3355
3356 (let lemma=prove(`!x v u :real^3.
3357 {w:real^3| (w-x) dot (e2_fan x v u)= &0 /\ &0 <= (w-x) dot (e3_fan x v u)
3358 /\ (w-x) dot (e1_fan x v u)= &0 }= {w:real^3| (w-x) dot (e2_fan x v u)= &0} INTER
3359 ({w:real^3| (w-x) dot (e1_fan x v u)= &0} INTER {w:real^3| &0 <= (w-x) dot (e3_fan x v u)})`,
3360 REWRITE_TAC[INTER;IN_ELIM_THM] THEN ASM_SET_TAC[]) in
3361
3362
3363 (let lemma1=prove(`!x:real^3 v:real^3 u:real^3.
3364 closed {w:real^3| (w-x) dot (e2_fan x v u)= &0}`,
3365 REWRITE_TAC[ DOT_SYM] THEN REWRITE_TAC[DOT_RSUB;REAL_ARITH`a-b= &0<=> a=b`;]
3366  THEN REPEAT GEN_TAC THEN MP_TAC(ISPECL[`e2_fan (x:real^3) (v:real^3) (u:real^3)`;
3367 ` e2_fan (x:real^3) (v:real^3) (u:real^3) dot x`]CLOSED_HYPERPLANE) THEN ASM_SET_TAC[]) in
3368
3369 (let lemma3=prove(`!x:real^3 v:real^3 u:real^3.
3370 closed {w:real^3| (w-x) dot (e1_fan x v u)= &0}`,
3371 REWRITE_TAC[ DOT_SYM] THEN REWRITE_TAC[DOT_RSUB;REAL_ARITH`a-b= &0<=> a=b`;]
3372  THEN REPEAT GEN_TAC THEN MP_TAC(ISPECL[`e1_fan (x:real^3) (v:real^3) (u:real^3)`;
3373 ` e1_fan (x:real^3) (v:real^3) (u:real^3) dot x`]CLOSED_HYPERPLANE) THEN ASM_SET_TAC[]) in
3374
3375 (let lemma2=prove(`!x:real^3 v:real^3 u:real^3.
3376 closed {w:real^3| &0 <= (w-x) dot (e3_fan x v u)  }`,
3377 REWRITE_TAC[ DOT_SYM] THEN REWRITE_TAC[DOT_RSUB;REAL_ARITH`&0 <= a-b<=> a>=b`;]
3378  THEN REPEAT GEN_TAC THEN MP_TAC(ISPECL[`e3_fan (x:real^3) (v:real^3) (u:real^3)`;
3379 ` e3_fan (x:real^3) (v:real^3) (u:real^3) dot x`]CLOSED_HALFSPACE_GE) THEN ASM_SET_TAC[]) in
3380 REPEAT STRIP_TAC THEN MP_TAC(ISPECL[`x:real^3`;` v:real^3`; `u:real^3`]exp_aff_ge_by_dot_1_1)
3381   THEN REWRITE_TAC[lemma]
3382 THEN RESA_TAC THEN ASSUME_TAC(ISPECL[`x:real^3`;` v:real^3`; `u:real^3`]lemma1) THEN ASSUME_TAC(ISPECL[`x:real^3`;` v:real^3`; `u:real^3`]lemma2) THEN ASSUME_TAC(ISPECL[`x:real^3`;` v:real^3`; `u:real^3`]lemma3)
3383   THEN SUBGOAL_THEN`closed({w:real^3| (w-x) dot (e1_fan x v u)= &0} INTER {w:real^3| &0 <= (w-x) dot (e3_fan x v u)})`
3384 ASSUME_TAC
3385 THENL[ASM_MESON_TAC[CLOSED_INTER];
3386 ASM_MESON_TAC[CLOSED_INTER]])))));;
3387
3388
3389
3390
3391
3392 (*--------------------------------------------------------------------------------------------*)
3393 (*       The properties of      ballnorm_fan (x:real^3)={y:real^3 | dist(x,y) = &1}           *)
3394 (*--------------------------------------------------------------------------------------------*)
3395
3396
3397
3398
3399
3400 let ballnorm_fan=new_definition`ballnorm_fan (x:real^3)={y:real^3 | dist(x,y) = &1}`;;
3401
3402
3403 let closed_ballnorm_fan=prove(`!x:real^3. closed (ballnorm_fan x)`,
3404 GEN_TAC THEN REWRITE_TAC[ballnorm_fan] THEN
3405 SUBGOAL_THEN  `{y:real^3 | dist((x:real^3),(y:real^3)) = &1} = frontier( ball((x:real^3), &1))` ASSUME_TAC
3406  THENL [ASSUME_TAC(REAL_ARITH `&0 < &1`) THEN POP_ASSUM MP_TAC THEN
3407         SIMP_TAC[frontier; CLOSURE_BALL; INTERIOR_OPEN; OPEN_BALL;
3408            REAL_LT_IMP_LE] THEN
3409   REWRITE_TAC[EXTENSION; IN_DIFF; IN_ELIM_THM; IN_BALL; IN_CBALL] THEN
3410   REAL_ARITH_TAC;
3411    ASM_REWRITE_TAC[] THEN MESON_TAC[FRONTIER_CLOSED]]);;
3412
3413 let bounded_ballnorm_fan=prove(`!x:real^3 . bounded(ballnorm_fan x)`,
3414 REPEAT GEN_TAC THEN REWRITE_TAC[ballnorm_fan;bounded] THEN
3415  EXISTS_TAC `norm(x:real^3) + &1`  THEN REWRITE_TAC[ dist; IN_ELIM_THM]
3416   THEN GEN_TAC THEN STRIP_TAC THEN ASSUME_TAC(NORM_TRIANGLE_SUB) THEN
3417 POP_ASSUM (MP_TAC o ISPECL [`(x':real^3)`; `(x:real^3)`]  o INST_TYPE [`:real^3`,`:real^3`])
3418   THEN REWRITE_TAC[NORM_SUB] THEN ASM_REWRITE_TAC[]);;
3419
3420 let bounded_ballnorm_fans=prove(`!x:real^3 v:real^3 w:real^3. bounded (aff_ge {x} {v, w} INTER ballnorm_fan x)`,
3421 REPEAT GEN_TAC THEN ASSUME_TAC (bounded_ballnorm_fan) THEN
3422 POP_ASSUM (MP_TAC o ISPEC `x:real^3`) THEN DISCH_TAC THEN
3423 SUBGOAL_THEN `aff_ge {x} {(v:real^3), (w:real^3)} INTER ballnorm_fan x SUBSET ballnorm_fan (x:real^3)` ASSUME_TAC THENL
3424 [ASM_SET_TAC[];
3425 ASM_MESON_TAC[BOUNDED_SUBSET ]]);;
3426
3427
3428
3429 (*--------------------------------------------------------------------------------------------*)
3430 (*       The properties of fan in norm ball                                                  *)
3431 (*--------------------------------------------------------------------------------------------*)
3432
3433
3434
3435
3436 let closed_aff_ge_ballnorm_fan=prove(`!(x:real^3)   (v:real^3) (w:real^3).
3437 ~collinear{x,v,w}
3438 ==>
3439 closed (aff_ge {x} {v, w} INTER ballnorm_fan x)`,
3440 ASM_MESON_TAC[closed_aff_ge_1_2; closed_ballnorm_fan;CLOSED_INTER]);;
3441
3442
3443
3444
3445
3446 let compact_aff_ge_ballnorm_fan=prove(`
3447 !(x:real^3) (v:real^3) (w:real^3).
3448 ~collinear{x,v,w}
3449 ==>
3450 compact (aff_ge {x} {v, w} INTER ballnorm_fan x)`,
3451 REPEAT GEN_TAC THEN DISCH_TAC THEN
3452 SUBGOAL_THEN `closed (aff_ge {x} {v, w} INTER ballnorm_fan x)` ASSUME_TAC
3453 THENL
3454   [ASM_MESON_TAC[closed_aff_ge_ballnorm_fan];
3455     ASSUME_TAC(bounded_ballnorm_fans)
3456     THEN
3457    POP_ASSUM (MP_TAC o ISPECL [`x:real^3`; `v:real^3`; `w:real^3`]) THEN
3458     ASM_MESON_TAC[BOUNDED_CLOSED_IMP_COMPACT ]]);;
3459
3460
3461
3462
3463
3464
3465
3466 let closed_point_fan=prove(`
3467 (!x:real^3 v:real^3 u:real^3.
3468 ~collinear {x,v,u}
3469 ==>
3470 closed (aff_ge {x} {v} INTER ballnorm_fan x) )`,
3471 REPEAT GEN_TAC THEN DISCH_TAC THEN
3472 SUBGOAL_THEN `closed (aff_ge {(x:real^3)} {(v:real^3)})` ASSUME_TAC THENL
3473    [ASM_MESON_TAC[ closed_halfline_fan];
3474     SUBGOAL_THEN `closed (ballnorm_fan (x:real^3))` ASSUME_TAC THENL
3475        [ASM_MESON_TAC[closed_ballnorm_fan];
3476         ASM_MESON_TAC[CLOSED_INTER]]]);;
3477
3478
3479
3480 (* ========================================================================== *)
3481 (*                   RCONE                         *)
3482 (* ========================================================================== *)
3483
3484
3485 (* rcone^0(x,v,h) *)
3486
3487 let rcone_fan = new_definition `rcone_fan  (x:real^3) (v:real^3) (h:real) = {y:real^3 | (y-x) dot (v-x) >(dist(y,x)*dist(v,x)*h)}`;;
3488
3489
3490 let origin_not_in_rcone_fan=prove(`!(x:real^3) (v:real^3) (h:real). ~(x IN rcone_fan x v h)`,
3491 REPEAT GEN_TAC
3492 THEN REWRITE_TAC[rcone_fan; IN_ELIM_THM; VECTOR_ARITH`x-x= vec 0`; DOT_LZERO;DIST_REFL]
3493 THEN REDUCE_ARITH_TAC
3494 THEN REAL_ARITH_TAC);;
3495
3496
3497 let conditions_in_rcone_fan=prove(`!x v u w:real^3 s:real.
3498 ~collinear {x,v,u}/\ w IN aff_gt {x} {v,u} /\ &0<s /\ s< pi/ &2 /\u IN rcone_fan x v (cos s)==> w IN rcone_fan x v (cos s) `,
3499
3500 REWRITE_TAC[rcone_fan;IN_ELIM_THM]
3501 THEN REPEAT STRIP_TAC
3502 THEN ASM_TAC
3503 THEN DISCH_TAC
3504 THEN MRESA_TAC th3[`(x:real^3)` ;` (v:real^3)`;`(u:real^3)`;]
3505 THEN MRESAL_TAC AFF_GT_1_2[`(x:real^3)` ;` (v:real^3)`;` (u:real^3)  `;][IN_ELIM_THM]
3506 THEN REPEAT STRIP_TAC
3507 THEN POP_ASSUM MP_TAC
3508 THEN ASM_REWRITE_TAC[dist;VECTOR_ARITH`(t1 % x + t2 % v + t3 % u) - x=((t1+t2+t3)- &1) % x + t2 % (v-x) + t3 % (u-x)`;REAL_ARITH`&1 - &1= &0`;REAL_ARITH`A>B<=> B<A`;DOT_LADD;DOT_LMUL]
3509 THEN REDUCE_VECTOR_TAC
3510 THEN REDUCE_ARITH_TAC
3511 THEN STRIP_TAC
3512 THEN MP_TAC(REAL_ARITH`&0< t3==> &0<= t3`) THEN RESA_TAC
3513 THEN MRESA1_TAC REAL_ABS_REFL`t3:real`
3514 THEN MRESA_TAC NORM_MUL[`t3:real`;`u-x:real^3`]
3515 THEN MP_TAC(REAL_ARITH`&0< t2==> &0<= t2`) THEN RESA_TAC
3516 THEN MRESA1_TAC REAL_ABS_REFL`t2:real`
3517 THEN MRESA_TAC NORM_MUL[`t2:real`;`v-x:real^3`]
3518 THEN MRESA_TAC REAL_LT_LMUL[`t3:real`;`norm (u - x) * norm (v - x:real^3) * (cos s):real`;`(u - x) dot (v - x:real^3)`]
3519 THEN MRESA1_TAC COS_BOUNDS`s:real`
3520 THEN MRESA1_TAC DOT_POS_LE`(v - x):real^3`
3521 THEN MRESA_TAC REAL_LE_MUL[`t2:real`;`(v-x) dot (v-x:real^3)`;]
3522 THEN MRESA_TAC REAL_LE_LMUL[`t2*((v - x:real^3) dot (v-x)):real`;`cos s:real`;`&1`]
3523 THEN POP_ASSUM MP_TAC THEN REDUCE_ARITH_TAC
3524 THEN GEN_REWRITE_TAC(LAND_CONV o LAND_CONV o ONCE_DEPTH_CONV)[DOT_SQUARE_NORM;]
3525 THEN STRIP_TAC
3526 THEN MP_TAC(REAL_ARITH` t3 * norm (u - x) * norm (v - x) * cos s< t3 * ((u - x) dot (v - x))
3527 /\(t2 * norm (v - x) pow 2) * cos s <= t2 * ((v - x) dot (v - x))
3528 ==> (t2 * norm (v - x:real^3)  + t3 * norm (u - x)) * norm (v - x) * cos s< t2 * ((v - x) dot (v - x))+ t3 * ((u - x) dot (v - x))`)
3529 THEN RESA_TAC
3530 THEN MRESA_TAC NORM_TRIANGLE[`t2 %(v - x:real^3)`;`t3 % (u - x:real^3)`]
3531 THEN MRESA1_TAC NORM_POS_LE`(v - x):real^3`
3532 THEN MRESA1_TAC COS_POS_PI2`(s):real`
3533 THEN MP_TAC(REAL_ARITH`&0< cos s:real ==> &0<= cos s`) THEN RESA_TAC
3534 THEN MRESA_TAC REAL_LE_MUL[`norm  (v-x:real^3)`;`cos s:real`]
3535 THEN MRESA_TAC REAL_LE_RMUL[`norm (t2 % (v - x) + t3 % (u - x):real^3):real`;`t2 * norm (v - x:real^3) + t3 * norm (u - x)`;`norm (v - x:real^3) * cos s`]
3536 THEN POP_ASSUM MP_TAC
3537 THEN REMOVE_ASSUM_TAC THEN REMOVE_ASSUM_TAC THEN REMOVE_ASSUM_TAC THEN REMOVE_ASSUM_TAC THEN REMOVE_ASSUM_TAC
3538 THEN POP_ASSUM MP_TAC
3539 THEN REAL_ARITH_TAC);;
3540
3541
3542
3543 let not_empty_rcone_fan_inter_aff_gt=prove(`!x v u:real^3 h:real.
3544 ~collinear {x,v,u} /\ &0< h /\ h<= pi==>
3545 ~(rcone_fan x v (cos h) INTER aff_gt {x} {v, u}={})`,
3546 REPEAT STRIP_TAC
3547 THEN POP_ASSUM MP_TAC
3548 THEN MRESA_TAC th3[`x:real^3`;`v:real^3`;`u:real^3`]
3549 THEN SUBGOAL_THEN`~(norm((v:real^3)-(x:real^3))= &0)` ASSUME_TAC
3550 THENL(*1*)[ASM_REWRITE_TAC[NORM_EQ_0;VECTOR_ARITH`v-x=vec 0<=> x=v`];
3551 ASM_REWRITE_TAC[rcone_fan;SET_RULE`~(A={})<=> ?y. y IN A`;INTER;IN_ELIM_THM]
3552 THEN DISJ_CASES_TAC(REAL_ARITH`(v - x) dot (u - x:real^3) <= &0 \/ &0< (v - x) dot (u - x)`)
3553 THENL(*2*)[ABBREV_TAC`s1= min h (pi / &2) / &2:real`
3554 THEN MP_TAC(REAL_ARITH` &0< pi /\ min h (pi / &2) / &2 =s1 /\ &0< h:real ==> &0<= s1 /\ &0<s1 /\ s1< h/\ s1<pi/ &2`)
3555 THEN ASM_REWRITE_TAC[PI_WORKS]
3556 THEN STRIP_TAC
3557 THEN EXISTS_TAC`sin (s1) % (e1_fan x v u) + (cos s1) %(e3_fan x v u)+x :real^3 `
3558 THEN REWRITE_TAC[dist;vector_norm;VECTOR_ARITH`(B+C+A)-A=(B+C:real^3)`; DOT_LADD;DOT_RADD;DOT_RMUL;DOT_LMUL;]
3559 THEN MRESAL_TAC properties_coordinate[`x:real^3`;`v:real^3`;`u:real^3`][orthonormal]
3560 THEN ONCE_REWRITE_TAC[DOT_SYM]
3561 THEN ASSUME_TAC(ISPEC`s1:real`SIN_CIRCLE)
3562 THEN ASM_REWRITE_TAC[]
3563 THEN REDUCE_ARITH_TAC
3564 THEN ASM_REWRITE_TAC[REAL_ARITH`sin s * sin s + cos s * cos s =(sin s) pow 2 + (cos s) pow 2`;e3_fan;DOT_RMUL; ]
3565 THEN ONCE_REWRITE_TAC[GSYM vector_norm;]
3566 THEN REWRITE_TAC[DOT_SQUARE_NORM;]
3567 THEN MRESAL1_TAC  SQRT_POW_2`&1`[REAL_ARITH`a pow 2 = a * a`;REAL_ARITH`&0<= &1`;]
3568 THEN POP_ASSUM MP_TAC
3569 THEN MRESAL_TAC SQRT_MUL[`&1`;`&1`][REAL_ARITH`&0<= &1`;]
3570 THEN POP_ASSUM (fun th-> REWRITE_TAC[SYM(th); REAL_ARITH`&1* &1= &1`])
3571 THEN RESA_TAC
3572 THEN REDUCE_ARITH_TAC
3573 THEN MP_TAC(ISPEC`norm((v:real^3)-(x:real^3))`REAL_MUL_LINV)
3574 THEN REWRITE_TAC[REAL_ARITH`A*B*D *D=(B*D) *D *A`;REAL_ARITH`A>B<=> B<A`]
3575 THEN RESA_TAC
3576 THEN REDUCE_ARITH_TAC
3577 THEN ASSUME_TAC(ISPEC`v-x:real^3`NORM_POS_LE)
3578 THEN STRIP_TAC
3579 THENL(*3*)[ MATCH_MP_TAC REAL_LT_LMUL
3580 THEN MP_TAC(REAL_ARITH`~(norm (v - x:real^3) = &0)/\ &0 <= norm (v - x)==> &0< norm (v - x) `)
3581 THEN RESA_TAC
3582 THEN MATCH_MP_TAC COS_MONO_LT
3583 THEN ASM_REWRITE_TAC[];(*3*)
3584 MRESA_TAC condition1_to_in_aff_gt_by_angle[`x:real^3`;`v:real^3`;`u:real^3`;`s1:real`]
3585 THEN POP_ASSUM MP_TAC
3586 THEN REWRITE_TAC[e3_fan]](*3*);(*2*)
3587 SUBGOAL_THEN`&0<(atn ((norm ((v - x) cross (u - x))) * inv((v - x) dot (u - x:real^3))))` ASSUME_TAC
3588 THENL(*3*)[MP_TAC(ISPEC`(v - x) dot (u - x:real^3)`REAL_LT_INV)
3589 THEN RESA_TAC
3590 THEN ASSUME_TAC(PI_WORKS)
3591 THEN MP_TAC(REAL_ARITH`&0< pi ==> --(pi / &2) < &0`)
3592 THEN RESA_TAC
3593 THEN MRESAL_TAC  ATN_MONO_LT[`&0:real`;` (norm ((v - x) cross (u - x)) * inv ((v - x) dot (u - x))):real`][ ATN_0]
3594 THEN POP_ASSUM MATCH_MP_TAC
3595 THEN MATCH_MP_TAC REAL_LT_MUL
3596 THEN ASM_REWRITE_TAC[]
3597 THEN SUBGOAL_THEN`~(norm((v - x) cross (u - x:real^3))= &0)` ASSUME_TAC
3598 THENL(*4*)[
3599 ASM_REWRITE_TAC[NORM_EQ_0]
3600 THEN MP_TAC(ISPECL[`v-x:real^3`;`u-x:real^3`]CROSS_EQ_0)
3601 THEN ONCE_REWRITE_TAC[GSYM COLLINEAR_3;]
3602 THEN RESA_TAC
3603 THEN ONCE_REWRITE_TAC[SET_RULE`{A,B,C}={B,A,C}`]
3604 THEN ASM_REWRITE_TAC[];(*4*)
3605
3606 POP_ASSUM MP_TAC
3607 THEN MP_TAC(ISPEC`(v - x) cross (u - x:real^3)`NORM_POS_LE)
3608 THEN REAL_ARITH_TAC](*4*);(*3*)
3609
3610  ASSUME_TAC(ISPEC`(norm ((v - x) cross (u - x)) * inv ((v - x) dot (u - x))):real`ATN_BOUNDS)
3611 THEN ABBREV_TAC`s2= atn ((norm ((v - x) cross (u - x))) * inv((v - x) dot (u - x))):real`
3612 THEN ABBREV_TAC`s1= min (h:real) (s2:real) / &2`
3613 THEN MP_TAC(REAL_ARITH`&0< h /\ s1= min (h:real) (s2) / &2  /\ &0< pi /\  &0< s2 /\ s2 < pi/ &2==> &0<= s1 /\ &0<s1 /\ s1<pi/ &2 /\ s1<h/\  s1< s2
3614 `)
3615 THEN REWRITE_TAC[PI_WORKS]
3616 THEN RESA_TAC
3617 THEN EXISTS_TAC`sin (s1) % (e1_fan x v u) + (cos s1) %(e3_fan x v u)+x :real^3 `
3618 THEN REWRITE_TAC[dist;vector_norm;VECTOR_ARITH`(B+C+A)-A=(B+C:real^3)`; DOT_LADD;DOT_RADD;DOT_RMUL;DOT_LMUL;]
3619 THEN MRESAL_TAC properties_coordinate[`x:real^3`;`v:real^3`;`u:real^3`][orthonormal]
3620 THEN ONCE_REWRITE_TAC[DOT_SYM]
3621 THEN ASSUME_TAC(ISPEC`s1:real`SIN_CIRCLE)
3622 THEN ASM_REWRITE_TAC[]
3623 THEN REDUCE_ARITH_TAC
3624 THEN ASM_REWRITE_TAC[REAL_ARITH`sin s * sin s + cos s * cos s =(sin s) pow 2 + (cos s) pow 2`;e3_fan;DOT_RMUL; ]
3625 THEN ONCE_REWRITE_TAC[GSYM vector_norm;]
3626 THEN REWRITE_TAC[DOT_SQUARE_NORM;]
3627 THEN MRESAL1_TAC  SQRT_POW_2`&1`[REAL_ARITH`a pow 2 = a * a`;REAL_ARITH`&0<= &1`;]
3628 THEN POP_ASSUM MP_TAC
3629 THEN MRESAL_TAC SQRT_MUL[`&1`;`&1`][REAL_ARITH`&0<= &1`;]
3630 THEN POP_ASSUM (fun th-> REWRITE_TAC[SYM(th); REAL_ARITH`&1* &1= &1`])
3631 THEN RESA_TAC
3632 THEN REDUCE_ARITH_TAC
3633 THEN MP_TAC(ISPEC`norm((v:real^3)-(x:real^3))`REAL_MUL_LINV)
3634 THEN REWRITE_TAC[REAL_ARITH`A*B*D *D=(B*D) *D *A`;REAL_ARITH`A>B<=> B<A`]
3635 THEN RESA_TAC
3636 THEN REDUCE_ARITH_TAC
3637 THEN ASSUME_TAC(ISPEC`v-x:real^3`NORM_POS_LE)
3638 THEN STRIP_TAC
3639 THENL(*4*)[ MATCH_MP_TAC REAL_LT_LMUL
3640 THEN MP_TAC(REAL_ARITH`~(norm (v - x:real^3) = &0)/\ &0 <= norm (v - x)==> &0< norm (v - x) `)
3641 THEN RESA_TAC
3642 THEN MATCH_MP_TAC COS_MONO_LT
3643 THEN ASM_REWRITE_TAC[];(*4*)
3644 MRESA_TAC condition_to_in_aff_gt_by_angle[`x:real^3`;`v:real^3`;`u:real^3`;`s1:real`]
3645 THEN POP_ASSUM MP_TAC
3646 THEN REWRITE_TAC[e3_fan]]]]]);;
3647
3648
3649
3650
3651 (* ========================================================================== *)
3652 (*                   TOPOLOGY COMPONENT YFAN                         *)
3653 (* ========================================================================== *)
3654
3655
3656
3657
3658 let in_topological_component_yfan_is_connected=prove(`!x:real^3 (V:real^3->bool) (E:(real^3->bool)->bool) U:real^3->bool.
3659 U IN topological_component_yfan (x,V,E)
3660 ==> connected U`,
3661 REWRITE_TAC[topological_component_yfan;IN_ELIM_THM]
3662 THEN REPEAT STRIP_TAC
3663 THEN ASM_REWRITE_TAC[CONNECTED_CONNECTED_COMPONENT]);;
3664
3665
3666
3667 let exists_point_in_component_yfan=prove(`!x:real^3 (V:real^3->bool) (E:(real^3->bool)->bool) U:real^3->bool.
3668 U IN topological_component_yfan (x,V,E)
3669 ==> ?z. z IN U`,
3670 REPEAT STRIP_TAC
3671 THEN POP_ASSUM MP_TAC
3672 THEN REWRITE_TAC[topological_component_yfan;IN_ELIM_THM]
3673 THEN STRIP_TAC
3674 THEN EXISTS_TAC`y:real^3`
3675 THEN ASM_REWRITE_TAC[CONNECTED_COMPONENT_SET;IN_ELIM_THM]
3676 THEN EXISTS_TAC`{y:real^3}`
3677 THEN ASM_REWRITE_TAC[CONNECTED_SING;IN_SING]
3678 THEN ASM_TAC THEN SET_TAC[]);;
3679
3680 let in_topological_component_yfan_is_connected=prove(`!x:real^3 (V:real^3->bool) (E:(real^3->bool)->bool) U:real^3->bool.
3681 U IN topological_component_yfan (x,V,E)
3682 ==> connected U`,
3683 REWRITE_TAC[topological_component_yfan;IN_ELIM_THM]
3684 THEN REPEAT STRIP_TAC
3685 THEN ASM_REWRITE_TAC[CONNECTED_CONNECTED_COMPONENT]);;
3686
3687
3688 let expand_element_in_topological_component_yfan=prove(`!x:real^3 (V:real^3->bool) (E:(real^3->bool)->bool) U:real^3->bool z:real^3.
3689  U IN topological_component_yfan (x,V,E)
3690 /\ z IN U
3691 ==> U=connected_component (yfan(x,V,E)) z`,
3692 REWRITE_TAC[topological_component_yfan;IN_ELIM_THM]
3693 THEN REPEAT STRIP_TAC
3694 THEN POP_ASSUM MP_TAC
3695 THEN ASM_REWRITE_TAC[]
3696 THEN STRIP_TAC
3697 THEN MRESA_TAC CONNECTED_COMPONENT_EQ[`yfan(x:real^3, (V:real^3->bool) ,E)`;`y:real^3`;`z:real^3`]);;
3698
3699
3700
3701 (* ========================================================================== *)
3702 (*                 BASIC PROPERTIES OF CONVEX                         *)
3703 (* ========================================================================== *)
3704
3705 let expansion_convex_fan=prove(`!(v:real^3) (u:real^3) (w:real^3) (t:real) s:real.
3706 &0 <= t /\ t<= &1
3707 /\ &0 <=s /\ s <= &1
3708 ==> (&1-s)%v+s%((&1-t)%u+ t%w) IN convex hull{v,u,w}`,
3709
3710 REWRITE_TAC[REAL_ARITH`A<= &1 <=> &0<= &1 -A`]
3711 THEN REPEAT STRIP_TAC
3712 THEN REWRITE_TAC[CONVEX_HULL_3; IN_ELIM_THM;]
3713 THEN EXISTS_TAC`&1 - (s:real)`
3714 THEN EXISTS_TAC`(s:real)*(&1 - (t:real))`
3715 THEN EXISTS_TAC`(s:real)*(t:real)`
3716 THEN ASM_REWRITE_TAC[VECTOR_ARITH`s%((&1-t)%u+ t%w)= (s*(&1-t))%u+ (s*t)%w:real^3`]
3717 THEN STRIP_TAC
3718 THENL[MATCH_MP_TAC REAL_LE_MUL
3719 THEN ASM_TAC
3720 THEN REAL_ARITH_TAC;
3721 STRIP_TAC
3722 THENL[MATCH_MP_TAC REAL_LE_MUL
3723 THEN ASM_TAC
3724 THEN REAL_ARITH_TAC;
3725 REAL_ARITH_TAC]]);;
3726
3727
3728 let expansion1_convex_fan=prove(`!(v:real^3) (u:real^3) s:real.
3729 &0 <=s /\ s <= &1
3730 ==> (&1-s)%v+s%u IN convex hull{v,u}`,
3731 REPEAT STRIP_TAC
3732 THEN MP_TAC(ISPECL[`(v:real^3)`;` (u:real^3)`;` (u:real^3)`;` &0`;`s:real`]expansion_convex_fan)
3733 THEN ASM_REWRITE_TAC[SET_RULE`{A,B,B}={A,B}`]
3734 THEN REDUCE_ARITH_TAC
3735 THEN REDUCE_VECTOR_TAC
3736 THEN DISCH_TAC
3737 THEN POP_ASSUM MATCH_MP_TAC
3738 THEN REAL_ARITH_TAC);;
3739
3740
3741
3742 (* ========================================================================== *)
3743 (*       CROSS_DOT       (^_^)                 *)
3744 (* ========================================================================== *)
3745
3746
3747 let JBDNJJB=prove(`!u:real^3 v:real^3 w:real^3.
3748 ~collinear {vec 0, u, v} /\ ~collinear {vec 0, u, w}
3749 ==>
3750 ?t:real. &0< t /\ sin(azim (vec 0) u v w)=t *(u cross v) dot w`,
3751
3752 REPEAT STRIP_TAC
3753 THEN MRESA_TAC th3[`((vec 0):real^3)`;` (u:real^3)`;` (v:real^3)`]
3754 THEN MRESA_TAC properties_coordinate[`((vec 0):real^3)`;` (u:real^3)`;` (v:real^3)`]
3755 THEN MRESA_TAC azim[`((vec 0):real^3)`;` (u:real^3)`;` (v:real^3)`;`(w:real^3)`]
3756 THEN POP_ASSUM (fun th->MRESA_TAC th [`e1_fan ((vec 0):real^3) (u:real^3) (v:real^3)`;`e2_fan ((vec 0):real^3) (u:real^3) (v:real^3)`;`e3_fan ((vec 0):real^3) (u:real^3) (v:real^3)`])
3757 THEN POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC
3758 THEN DISCH_THEN (LABEL_TAC"YEU EM")
3759 THEN DISCH_TAC THEN DISCH_TAC
3760 THEN MRESA_TAC sincos1_of_u_fan[`((vec 0):real^3)`;` (u:real^3)`;` (v:real^3)`;`r1:real`; `psi:real`; `h1:real`]
3761 THEN REMOVE_THEN "YEU EM" MP_TAC
3762 THEN ASM_REWRITE_TAC[COS_ADD;SIN_ADD;]
3763 THEN REDUCE_ARITH_TAC
3764 THEN REDUCE_VECTOR_TAC
3765 THEN STRIP_TAC
3766 THEN MP_TAC(SET_RULE`w =
3767       (r2 * cos (azim (vec 0) u v w)) % e1_fan (vec 0) u v +
3768       (r2 * sin (azim (vec 0) u v w)) % e2_fan (vec 0) u v +
3769       h2 % u ==>
3770 (u cross v) dot w =
3771 (u cross v) dot ((r2 * cos (azim (vec 0) u v w)) % e1_fan (vec 0) u v +
3772       (r2 * sin (azim (vec 0) u v w)) % e2_fan (vec 0) u v +
3773       h2 % u)`)
3774 THEN POP_ASSUM (fun th->GEN_REWRITE_TAC(LAND_CONV o LAND_CONV o LAND_CONV o ONCE_DEPTH_CONV)[th])
3775 THEN REWRITE_TAC[DOT_LADD; DOT_RADD; DOT_LMUL; DOT_RMUL;DOT_CROSS_SELF; e2_fan;e1_fan;e3_fan;
3776 VECTOR_ARITH`A- vec 0= A`;CROSS_LADD; CROSS_RADD; CROSS_LMUL; CROSS_RMUL;CROSS_REFL;CROSS_RNEG;CROSS_LNEG;]
3777 THEN REDUCE_ARITH_TAC
3778 THEN REWRITE_TAC[NORM_MUL;REAL_INV_MUL; REAL_ABS_INV;REAL_INV_INV;REAL_ABS_NORM;DOT_SQUARE_NORM
3779 ;REAL_ARITH`(r2 * sin (azim (vec 0) u v w)) *
3780  (norm u * inv (norm (u cross v))) *
3781  inv (norm u) *
3782  norm (u cross v) pow 2 =(r2* norm(u cross v)) * sin (azim (vec 0) u v w) *
3783  ( inv (norm u) * norm u)*
3784 ( inv (norm (u cross v))* norm (u cross (v:real^3)))`
3785 ]
3786 THEN MP_TAC(ISPECL[`u:real^3`;`(vec 0) :real^3`]imp_norm_not_zero_fan)
3787 THEN REDUCE_VECTOR_TAC
3788 THEN RESA_TAC
3789 THEN MP_TAC(ISPEC`(norm(u:real^3))`REAL_MUL_LINV)
3790 THEN RESA_TAC
3791 THEN ASSUME_TAC(ISPEC`u:real^3`NORM_POS_LE)
3792 THEN MP_TAC(REAL_ARITH`~(&0 =norm(u:real^3)) /\ &0 <= norm(u:real^3)==> &0 <norm(u:real^3)`)
3793 THEN RESA_TAC
3794 THEN SUBGOAL_THEN`~(u cross v = vec 0)` ASSUME_TAC
3795 THENL[ASM_REWRITE_TAC[CROSS_EQ_0];
3796
3797 MP_TAC(ISPECL[`u cross v :real^3`;`(vec 0) :real^3`]imp_norm_not_zero_fan)
3798 THEN REDUCE_VECTOR_TAC
3799 THEN RESA_TAC
3800 THEN MP_TAC(ISPEC`(norm(u cross v:real^3))`REAL_MUL_LINV)
3801 THEN RESA_TAC
3802 THEN ASSUME_TAC(ISPEC`u cross v:real^3`NORM_POS_LE)
3803 THEN MP_TAC(REAL_ARITH`~(&0 =norm(u cross v:real^3)) /\ &0 <= norm(u cross v:real^3)==> &0 <norm(u cross v:real^3)`)
3804 THEN RESA_TAC
3805 THEN MRESA_TAC REAL_LT_MUL[`r2:real`;`norm(u cross v:real^3)`]
3806 THEN MP_TAC(REAL_ARITH`&0<(r2:real)*norm(u cross v:real^3)==> ~((r2:real)*norm(u cross v:real^3)= &0)`)
3807 THEN REDUCE_VECTOR_TAC
3808 THEN RESA_TAC
3809 THEN MP_TAC(ISPEC`(r2 * norm(u cross v:real^3))`REAL_MUL_LINV)
3810 THEN RESA_TAC
3811 THEN MP_TAC(ISPEC`(r2 * norm(u cross v:real^3))`REAL_LT_INV)
3812 THEN RESA_TAC
3813 THEN REDUCE_ARITH_TAC
3814 THEN STRIP_TAC
3815 THEN MP_TAC(SET_RULE`(u cross v) dot w = (r2 * norm (u cross v)) * sin (azim (vec 0) u v w) ==>
3816 inv (r2 * norm (u cross v))*(r2 * norm (u cross v)) * sin (azim (vec 0) u v w)= inv (r2 * norm (u cross v)) *((u cross v) dot w)`)
3817 THEN POP_ASSUM (fun th->GEN_REWRITE_TAC(LAND_CONV o LAND_CONV o LAND_CONV o ONCE_DEPTH_CONV)[th])
3818 THEN ASM_REWRITE_TAC[REAL_ARITH`inv (r2 * norm (u cross v)) * (r2 * norm (u cross v)) *
3819  sin (azim (vec 0) u v w)=(inv (r2 * norm (u cross v)) * (r2 * norm (u cross v)))*
3820  sin (azim (vec 0) u v w)`]
3821 THEN REDUCE_ARITH_TAC
3822 THEN STRIP_TAC
3823 THEN EXISTS_TAC`inv (r2 * norm (u cross v)):real`
3824 THEN ASM_REWRITE_TAC[]]);;
3825
3826
3827
3828
3829
3830
3831 let cross_dot_fully_surrounded_fan=prove(`!x:real^3 v1:real^3 u1:real^3 v:real^3.
3832 ~collinear{x,v1,u1}
3833 /\ ~collinear{x,v1,v}
3834 /\ &0< azim x v1 v u1
3835 /\  azim x v1 v u1 < pi
3836 ==> &0 < ((v1 - x) cross (v - x)) dot (u1 - x)`,
3837
3838 REPEAT STRIP_TAC
3839 THEN MRESA1_TAC SIN_POS_PI`azim x v1 v (u1:real^3)`
3840 THEN POP_ASSUM MP_TAC
3841 THEN MRESA_TAC AZIM_TRANSLATION[`-- x:real^3`;`x:real^3`;`v1:real^3`;` v:real^3`;`u1:real^3`]
3842 THEN POP_ASSUM MP_TAC
3843 THEN ASM_REWRITE_TAC[VECTOR_ARITH`x-x= vec 0`;VECTOR_ARITH`(-- X)+A= A-X:real^3`]
3844 THEN DISCH_TAC
3845 THEN POP_ASSUM (fun th-> REWRITE_TAC[SYM(th)])
3846 THEN MRESA_TAC JBDNJJB[`(v1-x):real^3`;`v-x:real^3`;`u1-x:real^3`]
3847 THEN POP_ASSUM MP_TAC
3848 THEN REWRITE_TAC[GSYM COLLINEAR_3;]
3849 THEN ONCE_REWRITE_TAC[SET_RULE`{A,B,C}={B,A,C}`]
3850 THEN RESA_TAC
3851 THEN MRESAL_TAC REAL_LT_LMUL_EQ [` &0:real `;`(((v1 - x) cross (v - x)) dot ((u1 - x):real^3)):real`;`t:real`][REAL_ARITH`a * &0 = &0`]);;
3852
3853
3854 let cross_dot_fully_surrounded_ge_fan=prove(`!x:real^3 v1:real^3 u1:real^3 v:real^3.
3855 ~collinear{x,v1,u1}
3856 /\ ~collinear{x,v1,v}
3857 /\ &0<= azim x v1 v u1
3858 /\  azim x v1 v u1 <= pi
3859 ==> &0 <= ((v1 - x) cross (v - x)) dot (u1 - x)`,
3860 REPEAT STRIP_TAC
3861 THEN MRESA1_TAC SIN_POS_PI_LE`azim x v1 v (u1:real^3)`
3862 THEN POP_ASSUM MP_TAC
3863 THEN MRESA_TAC AZIM_TRANSLATION[`-- x:real^3`;`x:real^3`;`v1:real^3`;` v:real^3`;`u1:real^3`]
3864 THEN POP_ASSUM MP_TAC
3865 THEN ASM_REWRITE_TAC[VECTOR_ARITH`x-x= vec 0`;VECTOR_ARITH`(-- X)+A= A-X:real^3`]
3866 THEN DISCH_TAC
3867 THEN POP_ASSUM (fun th-> REWRITE_TAC[SYM(th)])
3868 THEN MRESA_TAC JBDNJJB[`(v1-x):real^3`;`v-x:real^3`;`u1-x:real^3`]
3869 THEN POP_ASSUM MP_TAC
3870 THEN REWRITE_TAC[GSYM COLLINEAR_3;]
3871 THEN ONCE_REWRITE_TAC[SET_RULE`{A,B,C}={B,A,C}`]
3872 THEN RESA_TAC
3873 THEN MRESAL_TAC REAL_LE_LMUL_EQ [` &0:real `;`(((v1 - x) cross (v - x)) dot ((u1 - x):real^3)):real`;`t:real`][REAL_ARITH`a * &0 = &0`]);;
3874
3875
3876 let coplanar_is_cross_fan=prove(`!x:real^3 v:real^3 u:real^3 v1:real^3.
3877 ~collinear{x,v,u}
3878 /\ v1 IN aff_gt {x} {v,u}
3879 ==> ((v-x) cross (u-x)) dot (v1-x)= &0`,
3880 REPEAT STRIP_TAC
3881 THEN MRESA_TAC properties_of_coplanar[`x:real^3`;`v:real^3`;`u:real^3`;`v1:real^3`]
3882 THEN ONCE_REWRITE_TAC[DOT_SYM;]
3883 THEN REWRITE_TAC[DOT_CROSS_DET]
3884 THEN ONCE_REWRITE_TAC[GSYM COPLANAR_DET_EQ_0]
3885 THEN ASM_REWRITE_TAC[]);;
3886
3887
3888
3889
3890
3891
3892 let cut_inside_fan=prove(`!x:real^3 v:real^3 u:real^3 w:real^3 w1:real^3.
3893 ~collinear {x,v,w1} /\ ~collinear {x,u,w} /\  ~collinear {x,v,u}
3894 /\ ~collinear {x,v,w}
3895 /\ &0< azim x u w v /\ azim x u w v < pi
3896 /\ &0< azim x v u w1 /\ azim x v u w1 < pi
3897 /\ &0< azim x v w1 w /\ azim x v w1 w < pi
3898 ==> ~(aff_ge {x,v} {w1} INTER aff_gt {x} {u,w:real^3}={})`,
3899 REWRITE_TAC[SET_RULE`~(A={})<=> ?x. x IN A`;IN_ELIM_THM; INTER]
3900 THEN REPEAT STRIP_TAC
3901 THEN MRESA_TAC th3[`x:real^3`;`v:real^3`;`w1:real^3`]
3902 THEN MRESA_TAC th3[`x:real^3`;`u:real^3`;`w:real^3`]
3903 THEN MRESAL_TAC  AFF_GE_2_1[`x:real^3`;`v:real^3`;`w1:real^3`][IN_ELIM_THM]
3904 THEN MRESAL_TAC  AFF_GT_1_2[`x:real^3`;`u:real^3`;`w:real^3`][IN_ELIM_THM]
3905 THEN MRESA_TAC cross_dot_fully_surrounded_fan[`x:real^3`;`u:real^3`;`v:real^3`;`w:real^3`]
3906 THEN POP_ASSUM MP_TAC
3907 THEN DISCH_THEN (LABEL_TAC"CON")
3908 THEN MRESA_TAC cross_dot_fully_surrounded_fan[`x:real^3`;`v:real^3`;`w1:real^3`;`u:real^3`]
3909 THEN POP_ASSUM MP_TAC
3910 THEN DISCH_THEN (LABEL_TAC"CON BE")
3911 THEN MRESA_TAC cross_dot_fully_surrounded_fan[`x:real^3`;`v:real^3`;`w:real^3`;`w1:real^3`]
3912 THEN POP_ASSUM MP_TAC
3913 THEN DISCH_THEN (LABEL_TAC"CON EM")
3914 THEN ABBREV_TAC`a1=(v-x):real^3`
3915 THEN ABBREV_TAC`a2=(w1-x):real^3`
3916 THEN ABBREV_TAC`a3=(w-x) :real^3`
3917 THEN ABBREV_TAC`a4=(u-x):real^3`
3918 THEN ABBREV_TAC`va=a1 cross a2:real^3`
3919 THEN ABBREV_TAC`vb=a3 cross a4:real^3`
3920 THEN EXISTS_TAC`(vb:real^3) cross (va:real^3)+(x:real^3)`
3921 THEN STRIP_TAC
3922 THENL(*2*)[
3923 EXISTS_TAC`&1-(vb:real^3) dot (a2:real^3)+ vb dot (a1:real^3)`
3924 THEN EXISTS_TAC`(vb:real^3) dot (a2:real^3)`
3925 THEN EXISTS_TAC`--((vb:real^3) dot (a1:real^3))`
3926 THEN ASM_REWRITE_TAC[REAL_ARITH`(&1 - vb dot a2 + vb dot a1) + vb dot a2 + --(vb dot a1) = &1`]
3927 THEN SUBGOAL_THEN `&0<= --((vb:real^3) dot (a1:real^3))` ASSUME_TAC
3928 THENL(*3*)[
3929 EXPAND_TAC"vb"
3930 THEN ONCE_REWRITE_TAC[CROSS_SKEW;]
3931 THEN REWRITE_TAC[DOT_LNEG]
3932 THEN REMOVE_THEN "CON"MP_TAC
3933 THEN ONCE_REWRITE_TAC[SET_RULE`{A,B,C}={A,C,B}`]
3934 THEN ASM_REWRITE_TAC[]
3935 THEN REAL_ARITH_TAC;
3936 ASM_REWRITE_TAC[]
3937 THEN EXPAND_TAC"va"
3938 THEN REWRITE_TAC[CROSS_LAGRANGE;VECTOR_MUL_LNEG]
3939 THEN EXPAND_TAC"a1"
3940 THEN EXPAND_TAC"a2"
3941 THEN VECTOR_ARITH_TAC];(*2*)
3942 ONCE_REWRITE_TAC[CROSS_SKEW]
3943 THEN EXPAND_TAC"vb"
3944 THEN REWRITE_TAC[CROSS_LAGRANGE;]
3945 THEN EXISTS_TAC`&1+(va:real^3) dot (a4:real^3)- va dot (a3:real^3)`
3946 THEN EXISTS_TAC`((va:real^3) dot (a3:real^3))`
3947 THEN EXISTS_TAC`--(va:real^3) dot (a4:real^3)`
3948 THEN ASM_REWRITE_TAC[DOT_LNEG;VECTOR_MUL_LNEG;REAL_ARITH`(&1 + va dot a4 - va dot a3) + va dot a3 + --(va dot a4) = &1`;]
3949 THEN STRIP_TAC
3950 THENL(*3*)[
3951 EXPAND_TAC"va"
3952 THEN ONCE_REWRITE_TAC[CROSS_SKEW;]
3953 THEN REWRITE_TAC[DOT_LNEG;CROSS_TRIPLE]
3954 THEN ASM_REWRITE_TAC[]
3955 THEN ASM_TAC
3956 THEN REAL_ARITH_TAC;
3957 EXPAND_TAC"a3"
3958 THEN EXPAND_TAC"a4"
3959 THEN REWRITE_TAC[VECTOR_ARITH`(&1+A-B)%X+B%U+ --(A%V)=X-(A%(V-X)-B%(U-X))`]
3960 THEN VECTOR_ARITH_TAC]]);;
3961
3962
3963
3964
3965 let exists_cut_in_edge_fan=prove(`!x:real^3 v:real^3 u:real^3 w:real^3 w1:real^3.
3966 ~collinear {x,v,w1} /\ ~collinear {x,u,w} /\  ~collinear {x,v,u}
3967 /\ ~collinear {x,v,w}
3968 /\ &0< azim x u w v /\ azim x u w v < pi
3969 /\ &0< azim x v u w1 /\ azim x v u w1 < pi
3970 /\ &0< azim x v w1 w /\ azim x v w1 w < pi
3971 ==> ?a. &0< a /\ a< &1
3972 /\ (&1-a) %u + a % w IN aff_ge {x,v} {w1:real^3}`,
3973
3974 REPEAT STRIP_TAC
3975 THEN MRESA_TAC th3[`x:real^3`;`v:real^3`;`w1:real^3`]
3976 THEN MRESA_TAC th3[`x:real^3`;`u:real^3`;`w:real^3`]
3977 THEN MRESAL_TAC  AFF_GE_2_1[`x:real^3`;`v:real^3`;`w1:real^3`][IN_ELIM_THM]
3978 THEN MRESAL_TAC  AFF_GT_1_2[`x:real^3`;`u:real^3`;`w:real^3`][IN_ELIM_THM]
3979 THEN MRESA_TAC cut_inside_fan[`x:real^3`;`v:real^3`;`u:real^3`;`w:real^3`;`w1:real^3`]
3980 THEN POP_ASSUM MP_TAC
3981 THEN GEN_REWRITE_TAC(LAND_CONV o DEPTH_CONV)[SET_RULE`~(A={})<=> ?x. x IN A`;INTER;]
3982 THEN REWRITE_TAC[IN_ELIM_THM]
3983 THEN STRIP_TAC
3984 THEN EXISTS_TAC`inv(&1-t1')*t3'`
3985 THEN MP_TAC(REAL_ARITH`&0< t2' /\ &0< t3' /\ t1'+t2'+t3'= &1==>  &0 < &1- t1' /\ ~(&1- t1' = &0)/\ t2'+t3'= &1- t1'`)
3986 THEN RESA_TAC
3987 THEN POP_ASSUM MP_TAC
3988 THEN MP_TAC(ISPEC`&1- (t1':real)`REAL_LT_INV)
3989 THEN RESA_TAC
3990 THEN MP_TAC(ISPEC`&1- (t1':real)`REAL_MUL_LINV)
3991 THEN RESA_TAC
3992 THEN STRIP_TAC
3993 THEN MP_TAC(SET_RULE`
3994 t2' + t3' = &1 - t1':real
3995 ==> (inv ( &1 - t1'))*(t2' + t3') = (inv ( &1 - t1'))*( &1 - t1':real)
3996 `)
3997 THEN POP_ASSUM (fun th->GEN_REWRITE_TAC(LAND_CONV o LAND_CONV o ONCE_DEPTH_CONV)[th])
3998 THEN ASM_REWRITE_TAC[REAL_ARITH`A*(B+C)= &1<=>  &1 -A*C=A*B`;REAL_ARITH`A< &1 <=> &0< &1-A`]
3999 THEN STRIP_TAC
4000 THEN MRESA_TAC REAL_LT_MUL[`inv (&1- t1'):real`;`t2':real`;]
4001 THEN MRESA_TAC REAL_LT_MUL[`inv (&1- t1'):real`;`t3':real`;]
4002 THEN REWRITE_TAC[VECTOR_ARITH`(A*B)%X+(A*C)%Y=A%(B%X+C%Y)`; VECTOR_ARITH`A%(t2' % u + t3' % w)= A%((t1'%x +t2' % u + t3' % w) - t1' %x) :real^3`]
4003 THEN FIND_ASSUM MP_TAC`x' = t1' % x + t2' % u + t3' % w:real^3`
4004 THEN DISCH_TAC
4005 THEN POP_ASSUM(fun th-> REWRITE_TAC[SYM(th)])
4006 THEN ASM_REWRITE_TAC[VECTOR_ARITH`(t1 % x + t2 % v + t3 % w1) - t1' % x=(t1-t1') % x + t2 % v + t3 % w1`;
4007 VECTOR_ARITH`A%(B+C+D)=A%B+A%C+A%D`;VECTOR_ARITH`A%B%C=(A*B)%C`]
4008 THEN EXISTS_TAC`(inv (&1 - t1') * (t1 - t1')):real`
4009 THEN EXISTS_TAC`(inv (&1 - t1') * t2):real`
4010 THEN EXISTS_TAC`(inv (&1 - t1') * t3):real`
4011 THEN ASM_REWRITE_TAC[REAL_ARITH`inv (&1 - t1') * (t1 - t1') + inv (&1 - t1') * t2 + inv (&1 - t1') * t3
4012 =inv (&1 - t1') * ((t1 +t2 + t3)-t1')`]
4013 THEN MATCH_MP_TAC REAL_LE_MUL
4014 THEN ASM_REWRITE_TAC[]
4015 THEN ASM_TAC THEN REAL_ARITH_TAC);;
4016
4017
4018
4019 let properties_of_fully_surrounded1_fan=prove(`!x:real^3 v:real^3 u:real^3 w:real^3 w1:real^3.
4020 ~coplanar {x,v,u,w}/\ &0< azim x u w v /\ azim x u w v < pi
4021 ==> &0 < azim x v u w /\ azim x v u w < pi`,
4022 REPEAT STRIP_TAC
4023 THEN MRESA_TAC azim[`(x:real^3)`;` (v:real^3)`;` (u:real^3)`;`(w:real^3)`]
4024 THEN MRESA_TAC notcoplanar_imp_notcollinear_fan[`x:real^3`;`v:real^3`;`u:real^3`;`w:real^3`]
4025 THENL[
4026  MP_TAC(REAL_ARITH` &0<= azim x v u (w:real^3) ==> azim x v u w = &0 \/ &0< azim x v u w`)
4027 THEN RESA_TAC
4028 THEN MRESA_TAC AZIM_EQ_0_PI_IMP_COPLANAR[`x:real^3`;`v:real^3`;`u:real^3`;`w:real^3`];
4029
4030 MP_TAC(REAL_ARITH` (azim x v u w = pi) \/ (pi < azim x v u w) \/  azim x v u w< pi`)
4031 THEN RESA_TAC
4032 THENL[
4033 MRESA_TAC AZIM_EQ_0_PI_IMP_COPLANAR[`x:real^3`;`v:real^3`;`u:real^3`;`w:real^3`];
4034
4035 MP_TAC(REAL_ARITH`pi< azim x v u w /\ azim x v u w < &2 * pi ==> &0< azim x v u w - pi /\ azim x v u w - pi< pi`)
4036 THEN RESA_TAC
4037 THEN MRESAL1_TAC SIN_POS_PI`azim x v u (w:real^3) -pi`[SIN_SUB; SIN_PI; COS_PI;REAL_ARITH`&0< A * -- &1 -B * &0 <=> A < &0`]
4038 THEN POP_ASSUM MP_TAC
4039 THEN MRESA_TAC AZIM_TRANSLATION[`-- x:real^3`;`x:real^3`;`v:real^3`;` u:real^3`;`w:real^3`]
4040 THEN POP_ASSUM MP_TAC
4041 THEN ASM_REWRITE_TAC[VECTOR_ARITH`x-x= vec 0`;VECTOR_ARITH`(-- X)+A= A-X:real^3`]
4042 THEN DISCH_TAC
4043 THEN MRESA_TAC JBDNJJB[`(v-x):real^3`;`u-x:real^3`;`w-x:real^3`]
4044 THEN POP_ASSUM MP_TAC
4045 THEN REWRITE_TAC[GSYM COLLINEAR_3;]
4046 THEN ONCE_REWRITE_TAC[SET_RULE`{A,B,C}={B,A,C}`]
4047 THEN RESA_TAC
4048 THEN STRIP_TAC
4049 THEN MRESAL_TAC REAL_LT_LMUL_EQ[`(((v - x) cross (u - x)) dot (w - x:real^3))`;`&0`;`t:real`][REAL_ARITH`A * &0= &0`]
4050 THEN POP_ASSUM MP_TAC
4051 THEN REWRITE_TAC[DOT_LNEG;CROSS_TRIPLE]
4052 THEN MRESA1_TAC SIN_POS_PI`azim x u  (w:real^3) v`
4053 THEN POP_ASSUM MP_TAC
4054 THEN MRESA_TAC AZIM_TRANSLATION[`-- x:real^3`;`x:real^3`;`u:real^3`;` w:real^3`;`v:real^3`]
4055 THEN POP_ASSUM MP_TAC
4056 THEN ASM_REWRITE_TAC[VECTOR_ARITH`x-x= vec 0`;VECTOR_ARITH`(-- X)+A= A-X:real^3`]
4057 THEN DISCH_TAC
4058 THEN MRESA_TAC JBDNJJB[`(u-x):real^3`;`w-x:real^3`;`v-x:real^3`]
4059 THEN POP_ASSUM MP_TAC
4060 THEN REWRITE_TAC[GSYM COLLINEAR_3;]
4061 THEN ONCE_REWRITE_TAC[SET_RULE`{A,B,C}={B,A,C}`]
4062 THEN ASM_REWRITE_TAC[]
4063 THEN ONCE_REWRITE_TAC[SET_RULE`{A,B,C}={A,C,B}`]
4064 THEN RESA_TAC
4065 THEN STRIP_TAC
4066 THEN MRESAL_TAC REAL_LT_LMUL_EQ[`&0`;`(((u - x) cross (w - x)) dot (v - x:real^3))`;`t':real`][REAL_ARITH`A * &0= &0`]
4067 THEN POP_ASSUM MP_TAC
4068 THEN REAL_ARITH_TAC]])
4069 ;;
4070
4071
4072
4073
4074 let inequality4_aim_in_convex_fan=prove(`!x:real^3 v:real^3 u:real^3 w:real^3 a:real.
4075 ~coplanar {x,v,u,w}/\ &0< azim x u w v /\ azim x u w v < pi
4076 /\ &0< a /\ a < &1
4077 ==>
4078 &0< azim x v u ((&1 - a) % u + a % w)
4079 /\ azim x v u ((&1 - a) % u + a % w)< azim x v u w `,
4080
4081 REPEAT STRIP_TAC
4082 THEN MRESA_TAC notcoplanar_imp_notcollinear_fan[`x:real^3`;`v:real^3`;`u:real^3`;`w:real^3`]
4083 THEN MRESA_TAC th3[`x:real^3`;`v:real^3`;`u:real^3`]
4084 THEN MRESA_TAC th3[`x:real^3`;`u:real^3`;`w:real^3`]
4085 THEN MRESA_TAC th3[`x:real^3`;`v:real^3`;`w:real^3`]
4086 THEN MRESA_TAC properties_of_fully_surrounded1_fan[`x:real^3`;`v:real^3`;`u:real^3`;`w:real^3`;`w1:real^3`]
4087 THEN MRESA_TAC WEDGE_LUNE_GT[`x:real^3`;` v:real^3`;`u:real^3`;`w:real^3`]
4088 THEN POP_ASSUM (fun th-> MP_TAC(SYM(th)))
4089 THEN DISCH_TAC
4090 THEN MRESA_TAC in_aff_2_2_fan[`x:real^3`;` v:real^3`;`u:real^3`;`w:real^3`]
4091 THEN POP_ASSUM(fun th-> MRESA1_TAC th `a:real`)
4092 THEN POP_ASSUM(fun th-> MRESAL_TAC th [`&0:real`;`&0`;`&1`][REAL_ARITH`&0< &1/\ &0+ &0 + &1 = &1`;wedge;IN_ELIM_THM])
4093 THEN POP_ASSUM MP_TAC  THEN POP_ASSUM MP_TAC  THEN REDUCE_VECTOR_TAC
4094 THEN DISCH_TAC THEN DISCH_TAC
4095 THEN ASM_REWRITE_TAC[]);;
4096
4097
4098
4099
4100
4101 let cut_in_angle_fan=prove(`!x:real^3 v:real^3 u:real^3 w:real^3 y:real^3.
4102  ~coplanar {x,v,u,w} /\ ~collinear {x,u,y}
4103 /\ &0< azim x u w v /\ azim x u w v< pi
4104 /\ azim x u w y< azim x u w v /\ &0< azim x u w y
4105 ==> let a1=(v-x):real^3 in
4106     let a2=w-x:real^3 in
4107     let a3=(y-x):real^3 in
4108     let a4=(u-x) :real^3 in
4109         let va=a1 cross a2:real^3 in
4110     let vb=a3 cross a4:real^3 in
4111     let v3= (vb:real^3) cross (va:real^3)+(x:real^3)
4112 in v3 IN aff_gt {x} {v,w:real^3}`,
4113
4114 REPEAT STRIP_TAC
4115 THEN CONV_TAC(TOP_DEPTH_CONV let_CONV)
4116 THEN ABBREV_TAC`a1=(v-x):real^3`
4117 THEN ABBREV_TAC`a2=(y-x):real^3`
4118 THEN ABBREV_TAC`a3=(u-x) :real^3`
4119 THEN ABBREV_TAC`a4=w-x:real^3`
4120 THEN ABBREV_TAC`va=a1 cross a4:real^3`
4121 THEN ABBREV_TAC`vb=a2 cross a3:real^3`
4122 THEN ABBREV_TAC`v3= (vb:real^3) cross (va:real^3)+(x:real^3)`
4123 THEN MRESA_TAC notcoplanar_imp_notcollinear_fan[`x:real^3`;`v:real^3`;`u:real^3`;`w:real^3`]
4124 THEN MRESA_TAC th3[`(x:real^3)` ;` (v:real^3)`;`(w:real^3) `;]
4125 THEN MRESAL_TAC  AFF_GT_1_2[`x:real^3`;`v:real^3`;`w:real^3`][IN_ELIM_THM]
4126 THEN EXISTS_TAC`&1-(vb:real^3) dot (a4:real^3)+vb dot (a1:real^3)`
4127 THEN EXISTS_TAC`((vb:real^3) dot (a4:real^3))`
4128 THEN EXISTS_TAC`(--((vb:real^3) dot (a1:real^3)))`
4129 THEN ASM_REWRITE_TAC[REAL_ARITH`(&1 - vb dot a4 + vb dot a1) + (vb dot a4) + --(vb dot a1) = &1`;VECTOR_ARITH`(&1-A+B)%X+ (A)%U+ (--B) %V=A%(U-X)- B%(V-X)+X`]
4130 THEN EXPAND_TAC"v3"
4131 THEN EXPAND_TAC"va"
4132 THEN REWRITE_TAC[CROSS_LAGRANGE;VECTOR_ARITH`--(A-B)+C=B-A+C:real^3`]
4133 THEN MP_TAC(REAL_ARITH`azim x u w v< pi
4134 /\ azim x u w y< azim x u w v==>azim x u w (y:real^3)< pi`)
4135 THEN RESA_TAC
4136 THEN MRESA_TAC cross_dot_fully_surrounded_fan[`x:real^3`;`u:real^3`;`y:real^3`;`w:real^3`]
4137 THEN POP_ASSUM MP_TAC
4138 THEN ONCE_REWRITE_TAC[CROSS_SKEW; ]
4139 THEN ASM_REWRITE_TAC[DOT_LNEG]
4140 THEN ONCE_REWRITE_TAC[CROSS_TRIPLE;] THEN ONCE_REWRITE_TAC[CROSS_SKEW;]
4141 THEN ASM_REWRITE_TAC[DOT_LNEG;REAL_ARITH`--(--A)=A`]
4142 THEN DISCH_TAC
4143 THEN MP_TAC(REAL_ARITH`azim x u w y< azim x u w v==> azim x u w y<= azim x u w (v:real^3)`)
4144 THEN RESA_TAC
4145 THEN MRESA_TAC sum4_azim_fan[`x:real^3`;`u:real^3`;`w:real^3`;`y:real^3`;`v:real^3`]
4146 THEN POP_ASSUM MP_TAC
4147 THEN ONCE_REWRITE_TAC[SET_RULE`{A,B,C}={A,C,B}`]
4148 THEN RESA_TAC
4149 THEN MP_TAC(REAL_ARITH`azim x u w y< azim x u w v/\ &0< azim x u w y/\ azim x u w v < pi /\ azim x u w v = azim x u w y + azim x u y v==>  ~(azim x u y (v:real^3)= &0)/\ &0< azim x u y v/\ azim x u y v < pi/\ ~(azim x u y (v:real^3)= pi)`)
4150 THEN RESA_TAC
4151 THEN MRESA_TAC cross_dot_fully_surrounded_fan[`x:real^3`;`u:real^3`;`v:real^3`;`y:real^3`]
4152 THEN POP_ASSUM MP_TAC
4153 THEN ONCE_REWRITE_TAC[SET_RULE`{A,B,C}={A,C,B}`]
4154 THEN ONCE_REWRITE_TAC[CROSS_SKEW; ]
4155 THEN ASM_REWRITE_TAC[DOT_LNEG] );;
4156
4157
4158
4159 (* ========================================================================== *)
4160 (*            GRAPH    (^_^)                 *)
4161 (* ========================================================================== *)
4162
4163
4164
4165
4166
4167
4168
4169
4170
4171 let GRAPH = prove
4172  (`!E. graph E <=> !e. e IN E ==> e HAS_SIZE 2`,
4173   REWRITE_TAC[graph; IN]);;
4174
4175
4176
4177
4178 let CARD_2_FAN=prove(`!v:A w:A. ~(v=w)
4179 ==> CARD {v,w}=2`,
4180 REPEAT STRIP_TAC
4181 THEN SUBGOAL_THEN`FINITE {v,w:A}`ASSUME_TAC
4182 THENL[      SIMP_TAC[HAS_SIZE; CARD_CLAUSES; FINITE_INSERT; FINITE_EMPTY;
4183                  IN_INSERT; NOT_IN_EMPTY];
4184
4185 ASSUME_TAC(SET_RULE `v:A IN {v:A,w:A} `)
4186 THEN MP_TAC(ISPECL[`v:A`;`{v:A,w:A}`;]CARD_DELETE)
4187 THEN RESA_TAC
4188 THEN MP_TAC(SET_RULE `v IN {v,w}==>{v:A,w:A} DELETE v PSUBSET {v,w}`)
4189 THEN RESA_TAC
4190 THEN MP_TAC(ISPECL[`{v:A,w:A} DELETE v`;`{v:A,w:A}`]CARD_PSUBSET)
4191 THEN POP_ASSUM (fun th->REWRITE_TAC[th])
4192 THEN FIND_ASSUM MP_TAC`FINITE {v:A,w:A}`
4193 THEN DISCH_TAC
4194 THEN POP_ASSUM (fun th->REWRITE_TAC[th])
4195 THEN DISCH_TAC
4196 THEN MP_TAC(ARITH_RULE`CARD ({v, w} DELETE v) < CARD {v, w}/\ CARD ({v, w} DELETE v) = CARD {v, w}-1
4197 <=>CARD ({v, w} DELETE v) +1= CARD {v:A, w:A}`)
4198 THEN POP_ASSUM (fun th->REWRITE_TAC[th])
4199 THEN POP_ASSUM (fun th->GEN_REWRITE_TAC(LAND_CONV o LAND_CONV o ONCE_DEPTH_CONV)[th;])
4200 THEN REWRITE_TAC[ARITH_RULE`A=A`]
4201 THEN DISCH_TAC
4202 THEN SUBGOAL_THEN `w:A IN ({v:A,w:A} DELETE v)` ASSUME_TAC
4203 THENL[
4204 ASM_SET_TAC[];
4205 MP_TAC(ISPECL[`{v:A,w:A}`;`v:A`] FINITE_DELETE)
4206 THEN RESA_TAC
4207 THEN MP_TAC(ISPECL[`w:A`;`{v:A,w:A} DELETE v`;]CARD_DELETE)
4208 THEN RESA_TAC
4209 THEN MP_TAC(SET_RULE `w IN ({v,w} DELETE v)==>{v:A,w:A} DELETE v DELETE w PSUBSET {v,w} DELETE v`)
4210 THEN RESA_TAC
4211 THEN MP_TAC(ISPECL[`{v:A,w:A} DELETE v DELETE w`;`{v:A,w:A} DELETE v`]CARD_PSUBSET)
4212 THEN POP_ASSUM (fun th->REWRITE_TAC[th])
4213 THEN FIND_ASSUM MP_TAC`FINITE ({v:A,w:A} DELETE v)`
4214 THEN DISCH_TAC
4215 THEN POP_ASSUM (fun th->REWRITE_TAC[th])
4216 THEN DISCH_TAC
4217 THEN MP_TAC(ARITH_RULE`CARD ({v, w} DELETE v DELETE w) < CARD ({v, w} DELETE v)/\ CARD ({v, w} DELETE v DELETE w) = CARD ({v, w} DELETE v)-1
4218 <=>CARD ({v, w} DELETE v DELETE w) +1= CARD ({v:A, w:A} DELETE v)`)
4219 THEN POP_ASSUM (fun th->REWRITE_TAC[th])
4220 THEN POP_ASSUM (fun th->GEN_REWRITE_TAC(LAND_CONV o LAND_CONV o ONCE_DEPTH_CONV)[th;])
4221 THEN REWRITE_TAC[ARITH_RULE`A=A`]
4222 THEN DISCH_TAC
4223 THEN POP_ASSUM MP_TAC
4224 THEN POP_ASSUM (fun th->REWRITE_TAC[])
4225 THEN POP_ASSUM (fun th->REWRITE_TAC[])
4226 THEN ASSUME_TAC(SET_RULE `{v, w} DELETE v:A DELETE w:A={}`)
4227 THEN POP_ASSUM (fun th->REWRITE_TAC[th;CARD_CLAUSES; ARITH_RULE `0+1=1`])
4228 THEN POP_ASSUM MP_TAC
4229 THEN DISCH_THEN(LABEL_TAC"B")
4230 THEN DISCH_TAC
4231 THEN REMOVE_THEN "B" MP_TAC
4232 THEN POP_ASSUM (fun th->REWRITE_TAC[SYM(th);ARITH_RULE` 1+1=2`])
4233 THEN SET_TAC[]]]);;
4234
4235
4236
4237 (* ========================================================================== *)
4238 (*            CONDITION OF CROSS DOT 4 POINT    (^_^)                 *)
4239 (* ========================================================================== *)
4240
4241
4242 let condition_cross_dot_4point=prove(`!x:real^3 y:real^3 z:real^3 v:real^3 u:real^3.
4243               let a1 = y - x in
4244               let a2 = z - x in
4245               let a3 = v - x in
4246               let a4 = u - x in
4247               let va = a1 cross a2 in
4248               let vb = a3 cross a4 in
4249               let v3 = va cross vb + x in
4250  ~collinear {x,v,u}
4251 /\ &0<(a1 cross a2) dot a4 /\  &0 < --((a1 cross a2) dot a3)
4252 ==> v3 IN aff_gt {x} {v,u}`,
4253 REPEAT GEN_TAC
4254 THEN CONV_TAC(TOP_DEPTH_CONV let_CONV)
4255 THEN ABBREV_TAC`a1=(y-x):real^3`
4256 THEN ABBREV_TAC`a2=(z-x):real^3`
4257 THEN ABBREV_TAC`a3=(v-x) :real^3`
4258 THEN ABBREV_TAC`a4=u-x:real^3`
4259 THEN ABBREV_TAC`va=a1 cross a2:real^3`
4260 THEN ABBREV_TAC`vb=a3 cross a4:real^3`
4261 THEN ABBREV_TAC`v3= (va:real^3) cross (vb:real^3)+(x:real^3)`
4262 THEN REPEAT STRIP_TAC
4263 THEN MRESA_TAC th3[`(x:real^3)` ;` (v:real^3)`;`(u:real^3) `;]
4264 THEN MRESAL_TAC  AFF_GT_1_2[`x:real^3`;`v:real^3`;`u:real^3`][IN_ELIM_THM]
4265 THEN EXISTS_TAC`&1-(va:real^3) dot (a4:real^3)+va dot (a3:real^3)`
4266 THEN EXISTS_TAC`((va:real^3) dot (a4:real^3))`
4267 THEN EXISTS_TAC`(--((va:real^3) dot (a3:real^3)))`
4268 THEN ASM_REWRITE_TAC[REAL_ARITH` (&1 - va dot a4 + va dot a3) + (va dot a4) + --(va dot a3) = &1`]
4269 THEN EXPAND_TAC"v3"
4270 THEN EXPAND_TAC"vb"
4271 THEN REWRITE_TAC[CROSS_LAGRANGE;VECTOR_ARITH`A+ B + --U%C=A +B-U%C:real^3`]
4272 THEN EXPAND_TAC"a3"
4273 THEN EXPAND_TAC"a4"
4274 THEN VECTOR_ARITH_TAC);;
4275
4276
4277
4278
4279 let aff_gt_2_1_crossr_dot_4point=prove(`!x:real^3 y:real^3 z:real^3 v:real^3 u:real^3.
4280               let a1 = y - x in
4281               let a2 = z - x in
4282               let a3 = v - x in
4283               let a4 = u - x in
4284  ~collinear {x,y,z}
4285 /\ u IN aff_gt {x,y} {z}
4286 /\ &0<(a1 cross a2) dot a3
4287 ==> &0<(a1 cross a4) dot a3 `,
4288 REPEAT GEN_TAC
4289 THEN CONV_TAC(TOP_DEPTH_CONV let_CONV)
4290 THEN REPEAT STRIP_TAC
4291 THEN POP_ASSUM MP_TAC
4292 THEN POP_ASSUM MP_TAC
4293 THEN MRESA_TAC th3[`x:real^3`;`y:real^3`;`z:real^3`]
4294 THEN MRESAL_TAC AFF_GT_2_1[`x:real^3`;`y:real^3`;`z:real^3`][IN_ELIM_THM]
4295 THEN REPEAT STRIP_TAC
4296 THEN ASM_REWRITE_TAC[VECTOR_ARITH`(u' % x + v' % y + w % z) - x=((u'+v'+w) - &1) % x + v' % (y-x) + w % (z - x)`;REAL_ARITH`&1- &1= &0`]
4297 THEN REDUCE_VECTOR_TAC
4298 THEN REWRITE_TAC[CROSS_RMUL;CROSS_RADD;CROSS_REFL;]
4299 THEN REDUCE_VECTOR_TAC
4300 THEN REWRITE_TAC[DOT_LMUL]
4301 THEN MATCH_MP_TAC REAL_LT_MUL
4302 THEN ASM_REWRITE_TAC[]);;
4303
4304
4305 let aff_gt_2_1_rcross_dot_4pointl=prove(`!x:real^3 y:real^3 z:real^3 v:real^3 u:real^3.
4306               let a1 = y - x in
4307               let a2 = z - x in
4308               let a3 = v - x in
4309               let a4 = u - x in
4310  ~collinear {x,y,z}
4311 /\ u IN aff_gt {x,z} {y}
4312 /\ &0<(a1 cross a2) dot a3
4313 ==> &0<(a4 cross a2) dot a3 `,
4314 REPEAT GEN_TAC
4315 THEN CONV_TAC(TOP_DEPTH_CONV let_CONV)
4316 THEN ONCE_REWRITE_TAC[SET_RULE`{A,B,C}={A,C,B}`]
4317 THEN REPEAT STRIP_TAC
4318 THEN POP_ASSUM MP_TAC
4319 THEN POP_ASSUM MP_TAC
4320 THEN MRESA_TAC th3[`x:real^3`;`z:real^3`;`y:real^3`]
4321 THEN MRESAL_TAC AFF_GT_2_1[`x:real^3`;`z:real^3`;`y:real^3`][IN_ELIM_THM]
4322 THEN REPEAT STRIP_TAC
4323 THEN ASM_REWRITE_TAC[VECTOR_ARITH`(u' % x + v' % z + w % y) - x=((u'+v'+w) - &1) % x + v' % (z-x) + w % (y - x)`;REAL_ARITH`&1- &1= &0`]
4324 THEN REDUCE_VECTOR_TAC
4325 THEN REWRITE_TAC[CROSS_LMUL;CROSS_LADD;CROSS_REFL;]
4326 THEN REDUCE_VECTOR_TAC
4327 THEN REWRITE_TAC[DOT_LMUL]
4328 THEN MATCH_MP_TAC REAL_LT_MUL
4329 THEN ASM_REWRITE_TAC[]);;
4330
4331
4332
4333
4334 let aff_gt_2_1_cross_dotr_4point=prove(`!x:real^3 y:real^3 z:real^3 v:real^3 u:real^3.
4335               let a1 = y - x in
4336               let a2 = z - x in
4337               let a3 = v - x in
4338               let a4 = u - x in
4339  ~collinear {x,y,v}
4340 /\ u IN aff_gt {x,y} {v}
4341 /\ &0<(a1 cross a2) dot a3
4342 ==> &0<(a1 cross a2) dot a4 `,
4343 REPEAT GEN_TAC
4344 THEN CONV_TAC(TOP_DEPTH_CONV let_CONV)
4345 THEN REPEAT STRIP_TAC
4346 THEN POP_ASSUM MP_TAC
4347 THEN POP_ASSUM MP_TAC
4348 THEN MRESA_TAC th3[`x:real^3`;`y:real^3`;`v:real^3`]
4349 THEN MRESAL_TAC AFF_GT_2_1[`x:real^3`;`y:real^3`;`v:real^3`][IN_ELIM_THM]
4350 THEN REPEAT STRIP_TAC
4351 THEN ASM_REWRITE_TAC[VECTOR_ARITH`(u' % x + v' % z + w % y) - x=((u'+v'+w) - &1) % x + v' % (z-x) + w % (y - x)`;REAL_ARITH`&1- &1= &0`]
4352 THEN REDUCE_VECTOR_TAC
4353 THEN REWRITE_TAC[DOT_RMUL;DOT_RADD;DOT_CROSS_SELF]
4354 THEN REDUCE_ARITH_TAC
4355 THEN MATCH_MP_TAC REAL_LT_MUL
4356 THEN ASM_REWRITE_TAC[]);;
4357
4358
4359 let aff_gt_2_1_cross_dotl_4point=prove(`!x:real^3 y:real^3 z:real^3 v:real^3 u:real^3.
4360               let a1 = y - x in
4361               let a2 = z - x in
4362               let a3 = v - x in
4363               let a4 = u - x in
4364  ~collinear {x,z,v}
4365 /\ u IN aff_gt {x,z} {v}
4366 /\ &0<(a1 cross a2) dot a3
4367 ==> &0<(a1 cross a2) dot a4 `,
4368 REPEAT GEN_TAC
4369 THEN CONV_TAC(TOP_DEPTH_CONV let_CONV)
4370 THEN REPEAT STRIP_TAC
4371 THEN POP_ASSUM MP_TAC
4372 THEN POP_ASSUM MP_TAC
4373 THEN MRESA_TAC th3[`x:real^3`;`z:real^3`;`v:real^3`]
4374 THEN MRESAL_TAC AFF_GT_2_1[`x:real^3`;`z:real^3`;`v:real^3`][IN_ELIM_THM]
4375 THEN REPEAT STRIP_TAC
4376 THEN ASM_REWRITE_TAC[VECTOR_ARITH`(u' % x + v' % z + w % y) - x=((u'+v'+w) - &1) % x + v' % (z-x) + w % (y - x)`;REAL_ARITH`&1- &1= &0`]
4377 THEN REDUCE_VECTOR_TAC
4378 THEN REWRITE_TAC[DOT_RMUL;DOT_RADD;DOT_CROSS_SELF]
4379 THEN REDUCE_ARITH_TAC
4380 THEN MATCH_MP_TAC REAL_LT_MUL
4381 THEN ASM_REWRITE_TAC[]);;
4382
4383
4384
4385
4386
4387 let aff_gt_2_1r_rcross_dotl_4point=prove(`!x:real^3 y:real^3 z:real^3 v:real^3 u:real^3.
4388               let a1 = y - x in
4389               let a2 = z - x in
4390               let a3 = v - x in
4391               let a4 = u - x in
4392  ~collinear {x,v,y}
4393 /\ u IN aff_gt {x,v} {y}
4394 /\ &0<(a1 cross a2) dot a3
4395 ==> &0<(a4 cross a2) dot a3 `,
4396 REPEAT GEN_TAC
4397 THEN CONV_TAC(TOP_DEPTH_CONV let_CONV)
4398 THEN REPEAT STRIP_TAC
4399 THEN POP_ASSUM MP_TAC
4400 THEN POP_ASSUM MP_TAC
4401 THEN MRESA_TAC th3[`x:real^3`;`v:real^3`;`y:real^3`]
4402 THEN MRESAL_TAC AFF_GT_2_1[`x:real^3`;`v:real^3`;`y:real^3`][IN_ELIM_THM]
4403 THEN REPEAT STRIP_TAC
4404 THEN ASM_REWRITE_TAC[VECTOR_ARITH`(u' % x + v' % z + w % y) - x=((u'+v'+w) - &1) % x + v' % (z-x) + w % (y - x)`;REAL_ARITH`&1- &1= &0`]
4405 THEN REDUCE_VECTOR_TAC
4406 THEN REWRITE_TAC[CROSS_LMUL;CROSS_LADD;DOT_LMUL;DOT_LADD;DOT_CROSS_SELF]
4407 THEN REDUCE_ARITH_TAC
4408 THEN MATCH_MP_TAC REAL_LT_MUL
4409 THEN ASM_REWRITE_TAC[]);;
4410
4411
4412
4413
4414
4415 let aff_gt_1_2_cross_dotr_4point=prove(`!x:real^3 y:real^3 z:real^3 v:real^3 u:real^3.
4416               let a1 = y - x in
4417               let a2 = z - x in
4418               let a3 = v - x in
4419               let a4 = u - x in
4420  ~collinear {x,v,u}
4421 /\ y IN aff_gt {x} {v,u}
4422 /\ &0<(a1 cross a2) dot a3
4423  ==> &0< --((a1 cross a2) dot a4)`,
4424
4425 REPEAT GEN_TAC
4426 THEN CONV_TAC(TOP_DEPTH_CONV let_CONV)
4427 THEN REPEAT STRIP_TAC
4428 THEN POP_ASSUM MP_TAC
4429 THEN POP_ASSUM MP_TAC
4430 THEN MRESA_TAC th3[`x:real^3`;`v:real^3`;`u:real^3`]
4431 THEN MRESAL_TAC AFF_GT_1_2[`x:real^3`;`v:real^3`;`u:real^3`][IN_ELIM_THM]
4432 THEN STRIP_TAC
4433 THEN ASM_REWRITE_TAC[VECTOR_ARITH`(u' % x + v' % z + w % y) - x=((u'+v'+w) - &1) % x + v' % (z-x) + w % (y - x)`;REAL_ARITH`&1- &1= &0`]
4434 THEN REDUCE_VECTOR_TAC
4435 THEN REWRITE_TAC[CROSS_LNEG;CROSS_LMUL;CROSS_LADD;CROSS_REFL;DOT_LMUL;DOT_LADD;]
4436 THEN ONCE_REWRITE_TAC[CROSS_SKEW;CROSS_TRIPLE]
4437 THEN REWRITE_TAC[CROSS_TRIPLE;CROSS_REFL;DOT_LZERO]
4438 THEN REDUCE_ARITH_TAC
4439 THEN STRIP_TAC
4440 THEN ONCE_REWRITE_TAC[CROSS_SKEW;]
4441 THEN REWRITE_TAC[DOT_LNEG;REAL_ARITH`--(A* (--B))=A*B`]
4442 THEN ONCE_REWRITE_TAC[CROSS_TRIPLE;]
4443 THEN MATCH_MP_TAC REAL_LT_MUL
4444 THEN ASM_REWRITE_TAC[]
4445 THEN MRESAL_TAC REAL_LT_RCANCEL_IMP[`&0`;`((u - x) cross (z - x)) dot (v - x:real^3)`;`t3:real`;][REAL_ARITH`&0 * A= &0`]
4446 THEN POP_ASSUM MATCH_MP_TAC
4447 THEN POP_ASSUM MP_TAC
4448 THEN REAL_ARITH_TAC);;
4449
4450
4451
4452
4453
4454 let aff_gt_1_2_cross_dotr_4point_neg=prove(`!x:real^3 y:real^3 z:real^3 v:real^3 u:real^3.
4455               let a1 = y - x in
4456               let a2 = z - x in
4457               let a3 = v - x in
4458               let a4 = u - x in
4459  ~collinear {x,v,u}
4460 /\ y IN aff_gt {x} {v,u}
4461 /\ &0< --((a1 cross a2) dot a3)
4462  ==> &0< ((a1 cross a2) dot a4)`,
4463 REPEAT GEN_TAC
4464 THEN CONV_TAC(TOP_DEPTH_CONV let_CONV)
4465 THEN REPEAT STRIP_TAC
4466 THEN POP_ASSUM MP_TAC
4467 THEN POP_ASSUM MP_TAC
4468 THEN MRESA_TAC th3[`x:real^3`;`v:real^3`;`u:real^3`]
4469 THEN MRESAL_TAC AFF_GT_1_2[`x:real^3`;`v:real^3`;`u:real^3`][IN_ELIM_THM]
4470 THEN STRIP_TAC
4471 THEN ASM_REWRITE_TAC[VECTOR_ARITH`(u' % x + v' % z + w % y) - x=((u'+v'+w) - &1) % x + v' % (z-x) + w % (y - x)`;REAL_ARITH`&1- &1= &0`]
4472 THEN REDUCE_VECTOR_TAC
4473 THEN REWRITE_TAC[CROSS_LNEG;CROSS_LMUL;CROSS_LADD;CROSS_REFL;DOT_LMUL;DOT_LADD;]
4474 THEN ONCE_REWRITE_TAC[CROSS_SKEW;CROSS_TRIPLE]
4475 THEN REWRITE_TAC[CROSS_TRIPLE;CROSS_REFL;DOT_LZERO]
4476 THEN REDUCE_ARITH_TAC
4477 THEN ONCE_REWRITE_TAC[CROSS_SKEW;]
4478 THEN REWRITE_TAC[DOT_LNEG;REAL_ARITH`--(A* (--B))=A*B`]
4479 THEN STRIP_TAC
4480 THEN ONCE_REWRITE_TAC[CROSS_SKEW;]
4481 THEN REWRITE_TAC[DOT_LNEG;REAL_ARITH`-- --A=A`]
4482 THEN ONCE_REWRITE_TAC[CROSS_TRIPLE;]
4483 THEN ONCE_REWRITE_TAC[CROSS_TRIPLE;]
4484 THEN MATCH_MP_TAC REAL_LT_MUL
4485 THEN ASM_REWRITE_TAC[]
4486 THEN MRESAL_TAC REAL_LT_RCANCEL_IMP[`&0`;`((z - x) cross (u - x)) dot (v - x):real^3`;`t3:real`;][REAL_ARITH`&0 * A= &0`]
4487 THEN POP_ASSUM MATCH_MP_TAC
4488 THEN POP_ASSUM MP_TAC
4489 THEN REAL_ARITH_TAC);;
4490
4491
4492
4493 let aff_gt_1_2_cross_dotr_4point_zero=prove(`!x:real^3 y:real^3 z:real^3 v:real^3 u:real^3.
4494               let a1 = y - x in
4495               let a2 = z - x in
4496               let a3 = v - x in
4497               let a4 = u - x in
4498  ~collinear {x,v,u}
4499 /\ y IN aff_gt {x} {v,u}
4500 /\ (a1 cross a2) dot a3= &0
4501  ==> ((a1 cross a2) dot a4)= &0`,
4502
4503 REPEAT GEN_TAC
4504 THEN CONV_TAC(TOP_DEPTH_CONV let_CONV)
4505 THEN REPEAT STRIP_TAC
4506 THEN POP_ASSUM MP_TAC
4507 THEN POP_ASSUM MP_TAC
4508 THEN MRESA_TAC th3[`x:real^3`;`v:real^3`;`u:real^3`]
4509 THEN MRESAL_TAC AFF_GT_1_2[`x:real^3`;`v:real^3`;`u:real^3`][IN_ELIM_THM]
4510 THEN STRIP_TAC
4511 THEN ASM_REWRITE_TAC[VECTOR_ARITH`(u' % x + v' % z + w % y) - x=((u'+v'+w) - &1) % x + v' % (z-x) + w % (y - x)`;REAL_ARITH`&1- &1= &0`]
4512 THEN REDUCE_VECTOR_TAC
4513 THEN REWRITE_TAC[CROSS_LNEG;CROSS_LMUL;CROSS_LADD;CROSS_REFL;DOT_LMUL;DOT_LADD;]
4514 THEN ONCE_REWRITE_TAC[CROSS_SKEW;CROSS_TRIPLE]
4515 THEN REWRITE_TAC[CROSS_TRIPLE;CROSS_REFL;DOT_LZERO]
4516 THEN REDUCE_ARITH_TAC
4517 THEN STRIP_TAC
4518 THEN ONCE_REWRITE_TAC[CROSS_SKEW;]
4519 THEN REWRITE_TAC[DOT_LNEG;REAL_ARITH`--(A* (--B))=A*B`]
4520 THEN ONCE_REWRITE_TAC[CROSS_TRIPLE;]
4521 THEN POP_ASSUM MP_TAC
4522 THEN ASM_REWRITE_TAC[REAL_ENTIRE]
4523 THEN STRIP_TAC
4524 THEN ASM_TAC THEN REAL_ARITH_TAC);;
4525
4526
4527 let exists_esilon_real=prove(`!a:real b:real.
4528 &0<a ==> ?t. &0< t /\ t< &1 /\
4529 (!h. &0< h /\ h< t==> &0< a- h * b)`,
4530 REPEAT STRIP_TAC
4531 THEN DISJ_CASES_TAC(REAL_ARITH`b <= &0 \/ &0< b`)
4532 THENL[ EXISTS_TAC`&1/ &2`
4533 THEN REWRITE_TAC[REAL_ARITH`&0< &1/ &2 /\ &1/ &2< &1`;]
4534 THEN REPEAT STRIP_TAC
4535 THEN MATCH_MP_TAC(REAL_ARITH`&0<a /\ &0<= h*(-- b)==> &0< a-h*b`)
4536 THEN ASM_REWRITE_TAC[]
4537 THEN MATCH_MP_TAC REAL_LE_MUL
4538 THEN ASM_REWRITE_TAC[REAL_ARITH`&0<= --B<=> B<= &0`]
4539 THEN ASM_TAC THEN REAL_ARITH_TAC;
4540 ABBREV_TAC`t1= (min (inv (b:real) * a) (&1)) / &2`
4541 THEN MRESA1_TAC REAL_LT_INV`b:real`
4542 THEN MRESA_TAC REAL_LT_MUL[`inv b:real`;`a:real`]
4543 THEN MP_TAC(REAL_ARITH`&0 < inv b * a /\ t1= (min (inv (b:real) * a) (&1)) / &2
4544 ==> &0< t1 /\ t1< &1 /\ t1< inv b * a`)
4545 THEN RESA_TAC
4546 THEN EXISTS_TAC `t1:real`
4547 THEN ASM_REWRITE_TAC[]
4548 THEN REPEAT STRIP_TAC
4549 THEN MP_TAC(REAL_ARITH`h<t1 /\ t1< inv b *a==> &0< inv b *a- h`)
4550 THEN RESA_TAC
4551 THEN MRESA_TAC REAL_LT_MUL[`b:real`;`inv b *a- h:real`]
4552 THEN POP_ASSUM MP_TAC
4553 THEN REWRITE_TAC[REAL_ARITH`b * (inv b * a - h)= (inv b * b) * a- h *b `]
4554 THEN MP_TAC(REAL_ARITH`&0<b==> ~(b= &0)`)
4555 THEN RESA_TAC
4556 THEN MRESA1_TAC REAL_MUL_LINV`b:real`
4557 THEN REAL_ARITH_TAC]);;
4558
4559
4560
4561 let invariant_cross_dotr_esilon_3piont=prove(`!x:real^3 y:real^3 z:real^3 v:real^3 u:real^3.
4562               let a1 = y - x in
4563               let a2 = z - x in
4564               let a3 = v - x in
4565               let a4 = u - x in
4566  &0<(a1 cross a2) dot a3
4567  ==>
4568 ?t. &0< t /\ t< &1 /\
4569 (!h. &0< h /\ h< t==>
4570  &0< ((a1 cross a2) dot ((&1 - h) % v + h % u-x)))`,
4571
4572 REPEAT GEN_TAC
4573 THEN CONV_TAC(TOP_DEPTH_CONV let_CONV)
4574 THEN REPEAT STRIP_TAC
4575 THEN REWRITE_TAC[VECTOR_ARITH`(&1 - h) % v + h % u-x=(&1 - h) % (v-x) + h % (u-x)`;]
4576 THEN REWRITE_TAC[DOT_RMUL;DOT_RADD;]
4577 THEN REWRITE_TAC[REAL_ARITH`(&1-h)*A+h*B=A-h*(A-B)`]
4578 THEN MATCH_MP_TAC exists_esilon_real
4579 THEN ASM_REWRITE_TAC[]);;
4580
4581
4582
4583 let invariant_rcross_dot_esilon_3piont=prove(`!x:real^3 y:real^3 z:real^3 v:real^3 u:real^3.
4584               let a1 = y - x in
4585               let a2 = z - x in
4586               let a3 = v - x in
4587               let a4 = u - x in
4588  &0<(a1 cross a2) dot a3
4589  ==>
4590 ?t. &0< t /\ t< &1 /\
4591 (!h. &0< h /\ h< t==>
4592  &0< (((&1 - h) % y + h % u-x) cross a2) dot a3)`,
4593 REPEAT GEN_TAC
4594 THEN CONV_TAC(TOP_DEPTH_CONV let_CONV)
4595 THEN REPEAT STRIP_TAC
4596 THEN REWRITE_TAC[VECTOR_ARITH`(&1 - h) % v + h % u-x=(&1 - h) % (v-x) + h % (u-x)`;]
4597 THEN REWRITE_TAC[CROSS_LMUL;CROSS_LADD;DOT_LMUL;DOT_LADD;]
4598 THEN REWRITE_TAC[REAL_ARITH`(&1-h)*A+h*B=A-h*(A-B)`]
4599 THEN MATCH_MP_TAC exists_esilon_real
4600 THEN ASM_REWRITE_TAC[]);;
4601
4602
4603 let invariant_crossr_dot_esilon_3piont=prove(`!x:real^3 y:real^3 z:real^3 v:real^3 u:real^3.
4604               let a1 = y - x in
4605               let a2 = z - x in
4606               let a3 = v - x in
4607               let a4 = u - x in
4608  &0<(a1 cross a2) dot a3
4609  ==>
4610 ?t. &0< t /\ t< &1 /\
4611 (!h. &0< h /\ h< t==>
4612  &0< (a1 cross ((&1 - h) % z + h % u-x)) dot a3)`,
4613 REPEAT GEN_TAC
4614 THEN CONV_TAC(TOP_DEPTH_CONV let_CONV)
4615 THEN REPEAT STRIP_TAC
4616 THEN REWRITE_TAC[VECTOR_ARITH`(&1 - h) % v + h % u-x=(&1 - h) % (v-x) + h % (u-x)`;]
4617 THEN REWRITE_TAC[CROSS_RMUL;CROSS_RADD;DOT_LMUL;DOT_LADD;]
4618 THEN REWRITE_TAC[REAL_ARITH`(&1-h)*A+h*B=A-h*(A-B)`]
4619 THEN MATCH_MP_TAC exists_esilon_real
4620 THEN ASM_REWRITE_TAC[]);;
4621
4622
4623
4624 let condition_4point_aff_gt_1_2inter_aff_gt_1_2=prove(`!x:real^3 y:real^3 z:real^3 v:real^3 u:real^3 w:real^3 a:real.
4625               let a1 = y - x in
4626               let a2 = z - x in
4627               let a3 = v - x in
4628               let a4 = u - x in
4629               let a5 = w - x in
4630
4631  ~collinear {x,v,u}
4632 /\ ~collinear {x,u,w}
4633 /\ ~collinear {x,y,z}
4634 /\  &0< a /\ a< &1
4635 /\ y IN aff_gt {x} {v,u}
4636 /\ &0<(a3 cross a4) dot a5
4637 /\ (!h. &0< h /\ h< a==> ~collinear {x,v,(&1-h)%u+h%w})
4638 /\ &0<(a3 cross a1) dot a2
4639  ==> ?t. &0< t /\ t< &1 /\
4640 (!h. &0< h /\ h< t==> ~(aff_gt {x} {y,z} INTER aff_gt {x} {v,(&1-h)%u+h%w}={}))`,
4641
4642 REPEAT STRIP_TAC
4643 THEN CONV_TAC(TOP_DEPTH_CONV let_CONV)
4644 THEN REPEAT STRIP_TAC
4645 THEN POP_ASSUM MP_TAC
4646 THEN POP_ASSUM MP_TAC
4647 THEN DISCH_THEN(LABEL_TAC"LINH")
4648 THEN ONCE_REWRITE_TAC[CROSS_TRIPLE]
4649 THEN STRIP_TAC
4650 THEN MRESA_TAC aff_gt_1_2_cross_dotr_4point[`x:real^3`;`y:real^3`;`z:real^3`;`v:real^3`;`u:real^3`;]
4651 THEN POP_ASSUM MP_TAC
4652 THEN CONV_TAC(TOP_DEPTH_CONV let_CONV)
4653 THEN RESA_TAC
4654 THEN MRESA_TAC invariant_cross_dotr_esilon_3piont[`x:real^3`; `z:real^3`;`y:real^3`;`u:real^3`;`w:real^3`]
4655 THEN POP_ASSUM MP_TAC
4656 THEN CONV_TAC(TOP_DEPTH_CONV let_CONV)
4657 THEN ONCE_REWRITE_TAC[CROSS_SKEW]
4658 THEN ASM_REWRITE_TAC[DOT_LNEG]
4659 THEN STRIP_TAC
4660 THEN POP_ASSUM MP_TAC
4661 THEN DISCH_THEN(LABEL_TAC"YEU")
4662 THEN MRESA_TAC properties_of_collinear4_points_fan[`x:real^3`;`v:real^3`;`u:real^3`;`y:real^3`]
4663 THEN MRESA_TAC point_in_aff_gt_2_1_change_point_in_aff_gt_1_2[`x:real^3`;`v:real^3`;`u:real^3`;`y:real^3`]
4664 THEN MRESA_TAC aff_gt_2_1r_rcross_dotl_4point[`x:real^3`;`y:real^3`;`z:real^3`;`v:real^3`;`u:real^3`]
4665 THEN POP_ASSUM MP_TAC
4666 THEN CONV_TAC(TOP_DEPTH_CONV let_CONV)
4667 THEN ONCE_REWRITE_TAC[SET_RULE`{A,B,C}={A,C,B}`]
4668 THEN RESA_TAC
4669 THEN MRESA_TAC invariant_rcross_dot_esilon_3piont[`x:real^3`; `u:real^3`;`z:real^3`;`v:real^3`;`w:real^3`]
4670 THEN POP_ASSUM MP_TAC
4671 THEN CONV_TAC(TOP_DEPTH_CONV let_CONV)
4672 THEN RESA_TAC
4673 THEN POP_ASSUM MP_TAC
4674 THEN DISCH_THEN(LABEL_TAC"EM")
4675 THEN ABBREV_TAC`t1= min (min t t') a:real`
4676 THEN MP_TAC(REAL_ARITH`&0<t/\ t< &1 /\ &0< t' /\ t'< &1 /\ &0< a /\ a < &1 /\ t1=min (min t t') a ==> &0< t1 /\ t1 < &1`)
4677 THEN RESA_TAC
4678 THEN EXISTS_TAC`t1:real`
4679 THEN ASM_REWRITE_TAC[SET_RULE`~(A={})<=> ?y1. y1 IN A`]
4680 THEN REPEAT STRIP_TAC
4681 THEN ABBREV_TAC`a1=(y-x):real^3`
4682 THEN ABBREV_TAC`a2=(z-x):real^3`
4683 THEN ABBREV_TAC`a3=(v-x) :real^3`
4684 THEN ABBREV_TAC`a4=(&1 - h) % u + h % w-x:real^3`
4685 THEN ABBREV_TAC`va=a1 cross a2:real^3`
4686 THEN ABBREV_TAC`vb=a3 cross a4:real^3`
4687 THEN ABBREV_TAC`v3= (vb:real^3) cross (va:real^3)+(x:real^3)`
4688 THEN EXISTS_TAC `v3:real^3`
4689 THEN MP_TAC(REAL_ARITH`h<t1 /\ t1< &1 /\ t1=min (min t t') a==> h<t' /\ h< &1 /\ h< t /\ h<a`)
4690 THEN RESA_TAC
4691 THEN REMOVE_THEN "EM" (fun th-> MRESA1_TAC th `h:real`)
4692 THEN POP_ASSUM MP_TAC
4693 THEN ONCE_REWRITE_TAC[CROSS_SKEW]
4694 THEN REWRITE_TAC[DOT_LNEG]
4695 THEN ONCE_REWRITE_TAC[CROSS_TRIPLE]
4696 THEN REWRITE_TAC[GSYM DOT_LNEG]
4697 THEN ONCE_REWRITE_TAC[GSYM CROSS_SKEW]
4698 THEN RESA_TAC
4699 THEN MRESA_TAC th3[`x:real^3`;`u:real^3`;`w:real^3`;]
4700 THEN MRESA_TAC pos_in_aff_gt_2_1_fan [`x:real^3`;`u:real^3`;`w:real^3`;`h:real`]
4701 THEN MRESAL_TAC aff_gt_2_1_cross_dotl_4point[`x:real^3`;`v:real^3`;`u:real^3`;`w:real^3`;`(&1 - h) % u + h % w:real^3`][VECTOR_ARITH`((&1 - h) % u + h % w) - x=(&1 - h) % u + h % w - x`]
4702 THEN POP_ASSUM MP_TAC
4703 THEN CONV_TAC(TOP_DEPTH_CONV let_CONV)
4704 THEN RESA_TAC
4705 THEN POP_ASSUM MP_TAC
4706 THEN ONCE_REWRITE_TAC[CROSS_TRIPLE]
4707 THEN STRIP_TAC
4708 THEN MRESA_TAC aff_gt_inter_aff_gt [`(x:real^3)`;`(v:real^3)`;`(u:real^3)`]
4709 THEN MP_TAC(SET_RULE`y IN aff_gt {x} {v, u} /\ aff_gt {x} {v, u} = aff_gt {x, v} {u} INTER aff_gt {x, u} {v}
4710 ==> y IN aff_gt {x, v} {u:real^3}`)
4711 THEN RESA_TAC
4712 THEN MRESAL_TAC aff_gt_2_1r_rcross_dotl_4point[`x:real^3`;`u:real^3`;`(&1 - h) % u + h % w:real^3`;`v:real^3`;`y:real^3`][VECTOR_ARITH`((&1 - h) % u + h % w) - x=(&1 - h) % u + h % w - x`]
4713 THEN POP_ASSUM MP_TAC
4714 THEN CONV_TAC(TOP_DEPTH_CONV let_CONV)
4715 THEN ASM_REWRITE_TAC[]
4716 THEN ONCE_REWRITE_TAC[CROSS_TRIPLE]
4717 THEN ONCE_REWRITE_TAC[CROSS_SKEW]
4718 THEN ASM_REWRITE_TAC[DOT_LNEG]
4719 THEN STRIP_TAC
4720 THEN MRESAL_TAC condition_cross_dot_4point[`x:real^3`;`v:real^3`;`(&1 - h) % u + h % w:real^3`;`y:real^3`;`z:real^3` ][VECTOR_ARITH`((&1 - h) % u + h % w) - x=(&1 - h) % u + h % w - x`]
4721 THEN POP_ASSUM MP_TAC
4722 THEN CONV_TAC(TOP_DEPTH_CONV let_CONV)
4723 THEN ASM_REWRITE_TAC[]
4724 THEN MRESAL_TAC condition_cross_dot_4point[`x:real^3`; `z:real^3`;`y:real^3` ;`v:real^3`;`(&1 - h) % u + h % w:real^3`][VECTOR_ARITH`((&1 - h) % u + h % w) - x=(&1 - h) % u + h % w - x`]
4725 THEN POP_ASSUM MP_TAC
4726 THEN CONV_TAC(TOP_DEPTH_CONV let_CONV)
4727 THEN RESA_TAC
4728 THEN POP_ASSUM MP_TAC
4729 THEN ONCE_REWRITE_TAC[CROSS_SKEW]
4730 THEN ASM_REWRITE_TAC[]
4731 THEN ONCE_REWRITE_TAC[GSYM CROSS_RNEG]
4732 THEN ONCE_REWRITE_TAC[GSYM CROSS_SKEW]
4733 THEN REWRITE_TAC[DOT_LNEG;REAL_ARITH`--(--A)=A`]
4734 THEN REMOVE_THEN "YEU" (fun th-> MRESA1_TAC th`h:real`)
4735 THEN REMOVE_THEN "LINH" (fun th-> MRESA1_TAC th`h:real`)
4736 THEN SET_TAC[]);;
4737
4738
4739
4740
4741
4742
4743
4744 end;;