klausvdl

22-09-2019, 03:37 PM

This is a special case of node based (not cell based) pathfinding with weighted edges and without obstacles.

I was playing around with a setting like Starflight (Binary Systems, 1986). We have a 2D starmap with wormhole tunnels.

1545

In terms of a graph each wormhole represents a node and each node is connected with all other nodes. These connections are the edges. Travelling through a wormhole tunnel is very cheap and costs almost no fuel. Normal travelling costs fuel proportionally to distance. These costs are the edges' weights.

You're treasure hunting across the galaxy, but planning your route on the map can be tedious. You're scrolling around in order to figure out which combination of wormhole tunnels would bring you to your destination at a minimal expense.

So I built a navigation system for wormhole tunnels. It is based on code from the book "Algorithms" from Robert Sedgewick (1991) which is an implementation of Dijkstra's algorithm (shortest path problem).

program wormpath;

uses

crt;

var

maxx, maxy: longint; // regarding crt

type

pttyp = packed record

x, y: longint;

end;

type

wormholetyp = packed record

position: pttyp;

target: longint;

end;

const

wormholemaxn = 50;

var

wormholes: array[0..wormholemaxn-1] of wormholetyp;

const

{ max of entries in cost matrix: all wormholes + start + destination }

nodemaxn = wormholemaxn+2;

var

{ cost matrix }

costmat: array[0..nodemaxn-1, 0..nodemaxn-1] of longint;

{ priority queue; all nodes +1 }

cost, pred: array[0..nodemaxn] of longint;

var

{ route }

start, dest: pttyp;

const

{ last 2 entries in cost matrix belong to start/destination }

startindex = wormholemaxn+1;

destindex = wormholemaxn;

{ routines for drawing a line in crt with clipping }

procedure draw_hline(x1, x2, y: longint; letter: char);

var

i, temp: longint;

begin

if y<1 then exit;

if y>maxy then exit;

if x1>x2 then begin

temp := x1;

x1 := x2;

x2 := temp;

end;

if x1<1 then x1 := 1;

if x2>maxx then x2 := maxy;

if x1>x2 then exit;

gotoxy(x1*2-1, y);

for i := x1 to x2 do write(letter, ' ');

end;

procedure draw_vline(x, y1, y2: longint; letter: char);

var

i, temp: longint;

begin

if x<1 then exit;

if x>maxx then exit;

if y1>y2 then begin

temp := y1;

y1 := y2;

y2 := temp;

end;

if y1<1 then y1 := 1;

if y2>maxy then y2 := maxy;

if y1>y2 then exit;

for i := y1 to y2 do begin

gotoxy(x*2-1, i);

write(letter);

end;

end;

procedure draw_line(x1, y1, x2, y2: longint; letter: char; color: byte);

var

dx, dy, rx, ry: longint;

error, c: longint;

step, rest: longint;

begin

textcolor(color);

if y1=y2 then begin

draw_hline(x1, x2, y1, letter);

exit;

end;

if x1=x2 then begin

draw_vline(x1, y1, y2, letter);

exit;

end;

dy := y2-y1;

if dy>=0 then ry := 1

else begin

dy := -dy;

ry := -1

end;

inc(dy);

dx := x2-x1;

if dx>=0 then rx := 1

else begin

dx := -dx;

rx := -1

end;

inc(dx);

{ dy/dx <= 1 }

if dx>=dy then begin

step := dx div dy;

rest := dx-(dy*step);

step := step*rx;

x2 := x1;

error := dy shr 1;

for c := 1 to dy do begin

dec(error, rest);

if error<0 then begin

inc(error, dy);

inc(x2, rx);

end;

inc(x2, step);

draw_hline(x1, x2-rx, y1, letter);

x1 := x2;

inc(y1, ry);

end;

end

{ dy/dx > 1 }

else begin

step := dy div dx;

rest := dy-(dx*step);

step := step*ry;

y2 := y1;

error := dx shr 1;

for c := 1 to dx do begin

dec(error, rest);

if error<0 then begin

inc(error, dx);

inc(y2, ry);

end;

inc(y2, step);

draw_vline(x1, y1, y2-ry, letter);

y1 := y2;

inc(x1, rx);

end;

end;

end;

{ pathfinding }

procedure connect_wormholes;

{ every wormhole calculates distances to all other wormholes

and puts results in cost matrix }

var

i, j: longint;

xa, ya, xb, yb: longint;

dx, dy, dist: longint;

targeta: longint;

begin

for i := 0 to wormholemaxn-1 do begin

{ wormhole A }

xa := wormholes[i].position.x;

ya := wormholes[i].position.y;

targeta := wormholes[i].target;

for j := 0 to wormholemaxn-1 do begin

{ the very same point: distance = 0 }

if j=i then dist := 0

else begin

{ wormhole's mate: distance = 1 }

if j=targeta then dist := 1

else begin

{ wormhole B }

xb := wormholes[j].position.x;

yb := wormholes[j].position.y;

{ distance wormhole A -> wormhole B }

dx := xb-xa;

dy := yb-ya;

dist := dx*dx+dy*dy;

dist := round(sqrt(dist));

end;

end;

costmat[i, j] := dist;

end;

end;

end;

procedure enter_route(startx, starty, destx, desty: longint);

{ enter start and destination into cost matrix }

var

j: longint;

xb, yb: longint;

dx, dy, dist: longint;

begin

{ save route }

start.x := startx;

start.y := starty;

dest.x := destx;

dest.y := desty;

dx := destx-startx;

dy := desty-starty;

dist := dx*dx+dy*dy;

dist := round(sqrt(dist));

costmat[startindex, destindex] := dist;

costmat[destindex, startindex] := dist;

{ distances for start/destination to all wormholes }

for j := 0 to wormholemaxn-1 do begin

xb := wormholes[j].position.x;

yb := wormholes[j].position.y;

{ start -> wormhole }

dx := xb-startx;

dy := yb-starty;

dist := dx*dx+dy*dy;

dist := round(sqrt(dist));

costmat[startindex, j] := dist;

costmat[j, startindex] := dist;

{ dest -> wormhole }

dx := xb-destx;

dy := yb-desty;

dist := dx*dx+dy*dy;

dist := round(sqrt(dist));

costmat[destindex, j] := dist;

costmat[j, destindex] := dist;

end;

end;

procedure find_path;

{ the core algorithm, adapted from R. Sedgewick: Algorithms (Dijkstra variant)

cost[]

negative entry : node yet in queue

positive entry : node in spanning tree already

pred[]

predecessor on path to start

unseen

used as mark

shortest path: from destindex repeatedly backwards via pred[] to startindex

costs for shortest path: abs(cost[destindex])

costs for direct route: costmat[startindex, destindex] }

const

unseen = maxlongint-10;

var

i, current, nextbest, next: longint;

newcost: longint;

begin

for i := 0 to nodemaxn-1 do begin

cost[i] := -unseen;

pred[i] := -1;

end;

cost[destindex] := -(unseen+1);

nextbest := startindex;

repeat

current := nextbest;

cost[current] := -cost[current];

nextbest := destindex;

if cost[current]=unseen then cost[current] := 0;

{ all nodes except start (last entry) }

for next := 0 to nodemaxn-1-1 do begin

{ next is still in queue? }

if cost[next]<0 then begin

{ current and next aren't identical }

if costmat[current, next]<>0 then begin

newcost := cost[current]+costmat[current, next];

if cost[next]<-newcost then begin

cost[next] := -newcost;

pred[next] := current;

end;

end;

if cost[next]>cost[nextbest] then nextbest := next;

end;

end;

until nextbest=destindex;

end;

procedure draw_path;

var

i: longint;

p1, p2: pttyp;

begin

i := destindex;

repeat

{ wormholes and destination (but not start) }

if i<=wormholemaxn then begin

if i<wormholemaxn

{ wormhole }

then p1 := wormholes[i].position

{ destination }

else p1 := dest;

{ predecessor is wormhole }

if pred[i]<wormholemaxn then begin

p2 := wormholes[pred[i]].position;

if wormholes[pred[i]].target=i

then draw_line(p1.x, p1.y, p2.x, p2.y, 'o', lightgreen)

else draw_line(p1.x, p1.y, p2.x, p2.y, 'o', lightred);

end

{ predecessor is start }

else begin

p2 := start;

draw_line(p1.x, p1.y, p2.x, p2.y, 'o', lightred);

end;

end;

i := pred[i];

until i=-1;

end;

procedure generate_wormholes;

var

i: longint;

begin

for i := 0 to wormholemaxn-1 do begin

with wormholes[i] do begin

position.x := 3+random(maxx-4);

position.y := 1+random(maxy-1);

if odd(i) then target := i-1 else target := i+1;

end;

end;

end;

procedure draw_wormholes;

var

i: longint;

p1, p2: pttyp;

begin

for i := 0 to wormholemaxn-1 do begin

if odd(i) then continue;

p1 := wormholes[i].position;

p2 := wormholes[i+1].position;

draw_line(p1.x, p1.y, p2.x, p2.y, '.', lightgray);

end;

end;

begin

{ try to create a square window }

window(1, 1, windmaxx, windmaxx shr 1);

maxx := windmaxx shr 1;

maxy := windmaxy;

{ start: top left corner; destination: bottom right corner }

start.x := 1;

start.y := 1;

dest.x := maxx;

dest.y := maxy-1;

repeat

{ update }

generate_wormholes;

connect_wormholes;

enter_route(start.x, start.y, dest.x, dest.y);

find_path;

{ render }

clrscr;

draw_wormholes;

draw_path;

textcolor(white);

gotoxy(1, maxy-3);

writeln(maxx, ' x ', maxy);

writeln('cost path : ', abs(cost[destindex]));

write('cost direct : ', costmat[startindex, destindex]);

readln;

until false;

end.

In order to visualize the matter I chose a CRT front end which hopefully isn't an imposition. I priorized compatibility and simplicity. (Assumed that CRT works everywhere out of the box ...)

First the program draws 25 wormhole tunnels. Then it draws the shortest path from the top left corner to the bottom right corner. Green stands for wormhole tunnel segments, red stands for normal space travel. Pressing RETURN restarts the process. If you want to quit just close the window.

You have to enlarge the window or maximize it.

1546

I was playing around with a setting like Starflight (Binary Systems, 1986). We have a 2D starmap with wormhole tunnels.

1545

In terms of a graph each wormhole represents a node and each node is connected with all other nodes. These connections are the edges. Travelling through a wormhole tunnel is very cheap and costs almost no fuel. Normal travelling costs fuel proportionally to distance. These costs are the edges' weights.

You're treasure hunting across the galaxy, but planning your route on the map can be tedious. You're scrolling around in order to figure out which combination of wormhole tunnels would bring you to your destination at a minimal expense.

So I built a navigation system for wormhole tunnels. It is based on code from the book "Algorithms" from Robert Sedgewick (1991) which is an implementation of Dijkstra's algorithm (shortest path problem).

program wormpath;

uses

crt;

var

maxx, maxy: longint; // regarding crt

type

pttyp = packed record

x, y: longint;

end;

type

wormholetyp = packed record

position: pttyp;

target: longint;

end;

const

wormholemaxn = 50;

var

wormholes: array[0..wormholemaxn-1] of wormholetyp;

const

{ max of entries in cost matrix: all wormholes + start + destination }

nodemaxn = wormholemaxn+2;

var

{ cost matrix }

costmat: array[0..nodemaxn-1, 0..nodemaxn-1] of longint;

{ priority queue; all nodes +1 }

cost, pred: array[0..nodemaxn] of longint;

var

{ route }

start, dest: pttyp;

const

{ last 2 entries in cost matrix belong to start/destination }

startindex = wormholemaxn+1;

destindex = wormholemaxn;

{ routines for drawing a line in crt with clipping }

procedure draw_hline(x1, x2, y: longint; letter: char);

var

i, temp: longint;

begin

if y<1 then exit;

if y>maxy then exit;

if x1>x2 then begin

temp := x1;

x1 := x2;

x2 := temp;

end;

if x1<1 then x1 := 1;

if x2>maxx then x2 := maxy;

if x1>x2 then exit;

gotoxy(x1*2-1, y);

for i := x1 to x2 do write(letter, ' ');

end;

procedure draw_vline(x, y1, y2: longint; letter: char);

var

i, temp: longint;

begin

if x<1 then exit;

if x>maxx then exit;

if y1>y2 then begin

temp := y1;

y1 := y2;

y2 := temp;

end;

if y1<1 then y1 := 1;

if y2>maxy then y2 := maxy;

if y1>y2 then exit;

for i := y1 to y2 do begin

gotoxy(x*2-1, i);

write(letter);

end;

end;

procedure draw_line(x1, y1, x2, y2: longint; letter: char; color: byte);

var

dx, dy, rx, ry: longint;

error, c: longint;

step, rest: longint;

begin

textcolor(color);

if y1=y2 then begin

draw_hline(x1, x2, y1, letter);

exit;

end;

if x1=x2 then begin

draw_vline(x1, y1, y2, letter);

exit;

end;

dy := y2-y1;

if dy>=0 then ry := 1

else begin

dy := -dy;

ry := -1

end;

inc(dy);

dx := x2-x1;

if dx>=0 then rx := 1

else begin

dx := -dx;

rx := -1

end;

inc(dx);

{ dy/dx <= 1 }

if dx>=dy then begin

step := dx div dy;

rest := dx-(dy*step);

step := step*rx;

x2 := x1;

error := dy shr 1;

for c := 1 to dy do begin

dec(error, rest);

if error<0 then begin

inc(error, dy);

inc(x2, rx);

end;

inc(x2, step);

draw_hline(x1, x2-rx, y1, letter);

x1 := x2;

inc(y1, ry);

end;

end

{ dy/dx > 1 }

else begin

step := dy div dx;

rest := dy-(dx*step);

step := step*ry;

y2 := y1;

error := dx shr 1;

for c := 1 to dx do begin

dec(error, rest);

if error<0 then begin

inc(error, dx);

inc(y2, ry);

end;

inc(y2, step);

draw_vline(x1, y1, y2-ry, letter);

y1 := y2;

inc(x1, rx);

end;

end;

end;

{ pathfinding }

procedure connect_wormholes;

{ every wormhole calculates distances to all other wormholes

and puts results in cost matrix }

var

i, j: longint;

xa, ya, xb, yb: longint;

dx, dy, dist: longint;

targeta: longint;

begin

for i := 0 to wormholemaxn-1 do begin

{ wormhole A }

xa := wormholes[i].position.x;

ya := wormholes[i].position.y;

targeta := wormholes[i].target;

for j := 0 to wormholemaxn-1 do begin

{ the very same point: distance = 0 }

if j=i then dist := 0

else begin

{ wormhole's mate: distance = 1 }

if j=targeta then dist := 1

else begin

{ wormhole B }

xb := wormholes[j].position.x;

yb := wormholes[j].position.y;

{ distance wormhole A -> wormhole B }

dx := xb-xa;

dy := yb-ya;

dist := dx*dx+dy*dy;

dist := round(sqrt(dist));

end;

end;

costmat[i, j] := dist;

end;

end;

end;

procedure enter_route(startx, starty, destx, desty: longint);

{ enter start and destination into cost matrix }

var

j: longint;

xb, yb: longint;

dx, dy, dist: longint;

begin

{ save route }

start.x := startx;

start.y := starty;

dest.x := destx;

dest.y := desty;

dx := destx-startx;

dy := desty-starty;

dist := dx*dx+dy*dy;

dist := round(sqrt(dist));

costmat[startindex, destindex] := dist;

costmat[destindex, startindex] := dist;

{ distances for start/destination to all wormholes }

for j := 0 to wormholemaxn-1 do begin

xb := wormholes[j].position.x;

yb := wormholes[j].position.y;

{ start -> wormhole }

dx := xb-startx;

dy := yb-starty;

dist := dx*dx+dy*dy;

dist := round(sqrt(dist));

costmat[startindex, j] := dist;

costmat[j, startindex] := dist;

{ dest -> wormhole }

dx := xb-destx;

dy := yb-desty;

dist := dx*dx+dy*dy;

dist := round(sqrt(dist));

costmat[destindex, j] := dist;

costmat[j, destindex] := dist;

end;

end;

procedure find_path;

{ the core algorithm, adapted from R. Sedgewick: Algorithms (Dijkstra variant)

cost[]

negative entry : node yet in queue

positive entry : node in spanning tree already

pred[]

predecessor on path to start

unseen

used as mark

shortest path: from destindex repeatedly backwards via pred[] to startindex

costs for shortest path: abs(cost[destindex])

costs for direct route: costmat[startindex, destindex] }

const

unseen = maxlongint-10;

var

i, current, nextbest, next: longint;

newcost: longint;

begin

for i := 0 to nodemaxn-1 do begin

cost[i] := -unseen;

pred[i] := -1;

end;

cost[destindex] := -(unseen+1);

nextbest := startindex;

repeat

current := nextbest;

cost[current] := -cost[current];

nextbest := destindex;

if cost[current]=unseen then cost[current] := 0;

{ all nodes except start (last entry) }

for next := 0 to nodemaxn-1-1 do begin

{ next is still in queue? }

if cost[next]<0 then begin

{ current and next aren't identical }

if costmat[current, next]<>0 then begin

newcost := cost[current]+costmat[current, next];

if cost[next]<-newcost then begin

cost[next] := -newcost;

pred[next] := current;

end;

end;

if cost[next]>cost[nextbest] then nextbest := next;

end;

end;

until nextbest=destindex;

end;

procedure draw_path;

var

i: longint;

p1, p2: pttyp;

begin

i := destindex;

repeat

{ wormholes and destination (but not start) }

if i<=wormholemaxn then begin

if i<wormholemaxn

{ wormhole }

then p1 := wormholes[i].position

{ destination }

else p1 := dest;

{ predecessor is wormhole }

if pred[i]<wormholemaxn then begin

p2 := wormholes[pred[i]].position;

if wormholes[pred[i]].target=i

then draw_line(p1.x, p1.y, p2.x, p2.y, 'o', lightgreen)

else draw_line(p1.x, p1.y, p2.x, p2.y, 'o', lightred);

end

{ predecessor is start }

else begin

p2 := start;

draw_line(p1.x, p1.y, p2.x, p2.y, 'o', lightred);

end;

end;

i := pred[i];

until i=-1;

end;

procedure generate_wormholes;

var

i: longint;

begin

for i := 0 to wormholemaxn-1 do begin

with wormholes[i] do begin

position.x := 3+random(maxx-4);

position.y := 1+random(maxy-1);

if odd(i) then target := i-1 else target := i+1;

end;

end;

end;

procedure draw_wormholes;

var

i: longint;

p1, p2: pttyp;

begin

for i := 0 to wormholemaxn-1 do begin

if odd(i) then continue;

p1 := wormholes[i].position;

p2 := wormholes[i+1].position;

draw_line(p1.x, p1.y, p2.x, p2.y, '.', lightgray);

end;

end;

begin

{ try to create a square window }

window(1, 1, windmaxx, windmaxx shr 1);

maxx := windmaxx shr 1;

maxy := windmaxy;

{ start: top left corner; destination: bottom right corner }

start.x := 1;

start.y := 1;

dest.x := maxx;

dest.y := maxy-1;

repeat

{ update }

generate_wormholes;

connect_wormholes;

enter_route(start.x, start.y, dest.x, dest.y);

find_path;

{ render }

clrscr;

draw_wormholes;

draw_path;

textcolor(white);

gotoxy(1, maxy-3);

writeln(maxx, ' x ', maxy);

writeln('cost path : ', abs(cost[destindex]));

write('cost direct : ', costmat[startindex, destindex]);

readln;

until false;

end.

In order to visualize the matter I chose a CRT front end which hopefully isn't an imposition. I priorized compatibility and simplicity. (Assumed that CRT works everywhere out of the box ...)

First the program draws 25 wormhole tunnels. Then it draws the shortest path from the top left corner to the bottom right corner. Green stands for wormhole tunnel segments, red stands for normal space travel. Pressing RETURN restarts the process. If you want to quit just close the window.

You have to enlarge the window or maximize it.

1546