You cannot select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
76 lines
3.8 KiB
Haskell
76 lines
3.8 KiB
Haskell
2 years ago
|
module LeastReachableCity(dijkstra, leastReachableCity) where
|
||
|
2 years ago
|
|
||
|
|
import Types
|
||
|
|
import qualified Data.Map as Map
|
||
|
|
import qualified Data.Set as Set
|
||
|
|
|
||
|
2 years ago
|
-- Well, it's just a magic number, because it's too much hassle to implement type like "Len val | Infinity"
|
||
|
|
-- TODO: get graph radius and use this number as infinity
|
||
|
2 years ago
|
infinity :: Len
|
||
|
|
infinity = 999999 :: Len
|
||
|
|
|
||
|
2 years ago
|
leastReachableCity :: Graph -> Len -> (Point, Int)
|
||
|
|
leastReachableCity graph mileage = foldl (\(p, n) (p', n') ->
|
||
|
|
if n' < n then (p',n')
|
||
|
|
else (p, n))
|
||
|
|
(-1, infinity) [(city, countReachableCities $ dijkstra city graph) | city <- Set.toList $ fst $ countVertices graph] where
|
||
|
|
countReachableCities :: Distances -> Int
|
||
|
|
countReachableCities distances = Map.foldl (\n val -> if (val <= mileage) && (val /= 0) then n + 1 else n) 0 distances
|
||
|
|
|
||
|
2 years ago
|
dijkstra :: Point -> Graph -> Distances
|
||
|
|
dijkstra start graph = dijkstra' start graph visited_init to_visit_init distances_init where
|
||
|
2 years ago
|
-- Helper (so we don' need to call dijkstra initializing empty visited, to_visit etc)
|
||
|
2 years ago
|
dijkstra' :: Point -> Graph -> Vertices -> Vertices -> Distances -> Distances
|
||
|
|
dijkstra' start graph visited to_visit distances = if Set.null to_visit
|
||
|
|
then
|
||
|
|
distances
|
||
|
|
else
|
||
|
|
dijkstra'
|
||
|
|
(findMinNotVisited to_visit distances)
|
||
|
|
graph
|
||
|
|
(Set.insert start visited)
|
||
|
|
(Set.union (Set.delete start to_visit) $ findNotVisitedNeighbours graph visited start)
|
||
|
|
(updateDistances graph start distances)
|
||
|
|
-- Other
|
||
|
2 years ago
|
to_visit_init = (Set.insert start $ Set.empty :: Vertices)
|
||
|
|
distances_init = (infinityDistances start $ snd $ countVertices graph)
|
||
|
|
visited_init = (Set.empty :: Vertices)
|
||
|
2 years ago
|
|
||
|
|
updateDistances :: Graph -> Point -> Distances -> Distances
|
||
|
|
updateDistances graph point distances = snd $ Map.foldrWithKey decideMin ((point, Map.findWithDefault (-1) point distances), Map.empty :: Distances) distances where
|
||
|
|
decideMin :: Point -> Len -> ((Point, Len), Distances) -> ((Point, Len), Distances)
|
||
|
|
decideMin p' l' ((p, l), dist) = if findDistance graph p p' + l < l' then
|
||
|
|
((p, l), Map.insert p' (l + findDistance graph p p') dist) else
|
||
|
|
((p, l), Map.insert p' l' dist)
|
||
|
|
|
||
|
|
findDistance :: Graph -> Point -> Point -> Len
|
||
|
|
findDistance ((Node (a, b, len)) : graph) p p' = if ((a == p) && (b == p') || (b == p) && (a == p')) then len else findDistance graph p p'
|
||
|
|
findDistance _ _ _ = infinity
|
||
|
|
|
||
|
|
findMinNotVisited :: Vertices -> Distances -> Point
|
||
|
|
findMinNotVisited to_visit distances = fst $ Set.foldl (\(p, l) p' -> case Map.lookup p' distances of
|
||
|
|
(Just l') -> if l' < l then
|
||
|
|
(p', l')
|
||
|
|
else (p,l))
|
||
|
2 years ago
|
(-1, infinity) to_visit
|
||
|
2 years ago
|
|
||
|
|
infinityDistances :: Point -> Int -> Distances
|
||
|
|
infinityDistances point n = Map.fromList $ (point, 0) : [(x, infinity) | x <- [1..n], x /= point]
|
||
|
|
|
||
|
2 years ago
|
countVertices :: Graph -> (Vertices, Int)
|
||
|
|
countVertices graph = foldl f (Set.empty :: Vertices, 0) graph where
|
||
|
2 years ago
|
f :: (Vertices, Int) -> Node -> (Vertices, Int)
|
||
|
|
f (vertices, n) (Node (a, b, _)) =
|
||
|
|
let aIsNotMember = not $ Set.member a vertices
|
||
|
|
bIsNotMember = not $ Set.member b vertices in if (aIsNotMember && bIsNotMember) then (Set.insert a $ Set.insert b vertices, n + 2)
|
||
|
|
else if (aIsNotMember) then (Set.insert a vertices, n + 1)
|
||
|
|
else if (bIsNotMember) then (Set.insert b vertices, n + 1)
|
||
|
|
else (vertices, n)
|
||
|
|
|
||
|
|
findNotVisitedNeighbours :: Graph -> Vertices -> Point -> Vertices
|
||
|
|
findNotVisitedNeighbours graph visited point = foldl f (Set.empty :: Vertices) graph where
|
||
|
|
f :: Vertices -> Node -> Vertices
|
||
|
|
f vertices (Node (a, b, _)) = if ((a == point) && (not $ Set.member b visited)) then Set.insert b vertices
|
||
|
|
else if ((b == point) && (not $ Set.member a visited)) then Set.insert a vertices
|
||
|
|
else vertices
|