|
Note: In addition to breaking up the code into several pieces, I also had to replace all square brackets with curly brackets. If you try to compile the code, piece it back together, then change all '{' and '}' characters to '[' and ']', respectively.
program SudokuSolver3;
(* (c) 2017 by Decomposed. All rights reserved. *)
(* Requires a text file that looks like this, where zero represents a blank spot in the initial puzzle. *)
(* Search this source code for 'Puzzle325.txt and set it match whatever the text file is named.' *)
(*
021009000
000071802
050200010
040095200
500000006
003160080
010004060
804320000
000700420
*)
{$mode objfpc}{$H+}
uses
crt,
sysutils,
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
Classes
{ you can add units after this };
const
GRID_XBASE = 2; (* X_BASE and Y_BASE allow us to push the grid over and down *)
GRID_YBASE = 0; (* if we ever want to which we probably won't. *)
MAXMODS = 7;
type
cell_characteristics = record
CellNumber : integer;
DisplayValue : char;
Possibilities : string;
Impossibilities : string;
xCoord : integer;
yCoord : integer;
BlockNumber : integer;
BlockRow, BlockColumn : integer;
IsSolved : boolean;
NumberOfModifications : integer;
ModificationReasons : array{1..MAXMODS} of string;
end;
var
OrigPuzzle : array{1..9} of string;
GridInfo : array{1..9, 1..9} of cell_characteristics;
ch : char;
i,j : integer;
Currentpos_x,Currentpos_y : integer;
cursorxpos, cursorypos: integer;
AutoMovement : BOOLEAN;
TotalCellsSolved : integer;
PassesSinceLastSolution : integer;
Unsolveable : BOOLEAN;
{$R *.res}
procedure drawline_h(xcoord:integer; ycoord:integer; linelength:integer; thischar:char);
(* Draw a horizontal line made up of 'thischar') *)
var
i : integer;
begin
if thischar = '0' then
thischar := '*';
gotoxy(xcoord,ycoord);
for i:=1 to linelength do
write(thischar);
end; (* procedure drawline_h *)
procedure drawline_v(xcoord:integer;
ycoord:integer;
linelength:integer;
thischar:char);
(* Draw a vertical line made up of 'thischar') *)
var
i : integer;
begin
if thischar = '0' then
thischar := '*';
for i:=1 to linelength do
begin
gotoxy(xcoord,ycoord);
write(thischar);
ycoord:=ycoord+1;
end;
end; (* procedure drawline_v); *)
procedure DisplayCurrentCoordinates;
begin
gotoxy(3,24);
write('Cell Info');
gotoxy(3,25);
write(' ');
gotoxy(3,25);
write('#', GridInfo{Currentpos_x}{Currentpos_y}.CellNumber,
' (',Currentpos_x,',',Currentpos_y,')');
gotoxy(62,24);
write('Block Info');
gotoxy(58,25);
write(' ');
gotoxy(58,25);
(* A \"Tower\" is three blocks, vertically.
A \"Swath\" is three blocks, horizontally. I had to call 'em something!
*)
write('#',GridInfo{Currentpos_x}{Currentpos_y}.BlockNumber,
' Tower: ',GridInfo{Currentpos_x}{Currentpos_y}.BlockColumn,
' Swath: ',GridInfo{Currentpos_x}{Currentpos_y}.BlockRow);
end;
procedure DisplayMessage(xpos, ypos : integer; str1: string);
begin
gotoxy(xpos,ypos);
write(str1);
end;
function EliminateCharacter(str1:string; char1:char) : string;
var
strlen : integer;
x : integer;
result1 : string;
begin
result1 := '';
strlen := length(str1);
for x:=1 to strlen do
begin
if str1{x} char1 then
result1 := result1 + str1{x};
end;
EliminateCharacter := result1;
end;
function EliminateCharacters(str1,str2: string) : string;
(* Returns str1 less any of the characters present in str2, regardless of their order *)
var
tmpstr : string;
y, int2: integer;
begin
int2 := length(str2);
for y := 1 to int2 do
begin
str1 := EliminateCharacter(str1, str2{y});
end;
end;
Gold is $1,581/oz today. When it hits $2,000, it will be up 26.5%. Let's see how long that takes. - De 3/11/2013 - ANSWER: 7 Years, 5 Months
- - - - -
View Replies (1)
»
» You can also:
- - - - -
The above is a reply to the following message:
Lazarus (Pascal)
By: Decomposed
in
POPE IV
Mon, 20 Nov 17 10:36 PM
|
Msg. 38935 of
47202
|
I took a class on the Pascal programming language once, and even became decent with Turbo Pascal waaay back, in the days when DOS was king. I haven't used it much since the advent of Windows.
So, when I learned a few weeks ago that there is a really good free compiler available... one that is Turbo Pascal compatible (and even compatible with TP's successor, Delphi), I grabbed a copy
You can get it here, for Windows, linux or Apple. http://www.lazarus-ide.org/index.php?page=downloads
I was surprised how much I'd forgotten, so I bought an old Pascal book from AbeBooks.com ($3.95 including shipping) and spent the last three days re-learning the language and writing a program to solve Sudoku puzzles. (* I'm sure snapits would have loved it. *)
If you'd like to play with it, here's the program. It's called SudokuSolver3, by the way, because I backed up the code each day and started the next day with a new name.
If anyone gives it a try, let me know if you have any feedback.
*grumble* Looks like I'll need to break the code up into pieces or AtomicBobs won't let it post (due to its length). Just append the pieces together to make a single program...
|
|
|
|
|
| 
