A program finds 16 sequences of discards that work:
3 11 7 7 12 2 9 5 5 9 2 12 8 6 4 10 10 4 6 8 2 12 8 6 5 9 11 3 7 7 3 11 9 5 1 13 13 1 10 4 3 11 4 10 12 2 6 8 1 13 13 1
3 11 7 7 12 2 9 5 5 9 2 12 8 6 4 10 10 4 6 8 12 2 8 6 5 9 11 3 7 7 3 11 9 5 1 13 13 1 10 4 3 11 4 10 12 2 6 8 1 13 13 1
3 11 7 7 12 2 9 5 5 9 2 12 8 6 10 4 10 4 6 8 2 12 8 6 5 9 11 3 7 7 3 11 9 5 1 13 13 1 10 4 3 11 4 10 12 2 6 8 1 13 13 1
3 11 7 7 12 2 9 5 5 9 2 12 8 6 10 4 10 4 6 8 12 2 8 6 5 9 11 3 7 7 3 11 9 5 1 13 13 1 10 4 3 11 4 10 12 2 6 8 1 13 13 1
3 11 7 7 12 2 9 5 5 9 12 2 8 6 4 10 10 4 6 8 2 12 8 6 5 9 11 3 7 7 3 11 9 5 1 13 13 1 10 4 3 11 4 10 12 2 6 8 1 13 13 1
3 11 7 7 12 2 9 5 5 9 12 2 8 6 4 10 10 4 6 8 12 2 8 6 5 9 11 3 7 7 3 11 9 5 1 13 13 1 10 4 3 11 4 10 12 2 6 8 1 13 13 1
3 11 7 7 12 2 9 5 5 9 12 2 8 6 10 4 10 4 6 8 2 12 8 6 5 9 11 3 7 7 3 11 9 5 1 13 13 1 10 4 3 11 4 10 12 2 6 8 1 13 13 1
3 11 7 7 12 2 9 5 5 9 12 2 8 6 10 4 10 4 6 8 12 2 8 6 5 9 11 3 7 7 3 11 9 5 1 13 13 1 10 4 3 11 4 10 12 2 6 8 1 13 13 1
11 3 7 7 12 2 9 5 5 9 2 12 8 6 4 10 10 4 6 8 2 12 8 6 5 9 11 3 7 7 3 11 9 5 1 13 13 1 10 4 3 11 4 10 12 2 6 8 1 13 13 1
11 3 7 7 12 2 9 5 5 9 2 12 8 6 4 10 10 4 6 8 12 2 8 6 5 9 11 3 7 7 3 11 9 5 1 13 13 1 10 4 3 11 4 10 12 2 6 8 1 13 13 1
11 3 7 7 12 2 9 5 5 9 2 12 8 6 10 4 10 4 6 8 2 12 8 6 5 9 11 3 7 7 3 11 9 5 1 13 13 1 10 4 3 11 4 10 12 2 6 8 1 13 13 1
11 3 7 7 12 2 9 5 5 9 2 12 8 6 10 4 10 4 6 8 12 2 8 6 5 9 11 3 7 7 3 11 9 5 1 13 13 1 10 4 3 11 4 10 12 2 6 8 1 13 13 1
11 3 7 7 12 2 9 5 5 9 12 2 8 6 4 10 10 4 6 8 2 12 8 6 5 9 11 3 7 7 3 11 9 5 1 13 13 1 10 4 3 11 4 10 12 2 6 8 1 13 13 1
11 3 7 7 12 2 9 5 5 9 12 2 8 6 4 10 10 4 6 8 12 2 8 6 5 9 11 3 7 7 3 11 9 5 1 13 13 1 10 4 3 11 4 10 12 2 6 8 1 13 13 1
11 3 7 7 12 2 9 5 5 9 12 2 8 6 10 4 10 4 6 8 2 12 8 6 5 9 11 3 7 7 3 11 9 5 1 13 13 1 10 4 3 11 4 10 12 2 6 8 1 13 13 1
11 3 7 7 12 2 9 5 5 9 12 2 8 6 10 4 10 4 6 8 12 2 8 6 5 9 11 3 7 7 3 11 9 5 1 13 13 1 10 4 3 11 4 10 12 2 6 8 1 13 13 1
The differences occur in four isolated pairs, so there's one basic solution with two alternative swaps of adjacent week at four spots, leading to these 2^4=16 sequences. Adding dates and having separate columns for the alternatives gives:
Date discard remaining alternative
count disc.remaining
Jan 8 3 361 11 353
Jan 15 11 350 3 350
Jan 22 7 343
Jan 29 7 336
Feb 5 12 324
Feb 12 2 322
Feb 19 9 313
Feb 26 5 308
Mar 5 5 303
Mar 12 9 294
Mar 19 2 292 12 282
Mar 26 12 280 2 280
Apr 2 8 272
Apr 9 6 266
Apr 16 4 262 10 256
Apr 23 10 252 4 252
Apr 30 10 242
May 7 4 238
May 14 6 232
May 21 8 224
May 28 2 222 12 212
Jun 4 12 210 2 210
Jun 11 8 202
Jun 18 6 196
Jun 25 5 191
Jul 2 9 182
Jul 9 11 171
Jul 16 3 168
Jul 23 7 161
Jul 30 7 154
Aug 6 3 151
Aug 13 11 140
Aug 20 9 131
Aug 27 5 126
Sep 3 1 125
Sep 10 13 112
Sep 17 13 99
Sep 24 1 98
Oct 1 10 88
Oct 8 4 84
Oct 15 3 81
Oct 22 11 70
Oct 29 4 66
Nov 5 10 56
Nov 12 12 44
Nov 19 2 42
Nov 26 6 36
Dec 3 8 28
Dec 10 1 27
Dec 17 13 14
Dec 24 13 1
Dec 31 1 0
The remaining count columns have been split into two, for alternate weeks, for more easily seeing the ones that match the remaining days of the year from those that need to be palindromes, squares or cubes.
In all cases, the 6's were discarded April 9, May 14, June 18 and November 26.
The program was written to call recursively a subroutine that chose the next card that resulted in a palindrome/square/cube, and the following card, that had to be 14 minus the first. In the case of an ace, that had to be followed by two kings and another ace, in succession, so in all the recursion level got to 26 - 2 = 24. (Each pair of two kings do not add up to 14 themselves, and so one of each pair must be preceded by an ace and the other followed by an ace. The two such pairs of kings then use up all the aces.)
DECLARE SUB playCd (cNo!)
CLEAR , , 9999
DIM SHARED nLine(364), lMax
OPEN "deckcaln.txt" FOR OUTPUT AS #2
PRINT : PRINT
FOR i = 1 TO 364
ok = 0
n$ = LTRIM$(STR$(i))
good = 1
FOR j = 1 TO LEN(n$) / 2
IF MID$(n$, j, 1) <> MID$(n$, LEN(n$) + 1 - j) THEN good = 0: EXIT FOR
NEXT
IF good THEN
ok = 1
ELSE
tst = INT(SQR(i) + .5)
IF tst * tst = i THEN ok = 1
tst = INT(i ^ (1 / 3) + .5)
IF tst * tst * tst = i THEN ok = 1
END IF
IF ok THEN
PRINT i; : nLine(i) = 1
IF i > 26 THEN
IF nLine(i - 26) = 1 THEN PRINT "<==*** (\\"; i - 26; \\")\\";
END IF
NEXT
PRINT
DIM SHARED cct(13), played(52), ctRem
FOR i = 1 TO 13: cct(i) = 4: NEXT
ctRem = 364
playCd 1
CLOSE
DIM soln(1, 52)
OPEN "deckcaln.txt" FOR INPUT AS #1
DO
LINE INPUT #1, l$
FOR week = 1 TO 52
soln(sNo, week) = VAL(MID$(l$, week * 3 - 1, 2))
NEXT
IF sNo = 0 THEN
sNo = sNo + 1
ELSE
ctmm = 0
FOR i = 1 TO 52
IF soln(0, i) <> soln(1, i) THEN ctmm = ctmm + 1
NEXT
IF ctmm = 8 THEN EXIT DO
END IF
LOOP UNTIL EOF(1)
CLOSE
OPEN "deckcal2.txt" FOR OUTPUT AS #2
DIM moLen(12), moName$(12)
DATA 31,28,31,30,31,30,31,31,30,31,30,31
FOR i = 1 TO 12: READ moLen(i): NEXT
DATA Jan,Feb,Mar,Apr,May,Jun,Jul,Aug,Sep,Oct,Nov,Dec
FOR i = 1 TO 12: READ moName$(i): NEXT
mo = 1: da = 8
remain1 = 364: remain2 = 364
FOR week = 1 TO 52
PRINT moName$(mo); " ";
PRINT #2, moName$(mo); " ";
PRINT USING "## "; da;
PRINT #2, USING "## "; da;
PRINT USING " ##"; soln(0, week);
PRINT #2, USING " ##"; soln(0, week);
remain1 = remain1 - soln(0, week)
remain2 = remain2 - soln(1, week)
IF week MOD 2 = 1 THEN PRINT " ";
IF week MOD 2 = 1 THEN PRINT #2, " ";
PRINT USING " ###"; remain1;
IF week MOD 2 = 0 THEN PRINT " ";
PRINT #2, USING " ###"; remain1;
IF week MOD 2 = 0 THEN PRINT #2, " ";
IF soln(1, week) <> soln(0, week) THEN
PRINT USING " ##"; soln(1, week);
IF week MOD 2 = 1 THEN PRINT " ";
PRINT USING " ###"; remain2;
IF week MOD 2 = 0 THEN PRINT " ";
PRINT #2, USING " ##"; soln(1, week);
IF week MOD 2 = 1 THEN PRINT #2, " ";
PRINT #2, USING " ###"; remain2;
IF week MOD 2 = 0 THEN PRINT #2, " ";
END IF
PRINT
PRINT #2,
da = da + 7
IF da > moLen(mo) THEN da = da - moLen(mo): mo = mo + 1
NEXT
CLOSE
SUB playCd (cNo)
IF cNo > lMax THEN lMax = cNo
IF cct(1) THEN
IF nLine(ctRem - 1) AND nLine(ctRem - 27) THEN
played(cNo) = 1
played(cNo + 1) = 13
played(cNo + 2) = 13
played(cNo + 3) = 1
cct(1) = cct(1) - 2
cct(13) = cct(13) - 2
ctRem = ctRem - 28
IF cNo = 49 THEN
FOR j = 1 TO 52
PRINT USING " ##"; played(j);
PRINT #2, USING " ##"; played(j);
NEXT
PRINT
PRINT #2,
ELSE
playCd cNo + 4
END IF
cct(1) = cct(1) + 2
cct(13) = cct(13) + 2
ctRem = ctRem + 28
END IF
END IF
FOR i = 2 TO 12
IF cct(i) THEN
IF nLine(ctRem - i) THEN
played(cNo) = i
played(cNo + 1) = 14 - i
cct(i) = cct(i) - 1
cct(14 - i) = cct(14 - i) - 1
ctRem = ctRem - 14
IF cNo = 51 THEN
FOR j = 1 TO 52
PRINT USING " ##"; played(j);
PRINT #2, USING " ##"; played(j);
NEXT
PRINT
PRINT #2,
ELSE
playCd cNo + 2
END IF
cct(i) = cct(i) + 1
cct(14 - i) = cct(14 - i) + 1
ctRem = ctRem + 14
END IF
END IF
NEXT
END SUB
From Enigma No. 1455, Deck calendar, by Susan Denham, New Scientist, 11 August 2007. |