 |
BCX Console Demonstration Program S152.bas
|
CONST
MaxFlights =
100
TYPE
FL
Depart[
20
]
AS
CHAR
Arrival[
20
]
AS
CHAR
Distance AS
INTEGER
Skip AS
INTEGER
END
TYPE
TYPE
STACK
Depart[
20
]
AS
CHAR
Arrival[
20
]
AS
CHAR
Distance AS
INTEGER
END
TYPE
GLOBAL
Flight[
MaxFlights]
AS
FL
GLOBAL
Bt_Stack[
MaxFlights]
AS
STACK
GLOBAL
Solution[
MaxFlights]
AS
STACK
GLOBAL
F_pos AS
INTEGER
GLOBAL
Find_pos AS
INTEGER
GLOBAL
tos AS
INTEGER
GLOBAL
stos AS
INTEGER
GLOBAL
start$
GLOBAL
end$
GLOBAL
gdist AS
INTEGER
GLOBAL
c1$
GLOBAL
c2$
GLOBAL
c3$
GLOBAL
Use_Method
GLOBAL
RouteTest
GLOBAL
dd
GLOBAL
tt
CONST
Depth =
0
CONST
Width =
1
CONST
Path =
2
CONST
Node =
3
CONST
Optimal =
4
PRINT
"From "
;
INPUT
start$
PRINT
"to "
;
INPUT
end$
'start$ = "New York"
'end$ = "Los Angeles"
'start$ = "Calgary"
'end$ = "Houston"
CALL
Setup
dd =
Find(
start$, end$)
IF
dd THEN
PRINT
"Direct Route, Distance is "
; dd
getchar(
)
END
=
0
END
IF
CALL
Setup
PRINT
PRINT
"Search by Depth"
Use_Method =
Depth
IsFlight(
start$, end$)
CALL
Setup
PRINT
PRINT
"Search by Width"
Use_Method =
Width
IsFlight(
start$, end$)
CALL
Setup
PRINT
PRINT
"Search by Path Removal"
Use_Method =
Path
DO
RouteTest =
IsFlight(
start$, end$)
tos =
0
LOOP
WHILE
RouteTest > 0
CALL
Setup
PRINT
PRINT
"Search by Node Removal"
Use_Method =
Node
DO
RouteTest =
IsFlight(
start$, end$)
CALL
ClearMarkers
IF
tos > 0
THEN
CALL
Pop(
c2$, c3$, &
gdist)
CALL
Pop(
c1$, c3$, &
gdist)
CALL
Retract(
c1$, c2$)
tos =
0
END
IF
LOOP
WHILE
RouteTest > 0
CALL
Setup
Use_Method =
Optimal
PRINT
PRINT
"Optimal Search"
RouteTest =
IsFlight(
start$, end$)
tt =
0
dd =
0
WHILE
tt < stos
PRINT
Solution[
tt]
.Depart; " to "
;
dd +
=
Solution[
tt]
.Distance
tt+
+
WEND
PRINT
end$
PRINT
"Distance is "
; dd
getchar(
)
;
END
=
0
SUB
Setup
F_pos =
0
tos =
0
stos =
0
Find_pos =
0
Assert_Flight(
"New York"
, "Chicago"
, 1000
)
Assert_Flight(
"Chicago"
, "New York"
, 1000
)
Assert_Flight(
"New York"
, "Urbana"
, 1200
)
Assert_Flight(
"Urbana"
, "New York"
, 1200
)
Assert_Flight(
"Chicago"
, "Denver"
, 1000
)
Assert_Flight(
"Denver"
, "Chicago"
, 1000
)
Assert_Flight(
"Chicago"
, "Urbana"
, 400
)
Assert_Flight(
"Urbana"
, "Chicago"
, 400
)
Assert_Flight(
"Urbana"
, "Houston"
, 900
)
Assert_Flight(
"Houston"
, "Urbana"
, 900
)
Assert_Flight(
"New York"
, "Toronto"
, 800
)
Assert_Flight(
"Toronto"
, "New York"
, 800
)
Assert_Flight(
"New York"
, "Denver"
, 1900
)
Assert_Flight(
"Denver"
, "New York"
, 1900
)
Assert_Flight(
"Toronto"
, "Calgary"
, 1500
)
Assert_Flight(
"Calgary"
, "Toronto"
, 1500
)
Assert_Flight(
"Toronto"
, "Los Angeles"
, 1800
)
Assert_Flight(
"Los Angeles"
, "Toronto"
, 1800
)
Assert_Flight(
"Toronto"
, "Chicago"
, 500
)
Assert_Flight(
"Chicago"
, "Toronto"
, 500
)
Assert_Flight(
"Denver"
, "Urbana"
, 1000
)
Assert_Flight(
"Urbana"
, "Denver"
, 1000
)
Assert_Flight(
"Denver"
, "Houston"
, 1500
)
Assert_Flight(
"Houston"
, "Denver"
, 1500
)
Assert_Flight(
"Houston"
, "Los Angeles"
, 1500
)
Assert_Flight(
"Los Angeles"
, "Houston"
, 1500
)
Assert_Flight(
"Denver"
, "Los Angeles"
, 1000
)
Assert_Flight(
"Los Angeles"
, "Denver"
, 1000
)
END
SUB
SUB
Assert_Flight(
frm$, dst$, dist AS
INTEGER
)
IF
F_pos < MaxFlights THEN
Flight[
F_pos]
.Depart =
frm$
Flight[
F_pos]
.Arrival =
dst$
Flight[
F_pos]
.Distance =
dist
Flight[
F_pos]
.Skip =
0
F_pos+
+
ELSE
PRINT
"Flight database full"
END
IF
END
SUB
FUNCTION
Match(
frm$, dst$)
DIM
RAW
t
t =
0
WHILE
t < F_pos
IF
Flight[
t]
.Depart =
frm$ AND
Flight[
t]
.Arrival =
dst$ THEN
FUNCTION
=
Flight[
t]
.Distance
END
IF
t+
+
WEND
FUNCTION
=
0
END
FUNCTION
FUNCTION
BeenTo(
where$)
DIM
RAW
t
t =
0
WHILE
t < tos
IF
Bt_Stack[
t]
.Depart =
where$ THEN
FUNCTION
=
1
END
IF
t+
+
WEND
FUNCTION
=
0
END
FUNCTION
FUNCTION
Find(
frm$, anywhere$)
Find_pos =
0
WHILE
Find_pos < F_pos
IF
Flight[
Find_pos]
.Depart =
frm$ AND
Flight[
Find_pos]
.Skip =
0
THEN
IF
BeenTo(
Flight[
Find_pos]
.Arrival)
=
0
THEN
anywhere$ =
Flight[
Find_pos]
.Arrival
Flight[
Find_pos]
.Skip =
1
+
tos
FUNCTION
=
Flight[
Find_pos]
.Distance
END
IF
END
IF
Find_pos+
+
WEND
FUNCTION
=
0
END
FUNCTION
SUB
Push(
frm$, dst$, dist AS
INTEGER
)
IF
tos < MaxFlights THEN
Bt_Stack[
tos]
.Depart =
frm$
Bt_Stack[
tos]
.Arrival =
dst$
Bt_Stack[
tos]
.Distance =
dist
tos+
+
ELSE
PRINT
"Stack full"
END
IF
END
SUB
SUB
Pop(
frm$, dst$, dist AS
INTEGER
PTR
)
IF
tos > 0
THEN
tos-
-
frm$ =
Bt_Stack[
tos]
.Depart
dst$ =
Bt_Stack[
tos]
.Arrival
*
dist =
Bt_Stack[
tos]
.Distance
ELSE
PRINT
"Stack underflow"
END
IF
END
SUB
SUB
Spush(
frm$, dst$, dist AS
INTEGER
)
IF
stos < MaxFlights THEN
Solution[
stos]
.Depart =
frm$
Solution[
stos]
.Arrival =
dst$
Solution[
stos]
.Distance =
dist
stos+
+
ELSE
PRINT
"Solution Stack full"
END
IF
END
SUB
SUB
ClearFar(
)
DIM
RAW
ts
ts =
tos +
1
Find_pos =
0
WHILE
Find_pos < F_pos
IF
Flight[
Find_pos]
.Skip > ts THEN
Flight[
Find_pos]
.Skip =
0
END
IF
Find_pos+
+
WEND
END
SUB
SUB
ClearWidth(
frm$, anywhere$)
DIM
RAW
ts
ts =
0
Find_pos =
0
WHILE
Find_pos < F_pos
IF
Flight[
Find_pos]
.Depart =
frm$ AND
(
Flight[
Find_pos]
.Arrival =
anywhere$ OR
ts =
1
)
THEN
ts =
1
Flight[
Find_pos]
.Skip =
0
END
IF
Find_pos+
+
WEND
END
SUB
FUNCTION
IsFlight(
frm$, dst$)
AS
INTEGER
DIM
RAW
d
DIM
RAW
dist
DIM
RAW
temp
DIM
RAW
anywhere$
DIM
RAW
fany$
DIM
RAW
r
r =
0
IF
Use_Method =
Width THEN
dist =
Find(
frm$, anywhere$)
fany$ =
anywhere$
WHILE
dist
d =
Match(
anywhere$, dst$)
IF
d THEN
Push(
frm$, dst$, dist)
Push(
anywhere$, dst$, d)
r =
Route(
dst$)
FUNCTION
=
r
END
IF
dist =
Find(
frm$, anywhere$)
WEND
CALL
ClearWidth(
frm$, fany$)
END
IF
IF
Use_Method <> Width THEN
d =
Match(
frm$, dst$)
IF
d THEN
Push(
frm$, dst$, d)
r =
Route(
dst$)
IF
Use_Method =
Optimal AND
r > 0
THEN
Pop(
frm$, dst$, &
dist)
CALL
ClearFar
r =
IsFlight(
frm$, dst$)
END
IF
FUNCTION
=
r
END
IF
END
IF
dist =
Find(
frm$, anywhere$)
IF
dist THEN
Push(
frm$, dst$, dist)
r =
IsFlight(
anywhere$, dst$)
ELSE
IF
tos > 0
THEN
Pop(
frm$, dst$, &
dist)
CALL
ClearFar
r =
IsFlight(
frm$, dst$)
END
IF
END
IF
FUNCTION
=
r
END
FUNCTION
FUNCTION
Route(
dst$)
AS
INTEGER
DIM
RAW
dist
DIM
RAW
t
STATIC old_dist =
32000
IF
Use_Method =
Optimal AND
tos =
0
THEN
FUNCTION
=
0
END
IF
dist =
0
t =
0
WHILE
t < tos
IF
Use_Method <> Optimal THEN
PRINT
Bt_Stack[
t]
.Depart; " to "
;
dist +
=
Bt_Stack[
t]
.Distance
t+
+
WEND
IF
Use_Method <> Optimal THEN
PRINT
dst$
PRINT
"Distance is "
; dist
END
IF
IF
Use_Method =
Optimal THEN
IF
dist < old_dist AND
dist > 0
THEN
t =
0
old_dist =
dist
stos =
0
WHILE
t < tos
CALL
Spush(
Bt_Stack[
t]
.Depart, Bt_Stack[
t]
.Arrival, Bt_Stack[
t]
.Distance)
t+
+
WEND
END
IF
END
IF
FUNCTION
=
dist
END
FUNCTION
SUB
ClearMarkers
DIM
RAW
t
FOR
t =
0
TO
F_pos
Flight[
t]
.Skip =
0
NEXT
END
SUB
SUB
Retract(
frm$, dst$)
DIM
RAW
t
FOR
t =
0
TO
F_pos
IF
Flight[
t]
.Depart =
frm$ AND
Flight[
t]
.Arrival =
dst$ THEN
Flight[
t]
.Depart =
""
EXIT
SUB
END
IF
NEXT
END
SUB