28
\$\begingroup\$

First of all ... I would like to wish everyone a Merry Christmas (sorry if I am a day late for your timezone).

To celebrate the occasion, we are going to draw a snowflake. Because the year is 2015 and Christmas is on the 25th (for a large portion of persons), we will draw a Pentaflake. The Pentaflake is a simple fractal composed of pentagons. Here are a few examples (taken from here):enter image description here

Each Pentaflake has an order n. The Pentaflake of order 0 is simply a pentagon. For all other orders n, a Pentaflake is composed of 5 Pentaflakes of the previous order arranged around a 6th Pentaflake of the previous order. For example, a Pentaflake of order 1 is composed of 5 pentagons arranged around a central pentagon.

Input

The order n. This may be given in any way except that of a predefined variable.

Output

An image of the order n Pentaflake. Must be at least 100px wide and 100px long. It may be saved to a file, displayed to the user, or outputted to STDOUT. Any other form of output is not allowed. All image formats existing before this challenge are allowed.

Winning

As codegolf, the person with the least number of bytes wins.

\$\endgroup\$
  • 3
    \$\begingroup\$ -1 because snowflakes only have 6 fold symmetry! =D \$\endgroup\$ – flawr Dec 25 '15 at 16:30
  • 1
    \$\begingroup\$ @flawr According to this article only about .1% of snowflakes actually have 6-fold symmetry ... or any symmetry at all. However, those snowflakes that do have symmetry can have 3-fold symmetry in addition to 6-fold symmetry :P \$\endgroup\$ – TheNumberOne Dec 26 '15 at 14:27
  • 5
    \$\begingroup\$ Well this article only studied way less than .1% of all snowflakes, and it is meaningless anyway, as they only studied american snowflakes. I bet metric snowflakes are way more symmetrical! (PS: Beautiful images! Snowflake #167 is especially interesting!) (I just noticed that metric snowflakes must have 10-fold symmetry.) \$\endgroup\$ – flawr Dec 26 '15 at 14:30
  • 1
    \$\begingroup\$ It will be okay as long as it outputs using one of the above methods. However, n cannot be predefined in your script file. You can read n from STDIN, prompt it from the user, take it as a function / commad line argument ... basically anything you want except for directly embedding it in your code. \$\endgroup\$ – TheNumberOne Dec 27 '15 at 0:20
  • 4
    \$\begingroup\$ Don't want to +1 this because it has 25 :( \$\endgroup\$ – The_Basset_Hound Jan 6 '16 at 3:23
16
\$\begingroup\$

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

Fifth iteration (already took quite a while to render).

enter image description here

A slight alteration of the code (unfortunately more bytes) results in this beauty=)

enter image description here

Oh, and another one:

enter image description here

| improve this answer | |
\$\endgroup\$
  • \$\begingroup\$ Thanks for pointing me to this challenge, I went and added another solution, hope you don't mind;) I'm safely away from your byte-count, anyway, I just found it too interesting to miss. \$\endgroup\$ – Andras Deak Dec 26 '15 at 19:26
8
\$\begingroup\$

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

The last line is a function which can be applied to an integer n.

Mathematica function names are long. Somebody should entropy-encode them and make a new language from it. :)

When applied to 1:

enter image description here

When applied to 2:

enter image description here

| improve this answer | |
\$\endgroup\$
8
\$\begingroup\$

MATLAB, 235 233 217 bytes

Update: a bunch of suggestions from @flawr helped me lose 16 bytes. Since only this allowed me to beat flawr's solution, and that I wouldn't have found the challenge without flawr's help in the first place, consider this a joint submission by us:)

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

This is another MATLAB solution, this one based on a philosophy of iterated function systems. I was mostly interested in developing the algorithm itself, and I haven't golfed too much on the solution. There's surely room for improvement. (I contemplated using a hard-coded fixed-point approximation for c, but that wouldn't be nice.)

Ungolfed version:

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

Result for N=5 (with a subsequent axis equal off for prettiness, but I hope that doesn't count byte-wise):

N=5 pentaflake

| improve this answer | |
\$\endgroup\$
  • 1
    \$\begingroup\$ I think you could save a few bytes by using R=[p(:,2),[-p(2,2);p(1,2)]]; (and eliminating the previous R,C,S) and you can use q=[q R^l*[c-1+t(1,:);t(2,:)]/c] and I think c=1.5+5^.5/2; \$\endgroup\$ – flawr Jan 1 '16 at 11:13
  • \$\begingroup\$ @flawr obviously you're right:) 1. thanks for the rotation matrix, 2. thanks for the new q, I even had a needless pair of parentheses in there... 3. thanks, but what is this magic??:D 4. since the solution is now shorter than your original, I consider this to be partly your submission as well. \$\endgroup\$ – Andras Deak Jan 3 '16 at 21:45
8
\$\begingroup\$

Mathematica, 124 bytes

Mathematica supports new syntax for Table since version 10: Table[expr, n], which saves another byte. Table[expr, n] is equivalent to 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}])

The core of this function is using complex numbers to do tranformations and then convert them to points by ReIm.

Test case:

f[4]

enter image description here

| improve this answer | |
\$\endgroup\$
  • 1
    \$\begingroup\$ π takes up two bytes in UTF-8, so you come out to 125 bytes total. \$\endgroup\$ – 2012rcampion Jan 4 '16 at 4:58
  • \$\begingroup\$ OMFG what is this \$\endgroup\$ – DumpsterDoofus Jan 5 '16 at 22:04
4
\$\begingroup\$

Mathematica, 199 196 bytes

Edging out Peter Richter's answer by a hair, here's one of my own. It leans heavily on graphics functionality, and less on math and FP. The CirclePoints builtin is new in 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: Thanks to DumpsterDoofus for GoldenRatio

| improve this answer | |
\$\endgroup\$
  • \$\begingroup\$ You can save 3 bytes by replacing ((1+Sqrt@5)/2) with GoldenRatio. Also in the second line I think it should be p@0=Polygon@c[{1,0},5]; instead of p@0=Polygon@cp[{1,0},5];. (BTW I'm actually Peter, I've got two profiles lol). \$\endgroup\$ – DumpsterDoofus Dec 27 '15 at 3:42
  • \$\begingroup\$ Yes! Good call. I spotted the typo, too, but forgot to fix it. D'oh, \$\endgroup\$ – hYPotenuser Dec 27 '15 at 3:43
4
\$\begingroup\$

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

I use a similar technique to njpipeorgan's answer (in fact I stole his 2Pi I/5 == Pi.4I trick), but implemented as a recursive function.

Example usage (using % to access the anonymous function that was output on the last line):

 %[5]

enter image description here

| improve this answer | |
\$\endgroup\$
2
\$\begingroup\$

Wolfram Language (Mathematica), 96 90 84bytes

Region@Polygon@ReIm@Nest[Join[Tr/@Tuples@{.62p,t=.39#},-t]&,{p=(-1)^(.4Range@5)},#]&

enter image description here

| improve this answer | |
\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.