画一个阿波罗垫片


28

给定三个相互切线的圆,我们总是可以找到另外两个与这三个圆都切线的圆。这两个被称为阿波罗圈。请注意,Apollonian圆之一实际上可能三个初始圆周围

从三个切圆开始,我们可以通过以下过程创建一个称为Apollonian垫片的分形:

  1. 将最初的3个圈子称为父圈子
  2. 找到父圈子的两个阿波罗圈
  3. 对于每个阿波罗圈:
    1. 对于三对父圆中的每对:
      1. 将Apollonian圈子和两个父圈子称为新的父圈子集,然后从步骤2重新开始。

例如从相等大小的圆圈开始,我们得到:

在此处输入图片说明

在Wikipedia上找到的图片

我们还需要一点符号。如果我们有一个半径为r且中心为(x,y)的圆,则可以将其曲率定义为k =±1 / r。通常,k为正,但是我们可以使用负k表示将垫圈中所有其他圆包围起来的圆(即所有切线从内部接触该圆)。然后,我们可以指定一个三元组的圆:(k,x * k,y * k)

出于这个问题的目的,我们将假设正整数k以及有理数xy

有关此类圈子的更多示例,请参见Wikipedia文章

在这篇文章中,还有一些关于整体垫圈的有趣的东西(以及其他有趣的东西)。

挑战

系统会为您提供4个圆的规格,每个规格看起来都像(14, 28/35, -112/105)。您可以使用任何方便的列表格式和除法运算符,以便在需要时可以简单地eval输入。您可以假设这四个圆确实彼此相切,并且第一个圆具有负曲率。这意味着您已经获得了其他三个周围的阿波罗圈。有关有效示例输入的列表,请参阅挑战的底部。

编写一个程序或函数,在给出此输入的情况下,绘制一个Apollonian垫片。

您可以通过函数参数ARGV或STDIN进行输入,然后将分形呈现在屏幕上或以您选择的格式将其写入图像文件。

如果对生成的图像进行光栅化,则其每侧必须至少为400像素,并且最大圆周围的填充不足20%。当您到达半径小于最大输入圆的400的圆或小于像素的圆时,以先发生的为准,您可能会停止递归。

您只能绘制圆形轮廓,而不能绘制完整的光盘,但是可以选择背景和线条的颜色。轮廓不得大于外圆直径的200。

这是代码高尔夫球,因此最短的答案(以字节为单位)获胜。

输入示例

这是维基百科文章中所有转换为规定输入格式的整体垫片:

[[-1, 0, 0], [2, 1, 0], [2, -1, 0], [3, 0, 2]]
[[-2, 0, 0], [3, 1/2, 0], [6, -2, 0], [7, -3/2, 2]]
[[-3, 0, 0], [4, 1/3, 0], [12, -3, 0], [13, -8/3, 2]]
[[-3, 0, 0], [5, 2/3, 0], [8, -4/3, -1], [8, -4/3, 1]]
[[-4, 0, 0], [5, 1/4, 0], [20, -4, 0], [21, -15/4, 2]]
[[-4, 0, 0], [8, 1, 0], [9, -3/4, -1], [9, -3/4, 1]]
[[-5, 0, 0], [6, 1/5, 0], [30, -5, 0], [31, -24/5, 2]]
[[-5, 0, 0], [7, 2/5, 0], [18, -12/5, -1], [18, -12/5, 1]]
[[-6, 0, 0], [7, 1/6, 0], [42, -6, 0], [43, -35/6, 2]]
[[-6, 0, 0], [10, 2/3, 0], [15, -3/2, 0], [19, -5/6, 2]]
[[-6, 0, 0], [11, 5/6, 0], [14, -16/15, -4/5], [15, -9/10, 6/5]]
[[-7, 0, 0], [8, 1/7, 0], [56, -7, 0], [57, -48/7, 2]]
[[-7, 0, 0], [9, 2/7, 0], [32, -24/7, -1], [32, -24/7, 1]]
[[-7, 0, 0], [12, 5/7, 0], [17, -48/35, -2/5], [20, -33/35, 8/5]]
[[-8, 0, 0], [9, 1/8, 0], [72, -8, 0], [73, -63/8, 2]]
[[-8, 0, 0], [12, 1/2, 0], [25, -15/8, -1], [25, -15/8, 1]]
[[-8, 0, 0], [13, 5/8, 0], [21, -63/40, -2/5], [24, -6/5, 8/5]]
[[-9, 0, 0], [10, 1/9, 0], [90, -9, 0], [91, -80/9, 2]]
[[-9, 0, 0], [11, 2/9, 0], [50, -40/9, -1], [50, -40/9, 1]]
[[-9, 0, 0], [14, 5/9, 0], [26, -77/45, -4/5], [27, -8/5, 6/5]]
[[-9, 0, 0], [18, 1, 0], [19, -8/9, -2/3], [22, -5/9, 4/3]]
[[-10, 0, 0], [11, 1/10, 0], [110, -10, 0], [111, -99/10, 2]]
[[-10, 0, 0], [14, 2/5, 0], [35, -5/2, 0], [39, -21/10, 2]]
[[-10, 0, 0], [18, 4/5, 0], [23, -6/5, -1/2], [27, -4/5, 3/2]]
[[-11, 0, 0], [12, 1/11, 0], [132, -11, 0], [133, -120/11, 2]]
[[-11, 0, 0], [13, 2/11, 0], [72, -60/11, -1], [72, -60/11, 1]]
[[-11, 0, 0], [16, 5/11, 0], [36, -117/55, -4/5], [37, -112/55, 6/5]]
[[-11, 0, 0], [21, 10/11, 0], [24, -56/55, -3/5], [28, -36/55, 7/5]]
[[-12, 0, 0], [13, 1/12, 0], [156, -12, 0], [157, -143/12, 2]]
[[-12, 0, 0], [16, 1/3, 0], [49, -35/12, -1], [49, -35/12, 1]]
[[-12, 0, 0], [17, 5/12, 0], [41, -143/60, -2/5], [44, -32/15, 8/5]]
[[-12, 0, 0], [21, 3/4, 0], [28, -4/3, 0], [37, -7/12, 2]]
[[-12, 0, 0], [21, 3/4, 0], [29, -5/4, -2/3], [32, -1, 4/3]]
[[-12, 0, 0], [25, 13/12, 0], [25, -119/156, -10/13], [28, -20/39, 16/13]]
[[-13, 0, 0], [14, 1/13, 0], [182, -13, 0], [183, -168/13, 2]]
[[-13, 0, 0], [15, 2/13, 0], [98, -84/13, -1], [98, -84/13, 1]]
[[-13, 0, 0], [18, 5/13, 0], [47, -168/65, -2/5], [50, -153/65, 8/5]]
[[-13, 0, 0], [23, 10/13, 0], [30, -84/65, -1/5], [38, -44/65, 9/5]]
[[-14, 0, 0], [15, 1/14, 0], [210, -14, 0], [211, -195/14, 2]]
[[-14, 0, 0], [18, 2/7, 0], [63, -7/2, 0], [67, -45/14, 2]]
[[-14, 0, 0], [19, 5/14, 0], [54, -96/35, -4/5], [55, -187/70, 6/5]]
[[-14, 0, 0], [22, 4/7, 0], [39, -12/7, -1/2], [43, -10/7, 3/2]]
[[-14, 0, 0], [27, 13/14, 0], [31, -171/182, -10/13], [34, -66/91, 16/13]]
[[-15, 0, 0], [16, 1/15, 0], [240, -15, 0], [241, -224/15, 2]]
[[-15, 0, 0], [17, 2/15, 0], [128, -112/15, -1], [128, -112/15, 1]]
[[-15, 0, 0], [24, 3/5, 0], [40, -5/3, 0], [49, -16/15, 2]]
[[-15, 0, 0], [24, 3/5, 0], [41, -8/5, -2/3], [44, -7/5, 4/3]]
[[-15, 0, 0], [28, 13/15, 0], [33, -72/65, -6/13], [40, -25/39, 20/13]]
[[-15, 0, 0], [32, 17/15, 0], [32, -161/255, -16/17], [33, -48/85, 18/17]]

您的示例插图似乎在第一次操作之后仅包括“内部”的阿波罗圆。
Sparr

@Sparr我不确定你的意思。第一次操作后,两个阿波罗尼亚圆中的一个已经存在(您未在当前迭代中选择的原始父圆),而您仅在寻找其他解决方案。
马丁·恩德2014年

没关系,您说得对,我读错了。
Sparr

Answers:


12

GolfScript(289字节向量/ 237字节栅格)

289个字节并在合理的时间内执行:

'/'/n*','/']['*0,`1/*~1.$[]*(~-400*:&;{1+1=*}/:D;{{1+2<~D@*\/}%}%'<svg><g fill="none" stroke="red">'puts.{[[~@:b[D&*\abs]{@&*[b]+}2*]{'.0/'*'"#{
}"'n/*~}%'<circle r="
" cx="
" cy="
" />'n/\]zip puts}:|/[{.([.;]+}3*]{(:?zip{)\~++2*\-}%:c.|0=D&*<{?);[c]+[{([.;]+.}3*;]+}*.}do'</g></svg>'

这将在stdin上输入并生成一个SVG文件到stdout。不幸的是,在线演示花费的时间太长,但是经过调整的版本会提前中止,您可以从中获得灵感

给定输入[[-2, 0, 0], [3, 1/2, 0], [6, -2, 0], [7, -3/2, 2]]输出(通过InkScape转换为PNG)为

垫片2/3/6/7


在237个字节的情况下,它花费的时间太长了(我推断,要产生与上面类似的输出,虽然只用一位或几位黑白,将花费一个多星期的时间):

'/'/n*','/']['*0,`1/*~1.$[]*(~-400*:&;{1+1=*}/:D;{{1+2<~D@*\/}%}%.[{.([.;]+}3*]{(:?[zip{)\~++2*\-}%:c]@+\0c=D&*<{?);[c]+[{([.;]+.}3*;]+}*.}do;:C;'P1 ''801 '2*.~:B*,{:P;C{:?[0=2/.D&*-.*\D&*+.*]{2,{P{B/}2$*B%400-?0=*\)?=&*-.*}/+<},,1=},!}/

输出为NetPBM格式,没有换行符,因此尽管GIMP仍会加载它,但可能并不严格遵循规范。如果需要严格遵守,则n在last之后插入!

光栅化是通过针对每个圆测试每个像素来完成的,因此所花费的时间在像素数乘以圆数中几乎是线性的。通过将所有内容缩小10倍,

'/'/n*','/']['*0,`1/*~1.$[]*(~-40*:&;{1+1=*}/:D;{{1+2<~D@*\/}%}%.[{.([.;]+}3*]{(:?[zip{)\~++2*\-}%:c]@+\0c=D&*<{?);[c]+[{([.;]+.}3*;]+}*.}do;:C;'P1 ''81 '2*.~:B*,{:P;C{:?[0=2/.D&*-.*\D&*+.*]{2,{P{B/}2$*B%40-?0=*\)?=&*-.*}/+<},,1=},!}/

将在10分钟内运行并产生

81x81图片

(使用GIMP转换为PNG)。给定36小时,它产生了401x401

401x401图片


3
我从没想过您可以用Golfscript做图形输出...
Beta Decay

12

JavaScript(418410字节)

实现为功能:

function A(s){P='<svg><g fill=none stroke=red transform=translate(400,400)>';Q=[];s=eval(s);S=-400*s[0][0];function d(c){P+='<circle r='+Math.abs(p=S/c[0])+' cx='+p*c[1]+' cy='+p*c[2]+' />'}for(c=4;c--;d(s[0]),s.push(s.shift()))Q.push(s.slice());for(;s=Q.shift();d(c)){c=[];for(i=4;i--;)c[i]=2*(s[0][i]+s[1][i]+s[2][i])-s[3][i];for(i=6;c[0]<S&&i;)Q.push([s[i--%3],s[i--%3],c,s[i%3]])}document.body.innerHTML=P}

在线演示(请注意:不适用于无法满足SVG规范要求的隐式调整大小的浏览器,因此,我提供了一个稍长的版本来解决该错误;浏览器渲染SVG的准确性可能不如Inkscape,尽管Inkscape在引用属性方面要严格一些)。

请注意,使用可以节省8个字节document.write,但这会使jsFiddle陷入困境。


1
你大概可以节省更多的通过定义ES6功能和存储,例如,S/c[0]在一个变量,然后又摆脱Math.abs了三元运营商等
英戈·伯克

@IngoBürk,如果我要走ES6路线,那我应该用CoffeeScript编写它。
彼得·泰勒

使用主机c99.nl。它允许document.write。
xem

2
高兴

@IngoBürk建议使用临时变量进行了更新。消除Math.abs实际上会花费一个角色。
彼得·泰勒

6

Mathematica 289个字符

通过求解双线性系统 http://arxiv.org/pdf/math/0101066v1.pdf定理2.2(效率极低)。

不需要的空间,仍然打高尔夫球:

w = {k, x, y};
d = IdentityMatrix;
j = Join;
p_~f~h_ := If[#[[-1, 1]] < 6! h,
    q = 2 d@4 - 1;
    m = #~j~{w};
    r = Complement[w /. NSolve[ And @@ j @@ 
                        MapThread[Equal, {Thread@m.q.m, 4 d@3 {0, 1, 1}}, 2], w], a];
    If[r != {},
     a~AppendTo~# & @@ r;
     Function[x, x~j~{#}~f~h & /@ r]@#]] & /@ p~Subsets~{3}; 
Graphics[Circle @@@ ({{##2}, 1}/# & @@@ (f[a = #, -Tr@#]; a))] &

带输入的缩小尺寸的动画 {{-13, 0, 0}, {23, 10/13, 0}, {30, -84/65, -1/5}, {38, -44/65, 9/5}}

在此处输入图片说明


您如何接受输入?
Martin Ender 2014年

@MartinBüttner作为函数参数,添加@{{-1, 0, 0}, {2, 1, 0}, {2, -1, 0}, {3, 0, 2}}到最后一行
belisarius博士2014年

@MartinBüttner如果要测试,请先尝试使用50/h而不是400/h。您将更快地得到结果。此外,您可以通过Dynamic@Length@a在执行功能之前输入信息来监视进度
belisarius博士2014年

Instructions for testing this answer (with a reduced number of circles) without Mathematica installed:1)下载从pastebin并将其另存为* .CDF 2)从Wolfram Research 下载并安装免费的CDF环境,网址为(不是小文件)。请享用。告诉我它是否有效!-注意:计算速度很慢,请等待图形显示出来。
belisarius博士2014年

“效率极低”的注释指的是什么?(看动画)是不是您要绘制大多数圆至少两次?我认为,复杂的笛卡尔方法本质上是高效的。
彼得·泰勒

4

枫(960字节)

我使用笛卡尔定理生成了Apollonian垫片,然后使用Maple的绘图系统对其进行了绘图。如果我有时间,我想进一步打高尔夫球并将其更改为Python(枫树绝对不是最适合分形的工具)。如果您想运行我的代码,这里是一个免费的Maple播放器的链接。

X,Y,Z,S,N:=abs,evalf,member,sqrt,numelems;
f:=proc(J)
    L:=map((x)->[x[1],(x[2]+x[3]*I)/x[1]+50*(1+I)/X(J[1][2])],J);
    R:=Vector([L]);
    T,r:=X(L[1][3]),L[1][4];
    A(L[1][5],L[2][6],L[3][7],L[1][8],L[2][9],L[3][10],R,T,r);
    A(L[1][11],L[2][12],L[4][13],L[1][14],L[2][15],L[4][16],R,T,r);
    A(L[1][17],L[3][18],L[4][19],L[1][20],L[3][21],L[4][22],R,T,r);
    A(L[2][23],L[3][24],L[4][25],L[2][26],L[3][27],L[4][28],R,T,r);
    plots[display](seq(plottools[circle]([Re(R[i][29]),Im(R[i][30])],X(1/R[i][31])),i=1..N(R))):
end proc:
A:=proc(a,b,c,i,j,k,R,E,F)
    K:=i+k+j+2*S(i*k+i*j+k*j);
    if K>400*E then
    return;
    end if;
    C:=(a*i+c*k+b*j+2*S(a*c*i*k+b*c*j*k+a*b*i*j))/K;
    C2:=(a*i+c*k+b*j-2*S(a*c*i*k+b*c*j*k+a*b*i*j))/K;
    if Y(X(C-F))<1/E and not Z([K,C],R) then
    R(N(R)+1):=[K,C];
    A(a,b,C,i,j,K,R,E,F);
    A(a,c,C,i,k,K,R,E,F);
    A(b,c,C,j,k,K,R,E,F);
    end if:    
    if Y(X(C2-F))<1/E and not Z([K,C2],R) then
    R(N(R)+1):=[K,C2];
    A(a,b,C2,i,j,K,R,E,F);
    A(a,c,C2,i,k,K,R,E,F);
    A(b,c,C2,j,k,K,R,E,F);
    end if: 
end proc:

一些样品垫片

f([[-1, 0, 0], [2, 1, 0], [2, -1, 0], [3, 0, 2]]);

在此处输入图片说明

f([[-9, 0, 0], [14, 5/9, 0], [26, -77/45, -4/5], [27, -8/5, 6/5]]);

在此处输入图片说明

By using our site, you acknowledge that you have read and understand our Cookie Policy and Privacy Policy.
Licensed under cc by-sa 3.0 with attribution required.