Sindbad~EG File Manager
(* ========================================================================= *)
(* ET Axioms for Proof-checking Euclid *)
(* ========================================================================= *)
(* M. Beeson, 12.23.17 *)
(* To use Flyspeck stuff:
load_path := "Formal_ineqs" :: !load_path;;
needs "verifier/m_verifier_main.hl";;
open M_verifier_main;;
let ineq =
`-- &1 / sqrt(&3) <= x /\ x <= sqrt(&2) /\
-- sqrt(pi) <= y /\ y <= &1
==> x pow 2 * y - x * y pow 4 + y pow 6 - &6 + x pow 4
> -- #7.17995`;;
*)
prioritize_real();;
parse_as_infix("cross2",(20,"right"));;
needs "/Users/beeson/Dropbox/Provers/HOL-Light/Examples/sos.ml";; (* To use REAL_SOS *)
needs "/Users/beeson/Dropbox/Provers/HOL-Light/Multivariate/vectors.ml";;
(* following tactic, due to Freek, is for help in debugging. It prints the
current goalstack. *)
let GOAL_TAC g =
current_goalstack := (mk_goalstate g)::!current_goalstack;
ALL_TAC g;;
let cross2 = new_definition
` x cross2 y = x$1* y$2 - x$2 *y$1`;;
(* collinearity plus a != c *)
let L = new_definition
` L(a,b,c) = ?t:real. (b-a) = t %(c-a)` ;;
(* betweenness *)
let B = new_definition
` B(a,b,c) = ?t. ((b-a = t % (c-a) ) /\ &0 < t /\ t < &1) /\ ~(a=c)`;;
(* non-collinearity as used in the paper is defined as
NEAB NEAC NEBC NOBEABC NOBEACB NOBEBAC *)
let NC = new_definition
` NC(a,b,c) = (~(a = b) /\ ~(a = c) /\ ~(b = c) /\ ~B(a,b,c) /\ ~B(a,c,b) /\ ~B(b,a,c))`;;
let triangle = new_definition
` triangle(a,b,c) = NC(a,b,c)`;;
(* twice the signed area of a triangle *)
let tarea = new_definition
` tarea(x,y,z) = (z-y) cross2 (x-y)`;;
(* Properties of scalar cross product *)
let crossanticommutative = prove(
`!a b. --( b cross2 a) = a cross2 b `,
(REPEAT GEN_TAC)THEN
REWRITE_TAC[cross2;VECTOR_MUL_COMPONENT] THEN
(CONV_TAC REAL_RING)
);;
let crossanticommutativebinary = prove(
`!a b u. u + a cross2 b = u - (b cross2 a)`,
(REPEAT GEN_TAC)THEN
REWRITE_TAC[cross2;VECTOR_MUL_COMPONENT] THEN
(CONV_TAC REAL_RING)
);;
let crossflip = prove(
`!a b c d. (b-a) cross2 (c-d) = (d-c) cross2 (b-a)`,
(REPEAT GEN_TAC)THEN
REWRITE_TAC[cross2;VECTOR_SUB_COMPONENT] THEN
(CONV_TAC REAL_RING)
);;
let crosslinear1 = prove
( `!t:real a b. (t % a) cross2 b = t* (a cross2 b)`,
(REPEAT GEN_TAC) THEN
REWRITE_TAC[cross2;VECTOR_MUL_COMPONENT] THEN
(CONV_TAC REAL_RING)
);;
let crosslinear2 = prove
( `!t:real a b. a cross2 (t % b) = t *(a cross2 b)`,
(REPEAT GEN_TAC) THEN
REWRITE_TAC[cross2;VECTOR_MUL_COMPONENT] THEN
(CONV_TAC REAL_RING)
);;
let crossdistrib1 = prove
( `!a b c. a cross2 b - a cross2 c = a cross2(b-c)`,
(REPEAT GEN_TAC) THEN
REWRITE_TAC[cross2;VECTOR_MUL_COMPONENT;VECTOR_SUB_COMPONENT] THEN
(CONV_TAC REAL_RING)
);;
let crossdistrib2 = prove
( `!a b c. a cross2 b - c cross2 b = (a-c)cross2 b`,
(REPEAT GEN_TAC) THEN
REWRITE_TAC[cross2;VECTOR_MUL_COMPONENT;VECTOR_SUB_COMPONENT] THEN
(CONV_TAC REAL_RING)
);;
let crossdistrib2plus = prove
( `!a b c. a cross2 b + c cross2 b = (a+c)cross2 b`,
(REPEAT GEN_TAC) THEN
REWRITE_TAC[cross2;VECTOR_MUL_COMPONENT;VECTOR_ADD_COMPONENT] THEN
(CONV_TAC REAL_RING)
);;
let crossdistrib3 = prove
( `!a b c. a cross2 b + a cross2 c = a cross2(b+c)`,
(REPEAT GEN_TAC) THEN
REWRITE_TAC[cross2;VECTOR_MUL_COMPONENT;VECTOR_ADD_COMPONENT] THEN
(CONV_TAC REAL_RING)
);;
let crossdistrib4 = prove
( `! a b c u. u cross2( a + b -c) = u cross2 a + u cross2 (b-c)`,
(REPEAT GEN_TAC) THEN
REWRITE_TAC[cross2;VECTOR_MUL_COMPONENT;VECTOR_SUB_COMPONENT;VECTOR_ADD_COMPONENT] THEN
(CONV_TAC REAL_RING)
);;
let crossdistrib5 = prove
( `! a b c u. u cross2( a + b -c) = u cross2 b + u cross2 (a-c)`,
(REPEAT GEN_TAC) THEN
REWRITE_TAC[cross2;VECTOR_MUL_COMPONENT;VECTOR_SUB_COMPONENT;VECTOR_ADD_COMPONENT] THEN
(CONV_TAC REAL_RING)
);;
let crossminus = prove
( `!a b c u. u + (a-b) cross2 c = u-(b-a) cross2 c`,
(REPEAT GEN_TAC) THEN
REWRITE_TAC[cross2;VECTOR_MUL_COMPONENT;VECTOR_SUB_COMPONENT] THEN
(CONV_TAC REAL_RING)
);;
let crossminusunary = prove
( `!a b c. (a-b) cross2 c = --(b-a) cross2 c`,
(REPEAT GEN_TAC) THEN
REWRITE_TAC[cross2;VECTOR_MUL_COMPONENT;VECTOR_NEG_COMPONENT;VECTOR_SUB_COMPONENT] THEN
(CONV_TAC REAL_RING)
);;
let crossminusunary2 = prove
( `!a b c. (a-b) cross2 c = --((b-a) cross2 c)`,
(REPEAT GEN_TAC) THEN
REWRITE_TAC[cross2;VECTOR_MUL_COMPONENT;VECTOR_NEG_COMPONENT;VECTOR_SUB_COMPONENT] THEN
(CONV_TAC REAL_RING)
);;
let crosszero = prove
(`!x. x cross2 x = &0`,
(REPEAT GEN_TAC) THEN
REWRITE_TAC[cross2] THEN
(CONV_TAC REAL_RING)
);;
let crosszero2 = prove
(`!x y. (x-y) cross2 (y-x) = &0`,
(REPEAT GEN_TAC) THEN
REWRITE_TAC[cross2;VECTOR_SUB_COMPONENT] THEN
(CONV_TAC REAL_RING)
);;
let crossreverse = prove
(`!x y z w. (x-y) cross2 (z-w) = (y-x) cross2 (w-z)`,
(REPEAT GEN_TAC) THEN
REWRITE_TAC[cross2;VECTOR_SUB_COMPONENT] THEN
(CONV_TAC REAL_RING)
);;
(*_______________________________________________________________*)
(* signed area of a quadrilateral *)
let sarea4 = new_definition
` sarea4(a,b,c,d) = (c-a) cross2 (b-d)`;;
let square = new_definition
` square(x:real) = x * x : real`;;
(* distance squared *)
let dsq = new_definition
` dsq(a,b) = square(a$1-b$1)+square(a$2-b$2)`;;
(* congruent triangles. Does not require non-collinearity, i.e that they really be triangles. *)
let TC = new_definition
` TC(a,b,c,p,q,r) = (dsq(a,b) = dsq(p,q) /\ dsq(a,c) = dsq(p,r) /\ dsq(b,c) = dsq(q,r))`;;
(* This definition follows the paper exactly. *)
let triangle_congruence = new_definition
`triangle_congruence(a,b,c,p,q,r) = ( TC(a,b,c,p,q,r) /\ NC(a,b,c))`;;
let LL = new_definition
` LL(a,b,t) = (B(t,a,b) \/ t=a \/ B(a,t,b) \/ t=b \/ B(a,b,t))`;;
let CO = new_definition
` CO(a,b,c) <=> (a=b \/ a=c \/ b=c \/ B(b,a,c) \/ B(a,b,c) \/ B(a,c,b))`;;
(* Not-necessarily-convex quadrilateral. This is not actually used. *)
let quad = new_definition
` quad(a,b,c,d) <=> ((?t. B(a,t,c) /\ LL(b,d,t)) \/ ?t. B(b,t,d) /\ LL(a,c,t))`;;
(* twice the (unsigned) area of a triangle *)
let area = new_definition
` area(x,y,z) = abs(tarea(x,y,z))`;;
(* twice the (unsigned) area of a quadrilateral *)
let area4 = new_definition
` area4(a,b,c,d) = abs(sarea4(a,b,c,d))`;;
let convex_quad = new_definition
` convex_quad(a,b,c,d) <=> (?t. B(a,t,c) /\ B(b,t,d))`;;
let really_triangle = new_definition
` really_triangle(a,b,c,d) <=> B(a,b,c) \/ B(b,c,d) \/ B(c,d,a) \/ B(d,a,b)`;;
let euclid_quad = new_definition
` euclid_quad(a,b,c,d) <=> (convex_quad(a,b,c,d) \/ really_triangle(a,b,c,d)) /\ &0 < area4(a,b,c,d)`;;
(* Equal Triangles *)
let ET = new_definition
` ET(u,v,w,x,y,z) <=> area(u,v,w) = area(x,y,z) /\ &0 < area(u,v,w)`;;
(* Opposite side; a and d are on opposite sides of bc*)
let OS = new_definition
`OS(a:real^2,b:real^2,c:real^2,d:real^2) = ?t:real^2. B(a,t,d) /\ CO(b,c,t) /\ NC(b,c,a)` ;;
(* constructor of 2-vectors; vector[x:real; y:real] has type real^N, not real^2 *)
let vec2 = new_definition
`vector2[x:real;y:real] = vector[x;y]:real^2`;;
(* The explicit typing in the next line is very important. *)
let zero2 = new_definition `zero2 = vec(0):real^2`;;
let cross = new_definition
`CR(a,b,c,d) <=> ?t:real^2. B(a,t,c) /\ B(b,t,d)` ;;
(* Equal Figures, i.e. equal quadrilaterals *)
let EF = new_definition
` EF(a,b,c,d,p,q,r,s) = (euclid_quad(a,b,c,d) /\ euclid_quad(p,q,r,s) /\
area4(a,b,c,d) = area4(p,q,r,s))`;;
(* That's all the definitions except EF, which is given much later. *)
prioritize_vector();;
let lemma166 = VECTOR_ARITH `d-b = t % (c-b) ==> (d-a) = (t % (c-b))+b-a`;;
prioritize_vector();;
let tadditive1 = prove
( `!a:real^2 b:real^2 c:real^2 d:real^2. L(b,d,c) ==> (tarea(d,a,b) + tarea(c,a,d) = tarea(a,b,c))`,
(REPEAT GEN_TAC) THEN
REWRITE_TAC [tarea] THEN
REWRITE_TAC [crossanticommutativebinary] THEN
REWRITE_TAC [crossdistrib2; (VECTOR_ARITH `x-y - (z-y) = x-z`) ] THEN
REWRITE_TAC [L; LEFT_IMP_EXISTS_THM] THEN
GEN_TAC THEN
ASM_SIMP_TAC[lemma166] THEN
SIMP_TAC[crossdistrib4] THEN
SIMP_TAC[crosslinear2;crosszero2] THEN
SIMP_TAC[crossreverse] THEN
REWRITE_TAC[REAL_RING `t * &0 = &0`] THEN
REWRITE_TAC[REAL_RING `&0+x = x`]
);;
let tadditive2 = prove
( `!a:real^2 b:real^2 c:real^2 d:real^2 t:real. d - b = t % (c - b) ==> (tarea(d,a,b) + tarea(c,a,d) = tarea(a,b,c))`,
(REPEAT GEN_TAC) THEN
REWRITE_TAC [tarea] THEN
REWRITE_TAC [crossanticommutativebinary] THEN
REWRITE_TAC [crossdistrib2; (VECTOR_ARITH `x-y - (z-y) = x-z`) ] THEN
ASM_SIMP_TAC[lemma166] THEN
SIMP_TAC[crossdistrib4] THEN
SIMP_TAC[crosslinear2;crosszero2] THEN
SIMP_TAC[crossreverse] THEN
REWRITE_TAC[REAL_RING `t * &0 = &0`] THEN
REWRITE_TAC[REAL_RING `&0+x = x`]
);;
let tacc = prove
( `! a c. tarea(c,a,c) = &0`,
(REPEAT GEN_TAC) THEN
REWRITE_TAC[tarea;crosszero]
);;
let ta3 = REWRITE_RULE[tacc; REAL_ADD_RID]
(ISPECL [`a:real^2`; `b:real^2`; `c:real^2`; `c:real^2`] tadditive1);;
let ta2 = prove(
` L(b:real^2,c:real^2,c:real^2)`,
REWRITE_TAC[L] THEN
EXISTS_TAC `&1` THEN
VECTOR_ARITH_TAC
);;
let tapermutation = GEN_ALL (MP ta3 ta2);; (* tarea(c,a,b) = tarea(a,b,c) *)
(* signed area is additive with linearity hypothesis, betweenness not needed *)
let tadditive = prove
( `!a:real^2 b:real^2 c:real^2 d:real^2 . L(b,d,c) ==> tarea(d,a,b) + tarea(c,a,d) = tarea(c,a,b)`,
REPEAT GEN_TAC THEN
CONV_TAC (PAT_CONV `\x. L(b,d,c) ==> cc + cc = x` (REWRITE_CONV[tapermutation])) THEN
MESON_TAC[tadditive1]
);;
let lemma246 = prove
( `! d b t. d-b = t % (c-b) ==> d = b + t % (c-b)`,
(REPEAT GEN_TAC) THEN
VECTOR_ARITH_TAC
);;
let lemma266 = prove
( `!d:real^2 b:real^2 c:real^2 a:real^2 t:real. d-b = t % (c-b) /\ &0 < t /\ t < &1 ==>
tarea(d,a,b) = t * tarea(a,b,c)`,
(REPEAT GEN_TAC) THEN
REWRITE_TAC[tarea] THEN
SIMP_TAC[lemma246] THEN
REWRITE_TAC[VECTOR_ARITH `(x+y)-z = x + y-z`] THEN
REWRITE_TAC[crossdistrib5; crosszero; REAL_ADD_RID; crosslinear2] THEN
REWRITE_TAC[crossflip]
);;
let lemma266rev = prove
( `!d:real^2 b:real^2 c:real^2 a:real^2 t:real. d-b = t % (c-b) /\ &0 < t /\ t < &1 ==>
t * tarea(a,b,c) = tarea(d,a,b)`,
MESON_TAC[lemma266]
);;
let lemma300 = REAL_RING `!x:real y:real z:real. (x + y = z) <=> (y = z-x)`;;
let lemma286 = prove
( `!d:real^2 b:real^2 c:real^2 a:real^2 t:real. d-b = t % (c-b) /\ &0 < t /\ t < &1 ==>
tarea(c,a,d) = tarea(a,b,c)-tarea(d,a,b)`,
(REPEAT GEN_TAC) THEN
MESON_TAC[L;tadditive;tadditive1; lemma300]
);;
let lemma279 = prove
( `!d:real^2 b:real^2 c:real^2 a:real^2 t:real. d-b = t % (c-b) /\ &0 < t /\ t < &1 ==>
tarea(c,a,d) = (&1-t) * tarea(a,b,c)`,
(REPEAT GEN_TAC) THEN
REWRITE_TAC[REAL_SUB_RDISTRIB] THEN
SIMP_TAC[lemma266rev] THEN
REWRITE_TAC[REAL_MUL_LID] THEN
MESON_TAC[lemma286]
);;
let lemma310 = TAUT `(x /\ y ==> z) <=> x ==> y ==> z`;;
let lemma311 = TAUT `x ==> y ==> z ==> w <=> (x /\ y /\ z ==> w)`;;
let lemma320 = prove
( `!a:real^2 b:real^2 d:real^2 c:real^2 . B(b,d,c) /\ &0 < tarea(a,b,c) ==> &0 < tarea(d,a,b)`,
REPEAT GEN_TAC THEN
REWRITE_TAC[B;lemma310;LEFT_IMP_EXISTS_THM] THEN
GEN_TAC THEN
SIMP_TAC[lemma311] THEN
MESON_TAC[lemma266;REAL_LT_MUL]
);;
let lemma342 = REAL_ARITH `t < &1 <=> &0 < &1-t`;;
let lemma343 = REAL_ARITH `&0 < &1-t <=> t < &1`;;
let lemma344 = prove
( `!a:real^2 b:real^2 d:real^2 c:real^2 . B(b,d,c) /\ &0 < tarea(a,b,c) ==> &0 < tarea(c,a,d)`,
REPEAT GEN_TAC THEN
REWRITE_TAC[B;lemma310;LEFT_IMP_EXISTS_THM] THEN
SIMP_TAC[lemma311] THEN
REWRITE_TAC[lemma343] THEN
SIMP_TAC[lemma279] THEN
MESON_TAC[lemma343;REAL_LT_MUL]
);;
let abspos = REAL_ARITH `&0 < x ==> abs(x) = x`;;
let absneg = REAL_ARITH `x < &0 ==> abs(x) = --x`;;
let absneg2 = REAL_ARITH `x <= &0 ==> abs(x) = --x`;;
let abszero = REAL_ARITH `abs(x) = &0 <=> x = &0`;;
let BimpliesL = prove
( `!a:real^2 b:real^2 c:real^2. B(a,b,c) ==> L(a,b,c)`,
MESON_TAC[B;L]
);;
let lemma366 = prove
( `!x:real^2 y:real^2 z:real^2. &0 < tarea(x,y,z) ==> area(x,y,z) = tarea(x,y,z)`,
MESON_TAC[area; abspos]
);;
let tadditiveB = prove
( ` !a:real^2 b:real^2 c:real^2 d:real^2. B (b,d,c) ==> tarea (d,a,b) + tarea (c,a,d) = tarea (a,b,c)`,
MESON_TAC[BimpliesL;tadditive1]
);;
let lemma371 = prove
( `!a:real^2 b:real^2 c:real^2 d:real^2. B(b,d,c) /\ &0 < tarea(a,b,c) ==> area(d,a,b) + area(c,a,d) = area(a,b,c)`,
REPEAT GEN_TAC THEN
REWRITE_TAC[area] THEN
ASM_SIMP_TAC[abspos] THEN
MESON_TAC[abspos;lemma320;lemma344;tadditiveB]
);;
let REAL_GE_MUL = prove
( `!x:real y:real. x <= &0 /\ y <= &0 ==> &0 <= x*y`,
REPEAT GEN_TAC THEN REWRITE_TAC[REAL_LE_LT] THEN
REWRITE_TAC[REAL_ARITH `x < &0 <=> &0 < --x`] THEN
MESON_TAC[REAL_ARITH `&0 * y = &0`;
REAL_ARITH `x * &0 = &0`;
REAL_LT_MUL;
REAL_ARITH `(--x) * (--y) = x*y`]
);;
let REAL_GT_LE_MUL = prove
( `! x:real y:real. &0 < x /\ y <= &0 ==> x*y <= &0`,
REPEAT GEN_TAC THEN REWRITE_TAC[REAL_LE_LT] THEN
REWRITE_TAC[REAL_ARITH `x < &0 <=> &0 < --x`] THEN
MESON_TAC[REAL_ARITH `&0 * y = &0`;
REAL_ARITH `x * &0 = &0`;
REAL_LT_MUL;
REAL_ARITH `x * (--y) = -- (x*y)`;
REAL_ARITH `(--x) * (--y) = x*y`]
);;
let lemma383 = prove
( `!a:real^2 b:real^2 c:real^2 d:real^2. B(b,d,c) /\ tarea(a,b,c) <= &0 ==> tarea(d,a,b) <= &0`,
REPEAT GEN_TAC THEN
REWRITE_TAC[B;lemma310;LEFT_IMP_EXISTS_THM] THEN
GEN_TAC THEN
SIMP_TAC[lemma311] THEN
SIMP_TAC[lemma266] THEN
MESON_TAC[REAL_ARITH `&0 * y = &0`;
REAL_ARITH `x * &0 = &0`;
REAL_LT_MUL;
REAL_ARITH `(--x) * (--y) = x*y`;
REAL_GT_LE_MUL
]
);;
let lemma420 = prove
( `!a:real^2 b:real^2 c:real^2 d:real^2. B(b,d,c) /\ tarea(a,b,c) <= &0 ==> tarea(c,a,d) <= &0`,
REPEAT GEN_TAC THEN
REWRITE_TAC[B;lemma310;LEFT_IMP_EXISTS_THM] THEN
GEN_TAC THEN
SIMP_TAC[lemma311] THEN
SIMP_TAC[lemma279] THEN
MESON_TAC[REAL_ARITH `&0 * y = &0`;
REAL_ARITH `x * &0 = &0`;
REAL_LT_MUL;
REAL_ARITH `(--x) * (--y) = x*y`;
REAL_ARITH `t < &1 ==> &0 < &1-t`;
REAL_GT_LE_MUL
]
);;
let MINUS_DISTRIB = REAL_ARITH `!x:real y:real. --x + (--y) = --(x+y)`;;
let lemma440 = prove
( `!a:real^2 b:real^2 c:real^2 d:real^2. B(b,d,c) /\ tarea(a,b,c)<= &0 ==> area(d,a,b) + area(c,a,d) = area(a,b,c)`,
REPEAT GEN_TAC THEN
REWRITE_TAC[area] THEN
ASM_SIMP_TAC[abspos] THEN
MESON_TAC[absneg2;lemma383;lemma420;MINUS_DISTRIB;tadditiveB]
);;
let area_additive = prove
( `!a:real^2 b:real^2 c:real^2 d:real^2. B(b,d,c) ==> area(d,a,b) + area(c,a,d) = area(a,b,c)`,
MESON_TAC[lemma371;lemma440;REAL_ARITH `&0 < x \/ x <= &0`]
);;
let lemma448 = prove
( `vec 0 $ x = &0`,
MESON_TAC[VEC_COMPONENT]
);;
let VEC2_TAC =
SIMP_TAC[CART_EQ; LAMBDA_BETA; FORALL_2; SUM_2; DIMINDEX_2; VECTOR_2;
vector_add; vec; dot; cross2; lemma448; orthogonal; basis; ARITH] THEN
TRY (CONV_TAC REAL_RING);;
let zero2_components = prove
( `zero2 $1 = &0 /\ zero2 $2 = &0`,
REWRITE_TAC[zero2] THEN
VEC2_TAC
);;
(* Now add zero2_components to VEC2_TAC *)
let VEC2_TAC =
SIMP_TAC[CART_EQ; LAMBDA_BETA; FORALL_2; SUM_2; DIMINDEX_2; VECTOR_2;
zero2_components;
vector_add; vec; dot; cross2; lemma448; orthogonal; basis; ARITH] THEN
TRY (CONV_TAC REAL_RING);;
let VEC2_RULE tm = prove(tm,VEC2_TAC);;
prioritize_real();;
(* TC ==> equal area when a is at origin and b on x-axis *)
let lemma471 = prove
( `!b:real^2 c:real^2 y:real^2 z:real^2.
b$2 = &0 /\ y$2 = &0 /\ b$1= y$1 /\ TC(vec(0),b,c,vec(0),y,z) ==>
b$1 = &0 \/ (c$1 = z$1 /\ (z$2 = c$2 \/ z$2 = --(c$2)))`,
REPEAT GEN_TAC THEN
REWRITE_TAC[TC] THEN
SIMP_TAC[dsq;square] THEN
REWRITE_TAC[lemma448] THEN
(CONV_TAC REAL_RING)
);;
let lemma485 = prove
( `!b:real^2 c:real^2 y:real^2 z:real^2.
(b$1 = &0 \/ (c$1 = z$1 /\ (z$2 = c$2 \/ z$2 = --(c$2))))
/\ b$2 = &0 /\ y$2 = &0 /\ b$1= y$1
==> b$1 = &0 \/ area(zero2,b,c) = area(zero2,y,z)`,
REPEAT GEN_TAC THEN
REWRITE_TAC[area;tarea;cross2;zero2] THEN
REWRITE_TAC[VECTOR_SUB_COMPONENT;lemma448;REAL_SUB_LZERO;REAL_SUB_RDISTRIB] THEN
REWRITE_TAC[ REAL_ARITH `x - (y*(--z) - w * (--z))= x+y*z - w*z`] THEN
REWRITE_TAC[ REAL_ARITH `x* (--y) - z * (--y) + w = z*y-x*y+w`] THEN
SIMP_TAC[ REAL_MUL_LZERO] THEN
REWRITE_TAC[ REAL_MUL_RZERO; REAL_SUB_LZERO;REAL_SUB_RZERO] THEN
REWRITE_TAC[REAL_ARITH `--(&0) + x = x`; REAL_ABS_MUL] THEN
MESON_TAC[REAL_ARITH ` x = y \/ x = --(y) ==> abs(x) = abs(y)`]
);;
let lemma500 = prove
( `!b:real^2 c:real^2 y:real^2 z:real^2.
b$2 = &0 /\ y$2 = &0 /\ b$1= y$1 /\ TC(zero2,b,c,zero2,y,z) ==>
b$1 = &0 \/ area(zero2,b,c) = area(zero2,y,z)`,
MESON_TAC[lemma471;lemma485;zero2] (* It takes a minute but it works *)
);;
(* minor variant of lemma500 with ~(b$1 = 0) moved to the hypothesis *)
let lemma501 = prove
( `!b:real^2 c:real^2 y:real^2 z:real^2.
b$2 = &0 /\ y$2 = &0 /\ b$1= y$1 /\ TC(zero2,b,c,zero2,y,z) /\ ~ (b$1 = &0)
==> area(zero2,b,c) = area(zero2,y,z)`,
MESON_TAC[lemma500]
);;
let det = new_definition
`det(A:real^2^2) = A$1$1 * A$2$2 - A$1$2 *A$2$1`;;
let absplusminus = REAL_ARITH ` x = y \/ x = --(y) ==> abs(x) = abs(y)`;;
let absequal = REAL_ARITH `abs(x) = abs(y) <=> x = y \/ x = --(y)`;;
let MATRIXTWO_MUL_COMPONENT = prove
(`!A:real^2^2 x:real^2.
(A**x)$1 = A$1$1 * x$1 + A$1$2 * x$2 /\
(A**x)$2 = A$2$1 * x$1 + A$2$2 * x$2`,
SIMP_TAC[MATRIX_VECTOR_MUL_COMPONENT;
DIMINDEX_2; LE_REFL; ARITH_RULE `1 <= 2`] THEN
REWRITE_TAC[DOT_2]
);;
let det_tarea = prove
( `!A:real^2^2 x:real^2 y:real^2 z:real^2. det(A) = &1 ==>
tarea(A**x, A**y, A**z) = tarea(x,y,z)`,
REPEAT GEN_TAC THEN
REWRITE_TAC[area;det;tarea;cross2;VECTOR_SUB_COMPONENT;absequal] THEN
REWRITE_TAC[REAL_SUB_RDISTRIB;REAL_SUB_LDISTRIB] THEN
SIMP_TAC[MATRIX_VECTOR_MUL_COMPONENT;
DIMINDEX_2; LE_REFL; ARITH_RULE `1 <= 2`] THEN
REWRITE_TAC[DOT_2] THEN
REWRITE_TAC[REAL_ADD_RDISTRIB;REAL_ADD_LDISTRIB] THEN
CONV_TAC REAL_RING
);;
let det_area = prove
( `!A:real^2^2 x:real^2 y:real^2 z:real^2. det(A) = &1 ==>
area(A**x, A**y, A**z) = area(x,y,z)`,
REWRITE_TAC[area] THEN
MESON_TAC[REAL_ARITH `x = y ==> abs(x) = abs(y)`;det_tarea]
);;
let congruence_symmetric = prove
( `!a:real^N b c x y z. TC(a,b,c,x,y,z) ==> TC(x,y,z,a,b,c)`,
REPEAT GEN_TAC THEN REWRITE_TAC[TC;dsq;square] THEN
MESON_TAC[TRUTH]
);;
let congruence_symmetric2 = prove
( `!a:real^2 b:real^2 c:real^2 x:real^2 y:real^2 z:real^2. TC(a,b,c,x,y,z) ==> TC(x,y,z,a,b,c)`,
REPEAT GEN_TAC THEN REWRITE_TAC[TC;dsq;square] THEN
MESON_TAC[TRUTH]
);;
let congruence_transitive = prove
( `!a:real^2 b:real^2 c:real^2 x:real^2 y:real^2 z:real^2 p:real^2 q:real^2 r:real^2.
TC(a,b,c,x,y,z) /\ TC(x,y,z,p,q,r) ==> TC(a,b,c,p,q,r)`,
REPEAT GEN_TAC THEN REWRITE_TAC[TC;dsq;square] THEN
MESON_TAC[TRUTH]
);;
let rotation_matrix = new_definition
`rotation_matrix (Q:real^2^2) <=>
det(Q) = &1 /\ Q$2$1 = --(Q$1$2) /\ Q$1$1 = Q$2$2`;;
let det_rot = prove
( `!Q:real^2^2. rotation_matrix(Q) ==> det(Q) = &1`,
GEN_TAC THEN
REWRITE_TAC[rotation_matrix] THEN
VEC2_TAC
);;
let REAL_SIMP_TAC =
REWRITE_TAC[
REAL_ABS_MUL; REAL_ABS_NEG; REAL_ABS_NUM; REAL_ABS_POS; REAL_ABS_POW;
REAL_ADD_LID; REAL_ADD_LINV; REAL_ADD_RID; REAL_ADD_SYM;
REAL_ENTIRE; REAL_EQ_IMP_LE; REAL_INV_MUL; REAL_LET_TRANS; REAL_LE_LMUL;
REAL_LE_LT; REAL_LE_REFL; REAL_LE_SQUARE; REAL_LE_TOTAL; REAL_LTE_TRANS;
REAL_LT_01; REAL_LT_DIV; REAL_LT_IMP_LE; REAL_LT_IMP_NZ; (* Not REAL_LT_LE, which will loop *)
REAL_LT_MUL; REAL_LT_REFL; REAL_LT_TRANS; REAL_MUL_AC;
REAL_MUL_LID; REAL_MUL_LINV; REAL_MUL_LZERO; REAL_MUL_RID; REAL_MUL_RINV;
REAL_MUL_RZERO; REAL_MUL_SYM; REAL_NEG_NEG; REAL_NOT_LE;
REAL_NOT_LT; REAL_OF_NUM_ADD; REAL_OF_NUM_EQ; REAL_OF_NUM_LE;
REAL_OF_NUM_LT; REAL_OF_NUM_MUL; REAL_OF_NUM_POW; REAL_POS;
REAL_POW_2; REAL_POW_ADD; REAL_SUB_0; REAL_SUB_LDISTRIB; REAL_SUB_LE;
REAL_SUB_LT; REAL_SUB_REFL; REAL_SUB_RZERO; REAL_SUB_LZERO;
REAL_RING `x*(y+z) = x*y + x*z`;
REAL_RING `(y+z)*x = y*x+z*x`;
REAL_RING `x*(y-z) = x*y - x*z`;
REAL_RING `(y-z)*x = y*x-z*x`;
REAL_RING `--(&0) = &0`;
REAL_RING `x - --y = x+y`;
REAL_RING `x - --y + z = x+y+z`;
REAL_RING `x - --y - z = x+y-z`;
REAL_RING `x - &0 + y = x+y`;
REAL_RING `x - &0 - y = x-y`;
REAL_RING `x - y + &0 - z = x-y-z`;
REAL_RING `x + &0 - y - z = x - y - z`;
REAL_RING `x + y + z - y = x + z`;
REAL_RING `x + y - z - y = x-z`;
REAL_RING `x * --(y) = --(x*y)`;
REAL_RING `(--x) * y = --(x*y)`;
REAL_FIELD `(--x)/y = --(x/y)`;
REAL_RING `x + --(y) = x-y`;
REAL_RING `x + --y + z = x-y+z`;
REAL_RING `x + --y - z = x-y-z`;
REAL_RING `x - (y - z) = x - y + z`;
REAL_RING `(y - w) - t = y- w -t`;
REAL_RING `(y - z - w) - t = y- z- w -t`;
REAL_RING `(y - z - w) + t = y- z- w + t`;
REAL_RING `t - (x - y - z) = t -x + y + z`;
REAL_RING `t - (x +u - y - z) = t -x-u + y + z`;
REAL_RING `t + (x +u - y - z) = t +x+u - y - z`;
REAL_RING `(t + x) - y - z = t + x - y -z`;
REAL_RING `x+a-x-b = a-b`;
REAL_RING `(x+y)-(b+z) = x+y-b-z`;
REAL_RING `x + (a-b-c) = x + a -b -c`;
REAL_RING `x + (a-b-c-d) = x+a-b-c-d`;
REAL_RING `x + (a-b-c+d) = x+a-b-c+d`;
REAL_RING `x + (a-b-c+d) = x+a-b-c+d`;
REAL_RING `x + (a-b-c-d-e) = x+a-b-c-d-e`;
REAL_RING `x + (a-b-c-d-e-f) = x+a-b-c-d-e-f`;
REAL_RING `(x-y-z) +w = x-y-z+ w`;
REAL_RING `(x+y)-(b+y) = x-b`;
REAL_RING `(-- x = &0) <=> (x = &0)`;
REAL_ADD_AC
];;
let rot_dsq0 = prove
( `! b:real^2 Q:real^2^2. rotation_matrix(Q:real^2^2) ==>
dsq(vec 0,b) = dsq(vec 0, Q**b)`,
REPEAT GEN_TAC THEN REWRITE_TAC[rotation_matrix;det;lemma448;vec;dsq;square] THEN
REWRITE_TAC[REAL_SUB_RDISTRIB;REAL_SUB_LDISTRIB;
REAL_ADD_RDISTRIB;REAL_ADD_LDISTRIB] THEN
SIMP_TAC[MATRIX_VECTOR_MUL_COMPONENT;
DIMINDEX_2; LE_REFL; ARITH_RULE `1 <= 2`] THEN
REWRITE_TAC[DOT_2] THEN
REWRITE_TAC[REAL_ADD_RDISTRIB;REAL_ADD_LDISTRIB] THEN
REAL_SIMP_TAC THEN
CONV_TAC REAL_RING
);;
(* proved sometime in Jan. 2018 *)
let rot_dsq = prove
( `! a:real^2 b:real^2 Q:real^2^2. rotation_matrix(Q) ==>
dsq(a,b) = dsq(Q**a, Q**b)`,
REPEAT GEN_TAC THEN REWRITE_TAC[rotation_matrix;det;dsq;square] THEN
REWRITE_TAC[REAL_SUB_RDISTRIB;REAL_SUB_LDISTRIB;
REAL_ADD_RDISTRIB;REAL_ADD_LDISTRIB] THEN
SIMP_TAC[MATRIX_VECTOR_MUL_COMPONENT;
DIMINDEX_2; LE_REFL; ARITH_RULE `1 <= 2`] THEN
REWRITE_TAC[DOT_2] THEN
REWRITE_TAC[REAL_ADD_RDISTRIB;REAL_ADD_LDISTRIB] THEN
CONV_TAC REAL_RING
);;
(* proved sometime in Jan. 2018 *)
let rotation_congruence = prove
( `!a:real^2 b:real^2 c:real^2 Q:real^2^2. rotation_matrix(Q:real^2^2) ==>
TC(a,b,c,Q**a, Q**b, Q**c)`,
REPEAT GEN_TAC THEN REWRITE_TAC[TC] THEN
MESON_TAC[rot_dsq]
);;
let lemma_sos = prove
( `!b y. &0 <= b*b + y*y`,
MESON_TAC[REAL_LE_SQUARE;REAL_LE_ADD]
);;
let lemma_sos_pos = REAL_SOS
`!b y. (~ (b = &0 /\ y = &0)) ==> &0 < b*b + y*y`;;
let lemma683 = prove
( `&0 <= x ==> sqrt(x) * sqrt(x) = x`,
MESON_TAC[SQRT_MUL; SQRT_POW_2; REAL_POW_2]
);;
let lemma688 = prove
( `sqrt(b*b + y*y) * sqrt(b*b + y*y) = b*b + y*y`,
MESON_TAC[lemma_sos;lemma683]
);;
let lemma693 = REAL_FIELD `x * y/z = (x*y)/z`;;
let lemma695 = REAL_FIELD `~(b = &0) /\ ~(u = &0) ==> (y*b) * y*b /u/(b*b) = (y*y)/u`;;
let lemma697 = prove
( `~ (b = &0) ==> ~ (b*b + y*y = &0)`,
MESON_TAC[ REAL_POW_2; REAL_SOS_EQ_0]
);;
let lemma700 = REAL_FIELD ` ~ (b*b + y*y = &0) ==> (b*b)/ (b*b + y*y) + (y*y)/(b*b + y*y) = &1`;;
let lemma703 = REAL_FIELD ` ~ (b = &0) ==> ((y * b) * y * b) / (b * b + y * y) / (b * b) = (y * y) / (b * b + y * y)`;;
let lemma710 = prove
( `!b:real y:real. ~ (b = &0) ==>
b / sqrt (b*b + y*y) * b / sqrt (b*b + y*y) +
(y*b/ sqrt (b*b + y*y)) / b * (y*b/ sqrt (b*b + y*y)) / b = &1`,
REPEAT GEN_TAC THEN DISCH_TAC THEN
REWRITE_TAC[REAL_FIELD `x / y * x / y = x * x / (y * y)`;
lemma693;
REAL_FIELD `x / y * x / y = x * x / (y * y)`;
REAL_FIELD `(y*b / u) * (y*b /u ) / (b*b) = (y*b)*(y*b)/ (u*u)/(b*b)`;
lemma688;
lemma695;
] THEN
ASM_MESON_TAC[lemma695;lemma697; lemma700; lemma703]
);;
let lemma730 = GEN_ALL (REWRITE_RULE[REAL_RING `b*b + y*y = y*y + b*b`]
(SPECL[`y:real`; `b:real`]lemma710));;
(* removes hypothesis b$2 = 0 from lemma500 *)
(* Define
$$ \ell = \frac {b_2} {\vert b \vert} $$
$$ m = - \frac{ \ell b_1} {b_2}$$
Then
$$ \ell^2 =
\frac {b_2^2}{b_1^2 + b_2^2}. $$
$$ m^2 + \ell^2 = \ell^2 (1 + (b_1/b_2)^2) = 1.$$
Let $Q$ be the matrix
$$
\left(\begin{array}{cc}m & -\ell \\
\ell & m
\end{array}\right)
$$
Then $det(Q) = m^2 + \ell^2 = 1$, and by definition
$Q$ is a rotation matrix. So by
{\tt rotation\_congruence}, $(a,b,c)$ is congruent
to $(0,Qb,Qc)$. By {\tt congruence\_transitive} and
{\tt congruence\_symmetric}, $(0, Qb, Qc)$ is
congruent to $(x,y,z)$.
We have $(Qb)_2 = 0$; so by {\tt lemma\_500},
$$ area(Qa, Qb,Qc) = area(x,yz).$$
By {\tt det\_area},
$$ area(0,b,c) = area(0,Qb,Qc).$$
By transitivity of equality,
$$ area(0,b,c) = area(0,y,z)$$
completing the proof of {\tt lemma\_680}.
*)
let lemma804 = prove
( `!b:real^2 c:real^2 y:real^2 z:real^2 Q:real^2^2 m:real ell:real.
~ (b$2 = &0)/\ y$2 = &0 /\ TC(zero2,b,c,zero2,y,z)
/\ ell = (b$1) / (sqrt(b dot b)) /\ m = (ell * b$2) / b$1
/\ Q = vector[vector[ell:real;m:real];vector[--m:real;ell:real]]
/\ ~(b$1 = &0)
==> m*m + ell*ell = &1 /\
rotation_matrix(Q)`,
REPEAT GEN_TAC THEN
REWRITE_TAC[TC] THEN
SIMP_TAC[dsq;square;zero2] THEN
REWRITE_TAC[lemma448] THEN
VEC2_TAC THEN
REWRITE_TAC[rotation_matrix;det;VECTOR_2] THEN
REAL_SIMP_TAC THEN
REWRITE_TAC[lemma_sos] THEN
MESON_TAC[lemma730]
);;
let veczero = prove
( `!Q:real^2^2. Q** zero2 = zero2`,
REWRITE_TAC[MATRIX_VECTOR_MUL_RZERO;zero2]
);;
let rotation_congruence_zero = prove
( `!b:real^2 c:real^2 Q:real^2^2. rotation_matrix(Q:real^2^2) ==>
TC(zero2,b,c,zero2, Q**b, Q**c)`,
REPEAT GEN_TAC THEN REWRITE_TAC[TC] THEN
MESON_TAC[rot_dsq;veczero]
);;
let rotation_congruence_one = SPECL [`y:real^2`;`z:real^2`] rotation_congruence_zero;;
let lemma830 = prove
( `!b:real^2 c:real^2 y:real^2 z:real^2 Q:real^2^2 m:real ell:real.
~ (b$2 = &0)/\ y$2 = &0 /\ b$1= y$1 /\ TC(zero2,b,c,zero2,y,z)
/\ ell = (b$1) / (sqrt(b dot b)) /\ m = (ell * b$2) / b$1
/\ Q = vector[vector[ell:real;m:real];vector[--m:real;ell:real]]
/\ ~(b$1 = &0)
==> rotation_matrix(Q)
/\ TC(a, b, c, Q**a, Q**b, Q**c)`,
(* /\ area( Q**a, Q**b, Q**c) = area (a, b,c)`, *)
MESON_TAC[lemma804; rotation_congruence; veczero;zero2]
);;
let lemma842 = REAL_FIELD ` ~ (y = &0) ==> -- ((y/u*b)/y)*y + y/u*b = &0`;;
let lemma844 = prove
( `!y:real b:real. ~ (y = &0) ==>
--((y / sqrt (y*y + b*b) *b) / y) * y +
y / sqrt (y*y + b*b) *b =
&0`,
REPEAT GEN_TAC THEN
ASM_SIMP_TAC[lemma842] THEN
DISCH_TAC THEN
REWRITE_TAC[REAL_RING `--u + u = &0`]
);;
let lemma855 = ISPECL [`y:real^2 $1`; `b:real^2 $2`] lemma844;;
(* The specified Q does rotate b around to the x-axis *)
let lemma859 = prove
( `!b:real^2 c:real^2 y:real^2 z:real^2 Q:real^2^2 m:real ell:real.
~ (b$2 = &0)/\ y$2 = &0 /\ TC(zero2,b,c,zero2,y,z)
/\ ell = (b$1) / (sqrt(b dot b)) /\ m = (ell * b$2) / b$1
/\ Q = vector[vector[ell:real;m:real];vector[--m:real;ell:real]]
/\ ~(b$1 = &0)
==> (Q**b)$2 = &0`,
(* /\ area( Q**a, Q**b, Q**c) = area (a, b,c)`, *)
REPEAT GEN_TAC THEN
VEC2_TAC THEN
SIMP_TAC[MATRIX_VECTOR_MUL_COMPONENT;
DIMINDEX_2; LE_REFL; ARITH_RULE `1 <= 2`]
THEN REWRITE_TAC[DOT_2] THEN
DISCH_TAC THEN
ASM_SIMP_TAC[] THEN
ASM_MESON_TAC[lemma844]
);;
let congruence_reflexive = prove
( `!a:real^2 b:real^2 c:real^2. TC(a,b,c,a,b,c)`,
REPEAT GEN_TAC THEN REWRITE_TAC[TC;dsq;square]
);;
let lemma860 = REWRITE_RULE[veczero] (ISPEC `zero2` rotation_congruence);;
(* proved 1.20.18 *)
let lemma863 = prove
( `!x:real^2 y:real^2 b:real^2 c:real^2 Q:real^2^2.
TC(zero2,x,y,zero2,b,c) /\ rotation_matrix(Q) ==>
TC(zero2,x,y,zero2,Q**b, Q**c)`,
REPEAT GEN_TAC THEN DISCH_TAC THEN
SUBGOAL_THEN `TC(zero2,b:real^2,c:real^2,zero2,Q:real^2^2 **b, Q:real^2^2**c)`
ASSUME_TAC THENL
[ ASM_MESON_TAC[veczero;rotation_congruence];
ASM_MESON_TAC[veczero;congruence_transitive]
]
);;
(* proved 1.20.18 *)
let lemma909 = prove
( `!b:real^2 c:real^2 y:real^2 z:real^2 Q:real^2^2 m:real ell:real.
~ (b$2 = &0)/\ y$2 = &0 /\ TC(zero2,y,z,zero2,b,c)
/\ ell = (b$1) / (sqrt(b dot b)) /\ m = (ell * b$2) / b$1
/\ Q = vector[vector[ell:real;m:real];vector[--m:real;ell:real]]
/\ ~(b$1 = &0)
==> Q ** zero2 = zero2
/\ (Q**b)$2 = &0
/\ rotation_matrix(Q)
/\ TC(zero2,y,z,zero2,b,c)
/\ TC(zero2,b,c,zero2,Q**b,Q**c)
/\ TC(zero2,y,z,zero2,Q**b,Q**c)
/\ TC(zero2,Q**b, Q**c,zero2,y,z)`,
MESON_TAC[veczero;zero2;lemma859;lemma804;congruence_symmetric;
congruence_transitive; lemma860; lemma863;
congruence_symmetric2;rotation_congruence]
);;
(* proved 1.21.18 *)
let lemma928 = REAL_FIELD `!b1:real b2:real u:real. ~(b1 = &0) ==> b2 * (b2*b1/u)/b1 = b2*b2/u`;;
(* proved 1.21.18 *)
let common_denom = REAL_FIELD `!x:real y:real z:real. x/y + z/y = (x+z)/y`;;
let common_denom_minus = REAL_FIELD `!x:real y:real z:real. x/y - z/y = (x-z)/y`;;
let common_denom_product_minus = REAL_FIELD ` u*x/y - v*z/y = (u*x-v*z)/y`;;
let common_denom_product_plus = REAL_FIELD ` u*x/y + v*z/y = (u*x+v*z)/y`;;
(* proved 1.21.18 *)
let lemma934 = prove
( `!b2:real b1:real u:real. ~(b1 = &0) /\ ~(u = &0) ==>
b1*b1/u + b2 * (b2 *b1/u) /b1 = (b1*b1 + b2*b2)/u`,
REPEAT GEN_TAC THEN DISCH_TAC THEN
SUBGOAL_THEN `b1*b1 / u + b2*b2 / u = (b1*b1+b2*b2)/u` ASSUME_TAC THENL
[ MESON_TAC[common_denom; REAL_FIELD `!x:real y:real z:real. x*y/z = (x*y)/z`];
ASM MESON_TAC[lemma928]
]
);;
(* proved 1.21.18 *)
let lemma944 = REAL_SOS `!b2:real b1:real. ~(b2 = &0) ==> &0 <= b1*b1 + b2*b2
/\ ~ (b1*b1 + b2*b2 = &0)`;;
(* The assumed-nonzero component is listed first in the sum of squares *)
let sum_of_squares_nonzero = REAL_SOS `!b2:real b1:real. ~(b2 = &0) ==> ~ (b2*b2 + b1*b1 = &0)`;;
let lemma946 = prove
( `!u:real y:real. &0 <= y /\ y*y = u ==> sqrt(u) = y`,
MESON_TAC[SQRT_UNIQUE; REAL_RING `!x:real. x*x = x pow 2`]
);;
(* proved 1.21.18 *)
let lemma952 = prove(
`!y1:real b1:real b2:real. ~(b2 = &0) /\ ~(b1 = &0) /\ &0 <= y1 /\
y1 * y1 = b1 *b1 + b2*b2 ==> ( b1*b1 + b2*b2) / sqrt(b1*b1 + b2*b2) = y1`,
REPEAT GEN_TAC THEN DISCH_TAC THEN
SUBGOAL_THEN `~ (b1*b1 + b2*b2 = &0) /\ &0 <= b1*b1 + b2*b2` ASSUME_TAC
THENL [ASM_MESON_TAC[lemma944];
ASM_MESON_TAC[lemma944;lemma946;REAL_DIV_SQRT];
]
);;
(* proved 1.23.18 *)
let abs_pos = REAL_SOS ` !x:real. &0 < abs(x) <=> ~ (abs(x) = &0)`;;
(* proved 1.23.18 *)
let zero_one_cases = REAL_SOS ` x < &0 \/ x = &0 \/ (&0 < x /\ x < &1) \/ x = &1 \/ &1 < x`;;
(* proved 1.24.18 *)
let minus_one_cases = REAL_SOS `x < --(&1) \/ x = --(&1) \/ --(&1) < x`;;
(* proved 1.24.18 *)
let lemma966 = REAL_SOS `x < &0 ==> x < --(&1) \/ x = --(&1) \/ (--(&1) < x /\ x < &0)`;;
let REAL_DIV_NONZERO = REAL_FIELD `!x:real y:real. ~(x= &0) /\ ~ (y = &0) ==> ~ (x/y = &0)`;;
let REAL_DIV_NONZERO2 = REAL_FIELD `!x:real y:real. ~(x= &0) ==> ~ (y = &0) ==> ~ (x/y = &0)`;;
let REAL_DIV_NONZERO3 = REAL_FIELD `!x:real y:real. ~(x= &0) /\ ~ (y = &0) ==> (~ (x/y = &0)) = T`;;
(* proved 1.24.18; REAL_DIV_LMUL has the equality on the right the other way around. *)
let lemma978 = REAL_FIELD `!x:real y:real. ~ (y = &0) ==> x = y * x / y`;;
let lemma982 = UNDISCH_ALL (SPEC_ALL lemma978);;
let nonzero_product = REAL_RING `!x:real y:real. ~(x = &0) /\ ~(y = &0) ==> ~(x*y = &0)`;;
let lemma992 = REAL_FIELD `!x1:real y1:real x2:real y2:real.
x1 *y2 = x2*y1 /\ ~(y1 = &0) ==> x2 = x1/y1 *y2`;;
let lemma996 = REAL_RING
`!x1:real x2:real y1:real y2:real t:real.
(x1 = &0 /\ x2 = &0) \/ (y1 = &0 /\ y2 = &0) \/
(?t. x1 = t * y1 /\ x2 = t * y2 /\ ~(t = &0))
==> x1 * y2 = x2 * y1` ;;
(* proved 1.24.18 and 1.25.18. This lemma was a 2-day project. *)
let lemma1003 = prove
( `!x:real^2 y:real^2.
x$1 * y$2 = x$2 * y$1 <=>
x$1 = &0 /\ x$2 = &0 \/
y$1 = &0 /\ y$2 = &0 \/
?t. (x$1 = t * y$1 /\ x$2 = t * y$2 /\ ~(t = &0))`,
REPEAT GEN_TAC THEN
EQ_TAC THENL
[ DISCH_TAC THEN
ASM_CASES_TAC `x:real^2 $1 = &0` THENL
[ ASM_CASES_TAC `x:real^2 $2 = &0` THENL
[ ASM_MESON_TAC[]; (* finish the case x1 = x2 = 0 *)
(* Now x2!= 0 but x1 = 0 *)
ASM_CASES_TAC `y:real^2 $1 = &0` THENL
[ ASM_CASES_TAC `y:real^2 $2 = &0` THENL
[ ASM_MESON_TAC[]; (* finish the case y1 = y2 = x1 = 0 and x2 != 0 *)
(* Now y1 = x1 = 0 and y2 and x2 are nonzero *)
(REPEAT DISJ2_TAC) THEN (* x2 and y2 nonzero, x1 = y1 = 0 *)
EXISTS_TAC `x:real^2$2 / (y:real^2 $2)` THEN
ASM_SIMP_TAC[REAL_DIV_NONZERO3; (* prove ~(x$2/y$2 = 0) *)
REAL_DIV_LMUL] (* prove x$2 = y$2 * x$2 / y$2 *)
THEN REAL_SIMP_TAC THEN
ASM_SIMP_TAC[REAL_DIV_LMUL]
(* finishing off this case *)
]; (* end case split on y2 and end the case y1 = 0 *)
(* Now x1 = 0, x2 and y1 are nonzero *)
ASM_MESON_TAC[REAL_MUL_LZERO;nonzero_product] (* disposing of that case *)
] (* end case split on y1 *)
]; (* end case split on x2 and semicolon to divide cases of x1 *)
(* Now x1 is nonzero *)
ASM_CASES_TAC `y:real^2 $1 = &0` THENL
[ ASM_CASES_TAC `y:real^2 $2 = &0` THENL
[ ASM_MESON_TAC[]; (* the case y1 = y2 = 0, second conjunct is trivial *)
(* Now y1 = 0 but y2 is not zero *)
(* That contradicts x1*y2 x2*y1 *)
ASM_SIMP_TAC[nonzero_product;REAL_MUL_RZERO] (* goal reduces to F *)
(* OK that the goal reduces to F as the assumptions
are contradictory, as the next line proves *)
THEN ASM_MESON_TAC[nonzero_product;REAL_MUL_RZERO;REAL_MUL_LZERO]
(* This takes a minute but it works. *)
]; (* end case split on y2 and semicolon to end the case y1 = 0 *)
(* Now y1 is nonzero, as is x1. This is the last case. *)
(REPEAT DISJ2_TAC) THEN
EXISTS_TAC `x:real^2$1 / (y:real^2 $1)` THEN
ASM_SIMP_TAC[REAL_DIV_NONZERO3; REAL_DIV_RMUL] THEN
(* Now the goal is x2 = x1/y1 *y2
so we have to use the first assumption *)
ASM_MESON_TAC[lemma992]
] (* end of case split on y1 *)
] (* end of case split on x1 *)
; (* That completes the left to right implication. Now we
have to prove x1*y2 = x2*y1 given the right-hand side.
That is done in a lemma above *)
ASM_MESON_TAC[lemma996];
] (* close EQTAC THENL *)
);;
(* proved 1.26.18 *)
let crossequalszero = prove
(`!x:real^2 y:real^2 t:real. (x cross2 y = &0) <=> (x = zero2 \/ y = zero2 \/ ?t:real. (x = t % y /\ ~ (t = &0)))`,
REPEAT GEN_TAC THEN
REWRITE_TAC[cross2;dsq;square;VECTOR_SUB_COMPONENT;zero2] THEN
VEC2_TAC THEN
REAL_SIMP_TAC THEN
REWRITE_TAC[VECTOR_MUL_COMPONENT] THEN
MESON_TAC[lemma1003]
);;
let NOT_AND = TAUT `~ (p /\ q) <=> ~ p \/ ~q`;;
let DOUBLE_NEG = TAUT `(~ ~ p) <=>p`;;
let lemma1101 = VECTOR_ARITH `!a:real^2 b:real^2 c:real^2 t:real.
c - b = t % (a - b) ==> c-a = (&1-t) %(b-a)`;;
let lemma1104 = REAL_ARITH `!t:real. &0 < t /\ t < &1 ==> &0 < &1-t /\ &1-t < &1`;;
(* proved 1.28.18 *)
let SCALAR_MUL_EQN = prove
( `!s:real x:real^2 y:real^2. (x = y) ==> (s%x = s%y)`,
REPEAT GEN_TAC THEN
VEC2_TAC THEN
REWRITE_TAC[VECTOR_MUL_COMPONENT] THEN
STRIP_TAC THEN
ASM_SIMP_TAC[]
);;
(* proved 1.28.18 *)
let lemma1123 = prove
(`!s: real x:real^2 y:real^2.
~ (s = &0) ==> (x = inv(s) % y <=> s % x = y)`,
REPEAT STRIP_TAC THEN
EQ_TAC THENL
[ DISCH_TAC THEN
ASM_MESON_TAC[ISPECL [`inv(s:real)`; `x:real^2`; `inv(s:real) % y:real^2`]SCALAR_MUL_EQN;
VECTOR_ARITH `!x:real^2. &1 % x = x`;
REAL_MUL_RINV;
VECTOR_ARITH `!s:real t:real x:real^2. s % t % x = (s*t) % x`]
;
(* Now the goal is s % x = y ==> x = inv s % y, assuming s is not zero *)
ASM_MESON_TAC[ISPECL [`inv(s:real)`;`inv(s:real) % x:real^2`;`y:real^2`]SCALAR_MUL_EQN;
VECTOR_ARITH `!x:real^2. &1 % x = x`;
REAL_MUL_LINV;
VECTOR_ARITH `!s:real t:real x:real^2. s % t % x = (s*t) % x`]
]
);;
(* proved 1.28.18 *)
let scalar_cancel =
REWRITE_RULE [ VECTOR_ARITH `!x:real^2. &1 % x = x`;
REAL_MUL_LINV;
VECTOR_ARITH `!s:real t:real x:real^2. s % t % x = (s*t) % x`
]
(ISPECL [`inv(s:real)`; `s:real % x:real^2`; `s:real % y:real^2`] SCALAR_MUL_EQN);;
(* proved 1.28.18 *)
let SCALAR_MUL_CANCEL = prove
( `!s:real x:real^2 y:real^2. ~(s = &0) /\ s % x = s % y ==> x = y`,
REPEAT STRIP_TAC THEN
ASM_MESON_TAC[REAL_MUL_LINV; scalar_cancel;
VECTOR_ARITH `!x:real^2. &1 % x = x`
] (* takes a couple of minutes but eventually works *)
);;
(* proved 1.28.18 *)
let SCALAR_MUL_EQN_NONZERO = prove
( `!s:real x:real^2 y:real^2. ~(s = &0) ==> ((x = y) <=> ( s%x = s%y ))`,
REPEAT STRIP_TAC THEN
EQ_TAC THENL[
ASM_SIMP_TAC[SCALAR_MUL_EQN]; (* left to right *)
ASM_MESON_TAC[SCALAR_MUL_CANCEL]; (* right to left *)
] (* close EQ_TAC *)
);;
(* started 1.26.18, proved 1.27.18 *)
let lemma1170 = prove
( `!t:real. ~(t = &0) /\ ~(t = &1) /\ ~(t < &1) ==> &0 < inv(t) /\ inv(t) < &1`,
GEN_TAC THEN
REWRITE_TAC[REAL_NOT_LT;REAL_LE_LT] THEN
REWRITE_TAC[TAUT `p /\ (q \/ r) <=> (p/\q)\/(p/\r)`] THEN
REWRITE_TAC[REAL_RING `t = &1 <=> &1 = t`] THEN
REWRITE_TAC[ TAUT `p /\ ~q /\ q <=> F`] THEN
REWRITE_TAC[REAL_SOS `~(t = &0) /\ ~(&1 = t) /\ &1 < t <=> &1 < t`] THEN
SIMP_TAC[REAL_LT_INV_EQ] THEN
DISCH_TAC THEN
ASM_SIMP_TAC[ REAL_ARITH `&1 < t ==> &0 < t` ] THEN
ASM_REWRITE_TAC[REAL_LT_INV_EQ] THEN
ASM_MESON_TAC[REAL_INV_LT_1]
);;
(* proved 1.28.18 *)
let lemma1186 =
VECTOR_ARITH `!t:real a:real^2 b:real^2 c:real^2. c-b = t % (a-b) <=> (&1-t) % (b-a) = (c-a)`;;
(* proved 1.28.18 *)
let lemma1190 = prove
( `!c:real^2 a:real^2 b:real^2 t:real.
(c - b = t % (a - b) /\ ~(&0 < t) /\ ~(t = &0) ) ==> b-a = inv(&1-t) % (c-a)`,
REPEAT (STRIP_TAC) THEN
SUBGOAL_THEN `~(&1 - t = &0)` ASSUME_TAC THENL
[
UNDISCH_TAC `~(&0 < t) ` THEN
REAL_ARITH_TAC ;
(* So now ~(1-t = 0) is in the assumption list, making 1/(1-t) defined *)
SUBGOAL_THEN `(&1 - t:real) % (b:real^2-a:real^2) = c:real^2-a:real^2` ASSUME_TAC THENL
[
ASM_MESON_TAC[ lemma1186];
ASM_MESON_TAC[ lemma1123]
]
]
);;
(* started 1.26.18; proved 1.28.18 after many struggles. *)
let NCarea = prove
( `!a:real^2 b:real^2 c:real^2. NC(a,b,c) ==> &0 < area(a,b,c)`,
REPEAT GEN_TAC THEN
ONCE_REWRITE_TAC[TAUT `(p ==> q) <=> (~q ==> ~p)`] THEN
REWRITE_TAC[REAL_NOT_LT] THEN
REWRITE_TAC[area;abs_pos; DOUBLE_NEG; NC] THEN
REWRITE_TAC[NOT_AND; B; DOUBLE_NEG] THEN
REWRITE_TAC[abszero;tarea;dsq;square] THEN
REAL_SIMP_TAC THEN
REWRITE_TAC[REAL_ARITH `!x:real. (abs(x) < &0) <=> F`] THEN
REWRITE_TAC[REAL_ABS_ZERO;crossequalszero] THEN
REWRITE_TAC[VECTOR_ARITH `!x:real^2 y :real^2. x-y = vec 0 <=> x = y`] THEN
ASM_CASES_TAC `a:real^2 = b:real^2` THEN ASM_SIMP_TAC[] (* use ASM_SIMP_TAC on both cases *) THEN
(* now ~ (a=b) *)
ASM_CASES_TAC `a:real^2 =c:real^2` THEN ASM_SIMP_TAC[] THEN
(* now ~ (a = c) *)
ASM_CASES_TAC `b:real^2 = c:real^2` THEN ASM_SIMP_TAC[] THEN
(* now ~ (b=c) *)
REWRITE_TAC[zero2;VECTOR_ARITH `!x:real^2 y :real^2. x-y = vec 0 <=> x = y`] THEN
ASM_SIMP_TAC[] THEN
REWRITE_TAC [LEFT_IMP_EXISTS_THM] THEN
GEN_TAC THEN
ASM_CASES_TAC `t:real = &0` THEN ASM_SIMP_TAC[] THEN
ASM_CASES_TAC `t:real = &1` THEN
ASM_SIMP_TAC[VECTOR_ARITH `!c:real^2 b:real^2 a:real^2. (c-b = &1 %(a-b)) <=> c=a`] THEN
(* now ~ (t = &1) *)
DISCH_TAC THEN (* Put c-b = t %(a-b) in the assumptions *)
ASM_CASES_TAC `&0 < t:real` THEN ASM_SIMP_TAC[] THENL
[ASM_CASES_TAC `t:real < &1` THEN ASM_SIMP_TAC[] THENL
[ (* 0 < t < 1 *)
DISJ2_TAC THEN DISJ1_TAC THEN (* picks out the second of three disjuncts *)
EXISTS_TAC `&1-t` THEN
(* Now the goal is c-a = (1-t) %(b-a) /\ 0 < (1-t) < 1 *)
(* We have c-b = t(a-b) so c-a = c-b + b-a = (1-t)(b-a) *)
ASM_SIMP_TAC[lemma1101;lemma1104]; (* finishes the case 0 < t < 1 *)
(* Now 0 < t and ~ (t < 1 *)
ASM_CASES_TAC `t:real = &1` THENL
[ ASM_SIMP_TAC[VECTOR_MUL_LID] THEN
UNDISCH_TAC `~(a:real^2=c:real^2)` THEN
UNDISCH_TAC `c:real^2-b:real^2 = t:real % (a:real^2-b:real^2)` THEN
ASM_SIMP_TAC[VECTOR_ARITH `c-b = &1 %(a-b) <=> a=c`]
; (* close the case t=1 and assume instead ~(t=1) *)
DISJ2_TAC THEN DISJ2_TAC THEN (* picks out the third disjunct *)
EXISTS_TAC `inv(t)` THEN
REWRITE_TAC [ VECTOR_ARITH `!a:real b:real x:real^2. a % b % x = (a*b) %x`] THEN
ASM_SIMP_TAC[REAL_FIELD `&0 < t ==> inv(t) * t = &1`] THEN
REWRITE_TAC[VECTOR_MUL_LID] THEN
ASM_SIMP_TAC[lemma1170]
] (* close the case ~(t=&1) *)
] (* close the case ~(t < 1) *)
; (* close the case split on t < 1 *)
(* Now ~ (0 < t); since also ~(t=0) in effect t < 0 *)
DISJ1_TAC THEN
EXISTS_TAC `inv(&1-t:real)` THEN
CONJ_TAC THENL
[ ASM_MESON_TAC[lemma1190]; (* proves `b - a = inv (&1 - t) % (c - a)`) *)
MATCH_MP_TAC lemma1170 THEN (* matches 0 < inv(&1-t) < 1 *)
(* Now the goal is `~(&1 - t = &0) /\ ~(&1 - t = &1) /\ ~(&1 - t < &1)` *)
ASM_MESON_TAC[REAL_ARITH `~(t = &1) ==> ~(t = &0) ==> ~(&0 < t)
==> ~(&1 - t = &0) /\ ~(&1 - t = &1) /\ ~(&1 - t < &1)`]
]
] (* close the case split on (0 < t) *)
);;
(* variant of lemma501 using triangle_congruence and ET *)
let lemma1273 = prove
( `!b:real^2 c:real^2 y:real^2 z:real^2.
b$2 = &0 /\ y$2 = &0 /\ b$1= y$1 /\ triangle_congruence(zero2,b,c,zero2,y,z) ==>
b$1 = &0 \/ ET(zero2,b,c,zero2,y,z)`,
REWRITE_TAC[triangle_congruence;ET] THEN
MESON_TAC[lemma501;zero2;NCarea]
);;
(* proved 1.28.18 *)
let lemma1282 = prove
( `!b:real^2 c:real^2 y:real^2 z:real^2.
b$2 = &0 /\ y$2 = &0 /\ triangle_congruence(zero2,b,c,zero2,y,z)
==> b$1 = y$1 \/ b$1 = -- (y$1)`,
REPEAT GEN_TAC THEN
REWRITE_TAC[triangle_congruence;TC;dsq;square;zero2] THEN
VEC2_TAC
);;
(* proved 1.28.18 *)
let lemma1292 = prove
( `!b:real^2 c:real^2 y:real^2 z:real^2.
b$2 = &0 /\ y$2 = &0 /\ triangle_congruence(zero2,b,c,zero2,y,z)
==> ~(b$1 = &0)`,
REPEAT GEN_TAC THEN
REWRITE_TAC[triangle_congruence;TC;dsq;square;zero2] THEN
VEC2_TAC THEN
REAL_SIMP_TAC THEN
REWRITE_TAC[NC] THEN
VEC2_TAC
);;
(* Now we can drop the clause b1 = 0 from lemma1273 *)
(* proved 1.28.18 *)
let lemma1306 = prove
( `!b:real^2 c:real^2 y:real^2 z:real^2.
b$2 = &0 /\ y$2 = &0 /\ b$1= y$1 /\ triangle_congruence(zero2,b,c,zero2,y,z) ==>
ET(zero2,b,c,zero2,y,z)`,
MESON_TAC[lemma1273;lemma1292]
);;
(* proved 1.29.18 *) (* And apparently not actually used! *)
let lemma1315 = prove
( `! Q:real^2^2 b:real^2 c:real^2 y:real^2 z:real^2 .
(b$2 = &0)/\ y$2 = &0 /\ b$1 = --(y$1) /\ TC(zero2,y,z,zero2,b,c)
/\ Q = vector[vector[ --(&1);&0];vector[&0; --(&1)]]
/\ ~(b$1 = &0)
==> Q ** zero2 = zero2
/\ (Q**b)$2 = &0
/\ rotation_matrix(Q)
/\ TC(zero2,y,z,zero2,b,c)
/\ TC(zero2,b,c,zero2,Q**b,Q**c)
/\ TC(zero2,y,z,zero2,Q**b,Q**c)
/\ TC(zero2,Q**b, Q**c,zero2,y,z)`,
REPEAT STRIP_TAC THENL
(* Now we have 7 goals corresponding to the conjuncts *)
[ REWRITE_TAC[veczero]; (* knocks off Q **zero2 = zero2 *)
(* Now the goal is (Q **b) $2 = &0 *)
REWRITE_TAC[MATRIXTWO_MUL_COMPONENT] THEN
ASM_SIMP_TAC[] THEN
REAL_SIMP_TAC THEN
SIMP_TAC[VECTOR_2; REAL_MUL_RZERO; REAL_NEG_0]; (* finishes goal number 2 *)
(* Now the goal is rotation_matrix(Q) *)
ASM_SIMP_TAC[rotation_matrix] THEN
SIMP_TAC[VECTOR_2;REAL_NEG_0;det] THEN
REAL_SIMP_TAC; (* polishes off rotation_matrix(Q) *)
ASM_SIMP_TAC[]; (* polishes off TC(zero2,y,z,zero2,b,c) *)
(* Now the goal is TC(zero2,b,c,zero2,Q**b, Q**c) *)
(* We could get this from rotation_congruence but here we just do it directly. *)
REWRITE_TAC[TC; dsq; square] THEN
REWRITE_TAC[MATRIXTWO_MUL_COMPONENT] THEN
ASM_SIMP_TAC[zero2_components] THEN
REAL_SIMP_TAC THEN
SIMP_TAC[VECTOR_2; REAL_MUL_RZERO; REAL_NEG_0] THEN
REAL_SIMP_TAC THEN
REWRITE_TAC[zero2_components] THEN
STRIP_TAC THEN REAL_SIMP_TAC; (* finishes TC(zero2,b,c,zero2,Q**b, Q**c) *)
(* Now the goal is TC(zero2,y,z,zero2,Q**b,Q**c). *)
(* We need to use the previous conjunct, just proved, but the only way
I know to do that is to prove it again using SUBGOAL_THEN *)
SUBGOAL_THEN `TC(zero2,b:real^2,c:real^2,zero2,Q:real^2^2**b:real^2, Q:real^2^2**c:real^2)`
ASSUME_TAC THENL
[ REWRITE_TAC[TC; dsq; square] THEN
REWRITE_TAC[MATRIXTWO_MUL_COMPONENT] THEN
ASM_SIMP_TAC[zero2_components] THEN
REAL_SIMP_TAC THEN
SIMP_TAC[VECTOR_2; REAL_MUL_RZERO; REAL_NEG_0] THEN
REAL_SIMP_TAC THEN
REWRITE_TAC[zero2_components] THEN
STRIP_TAC THEN REAL_SIMP_TAC; (* finishes TC(zero2,b,c,zero2,Q**b, Q**c) *)
(* now returning to TC(zero2,y,z,zero2,Q**b,Q**c) *)
ASM_MESON_TAC[veczero;congruence_transitive]
];
(* Last goal: TC(zero2, Q**b, Q**c, zero2,y,z) *)
(* Now I have to repeat the proof above for a third time. *)
SUBGOAL_THEN `TC(zero2,b:real^2,c:real^2,zero2,Q:real^2^2**b:real^2, Q:real^2^2**c:real^2)`
ASSUME_TAC THENL
[ REWRITE_TAC[TC; dsq; square] THEN
REWRITE_TAC[MATRIXTWO_MUL_COMPONENT] THEN
ASM_SIMP_TAC[zero2_components] THEN
REAL_SIMP_TAC THEN
SIMP_TAC[VECTOR_2; REAL_MUL_RZERO; REAL_NEG_0] THEN
REAL_SIMP_TAC THEN
REWRITE_TAC[zero2_components] THEN
STRIP_TAC THEN REAL_SIMP_TAC; (* finishes TC(zero2,b,c,zero2,Q**b, Q**c) *)
(* now returning to TC(zero2,y,z,zero2,Q**b,Q**c) *)
ASM_MESON_TAC[veczero;congruence_transitive;congruence_symmetric]
]
]
);;
let VECTOR_MUL_EQ = prove( `!R:real^2^2 x:real^2 y:real^2. x = y ==> R ** x = R ** y`, MESON_TAC[]);;
(* proved 1.30.18 *)
let rotation_injective = prove
( `!Q:real^2^2 x:real^2 y:real^2. ~(det(Q)= &0) /\ Q**x = Q**y ==> x = y`,
REPEAT STRIP_TAC THEN
ABBREV_TAC `M:real^2^2 = vector[vector[Q:real^2^2 $2$2; --(Q$1$2)] ; vector[--(Q:real^2^2 $2$1);Q$1$1]]` THEN
SUBGOAL_THEN `M:real^2^2 **(Q:real^2^2 **x:real^2) = M:real^2^2 **(Q:real^2^2 **y:real^2)` ASSUME_TAC THENL
[ MATCH_MP_TAC VECTOR_MUL_EQ THEN
ASM_MESON_TAC[];
UNDISCH_TAC `M:real^2^2 ** Q:real^2^2 ** x:real^2 = M:real^2^2 ** Q:real^2^2 ** y:real^2` THEN
EXPAND_TAC "M" THEN
VEC2_TAC THEN REWRITE_TAC[MATRIXTWO_MUL_COMPONENT] THEN
SIMP_TAC[VECTOR_2; REAL_MUL_RZERO; REAL_NEG_0] THEN
REAL_SIMP_TAC THEN
UNDISCH_TAC `~(det(Q:real^2^2) = &0)` THEN
REWRITE_TAC[det] THEN
CONV_TAC REAL_RING
]
);;
(* proved 1.30.18 *)
let lemma1406 = prove
( `!Q:real^2^2 x:real^2 z:real^2 t:real.t % (Q **z - Q**x) = Q ** (t%(z-x))`,
REPEAT GEN_TAC THEN
REWRITE_TAC [VECTOR_ARITH `t % (x-y) = t % x - t % y`] THEN
REWRITE_TAC [MATRIX_VECTOR_MUL_RMUL] THEN
REWRITE_TAC[ GSYM MATRIX_VECTOR_MUL_RMUL] THEN
REWRITE_TAC[MATRIX_VECTOR_MUL_SUB_LDISTRIB]
);;
(* proved 1.30.18 *)
let lemma1416 = prove
( `!t:real Q:real^2^2 x:real^2. t % (Q ** x) = Q ** (t% x)`,
REPEAT GEN_TAC THEN
VEC2_TAC THEN
REWRITE_TAC[MATRIX_VECTOR_MUL_RMUL]
);;
(* proved 1.30.18 and again 2.12.18 after correcting definition of B *)
let rotation_preserves_betweenness = prove
( `!Q:real^2^2 x:real^2 y:real^2 z:real^2. ~(det(Q)= &0) ==> (B(x,y,z) <=> B(Q**x, Q**y, Q**z))`,
REPEAT GEN_TAC THEN STRIP_TAC THEN
REWRITE_TAC[B] THEN
EQ_TAC THENL
[ ASM_CASES_TAC `x:real^2 = z:real^2` THEN
ASM_SIMP_TAC[] THEN
ASM_REWRITE_TAC[] THEN
REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
REPEAT STRIP_TAC THEN
EXISTS_TAC `t:real` THEN
ASM_SIMP_TAC[] THEN
REWRITE_TAC[lemma1406] THEN
UNDISCH_TAC `y:real^2 - x:real^2 = t:real % (z:real^2 - x:real^2)` THEN
REWRITE_TAC [GSYM MATRIX_VECTOR_MUL_SUB_LDISTRIB] THEN
DISCH_TAC THEN
ASM_REWRITE_TAC[] THEN
ASM_MESON_TAC[rotation_injective]
;
REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
REPEAT STRIP_TAC THEN
ASM_CASES_TAC `x:real^2 = z:real^2` THENL
[ ASM_REWRITE_TAC[] THEN
ASM_MESON_TAC[rotation_injective]
;
ASM_SIMP_TAC[] THEN
EXISTS_TAC `t:real` THEN
ASM_REWRITE_TAC[] THEN
ASM_SIMP_TAC[] THEN
UNDISCH_TAC `Q:real^2^2 **y:real^2 - Q:real^2^2 ** x:real^2 =
t:real % (Q:real^2^2 ** z:real^2 - Q:real^2^2 ** x:real^2)` THEN
REWRITE_TAC[lemma1406] THEN
REWRITE_TAC[GSYM MATRIX_VECTOR_MUL_SUB_LDISTRIB] THEN
ASM_MESON_TAC[MATRIX_VECTOR_MUL_SUB_LDISTRIB;rotation_injective]
]
]
);;
(* proved 1.30.18 *)
let rotation_NC = prove
( ` ! Q:real^2^2 a:real^2 b:real^2 c:real^2. NC(a,b,c) /\ rotation_matrix(Q) ==> NC(Q**a, Q**b, Q**c)`,
REPEAT GEN_TAC THEN
REWRITE_TAC[NC; rotation_matrix] THEN
DISCH_TAC THEN
ASM_MESON_TAC[rotation_preserves_betweenness; rotation_injective; REAL_ARITH `~(&1 = &0)`]
);;
(* I define a new theorem-tactic *)
(* If you've already proved t = |-p=>q, and p' is an instance of p, and you have the goal (... p' ? s),
then
VE_BY[t] is a tactic that reduces the goal to (...p',q' ? s), where q' is an instance of q, by
the same substitution that produces p' from p. *)
(* original code: let (WE_HAVE_BY: thm_tactic) =
fun th -> FIRST_ASSUM (fun asm -> ASSUME_TAC (MATCH_MP th asm));;
*)
(* Shorter version by Freek: *)
let WE_HAVE_BY th = FIRST_ASSUM (STRIP_ASSUME_TAC o MATCH_MP th);;
(* similar function in case th has a conjunction of two propositions for its antecedent *)
let WE_HAVE_BY2 th = FIRST_ASSUM (fun asm1 -> FIRST_ASSUM (STRIP_ASSUME_TAC o (MATCH_MP th) o (CONJ asm1)));;
(* and we also need three conjuncts in the antecedent *)
let WE_HAVE_BY3 th = FIRST_ASSUM (fun asm1 -> FIRST_ASSUM (fun asml2 ->
FIRST_ASSUM(STRIP_ASSUME_TAC o (MATCH_MP th) o (CONJ asm1 o CONJ asml2))));;
let WE_HAVE_BY3_NOMATCHING th = FIRST_ASSUM (fun asm1 -> FIRST_ASSUM (fun asml2 ->
FIRST_ASSUM(STRIP_ASSUME_TAC o (MP th) o (CONJ asm1 o CONJ asml2))));;
let WE_HAVE_BY4 th = FIRST_ASSUM (fun asm1 -> FIRST_ASSUM (fun asml2 -> FIRST_ASSUM (fun asml3 ->
FIRST_ASSUM(STRIP_ASSUME_TAC o (MATCH_MP th) o (CONJ asm1 o CONJ asml2 o CONJ asml3)))));;
let WE_HAVE_BY4_NOMATCHING th = FIRST_ASSUM (fun asm1 -> FIRST_ASSUM (fun asml2 -> FIRST_ASSUM (fun asml3 ->
FIRST_ASSUM(STRIP_ASSUME_TAC o (MP th) o (CONJ asm1 o CONJ asml2 o CONJ asml3)))));;
let WE_HAVE_BY_NOMATCHING th = FIRST_ASSUM (STRIP_ASSUME_TAC o MP th);;
let WE_HAVE_BY2_NOMATCHING th = FIRST_ASSUM (fun asm1 -> FIRST_ASSUM (STRIP_ASSUME_TAC o (MP th) o (CONJ asm1)));;
(* coded by Freek 2.15.18 *)
let (NTH_ASSUM: int -> thm_tactic -> tactic) =
fun n ttac (asl,w as g) -> ttac (snd (el (length asl - n - 1) asl)) g;;
let WE_HAVE_BY_N n th = NTH_ASSUM n (STRIP_ASSUME_TAC o MATCH_MP th);;
(* The following example demonstrates WE_HAVE_BY:
let test = REAL_ARITH `(&1 + &1) = &2 ==> &2 + &2 = &4`;;
let test2 = `(&1 + &1) = &2 ==> &4 = &7`;;
let test3 = REAL_ARITH `&1 + &1 = &2 /\ &2 + &2 = &4 ==> &5 + &3= &8`;;
# g test2;;
# e (DISCH_TAC);;
# e (WE_HAVE_BY test);;
e (WE_HAVE_BY2 test3);;
val it : goalstack = 1 subgoal (1 total)
`&1 + &1 = &2 ==> &4 = &7`
val it : goalstack = 1 subgoal (1 total)
0 [`&1 + &1 = &2`]
`&4 = &7`
val it : goalstack = 1 subgoal (1 total)
0 [`&1 + &1 = &2`]
1 [`&2 + &2 = &4`]
`&4 = &7`
e (WE_HAVE_BY2 test3);;
*)
let triangle_congruence_implies_TC = prove
( `!a:real^2 b:real^2 c:real^2 x:real^2 y:real^2 z:real^2. triangle_congruence(a,b,c,x,y,z) ==> TC(a,b,c,x,y,z)`,
REPEAT GEN_TAC THEN
REWRITE_TAC[triangle_congruence] THEN
MESON_TAC[]
);;
let triangle_congruence_implies_NC = prove
( `!a:real^2 b:real^2 c:real^2 x:real^2 y:real^2 z:real^2. triangle_congruence(a,b,c,x,y,z) ==> NC(a,b,c)`,
REPEAT GEN_TAC THEN
REWRITE_TAC[triangle_congruence] THEN
MESON_TAC[]
);;
let TC_to_congruence = prove
( `!a:real^2 b:real^2 c:real^2 x:real^2 y:real^2 z:real^2.
TC(a,b,c,x,y,z) ==> NC(a,b,c) ==> triangle_congruence(a,b,c,x,y,z)`,
MESON_TAC[triangle_congruence]
);;
let get_triangle_congruence = prove
( `!a:real^2 b:real^2 c:real^2 x:real^2 y:real^2 z:real^2.
TC(a,b,c,x,y,z) /\ NC(a,b,c) ==> triangle_congruence(a,b,c,x,y,z)`,
MESON_TAC[triangle_congruence]
);;
let eqzero2 = prove
( `!x:real^2. x = zero2 <=> x$1 = &0 /\ x$2 = &0`,
GEN_TAC THEN EQ_TAC THEN
REWRITE_TAC[zero2; MATRIXTWO_MUL_COMPONENT] THEN
VEC2_TAC;
);;
let notNC = prove
( `!a:real^2 c:real^2. ~ NC(a,a,c)`,
REPEAT GEN_TAC THEN
REWRITE_TAC[NC]
);;
let rotation_fixes_origin = prove
( `!Q:real^2^2. Q**zero2 = zero2`,
REWRITE_TAC[eqzero2; zero2; MATRIXTWO_MUL_COMPONENT] THEN
VEC2_TAC
);;
(* proved 1.31.18 *)
let lemma1541 = prove
(`! Q11:real Q22:real Q12:real Q21:real x1:real x2:real y1:real y2:real.
Q22 * Q11 - Q21 * Q12 = &1 /\ Q21 = --(Q12) /\ Q11 = Q22
==> x1 * y2 - x2 * y1 =
x2 * y1 * Q21 * Q12 +
x1 * y2 * Q22 * Q11 +
x1 * y1 * Q21 * Q11 -
x2 * y1 * Q22 * Q11 -
(x1 * y2 * Q21 * Q12 + x1 * y1 * Q21 * Q11)`,
REPEAT STRIP_TAC THEN
ASM_SIMP_TAC[] THEN
UNDISCH_TAC `Q22*Q11-Q21*Q12 = &1` THEN
ASM_SIMP_TAC[] THEN
REAL_SIMP_TAC THEN
CONV_TAC REAL_RING
);;
(* proved 1.31.18 *)
let rotation_cross = prove
( `!Q:real^2^2 x:real^2 y:real^2. rotation_matrix(Q) ==> x cross2 y = (Q**x) cross2 (Q**y)`,
REPEAT GEN_TAC THEN
REWRITE_TAC[cross2; MATRIXTWO_MUL_COMPONENT; rotation_matrix; det] THEN
REAL_SIMP_TAC THEN
ASM_MESON_TAC[lemma1541]
);;
(* proved 1.31.18 *)
let rotation_preserves_area = prove
(`!a:real^2 b:real^2 c:real^2 Q:real^2^2.
rotation_matrix(Q) ==> tarea(a,b,c) = tarea(Q**a, Q**b, Q**c)`,
REPEAT GEN_TAC THEN
REWRITE_TAC[tarea] THEN
ONCE_REWRITE_TAC [GSYM MATRIX_VECTOR_MUL_SUB_LDISTRIB] THEN
ONCE_ASM_SIMP_TAC[GSYM rotation_cross] THEN
MESON_TAC[]
);;
(* proved 1.31.18 *)
let rotation_ET = prove
(`!Q:real^2^2 a:real^2 b:real^2 c:real^2.
NC(a,b,c) /\ rotation_matrix(Q) ==> ET(a,b,c,Q**a, Q**b, Q**c)`,
REPEAT GEN_TAC THEN
REWRITE_TAC[ET; area] THEN
REPEAT STRIP_TAC THENL
[ ASM_MESON_TAC[rotation_preserves_area];
(* Now the goal is &0 < abs (tarea(a,b,c)) *)
ONCE_REWRITE_TAC[GSYM area] THEN
ASM_MESON_TAC[NCarea];
]
);;
(* proved 2.14.18 *)
let rotation_ET_converse = prove
(`!Q:real^2^2 b:real^2 c:real^2 y:real^2 z:real^2.
ET(zero2,y,z,zero2,Q**b,Q**c) /\ NC(zero2,y,z) /\ rotation_matrix(Q) ==> ET(zero2,y,z,zero2,b,c)`,
REPEAT GEN_TAC THEN
REWRITE_TAC[ET] THEN
REPEAT STRIP_TAC THEN
SUBGOAL_THEN `area(zero2,b:real^2,c:real^2) = area(zero2,Q:real^2^2**b:real^2,Q:real^2^2**c:real^2)`
ASSUME_TAC THENL
[ ASM_MESON_TAC[veczero;det_area;rotation_matrix]
;
ASM_MESON_TAC[]
;
ASM_MESON_TAC[veczero;det_area;rotation_matrix]
;
ASM_REWRITE_TAC[]
]
);;
(* proved 1.31.18 *)
let ET_transitive = prove
( `!a:real^2 b:real^2 c:real^2 x:real^2 y:real^2 z:real^2 p:real^2 q:real^2 r:real^2.
ET(a,b,c,x,y,z) /\ ET(x,y,z,p,q,r) ==> ET(a,b,c,p,q,r)`,
REPEAT GEN_TAC THEN
REWRITE_TAC[ET] THEN
MESON_TAC[]
);;
(* proved 2.1.18 *)
let ET_symmetric = prove
( `!a:real^2 b:real^2 c:real^2 x:real^2 y:real^2 z:real^2.
ET(a,b,c,x,y,z) ==> ET(x,y,z,a,b,c)`,
REPEAT GEN_TAC THEN
REWRITE_TAC[ET] THEN
MESON_TAC[]
);;
(* Next we need to remove the hypothesis b1 = y1 in lemma1215. We use lemma1282 to show
that b1 must be --y1; then we rotate 180 degrees by Q, which is done by minus the identity
matrix. Then (Qb) $1 = y$1, and triangle_congruence(zero2, Q**b, Q**c, zero2, y,z),
which implies ET(zero2,Q**b,Q**z,zero2,y,z), which implies ET(zero2,b,c,y,z) *)
(* Outlined 1.29.18. Proved 1.31.18 *)
let congruence_implies_ET_00 = prove
( `!b:real^2 c:real^2 y:real^2 z:real^2.
b$2 = &0 /\ y$2 = &0 /\ triangle_congruence(zero2,b,c,zero2,y,z) ==>
ET(zero2,b,c,zero2,y,z)`,
REPEAT STRIP_TAC THEN
ASM_CASES_TAC `b:real^2 $1 = y:real^2 $1` THENL
[ ASM_MESON_TAC[lemma1306]; (* finishes the case b1 = y1 *)
SUBGOAL_THEN `b:real^2 $1 = -- (y:real^2 $1)` ASSUME_TAC THENL
[ ASM_MESON_TAC[lemma1282];
(* so now we have b1 = --y1 in the assumptions list, and goal ET (zero2,b,c,zero2,y,z) *)
(* Now define the required rotation matrix Q *)
ABBREV_TAC `Q:real^2^2 = vector[vector [--(&1); &0]; vector [&0; --(&1)]]` THEN
SUBGOAL_THEN `(Q:real^2^2 ** b) $1 = y:real^2 $1` ASSUME_TAC THENL
(* we have b1 = --y1 in the assumptions and goal (Q**b)$1 = y $1 *)
[ REWRITE_TAC[MATRIXTWO_MUL_COMPONENT] THEN
ASM_SIMP_TAC[] THEN
REAL_SIMP_TAC THEN
EXPAND_TAC "Q" THEN
VEC2_TAC THEN
REAL_SIMP_TAC
; (* That puts (Q**b) $1 = y$1 on the assumptions list *)
WE_HAVE_BY triangle_congruence_implies_TC THEN (* adds TC(zero2,b,c,zero2,y,z) *)
WE_HAVE_BY triangle_congruence_implies_NC THEN (* adds NC(zero2,b,c) *)
WE_HAVE_BY congruence_symmetric THEN (* adds TC(zero2,y,z,zero2,b,c) *)
(* Now the goal is ET(zero2,b,c,zero2,y,z) and we have Q**b $1 = y$1 *)
SUBGOAL_THEN `rotation_matrix(Q:real^2^2)` ASSUME_TAC THENL
[ REWRITE_TAC[rotation_matrix;det] THEN
REWRITE_TAC[MATRIXTWO_MUL_COMPONENT] THEN
ASM_SIMP_TAC[] THEN
REAL_SIMP_TAC THEN
EXPAND_TAC "Q" THEN
VEC2_TAC THEN
REAL_SIMP_TAC
; (* That puts rotation_matrix(Q) on the assumptions list *)
WE_HAVE_BY rotation_congruence_zero THEN (* adds ! a b c . TC(zero2,b,c,zero2, Q**b, Q**c *)
ASM_CASES_TAC `b:real^2 $1 = &0` THENL
[ (* since b2 = 0 that means b = zero2, contradicting NC(zero2,b,c) *)
ASM_MESON_TAC[eqzero2;notNC]
; (* now ~(b$1 = &0) is on the assumption list *)
SUBGOAL_THEN `triangle_congruence(zero2,
Q:real^2^2 ** b:real^2, Q:real^2^2 **c:real^2,zero2,y:real^2,z:real^2)` ASSUME_TAC THENL
[ REWRITE_TAC[triangle_congruence] THEN
CONJ_TAC THENL
[ ONCE_REWRITE_TAC [GSYM rotation_fixes_origin] THEN
REWRITE_TAC[veczero] THEN
ASM_MESON_TAC[congruence_symmetric;congruence_transitive]
;
(* Now the goal is NC(zero2, Q**b, Q**c) *)
ASM_MESON_TAC[veczero;rotation_NC]
]
; (* Now the goal is ET( zero2,b,c,zero2,y,z) again *)
SUBGOAL_THEN `(Q:real^2^2 ** b:real^2) $2 = &0` ASSUME_TAC THENL
[ REWRITE_TAC[MATRIXTWO_MUL_COMPONENT] THEN
ASM_SIMP_TAC[] THEN
REAL_SIMP_TAC THEN
EXPAND_TAC "Q" THEN
VEC2_TAC THEN
REAL_SIMP_TAC
; (* Now the goal is ET(zero2,b,c,zero2,y,z) *)
SUBGOAL_THEN `ET(zero2, Q:real^2^2 ** b:real^2,
Q:real^2^2 **c:real^2,zero2,y:real^2,z:real^2)` ASSUME_TAC THENL
[ ASM_MESON_TAC[
SPECL [`Q:real^2^2 ** b:real^2`; `Q:real^2^2 **c:real^2`;
`y:real^2`; `z:real^2`] lemma1306
]
;
(* Now the goal is ET (zero2,b,c,zero2,y,z) again
but now we have ET (zero2,Q ** b,Q ** c,zero2,y,z) in the assumptions *)
ASM_MESON_TAC[rotation_ET; veczero; ET_transitive]
]
]
]
]
]
]
]
]
);;
(* proved 2.2.18 *)
let rotate_to_zero = prove
( `!Q:real^2^2 y:real^2. ~(y$2 = &0) /\
Q:real^2^2 = vector[ vector [y$1/ (sqrt(y$1 * y$1 + y$2*y$2)) ;
(y$2)/(sqrt(y$1 * y$1 + y$2*y$2))]
;
vector [--(y$2)/ (sqrt(y$1 * y$1 + y$2*y$2));
y$1/ (sqrt(y$1 * y$1 + y$2*y$2))]]
==> rotation_matrix(Q:real^2^2) /\ (Q:real^2^2 ** y) $2 = &0 /\ (Q:real^2^2 ** y) $1 = sqrt(y$1*y$1 + y$2*y$2)`,
REPEAT GEN_TAC THEN
REWRITE_TAC[rotation_matrix; det] THEN
REWRITE_TAC[MATRIXTWO_MUL_COMPONENT] THEN
VEC2_TAC THEN
REAL_SIMP_TAC THEN
REWRITE_TAC [common_denom_product_minus; common_denom_product_plus] THEN
STRIP_TAC THEN
WE_HAVE_BY (SPECL[`y:real^2 $2`; `y:real^2 $1`] sum_of_squares_nonzero) THEN
SUBGOAL_THEN ` &0 <= y:real^2 $2 * y:real^2 $ 2 + y:real^2 $1 * y:real^2 $1` ASSUME_TAC THENL
[ (CONV_TAC REAL_SOS);
ASM_SIMP_TAC[REAL_DIV_SQRT] THEN
REWRITE_TAC[common_denom] THEN
REAL_SIMP_TAC THEN
REWRITE_TAC[ REAL_FIELD `(x*x/u + z*z/u)/u = (x*x+z*z)/ (u*u)`] THEN
ASM_SIMP_TAC[lemma688;REAL_DIV_REFL] THEN
REWRITE_TAC[REAL_FIELD ` a*b/c = b*a/c`]
]
);;
(* just like rotate_to_zero but with the first equation in reversed order *)
let rotate_to_zero2 = prove
( `!Q:real^2^2 y:real^2. ~(y$2 = &0) /\
vector[ vector [y$1/ (sqrt(y$1 * y$1 + y$2*y$2)) ;
(y$2)/(sqrt(y$1 * y$1 + y$2*y$2))]
;
vector [--(y$2)/ (sqrt(y$1 * y$1 + y$2*y$2));
y$1/ (sqrt(y$1 * y$1 + y$2*y$2))]]
= Q
==> rotation_matrix(Q:real^2^2) /\ (Q:real^2^2 ** y) $2 = &0 /\ (Q:real^2^2 ** y) $1 = sqrt(y$1*y$1 + y$2*y$2)`,
MESON_TAC[rotate_to_zero]
);;
(* proved 2.4.18 *)
let X_MINUS_ZERO2 = prove
( `!x:real^2. x - zero2 = x`,
GEN_TAC THEN
REWRITE_TAC[zero2] THEN
VEC2_TAC THEN
REWRITE_TAC[VECTOR_SUB_COMPONENT]
THEN VEC2_TAC
);;
(* proved 2.4.18 *)
let ZERO2_MINUS_X = prove
( `!x:real^2. zero2-x = --x`,
GEN_TAC THEN
REWRITE_TAC[zero2] THEN
VEC2_TAC THEN
REWRITE_TAC[VECTOR_SUB_COMPONENT;VECTOR_NEG_COMPONENT]
THEN VEC2_TAC
);;
(* proved 2.4.18 *)
let X_PLUS_ZERO2 = prove
( `!x:real^2. x + zero2 = x`,
GEN_TAC THEN
REWRITE_TAC[zero2] THEN
VEC2_TAC THEN
REWRITE_TAC[VECTOR_ADD_COMPONENT]
THEN VEC2_TAC
);;
(* proved 2.4.18 *)
let VEC2_COMPONENTS = prove
( `!x:real^2 y:real^2. x = y <=> x$1 = y$1 /\ x$2 = y$2`,
GEN_TAC THEN
REWRITE_TAC[zero2] THEN
VEC2_TAC
);;
let lemma1793 = REAL_SOS `&0 = b1 /\ &0 = b2 /\ y2*y2 + y1*y1 = b2*b2 + b1*b1 ==> y1 = &0 /\ y2 = &0`;;
(* This tactic adds `right=left` to the assumption list if `left = right` is already there. *)
let REVERSE_EQ_TAC left right =
WE_HAVE_BY (MATCH_MP (TAUT `(p <=>q) ==> (p ==>q)`) (ISPECL [left;right] EQ_SYM_EQ));;
(* proved 2.5.18 *)
let lemma1806 = REAL_RING `z1 * z1 +
z2 * z2 +
y1 * y1 - y1 * z1 - y1 * z1 +
y2 * y2 - y2 * z2 - y2 * z2 =
(z1-y1)*(z1-y1) + (z2-y2)*(z2-y2)`;;
(* proved 2.5.18 *)
let lemma1813 = prove
( `(z1-y1)*(z1-y1) + (z2-y2)*(z2-y2) = &0 ==> z1 = y1 /\ z2 = y2`,
MESON_TAC[lemma_sos; lemma_sos_pos; REAL_SOS `&0 < x ==> ~(&0=x)`; REAL_RING `x = y <=> x-y = &0`]
);;
(* proved 2.6.18 *)
let NORM_TRIANGLE_EQ_SUB = prove
( `!y z:real^N. norm(z) = norm(y) + norm(z-y) <=> norm(y) % (z-y) = norm(z-y) % y`,
MESON_TAC[NORM_TRIANGLE_EQ; VECTOR_SUB_ADD2]
);;
(* proved 2.6.18 *)
let NORM_TRIANGLE_EQ_SUB2 = prove
( `!y:real^N z:real^N. norm(y) + norm(z-y) = norm(z) <=> norm(y) % (z-y) = norm(z-y) % y`,
MESON_TAC[NORM_TRIANGLE_EQ; VECTOR_SUB_ADD2]
);;
let temp1357 = ISPECL [`(y:real^2) - (x:real^2)`; `(z:real^2) - (y:real^2)`] NORM_TRIANGLE_EQ_SUB2 ;;
let temp1358 = VECTOR_ARITH `!z:real^2 y:real^2 x:real^2 . z-y = z-x-(y-x)`;;
let temp1360 = NORM_ARITH `!x:real^2 y:real^2 z:real^2.
norm (y - x) + norm (z - y) =
norm (y - x) + norm ((z-x) - (y-x))`;;
(* proved 2.11.18 *)
let NORM_TRIANGLE_EQ_SUB3 = prove
( `!x:real^2 y:real^2 z:real^2.
norm(y-x) + norm(z-y) = norm(z-x) <=> norm(y-x) %(z-y) = norm(z-y) % (y-x)`,
REPEAT GEN_TAC THEN
REWRITE_TAC[temp1360] THEN
REWRITE_TAC[ ISPECL [`(y:real^2) - (x:real^2)`; `(z:real^2) - (x:real^2)`] NORM_TRIANGLE_EQ_SUB2 ] THEN
REWRITE_TAC[GSYM temp1358]
);;
let NORM_TRIANGLE_EQ_SUB4 = prove
( `!x:real^2 y:real^2 z:real^2.
norm(y-x) + norm(z-y) = norm(z-x) <=> norm(x-y) %(z-y) = norm(z-y) % (y-x)`,
MESON_TAC[NORM_TRIANGLE_EQ_SUB3;NORM_ARITH `norm(x:real^2-y:real^2) = norm(y:real^2-x:real^2)`]
);;
let NORM_TRIANGLE_EQ_SUB5 = prove
( `!x:real^2 y:real^2 z:real^2.
norm(y-x) + norm(z-y) = norm(z-x) ==> norm(x-y) %(z-y) = norm(z-y) % (y-x)`,
MESON_TAC[NORM_TRIANGLE_EQ_SUB3;NORM_ARITH `norm(x:real^2-y:real^2) = norm(y:real^2-x:real^2)`]
);;
(* proved 2.8.18 *)
let VECTOR_EQ_MUL = prove
( `!q:real p:real z:real^2 y:real^2.
(~(q = &0)) ==> ((p/q) % z = y <=> p % z = q % y) `,
REPEAT STRIP_TAC THEN EQ_TAC THEN (* same proof both directions, so THEN instead of THENL *)
DISCH_TAC THEN
ASM_MESON_TAC[ VECTOR_MUL_LCANCEL;
VECTOR_ARITH `!a:real b:real x:real^2. a % b % x = (a*b) % x`;
REAL_FIELD `!q:real p:real. (~(q = &0)) ==> q * (p/q) = p`
]
);;
(* proved 2.8.18 *)
let lemma1370 = prove
( `!y:real^2 z:real^2.
norm(y) + norm(z-y) = norm(z) ==>
?t. ( t % z = y)`,
REPEAT STRIP_TAC THEN
WE_HAVE_BY (MATCH_MP EQ_IMP (SPEC_ALL NORM_TRIANGLE_EQ_SUB2)) THEN (* norm y % (z-y) = norm(z-y) % y *)
ASM_CASES_TAC `norm(z:real^2)= &0` THENL
[ EXISTS_TAC `&0` THEN
REWRITE_TAC[ VECTOR_ARITH `&0 % z:real^2 = (vec 0):real^2`;
NORM_ARITH `norm( (vec 0):real^2) = &0`;
REAL_ADD_LID;
NORM_ARITH `norm((vec 0):real^2 - y:real^2) = norm(y:real^2)`;
NORM_ARITH `norm(y:real^2) + norm(y:real^2) = &0 <=> norm(y:real^2) = &0`;
NORM_ARITH `norm(z:real^2) = &0 <=> z:real^2 = (vec 0):real^2`
] THEN
WE_HAVE_BY (NORM_ARITH `norm(z:real^2) = &0 ==> z:real^2 = (vec 0):real^2`) THEN (* z = vec 0 *)
UNDISCH_TAC `norm(y:real^2) + norm(z:real^2 - y:real^2) = norm(z:real^2)` THEN
ASM_REWRITE_TAC[NORM_ARITH `norm((vec 0):real^2 - y:real^2) = norm(y:real^2)`] THEN
REWRITE_TAC[ NORM_ARITH `norm(y:real^2) + norm(y:real^2) = &0 <=> (vec 0):real^2 = y`]
; (* That finishes the case norm(z) = &0 *)
EXISTS_TAC `norm(y:real^2) / norm(z:real^2)` THEN
ASM_SIMP_TAC [SPECL [` norm(z:real^2)`; `norm(y:real^2)`; `z:real^2`; `y:real^2`] VECTOR_EQ_MUL] THEN
ASSUME_TAC VECTOR_SUB_LDISTRIB THEN
UNDISCH_TAC `norm (y:real^2) % (z:real^2 - y:real^2) = norm (z:real^2 - y:real^2) % y:real^2` THEN
ASM_REWRITE_TAC[] (* |y| z - |y|y = |z-y| y *) THEN
DISCH_TAC THEN
WE_HAVE_BY (VECTOR_ARITH `((x:real^2) - (y:real^2) = (z:real^2)) ==> ((x:real^2) = (z:real^2 )+ (y:real^2))`) THEN
(* |y| z = |z-y| y + |y| y *)
UNDISCH_TAC `norm (y:real^2) % (z:real^2) = norm (z:real^2 - y:real^2) % (y:real^2) + norm (y:real^2) % (y:real^2)` THEN
ASM_SIMP_TAC[GSYM VECTOR_ADD_RDISTRIB] THEN
ASM_MESON_TAC[REAL_ADD_SYM]
]
);;
let temp1434 = prove
( `!t:real x:real^2 z:real^2. &0 < t /\ t % (z-x) = vec(0):real^2 ==> x = z`,
REPEAT GEN_TAC THEN STRIP_TAC THEN
WE_HAVE_BY REAL_LT_IMP_NZ THEN
ASM_MESON_TAC[VECTOR_MUL_EQ_0; VECTOR_ARITH `x:real^2 = z:real^2 <=> (z:real^2 - x:real^2) = vec(0):real^2`]
);;
(* proved 2.13.18 *)
let lemma1453 = prove
( `!u:real^2 v:real^2 c:real d:real . ~ (d = &0) ==> (u = c/d %v <=> d % u = c % v)`,
REPEAT GEN_TAC THEN DISCH_TAC THEN EQ_TAC THENL
[ STRIP_TAC THEN
WE_HAVE_BY (SPEC `d:real` SCALAR_MUL_EQN) THEN
(* puts d % u = d % c / d % v in assumptions *)
UNDISCH_TAC `d:real % u:real^2 = d:real % c:real / d:real % v:real^2` THEN
REWRITE_TAC [VECTOR_MUL_ASSOC] THEN
(* `d % u = (d * c / d) % v ==> d % u = c % v` *)
ASM_SIMP_TAC [REAL_DIV_LMUL]
;
DISCH_TAC THEN
WE_HAVE_BY (SPEC `&1/d:real` SCALAR_MUL_EQN) THEN
UNDISCH_TAC `&1 / d:real % d:real % u:real^2 = &1 / d:real % c:real % v:real^2` THEN
REWRITE_TAC [VECTOR_MUL_ASSOC] THEN
ASM_SIMP_TAC[ REAL_DIV_RMUL] THEN
REWRITE_TAC [VECTOR_MUL_LID] THEN
ASM_SIMP_TAC [REAL_FIELD `!d:real c:real. (~(d = &0)) ==> (&1 /d * c) = c / d`]
]
);;
let lemma1477 = REAL_SOS `!a:real b:real c:real . &0 < a /\ &0 < b /\ &0 < c /\ a + b = c ==> a < c`;;
let lemma1490 = prove
( `!a:real c:real. &0 < a /\ &0 < c /\ a < c ==> a/c < &1`,
REPEAT STRIP_TAC THEN
ONCE_ASM_SIMP_TAC[REAL_SOS `&0<c ==> (u < v <=> c*u < c*v)`] THEN
WE_HAVE_BY_NOMATCHING (SPECL [`&0`;`c:real`] REAL_LT_IMP_NE) THEN
ASM_SIMP_TAC [REAL_FIELD `~(&0 = c) ==> c*a/c = a`] THEN
REWRITE_TAC [REAL_MUL_RID] THEN
ASM_SIMP_TAC[]
);;
(* 2.13.18 *)
let PATH_REWRITE_TAC path = CONV_TAC o PATH_CONV path o ONCE_REWRITE_CONV;;
(* proved 2.14.18 *)
let between_norm = prove
( `!x:real^2 y:real^2 z:real^2. B(x,y,z) <=>
norm(y-x) + norm(z-y) = norm(z-x) /\ ~(x = y) /\ ~(y=z) /\ ~(x=z)`,
REPEAT GEN_TAC THEN
REWRITE_TAC[B] THEN
ASM_CASES_TAC `x:real^2 = z:real^2` THEN
ASM_REWRITE_TAC[] THEN
REPEAT STRIP_TAC THEN EQ_TAC THENL
[ REWRITE_TAC[B] THEN
REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
REPEAT STRIP_TAC THENL
[
REWRITE_TAC[temp1360] THEN
ASM_REWRITE_TAC[] THEN
ABBREV_TAC `u:real^2 = z:real^2-x:real^2` THEN
REWRITE_TAC[ VECTOR_ARITH `!u:real^2 t:real. u - t % u = (&1-t) % u`] THEN
REWRITE_TAC[ NORM_MUL] THEN
(* the goal is now `abs t * norm u + abs (&1 - t) * norm u = norm u` *)
WE_HAVE_BY (SPECL [`&0`; `t:real`] REAL_LT_IMP_LE) THEN (* &0 <= t *)
WE_HAVE_BY (REAL_ARITH `t < &1 ==> &0 <= (&1-t)`) THEN (* &0 <= &1-t *)
ASM_SIMP_TAC[REAL_ARITH `&0 <= x ==> abs(x) = x`] THEN
REWRITE_TAC [GSYM REAL_ADD_RDISTRIB] THEN (* (t + &1-t)) * norm u = norm u *)
REWRITE_TAC[ REAL_RING `(t + &1 - t) * u = u`]
;
ABBREV_TAC `u:real^2 = z:real^2-x:real^2` THEN
UNDISCH_TAC `y:real^2 - x:real^2 = t:real % u:real^2` THEN
ASM_REWRITE_TAC[] THEN
EXPAND_TAC "u" THEN
ASM_MESON_TAC[temp1434;VECTOR_ARITH `!y:real^2. y - y = vec(0):real^2`]
;
ABBREV_TAC `u:real^2 = z:real^2-x:real^2` THEN
UNDISCH_TAC `y:real^2 - x:real^2 = t:real % u:real^2` THEN
ASM_REWRITE_TAC[] THEN
WE_HAVE_BY (REAL_ARITH `t:real < &1 ==> ~(t:real = &1)`) THEN (* ~ (t = &1) *)
ASM_MESON_TAC[VECTOR_MUL_LID;VECTOR_MUL_RCANCEL;
VECTOR_ARITH `x:real^2 = z:real^2 <=> z:real^2-x:real^2 = vec(0):real^2`]
]
;
(* Now there's just one goal, namely 0 [`~(x = z)`]
`norm (y - x) + norm (z - y) = norm (z - x) /\ ~(x = y) /\ ~(y = z)
==> (?t. y - x = t % (z - x) /\ &0 < t /\ t < &1)` *)
STRIP_TAC THEN
WE_HAVE_BY NORM_TRIANGLE_EQ_SUB5 THEN
EXISTS_TAC `norm(y:real^2 - x:real^2)/norm(z:real^2 - x:real^2)` THEN
REPEAT STRIP_TAC THENL (* That creates three goals *)
[ ONCE_REWRITE_TAC [ VECTOR_ARITH `!t:real x:real^2 y:real^2 z:real^2. t % (z-x) = t % (z-y-(x-y))`] THEN
(* y-x = norm(y-x)/norm(z-x) % ((z-y)- (x-y)) *)
WE_HAVE_BY (NORM_ARITH `(~(x:real^2 = z:real^2)) ==> ~ (norm(z:real^2-x:real^2) = &0)`) THEN
(* ~ norm(z-x) = 0 *)
SUBGOAL_THEN `~(norm(z:real^2 - x:real^2) = &0)` ASSUME_TAC THENL
[ ASM_REWRITE_TAC[
NORM_ARITH ` ~ (norm(z:real^2-x:real^2) = &0) <=> ~ (x:real^2 = z:real^2)`
]
;
ASM_SIMP_TAC [lemma1453] THEN
(* norm(z-x) % (y-x) = norm(y-x) % ((z-y)-(x-y)) *)
WE_HAVE_BY (REAL_ARITH `!a:real b:real c:real. (a+b=c) ==> (c=a+b)`) THEN
(* `norm (z - x) = norm (y - x) + norm (z - y)` added to assumptions *)
ONCE_ASM_REWRITE_TAC[] THEN
(* goal is now `(norm (y - x) + norm (z - y))%(y - x) = norm (y - x) % (z - y - (x - y))` *)
REWRITE_TAC[VECTOR_ADD_RDISTRIB] THEN
(* norm(y-x) % (y-x) + norm(z-y) % (y-x) = ... *)
PATH_REWRITE_TAC "r" [VECTOR_SUB_LDISTRIB] THEN
(* norm(y-x) % (y-x) + norm(z-y) % (y-x) = norm(y-x) % (z-y) - norm(y-x) %(x-y) *)
REWRITE_TAC [VECTOR_ARITH `!x:real^2 y:real^2 u:real^2.
u - norm(y-x) % (x-y) = u + norm(y-x) % (y-x)`] THEN
(* ... = norm(y-x) % (z-y) + norm(y-x) %(y-x) *)
REWRITE_TAC[VECTOR_ARITH `!x:real^2 y:real^2 z:real^2. (z + x = y + z) <=> (x=y)`] THEN
(* That cancels the first and last terms out leaving
norm(z-y) % (y-x) = norm(y-x) % (z-y). The assumptions contain
`norm (x - y) % (z - y) = norm (z - y) % (y - x)` so we're almost done. *)
ASM_MESON_TAC[ NORM_SUB]
]
;
(* Now there are two subgoals:
The current one is `&0 < norm (y - x) / norm (z - x)` with `~(x=z)` among the assumptions *)
WE_HAVE_BY_NOMATCHING (NORM_ARITH ` ~ ( x:real^2 = z:real^2) ==> &0 < norm(z:real^2-x:real^2)`) THEN
WE_HAVE_BY_NOMATCHING (NORM_ARITH ` ~ ( x:real^2 = y:real^2) ==> &0 < norm(y:real^2-x:real^2)`) THEN
ASM_MESON_TAC[REAL_LT_DIV]
;
(* Now the goal is `norm (y - x) / norm (z - x) < &1` with
`norm (y - x) + norm (z - y) = norm (z - x)` in the assumptions list *)
(* First get it in the assumption list that all the norms in sight are positive *)
WE_HAVE_BY_NOMATCHING (NORM_ARITH ` ~ ( x:real^2 = z:real^2) ==> &0 < norm(z:real^2-x:real^2)`) THEN
WE_HAVE_BY_NOMATCHING (NORM_ARITH ` ~ ( x:real^2 = y:real^2) ==> &0 < norm(y:real^2-x:real^2)`) THEN
WE_HAVE_BY_NOMATCHING (NORM_ARITH ` ~ ( y:real^2 = z:real^2) ==> &0 < norm(z:real^2-y:real^2)`) THEN
ASM_MESON_TAC[lemma1477;lemma1490]
]
]
);;
(* proved 2.7.18 *)
let norm2 = prove
( `! x:real y:real. norm(vector2[x;y]) = sqrt(x*x + y*y)`,
REPEAT GEN_TAC THEN
REWRITE_TAC[vec2;vector_norm; dot; DOT_2] THEN
VEC2_TAC
);;
(* proved 2.7.18 *)
let vector_dif = prove
( `!a:real b:real c:real d:real. vector2[a-b;c-d] = vector2[a;c]- vector2[b;d]`,
REPEAT GEN_TAC THEN
REWRITE_TAC[vec2] THEN
VEC2_TAC THEN
REWRITE_TAC[VECTOR_SUB_COMPONENT;VECTOR_2]
);;
(* proved 2.7.17 *)
let lemma_sos2 = prove
( `!x:real y:real. &0 <= x pow 2 + y pow 2`,
MESON_TAC[SQRT_POW_2; lemma_sos; REAL_ARITH `x*x = x pow 2`]
);;
(* proved 2.7.18 *)
let SQRT_SQ_SOS = prove
( `!x:real y:real. (sqrt (x*x + y*y)) * (sqrt (x*x+y*y)) = x*x+y*y`,
REPEAT GEN_TAC THEN
REWRITE_TAC [REAL_ARITH `x*x = x pow 2`] THEN
MESON_TAC[ SQRT_POW_2; lemma_sos2 ]
);;
(* proved 2.7.18 *)
let sos_normsq = prove
( `!x1:real x2:real.
(x1*x1 + x2*x2) = norm(vector2[x1;x2]) * norm(vector2[x1;x2])`,
REPEAT GEN_TAC THEN
ASSUME_TAC lemma_sos2 THEN
ASM_SIMP_TAC[SQRT_POW_2] THEN
REWRITE_TAC[norm2; SQRT_SQ_SOS]
);;
(* proved 2.7.18 *)
let sqrt_norm = prove
( `!y:real^2 z:real^2 t:real. &0 <= t ==>
( norm y * norm y = (norm z * norm z) * t * t <=> norm y = (norm z) * t)`,
REPEAT GEN_TAC THEN
MESON_TAC [ REAL_SOS `&0 <= x /\ &0 <= y ==> (x = y <=> x*x = y*y)`;
lemma_sos;
NORM_ARITH `&0 <= norm(x:real^2)`;
REAL_LE_MUL;
REAL_RING `(u*u) *t*t = (u*t)*(u*t)`
];
);;
(* proved 2.8.18 *)
let sqrt_norm2 = prove
( `!y:real^2 z:real^2 t:real. &0 <= t ==>
( norm y * norm y = t*t*norm z * norm z <=> norm y = (norm z) * t)`,
REPEAT GEN_TAC THEN
MESON_TAC [ REAL_SOS `&0 <= x /\ &0 <= y ==> (x = y <=> x*x = y*y)`;
lemma_sos;
NORM_ARITH `&0 <= norm(x:real^2)`;
REAL_LE_MUL;
REAL_RING `t*t*u*u = (u*t)*(u*t)`
];
);;
(* proved 2.8.18 *)
let lemma1427 = prove
( `!y1:real y2:real z1:real z2:real t:real.
&0 < t /\ t < &1 ==>
y1 * y1 + y2 * y2 = (z1 * z1 + z2 * z2) * t * t /\
(z1 - y1) * (z1 - y1) + (z2 - y2) * (z2 - y2) =
(&1 - t) * (&1 - t) * (z1*z1 + z2*z2) ==>
sqrt(y1*y1 + y2*y2) + sqrt((z1-y1)*(z1-y1) + (z2-y2)*(z2-y2)) = sqrt(z1*z1+z2*z2)`,
REPEAT GEN_TAC THEN
ABBREV_TAC `y= vector2[y1;y2]` THEN
ABBREV_TAC `z = vector2[z1;z2]` THEN
REWRITE_TAC [GSYM norm2] THEN
ASM_SIMP_TAC[] THEN
(* Now we have ...==> norm (y) + norm (vector2 [z1 - y1; z2 - y2]) =
norm (vector2 [z1; z2])` *)
REWRITE_TAC[vector_dif] THEN
ASM_SIMP_TAC[] THEN
(* Now the goal ends in ==> norm y + norm (z - y) = norm z` *)
REWRITE_TAC[sos_normsq] THEN
ASM_SIMP_TAC[] THEN
REWRITE_TAC[vector_dif] THEN
ASM_SIMP_TAC[] THEN
REWRITE_TAC[sqrt_norm] THEN
STRIP_TAC THEN
WE_HAVE_BY_N 2 REAL_LT_IMP_LE THEN (* &0 <= t *)
ASSUME_TAC (NORM_ARITH `!x:real^2. &0 <= norm(x:real^2)`) THEN
WE_HAVE_BY2 (REAL_SOS `&0 < t /\ t < &1 ==> &0 <= (&1-t)`) THEN (* &0 <= 1-t *)
ASM_SIMP_TAC [sqrt_norm; sqrt_norm2] THEN
REWRITE_TAC [REAL_RING `p*t + p*(&1-t) = p`]
);;
(* proved 2.8.18 *)
let lemma1458 = prove
( `!y1:real y2:real z1:real z2:real t:real.
&0 < t /\ t < &1 ==>
y1 * y1 + y2 * y2 = (z1 * z1 + z2 * z2) * t * t /\
(z1 - y1) * (z1 - y1) + (z2 - y2) * (z2 - y2) =
(&1 - t) * (&1 - t) * (z1*z1 + z2*z2) ==>
sqrt(y2*y2 + y1*y1) + sqrt((z2-y2)*(z2-y2) + (z1-y1)*(z1-y1)) = sqrt(z2*z2+z1*z1)`,
MESON_TAC[lemma1427;REAL_ADD_AC]
);;
(* proved 2.14.18 *)
let dsq_norm = prove
(` !x:real^2 y:real^2. dsq(x,y) = norm(y-x) * norm(y-x)`,
REPEAT GEN_TAC THEN
REWRITE_TAC[dsq;square;vector_norm;dot] THEN
VEC2_TAC THEN
REWRITE_TAC[lemma688] THEN
REWRITE_TAC [REAL_SUB_LDISTRIB; REAL_SUB_RDISTRIB; VECTOR_SUB_COMPONENT] THEN
REAL_SIMP_TAC THEN
CONV_TAC REAL_RING
);;
(* proved 2.14.18 *)
let TC_norm = prove
( `!x:real^2 y:real^2 z:real^2 a:real^2 b:real^2 c:real^2.
TC(x,y,z,a,b,c) ==> norm(y-x) = norm(b-a) /\ norm(z-x) = norm(c-a) /\ norm(z-y) = norm(c-b)`,
REPEAT GEN_TAC THEN
REWRITE_TAC[TC; dsq_norm] THEN
MESON_TAC[REAL_SOS `x*x = y*y /\ &0 <= x /\ &0 <= y ==> x = y`; NORM_POS_LE]
);;
(* proved 2.15.18 *)
let TC_norm2 = prove
( `!x:real^2 y:real^2 z:real^2 a:real^2 b:real^2 c:real^2.
TC(x,y,z,a,b,c) <=> norm(y-x) = norm(b-a) /\ norm(z-x) = norm(c-a) /\ norm(z-y) = norm(c-b)`,
REPEAT GEN_TAC THEN EQ_TAC THEN
REWRITE_TAC[TC; dsq_norm] THEN
MESON_TAC[REAL_SOS `x*x = y*y /\ &0 <= x /\ &0 <= y ==> x = y`; NORM_POS_LE]
);;
let lemma1717 = NORM_ARITH `!x:real^2 y:real^2 a:real^2 b:real^2.(norm(x-y) = norm(b-a)) ==> ((x=y) <=> (b=a))`;;
(* proved 2.14.18 *)
let TC_preserves_NC = prove
( `!x:real^2 y:real^2 z:real^2 a:real^2 b:real^2 c:real^2.
TC(x,y,z,a,b,c) /\ NC(x,y,z) ==> NC(a,b,c)`,
REPEAT STRIP_TAC THEN
UNDISCH_TAC `NC(x:real^2, y:real^2, z:real^2)` THEN
WE_HAVE_BY TC_norm THEN
REWRITE_TAC[NC;between_norm] THEN
ASM_REWRITE_TAC[] THEN
ASM_MESON_TAC[NORM_ARITH `!x:real^2 y:real^2 . norm(y-x) = norm(x-y)`;lemma1717]
);;
(* proved 2.14.18 *)
(* Special case of `congruent triangles are equal'. Namely,
if 0bc and 0xy are congruent, and b lies on the positive x-axis, then they are equal *)
let congruence_implies_ET_0 = prove
( `!b:real^2 c:real^2 y:real^2 z:real^2.
b$2 = &0 /\ triangle_congruence(zero2,b,c,zero2,y,z) ==> ET(zero2,b,c,zero2,y,z)`,
REPEAT STRIP_TAC THEN
ASM_CASES_TAC `y:real^2 $2 = &0` THENL
[ (* case y$2 = 0 , so both y2 and b2 are zero *)
ASM_MESON_TAC[congruence_implies_ET_00];
(* Now y2 is not zero but b2 is zero. So rotate x,y,z *)
(* Define the required rotation matrix Q *)
ABBREV_TAC `Q:real^2^2 = vector[
vector [y:real^2 $1/ sqrt(y:real^2 $1 * y:real^2 $1 + y:real^2 $2*y:real^2 $2) ;
( y:real^2 $2)/(sqrt(y:real^2 $1 * y:real^2 $1 + y:real^2 $2*y:real^2 $2))]
;
vector [--(y:real^2 $2)/sqrt(y:real^2 $1 * y:real^2 $1 + y:real^2 $2*y:real^2 $2);
y:real^2 $1/ (sqrt(y:real^2 $1 * y:real^2 $1 + y:real^2 $2*y$2))]
]` THEN
WE_HAVE_BY2 rotate_to_zero2 THEN (* rotation_matrix(Q) /\ Q**y $ 2 = 0 /\ etc *)
WE_HAVE_BY rotation_congruence_one THEN (* TC(zero2,y,z,zero2,Q**y, Q**z) *)
WE_HAVE_BY triangle_congruence_implies_TC THEN (* TC(zero2,b,c,zero2,y,z) *)
WE_HAVE_BY2
(ISPECL [`zero2`; `b:real^2`; `c:real^2`;
`zero2`; `y:real^2`; `z:real^2`;
`zero2`; `Q:real^2^2 ** y:real^2`; `Q:real^2^2 ** z:real^2`]
congruence_transitive
) THEN (* TC(zero2,b,c,zero2, Q**y, Q**z) *)
WE_HAVE_BY triangle_congruence_implies_NC THEN (* NC(zero2,b,c) *)
UNDISCH_TAC `TC(zero2,b:real^2, c:real^2,zero2,y:real^2,z:real^2)` THEN
DISCH_TAC THEN (* this moves this assumption to the top of the list *)
WE_HAVE_BY2 TC_preserves_NC THEN (* NC(zero2,y,z) *)
WE_HAVE_BY2 rotation_NC THEN (* NC(Q**zero2, Q**c, Q**y) *)
WE_HAVE_BY2 (MATCH_MP EQ_IMP
(GSYM (ISPECL [`zero2`; `Q:real^2^2 ** y:real^2`; `Q:real^2^2 ** z:real^2`;
`zero2`; `b:real^2`; `c:real^2`] triangle_congruence)))
THEN (* triangle_congruence(zero2,b,c,zero2,Q**y, Q**z) *)
WE_HAVE_BY3
( SPECL [`b:real^2`; `c:real^2`; `Q:real^2^2 ** y:real^2`; `Q:real^2^2 **z:real^2`]congruence_implies_ET_00)
THEN (* ET(zero2,b,c,zero2,Q**y, Q**z) *)
WE_HAVE_BY2
(SPECL [`Q:real^2^2`; `zero2`; `y:real^2`; `z:real^2`] rotation_ET)
THEN (* ET(zero2,y,z,zero2, Q**y, Q**z) *)
ASM_MESON_TAC[ET_symmetric; ET_transitive;veczero]
]
);;
let triangle_congruence_symmetric = prove
( `!a:real^2 b:real^2 c:real^2 p:real^2 q:real^2 r:real^2.
triangle_congruence(a,b,c,p,q,r) ==> triangle_congruence(p,q,r,a,b,c)`,
REPEAT GEN_TAC THEN
REWRITE_TAC [triangle_congruence] THEN
MESON_TAC[congruence_symmetric; TC_preserves_NC]
);;
(* proved 2.14.18 *)
(* congruent implies ET, when both triangles have a vertex at origin, and we don't assume anything about the other vertices.*)
let congruent_implies_ET_1 = prove
( `!b:real^2 c:real^2 y:real^2 z:real^2.
triangle_congruence(zero2,b,c,zero2,y,z) ==> ET(zero2,b,c,zero2,y,z)`,
REPEAT GEN_TAC THEN
ASM_CASES_TAC `b:real^2 $2 = &0` THENL
[ ASM_MESON_TAC[congruence_implies_ET_0]
; (* completes the case b2 = 0. So now b2 is nonzero *)
ABBREV_TAC `Q:real^2^2 = vector[vector [b:real^2$1/ sqrt(b:real^2$1 * b:real^2$1 + b:real^2$2*b:real^2$2) ;
b:real^2$2 /sqrt(b:real^2$1 * b:real^2$1 + b:real^2$2*b:real^2$2)];
vector [--(b:real^2$2)/sqrt(b:real^2$1 * b:real^2$1 + b:real^2$2*b:real^2$2);
b:real^2$1/ sqrt(b:real^2$1 * b:real^2$1 + b:real^2$2*b:real^2$2)]]` THEN
WE_HAVE_BY2 rotate_to_zero2 THEN (* rotation_matrix(Q) /\ Q**b $ 2 = 0 /\ etc *)
DISCH_TAC THEN
WE_HAVE_BY triangle_congruence_implies_TC THEN (* TC(zero2,b,c,zero2,y,z) *)
WE_HAVE_BY congruence_symmetric THEN (* TC(zero2,y,z,zero2,b,c) *)
WE_HAVE_BY (SPECL [`b:real^2`;`c:real^2`]rotation_congruence_zero) THEN (* TC(zero2,b,c,zero2,Q**b Q**c) *)
WE_HAVE_BY2 congruence_transitive THEN (* TC(zero2,y,z,zero2, Q**b, Q**c) *)
WE_HAVE_BY congruence_symmetric THEN (* TC(zero2,Q**b, Q**c, zero2,y,z) *)
WE_HAVE_BY triangle_congruence_implies_NC THEN (* NC(zero2,b,c) *)
UNDISCH_TAC `TC (zero2,b:real^2,c:real^2,zero2,y:real^2,z:real^2)` THEN (* out of the way *)
WE_HAVE_BY2 (TC_preserves_NC) THEN (* NC(zero2, Q**b, Q**c) *)
DISCH_TAC THEN (* Move TC(zero2,b,c,zero2,y,z) back into assumptions *)
UNDISCH_TAC `NC (zero2,b:real^2,c:real^2)` THEN
(* get it out of the way so it doesn't interfere with the next inference *)
WE_HAVE_BY2 get_triangle_congruence THEN (* triangle_congruence( zero2, Q**b, Q**c,zero2,y,z,) *)
WE_HAVE_BY triangle_congruence_symmetric THEN (* triangle_congruence(zero2,y,z,zero2,Q**b,Q**c) *)
WE_HAVE_BY2 congruence_implies_ET_0 THEN (* ET(zero2,Q**b, Q**c,zero2,y,z) *)
WE_HAVE_BY ET_symmetric THEN (* ET(zero2,y,z,zero2,Q**b,Q**c) *)
DISCH_TAC THEN (* put NC(zero2,b,c) back in the assumptions *)
WE_HAVE_BY2 TC_preserves_NC THEN (* NC(zero2,y,z) *)
WE_HAVE_BY3 rotation_ET_converse THEN (* ET(zero2,y,z,zero2,b,c) *)
WE_HAVE_BY ET_symmetric (* ET(zero2,b,c,zero2,y,z) the goal *)
]
);;
(* proved 2.15.18 *)
let translation_invarianceTC3 = prove
( `!u:real^2 v:real^2 a:real^2 b:real^2 c:real^2 x:real^2 y:real^2 z:real^2.
TC(a,b,c,x,y,z) ==> TC(a-v,b-v,c-v, x-u,y-u,z-u)`,
REPEAT GEN_TAC THEN
REWRITE_TAC[TC_norm2] THEN
REWRITE_TAC[ NORM_ARITH `x:real^2-v:real^2-(u:real^2-v:real^2) = x:real^2-u:real^2`]
);;
(* proved 2.15.18 *)
let translation_invarianceB = prove
( `!u:real^2 a:real^2 b:real^2 c:real^2. B(a,b,c) <=> B(a-u,b-u,c-u)`,
REPEAT GEN_TAC THEN
REWRITE_TAC [between_norm] THEN
REWRITE_TAC [NORM_ARITH `b:real^2 - u:real^2 - (a:real^2 - u:real^2) = b:real^2 - a:real^2`] THEN
REWRITE_TAC [NORM_ARITH `(a:real^2 - u:real^2 = b:real^2 - u:real^2) <=> a:real^2 = b:real^2`]
);;
(* proved 2.15.18 *)
let translation_invariantNC = prove
( `!u:real^2 a:real^2 b:real^2 c:real^2. NC(a,b,c) <=> NC(a-u,b-u,c-u)`,
REPEAT GEN_TAC THEN
REWRITE_TAC[NC] THEN
REWRITE_TAC [NORM_ARITH `(a:real^2 - u:real^2 = b:real^2 - u:real^2) <=> a:real^2 = b:real^2`] THEN
MESON_TAC[translation_invarianceB]
);;
let left_to_right th = MATCH_MP (TAUT `(p <=>q) ==> (p ==>q)`) (SPEC_ALL th);;
(* proved 1.22.18 *)
let translation_invariance_area = prove
( `!x:real^2 y:real^2 z:real^2 a:real^2.
area(x,y,z) = area(x-a,y-a,z-a)`,
REPEAT GEN_TAC THEN
REWRITE_TAC[area;tarea;cross2;VECTOR_SUB_COMPONENT] THEN
REAL_SIMP_TAC
);;
(* proved 2.15.18 *)
let translation_invariance_ET = prove
( `!u:real^2 v:real^2 a:real^2 b:real^2 c:real^2 x:real^2 y:real^2 z:real^2.
ET(a,b,c,x,y,z) <=> ET(a-u,b-u,c-u,x-v,y-v,z-v)`,
REPEAT GEN_TAC THEN
REWRITE_TAC[ET] THEN
REPEAT STRIP_TAC THEN
MESON_TAC[translation_invariance_area]
);;
(* proved 2.15.18. This is one of the equal-triangle axioms *)
let congruentequal = prove
( `!a:real^2 b:real^2 c:real^2 x:real^2 y:real^2 z:real^2.
triangle_congruence(a,b,c,x,y,z) ==> ET(a,b,c,x,y,z)`,
REPEAT GEN_TAC THEN
REWRITE_TAC[triangle_congruence] THEN
STRIP_TAC THEN
WE_HAVE_BY (SPECL [ `x:real^2`; `a:real^2`] translation_invarianceTC3) THEN
UNDISCH_TAC `TC(a:real^2 - a:real^2,b:real^2 - a:real^2,c:real^2 - a:real^2,
x:real^2 - x:real^2,y:real^2 - x:real^2,z:real^2 - x:real^2)` THEN
REWRITE_TAC [NORM_ARITH `a:real^2 - a:real^2 = vec(0):real^2`; GSYM zero2] THEN
DISCH_TAC THEN
(* Now we have `TC (zero2,b - a,c - a,zero2,y - x,z - x)` in the assumption list *)
WE_HAVE_BY (left_to_right (SPEC `a:real^2` translation_invariantNC)) THEN
(* NC(a-a,b-a,c-a) *)
UNDISCH_TAC `NC (a:real^2 - a:real^2 ,b:real^2 - a:real^2 ,c:real^2 - a:real^2 )` THEN
REWRITE_TAC [VECTOR_ARITH `a:real^2 - a:real^2 = vec(0):real^2`; GSYM zero2] THEN
DISCH_TAC THEN
WE_HAVE_BY2 (left_to_right (GSYM triangle_congruence)) THEN
WE_HAVE_BY congruent_implies_ET_1 THEN
(* Now we have `ET (zero2,b - a,c - a,zero2,y - x,z - x)` and the goal is ET(a,b,c,x,y,z) *)
ONCE_REWRITE_TAC[ SPECL[ `a:real^2`; `x:real^2`] translation_invariance_ET] THEN
REWRITE_TAC[GSYM zero2; NORM_ARITH `a:real^2 - a:real^2 = vec(0):real^2`] THEN
ASM_REWRITE_TAC[]
);;
(* Now we systematically prove all the ET axioms *)
(* proved 2.16.18 *)
let area_permutation1 = prove
(` !a:real^2 b:real^2 c:real^2. area(a,b,c) = area(b,c,a)`,
REPEAT GEN_TAC THEN
REWRITE_TAC[area; tarea; cross2; VECTOR_SUB_COMPONENT;REAL_SUB_LDISTRIB; REAL_SUB_RDISTRIB] THEN
MATCH_MP_TAC( REAL_ARITH `!x:real y:real. x = y ==> abs(x) = abs(y)`) THEN
CONV_TAC REAL_RING
);;
(* proved 2.16.18 *)
let area_permutation2 = prove
(` !a:real^2 b:real^2 c:real^2. area(a,b,c) = area(a,c,b)`,
REPEAT GEN_TAC THEN
REWRITE_TAC[area; tarea; cross2; VECTOR_SUB_COMPONENT;REAL_SUB_LDISTRIB; REAL_SUB_RDISTRIB] THEN
MATCH_MP_TAC( REAL_ARITH `!x:real y:real. x = --y ==> abs(x) = abs(y)`) THEN
REAL_SIMP_TAC THEN
CONV_TAC REAL_RING
);;
(* proved 2.16.18 *)
let ETpermuation1 = prove
(`!a:real^2 b:real^2 c:real^2 A:real^2 B1:real^2 C:real^2.
ET(A,B1,C,a,b,c) ==> ET(A,B1,C,b,c,a)`,
REWRITE_TAC[ET] THEN
MESON_TAC[area_permutation1]
);;
(* proved 2.16.18 *)
let ETpermutation = prove
( `!a:real^2 b:real^2 c:real^2 A:real^2 B1:real^2 C:real^2.
ET(A,B1,C,a,b,c) ==> ET(A,B1,C,b,c,a) /\ ET(A,B1,C,a,c,b) /\ ET(A,B1,C,b,a,c)
/\ ET(A,B1,C,c,b,a) /\ ET(A,B1,C,c,a,b)`,
REPEAT GEN_TAC THEN
REWRITE_TAC[ET] THEN
MATCH_MP_TAC (
TAUT `!P R1 R2 R3 R4 R5. (P ==> R1 /\ R2 /\ R3 /\ R4 /\ R5)
==>
(P /\ Q ==> (R1 /\ Q) /\ (R2 /\ Q) /\ (R3 /\ Q) /\ (R4 /\ Q) /\ R5 /\ Q)`) THEN
DISCH_TAC THEN
ASM_REWRITE_TAC[] THEN
REWRITE_TAC[area_permutation1; area_permutation2]
);;
let ETsymmetric = ET_symmetric;;
let ETtranstive = ET_transitive;;
(* proved 2.16.18 *)
let betweennesssymmetry = prove
( `!a:real^2 b:real^2 c:real^2. B(a,b,c) <=> B(c,b,a)`,
REPEAT STRIP_TAC THEN
REWRITE_TAC[between_norm] THEN
EQ_TAC THEN DISCH_TAC THEN
ONCE_REWRITE_TAC[NORM_ARITH `!x:real^2 y:real^2. norm(x-y) = norm(y-x)`] THEN
ASM_MESON_TAC[REAL_ADD_AC]
);;
(* proved 2.16.18 *)
let deZolt_prep = prove
(`! b:real^2 e:real^2 c:real^2 d:real^2.
B(d,e,b) /\ area(d,e,c) = &0 ==> area(d,b,c) = &0`,
REPEAT STRIP_TAC THEN
UNDISCH_TAC `B (d:real^2,e:real^2,b:real^2)` THEN
REWRITE_TAC [B; LEFT_IMP_EXISTS_THM] THEN GEN_TAC THEN
STRIP_TAC THEN
ONCE_REWRITE_TAC[area_permutation1] THEN
ONCE_REWRITE_TAC[area_permutation1] THEN
UNDISCH_TAC `area (d:real^2,e:real^2,c:real^2) = &0` THEN
PATH_REWRITE_TAC "l" [area_permutation1] THEN
PATH_REWRITE_TAC "l" [area_permutation1] THEN
(* goal is `area (c,d,e) = &0 ==> area (c,d,b) = &0` *)
REWRITE_TAC[area;tarea] THEN
REWRITE_TAC[ REAL_ARITH `!x:real y:real. abs(x) = &0 <=> x = &0`] THEN
ASM_REWRITE_TAC[] THEN
WE_HAVE_BY REAL_LT_IMP_NZ THEN (* add ~(t = &0) to the assumptions *)
REWRITE_TAC [crosslinear1] THEN
ASM_SIMP_TAC[REAL_RING `(~(t:real = &0)) ==> (t *x = &0 <=> x = &0)`]
);;
(* proved 2.16.18 *)
let deZolt1 = prove
( `!B1:real^2 E:real^2 D:real^2 C:real^2. B(B1, E, D) ==> ~ET(D,B1,C,E,B1,C)`,
REPEAT GEN_TAC THEN DISCH_TAC THEN
WE_HAVE_BY (SPEC `C:real^2` area_additive) THEN
REWRITE_TAC[ET] THEN
REPEAT STRIP_TAC THEN
UNDISCH_TAC `area (E:real^2,C:real^2,B1:real^2) + area (D:real^2,C:real^2,E:real^2) = area (C:real^2,B1:real^2,D:real^2)` THEN
ASM_REWRITE_TAC[] THEN
ONCE_REWRITE_TAC[area_permutation2] THEN
PATH_REWRITE_TAC "rr" [area_permutation1] THEN
ASM_REWRITE_TAC[] THEN
(* Now the goal is `~(area (E,B1,C) + area (D,E,C) = area (E,B1,C))` *)
REWRITE_TAC [REAL_ARITH `!x c. ( x+c = x) <=> (c = &0)`] THEN
WE_HAVE_BY REAL_LT_IMP_NZ THEN
WE_HAVE_BY (left_to_right betweennesssymmetry) THEN
ASM_MESON_TAC[deZolt_prep]
);;
(* proved 2.16.18 *)
let lemma01 = prove
( `!x:real y:real. &0 < x /\ x < &1 /\ &0 < y /\ y < &1 ==> &0 < x*y /\ x*y < &1`,
REPEAT STRIP_TAC THENL
[ ASM_SIMP_TAC[REAL_LT_MUL]
;
ASM_MESON_TAC[REAL_LT_MUL2; REAL_MUL_LID;REAL_LT_IMP_LE]
]
);;
(* proved 2.16.18 *)
let deZolt2 = prove
( `!a:real^2 b:real^2 c:real^2 e:real^2 f:real^2. triangle(a,b,c) /\ B(b,e,a) /\ B(b,f,c) ==> ~ET(a,b,c,e,b,f)`,
REPEAT STRIP_TAC THEN
UNDISCH_TAC `B(b:real^2, e:real^2,a:real^2)` THEN
REWRITE_TAC[B; NOT_EXISTS_THM] THEN GEN_TAC THEN
STRIP_TAC THEN
UNDISCH_TAC `B(b:real^2, f:real^2,c:real^2)` THEN
REWRITE_TAC[B; NOT_EXISTS_THM] THEN GEN_TAC THEN
STRIP_TAC THEN
UNDISCH_TAC `ET (a:real^2,b:real^2,c:real^2,e:real^2,b:real^2,f:real^2)` THEN
REWRITE_TAC[ET; area; tarea] THEN
ASM_REWRITE_TAC[] THEN
(* That gets rid of e and f entirely *)
STRIP_TAC THEN
UNDISCH_TAC `abs ((c:real^2 - b:real^2) cross2 (a:real^2 - b:real^2)) =
abs (t' % (c:real^2 - b:real^2) cross2 t % (a:real^2 - b:real^2))` THEN
REWRITE_TAC[crosslinear1; crosslinear2] THEN
ASM_SIMP_TAC[REAL_SOS `&0 < t ==> abs(t*x) = t *abs(x)`] THEN
ASM_SIMP_TAC [REAL_SOS `&0 < c ==> (c = a*b*c <=> &1 = a*b)`] THEN
(* Now the goal is `~(&1 = t * t')` with 0 < t < &1 and 0 < t' < &1 in the assumptions *)
ASM_MESON_TAC[lemma01; REAL_LT_IMP_NE]
);;
Sindbad File Manager Version 1.0, Coded By Sindbad EG ~ The Terrorists