IM204 Coursework 3: A Journey Planner

!--------------------------------------------------------------------
! IM204 Coursework 3: London Tube Map - Eamonn Martin - ID: 96/D59682
!--------------------------------------------------------------------

typevar any;

!--------------------------------------------------------------------
! POLYMORPHIC LIST FUNCTIONS

! Return the number of items in a list
dec count : list (any) -> num;
--- count ( [] ) <= 0;
--- count ( h :: t ) <= 1 + count(t);

! Return the index of an item in a list
infix indexof : 8;
dec indexof : list (any) # any -> num;
--- ( [] ) indexof i <= 1;
--- (a :: l) indexof i <=
    if (a=i) then 0 else 1 + (l indexof i);

! Return true if a list contains a specified item
infix contains : 8;
dec contains : list (any) # any -> truval;
--- l contains i <= (l indexof i) < count(l);

! Return a specified number of items from the start of a list
dec first : num # list (any) -> list (any);
--- first ( n, [] ) <= [];
--- first ( n, i :: l ) <=
    if (n<1) then [] else (i :: first(n-1, l));

! Return a list of lists combined into one big list
dec join : list (list (any) ) -> list (any);
--- join ( [] ) <= [];
--- join ( s :: l ) <= s <> join(l);

! Return a list reversed
dec reverse : list (any) -> list (any);
--- reverse ( [] ) <= [];
--- reverse ( h :: t ) <= reverse(t) <> [h];

! Return the larger of two lists
dec maxlist : list (any) # list (any) -> list (any);
--- maxlist ( l1, l2 ) <=
    if (count(l1) < count(l2)) then l2 else l1;

! Return the smaller of two lists (excluding empties)
dec minlist : list (any) # list (any) -> list (any);
--- minlist ( [], l2 ) <= l2;
--- minlist ( l1, [] ) <= l1;
--- minlist ( l1, l2 ) <=
    if (count(l1) > count(l2)) then l2 else l1;

!--------------------------------------------------------------------
! BINARY-MAP DATA TYPES AND ACCESS FUNCTIONS

type node == any;
type link == node # node;
type path == list (node);
type map  == list (link);

dec node1 : link -> node;
--- node1 ( n1, n2 ) <= n1;

dec node2 : link -> node;
--- node2 ( n1, n2 ) <= n2;

!--------------------------------------------------------------------
! BINARY-MAP UTILITY FUNCTIONS

! Return true if a link contains a given node
infix hasnode : 8;
dec hasnode : link # node -> truval;
--- l hasnode n <= (node1(l)=n) or (node2(l)=n);

! Return the node linked to a given node in a link
dec linknode : link # node -> node;
--- linknode ( (n1, n2), n ) <= if (n=n1) then n2 else n1;

! Return a map with a list of removed links that contain a given node
dec nodelinks : map # node # map # map -> map # map;
--- nodelinks ( [], n, m2, t ) <= ( m2, t );
--- nodelinks ( l :: m1, n, m2, t ) <=
    if (l hasnode n)
    then nodelinks(m1, n, m2, l :: t)
    else nodelinks(m1, n, l :: m2, t);

! Return the extracted links from the structure returned by nodelinks
dec getlinks : map # map -> map;
--- getlinks ( m, l ) <= l;

! Return the number of links to a specific node in a map
dec numlinks : map # node -> num;
--- numlinks ( m, n ) <= count(getlinks(nodelinks(m, n, [], [])));

!--------------------------------------------------------------------
! MAP-SEARCHING FUNCTIONS

dec findlink : ( map # map ) # node # node # path # path #
    (list (any) # list (any) -> list (any)) -> path;

dec findnode : map # node # node # path # path #
    (list (any) # list (any) -> list (any)) -> path;

! Parameters:
!   m=map, s=start, d=destination, l=link, r=rest,
!   n=node, c=current-path, b=best-path, f=function

--- findlink ( ( m, [] ), s, d, c, b, f ) <= b;
--- findlink ( ( m, l :: r ), s, d, c, b, f ) <=
    f(findlink((l :: m, r), s, d, c, b, f),
      if (n=d) then (c <> [d])
      else findnode(m <> r, n, d, c, b, f)
    ) where n == linknode(l, s);

--- findnode ( [], s, d, c, b, f ) <= b;
--- findnode ( m, s, d, c, b, f ) <=
    f(findlink(nodelinks(m, s, [], []), s, d, c <> [s], b, f), b);

! Return a path between two nodes using a path-selector function
! For efficiency, the search begins from the node with fewer links
dec getpath : map # node # node # 
    (list (any) # list (any) -> list (any)) -> path;
--- getpath ( m, s, d, f ) <=
    if (numlinks(m, s) > numlinks(m, d))
    then reverse(findnode(m, d, s, [], [], f))
    else findnode(m, s, d, [], [], f);


!--------------------------------------------------------------------
! MAP TESTING

!   B
!  / \
! A-E-C  X-Y
!   |/
!   D

dec testmap : map;
--- testmap <=
    [ ("A","B"), ("A","E"), ("B","C"),
      ("C","D"), ("C","E"), ("D","E"), ("X","Y") ];

! Short paths

getpath(testmap, "E", "E", minlist);

getpath(testmap, "A", "D", minlist);

getpath(testmap, "B", "E", minlist);

getpath(testmap, "B", "D", minlist);

! Long paths

getpath(testmap, "E", "E", maxlist);

getpath(testmap, "A", "D", maxlist);

getpath(testmap, "B", "E", maxlist);

getpath(testmap, "B", "D", maxlist);

! Impossible paths

getpath(testmap, "A", "X", minlist);

getpath(testmap, "A", "Z", minlist);

getpath(testmap, "Z", "Y", maxlist);

getpath(testmap, "Z", "Z", maxlist);


!--------------------------------------------------------------------
! TUBE MAP DEFINITIONS

type nodes == list (node);

! Return a map to represent a path
dec pathmap : path -> map;
--- pathmap ( [] ) <= [];
--- pathmap ( n :: [] ) <= [];
--- pathmap ( n :: (m :: r) ) <= (n, m) :: pathmap(m :: r);

! Return a map for a line composed of a list of paths
dec linemap : list (path) -> map;
--- linemap ( [] ) <= [];
--- linemap ( m :: l ) <= pathmap(m) <> linemap(l);

!--------------------------------------------------------------------
! Circle line

dec circles : nodes;
dec circle : map;

--- circles <= [
    "NOTTING HILL GATE", "BAYSWATER", "PADDINGTON", "BAKER STREET",
    "GREAT PORTLAND STREET", "EUSTON SQUARE", "KING'S CROSS",
    "FARRINGDON", "BARBICAN", "MOORGATE", "LIVERPOOL STREET",
    "ALDGATE", "TOWER HILL", "MONUMENT", "CANNON STREET",
    "MANSION HOUSE", "BLACKFRIARS", "TEMPLE", "EMBANKMENT",
    "WESTMINSTER", "ST JAMES'S PARK", "VICTORIA", "SLOANE SQUARE",
    "HIGH STREET KENSINGTON"
];

--- circle <= linemap [
    [ 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13,
      14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 0 ]
];

!--------------------------------------------------------------------
! Central line

dec centrals : nodes;
dec central : map;

--- centrals <= [
    "QUEENSWAY", "LANCASTER GATE", "MARBLE ARCH", "BOND STREET",
    "OXFORD CIRCUS", "TOTTENHAM COURT ROAD", "HOLBORN",
    "CHANCERY LANE", "ST PAUL'S", "BANK"
];

--- central <= linemap [
    [ 0, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 10 ]
];

!--------------------------------------------------------------------
! Northern line

dec northerns : nodes;
dec northern : map;

--- northerns <= [
    "EUSTON", "WARREN STREET", "GOODGE STREET", "LEICESTER SQUARE",
    "CHARING CROSS", "WATERLOO", "KENNINGTON",

    "ANGEL", "OLD STREET", "LONDON BRIDGE", "BOROUGH",
    "ELEPHANT AND CASTLE"
];

--- northern <= linemap [
    [ 34, 35, 36, 29, 37, 38, 18, 39, 40 ],
    [ 34, 6, 41, 42, 9, 33, 43, 44, 45, 40 ]
];

!--------------------------------------------------------------------
! Piccadilly line

dec piccadillys : nodes;
dec piccadilly : map;

--- piccadillys <= [
    "RUSSELL SQUARE", "COVENT GARDEN", "PICCADILLY CIRCUS",
    "GREEN PARK", "HYDE PARK CORNER", "KNIGHTSBRIDGE",
    "SOUTH KENSINGTON", "GLOUCESTER ROAD", "EARL'S COURT"
];

--- piccadilly <= linemap [
    [ 6, 46, 30, 47, 37, 48, 49, 50, 51, 52, 53, 54 ]
];

!--------------------------------------------------------------------
! Victoria line

dec victorias : nodes;
dec victoria : map;

--- victorias <= [];

--- victoria <= linemap [
    [ 6, 34, 35, 28, 49, 21 ]
];

!--------------------------------------------------------------------
! Bakerloo line

dec bakerloos : nodes;
dec bakerloo : map;

--- bakerloos <= [ "EDGWARE ROAD", "MARYLEBONE", "REGENT'S PARK" ];

--- bakerloo <= linemap [
    [ 2, 55, 56, 3, 57, 28, 48, 38, 18 ]
];

!--------------------------------------------------------------------
! TUBE MAP GLOBAL DATA

! Return the number of tube-lines to use (reduce to save memory)
dec numlines : num;
--- numlines <= 4;

! The complete list of station names
dec _names : list (any);
dec  names : nodes;
--- _names <= [ circles, centrals,  northerns,
                piccadillys, victorias, bakerloos ];
---  names <= join(first(numlines, _names));

! The complete London tube map
dec _tube : list (any);
dec  tube : map;
--- _tube <= [ circle, central, northern,
               piccadilly, victoria, bakerloo ];
---  tube <= join(first(numlines, _tube));

!--------------------------------------------------------------------
! TUBE MAP ACCESS FUNCTIONS

! Return the name indexed by a map-node in a node-name list
dec getname : list (node) # node -> node;
--- getname ( [], n ) <= [];
--- getname ( s :: p, n ) <=
    if (n=0) then s else getname(p, n-1);

! Convert all nodes in a path into names
dec getnames : path -> path;
--- getnames ( [] ) <= [];
--- getnames ( n :: p ) <= getname(names, n) :: getnames(p);

! Convert node-names to and from map-indices for getpath
dec route : map # node # node # 
    (list (any) # list (any) -> list (any)) -> path;
--- route ( m, s, d, f ) <=
    if not ((names contains s) and (names contains d)) then []
    else getnames(getpath(m, names indexof s, names indexof d, f));

! Return the shortest route between two stations
dec shortest : node # node -> path;
--- shortest ( s, d ) <= route(tube, s, d, minlist);

! Return the longest route between two stations
dec longest : node # node -> path;
--- longest ( s, d ) <= route(tube, s, d, maxlist);


!--------------------------------------------------------------------
! TUBE-MAP TESTING

tube;

names;

shortest("KING'S CROSS", "MARBLE ARCH");

shortest("KENNINGTON", "KING'S CROSS");

longest("KING'S CROSS", "MARBLE ARCH");

longest("KENNINGTON", "KING'S CROSS");

! END