github.com/retro-software.B5500-software
1
0
Fork 0
mirror of https://github.com/retro-software/B5500-software.git synced 2026-04-29 21:17:05 +00:00
Code Issues Releases Wiki Activity

Commit new Sudoku solver program and RC documentation update.

Browse Source 
1. Commit Sudoku solver program from Paul Cumberworth.
2. Replace RC reference document with version generated from CUBE13
library files
This commit is contained in:
Paul Kimpel
2019-03-24 14:14:06 -07:00
parent 13642bcfdd
commit e24ebe2110
6 changed files with 3544 additions and 1446 deletions
Download Patch File Download Diff File Expand all files Collapse all files

148
RC-Ron-Brody/RC-Reference.txt
View File

@@ -1,3 +1,23 @@
LABEL 000000000LINE 00188158?EXECUTE XREF/JONES XREF /JONES
XREF PROGRAM OF 3DC70 THIS LISTING PRODUCED 6 JUN 1988 TIME 7.59
$ DISK SIX DOCONLY DOCUMENT FINAL
CARD FILE IS CARD /0000000
SOURCE FILE IS TEACHER/0000094
@@ -42,7 +62,6 @@
BY
@@ -57,7 +76,6 @@
PAGE 1
INTRODUCTION
@@ -182,7 +200,7 @@
------- ------ -------- ----------
FOR LOGGING-IN TO A TELETYPEWRITER, PRESS THE "ORGI" BUTTON,
FOR LOGGING-IN TO A TELETYPEWRITER, PRESS THE "ORIG" BUTTON,
WAIT FOR A DIAL TONE FROM THE SPEAKER, AND DIAL THE COMPUTER
NUMBER. THE B5500 RESPONDS WITH THE MESSAGE:
@@ -248,7 +266,7 @@
<R/C VERSION NUMBER>
HELLO <USERCODE.
HELLO <USERCODE>
:
@@ -264,7 +282,7 @@
OR IF NO FILE IS OPEN
<R/C> VERSION NUMBER>
<R/C VERSION NUMBER>
HELLO+<USERCODE>
:
@@ -278,7 +296,7 @@
VERSION #
HELLO BLUM
HELLO BLUM
:
@@ -299,7 +317,7 @@
THIS SEQUENCE INDICATES THAT R/C REMEMBERS THE USERS
STATE FROM THE PREVIOUS RUN. THE STATE INDICATES THE
STATE FROM THE PREVIOUS RUN. THE STATE INCLUDES THE
INCREMENT VALUE, TAB AMOUNT, SAVE FACTOR, PERCENT ON-OFF,
AND VERB REPLACEMENTS.
@@ -415,14 +433,14 @@
PAGE 7
-
100:THE7IS IT~
100:THE7IS IS IT~
-
100:THESE777IS IS IT~
---
IF, AFTER BACKSPACING AND LINE ERASING, THE INPUT LINE
CONTAINS MORE THEN 240 CHARACTERS, THE INPUT IS DISCARDED WITH AN
CONTAINS MORE THAN 240 CHARACTERS, THE INPUT IS DISCARDED WITH AN
"INPUT OVERFLW" ERROR MESSAGE. DATA RECORDS ARE ALSO DISCARDED
(WITH THE ERROR MESSAGE) IF THEY ARE TOO LARGE FOR THE FILE. (I.
E. GTR 66 FOR COBOL FILES; GTR 80 FOR DATA FILES; AND GTR 72 FOR
@@ -444,7 +462,7 @@
IF A USER PRODUCES NO INPUT FOR FIVE MINUTES, HE IS SENT THE
MESSAGE "LOOK ALIVE". IF HE DOES NOT RESPOND WITHIN ANOTHER FIVE
MINUTE PERIOD, R/C PROCESSES A "*END DS" FOR THAT USER.
MINUTE PERIOD, R/C PROCESSES A "* END DS" FOR THAT USER.
R/C OUTPUT
@@ -453,7 +471,7 @@
OUTPUT TO THE TELETYPEWRITER OF THE SPECIAL CHARACTERS ~, !,
<, {, >, AND } IS REPLACED BY A "$" CHARACTER IN ORDER THAT THEY
DO NOT EVOKE TELETYPEWRITER CONTROL FUNCTIONS WITH WHICH THEY ARE
DO NOT EVOKE TELETYPWRITER CONTROL FUNCTIONS WITH WHICH THEY ARE
ASSOCIATED. (THESE INCLUDE LINE-FEED, CARRIAGE-RETURN, MESSAGE-
END, AND PAPER-TAPE-ON.)
@@ -663,7 +681,7 @@
THE FILE <FILE-NAME> WHICH THE USER IS TRYING TO OPEN
IS NOT BLOCKED CORRECTLY. THE CORRECT BLOCKING IS 10-WORD
RECORDS WITH MULTIPLE OF 3 RECORDS PER BLOCK.
RECORDS WITH A MULTIPLE OF 3 RECORDS PER BLOCK.
INV USER: <FILE-NAME>
@@ -677,7 +695,7 @@
FILE TOO LONG
THE USER IS TRYING TO OPEN A FILE WITH MORE THEN 8191
THE USER IS TRYING TO OPEN A FILE WITH MORE THAN 8191
RECORDS.
@@ -755,7 +773,7 @@
NO FILE OPEN: CLOSE
THERE IS NO OPEN FILE TO CLOSE
THERE IS NO OPEN FILE TO CLOSE.
@@ -882,6 +900,7 @@
PAGE 17
:* LIST LIBRARY/FILE 2,4~
2:PROCEDURE READDATA 567,653
3:PROCEDURE WRITEDATA 654,789
@@ -903,7 +922,6 @@
PAGE 18
@@ -928,8 +946,8 @@
- ----- ----------- --
* QUICK <FILE-NAME> <M>
- ----- ----------- ---
* QUICK <FILE-NAME> <M>
- ----- ----------- ---
* QUICK <FILE-NAME> <M> <N>
@@ -955,7 +973,7 @@
4500:* LIST 4300,4400~
4300: FOR I := A STEP -1 UNTIL 0 DO
4400: X [I] := SIN (Y) ;
4500:*QUICK -2 + 1~
4500:* QUICK -2, + 1~
4300: FOR I := A STEP -1 UNTIL 0 DO
4400: X [I] := SIN (Y) ;
4500:
@@ -998,7 +1016,7 @@
546:* REMOVE ANOTHER/FILE~
NO FILE: ANOTHER/FILE
546:
546:
:* OPEN EXAMPLE/X COBOL OLD~
46500* REMOVE EXAMPLE/X~
@@ -1042,7 +1060,7 @@
EXAMPLES:
:* OPEN TEST/CASE DATA;*PRINT TC DOUBLE;* CLOSE~
:* OPEN TEST/CASE DATA;* PRINT TC DOUBLE;* CLOSE~
:
THIS EXAMPLE ILLUSTRATES AN INSTANCE WHERE A SEQUENCED
@@ -1129,7 +1147,7 @@
- ------- ----------- ----------
COMPILES THE OPEN FILE USING SPECIFIED COMPILER.
COMPILES THE OPEN FILE USING THE SPECIFIED COMPILER.
EXAMPLES:
@@ -1206,7 +1224,7 @@
9300: REL. ADDR. = 35.
:* LISTING ALGOL ERRORS~
WAIT...
7800:ERROR 100 I,
7800:ERROR 100 I.
:
8900:* LISTING~
@@ -1244,7 +1262,7 @@
COPIES THE OPENED FILE CREATING <FILE-NAME> AND ZIPS
<FILE-NAME>. NOTE THIS "ZIP" CONSTRUCT DOES NOT DESTROY THE
OPEN FILE AS DOES THE FIRST FORM.
OPEN FILE, AS DOES THE FIRST FORM.
EXAMPLES:
@@ -1256,7 +1274,7 @@
300:%% DATA CARD.~
400:$ DISK SIX DOCONLY DOCUMENT FINAL~
500:@99999999~
600%% END.~
600:%% END.~
700:* ZIP TEMP/NAME~
WAIT...
700:
@@ -1371,7 +1389,7 @@
400:FOUR
500:TWO
600:THREE
700:*DITTO 200,300 MOVE;*LIST~
700:* DITTO 200,300 MOVE;*LIST~
100:ONE
400:FOUR
500:TWO
@@ -1506,12 +1524,12 @@
- ------
* INLINE <M> <EDIT CHAR>
- ------ --- ----- -----
* INLINE <M> <EDIT CHR>
- ------ --- ----- ----
* INLINE <EDIT CHAR>
- ------ ----- -----
* INLINE <EDIT CHR>
- ------ ----- ----
THIS SETS UP LINE <M> FOR INLINE EDITING. IF THE SEQUENCE
@@ -1696,8 +1714,8 @@
CHANGE" VERB.
* CHANGE <STRING> TO <STRING>
- ------ -------- -- --------
* CHANGE <STRING> TO <STRING>
- ------ -------- -- --------
SCANS THE CURRENT RECORD REPLACING EVERY OCCURRENCE OF
@@ -1754,7 +1772,7 @@
00005300:
8700:* -CHANGE -1 .TWX.@25-30 TO "TELETYPWRITER"~
8600: THE OUTPUT IS TYPED ON THE TELETYPWRITER IF
8600: THE OUPUT IS TYPED ON THE TELETYPWRITER IF
00008600:
450:* CHANGE 232, 448 "IMAGE [I]" TO (Z [J])~
@@ -1868,11 +1886,11 @@
RECORD FORMATTING (EDIT)
------ ---------- ------
RECORD FORMATING (EDIT)
------ --------- ------
RECORDS MAY BE FORMATTED BY THE FOLLOWING CONSTRUCTS:
RECORDS MAY BE FORMATED BY THE FOLLOWING CONSTRUCTS:
* EDIT <M>, <N>: <F>
@@ -1906,7 +1924,7 @@
THE EDIT ECHO IS ON. (IT IS INITIALLY OFF.) THE ABOVE
COMMANDS ARE USED TO SET THE ECHO AND TO PRINT ITS CURRENT
SETTING. IT SETTING MAY BE REVERSED FOR A COMMAND BY
PREFIXING THE EDIT WITH A -. (E.G. *- EDIT 200,800:2)
PREFIXING THE EDIT WITH A -. (E.G. *- EDIT 200,800:2.)
EXAMPLE:
@@ -2239,8 +2257,8 @@
- --- ---
*TAB
----
* TAB
- ---
THE TAB OPTION PERMITS THE USER (BY SETTING THE OPTION
@@ -2253,7 +2271,7 @@
EXAMPLE:
4500:* TAB~
4500:* TAB 5~
4500: BEGIN~
@@ -2349,7 +2367,7 @@
:COLUMN ON "#";* COLUMN 10 20 25;COLUMN~
COLUMN ON # 10 20 25
COLUMN ON # 10 20 25
:OPEN COLUMN/SHOW ALGOL NEW~
100:ABC#123#XYZ#IJK#789~
200:* LIST~
@@ -2413,7 +2431,7 @@
:* MAIL~
PLEASE SEE ME WHEN YOU GET A CHANCE-BALDWIN
THERE WILL NOT BE ANY REMOTE TIME 10/24/70-SYSTEM
:* MAIL TO BALDWIN:MY OFFICE - 10AM- FRIDAY~
:* MAIL TO BALDWIN:MY OFFICE- 10AM- FRIDAY~
PAGE 52
@@ -2480,11 +2498,11 @@
LEARNING ABOUT R/C ON THE TELETYPEWRITER (TEACH)
-------- ----- --- -- --- -------------- -------
LEARNING ABOUT R/C ON THE TELETYPWRITER (TEACH)
-------- ----- --- -- --- ------------- -------
THE TEACH VERB ALLOWS A USER AT THE TELETYPEWRITER TO LEARN
THE TEACH VERB ALLOWS A USER AT THE TELETYPWRITER TO LEARN
ABOUT THE R/C VERBS AND SPECIFICALLY WHAT VERBS HE MAY USE.
@@ -2556,7 +2574,7 @@
----- ---------
THE EXECUTE VERB GIVES R/C A SIMPLE MACRO CAPABILITY.
THE EXECUTE VERB GIVES R/C USERS A SIMPLE MACRO CAPABILITY.
* EXECUTE <SOURCE> <OPTIONAL PARAMETER LIST>
@@ -2620,7 +2638,7 @@
THE <MACRO LIBRARY> IS "MACRO" AND ANY OTHER NAME
DESIGNATED THRU THE
DESIGNATED THRU THE * EXECUTE LIBRARY = <NAME> COMMAND.
EXAMPLES:
@@ -2687,7 +2705,7 @@
THE FILES SHOULD BE LOADED USING THE CONTROL DECK:
? LOAD FROM RC RCSYS94/RON,TEACHER/0000094,XREF/JONES.
? LOAD FROM RC RCSY94/RON,TEACHER/0000094,XREF/JONES.
? END.
@@ -2701,6 +2719,7 @@
? CORE = 2800. = 2500 + 100 | MAXUSERS.
? PRIORITY = 1.
? DATA
$ TAPE
99999999
? END.
@@ -2709,9 +2728,9 @@
A- 2
WHEN PATCHES ARE ISSUED THEY SHOULD BE PLACED AFTER THE "$
TAPE" CARD AND R/C SHOULD BE RECOMPILED.
@@ -2720,15 +2739,15 @@
3 IN RCSY94/RON. TO INCREASE THE NUMBER, A PATCH CARD MUST BE
ADDED. AS AN EXAMPLE, THE FOLLOWING CARD SHOULD BE ADDED TO
INCREASE THE MAXIMUM NUMBER OF USERS TO 5.
DEFINE MAXUSERS = 5#, MAXUSER =4# ; 00002500
DEFINE MAXUSERS = 5#, MAXUSER =4# ; 00002500
THE OUTPUT BUFFERS ARE DEFINED TO BE 56 CHARACTERS IN
RCSY94/RON. THEY MAY BE SET AT 28 CHARACTERS USING THE FOLLOWING
PATCH CARDS:
DEFINE CHRSPERBUFFER = 28#, % OR 56 00002600
WORDSPERBUFFER = 5#, % OR 8 00002700
WRDSPERBUFFER = 4# ; % OR 7 00002800
DEFINE CHRSPERBUFFER = 28#, % OR 56 00002600
WORDSPERBUFFER = 5#, % OR 8 00002700
WRDSPERBUFFER = 4# ; % OR 7 00002800
TEACHER/0000094 IS AN AUXILIARY FILE USED BY R/C. IT IS
@@ -2751,10 +2770,9 @@
PATCHES TO R/C AND THE TEACHER FILE WILL BE ISSUED THRU CUBE.
RATHER THAN PATCH DECKS, NEW SYMBOL FILES WILL BE INCLUDED ON THE
CUBE TAPE. THE SEQUENCE NUMBERS WILL REMAIN THE SAME EXCEPT IN
THE PATCHED AREA.
RATHER THAN PATCH DECKS, NEW SYMBOLIC FILES WILL BE INCLUDED ON
THE CUBE TAPE. THE SEQUENCE NUMBERS WILL REMAIN THE SAME EXCEPT
IN THE PATCHED AREA.
@@ -2791,7 +2809,7 @@
* COLUMN <OPTIONAL STRING>
* COLUMN ON <OPTIONAL STRING>
* COLUMN OFF <OPTIONAL STRING>
* COLUMN <STOP-1> <STOP-2> <STOP-3> <STOP-4> <OPTIONAL STRING>
* COLUMN <STOP-1> <STOP-2> <STOP-3> <STOP-4> <OPTIOANL STRING>
* COMPILE <OBJECT FILE-NAME>
* COMPILE <OBJECT FILE-NAME> <COMPILER>
* COPY <FILE-NAME>
@@ -2902,7 +2920,7 @@
* QUICK <SEQ NUMBER>
* QUICK <START SEQ NUMBER> <END SEQ NUMBER>
* REMOVE <FILE-NAME>
* REPLACE <OLD-VERB> : <NEW-VERB>
* REPLACE <OLD VERB> : <NEW VERB>
* RESEQ
* RESEQ <INCREMENT>
* RESEQ <START SEQ NUMBER> <END SEQ NUMBER>
@@ -2934,7 +2952,7 @@
*-SCAN <FILE-NAME>
*-SCAN <FILE-NAME> <START RECORD NUMBER>
*-SCAN <FILE-NAME> <START RECORD NUMBER> <END RECORD NUMBER>
* TAB <COLUMN-NUMBER>
* TAB <COLUMN NUMBER>
* TAB + <OFF-SET NUMBER>
* TAB - <OFF-SET NUMBER>
* TAB ON
@@ -2983,7 +3001,7 @@ RECORD HANDLING VERBS . . . . . . . . . . . . . . . . . . . . . PAGE 25
STRINGS. . . . . . . . . . . . . . . . . . . . . . . . . . PAGE 33
CHANGING THE OCCURRENCE OF A STRING (CHANGE) . . . . . . . PAGE 34
SCANNING FOR OCCURRENCE OF A STRING (SCAN) . . . . . . . . PAGE 36
RECORD FORMATTING (EDIT) . . . . . . . . . . . . . . . . . PAGE 38
RECORD FORMATING (EDIT). . . . . . . . . . . . . . . . . . PAGE 38
RESEQUENCING RECORD NUMBERS (RESEQ). . . . . . . . . . . . PAGE 39
DELETION OF RECORDS (DELETE) . . . . . . . . . . . . . . . PAGE 40
OPERATIONAL COMMANDS. . . . . . . . . . . . . . . . . . . . . . PAGE 41
@@ -2996,10 +3014,18 @@ OPERATIONAL COMMANDS. . . . . . . . . . . . . . . . . . . . . . PAGE 41
AUXILIARY COMMANDS. . . . . . . . . . . . . . . . . . . . . . . PAGE 50
MESSAGES TO OTHERS (MAIL). . . . . . . . . . . . . . . . . PAGE 51
HOW TO DETACH YOURSELF FROM R/C (END). . . . . . . . . . . PAGE 52
LEARNING ABOUT R/C ON THE TELETYPEWRITER (TEACH) . . . . . PAGE 53
LEARNING ABOUT R/C ON THE TELETYPWRITER (TEACH). . . . . . PAGE 53
MACRO VERB. . . . . . . . . . . . . . . . . . . . . . . . . . . PAGE 54
MACRO (EXECUTE). . . . . . . . . . . . . . . . . . . . . . PAGE 55
APPENDIX A. . . . . . . . . . . . . . . . . . . . . . . . . . . A- 1
R/C SOURCE TAPE . . . . . . . . . . . . . . . . . . . . . . . . A- 1
APPENDIX B. . . . . . . . . . . . . . . . . . . . . . . . . . . B- 1
R / C USER-S GUIDE. . . . . . . . . . . . . . . . . . . . . . . B- 1
LABEL 000000000LINE 00188158?EXECUTE XREF/JONES XREF /JONES

6
RC-Ron-Brody/README.txt
View File

@@ -34,7 +34,10 @@ of the source was done by Paul Kimpel.
The transcriptions have now been renamed and moved under the respective
files extracted from the CUBEB13 tape so that they will appear in the
versioned history of those files.
versioned history of those files:
RCSY94.RON.alg_m to CUBE-Library-13/Files/RCSY94.Z100006.alg
TEACHER.0000094.txt_m to CUBE-Library-13/Files/TEACHER-0000094.dat
RC-Compile.card
@@ -89,4 +92,3 @@ __________
text file.
2018-05-26 Paul Kimpel
Rename and move transcribed files under /CUBE-Library-13.

28
Sudoku-Paul-Cumberworth/README.txt Normal file
View File

@@ -0,0 +1,28 @@
Sudoku Solver: Paul Cumberworth
B5500 programs to solve Sudoku puzzles by Paul Cumberworth. He says this
about them:
"It is still a little ragged around the edges - it is a port of the
one from Michael Mahon's website. I've also just got it running on
the Elliott 803 emulator from Tom Sawyer, and I have passed it on to
Peter Onion to try on the his emulator and maybe the Bletchley Park
Elliott 803."
There are two programs, one in Extended Algol that uses a stream
procedure to count the bits in a word, and one in XALGOL (Compatible
Algol) that uses bit-wise Boolean logic. Otherwise, the two programs are
currently identical.
Soduku-Solver-List.lst
Text file listing of the XALGOL version of the program
Sudoku-Solver.card
Source compile deck for the XALGOL version of the program.
Proofing-Tools/PDF-Listing-Column-Ruler-ISO-A4.pdf
Source compile deck for the Extended Algol/stream procedure version
of the program.
March 2019

1236
Sudoku-Paul-Cumberworth/Soduku-Solver-List.lst Normal file
View File

File diff suppressed because it is too large Load Diff

402
Sudoku-Paul-Cumberworth/Sudoku-Solver-SP.card Normal file
View File

@@ -0,0 +1,402 @@
?COMPILE SUDOKU/TEST WITH ALGOL GO
?ALGOL FILE LINE = LINE/SUDOKU PRINT BACK UP DISK
?STACK = 5000
?DATA CARD
%CARD STACK SEG PRT LIST SINGLE DEBUGN
$LIST PRT STACK SINGLE
% SUDOKU SOLVER
% ORIGINALLY WRITTEN IN C BY SCOTT HEMPHILL AND PLACED IN
% THE PUBLIC DOMAIN 5 SEPTEMBER 2005
% CONVERTED TO B5500 BY PAUL C JULY 2018
% MAKE SURE STACK SET TO AT LEAST 5000 WORDS TO COPE WITH RECURSION
BEGIN
BOOLEAN
FINDMULTIPLE; % FIND MULTIPLE SOLUTIONS (SET COMMON = 1 IN CC)
INTEGER
NUM, % COUNT OF NUMBER OF SOLUTIONS FOUND
CURDEPTH, % CURRENT RECURSION DEPTH
MAXDEPTH, % MAXIMUM RECURSION DEPTH
STARTET; % TIME(1) OF WHEN WE STARTED
INTEGER ARRAY
BITNO[0:11], % ALLOW FOR 12 BITS, ONLY USE 9 THOUGH
GRID [0:80], % THE PUZZLE GRID: 1 THRU 9, OR 0 IF NO NUMBER YET
BITS [0:80], % BITMAP OF EACH SQUARE: BIT SET => NOT POSSIBLE
% I.E. 3"001" => !1, 3"002" => !2, 3"004" => !3,
% 3"010" => !4, ... 3"400" => !9.
COUNT [0:511], % BIT COUNT FOR EACH NUMBER
OTHERSARY [0:80, 0:19];
DEFINE OTHERS(X,Y) =
OTHERSARY[X,Y] #; % MAKE IT EASIER TO OPTIMISE LATER
% FOR EACH SQUARE, AN ARRAY OF 20 "OTHER"
% LOCATIONS AFFECT BY THIS SQUARE. FOR
% EXAMPLE, IF THERE IS A "6" IN SQUARE 0,
% THERE ARE 20 OTHER SQUARES WE KNOW
% CANT CONTAIN A SIX:
% 1,2,3,4,5,6,7,8 (HORIZONTAL ROW)
% 9,18,27,36,45,54,63,72 (VERTCAL COLUMN)
% 1,2,9,10,11,18,19,20 (3X3 SQUARE)
% THATS A TOTAL OF 24 SQUARE NUMBERS,
% BUT 4 OF THEM ARE DUPLICATES. THE
% "OTHERS" ARRAY IS BIG ENOUGH TO HOLD
% 24 NUMBERS WHILE IT IS BEING BUILT, BUT
% WILL ONLY 20 NUMBERS WILL BE USED WHEN
% IT IS COMPLETE.
FILE CARD (2,10,150);
FILE SPO 11 (1,10);
FILE LINE 15 (1,15); % 15, 17 IS PRINTER BACKUP DISK
INTEGER STREAM PROCEDURE ONES32(I);
%---------------------------
VALUE I;
BEGIN
SI:= LOC I;
SI:= SI+2;
SKIP 4 SB;
32(IF SB THEN TALLY:= TALLY+1; SKIP SB);
ONES32:= TALLY;
END;
PROCEDURE SETBOX(N, X, BIT);
%---------------------------
VALUE N, X, BIT; INTEGER N, X, BIT;
% "SETBOX" IS USED TO PLACE A NUMBER IN THE GRID, WHETHER IT IS KNOWN,
% OR A GUESS. IT ALSO UPDATES ALL THE BITMASKS FOR ALL THE ASSOCIATED
% SQUARES TO INDICATE THAT THEY CANT CONTAIN THIS NUMBER.
BEGIN
INTEGER I;
GRID[N]:= X;
FOR I:= 0 STEP 1 UNTIL 19 DO
BITS[OTHERS(N,I)]:= REAL(BOOLEAN(BITS[OTHERS(N,I)]) OR
BOOLEAN(BIT));
END;
PROCEDURE READGRID;
%------------------
% READ IN INITIAL DATA
% THE INITIAL BITMASK IS CALCULATED AT THE SAME TIME BY CALLING SETBOX
BEGIN
INTEGER I, J;
ALPHA ARRAY AIN[0:2];
POINTER P;
FOR I:= 0 STEP 1 UNTIL 8 DO % 9 ROWS OF 9 NUMBERS
BEGIN
READ(CARD, 3, AIN[*]);
P:= POINTER(AIN[0]);
FOR J:= 0 STEP 1 UNTIL 8 DO
BEGIN
SETBOX(9 | I + J, INTEGER(P,1),
BITNO[INTEGER(P,1)]); % SET BITNO, LSB=BIT0
P:= P + 1;
END;
END;
%WRITE OUT WHAT WE GOT!
WRITE(LINE, <"WE STORED IN GRID:">);
FOR I:= 0 STEP 1 UNTIL 8 DO
WRITE(LINE, <9I1>, FOR J:= 0 STEP 1 UNTIL 8 DO GRID[9|I+J]);
%CHECK FOR CONSISTENCY
FOR I:= 0 STEP 1 UNTIL 80 DO
IF GRID[I] > 0 THEN
IF REAL(BOOLEAN(BITS[I]) AND BOOLEAN(BITNO[GRID[I]])) > 0 THEN
BEGIN
WRITE(LINE, <"INCONSISTENT DATA IN ",I1,",",I1>,
(I DIV 9)+1, (I MOD 9) + 1);
J:= 1/0;
END;
END;
PROCEDURE PRINTSOLUTION;
%-----------------------
BEGIN
INTEGER I, J;
NUM:= NUM + 1;
IF NUM > 1 THEN
WRITE(LINE, <" ">); % BLANK
WRITE(LINE,<"SOLUTION ",I3,":">, NUM);
FOR I:= 0 STEP 1 UNTIL 8 DO
WRITE(LINE, <9I1>, FOR J:= 0 STEP 1 UNTIL 8 DO GRID[9|I+J]);
END;
PROCEDURE SELECTBOX;
%-------------------
% "SELECTBOX" IS THE HEART OF THE ALGORITHM. IT WORKS THIS WAY:
% FIRST, THE GRID IS SEARCHED FOR AN EMPTY SQUARE. IF THERE ISNT ONE,
% THEN THE GRID CONTAINS A SOLUTION, SO IT IS PRINTED. IF AN EMPTY
% SQUARE IS FOUND, THEN IT IS COMPARED WITH ALL OTHER EMPTY SQUARES TO
% SEE WHICH ONE OF THEM HAS THE MAXIMUM NUMBER OF 1-BITS IN ITS BITMASK.
% THAT SQUARE IS THE ONE SELECTED, AND EACH OF THE POSSIBLE VALUES ARE
% TRIED IN RETURN, CALLING "SELECTBOX" RECURSIVELY TO SEARCH FOR A
% SOLUTION. NOTE THAT IF A SQUARE HAS 9 1-BITS IN ITS BITMASK, THEN
% THERE ARE NO POSSIBLE VALUES, AND "SELECTBOX" WILL RETURN WITHOUT ANY
% FURTHER RECURSION. OTHERWISE, IF A SQUARE HAS 8 1-BITS IN ITS BITMASK,
% THEN IT HAS A FORCED CHOICE, AND ONLY THAT CHOICE WILL BE TAKEN AT THIS
% LEVEL IN THE RECURSION.
BEGIN
INTEGER ARRAY
BITSAVE[0:80]; % SAVED ON EVERY RECURSION, MAX DEPTH 81|81 = 4131 WORDS?
INTEGER
I,
J,
BEST,
BESTCOUNT;
BOOLEAN
FINISHED;
LABEL XIT;
CURDEPTH:= CURDEPTH + 1;
MAXDEPTH:= MAX(MAXDEPTH, CURDEPTH);
% IF NUM = 0 THEN % RECURSE ONLY IF NO SOLUTIONS SO FAR
BEGIN
% FIND EMPTY SQUARE
BEST:= 0;
WHILE NOT FINISHED DO % PREFER TO HAVE CONDITIONAL AND :)
IF NOT FINISHED:= GRID[BEST] = 0 THEN
FINISHED:= (BEST:= BEST + 1) GTR 80;
IF BEST = 81 THEN % 81 INDICATES NO EMPTY SQUARES
BEGIN
PRINTSOLUTION;
GO TO XIT;
END;
BESTCOUNT:= COUNT[BITS[BEST]]; % BITS IN THE SQUARE WE FOUND
FOR I:= BEST+1 STEP 1 WHILE I LSS 81 DO
BEGIN % FIND THE BIGGEST COUNT OVER ALL SQUARES
IF GRID[I] = 0 THEN % ONLY CONSIDER EMPTY SQUARES
BEGIN
J:= COUNT[BITS[I]];
IF J > BESTCOUNT THEN
BEGIN
BEST:= I;
BESTCOUNT:= J;
END;
END;
END;
% TRY ALL NUMBERS FOR THIS SQUARE
FOR I:= 1 STEP 1 WHILE I LEQ 9 DO
BEGIN
IF REAL(BOOLEAN(BITS[BEST]) AND BOOLEAN(BITNO[I])) = 0 THEN
BEGIN % IF THE NUMBER IS POSSIBLE, RECURSE
% SAVE STATE ON STACK
REPLACE POINTER(BITSAVE) BY POINTER(BITS) FOR 81 WORDS;
SETBOX(BEST, I, BITNO[I]); % SET NUMBER AND FIX BITMASK
SELECTBOX; % RECURSE
GRID[BEST]:= 0; % UNPLACE NUMBER IN SQUARE
% RESTORE
REPLACE POINTER(BITS) BY POINTER(BITSAVE) FOR 81 WORDS;
END;
END;
END;
XIT:
CURDEPTH:= CURDEPTH - 1;
END;
PROCEDURE INITIALIZE;
%---------------------
% FILL THE COUNT AND OTHERS ARRAYS
BEGIN
DEFINE FO(I) = FILL OTHERSARY[I, *] WITH #; % MAKE IT EASIER TO WRITE!
INTEGER CNT;
% PREFILLED COUNT ARRAY: PT= 0.833 IO= 9.267 ET= 3.483
% CALCULATED COUNT ARRAY: PT= 1.150 IO= 8.850 ET= 3.517
FOR CNT:= 0 STEP 1 UNTIL 511 DO
COUNT[CNT]:= ONES32(CNT);
% BE NICE TO REDUCE PBITTING SOMEHOW, AND MAYBE MAKE FASTER ACCESS,
% WHICH IS BETTER INDEXED DESCRIPTOR OR MULTIPLY TO DETERMINE VALUE?
% CURRENT IMPLEMENTATION SLOWS THE COMPILER AS WELL!
% AS FILL CAN ONLY DO 1024 NUMBERS, CANNOT USE SINGLE DIMENSION ARRAY
% 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19
FO( 0) 1, 2, 3, 4, 5, 6, 7, 8, 9,10,11,18,19,20,27,36,45,54,63,72; % 0
FO( 1) 0, 2, 3, 4, 5, 6, 7, 8, 9,10,11,18,19,20,28,37,46,55,64,73; % 1
FO( 2) 0, 1, 3, 4, 5, 6, 7, 8, 9,10,11,18,19,20,29,38,47,56,65,74; % 2
FO( 3) 0, 1, 2, 4, 5, 6, 7, 8,12,13,14,21,22,23,30,39,48,57,66,75; % 3
FO( 4) 0, 1, 2, 3, 5, 6, 7, 8,12,13,14,21,22,23,31,40,49,58,67,76; % 4
FO( 5) 0, 1, 2, 3, 4, 6, 7, 8,12,13,14,21,22,23,32,41,50,59,68,77; % 5
FO( 6) 0, 1, 2, 3, 4, 5, 7, 8,15,16,17,24,25,26,33,42,51,60,69,78; % 6
FO( 7) 0, 1, 2, 3, 4, 5, 6, 8,15,16,17,24,25,26,34,43,52,61,70,79; % 7
FO( 8) 0, 1, 2, 3, 4, 5, 6, 7,15,16,17,24,25,26,35,44,53,62,71,80; % 8
FO( 9) 0, 1, 2,10,11,12,13,14,15,16,17,18,19,20,27,36,45,54,63,72; % 9
FO(10) 0, 1, 2, 9,11,12,13,14,15,16,17,18,19,20,28,37,46,55,64,73; % 10
FO(11) 0, 1, 2, 9,10,12,13,14,15,16,17,18,19,20,29,38,47,56,65,74; % 11
FO(12) 3, 4, 5, 9,10,11,13,14,15,16,17,21,22,23,30,39,48,57,66,75; % 12
FO(13) 3, 4, 5, 9,10,11,12,14,15,16,17,21,22,23,31,40,49,58,67,76; % 13
FO(14) 3, 4, 5, 9,10,11,12,13,15,16,17,21,22,23,32,41,50,59,68,77; % 14
FO(15) 6, 7, 8, 9,10,11,12,13,14,16,17,24,25,26,33,42,51,60,69,78; % 15
FO(16) 6, 7, 8, 9,10,11,12,13,14,15,17,24,25,26,34,43,52,61,70,79; % 16
FO(17) 6, 7, 8, 9,10,11,12,13,14,15,16,24,25,26,35,44,53,62,71,80; % 17
FO(18) 0, 1, 2, 9,10,11,19,20,21,22,23,24,25,26,27,36,45,54,63,72; % 18
FO(19) 0, 1, 2, 9,10,11,18,20,21,22,23,24,25,26,28,37,46,55,64,73; % 19
FO(20) 0, 1, 2, 9,10,11,18,19,21,22,23,24,25,26,29,38,47,56,65,74; % 20
FO(21) 3, 4, 5,12,13,14,18,19,20,22,23,24,25,26,30,39,48,57,66,75; % 21
FO(22) 3, 4, 5,12,13,14,18,19,20,21,23,24,25,26,31,40,49,58,67,76; % 22
FO(23) 3, 4, 5,12,13,14,18,19,20,21,22,24,25,26,32,41,50,59,68,77; % 23
FO(24) 6, 7, 8,15,16,17,18,19,20,21,22,23,25,26,33,42,51,60,69,78; % 24
FO(25) 6, 7, 8,15,16,17,18,19,20,21,22,23,24,26,34,43,52,61,70,79; % 25
FO(26) 6, 7, 8,15,16,17,18,19,20,21,22,23,24,25,35,44,53,62,71,80; % 26
FO(27) 0, 9,18,28,29,30,31,32,33,34,35,36,37,38,45,46,47,54,63,72; % 27
FO(28) 1,10,19,27,29,30,31,32,33,34,35,36,37,38,45,46,47,55,64,73; % 28
FO(29) 2,11,20,27,28,30,31,32,33,34,35,36,37,38,45,46,47,56,65,74; % 29
FO(30) 3,12,21,27,28,29,31,32,33,34,35,39,40,41,48,49,50,57,66,75; % 30
FO(31) 4,13,22,27,28,29,30,32,33,34,35,39,40,41,48,49,50,58,67,76; % 31
FO(32) 5,14,23,27,28,29,30,31,33,34,35,39,40,41,48,49,50,59,68,77; % 32
FO(33) 6,15,24,27,28,29,30,31,32,34,35,42,43,44,51,52,53,60,69,78; % 33
FO(34) 7,16,25,27,28,29,30,31,32,33,35,42,43,44,51,52,53,61,70,79; % 34
FO(35) 8,17,26,27,28,29,30,31,32,33,34,42,43,44,51,52,53,62,71,80; % 35
FO(36) 0, 9,18,27,28,29,37,38,39,40,41,42,43,44,45,46,47,54,63,72; % 36
FO(37) 1,10,19,27,28,29,36,38,39,40,41,42,43,44,45,46,47,55,64,73; % 37
FO(38) 2,11,20,27,28,29,36,37,39,40,41,42,43,44,45,46,47,56,65,74; % 38
FO(39) 3,12,21,30,31,32,36,37,38,40,41,42,43,44,48,49,50,57,66,75; % 39
FO(40) 4,13,22,30,31,32,36,37,38,39,41,42,43,44,48,49,50,58,67,76; % 40
FO(41) 5,14,23,30,31,32,36,37,38,39,40,42,43,44,48,49,50,59,68,77; % 41
FO(42) 6,15,24,33,34,35,36,37,38,39,40,41,43,44,51,52,53,60,69,78; % 42
FO(43) 7,16,25,33,34,35,36,37,38,39,40,41,42,44,51,52,53,61,70,79; % 43
FO(44) 8,17,26,33,34,35,36,37,38,39,40,41,42,43,51,52,53,62,71,80; % 44
FO(45) 0, 9,18,27,28,29,36,37,38,46,47,48,49,50,51,52,53,54,63,72; % 45
FO(46) 1,10,19,27,28,29,36,37,38,45,47,48,49,50,51,52,53,55,64,73; % 46
FO(47) 2,11,20,27,28,29,36,37,38,45,46,48,49,50,51,52,53,56,65,74; % 47
FO(48) 3,12,21,30,31,32,39,40,41,45,46,47,49,50,51,52,53,57,66,75; % 48
FO(49) 4,13,22,30,31,32,39,40,41,45,46,47,48,50,51,52,53,58,67,76; % 49
FO(50) 5,14,23,30,31,32,39,40,41,45,46,47,48,49,51,52,53,59,68,77; % 50
FO(51) 6,15,24,33,34,35,42,43,44,45,46,47,48,49,50,52,53,60,69,78; % 51
FO(52) 7,16,25,33,34,35,42,43,44,45,46,47,48,49,50,51,53,61,70,79; % 52
FO(53) 8,17,26,33,34,35,42,43,44,45,46,47,48,49,50,51,52,62,71,80; % 53
FO(54) 0, 9,18,27,36,45,55,56,57,58,59,60,61,62,63,64,65,72,73,74; % 54
FO(55) 1,10,19,28,37,46,54,56,57,58,59,60,61,62,63,64,65,72,73,74; % 55
FO(56) 2,11,20,29,38,47,54,55,57,58,59,60,61,62,63,64,65,72,73,74; % 56
FO(57) 3,12,21,30,39,48,54,55,56,58,59,60,61,62,66,67,68,75,76,77; % 57
FO(58) 4,13,22,31,40,49,54,55,56,57,59,60,61,62,66,67,68,75,76,77; % 58
FO(59) 5,14,23,32,41,50,54,55,56,57,58,60,61,62,66,67,68,75,76,77; % 59
FO(60) 6,15,24,33,42,51,54,55,56,57,58,59,61,62,69,70,71,78,79,80; % 60
FO(61) 7,16,25,34,43,52,54,55,56,57,58,59,60,62,69,70,71,78,79,80; % 61
FO(62) 8,17,26,35,44,53,54,55,56,57,58,59,60,61,69,70,71,78,79,80; % 62
FO(63) 0, 9,18,27,36,45,54,55,56,64,65,66,67,68,69,70,71,72,73,74; % 63
FO(64) 1,10,19,28,37,46,54,55,56,63,65,66,67,68,69,70,71,72,73,74; % 64
FO(65) 2,11,20,29,38,47,54,55,56,63,64,66,67,68,69,70,71,72,73,74; % 65
FO(66) 3,12,21,30,39,48,57,58,59,63,64,65,67,68,69,70,71,75,76,77; % 66
FO(67) 4,13,22,31,40,49,57,58,59,63,64,65,66,68,69,70,71,75,76,77; % 67
FO(68) 5,14,23,32,41,50,57,58,59,63,64,65,66,67,69,70,71,75,76,77; % 68
FO(69) 6,15,24,33,42,51,60,61,62,63,64,65,66,67,68,70,71,78,79,80; % 69
FO(70) 7,16,25,34,43,52,60,61,62,63,64,65,66,67,68,69,71,78,79,80; % 70
FO(71) 8,17,26,35,44,53,60,61,62,63,64,65,66,67,68,69,70,78,79,80; % 71
FO(72) 0, 9,18,27,36,45,54,55,56,63,64,65,73,74,75,76,77,78,79,80; % 72
FO(73) 1,10,19,28,37,46,54,55,56,63,64,65,72,74,75,76,77,78,79,80; % 73
FO(74) 2,11,20,29,38,47,54,55,56,63,64,65,72,73,75,76,77,78,79,80; % 74
FO(75) 3,12,21,30,39,48,57,58,59,66,67,68,72,73,74,76,77,78,79,80; % 75
FO(76) 4,13,22,31,40,49,57,58,59,66,67,68,72,73,74,75,77,78,79,80; % 76
FO(77) 5,14,23,32,41,50,57,58,59,66,67,68,72,73,74,75,76,78,79,80; % 77
FO(78) 6,15,24,33,42,51,60,61,62,69,70,71,72,73,74,75,76,77,79,80; % 78
FO(79) 7,16,25,34,43,52,60,61,62,69,70,71,72,73,74,75,76,77,78,80; % 79
FO(80) 8,17,26,35,44,53,60,61,62,69,70,71,72,73,74,75,76,77,78,79; % 80
FILL BITNO[*] WITH 0, 1, 2, 4, % NOTE ZERO BASED!!!
8, 16, 32, 64,
128, 256, 512, 1024;
WRITE(LINE, <"INITIALIZATION TIME: ",
"PT=",F8.3," IO=",F8.3," ET=", F10.3>,
TIME(2)/60, TIME(3)/60, (TIME(1)-STARTET)/60);
END;
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% SOME TESTED DATA VALUES,
%071698035
%600030700
%090400100
%000009002
%300000009
%500200000
%004006070
%006080001
%820314950
%000000008
%010000040
%000645910
%591300000
%062401790
%000008165
%024173000
%080000020
%900000000
%000000000 - 272 SOLUTIONS
%010000040
%000605910
%591300000
%062401790
%000008105
%024173000
%080000020
%000000000
%600900050 - VERY HARD - PT = 30SEC+
%009000003
%050040007
%013502790
%000000000
%092603540
%900050020
%100000600
%020004005
%000000008 - 12 SOLUTIONS
%010000040
%000645910
%591300000
%000000007
%000008165
%024173000
%080000020
%900000000
%000000008 - 118 SOLUTIONS
%010000040
%000645910
%591300000
%000000000
%000008165
%024173000
%080000020
%900000000
STARTET:= TIME(1);
INITIALIZE;
READGRID;
SELECTBOX;
% WARN THE OPERATOR
IF NUM > 1 THEN
WRITE(SPO, <"FOUND ", I5, " SOLUTIONS">, NUM);
WRITE(LINE, <" ">);
WRITE(LINE, <I3," SOLUTION(S), ",
"MAX RECURSION DEPTH = ",I3,", TIMES: ",
"PT=",F8.3," IO=",F8.3," ET = ", F10.3>,
NUM, MAXDEPTH,
TIME(2)/60, TIME(3)/60, (TIME(1)-STARTET)/60);
END.
?DATA CARD
000000008
010000040
000645910
591300000
062401790
000008165
024173000
080000020
900000000
?END

404
Sudoku-Paul-Cumberworth/Sudoku-Solver.card Normal file
View File

@@ -0,0 +1,404 @@
?COMPILE SUDOKU/TEST WITH XALGOL GO
?XALGOL FILE LINE = LINE/SUDOKU PRINT BACK UP DISK
?STACK = 5000
?DATA CARD
%CARD STACK SEG PRT LIST SINGLE DEBUGN
$LIST PRT STACK SINGLE
% SUDOKU SOLVER
% ORIGINALLY WRITTEN IN C BY SCOTT HEMPHILL AND PLACED IN
% THE PUBLIC DOMAIN 5 SEPTEMBER 2005
% CONVERTED TO B5500 BY PAUL C JULY 2018
% MAKE SURE STACK SET TO AT LEAST 5000 WORDS TO COPE WITH RECURSION
BEGIN
BOOLEAN
FINDMULTIPLE; % FIND MULTIPLE SOLUTIONS (SET COMMON = 1 IN CC)
INTEGER
NUM, % COUNT OF NUMBER OF SOLUTIONS FOUND
CURDEPTH, % CURRENT RECURSION DEPTH
MAXDEPTH, % MAXIMUM RECURSION DEPTH
STARTET; % TIME(1) OF WHEN WE STARTED
INTEGER ARRAY
BITNO[0:11], % ALLOW FOR 12 BITS, ONLY USE 9 THOUGH
GRID [0:80], % THE PUZZLE GRID: 1 THRU 9, OR 0 IF NO NUMBER YET
BITS [0:80], % BITMAP OF EACH SQUARE: BIT SET => NOT POSSIBLE
% I.E. 3"001" => !1, 3"002" => !2, 3"004" => !3,
% 3"010" => !4, ... 3"400" => !9.
COUNT [0:511], % BIT COUNT FOR EACH NUMBER
OTHERSARY [0:80, 0:19];
DEFINE OTHERS(X,Y) =
OTHERSARY[X,Y] #; % MAKE IT EASIER TO OPTIMISE LATER
% FOR EACH SQUARE, AN ARRAY OF 20 "OTHER"
% LOCATIONS AFFECT BY THIS SQUARE. FOR
% EXAMPLE, IF THERE IS A "6" IN SQUARE 0,
% THERE ARE 20 OTHER SQUARES WE KNOW
% CANT CONTAIN A SIX:
% 1,2,3,4,5,6,7,8 (HORIZONTAL ROW)
% 9,18,27,36,45,54,63,72 (VERTCAL COLUMN)
% 1,2,9,10,11,18,19,20 (3X3 SQUARE)
% THATS A TOTAL OF 24 SQUARE NUMBERS,
% BUT 4 OF THEM ARE DUPLICATES. THE
% "OTHERS" ARRAY IS BIG ENOUGH TO HOLD
% 24 NUMBERS WHILE IT IS BEING BUILT, BUT
% WILL ONLY 20 NUMBERS WILL BE USED WHEN
% IT IS COMPLETE.
FILE CARD (2,10,150);
FILE SPO 11 (1,10);
FILE LINE 15 (1,15); % 15, 17 IS PRINTER BACKUP DISK
INTEGER PROCEDURE ONES32(I); % FROM HACKERS DELIGHT
%---------------------------
VALUE I; INTEGER I;
BEGIN
I:= I - REAL(BOOLEAN(I.[31:31]) AND BOOLEAN(3"12525252525"));
I:= REAL(BOOLEAN(I.[31:30]) AND BOOLEAN(3"6314631463")) +
REAL(BOOLEAN(I) AND BOOLEAN(3"6314631463"));
I:= REAL(BOOLEAN(I.[31:28] + I) AND BOOLEAN(3"1703607417"));
I:= I + I.[31:24];
I:= I + I.[31:16];
ONES32:= REAL(BOOLEAN(I) AND BOOLEAN(3"77"));
END;
PROCEDURE SETBOX(N, X, BIT);
%---------------------------
VALUE N, X, BIT; INTEGER N, X, BIT;
% "SETBOX" IS USED TO PLACE A NUMBER IN THE GRID, WHETHER IT IS KNOWN,
% OR A GUESS. IT ALSO UPDATES ALL THE BITMASKS FOR ALL THE ASSOCIATED
% SQUARES TO INDICATE THAT THEY CANT CONTAIN THIS NUMBER.
BEGIN
INTEGER I;
GRID[N]:= X;
FOR I:= 0 STEP 1 UNTIL 19 DO
BITS[OTHERS(N,I)]:= REAL(BOOLEAN(BITS[OTHERS(N,I)]) OR
BOOLEAN(BIT));
END;
PROCEDURE READGRID;
%------------------
% READ IN INITIAL DATA
% THE INITIAL BITMASK IS CALCULATED AT THE SAME TIME BY CALLING SETBOX
BEGIN
INTEGER I, J;
ALPHA ARRAY AIN[0:2];
POINTER P;
FOR I:= 0 STEP 1 UNTIL 8 DO % 9 ROWS OF 9 NUMBERS
BEGIN
READ(CARD, 3, AIN[*]);
P:= POINTER(AIN[0]);
FOR J:= 0 STEP 1 UNTIL 8 DO
BEGIN
SETBOX(9 | I + J, INTEGER(P,1),
BITNO[INTEGER(P,1)]); % SET BITNO, LSB=BIT0
P:= P + 1;
END;
END;
%WRITE OUT WHAT WE GOT!
WRITE(LINE, <"WE STORED IN GRID:">);
FOR I:= 0 STEP 1 UNTIL 8 DO
WRITE(LINE, <9I1>, FOR J:= 0 STEP 1 UNTIL 8 DO GRID[9|I+J]);
%CHECK FOR CONSISTENCY
FOR I:= 0 STEP 1 UNTIL 80 DO
IF GRID[I] > 0 THEN
IF REAL(BOOLEAN(BITS[I]) AND BOOLEAN(BITNO[GRID[I]])) > 0 THEN
BEGIN
WRITE(LINE, <"INCONSISTENT DATA IN ",I1,",",I1>,
(I DIV 9)+1, (I MOD 9) + 1);
J:= 1/0;
END;
END;
PROCEDURE PRINTSOLUTION;
%-----------------------
BEGIN
INTEGER I, J;
NUM:= NUM + 1;
IF NUM > 1 THEN
WRITE(LINE, <" ">); % BLANK
WRITE(LINE,<"SOLUTION ",I3,":">, NUM);
FOR I:= 0 STEP 1 UNTIL 8 DO
WRITE(LINE, <9I1>, FOR J:= 0 STEP 1 UNTIL 8 DO GRID[9|I+J]);
END;
PROCEDURE SELECTBOX;
%-------------------
% "SELECTBOX" IS THE HEART OF THE ALGORITHM. IT WORKS THIS WAY:
% FIRST, THE GRID IS SEARCHED FOR AN EMPTY SQUARE. IF THERE ISNT ONE,
% THEN THE GRID CONTAINS A SOLUTION, SO IT IS PRINTED. IF AN EMPTY
% SQUARE IS FOUND, THEN IT IS COMPARED WITH ALL OTHER EMPTY SQUARES TO
% SEE WHICH ONE OF THEM HAS THE MAXIMUM NUMBER OF 1-BITS IN ITS BITMASK.
% THAT SQUARE IS THE ONE SELECTED, AND EACH OF THE POSSIBLE VALUES ARE
% TRIED IN RETURN, CALLING "SELECTBOX" RECURSIVELY TO SEARCH FOR A
% SOLUTION. NOTE THAT IF A SQUARE HAS 9 1-BITS IN ITS BITMASK, THEN
% THERE ARE NO POSSIBLE VALUES, AND "SELECTBOX" WILL RETURN WITHOUT ANY
% FURTHER RECURSION. OTHERWISE, IF A SQUARE HAS 8 1-BITS IN ITS BITMASK,
% THEN IT HAS A FORCED CHOICE, AND ONLY THAT CHOICE WILL BE TAKEN AT THIS
% LEVEL IN THE RECURSION.
BEGIN
INTEGER ARRAY
BITSAVE[0:80]; % SAVED ON EVERY RECURSION, MAX DEPTH 81|81 = 4131 WORDS?
INTEGER
I,
J,
BEST,
BESTCOUNT;
BOOLEAN
FINISHED;
LABEL XIT;
CURDEPTH:= CURDEPTH + 1;
MAXDEPTH:= MAX(MAXDEPTH, CURDEPTH);
% IF NUM = 0 THEN % RECURSE ONLY IF NO SOLUTIONS SO FAR
BEGIN
% FIND EMPTY SQUARE
BEST:= 0;
WHILE NOT FINISHED DO % PREFER TO HAVE CONDITIONAL AND :)
IF NOT FINISHED:= GRID[BEST] = 0 THEN
FINISHED:= (BEST:= BEST + 1) GTR 80;
IF BEST = 81 THEN % 81 INDICATES NO EMPTY SQUARES
BEGIN
PRINTSOLUTION;
GO TO XIT;
END;
BESTCOUNT:= COUNT[BITS[BEST]]; % BITS IN THE SQUARE WE FOUND
FOR I:= BEST+1 STEP 1 WHILE I LSS 81 DO
BEGIN % FIND THE BIGGEST COUNT OVER ALL SQUARES
IF GRID[I] = 0 THEN % ONLY CONSIDER EMPTY SQUARES
BEGIN
J:= COUNT[BITS[I]];
IF J > BESTCOUNT THEN
BEGIN
BEST:= I;
BESTCOUNT:= J;
END;
END;
END;
% TRY ALL NUMBERS FOR THIS SQUARE
FOR I:= 1 STEP 1 WHILE I LEQ 9 DO
BEGIN
IF REAL(BOOLEAN(BITS[BEST]) AND BOOLEAN(BITNO[I])) = 0 THEN
BEGIN % IF THE NUMBER IS POSSIBLE, RECURSE
% SAVE STATE ON STACK
REPLACE POINTER(BITSAVE) BY POINTER(BITS) FOR 81 WORDS;
SETBOX(BEST, I, BITNO[I]); % SET NUMBER AND FIX BITMASK
SELECTBOX; % RECURSE
GRID[BEST]:= 0; % UNPLACE NUMBER IN SQUARE
% RESTORE
REPLACE POINTER(BITS) BY POINTER(BITSAVE) FOR 81 WORDS;
END;
END;
END;
XIT:
CURDEPTH:= CURDEPTH - 1;
END;
PROCEDURE INITIALIZE;
%---------------------
% FILL THE COUNT AND OTHERS ARRAYS
BEGIN
DEFINE FO(I) = FILL OTHERSARY[I, *] WITH #; % MAKE IT EASIER TO WRITE!
INTEGER CNT;
% PREFILLED COUNT ARRAY: PT= 0.833 IO= 9.267 ET= 3.483
% CALCULATED COUNT ARRAY: PT= 1.150 IO= 8.850 ET= 3.517
FOR CNT:= 0 STEP 1 UNTIL 511 DO
COUNT[CNT]:= ONES32(CNT);
% BE NICE TO REDUCE PBITTING SOMEHOW, AND MAYBE MAKE FASTER ACCESS,
% WHICH IS BETTER INDEXED DESCRIPTOR OR MULTIPLY TO DETERMINE VALUE?
% CURRENT IMPLEMENTATION SLOWS THE COMPILER AS WELL!
% AS FILL CAN ONLY DO 1024 NUMBERS, CANNOT USE SINGLE DIMENSION ARRAY
% 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19
FO( 0) 1, 2, 3, 4, 5, 6, 7, 8, 9,10,11,18,19,20,27,36,45,54,63,72; % 0
FO( 1) 0, 2, 3, 4, 5, 6, 7, 8, 9,10,11,18,19,20,28,37,46,55,64,73; % 1
FO( 2) 0, 1, 3, 4, 5, 6, 7, 8, 9,10,11,18,19,20,29,38,47,56,65,74; % 2
FO( 3) 0, 1, 2, 4, 5, 6, 7, 8,12,13,14,21,22,23,30,39,48,57,66,75; % 3
FO( 4) 0, 1, 2, 3, 5, 6, 7, 8,12,13,14,21,22,23,31,40,49,58,67,76; % 4
FO( 5) 0, 1, 2, 3, 4, 6, 7, 8,12,13,14,21,22,23,32,41,50,59,68,77; % 5
FO( 6) 0, 1, 2, 3, 4, 5, 7, 8,15,16,17,24,25,26,33,42,51,60,69,78; % 6
FO( 7) 0, 1, 2, 3, 4, 5, 6, 8,15,16,17,24,25,26,34,43,52,61,70,79; % 7
FO( 8) 0, 1, 2, 3, 4, 5, 6, 7,15,16,17,24,25,26,35,44,53,62,71,80; % 8
FO( 9) 0, 1, 2,10,11,12,13,14,15,16,17,18,19,20,27,36,45,54,63,72; % 9
FO(10) 0, 1, 2, 9,11,12,13,14,15,16,17,18,19,20,28,37,46,55,64,73; % 10
FO(11) 0, 1, 2, 9,10,12,13,14,15,16,17,18,19,20,29,38,47,56,65,74; % 11
FO(12) 3, 4, 5, 9,10,11,13,14,15,16,17,21,22,23,30,39,48,57,66,75; % 12
FO(13) 3, 4, 5, 9,10,11,12,14,15,16,17,21,22,23,31,40,49,58,67,76; % 13
FO(14) 3, 4, 5, 9,10,11,12,13,15,16,17,21,22,23,32,41,50,59,68,77; % 14
FO(15) 6, 7, 8, 9,10,11,12,13,14,16,17,24,25,26,33,42,51,60,69,78; % 15
FO(16) 6, 7, 8, 9,10,11,12,13,14,15,17,24,25,26,34,43,52,61,70,79; % 16
FO(17) 6, 7, 8, 9,10,11,12,13,14,15,16,24,25,26,35,44,53,62,71,80; % 17
FO(18) 0, 1, 2, 9,10,11,19,20,21,22,23,24,25,26,27,36,45,54,63,72; % 18
FO(19) 0, 1, 2, 9,10,11,18,20,21,22,23,24,25,26,28,37,46,55,64,73; % 19
FO(20) 0, 1, 2, 9,10,11,18,19,21,22,23,24,25,26,29,38,47,56,65,74; % 20
FO(21) 3, 4, 5,12,13,14,18,19,20,22,23,24,25,26,30,39,48,57,66,75; % 21
FO(22) 3, 4, 5,12,13,14,18,19,20,21,23,24,25,26,31,40,49,58,67,76; % 22
FO(23) 3, 4, 5,12,13,14,18,19,20,21,22,24,25,26,32,41,50,59,68,77; % 23
FO(24) 6, 7, 8,15,16,17,18,19,20,21,22,23,25,26,33,42,51,60,69,78; % 24
FO(25) 6, 7, 8,15,16,17,18,19,20,21,22,23,24,26,34,43,52,61,70,79; % 25
FO(26) 6, 7, 8,15,16,17,18,19,20,21,22,23,24,25,35,44,53,62,71,80; % 26
FO(27) 0, 9,18,28,29,30,31,32,33,34,35,36,37,38,45,46,47,54,63,72; % 27
FO(28) 1,10,19,27,29,30,31,32,33,34,35,36,37,38,45,46,47,55,64,73; % 28
FO(29) 2,11,20,27,28,30,31,32,33,34,35,36,37,38,45,46,47,56,65,74; % 29
FO(30) 3,12,21,27,28,29,31,32,33,34,35,39,40,41,48,49,50,57,66,75; % 30
FO(31) 4,13,22,27,28,29,30,32,33,34,35,39,40,41,48,49,50,58,67,76; % 31
FO(32) 5,14,23,27,28,29,30,31,33,34,35,39,40,41,48,49,50,59,68,77; % 32
FO(33) 6,15,24,27,28,29,30,31,32,34,35,42,43,44,51,52,53,60,69,78; % 33
FO(34) 7,16,25,27,28,29,30,31,32,33,35,42,43,44,51,52,53,61,70,79; % 34
FO(35) 8,17,26,27,28,29,30,31,32,33,34,42,43,44,51,52,53,62,71,80; % 35
FO(36) 0, 9,18,27,28,29,37,38,39,40,41,42,43,44,45,46,47,54,63,72; % 36
FO(37) 1,10,19,27,28,29,36,38,39,40,41,42,43,44,45,46,47,55,64,73; % 37
FO(38) 2,11,20,27,28,29,36,37,39,40,41,42,43,44,45,46,47,56,65,74; % 38
FO(39) 3,12,21,30,31,32,36,37,38,40,41,42,43,44,48,49,50,57,66,75; % 39
FO(40) 4,13,22,30,31,32,36,37,38,39,41,42,43,44,48,49,50,58,67,76; % 40
FO(41) 5,14,23,30,31,32,36,37,38,39,40,42,43,44,48,49,50,59,68,77; % 41
FO(42) 6,15,24,33,34,35,36,37,38,39,40,41,43,44,51,52,53,60,69,78; % 42
FO(43) 7,16,25,33,34,35,36,37,38,39,40,41,42,44,51,52,53,61,70,79; % 43
FO(44) 8,17,26,33,34,35,36,37,38,39,40,41,42,43,51,52,53,62,71,80; % 44
FO(45) 0, 9,18,27,28,29,36,37,38,46,47,48,49,50,51,52,53,54,63,72; % 45
FO(46) 1,10,19,27,28,29,36,37,38,45,47,48,49,50,51,52,53,55,64,73; % 46
FO(47) 2,11,20,27,28,29,36,37,38,45,46,48,49,50,51,52,53,56,65,74; % 47
FO(48) 3,12,21,30,31,32,39,40,41,45,46,47,49,50,51,52,53,57,66,75; % 48
FO(49) 4,13,22,30,31,32,39,40,41,45,46,47,48,50,51,52,53,58,67,76; % 49
FO(50) 5,14,23,30,31,32,39,40,41,45,46,47,48,49,51,52,53,59,68,77; % 50
FO(51) 6,15,24,33,34,35,42,43,44,45,46,47,48,49,50,52,53,60,69,78; % 51
FO(52) 7,16,25,33,34,35,42,43,44,45,46,47,48,49,50,51,53,61,70,79; % 52
FO(53) 8,17,26,33,34,35,42,43,44,45,46,47,48,49,50,51,52,62,71,80; % 53
FO(54) 0, 9,18,27,36,45,55,56,57,58,59,60,61,62,63,64,65,72,73,74; % 54
FO(55) 1,10,19,28,37,46,54,56,57,58,59,60,61,62,63,64,65,72,73,74; % 55
FO(56) 2,11,20,29,38,47,54,55,57,58,59,60,61,62,63,64,65,72,73,74; % 56
FO(57) 3,12,21,30,39,48,54,55,56,58,59,60,61,62,66,67,68,75,76,77; % 57
FO(58) 4,13,22,31,40,49,54,55,56,57,59,60,61,62,66,67,68,75,76,77; % 58
FO(59) 5,14,23,32,41,50,54,55,56,57,58,60,61,62,66,67,68,75,76,77; % 59
FO(60) 6,15,24,33,42,51,54,55,56,57,58,59,61,62,69,70,71,78,79,80; % 60
FO(61) 7,16,25,34,43,52,54,55,56,57,58,59,60,62,69,70,71,78,79,80; % 61
FO(62) 8,17,26,35,44,53,54,55,56,57,58,59,60,61,69,70,71,78,79,80; % 62
FO(63) 0, 9,18,27,36,45,54,55,56,64,65,66,67,68,69,70,71,72,73,74; % 63
FO(64) 1,10,19,28,37,46,54,55,56,63,65,66,67,68,69,70,71,72,73,74; % 64
FO(65) 2,11,20,29,38,47,54,55,56,63,64,66,67,68,69,70,71,72,73,74; % 65
FO(66) 3,12,21,30,39,48,57,58,59,63,64,65,67,68,69,70,71,75,76,77; % 66
FO(67) 4,13,22,31,40,49,57,58,59,63,64,65,66,68,69,70,71,75,76,77; % 67
FO(68) 5,14,23,32,41,50,57,58,59,63,64,65,66,67,69,70,71,75,76,77; % 68
FO(69) 6,15,24,33,42,51,60,61,62,63,64,65,66,67,68,70,71,78,79,80; % 69
FO(70) 7,16,25,34,43,52,60,61,62,63,64,65,66,67,68,69,71,78,79,80; % 70
FO(71) 8,17,26,35,44,53,60,61,62,63,64,65,66,67,68,69,70,78,79,80; % 71
FO(72) 0, 9,18,27,36,45,54,55,56,63,64,65,73,74,75,76,77,78,79,80; % 72
FO(73) 1,10,19,28,37,46,54,55,56,63,64,65,72,74,75,76,77,78,79,80; % 73
FO(74) 2,11,20,29,38,47,54,55,56,63,64,65,72,73,75,76,77,78,79,80; % 74
FO(75) 3,12,21,30,39,48,57,58,59,66,67,68,72,73,74,76,77,78,79,80; % 75
FO(76) 4,13,22,31,40,49,57,58,59,66,67,68,72,73,74,75,77,78,79,80; % 76
FO(77) 5,14,23,32,41,50,57,58,59,66,67,68,72,73,74,75,76,78,79,80; % 77
FO(78) 6,15,24,33,42,51,60,61,62,69,70,71,72,73,74,75,76,77,79,80; % 78
FO(79) 7,16,25,34,43,52,60,61,62,69,70,71,72,73,74,75,76,77,78,80; % 79
FO(80) 8,17,26,35,44,53,60,61,62,69,70,71,72,73,74,75,76,77,78,79; % 80
FILL BITNO[*] WITH 0, 1, 2, 4, % NOTE ZERO BASED!!!
8, 16, 32, 64,
128, 256, 512, 1024;
WRITE(LINE, <"INITIALIZATION TIME: ",
"PT=",F8.3," IO=",F8.3," ET=", F10.3>,
TIME(2)/60, TIME(3)/60, (TIME(1)-STARTET)/60);
END;
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% SOME TESTED DATA VALUES,
%071698035
%600030700
%090400100
%000009002
%300000009
%500200000
%004006070
%006080001
%820314950
%000000008
%010000040
%000645910
%591300000
%062401790
%000008165
%024173000
%080000020
%900000000
%000000000 - 272 SOLUTIONS
%010000040
%000605910
%591300000
%062401790
%000008105
%024173000
%080000020
%000000000
%600900050 - VERY HARD - PT = 30SEC+
%009000003
%050040007
%013502790
%000000000
%092603540
%900050020
%100000600
%020004005
%000000008 - 12 SOLUTIONS
%010000040
%000645910
%591300000
%000000007
%000008165
%024173000
%080000020
%900000000
%000000008 - 118 SOLUTIONS
%010000040
%000645910
%591300000
%000000000
%000008165
%024173000
%080000020
%900000000
STARTET:= TIME(1);
INITIALIZE;
READGRID;
SELECTBOX;
% WARN THE OPERATOR
IF NUM > 1 THEN
WRITE(SPO, <"FOUND ", I5, " SOLUTIONS">, NUM);
WRITE(LINE, <" ">);
WRITE(LINE, <I3," SOLUTION(S), ",
"MAX RECURSION DEPTH = ",I3,", TIMES: ",
"PT=",F8.3," IO=",F8.3," ET = ", F10.3>,
NUM, MAXDEPTH,
TIME(2)/60, TIME(3)/60, (TIME(1)-STARTET)/60);
END.
?DATA CARD
000000008
010000040
000645910
591300000
062401790
000008165
024173000
080000020
900000000
?END