Desenhe o Pentaflake

25

Antes de tudo ... eu gostaria de desejar a todos um Feliz Natal (desculpe se estou um dia atrasado para o seu fuso horário).

Para comemorar a ocasião, vamos desenhar um floco de neve. Como o ano é 201 5 e o Natal é o dia 5 5 (para grande parte das pessoas), desenharemos um floco Penta . O Pentaflake é um fractal simples composto por pentágonos. Aqui estão alguns exemplos (extraídos daqui) :insira a descrição da imagem aqui

Cada Pentaflake tem um pedido n. O Pentaflake da ordem 0 é simplesmente um pentágono. Para todos os outros pedidos n, um Pentaflake é composto por 5 Pentaflakes da ordem anterior organizados em torno de um sexto Pentaflake da ordem anterior. Por exemplo, um Pentaflake da ordem 1 é composto por 5 pentágonos dispostos em torno de um pentágono central.

Entrada

A ordem n. Isso pode ser dado de qualquer maneira, exceto a de uma variável predefinida.

Saída

Uma imagem do pedido nPentaflake. Deve ter pelo menos 100 px de largura e 100 px de comprimento. Pode ser salvo em um arquivo, exibido para o usuário ou enviado para STDOUT. Qualquer outra forma de saída não é permitida. Todos os formatos de imagem existentes antes desse desafio são permitidos.

Ganhando

Como codegolf, a pessoa com o menor número de bytes vence.

O número um
fonte
3
-1 porque os flocos de neve têm apenas 6 vezes de simetria! = D
flawr
@flawr De acordo com este artigo, apenas 0,1% dos flocos de neve têm simetria 6 vezes maior ... ou qualquer simetria. No entanto, esses flocos de neve que têm simetria pode ter simetria de 3 vezes em adição à simetria de 6 vezes: P
TheNumberOne
4
Bem, este artigo estudou apenas menos de 0,1% de todos os flocos de neve e, de qualquer maneira, não faz sentido, pois eles estudaram apenas os flocos de neve americanos. Aposto que os flocos de neve métricos são muito mais simétricos! (! PS: imagens bonitas do floco de neve # 167 é especialmente interessante !) (Eu notei que os flocos de neve métricas deve ter simetria 10 vezes.)
flawr
1
Tudo ficará bem, desde que seja gerado usando um dos métodos acima. No entanto, nnão pode ser predefinido no seu arquivo de script. Você pode ler na partir STDIN, alerta-lo do usuário, tomá-lo como um argumento de linha / função commad ... basicamente qualquer coisa que quiser, exceto para incorporá-lo diretamente em seu código.
TheNumberOne
1
Não quero marcar +1 porque tem 25 :(
The_Basset_Hound

Respostas:

14

Matlab, 226

function P(M);function c(L,X,Y,O);hold on;F=.5+5^.5/2;a=2*pi*(1:5)/5;b=a(1)/2;C=F^(2*L);x=cos(a+O*b)/C;y=sin(a+O*b)/C;if L<M;c(L+1,X,Y,~O);for k=1:5;c(L+1,X+x(k),Y+y(k),O);end;else;fill(X+x*F, Y+y*F,'k');end;end;c(0,0,0,0);end

Ungolfed:

function P(M);                
function c(L,X,Y,O);          %recursive function
hold on;
F=.5+5^.5/2;                  %golden ratio
a=2*pi*(1:5)/5;               %full circle divided in 5 parts (angles)
b=a(1)/2;
C=F^(2*L);
x=cos(a+O*b)/C;               %calculate the relative position ofnext iteration
y=sin(a+O*b)/C;
if L<M;                       %current recursion (L) < Maximum (M)? recurse
    c(L+1,X,Y,~O);            %call recursion for inner pentagon
    for k=1:5;
        c(L+1,X+x(k),Y+y(k),O)%call recursion for the outer pentagons
    end; 
else;                         %draw
    fill(X+x*F, Y+y*F,'k');  
end;
end;
c(0,0,0,0);
end

Quinta iteração (já demorou um pouco para renderizar).

insira a descrição da imagem aqui

Uma ligeira alteração no código (infelizmente mais bytes) resulta nessa beleza =)

insira a descrição da imagem aqui

Ah, e outro:

insira a descrição da imagem aqui

flawr
fonte
Obrigado por me apontar para esse desafio, adicionei outra solução, espero que você não se importe;) Estou longe de sua contagem de bytes, de qualquer forma, achei interessante demais para ser desperdiçada.
precisa
7

Mathematica, 200 bytes

a=RotationTransform
b=Range
r@k_:={Re[t=I^(4k/5)],Im@t}
R@k_:=a[Pi,(r@k+r[k+1])/2]
Graphics@Nest[GeometricTransformation[#,ScalingTransform[{1,1}(Sqrt@5-3)/2]@*#&/@Append[R/@b@5,a@0]]&,Polygon[r/@b@5],#]&

A última linha é uma função que pode ser aplicada a um número inteiro n.

Os nomes das funções do Mathematica são longos. Alguém deve codificá-los por entropia e criar um novo idioma a partir dele. :)

Quando aplicado a 1:

insira a descrição da imagem aqui

Quando aplicado a 2:

insira a descrição da imagem aqui

Peter Richter
fonte
6

MATLAB, 235 233 217 bytes

Atualização: várias sugestões do @flawr me ajudaram a perder 16 bytes. Como somente isso me permitiu vencer a solução da flawr e que eu não teria encontrado o desafio sem a ajuda da flawr, considere isso uma submissão conjunta por nós :)

N=input('');f=2*pi/5;c=1.5+5^.5/2;g=0:f:6;p=[cos(g);sin(g)];R=[p(:,2),[-p(2,2);p(1,2)]];for n=1:N,t=p;q=[];for l=0:4,q=[q R^l*[c-1+t(1,:);t(2,:)]/c];end,p=[q -t/c];end,p=reshape(p',5,[],2);fill(p(:,:,1),p(:,:,2),'k');

Essa é outra solução MATLAB, baseada em uma filosofia de sistemas de funções iteradas. Eu estava interessado principalmente no desenvolvimento do algoritmo em si e não joguei muito na solução. Certamente há espaço para melhorias. (Eu pensei em usar uma aproximação de ponto fixo codificada para c, mas isso não seria legal.)

Versão não destruída:

N=input('');                                % read order from stdin

f=2*pi/5;                                   % angle of 5-fold rotation
c=1.5+5^.5/2;                               % scaling factor for contraction

g=0:f:6;
p=[cos(g);sin(g)];                          % starting pentagon, outer radius 1
R=[p(:,2),[-p(2,2);p(1,2)]];                % 2d rotation matrix with angle f

for n=1:N,                                  % iterate the points
    t=p;
    q=[];
    for l=0:4,
       q=[q R^l*[c-1+t(1,:);t(2,:)]/c];     % add contracted-rotated points
    end,
    p=[q -t/c];                             % add contracted middle block
end,

p=reshape(p',5,[],2);                 % reshape to 5x[]x2 matrix to separate pentagons
fill(p(:,:,1),p(:,:,2),'k');          % plot pentagons

Resultado para N=5(com um subsequente axis equal offpara beleza, mas espero que não conte em bytes):

N = 5 penta-flocos

Andras Deak
fonte
1
Eu acho que você poderia economizar alguns bytes usando R=[p(:,2),[-p(2,2);p(1,2)]];(e eliminando a anterior R,C,S) e você pode usar q=[q R^l*[c-1+t(1,:);t(2,:)]/c]e eu achoc=1.5+5^.5/2;
flawr
@ flawr, obviamente, você está certo :) 1. obrigado pela matriz de rotação, 2. obrigado pelo novo q, eu ainda tinha um par desnecessário de parênteses lá ... 3. obrigado, mas o que é essa mágica ??: D 4. Como a solução agora é mais curta que a original, considero que isso também é parcialmente sua submissão.
Andras Deak
6

Mathematica, 124 bytes

O Mathematica suporta nova sintaxe Tabledesde a versão 10 Table[expr, n]:, que salva outro byte. Table[expr, n]é equivalente a Table[expr, {n}].

f@n_:=(p=E^Array[π.4I#&,5];Graphics@Map[Polygon,ReIm@Fold[{g,s}~Function~Join[.62(.62g#+#&/@s),{-.39g}],p,p~Table~n],{-3}])

O núcleo desta função é usar números complexos para fazer transformações e depois convertê-los em pontos por ReIm.

Caso de teste:

f[4]

insira a descrição da imagem aqui

njpipeorgan
fonte
1
πocupa dois bytes em UTF-8, então você obtém um total de 125 bytes.
usar o seguinte código
O que é isso, OMFG
DumpsterDoofus
3

Mathematica, 199 196 bytes

Afiando a resposta de Peter Richter com um fio de cabelo, aqui está uma das minhas. Ele se apóia fortemente na funcionalidade gráfica e menos em matemática e FP. O CirclePoints embutido é novo no 10.1 .

c=CirclePoints;g=GeometricTransformation;
p@0=Polygon@c[{1,0},5];
p@n_:=GraphicsGroup@{
        p[n-1],
        g[
          p[n-1]~g~RotationTransform[Pi/5],
          TranslationTransform/@{GoldenRatio^(2n-1),n*Pi/5}~c~5
        ]
      };
f=Graphics@*p

Edit: Graças a DumpsterDoofus para GoldenRatio

hYPotenuser
fonte
Você pode salvar 3 bytes substituindo ((1+Sqrt@5)/2)por GoldenRatio. Também na segunda linha, acho que deveria ser em p@0=Polygon@c[{1,0},5];vez de p@0=Polygon@cp[{1,0},5];. (Na verdade, eu sou Peter, tenho dois perfis, lol).
usar o seguinte
Sim! Boa decisão. Também vi o erro de digitação, mas esqueci de corrigi-lo. D'oh,
hYPotenuser
2

Mathematica, 130 bytes

r=Exp[Pi.4I Range@5]
p=1/GoldenRatio
f@0={r}
f@n_:=Join@@Outer[1##&,r,p(f[n-1]p+1),1]~Join~{-f[n-1]p^2}
Graphics@*Polygon@*ReIm@*f

Uso uma técnica semelhante à resposta de njpipeorgan (de fato, roubei o 2Pi I/5 == Pi.4Itruque dele ), mas implementada como uma função recursiva.

Exemplo de uso (usando %para acessar a função anônima que foi impressa na última linha):

 %[5]

insira a descrição da imagem aqui

2012rcampion
fonte