Weird result different from prediction (Knight's tour) - pascal

I'm coding the Knight's tour problem to find a tour for the knight in a n*n chessboard. I have made 2 answers, which I think are identical. However, when compiled, two codes produce 2 different results. I want to know the difference between two of my codes.
This is my first code: http://ideone.com/WUI7xD.
const
max = 10;
type
square = array [-1..max+1, -1..max+1] of longint;
vector = array [1..max*max] of longint;
var
n : longint;
x : array [1..8] of longint = (-2, -2, -1, -1, +1, +1, +2, +2);
y : array [1..8] of longint = (-1, +1, -2, +2, -2, +2, -1, +1);
c, r : square;
a, b : vector;
checking : boolean;
procedure input;
begin
readln(n);
end;
procedure backTrack(i, u, v : longint);
var
j : longint;
begin
if (i > n * n) then
begin
checking := true;
exit;
end;
for j := 1 to 8 do
begin
if checking then exit;
inc(u, x[j]);
inc(v, y[j]);
if (u > 0) and (u <= n) and (v > 0) and (v <= n) and (i<=n*n) and (c[u,v] = 0) then
begin
c[u, v] := 1;
r[u, v] := i;
backTrack(i + 1, u, v);
c[u, v] := 0;
end;
dec(u, x[j]);
dec(v, y[j]);
end;
end;
procedure solve;
begin
fillchar(c, sizeof(c), 0);
c[1, 1] := 1;
r[1, 1] := 1;
checking := false;
backTrack(2, 1, 1);
end;
procedure output;
var
j, i : longint;
begin
for j := 1 to n do
begin
for i := 1 to n do
write(r[i, j], ' ');
writeln;
end;
readln;
end;
begin
input;
solve;
output;
end.
And my second code: http://ideone.com/FdFQuX
const
max = 10;
type
square = array [-1..max+1, -1..max+1] of longint;
vector = array [1..max*max] of longint;
var
n : longint;
x : array [1..8] of longint = (-2, -2, -1, -1, +1, +1, +2, +2);
y : array [1..8] of longint = (-1, +1, -2, +2, -2, +2, -1, +1);
c, r : square;
a, b : vector;
checking : boolean;
procedure input;
begin
readln(n);
end;
procedure backTrack(i, u, v : longint);
var
j : longint;
begin
if (i > n * n) then
begin
checking := true;
exit;
end;
r[u, v] := i;
for j := 1 to 8 do
begin
if checking then exit;
inc(u, x[j]);
inc(v, y[j]);
if (u > 0) and (u <= n) and (v > 0) and (v <= n) and (i <= n * n) and (c[u, v] = 0) then
begin
c[u, v] := 1;
backTrack(i + 1, u, v);
c[u, v] := 0;
end;
dec(u,x[j]);
dec(v,y[j]);
end;
end;
procedure solve;
begin
fillchar(c, sizeof(c), 0);
c[1, 1] := 1;
r[1, 1] := 1;
checking := false;
backTrack(1, 1, 1);
end;
procedure output;
var
j, i : longint;
begin
for j := 1 to n do
begin
for i:=1 to n do
write(r[i, j], ' ');
writeln;
end;
end;
begin
input;
solve;
output;
end.

r[u,v]:=i; appears before for j:=1 to 8 do in the second code but not the first.
There are differencing tools which can be used to tell where two text files differ. It is a good idea to become familiar with such tools.

Related

Quicksort script works, but heapsort one doesn't

I've been using a quicksort function to sort my stringlists, but as an exercise I wanted to try and code an heapsort function too. Unfortunately it does not work and I can't understand why. The utility functions I use work (because I use them in the quicksort script too and trying both on a list the quicksort one works and the other doesn't)
{------------------------------------------------------------------------------}
Procedure Heapify(AList : TStringList; N, Root : Integer);
Var
Max, L, R : Integer;
Begin
Max := Root;
L := (2 * Root) + 1;
R := (2 * Root) + 2;
If (L < N) And (ListSort(AList, Max, L) < 0 {function to compare strings, read as List[L]>List[Max]}) Then Max := L;
If (R < N) And (ListSort(AList, Max, R) < 0) Then Max := R;
If Max <> Root Then
Begin
ExchangeItems(AList, Root, Max); {Function to swap strings}
Heapify(AList, N, Max);
End;
End;
{------------------------------------------------------------------------------}
Procedure HeapSortStringList(AList : TStringList);
Var
I : Integer;
Begin
For I := (AList.Count / 2) - 1 DownTo 0 Do Heapify(AList, AList.Count, I);
For I := AList.Count - 1 DownTo 1 Do
Begin
ExchangeItems(AList, I, 0);
Heapify(AList, I, 0);
End;
End;
{------------------------------------------------------------------------------}
How did you compile this code?
Note that compiler gives us message:
[dcc32 Error] Unit2.pas(175): E2010 Incompatible types: 'Integer' and
'Extended'
(AList.Count / 2) should be (AList.Count div 2) for integers
After this correction code becomes working.

What's wrong with max values of GotoXY function?

My code is doing strange thing when MoveMessage procedure takes max values(ScreenWidth and ScreenHeight). So the "Hello, world" string moves to the right down corner and doing strange thing, but the max and min values are set correctly.
Can someone tell me where is my mistake.
program HelloCrt;
uses crt;
const
Message = 'Hello, world!';
procedure GetKey(var code: integer);
var
c: char;
begin
c := Readkey;
if c = #0 then
begin
c := Readkey;
code := -ord(c);
end
else
code := ord(c);
end;
procedure ShowMessage(x, y: integer; msg: string);
begin
GotoXY(x, y);
write(msg);
GotoXY(1, 1);
end;
procedure HideMessage(x, y: integer; msg: string);
var
len, i: integer;
begin
len := Length(msg);
GotoXY(x, y);
for i := 1 to len do
write(' ');
GotoXY(1, 1);
end;
procedure MoveMessage(var x, y: integer; msg: string; dx, dy: integer);
begin
HideMessage(x, y, msg);
x := x + dx;
y := y + dy;
if x > (ScreenWidth - length(msg)) then
x := (ScreenWidth - length(msg) + 1);
if x < 1 then
x := 1;
if y > ScreenHeight then
y := ScreenHeight;
if y < 1 then
y := 1;
ShowMessage(x, y, msg);
end;
var
CurX, CurY: integer;
c: integer;
begin
clrscr;
CurX := (ScreenWidth - length(Message)) div 2;
CurY := ScreenHeight div 2;
ShowMessage(CurX, CurY, Message);
while true do
begin
Getkey(c);
if c > 0 then
break;
case c of
-75:
MoveMessage(CurX, CurY, Message, -1, 0);
-77:
MoveMessage(CurX, CurY, Message, 1, 0);
-72:
MoveMessage(CurX, CurY, Message, 0, -1);
-80:
MoveMessage(CurX, CurY, Message, 0, 1);
end
end;
clrscr;
end.

All sums of a number

I need an algorithm to print all possible sums of a number (partitions).
For example: for 5 I want to print:
1+1+1+1+1
1+1+1+2
1+1+3
1+2+2
1+4
2+3
5
I am writing my code in Pascal. So far I have this:
Program Partition;
Var
pole :Array [0..100] of integer;
n :integer;
{functions and procedures}
function Minimum(a, b :integer): integer;
Begin
if (a > b) then Minimum := b
else Minimum := a;
End;
procedure Rozloz(cislo, i :integer);
Var
j, soucet :integer;
Begin
soucet := 0;
if (cislo = 0) then
begin
for j := i - 1 downto 1 do
begin
soucet := soucet + pole[j];
if (soucet <> n) then
Write(pole[j], '+')
else Write(pole[j]);
end;
soucet := 0;
Writeln()
end
else
begin
for j := 1 to Minimum(cislo, pole[i - 1]) do
begin
pole[i] := j;
Rozloz(cislo - j, i + 1);
end;
end;
End;
{functions and procedures}
{Main program}
Begin
Read(n);
pole[0] := 101;
Rozloz(n, 1);
Readln;
End.
It works good but instead of output I want I get this:
1+1+1+1+1
2+1+1+1
2+2+1
3+1+1
3+2
4+1
5
I can't figure out how to print it in right way. Thank you for help
EDIT: changing for j:=i-1 downto 1 to for j:=1 to i-1 solves one problem. But my output is still this: (1+1+1+1+1) (2+1+1+1) (2+2+1) (3+1+1) (3+2) (4+1) (5) but it should be: (1+1+1+1+1) (1+1+1+2) (1+1+3) (1+2+2) (1+4) (2+3) (5) Main problem is with the 5th and the 6th element. They should be in the opposite order.
I won't attempt Pascal, but here is pseudocode for a solution that prints things in the order that you want.
procedure print_partition(partition);
print "("
print partition.join("+")
print ") "
procedure finish_and_print_all_partitions(partition, i, n):
for j in (i..(n/2)):
partition.append(j)
finish_and_print_all_partitions(partition, j, n-j)
partition.pop()
partition.append(n)
print_partition(partition)
partition.pop()
procedure print_all_partitions(n):
finish_and_print_all_partitions([], 1, n)

2^n calculator in pascal for n={bigger numbers}

Before i must say this : Please, excuse me for my bad english...
I'm student.My teacher gave me problem in pascal for my course work...
I must write program that calculates 2^n for big values of n...I've wrote but there is a problem...My program returns 0 for values of n that bigger than 30...My code is below...Please help me:::Thanks beforehand...
function control(a: integer): boolean;
var
b: boolean;
begin
if (a >= 10) then b := true
else b := false;
control := b;
end;
const
n = 200000000;
var
a: array[1..n] of integer;
i, j, c, t, rsayi: longint; k: string;
begin
writeln('2^n');
write('n=');
read(k);
a[1] := 1;
rsayi := 1;
val(k, t, c);
for i := 1 to t do
for j := 1 to t div 2 do
begin
a[j] := a[j] * 2;
end;
for i := 1 to t div 2 do
begin
if control(a[j]) = true then
begin
a[j + 1] := a[j + 1] + (a[j] div 10);
a[j] := a[j] mod 10;
rsayi := rsayi + 1;
end;
end;
for j := rsayi downto 1 do write(a[j]);
end.
The first (nested) loop boils down to "t" multiplications by 2 on every single element of a.
30 multiplications by two is as far as you can go with a 32-bit integer (2^31-1 of positive values, so 2^31 is out of reach)
So the first loop doesn't work, and you probably have to rethink your strategy.
Here is a quick and dirty program to compute all 2^n up to some given, possibly large, n. The program repeatedly doubles the number in array a, which is stored in base 10; with lower digit in a[1]. Notice it's not particularly fast, so it would not be wise to use it for n = 200000000.
program powers;
const
n = 2000; { largest power to compute }
m = 700; { length of array, should be at least log(2)*n }
var
a: array[1 .. m] of integer;
carry, s, p, i, j: integer;
begin
p := 1;
a[1] := 1;
for i := 1 to n do
begin
carry := 0;
for j := 1 to p do
begin
s := 2*a[j] + carry;
if s >= 10 then
begin
carry := 1;
a[j] := s - 10
end
else
begin
carry := 0;
a[j] := s
end
end;
if carry > 0 then
begin
p := p + 1;
a[p] := 1
end;
write(i, ': ');
for j := p downto 1 do
write(a[j]);
writeln
end
end.

A* / Dijkstra's algorithm simple implementation (Pascal)

I'm trying to implement A* path finding algorithm (now it's Dijkstra's algorithm i.e without heuristic) using this article Link. But I can't figure out what's wrong in my code (it finds incorrect path).
instead of the empty begin ... end; it should be this step:
If it is on the open list already, check to see if this path to that
square is better, using G cost as the measure. A lower G cost means
that this is a better path. If so, change the parent of the square to
the current square, and recalculate the G and F scores of the square.
but I think it is not important because there is no diagonal movement.
uses
crt;
const
MAXX = 20;
MAXY = 25;
type
TArr = array [0..MAXY, 0..MAXX] of integer;
TCell = record
x: integer;
y: integer;
end;
TListCell = record
x: integer;
y: integer;
G: integer;
parent: TCell;
end;
TListArr = array [1..10000] of TListCell;
TList = record
arr: TListArr;
len: integer;
end;
var
i, j, minind, ind, c: integer;
start, finish: TCell;
current: TListCell;
field: TArr;
opened, closed: TList;
procedure ShowField;
var
i, j: integer;
begin
textcolor(15);
for i := 0 to MAXX do
begin
for j := 0 to MAXY do
begin
case field[j, i] of
99: textcolor(8); // not walkable
71: textcolor(14); // walkable
11: textcolor(10); // start
21: textcolor(12); // finish
15: textcolor(2); // path
14: textcolor(5);
16: textcolor(6);
end;
write(field[j, i], ' ');
end;
writeln;
end;
textcolor(15);
end;
procedure AddClosed(a: TListCell);
begin
closed.arr[closed.len + 1] := a;
inc(closed.len);
end;
procedure AddOpened(x, y, G: integer);
begin
opened.arr[opened.len + 1].x := x;
opened.arr[opened.len + 1].y := y;
opened.arr[opened.len + 1].G := G;
inc(opened.len);
end;
procedure DelOpened(n: integer);
var
i: integer;
begin
AddClosed(opened.arr[n]);
for i := n to opened.len - 1 do
opened.arr[i] := opened.arr[i + 1];
dec(opened.len);
end;
procedure SetParent(var a: TListCell; parx, pary: integer);
begin
a.parent.x := parx;
a.parent.y := pary;
end;
function GetMin(var a: TList): integer;
var
i, min, mini: integer;
begin
min := MaxInt;
mini := 0;
for i := 1 to a.len do
if a.arr[i].G < min then
begin
min := a.arr[i].G;
mini := i;
end;
GetMin := mini;
end;
function FindCell(a: TList; x, y: integer): integer;
var
i: integer;
begin
FindCell := 0;
for i := 1 to a.len do
if (a.arr[i].x = x) and (a.arr[i].y = y) then
begin
FindCell := i;
break;
end;
end;
procedure ProcessNeighbourCell(x, y: integer);
begin
if (field[current.x + x, current.y + y] <> 99) then // if walkable
if (FindCell(closed, current.x + x, current.y + y) <= 0) then // and not visited before
if (FindCell(opened, current.x + x, current.y + y) <= 0) then // and not added to list already
begin
AddOpened(current.x + x, current.y + y, current.G + 10);
SetParent(opened.arr[opened.len], current.x, current.y);
// field[opened.arr[opened.len].x, opened.arr[opened.len].y]:=16;
end
else
begin
end;
end;
begin
randomize;
for i := 0 to MAXX do
for j := 0 to MAXY do
field[j, i] := 99;
for i := 1 to MAXX - 1 do
for j := 1 to MAXY - 1 do
if random(5) mod 5 = 0 then
field[j, i] := 99
else field[j, i] := 71;
// start and finish positions coordinates
start.x := 5;
start.y := 3;
finish.x := 19;
finish.y := 16;
field[start.x, start.y] := 11;
field[finish.x, finish.y] := 21;
ShowField;
writeln;
opened.len := 0;
closed.len := 0;
AddOpened(start.x, start.y, 0);
SetParent(opened.arr[opened.len], -1, -1);
current.x := start.x;
current.y := start.y;
repeat
minind := GetMin(opened);
current.x := opened.arr[minind].x;
current.y := opened.arr[minind].y;
current.G := opened.arr[minind].G;
DelOpened(minind);
ProcessNeighbourCell(1, 0); // look at the cell to the right
ProcessNeighbourCell(-1, 0); // look at the cell to the left
ProcessNeighbourCell(0, 1); // look at the cell above
ProcessNeighbourCell(0, -1); // look at the cell below
if (FindCell(opened, finish.x, finish.y) > 0) then
break;
until opened.len = 0;
// count and mark path
c := 0;
while ((current.x <> start.x) or (current.y <> start.y)) do
begin
field[current.x, current.y] := 15;
ind := FindCell(closed, current.x, current.y);
current.x := closed.arr[ind].parent.x;
current.y := closed.arr[ind].parent.y;
inc(c);
end;
ShowField;
writeln(c);
readln;
end.
Edit Feb 1 '12: updated code, also fixed path marking (there should be or instead and), looks like it works now :)
You should rewrite the program to use a loop instead of cut-and-paste to visit each neighbor. If you do that you will avoid bugs like the following:
if (field[current.x, current.y - 1] <> 99) then
if (FindCell(closed, current.x, current.y - 1) <= 0) then
if (FindCell(opened, current.x + 1, current.y) <= 0) then
(See the inconsistent current.x + 1, current.y in the last line.)
With respect to the loop, I was thinking of something like this (pseudo-Python):
neighbor_offsets = [(0, 1), (0, -1), (1, 0), (-1, 0)]
for offset in neighbor_offsets:
neighbor = current + offset
if is_walkable(neighbor) and not is_visited(neighbor):
# Open 'neighbor' with 'current' as parent:
open(neighbor, current)
# Perhaps check if the goal is reached:
if neighbor == finish:
goal_reached = True
break
If you don't write a loop but just refactor to
ProcessCell(x+1, y);
ProcessCell(x-1, y);
ProcessCell(x, y-1);
ProcessCell(x, y-1);
then that's a great improvement too.
Youre posting quite a lot of code, have you tried narrow it down where it fails?
Have you compared your code with the pseudocode on wikipedia?
Also remember that dijkstra is just A* with a heuristic of 0.
Edit:
The article you linked (which I now realize is the very same I used to learn the A*, funny) contains illustrated steps. I would suggest that you recreate that map/grid and run your implementation on it. Then step through the images:
Are the eight initial neighbors added to the open list? Do they have the correct parent?
Is the correct open node picked as next to be scanned according to the heuristic?
Is the list of closed nodes correct?
And so on...

Resources