Related
PROGRAM satellite
IMPLICIT NONE
INTEGER :: i, j, ok, nc
REAL :: alph, bet, chi, ninf1, C1
REAL, DIMENSION(:), ALLOCATABLE :: uexact, x, Econs
REAL :: E, k, Lc, hc, eps, h
Read*,nc
E=25. ; k=125. ; hc=0.01 ; eps=0.01 ; Lc=1 ;
h = Lc/nc ; chi=sqrt((E*hc)/k) ; alph= -(1/h**2) ; bet=(2/h**2)+(k/(E*hc))
ALLOCATE(x(0:nc), uexact(0:nc), Econs(0:nc))
OPEN(UNIT=888,FILE="uetuexact.out",ACTION="write",STATUS='old')
OPEN(UNIT=889,FILE="consistance.out",ACTION="write",STATUS='old')
DO i = 0, nc
x(i) = h*i-Lc/2
uexact(i) = eps*chi*((sinh(x(i)/chi))/(cosh(Lc/(2*chi))))
END DO
!-------------------------------------------------------------------------------
DO i=1,nc-1
Econs(i)=(alph*(uexact(i-1)))+(bet*(uexact(i)))+(alph*(uexact(i+1)))
END DO
ninf1=maxval(Econs)
C1=ninf1*(nc**2)
DO i = 0, nc
WRITE(888,fmt='(3E15.6)') x(i), uexact(i)
WRITE(889,fmt='(3E15.6)') x(i), uexact(i), -Econs(i)
END DO
Print* , 'nc :', nc
Print* , 'h :', h
Print* , 'ninf1 :', ninf1
Print* , 'C1 :', C1
END PROGRAM satellite
I need my nc variable to change from 10,50,100,500,1000,5000,10000 in order to write out for each given nc, the ninf1 and C1 values. For now, i was doing nc manually but i will need a file .out : that gives me nc | ninf1 | C1. I want to know how can i vary my nc to this values precisely.
You could do the following:
define an array nsizes that would hold all the values you want nc to take.
declare a variable iter that would run along this array
iterate with iter over the length of nsizes
At the beginning of each iteration assign nc = nsizes(iter)
At the end of each iteration deallocate the arrays
Here is a patch that does just that.
--- satellite.f90 2020-02-16 18:13:35.662123215 +0700
+++ satellite_loop.f90 2020-02-16 18:50:09.662029872 +0700
## -1,11 +1,15 ##
PROGRAM satellite
IMPLICIT NONE
- INTEGER :: i, j, ok, nc
+ INTEGER :: i, j, ok, nc, iter
REAL :: alph, bet, chi, ninf1, C1
REAL, DIMENSION(:), ALLOCATABLE :: uexact, x, Econs
REAL :: E, k, Lc, hc, eps, h
+ INTEGER, DIMENSION(7) :: nsizes = (/ 10, 50, 100, 500, 1000, 5000, 10000/)
+
+ ! Read*,nc
+ do iter = 1, 7
+ nc = nsizes(iter)
- Read*,nc
E=25. ; k=125. ; hc=0.01 ; eps=0.01 ; Lc=1 ;
h = Lc/nc ; chi=sqrt((E*hc)/k) ; alph= -(1/h**2) ; bet=(2/h**2)+(k/(E*hc))
## -38,4 +42,8 ##
Print* , 'ninf1 :', ninf1
Print* , 'C1 :', C1
+deallocate(x, uexact, econs)
+
+end do
+
END PROGRAM satellite
The output would look like this:
nc : 10
h : 0.100000001
ninf1 : 1.17741162E-02
C1 : 1.17741168
nc : 50
h : 1.99999996E-02
ninf1 : 2.39971280E-03
C1 : 5.99928188
nc : 100
h : 9.99999978E-03
ninf1 : 7.46726990E-04
C1 : 7.46726990
nc : 500
h : 2.00000009E-03
ninf1 : 1.44958496E-04
C1 : 36.2396240
nc : 1000
h : 1.00000005E-03
ninf1 : 8.23974609E-04
C1 : 823.974609
nc : 5000
h : 1.99999995E-04
ninf1 : 2.73437500E-02
C1 : 683593.750
nc : 10000
h : 9.99999975E-05
ninf1 : 0.125000000
C1 : 12500000.0
Here is a block function:
ublock[UU_]:=Block[{tt},U[z_]:=UU[[1]];
tt=2 U[z]+3 U'[z]+U''[z]];
UU:={z^2,z,Sin[z]};
ublock[UU]
Where tt,U[z] are temp variables, and I want to get the result:
2*z^2+6z+2
but the result is:
2z^2
why the results of U'[z] and U''[z] lost?
How to get the result I want?
Some evaluations help
UU := {z^2, z, Sin[z]};
ublock[UU_] := Evaluate#Block[{tt},
U[z_] := Evaluate#UU[[1]];
tt = 2 U[z] + 3 U'[z] + U''[z]];
ublock[UU]
2 + 6 z + 2 z^2
But for more flexibility
Clear[U, UU, ublock]
ublock[UU_] := Block[{tt},
U[z_] := 0;
DownValues[U] = ReplacePart[DownValues[U], {1, 2} -> UU[[1]]];
tt = 2 U[z] + 3 U'[z] + U''[z]]
UU := {z^2, z, Sin[z]}
ublock[UU]
2 + 6 z + 2 z^2
UU = {z^2, z, Sin[z]};
ublock[UU_] := Evaluate#Block[{tt}, U[z_] = UU[[1]];
tt = 2 U[z] + 3 U'[z] + U''[z]];
ublock[UU]
(* 2 + 6 z + 2 z^2 *)
ublock[UU_] := Module[{tt}, U = UU[[1]];
tt = 2 U + 3 D[U, z] + D[U, {z, 2}]]
or better yet
ublock[UU_] := With[{U = UU[[1]]}, 2 U + 3 D[U, z] + D[U, {z, 2}]]
I'm programming concurrency in Pascal-FC using Eclipse Gavab 2.0. I haven't had any problems so far using it, as it always inform me of which the errors are when it's unable to execute a program.
I did the producer-consumer problem using semaphores and it worked alright. Now I've done it using a monitor, but when I run it, it launches for a second then stops, and does nothing else. It shows no errors at all, and I can't find anything wrong with the code. Is it a compiler's problem?
Producer-Consumer using semaphores:
program ProdCons;
const MAXDATOS = 10;
{ Creamos el buffer de comunicación: }
type tBuffer = record
datos : array [1..MAXDATOS] of integer;
posInser, posSacar : integer;
nProductos, nHuecos, em : semaphore;
end;
var buffer : tBuffer;
{ METODOS O PROCEDIMIENTOS: }
procedure inicializar(var buffer : tBuffer);
begin
buffer.posInser := 1;
buffer.posSacar := 1;
initial(buffer.nProductos,0);
initial(buffer.nHuecos,MAXDATOS);
initial(buffer.em,1);
end;
procedure insertar(dato : integer; var buffer : tBuffer);
begin
wait(buffer.nHuecos); {En num de huecos debe ser >0}
wait(buffer.em);
buffer.datos[buffer.posInser] := dato;
writeln('Inserta dato ',dato,' en datos[',buffer.posInser,']');
buffer.posInser := buffer.posInser MOD MAXDATOS + 1;
signal(buffer.em);
signal(buffer.nProductos); {Confirmamos que num. productos >0}
end;
procedure sacar(dato : integer; var buffer : tBuffer);
begin
wait(buffer.nProductos); {Esperamos a que num. productos >0}
wait(buffer.em);
dato:=buffer.datos[buffer.posSacar];
writeln('Consume dato ',dato,' en datos[',buffer.posSacar,']');
buffer.posSacar := buffer.posSacar MOD MAXDATOS + 1;
signal(buffer.em);
signal(buffer.nHuecos);
end;
{ PROCESOS TIPO: }
process type tProductor(var buffer : tBuffer);
var dato : integer;
begin
repeat
dato := random(200);
insertar(dato,buffer);
forever
end;
process type tConsumidor(var buffer : tBuffer);
var dato : integer;
begin
repeat
sacar(dato,buffer);
forever
end;
{ Variables: }
var i : integer;
prod : array [1..5] of tProductor;
cons : array [1..3] of tConsumidor;
begin
inicializar(buffer);
cobegin
for i:=1 to 5 do
prod[i](buffer);
for i:=1 to 3 do
cons[i](buffer);
coend;
end.
Producer-Consumer with semaphore's output
Producer-Consumer using a monitor:
program ProdConsMONITORES;
const N = 5;
monitor ProdCons;
export produce, consume;
{Variables}
var posProd, posCons, cont : integer;
obj : array [1..N] of integer;
vacio, lleno : condition;
{Procedimientos/metodos}
procedure produce(dato,i : integer);
begin
if cont=N then delay(lleno);
obj[posProd] := dato;
writeln('Productor',i,' produce dato ',dato,' en obj[',posProd,']');
posProd := posProd MOD N + 1;
cont := cont + 1;
writeln(' [',cont,' objetos disponibles]');
resume(vacio);
end;
procedure consume(j : integer);
var dato := integer;
begin
if cont=0 then delay(vacio);
dato := obj[posCons];
writeln('Consumidor',j,' consume dato ',dato,' en obj[',posCons,']');
posCons := posCons MOD N + 1;
cont := cont - 1;
writeln(' [',cont,' objetos disponibles]');
resume(lleno);
end;
{Procesos}
process type Productor(i : integer);
var dato : integer;
begin
dato := random(10);
ProdCons.produce(dato,i);
end;
process type Consumidor(j : integer);
begin
ProdCons.consume(j);
end;
{Variables locales}
var p : array [1..5] of Productor;
var c : array [1..3] of Consumidor;
var i,j : integer;
begin
cont := 0;
posProd := 1; posCons := 1;
cobegin
writeln('hola');
for i:=1 to 5 do
p[i](i);
for j:=1 to 3 do
c[j](j);
coend;
end.
Producer-Consumer with monitor's output
Just in case someone else has this problem: the error was I didn't create the body of the monitor, which is a "begin-end" where variables are initialized. It must be placed right after the procedures and goes like this:
begin
cont := 0;
posProd := 1; posCons := 1;
end;
Obviously it's no longer necesary to initialize vars. at the last begin-end.
I m just trying to write my second (yes, it s absolutely new for me) teaching programm on Pascal. I ve made once, using "if", here it is:
program DemoBool;
Var A: Boolean ; B: Boolean ;
C:Integer ; D:Integer ;
I:Integer;
begin
write('Enter A(1/0): '); readln(I);
if (I= 1)
then A:=true else A:=false;
writeln(A);
write('Enter B(1/0): '); readln(I);
if I=1
then B:=true else B:=false;
writeln(B);
write('enter C: '); readln(C);
write('enter D: '); readln(D);
IF ((A=B) AND (C>D)=TRUE OR NOT A )
THEN IF ((TRUE<>A) AND (C-D<3))
THEN writeln('a=b, c>d, or not A=true, (true<>a and c-d<3)=true')
ELSE writeln('a=b, c>d, or not A=true, (true<>a and c-d<3)=false')
ELSE writeln('a<>b, c<d, or not A=false') ;
readln;
end.
And how can I use case instead if for latest conditions?..
Can I write new Var-s , F, F2- Boolean and then somehow, making this:
F:= ((A=B) AND (C>D)=TRUE OR NOT A ) ;
F2:= ((TRUE<>A) AND (C-D<3));
use Case?
It s really not easy for me, but hope, I can manage this task) sorry for my explanation. Thank you for attention
There are several improvments possible to your use of boolean, but this is normal since you learn.
1
if (I= 1) then A:=true else A:=false;
You can directly assign to A the comparison result of I equal to 1
A := (I = 1);
Which leads to better byte code, even without optimization (a TEST than a SETZ instruction). The Paren pair is just for readability.
2
IF ((A=B) AND (C>D)=TRUE OR NOT A )
You don't need to compare the result of boolean operation to true of false.
if ((a=b) and (c>d) or not a)
The expression statements (a=b) and (c>d) already evaluates to a Boolean.
3
If you want to use the case of expression, let's say to replace the end of the program:
case (A = B) and (C > D)) and A and (C - D < 3) of
true: writeln('yep');
false: writeln('nope');
end;
note that I use the simplified statements of lurker comment.
As far as I understood you insisted on using a case statement. Though I entirely agree with #lurker and suppose that case statement is not useful here I have the following proposal.
program DemoBool;
var
BitLogic: byte;
tmpb: byte;
A: Boolean;
B: Boolean;
C: Integer;
D: Integer;
I: Integer;
function GetBoolBit(const B: Boolean; Offset: byte): byte;
begin
if B then
begin
result := 1;
result := result shl Offset;
end
else
result := 0;
end;
begin
//input the values
BitLogic := GetBoolBit(A = B, 0);
tmpb := GetBoolBit(A, 1);
BitLogic := tmpb or BitLogic;//make comparison and store the result
// in bit-by-bit mode - every new boolean with the new offset
// the code is unscrolled here. We can optimize it writing the following instead:
// BitLogic := GetBoolBit(A, 1) or BitLogic;
tmpb := GetBoolBit(C > D, 2);
BitLogic := tmpb or BitLogic;
tmpb := GetBoolBit(C - D < 3, 3);
BitLogic := tmpb or BitLogic;
// we get the following the lower bit will store the first boolean - A=B
// the second - the second - A
// the third - C>D etc.
// the fourth - C-D<3 etc.
//now we can make an adequate case statement:
case BitLogic of
0: {00000000b}writeln('all false');
1: {00000001b}writeln('A=B');
2: {00000010b}writeln('A(=true)');
3: {00000011b}writeln('A and A=B');
4: {00000100b}writeln('C>D');
5: {00000101b}writeln('C>D and A=B');
6: {00000110b}writeln('C>D and A');
7: {00000111b}writeln('C>D and A and A=B');
8: {00001000b}writeln('C - D < 3');
9: {00001001b}writeln('C - D < 3 and A=B');
10:{00001010b}writeln('C - D < 3 and A');
11:{00001011b}writeln('C - D < 3 and A and A=B');
12:{00001100b}writeln('C - D < 3 and C>D');
13:{00001101b}writeln('C - D < 3 and C>D and A=B');
14:{00001110b}writeln('C - D < 3 and C>D and A');
15:{00001111b}writeln('C - D < 3 and C>D and A and A=B');
end;
end.
P.S. Check the logics of your if then else statements. There is a false decision: you decide that if not C > D then C < D. It is C <= D. I would advise you to read this SO answer as well.
I'm looking for advices to speed up my implementation of Dijkstra Shortest Path Search on a weighted graph which is a square matrix N x N. The weight on horizontal vertice is called H (resp. V on vertical ones).
A picture is worth a thousand words:
(source: free.fr)
Of course, this is part of a bigger application, but I've extracted the relevant bit here:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
const
N = 200; //Working on a grid of N x N, here for a quick test, in practice, it's more 10000
type
TForm1 = class(TForm)
Button1: TButton;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
end;
TNode = class
public
ID, //Number of the Node
origin, //From which Node did I came?
weight : integer; //The total weight of the path to Node ID
done : boolean; //Is the Node already explored?
constructor Create(myID, myOrigin, myweight: integer);
end;
var
Form1: TForm1;
implementation
var
H, V : array of integer;
{$R *.dfm}
constructor TNode.Create(myID, myOrigin, myweight: integer);
begin
ID:=MyID;
origin:=MyOrigin;
weight:=MyWeight;
end;
{------------------------------------------------------------------------------}
Function GetNodeFromID(ID: integer; NodeList: TList) : TNode; overload;
var
I: Integer;
Node: TNode;
begin
result:=nil;
for I := 0 to NodeList.count-1 do
begin
Node := NodeList[i];
if Node.ID=ID then
begin
result:=Node;
break;
end;
end;
end;
{------------------------------------------------------------------------------}
Function GetNodeOfMiniWeight(NodeList: TList) : TNode; overload;
var
I, min: Integer;
Node: TNode;
begin
result:=nil;
min :=maxint;
for I := 0 to NodeList.count-1 do
begin
Node := NodeList[i];
if Node.done then continue;
if Node.weight < min then
begin
result:=Node;
min := Node.weight;
end;
end;
end;
{------------------------------------------------------------------------------}
procedure SearchShortestPath(origin,arrival: integer);
var
NewWeight: integer;
NodeList : Tlist;
NodeFrom, //The Node currently being examined
NodeTo :TNode; //The Node where it is intented to go
s : string;
begin
NodeList := Tlist.Create;
NodeFrom := TNode.Create(origin,MaxInt,0);
NodeList.Add(NodeFrom);
while not (NodeFrom.ID = arrival) do //Arrived?
begin
//Path toward the top
if (NodeFrom.ID > N-1) //Already at the top of the grid
and not(NodeFrom.origin-NodeFrom.ID = N) then //Coming from the top
begin
NewWeight:=NodeFrom.weight + H[NodeFrom.ID-N];
NodeTo := GetNodeFromID(NodeFrom.ID-N, NodeList);
if NodeTo <> nil then
begin
if NodeTo.weight > NewWeight then
begin
NodeTo.Origin:=NodeFrom.ID;
NodeTo.weight:=NewWeight;
end;
end
else
begin
NodeTo := TNode.Create(NodeFrom.ID-N,NodeFrom.ID,NewWeight);
NodeList.Add(NodeTo);
end;
end;
//Path toward the bottom
if (NodeFrom.ID < N*N-N) //Already at the bottom of the grid
and not(NodeFrom.Origin- NodeFrom.ID = N) then //Coming from the bottom
begin
NewWeight:=NodeFrom.weight + H[NodeFrom.ID];
NodeTo := GetNodeFromID(NodeFrom.ID+N, NodeList);
if NodeTo <> nil then
begin
if NodeTo.weight > NewWeight then
begin
NodeTo.Origin:=NodeFrom.ID;
NodeTo.weight:=NewWeight;
end;
end
else
begin
NodeTo := TNode.Create(NodeFrom.ID+N,NodeFrom.ID,NewWeight);
NodeList.Add(NodeTo);
end;
end;
//Path toward the right
if not(NodeFrom.ID mod N = N-1) //Already at the extrem right of the grid
and not(NodeFrom.Origin - NodeFrom.ID = 1) then //Coming from the right
begin
NewWeight:=NodeFrom.weight + V[NodeFrom.ID];
NodeTo := GetNodeFromID(NodeFrom.ID+1, NodeList);
if NodeTo <> nil then
begin
if NodeTo.weight > NewWeight then
begin
NodeTo.Origin:=NodeFrom.ID;
NodeTo.weight:=NewWeight;
end;
end
else
begin
NodeTo := TNode.Create(NodeFrom.ID+1,NodeFrom.ID,NewWeight);
NodeList.Add(NodeTo);
end;
end;
//Path toward the left
if not (NodeFrom.ID mod N = 0) //Already at the extrem right of the grid
and not(NodeFrom.Origin - NodeFrom.ID = -1) then //Coming from the left
begin
NewWeight:=NodeFrom.weight + V[NodeFrom.ID-1];
NodeTo := GetNodeFromID(NodeFrom.ID-1, NodeList);
if NodeTo <> nil then
begin
if NodeTo.weight > NewWeight then
begin
NodeTo.Origin:=NodeFrom.ID;
NodeTo.weight:=NewWeight;
end;
end
else
begin
NodeTo := TNode.Create(NodeFrom.ID-1,NodeFrom.ID,NewWeight);
NodeList.Add(NodeTo);
end;
end;
NodeFrom.done :=true;
NodeFrom:=GetNodeOfMiniWeight(NodeList);
end;
s:='The shortest path from '
+ inttostr(arrival) + ' to '
+ inttostr(origin) + ' is : ';
//Get the path
while (NodeFrom.ID <> origin) do
begin
s:= s + inttostr(NodeFrom.ID) + ', ';
NodeFrom:=GetNodeFromID(NodeFrom.Origin, NodeList);
end;
s:= s + inttostr(NodeFrom.ID);
ShowMessage(s);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
SearchShortestPath(Random(N*N),Random(N*N));
end;
procedure TForm1.FormCreate(Sender: TObject);
var
I: Integer;
begin
//Initialisation
randomize;
SetLength(V,N*N);
SetLength(H,N*N);
for I := 0 to N*N-1 do
begin
V[I]:=random(100);
H[I]:=random(100);
end;
end;
end.
The code spend most of the time in the routines: GetNodeFromID and GetNodeOfMiniWeight, and a substantial time to create nodes.
I thought that I could use a binary search, but since it requires the list to be sorted, I think that I'll loose the time in sorting the list. Any advice is welcome.
First of all, use a profiler! For instance, see http://www.delphitools.info/samplingprofiler
Your current code has several weaknesses:
It leaks memory (TNode/TNodeList instances);
You may use dynamic arrays of records instead of individual class instances for nodes (with a count stored outside);
I was not able to recognize your algorithm just by reading the code - so I guess you may enhance the code design.
The pseudo-code of this algorithm is as followed:
for all vertices v,
dist(v) = infinity;
dist(first) = 0;
place all vertices in set toBeChecked;
while toBeChecked is not empty
{in this version, also stop when shortest path to a specific destination is found}
select v: min(dist(v)) in toBeChecked;
remove v from toBeChecked;
for u in toBeChecked, and path from v to u exists
{i.e. for unchecked adjacents to v}
do
if dist(u) > dist(v) + weight({u,v}),
then
dist(u) = dist(v) + weight({u,v});
set predecessor of u to v
save minimum distance to u in array "d"
endif
enddo
endwhile
Did you try this library from DelphiForFun ? Sounds like something already proven, updated recently, and well written. May be improved (e.g. using an array of bits instead array of boolean), but sounds pretty correct for a start.
I've implemented modification of Dijkstra Shortest Path algorithm for sparsed graphs. Your graph is very sparsed (E << V^2). This code uses priority queue based on binary heap, that contains (VerticeNum, DistanceFromSource) pairs as TPoints, ordered by Distance (Point.Y). It reveals loglinear (close to linear) asymptotic behavior. Example for small graph:
Times for i5-4670
N V time, ms
100 10^4 ~15
200 4*10^4 ~50-60 //about 8000 for your implementation
400 1.6*10^5 100
1600 2.5*10^6 1300
6400 4*10^7 24000
10000 10^8 63000
//~max size in 32-bit OS due to H,V arrays memory consumption
code:
function SparseDijkstra(Src, Dest: integer): string;
var
Dist, PredV: array of integer;
I, j, vert, CurDist, toVert, len: integer;
q: TBinaryHeap;
top: TPoint;
procedure CheckAndChange;
begin
if Dist[vert] + len < Dist[toVert] then begin
Dist[toVert] := Dist[vert] + len;
PredV[toVert] := vert;
q.Push(Point(toVert, Dist[toVert]));
//old pair is still stored but has bad (higher) distance value
end;
end;
begin
SetLength(Dist, N * N);
SetLength(PredV, N * N);
for I := 0 to N * N - 1 do
Dist[I] := maxint;
Dist[Src] := 0;
q := TBinaryHeap.Create(N * N);
q.Cmp := ComparePointsByY;
q.Push(Point(Src, 0));
while not q.isempty do begin
top := q.pop;
vert := top.X;
CurDist := top.Y;
if CurDist > Dist[vert] then
continue; //out-of-date pair (bad distance value)
if (vert mod N) <> 0 then begin // step left
toVert := vert - 1;
len := H[toVert];
CheckAndChange;
end;
if (vert div N) <> 0 then begin // step up
toVert := vert - N;
len := V[toVert];
CheckAndChange;
end;
if (vert mod N) <> N - 1 then begin // step right
toVert := vert + 1;
len := H[vert];
CheckAndChange;
end;
if (vert div N) <> N - 1 then begin // step down
toVert := vert + N;
len := V[vert];
CheckAndChange;
end;
end;
q.Free;
// calculated data may be used with miltiple destination points
result := '';
vert := Dest;
while vert <> Src do begin
result := Format(', %d', [vert]) + result;
vert := PredV[vert];
end;
result := Format('%d', [vert]) + result;
end;
procedure TForm1.Button2Click(Sender: TObject);
var
t: Dword;
I, row, col: integer;
begin
t := GetTickCount;
if N < 6 then // visual checker
for I := 0 to N * N - 1 do begin
col := I mod N;
row := I div N;
Canvas.Font.Color := clBlack;
Canvas.Font.Style := [fsBold];
Canvas.TextOut(20 + col * 70, row * 70, inttostr(I));
Canvas.Font.Style := [];
Canvas.Font.Color := clRed;
if col < N - 1 then
Canvas.TextOut(20 + col * 70 + 30, row * 70, inttostr(H[I]));
Canvas.Font.Color := clBlue;
if row < N - 1 then
Canvas.TextOut(20 + col * 70, row * 70 + 30, inttostr(V[I]));
end;
Memo1.Lines.Add(SparseDijkstra({0, n*n-1}random(N * N), random(N * N)));
Memo1.Lines.Add('time ' + inttostr(GetTickCount - t));
end;
Edit: TQPriorityQueue is class for internal use, but you can try any implementation of heap-based priority queue. For example, this one. You have to change Pointer to TPoint, Word to Integer in this module.
Edit2:
I've replaced proprietary queue method names in my procedure by BinaryHeap methods.