গণিত, 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}"]
