Нарисуй пентаклейку


25

Прежде всего ... Я хотел бы пожелать всем счастливого Рождества (извините, если я опаздываю из-за вашего часового пояса).

Чтобы отпраздновать это событие, мы собираемся нарисовать снежинку. Поскольку год 201 5, а Рождество - 2 5 (для большой части людей), мы нарисуем хлопья Пента . Pentaflake - это простой фрактал, состоящий из пятиугольников. Вот несколько примеров (взятых отсюда) :введите описание изображения здесь

Каждый пятиугольник имеет порядок n. Пентафляк порядка 0 - это просто пятиугольник. Для всех других порядков n пятиугольник состоит из 5 пятиугольников предыдущего порядка, расположенных вокруг 6-го пятиугольника предыдущего порядка. Например, пятиугольник порядка 1 состоит из пяти пятиугольников, расположенных вокруг центрального пятиугольника.

вход

Порядок n. Это может быть дано любым способом, кроме предопределенной переменной.

Выход

Изображение заказа nПентакла. Должен быть не менее 100 пикселей в ширину и 100 пикселей в длину. Он может быть сохранен в файл, отображен для пользователя или выведен в STDOUT. Любая другая форма вывода не допускается. Все графические форматы, существующие до этого испытания, разрешены.

выигрыш

Как Codegolf, выигрывает человек с наименьшим количеством байтов.


3
-1 потому что снежинки имеют только 6-кратную симметрию! = D
flawr

@flawr Согласно этой статье только около 0,1% снежинок на самом деле имеют 6-кратную симметрию ... или вообще какую-либо симметрию. Однако те снежинки, у которых есть симметрия, могут иметь 3-кратную симметрию в дополнение к 6-кратной симметрии: P
TheNumberOne

4
Ну, эта статья изучала только менее 0,1% всех снежинок, и это все равно бессмысленно, так как они изучали только американские снежинки. Бьюсь об заклад, метрические снежинки гораздо более симметричны! (PS: Красивые картинки! Снежинка № 167 особенно интересна !) (Я только что заметил, что метрические снежинки должны иметь 10-кратную симметрию.)
flawr

1
Это будет хорошо, пока он выводит, используя один из вышеуказанных методов. Однако nне может быть предопределено в вашем файле сценария. Вы можете прочитать nиз STDIN, подсказывать от пользователя, принять его в качестве функции / строки аргумента commad ... в основном все , что вы хотите для встраивания непосредственно в коде , за исключением.
TheNumberOne

1
Не хочу +1 это, потому что у него 25 :(
The_Basset_Hound

Ответы:


14

Матлаб, 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

Пятая итерация (рендеринг уже занял довольно много времени).

введите описание изображения здесь

Небольшое изменение кода (к сожалению, больше байтов) приводит к этой красоте =)

введите описание изображения здесь

Ох, и еще один:

введите описание изображения здесь


Спасибо, что указали мне на этот вызов, я пошел и добавил другое решение, надеюсь, вы не возражаете;) Я в безопасности от вашего количества байтов, в любом случае, я просто нашел его слишком интересным, чтобы его пропустить.
Андрас Дик

7

Mathematica, 200 байт

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],#]&

Последняя строка - это функция, которая может быть применена к целому числу n.

Имена функций Mathematica длинные. Кто-то должен энтропийно кодировать их и сделать из них новый язык. :)

Применительно к 1:

введите описание изображения здесь

Применительно к 2:

введите описание изображения здесь


6

MATLAB, 235 233 217 байт

Обновление: куча предложений от @flawr помогла мне потерять 16 байт. Так как только это позволило мне победить решение flawr , и что я не нашел бы проблему без помощи flawr в первую очередь, мы считаем это совместным представлением :)

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');

Это еще одно решение MATLAB, основанное на философии систем итерированных функций. Я был в основном заинтересован в разработке самого алгоритма, и я не слишком много играл в решение. Там, безусловно, есть место для улучшения. (Я предполагал использовать жестко закодированное приближение для фиксированной точки c, но это было бы не очень хорошо.)

Безголовая версия:

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

Результат для N=5(с последующей axis equal offдля красивости, но я надеюсь, что это не считается в байтовом выражении):

N = 5 пентамен


1
Я думаю, что вы могли бы сэкономить несколько байтов, используя R=[p(:,2),[-p(2,2);p(1,2)]];(и исключая предыдущие R,C,S), и вы можете использовать, q=[q R^l*[c-1+t(1,:);t(2,:)]/c]и я думаюc=1.5+5^.5/2;
flawr

@flawr, очевидно, вы правы :) 1. спасибо за матрицу вращения, 2. спасибо за новое q, у меня даже была пара ненужных скобок там ... 3. спасибо, но что это за магия ??: D 4. поскольку решение теперь короче вашего оригинала, я считаю, что это также частично ваше представление.
Андрас Дик

6

Mathematica, 124 байта

Mathematica поддерживает новый синтаксис Tableначиная с версии 10:, Table[expr, n]который сохраняет еще один байт. Table[expr, n]эквивалентно 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}])

Суть этой функции заключается в использовании комплексных чисел для преобразования и последующего преобразования их в точки ReIm.

Прецедент:

f[4]

введите описание изображения здесь


1
πзанимает в UTF-8 два байта, поэтому получается всего 125 байтов.
2012 rcampion

OMFG что это
DumpsterDoofus

3

Mathematica, 199 196 байт

Подчеркивая ответ Питера Рихтера за волосы, вот мой собственный. Он в значительной степени опирается на графическую функциональность и меньше на математику и FP. Встроенный CirclePoints является новым в 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

Изменить: Благодаря DumpsterDoofus для GoldenRatio


Вы можете сохранить 3 байта, заменив ((1+Sqrt@5)/2)на GoldenRatio. Также во второй строке я думаю, что это должно быть p@0=Polygon@c[{1,0},5];вместо p@0=Polygon@cp[{1,0},5];. (Кстати, я на самом деле Питер, у меня есть два профиля LOL).
DumpsterDoofus

Да! Хороший звонок. Я тоже обнаружил опечатку, но забыл ее исправить.
Д'Ох

2

Mathematica, 130 байт

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

Я использую технику, аналогичную ответу njpipeorgan (фактически я украл его 2Pi I/5 == Pi.4Iтрюк), но реализован как рекурсивная функция.

Пример использования (используется %для доступа к анонимной функции, которая была выведена в последней строке):

 %[5]

введите описание изображения здесь

Используя наш сайт, вы подтверждаете, что прочитали и поняли нашу Политику в отношении файлов cookie и Политику конфиденциальности.
Licensed under cc by-sa 3.0 with attribution required.