गणितज्ञ, 2535 बाइट्स
यहाँ से लिया गया है (इसलिए यह सामुदायिक विकि क्यों है)। वास्तव में नहीं है कि गोल्फ। लेखक की उसके कोड की व्याख्या के लिए दिए गए लिंक को देखें।
इसके अलावा, मैं कोई गणितज्ञ विशेषज्ञ नहीं हूं, लेकिन मुझे यकीन है कि मार्टिन कोड की लंबाई पर चमत्कार कर सकता है। मैं इसके पीछे के गणित को भी नहीं समझता।
मैंने इसे पठनीय छोड़ दिया है, लेकिन यदि प्रश्न बंद नहीं होता है, तो मैं इसे पठनीयता से जोड़ दूंगा और कॉलर फ़ंक्शन के अंदर 2 अन्य मापदंडों को स्थानांतरित करूंगा।
वर्तमान में अमान्य है , इसे सुधारने में मदद करने के लिए स्वतंत्र महसूस करें:
मुझे लगता है कि यह आर्क्स के बजाय लाइनों का उपयोग करता है।
एक चेहरे पर केंद्रित है, बजाय एक शीर्ष पर।
HyperbolicLine[{{Px_, Py_}, {Qx_, Qy_}}] :=
If[N[Chop[Px Qy - Py Qx]] =!= 0.,
Circle[OrthoCentre[{{Px, Py}, {Qx, Qy}}],
OrthoRadius[{{Px, Py}, {Qx, Qy}}],
OrthoAngles[{{Px, Py}, {Qx, Qy}}]], Line[{{Px, Py}, {Qx, Qy}}]]
OrthoCentre[{{Px_, Py_}, {Qx_, Qy_}}] :=
With[{d = 2 Px Qy - 2 Py Qx, p = 1 + Px^2, q = 1 + Qx^2 + Qy^2},
If[N[d] =!= 0., {p Qy + Py^2 Qy - Py q, -p Qx - Py^2 Qx + Px q}/d,
ComplexInfinity]]
OrthoRadius[{{Px_, Py_}, {Qx_, Qy_}}] :=
If[N[Chop[Px Qy - Py Qx]] =!= 0.,
Sqrt[Total[OrthoCentre[{{Px, Py}, {Qx, Qy}}]^2] - 1], Infinity]
OrthoAngles[{{Px_, Py_}, {Qx_, Qy_}}] :=
Block[{a, b, c = OrthoCentre[{{Px, Py}, {Qx, Qy}}]},
If[(a = N[Apply[ArcTan, {Px, Py} - c]]) < 0., a = a + 2 \[Pi]];
If[(b = N[Apply[ArcTan, {Qx, Qy} - c]]) < 0.,
b = b + 2 \[Pi]]; {a, b} = Sort[{a, b}];
If[b - a > \[Pi], {b, a + 2 \[Pi]}, {a, b}]]
Inversion[Circle[{Cx_, Cy_}, r_], {Px_, Py_}] := {Cx, Cy} +
r^2 {Px - Cx, Py - Cy}/((Cx - Px)^2 + (Cy - Py)^2)
Inversion[Circle[{Cx_, Cy_}, r_, {a_, b_}], {Px_, Py_}] := {Cx, Cy} +
r^2 {Px - Cx, Py - Cy}/((Cx - Px)^2 + (Cy - Py)^2)
Inversion[Circle[{Cx_, Cy_}, r_, {a_, b_}], p_Line] :=
Map[Inversion[Circle[{Cx, Cy}, r], #] &, p, {2}]
Inversion[Circle[{Cx_, Cy_}, r_, {a_, b_}], p_Polygon] :=
Map[Inversion[Circle[{Cx, Cy}, r], #] &, p, {2}]
Inversion[Line[{{Px_, Py_}, {Qx_, Qy_}}], {Ux_, Uy_}] :=
With[{u = Px - Qx,
v = Qy - Py}, {-Ux (v^2 - u^2) - 2 u v Uy,
Uy (v^2 - u^2) - 2 u v Ux}/(u^2 + v^2)]
Inversion[Line[{{Px_, Py_}, {Qx_, Qy_}}], p_Polygon] :=
Map[Inversion[Line[{{Px, Py}, {Qx, Qy}}], #] &, p, {2}]
Inversion[Circle[{Cx_, Cy_}, r_], c_List] :=
Map[Inversion[Circle[{Cx, Cy}, r], #] &, c]
PolygonInvert[p_Polygon] :=
Map[Inversion[HyperbolicLine[#], p] &,
Partition[Join[p[[1]], {p[[1, 1]]}], 2, 1]]
PolygonInvert[p_List] := Flatten[Map[PolygonInvert[#] &, p]]
LineRule = Polygon[x_] :> Line[Join[x, {x[[1]]}]];
HyperbolicLineRule =
Polygon[x_] :>
Map[HyperbolicLine, Partition[Join[x, {x[[1]]}], 2, 1]];
CentralPolygon[p_Integer, q_Integer, \[Phi]_: 0] :=
With[{r = (Cot[\[Pi]/p] Cot[\[Pi]/q] - 1)/
Sqrt[Cot[\[Pi]/p]^2 Cot[\[Pi]/q]^2 - 1], \[Theta] = \[Pi] Range[
1, 2 p - 1, 2]/p},
r Map[{{Cos[\[Phi]], -Sin[\[Phi]]}, {Sin[\[Phi]], Cos[\[Phi]]}}.# &,
Transpose[{Cos[\[Theta]], Sin[\[Theta]]}]]]
PolygonUnion[p_Polygon, tol_: 10.^-10] := p
PolygonUnion[p_List, tol_: 10.^-10] :=
With[{q = p /. Polygon[x_] :> N[Polygon[Round[x, 10.^-10]]]},
DeleteDuplicates[q]]
HyperbolicTessellation[p_Integer, q_Integer, \[Phi]_, k_Integer,
t_: 10.^-10] :=
Map[PolygonUnion[#, t] &,
NestList[PolygonInvert, Polygon[CentralPolygon[p, q, \[Phi]]],
k][[{-2, -1}]]] /; k > 0
HyperbolicTessellation[p_Integer, q_Integer, \[Phi]_, k_Integer,
t_: 10.^-10] := Polygon[CentralPolygon[p, q, \[Phi]]] /; k == 0
HyperbolicTessellationGraphics[p_Integer, q_Integer, \[Phi]_,
k_Integer, rule_RuleDelayed, opts___] :=
Graphics[{Circle[{0, 0}, 1],
HyperbolicTessellation[p, q, \[Phi], k, 10.^-10] /. rule}, opts]
जैसे कहा जाता है:
HyperbolicTessellationGraphics[3, 7, 0., 7, HyperbolicLineRule, ImageSize -> 300, PlotLabel -> "{7,7}"]
