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]
);;
(* proved 2.17.17 |- !a b c. tarea (a,b,c) = --tarea (b,a,c) *)
let tarea_flip = prove
( `!a:real^2 b:real^2 c:real^2. tarea(a,b,c) = -- tarea(b,a,c)`,
REPEAT GEN_TAC THEN
PATH_REWRITE_TAC "l" [tapermutation] THEN
PATH_REWRITE_TAC "l" [tapermutation] THEN
REWRITE_TAC[tarea] THEN
PATH_REWRITE_TAC "r" [crossflip] THEN
REWRITE_TAC[crossanticommutative] THEN
PATH_REWRITE_TAC "r" [crossflip] THEN
ASM_REWRITE_TAC[]
);;
(* proved 2.18.18 *)
let abs_pos2 = REAL_SOS `!x:real. &0 < x ==> &0 < abs(x)`;;
(* proved 2.18.18 *)
let REAL_ADD_EQ = prove
( `!x:real y:real u:real v:real. x=y /\ u=v ==> x+u = y+v`,
REPEAT STRIP_TAC THEN
ASM_SIMP_TAC[]
);;
(* proved 2.18.18 *)
let REAL_SUB_EQ = prove
( `!x:real y:real u:real v:real. x=y /\ u=v ==> x-u = y-v`,
REPEAT STRIP_TAC THEN
ASM_SIMP_TAC[]
);;
let absx_minus_x = GEN_ALL (MATCH_MP (left_to_right (GSYM REAL_SUB_LE)) (SPEC_ALL REAL_ABS_LE));;
(* or this way:
let absx_minus_x = prove
( `!x. &0 <= abs x - x`,
MESON_TAC[REAL_SUB_LE;REAL_ABS_LE]
);;
*)
(* proved 2.18.18 *)
let lemma43 = REAL_ARITH `!x:real y:real z:real. abs(x) + abs(y) = abs(z) /\ x + y = z /\ &0 < x ==> &0 <= y` ;;
let lemma44 = REAL_ARITH `!x:real y:real z:real. abs(x) + abs(y) = abs(z) /\ x + y = z /\ y < &0 ==> x <= &0` ;;
let lemma45 = REAL_ARITH `!x:real y:real z:real. abs(x) + abs(y) = abs(z) /\ x + y = z /\ &0 < y ==> &0 <= x` ;;
(* proved 2.19.18 *)
let lemma47 = prove
( `!a:real^2 b:real^2 d:real^2 c:real^2. B(b,d,c) /\ &0 < tarea(d,a,b) ==> ~ (tarea(c,a,d) = &0)`,
REPEAT GEN_TAC THEN
STRIP_TAC THEN
ASSUME_TAC (ASSUME `B(b:real^2, d:real^2, c:real^2)`) THEN (* duplicates the assumption in question *)
UNDISCH_TAC `B(b:real^2, d:real^2, c:real^2)` THEN
REWRITE_TAC[B] THEN
REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
REPEAT STRIP_TAC THEN
ASSUME_TAC (SPECL [`a:real^2`;`b:real^2`;`d:real^2`] tapermutation) THEN
WE_HAVE_BY REAL_LT_IMP_NZ THEN (* [`~(tarea (d,a,b) = &0)` *)
WE_HAVE_BY_N 1 REAL_LT_IMP_NZ THEN (* ~ (t = 0) *)
WE_HAVE_BY (REAL_SOS `t:real < &1 ==> ~ (&1-t:real = &0)`) THEN (* `~(&1 - t = &0)` *)
UNDISCH_TAC `tarea (d:real^2,a:real^2,b:real^2) = tarea (a:real^2,b:real^2,d:real^2)` THEN
ASM_REWRITE_TAC[] THEN (* `~(tarea (d,a,b) = tarea (a,b,d))` *)
PATH_REWRITE_TAC "rr" [tarea] THEN (* = (d - b) cross2 (a - b)*)
ASM_REWRITE_TAC[] THEN (* t % (c - b) cross2 (a - b) *)
REWRITE_TAC[crosslinear1] THEN
PATH_REWRITE_TAC "rr" [GSYM tarea] THEN (* `~(tarea (d,a,b) = t * tarea (a,b,c))` *)
ASM_SIMP_TAC [GSYM tadditiveB] THEN (* `~(tarea (d,a,b) = t * (tarea (d,a,b) + &0))` *)
REAL_SIMP_TAC THEN (* ~(tarea (d,a,b) = t * tarea (d,a,b))` *)
ASM_SIMP_TAC [ REAL_SOS `!x:real t:real. ((~(x = &0)) ==> ( x = t*x <=> t = &1))`] THEN(* ~ (t = &1 *)
ASM_MESON_TAC [REAL_LT_IMP_NE]
);;
(* I could not succeed in reducing the following to lemma47, so it's proved from scratch. *)
(* 2.21.18 *)
let lemma74 = prove
( `!a:real^2 b:real^2 d:real^2 c:real^2. B(b,d,c) /\ tarea(d,a,b) < &0 ==> ~ (tarea(c,a,d) = &0)`,
REPEAT GEN_TAC THEN
STRIP_TAC THEN
ASSUME_TAC (ASSUME `B(b:real^2, d:real^2, c:real^2)`) THEN (* duplicates the assumption in question *)
UNDISCH_TAC `B(b:real^2, d:real^2, c:real^2)` THEN
REWRITE_TAC[B] THEN
REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
REPEAT STRIP_TAC THEN
ASSUME_TAC (SPECL [`a:real^2`;`b:real^2`;`d:real^2`] tapermutation) THEN
WE_HAVE_BY_N 1 REAL_LT_IMP_NE THEN (* [`~(tarea (d,a,b) = &0)` *)
WE_HAVE_BY_N 3 REAL_LT_IMP_NZ THEN (* ~ (t = 0) *)
WE_HAVE_BY (REAL_SOS `t:real < &1 ==> ~ (&1-t:real = &0)`) THEN (* `~(&1 - t = &0)` *)
UNDISCH_TAC `tarea (d:real^2,a:real^2,b:real^2) = tarea (a:real^2,b:real^2,d:real^2)` THEN
ASM_REWRITE_TAC[] THEN (* `~(tarea (d,a,b) = tarea (a,b,d))` *)
PATH_REWRITE_TAC "rr" [tarea] THEN (* = (d - b) cross2 (a - b)*)
ASM_REWRITE_TAC[] THEN (* t % (c - b) cross2 (a - b) *)
REWRITE_TAC[crosslinear1] THEN
PATH_REWRITE_TAC "rr" [GSYM tarea] THEN (* `~(tarea (d,a,b) = t * tarea (a,b,c))` *)
ASM_SIMP_TAC [GSYM tadditiveB] THEN (* `~(tarea (d,a,b) = t * (tarea (d,a,b) + &0))` *)
REAL_SIMP_TAC THEN (* ~(tarea (d,a,b) = t * tarea (d,a,b))` *)
ASM_SIMP_TAC [ REAL_SOS `!x:real t:real. ((~(x = &0)) ==> ( x = t*x <=> t = &1))`] THEN(* ~ (t = &1 *)
ASM_MESON_TAC [REAL_LT_IMP_NE]
);;
(* proved 3.1.18 *)
let lemma100 = prove
( `!a:real^2 b:real^2 d:real^2 c:real^2. B(b,d,c) /\ &0 < tarea(d,a,b) ==> &0 < tarea(d,c,a)`,
REPEAT STRIP_TAC THEN
ONCE_REWRITE_TAC[tapermutation] THEN
WE_HAVE_BY tadditiveB THEN (* tarea (d,a,b) + tarea (c,a,d) = tarea (a,b,c) *)
WE_HAVE_BY area_additive THEN (* area (d,a,b) + area (c,a,d) = area (a,b,c) *)
ASM_CASES_TAC ` &0 < tarea(c:real^2,a:real^2,d:real^2)` THENL
[
ASM_REWRITE_TAC[]
;
ASM_CASES_TAC `tarea(c:real^2,a:real^2,d:real^2) < &0` THENL
[ WE_HAVE_BY (left_to_right REAL_NOT_LT) THEN
ASM_MESON_TAC[area; REAL_NOT_LT; lemma44]
;
WE_HAVE_BY2 (REAL_SOS `!x:real. ~(&0 < x) /\ ~(x < &0) ==> x = &0`) THEN (* tarea(c,a,d) = &0 *)
ASM_MESON_TAC[lemma47]
]
]
);;
(* proved 3.2.18 *)
let lemma120 = prove
( `!a:real^2 b:real^2 d:real^2 c:real^2. B(b,d,c) /\ tarea(d,a,b) < &0 ==> tarea(d,c,a) < &0`,
REPEAT STRIP_TAC THEN
ONCE_REWRITE_TAC[tapermutation] THEN
WE_HAVE_BY (SPEC `a:real^2` tadditiveB) THEN (* tarea (d,a,b) + tarea (c,a,d) = tarea (a,b,c) *)
WE_HAVE_BY (SPEC `a:real^2` area_additive) THEN (* area (d,a,b) + area (c,a,d) = area (a,b,c) *)
ASM_CASES_TAC ` tarea(c:real^2,a:real^2,d:real^2) < &0` THENL
[
ASM_REWRITE_TAC[]
;
ASM_CASES_TAC `&0 < tarea(c:real^2,a:real^2,d:real^2)` THENL
[ WE_HAVE_BY (left_to_right REAL_NOT_LT) THEN
ASM_MESON_TAC[area; REAL_NOT_LE;lemma45]
;
WE_HAVE_BY2 (REAL_SOS `!x:real. ~(&0 < x) /\ ~(x < &0) ==> x = &0`) THEN (* tarea(c,a,d) = &0 *)
ASM_MESON_TAC[lemma74]
]
]
);;
let lemma141 = prove
( `!a:real^2 b:real^2 d:real^2 c:real^2. B(b,d,c) /\ (~(tarea(d,a,b)= &0)) ==> ~ (tarea(c,a,d) = &0)`,
MESON_TAC[ REAL_ARITH `(~ (&0 < x)) /\ (~ (x < &0)) <=> x = &0`;
tapermutation;lemma47;lemma100;lemma74
]
);;
let lemma93 = prove
( `!a:real^2 b:real^2 d:real^2 c:real^2. &0 < tarea(d,a,b) /\ B(b,d,c) ==> &0 < tarea(d,c,a)`,
MESON_TAC[lemma100]
);;
let lemma98 = REAL_ARITH `!a:real b:real c:real d:real. &0 < a /\ &0 < b /\ &0 < c /\ &0 < d ==> abs(a+b+c+d) = a+b+c+d`;;
let REAL_TRICHOTOMY = REAL_ARITH `!x:real. x < &0 \/ x = &0 \/ &0 < x`;;
(* proved 2.21.18 *)
let additivity_by_quarters = prove
( `!a:real^2 b:real^2 c:real^2 d:real^2 p:real^2.
B(b,p,d) /\ B(a,p,c) ==> area(a,p,b) + area(b,p,c) + area(c,p,d) + area(d,p,a) = area4(a,b,c,d)`,
REPEAT STRIP_TAC THEN
WE_HAVE_BY_N 1(SPEC `b:real^2` (GSYM area_additive)) THEN
WE_HAVE_BY_N 0 (SPEC `a:real^2` (GSYM area_additive)) THEN
WE_HAVE_BY_N 0 (SPEC `c:real^2` (GSYM area_additive)) THEN
WE_HAVE_BY_N 1 (SPEC `d:real^2` (GSYM area_additive)) THEN
WE_HAVE_BY_N 0 (left_to_right betweennesssymmetry) THEN
WE_HAVE_BY_N 1 (left_to_right betweennesssymmetry) THEN
REWRITE_TAC[area4;sarea4] THEN
ASM_CASES_TAC ` &0 < tarea(p:real^2,b:real^2,a:real^2)` THENL
[ WE_HAVE_BY2 lemma100 THEN
WE_HAVE_BY2 lemma100 THEN
WE_HAVE_BY2 lemma93 THEN
WE_HAVE_BY2 lemma93 THEN
ONCE_REWRITE_TAC[ SPEC `p:real^2` (VECTOR_ARITH `!p:real^2 x:real^2 y:real^2. (x-y) = (x-p)-(y-p)`)] THEN
ONCE_REWRITE_TAC[GSYM crossdistrib1] THEN
ONCE_REWRITE_TAC[GSYM crossdistrib2] THEN
REWRITE_TAC[ GSYM tarea ] THEN
REAL_SIMP_TAC THEN
PATH_REWRITE_TAC "rrlrr" [tarea_flip] THEN
REAL_SIMP_TAC THEN
PATH_REWRITE_TAC "rrlrr" [tarea_flip] THEN
REAL_SIMP_TAC THEN
PATH_REWRITE_TAC "rrl" [tapermutation] THEN
PATH_REWRITE_TAC "rrl" [tapermutation] THEN
REWRITE_TAC [area] THEN
PATH_REWRITE_TAC "rrlr" [tapermutation] THEN
PATH_REWRITE_TAC "rrlr" [tapermutation] THEN
PATH_REWRITE_TAC "rrrlr" [tapermutation] THEN
PATH_REWRITE_TAC "lr" [tapermutation] THEN
ASM_SIMP_TAC [REAL_ARITH `!a:real b:real c:real d:real. &0 < a /\ &0 < b /\ &0 < c /\ &0 < d ==> abs(a+b+c+d) = a+b+c+d`] THEN
REAL_SIMP_TAC THEN
ASM_MESON_TAC[abspos]
;
WE_HAVE_BY (left_to_right REAL_NOT_LT) THEN (* `tarea (p,b,a) <= &0` *)
ASM_CASES_TAC `tarea(p:real^2, b:real^2, a:real^2) < &0` THENL
[ UNDISCH_TAC `tarea(p:real^2,b:real^2,a:real^2) < &0`THEN
ONCE_REWRITE_TAC[tarea_flip] THEN
REWRITE_TAC [REAL_SOS `--x < &0 <=> &0 < x`] THEN
ONCE_REWRITE_TAC[tapermutation] THEN
DISCH_TAC THEN
WE_HAVE_BY2 lemma100 THEN
WE_HAVE_BY2 lemma100 THEN
WE_HAVE_BY2 lemma93 THEN
WE_HAVE_BY2 lemma93 THEN
ONCE_REWRITE_TAC[ SPEC `p:real^2` (VECTOR_ARITH `!p:real^2 x:real^2 y:real^2. (x-y) = (x-p)-(y-p)`)] THEN
ONCE_REWRITE_TAC[GSYM crossdistrib1] THEN
ONCE_REWRITE_TAC[GSYM crossdistrib2] THEN
REWRITE_TAC[ GSYM tarea ] THEN
REAL_SIMP_TAC THEN
PATH_REWRITE_TAC "rrlrr" [tarea_flip] THEN
REAL_SIMP_TAC THEN
PATH_REWRITE_TAC "rrlrr" [tarea_flip] THEN
REAL_SIMP_TAC THEN
PATH_REWRITE_TAC "rrl" [tapermutation] THEN
PATH_REWRITE_TAC "rrrlr" [tapermutation] THEN
REWRITE_TAC [area] THEN
PATH_REWRITE_TAC "lr" [tapermutation] THEN
PATH_REWRITE_TAC "lrr" [tapermutation] THEN
PATH_REWRITE_TAC "lrr" [tapermutation] THEN
PATH_REWRITE_TAC "lrr" [tapermutation] THEN
GEN_REWRITE_TAC ONCE_DEPTH_CONV [tarea_flip] THEN
GEN_REWRITE_TAC ONCE_DEPTH_CONV [tapermutation] THEN
REAL_SIMP_TAC THEN
ASM_SIMP_TAC [REAL_ARITH `!a:real b:real c:real d:real. &0 < a /\ &0 < b /\ &0 < c /\
&0 < d ==> abs((--a) -b - c -d )= a+b+c+d`] THEN
ASM_SIMP_TAC[abspos;REAL_ADD_AC]
;
(* Now we have that tarea(p,b,a) is not positive and not negative *)
WE_HAVE_BY2 (REAL_ARITH `(~(&0 < x)) /\ (~(x < &0)) ==> x = &0`) THEN
ONCE_REWRITE_TAC[ SPEC `p:real^2` (VECTOR_ARITH `!p:real^2 x:real^2 y:real^2. (x-y) = (x-p)-(y-p)`)] THEN
ONCE_REWRITE_TAC[GSYM crossdistrib1] THEN
ONCE_REWRITE_TAC[GSYM crossdistrib2] THEN
REWRITE_TAC[ GSYM tarea ] THEN
REWRITE_TAC[area] THEN
REAL_SIMP_TAC THEN
SUBGOAL_THEN `tarea (a:real^2,p:real^2,b:real^2) = &0 /\
tarea (b:real^2,p:real^2,c:real^2) = &0 /\
tarea (c:real^2,p:real^2,d:real^2) = &0 /\
tarea (d:real^2,p:real^2,a:real^2) = &0 /\
tarea (d:real^2,p:real^2,c:real^2) = &0` STRIP_ASSUME_TAC THENL
[ REPEAT STRIP_TAC THEN (* 5 goals created in addition to the old one *)
(* but they can all be dealt with by the same tactic: *)
ASM_MESON_TAC[lemma141; tapermutation;betweennesssymmetry;
tarea_flip; REAL_ARITH `--x = &0 <=> x = &0`]
;
ASM_REWRITE_TAC[] THEN
REAL_SIMP_TAC THEN (* Now the goal is &0 = abs(tarea(b,p,a)) *)
ONCE_REWRITE_TAC[tarea_flip] THEN
REAL_SIMP_TAC THEN
ASM_REWRITE_TAC[] THEN
REAL_SIMP_TAC
]
]
]
);;
(* proved 4.10.18 *)
let convex_quadflip= prove
( `!a:real^2 b:real^2 c:real^2 d:real^2. convex_quad(a,b,c,d) ==> convex_quad(b,a,d,c)`,
REPEAT GEN_TAC THEN
REWRITE_TAC[convex_quad] THEN
STRIP_TAC THEN
ASM_MESON_TAC[betweennesssymmetry]
);;
(* proved 4.11.18 *)
let convex_quadflip2= prove
( `!a:real^2 b:real^2 c:real^2 d:real^2. convex_quad(a,b,c,d) <=> convex_quad(b,a,d,c)`,
REPEAT GEN_TAC THEN
REWRITE_TAC[convex_quad] THEN
EQ_TAC THEN
STRIP_TAC THEN
ASM_MESON_TAC[betweennesssymmetry]
);;
(* proved 2.28.18 *)
let LLorder = prove
( `!a:real^2 b:real^2 c:real^2. LL(a,b,c) ==> LL(b,a,c)`,
REPEAT GEN_TAC THEN
REWRITE_TAC[LL] THEN
MESON_TAC[betweennesssymmetry]
);;
(* proved 2.28.18 *)
let quadperm2 = prove
( `!a:real^2 b:real^2 c:real^2 d:real^2. quad(a,b,c,d) ==> quad(d,c,b,a)`,
REPEAT GEN_TAC THEN
REWRITE_TAC[quad] THEN
STRIP_TAC THENL
[ DISJ2_TAC THEN
EXISTS_TAC `t:real^2` THEN
ASM_MESON_TAC[betweennesssymmetry; LLorder]
;
DISJ1_TAC THEN
EXISTS_TAC `t:real^2` THEN
ASM_MESON_TAC[LL; betweennesssymmetry;LLorder]
]
);;
(* proved 3.5.18 *)
let convex_quad_reverse_oneway = prove
( `!a:real^2 b:real^2 c:real^2 d:real^2. convex_quad(a,b,c,d) ==> convex_quad(d,c,b,a)`,
REPEAT GEN_TAC THEN
REWRITE_TAC[convex_quad] THEN
STRIP_TAC THEN
EXISTS_TAC `t:real^2` THEN
WE_HAVE_BY (left_to_right betweennesssymmetry) THEN
WE_HAVE_BY_N 0 (left_to_right betweennesssymmetry) THEN
ASM_REWRITE_TAC[]
);;
(* proved 3.13.18 *)
let convex_quad_reverse = prove
( `!a:real^2 b:real^2 c:real^2 d:real^2. convex_quad(a,b,c,d) <=> convex_quad(d,c,b,a)`,
MESON_TAC[convex_quad_reverse_oneway]
);;
(* proved perhaps 3.5.18 *)
let convex_quad_perm_oneway = prove
( `!a:real^2 b:real^2 c:real^2 d:real^2. convex_quad(a,b,c,d) ==> convex_quad(b,c,d,a)`,
REPEAT GEN_TAC THEN
REWRITE_TAC[convex_quad] THEN
STRIP_TAC THEN
EXISTS_TAC `t:real^2` THEN
WE_HAVE_BY (left_to_right betweennesssymmetry) THEN
WE_HAVE_BY_N 0 (left_to_right betweennesssymmetry) THEN
ASM_REWRITE_TAC[]
);;
(* proved 3.13.18 *)
let convex_quad_perm = prove
( `!a:real^2 b:real^2 c:real^2 d:real^2. convex_quad(a,b,c,d) <=> convex_quad(b,c,d,a)`,
MESON_TAC[convex_quad_perm_oneway]
);;
(* proved 2.28.18 *)
let sarea4perm = prove
( `!a:real^2 b:real^2 c:real^2 d:real^2. sarea4(a,b,c,d) = sarea4(b,c,d,a)`,
REPEAT GEN_TAC THEN
REWRITE_TAC[sarea4;crossflip;crossminus] THEN
PATH_REWRITE_TAC "r" [crossreverse] THEN
ASM_REWRITE_TAC[]
);;
(* proved 3.1.18 *)
let area4perm = prove
( `!a:real^2 b:real^2 c:real^2 d:real^2. area4(a,b,c,d) = area4(b,c,d,a)`,
MESON_TAC[area4;sarea4perm]
);;
(* proved 3.6.18 *)
let area4_reverse = prove
( `!a:real^2 b:real^2 c:real^2 d:real^2. area4(a,b,c,d) = area4(a,d,c,b)`,
REPEAT GEN_TAC THEN
REWRITE_TAC[area4;sarea4] THEN
PATH_REWRITE_TAC "r" [crossreverse] THEN
PATH_REWRITE_TAC "r" [crossminusunary2] THEN
REWRITE_TAC[REAL_ABS_NEG]
);;
(* proved 3.6.18 *)
let really_triangle_perm = prove
( `!a:real^2 b:real^2 c:real^2 d:real^2. really_triangle(a,b,c,d) = really_triangle(b,c,d,a)`,
REPEAT GEN_TAC THEN
REWRITE_TAC[really_triangle] THEN
MESON_TAC[betweennesssymmetry]
);;
(* proved 3.6.18 *)
let really_triangle_reverse = prove
( `!a:real^2 b:real^2 c:real^2 d:real^2. really_triangle(a,b,c,d) = really_triangle(d,c,b,a)`,
REPEAT GEN_TAC THEN
REWRITE_TAC[really_triangle] THEN
MESON_TAC[betweennesssymmetry]
);;
(* proved 3.6.18 *)
let euclid_quad_reverse = prove
( `!a:real^2 b:real^2 c:real^2 d:real^2. euclid_quad(a,b,c,d) ==> euclid_quad(d,c,b,a)`,
REPEAT GEN_TAC THEN
REWRITE_TAC[euclid_quad] THEN
STRIP_TAC THEN
ASM_MESON_TAC[convex_quad_reverse_oneway; area4_reverse;area4perm;really_triangle_reverse]
);;
(* proved 3.6.18 *)
let euclid_quad_perm = prove
( `!a:real^2 b:real^2 c:real^2 d:real^2. euclid_quad(a,b,c,d) ==> euclid_quad(b,c,d,a)`,
REPEAT GEN_TAC THEN
REWRITE_TAC[euclid_quad] THEN
STRIP_TAC THEN
ASM_SIMP_TAC[convex_quad_perm_oneway; area4_reverse;area4perm;really_triangle_perm; really_triangle_reverse] THEN
DISJ2_TAC THEN
ASM_MESON_TAC[really_triangle_perm;really_triangle_reverse]
);;
(* proved 3.6.18 *)
let EFpermutation1 = prove
( `!A:real^2 B1:real^2 C:real^2 D:real^2 a:real^2 b:real^2 c:real^2 d:real^2.
EF(A,B1,C,D,a,b,c,d) ==> EF(A,B1,C,D,b,c,d,a)`,
REPEAT GEN_TAC THEN
REWRITE_TAC[EF] THEN
STRIP_TAC THEN
ASM_REWRITE_TAC[] THEN
WE_HAVE_BY euclid_quad_perm THEN
ASM_REWRITE_TAC[] THEN
PATH_REWRITE_TAC "lr" [area4perm] THEN
ASM_REWRITE_TAC[]
);;
(* proved 2.28.18 *)
let sarea4perm2 = prove
( `!a:real^2 b:real^2 c:real^2 d:real^2. sarea4(a,b,c,d) = --sarea4(d,c,b,a)`,
REPEAT GEN_TAC THEN
REWRITE_TAC[sarea4;GSYM crossdistrib1; GSYM crossdistrib2] THEN
PATH_REWRITE_TAC "lr" [GSYM crossanticommutative] THEN
REAL_SIMP_TAC THEN
REWRITE_TAC [REAL_ARITH `--(x+y-z-w) = z+w-x-y`] THEN
REAL_SIMP_TAC THEN
ASM_REWRITE_TAC[] THEN
REWRITE_TAC [REAL_ARITH `x-y+z-w = x+z-w-y`]
);;
(* proved 3.1.18 *)
let area4perm2 = prove
( `!a:real^2 b:real^2 c:real^2 d:real^2. area4(a,b,c,d) = area4(d,c,b,a)`,
MESON_TAC[area4;sarea4;REAL_ABS_NEG;sarea4perm2]
);;
(* proved 4.10.18 *)
let area4flip = prove
( `!a:real^2 b:real^2 c:real^2 d:real^2. area4(a,b,c,d) = area4(b,a,d,c)`,
MESON_TAC[area4perm; area4perm2]
);;
(* proved 3.6.18 *)
let EFpermutation2 = prove
( `!A:real^2 B1:real^2 C:real^2 D:real^2 a:real^2 b:real^2 c:real^2 d:real^2.
EF(A,B1,C,D,a,b,c,d) ==> EF(A,B1,C,D,d,c,b,a)`,
REPEAT GEN_TAC THEN
REWRITE_TAC[EF] THEN
STRIP_TAC THEN
WE_HAVE_BY euclid_quad_reverse THEN
ASM_REWRITE_TAC[] THEN
PATH_REWRITE_TAC "lr" [area4perm2] THEN
REWRITE_TAC [REAL_ABS_NEG]
);;
(* proved 2.28.18 *)
let EFpermutation = prove
( `!A:real^2 B1:real^2 C:real^2 D:real^2 a:real^2 b:real^2 c:real^2 d:real^2.
EF(A,B1,C,D,a,b,c,d) ==>
EF(A,B1,C,D,b,c,d,a) /\
EF(A,B1,C,D,d,c,b,a) /\
EF(A,B1,C,D,c,d,a,b) /\
EF(A,B1,C,D,b,a,d,c) /\
EF(A,B1,C,D,d,a,b,c) /\
EF(A,B1,C,D,c,d,a,b) /\
EF(A,B1,C,D,a,d,c,b)`,
MESON_TAC[EFpermutation1; EFpermutation2]
);;
(* proved 2.28.18 *)
let EFsymmetric = prove
( `!A:real^2 B1:real^2 C:real^2 D:real^2 a:real^2 b:real^2 c:real^2 d:real^2.
EF(A,B1,C,D,a,b,c,d) ==> EF(a,b,c,d,A,B1,C,D)`,
MESON_TAC[EF]
);;
(* proved 2.28.18 *)
let EFtransitive = prove
( `!A:real^2 B1:real^2 C:real^2 D:real^2 a:real^2 b:real^2 c:real^2 d:real^2
P:real^2 Q:real^2 R:real^2 S:real^2.
EF(A,B1,C,D,a,b,c,d) /\ EF(a,b,c,d,P,Q,R,S) ==> EF(A,B1,C,D,P,Q,R,S)`,
MESON_TAC[EF]
);;
(* proved 2.28.18 *)
let xcrosszero = prove
( `!x:real^2. x cross2 vec(0):real^2 = &0`,
MESON_TAC[zero2;crossequalszero]
);;
(* proved 3.9.18 *)
let zerocrossx = prove
( `!x:real^2. vec(0):real^2 cross2 x = &0`,
MESON_TAC[zero2;crossequalszero]
);;
(* proved 3.1.18 *)
let areaequalsarea4 = prove
( `!a:real^2 b:real^2 c:real^2 d:real^2. B(b,d,c) ==> area(b,c,a) = area4(b,d,c,a)`,
REPEAT STRIP_TAC THEN
REWRITE_TAC[area;area4;sarea4] THEN
ONCE_REWRITE_TAC[tapermutation] THEN
ONCE_REWRITE_TAC[tapermutation] THEN
ASM_SIMP_TAC [SPEC `a:real^2` ( GSYM tadditiveB)] THEN
(* `abs (tarea (d,a,b) + tarea (c,a,d)) = abs ((c - b) cross2 (d - a))` *)
REWRITE_TAC[tarea] THEN
(* `abs ((b - a) cross2 (d - a) + (d - a) cross2 (c - a)) =
abs ((c - b) cross2 (d - a))` *)
PATH_REWRITE_TAC "lrrr" [crossflip] THEN
REWRITE_TAC[crossdistrib2plus] THEN
REWRITE_TAC [NORM_ARITH `!a:real^2 c:real^2 d:real^2. a-c+c-d = a-d`] THEN
PATH_REWRITE_TAC "lrr" [crossminusunary2] THEN
REWRITE_TAC[REAL_ABS_NEG]
);;
(* proved 3.1.18 *)
let tarea_sign = prove
( `!a:real^2 b:real^2 c:real^2. &0 < tarea(a,b,c) ==>
tarea(b,a,c) < &0 /\ &0 < tarea(b,c,a) /\ &0 < tarea(c,a,b) /\ tarea(a,c,b) < &0
/\ tarea(c,b,a) < &0`,
MESON_TAC[tapermutation; tarea_flip; REAL_ARITH `&0 < x ==> --x < &0`]
);;
(* proved 3.2.18 *)
let tarea_sign2 = prove
( `!a:real^2 b:real^2 c:real^2. tarea(a,b,c) < &0 ==>
&0 < tarea(b,a,c) /\ tarea(b,c,a) < &0 /\ tarea(c,a,b) < &0 /\ &0 < tarea(a,c,b)
/\ &0 < tarea(c,b,a)`,
MESON_TAC[tapermutation; tarea_flip; REAL_ARITH `x < &0 ==> &0 < --x`]
);;
(* proved 3.2.18 *)
let tarea_sub = prove
( `!a:real^2 t:real^2 d:real^2 c:real^2. B(c,b,t) ==> tarea(c,t,d)-tarea(b,t,d) = tarea(c,b,d)`,
MESON_TAC[betweennesssymmetry;tadditiveB;REAL_ARITH `x+y=z <=>z-y = x`;
REAL_ARITH `x+y = z <=> z-x = y`; tapermutation]
);;
(* proved 3.2.18 *)
let tarea_sub2 = prove
( `!a:real^2 t:real^2 d:real^2 c:real^2. B(c,b,t) ==> tarea(b,t,d)- tarea(c,t,d) = tarea(b,c,d)`,
MESON_TAC[tarea_flip; tarea_sub; REAL_ARITH `x-y = z <=> y-x = --z`]
);;
(* proved 3.2.18 *)
let lemma440 = prove
( `!a:real^2 b:real^2 c:real^2 d:real^2. B(b,d,c) ==>
( tarea(d,a,b) = &0 ==> tarea(c,a,d) = &0)`,
REPEAT STRIP_TAC THEN
ASM_CASES_TAC `tarea(c:real^2, a:real^2,d:real^2) = &0` THENL
[ ASM_REWRITE_TAC[]
;
ASM_CASES_TAC `&0 < tarea(d:real^2, a:real^2, c:real^2)` THENL
[ UNDISCH_TAC `B(b:real^2, d:real^2, c:real^2)` THEN
ONCE_REWRITE_TAC[betweennesssymmetry] THEN
DISCH_TAC THEN
WE_HAVE_BY2 lemma47 THEN
ASM_MESON_TAC[tarea_flip;tapermutation; REAL_ARITH `--(x) = &0 <=> x = &0`]
;
ASM_CASES_TAC `tarea(d:real^2, a:real^2, c:real^2) < &0` THENL
[ UNDISCH_TAC `B(b:real^2, d:real^2, c:real^2)` THEN
ONCE_REWRITE_TAC[betweennesssymmetry] THEN
DISCH_TAC THEN
WE_HAVE_BY2 lemma74 THEN
ASM_MESON_TAC[tarea_flip;tapermutation; REAL_ARITH `--(x) = &0 <=> x = &0`]
;
ASM_MESON_TAC[REAL_TRICHOTOMY;tarea_flip;tapermutation; REAL_ARITH `--(x) = &0 <=> x = &0`]
]
]
]
);;
(* proved 3.2.18 *)
let lemma468 = prove
( `!a:real^2 b:real^2 c:real^2 d:real^2. B(b,d,c) /\
tarea(d,a,b) = &0 ==> tarea(c,a,d) = &0`,
MESON_TAC[lemma440]
);;
(* proved 3.2.18 *)
let tarea_zero = prove(
` !b:real^2 d:real^2 c:real^2. tarea(b,c,d) = &0 ==> tarea(b,d,c) = &0`,
MESON_TAC[tarea_flip; tapermutation; REAL_ARITH `--(x) = &0 <=> x = &0`]
);;
(* proved 3.2.18 *)
let additivity1 = prove
( `!a:real^2 b:real^2 c:real^2 d:real^2 t:real^2.
B(a,t,d) /\ B(c,b,t) ==> area(b,c,a) + area(b,c,d) = area4(a,b,d,c)`,
REPEAT STRIP_TAC THEN
WE_HAVE_BY (SPEC `a:real^2` area_additive) THEN (* `area (b,a,c) + area (t,a,b) = area (a,c,t)` *)
WE_HAVE_BY (SPEC `d:real^2` area_additive) THEN (* `area (b,d,c) + area (t,d,b) = area (d,c,t)` *)
WE_HAVE_BY_N 0 (SPEC `c:real^2` area_additive) THEN
(* `area (t,c,a) + area (d,c,t) = area (c,a,d)` *)
WE_HAVE_BY_N 0 (SPEC `b:real^2` area_additive) THEN
(* `area (t,b,a) + area (d,b,t) = area (b,a,d)` *)
REWRITE_TAC[area4;sarea4] THEN
PATH_REWRITE_TAC "rrr" [NORM_ARITH `b:real^2-c:real^2 = (b:real^2-t:real^2)-(c:real^2-t:real^2)`] THEN
ONCE_REWRITE_TAC [GSYM crossdistrib1] THEN
PATH_REWRITE_TAC "rrlrlr"
[NORM_ARITH `d:real^2-a:real^2 = (d:real^2 - t:real^2) - (a:real^2-t:real^2)`] THEN
PATH_REWRITE_TAC "rrlr" [GSYM crossdistrib2] THEN
REWRITE_TAC [GSYM tarea] THEN
(* area (b,c,a) + area (b,c,d) =
abs (tarea (b,t,d) - tarea (b,t,a) - (d - a) cross2 (c - t))` *)
PATH_REWRITE_TAC "rrrlr" [NORM_ARITH `d:real^2-a:real^2 = (d:real^2-t:real^2)-(a:real^2-t:real^2)`] THEN
ONCE_REWRITE_TAC [GSYM crossdistrib2] THEN
REWRITE_TAC [GSYM tarea] THEN
REAL_SIMP_TAC THEN
(* `area (b,c,a) + area (b,c,d) =
abs (tarea (b,t,d) - tarea (b,t,a) - tarea (c,t,d) + tarea (c,t,a))` *)
REWRITE_TAC [REAL_ARITH `x-y-z+w = (x-z) + (w-y)`] THEN
ASM_SIMP_TAC [tarea_sub2] THEN
ASM_SIMP_TAC [tarea_sub] THEN
ASM_CASES_TAC `&0 < tarea(b:real^2,c:real^2,d:real^2)` THENL
[ WE_HAVE_BY tarea_sign THEN
SUBGOAL_THEN `&0 < tarea(c:real^2,b:real^2,a:real^2)` ASSUME_TAC THENL
[ WE_HAVE_BY tarea_sign THEN
WE_HAVE_BY2 lemma120 THEN
WE_HAVE_BY tarea_sign2 THEN
UNDISCH_TAC `B(a:real^2, t:real^2, d:real^2)` THEN
ONCE_REWRITE_TAC[betweennesssymmetry] THEN
DISCH_TAC THEN
WE_HAVE_BY2 lemma100 THEN
WE_HAVE_BY tarea_sign THEN
UNDISCH_TAC `B(c:real^2,b:real^2, t:real^2)` THEN
ONCE_REWRITE_TAC[betweennesssymmetry] THEN
DISCH_TAC THEN
WE_HAVE_BY2 lemma120 THEN
WE_HAVE_BY tarea_sign2 THEN
WE_HAVE_BY tarea_sign
;
(* `area (b,c,a) + area (b,c,d) = abs (tarea (b,c,d) + tarea (c,b,a))`
with assumptions &0 < tarea(c,b,a) and &0 < tarea(b,c,d) *)
ASM_SIMP_TAC [REAL_ARITH `&0 < x /\ &0 < y ==> abs(x+y) = abs(x) + abs(y)`] THEN
REWRITE_TAC [GSYM area] THEN
ASM_MESON_TAC[area_permutation1; area_permutation2; REAL_ADD_AC]
]
;
(* goal is `area (b,c,a) + area (b,c,d) = abs (tarea (b,c,d) + tarea (c,b,a))`
with assumption ~(&0 < tarea(b,c,d) *)
WE_HAVE_BY (left_to_right REAL_NOT_LT) THEN
ASM_CASES_TAC `tarea(b:real^2,c:real^2, d:real^2) < &0` THENL
[ WE_HAVE_BY tarea_sign2 THEN
SUBGOAL_THEN `tarea(c:real^2, b:real^2, a:real^2) < &0` ASSUME_TAC THENL
[ WE_HAVE_BY tarea_sign2 THEN
WE_HAVE_BY2 lemma100 THEN
WE_HAVE_BY tarea_sign THEN
UNDISCH_TAC `B(a:real^2, t:real^2, d:real^2)` THEN
ONCE_REWRITE_TAC[betweennesssymmetry] THEN
DISCH_TAC THEN
WE_HAVE_BY2 lemma120 THEN
WE_HAVE_BY tarea_sign2 THEN
UNDISCH_TAC `B(c:real^2,b:real^2, t:real^2)` THEN
ONCE_REWRITE_TAC[betweennesssymmetry] THEN
DISCH_TAC THEN
WE_HAVE_BY2 lemma100 THEN
WE_HAVE_BY tarea_sign THEN
WE_HAVE_BY tarea_sign2
;
(* Now the goal is `area (b,c,a) + area (b,c,d) = abs (tarea (b,c,d) + tarea (c,b,a))`
with both tarea terms on the right assumed negative *)
ASM_SIMP_TAC [REAL_ARITH `x < &0 /\ y < &0 ==> abs(x+y) = abs(x) + abs(y)`] THEN
MESON_TAC[area_permutation1;area_permutation2;area;REAL_ADD_AC]
]
;
(* Now the goal is `area (b,c,a) + area (b,c,d) = abs (tarea (b,c,d) + tarea (c,b,a))`
with assumptions
[`~(&0 < tarea (b,c,d))`]
[`tarea (b,c,d) <= &0`]
[`~(tarea (b,c,d) < &0)`] *)
WE_HAVE_BY2 ( REAL_ARITH `x <= &0 /\ ~ (x < &0) ==> x = &0`) THEN (* tarea(b,c,d) = &0 *)
WE_HAVE_BY tarea_zero THEN
WE_HAVE_BY2 lemma468 THEN (* tarea(b,d,b) = &0 *)
UNDISCH_TAC `B(a:real^2, t:real^2, d:real^2)` THEN
ONCE_REWRITE_TAC [betweennesssymmetry] THEN
DISCH_TAC THEN
ASM_REWRITE_TAC[] THEN
REAL_SIMP_TAC THEN
REWRITE_TAC[GSYM area] THEN
PATH_REWRITE_TAC "r" [area_permutation2] THEN
PATH_REWRITE_TAC "r" [area_permutation1] THEN
PATH_REWRITE_TAC "r" [area_permutation1] THEN
REWRITE_TAC [REAL_ARITH `x + y = x <=> y = &0`] THEN
REWRITE_TAC[area] THEN
ASM_REWRITE_TAC[REAL_ABS_ZERO]
]
]
);;
(* proved 3.2.18 *)
let area4_permutation = prove
( `!a:real^2 b:real^2 c:real^2 d:real^2. area4(a,b,d,c) = area4(a,c,d,b)`,
REPEAT GEN_TAC THEN
REWRITE_TAC[area4;sarea4] THEN
MESON_TAC[REAL_ABS_NEG;crossminusunary2;crossanticommutative]
);;
(* proved 3.2.18 *)
let additivity2 = prove
( `!a:real^2 b:real^2 c:real^2 d:real^2.
OS(a,b,c,d) ==> area(b,c,a) + area(b,c,d) = area4(a,b,d,c)`,
REPEAT GEN_TAC THEN
REWRITE_TAC[OS;CO] THEN
STRIP_TAC THENL
[ (* B(a,t,d) and b = c *)
ASM_REWRITE_TAC[] THEN
REWRITE_TAC[area;area4;sarea4;tarea] THEN
REWRITE_TAC [VECTOR_ARITH `c:real^2-c:real^2 = vec(0):real^2`] THEN
(* `abs ((a - c) cross2 vec 0) + abs ((d - c) cross2 vec 0) =
abs ((d - a) cross2 vec 0)` *)
REWRITE_TAC[xcrosszero] THEN
REAL_SIMP_TAC
;
(* B(a,t,d) and b = t *)
ASM_REWRITE_TAC[] THEN
PATH_REWRITE_TAC "lrr" [area_permutation2] THEN
PATH_REWRITE_TAC "lrr" [area_permutation1] THEN
ASM_SIMP_TAC[area_additive] THEN
ASM_MESON_TAC[areaequalsarea4;area_permutation1]
;
ASM_REWRITE_TAC[] THEN
(* `area (b,t,a) + area (b,t,d) = area4 (a,b,d,t)` *)
(* We want it to be tba and dbt *)
PATH_REWRITE_TAC "lrlr" [area_permutation2] THEN
PATH_REWRITE_TAC "lrlr" [area_permutation1] THEN
PATH_REWRITE_TAC "lrlr" [area_permutation1] THEN
PATH_REWRITE_TAC "lrr" [area_permutation1] THEN
PATH_REWRITE_TAC "lrr" [area_permutation1] THEN
(* `area (t,b,a) + area (d,b,t) = area4 (a,b,d,t)` *)
ASM_SIMP_TAC[area_additive] THEN
(* `area (b,a,d) = area4 (a,b,d,t)` *)
(* we need to change this to area(a,d,b) = area4(a,t,d,b) *)
PATH_REWRITE_TAC "lr" [area_permutation1] THEN
(* `area (a,d,b) = area4 (a,b,d,t)` *)
PATH_REWRITE_TAC "r" [area4perm2] THEN
ASM_MESON_TAC[areaequalsarea4;area4perm]
;
(* goal is area (b,c,a) + area (b,c,d) = area4 (a,b,d,c) with assumptions B(a,t,d) and B(c,b,t) *)
ASM_MESON_TAC[additivity1]
;
(* goal is area (b,c,a) + area (b,c,d) = area4 (a,b,d,c) with assumptions B(a,t,d) and B(b,c,t) *)
WE_HAVE_BY2 additivity1 THEN
ONCE_REWRITE_TAC[area_permutation2] THEN
ONCE_REWRITE_TAC[area_permutation1] THEN
ONCE_REWRITE_TAC[area_permutation2] THEN
ONCE_REWRITE_TAC[area4_permutation] THEN
ASM_MESON_TAC[area_permutation1;area_permutation2]
;
(* goal is `area (b,c,a) + area (b,c,d) = area4 (a,b,d,c)` with assumptions B(a,t,d) and B(b,t,c) *)
ASM_SIMP_TAC [SPECL [`a:real^2`; `b:real^2`; `d:real^2`; `c:real^2`; `t:real^2`] (GSYM additivity_by_quarters)] THEN
WE_HAVE_BY_N 1 (SPEC `a:real^2` area_additive) THEN
WE_HAVE_BY_N 1 (SPEC `d:real^2` area_additive) THEN
(* The goal is `area (b,c,a) + area (b,c,d) =
area (a,t,b) + area (b,t,d) + area (d,t,c) + area (c,t,a)`
and in the assumptions we have
3 [`area (t,a,b) + area (c,a,t) = area (a,b,c)`]
4 [`area (t,d,b) + area (c,d,t) = area (d,b,c)`] *)
REWRITE_TAC [REAL_ARITH `x+y+p+q = (x+q) + (y+p)`] THEN
PATH_REWRITE_TAC "lr" [area_permutation1] THEN
PATH_REWRITE_TAC "lr" [area_permutation1] THEN
PATH_REWRITE_TAC "rrr" [area_permutation1] THEN
PATH_REWRITE_TAC "rrr" [area_permutation1] THEN
PATH_REWRITE_TAC "rrlr" [area_permutation1] THEN
PATH_REWRITE_TAC "rlrr" [area_permutation2] THEN
PATH_REWRITE_TAC "rlrlr" [area_permutation2] THEN
PATH_REWRITE_TAC "rlrlr" [area_permutation1] THEN
PATH_REWRITE_TAC "rlrlr" [area_permutation1] THEN
ASM_REWRITE_TAC[]
]
);;
(* proved 3.2.18 *)
let halvesofequals = prove
( `!A:real^2 B1:real^2 C:real^2 D:real^2 a:real^2 b:real^2 c:real^2 d:real^2.
ET(A,B1,C,B1,C,D) /\ OS(A,B1,C,D) /\ ET(a,b,c,b,c,d) /\ OS(a,b,c,d) /\ EF(A,B1,D,C,a,b,d,c) ==> ET(A,B1,C,a,b,c)`,
REPEAT GEN_TAC THEN
REWRITE_TAC[ET;EF] THEN
REWRITE_TAC[GSYM area4] THEN
REPEAT STRIP_TAC THENL
[
UNDISCH_TAC `area4(A:real^2, B1:real^2, D:real^2, C:real^2) =
area4(a:real^2, b:real^2, d:real^2, c:real^2)` THEN
ASM_SIMP_TAC [GSYM additivity2] THEN
PATH_REWRITE_TAC "lrlrlr" [area_permutation1] THEN
PATH_REWRITE_TAC "lrlrlr" [area_permutation1] THEN
PATH_REWRITE_TAC "lrrlr" [area_permutation1] THEN
PATH_REWRITE_TAC "lrrlr" [area_permutation1] THEN
ASM_REWRITE_TAC[] THEN
MESON_TAC [REAL_ARITH `x+x = y+y ==> x = y`]
;
ASM_REWRITE_TAC[]
]
);;
(* proved 3.3.18 *)
let area_translation = prove
( `!d:real^2 a:real^2 b:real^2 c:real^2. area(a,b,c) = area(a-d,b-d,c-d)`,
REPEAT GEN_TAC THEN
REWRITE_TAC[area;tarea] THEN
REWRITE_TAC [NORM_ARITH `(c:real^2-d:real^2 - (b:real^2-d:real^2) = c:real^2-b:real^2)`]
);;
(* proved 3.3.18 *)
let area4_translation = prove
( `!d:real^2 a:real^2 b:real^2 c:real^2 e:real^2. area4(a,b,c,e) = area4(a-d,b-d,c-d,e-d)`,
REPEAT GEN_TAC THEN
REWRITE_TAC[area4;sarea4] THEN
REWRITE_TAC [NORM_ARITH `(c:real^2-d:real^2 - (b:real^2-d:real^2) = c:real^2-b:real^2)`]
);;
(* proved 3.3.18 *)
let lemma707 = prove
( `!t:real s:real. &0 < t /\ &0 < s /\ s < &1 /\ t < &1 ==> &0 < &1 - t*s`,
MESON_TAC[ lemma01; REAL_ARITH `&0 < x-y <=> y < x`]
);;
(* proved 3.3.18 *)
let lemma713 = prove
( `!e:real^2 a:real^2. e cross2 a <= &0 ==> &0 <= a cross2 e`,
MESON_TAC[crossanticommutative;REAL_ARITH `x <= &0 ==> &0 <= --(x)`]
);;
(* proved 3.3.18 *)
let additivity3_zero = prove
( `!a:real^2 b:real^2 c:real^2 d:real^2 e:real^2. B(a,b,vec(0):real^2) /\ B(e,d,vec(0):real^2) ==>
area(b,vec(0):real^2,d) + area4(a,b,d,e) = area(a,vec(0):real^2,e)`,
REPEAT GEN_TAC THEN
ONCE_REWRITE_TAC[betweennesssymmetry] THEN
REWRITE_TAC[B] THEN
REWRITE_TAC [NORM_ARITH `x:real^2-vec(0):real^2 = x:real^2`] THEN
STRIP_TAC THEN
REWRITE_TAC[area;tarea;area4;sarea4] THEN
ASM_REWRITE_TAC[] THEN
REWRITE_TAC [NORM_ARITH `x:real^2-vec(0):real^2 = x:real^2`] THEN
REWRITE_TAC[GSYM crossdistrib1; GSYM crossdistrib2; crosslinear1;crosslinear2;crosszero] THEN
REAL_SIMP_TAC THEN
ASM_SIMP_TAC [abspos] THEN
ASM_CASES_TAC `e:real^2 cross2 a:real^2 <= &0` THENL
[ ASM_SIMP_TAC[REAL_ARITH `x <= &0 ==> abs(x) = --x`] THEN
REAL_SIMP_TAC THEN
PATH_REWRITE_TAC "lrlrrr" [GSYM crossanticommutative] THEN
PATH_REWRITE_TAC "lrr" [GSYM crossanticommutative] THEN
REAL_SIMP_TAC THEN
REWRITE_TAC[ REAL_ARITH `x - y*w*x = (&1-y*w)*x`] THEN
(* `abs ((&1 - t * t') * (a cross2 e)) + t * t' * (a cross2 e) = --(e cross2 a)` *)
SUBGOAL_THEN `&0 < &1 - t:real * t':real` ASSUME_TAC THENL
[ ASM_MESON_TAC[lemma707]
;
WE_HAVE_BY lemma713 THEN
WE_HAVE_BY2 (REAL_SOS `&0 <x /\ &0 <= y ==> &0 <= x*y`) THEN
ASM_SIMP_TAC[ REAL_ARITH ` &0 <= x:real ==> abs(x:real) = x:real`] THEN
REWRITE_TAC[REAL_SUB_RDISTRIB] THEN
REAL_SIMP_TAC THEN
REWRITE_TAC [REAL_ARITH `x+y-x = y`] THEN
MESON_TAC[crossanticommutative]
]
;
(* goal `abs (a cross2 e + t * t' * (e cross2 a)) + t * t' * abs (e cross2 a) =
abs (e cross2 a)` with assumption `~(e cross2 a <= &0) *)
WE_HAVE_BY (left_to_right REAL_NOT_LE) THEN (* `&0 < e cross2 a` *)
PATH_REWRITE_TAC "lrlrrr" [GSYM crossanticommutative] THEN
REAL_SIMP_TAC THEN
REWRITE_TAC[ REAL_ARITH `x - y*w*x = (&1-y*w)*x`] THEN
SUBGOAL_THEN `&0 < &1 - t:real * t':real` ASSUME_TAC THENL
[ ASM_MESON_TAC[lemma707]
;
(* `abs ((&1 - t * t') * (a cross2 e)) + t * t' * abs (e cross2 a) =
abs (e cross2 a)` *)
PATH_REWRITE_TAC "lrlrr" [GSYM crossanticommutative] THEN
REAL_SIMP_TAC THEN
ASM_SIMP_TAC[abspos] THEN
REAL_SIMP_TAC THEN
REWRITE_TAC [REAL_ARITH `x+y-x = y`]
]
]
);;
(* proved 3.3.18 *)
let additivity3 = prove
( `!a:real^2 b:real^2 c:real^2 d:real^2 e:real^2. B(a,b,c:real^2) /\ B(e,d,c:real^2) ==>
area(b,c,d) + area4(a,b,d,e) = area(a,c,e)`,
ONCE_REWRITE_TAC[ SPEC `c:real^2` area_translation; SPEC `c:real^2` area4_translation;
SPEC `c:real^2` translation_invarianceB ] THEN
REWRITE_TAC[NORM_ARITH `!x:real^2. x-x = vec(0):real^2`] THEN
MESON_TAC[additivity3_zero]
);;
(* proved 3.4.18 *)
let lemma783 = VECTOR_ARITH
`!x:real e:real^2 a:real^2. x % e + y % a - z % e = (x-z) % e + y % a` ;;
(* proved 3.4.18 *)
let lemma787 = REAL_FIELD `!t:real u:real v:real a:real. &0 < t ==> ( a - u/t *a= v/t <=> a*t - a*u = v)`;;
(* proved 3.4.18 *)
let lemma790 = REAL_FIELD `!t:real u:real v:real a:real. &0 < t ==> ( v/t = a - u/t*a <=> v = a*t - a*u)`;;
(* proved 3.4.18 *)
let lemma791 = prove
( `!t:real s:real. &0 < t /\ t < &1 /\ &0 < s /\ s < &1 ==>
s - (t - t * s) / (&1 - t * s) *s = (s - t * s) / (&1 - t * s)`,
REPEAT STRIP_TAC THEN
SUBGOAL_THEN `&0 < &1-(t:real)*(s:real)` ASSUME_TAC THENL
[ ASM_MESON_TAC[lemma707]
;
ASM_SIMP_TAC [lemma787] THEN
(* (&1-t*s)*s - s*(t-t*s) = s-t*s *)
REWRITE_TAC[REAL_SUB_LDISTRIB; REAL_SUB_RDISTRIB] THEN
REAL_SIMP_TAC
]
);;
(* proved 3.4.18 *)
let lemma808 = prove
( `!t:real s:real. &0 < t /\ t < &1 /\ &0 < s /\ s < &1 ==>
(t - t * s) / (&1 - t * s) = t - (s - t * s) / (&1 - t * s) * t`,
REPEAT STRIP_TAC THEN
SUBGOAL_THEN `&0 < &1-(t:real)*(s:real)` ASSUME_TAC THENL
[ ASM_MESON_TAC[lemma707]
;
ASM_SIMP_TAC [ lemma790] THEN
(* (&1-t*s)*s - s*(t-t*s) = s-t*s *)
REWRITE_TAC[REAL_SUB_LDISTRIB; REAL_SUB_RDISTRIB] THEN
REAL_SIMP_TAC
]
);;
(* proved 3.4.18 *)
let lemma824 = prove
( `!a:real^2 e:real^2 u:real v:real x:real y:real.
x = v /\ y = u ==> x % e + y % a = u % a + v % e`,
REPEAT GEN_TAC THEN
ONCE_REWRITE_TAC [VECTOR_ARITH `!u:real^2 v:real^2. u=v <=> u-v = vec(0):real^2`] THEN
REWRITE_TAC [VECTOR_ARITH `!a:real^2 b:real^2 c:real^2 d:real^2. (a+b)-(c+d) = (a-d)+ (b-c)`] THEN
REWRITE_TAC[GSYM VECTOR_SUB_RDISTRIB] THEN
DISCH_TAC THEN
ASM_REWRITE_TAC[] THEN
REAL_SIMP_TAC THEN
REWRITE_TAC[VECTOR_MUL_LZERO] THEN
REWRITE_TAC[VECTOR_ADD_LID]
);;
(* proved 3.4.18 *)
let lemma839 = prove
( `!t:real s:real. &0 < t /\ t < &1 /\ &0 < s /\ s < &1 ==> &0 < t* (&1-s)/(&1-t*s)`,
REPEAT STRIP_TAC THEN
SUBGOAL_THEN `&0 < &1 - t*s` ASSUME_TAC THENL
[ ASM MESON_TAC[lemma707]
;
REWRITE_TAC[ REAL_FIELD `a*b/c = (a*b)/c`] THEN
MATCH_MP_TAC REAL_LT_DIV THEN
ASM_REWRITE_TAC[] THEN
WE_HAVE_BY (left_to_right lemma342) THEN (* &0 < &1 -s *)
ASM_MESON_TAC[REAL_MUL_POS_LT]
]
);;
(* proved 3.4.18 *)
let lemma854 = prove
( `!t:real s:real. &0 < t /\ t < &1 /\ &0 < s /\ s < &1 ==> t* (&1-s)/(&1-t*s) < &1`,
REPEAT STRIP_TAC THEN
SUBGOAL_THEN `&0 < &1 - t*s` ASSUME_TAC THENL
[ ASM MESON_TAC[lemma707]
;
REWRITE_TAC[ REAL_FIELD `a*b/c = (a*b)/c`] THEN
ASM_SIMP_TAC[ REAL_LT_LDIV_EQ] THEN (* `t * (&1 - s) < &1 * (&1 - t * s)` *)
REAL_SIMP_TAC THEN (* `t - s * t < &1 - s * t` *)
ONCE_REWRITE_TAC[GSYM REAL_SUB_LT] THEN
REWRITE_TAC[REAL_ARITH `x-y - (z-y) = x-z`] THEN (* &0 < &1 - t *)
REAL_SIMP_TAC THEN
ASM_REWRITE_TAC[]
]
);;
(* proved 3.4.18 *)
let lemma870 = VECTOR_ARITH `!x:real^2. x-(vec(0):real^2) = x`;;
(* proved 3.4.18 *)
let REAL_ABS_LE_0 = REAL_ARITH `!x:real. abs(x) <= &0 <=> x = &0`;;
(* proved 3.4.18 *)
let MINUS_EQ_0 = REAL_ARITH `--x = &0 <=> x = &0`;;
(* proved 3.4.18 *)
let PLUS_MINUS = VECTOR_ARITH `!x:real^2 y:real^2. (x+y)-x = y`;;
(* proved 3.4.18 *)
let lemma879 = REAL_ARITH `!t s r. (s-t*s)/r = s*(&1-t)/r`;;
(* proved 3.4.18 *)
let lemma880 = REAL_ARITH `!t s r. (t-t*s)/r = t*(&1-s)/r`;;
(* case of innerPasch with c = &0 *)
(* proved 3.4.18 *)
let pasch_zero = prove
( `!a:real^2 b:real^2 d:real^2 e:real^2.
B(vec(0):real^2,b,a) /\ B(vec(0):real^2,d,e) /\ &0 < area(a,vec(0):real^2,e) ==>
?(t:real^2). B(a,t,d) /\ B(e,t,b)`,
REPEAT GEN_TAC THEN
PATH_REWRITE_TAC "lr" [B] THEN
REWRITE_TAC[NORM_ARITH `!x:real^2. x-x = vec(0):real^2`;
lemma870
] THEN
REPEAT STRIP_TAC THEN
ASM_REWRITE_TAC[] THEN
ONCE_REWRITE_TAC[betweennesssymmetry] THEN
ABBREV_TAC `p:real = (t:real - t:real *t':real)/(&1-t:real * t':real)` THEN
ABBREV_TAC `q:real = (t':real - t:real *t':real)/(&1-t:real * t':real)` THEN
SUBGOAL_THEN `(d:real^2) + (p:real) % (a:real^2 - d:real^2) =
(b:real^2) + (q:real) % (e:real^2-b:real^2)` ASSUME_TAC THENL
[ (* goal is `d + p % (a - d) = b + q % (e - b)` *)
ASM_REWRITE_TAC[] THEN
REWRITE_TAC[VECTOR_SUB_LDISTRIB;VECTOR_MUL_ASSOC] THEN
EXPAND_TAC "p" THEN
EXPAND_TAC "q" THEN
REWRITE_TAC [lemma783] THEN (* collect e terms and a terms *)
ASM_MESON_TAC[lemma791; lemma808; lemma824]
;
(* only goal is `?t. B (t' % e,t,a) /\ B (t % a,t,e)` *)
EXISTS_TAC `(d:real^2) + (p:real) % ((a:real^2)-(d:real^2))` THEN
CONJ_TAC THENL
[ REWRITE_TAC[B] THEN
EXISTS_TAC `p:real` THEN
CONJ_TAC THENL
[ CONJ_TAC THENL
[ ASM_MESON_TAC[ VECTOR_ARITH `!x:real^2 y:real^2. (x+y)-x = y`]
;
(* Now the goal is &0 < p /\ p < &1 *)
CONJ_TAC THENL
[ (* goal is &0 < p *)
EXPAND_TAC "p" THEN
REWRITE_TAC [lemma880] THEN
ASM_MESON_TAC[lemma839]
;
(* goal is p < &1 *)
EXPAND_TAC "p" THEN
REWRITE_TAC [lemma880] THEN
ASM_MESON_TAC[lemma854]
]
]
;
(* The goal is ~(t' % e = a) *)
STRIP_TAC THEN (* put t' %e = a in the assumptions *)
UNDISCH_TAC `&0 < area((a:real^2), (vec(0):real^2), (e:real^2))` THEN
ASM_REWRITE_TAC[] THEN
REWRITE_TAC[ REAL_NOT_LT] THEN (* area(a, vec 0, e) <= &0 *) (* 2516 *)
REWRITE_TAC[area;tarea] THEN
REWRITE_TAC[lemma870] THEN (* abs( e cross2 a) <= &0 *)
REWRITE_TAC[REAL_ABS_LE_0] THEN (* e cross2 a = &0 *)
ASM_MESON_TAC[crossanticommutative;crosslinear1;
MINUS_EQ_0;crosszero; REAL_MUL_RZERO
]
]
;
(* The goal is B( t %a, d + p %(a-d),e) *)
ASM_REWRITE_TAC[] THEN
REWRITE_TAC[B] THEN
EXISTS_TAC `(q:real)` THEN
CONJ_TAC THENL
[ CONJ_TAC THENL
[ (* `(t % a + q % (e - t % a)) - t % a = q % (e - t % a)` *)
ASM_MESON_TAC[PLUS_MINUS]
;
(* goal is &0 < q /\ q < &1 *)
CONJ_TAC THENL
[ (* goal is &0 < q *)
EXPAND_TAC "q" THEN
REWRITE_TAC [lemma879] THEN
ASM_MESON_TAC[lemma839; REAL_MUL_AC]
;
(* goal is q < &1 *)
EXPAND_TAC "q" THEN
REWRITE_TAC [lemma879] THEN
ASM_MESON_TAC[lemma854; REAL_MUL_AC]
]
]
; (* The goal is ~(t % a = e ) *)
STRIP_TAC THEN (* put t % a = e in the assumptions *)
UNDISCH_TAC `&0 < area((a:real^2), (vec(0):real^2), (e:real^2))` THEN
REWRITE_TAC[area;tarea] THEN
REWRITE_TAC[ lemma870] THEN
REWRITE_TAC[ REAL_NOT_LT] THEN (* abs( e cross2 a) <= 0 *)
REWRITE_TAC[REAL_ABS_LE_0] THEN (* e cross2 a = &0 *)
ASM_MESON_TAC[crossanticommutative;crosslinear1;
MINUS_EQ_0;
crosszero; REAL_MUL_RZERO
]
]
]
] (* close SUBGOAL_THEN *)
);;
(* proved 3.4.18 *)
let innerPasch = prove
( `!a:real^2 b:real^2 c:real^2 d:real^2 e:real^2.
B(a,b,c) /\ B(e,d,c) /\ &0 < area(a,c,e) ==> ?t:real^2. B(a,t,d) /\ B(e,t,b)`,
REPEAT GEN_TAC THEN
ONCE_REWRITE_TAC[SPEC `c:real^2` translation_invarianceB ] THEN
ONCE_REWRITE_TAC[SPEC `c:real^2` area_translation ] THEN
REWRITE_TAC[NORM_ARITH `!x:real^2. x-x = vec(0):real^2`] THEN
STRIP_TAC THEN
WE_HAVE_BY_N 0 (left_to_right betweennesssymmetry) THEN
WE_HAVE_BY_N 1 (left_to_right betweennesssymmetry) THEN
WE_HAVE_BY3 pasch_zero THEN
EXISTS_TAC `(t:real^2) + (c:real^2)` THEN
REWRITE_TAC[VECTOR_ARITH `((x:real^2) + (y:real^2))-(y:real^2) = x:real^2`] THEN
ASM_REWRITE_TAC[]
);;
(* proved 3.4.18 *)
let pasch_quad = prove
( `!a:real^2 b:real^2 c:real^2 d:real^2 e:real^2.
B(a,b,c) /\ B(e,d,c) /\ &0 < area(a,c,e) ==> convex_quad(a,b,d,e)`,
REPEAT GEN_TAC THEN
REWRITE_TAC[convex_quad] THEN
STRIP_TAC THEN
WE_HAVE_BY3 innerPasch THEN
EXISTS_TAC `t:real^2` THEN
ASM_REWRITE_TAC[] THEN
(* Now the goal is LL(b,e,t) *)
REWRITE_TAC[LL] THEN
ASM_MESON_TAC[betweennesssymmetry]
);;
(* proved 3.6.18 *)
let lemma1085 = prove
( `!a:real^2 b:real^2 d:real^2 e:real^2.
B(a,b,vec(0):real^2) /\ B(e,d,vec(0):real^2) /\ &0 < area(a,vec(0):real^2,e) ==> &0 < area4(a,b,d,e)`,
REPEAT GEN_TAC THEN
ONCE_REWRITE_TAC [betweennesssymmetry] THEN
REWRITE_TAC[B;area;tarea] THEN
REWRITE_TAC [VECTOR_ARITH `c:real^2 - c:real^2 = vec(0):real^2`;
VECTOR_ARITH `x:real^2 - vec(0):real^2 = x:real^2`;
VECTOR_ARITH `vec(0):real^2 - x:real^2 = --(x:real^2)`;
VECTOR_ARITH `(p:real) % --(x:real^2) = (--p:real)%x:real^2`;
] THEN
STRIP_TAC THEN
REWRITE_TAC[area4;sarea4] THEN (* &0 < abs ((d - a) cross2 (b - e))` *)
ASM_REWRITE_TAC[] THEN (* `&0 < abs ((t' % e - a) cross2 (t % a - e))` *)
REWRITE_TAC[GSYM crossdistrib1;GSYM crossdistrib2] THEN
REAL_SIMP_TAC THEN
REWRITE_TAC[crosslinear1;crosslinear2;crosszero] THEN
REAL_SIMP_TAC THEN (* `&0 < abs (a cross2 e + t * t' * (e cross2 a))` *)
PATH_REWRITE_TAC "rrlr" [GSYM crossanticommutative] THEN
REWRITE_TAC [REAL_ARITH `-- (x:real) + (t:real)*(s:real)*(x:real) = --((&1- (t:real)*(s:real))*(x:real))`] THEN
REWRITE_TAC[REAL_ABS_NEG] THEN (* `&0 < abs ((&1 - t * t') * (e cross2 a))` *)
ASM_MESON_TAC[lemma707; (* &0 < 1-t*t' *)
REAL_SOS `&0 < c ==> abs(c *x) = c * abs(x)`;
REAL_LT_MUL
]
);;
(* proved 3.7.18 *)
let lemma1113 = prove
( `!a:real^2 b:real^2 c:real^2 d:real^2 e:real^2.
B(a,b,c) /\ B(e,d,c) /\ &0 < area(a,c,e) ==> &0 < area4(a,b,d,e)`,
REPEAT GEN_TAC THEN
ONCE_REWRITE_TAC[SPEC `c:real^2` translation_invarianceB ;
SPEC `c:real^2` area_translation;
SPEC `c:real^2` area4_translation
] THEN
REWRITE_TAC [VECTOR_ARITH `c:real^2 - c:real^2 = vec(0):real^2`] THEN
MESON_TAC[lemma1085]
);;
(* proved 3.7.18 *)
let cutoff1 = prove
( `!A:real^2 B1:real^2 C:real^2 a:real^2 b:real^2 c:real^2 E:real^2 D:real^2 e:real^2 d:real^2.
B(A,B1,C) /\ B(a,b,c) /\ B(E,D,C) /\ B(e,d,c) /\ ET(B1,C,D,b,c,d) /\ ET(A,C,E,a,c,e) ==> EF(A,B1,D,E,a,b,d,e)`,
REWRITE_TAC[ET] THEN
REPEAT STRIP_TAC THEN
WE_HAVE_BY3 pasch_quad THEN (* `convex_quad (A,B1,D,E)` *)
UNDISCH_TAC `&0 < area(A:real^2, C:real^2, E:real^2)` THEN
ASM_REWRITE_TAC[] THEN
DISCH_TAC THEN
WE_HAVE_BY3 (SPEC_ALL pasch_quad) THEN
REWRITE_TAC[EF;GSYM area4;euclid_quad] THEN
ASM_REWRITE_TAC[] THEN
CONJ_TAC THENL
[ ASM_MESON_TAC[lemma1113] (* solves goal `&0 < area4 (A,B1,D,E)` *)
;
CONJ_TAC THENL
[ ASM_MESON_TAC[lemma1113] (* solves goal `&0 < area4 (a,b,d,e)` *)
;
(* Remaining goal is `area4 (A,B1,D,E) = area4 (a,b,d,e)` *)
ASM_MESON_TAC[additivity3; REAL_SOS `!x y z X Y Z. x=X /\ z = Z /\ x+y=z /\ X+Y=Z ==> y = Y`]
]
]
);;
(* proved 3.7.18 *)
let lemma1150 = prove
( `!a:real^2 b:real^2 c:real^2 d:real^2 e:real^2. B(a,b,c) /\ B(e,d,c) /\ &0 < area(b,c,d) ==> &0 < area(a,c,e)`,
REPEAT GEN_TAC THEN
ONCE_REWRITE_TAC[betweennesssymmetry] THEN
REWRITE_TAC[B;area;tarea] THEN
STRIP_TAC THEN
UNDISCH_TAC `&0 < abs ((d:real^2 - c:real^2) cross2 (b:real^2 - c:real^2))` THEN
ASM_REWRITE_TAC[] THEN
REWRITE_TAC[crosslinear1;crosslinear2;REAL_ABS_MUL] THEN
WE_HAVE_BY2_NOMATCHING (SPECL [`t':real`; `t:real`] (REAL_SOS `!x y. &0 < x /\ &0 < y ==> &0 < abs(x)* abs(y)`)) THEN
ONCE_REWRITE_TAC [ REAL_ARITH `x*y*z = (x*y) *z`] THEN
ASM_SIMP_TAC [REAL_SOS `&0 < t ==> (&0 < t* x <=> &0 < x)`]
);;
(* proved 3.7.18 *)
let paste1 = prove
( `!A:real^2 B1:real^2 C:real^2 a:real^2 b:real^2 c:real^2 E:real^2 D:real^2 e:real^2 d:real^2.
B(A,B1,C) /\ B(a,b,c) /\ B(E,D,C) /\ B(e,d,c) /\ ET(B1,C,D,b,c,d) /\ EF(A,B1,D,E,a,b,d,e) ==> ET(A,C,E,a,c,e) `,
REWRITE_TAC[ET] THEN
REPEAT STRIP_TAC THEN
WE_HAVE_BY3 lemma1150 THEN
WE_HAVE_BY3 pasch_quad THEN (* `convex_quad (A,B1,D,E)` *)
UNDISCH_TAC `EF(A:real^2, B1:real^2, D:real^2, E:real^2, a:real^2, b:real^2, d:real^2, e:real^2)` THEN
REWRITE_TAC[EF;euclid_quad] THEN
ASM_REWRITE_TAC[] THEN
STRIP_TAC THEN
ASM_MESON_TAC[additivity3; REAL_ARITH `x=X /\ y= Y /\ x+y=z /\ X+Y=Z ==> z=Z`]
);;
(* proved 3.9.18 *)
let lemma1181 = prove
( `!t:real. ~(t = &0) /\ ~(&0 < t) ==> &0 < inv(&1-t) /\ inv(&1-t) < &1`,
REPEAT STRIP_TAC THENL
[ (* &0 < inv(&1-t) *)
REWRITE_TAC[REAL_LT_INV_EQ] THEN (* &0 < 1-t *)
ASM_SIMP_TAC[REAL_ARITH `(~(&0 < t)) ==> &0 < &1-t`]
;
(* Now the goal is inv(&1-t) < &1 *)
MATCH_MP_TAC REAL_INV_LT_1 THEN (* &1 < &1-t *)
ASM_SIMP_TAC[REAL_ARITH `(~(&0 < t)) /\ ~(t = &0)==> &1 < &1-t`]
]
);;
(* proved 3.9.18 *)
(* Turned out I already proved this! under the name NCarea. Sheesh! *)
let NC_area = prove
( `!a:real^2 b:real^2 d:real^2. NC(a,d,b) ==> &0 < area(a,d,b)`,
REPEAT GEN_TAC THEN
REWRITE_TAC[area;tarea;NC;REAL_ARITH `&0 < abs (x) <=> ~(x = &0)`;
crossequalszero; TAUT `~(p \/ q \/ r) <=> ~p /\ ~q /\ ~r`; NOT_EXISTS_THM] THEN
STRIP_TAC THEN
CONJ_TAC THENL
[ (* goal ~(b-d = zero2) *)
REWRITE_TAC[zero2; VECTOR_ARITH `x-y = vec(0):real^2 <=> x=y`] THEN
ASM_REWRITE_TAC[]
;
REWRITE_TAC[zero2; VECTOR_ARITH `x-y = vec(0):real^2 <=> x=y`] THEN
ASM_REWRITE_TAC[] THEN
(* `!t. ~(b - d = t % (a - d) /\ ~(t = &0))` *)
GEN_TAC THEN
STRIP_TAC THEN
ASM_CASES_TAC `&0 < t:real` THENL
[ (* case 0 < t *)
ASM_CASES_TAC `t:real < &1` THENL
[ SUBGOAL_THEN `B(d:real^2, b:real^2, a:real^2)` ASSUME_TAC THENL
[ REWRITE_TAC[B] THEN
ASM_REWRITE_TAC[] THEN
EXISTS_TAC `t:real` THEN
ASM_REWRITE_TAC[]
;
ASM_MESON_TAC[betweennesssymmetry]
]
;
(* Now the case ~(t < &1 ) *)
ASM_CASES_TAC `t:real = &1` THENL
[ ASM_MESON_TAC [VECTOR_MUL_LID;
VECTOR_ARITH `!x:real^2 y:real^2 z:real^2. x-z = y-z ==> x = y`]
;
WE_HAVE_BY (SPEC `t:real` lemma1123) THEN
(* [`!x y. x = inv t % y <=> t % x = y`] *)
WE_HAVE_BY3 lemma1170 THEN
(* 0 < inv(t) < 1 *)
SUBGOAL_THEN `B(d:real^2,a:real^2,b:real^2)` ASSUME_TAC THENL
[ REWRITE_TAC[B] THEN
ASM_REWRITE_TAC[] THEN
EXISTS_TAC `inv(t:real)` THEN
ASM_REWRITE_TAC[]
;
ASM_MESON_TAC[]
]
] (* done with case ~(t = 1 *)
] (* done also with case ~(t < &1) *)
; (* case ~(&0 < t) with goal F *)
UNDISCH_TAC `~B(a:real^2, d:real^2, b:real^2)` THEN
ASM_REWRITE_TAC[] THEN (* goal B(a,d,b) *)
REWRITE_TAC[B] THEN
ASM_REWRITE_TAC[] THEN
EXISTS_TAC `inv(&1-t)` THEN
WE_HAVE_BY3 lemma1190 THEN
ASM_REWRITE_TAC[] THEN
WE_HAVE_BY2 lemma1181 THEN
ASM_REWRITE_TAC[]
] (* end case ~(&0 < t) *)
] (* end of the first CONJ_TAC *)
);;
(* proved 3.9.18 *)
let insertp = VECTOR_ARITH `!p:real^2 x:real^2 y:real^2. x-y = (x-p) - (y-p)`;;
(* proved 3.9.18 *)
let quad_area_pos1 = prove
( `!a:real^2 b:real^2 c:real^2 d:real^2 p:real^2.
B (b,p,d) /\ B (a,p,c) /\ &0 < area4(a,b,c,d) ==> &0 < area(a,p,b)`,
REPEAT GEN_TAC THEN
REWRITE_TAC[B] THEN
REWRITE_TAC[area;tarea;area4;sarea4] THEN
STRIP_TAC THEN
ONCE_REWRITE_TAC[crossreverse] THEN
ASM_REWRITE_TAC[] THEN
REWRITE_TAC[crosslinear1;crosslinear2] THEN
REWRITE_TAC[crossflip] THEN
ONCE_REWRITE_TAC[crossreverse] THEN
REWRITE_TAC[ REAL_RING `x*y*z = (x*y)*z`] THEN
REWRITE_TAC[REAL_ABS_MUL] THEN
ASM_SIMP_TAC[abspos] THEN
ASM_MESON_TAC[REAL_LT_MUL]
);;
(* proved 3.9.18 *)
let area_non_negative = prove
( `!a:real^2 b:real^2 c:real^2. &0 <= area(a,b,c)`,
MESON_TAC[area; REAL_ABS_POS]
);;
(* proved 3.9.18 *)
let quad_area_pos2 = prove
( `!a:real^2 b:real^2 c:real^2 d:real^2 p:real^2.
B (b,p,d) /\ B (a,p,c) /\ &0 < area4(a,b,c,d) ==> &0 < area(a,d,b)`,
REPEAT GEN_TAC THEN
STRIP_TAC THEN
WE_HAVE_BY_N 0 (left_to_right betweennesssymmetry) THEN
WE_HAVE_BY_N 1 (left_to_right betweennesssymmetry) THEN
WE_HAVE_BY_N 3 (SPEC `a:real^2` area_additive) THEN
WE_HAVE_BY3 quad_area_pos1 THEN
ASM_MESON_TAC[area_non_negative; area_permutation1; REAL_SOS `&0 <= x /\ &0 < y ==> &0 < x+y`]
);;
(* proved 4.11.18 *)
let quad_area_pos3 = prove
( `!a:real^2 b:real^2 c:real^2 d:real^2 p:real^2.
B (b,p,d) /\ B (a,p,c) /\ &0 < area4(a,b,c,d) ==> &0 < area(a,b,c)`,
MESON_TAC[quad_area_pos2;area_permutation1;area_permutation2; area4flip]
);;
(* proved 3.9.18 *)
let connectivity = prove
( `!b:real^2 p:real^2 e:real^2 t:real^2. B(b,p,t) /\ B(b,t,e) ==> B(b,p,e)`,
REPEAT GEN_TAC THEN
REWRITE_TAC[B] THEN
STRIP_TAC THEN
EXISTS_TAC `(t':real) * (t'':real)` THEN
REPEAT STRIP_TAC THENL
[ ASM_REWRITE_TAC[] THEN
REWRITE_TAC[VECTOR_MUL_ASSOC]
;
ASM_MESON_TAC[REAL_LT_MUL]
;
ASM_MESON_TAC[lemma01]
;
UNDISCH_TAC `~(b:real^2 = e:real^2)` THEN
ASM_REWRITE_TAC[]
]
);;
(* proved 3.11.18 *)
let REAL_MUL_LT = REAL_SOS `!c:real x:real y:real. &0 < c /\ x < y ==> c*x < c*y`;;
(* proved 3.11.18 *)
let lemma1326 = prove
( `!t:real z:real. &0 < t /\ t < z ==> t*inv(z) < &1`,
REPEAT STRIP_TAC THEN
WE_HAVE_BY2 REAL_LT_TRANS THEN (* &0 < z *)
WE_HAVE_BY REAL_LT_INV THEN (* &0 < inv(z) *)
WE_HAVE_BY_NOMATCHING (SPEC `z:real` REAL_LT_IMP_NZ) THEN (* `~(z = &0)` *)
WE_HAVE_BY2_NOMATCHING (SPECL [`inv(z:real)`;`t:real`; `z:real`] REAL_MUL_LT) THEN (* inv(z)*t < inv(z)*z *)
UNDISCH_TAC `inv(z:real) * (t:real) < inv(z:real) * (z:real)` THEN
ASM_SIMP_TAC[REAL_MUL_LINV] THEN
REWRITE_TAC[REAL_MUL_SYM]
);;
(* proved 3.11.18 *)
let connectivity2A = prove
( `!b:real^2 c:real^2 d:real^2. B(vec(0):real^2,b,d) /\ B(b,c,d) ==> B(vec(0):real^2,b,c)`,
REPEAT GEN_TAC THEN
REWRITE_TAC [VECTOR_ARITH `x:real^2-vec(0):real^2 = x:real^2`] THEN
REWRITE_TAC[B] THEN
REWRITE_TAC [VECTOR_ARITH `x:real^2-vec(0):real^2 = x:real^2`] THEN
STRIP_TAC THEN
WE_HAVE_BY2_NOMATCHING (SPEC `t:real` lemma1104) THEN (* 0 < 1-t < 1 *)
WE_HAVE_BY4_NOMATCHING (SPECL [`t':real`; `&1-t:real`] lemma01) THEN (* 0 < t' * (1-t) < 1 *)
ABBREV_TAC `lam:real = t:real * inv((t:real) + (t':real) * (&1-t:real))` THEN
SUBGOAL_THEN `&0 < lam:real` ASSUME_TAC THENL
[ ASM_MESON_TAC[ REAL_LT_01; REAL_LT_ADD; REAL_LT_MUL; REAL_LT_INV]
;
SUBGOAL_THEN `lam:real < &1` ASSUME_TAC THENL
[ SUBGOAL_THEN `&0 < inv((t:real) + (t':real) * (&1-t:real))` ASSUME_TAC THENL
[ MATCH_MP_TAC REAL_LT_INV THEN (* 0 < t + t*(1-t) *)
ASM_MESON_TAC[REAL_LT_ADD; REAL_LT_01] THEN
MATCH_MP_TAC (REAL_ARITH `&0 < x ==> &1 < &1 + x` ) THEN
ASM_REWRITE_TAC[]
;
EXPAND_TAC "lam" THEN
(* Now the goal is `t * inv (t + t' * (&1 - t)) < &1` *)
ASM_MESON_TAC[ REAL_SOS `!t:real x:real. &0 < x ==> t < t+x`; lemma1326]
]
;
EXISTS_TAC `lam:real` THEN
REWRITE_TAC [VECTOR_ARITH `x:real^2-vec(0):real^2 = x:real^2`] THEN
ASM_REWRITE_TAC[] THEN
EXPAND_TAC "lam" THEN
(* `t % d = (t * inv (&1 + t' * (&1 - t))) % c /\ ~(vec 0 = c)` *)
CONJ_TAC THENL
[ (* t % d = (t * inv (&1 + t' * (&1 - t))) % c` *)
WE_HAVE_BY_NOMATCHING (SPEC `t:real` REAL_LT_IMP_NZ) THEN (* ~(t = &0) *)
REWRITE_TAC[GSYM VECTOR_MUL_ASSOC] THEN
AP_TERM_TAC THEN (* d = inv (t + t' * (&1 - t)) % c` *)
WE_HAVE_BY2_NOMATCHING (SPECL [`t:real`; `t':real * (&1 - t:real)`] REAL_LT_ADD) THEN
WE_HAVE_BY_NOMATCHING (SPEC `(t:real) + (t':real) * (&1 - t:real)` REAL_LT_IMP_NZ) THEN
ASM_SIMP_TAC[lemma1123] THEN (* `(t + t' * (&1 - t)) % d = c` *)
(* Now to eliminate c in favor of b and d, and then to eliminate b in favor of d *)
WE_HAVE_BY (NORM_ARITH `!c:real^2 b:real^2 x:real^2. c-b = x ==> c = b+x`) THEN
(* `c = b + t' % (d - b)` in assumptions *)
ASM_REWRITE_TAC[] THEN (* `(t + t' * (&1 - t)) % d = t % d + t' % (d - t % d)` *)
REWRITE_TAC[VECTOR_SUB_LDISTRIB;VECTOR_ADD_RDISTRIB] THEN
AP_TERM_TAC THEN (* (t' * (&1 - t)) % d = t' % d - t' % t % d` *)
REWRITE_TAC[REAL_SUB_LDISTRIB; REAL_MUL_RID; VECTOR_SUB_RDISTRIB] THEN
AP_TERM_TAC THEN
REWRITE_TAC [VECTOR_MUL_ASSOC]
;
(* Now the last goal: ~(vec 0 = c) *)
WE_HAVE_BY (NORM_ARITH `!c:real^2 b:real^2 x:real^2. c-b = x ==> c = b+x`) THEN
WE_HAVE_BY2_NOMATCHING (SPECL [`t:real`; `t':real * (&1 - t:real)`] REAL_LT_ADD) THEN
WE_HAVE_BY_NOMATCHING (SPEC `(t:real) + (t':real) * (&1 - t:real)` REAL_LT_IMP_NZ) THEN
ASM_REWRITE_TAC[] THEN
REWRITE_TAC [VECTOR_SUB_LDISTRIB] THEN
REWRITE_TAC [VECTOR_MUL_ASSOC] THEN
REWRITE_TAC [GSYM VECTOR_SUB_RDISTRIB] THEN
REWRITE_TAC [GSYM VECTOR_ADD_RDISTRIB] THEN
REWRITE_TAC [REAL_ARITH `t + t' - t' *t = t + t' * (&1-t)`] THEN
ASM_MESON_TAC[VECTOR_MUL_EQ_0]
]
]
]
);;
(* proved 3.11.18 *)
let connectivity2 = prove
( `!a:real^2 b:real^2 c:real^2 d:real^2. B(a,b,d) /\ B(b,c,d) ==> B(a,b,c)`,
REPEAT GEN_TAC THEN
ONCE_REWRITE_TAC[SPEC `a:real^2` translation_invarianceB] THEN
REWRITE_TAC [VECTOR_ARITH `(x:real^2)-x:real^2 = vec(0):real^2`] THEN
MESON_TAC[connectivity2A]
);;
(* proved 3.11.18 *)
let connectivity3 = prove
( `!a:real^2 b:real^2 c:real^2 d:real^2. B(a,b,d) /\ B(b,c,d) ==> B(a,c,d)`,
MESON_TAC[betweennesssymmetry;connectivity]
);;
(* proved 3.12.18 *)
let connectivity4 = prove
( `!a:real^2 b:real^2 c:real^2 d:real^2. B(a,c,d) /\ B(a,b,c) ==> B(b,c,d)`,
MESON_TAC[betweennesssymmetry;connectivity2]
);;
(* proved 3.12.18 *)
let connectivity5 = prove
( `!a:real^2 b:real^2 c:real^2 d:real^2. B(a,c,d) /\ B(a,b,c) ==> B(a,b,d)`,
MESON_TAC[betweennesssymmetry;connectivity]
);;
(* proved 3.12.18 *)
let connectivity6 = prove
( `!a:real^2 b:real^2 c:real^2 d:real^2. B(a,c,d) /\ B(a,b,c) ==> B(b,c,d)`,
MESON_TAC[betweennesssymmetry;connectivity2]
);;
(* proved 4.13.18 *)
let VECTOR_MUL_EQ = prove
( `!z:real x:real^2 y:real p:real^2. &0 < z ==> ( x = (y/z)%p <=> z%x = y%p)`,
REPEAT GEN_TAC THEN
REWRITE_TAC[VEC2_COMPONENTS;VECTOR_MUL_COMPONENT] THEN
ASM_SIMP_TAC [ REAL_FIELD `&0 < z ==> ( x = (y/z)*w <=> z*x = y*w)`]
);;
(* proved 4.13.18 *)
let lemma1485 = prove
( `!c:real x:real^2. &0 < c ==> c % x = vec(0):real^2 ==> x = vec(0):real^2`,
REPEAT GEN_TAC THEN
DISCH_TAC THEN
VEC2_TAC THEN
REWRITE_TAC[VECTOR_MUL_COMPONENT] THEN
ASM_MESON_TAC[REAL_LT_IMP_NZ; nonzero_product]
);;
(* proved 4.13.18 *)
let connectivity7 = prove
( `!a:real^2 b:real^2 c:real^2 d:real^2. B(a,b,c) /\ B(b,c,d) ==> B(a,b,d)`,
REPEAT GEN_TAC THEN
REWRITE_TAC[B] THEN
REPEAT STRIP_TAC THEN
EXISTS_TAC `t*t' /(&1-t + t*t')` THEN
(* next three lines deduce 0 < 1-t < 1 and 0 < 1-t' < 1 *)
WE_HAVE_BY2 lemma1104 THEN
UNDISCH_TAC `&0 < t:real` THEN
DISCH_TAC THEN
WE_HAVE_BY2 lemma1104 THEN
SUBGOAL_THEN `&0 < &1-t+t*t'` ASSUME_TAC THENL
[ ASM_MESON_TAC[REAL_LT_MUL; (* to get 0 < t*t' *)
REAL_LT_ADD;
REAL_ADD_AC]
;
REWRITE_TAC [REAL_FIELD `x*y/z = (x*y)/z`] THEN
ASM_SIMP_TAC[VECTOR_MUL_EQ] THEN
SUBGOAL_THEN `(&1-(t:real) + (t:real) *(t':real)) % (t:real) %((c:real^2)-a:real^2)=
((t:real)*(t':real))%((d:real^2)-a:real^2)` ASSUME_TAC THENL
[ (* 1-t+t*t') %t % (c=a) = (t*t')%(d-a) *)
WE_HAVE_BY_N 0 EQ_SYM THEN
ONCE_ASM_REWRITE_TAC[] THEN
(* (&1 - t + t * t') % (b - a) = (t * t') % (d - a)` *)
REWRITE_TAC[VECTOR_ADD_RDISTRIB] THEN
(* `(&1 - t) % (b - a) + (t * t') % (b - a) = (t * t') % (d - a)` *)
REWRITE_TAC[ NORM_ARITH `!x:real^2 y:real^2 z:real^2. x+y=z <=> x = z-y`] THEN
(* `(&1 - t) % (b - a) = (t * t') % (d - a) - (t * t') % (b - a)` *)
REWRITE_TAC [GSYM VECTOR_SUB_LDISTRIB] THEN
(* `(&1 - t) % (b - a) = (t * t') % (d - a - (b - a))` *)
REWRITE_TAC [NORM_ARITH `!a:real^2 b:real^2 d:real^2. d-a - (b-a) = d-b`] THEN
(* `(&1 - t) % (b - a) = (t * t') % (d - b)` *)
REWRITE_TAC [GSYM VECTOR_MUL_ASSOC] THEN
WE_HAVE_BY_N 3 EQ_SYM THEN
(* Move an assumption temporarily out of the assumption list *)
UNDISCH_TAC `b:real^2-a:real^2 = t:real % (c:real^2-a:real^2)` THEN
(* so it won't be used in the next line *)
ONCE_ASM_REWRITE_TAC[] THEN
(* and then put it back *)
DISCH_TAC THEN
(* `(&1 - t) % (b - a) = t % (c - b)` *)
REWRITE_TAC[VECTOR_SUB_RDISTRIB;VECTOR_MUL_LID] THEN
(* `b - a - t % (b - a) = t % (c - b)` *)
ONCE_REWRITE_TAC[NORM_ARITH `!x:real^2 y:real^2 z:real^2. x-y = z <=> x = z+y`] THEN
(* `b - a = t % (c - b) + t % (b - a)` *)
REWRITE_TAC[GSYM VECTOR_ADD_LDISTRIB] THEN
REWRITE_TAC[NORM_ARITH `!a:real^2 b:real^2 c:real^2. c-b +b-a = c-a`] THEN
(* `b - a = t % (c - a)` *)
ASM_REWRITE_TAC[]
;
REPEAT CONJ_TAC THENL (* 4 subgoals *)
[ ASM_REWRITE_TAC[]
;
(* next goal is &0 < (t * t') / (&1 - t + t * t')` *)
MATCH_MP_TAC REAL_LT_DIV THEN
ASM_REWRITE_TAC[] THEN
MATCH_MP_TAC REAL_LT_MUL THEN
ASM_REWRITE_TAC[]
;
(* next goal is `(t * t') / (&1 - t + t * t') < &1` *)
MATCH_MP_TAC lemma1490 THEN
ASM_REWRITE_TAC[] THEN
CONJ_TAC THENL
[ MATCH_MP_TAC REAL_LT_MUL THEN
ASM_REWRITE_TAC[]
;
REWRITE_TAC[ REAL_SOS `x < y + x <=> &0 < y`] THEN
ASM_REWRITE_TAC[]
]
;
(* last goal is ~(a=d) *)
STRIP_TAC THEN
UNDISCH_TAC `(&1-(t:real) + (t:real) *(t':real)) % (t:real) %((c:real^2)-a:real^2)=
((t:real)*(t':real))%((d:real^2)-a:real^2)` THEN
WE_HAVE_BY_N 0 EQ_SYM THEN
ONCE_ASM_REWRITE_TAC[] THEN
ONCE_ASM_REWRITE_TAC[] THEN
REWRITE_TAC[ VECTOR_ARITH `x:real^2-x:real^2 = vec(0):real^2`;
VECTOR_MUL_RZERO] THEN
ASM_MESON_TAC[ VECTOR_ARITH `!x:real^2 y:real^2. x-y = vec(0):real^2 <=> x=y`;
VECTOR_MUL_RZERO; lemma1485]
]
]
]
);;
let connectivity8 = prove
( `!a:real^2 b:real^2 c:real^2 d:real^2. B(a,b,c) /\ B(b,c,d) ==> B(a,c,d)`,
MESON_TAC[betweennesssymmetry;connectivity7]
);;
(* proved 3.9.18 *)
let pasch_quad2A = prove
( `!a:real^2 b:real^2 c:real^2 d:real^2 e:real^2.
B(b,c,d) /\ convex_quad(a,b,d,e)/\ &0 < area4(a,b,d,e) ==> convex_quad(a,b,c,e)`,
REPEAT GEN_TAC THEN
ONCE_REWRITE_TAC[area4_permutation] THEN (* area4(a,e,d,b). We need area4(b,a,e,d) *)
ONCE_REWRITE_TAC[area4perm] THEN
ONCE_REWRITE_TAC[area4perm] THEN
ONCE_REWRITE_TAC[area4perm] THEN (* at last, area4(b,a,e,d) *)
REWRITE_TAC[convex_quad] THEN
STRIP_TAC THEN
WE_HAVE_BY3 quad_area_pos2 THEN
WE_HAVE_BY3 innerPasch THEN
(* Now t' is between a and c and between b and t *)
EXISTS_TAC `t':real^2` THEN
ASM_REWRITE_TAC[] THEN
(* Now the goal is B(b,t',e) and we have B(b,t', t) and B(b,t,e) *)
ASM_MESON_TAC[connectivity]
);;
(* proved 3.9.18 *)
let weak_additivity2 = prove
( `!a:real^2 b:real^2 c:real^2 e:real^2. convex_quad(a,b,c,e) ==>
area4(a,b,c,e) = area(a,e,b) + area(c,e,b)`,
REPEAT GEN_TAC THEN
REWRITE_TAC[convex_quad] THEN
STRIP_TAC THEN
WE_HAVE_BY2_NOMATCHING
(SPECL [`a:real^2`; `b:real^2`; `c:real^2`; `e:real^2`; `t:real^2`] additivity_by_quarters) THEN
ONCE_REWRITE_TAC [area_permutation2] THEN
WE_HAVE_BY_N 1 (GSYM (SPECL [ `a:real^2` ; `b:real^2`; `e:real^2`; `t:real^2`]
area_additive)) THEN
ASM_SIMP_TAC [GSYM (SPEC `a:real^2` area_additive)] THEN
REAL_SIMP_TAC THEN
PATH_REWRITE_TAC "r" [area_permutation2] THEN (* eta is good *)
PATH_REWRITE_TAC "rr" [area_permutation2] THEN
PATH_REWRITE_TAC "rr" [area_permutation1] THEN (* cte is good *)
PATH_REWRITE_TAC "rrr" [area_permutation2] THEN (* atb *)
PATH_REWRITE_TAC "rrrr" [area_permutation2] THEN
PATH_REWRITE_TAC "rrrr" [area_permutation1] THEN (* btc *)
ASM_MESON_TAC[REAL_ADD_AC]
);;
(* proved 4.11.18 *)
let weak_additivity3 = prove
( `!a:real^2 b:real^2 c:real^2 e:real^2. convex_quad(a,b,c,e) ==>
area4(a,b,c,e) = area(a,b,c) + area(c,e,a)`,
REPEAT GEN_TAC THEN
ONCE_REWRITE_TAC[area4flip] THEN
ONCE_REWRITE_TAC[convex_quadflip2] THEN
STRIP_TAC THEN
WE_HAVE_BY weak_additivity2 THEN
ASM_MESON_TAC[area_permutation1;area_permutation2; REAL_ADD_AC]
);;
(* proved 3.9.18 *)
let pasch_quad2B = prove
( `!a:real^2 b:real^2 c:real^2 d:real^2 e:real^2.
B(b,c,d) /\ convex_quad(a,b,d,e)/\ &0 < area4(a,b,d,e) ==> &0 < area4(a,b,c,e)`,
REPEAT GEN_TAC THEN
STRIP_TAC THEN
ASSUME_TAC (ASSUME `convex_quad(a:real^2, b:real^2, d:real^2, e:real^2)`) THEN
UNDISCH_TAC `convex_quad(a:real^2, b:real^2, d:real^2, e:real^2)` THEN
REWRITE_TAC[convex_quad] THEN
STRIP_TAC THEN
WE_HAVE_BY3 quad_area_pos2 THEN (* &0 < area(a,e,b) added to assumptions *)
WE_HAVE_BY3 pasch_quad2A THEN (* convex_quad(a,b,c,e) *)
ASM_SIMP_TAC[weak_additivity2] THEN (* produces &0 < area(a,e,b) + area(c,e,b) *)
ASM_MESON_TAC[area_non_negative; REAL_SOS `&0 < x /\ &0 <= y ==> &0 < x + y`]
);;
(* proved 3.9.18 *)
let additivity4 = prove
( `!a:real^2 b:real^2 c:real^2 d:real^2 e:real^2. B(b,c,d) /\ convex_quad(a,b,c,e) /\
convex_quad(a,b,d,e) ==> area4(a,b,c,e) + area(c,e,d) = area4(a,b,d,e)`,
REPEAT GEN_TAC THEN
STRIP_TAC THEN
ASSUME_TAC (ASSUME `convex_quad(a:real^2, b:real^2, c:real^2, e:real^2)`) THEN
UNDISCH_TAC `convex_quad(a:real^2, b:real^2, c:real^2, e:real^2)` THEN
REWRITE_TAC[convex_quad] THEN
STRIP_TAC THEN
ASM_SIMP_TAC[weak_additivity2] THEN
REAL_SIMP_TAC THEN
(* area (a,e,b) + area (c,e,b) + area (c,e,d) =
area (a,e,b) + area (d,e,b)` *)
REWRITE_TAC [REAL_ARITH `x + y + z = x + w <=> y+z = w`] THEN
(* goal is `area (c,e,b) + area (c,e,d) = area (d,e,b)` *)
WE_HAVE_BY_N 0 (SPEC `e:real^2` area_additive) THEN
(* [`area (c,e,b) + area (d,e,c) = area (e,b,d)` added to assumptions *)
PATH_REWRITE_TAC "lrr" [area_permutation2] THEN
PATH_REWRITE_TAC "lrr" [area_permutation1] THEN
PATH_REWRITE_TAC "r" [area_permutation1] THEN
ASM_REWRITE_TAC[]
);;
(* proved 3.11.18 *)
let triangle1 = prove
( `!a:real^2 b:real^2 c:real^2 d:real^2 e:real^2.
really_triangle(a,b,d,e) /\ &0 < area4(a,b,d,e) /\ B(b,c,d) ==> convex_quad(a,b,c,e)\/ really_triangle(a,b,c,e)`,
REPEAT GEN_TAC THEN
REWRITE_TAC[really_triangle] THEN
STRIP_TAC THENL (* 4 goals *)
[ (* B(a,b,d), which is contradictory as we will show *)
WE_HAVE_BY2 connectivity2 THEN (* B(a,b,c) *)
ASM_REWRITE_TAC[]
;
WE_HAVE_BY2 connectivity THEN (* B(b,c,e) *)
ASM_REWRITE_TAC[]
;
(* given B(d,e,a) and B(b,c,d) and 0 < area4(a,b,d,e) *)
DISJ1_TAC THEN (* select the goal: convex_quad(a,b,c,e) *)
WE_HAVE_BY_N 0 (left_to_right betweennesssymmetry) THEN
UNDISCH_TAC `&0 < area4(a:real^2, b:real^2,d:real^2, e:real^2)` THEN
ONCE_REWRITE_TAC[area4perm] THEN
ONCE_REWRITE_TAC[area4perm] THEN
ASM_SIMP_TAC [GSYM areaequalsarea4] THEN (* `&0 < area (d,a,b) ==> convex_quad (a,b,c,e)` *)
REWRITE_TAC[area_permutation1] THEN (* &0 < area(a,b,d) *)
ONCE_REWRITE_TAC[area_permutation2] THEN
DISCH_TAC THEN
WE_HAVE_BY3 innerPasch THEN
ASM_MESON_TAC[convex_quad]
;
(* given B(e,a,b) and B(b,c,d) and 0 < area4(a,b,d,e) *)
ASM_REWRITE_TAC[] (* concluding B(e,a,b) *)
]
);;
(* Freek's code: *)
let (NTH_ASSUM: int -> thm_tactic -> tactic) =
fun n ttac (asl,w as g) -> ttac (snd (el (length asl - n - 1) asl)) g;;
(* proved 3.12.18 *)
let triangle2 = prove
( `!a:real^2 b:real^2 c:real^2 d:real^2 e:real^2.
really_triangle(a,b,d,e) /\ &0 < area4(a,b,d,e) /\ B(b,c,d) ==> &0 < area4(a,b,c,e)`,
REPEAT GEN_TAC THEN
REWRITE_TAC[really_triangle] THEN
STRIP_TAC THENL (* 4 goals *)
[ (* B(a,b,d) and B(b,c,d) and 0 < area4(a,b,d,a) |- 0 < area4(a,b,c,e) *)
WE_HAVE_BY2 connectivity3 THEN
UNDISCH_TAC `B(a:real^2, c:real^2, d:real^2)` THEN
UNDISCH_TAC `&0 < area4(a:real^2, b:real^2, d:real^2, e:real^2)` THEN
REWRITE_TAC[B; area4;sarea4] THEN
REPEAT STRIP_TAC THEN (* this STRIP_TAC only creates one goal *)
(* goal `&0 < abs ((c - a) cross2 (b - e))` *)
ASM_REWRITE_TAC[] THEN (* &0 < abs (t % (d - a) cross2 (b - e))` *)
REWRITE_TAC[crosslinear1;REAL_ABS_MUL] THEN
ASM_SIMP_TAC[abspos] THEN (* `&0 < t * abs ((d - a) cross2 (b - e))` *)
ASM_MESON_TAC[REAL_LT_MUL]
;
(* second goal: B (b,d,e) and &0 < area4(a,b,d,e) and B(b,c,d) imply 0 < area4(a,b,c,e ) *)
(* so we want to convert both area4 terms to area(abe) *)
(* So we need area4(bdea) and area4(bcea) and we will need B(b,c,e) *)
UNDISCH_TAC `&0 < area4(a:real^2,b:real^2, d:real^2,e:real^2)` THEN
WE_HAVE_BY2 connectivity5 THEN
ONCE_REWRITE_TAC[area4perm] THEN
ASM_SIMP_TAC [GSYM areaequalsarea4]
;
(* third goal: B(d,e,a) and B(b,c,d) and 0 < area4(abde) |- 0 < area4(abce) *)
(* plan: convert area4(abde) to area(adb) and then use lemma1113 *)
UNDISCH_TAC `&0 < area4(a:real^2,b:real^2, d:real^2, e:real^2)` THEN
PATH_REWRITE_TAC "lr" [area4perm2] THEN
PATH_REWRITE_TAC "lr" [area4perm] THEN
PATH_REWRITE_TAC "lr" [area4perm] THEN
PATH_REWRITE_TAC "lr" [area4perm] THEN
WE_HAVE_BY_N 0 (left_to_right betweennesssymmetry) THEN
ASM_SIMP_TAC [GSYM areaequalsarea4] THEN
ASM_MESON_TAC[area4perm;area4perm2;lemma1113]
; (* last goal: B(e,a,b) and B(b,c,d) and 0 < area4(abde) |- 0 < area4(abce) *)
(* plan, convert both area4 terms to area terms, namely ebd and ebc.
Then write them as cross products, expand B, and simplify *)
WE_HAVE_BY_N 0 (left_to_right betweennesssymmetry) THEN
UNDISCH_TAC `&0 < area4(a:real^2, b:real^2, d:real^2, e:real^2)` THEN
PATH_REWRITE_TAC "lr" [area4perm] THEN
PATH_REWRITE_TAC "lr" [area4perm] THEN
PATH_REWRITE_TAC "lr" [area4perm] THEN
ASM_SIMP_TAC [GSYM areaequalsarea4] THEN
DISCH_TAC THEN
ONCE_REWRITE_TAC [area4perm] THEN
ONCE_REWRITE_TAC [area4perm] THEN
ONCE_REWRITE_TAC [area4perm] THEN
ASM_SIMP_TAC [GSYM areaequalsarea4] THEN
UNDISCH_TAC `B(b:real^2, c:real^2, d:real^2)` THEN
UNDISCH_TAC `&0 < area(e:real^2, b:real^2, d:real^2)` THEN
REWRITE_TAC[B; area; tarea] THEN
REPEAT STRIP_TAC THEN (* &0 < abs ((c - b) cross2 (e - b)) *)
ASM_REWRITE_TAC[] THEN
REWRITE_TAC [crosslinear1] THEN
REWRITE_TAC [REAL_ABS_MUL] THEN
ASM_SIMP_TAC [abspos] THEN
ASM_MESON_TAC[REAL_LT_MUL]
]
);;
(* proved 3.12.18 *)
let between_area_zero = prove
( `!a:real^2 b:real^2 c:real^2. B(a,b,c) ==> area(b,a,c) = &0`,
REPEAT GEN_TAC THEN
REWRITE_TAC[B;area;tarea] THEN
STRIP_TAC THEN
ASM_REWRITE_TAC[] THEN
REWRITE_TAC[crosslinear2] THEN
REWRITE_TAC[crosszero; REAL_MUL_RZERO;REAL_ABS_0]
);;
(* proved 3.12.18 *)
let cutoff2_helper = prove
( `!A:real^2 B1:real^2 C:real^2 D:real^2 E:real^2 a:real^2 b:real^2 c:real^2 d:real^2 e:real^2.
B(B1,C,D) /\ B(b,c,d) /\ ET(C,D,E,c,d,e)/\ area4(A,B1,D,E) = area4(a,b,d,e) /\ &0 < area4(a,b,d,e) /\ &0 < area4(A,B1,D,E) /\
convex_quad(A,B1,D,E) /\ really_triangle(a,b,d,e) ==> EF(A,B1,C,E,a,b,c,e)`,
REPEAT GEN_TAC THEN
REWRITE_TAC[EF; euclid_quad] THEN
REPEAT STRIP_TAC THEN (* 5 goals *)
WE_HAVE_BY3 pasch_quad2A THEN (* `convex_quad (A,B1,C,E)` *)
WE_HAVE_BY3 pasch_quad2B THEN
ASM_SIMP_TAC[] THENL
[ (* 3 goals in this list *)
(* first goal is `convex_quad (A,B1,C,E \/ really_triangle (A,B1,C,E)` *)
ASM_MESON_TAC[triangle1]
;
(* goal is &0 < area4 (a,b,c,e) *)
ASM_MESON_TAC[triangle2]
; (* Now just one goal left, namely `area4 (A,B1,C,E) = area4 (a,b,c,e)` *)
UNDISCH_TAC `really_triangle(a:real^2, b:real^2, d:real^2, e:real^2)` THEN
REWRITE_TAC[really_triangle] THEN
WE_HAVE_BY3 pasch_quad2A THEN (* convex_quad(a,b,c,e) *)
WE_HAVE_BY3 pasch_quad2B THEN
REPEAT STRIP_TAC THEN
ASM_SIMP_TAC[] THENL
(* There are 4 cases remaining from STRIP_TAC *)
[ (* first case, B(abd), B(bcd) so abde = ade; and abce = ace
so by area_additive, ace + ecd = ade. Now
ABCE + CDE = ABDE by additivity4,
so subtracting CDE = cde we get ABCE = abce as desired *)
WE_HAVE_BY3 additivity4 THEN
WE_HAVE_BY2 connectivity2 THEN (* B(abc) *)
WE_HAVE_BY_N 11 (SPEC `e:real^2` (GSYM areaequalsarea4)) THEN (* abce = ace *)
WE_HAVE_BY_N 9 (SPEC `e:real^2` (GSYM areaequalsarea4)) THEN (* abde = ade *)
WE_HAVE_BY2_NOMATCHING (SPEC_ALL connectivity3) THEN (* B(acd) *)
WE_HAVE_BY_N 14 (SPEC `e:real^2` areaequalsarea4) THEN (* `area (a,d,e) = area4 (a,c,d,e)` *)
WE_HAVE_BY_N 14 (SPEC `e:real^2` area_additive) THEN
UNDISCH_TAC `ET(C:real^2,D:real^2,E:real^2,c:real^2,d:real^2,e:real^2)` THEN
REWRITE_TAC[ET] THEN
STRIP_TAC THEN
ASM_REWRITE_TAC[] THEN (* `area4 (A,B1,C,E) = area (a,c,e)` *)
MATCH_MP_TAC (SPEC `area(C:real^2, D:real^2, E:real^2)` (REAL_ARITH `!u:real x:real y:real. x+u = y + u ==> x=y`)) THEN
(* `area4 (A,B1,C,E) + area (C,D,E) = area (a,c,e) + area (C,D,E)` *)
PATH_REWRITE_TAC "lrr" [area_permutation2] THEN
ASM_REWRITE_TAC[] THEN (* `area4 (a,c,d,e) = area (a,c,e) + area (c,d,e)` *)
ONCE_REWRITE_TAC[area_permutation1] THEN (* area4 (a,c,d,e) = area (c,e,a) + area (d,e,c) *)
ASM_REWRITE_TAC[] THEN (* area4 (a,c,d,e) = area (e,a,d) *)
ONCE_REWRITE_TAC[area_permutation1] THEN
ASM_REWRITE_TAC[]
; (* End of first case *)
(* Now we have B(bde) and B(bcd) *)
UNDISCH_TAC `ET (C:real^2,D:real^2,E:real^2,c:real^2,d:real^2,e:real^2)` THEN
REWRITE_TAC[ET] THEN
ASM_REWRITE_TAC[] THEN
STRIP_TAC THEN
WE_HAVE_BY2 connectivity6 THEN (* B(cde) *)
WE_HAVE_BY between_area_zero THEN (* area(c,d,e) = 0 *)
ASM_MESON_TAC [area_permutation1; area_permutation2; REAL_LT_IMP_NZ]
; (* End of that case *)
(* Now we have B(bcd) and B(dea) and goal area4 (A,B1,C,E) = area4 (a,b,c,e)` *)
WE_HAVE_BY (left_to_right betweennesssymmetry) THEN (* B(a,e,d) *)
UNDISCH_TAC `&0 < area4(a:real^2,b:real^2,d:real^2, e:real^2)` THEN
PATH_REWRITE_TAC "lr" [area4perm] THEN
PATH_REWRITE_TAC "lr" [area4perm] THEN
ASM_SIMP_TAC[GSYM areaequalsarea4] THEN
ONCE_REWRITE_TAC [area_permutation1] THEN
ONCE_REWRITE_TAC [area_permutation1] THEN
DISCH_TAC THEN
UNDISCH_TAC `B(b:real^2,c:real^2, d:real^2)` THEN
DISCH_TAC THEN (* Moves that statement to the top of the assumption list *)
WE_HAVE_BY2_NOMATCHING (SPECL [`b:real^2`; `c:real^2`; `d:real^2`; `e:real^2`; `a:real^2`] additivity3) THEN
UNDISCH_TAC `area4 (A:real^2,B1:real^2,D:real^2,E:real^2) = area4 (a:real^2,b:real^2,d:real^2,e:real^2)` THEN
ASM_SIMP_TAC [SPECL [`A:real^2`; `B1:real^2`; `C:real^2`; `D:real^2`; `E:real^2`] (GSYM additivity4)] THEN
(* Now the goal is `area4 (A,B1,C,E) + area (C,E,D) = area4 (a,b,d,e)
==> area4 (A,B1,C,E) = area4 (a,b,c,e)` *)
UNDISCH_TAC `ET(C:real^2, D:real^2, E:real^2, c:real^2, d:real^2, e:real^2)` THEN
REWRITE_TAC[ET] THEN
STRIP_TAC THEN
PATH_REWRITE_TAC "lrr" [area4perm] THEN
PATH_REWRITE_TAC "lrr" [area4perm] THEN
ASM_SIMP_TAC [GSYM areaequalsarea4] THEN
PATH_REWRITE_TAC "lrr" [area_permutation1] THEN
PATH_REWRITE_TAC "lrr" [area_permutation2] THEN
ASM_SIMP_TAC [SPECL [`a:real^2`; `e:real^2`; `d:real^2`; `c:real^2`;`b:real^2`] (GSYM additivity3)] THEN
(* `area4 (A,B1,C,E) + area (C,E,D) = area (e,d,c) + area4 (a,e,c,b)
==> area4 (A,B1,C,E) = area4 (a,b,c,e)` *)
ONCE_REWRITE_TAC[area_permutation2] THEN
ASM_REWRITE_TAC[] THEN
PATH_REWRITE_TAC "lrr" [area_permutation1] THEN
PATH_REWRITE_TAC "lrlr" [REAL_ADD_SYM] THEN
REWRITE_TAC [REAL_ARITH `x+y = x + z <=> y = z`] THEN
MESON_TAC[area4perm;area4perm2]
; (* end of third case *)
(* Now we have B(bcd) and B(eab) *)
UNDISCH_TAC `area4 (A:real^2,B1:real^2,D:real^2,E:real^2) = area4 (a:real^2,b:real^2,d:real^2,e:real^2)` THEN
ASM_SIMP_TAC [SPECL [`A:real^2`; `B1:real^2`; `C:real^2`; `D:real^2`; `E:real^2`] (GSYM additivity4)] THEN
(* area4 (A,B1,C,E) + area (C,E,D) = area4 (a,b,d,e)
==> area4 (A,B1,C,E) = area4 (a,b,c,e)` *)
UNDISCH_TAC `ET(C:real^2, D:real^2, E:real^2, c:real^2, d:real^2, e:real^2)` THEN
REWRITE_TAC[ET] THEN
STRIP_TAC THEN (* assumptions contain area (C,D,E) = area (c,d,e)` *)
ONCE_REWRITE_TAC [area_permutation2] THEN
ASM_REWRITE_TAC[] THEN
PATH_REWRITE_TAC "lrr" [area4perm] THEN
PATH_REWRITE_TAC "lrr" [area4perm] THEN
PATH_REWRITE_TAC "lrr" [area4perm] THEN
ASM_SIMP_TAC [SPECL [`d:real^2`;`a:real^2`;`b:real^2`;`e:real^2`] (GSYM areaequalsarea4)] THEN
(* area4 (A,B1,C,E) + area (c,d,e) = area (e,b,d)
==> area4 (A,B1,C,E) = area4 (a,b,c,e)` *)
WE_HAVE_BY_N 1 (SPEC `e:real^2` (GSYM area_additive)) THEN (* area (e,b,d) = `area (c,e,b) + area (d,e,c) ` *)
ASM_REWRITE_TAC[] THEN
PATH_REWRITE_TAC "lrrr" [area_permutation1] THEN
PATH_REWRITE_TAC "lrrr" [area_permutation1] THEN
PATH_REWRITE_TAC "rr" [area4perm2] THEN
PATH_REWRITE_TAC "rr" [area4perm] THEN
PATH_REWRITE_TAC "rr" [area4perm] THEN
ASM_SIMP_TAC [SPECL [`c:real^2`;`b:real^2`;`e:real^2`;`a:real^2`](GSYM areaequalsarea4) ] THEN
REWRITE_TAC[REAL_ARITH `x+y = z + y <=> x = z`] THEN
(* `area4 (A,B1,C,E) = area (c,e,b) ==> area4 (A,B1,C,E) = area4 (b,a,e,c)` *)
WE_HAVE_BY_N 7 (left_to_right betweennesssymmetry) THEN
ASM_SIMP_TAC [SPECL [`c:real^2`;`b:real^2`;`e:real^2`;`a:real^2`](GSYM areaequalsarea4) ] THEN
MESON_TAC[area_permutation1; area_permutation2]
]
]
);;
let REAL_LT_LEFT_CANCEL = REAL_SOS `&0 < c ==> (&0 < c *t <=> &0 < t)`;;
(* proved 3.14.18 *)
let additivity5 = prove
( `!a:real^2 b:real^2 c:real^2 d:real^2 e:real^2.
B(b,c,d) /\ &0 < area4(a,b,d,e) /\ &0 < area(c,d,e) /\ really_triangle(a,b,d,e) ==>
( B(a,e,d) /\ area4(a,b,d,e) = area4(a,e,c,b) + area(e,d,c) ) \/
( B(b,a,e) /\ area4(a,b,d,e) = area(e,b,c) + area(e,d,c) /\ area4(a,e,c,b) = area(e,b,c)) \/
(B(a,b,d) /\ area4(a,b,d,e) = area(e,a,c) + area(e,d,c) /\ area4(a,e,c,b) = area(e,a,c))`,
REPEAT GEN_TAC THEN
REWRITE_TAC[really_triangle] THEN
STRIP_TAC THENL(* 4 goals *)
[ (* B(a,b,d) *)
REPEAT DISJ2_TAC THEN
ASM_REWRITE_TAC[] THEN
WE_HAVE_BY2 connectivity2 THEN (* B(a,b,c) *)
WE_HAVE_BY2 connectivity3 THEN (* B(a,c,d) *)
CONJ_TAC THENL
[ (* goal area4 (a,b,d,e) = area (e,a,c) + area (e,d,c)` *)
WE_HAVE_BY_N 3 (SPEC `e:real^2` (GSYM areaequalsarea4)) THEN
ASM_REWRITE_TAC[] THEN (* area (a,d,e) = area (e,a,c) + area (e,d,c)` *)
ASM_MESON_TAC[area_additive; area_permutation1; area_permutation2;REAL_ADD_AC]
;
WE_HAVE_BY_N 4 (SPEC `e:real^2` (GSYM areaequalsarea4)) THEN
ASM_REWRITE_TAC[] THEN
ASM_MESON_TAC[area_permutation1;area4perm;area4perm2]
]
;
(* B(b,d,e) *)
MATCH_MP_TAC (TAUT `!P.F==>P`) THEN (* This case has contradictory assumptions *)
WE_HAVE_BY2 connectivity THEN
WE_HAVE_BY2 connectivity4 THEN (* B(c,d,e) *)
UNDISCH_TAC `&0 < area(c:real^2, d:real^2, e:real^2)` THEN
ASM_REWRITE_TAC[] THEN
ONCE_REWRITE_TAC[area_permutation2] THEN (* ~ &0 < area(c,e,d) *)
ONCE_REWRITE_TAC[area_permutation1] THEN (* ~ &0 < area(e,d,c) *)
ONCE_REWRITE_TAC[area_permutation1] THEN (* ~ &0 < area(d,c,e) *)
UNDISCH_TAC `B(c:real^2,d:real^2, e:real^2)` THEN
REWRITE_TAC[B; area;tarea] THEN
STRIP_TAC THEN
ASM_REWRITE_TAC[] THEN
REWRITE_TAC[crosslinear2;crosszero; REAL_MUL_RZERO;REAL_ABS_0;REAL_LT_REFL]
;
(* B(d,e,a) *)
DISJ1_TAC THEN
WE_HAVE_BY ( left_to_right betweennesssymmetry) THEN (* B(a,e,d) *)
ASM_REWRITE_TAC[] THEN (* Get rid of B(a,e,d) in the goal *)
WE_HAVE_BY_N 0 (left_to_right betweennesssymmetry) THEN (* B(d,c,b) *)
SUBGOAL_THEN `&0 < area(b:real^2, d:real^2, a:real^2)` ASSUME_TAC THENL
[ UNDISCH_TAC `B(d:real^2,c:real^2, b:real^2)` THEN
UNDISCH_TAC `B(d:real^2,e:real^2, a:real^2)` THEN
REWRITE_TAC [B] THEN
REPEAT STRIP_TAC THEN
UNDISCH_TAC `&0 < area(c:real^2, d:real^2, e:real^2)` THEN
REWRITE_TAC[area;tarea] THEN
ASM_REWRITE_TAC[] THEN
REWRITE_TAC[crosslinear2;crosslinear1;REAL_ABS_MUL] THEN
ASM_SIMP_TAC[abspos] THEN
ASM_SIMP_TAC[REAL_LT_LEFT_CANCEL]
;
(* goal is area4(a,b,d,e) = area4(a,e,c,b) + area(e,d,c) *)
(* Plan: By pasch_quad, we have convex_quad(a,b,c,e).
Then by weak_additivity2, area4(a,b,c,e) = area(aeb) + area(ceb) = aeb + ceb for short.
On the other hand by area_additivity, bda = eba + ebd = eba + (ceb + ced) = (eba + ceb) + ced
= abce + ced. So it only remains to show bda = abcd, but that follows by areaequalsarea4. *)
(* At this point, I can't succeed with ASM_MESON_TAC. The following fails:
ASM_MESON_TAC[REAL_ADD_AC; pasch_quad;weak_additivity2;areaequalsarea4;area_additive; area_permutation1;
area_permutation2; area4perm;area4perm2; betweennesssymmetry; convex_quad_perm] *)
WE_HAVE_BY3 pasch_quad THEN (* convex_quad(b,c,e,a) *)
(* We want convex_quad(a,b,c,e) *)
UNDISCH_TAC `convex_quad(b:real^2, c:real^2, e:real^2, a:real^2)` THEN
ONCE_REWRITE_TAC [convex_quad_perm] THEN
ONCE_REWRITE_TAC [convex_quad_perm] THEN
ONCE_REWRITE_TAC [convex_quad_perm] THEN
DISCH_TAC THEN (* put convex_quad back in assumptions *)
WE_HAVE_BY weak_additivity2 THEN
ASM_REWRITE_TAC[] THEN
PATH_REWRITE_TAC "r" [area4perm2] THEN
PATH_REWRITE_TAC "r" [area4perm] THEN
PATH_REWRITE_TAC "r" [area4perm] THEN
PATH_REWRITE_TAC "r" [area4perm] THEN
ASM_REWRITE_TAC[] THEN
REAL_SIMP_TAC THEN (* goal is area4 (a,b,d,e) = area (a,e,b) + area (c,e,b) + area (e,d,c)` *)
WE_HAVE_BY_N 3 (SPEC `b:real^2` (GSYM areaequalsarea4)) THEN (* area4 (d,e,a,b) = area (d,a,b) *)
ONCE_REWRITE_TAC [area4perm] THEN
ONCE_REWRITE_TAC [area4perm] THEN
ASM_REWRITE_TAC[] THEN
(* Now the goal is `area (d,a,b) = area (a,e,b) + area (c,e,b) + area (e,d,c)` which we
plan to prove by two applications of area_additive. But the following command fails:
ASM_MESON_TAC[area_additive; betweennesssymmetry; REAL_ADD_AC; area_permutation1;area_permutation2]
*)
WE_HAVE_BY_N 4 (GSYM (SPEC `b:real^2` area_additive)) THEN
PATH_REWRITE_TAC "lr" [area_permutation1] THEN
PATH_REWRITE_TAC "lr" [area_permutation1] THEN
PATH_REWRITE_TAC "lr" [area_permutation2] THEN
ASM_REWRITE_TAC[] THEN
PATH_REWRITE_TAC "lrlr" [area_permutation1] THEN
PATH_REWRITE_TAC "lrlr" [area_permutation1] THEN
AP_TERM_TAC THEN (* `area (d,b,e) = area (c,e,b) + area (e,d,c)` *)
WE_HAVE_BY_N 0 (GSYM (SPEC `e:real^2` area_additive)) THEN
PATH_REWRITE_TAC "lr" [area_permutation2] THEN
PATH_REWRITE_TAC "lr" [area_permutation1] THEN
ASM_REWRITE_TAC[] THEN
AP_TERM_TAC THEN
PATH_REWRITE_TAC "r" [area_permutation1] THEN
PATH_REWRITE_TAC "r" [area_permutation2] THEN
ASM_REWRITE_TAC[]
]
;
(* The final case, B(e,a,b) *)
DISJ2_TAC THEN DISJ1_TAC THEN (* select second disjunct *)
WE_HAVE_BY (left_to_right betweennesssymmetry) THEN
ASM_REWRITE_TAC[] THEN
WE_HAVE_BY (SPEC `c:real^2` (GSYM areaequalsarea4)) THEN (* area4 (b,a,e,c) = area (b,e,c)` *)
PATH_REWRITE_TAC "r" [area4perm] THEN
PATH_REWRITE_TAC "r" [area4perm] THEN
PATH_REWRITE_TAC "r" [area4perm] THEN
ASM_REWRITE_TAC[] THEN
PATH_REWRITE_TAC "rrr" [area_permutation2] THEN
PATH_REWRITE_TAC "rr" [area_permutation2] THEN
PATH_REWRITE_TAC "rr" [area_permutation1] THEN
PATH_REWRITE_TAC "rr" [area_permutation1] THEN
ASM_REWRITE_TAC[] THEN (* goal is now `area4 (a,b,d,e) = area (e,b,c) + area (e,d,c)` *)
WE_HAVE_BY_N 4 (SPEC `d:real^2` (GSYM areaequalsarea4)) THEN (* `area4 (b,a,e,d) = area (b,e,d)`] *)
ONCE_REWRITE_TAC[area4perm2] THEN
ONCE_REWRITE_TAC[area4perm] THEN
ONCE_REWRITE_TAC[area4perm] THEN
ASM_REWRITE_TAC[] THEN
WE_HAVE_BY_N 0 (SPEC `e:real^2` (GSYM area_additive)) THEN
REWRITE_TAC[area_permutation2] THEN
ONCE_REWRITE_TAC[area_permutation1] THEN
ONCE_REWRITE_TAC[area_permutation1] THEN
ASM_REWRITE_TAC[]
]
);;
(* proved 3.14.18 *)
let additivity6 = prove
( `!a:real^2 b:real^2 c:real^2 d:real^2 e:real^2.
B(b,c,d) /\ &0 < area4(a,b,d,e) /\ &0 < area(c,d,e) /\ really_triangle(a,b,d,e) ==>
area4 (a,b,d,e) = area4 (a,e,c,b) + area (e,d,c)`,
REPEAT GEN_TAC THEN
STRIP_TAC THEN
WE_HAVE_BY4 additivity5 THEN
ASM_REWRITE_TAC[]
);;
(* proved 3.14.18 *)
let cutoff_helper3 = prove
( `!A:real^2 B1:real^2 C:real^2 D:real^2 E:real^2 a:real^2 b:real^2 c:real^2 d:real^2 e:real^2.
B(B1,C,D) /\ B(b,c,d) /\ ET(C,D,E,c,d,e)/\ area4(A,B1,D,E) = area4(a,b,d,e) /\ &0 < area4(a,b,d,e) /\ &0 < area4(A,B1,D,E) /\
really_triangle(A,B1,D,E) /\ really_triangle(a,b,d,e) ==> area4 (A,B1,C,E) = area4 (a,b,c,e)`,
REPEAT GEN_TAC THEN
REWRITE_TAC[ET] THEN
REPEAT STRIP_TAC THEN
REWRITE_TAC[abs_pos;abszero] THEN
SUBGOAL_THEN `&0 < area(c:real^2, d:real^2, e:real^2)` ASSUME_TAC THENL
[ ASM_MESON_TAC[]
;
WE_HAVE_BY4 additivity6 THEN
UNDISCH_TAC `really_triangle(A:real^2, B1:real^2, D:real^2, E:real^2)` THEN
DISCH_TAC THEN (* Move this formula to top of assumptions *)
WE_HAVE_BY4_NOMATCHING (SPECL [`A:real^2`; `B1:real^2`; `C:real^2` ; `D:real^2`; `E:real^2`] additivity6) THEN
(* Now we have [`area4 (A,B1,D,E) = area4 (A,E,C,B1) + area (E,D,C)`] and
[`area4 (a,b,d,e) = area4 (a,e,c,b) + area (e,d,c)`] and
[`area (C,D,E) = area (c,d,e)`] and we want
`area4 (A,B1,C,E) = area4 (a,b,c,e)` *)
(* The following doesn't work:
ASM_MESON_TAC[ area_permutation1; area_permutation2; area4perm; area4perm2;REAL_ARITH `x+y = X+y <=> x=X`].
The proof below uses only those axioms.
*)
UNDISCH_TAC `area4 (A:real^2,B1:real^2,D:real^2,E:real^2) = area4 (A:real^2,E:real^2,C:real^2,B1:real^2) +
area (E:real^2,D:real^2,C:real^2)` THEN
ASM_REWRITE_TAC[] THEN
REWRITE_TAC[area_permutation2] THEN
ONCE_REWRITE_TAC[area_permutation1] THEN
ASM_REWRITE_TAC[] THEN
PATH_REWRITE_TAC "lr" [area4perm2] THEN
PATH_REWRITE_TAC "lr" [area4perm] THEN
PATH_REWRITE_TAC "lr" [area4perm] THEN
PATH_REWRITE_TAC "lr" [area4perm] THEN
(* `area4 (a,b,c,e) + area (c,d,e) = area4 (A,B1,C,E) + area (c,d,e)
==> area4 (A,B1,C,E) = area4 (a,b,c,e)` *)
ASM_MESON_TAC[REAL_ARITH `x+y = X+y <=> x=X`]
]
);;
(* proved 3.14.18 *)
let cutoff2_helper2 = prove
( `!A:real^2 B1:real^2 C:real^2 D:real^2 E:real^2 a:real^2 b:real^2 c:real^2 d:real^2 e:real^2.
B(B1,C,D) /\ B(b,c,d) /\ ET(C,D,E,c,d,e)/\ area4(A,B1,D,E) = area4(a,b,d,e) /\ &0 < area4(a,b,d,e) /\ &0 < area4(A,B1,D,E) /\
really_triangle(A,B1,D,E) /\ really_triangle(a,b,d,e) ==> EF(A,B1,C,E,a,b,c,e)`,
REPEAT GEN_TAC THEN
REWRITE_TAC[EF;euclid_quad] THEN
REPEAT STRIP_TAC THEN
ASM_REWRITE_TAC[] THENL (* five goals *)
[ UNDISCH_TAC `really_triangle(A:real^2, B1:real^2, D:real^2, E:real^2)` THEN
REWRITE_TAC[really_triangle] THEN
ASM_REWRITE_TAC[] THEN
STRIP_TAC THEN ASM_REWRITE_TAC[] THENL (* 3 new goals, 7 total *)
[ (* BCD, ABD *)
DISJ2_TAC THEN DISJ1_TAC THEN (* select goal ABC *)
ASM_MESON_TAC[connectivity2]
;
(* BCD BDE *)
DISJ2_TAC THEN DISJ2_TAC THEN DISJ1_TAC THEN (* select goal BCE *)
ASM_MESON_TAC[connectivity5]
; (* 5 goals remaining *)
(* BCD and DEA *)
DISJ1_TAC THEN (* select goal convex_quad(A,B1,C,E) *)
WE_HAVE_BY (left_to_right betweennesssymmetry) THEN
UNDISCH_TAC `&0 < area4(A:real^2,B1:real^2,D:real^2,E:real^2)` THEN
ONCE_REWRITE_TAC [area4perm] THEN
ONCE_REWRITE_TAC [area4perm] THEN
ASM_SIMP_TAC [GSYM areaequalsarea4] THEN (* `&0 < area (D,A,B1) ==> convex_quad (A,B1,C,E)` *)
ONCE_REWRITE_TAC[area_permutation1] THEN
ONCE_REWRITE_TAC[area_permutation2] THEN (* &0 < area (A,D,B1) ==> convex_quad (A,B1,C,E) *)
DISCH_TAC THEN
(* To apply pasch_quad we need convex_quad BCEA instead of ABCE *)
ONCE_REWRITE_TAC [ convex_quad_perm] THEN
UNDISCH_TAC `&0 < area4(a:real^2, b:real^2, d:real^2, e:real^2)` THEN
SUBGOAL_THEN `&0 < area(B1:real^2, D:real^2, A:real^2)` ASSUME_TAC THENL
[
ONCE_REWRITE_TAC [area_permutation2] THEN
ONCE_REWRITE_TAC [area_permutation1] THEN
ASM_REWRITE_TAC[]
;
ASM_MESON_TAC[pasch_quad]
]
]
;
(* 4 goals remaining *)
(* two really_triangles, goal 0 < area4(A,B1,C,E) *)
ASM_MESON_TAC[triangle2]
;
ASM_MESON_TAC[triangle1]
;
ASM_MESON_TAC[triangle2]
;
ASM_MESON_TAC[cutoff_helper3]
]
);;
(* proved 3.14.18 *)
let cutoff2 = prove
( `!A:real^2 B1:real^2 C:real^2 D:real^2 E:real^2 a:real^2 b:real^2 c:real^2 d:real^2 e:real^2.
B(B1,C,D) /\ B(b,c,d) /\ ET(C,D,E,c,d,e) /\ EF(A,B1,D,E,a,b,d,e) ==> EF(A,B1,C,E,a,b,c,e)`,
REPEAT GEN_TAC THEN
PATH_REWRITE_TAC "lr" [EF] THEN
PATH_REWRITE_TAC "lr" [euclid_quad] THEN
STRIP_TAC THENL (* 4 goals created, possible cases of really_triangle and convex_quad for abde and ABDE*)
[ (* both convex_quad *)
WE_HAVE_BY3 pasch_quad2A THEN (* convex_quad(a,b,c,e) *)
WE_HAVE_BY3 pasch_quad2B THEN (* &0 < area4(a,b,c,e) *)
WE_HAVE_BY3_NOMATCHING (SPECL[ `A:real^2`; `B1:real^2`; `C:real^2`; `D:real^2`;`E:real^2`] pasch_quad2A) THEN
WE_HAVE_BY3_NOMATCHING (SPECL[ `A:real^2`; `B1:real^2`; `C:real^2`; `D:real^2`;`E:real^2`] pasch_quad2B) THEN
REWRITE_TAC[EF] THEN
REWRITE_TAC[euclid_quad] THEN
ASM_REWRITE_TAC[] THEN
(* goal is `area4 (A,B1,C,E) = area4 (a,b,c,e)` *)
WE_HAVE_BY (left_to_right ET) THEN (* adds area(C,D,E) = area(c,d,e) *)
UNDISCH_TAC `area(C:real^2, D:real^2, E:real^2) = area(c:real^2, d:real^2, e:real^2)` THEN
ONCE_REWRITE_TAC [area_permutation2] THEN
DISCH_TAC THEN
UNDISCH_TAC `area4 (A:real^2,B1:real^2,D:real^2,E:real^2) = area4 (a:real^2,b:real^2,d:real^2,e:real^2)` THEN
(* Mysteriously this line only rewrites ONE term, not both: ASM_SIMP_TAC[GSYM additivity4] *)
(* But this works though it takes a few seconds *)
ASM_MESON_TAC[additivity4; REAL_ARITH `x+y = z /\ X+y=z ==> x=X`]
; (* That finishes the case when both are convex_quads. *)
(* Now we have convex_quad(A,B1,D,E) and really_triangle(a,b,d,e) *)
ASM_MESON_TAC[cutoff2_helper]
;
(* The third case, when really_triangle (A,B1,D,E)` and convex_quad (a,b,d,e). So
that should also work by cutoff2_helper, but we need at least ETsymmetric as well. *)
WE_HAVE_BY ETsymmetric THEN
MATCH_MP_TAC EFsymmetric THEN
ASM_MESON_TAC[cutoff2_helper]
;
(* In this last case, both ABDE and abde are really_triangles. *)
ASM_MESON_TAC[cutoff2_helper2]
]
);;
(* proved 3.15.18 *)
let lemma2057 = prove
( `!a:real^2 b:real^2 c:real^2 d:real^2. convex_quad(a,b,c,d) /\ &0 < area4(a,b,c,d)
==> ~ B(a,b,c)`,
REPEAT GEN_TAC THEN
REWRITE_TAC[convex_quad] THEN
REPEAT STRIP_TAC THEN
WE_HAVE_BY3 quad_area_pos1 THEN (* `&0 < area (a,t,b)` *)
WE_HAVE_BY_N 0 (SPECL [`b:real^2`;`a:real^2`;`c:real^2`;`t:real^2`] (GSYM areaequalsarea4)) THEN
(* `area4 (a,t,c,b) = area (a,c,b)`] *)
WE_HAVE_BY_N 0 (SPEC `b:real^2` area_additive) THEN (* `area (t,b,a) + area (c,b,t) = area (b,a,c)`] *)
WE_HAVE_BY between_area_zero THEN
ASM_MESON_TAC[area_permutation1; area_permutation2; REAL_SOS `&0 < x /\ &0 <= y ==> &0 < x+y`;
REAL_LT_IMP_NZ; area_non_negative]
);;
(* proved 3.15.18 *)
let convex_quad_not_triangle = prove
( `!a:real^2 b:real^2 c:real^2 d:real^2. convex_quad(a,b,c,d) /\ &0 < area4(a,b,c,d)
==> ~ really_triangle(a,b,c,d)`,
REPEAT GEN_TAC THEN
REWRITE_TAC[really_triangle] THEN
STRIP_TAC THEN
ASM_MESON_TAC[convex_quad_perm; lemma2057;area4perm]
);;
(* proved 3.16.18 *)
let tarski_pasch_zero = prove
( `!a:real^2 b:real^2 d:real^2 e:real^2.
B(vec(0):real^2,b,a) /\ B(vec(0):real^2,d,e) /\ ~(d = a) /\ ~(b=e) ==>
?(t:real^2). B(a,t,d) /\ B(e,t,b)`,
REPEAT GEN_TAC THEN
PATH_REWRITE_TAC "lr" [B] THEN
REWRITE_TAC[NORM_ARITH `!x:real^2. x-x = vec(0):real^2`;
lemma870
] THEN
REPEAT STRIP_TAC THEN
ASM_REWRITE_TAC[] THEN
ONCE_REWRITE_TAC[betweennesssymmetry] THEN
ABBREV_TAC `p:real = (t:real - t:real *t':real)/(&1-t:real * t':real)` THEN
ABBREV_TAC `q:real = (t':real - t:real *t':real)/(&1-t:real * t':real)` THEN
SUBGOAL_THEN `(d:real^2) + (p:real) % (a:real^2 - d:real^2) =
(b:real^2) + (q:real) % (e:real^2-b:real^2)` ASSUME_TAC THENL
[ (* goal is `d + p % (a - d) = b + q % (e - b)` *)
ASM_REWRITE_TAC[] THEN
REWRITE_TAC[VECTOR_SUB_LDISTRIB;VECTOR_MUL_ASSOC] THEN
EXPAND_TAC "p" THEN
EXPAND_TAC "q" THEN
REWRITE_TAC [lemma783] THEN (* collect e terms and a terms *)
ASM_MESON_TAC[lemma791; lemma808; lemma824]
;
(* only goal is `?t. B (t' % e,t,a) /\ B (t % a,t,e)` *)
EXISTS_TAC `(d:real^2) + (p:real) % ((a:real^2)-(d:real^2))` THEN
CONJ_TAC THENL
[ REWRITE_TAC[B] THEN
EXISTS_TAC `p:real` THEN
CONJ_TAC THENL
[ CONJ_TAC THENL
[ ASM_MESON_TAC[ VECTOR_ARITH `!x:real^2 y:real^2. (x+y)-x = y`]
;
(* Now the goal is &0 < p /\ p < &1 *)
CONJ_TAC THENL
[ (* goal is &0 < p *)
EXPAND_TAC "p" THEN
REWRITE_TAC [lemma880] THEN
ASM_MESON_TAC[lemma839]
;
(* goal is p < &1 *)
EXPAND_TAC "p" THEN
REWRITE_TAC [lemma880] THEN
ASM_MESON_TAC[lemma854]
]
]
;
(* The goal is ~(t' % e = a), but that's just ~ (d = a), which we have *)
ASM_MESON_TAC[]
]
;
(* The goal is B( t %a, d + p %(a-d),e) *)
ASM_REWRITE_TAC[] THEN
REWRITE_TAC[B] THEN
EXISTS_TAC `(q:real)` THEN
CONJ_TAC THENL
[ CONJ_TAC THENL
[ (* `(t % a + q % (e - t % a)) - t % a = q % (e - t % a)` *)
ASM_MESON_TAC[PLUS_MINUS]
;
(* goal is &0 < q /\ q < &1 *)
CONJ_TAC THENL
[ (* goal is &0 < q *)
EXPAND_TAC "q" THEN
REWRITE_TAC [lemma879] THEN
ASM_MESON_TAC[lemma839; REAL_MUL_AC]
;
(* goal is q < &1 *)
EXPAND_TAC "q" THEN
REWRITE_TAC [lemma879] THEN
ASM_MESON_TAC[lemma854; REAL_MUL_AC]
]
]
; (* The goal is ~(t % a = e ), which is just ~ (b = e) *)
ASM_MESON_TAC[]
]
]
] (* close SUBGOAL_THEN *)
);;
(* proved 3.16.18 *)
let tarski_innerPasch = prove
( `!a:real^2 b:real^2 c:real^2 d:real^2 e:real^2.
B(a,b,c) /\ B(e,d,c) /\ ~(d=a) /\ ~(b=e) ==> ?t:real^2. B(a,t,d) /\ B(e,t,b)`,
REPEAT GEN_TAC THEN
ONCE_REWRITE_TAC[SPEC `c:real^2` translation_invarianceB ] THEN
ONCE_REWRITE_TAC[SPEC `c:real^2` area_translation ] THEN
REWRITE_TAC[NORM_ARITH `!x:real^2. x-x = vec(0):real^2`] THEN
STRIP_TAC THEN
WE_HAVE_BY_N 0 (left_to_right betweennesssymmetry) THEN
WE_HAVE_BY_N 1 (left_to_right betweennesssymmetry) THEN
WE_HAVE_BY_N 2 (SPEC `c:real^2` (NORM_ARITH `!c:real^2 d:real^2 a:real^2. ~(d=a) ==> ~(d-c = a-c)`)) THEN
WE_HAVE_BY_N 3 (SPEC `c:real^2` (NORM_ARITH `!c:real^2 d:real^2 a:real^2. ~(d=a) ==> ~(d-c = a-c)`)) THEN
WE_HAVE_BY4 tarski_pasch_zero THEN
EXISTS_TAC `(t:real^2) + (c:real^2)` THEN
REWRITE_TAC[VECTOR_ARITH `((x:real^2) + (y:real^2))-(y:real^2) = x:real^2`] THEN
ASM_REWRITE_TAC[]
);;
(* proved 3.16.18 *)
let lemma2183 = prove
( `!t:real x:real^2. x = t % x ==> x = vec(0):real^2 \/ t = &1`,
REPEAT GEN_TAC THEN
ASM_CASES_TAC `t:real = &1` THENL
[ ASM_REWRITE_TAC[]
;
(* Now ~(t = &1) *)
DISCH_TAC THEN
DISJ1_TAC THEN
ASM_MESON_TAC[ VECTOR_ARITH `!x:real^2. x = &1 % x`; VECTOR_MUL_RCANCEL]
]
);;
(* proved 3.16.18 *)
let betweennotequal = prove
( `!a:real^2 b:real^2 c:real^2. B(a,b,c) ==> ~(a = b) /\ ~(a=c) /\ ~(b=c)`,
REPEAT GEN_TAC THEN
REWRITE_TAC[B] THEN
REPEAT STRIP_TAC THENL
[
UNDISCH_TAC `b:real^2 - a:real^2 = t:real % (c:real^2-a:real^2)` THEN
ASM_REWRITE_TAC[] THEN
REWRITE_TAC [VECTOR_ARITH `!a:real^2. a-a = vec(0):real^2`] THEN
WE_HAVE_BY REAL_LT_IMP_NZ THEN
ASM_MESON_TAC[VECTOR_ARITH `!a:real^2. a-a = vec(0):real^2`;
VECTOR_ARITH `!a:real^2 b:real^2. a-b = vec(0):real^2 <=> a=b`;
VECTOR_MUL_EQ_0]
;
UNDISCH_TAC `~(a:real^2 = c:real^2)` THEN
ASM_REWRITE_TAC[]
;
UNDISCH_TAC `b:real^2 - a:real^2 = t:real % (c:real^2-a:real^2)` THEN
ASM_REWRITE_TAC[] THEN
WE_HAVE_BY_N 1 REAL_LT_IMP_NE THEN (* ~(1 = t) *)
ASM_MESON_TAC[ NORM_ARITH `!x:real^2 y:real^2. (x-y = vec(0):real^2 <=> x=y)`; lemma2183]
]
);;
(* proved 3.16.18 *)
let convex_quad_not_triangle2 = prove
( `!a:real^2 b:real^2 c:real^2 d:real^2 e:real^2. convex_quad(a,b,d,e) /\ B(b,c,d) /\ &0 < area4(a,b,c,e)
==> ~ really_triangle(a,b,c,e)`,
REPEAT GEN_TAC THEN
REWRITE_TAC [convex_quad] THEN
STRIP_TAC THEN
WE_HAVE_BY_NOMATCHING (SPECL [`b:real^2`; `t:real^2`; `e:real^2`] betweennotequal) THEN
ASM_CASES_TAC `(a:real^2 = c:real^2)` THENL
[
(* First the case a=c *)
UNDISCH_TAC `&0 < area4(a:real^2, b:real^2, c:real^2, e:real^2)` THEN
REWRITE_TAC[area4;sarea4] THEN
ASM_REWRITE_TAC[] THEN
REWRITE_TAC[VECTOR_SUB_REFL;crossequalszero;zerocrossx;REAL_ABS_0] THEN
ASM_MESON_TAC [REAL_ARITH `~ (&0 < &0)`]
;
SUBGOAL_THEN `convex_quad(a:real^2, b:real^2, c:real^2, e:real^2)` ASSUME_TAC THENL
[ REWRITE_TAC[convex_quad] THEN
MP_TAC (SPECL [`a:real^2`; `t:real^2`; `d:real^2`; `c:real^2`; `b:real^2`] tarski_innerPasch) THEN
ASM_REWRITE_TAC[] THEN
STRIP_TAC THEN
EXISTS_TAC `t':real^2` THEN
ASM_REWRITE_TAC[] THEN
ASM_MESON_TAC[connectivity]
;
ASM_MESON_TAC[convex_quad_not_triangle]
]
]
);;
(* proved 3.16.18 *)
let paste2 = prove
( `!A:real^2 B1:real^2 C:real^2 D:real^2 E:real^2 a:real^2 b:real^2 c:real^2 d:real^2 e:real^2 M:real^2 m:real^2.
B(B1,C,D) /\ B(b,c,d) /\ ET(C,D,E,c,d,e) /\ EF(A,B1,C,E,a,b,c,e)
/\ B(B1,M,E) /\ B(A,M,D) /\ B(b,m,e) /\ B(a,m,d) ==> EF(A,B1,D,E,a,b,d,e)`,
REPEAT STRIP_TAC THEN
SUBGOAL_THEN `convex_quad(A:real^2, B1:real^2, D:real^2, E:real^2)` ASSUME_TAC THENL
[ REWRITE_TAC[convex_quad] THEN
EXISTS_TAC `M:real^2` THEN
ASM_REWRITE_TAC[]
;
SUBGOAL_THEN `convex_quad(a:real^2, b:real^2, d:real^2, e:real^2)` ASSUME_TAC THENL
[ REWRITE_TAC[convex_quad] THEN
EXISTS_TAC `m:real^2` THEN
ASM_REWRITE_TAC[]
;
UNDISCH_TAC `EF(A:real^2,B1:real^2,C:real^2,E:real^2,a:real^2,b:real^2,c:real^2,e:real^2)` THEN
UNDISCH_TAC `ET(C:real^2,D:real^2,E:real^2,c:real^2,d:real^2,e:real^2)` THEN
REWRITE_TAC[EF;euclid_quad;ET] THEN
ASM_REWRITE_TAC[] THEN
REPEAT STRIP_TAC THENL (* 12 goals *)
[ ASM_SIMP_TAC [GSYM (SPECL [`A:real^2`; `B1:real^2`; `C:real^2`; `D:real^2`; `E:real^2`] additivity4)] THEN
ASM_MESON_TAC[area_non_negative; REAL_SOS `&0 < x /\ &0 <= y ==> &0 < x+y`]
; (* 11 goals *)
ASM_SIMP_TAC [GSYM (SPECL [`a:real^2`; `b:real^2`; `c:real^2`; `d:real^2`; `e:real^2`] additivity4)] THEN
ASM_MESON_TAC[area_non_negative; REAL_SOS `&0 < x /\ &0 <= y ==> &0 < x+y`]
; (* 10 goals *)
ASM_MESON_TAC[additivity4;area_permutation2; REAL_ADD_EQ]
; (* 9 goals *)
ASM_MESON_TAC[additivity4;area_non_negative; REAL_SOS `&0 < x /\ &0 <= y ==> &0 < x+y`]
; (* 8 goals *)
ASM_MESON_TAC[convex_quad_not_triangle2]
; ASM_MESON_TAC[convex_quad_not_triangle2]
; ASM_MESON_TAC[convex_quad_not_triangle2]
; ASM_MESON_TAC[convex_quad_not_triangle2]
; ASM_MESON_TAC[convex_quad_not_triangle2]
; ASM_MESON_TAC[convex_quad_not_triangle2]
; ASM_MESON_TAC[convex_quad_not_triangle2]
; ASM_MESON_TAC[convex_quad_not_triangle2]
]
]
]
);;
(* proved 3.17.18 *)
let betweennessidentity = prove
( `!a:real^2 b:real^2. ~B(a,b,a)`,
REPEAT GEN_TAC THEN
REWRITE_TAC[B]
);;
(* proved 3.18.18 *)
let lemma2299 = prove
( `!a:real^2 b:real^2 c:real^2 d:real^2 m:real^2.
(B(c,m,d) \/ c=m \/ m=d) /\ NC(a,b,c) /\ NC(a,b,d) ==>
(B(a,m,b) \/ a = m \/ m = b) ==> area4(a,c,b,d) = area(a,b,c) + area(a,b,d)`,
REPEAT GEN_TAC THEN
REWRITE_TAC[NC] THEN
REPEAT STRIP_TAC THENL (* 9 goals *)
[
SUBGOAL_THEN `OS(c:real^2, a:real^2, b:real^2, d:real^2)` ASSUME_TAC THENL
[ REWRITE_TAC[OS] THEN
EXISTS_TAC `m:real^2` THEN
REWRITE_TAC[CO; NC] THEN
ASM_REWRITE_TAC[]
;
PATH_REWRITE_TAC "rlr" [area_permutation1] THEN
WE_HAVE_BY (GSYM additivity2) THEN
ASM_MESON_TAC[area4perm2;area4perm;area_permutation1]
]
;
(* be patient, this takes at least a minute *)
ASM_MESON_TAC[areaequalsarea4; area_additive;area4perm;area4perm2;area_permutation1;area_permutation2]
; ASM_MESON_TAC[areaequalsarea4; area_additive;area4perm;area4perm2;area_permutation1;area_permutation2]
; ASM_MESON_TAC[areaequalsarea4; area_additive;area4perm;area4perm2;area_permutation1;area_permutation2]
; ASM_MESON_TAC[areaequalsarea4; area_additive;area4perm;area4perm2;area_permutation1;area_permutation2]
; ASM_MESON_TAC[areaequalsarea4; area_additive;area4perm;area4perm2;area_permutation1;area_permutation2]
; ASM_MESON_TAC[areaequalsarea4; area_additive;area4perm;area4perm2;area_permutation1;area_permutation2]
; ASM_MESON_TAC[areaequalsarea4; area_additive;area4perm;area4perm2;area_permutation1;area_permutation2]
; ASM_MESON_TAC[areaequalsarea4; area_additive;area4perm;area4perm2;area_permutation1;area_permutation2]
]
);;
(* proved 3.17.18 *)
let lemma2332 = prove
( `!a:real^2 b:real^2 c:real^2 d:real^2 m:real^2.
B(c,m,d) /\ ~(a=b) /\ ~(a=c) /\ NC(a,b,c) /\ NC(a,b,d) ==>
(B(a,m,b) \/ a = m \/ m = b) ==> euclid_quad(a,c,b,d)`,
REPEAT GEN_TAC THEN
REPEAT STRIP_TAC THENL (* 3 goals *)
[
SUBGOAL_THEN `&0 < area4(a:real^2,c:real^2, b:real^2, d:real^2)` ASSUME_TAC THENL
[ ASM_MESON_TAC[lemma2299;NCarea;area_non_negative;
REAL_ARITH `!x:real y:real . &0 < x /\ &0 <= y ==> &0 < x + y`]
;
REWRITE_TAC[NC;euclid_quad] THEN
REPEAT STRIP_TAC THENL (* 4 total goals *)
[ DISJ1_TAC THEN
REWRITE_TAC[convex_quad] THEN
EXISTS_TAC `m:real^2` THEN
ASM_REWRITE_TAC[]
; (* 3 more goals *)
ASM_REWRITE_TAC[]
]
]
; (* 2 more goals *)
REWRITE_TAC[NC;euclid_quad] THEN
REPEAT STRIP_TAC THENL (* 2 new goals *)
[ DISJ2_TAC THEN
REWRITE_TAC[really_triangle] THEN
ASM_REWRITE_TAC[] THEN
ASM_MESON_TAC[betweennesssymmetry]
;
ASM_MESON_TAC[lemma2299;NCarea;area_non_negative;
REAL_ARITH `!x:real y:real . &0 < x /\ &0 <= y ==> &0 < x + y`]
]
; (* 1 more goal *)
REWRITE_TAC[NC;euclid_quad] THEN
REPEAT STRIP_TAC THENL (* 2 goals *)
[ DISJ2_TAC THEN
REWRITE_TAC[really_triangle] THEN
ASM_REWRITE_TAC[] THEN
ASM_MESON_TAC[betweennesssymmetry]
;
ASM_MESON_TAC[lemma2299;NCarea;area_non_negative;
REAL_ARITH `!x:real y:real . &0 < x /\ &0 <= y ==> &0 < x + y`]
]
]
);;
let NCNE = prove
( `!a:real^2 b:real^2 c:real^2. NC(a,b,c) ==> ~(a=b) /\ ~(a=c) /\ ~(b=c)`,
REPEAT GEN_TAC THEN
REWRITE_TAC[NC] THEN
DISCH_TAC THEN
ASM_REWRITE_TAC[]
);;
(* proved 3.17.18 *)
let areaNC = prove
( `!a:real^2 b:real^2 c:real^2. &0 < area(a,b,c) ==> NC(a,b,c)`,
REPEAT GEN_TAC THEN
REWRITE_TAC[area;tarea;NC;abs_pos] THEN
REPEAT STRIP_TAC THENL (* 6 goals *)
[ UNDISCH_TAC `~(abs ((c:real^2 - b:real^2) cross2 (a:real^2 - b:real^2)) = &0)` THEN
ASM_REWRITE_TAC[] THEN
REWRITE_TAC[VECTOR_ARITH `!a:real^2. a-a = vec(0):real^2`; xcrosszero;abszero]
;
UNDISCH_TAC `~(abs ((c:real^2 - b:real^2) cross2 (a:real^2 - b:real^2)) = &0)` THEN
ASM_REWRITE_TAC[] THEN
REWRITE_TAC[crosszero;abszero]
;
UNDISCH_TAC `~(abs ((c:real^2 - b:real^2) cross2 (a:real^2 - b:real^2)) = &0)` THEN
ASM_REWRITE_TAC[] THEN
REWRITE_TAC[VECTOR_ARITH `!a:real^2. a-a = vec(0):real^2`; zerocrossx; abszero]
;
UNDISCH_TAC `~(abs ((c:real^2 - b:real^2) cross2 (a:real^2 - b):real^2) = &0)` THEN
ASM_REWRITE_TAC[] THEN
UNDISCH_TAC `B(a:real^2,b:real^2,c:real^2)` THEN
REWRITE_TAC[B] THEN
STRIP_TAC THENL
[ ASM_REWRITE_TAC[] THEN
REWRITE_TAC[crossflip] THEN
ASM_REWRITE_TAC[] THEN
REWRITE_TAC[crosslinear1] THEN
ONCE_REWRITE_TAC[SPECL [`a:real^2`; `c:real^2`; `b:real^2`]
(VECTOR_ARITH `!z:real^2 x:real^2 y:real^2. x-y = (x-z)-(y-z)`) ] THEN
ASM_REWRITE_TAC[] THEN
REWRITE_TAC[crosslinear2;crosslinear1;crosszero;
VECTOR_ARITH `!a:real^2. a-a = vec(0):real^2`;
VECTOR_ARITH `x - (vec(0):real^2) = x`] THEN
REWRITE_TAC[VECTOR_ARITH `!x:real^2 y:real^2 z:real^2. x-y-z = (x-y)-z`] THEN
ONCE_REWRITE_TAC [GSYM crossdistrib1] THEN
REWRITE_TAC[crosslinear1;crosslinear2;crosszero] THEN
REAL_SIMP_TAC
]
;
UNDISCH_TAC `~(abs ((c:real^2 - b:real^2) cross2 (a:real^2 - b):real^2) = &0)` THEN
ASM_REWRITE_TAC[] THEN
UNDISCH_TAC `B(a:real^2,c:real^2,b:real^2)` THEN
REWRITE_TAC[B] THEN
STRIP_TAC THENL
[ ASM_REWRITE_TAC[] THEN
REWRITE_TAC[crossflip] THEN
ASM_REWRITE_TAC[] THEN
REWRITE_TAC[crosslinear1] THEN
ONCE_REWRITE_TAC[SPECL [`a:real^2`; `c:real^2`; `b:real^2`]
(VECTOR_ARITH `!z:real^2 x:real^2 y:real^2. x-y = (x-z)-(y-z)`) ] THEN
ASM_REWRITE_TAC[] THEN
REWRITE_TAC[crosslinear2;crosslinear1;crosszero;
VECTOR_ARITH `!a:real^2. a-a = vec(0):real^2`;
VECTOR_ARITH `x - (vec(0):real^2) = x`] THEN
REWRITE_TAC[VECTOR_ARITH `!x:real^2 y:real^2 z:real^2. x-y-z = (x-y)-z`] THEN
ONCE_REWRITE_TAC [GSYM crossdistrib1] THEN
REWRITE_TAC[crosslinear1;crosslinear2;crosszero] THEN
REAL_SIMP_TAC
]
;
UNDISCH_TAC `~(abs ((c:real^2 - b:real^2) cross2 (a:real^2 - b):real^2) = &0)` THEN
ASM_REWRITE_TAC[] THEN
UNDISCH_TAC `B(b:real^2,a:real^2,c:real^2)` THEN
REWRITE_TAC[B] THEN
STRIP_TAC THENL
[ ASM_REWRITE_TAC[] THEN
REWRITE_TAC[crossflip] THEN
ASM_REWRITE_TAC[] THEN
REWRITE_TAC[crosslinear1] THEN
ONCE_REWRITE_TAC[SPECL [`a:real^2`; `c:real^2`; `b:real^2`]
(VECTOR_ARITH `!z:real^2 x:real^2 y:real^2. x-y = (x-z)-(y-z)`) ] THEN
ASM_REWRITE_TAC[] THEN
REWRITE_TAC[crosslinear2;crosslinear1;crosszero;
VECTOR_ARITH `!a:real^2. a-a = vec(0):real^2`;
VECTOR_ARITH `x - (vec(0):real^2) = x`] THEN
REWRITE_TAC[VECTOR_ARITH `!x:real^2 y:real^2 z:real^2. x-y-z = (x-y)-z`] THEN
ONCE_REWRITE_TAC [GSYM crossdistrib1] THEN
REWRITE_TAC[crosslinear1;crosslinear2;crosszero] THEN
REAL_SIMP_TAC
]
]
);;
(* proved 3.18.18 *)
let paste3 = prove
( `!A:real^2 B1:real^2 C:real^2 D:real^2 a:real^2 b:real^2 c:real^2 d:real^2 M:real^2 m:real^2.
ET(A,B1,C,a,b,c) /\ ET(A,B1,D,a,b,d) /\ B(C,M,D) /\ B(c,m,d) /\
(B(A,M,B1) \/ A = M \/ M = B1) /\ (B(a,m,b) \/ a = m \/ m = b) ==> EF(A,C,B1,D,a,c,b,d)`,
REPEAT GEN_TAC THEN
REWRITE_TAC[ET;EF] THEN
DISCH_TAC THEN
REPEAT CONJ_TAC THENL (* 3 goals *)
[ ASM_MESON_TAC[lemma2332;NCNE;areaNC]
;
(* be patient, this takes a couple of minutes, munch longer than the similar goal above. *)
ASM_MESON_TAC[lemma2332;NCNE;areaNC]
;
ASM_MESON_TAC[lemma2299;NCNE;areaNC] (* Takes even longer. Be patient *)
]
);;
(* proved 3.30.18 *)
let lemma2494 = prove
( `!t:real s:real. &0 < t /\ t < &1 /\ &0 < s /\ s < &1 ==> (&1-s)/(&1-t*s) < &1`,
REPEAT STRIP_TAC THEN
SUBGOAL_THEN `&0 < &1 - t*s` ASSUME_TAC THENL
[ ASM MESON_TAC[lemma707]
;
REWRITE_TAC[ REAL_FIELD `a*b/c = (a*b)/c`] THEN
ASM_SIMP_TAC[ REAL_LT_LDIV_EQ] THEN (* `(&1 - s) < &1 * (&1 - t * s)` *)
REAL_SIMP_TAC THEN (* `1- s < &1 - s * t` *)
ONCE_REWRITE_TAC[GSYM REAL_SUB_LT] THEN
REWRITE_TAC[REAL_ARITH `x-y - (x-z) = z-y`] THEN (* &0 < s - s*t *)
REAL_SIMP_TAC THEN (* s*t < s *)
ASM_MESON_TAC[REAL_MUL_LT; REAL_MUL_RID]
]
);;
(* proved 3.30.18 *)
let lemma2510 = prove
( `!t:real s:real. &0 < t /\ t < &1 /\ &0 < s /\ s < &1 ==> &0 < (&1-s)/(&1-t*s)`,
REPEAT STRIP_TAC THEN
SUBGOAL_THEN `&0 < &1 - t*s` ASSUME_TAC THENL
[ ASM MESON_TAC[lemma707]
;
REWRITE_TAC[ REAL_FIELD `a*b/c = (a*b)/c`] THEN
ASM_SIMP_TAC[ REAL_LT_RDIV_EQ; REAL_ARITH `&0 * (x:real) = &0`] THEN (* `(&0 < &1-s` *)
ASM_MESON_TAC[ lemma342]
]
);;
(* case q = 0 of outer_pasch, but with one betweenness hypothesis in reversed order .*)
(* proved 4.2.18 *)
let outer_pasch_zero = prove
( `!a:real^2 p:real^2 b:real^2 c:real^2.
B(a,p,c) /\ B(vec(0):real^2,c,b) /\ &0 < area(b,vec(0):real^2,a) ==>
?(x:real^2). B(a,x,vec(0):real^2) /\ B(b,p,x)`,
REPEAT GEN_TAC THEN
PATH_REWRITE_TAC "lr" [B] THEN
REWRITE_TAC[NORM_ARITH `!x:real^2. x-x = vec(0):real^2`;
lemma870
] THEN
REPEAT STRIP_TAC THEN
ASM_REWRITE_TAC[] THEN
ONCE_REWRITE_TAC[betweennesssymmetry] THEN
ABBREV_TAC `u:real = (&1-(t:real) * (t':real))` THEN
ABBREV_TAC `s:real = (&1-t:real)/ (u:real)` THEN
EXISTS_TAC `(s:real) % (a:real^2)` THEN
REWRITE_TAC[B] THEN
CONJ_TAC THENL
[ EXISTS_TAC `s:real` THEN
REWRITE_TAC[NORM_ARITH `x:real^2-vec(0):real^2 = x:real^2`] THEN
CONJ_TAC THENL
[ (* goal is &0 < s /\ s < &1 *)
EXPAND_TAC "s" THEN EXPAND_TAC "u" THEN
(* &0 < (1-t)/(1-t*t') < &1 *)
ASM_MESON_TAC[REAL_MUL_SYM; lemma2494;lemma2510]
;
(* goal is ~(vec(0) = a *)
STRIP_TAC THEN (* puts vec 0 = a in assumption list *)
UNDISCH_TAC `&0 < area(b:real^2, vec(0):real^2, a:real^2)` THEN
REWRITE_TAC[area;tarea;NORM_ARITH `x:real^2-vec(0):real^2 = x:real^2`;GSYM REAL_ABS_NZ] THEN
ASM_MESON_TAC[zerocrossx]
]
; (* Now the goal is `?t. (p - s % a = t % (b - s % a) /\ &0 < t /\ t < &1) /\ ~(s % a = b)` *)
(* p = a + t%(c-a) = (1-t) a + tc = (1-t)a + tt'b, so p-s%a = (1-t-s)a + tt'b so (new t) = tt'
and then we should have -tt's % a = (1-t-s)% a or -tt' s = 1-t-s. We have (1-tt')s = 1-t,
or s-tt's = 1-t and thus -tt's = 1-s-t. So there is no mistake here: just tricky algebra. *)
EXISTS_TAC `(t:real)*(t':real)` THEN
CONJ_TAC THENL
[ CONJ_TAC THENL
[ (* goal is `p - s % a = (t * t') % (b - s % a)` *)
WE_HAVE_BY (NORM_ARITH `!p:real^2 q:real^2 r:real^2. p -q = r ==> p = q+r`) THEN
ASM_REWRITE_TAC[] THEN (* That eliminates p leaving
`(a + t % (t' % b - a)) - s % a = (t * t') % (b - s % a)` *)
REWRITE_TAC[VECTOR_SUB_LDISTRIB;VECTOR_MUL_ASSOC] THEN
SUBGOAL_THEN `(&1-t:real*t':real)*s:real = &1-t:real` ASSUME_TAC THENL
[ ASM_MESON_TAC[REAL_LT_IMP_NZ;lemma707;REAL_FIELD `~(b = &0) ==> (a/b = c <=> a=b*c)`]
;
REWRITE_TAC [ NORM_ARITH `!x:real^2 y:real^2 z:real^2 w:real^2 p:real^2.
(x+y-z)-w = y-p <=> x-z-w+p = vec(0):real^2`] THEN
(* `a - t % a - s % a + ((t * t') * s) % a = vec 0` *)
REWRITE_TAC [ VECTOR_ARITH `!a:real^2. a - t % a - s % a + ((t * t') * s) % a =
a - t%a - ((&1- t*t')*s) % a`] THEN
ASM_REWRITE_TAC[] THEN
(* `a - t % a - (&1 - t) % a = vec 0 *)
REWRITE_TAC[VECTOR_SUB_RDISTRIB; VECTOR_MUL_LID ] THEN
VECTOR_ARITH_TAC
]
;
ASM_SIMP_TAC[lemma01]
]
;
(* one goal left, namely ~(s % a = b) *)
STRIP_TAC THEN
UNDISCH_TAC `&0 < area(b:real^2, vec(0):real^2,a:real^2)` THEN
REWRITE_TAC[area;tarea;VECTOR_SUB_RZERO] THEN
UNDISCH_TAC `s:real % a:real^2 = b:real^2` THEN
ONCE_REWRITE_TAC [VECTOR_ARITH `!x:real^2 y:real^2. x=y <=> y=x`] THEN
DISCH_TAC THEN
ASM_REWRITE_TAC[] THEN
REWRITE_TAC[crosslinear2;crosszero] THEN
ASM_MESON_TAC[crosslinear2;crosszero;REAL_ABS_0;REAL_LT_REFL;REAL_MUL_RZERO]
(* This would have worked before UNDISCH_TAC above, but it takes longer so might as well leave it this way.*)
]
]
);;
(* stated 3.30.18, proved 4.2.18 *)
let outerPasch = prove
( `!a:real^2 p:real^2 c:real^2 q:real^2 b:real^2.
B(a,p,c) /\ B(b,c,q) /\ &0 < area(b,q,a) ==> ?t:real^2. B(a,t,q) /\ B(b,p,t)`,
REPEAT GEN_TAC THEN
ONCE_REWRITE_TAC[SPEC `q:real^2` translation_invarianceB ] THEN
ONCE_REWRITE_TAC[SPEC `q:real^2` area_translation ] THEN
REWRITE_TAC[NORM_ARITH `!x:real^2. x-x = vec(0):real^2`] THEN
STRIP_TAC THEN
WE_HAVE_BY_N 0 (left_to_right betweennesssymmetry) THEN
WE_HAVE_BY_N 1 (left_to_right betweennesssymmetry) THEN
WE_HAVE_BY3 outer_pasch_zero THEN
EXISTS_TAC `(x:real^2) + (q:real^2)` THEN
REWRITE_TAC[VECTOR_ARITH `((x:real^2) + (y:real^2))-(y:real^2) = x:real^2`] THEN
ASM_REWRITE_TAC[]
);;
(* proved 4.2.18 *)
let two_pieces = prove
( `!d:real^2 a:real^2 b:real^2 c:real^2. B(a,b,c) /\ &0 < area(d,a,c) ==> &0 < area(d,a,b)`,
REPEAT GEN_TAC THEN
REWRITE_TAC[B;area;tarea] THEN
REPEAT STRIP_TAC THEN
REWRITE_TAC [REAL_ARITH `&0 < abs(x) <=> ~(x = &0)`] THEN
ASM_REWRITE_TAC[] THEN
REWRITE_TAC[crosslinear1] THEN
ASM_SIMP_TAC[ REAL_SOS `&0 < t ==> (t*x = &0 <=> x = &0)`] THEN
STRIP_TAC THEN
UNDISCH_TAC `&0 < abs ((c:real^2 - a:real^2) cross2 (d:real^2 - a:real^2))` THEN
REWRITE_TAC [REAL_ARITH `&0 < abs(x) <=> ~(x = &0)`] THEN
ASM_SIMP_TAC[]
);;
(* proved 4.2.18 *)
let area_monotone = prove
( `!d:real^2 a:real^2 b:real^2 c:real^2. B(a,b,c) /\ &0 < area(d,a,b) ==> &0 < area(d,a,c)`,
REPEAT GEN_TAC THEN
REWRITE_TAC[B;area;tarea] THEN
REPEAT STRIP_TAC THEN
REWRITE_TAC [REAL_ARITH `&0 < abs(x) <=> ~(x = &0)`] THEN
ASM_REWRITE_TAC[] THEN
REWRITE_TAC[crosslinear1] THEN
ASM_SIMP_TAC[ REAL_SOS `&0 < t ==> (t*x = &0 <=> x = &0)`] THEN
STRIP_TAC THEN
UNDISCH_TAC `&0 < abs ((b:real^2 - a:real^2) cross2 (d:real^2 - a:real^2))` THEN
REWRITE_TAC [REAL_ARITH `&0 < abs(x) <=> ~(x = &0)`] THEN
ASM_SIMP_TAC[] THEN
REWRITE_TAC[crosslinear1] THEN
ASM_SIMP_TAC[ REAL_SOS `&0 < t ==> (t*x = &0 <=> x = &0)`]
);;
let area_monotone2 = prove
( `!d:real^2 a:real^2 b:real^2 c:real^2 m:real^2. B(d,m,a) /\ B(b,m,c) /\ &0 < area(d,a,b) ==> &0 < area4(a,b,d,c)`,
(* This doesn't work although it lists everything used in the final proof:
MESON_TAC[convex_quad;weak_additivity2;area_permutation1;area_permutation2; area4perm;area4perm2;
REAL_ARITH `!x:real y:real. &0 <= y /\ &0 < x ==> &0 < x+y`; area_non_negative;betweennesssymmetry] *)
REPEAT STRIP_TAC THEN
SUBGOAL_THEN `convex_quad(b:real^2,d:real^2,c:real^2,a:real^2)` ASSUME_TAC THENL
[ ASM_MESON_TAC[convex_quad;betweennesssymmetry]
;
ONCE_REWRITE_TAC[ area4perm2] THEN
ONCE_REWRITE_TAC[ area4perm] THEN
WE_HAVE_BY weak_additivity2 THEN (* `area4 (d,b,a,c) = area (d,c,b) + area (a,c,b)`] *)
UNDISCH_TAC `&0 < area(d:real^2, a:real^2, b:real^2)` THEN
ONCE_REWRITE_TAC[area_permutation2] THEN (* without these two lines the proof works but is much slower. *)
ONCE_REWRITE_TAC[area_permutation1] THEN
ASM_MESON_TAC[ REAL_ARITH `!x:real y:real. &0 <= y /\ &0 < x ==> &0 < x+y`; area_non_negative;area_permutation1;
area_permutation2;area4perm2;area4perm]
]
);;
(* proved 4.10.18 *)
let additivity7 = prove
( `!K:real^2 F1:real^2 H:real^2 G:real^2 M:real^2 L1:real^2.
B(K,H,M) /\ B(F1,G,L1) /\ convex_quad(F1,K,H,G) /\ convex_quad(F1,K,M,L1) /\ convex_quad(G,H,M,L1)
==> area4(F1,K,M,L1) = area4(F1,K,H,G) + area4(G,H,M,L1)`,
REPEAT GEN_TAC THEN
STRIP_TAC THEN
(* following line duplicates an assumption *)
ASSUME_TAC (ASSUME `convex_quad(F1:real^2, K:real^2, M:real^2, L1:real^2)`) THEN
UNDISCH_TAC `convex_quad(F1:real^2, K:real^2, M:real^2, L1:real^2)` THEN (* get one copy out *)
REWRITE_TAC [convex_quad] THEN
STRIP_TAC THEN
(* following line duplicates an assumption *)
ASSUME_TAC (ASSUME `convex_quad(F1:real^2, K:real^2, H:real^2, G:real^2)`) THEN
UNDISCH_TAC `convex_quad(F1:real^2, K:real^2, H:real^2, G:real^2)` THEN (* get one copy out *)
REWRITE_TAC [convex_quad] THEN
STRIP_TAC THEN
SUBGOAL_THEN `~(G:real^2 = K:real^2)` ASSUME_TAC THENL
[ ASM_MESON_TAC[betweennotequal;betweennesssymmetry]
;
SUBGOAL_THEN `~(t:real^2 = F1:real^2)` ASSUME_TAC THENL
[ ASM_MESON_TAC[betweennotequal;betweennesssymmetry]
;
WE_HAVE_BY4 tarski_innerPasch THEN
SUBGOAL_THEN `B(F1:real^2, t'':real^2,M:real^2)` ASSUME_TAC THENL
[ ASM_MESON_TAC[connectivity]
;
SUBGOAL_THEN `convex_quad(F1:real^2,K:real^2, M:real^2, G:real^2)` ASSUME_TAC THENL
[ ASM_MESON_TAC[convex_quad;betweennesssymmetry]
;
WE_HAVE_BY3 additivity4 THEN
(* deduces `area4 (F1,K,H,G) + area (H,G,M) = area4 (F1,K,M,G)` *)
WE_HAVE_BY convex_quadflip THEN (* convex_quad (K,F1,G,M) *)
WE_HAVE_BY_N 3 convex_quadflip THEN (* `convex_quad (K,F1,L1,M)` *)
WE_HAVE_BY3 additivity4 THEN
WE_HAVE_BY_N 4 convex_quadflip THEN
WE_HAVE_BY weak_additivity2 THEN
(* ASM_MESON_TAC[REAL_ADD_AC; area_permutation1;area_permutation2;area4perm;area4perm2] *)
(* does not work in 8 minutes; then I wrote area4flip, which seemed to help: *)
PATH_REWRITE_TAC "rr" [area4flip] THEN
ASM_REWRITE_TAC[] THEN
ASM_MESON_TAC[REAL_ADD_AC; area_permutation1;area_permutation2;area4flip]
]
]
]
]
);;
(* proved 4.11.18 *)
(* like additivity7 but without the hypothesis convex_quad(G,H,L1,M), so we have to prove that
and then apply additivity7 *)
let additivity8 = prove
( `!K:real^2 F1:real^2 H:real^2 G:real^2 M:real^2 L1:real^2.
B(K,H,M) /\ B(F1,G,L1) /\ convex_quad(F1,K,H,G) /\ convex_quad(F1,K,M,L1) /\ ~(G = M) /\ ~(H=L1)
==> area4(F1,K,M,L1) = area4(F1,K,H,G) + area4(G,H,M,L1)`,
REPEAT GEN_TAC THEN
STRIP_TAC THEN
WE_HAVE_BY (left_to_right convex_quad) THEN
WE_HAVE_BY_N 0 (left_to_right betweennesssymmetry) THEN
WE_HAVE_BY_N 1 (left_to_right betweennesssymmetry) THEN
WE_HAVE_BY_N 6 (left_to_right betweennesssymmetry) THEN
WE_HAVE_BY_N 7 (left_to_right betweennesssymmetry) THEN
SUBGOAL_THEN `~(t:real^2 = L1:real^2)` ASSUME_TAC THENL
[ ASM_MESON_TAC[betweennotequal]
;
(* WE_HAVE_BY4 tarski_innerPasch only adds ONE assumption instead of the expected two! *)
WE_HAVE_BY4_NOMATCHING ( SPECL [`L1:real^2`;`G:real^2`;`F1:real^2`;`t:real^2`;`M:real^2`] tarski_innerPasch) THEN
(* 13 [`B (L1,t',t)`]
14 [`B (M,t',G)`] *)
SUBGOAL_THEN `~(t:real^2 = M:real^2)` ASSUME_TAC THENL
[ ASM_MESON_TAC[betweennotequal]
;
WE_HAVE_BY4_NOMATCHING ( SPECL [`M:real^2`;`H:real^2`;`K:real^2`;`t:real^2`;`L1:real^2`] tarski_innerPasch) THEN
(* 16 [`B (M,t'',t)`]
17 [`B (L1,t'',H)`] *)
SUBGOAL_THEN `~(t':real^2 = M:real^2)` ASSUME_TAC THENL
[ ASM_MESON_TAC[betweennotequal]
;
SUBGOAL_THEN `~(t'':real^2 = L1:real^2)` ASSUME_TAC THENL
[ ASM_MESON_TAC[betweennotequal]
;
WE_HAVE_BY4_NOMATCHING ( SPECL [`L1:real^2`;`t':real^2`;`t:real^2`;`t'':real^2`;`M:real^2`] tarski_innerPasch) THEN
SUBGOAL_THEN `B(M:real^2, t''':real^2, G:real^2)` ASSUME_TAC THENL
[ ASM_MESON_TAC[connectivity]
;
SUBGOAL_THEN `B(L1:real^2, t''':real^2, H:real^2)` ASSUME_TAC THENL
[ ASM_MESON_TAC[connectivity]
;
ASM_MESON_TAC[convex_quad;additivity7; betweennesssymmetry]
]
]
]
]
]
]
);;
(* proved 4.11.18 *)
let lemma2840 = prove
( `!a:real^2 b:real^2 d:real^2. area4(a,b,a,d) = &0`,
REPEAT GEN_TAC THEN
REWRITE_TAC[area4;sarea4] THEN
REWRITE_TAC[ VECTOR_ARITH `x:real^2-x:real^2 = vec(0):real^2`] THEN
REWRITE_TAC[ zerocrossx;REAL_ABS_0] THEN
REAL_SIMP_TAC
);;
(* proved 4.16.18 *)
let lemma2850 = prove
(`!F1:real^2 H:real^2 G:real^2 K:real^2 M:real^2 L1:real^2.
B(F1,G,L1) /\ B(K,H,M) /\ B(F1,J,M) /\ B(K,J,L1) /\ euclid_quad(F1,K,H,G) ==>
euclid_quad(F1,K,M,L1)`,
REPEAT STRIP_TAC THEN
SUBGOAL_THEN `convex_quad(F1:real^2, K:real^2, M:real^2, L1:real^2)` ASSUME_TAC THENL
[ ASM_MESON_TAC[convex_quad]
;
REWRITE_TAC[euclid_quad] THEN
STRIP_TAC THENL (* two goals *)
[ DISJ1_TAC THEN
ASM_REWRITE_TAC[]
;
UNDISCH_TAC `euclid_quad(F1:real^2,K:real^2,H:real^2, G:real^2)` THEN
REWRITE_TAC[euclid_quad] THEN
STRIP_TAC THENL (* two goals, both to prove 0 < area4(F1,K,M,L1) *)
[ (* assuming convex_quad(F1,K,H,G) *)
ASSUME_TAC (ASSUME `convex_quad(F1:real^2, K:real^2, H:real^2, G:real^2)`) THEN
UNDISCH_TAC `convex_quad(F1:real^2, K:real^2, H:real^2, G:real^2)` THEN (* get one copy out *)
REWRITE_TAC [convex_quad] THEN
STRIP_TAC THEN
SUBGOAL_THEN `~(G:real^2 = M:real^2)` ASSUME_TAC THENL
[ WE_HAVE_BY_N 1 (left_to_right betweennesssymmetry) THEN (* B(M,H,K) *)
WE_HAVE_BY_N 8 (left_to_right betweennesssymmetry) THEN (* B(G,t,K) *)
WE_HAVE_BY_N 7 (left_to_right betweennesssymmetry) THEN (* B(H,t,F1) *)
STRIP_TAC THEN
UNDISCH_TAC `B (G:real^2,t:real^2,K:real^2)` THEN
ASM_REWRITE_TAC[] THEN
STRIP_TAC THEN
ASSUME_TAC (ASSUME `&0 < area4(F1:real^2, K:real^2, H:real^2, G:real^2)`) THEN
UNDISCH_TAC `&0 < area4(F1:real^2, K:real^2, H:real^2, G:real^2)` THEN
ONCE_REWRITE_TAC[area4flip] THEN
ONCE_REWRITE_TAC[area4flip] THEN
WE_HAVE_BY_N 8 (left_to_right betweennesssymmetry) THEN (* B(G,t,K) *)
ONCE_REWRITE_TAC[area4perm] THEN
ONCE_REWRITE_TAC[area4perm] THEN
ONCE_REWRITE_TAC[area4perm] THEN
STRIP_TAC THEN
WE_HAVE_BY3 quad_area_pos2 THEN (* &0 < area(H,G,K) *)
SUBGOAL_THEN `&0 < area(K:real^2, G:real^2, M:real^2)` ASSUME_TAC THENL
[ ASM_MESON_TAC[area_monotone; area_permutation1;area_permutation2]
;
UNDISCH_TAC `&0 < area(K:real^2, G:real^2, M:real^2)` THEN
ASM_REWRITE_TAC[] THEN
ASM_MESON_TAC[areaNC;NCarea;NC]
]
; (* Now we have ~ (G = M) in the assumption list *)
SUBGOAL_THEN `~(L1:real^2 = H:real^2)` ASSUME_TAC THENL
[ (* This is symmetric with the above argument, changing FGL for KHM. So the
following should theoretically work, but it doesn't.
ASM_MESON_TAC[betweennesssymmetry;area4flip;area4perm2;quad_area_pos2;
area_monotone; area_permutation1; area_permutation2; areaNC; NCarea;NC]
*)
STRIP_TAC THEN
ASSUME_TAC (ASSUME `&0 < area4(F1:real^2, K:real^2, H:real^2, G:real^2)`) THEN
UNDISCH_TAC `&0 < area4(F1:real^2, K:real^2, H:real^2, G:real^2)` THEN
PATH_REWRITE_TAC "lr" [area4perm2] THEN
STRIP_TAC THEN
WE_HAVE_BY_N 7 (left_to_right betweennesssymmetry) THEN (* B(H,t,F1) *)
WE_HAVE_BY_N 8 (left_to_right betweennesssymmetry) THEN (* B(G,t,K) *)
WE_HAVE_BY3 quad_area_pos2 THEN
SUBGOAL_THEN `&0 < area(F1:real^2, H:real^2, L1:real^2)` ASSUME_TAC THENL
[ ASM_MESON_TAC[area_monotone; area_permutation1;area_permutation2]
;
UNDISCH_TAC `&0 < area(F1:real^2, H:real^2, L1:real^2)` THEN
ASM_REWRITE_TAC[] THEN
ASM_MESON_TAC[areaNC;NCarea;NC]
]
; (* Now ~(L1=H) is in the assumption list and the goal is 0 < area4(F1,K,M,L1 *)
ASSUME_TAC (ASSUME `&0 < area4(F1:real^2, K:real^2, H:real^2, G:real^2)`) THEN
UNDISCH_TAC `&0 < area4(F1:real^2, K:real^2, H:real^2, G:real^2)` THEN
ONCE_REWRITE_TAC[area4perm] THEN
ONCE_REWRITE_TAC[area4perm] THEN
ONCE_REWRITE_TAC[area4perm] THEN
WE_HAVE_BY_N 8 (left_to_right betweennesssymmetry) THEN (* B(G,t,K) *)
STRIP_TAC THEN
UNDISCH_TAC `B(F1:real^2, t:real^2, H:real^2)` THEN
DISCH_TAC THEN
WE_HAVE_BY3 quad_area_pos2 THEN (* 0 < area(F1,G,H) *)
SUBGOAL_THEN `&0 < area(F1:real^2, H:real^2, L1:real^2)` ASSUME_TAC THENL
[ ASM_MESON_TAC[area_monotone; area_permutation1;area_permutation2;betweennesssymmetry]
;
ONCE_REWRITE_TAC[area4perm] THEN
ASM_SIMP_TAC[additivity8] THEN (* at last! *)
MATCH_MP_TAC (REAL_ARITH `!x y. &0 < x /\ &0 <= y ==> &0< x+y`) THEN
ASM_REWRITE_TAC[] THEN
REWRITE_TAC[area4; REAL_ABS_POS]
]
]
]
;
(* Now the goal is `&0 < area4 (F1,K,M,L1)`, but we have really_triangle(F,K,H,G) instead
of convex_quad *)
UNDISCH_TAC `really_triangle(F1:real^2, K:real^2, H:real^2, G:real^2)` THEN
REWRITE_TAC [really_triangle] THEN
STRIP_TAC THENL (* 4 goals *)
[ (* B(F1, K, H) *)
WE_HAVE_BY2 connectivity7 THEN (* B(F1,K,M) *)
ASM_SIMP_TAC[GSYM areaequalsarea4] THEN (* &0 < area(F1,M,L) *)
UNDISCH_TAC `&0 < area4(F1:real^2, K:real^2, H:real^2, G:real^2)` THEN
ASM_SIMP_TAC[GSYM areaequalsarea4] THEN
DISCH_TAC THEN (* &0 < area(F1,H,G) *)
WE_HAVE_BY2 connectivity8 THEN (* B(F1,H,M) *)
(* Be patient! *)
ASM_MESON_TAC[betweennesssymmetry;
area4perm;area4perm2;area_permutation1;area_permutation2;
area_monotone]
;
(* Now assuming B(K,H,G) *)
UNDISCH_TAC `&0 < area4(F1:real^2, K:real^2, H:real^2, G:real^2)` THEN
PATH_REWRITE_TAC "lr" [area4perm] THEN
ASM_SIMP_TAC[GSYM areaequalsarea4] THEN
ONCE_REWRITE_TAC[area_permutation2] THEN
DISCH_TAC THEN
WE_HAVE_BY2 area_monotone THEN (* `&0 < area (K,F1,L1)` *)
ASM_MESON_TAC[area_monotone2; betweennesssymmetry; area4perm;area4perm2;area_permutation1;area_permutation2]
;
(* Now assuming B(H,G,F1) *)
UNDISCH_TAC `&0 < area4(F1:real^2, K:real^2, H:real^2, G:real^2)` THEN
PATH_REWRITE_TAC "lr" [area4perm] THEN
PATH_REWRITE_TAC "lr" [area4perm] THEN
ASM_SIMP_TAC[GSYM areaequalsarea4] THEN
ONCE_REWRITE_TAC[area_permutation1] THEN
DISCH_TAC THEN
WE_HAVE_BY2 area_monotone THEN (* `&0 < area (F1,K,M)`] *)
ASM_MESON_TAC[area_monotone2; betweennesssymmetry; area4perm;area4perm2;area_permutation1;area_permutation2]
; (* Now assuming B(G,F1,K) *)
WE_HAVE_BY (left_to_right betweennesssymmetry) THEN (* `B (K,F1,G)`] *)
WE_HAVE_BY2 connectivity7 THEN (* [`B (K,F1,L1)`] *)
ONCE_REWRITE_TAC [area4flip] THEN
ASM_SIMP_TAC[GSYM areaequalsarea4] THEN (* `&0 < area (K,L1,M)` *)
UNDISCH_TAC `&0 < area4(F1:real^2, K:real^2, H:real^2, G:real^2)` THEN
PATH_REWRITE_TAC "lr" [area4flip] THEN
ASM_SIMP_TAC[GSYM areaequalsarea4] THEN
DISCH_TAC THEN
WE_HAVE_BY_N 0 (left_to_right betweennesssymmetry) THEN (* B(L1, G, F1) *)
WE_HAVE_BY2 connectivity7 THEN (* `B (L1,G,K)`] *)
(* Be very patient *)
ASM_MESON_TAC[betweennesssymmetry;area_permutation1;area_permutation2;area_monotone]
]
]]]
);;
let VECTOR_SUB_EQ = VECTOR_ARITH `!z:real^2 y:real^2 x:real^2. x=y <=> x-z = y-z`;;
let VECTOR_ADD_EQ = VECTOR_ARITH `!z:real^2 y:real^2 x:real^2. x=y <=> x+z = y+z`;;
(* proved 4.18.18 *)
let lemma3078= prove
( `!a:real^2 b:real^2 c:real^2. B(a,b,c) ==> ?t:real. (&0 < t /\ (c-b) = t % (b-a))`,
REPEAT GEN_TAC THEN
REWRITE_TAC[B] THEN STRIP_TAC THEN
EXISTS_TAC `&1/t - &1` THEN
CONJ_TAC THENL
[ MATCH_MP_TAC (SPEC `t:real` REAL_LT_LCANCEL_IMP) THEN
ASM_REWRITE_TAC[] THEN
REAL_SIMP_TAC THEN (* t < t * &1/t *)
WE_HAVE_BY REAL_LT_IMP_NZ THEN (* ~ (t = &0) *)
ASM_SIMP_TAC[GSYM lemma978]
;
(* `c - b = (&1 / t - &1) % (b - a)` *)
REWRITE_TAC[VECTOR_SUB_RDISTRIB] THEN
REWRITE_TAC [VECTOR_MUL_LID] THEN
ONCE_REWRITE_TAC [SPEC `b:real^2-a:real^2` VECTOR_ADD_EQ] THEN
REWRITE_TAC [VECTOR_ARITH `!x:real^2 y:real^2 z:real^2. x-y+y = x`] THEN
REWRITE_TAC [VECTOR_ARITH `!x:real^2 y:real^2 z:real^2 w:real^2. x-y+y-w = x-w`] THEN
ASM_SIMP_TAC[VECTOR_MUL_EQ] THEN
REWRITE_TAC[VECTOR_MUL_LID]
]
);;
(* proved 4.18.18 *)
let outer_connectivity = prove
( `!x:real^2 y:real^2 a:real^2 b:real^2. B(x,y,a) /\ B(x,y,b) ==> B(y,a,b) \/ B(y,b,a) \/ a=b`,
REPEAT GEN_TAC THEN
STRIP_TAC THEN
WE_HAVE_BY lemma3078 THEN
WE_HAVE_BY_N 0 lemma3078 THEN
ASM_CASES_TAC `t:real < t':real` THENL
[ (* t < t' *)
DISJ2_TAC THEN DISJ1_TAC THEN
(* goal is B(y,b,a) *)
REWRITE_TAC[B] THEN
EXISTS_TAC `(t:real)/(t':real)` THEN
REPEAT CONJ_TAC THENL (* 4 goals, 5 total *)
[ ASM_SIMP_TAC[VECTOR_MUL_EQ] THEN
ASM_MESON_TAC[VECTOR_MUL_ASSOC; REAL_MUL_SYM]
;
ASM_SIMP_TAC [REAL_LT_DIV] THEN
MATCH_MP_TAC lemma1490 THEN
ASM_SIMP_TAC[]
;
ASM_MESON_TAC[lemma1490]
;
ASM_MESON_TAC[betweennotequal]
]
;
ASM_CASES_TAC `t:real = t':real` THENL
[ (* case t = t' *)
DISJ2_TAC THEN DISJ2_TAC THEN
ONCE_REWRITE_TAC [SPEC `y:real^2` VECTOR_SUB_EQ] THEN
ASM_MESON_TAC[]
;
(* ~t < t' and ~(t = t') *)
DISJ1_TAC THEN
WE_HAVE_BY2 (REAL_ARITH `!t:real s:real. ~(t < s) /\ ~(t = s) ==> s < t`) THEN (* deduce t' < t *)
REWRITE_TAC[B] THEN
EXISTS_TAC `(t':real)/(t:real)` THEN
REPEAT CONJ_TAC THENL (* 4 subgoals *)
[ ASM_REWRITE_TAC[] THEN (* `t' % (y - x) = t' / t % t % (y - x)` *)
REWRITE_TAC [VECTOR_MUL_ASSOC] THEN
ASM_MESON_TAC[ REAL_LT_IMP_NZ; REAL_DIV_RMUL]
;
(* goal is 0 < t'/t *)
ASM_MESON_TAC[REAL_LT_DIV]
;
(* goal is t'/t < &1 *)
ASM_MESON_TAC[lemma1490]
;
(* goal is ~(y = b) *)
ASM_MESON_TAC[betweennotequal]
]
]
]
);;
(* proved 4.19.18 *)
(* In a convex_quad with positive area, two opposite sides cannot cross. *)
let lemma3157 = prove
(`!a:real^2 b:real^2 c:real^2 d:real^2 p:real^2 q:real^2 m:real^2.
B(a,p,b) /\ B(c,q,d) /\ B(a,m,c) /\ B(b,m,d) /\ &0 < area4(a,b,c,d) ==> ~(p = q)`,
REPEAT STRIP_TAC THEN
WE_HAVE_BY_N 0 (left_to_right betweennesssymmetry) THEN (* B(bpa) *)
WE_HAVE_BY_N 2 (left_to_right betweennesssymmetry) THEN (* B(cma) *)
WE_HAVE_BY_N 3 (left_to_right betweennesssymmetry) THEN (* B(dmb) *)
UNDISCH_TAC `&0 < area4(a:real^2, b:real^2, c:real^2, d:real^2)` THEN
ONCE_REWRITE_TAC[area4perm] THEN
ONCE_REWRITE_TAC[area4perm] THEN
DISCH_TAC THEN
WE_HAVE_BY3 quad_area_pos2 THEN (* &0 < area(b,a,c) *)
WE_HAVE_BY3 innerPasch THEN (* B(c,t,p) and B(b,t,m) *)
UNDISCH_TAC `&0 < area4(b:real^2, c:real^2, d:real^2, a:real^2)` THEN
ONCE_REWRITE_TAC[area4perm] THEN
ONCE_REWRITE_TAC[area4perm] THEN
DISCH_TAC THEN
WE_HAVE_BY3 quad_area_pos1 THEN (* &0 < area(c,m,d) *)
SUBGOAL_THEN `B(d:real^2, m:real^2, t:real^2)` ASSUME_TAC THENL
[ ASM_MESON_TAC[betweennesssymmetry; connectivity2]
;
SUBGOAL_THEN `&0 < area(c:real^2,d:real^2,t:real^2)` ASSUME_TAC THENL
[ ASM_MESON_TAC[area_permutation2; area_monotone; area_permutation1]
;
SUBGOAL_THEN `&0 < area(d:real^2, c:real^2, p:real^2)` ASSUME_TAC THENL
[ ASM_MESON_TAC[area_permutation2; area_monotone; area_permutation1]
;
WE_HAVE_BY_N 1 (left_to_right betweennesssymmetry) THEN (* B(d,q,c) *)
WE_HAVE_BY_N 10 (left_to_right betweennesssymmetry) THEN (* B(p,t,c) *)
WE_HAVE_BY3 innerPasch THEN
ASM_MESON_TAC[betweennotequal]
]
]
]
);;
(* proved 4.20.18 *)
let lemma3195 = prove
( `!x:real^2 y:real^2. area(x,y,x) = &0`,
MESON_TAC[areaNC;NC;area_non_negative;REAL_ARITH `&0 <= x /\ ~(x = &0) ==> &0 < x`]
);;
(* proved 4.20.18 *)
let lemma3201 = prove
( `!a:real^2 b:real^2 c:real^2 d:real^2 e:real^2. B(b,a,c) /\ B(d,e,c) /\ &0 < area(b,c,d) ==> &0 < area(a,c,e)`,
REPEAT GEN_TAC THEN
ONCE_REWRITE_TAC[betweennesssymmetry] THEN
REWRITE_TAC[B;area;tarea] THEN
STRIP_TAC THEN
UNDISCH_TAC `&0 < abs ((d:real^2 - c:real^2) cross2 (b:real^2 - c:real^2))` THEN
ASM_REWRITE_TAC[] THEN
REWRITE_TAC[crosslinear1;crosslinear2;REAL_ABS_MUL] THEN
WE_HAVE_BY2_NOMATCHING (SPECL [`t':real`; `t:real`] (REAL_SOS `!x y. &0 < x /\ &0 < y ==> &0 < abs(x)* abs(y)`)) THEN
ONCE_REWRITE_TAC [ REAL_ARITH `x*y*z = (x*y) *z`] THEN
ASM_SIMP_TAC [REAL_SOS `&0 < t ==> (&0 < t* x <=> &0 < x)`]
);;
(* proved 4.20.18 *)
let lemma3216 = prove
( `!a:real^2 b:real^2 c:real^2 d:real^2 e:real^2.
B(b,a,c) /\ B(d,e,c) /\ area(a,c,e) = &0 ==> area(b,c,d) = &0`,
MESON_TAC[area_non_negative;REAL_ARITH `&0 <= x ==> ( ~(x = &0) <=> &0 < x)`; lemma3201]
);;
(* proved 4.20.18 *)
(* In a convex_quad with positive area, vertex c can't lie on side ad *)
let lemma3224 = prove
(`!a:real^2 b:real^2 c:real^2 d:real^2 p:real^2 q:real^2 m:real^2.
B(a,m,c) /\ B(b,m,d) /\ &0 < area4(a,b,c,d) ==> ~B(a,c,d)`,
REPEAT GEN_TAC THEN
ONCE_REWRITE_TAC [area4perm] THEN
ONCE_REWRITE_TAC [area4perm] THEN
ONCE_REWRITE_TAC [area4perm] THEN
REPEAT STRIP_TAC THEN
WE_HAVE_BY_N 0 (left_to_right betweennesssymmetry) THEN
WE_HAVE_BY_N 1 (left_to_right betweennesssymmetry) THEN
WE_HAVE_BY3 quad_area_pos2 THEN
ASM_MESON_TAC[areaNC; NC; betweennesssymmetry]
);;
(* proved 4.21.18 *)
let paste4_convex = prove
( `!A:real^2 B1:real^2 m:real^2 D:real^2 K:real^2 F1:real^2 H:real^2 G:real^2
C:real^2 e:real^2 M:real^2 L1:real^2 J:real^2 P:real^2.
euclid_quad (A,B1,m,D) /\ area4 (A,B1,m,D) = area4 (F1,K,H,G) /\
euclid_quad (D,B1,e,C) /\ euclid_quad (G,H,M,L1) /\
area4 (D,B1,e,C) = area4 (G,H,M,L1) /\
B(A,P,C) /\ B(B1,P,D) /\ B(K,H,M) /\
B(F1,G,L1) /\ B(B1,m,D) /\ B(B1,e,C) /\ B(F1,J,M) /\ B(K,J,L1) /\
euclid_quad (F1,K,M,L1) /\
convex_quad(F1,K,H,G) /\ &0 < area4(F1,K,H,G)
==> area4 (A,B1,C,D) = area4 (F1,K,M,L1)`,
REPEAT STRIP_TAC THEN
SUBGOAL_THEN `convex_quad(F1:real^2,K:real^2, M:real^2,L1:real^2)` ASSUME_TAC THENL
[ ASM_MESON_TAC[convex_quad]
;
ASSUME_TAC (ASSUME `euclid_quad(G:real^2, H:real^2, M:real^2, L1:real^2)`) THEN
UNDISCH_TAC `euclid_quad(G:real^2, H:real^2, M:real^2, L1:real^2)` THEN (* get one copy out *)
REWRITE_TAC [euclid_quad] THEN
STRIP_TAC THENL (* 2 goals in this list, 2 total *)
[ (* goal is `area4 (A,B1,C,D) = area4 (F1,K,M,L1)` with three convex_quad hypotheses, so additivity7 applies *)
ASM_SIMP_TAC[additivity7] THEN (* `area4 (A,B1,C,D) = area4 (F1,K,H,G) + area4 (G,H,M,L1)` *)
SUBGOAL_THEN `OS(A:real^2, B1:real^2, D:real^2, C:real^2)` ASSUME_TAC THENL
[ MATCH_MP_TAC (left_to_right (GSYM OS)) THEN
EXISTS_TAC `P:real^2` THEN
ASM_REWRITE_TAC[] THEN
CONJ_TAC THENL
[ ASM_MESON_TAC[CO]
;
(* goal is `NC (B1,D,A)` *)
ASM_MESON_TAC[euclid_quad;areaNC;area4perm;area4perm2;areaequalsarea4]
]
;
ASM_SIMP_TAC[GSYM additivity2] THEN
(* goal is `area (B1,D,A) + area (B1,D,C) = area4 (F1,K,H,G) + area4 (G,H,M,L1)` *)
ASM_MESON_TAC[areaequalsarea4; betweennesssymmetry;area_permutation1;area_permutation2;area4perm;area4perm2]
]
;
(* goal is `area4 (A,B1,C,D) = area4 (F1,K,M,L1) assuming `really_triangle (G,H,M,L1)` and `&0 < area4 (G,H,M,L1)` *)
(* we have to show ~(G = M) and ~(L=H) to apply additivity8 *)
SUBGOAL_THEN `~(G:real^2 = M:real^2)` ASSUME_TAC THENL
[ ASM_MESON_TAC[lemma2840; REAL_LT_REFL; euclid_quad]
;
SUBGOAL_THEN `~(L1:real^2 = H:real^2)` ASSUME_TAC THENL
[ ASM_MESON_TAC[lemma2840; REAL_LT_REFL; area4perm;area4perm2;euclid_quad]
;
SUBGOAL_THEN `convex_quad(F1:real^2,K:real^2,M:real^2,L1:real^2)` ASSUME_TAC THENL
[ ASM_MESON_TAC[convex_quad]
;
ASM_SIMP_TAC[additivity8] THEN
SUBGOAL_THEN `OS(A:real^2, B1:real^2, D:real^2, C:real^2)` ASSUME_TAC THENL
[ MATCH_MP_TAC (left_to_right (GSYM OS)) THEN
EXISTS_TAC `P:real^2` THEN
ASM_REWRITE_TAC[] THEN
CONJ_TAC THENL
[ ASM_MESON_TAC[CO]
;
(* goal is `NC (B1,D,A)` *)
ASM_MESON_TAC[euclid_quad;areaNC;area4perm;area4perm2;areaequalsarea4]
]
;
ASM_SIMP_TAC[GSYM additivity2] THEN
(* goal is `area (B1,D,A) + area (B1,D,C) = area4 (F1,K,H,G) + area4 (G,H,M,L1)` *)
ASM_MESON_TAC[areaequalsarea4; betweennesssymmetry;area_permutation1;area_permutation2;area4perm;area4perm2]
]
]
]
]
]
]
);;
(* proved 4.21.18 *)
let paste4_triangle1 = prove
( `!A:real^2 B1:real^2 m:real^2 D:real^2 K:real^2 F1:real^2 H:real^2 G:real^2
C:real^2 e:real^2 M:real^2 L1:real^2 J:real^2 P:real^2.
euclid_quad (A,B1,m,D) /\ area4 (A,B1,m,D) = area4 (F1,K,H,G) /\
euclid_quad (D,B1,e,C) /\ euclid_quad (G,H,M,L1) /\
area4 (D,B1,e,C) = area4 (G,H,M,L1) /\
B(A,P,C) /\ B(B1,P,D) /\ B(K,H,M) /\
B(F1,G,L1) /\ B(B1,m,D) /\ B(B1,e,C) /\ B(F1,J,M) /\ B(K,J,L1) /\
euclid_quad (F1,K,M,L1) /\ &0 < area4(F1,K,H,G) /\ B(F1,K,H)
==> area4 (F1,K,M,L1) = area4 (F1,K,H,G) + area4 (G,H,M,L1)`,
REPEAT STRIP_TAC THEN
ASM_SIMP_TAC[ GSYM areaequalsarea4] THEN
WE_HAVE_BY2 connectivity8 THEN (* `B (F1,H, M)`] *)
ONCE_REWRITE_TAC [area_permutation1] THEN
ONCE_REWRITE_TAC [area_permutation1] THEN
ONCE_REWRITE_TAC [area4perm] THEN
ONCE_REWRITE_TAC [area4perm] THEN
ONCE_REWRITE_TAC [area4perm] THEN
WE_HAVE_BY_N 8 (left_to_right betweennesssymmetry) THEN
WE_HAVE_BY_N 17 (left_to_right betweennesssymmetry) THEN
ONCE_REWRITE_TAC[VECTOR_ADD_SYM] THEN
ASM_SIMP_TAC[additivity3] THEN (* `area4 (L1,F1,K,M) = area (L1,F1,M)` *)
WE_HAVE_BY2 connectivity7 THEN (* B(F1,K,M) *)
PATH_REWRITE_TAC "lr" [area4perm] THEN
ASM_SIMP_TAC[GSYM areaequalsarea4] THEN
ASM_MESON_TAC[betweennesssymmetry;area_permutation1;area_permutation2;additivity3;]
);;
(* proved 4.21.18 *)
let paste4_triangle2 = prove
( `!A:real^2 B1:real^2 m:real^2 D:real^2 K:real^2 F1:real^2 H:real^2 G:real^2
C:real^2 e:real^2 M:real^2 L1:real^2 J:real^2 P:real^2.
euclid_quad (A,B1,m,D) /\ area4 (A,B1,m,D) = area4 (F1,K,H,G) /\
euclid_quad (D,B1,e,C) /\ euclid_quad (G,H,M,L1) /\
area4 (D,B1,e,C) = area4 (G,H,M,L1) /\
B(A,P,C) /\ B(B1,P,D) /\ B(K,H,M) /\
B(F1,G,L1) /\ B(B1,m,D) /\ B(B1,e,C) /\ B(F1,J,M) /\ B(K,J,L1) /\
euclid_quad (F1,K,M,L1) /\ &0 < area4(F1,K,H,G) /\ B(K,H,G)
==> area4 (F1,K,M,L1) = area4 (F1,K,H,G) + area4 (G,H,M,L1)`,
REPEAT STRIP_TAC THEN
WE_HAVE_BY2_NOMATCHING (SPECL [`K:real^2`;`H:real^2`;`G:real^2`; `M:real^2`] outer_connectivity) THENL
[ (* B(H,G,M) *)
WE_HAVE_BY2 connectivity8 THEN (* B(K,G,M) *)
SUBGOAL_THEN `&0 < area4(K:real^2, M:real^2, L1:real^2, F1:real^2)` ASSUME_TAC THENL
[ ASM_MESON_TAC[euclid_quad;area4perm]
;
ASM_MESON_TAC[lemma3157;betweennesssymmetry]
]
;
(* B(H,M,G) *)
WE_HAVE_BY2 connectivity8 THEN (* B(K,M,G) *)
UNDISCH_TAC `&0 < area4(F1:real^2, K:real^2, H:real^2, G:real^2)` THEN
PATH_REWRITE_TAC "lr" [area4perm] THEN
ASM_SIMP_TAC [GSYM areaequalsarea4] THEN
DISCH_TAC THEN (* 0 < area(K,G,F1) *)
WE_HAVE_BY3 outerPasch THEN (* B(F1,t,G) and B(K,J,t) *)
WE_HAVE_BY2 connectivity THEN (* B(F1,t,L1) *)
SUBGOAL_THEN `B(t:real^2,G:real^2, L1:real^2)` ASSUME_TAC THENL
[ ASM_MESON_TAC[connectivity; betweennessidentity; connectivity2; connectivity3;
connectivity4; connectivity5; connectivity6;connectivity7;
connectivity8;betweennesssymmetry]
;
SUBGOAL_THEN `area(J:real^2, K:real^2, J:real^2) = &0` ASSUME_TAC THENL
[ ASM_MESON_TAC[lemma3195]
;
SUBGOAL_THEN `area(t:real^2,K:real^2, L1:real^2) = &0` ASSUME_TAC THENL
[ ASM_MESON_TAC [lemma3216; betweennesssymmetry]
;
SUBGOAL_THEN `area(K:real^2, t:real^2, G:real^2) = &0` ASSUME_TAC THENL
[ ASM_MESON_TAC[area_monotone; area_permutation1; area_permutation2;
area_non_negative; REAL_ARITH `&0 <= x ==> ( ~(x = &0) <=> &0 < x)`]
;
SUBGOAL_THEN `area(K:real^2,G:real^2,F1:real^2) = &0` ASSUME_TAC THENL
[ ASM_MESON_TAC[two_pieces; area_permutation1; area_permutation2;
area_non_negative; betweennesssymmetry;
REAL_ARITH `&0 <= x ==> ( ~(x = &0) <=> &0 < x)`]
;
ASM_MESON_TAC [REAL_LT_REFL]
]
]
]
]
]
;
(* G=M *)
ASM_MESON_TAC[lemma3224;area4perm;betweennesssymmetry;euclid_quad]
]
);;
(* proved 4.21.18 *)
let really_triangle_flip = prove
(`!a:real^2 b:real^2 c:real^2 d:real^2. really_triangle(a,b,c,d) ==> really_triangle(b,a,d,c)`,
MESON_TAC[really_triangle;betweennesssymmetry]
);;
let euclid_quad_flip = prove
(`!a:real^2 b:real^2 c:real^2 d:real^2. euclid_quad(a,b,c,d) ==> euclid_quad(b,a,d,c)`,
MESON_TAC[euclid_quad;area4flip;convex_quadflip;really_triangle_flip]
);;
(* proved 4.21.18 *)
let paste4 = prove
( `!A:real^2 B1:real^2 m:real^2 D:real^2 K:real^2 F1:real^2 H:real^2 G:real^2
C:real^2 e:real^2 M:real^2 L1:real^2 J:real^2 P:real^2.
EF(A,B1,m,D,F1,K,H,G) /\ EF(D,B1,e,C,G,H,M,L1) /\ B(A,P,C) /\ B(B1,P,D) /\ B(K,H,M) /\
B(F1,G,L1) /\ B(B1,m,D) /\ B(B1,e,C) /\ B(F1,J,M) /\ B(K,J,L1) ==> EF(A,B1,C,D,F1,K,M,L1)`,
REPEAT GEN_TAC THEN
REWRITE_TAC[EF] THEN
STRIP_TAC THEN
STRIP_TAC THENL (* 2 goals *)
[ (* This takes a minute, be patient! *)
(* The goal is `euclid_quad (A,B1,C,D)` *)
ASM_MESON_TAC[euclid_quad;convex_quad;areaequalsarea4;area_monotone2;area_permutation1;area_permutation2;
betweennesssymmetry;area4perm;area4perm2]
;
(* Now the goal is euclid_quad (F1,K,M,L1) /\ area4 (A,B1,C,D) = area4 (F1,K,M,L1)` *)
SUBGOAL_THEN `euclid_quad(F1:real^2, K:real^2, M:real^2, L1:real^2)` ASSUME_TAC THENL
[ ASM_MESON_TAC[lemma2850] (* put euclid_quad(F1,K,M,L) in the assumptions *)
;
ASM_REWRITE_TAC[] THEN
(* goal is area4 (A,B1,C,D) = area4 (F1,K,M,L1)` *)
UNDISCH_TAC `euclid_quad(F1:real^2, K:real^2, H:real^2, G:real^2)` THEN
PATH_REWRITE_TAC "lr" [euclid_quad] THEN
REPEAT STRIP_TAC THENL (* 2 subgoals, 2 total *)
[ (* area4 (A,B1,C,D) = area4 (F1,K,M,L1)` assuming convex_quad(F1,K,H,G) *)
ASM_MESON_TAC[paste4_convex]
;
(* one goal left, `area4 (A,B1,C,D) = area4 (F1,K,M,L1)` *)
(* under assumption really_triangle(F1,K,H,G) *)
SUBGOAL_THEN `area4(F1:real^2, K:real^2, M:real^2, L1:real^2) =
area4(F1:real^2, K:real^2, H:real^2, G:real^2) +
area4(G:real^2, H:real^2, M:real^2, L1:real^2)` ASSUME_TAC THENL
[ UNDISCH_TAC `really_triangle(F1:real^2, K:real^2, H:real^2, G:real^2)` THEN
REWRITE_TAC [really_triangle] THEN
STRIP_TAC THENL (* 4 subgoals, 5 total; all with goal `area4 (F1,K,M,L1) = area4 (F1,K,H,G) + area4 (G,H,M,L1)` *)
[ (* case 1, B(F1,K,H) *)
ASM_MESON_TAC[paste4_triangle1]
;
(* case 2, B(K,H,G) *)
ASM_MESON_TAC[paste4_triangle2]
;
(* Case 3, B(H,G,F1) *)
WE_HAVE_BY (left_to_right betweennesssymmetry) THEN (* B(F1,G,H) *)
ONCE_REWRITE_TAC[area4flip] THEN
WE_HAVE_BY_N 13 euclid_quad_flip THEN
WE_HAVE_BY_N 3 euclid_quad_flip THEN
UNDISCH_TAC `&0 < area4 (F1:real^2,K:real^2,H:real^2,G:real^2)` THEN
PATH_REWRITE_TAC "lr" [area4flip] THEN
DISCH_TAC THEN
UNDISCH_TAC `area4 (A:real^2,B1:real^2,m:real^2,D:real^2) =
area4 (F1:real^2,K:real^2,H:real^2,G:real^2)` THEN
PATH_REWRITE_TAC "lrr" [area4flip] THEN
DISCH_TAC THEN
UNDISCH_TAC `area4 (D:real^2,B1:real^2,e:real^2,C:real^2) = area4 (G:real^2,H:real^2,M:real^2,L1:real^2)` THEN
PATH_REWRITE_TAC "lrr" [area4flip] THEN
DISCH_TAC THEN
ASM_MESON_TAC[paste4_triangle2;betweennesssymmetry]
;
(* Case 4, B(G,F1,K) *)
WE_HAVE_BY (left_to_right betweennesssymmetry) THEN (* B(F1,G,H) *)
ONCE_REWRITE_TAC[area4flip] THEN
WE_HAVE_BY_N 13 euclid_quad_flip THEN
WE_HAVE_BY_N 3 euclid_quad_flip THEN
UNDISCH_TAC `&0 < area4 (F1:real^2,K:real^2,H:real^2,G:real^2)` THEN
PATH_REWRITE_TAC "lr" [area4flip] THEN
DISCH_TAC THEN
UNDISCH_TAC `area4 (A:real^2,B1:real^2,m:real^2,D:real^2) =
area4 (F1:real^2,K:real^2,H:real^2,G:real^2)` THEN
PATH_REWRITE_TAC "lrr" [area4flip] THEN
DISCH_TAC THEN
UNDISCH_TAC `area4 (D:real^2,B1:real^2,e:real^2,C:real^2) = area4 (G:real^2,H:real^2,M:real^2,L1:real^2)` THEN
PATH_REWRITE_TAC "lrr" [area4flip] THEN
DISCH_TAC THEN
ASM_MESON_TAC[paste4_triangle1;betweennesssymmetry]
]
;
(* Just one goal left, area4(A,B1,C,D) = area4(F1,K,M,L1)
assuming area4 (F1,K,M,L1) = area4 (F1,K,H,G) + area4 (G,H,M,L1) *)
ASM_REWRITE_TAC[] THEN
SUBGOAL_THEN `OS(A:real^2, B1:real^2, D:real^2, C:real^2)` ASSUME_TAC THENL
[ REWRITE_TAC[OS] THEN
EXISTS_TAC `P:real^2` THEN
ASM_REWRITE_TAC[] THEN
REWRITE_TAC[CO] THEN
CONJ_TAC THENL
[ ASM_REWRITE_TAC[]
;
(* goal is NC(B1,D,A) *)
SUBGOAL_THEN `&0 < area4(A:real^2, B1:real^2, m:real^2, D:real^2)` ASSUME_TAC THENL
[ ASM_MESON_TAC[euclid_quad]
;
UNDISCH_TAC `&0 < area4 (A:real^2,B1:real^2,m:real^2,D:real^2)` THEN
ONCE_REWRITE_TAC [area4perm] THEN
ASM_SIMP_TAC[GSYM areaequalsarea4] THEN
ASM_MESON_TAC [areaNC]
]
]
; (* Now OS(A,B1,D,C) is on the assumption list *)
ASM_SIMP_TAC[GSYM additivity2] THEN
(* `area (B1,D,A) + area (B1,D,C) = area4 (F1,K,H,G) + area4 (G,H,M,L1)` *)
(* Be patient! *)
ASM_MESON_TAC[areaequalsarea4;area_permutation1;area_permutation2;
area4perm;area4perm2;betweennesssymmetry]
]
]
]
]]
);;
let ETtransitive = prove
(`!A:real^2 B1:real^2 C:real^2 a:real^2 b:real^2 c:real^2 P:real^2 Q:real^2 R:real^2.
ET(A,B1,C,a,b,c) /\ ET(a,b,c,P,Q,R) ==> ET(A,B1,C,P,Q,R)`,
MESON_TAC[ET]
);;
let EFAxioms = [ congruentequal;
ETpermutation;
ETsymmetric;
EFpermutation;
halvesofequals;
EFsymmetric;
EFtransitive;
ETtransitive;
cutoff1;
cutoff2;
paste1;
deZolt1;
deZolt2;
paste2;
paste3;
paste4
];;
Sindbad File Manager Version 1.0, Coded By Sindbad EG ~ The Terrorists