import Data.IntMap.Strict (IntMap, (!)) import qualified Data.IntMap.Strict as M import qualified Data.Set as S import qualified Data.ByteString.Char8 as B import qualified Data.Array.IArray as A import Data.Maybe import Data.List type Vertex = Int type Cost = Int type Edge = (Vertex, (Vertex, Cost)) type Path = [Vertex] type Graph = A.Array Vertex (S.Set (Vertex, Cost)) type Heap = S.Set (Cost, Vertex) nullq :: Heap -> Bool nullq = S.null empty :: Heap empty = S.empty push :: Cost -> Vertex -> Heap -> Heap push c v = S.insert (c,v) pop :: Heap -> ((Cost, Vertex), Heap) pop = S.deleteFindMin readUndirectedEdge :: B.ByteString -> [Edge] readUndirectedEdge = concatMap ((\[v,w,l] -> [(v,(w,l)),(w,(v,l))]) . map readVertex . B.words) . B.lines readVertex :: B.ByteString -> Vertex readVertex = fst . fromJust . B.readInt buildG :: Int -> [Edge] -> Graph buildG n = A.accumArray (flip S.insert) S.empty (0, n-1) from :: Graph -> Vertex -> S.Set (Vertex, Cost) from g = (g A.!) main :: IO () main = do [n,_,vs,vg] <- map read . words <$> getLine es <- readUndirectedEdge <$> B.getContents let g = buildG n es putStrLn $ unwords $ map show (route g vs vg) route :: Graph -> Vertex -> Vertex -> Path route g vs vg = unfoldr (backtrack imr) vs ++ [vg] where imr = dijkstra g q0 im0 im0 = M.singleton vg (0,[]) q0 = push 0 vg empty backtrack :: IntMap (Cost, Path) -> Vertex -> Maybe (Vertex, Vertex) backtrack im v = case im!v of (_,[]) -> Nothing (_,(vp:_)) -> Just (v,vp) dijkstra :: Graph -> Heap -> IntMap (Cost, Path) -> IntMap (Cost, Path) dijkstra g q im | nullq q = im | otherwise = dijkstra g q'' im' where ((c0,v),q') = pop q im' = S.foldl' (\acc (b,c) -> M.insertWith mindic b (c0+c,[v]) acc) im vns q'' = S.foldl' (\acc (b,c) -> push (c0+c) b acc) q' vns vns = S.filter (\(b,c) -> M.notMember b im || c0+c <= fst (im!b)) (from g v) mindic :: (Cost, Path) -> (Cost, Path) -> (Cost, Path) mindic (_,[]) (_,_) = undefined mindic (c1,v1@(v:_)) (c2,v2) | c1 < c2 = (c1,v1) | c1 == c2 = (c1, insert v v2) | otherwise = undefined