BCX Console Demonstration Program s152.bas

MACRO 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

MACRO Depth   = 0
MACRO Width   = 1
MACRO Path    = 2
MACRO Node    = 3
MACRO 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

KEYPRESS
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$)
  LOCAL t
  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$)
  LOCAL t
  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 ()
  LOCAL 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$)
  LOCAL ts

  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 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

Result:

From Here
  to Hell and Back

Search by Depth

Search by Width

Search by Path Removal

Search by Node Removal

Optimal Search
Hell and Back
Distance is  0