(--
Dave Christianson
The Traveling Tourist Problem
1/24/96

This program solves the travelling tourist
problem using different types of search.
--)


(--

  Data structures for Tourist Problem

--)

(-- Bus schedule --)

template object schedule;
  field cities(@:schedule):array[city];
  field buses(@:schedule):array[bus];
  field period(@:schedule):int;

method new_schedule(p:int):schedule {
  concrete object isa schedule { period := p,
                                 cities := new_array[city](),
                                 buses  := new_array[int]() } }

method add_city(s@:schedule, c@:city):void {
  c.id := s.cities.length;
  s.cities.add_last(c);
}

method add_bus(s@:schedule, b@:bus):void {
  b.id := s.buses.length;
  s.buses.add_last(b);
  (s.cities!b.from).buses := cons(b.id,(s.cities!b.from).buses);
}


(-- Cities --)

template object city;
  var field id(@:city):int|void;
  field name(@:city):string;
  var field buses(@:city):list[int];
  method print_string(c@:city):string
    { c.name.print_string }

method new_city(label:string):city {
  concrete object isa city { id := void,
                             name := label,
                             buses := nil[int] };
}

(-- Bus rides --)

template object bus;
  var field id(@:bus):int|void;
  field from(@:bus):int;
  field to(@:bus):int;
  field leaves(@:bus):int;
  field arrives(@:bus):int;

method print_string(b@:bus):string
  { b.id.print_string }

method new_bus(origin:int, dest:int,
               start:int, stop:int):bus {
 concrete object isa bus { id := void,
                           from := origin,
                           to := dest,
                           leaves := start,
                           arrives := stop };
}

(-- Trips --)

template object trip isa ordered;
  field start(@:trip):int;
  field path(@:trip):list[int];
  field visits(@:trip):bit_vector;
  field time(@:trip):int := 0;

method print_string(t@:trip):string {
  let var result:collector := new_collector[char]();
  result := result && "Trip: {" && t.start.print_string;
  t.path.reverse_do(&(b:int) {
    result := result && "->" && b.print_string;
  });
  result := result && "}";
  result.flat_string
}

(-- simple ordering over time --)

method =(t@:trip,x@:trip):bool {
  t.time = x.time;
}

method <(t@:trip,x@:trip):bool {
  t.time < x.time;
}

(-- constructors --)

method new_trip(s@:schedule, origin:int, begin:int) {
  let t := concrete object isa trip { start := origin,
                                      path := nil[int],
                                      visits := new_bit_vector(s.cities.length),
                                      time := begin };
  t.visits.clear_all_bits();
  t.visits!origin := 1;
  t
}

(-- generate a new trip given a bus ride to the next town --)

method new_trip(s@:schedule,t@:trip,b@:bus):trip {
  let time:int := t.time % s.period;
  let var days:int := (t.time - time) / s.period;
  if_false (time <= b.leaves, {
    days := days + 1;
  });
  let newTrip := concrete object isa trip {
                                           start := t.start,
                                           path  := cons(b.id,t.path),
                                           visits := copy(t.visits),
                                           time  := s.period * days + b.arrives
                                          };
  newTrip.visits!b.to := 1;
  newTrip
}


(--
  Searches
  
  Searches require only a way to
  fetch an item and a way to merge new
  items back in.
--)


abstract object search;


(--
  Breadth First Search
  
  For breadth first, we only need
  to append children to the back of the list.
--)

template object breadth_first_search isa search;
  field queue(b@:breadth_first_search):m_list[trip];

(-- constructor --)
method bfs():breadth_first_search {
  concrete object isa breadth_first_search {
    queue := new_queue[trip]()
  }
}

(-- required methods --)
method init(s@:breadth_first_search,t@:trip):void {
  s.queue.enqueue(t);
}
method choose(s@:breadth_first_search):trip {
  s.queue.dequeue()
}

(-- inefficient append (copies appended list) --)
method merge(s@:breadth_first_search,l@:list[trip]) {
  l.do(&(t:T) {
    s.queue.add_last(t);
  });
}

(--
  Depth First Search
  
  For depth first, we only need
  to append children to the front of the list.
--)

template object depth_first_search isa search;
  field stack(b@:depth_first_search):m_list[trip];

(-- constructor --)
(--** assignment of new_stack[trip]() could be done as
      the default initializer for the field
 **--)
method dfs():depth_first_search {
  concrete object isa depth_first_search {
    stack := new_stack[trip]()
  }
}

(-- required methods --)
method init(s@:depth_first_search,t@:trip):void {
  s.stack.push(t);
}
method choose(s@:depth_first_search):trip {
  s.stack.pop()
}

(-- inefficient append (copies appended list) --)
(--** well, it copies only the pointers but not the objects pointed to **--) 
method merge(s@:depth_first_search,l@:list[trip]) {
  l.do(&(t:T) {
    s.stack.push(t);
  });
}

(--

  These methods are common to all searches

--)

method goal(t@:trip):bool {
  t.visits.all_ones()
}

method generate(s@:schedule,t@:trip):list[trip] {
  let c := if (t.path.length > 0, {
    (s.buses!t.path.first).to
  }, {
    t.start
  });
  let var result := nil[trip];
  (s.cities!c).buses.do(&(i:int) {
    result := cons(new_trip(s,t,s.buses!i),result);
  });
  result
}

method solve(s@:schedule,t@:trip,srch@:search):trip {
 srch.init(t);
 loop({
   let top:trip := srch.choose();
   if (top.goal(), { ^ top });
   srch.merge(s.generate(top));
 })
}