Wolfram Cloud Document

One of my daily routines is solving A-Puzzle-A-Day by DragonFjord over coffee in the morning. This unique and addictive puzzle is designed to provide a new challenge every day of the year. It consists of a calendar board and eight distinct pieces that you must place together to leave one specific month and day visible, corresponding to the date you’re solving for - like today’s date, a birthday, or a favorite holiday.

I can sometimes solve it before my coffee gets cold, but other times I struggle. So, I tried solving it with Wolfram Language.

https://www.dragonfjord.com/product/a-puzzle-a-day-acrylic/

Create board

Create a calendar board. It can create any date from January 1st to December 31st.

The top two lines represent the month and the five lines below represent the day.

In[]:=

(*initialboard*)initialboard=ReplacePart[ConstantArray[0,{7,7}],{{1,7},{2,7},{7,4},{7,5},{7,6},{7,7}}->1];initialboard//MatrixForm

Out[]//MatrixForm=

0	0	0	1
0	0	0	1
0	0	0	0
0	0	0	0
0	0	0	0
0	0	0	0
1	1	1	1

The above matrix represents a board in the following state, where no piece has yet been placed.

The board for 14 March is as follows.

In[]:=

(*adayboard*)dayboard[m_,d_]:=Block[{mpos,dpos},mpos=QuotientRemainder[m-1,6]+{1,1};dpos=QuotientRemainder[d-1,7]+{3,1};ReplacePart[initialboard,{mpos,dpos}->1]];dayboard[3,14]//MatrixForm

Out[]//MatrixForm=

1	0	0	0	1
0	0	0	0	1
0	0	0	0	0
0	0	0	0	1
0	0	0	0	0
0	0	0	0	0
0	1	1	1	1

Create pieces

Create eight distinct pieces. Assign a colour to each piece.

In[]:=

colors={Blue,Darker[Green,.5],Orange,Red,Magenta,Green,Cyan,Yellow}

Out[]=

{

}

Create eight distinct pieces. The pieces can be rotated 90, 180 or 270 degrees in orientation or turned inside out, giving up to eight different ways to place them.

In[]:=

createpieces[base_List]:=Block[{p7x7,p7x7rotates,p7x7reverses,p7x7s,compacts,pieces},p7x7=ReplacePart[ConstantArray[0,{7,7}],(base+Threaded@{1,1})->1];p7x7rotates=NestList[rotateMatrix90,p7x7,3];p7x7reverses=(Reverse/@#)&/@p7x7rotates;p7x7s=Join[p7x7rotates,p7x7reverses];compacts=compact/@p7x7s;pieces=getposition/@compacts;DeleteDuplicates@pieces];piecescnt=8;rotateMatrix90[matrix_List]:=Reverse/@Transpose[matrix];getposition[list_List]:=Position[list,1]-Threaded[{1,1}];compact[matrix_List]:=Block[{rows,cols,nonZeroPositions},nonZeroPositions=Position[matrix,_?(#!=0&)];rows=Union[nonZeroPositions[[All,1]]];cols=Union[nonZeroPositions[[All,2]]];matrix[[rows,cols]]];showpiece[p_List,col_]:=Block[{comp,plot},comp=compact@ReplacePart[ConstantArray[0,{7,7}],(#+Threaded@{1,1})->1]&/@p;plot=ArrayPlot[#,ColorRules->{1->col},Frame->False,PlotRangePaddingNone]&/@comp;Row[plot,Frame->All]];

For example, a rectangular-shaped piece can be placed in the following two patterns.

In[]:=