The QBasic / QB64 Discussion Forum      Other Subforums, Links and Downloads
 
 

 Return to Index  

Dijkstra's algorithm in QB64

July 29 2016 at 2:15 PM
Simmons  (no login)

 
'Algorithm to find the shortest path from the initial node (in red box) to every other node

RANDOMIZE TIMER
CONST false = 0
CONST true = -1

SCREEN 12
DIM shared numNodes as integer
DIM shared connections as integer
DIM pathFollow as integer
DIM ans as string

input "Enter number of nodes in network: ", numNodes
INPUT "Enter number of connections between nodes to attempt: ", connections
INPUT "Do you wish to step through path finding? (Yes/No): ", ans
cls
pathFollow = false
IF instr(ucase$(ans), "Y") then pathFollow = true

TYPE nodeType
x AS LONG
y AS LONG
distance as LONG
numConnections as integer
fromNode as integer
tempFrom as integer
END TYPE

DIM distances(1 TO numNodes, 1 TO numNodes) AS LONG

DIM currentNode AS INTEGER
DIM targetNode AS INTEGER
DIM deltaX AS LONG
DIM deltaY AS LONG

Dim smallestDistance as long
dim closestNode as integer
DIM cycles as integer

dim maxConnections as integer

1
DIM SHARED nodes(1 TO numNodes) AS nodeType
DIM SHARED gridConnections(1 TO numNodes, 1 TO numNodes) AS INTEGER

'Generate random points for screen 12
FOR currentNode = 1 TO numNodes
nodes(currentNode).x = RND * 600 + 20
nodes(currentNode).y = RND * 440 + 20
NEXT

'Compute and store distances between each point
FOR currentNode = 1 TO numNodes
FOR targetNode = currentNode TO numNodes
deltaX = nodes(currentNode).x - nodes(targetNode).x
deltaY = nodes(currentNode).y - nodes(targetNode).y
IF currentNode = targetNode THEN
distances(currentNode, targetNode) = 2147483647
ELSE
distances(currentNode, targetNode) = SQR(deltaX ^ 2 + deltaY ^ 2)
distances(targetNode, currentNode) = distances(currentNode, targetNode)
END IF
NEXT
NEXT

'Build network choosing smallest connections between nodes without intersecting another connection
FOR cycles = 1 to connections
FOR currentNode = 1 to numNodes
locate 1,1: print numNodes*connections - (cycles-1)*numNodes -currentNode
closestNode = 0
smallestDistance = 2147483647
for targetNode = 1 to numNodes
'If there isn't already a connection between current and target AND the distance is smaller
IF distances(currentNode, targetNode) < smallestDistance then
IF gridConnections(currentNode, targetNode) = false then
'If path from current node to target node doesn't cross another
if lineIntersect(currentNode, targetNode) = false then
smallestDistance = distances(currentNode, targetNode)
closestNode = targetNode
ELSE
distances(currentNode, targetNode) = 2147483647
end if
end if
end if
NEXT targetNode
'If a smallest allowable connection was found
If closestNode > 0 then
gridConnections(currentNode, closestNode) = true
gridConnections(closestNode, currentNode) = true
end if
NEXT currentNode
NEXT cycles

'Draw network and find the maximum number of connections per node
for currentNode = 1 to numNodes - 1
CIRCLE (nodes(currentNode).x, nodes(currentNode).y), 5, 3
For targetNode = currentNode to numNodes
if gridConnections(currentNode, targetNode) = true then
line(nodes(currentNode).x, nodes(currentNode).y)-(nodes(targetNode).x, nodes(targetNode).y), 8,,21845
nodes(currentNode).numConnections = nodes(currentNode).numConnections + 1
nodes(targetNode).numConnections = nodes(targetNode).numConnections + 1
end if
next targetNode
if nodes(currentNode).numConnections > maxConnections then maxConnections = nodes(currentNode).numConnections
nodes(currentNode).numConnections = 0
next currentNode
if nodes(numNodes).numConnections > maxConnections then maxConnections = nodes(numNodes).numConnections
nodes(currentNode).numConnections = 0
CIRCLE (nodes(numNodes).x, nodes(numNodes).y), 5, 3
LINE (nodes(1).x - 7, nodes(1).y - 7)-(nodes(1).x + 7, nodes(1).y + 7), 12, B
LINE (nodes(1).x - 8, nodes(1).y - 7)-(nodes(1).x + 8, nodes(1).y + 7), 12, B
LINE (nodes(1).x - 7, nodes(1).y - 8)-(nodes(1).x + 7, nodes(1).y + 8), 12, B

'Re-organize network by nodes
Type connectionType
node as integer
distance as LONG
end type
DIM connections(1 to numNodes, 1 to maxConnections) as connectionType
FOR currentNode = 1 to numNodes -1
for targetNode = currentNode + 1 to numNodes
if gridConnections(currentNode, targetNode) = true then
nodes(currentNode).numConnections = nodes(currentNode).numConnections + 1
nodes(targetNode).numConnections = nodes(targetNode).numConnections + 1
connections(currentNode, nodes(currentNode).numConnections).node = targetNode
connections(currentNode, nodes(currentNode).numConnections).distance = distances(currentNode, targetNode)
connections(targetNode, nodes(targetNode).numConnections).node = currentNode
connections(targetNode, nodes(targetNode).numConnections).distance = distances(currentNode, targetNode)
end if
next targetNode
nodes(currentNode).distance = 2147483647
next currentNode
nodes(numNodes).distance = 2147483647

'Wait for user
LOCATE 1,1
if pathFollow then
PRINT "Press any Key to step through paths"
ELSE
PRINT "Press any Key to show paths..."
end if
while inkey$ = ""
wend
LOCATE 1,1
PRINT " "

'Implement Dijkstra's shortest path algorithm
DIM openSpot as integer
DIM branchNode as integer
DIM index as integer
DIM newDistance as long
DIM x1 as LONG
dim y1 as long
dim x2 as long
dim y2 as long

nodes(1).distance = 0
for index = 1 to nodes(1).numConnections
currentNode = connections(1, index).node
nodes(currentNode).distance = connections(1, index).distance
nodes(currentNode).tempFrom = 1
NEXT

DO
smallestDistance = 2147483647
closestNode = 0
FOR currentNode = 2 to numNodes
if nodes(currentNode).distance < smallestDistance AND nodes(currentNode).fromNode = 0 then
smallestDistance = nodes(currentNode).distance
closestNode = currentNode
end if
next currentNode

if closestNode = 0 then exit do
nodes(closestNode).fromNode = nodes(closestNode).tempFrom
x1 = nodes(closestNode).x
y1 = nodes(closestNode).y
x2 = nodes(nodes(closestNode).fromNode).x
y2 = nodes(nodes(closestNode).fromNode).y
LINE (x1-1, y1)-(x2, y2), 10
LINE (x1, y1+1)-(x2, y2), 10
LINE (x1+1, y1)-(x2, y2), 10
LINE (x1, y1-1)-(x2, y2), 15
if pathFollow then sleep
FOR index = 1 to nodes(closestNode).numConnections
currentNode = connections(closestNode, index).node
if nodes(currentNode).fromNode = 0 then
newDistance = connections(closestNode, index).distance + nodes(closestNode).distance
if newDistance < nodes(currentNode).distance then
nodes(currentNode).distance = connections(closestNode, index).distance + nodes(closestNode).distance
nodes(currentNode).tempFrom = closestNode
end if
end if
next index
LOOP

LOCATE 1,1: PRINT "Press ENTER to run again, Press ESC to quit..."

do
temp$ = inkey$
IF temp$ = chr$(13) then
erase connections
ERASE gridConnections
ERASE nodes
cls
GOTO 1
ELSEif temp$ = CHR$(27) then
end
end if
LOOP

'Function returns true if a path between two nodes intersects any other path
Function lineIntersect%(node1 as integer, node2 as integer)

DIM x1 as double
dim y1 as double
DIM x2 as double
dim y2 as double

DIM x3 as DOUBLE
DIM y3 as double
DIM x4 as double
dim y4 as double

DIM x21 as double
dim x31 as double
DIM x43 as double

DIm y21 as double
dim y31 as double
dim y43 as double

dim numer as double
dim denom as double
dim scalar as double

Dim node3 as integer
DIM node4 as integer

x1 = nodes(node1).x
y1 = nodes(node1).y
x2 = nodes(node2).x
y2 = nodes(node2).y

FOR node3 = 1 to numNodes -1
FOR node4 = node3 to numNodes
if gridConnections(node3, node4) = true then
x3 = nodes(node3).x
y3 = nodes(node3).y
x4 = nodes(node4).x
y4 = nodes(node4).y

x21 = x2-x1
x31 = x3-x1
x43 = x4-x3

y21 = y2-y1
y31 = y3-y1
y43 = y4-y3

denom = x43 * y21 - y43 * x21
if denom <> 0 then
numer = x43 * y31 - y43 * x31
scalar = numer/denom
if scalar > 0 AND scalar < 1 then
numer = y21 * x31 - x21 * y31
denom = x21 * y43 - y21 * x43
scalar = numer / denom
if scalar > 0 AND scalar < 1 then
lineIntersect% = true
exit Function
end if
end if
end if
end if
NEXT node4
NEXT node3
LineIntersect% = false

end function

 
 Respond to this message   
 Copyright © 1999-2018 Network54. All rights reserved.   Terms of Use   Privacy Statement  

Newbies usually go to www.qbasic.com and click on The QBasic Forum
Forum regulars have their own ways, which include The QBasic Community Forums