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