Apolonijev problem

Konstruiraj krožnico, ki se dotika treh danih krožnic.

Ker bomo primerjali razdalje, definiramo funkcijo razdalja2, ki izračuna kvadrat razdalje med dvema točkama:

ClearAll[razdalja2]
razdalja2[P_,Q_]:=(P-Q).(P-Q)

Krožnico s središčem S in polmerom r predstavimo simbolno z izrazom Circle[S,r], pri čemer je točka S predstavljena s parom koordinat {x,y}. Tu je besedica Circle samo simbol ali oznaka, ki nakazuje pome podatkov S in r. Prav lahko bi uporabili kako drugo predstavitev, na primer {S,r}, a to bi bilo manj razumljivo.

Definiramo funkcijo, ki pove, ali se dve krožnici dotikata. Tu vidimo, kako uporabimo vzorce, s katerimi izluščimo podatke o krožnicah.

ClearAll[dotikataQ]

dotikataQ[Circle[S1_,r1_],Circle[S2_,r2_]]:=razdalja2[S1,S2]==(((r1+r2))^2)∨razdalja2[S1,S2]==(((r1-r2))^2)

Preverimo, kako deluje dotikataQ

dotikataQ[Circle[{0,0},1],Circle[{2,0},1]]

dotikataQ[Circle[{0,0},1],Circle[{2,0},r]]

Reduce[dotikataQ[Circle[{0,0},1],Circle[{2,0},r]]]

Sedaj že lahko izračunamo kaj zanimivega. Denimo, kolikšen je polmer krožnice s središčem (1,1), ki se dotika enotske krožnice s središčem (0,0)?

Solve[dotikataQ[Circle[{0,0},1],Circle[{1,1},r]],r]

V poštev pridejo samo pozitivne rešitve.

Select[Solve[dotikataQ[Circle[{0,0},1],Circle[{1,1},r]],r],Function[resitev,(r/.resitev)>0]]

V Mathematici zapis z # in & pomeni funkcijski predpis. Denimo, (# + 7)& pomeni x↦x+7. Bolj človeški alternativni zapis je Function[x, x+7], ki ga priporočamo začetniku. Naloga: razvozlajte, kako deluje zgornji ukaz Select.

Pravzaprav imamo še bolj eleganten način, da izberemo le pozitivne rešitve – v Solve preprosto dodamo pogoj r > 0, zraven pa povemo še, da nas zanimajo le realne rešitve:

Solve[dotikataQ[Circle[{0,0},1],Circle[{1,1},r]]∧ r > 0,r, Reals]

Definirajmo funkcijo, ki pove pogoj, pod katerim se dana krožnica dotika ostalih:

ClearAll[dotikaQ]
dotikaQ[k_Circle,kroznice_List]:=Apply[And,Map[Function[l,dotikataQ[k,l]],kroznice]]

Naloga: naučite se, kako delujeta Apply in Map. Tu je nekaj primerov uporabe, preberite tudi dokumentacijo.

Map[g,{a,b,c,d}]

Apply[g,h[a,b,c]]

{a,b,c,d}//FullForm

Apply[Plus,{a,b,c,d}]

Rešimo Apolonijev problem:

ClearAll[apolonij]
apolonij[kroznice_List]:=
Module[{x,y,r},
Circle[{x,y},r]/.
Solve[dotikaQ[Circle[{x,y},r],kroznice]∧ r > 0,{x,y,r}, Reals]
]

Preverimo, ali funkcija deluje:

apolonij[{Circle[{0,0},1],Circle[{3,0},1],Circle[{0,3},1]}]

Sedaj bi radi rešitve tudi narisali.

ClearAll[narisiApolonij]
narisiApolonij[kroznice_List]:=
Graphics[{{{Red,apolonij[kroznice]},Black,Thick,kroznice}}]

narisiApolonij[{Circle[{0,0},1],Circle[{3,0},1],Circle[{0,3},1]}]

Radi bi tudi videli, kako se spreminja rešitev, ko spreminjamo krožnice. V ta namen uporabimo Manipulate

Off[Solve::ratnz]
Manipulate[narisiApolonij[{Circle[{0,0},1],Circle[{3,0},1],Circle[{0,3},r]}],{r,1,3}]

Zgornja slika zelo “skače”, ko spreminjamo polmer. Poskusimo še enkrat, tako da fiksiramo območje, ki ga rišemo. Dodajmo še premikanje središča kroga, kar se naredi z  Locator:

Off[Solve::ratnz]
Manipulate[Show[narisiApolonij[{Circle[{0,0},1],Circle[{3,0},1],Circle[S,r]}], Axes->True, PlotRange->{{-10,10},{-10,10}}],{{r,1},0,5},{{S,{0,3}},Locator}]