geoprover.rlg 25 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199
  1. Sun Apr 18 17:57:49 2004 run on Linux
  2. Geoprover 1.3a Last update December 30, 2002
  3. % GeoProver test file for Reduce, created on Jan 18 2003
  4. load cali,geoprover;
  5. off nat;
  6. on echo;
  7. %in "$reduce/packages/geometry/supp.red"$
  8. %###############################################################
  9. %
  10. % FILE: supp.red
  11. % AUTHOR: graebe
  12. % CREATED: 2/2002
  13. % PURPOSE: Interface for the extended GEO syntax to Reduce
  14. % VERSION: $Id: supp.red,v 1.1 2002/12/26 16:27:22 compalg Exp $
  15. algebraic procedure geo_simplify u; u;
  16. geo_simplify$
  17. algebraic procedure geo_normal u; u;
  18. geo_normal$
  19. algebraic procedure geo_subs(a,b,c); sub(a=b,c);
  20. geo_subs$
  21. algebraic procedure geo_gbasis(polys,vars);
  22. begin
  23. setring(vars,{},lex);
  24. setideal(uhu,polys);
  25. return gbasis uhu;
  26. end;
  27. geo_gbasis$
  28. algebraic procedure geo_groebfactor(polys,vars,nondeg);
  29. begin
  30. setring(vars,{},lex);
  31. return groebfactor(polys,nondeg);
  32. end;
  33. geo_groebfactor$
  34. algebraic procedure geo_normalf(p,polys,vars);
  35. begin
  36. setring(vars,{},lex);
  37. return p mod polys;
  38. end;
  39. geo_normalf$
  40. algebraic procedure geo_eliminate(polys,vars,elivars);
  41. begin
  42. setring(vars,{},lex);
  43. return eliminate(polys,elivars);
  44. end;
  45. geo_eliminate$
  46. algebraic procedure geo_solve(polys,vars);
  47. solve(polys,vars);
  48. geo_solve$
  49. algebraic procedure geo_solveconstrained(polys,vars,nondegs);
  50. begin scalar u;
  51. setring(vars,{},lex);
  52. u:=groebfactor(polys,nondegs);
  53. return for each x in u join solve(x,vars);
  54. end;
  55. geo_solveconstrained$
  56. algebraic procedure geo_eval(con,sol);
  57. for each x in sol collect sub(x,con);
  58. geo_eval$
  59. % end;
  60. % Example Arnon
  61. %
  62. % The problem:
  63. % Let $ABCD$ be a square and $P$ a point on the line parallel to $BD$
  64. % through $C$ such that $l(BD)=l(BP)$, where $l(BD)$ denotes the
  65. % distance between $B$ and $D$. Let $Q$ be the intersection point of
  66. % $BF$ and $CD$. Show that $l(DP)=l(DQ)$.
  67. %
  68. % The solution:
  69. vars_:=List(x1, x2, x3);
  70. vars_ := {x1,x2,x3}$
  71. % Points
  72. A__:=Point(0,0);
  73. a__ := {0,0}$
  74. B__:=Point(1,0);
  75. b__ := {1,0}$
  76. P__:=Point(x1,x2);
  77. p__ := {x1,x2}$
  78. % coordinates
  79. D__:=rotate(A__,B__,1/2);
  80. d__ := {0,1}$
  81. C__:=par_point(D__,A__,B__);
  82. c__ := {1,1}$
  83. Q__:=varpoint(D__,C__,x3);
  84. q__ := {x3,1}$
  85. % polynomials
  86. polys_:=List(on_line(P__,par_line(C__,pp_line(B__,D__))),
  87. eq_dist(B__,D__,B__,P__), on_line(Q__,pp_line(B__,P__)));
  88. polys_ := {x1 + x2 - 2,
  89. - x1**2 + 2*x1 - x2**2 + 1,
  90. - x1 + x2*x3 - x2 + 1}$
  91. % conclusion
  92. con_:=eq_dist(D__,P__,D__,Q__);
  93. con_ := x1**2 + x2**2 - 2*x2 - x3**2 + 1$
  94. % solution
  95. gb_:=geo_gbasis(polys_,vars_);
  96. gb_ := {x3**2 + 2*x3 - 2,2*x2 - x3 - 2,2*x1 + x3 - 2}$
  97. result_:=geo_normalf(con_,gb_,vars_);
  98. result_ := 0$
  99. % Example CircumCenter_1
  100. %
  101. % The problem:
  102. % The intersection point of the midpoint perpendiculars is the
  103. % center of the circumscribed circle.
  104. %
  105. % The solution:
  106. parameters_:=List(a1, a2, b1, b2, c1, c2);
  107. parameters_ := {a1,
  108. a2,
  109. b1,
  110. b2,
  111. c1,
  112. c2}$
  113. % Points
  114. A__:=Point(a1,a2);
  115. a__ := {a1,a2}$
  116. B__:=Point(b1,b2);
  117. b__ := {b1,b2}$
  118. C__:=Point(c1,c2);
  119. c__ := {c1,c2}$
  120. % coordinates
  121. M__:=intersection_point(p_bisector(A__,B__),
  122. p_bisector(B__,C__));
  123. m__ := {(a1**2*b2 - a1**2*c2 + a2**2*b2 - a2**2*c2 - a2*b1**2 - a2*b2**2 + a2*c1
  124. **2 + a2*c2**2 + b1**2*c2 + b2**2*c2 - b2*c1**2 - b2*c2**2)/(2*(a1*b2 - a1*c2 -
  125. a2*b1 + a2*c1 + b1*c2 - b2*c1)),
  126. ( - a1**2*b1 + a1**2*c1 + a1*b1**2 + a1*b2**2 - a1*c1**2 - a1*c2**2 - a2**2*b1 +
  127. a2**2*c1 - b1**2*c1 + b1*c1**2 + b1*c2**2 - b2**2*c1)/(2*(a1*b2 - a1*c2 - a2*b1
  128. + a2*c1 + b1*c2 - b2*c1))}$
  129. % conclusion
  130. result_:=List( eq_dist(M__,A__,M__,B__), eq_dist(M__,A__,M__,C__) );
  131. result_ := {0,0}$
  132. % Example EulerLine_1
  133. %
  134. % The problem:
  135. % Euler's line: The center $M$ of the circumscribed circle,
  136. % the orthocenter $H$ and the barycenter $S$ are collinear and $S$
  137. % divides $MH$ with ratio 1:2.
  138. %
  139. % The solution:
  140. parameters_:=List(a1, a2, b1, b2, c1, c2);
  141. parameters_ := {a1,
  142. a2,
  143. b1,
  144. b2,
  145. c1,
  146. c2}$
  147. % Points
  148. A__:=Point(a1,a2);
  149. a__ := {a1,a2}$
  150. B__:=Point(b1,b2);
  151. b__ := {b1,b2}$
  152. C__:=Point(c1,c2);
  153. c__ := {c1,c2}$
  154. % coordinates
  155. S__:=intersection_point(median(A__,B__,C__),median(B__,C__,A__));
  156. s__ := {(a1 + b1 + c1)/3,(a2 + b2 + c2)/3}$
  157. M__:=intersection_point(p_bisector(A__,B__),
  158. p_bisector(B__,C__));
  159. m__ := {(a1**2*b2 - a1**2*c2 + a2**2*b2 - a2**2*c2 - a2*b1**2 - a2*b2**2 + a2*c1
  160. **2 + a2*c2**2 + b1**2*c2 + b2**2*c2 - b2*c1**2 - b2*c2**2)/(2*(a1*b2 - a1*c2 -
  161. a2*b1 + a2*c1 + b1*c2 - b2*c1)),
  162. ( - a1**2*b1 + a1**2*c1 + a1*b1**2 + a1*b2**2 - a1*c1**2 - a1*c2**2 - a2**2*b1 +
  163. a2**2*c1 - b1**2*c1 + b1*c1**2 + b1*c2**2 - b2**2*c1)/(2*(a1*b2 - a1*c2 - a2*b1
  164. + a2*c1 + b1*c2 - b2*c1))}$
  165. H__:=intersection_point(altitude(A__,B__,C__),altitude(B__,C__,A__));
  166. h__ := {( - a1*a2*b1 + a1*a2*c1 + a1*b1*b2 - a1*c1*c2 - a2**2*b2 + a2**2*c2 + a2
  167. *b2**2 - a2*c2**2 - b1*b2*c1 + b1*c1*c2 - b2**2*c2 + b2*c2**2)/(a1*b2 - a1*c2 -
  168. a2*b1 + a2*c1 + b1*c2 - b2*c1),
  169. (a1**2*b1 - a1**2*c1 + a1*a2*b2 - a1*a2*c2 - a1*b1**2 + a1*c1**2 - a2*b1*b2 + a2
  170. *c1*c2 + b1**2*c1 + b1*b2*c2 - b1*c1**2 - b2*c1*c2)/(a1*b2 - a1*c2 - a2*b1 + a2*
  171. c1 + b1*c2 - b2*c1)}$
  172. % conclusion
  173. result_:=List(is_collinear(M__,H__,S__), sqrdist(S__,fixedpoint(M__,H__,1/3)));
  174. result_ := {0,0}$
  175. % Example Brocard_3
  176. %
  177. % The problem:
  178. % Theorem about the Brocard points:
  179. % Let $\Delta\,ABC$ be a triangle. The circles $c_1$ through $A,B$ and
  180. % tangent to $g(AC)$, $c_2$ through $B,C$ and tangent to $g(AB)$, and
  181. % $c_3$ through $A,C$ and tangent to $g(BC)$ pass through a common
  182. % point.
  183. %
  184. % The solution:
  185. parameters_:=List(u1, u2);
  186. parameters_ := {u1,u2}$
  187. % Points
  188. A__:=Point(0,0);
  189. a__ := {0,0}$
  190. B__:=Point(1,0);
  191. b__ := {1,0}$
  192. C__:=Point(u1,u2);
  193. c__ := {u1,u2}$
  194. % coordinates
  195. M_1_:=intersection_point(altitude(A__,A__,C__),p_bisector(A__,B__));
  196. m_1_ := {1/2,( - u1)/(2*u2)}$
  197. M_2_:=intersection_point(altitude(B__,B__,A__),p_bisector(B__,C__));
  198. m_2_ := {1,(u1**2 - 2*u1 + u2**2 + 1)/(2*u2)}$
  199. M_3_:=intersection_point(altitude(C__,C__,B__),p_bisector(A__,C__));
  200. m_3_ := {( - u1**2 + 2*u1 - u2**2)/2,(u1**3 - u1**2 + u1*u2**2 + u2**2)/(2*u2)}$
  201. c1_:=pc_circle(M_1_,A__);
  202. c1_ := {u2, - u2,u1,0}$
  203. c2_:=pc_circle(M_2_,B__);
  204. c2_ := {u2, - 2*u2, - u1**2 + 2*u1 - u2**2 - 1,u2}$
  205. c3_:=pc_circle(M_3_,C__);
  206. c3_ := {u2,
  207. u2*(u1**2 - 2*u1 + u2**2),
  208. - u1**3 + u1**2 - u1*u2**2 - u2**2,
  209. 0}$
  210. P__:=other_cc_point(B__,c1_,c2_);
  211. p__ := {(u1**3 - u1**2 + u1*u2**2 + u1 + u2**2)/(u1**4 - 2*u1**3 + 2*u1**2*u2**2
  212. + 3*u1**2 - 2*u1*u2**2 - 2*u1 + u2**4 + 3*u2**2 + 1),
  213. (u2*(u1**2 - 2*u1 + u2**2 + 1))/(u1**4 - 2*u1**3 + 2*u1**2*u2**2 + 3*u1**2 - 2*
  214. u1*u2**2 - 2*u1 + u2**4 + 3*u2**2 + 1)}$
  215. % conclusion
  216. result_:= on_circle(P__,c3_);
  217. result_ := 0$
  218. % Example Feuerbach_1
  219. %
  220. % The problem:
  221. % Feuerbach's circle or nine-point circle: The midpoint $N$ of $MH$ is
  222. % the center of a circle that passes through nine special points, the
  223. % three pedal points of the altitudes, the midpoints of the sides of the
  224. % triangle and the midpoints of the upper parts of the three altitudes.
  225. %
  226. % The solution:
  227. parameters_:=List(u1, u2, u3);
  228. parameters_ := {u1,u2,u3}$
  229. % Points
  230. A__:=Point(0,0);
  231. a__ := {0,0}$
  232. B__:=Point(u1,0);
  233. b__ := {u1,0}$
  234. C__:=Point(u2,u3);
  235. c__ := {u2,u3}$
  236. % coordinates
  237. H__:=intersection_point(altitude(A__,B__,C__),altitude(B__,C__,A__));
  238. h__ := {u2,(u2*(u1 - u2))/u3}$
  239. D__:=intersection_point(pp_line(A__,B__),pp_line(H__,C__));
  240. d__ := {u2,0}$
  241. M__:=intersection_point(p_bisector(A__,B__),
  242. p_bisector(B__,C__));
  243. m__ := {u1/2,( - u1*u2 + u2**2 + u3**2)/(2*u3)}$
  244. N__:=midpoint(M__,H__);
  245. n__ := {(u1 + 2*u2)/4,(u1*u2 - u2**2 + u3**2)/(4*u3)}$
  246. % conclusion
  247. result_:=List( eq_dist(N__,midpoint(A__,B__),N__,midpoint(B__,C__)),
  248. eq_dist(N__,midpoint(A__,B__),N__,midpoint(H__,C__)),
  249. eq_dist(N__,midpoint(A__,B__),N__,D__) );
  250. result_ := {0,0,0}$
  251. % Example FeuerbachTangency_1
  252. %
  253. % The problem:
  254. % For an arbitrary triangle $\Delta\,ABC$ Feuerbach's circle (nine-point
  255. % circle) is tangent to its 4 tangent circles.
  256. %
  257. % The solution:
  258. vars_:=List(x1, x2);
  259. vars_ := {x1,x2}$
  260. parameters_:=List(u1, u2);
  261. parameters_ := {u1,u2}$
  262. % Points
  263. A__:=Point(0,0);
  264. a__ := {0,0}$
  265. B__:=Point(2,0);
  266. b__ := {2,0}$
  267. C__:=Point(u1,u2);
  268. c__ := {u1,u2}$
  269. P__:=Point(x1,x2);
  270. p__ := {x1,x2}$
  271. % coordinates
  272. M__:=intersection_point(p_bisector(A__,B__), p_bisector(B__,C__));
  273. m__ := {1,(u1**2 - 2*u1 + u2**2)/(2*u2)}$
  274. H__:=intersection_point(altitude(A__,B__,C__),altitude(B__,C__,A__));
  275. h__ := {u1,(u1*( - u1 + 2))/u2}$
  276. N__:=midpoint(M__,H__);
  277. n__ := {(u1 + 1)/2,( - u1**2 + 2*u1 + u2**2)/(4*u2)}$
  278. c1_:=pc_circle(N__,midpoint(A__,B__));
  279. c1_ := {2*u2,
  280. - 2*u2*(u1 + 1),
  281. u1**2 - 2*u1 - u2**2,
  282. 2*u1*u2}$
  283. Q__:=pedalpoint(P__,pp_line(A__,B__));
  284. q__ := {x1,0}$
  285. % polynomials
  286. polys_:=List(on_bisector(P__,A__,B__,C__), on_bisector(P__,B__,C__,A__));
  287. polys_ := {2*( - 2*u1*x1*x2 + 4*u1*x2 + u2*x1**2 - 4*u2*x1 - u2*x2**2 + 4*u2 + 4
  288. *x1*x2 - 8*x2),
  289. 2*( - u1**3*x2 + u1**2*u2*x1 - u1**2*u2 + u1**2*x1*x2 + 2*u1**2*x2 - u1*u2**2*x2
  290. - u1*u2*x1**2 + u1*u2*x2**2 - 2*u1*x1*x2 + u2**3*x1 - u2**3 - u2**2*x1*x2 + 2*
  291. u2**2*x2 + u2*x1**2 - u2*x2**2)}$
  292. % conclusion
  293. con_:=is_cc_tangent(pc_circle(P__,Q__),c1_);
  294. con_ := 16*u2*( - u1**3*x1*x2 + u1**3*x2 + u1**2*u2*x1**2 - 2*u1**2*u2*x1 - u1**
  295. 2*u2*x2**2 + u1**2*u2 + u1**2*x1**2*x2 + u1**2*x1*x2 - 2*u1**2*x2 + u1*u2**2*x1*
  296. x2 - u1*u2**2*x2 - 2*u1*u2*x1**3 + 4*u1*u2*x1**2 - 2*u1*u2*x1 + 2*u1*u2*x2**2 -
  297. 2*u1*x1**2*x2 + 2*u1*x1*x2 - u2**2*x1**2*x2 + u2**2*x1*x2 + u2*x1**4 - 2*u2*x1**
  298. 3 + u2*x1**2 - u2*x2**2)$
  299. % solution
  300. gb_:=geo_gbasis(polys_,vars_);
  301. gb_ := {u1**2*u2*x2**2 - 2*u1**2*x2**3 - 2*u1*u2*x2**2 + 4*u1*x2**3 + u2**3*x2**
  302. 2 - u2**3 - 2*u2**2*x2**3 + 4*u2**2*x2 + u2*x2**4 - 4*u2*x2**2,
  303. - u1**2*u2*x2 - 2*u1**2*x2**2 + u1*u2**2*x1 - u1*u2**2 + 2*u1*u2*x2 + 4*u1*x2**
  304. 2 - u2**2*x1 - u2**2*x2**2 + 2*u2**2 + u2*x2**3 - 4*u2*x2}$
  305. result_:=geo_normalf(con_,gb_,vars_);
  306. result_ := 0$
  307. % Example GeneralizedFermatPoint_1
  308. %
  309. % The problem:
  310. % A generalized theorem about Napoleon triangles:
  311. % Let $\Delta\,ABC$ be an arbitrary triangle and $P,Q$ and $R$ the third
  312. % vertex of isosceles triangles with equal base angles erected
  313. % externally on the sides $BC, AC$ and $AB$ of the triangle. Then the
  314. % lines $g(AP), g(BQ)$ and $g(CR)$ pass through a common point.
  315. %
  316. % The solution:
  317. vars_:=List(x1, x2, x3, x4, x5);
  318. vars_ := {x1,
  319. x2,
  320. x3,
  321. x4,
  322. x5}$
  323. parameters_:=List(u1, u2, u3);
  324. parameters_ := {u1,u2,u3}$
  325. % Points
  326. A__:=Point(0,0);
  327. a__ := {0,0}$
  328. B__:=Point(2,0);
  329. b__ := {2,0}$
  330. C__:=Point(u1,u2);
  331. c__ := {u1,u2}$
  332. P__:=Point(x1,x2);
  333. p__ := {x1,x2}$
  334. Q__:=Point(x3,x4);
  335. q__ := {x3,x4}$
  336. R__:=Point(x5,u3);
  337. r__ := {x5,u3}$
  338. % polynomials
  339. polys_:=List(eq_dist(P__,B__,P__,C__),
  340. eq_dist(Q__,A__,Q__,C__),
  341. eq_dist(R__,A__,R__,B__),
  342. eq_angle(R__,A__,B__,P__,B__,C__),
  343. eq_angle(Q__,C__,A__,P__,B__,C__));
  344. polys_ := { - u1**2 + 2*u1*x1 - u2**2 + 2*u2*x2 - 4*x1 + 4,
  345. - u1**2 + 2*u1*x3 - u2**2 + 2*u2*x4,
  346. 4*(x5 - 1),
  347. (u1*u3*x1 - 2*u1*u3 - u1*x2*x5 + u2*u3*x2 + u2*x1*x5 - 2*u2*x5 - 2*u3*x1 + 4*u3
  348. + 2*x2*x5)/(x5*(u1*x1 - 2*u1 + u2*x2 - 2*x1 + 4)),
  349. ( - u1**3*x2 + u1**2*u2*x1 - 2*u1**2*u2 - u1**2*x1*x4 + u1**2*x2*x3 + 2*u1**2*x2
  350. + 2*u1**2*x4 - u1*u2**2*x2 + 2*u1*x1*x4 - 2*u1*x2*x3 - 4*u1*x4 + u2**3*x1 - 2*
  351. u2**3 - u2**2*x1*x4 + u2**2*x2*x3 + 2*u2**2*x2 + 2*u2**2*x4 - 2*u2*x1*x3 - 2*u2*
  352. x2*x4 + 4*u2*x3)/(u1**3*x1 - 2*u1**3 + u1**2*u2*x2 - u1**2*x1*x3 - 2*u1**2*x1 +
  353. 2*u1**2*x3 + 4*u1**2 + u1*u2**2*x1 - 2*u1*u2**2 - u1*u2*x1*x4 - u1*u2*x2*x3 + 2*
  354. u1*u2*x4 + 2*u1*x1*x3 - 4*u1*x3 + u2**3*x2 - 2*u2**2*x1 - u2**2*x2*x4 + 4*u2**2
  355. + 2*u2*x1*x4 - 4*u2*x4)}$
  356. % conclusion
  357. con_:=is_concurrent(pp_line(A__,P__), pp_line(B__,Q__), pp_line(C__,R__));
  358. con_ := - u1*u3*x1*x4 + u1*u3*x2*x3 - 2*u1*u3*x2 + 2*u1*x2*x4 + u2*x1*x4*x5 - 2
  359. *u2*x1*x4 - u2*x2*x3*x5 + 2*u2*x2*x5 + 2*u3*x1*x4 - 2*x2*x4*x5$
  360. % solution
  361. sol_:=geo_solve(polys_,vars_);
  362. sol_ := {{x1=(u1 - u2*u3 + 2)/2,
  363. x2=(u1*u3 + u2 - 2*u3)/2,
  364. x3=(u1 + u2*u3)/2,
  365. x4=( - u1*u3 + u2)/2,
  366. x5=1}}$
  367. result_:=geo_eval(con_,sol_);
  368. result_ := {0}$
  369. % Example TaylorCircle_1
  370. %
  371. % The problem:
  372. % Let $\Delta\,ABC$ be an arbitrary triangle. Consider the three
  373. % altitude pedal points and the pedal points of the perpendiculars from
  374. % these points onto the the opposite sides of the triangle. Show that
  375. % these 6 points are on a common circle, the {\em Taylor circle}.
  376. %
  377. % The solution:
  378. parameters_:=List(u1, u2, u3);
  379. parameters_ := {u1,u2,u3}$
  380. % Points
  381. A__:=Point(u1,0);
  382. a__ := {u1,0}$
  383. B__:=Point(u2,0);
  384. b__ := {u2,0}$
  385. C__:=Point(0,u3);
  386. c__ := {0,u3}$
  387. % coordinates
  388. P__:=pedalpoint(A__,pp_line(B__,C__));
  389. p__ := {(u2*(u1*u2 + u3**2))/(u2**2 + u3**2),
  390. (u2*u3*( - u1 + u2))/(u2**2 + u3**2)}$
  391. Q__:=pedalpoint(B__,pp_line(A__,C__));
  392. q__ := {(u1*(u1*u2 + u3**2))/(u1**2 + u3**2),
  393. (u1*u3*(u1 - u2))/(u1**2 + u3**2)}$
  394. R__:=pedalpoint(C__,pp_line(A__,B__));
  395. r__ := {0,0}$
  396. P_1_:=pedalpoint(P__,pp_line(A__,B__));
  397. p_1_ := {(u2*(u1*u2 + u3**2))/(u2**2 + u3**2),0}$
  398. P_2_:=pedalpoint(P__,pp_line(A__,C__));
  399. p_2_ := {(u1*(u1**2*u2**2 + 2*u1*u2*u3**2 + u3**4))/(u1**2*u2**2 + u1**2*u3**2 +
  400. u2**2*u3**2 + u3**4),
  401. (u3**3*(u1**2 - 2*u1*u2 + u2**2))/(u1**2*u2**2 + u1**2*u3**2 + u2**2*u3**2 + u3
  402. **4)}$
  403. Q_1_:=pedalpoint(Q__,pp_line(A__,B__));
  404. q_1_ := {(u1*(u1*u2 + u3**2))/(u1**2 + u3**2),0}$
  405. Q_2_:=pedalpoint(Q__,pp_line(B__,C__));
  406. q_2_ := {(u2*(u1**2*u2**2 + 2*u1*u2*u3**2 + u3**4))/(u1**2*u2**2 + u1**2*u3**2 +
  407. u2**2*u3**2 + u3**4),
  408. (u3**3*(u1**2 - 2*u1*u2 + u2**2))/(u1**2*u2**2 + u1**2*u3**2 + u2**2*u3**2 + u3
  409. **4)}$
  410. R_1_:=pedalpoint(R__,pp_line(A__,C__));
  411. r_1_ := {(u1*u3**2)/(u1**2 + u3**2),(u1**2*u3)/(u1**2 + u3**2)}$
  412. R_2_:=pedalpoint(R__,pp_line(B__,C__));
  413. r_2_ := {(u2*u3**2)/(u2**2 + u3**2),(u2**2*u3)/(u2**2 + u3**2)}$
  414. % conclusion
  415. result_:=List( is_concyclic(P_1_,P_2_,Q_1_,Q_2_),
  416. is_concyclic(P_1_,P_2_,Q_1_,R_1_),
  417. is_concyclic(P_1_,P_2_,Q_1_,R_2_));
  418. result_ := {0,0,0}$
  419. % Example Miquel_1
  420. %
  421. % The problem:
  422. % Miquels theorem: Let $\Delta\,ABC$ be a triangle. Fix arbitrary points
  423. % $P,Q,R$ on the sides $AB, BC, AC$. Then the three circles through each
  424. % vertex and the chosen points on adjacent sides pass through a common
  425. % point.
  426. %
  427. % The solution:
  428. parameters_:=List(c1, c2, u1, u2, u3);
  429. parameters_ := {c1,
  430. c2,
  431. u1,
  432. u2,
  433. u3}$
  434. % Points
  435. A__:=Point(0,0);
  436. a__ := {0,0}$
  437. B__:=Point(1,0);
  438. b__ := {1,0}$
  439. C__:=Point(c1,c2);
  440. c__ := {c1,c2}$
  441. % coordinates
  442. P__:=varpoint(A__,B__,u1);
  443. p__ := {u1,0}$
  444. Q__:=varpoint(B__,C__,u2);
  445. q__ := {c1*u2 - u2 + 1,c2*u2}$
  446. R__:=varpoint(A__,C__,u3);
  447. r__ := {c1*u3,c2*u3}$
  448. X__:=other_cc_point(P__,p3_circle(A__,P__,R__),p3_circle(B__,P__,Q__));
  449. x__ := {( - c1**4*u2*u3 + c1**4*u3**2 + c1**3*u1*u2 - c1**3*u1*u3 + 2*c1**3*u2*
  450. u3 - c1**3*u3 - 2*c1**2*c2**2*u2*u3 + 2*c1**2*c2**2*u3**2 - 2*c1**2*u1*u2 - c1**
  451. 2*u1*u3 + c1**2*u1 - c1**2*u2*u3 + c1**2*u3 + c1*c2**2*u1*u2 - c1*c2**2*u1*u3 +
  452. 2*c1*c2**2*u2*u3 - c1*c2**2*u3 + c1*u1**2 + c1*u1*u2 - c1*u1 - c2**4*u2*u3 + c2
  453. **4*u3**2 - c2**2*u1*u3 + c2**2*u1 - c2**2*u2*u3 + c2**2*u3)/(c1**4*u2**2 - 2*c1
  454. **4*u2*u3 + c1**4*u3**2 - 4*c1**3*u2**2 + 4*c1**3*u2*u3 + 2*c1**3*u2 - 2*c1**3*
  455. u3 + 2*c1**2*c2**2*u2**2 - 4*c1**2*c2**2*u2*u3 + 2*c1**2*c2**2*u3**2 + 2*c1**2*
  456. u1*u2 - 2*c1**2*u1*u3 + 6*c1**2*u2**2 - 2*c1**2*u2*u3 - 6*c1**2*u2 + 2*c1**2*u3
  457. + c1**2 - 4*c1*c2**2*u2**2 + 4*c1*c2**2*u2*u3 + 2*c1*c2**2*u2 - 2*c1*c2**2*u3 -
  458. 4*c1*u1*u2 + 2*c1*u1 - 4*c1*u2**2 + 6*c1*u2 - 2*c1 + c2**4*u2**2 - 2*c2**4*u2*u3
  459. + c2**4*u3**2 + 2*c2**2*u1*u2 - 2*c2**2*u1*u3 + 2*c2**2*u2**2 - 2*c2**2*u2*u3 -
  460. 2*c2**2*u2 + 2*c2**2*u3 + c2**2 + u1**2 + 2*u1*u2 - 2*u1 + u2**2 - 2*u2 + 1),
  461. (c2*(c1**2*u1*u2 - c1**2*u1*u3 + c1**2*u3 - 2*c1*u1*u2 + c2**2*u1*u2 - c2**2*u1*
  462. u3 + c2**2*u3 + u1**2 + u1*u2 - u1))/(c1**4*u2**2 - 2*c1**4*u2*u3 + c1**4*u3**2
  463. - 4*c1**3*u2**2 + 4*c1**3*u2*u3 + 2*c1**3*u2 - 2*c1**3*u3 + 2*c1**2*c2**2*u2**2
  464. - 4*c1**2*c2**2*u2*u3 + 2*c1**2*c2**2*u3**2 + 2*c1**2*u1*u2 - 2*c1**2*u1*u3 + 6*
  465. c1**2*u2**2 - 2*c1**2*u2*u3 - 6*c1**2*u2 + 2*c1**2*u3 + c1**2 - 4*c1*c2**2*u2**2
  466. + 4*c1*c2**2*u2*u3 + 2*c1*c2**2*u2 - 2*c1*c2**2*u3 - 4*c1*u1*u2 + 2*c1*u1 - 4*
  467. c1*u2**2 + 6*c1*u2 - 2*c1 + c2**4*u2**2 - 2*c2**4*u2*u3 + c2**4*u3**2 + 2*c2**2*
  468. u1*u2 - 2*c2**2*u1*u3 + 2*c2**2*u2**2 - 2*c2**2*u2*u3 - 2*c2**2*u2 + 2*c2**2*u3
  469. + c2**2 + u1**2 + 2*u1*u2 - 2*u1 + u2**2 - 2*u2 + 1)}$
  470. % conclusion
  471. result_:=on_circle(X__,p3_circle(C__,Q__,R__));
  472. result_ := 0$
  473. % Example PappusPoint_1
  474. %
  475. % The problem:
  476. % Let $A,B,C$ and $P,Q,R$ be two triples of collinear points. Then by
  477. % the Theorem of Pappus the intersection points $g(AQ)\wedge g(BP),
  478. % g(AR)\wedge g(CP)$ and $g(BR)\wedge g(CQ)$ are collinear.
  479. %
  480. % Permuting $P,Q,R$ we get six such {\em Pappus lines}. Those
  481. % corresponding to even resp. odd permutations are concurrent.
  482. %
  483. % The solution:
  484. parameters_:=List(u1, u2, u3, u4, u5, u6, u7, u8);
  485. parameters_ := {u1,
  486. u2,
  487. u3,
  488. u4,
  489. u5,
  490. u6,
  491. u7,
  492. u8}$
  493. % Points
  494. A__:=Point(u1,0);
  495. a__ := {u1,0}$
  496. B__:=Point(u2,0);
  497. b__ := {u2,0}$
  498. P__:=Point(u4,u5);
  499. p__ := {u4,u5}$
  500. Q__:=Point(u6,u7);
  501. q__ := {u6,u7}$
  502. % coordinates
  503. C__:=varpoint(A__,B__,u3);
  504. c__ := { - u1*u3 + u1 + u2*u3,0}$
  505. R__:=varpoint(P__,Q__,u8);
  506. r__ := { - u4*u8 + u4 + u6*u8, - u5*u8 + u5 + u7*u8}$
  507. % conclusion
  508. result_:=is_concurrent(pappus_line(A__,B__,C__,P__,Q__,R__),
  509. pappus_line(A__,B__,C__,Q__,R__,P__),
  510. pappus_line(A__,B__,C__,R__,P__,Q__));
  511. result_ := 0$
  512. % Example IMO/36_1
  513. %
  514. % The problem:
  515. % Let $A,B,C,D$ be four distinct points on a line, in that order. The
  516. % circles with diameters $AC$ and $BD$ intersect at the points $X$ and
  517. % $Y$. The line $XY$ meets $BC$ at the point $Z$. Let $P$ be a point on
  518. % the line $XY$ different from $Z$. The line $CP$ intersects the circle
  519. % with diameter $AC$ at the points $C$ and $M$, and the line $BP$
  520. % intersects the circle with diameter $BD$ at the points $B$ and
  521. % $N$. Prove that the lines $AM, DN$ and $XY$ are concurrent.
  522. %
  523. % The solution:
  524. vars_:=List(x1, x2, x3, x4, x5, x6);
  525. vars_ := {x1,
  526. x2,
  527. x3,
  528. x4,
  529. x5,
  530. x6}$
  531. parameters_:=List(u1, u2, u3);
  532. parameters_ := {u1,u2,u3}$
  533. % Points
  534. X__:=Point(0,1);
  535. x__ := {0,1}$
  536. Y__:=Point(0,-1);
  537. y__ := {0,-1}$
  538. M__:=Point(x1,x2);
  539. m__ := {x1,x2}$
  540. N__:=Point(x3,x4);
  541. n__ := {x3,x4}$
  542. % coordinates
  543. P__:=varpoint(X__,Y__,u3);
  544. p__ := {0, - 2*u3 + 1}$
  545. Z__:=midpoint(X__,Y__);
  546. z__ := {0,0}$
  547. l_:=p_bisector(X__,Y__);
  548. l_ := {0,1,0}$
  549. B__:=line_slider(l_,u1);
  550. b__ := {u1,0}$
  551. C__:=line_slider(l_,u2);
  552. c__ := {u2,0}$
  553. A__:=line_slider(l_,x5);
  554. a__ := {x5,0}$
  555. D__:=line_slider(l_,x6);
  556. d__ := {x6,0}$
  557. % polynomials
  558. polys_:=List(is_concyclic(X__,Y__,B__,N__), is_concyclic(X__,Y__,C__,M__),
  559. is_concyclic(X__,Y__,B__,D__), is_concyclic(X__,Y__,C__,A__),
  560. is_collinear(B__,P__,N__), is_collinear(C__,P__,M__));
  561. polys_ := { - u1**2*x3 + u1*x3**2 + u1*x4**2 - u1 + x3,
  562. - u2**2*x1 + u2*x1**2 + u2*x2**2 - u2 + x1,
  563. - u1**2*x6 + u1*x6**2 - u1 + x6,
  564. - u2**2*x5 + u2*x5**2 - u2 + x5,
  565. - 2*u1*u3 - u1*x4 + u1 + 2*u3*x3 - x3,
  566. - 2*u2*u3 - u2*x2 + u2 + 2*u3*x1 - x1}$
  567. % constraints
  568. nondeg_:=List(x5-u2,x1-u2,x6-u1,x3-u1);
  569. nondeg_ := { - u2 + x5,
  570. - u2 + x1,
  571. - u1 + x6,
  572. - u1 + x3}$
  573. % conclusion
  574. con_:=is_concurrent(pp_line(A__,M__),pp_line(D__,N__),pp_line(X__,Y__));
  575. con_ := - x1*x4*x6 + x2*x3*x5 - x2*x5*x6 + x4*x5*x6$
  576. % solution
  577. sol_:=geo_solveconstrained(polys_,vars_,nondeg_);
  578. sol_ := {{x1=(4*u2*u3**2 - 4*u2*u3)/(u2**2 + 4*u3**2 - 4*u3 + 1),
  579. x2=( - 2*u2**2*u3 + u2**2 - 2*u3 + 1)/(u2**2 + 4*u3**2 - 4*u3 + 1),
  580. x3=(4*u1*u3**2 - 4*u1*u3)/(u1**2 + 4*u3**2 - 4*u3 + 1),
  581. x4=( - 2*u1**2*u3 + u1**2 - 2*u3 + 1)/(u1**2 + 4*u3**2 - 4*u3 + 1),
  582. x5=( - 1)/u2,
  583. x6=( - 1)/u1}}$
  584. result_:=geo_eval(con_,sol_);
  585. result_ := {0}$
  586. % Example IMO/43_2
  587. %
  588. % The problem:
  589. %
  590. % No verbal problem description available
  591. %
  592. % The solution:
  593. vars_:=List(x1, x2);
  594. vars_ := {x1,x2}$
  595. parameters_:=List(u1);
  596. parameters_ := {u1}$
  597. % Points
  598. B__:=Point(-1,0);
  599. b__ := {-1,0}$
  600. C__:=Point(1,0);
  601. c__ := {1,0}$
  602. % coordinates
  603. O__:=midpoint(B__,C__);
  604. o__ := {0,0}$
  605. gamma_:=pc_circle(O__,B__);
  606. gamma_ := {1,0,0,-1}$
  607. D__:=circle_slider(O__,B__,u1);
  608. d__ := {( - u1**2 + 1)/(u1**2 + 1),(2*u1)/(u1**2 + 1)}$
  609. E__:=circle_slider(O__,B__,x1);
  610. e__ := {( - x1**2 + 1)/(x1**2 + 1),(2*x1)/(x1**2 + 1)}$
  611. F__:=circle_slider(O__,B__,x2);
  612. f__ := {( - x2**2 + 1)/(x2**2 + 1),(2*x2)/(x2**2 + 1)}$
  613. A__:=sym_point(B__,pp_line(O__,D__));
  614. a__ := {( - u1**4 + 6*u1**2 - 1)/(u1**4 + 2*u1**2 + 1),(4*u1*(u1**2 - 1))/(u1**4
  615. + 2*u1**2 + 1)}$
  616. J__:=intersection_point(pp_line(A__,C__), par_line(O__, pp_line(A__,D__)));
  617. j__ := {(2*(3*u1**2 - 1))/(u1**4 + 2*u1**2 + 1),(2*u1*(u1**2 - 3))/(u1**4 + 2*u1
  618. **2 + 1)}$
  619. m_:=p_bisector(O__,A__);
  620. m_ := {2*(u1**4 - 6*u1**2 + 1),8*u1*( - u1**2 + 1),u1**4 + 2*u1**2 + 1}$
  621. P_1_:=pedalpoint(J__,m_);
  622. p_1_ := {( - u1**8 + 20*u1**6 + 10*u1**4 - 12*u1**2 - 1)/(2*(u1**8 + 4*u1**6 + 6
  623. *u1**4 + 4*u1**2 + 1)),
  624. (4*u1**3*(u1**4 - 2*u1**2 - 3))/(u1**8 + 4*u1**6 + 6*u1**4 + 4*u1**2 + 1)}$
  625. P_2_:=pedalpoint(J__,pp_line(C__,E__));
  626. p_2_ := {(u1**4 - 2*u1**3*x1 + 6*u1**2*x1**2 + 2*u1**2 + 6*u1*x1 - 2*x1**2 + 1)/
  627. (u1**4*x1**2 + u1**4 + 2*u1**2*x1**2 + 2*u1**2 + x1**2 + 1),
  628. (u1**4*x1 + 2*u1**3 - 4*u1**2*x1 - 6*u1 + 3*x1)/(u1**4*x1**2 + u1**4 + 2*u1**2*
  629. x1**2 + 2*u1**2 + x1**2 + 1)}$
  630. P_3_:=pedalpoint(J__,pp_line(C__,F__));
  631. p_3_ := {(u1**4 - 2*u1**3*x2 + 6*u1**2*x2**2 + 2*u1**2 + 6*u1*x2 - 2*x2**2 + 1)/
  632. (u1**4*x2**2 + u1**4 + 2*u1**2*x2**2 + 2*u1**2 + x2**2 + 1),
  633. (u1**4*x2 + 2*u1**3 - 4*u1**2*x2 - 6*u1 + 3*x2)/(u1**4*x2**2 + u1**4 + 2*u1**2*
  634. x2**2 + 2*u1**2 + x2**2 + 1)}$
  635. % polynomials
  636. polys_:=List(on_line(E__,m_), on_line(F__,m_));
  637. polys_ := {( - u1**4*x1**2 + 3*u1**4 - 16*u1**3*x1 + 14*u1**2*x1**2 - 10*u1**2 +
  638. 16*u1*x1 - x1**2 + 3)/(x1**2 + 1),
  639. ( - u1**4*x2**2 + 3*u1**4 - 16*u1**3*x2 + 14*u1**2*x2**2 - 10*u1**2 + 16*u1*x2 -
  640. x2**2 + 3)/(x2**2 + 1)}$
  641. % constraints
  642. nondegs_:=List(x1-x2);
  643. nondegs_ := {x1 - x2}$
  644. % conclusion
  645. con_:=List(eq_dist(J__,P_1_,J__,P_2_), eq_dist(J__,P_1_,J__,P_3_));
  646. con_ := {(u1**8*x1**4 - 2*u1**8*x1**2 - 3*u1**8 + 16*u1**7*x1**3 + 16*u1**7*x1 -
  647. 20*u1**6*x1**4 + 8*u1**6*x1**2 + 28*u1**6 - 112*u1**5*x1**3 - 112*u1**5*x1 + 94
  648. *u1**4*x1**4 + 4*u1**4*x1**2 - 90*u1**4 + 240*u1**3*x1**3 + 240*u1**3*x1 - 132*
  649. u1**2*x1**4 - 24*u1**2*x1**2 + 108*u1**2 - 144*u1*x1**3 - 144*u1*x1 + 9*x1**4 -
  650. 18*x1**2 - 27)/(4*(u1**8*x1**4 + 2*u1**8*x1**2 + u1**8 + 4*u1**6*x1**4 + 8*u1**6
  651. *x1**2 + 4*u1**6 + 6*u1**4*x1**4 + 12*u1**4*x1**2 + 6*u1**4 + 4*u1**2*x1**4 + 8*
  652. u1**2*x1**2 + 4*u1**2 + x1**4 + 2*x1**2 + 1)),
  653. (u1**8*x2**4 - 2*u1**8*x2**2 - 3*u1**8 + 16*u1**7*x2**3 + 16*u1**7*x2 - 20*u1**6
  654. *x2**4 + 8*u1**6*x2**2 + 28*u1**6 - 112*u1**5*x2**3 - 112*u1**5*x2 + 94*u1**4*x2
  655. **4 + 4*u1**4*x2**2 - 90*u1**4 + 240*u1**3*x2**3 + 240*u1**3*x2 - 132*u1**2*x2**
  656. 4 - 24*u1**2*x2**2 + 108*u1**2 - 144*u1*x2**3 - 144*u1*x2 + 9*x2**4 - 18*x2**2 -
  657. 27)/(4*(u1**8*x2**4 + 2*u1**8*x2**2 + u1**8 + 4*u1**6*x2**4 + 8*u1**6*x2**2 + 4
  658. *u1**6 + 6*u1**4*x2**4 + 12*u1**4*x2**2 + 6*u1**4 + 4*u1**2*x2**4 + 8*u1**2*x2**
  659. 2 + 4*u1**2 + x2**4 + 2*x2**2 + 1))}$
  660. % solution
  661. sol_:=geo_solveconstrained(polys_,vars_,nondegs_);
  662. sol_ := {{x1=(sqrt(3)*u1**4 + 2*sqrt(3)*u1**2 + sqrt(3) - 8*u1**3 + 8*u1)/(u1**4
  663. - 14*u1**2 + 1),
  664. x2=(sqrt(3)*u1**4 + 2*sqrt(3)*u1**2 + sqrt(3) - 8*u1**3 + 8*u1)/(u1**4 - 14*u1**
  665. 2 + 1)},
  666. {x1=(sqrt(3)*u1**4 + 2*sqrt(3)*u1**2 + sqrt(3) - 8*u1**3 + 8*u1)/(u1**4 - 14*u1
  667. **2 + 1),
  668. x2=( - sqrt(3)*u1**4 - 2*sqrt(3)*u1**2 - sqrt(3) - 8*u1**3 + 8*u1)/(u1**4 - 14*
  669. u1**2 + 1)},
  670. {x1=( - sqrt(3)*u1**4 - 2*sqrt(3)*u1**2 - sqrt(3) - 8*u1**3 + 8*u1)/(u1**4 - 14*
  671. u1**2 + 1),
  672. x2=(sqrt(3)*u1**4 + 2*sqrt(3)*u1**2 + sqrt(3) - 8*u1**3 + 8*u1)/(u1**4 - 14*u1**
  673. 2 + 1)},
  674. {x1=( - sqrt(3)*u1**4 - 2*sqrt(3)*u1**2 - sqrt(3) - 8*u1**3 + 8*u1)/(u1**4 - 14*
  675. u1**2 + 1),
  676. x2=( - sqrt(3)*u1**4 - 2*sqrt(3)*u1**2 - sqrt(3) - 8*u1**3 + 8*u1)/(u1**4 - 14*
  677. u1**2 + 1)}}$
  678. result_:=geo_simplify(geo_eval(con_,sol_));
  679. result_ := {{0,0},{0,0},{0,0},{0,0}}$
  680. showtime;
  681. Time: 670 ms plus GC time: 60 ms
  682. end;
  683. Time for test: 670 ms, plus GC time: 60 ms