Dessinez un joint Apollonian

28

Étant donné trois cercles mutuellement tangents, nous pouvons toujours trouver deux autres cercles qui sont tangents à tous les trois. Ces deux sont appelés cercles apolliniens . Notez que l'un des cercles apolliniens pourrait en fait être autour des trois cercles initiaux.

À partir de trois cercles tangents, nous pouvons créer une fractale appelée joint Apollonian , par le processus suivant:

  1. Appelez les 3 cercles initiaux les cercles parents
  2. Trouver les deux cercles apolliniens des cercles parents
  3. Pour chaque cercle apollinien:
    1. Pour chaque paire des trois paires de cercles parents:
      1. Appelez le cercle Apollonian et les deux cercles parents le nouvel ensemble de cercles parents et recommencez à partir de l'étape 2.

Par exemple, en commençant par des cercles de taille égale, nous obtenons:

entrez la description de l'image ici

Image trouvée sur Wikipédia

Il y a encore un peu de notation dont nous avons besoin. Si nous avons un cercle de rayon r de centre (x, y) , nous pouvons définir sa courbure comme k = ± 1 / r . Habituellement, k sera positif, mais nous pouvons utiliser k négatif pour désigner le cercle qui entoure tous les autres cercles dans le joint (c'est-à-dire que toutes les tangentes touchent ce cercle de l'intérieur). Ensuite, nous pouvons spécifier un cercle avec un triplet de nombres: (k, x * k, y * k) .

Aux fins de cette question, nous supposerons un entier positif k et rationnel x et y .

D'autres exemples de tels cercles peuvent être trouvés dans l'article Wikipedia .

Il y a aussi des trucs intéressants sur les joints intégraux dans cet article (entre autres choses amusantes avec des cercles).

Le défi

Vous recevrez 4 spécifications de cercle, dont chacune ressemblera (14, 28/35, -112/105). Vous pouvez utiliser n'importe quel format de liste et opérateur de division qui vous convient, de sorte que vous pouvez simplement evalsaisir les données si vous le souhaitez. Vous pouvez supposer que les 4 cercles sont en effet tangents les uns aux autres et que le premier a une courbure négative. Cela signifie que vous avez déjà reçu le cercle apollinien environnant des trois autres. Pour une liste d'exemples d'entrées valides, voir le bas du défi.

Écrivez un programme ou une fonction qui, compte tenu de cette entrée, dessine un joint apollinien.

Vous pouvez saisir des données via l'argument de fonction, ARGV ou STDIN et rendre la fractale à l'écran ou l'écrire dans un fichier image dans le format de votre choix.

Si l'image résultante est tramée, elle doit être d'au moins 400 pixels de chaque côté, avec moins de 20% de remplissage autour du plus grand cercle. Vous pouvez arrêter la récurrence lorsque vous atteignez des cercles dont le rayon est inférieur à un 400e du plus grand cercle d'entrée, ou des cercles plus petits qu'un pixel, selon la première éventualité.

Vous devez dessiner uniquement les contours des cercles, pas les disques pleins, mais les couleurs de l'arrière-plan et des lignes sont votre choix. Les contours ne doivent pas dépasser un 200e du diamètre des cercles extérieurs.

Il s'agit du code golf, donc la réponse la plus courte (en octets) l'emporte.

Exemples d'entrées

Voici tous les joints intégrés de l'article Wikipedia convertis au format d'entrée prescrit:

[[-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]]
Martin Ender
la source
Votre exemple d'illustration ne semble avoir inclus les cercles apolloniens "intérieurs" qu'après la première opération.
Sparr
@Sparr, je ne sais pas ce que tu veux dire. Après la première opération, l'un des deux cercles apolliniens existe déjà (le cercle parent d'origine que vous n'avez pas choisi pour l'itération actuelle) et vous ne cherchez que l'autre solution.
Martin Ender
Tant pis, tu as raison, j'ai mal lu.
Sparr

Réponses:

12

GolfScript (vecteur 289 octets / raster 237 octets)

À 289 octets et s'exécutant dans un délai raisonnable:

'/'/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>'

Cela prend une entrée sur stdin et génère un fichier SVG sur stdout. Malheureusement, cela prend un peu trop de temps pour une démo en ligne, mais une version modifiée qui s'arrête tôt peut vous donner une idée.

Étant donné l'entrée [[-2, 0, 0], [3, 1/2, 0], [6, -2, 0], [7, -3/2, 2]]la sortie (convertie en PNG avec InkScape) est

joint 2/3/6/7


À 237 octets et prenant beaucoup trop de temps (j'extrapole qu'il faudrait un peu plus d'une semaine pour produire une sortie similaire à celle ci-dessus, bien qu'en noir et blanc un bit):

'/'/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=},!}/

La sortie est au format NetPBM sans retour à la ligne, il est donc possible qu'elle ne suive pas strictement les spécifications, bien que GIMP la charge toujours. Si une stricte conformité est requise, insérez un naprès le dernier !.

La pixellisation consiste à tester chaque pixel contre chaque cercle, donc le temps pris est à peu près linéaire en nombre de pixels multiplié par le nombre de cercles. En réduisant tout par un facteur 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=},!}/

fonctionnera en 10 minutes et produira

Image 81x81

(converti en PNG avec GIMP). Compte tenu de 36 heures, il a produit le 401x401

Image 401x401

Peter Taylor
la source
3
Je n'aurais jamais pensé que vous pourriez faire une sortie graphique avec Golfscript ...
Beta Decay
12

JavaScript ( 418 410 octets)

Implémenté en fonction:

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}

Démo en ligne (note: ne fonctionne pas dans les navigateurs qui ne respectent pas les exigences de la spécification SVG en ce qui concerne le dimensionnement implicite, donc je propose une version légèrement plus longue qui contourne ce bogue; les navigateurs peuvent également rendre le SVG moins précis que par exemple Inkscape, bien qu'Inkscape soit un peu plus strict sur la citation des attributs).

Notez que 8 octets pourraient être sauvegardés en utilisant document.write, mais cela fausse sérieusement jsFiddle.

Peter Taylor
la source
1
Vous pouvez probablement économiser davantage en définissant la fonction avec ES6 et en la stockant, par exemple, S/c[0]dans une variable, puis en vous débarrassant également Math.absavec un opérateur ternaire, etc.
Ingo Bürk
@ IngoBürk, si je devais emprunter la route ES6, je l'écrirais plutôt à CoffeeScript.
Peter Taylor
utilisez l'hôte c99.nl. Il autorise document.write.
2014
2
Bon de voir une réponse à cela :)
MickyT
Mis à jour avec la suggestion de @ IngoBürk pour une variable temporaire. L'éliminer Math.abscoûterait en fait un personnage.
Peter Taylor
6

Mathematica 289 caractères

En résolvant le système bilinéaire selon http://arxiv.org/pdf/math/0101066v1.pdf Théorème 2.2 (très inefficace).

Espaces non nécessaires, toujours au golf:

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, {[email protected], 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))] &

Une animation de taille réduite avec entrée {{-13, 0, 0}, {23, 10/13, 0}, {30, -84/65, -1/5}, {38, -44/65, 9/5}}

entrez la description de l'image ici

Dr. belisarius
la source
Comment prenez-vous vos commentaires?
Martin Ender
@ MartinBüttner comme argument de fonction, en ajoutant @{{-1, 0, 0}, {2, 1, 0}, {2, -1, 0}, {3, 0, 2}}à la dernière ligne
Dr. belisarius
@ MartinBüttner Si vous voulez le tester, essayez d'abord avec 50/hau lieu de 400/h. Vous allez obtenir le résultat plus rapidement. vous pouvez également suivre les progrès en entrant Dynamic@Length@aavant d'exécuter la fonction
Dr. belisarius
Instructions for testing this answer (with a reduced number of circles) without Mathematica installed: 1) Téléchargez -le à partir de pastebin et enregistrez-le sous * .CDF 2) Téléchargez et installez l'environnement CDF gratuit de Wolfram Research à (pas un petit fichier). Prendre plaisir. Dites-moi si cela fonctionne! - Remarque: Les calques sont lents, attendez que les graphiques apparaissent.
Dr belisarius
À quoi fait référence le commentaire "très inefficace"? Est-ce que (en regardant l'animation) vous dessinez apparemment la plupart des cercles au moins deux fois? Je pense que l'approche complexe de Descartes est intrinsèquement aussi efficace que possible.
Peter Taylor du
4

Érable (960 octets)

J'ai utilisé le théorème de Descartes pour générer le joint Apollonian, puis j'ai utilisé le système de traçage de Maple pour le tracer. Si j'ai le temps, je veux continuer à jouer au golf et le changer en Python (Maple n'est certainement pas le meilleur pour les fractales). Voici un lien vers un lecteur Maple gratuit si vous souhaitez exécuter mon code.

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:

Quelques exemples de joints

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

entrez la description de l'image ici

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

entrez la description de l'image ici

Cameron
la source