gistfile1.hs

import Data.Map(Map(..), (!), empty, findWithDefault, foldWithKey, fromList, insert)
import Data.Map as M

data City = Boise 
          | LosAngeles 
          | NewYork 
          | Seattle
          | StLouis 
          | Phoenix 
          | Boston 
          | Chicago
          | Denver
          deriving (Show, Eq, Ord)
          
type CityMatrix = Map City (Map City Int)          
          
transposeCombine :: (Ord k) => Map k (Map k a) -> Map k (Map k a)
transposeCombine m =
  foldWithKey transpose m m 
    where transpose k1 m' acc = 
            let transposeInner k2 v acc' = 
                 insert k2 (insert k1 v $ findWithDefault empty k2 acc') acc'
            in foldWithKey transposeInner acc m'

distanceBetweenCities :: CityMatrix            
distanceBetweenCities =
  transposeCombine $
  fromList
    [
        (Boise, fromList [(Seattle, 496),(Denver, 830),(Chicago, 1702)]),
        (Seattle, fromList [(LosAngeles, 1141),(Denver, 1321)]),
        (LosAngeles, fromList [(Denver, 1022),(Phoenix, 371)]),
        (Phoenix, fromList [(Denver, 809),(StLouis, 1504)]),
        (Denver, fromList [(StLouis, 588),(Chicago, 1009)]),
        (Chicago, fromList [(NewYork, 811),(Boston, 986)]),
        (StLouis, fromList [(Chicago, 300)]),
        (Boston, fromList [(StLouis, 986)]),
        (NewYork, fromList [(Boston, 211)])
    ]

shortestPathBetween :: City -> City -> (Int, [City])
shortestPathBetween startCity endCity =
  shortestPaths ! endCity
    where shortestPaths = searchForShortestPath startCity 0 [] empty
          searchForShortestPath currentCity distanceSoFar citiesVisitedSoFar accMap = 
            -- Go through each destination
            let visitDestinations m = 
                  foldWithKey accSearch m $ distanceBetweenCities ! currentCity
                    where accSearch city distance = 
                            searchForShortestPath city (distance + distanceSoFar) (citiesVisitedSoFar ++ [city])
                -- Insert a destination
                insertDestination = visitDestinations $ insert currentCity (distanceSoFar, citiesVisitedSoFar) accMap
            
            -- Is this an optimal route?
            in case M.lookup currentCity accMap of
              Nothing -> insertDestination
              Just (shortestKnownPath, _) -> 
                         case distanceSoFar < shortestKnownPath of
                           True -> insertDestination
                           _    -> accMap