aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

Data commit

Browse source
This commit is contained in:
Ingy döt Net 2023-07-01 11:58:00 -04:00
parent 7387c8f97b
commit cb5bb5e222
199093 changed files with 3378972 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

83
Task/Sudoku/PL-I/sudoku-1.pli Normal file
View file

@ -0,0 +1,83 @@
sudoku: procedure options (main); /* 27 July 2014 */
declare grid (9,9) fixed (1) static initial (
0, 0, 3, 0, 2, 0, 6, 0, 0,
9, 0, 0, 3, 0, 5, 0, 0, 1,
0, 0, 1, 8, 0, 6, 4, 0, 0,
0, 0, 8, 1, 0, 2, 9, 0, 0,
7, 0, 0, 0, 0, 0, 0, 0, 8,
0, 0, 6, 7, 0, 8, 2, 0, 0,
0, 0, 2, 6, 0, 9, 5, 0, 0,
8, 0, 0, 2, 0, 3, 0, 0, 9,
0, 0, 5, 0, 1, 0, 3, 0, 0 );
declare grid_solved (9,9) fixed (1);
call print_sudoku (grid);
call solve (1, 1);
put skip (2);
call print_sudoku (grid_solved);
solve: procedure (i, j) recursive options (reorder);
declare (i, j) fixed binary;
declare (n, n_tmp) fixed binary;
if i > 9 then
grid_solved = grid;
else
do n = 1 to 9;
if is_safe (i, j, n) then
do;
n_tmp = grid (i, j);
grid (i, j) = n;
if j = 9 then
call solve (i + 1, 1);
else
call solve (i, j + 1);
grid (i, j) = n_tmp;
end;
end;
end solve;
is_safe: procedure (i, j, n) returns (bit(1) aligned) options (reorder);
declare (i, j, n) fixed binary;
declare (true value ('1'b), false value ('0'b) ) bit (1);
declare (i_min, j_min, ii, jj) fixed binary;
declare kk bit(1) aligned;
if grid (i, j) = n then return (true);
if grid (i, j) ^= 0 then return (false);
if any (grid (i, *) = n) then return (false);
if any (grid (*, j) = n) then return (false);
/* i_min and j_min are the co-ordinates of the top left-hand corner */
/* of 3 x 3 grid in which element (i,j) exists. */
i_min = 1 + 3 * trunc((i - 1) / 3);
j_min = 1 + 3 * trunc((j - 1) / 3);
begin;
declare sub_grid(3,3) fixed (1) defined grid(1sub+i_min-1,2sub+j_min-1);
kk = true;
if any(sub_grid = n) then kk = false;
end;
return (kk);
end is_safe;
print_sudoku: procedure (grid);
declare grid (*,*) fixed (1);
declare ( i, j, ii) fixed binary;
declare bar character (19) initial ( '+-----+-----+-----+' );
declare frame (9) character (1) initial (' ', ' ', '|', ' ', ' ', '|', ' ', ' ', '|' );
put skip list (bar);
do i = 1 to 7 by 3;
do ii = i to i + 2;
put skip edit ( '|', (grid (ii, j), frame(j) do j = 1 to 9) ) (a, f(1));
end;
put skip list (bar);
end;
end print_sudoku;
end sudoku;

138
Task/Sudoku/PL-I/sudoku-2.pli Normal file
View file

@ -0,0 +1,138 @@
*PROCESS MARGINS(1,120) LIBS(SINGLE,STATIC);
*PROCESS OPTIMIZE(2) DFT(REORDER);
sudoku: proc(parms) options(main);
dcl parms char (100) var;
define alias bits bit (9) aligned;
dcl total (81) type bits;
dcl matrix (9, 9) type bits based(addr(total));
dcl box (9, 3, 3) type bits defined (total(trunc((1sub-1) /3) * 27 + mod(1sub-1, 3) * 3 + (2sub-1) * 9 + 3sub));
dcl posbit (0:9) type bits init('000000000'b, '100000000'b, '010000000'b, '001000000'b,
'000100000'b, '000010000'b, '000001000'b, '000000100'b,
'000000010'b, '000000001'b);
dcl (i, j, k) fixed bin(31);
dcl (start, finish) float(18);
dcl result fixed dec(5,3);
dcl buffer char(81);
dcl in file;
/* ON UNIT for the Sudoku data conversion */
on conversion
begin;
put skip
list('Sudoku data not valid.');
stop;
end;
/* ON UNIT to display info about the usage */
on undefinedfile(in)
begin;
put skip
list('Usage: ' || procedurename() || ' /filename');
stop;
end;
open file(in)
title ('/'||parms||',type(fixed), recsize(81)') record input;
/* Ignore the endfile condition */
on endfile(in);
/* Read the Sudoku data into buffer as one record */
read file(in) into(buffer);
close file(in);
/* Convert numbers -> position bit presentation and assign into the Sudoku board */
do k = 1 to 81;
total(k) = posbit(substr(buffer, k, 1));
end;
/* Start solving the Sudoku */
start = secs();
if solve() then
do;
finish = secs();
result = finish - start + 0.0005;
put skip list('Sudoku solved! Time: ' || trim(result) || ' seconds');
put skip(2);
/* display the solved Sudoku if solution exist */
do i = 1 to 9;
do j = 1 to 9;
put edit(trim(index(matrix(i, j), '1'b))) (a(3));
end;
put skip(2);
end;
end;
else put skip list('Impossible!');
/*************************************/
/* Simple backtracking sudoku solver */
/*************************************/
solve: proc recursive returns(bit(1));
dcl (i, j, k) fixed bin(31);
dcl result type bits;
/* find free cell */
do i = 1 to 9;
do j = 1 to 9;
if matrix(i, j) = posbit(0) then goto skip;
end;
end;
/* No more free cells. Check if the completed Sudoku is valid. */
/* Number in the cell is valid if the matching position bit is set. */
do i = 1 to 9;
do j = 1 to 9;
k = index(matrix(i, j), '1'b);
matrix(i, j) = posbit(0);
result = ^(any(matrix(i, *)) | any(matrix(*, j)) | any(box(numbox(i, j), *, *)));
if substr(result, k, 1) = '0'b then return('0'b);
matrix(i, j) = posbit(k);
end;
end;
return('1'b);
skip:
/* Go through and test possible values for the free cell untill the Sudoku is completed */
result = ^(any(matrix(i, *)) | any(matrix(*, j)) | any(box(numbox(i, j), *, *)));
k = 0;
do forever;
k = search(result, '1'b, k+1);
if k = 0 then leave;
matrix(i, j) = posbit(k);
if solve() then return('1'b);
else matrix(i, j) = posbit(0);
end;
return('0'b);
end solve;
/********************************************/
/* Returns box number for the sudoku coords */
/********************************************/
numbox: proc(i, j) returns(fixed bin(31));
dcl (i, j) fixed bin(31);
dcl lookup (9, 9) fixed bin(31) static init( (3)1, (3)2, (3)3,
(3)1, (3)2, (3)3,
(3)1, (3)2, (3)3,
(3)4, (3)5, (3)6,
(3)4, (3)5, (3)6,
(3)4, (3)5, (3)6,
(3)7, (3)8, (3)9,
(3)7, (3)8, (3)9,
(3)7, (3)8, (3)9 );
return(lookup(i, j));
end numbox;
end sudoku;