Mathematica Notebook 
za članak 

"Problemi s ortocentrom"
      Zvonka Čerina

Skračenica za kompoziciju simplify i factor.

FS[a_]:=Factor[FullSimplify[a]]

Skračenica za kompoziciju subs, simplify i factor.

FSS[a_,b_]:=Factor[FullSimplify[(b)/.(a)]]

Vrhovi trokuta.

tA:={0,0}

tB:={r*(f+g),0}

tC:={g*r*(1-f)*(1+f)/(1-f*g),2*r*f*g/(f*g-1)}

Kvadrat udaljenosti dvije točke.

dis[{a_,u_},{b_,v_}]:=FS[(b-a)^2+(v-u)^2]

Određivanje (kvadrata) duljina stranica trokuta ABC.

{dis[tB,tC],dis[tC,tA],dis[tA,tB]}

Duljine stranica trokuta ABC.

sa:=r*f*(1+g^2)/(f*g-1)

sb:=r*g*(1+f^2)/(f*g-1)

sc:=r*(f+g)

Substitucija za pretvaranje a, b, c (duljine stranica) u f, g, r.

subabc:={a->r*f*(1+g^2)/(f*g-1),b->r*g*(1+f^2)/(f*g-1),
c->r*(f+g)}

Traženje obrnute veze.

rj:=FS[Solve[{sa==a,sb==b,sc==c},{f,g,r}]]

rj

pf:=(a+b+c)*(b+c-a)/Sqrt[(a+b+c)*(-a+b+c)*(a-b+c)*(a+b-c)]

pg:=(a+b+c)*(-b+c+a)/Sqrt[(a+b+c)*(-a+b+c)*(a-b+c)*(a+b-c)]

pr:=Sqrt[(a+b+c)*(-a+b+c)*(a-b+c)*(a+b-c)]/(a+b+c)/2

Substitucija za pretvaranje parametara f, g, r u a, b, c (duljine stranica).

subfgr:={f->(a+b+c)*(b+c-a)/Sqrt[(a+b+c)*(-a+b+c)*(a-b+c)*(a+b-c)],g->(a+b+c)*(-b+c+a)/Sqrt[(a+b+c)*(-a+b+c)*(a-b+c)*(a+b-c)],r->Sqrt[(a+b+c)*(-a+b+c)*(a-b+c)*(a+b-c)]/(a+b+c)/2}

Polovište dužine.

mid[{a_,u_},{b_,v_}]:=FS[{(a+b)/2,(u+v)/2}]

Točka koja dijeli dužinu u danom omjeru k (<> -1).

rat[{a_,u_},{b_,v_},k_]:=FS[{(a+k*b)/(1+k),(u+k*v)/(1+k)}]

Pravac kroz dvije različite točke.

li2[{a1_,a2_},{b1_,b2_}]:=FS[{a2-b2,b1-a1,a1*b2-b1*a2}]

Paralela točkom danom pravcu.

par[{p_,q_},{a_,b_,c_}]:=FS[{a,b,-a*p-b*q}]

Okomica točkom na dani pravac.

per[{p_,q_},{a_,b_,c_}]:=FS[{b,-a,a*q-b*p}]

Presjek dva pravca.

ins[{a_, b_, c_}, {u_, v_, w_}]:=FS[{(w*b - v*c)/(a*v - b*u), (u*c - 
                  w*a)/(a*v - b*u)}]

Ortogonalna projekcija točke na pravac.

ins[per[{a1,a2},{p1,p2,p3}],{p1,p2,p3}]

pro[{p_,q_},{a_,b_,c_}]:=FS[{(p*b^2-a*c-a*b*q)/(b^2+a^2),
(q*a^2-b*c-a*b*p)/(b^2+a^2)}]

Orijentirana površina trokuta zadanog vrhovima.

ar[{a_,x_},{b_,y_},{c_,z_}]:=
FS[(x*c-b*x-a*z+a*y+b*z-c*y)/2]

Simetrala dužine.

bis[a_,b_]:=per[mid[a,b],li2[a,b]]

Središte opisane kružnice trokuta.

fuO[a_,b_,c_]:=ins[bis[a,b],bis[a,c]]

Ortocentar trokuta.

fuH[a_,b_,c_]:=ins[per[a,li2[b,c]],per[b,li2[c,a]]]

Dokaz leme 1.

tD:=pro[tA,li2[tB,tC]]

tE:=pro[tB,li2[tA,tC]]

tF:=pro[tC,li2[tB,tA]]

fuO[tA,tB,tC]

Središte opisane kružnice trokuta ABC.

tO:={r*(f+g)/2,(g+f*g-1+f)*(g-f*g+1+f)*r/(4*(f*g-1))}

fuH[tA,tB,tC]

Ortocentar trokuta ABC.

tH:={g*r*(f^2-1)/(f*g-1),r*(f^2-1)*(g^2-1)/(2*(f*g-1))}

tH

Određivanje omjera w točke F u dužini AB i omjera v točke H u dužini CF.

iz:=dis[rat[tA,tB,w],tF]

iz

iz[[4]][[1]]

rjw:=Solve[iz[[4]][[1]]==0,w]

rjw

FSS[subfgr,w/.(rjw[[1]])]

iz:=dis[rat[tC,tF,v],tH]

iz

iz[[5]][[1]]

rjv:=Solve[iz[[5]][[1]]==0,v]

rjv

rjvabc:=FSS[subfgr,v/.(rjv[[1]])]

rjvabc

Određivanje omjera w0 točke D u dužini AH i omjera v0 točke E u dužini BH.

iz:=dis[rat[tA,tH,w0],tD];iz

iz[[6]][[1]]

rjw0:=Solve[iz[[6]][[1]]==0,w0];rjw0

rjw0abc:=FSS[subfgr,w0/.(rjw0[[1]])];rjw0abc

iz:=dis[rat[tB,tH,v0],tE];iz

iz[[6]][[1]]

rjv0:=Solve[iz[[6]][[1]]==0,v0];rjv0

rjv0[[1]]

FSS[subfgr, v0 /. (rjv0[[1]])]

Dokaz leme 2.

dis[tA,tO]

mR:=r*(1+g^2)*(1+f^2)/(4*(f*g-1))

FSS[subfgr,mR^2-dis[tO,tH]]

Dokaz teorema 3.

tP:={p,q}

taP:=ins[li2[tP,tA],li2[tB,tC]]

tbP:=ins[li2[tP,tB],li2[tC,tA]]

tcP:=ins[li2[tP,tC],li2[tA,tB]]

con1:=FS[dis[tC,tP]*dis[tP,tcP]-dis[tB,tP]*dis[tP,tbP]]

con2:=FS[dis[tC,tP]*dis[tP,tcP]-dis[tA,tP]*dis[tP,taP]]

con3:=FS[dis[tC,tP]*dis[tP,tcP]-((dis[tO,tP]-dis[tO,tA])/2)^2]

rjpq:=Solve[{con1==0,con2==0,con3==0},{p,q}]

Timing[rjpq]

Ni za 60 minuta nije bilo rješenja!

dis[tH,FSS[rjpq,tP]]

Odgovor na pitanje da li već uvjeti |AP|×|P aP| = |BP|×|P bP| = |CP|×|P cP|  određuju ortocentar.

rjpq0:=Solve[{FSS[{f->2,g->5,r->1},con1]==0
,FSS[{f->2,g->5,r->1},con2]==0},{p,q}]

Timing[rjpq0][[1]]

rjpq00 := Timing[rjpq0][[2]]

For[i = 1, i <= Length[rjpq00], i++, 
      Print[i, N[rjpq00[[i]]]]]

iz := {rjpq00[[1]], rjpq00[[2]], rjpq00[[5]], 
        rjpq00[[8]]}

iz[[1]]

Assuming[k > 0, 
      FS[iz[[2]] /. {129600 + (Sqrt[45746138067]) -> k^3/3}]]

pol := 
      Collect[FS[((40793769 + k (-383220 + k (28698 + k (60 + k))))/(5346 (k^2))) - (a + b*((-6387 + (k^2))/(54 k)) + 
                c*(((-6387 + (k^2))/(54 k)))^2)], k]

pol

Solve[{pol[[1]] == 0, pol[[2]] == 0, 
        pol[[3]] == 0, pol[[4]] == 0, 
        pol[[5]] == 0}, {a, b, c}]

in[a_] := InputForm[a]

Dokaz teorema 5.

tI:={f*r,r}

dIH:=dis[tI,tH]

dIH

polM1:=Part[dIH,4]

polM1

dOH:=dis[tO,tH]

dOH

polM2:=Part[dOH,3]

polM2

dOA:=dis[tO,tA]

dOA

polM3:=Part[dOA,3]*Part[dOA,5]

polM3

FS[8*polM1 - polM2 + polM3]

FS[2*dis[tI, tH] - dis[tO, tH] + dis[tO, tA] - 4*r^2]

Dokaz teorema 6.

con4:=FS[dis[tC,tP]*dis[tP,tcP]-(dis[tI,tP]-2*r^2)^2]

rjpq:=Solve[{con1==0,con2==0,con4==0},{p,q}]

dis[tH,FSS[rjpq,tP]]

Dokaz teorema 8.

dis[tH,tA]

dHA:=r*(f^2-1)*(g^2+1)/(2*(f*g-1))

dis[tH,tB]

dHB:=r*(g^2-1)*(f^2+1)/(2*(f*g-1))

dis[tH,tC]

dHC:=r*(g+f*g-1+f)*Abs[f*g-f-g-1]/(2*(f*g-1))

dHCg:=r*(g+f*g-1+f)*(f*g-f-g-1)/(2*(f*g-1))

dHCa:=r*(g+f*g-1+f)*(-f*g+f+g+1)/(2*(f*g-1))

dis[tO,tA]

mR:=r*(g^2+1)*(f^2+1)/(4*(f*g-1))

FS[r*(f^2 - 1)*(g^2 + 1)/(2*(f*g - 1)) + 
          r*(g^2 - 1)*(f^2 + 1)/(2*(f*g - 1)) + 
          r*(g + f*g - 1 + 
                f)*(-f*g + f + g + 1)/(2*(f*g - 1)) - 
          2*(r*(g^2 + 1)*(f^2 + 1)/(4*(f*g - 1)) + r)]

iz := {dHA, dHB, dHCa, -2*(mR + r)}

iz

FS[iz[[1]] + iz[[2]] + iz[[3]] + iz[[4]]]

FS[dHA+dHB+dHCa-2*(mR+r)]

Mathematica to nije sposobna izračunati.

rjdHCx:=FS[dHCx/.(Solve[dHA+dHB+dHCx-2*(mR+r)==0,dHCx][[1]])]

rjdHCx

FS[dHA+dHB-dHCg-2*(mR+r)]

rjdHCx:=FS[dHCx/.(Solve[dHA+dHB-dHCx-2*(mR+r)==0,dHCx][[1]])]

rjdHCx

iz:=FSS[subfgr,f*g-f-g-1]

iz

iz1:=Part[iz,6]

iz1

FS[(iz1-Part[iz1,5])^2-Part[iz1,5]^2]

Dokaz leme 3.

iz:=FSS[subfgr,f*g-f-g-1]

iz

iz1:=FSS[{Sqrt[(a+b-c)*(a-b+c)*(-a+b+c)*(a+b+c)]->4*S},iz]

iz1

FS[Solve[-c^2+a^2+b^2-4*S+2*b*a<0,S]]

FS[((-(b+c+a)*(-b+a-c)*(-b+a+c)*(-c+b+a))^(1/2))^2-((b+c+a)*(-c+b+a))^2]

Dokaz teorema 9.

dis[tE,tF]

dEF:=(1+g^2)*(f^2-1)*f*r/(f*g-1)/(f^2+1)

dis[tF,tD]

dFD:=(1+f^2)*(g^2-1)*g*r/(f*g-1)/(g^2+1)

dis[tD,tE]

dDE:=(f+g)*(f+g-1+f*g)*Abs[f*g-f-g-1]*r/(g^2+1)/(f^2+1)

dDEa:=(f+g)*(f+g-1+f*g)*(-f*g+f+g+1)*r/(g^2+1)/(f^2+1)

dDEd:=(f+g)*(f+g-1+f*g)*(f*g-f-g-1)*r/(g^2+1)/(f^2+1)

mS:=ar[tA,tB,tC]

FS[dEF+dFD+dDEa-2*mS/mR]

rjdDEx:=FS[Solve[dEF+dFD+dDEx-2*mS/mR==0,dDEx]]

dDEx /. (rjdDEx[[1]])

FS[dEF+dFD-dDEd-2*mS/mR]

rjdDEx:=FS[Solve[dEF+dFD-dDEx-2*mS/mR==0,dDEx]]

Part[rjdDEx[[1]][[1]], 2]

dDEx /. Part[rjdDEx[[1]][[1]], 2]

Dokaz teorema 10.

tDb:=pro[tD,li2[tC,tA]]

tDc:=pro[tD,li2[tA,tB]]

FS[dis[tDb,tDc]-((dEF+dFD+dDEa)/2)^2]

rjdDEx:=FS[Solve[dis[tDb,tDc]-((dEF+dFD+dDEx)/2)^2==0,dDEx]]

dDEx /. Part[rjdDEx[[1]][[1]], 2]

FS[dis[tDb,tDc]-((dEF+dFD-dDEd)/2)^2]

rjdDEx:=FS[Solve[dis[tDb,tDc]-((dEF+dFD-dDEx)/2)^2==0,dDEx]]

dDEx /. Part[rjdDEx[[1]][[1]], 2]

Dokaz teorema 11.

dis[tA,tD]

dAD:=2*(f+g)*g*r/(g^2+1)

dis[tB,tE]

dBE:=2*(f+g)*f*r/(f^2+1)

dis[tC,tF]

dCF:=2*f*g*r/(f*g-1)

FS[dAD*dBE*dCF-mS*(dEF+dFD+dDEa)]

rjdDEx:=FS[Solve[dAD*dBE*dCF-mS*(dEF+dFD+dDEx)==0,dDEx]]

FS[dDEx /. Part[rjdDEx[[1]][[1]], 2]]

FS[dAD*dBE*dCF-mS*(dEF+dFD-dDEd)]

rjdDEx:=FS[Solve[dAD*dBE*dCF-mS*(dEF+dFD-dDEx)==0,dDEx]]

FS[dDEx /. (rjdDEx[[1]])]

Provjera zadatka 52(b) iz D'Ignazio&Suppa knjige.

dis[tA,tH]

dAH:=r*(f^2-1)*(g^2+1)/(f*g-1)/2

dis[tB,tH]

dBH:=r*(g^2-1)*(f^2+1)/(f*g-1)/2

dis[tC,tH]

dCH:=r*(f+g+f*g-1)*Abs[f*g-f-g-1]/(f*g-1)/2

dCHa:=r*(f+g+f*g-1)*(-f*g+f+g+1)/(f*g-1)/2

dCHd:=r*(f+g+f*g-1)*(f*g-f-g-1)/(f*g-1)/2

FS[dAH*dAD+dBH*dBE+dCHa*dCF-(sa^2+sb^2+sc^2)/2]

rjdCHx:=FS[Solve[dAH*dAD+dBH*dBE+dCHx*dCF-(sa^2+sb^2+sc^2)/2==0,dCHx]]

FS[dCHx /. Part[rjdCHx[[1]][[1]], 2]]

FS[dAH*dAD+dBH*dBE-dCHd*dCF-(sa^2+sb^2+sc^2)/2]

rjdCHx:=FS[Solve[dAH*dAD+dBH*dBE-dCHx*dCF-(sa^2+sb^2+sc^2)/2==0,dCHx]]

dCHx /. Part[rjdCHx[[1]][[1]], 2]

Provjera tvrdnje h. iz Johnsona (str. 191).

tPa:=pro[tP,li2[tE,tF]]

tPa

tPb:=pro[tP,li2[tF,tD]]

tPc:=pro[tP,li2[tD,tE]]

rjIo:=Solve[{dis[tP,tPa]-dis[tP,tPb]==0,dis[tP,tPa]-dis[tP,tPc]==0},{p,q}]

rjIo

dis[tH,pro[tH,li2[tE,tF]]]

rho:=(f^2-1)*r*(g^2-1)*(g+f*g-1+f)*Abs[-g+f*g-1-f]/(f*g-1)/(g^2+1)/(f^2+1)/2;

rho

rhoa:=(f^2-1)*r*(g^2-1)*(g+f*g-1+f)*(g-f*g+1+f)/(f*g-1)/(g^2+1)/(f^2+1)/2

rhod:=(f^2-1)*r*(g^2-1)*(g+f*g-1+f)*(-g+f*g-1-f)/(f*g-1)/(g^2+1)/(f^2+1)/2;

FS[(sa^2+sb^2+sc^2)-8*mR^2-4*rhoa*mR]

rjrhox:=FS[Solve[(sa^2+sb^2+sc^2)-8*mR^2-4*rhox*mR==0,rhox]]

FS[(sa^2+sb^2+sc^2)-8*mR^2+4*rhod*mR]

rjrhox:=FS[Solve[(sa^2+sb^2+sc^2)-8*mR^2+4*rhox*mR==0,rhox]]

FS[dAH^2+dBH^2+dCHa^2-4*mR^2+4*rhoa*mR]

rjrhox:=FS[Solve[dAH^2+dBH^2+dCHa^2-4*mR^2+4*rhox*mR==0,rhox]]

FS[dAH^2+dBH^2+dCHd^2-4*mR^2-4*rhod*mR]

rjrhox:=FS[Solve[dAH^2+dBH^2+dCHa^2-4*mR^2-4*rhox*mR==0,rhox]]

Rješenje Marićevog problema.

rjfgr:=Solve[{13==sa,14==sb,15==sc},{f,g,r}]

rjfgr

tAe:=ins[li2[tA,tI],per[tB,li2[tB,tI]]]

tAe

tBe:=ins[li2[tB,tI],per[tA,li2[tA,tI]]]

tBe

tCe:=ins[li2[tC,tI],per[tB,li2[tB,tI]]]

tCe

FSS[{f->2,g->7/4,r->4},ar[tAe,tBe,tCe]]

FSS[{f->2,g->7/4,r->4},ar[tI,tBe,tCe]]

FSS[{f->2,g->7/4,r->4},ar[tAe,tI,tCe]]

FSS[{f->2,g->7/4,r->4},ar[tAe,tBe,tI]]

Dokaz teorema 12.

FS[dAH/dAD+dBH/dBE+dCHa/dCF-2]

rjdCHx:=FS[Solve[dAH/dAD+dBH/dBE+dCHx/dCF-2==0,dCHx]]

FS[dAH/dAD+dBH/dBE-dCHd/dCF-2]

rjdCHx:=FS[Solve[dAH/dAD+dBH/dBE-dCHx/dCF-2==0,dCHx]]

Dokaz teorema 13.

dis[tH,tD]

dHD:=r*(g^2-1)*(f+g+f*g-1)*Abs[-g+f*g-1-f]/(2*(f*g-1)*(g^2+1))

dHD

dHDa:=r*(g^2-1)*(f+g+f*g-1)*(g-f*g+1+f)/(2*(f*g-1)*(g^2+1))

dHDd:=r*(g^2-1)*(f+g+f*g-1)*(-g+f*g-1-f)/(2*(f*g-1)*(g^2+1))

dis[tH,tE]

dHE:=r*(f^2-1)*(f+g+f*g-1)*Abs[-g+f*g-1-f]/(2*(f*g-1)*(f^2+1))

dHE

dHEa:=r*(f^2-1)*(f+g+f*g-1)*(g-f*g+1+f)/(2*(f*g-1)*(f^2+1))

dHEa

dHEd:=r*(f^2-1)*(f+g+f*g-1)*(-g+f*g-1-f)/(2*(f*g-1)*(f^2+1))

dHEd

dis[tH,tF]

dHF:=r*(f^2-1)*(g^2-1)/(2*(f*g-1))

dHF

FS[dHDa/dAD+dHEa/dBE+dHF/dCF-1]

FS[-dHDd/dAD-dHEd/dBE+dHF/dCF-1]

FS[dHD/dAD+dHE/dBE+dHF/dCF-1]

Ako je to nula mora fg-f-g-1 biti negativno tj. kut C nije tup.

FS[-dHD/dAD-dHE/dBE+dHF/dCF-1]

Ako je to nula mora fg-f-g-1 biti pozitivno tj. kut C je tup.

Dokaz teorema 14.

tU:=ins[li2[tA,tP],li2[tB,tC]]

tV:=ins[li2[tB,tP],li2[tA,tC]]

tW:=ins[li2[tC,tP],li2[tB,tA]]

tQ:={u,v}

tX:=ins[par[tQ,li2[tA,tP]],li2[tB,tC]]

tY:=ins[par[tQ,li2[tB,tP]],li2[tA,tC]]

tZ:=ins[par[tQ,li2[tC,tP]],li2[tB,tA]]

FS[dis[tQ,tX]/dis[tA,tU]]

q1a:=(-2*u*g+2*r*f*g+2*r*g^2+v-g^2*v)/(2*g*(f+g)*r)

q1b:=(2*u*g-2*r*f*g-2*r*g^2-v+g^2*v)/(2*g*(f+g)*r)

FS[dis[tQ,tY]/dis[tB,tV]]

q2a:=(-v+v*f^2-2*u*f)/(2*f*r*(f+g))

q2b:=(v-v*f^2+2*u*f)/(2*f*r*(f+g))

FS[dis[tQ,tZ]/dis[tC,tW]]

q3a:=v*(f*g-1)/(2*r*f*g)

q3b:=-v*(f*g-1)/(2*r*f*g)

tI5:=rat[tI,tA,-2]

tI6:=rat[tI,tB,-2]

tI7:=rat[tI,tC,-2]

Područje I.

FSS[{u->tI[[1]],v->tI[[2]]},{Numerator[q1a],Numerator[q2a],Numerator[q3a]}]

FS[q1a+q2b+q3a-1]

Područje II.

FSS[{u->tAe[[1]],v->tAe[[2]]},{Numerator[q1a],Numerator[q2a],Numerator[q3a]}]

FS[q2b+q3a-q1b-1]

Područje III.

FSS[{u->tBe[[1]],v->tBe[[2]]},{Numerator[q1a],Numerator[q2a],Numerator[q3a]}]

FS[q1a-q2a+q3a-1]

Područje IV.

FSS[{u->tCe[[1]],v->tCe[[2]]},{Numerator[q1a],Numerator[q2a],Numerator[q3a]}]

FS[q1a+q2b-q3b-1]

Podruèje V.

FSS[{u->tI5[[1]],v->tI5[[2]]},{Numerator[q1a],Numerator[q2a],Numerator[q3a]}]

FS[q1a-q2a-q3b-1]

Područje VI.

FSS[{u->tI6[[1]],v->tI6[[2]]},{Numerator[q1a],Numerator[q2a],Numerator[q3a]}]

FS[-q1b+q2b-q3b-1]

Područje VII.

FSS[{u->tI7[[1]],v->tI7[[2]]},{Numerator[q1a],Numerator[q2a],Numerator[q3a]}]

FS[-q1b-q2a+q3a-1]

KRAJ (THE END)