Gambarkan Gasket Apollonian

28

Dengan tiga lingkaran singgung yang saling berhubungan, kita selalu dapat menemukan dua lingkaran lagi yang bersinggungan dengan ketiganya. Keduanya disebut lingkaran Apollonia . Perhatikan bahwa salah satu lingkaran Apolonia mungkin sebenarnya berada di sekitar tiga lingkaran awal.

Mulai dari tiga lingkaran singgung, kita dapat membuat fraktal yang disebut paking Apollonia , dengan proses berikut:

  1. Panggil 3 lingkaran awal lingkaran induk
  2. Temukan dua lingkaran Apollonia lingkaran induk
  3. Untuk setiap lingkaran Apolonia:
    1. Untuk setiap pasangan dari tiga pasang lingkaran induk:
      1. Panggil lingkaran Apollonia dan dua lingkaran induk kumpulan baru lingkaran orangtua dan mulai lagi dari langkah 2.

Misalnya dimulai dengan lingkaran dengan ukuran yang sama, kita mendapatkan:

masukkan deskripsi gambar di sini

Gambar ditemukan di Wikipedia

Ada satu lagi notasi yang kami butuhkan. Jika kita memiliki lingkaran jari-jari r dengan pusat (x, y) , kita dapat mendefinisikan kelengkungannya sebagai k = ± 1 / r . Biasanya k akan positif, tetapi kita dapat menggunakan k negatif untuk menunjukkan lingkaran yang membungkus semua lingkaran lain di dalam paking (yaitu semua garis singgung menyentuh lingkaran itu dari dalam). Kemudian kita dapat menentukan lingkaran dengan triplet angka: (k, x * k, y * k) .

Untuk keperluan pertanyaan ini, kita akan mengasumsikan bilangan bulat positif k dan rasional x dan y .

Contoh lebih lanjut untuk lingkaran tersebut dapat ditemukan di artikel Wikipedia .

Ada juga beberapa hal menarik tentang gasket integral dalam artikel ini (di antara hal-hal menyenangkan lainnya dengan lingkaran).

Tantangan

Anda akan diberikan spesifikasi 4 lingkaran, yang masing-masing akan terlihat seperti (14, 28/35, -112/105). Anda dapat menggunakan format daftar dan operator divisi apa saja yang nyaman, sehingga Anda dapat dengan mudah evalmemasukkannya jika mau. Anda mungkin berasumsi bahwa 4 lingkaran memang bersinggungan satu sama lain, dan yang pertama memiliki kelengkungan negatif. Itu berarti Anda sudah diberikan lingkaran Apollonia di sekitar tiga lainnya. Untuk daftar input contoh yang valid, lihat bagian bawah tantangan.

Tulis program atau fungsi yang, jika diberi input ini, menggambar gasket Apollonia.

Anda dapat mengambil input melalui argumen fungsi, ARGV atau STDIN dan membuat fraktal di layar atau menulisnya ke file gambar dalam format pilihan Anda.

Jika gambar yang dihasilkan dirasterisasi, itu harus setidaknya 400 piksel di setiap sisi, dengan kurang dari 20% di sekitar lingkaran terbesar. Anda dapat berhenti berulang ketika Anda mencapai lingkaran yang radiusnya kurang dari 400 dari lingkaran input terbesar, atau lingkaran yang lebih kecil dari piksel, mana yang terjadi terlebih dahulu.

Anda harus menggambar hanya garis lingkaran, bukan cakram penuh, tetapi warna latar dan garis adalah pilihan Anda. Garis luar tidak boleh lebih lebar dari 200 dari diameter lingkaran luar.

Ini kode golf, jadi jawaban tersingkat (dalam byte) menang.

Contoh Input

Berikut ini adalah semua gasket integral dari artikel Wikipedia yang dikonversi ke format input yang ditentukan:

[[-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
sumber
Ilustrasi contoh Anda tampaknya hanya menyertakan lingkaran apolonia "di dalam" setelah operasi pertama.
Sparr
@Parr Saya tidak yakin apa yang Anda maksud. Setelah operasi pertama, salah satu dari dua lingkaran Apolonia sudah ada (lingkaran induk asli yang tidak Anda pilih untuk iterasi saat ini) dan Anda hanya mencari solusi lainnya.
Martin Ender
Sudahlah, Anda benar, saya salah membaca.
Sparr

Jawaban:

12

GolfScript (vektor 289 byte / raster 237 byte)

Pada 289 byte dan mengeksekusi dalam waktu yang wajar:

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

Ini membutuhkan input pada stdin dan menghasilkan file SVG ke stdout. Sayangnya butuh sedikit terlalu lama untuk demo online, tetapi versi tweak yang dibatalkan lebih awal dapat memberi Anda ide.

Mengingat masukan [[-2, 0, 0], [3, 1/2, 0], [6, -2, 0], [7, -3/2, 2]]yang keluaran (dikonversi ke PNG dengan Inkscape) adalah

paking 2/3/6/7


Pada 237 byte dan memakan waktu terlalu lama (saya memperkirakan bahwa itu akan memakan waktu lebih dari satu minggu untuk menghasilkan output yang sama dengan di atas, meskipun dalam satu-bit hitam dan putih):

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

Output adalah format NetPBM tanpa baris baru, jadi mungkin tidak secara ketat mengikuti spesifikasi, meskipun GIMP akan tetap memuatnya. Jika kepatuhan yang ketat diperlukan, masukkan nsetelah yang terakhir !.

Rasterisasi adalah dengan menguji setiap piksel terhadap setiap lingkaran, sehingga waktu yang diambil cukup linier dalam jumlah piksel kali jumlah lingkaran. Dengan menurunkan segalanya dengan faktor 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=},!}/

akan berjalan dalam 10 menit dan menghasilkan

Gambar 81x81

(dikonversi ke PNG dengan GIMP). Diberikan 36 jam menghasilkan 401x401

Gambar 401x401

Peter Taylor
sumber
3
Saya tidak akan pernah berpikir Anda bisa melakukan output grafis dengan Golfscript ...
Beta Decay
12

JavaScript ( 418 410 byte)

Diimplementasikan sebagai fungsi:

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}

Demo online (catatan: tidak berfungsi di browser yang gagal memenuhi persyaratan spesifikasi SVG sehubungan dengan ukuran tersirat, jadi saya menawarkan versi yang sedikit lebih panjang yang yang mengatasi bug itu; peramban juga dapat membuat SVG kurang akurat daripada misalnya Inkscape, meskipun Inkscape sedikit lebih ketat dalam mengutip atribut).

Perhatikan bahwa 8 byte dapat disimpan dengan menggunakan document.write, tapi itu benar-benar merusak jsFiddle.

Peter Taylor
sumber
1
Anda mungkin dapat menyimpan lebih banyak dengan mendefinisikan fungsi dengan ES6 dan menyimpan, misalnya, S/c[0]dalam suatu variabel dan kemudian juga menyingkirkannya Math.absdengan operator ternary dll.
Ingo Bürk
@ IngoBürk, jika saya akan pergi rute ES6 maka saya akan menulisnya dalam CoffeeScript.
Peter Taylor
gunakan host c99.nl. Ini memungkinkan document.write.
xem
2
Senang melihat jawaban untuk ini :)
MickyT
Diperbarui dengan saran @ IngoBürk untuk variabel sementara. Menghilangkan Math.abssebenarnya akan membutuhkan karakter.
Peter Taylor
6

Mathematica 289 karakter

Dengan memecahkan sistem bilinear sesuai http://arxiv.org/pdf/math/0101066v1.pdf Teorema 2.2 (sangat tidak efisien).

Spasi tidak diperlukan, masih bisa bermain 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))] &

Animasi ukuran dikurangi dengan input {{-13, 0, 0}, {23, 10/13, 0}, {30, -84/65, -1/5}, {38, -44/65, 9/5}}

masukkan deskripsi gambar di sini

Belisarius
sumber
Bagaimana Anda mengambil input?
Martin Ender
@ MartinBüttner sebagai argumen fungsi, dengan menambahkan @{{-1, 0, 0}, {2, 1, 0}, {2, -1, 0}, {3, 0, 2}}baris terakhir
Dr. belisarius
@ MartinBüttner Jika Anda akan untuk menguji coba pertama dengan 50/hbukan 400/h. Anda akan mendapatkan hasilnya lebih cepat. juga, Anda dapat memantau kemajuan dengan memasukkan Dynamic@Length@asebelum menjalankan fungsi
Dr. belisarius
Instructions for testing this answer (with a reduced number of circles) without Mathematica installed: 1) Unduh ini dari pastebin dan simpan sebagai * .CDF 2) Unduh dan instal lingkungan CDF gratis dari Wolfram Research at (bukan file kecil). Nikmati. Katakan padaku jika itu berhasil! - Catatan: Calcs lambat, tunggu sampai grafik muncul.
Dr. belisarius
Apa yang dimaksud dengan komentar "sangat tidak efisien"? Apakah itu (melihat animasi) Anda tampaknya menggambar sebagian besar lingkaran setidaknya dua kali? Saya pikir pendekatan kompleks Descartes secara inheren seefisien mungkin.
Peter Taylor
4

Maple (960 byte)

Saya menggunakan Descartes Theorem untuk menghasilkan Gasket Apollonian dan kemudian menggunakan sistem plot Maple untuk merencanakannya. Jika saya punya waktu saya ingin golf lebih lanjut dan mengubahnya menjadi Python (Maple jelas bukan yang terbaik untuk fraktal). Berikut ini tautan ke pemain Maple gratis jika Anda ingin menjalankan kode saya.

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:

Beberapa contoh gasket

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

masukkan deskripsi gambar di sini

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

masukkan deskripsi gambar di sini

Cameron
sumber