Hi Rick,
Many thanks for the inspiring blog post. Below I am attempting to combine your 2nd and 3rd suggestions from the end of the post. So I have modified your code to look for a random 'artwork' with no adjacent polygons of the same colour, that also uses all 16 of the pinwheels.
/* Rick's Code */
data Shape;
input ID x y @@;
datalines;
0 0 0 0 0.667 0.333 0 1 1 0 0 1 0 0 0
1 0 0 1 -0.333 0.667 1 -1 1 1 -1 0 1 0 0
2 0 0 2 -0.667 -0.333 2 -1 -1 2 0 -1 2 0 0
3 0 0 3 0.333 -0.667 3 1 -1 3 1 0 3 0 0
;
proc iml;
/* actions of the D4 dihedral group */
start D4Action(v, act);
/* the subroup of rotations by 90 degrees */
if act=0 then M = { 1 0, 0 1};
else if act=1 then M = { 0 -1, 1 0};
else if act=2 then M = {-1 0, 0 -1};
else if act=3 then M = { 0 1, -1 0};
/* the subgroup of reflections across horz, vert, or diagonals */
else if act=4 then M = {-1 0, 0 1};
else if act=6 then M = { 0 -1, -1 0};
else if act=7 then M = { 1 0, 0 -1};
else if act=5 then M = { 0 1, 1 0};
return( v*M` ); /* = (M*z`)` */
finish;
/* read in the pinwheel shape */
use Shape; read all var {x y} into P1;
read all var "ID"; close;
/* Modifying Rick's code below to output all 16 pinwheels.
Define ID2 where the odd colour numbers are switched */
ID2 = ID;
do i = 1 to 20;
if mod(ID2[i], 2)=1 then ID2[i] = 4 - ID2[i];
end;
/* write out the transformation of the pinwheel under the D4 actions */
OpNames = {"I" "R1" "R2" "R3" "S0" "S1" "S2" "S3",
"ZI" "ZR1" "ZR2" "ZR3" "ZS0" "ZS1" "ZS2" "ZS3"};
Name = OpNames[1];
Q = {. . .};
create Panel from Name Q[c={'Name' 'ID' 'x' 'y'}];
do j = 1 to 2;
do i = 0 to 7;
R = D4Action(P1, i);
if j=1 then Q = ID || R; else Q=ID2 || R;
Name = j(nrow(Q), 1, OpNames[j,i+1]);
append from Name Q;
end;
end;
close;
QUIT;
/* get colour by quadrant for each of the 16 pinwheels
Q4|Q1
-----
Q3|Q2
*/
data quadrant_col;
set Panel(where=( (abs(x) + abs(y)) = 2 ));
if x=1
then if y>0 then quad=1; else quad=2;
else if y>0 then quad=4; else quad=3;
drop x y;
run;
proc sort; by Name quad; run;
proc transpose data=quadrant_col out=quadrant_col(drop=_:) prefix=Q;
var ID;
by Name;
id quad;
run;
proc iml;
start grid_eval(x) global(c_LR, c_TB);
/* return the number of adjacent same coloured polygons in a grid of pinwheels */
nr = nrow(x);
nc = ncol(x);
count = 0;
if nc>1 then do i = 1 to nr; do j = 1 to nc-1;
count = count + c_LR[ x[i,j], x[i,j+1] ];
end; end;
if nr>1 then do i = 1 to nr-1; do j = 1 to nc;
count = count + c_TB[ x[i,j], x[i+1,j] ];
end; end;
return(count);
finish;
use quadrant_col;
read all var _num_ into q;
use Panel;
read all var {ID x y} into pdata;
/* create two matrices that count the number of same coloured polygons next to each other
when 2 pinwheels are either side by side (row indexes left pinwheel, col indexes right
pinwheel) or when stacked on top of each other (row indexes top pinwheel, col indexes
bottom pinwheel) */
c_LR = j(16, 16, .);
c_TB = j(16, 16, .);
do i = 1 to 16; do j = 1 to 16;
c_LR[i, j] = sum( q[i,{1 2}] = q[j,{4 3}]);
c_TB[i, j] = sum( q[i,{3 2}] = q[j,{4 1}]);
end; end;
/* start with a random assignment of 16 pinwheels to a 4x4 grid */
g = shape(ranperm(16), 4, 4);
cc = grid_eval( g );
/* consider swaps of one pinwheel for another that might improve the artwork. Use
matrix b to keep a list for each cycle of swaps that give the best improvement */
b = j(100, 2);
do cycle = 1 to 200 until(cc=0);
bestcc = 1E20; /* best cc this cycle */
do i = 1 to 15; do j = i+1 to 16;
h = g;
h[i] = g[j];
h[j] = g[i];
newcc = grid_eval( h );
if newcc<=bestcc then do;
if newcc<bestcc then do;
bestcc=newcc;
nb = 0;
end;
nb = nb + 1;
b[nb, 1] = i;
b[nb, 2] = j;
end;
end; end;
/* choose a swap at random from those in b */
swap = 1 + floor(rand('uniform')#nb);
besti = b[swap,1];
bestj = b[swap,2];
t = g[besti];
g[besti] = g[bestj];
g[bestj] = t;
cc = bestcc;
end;
reset noname;
if cc=0 then print 'Found grid with no adjacent same colour polygons after' cycle [format=3.0] 'swaps';
else print 'Optimal arrangement was not found!';
print g [format=2.0];
Q = {. . . .};
create OptPanel from Q[c={'Cell' 'ID' 'x' 'y'}];
do i = 1 to 16;
/* work out which rows of panel data correspond to ith pinwheel in g */
ridx = ( 20#(g[i]-1) + 1) : (20#g[i]);
Q = j(20,1,i) || pdata[ridx, ];
append from Q;
end;
quit;
/* Show the artwork */
%let teal = CX288c95;
%let orange = CXeba411;
%let blue = CX0f5098;
%let salmon = CXd5856e;
%let gray = CX929386;
ods graphics / width=500px height=500px;
/* for convenience, define macros for the COLAXIS and ROWAXIS options */
%macro colOpts; colaxis offsetmin=0 offsetmax=0 display=(nolabel noticks novalues); %mend;
%macro rowOpts; rowaxis offsetmin=0 offsetmax=0 display=(nolabel noticks novalues); %mend;
title 'Random Shadow';
proc sgpanel data=OptPanel noautolegend;
styleattrs wallcolor=&gray datacolors=(&teal &orange &blue &salmon);
panelby Cell / columns=4 onepanel noheader noborder;
polygon x=x y=y ID=ID / group=ID fill;
%colOpts; %rowOpts;
run;
... View more
