Tạo một âm mưu (đĩa Poincare) của một phần tử trên mặt phẳng hyperbol, chẳng hạn như:

Chương trình có bốn đầu vào:

1) Có bao nhiêu cạnh / đa giác (ba trong ví dụ này).

2) Có bao nhiêu giao điểm tại mỗi đỉnh (bảy trong ví dụ này).

3) Có bao nhiêu bước từ đỉnh trung tâm để kết xuất (5 trong ví dụ này, nếu bạn nhìn kỹ). Điều này có nghĩa là một đỉnh được bao gồm nếu nó có thể đạt được trong 5 bước hoặc ít hơn tạo thành trung tâm. Các cạnh được hiển thị iff cả hai đỉnh của chúng được bao gồm.

4) Độ phân giải của hình ảnh (một số pixel, hình ảnh là hình vuông).

Đầu ra phải là một hình ảnh. Các cạnh phải được hiển thị dưới dạng vòng cung, không phải đường (phép chiếu đĩa Poincaré biến đường thành vòng tròn). Điểm không cần phải được kết xuất. Khi người dùng đặt vào thứ gì đó không phải là hyperbolic (tức là 5 tam giác gặp nhau ở mỗi đỉnh), chương trình không phải hoạt động chính xác. Đây là môn đánh gôn, vì vậy câu trả lời ngắn nhất sẽ thắng.

Toán học, 2535 byte

Lấy từ đây (vì sao nó là cộng đồng wiki). Không thực sự mà chơi golf. Xem liên kết được cung cấp cho lời giải thích của tác giả về mã của mình.

Ngoài ra, tôi không phải là chuyên gia Mathicala, nhưng tôi cá rằng Martin có thể làm được điều kỳ diệu về độ dài mã. Tôi thậm chí không hiểu toán học đằng sau nó.

Tôi để nó có thể đọc được, nhưng nếu câu hỏi không bị đóng, tôi sẽ đánh golf qua khả năng đọc và di chuyển 2 tham số khác bên trong chức năng của người gọi.

Hiện tại không hợp lệ , vui lòng giúp cải thiện nó:

• Tôi nghĩ rằng điều này sử dụng các dòng hơn là vòng cung.

• Trung tâm trên một khuôn mặt, chứ không phải là một đỉnh.

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]

Được gọi là:

HyperbolicTessellationGraphics[3, 7, 0., 7, HyperbolicLineRule, ImageSize -> 300, PlotLabel -> "{7,7}"]