Submission #39359250


Source Code Expand

{-# LANGUAGE TupleSections #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE LambdaCase #-}
import Control.Monad
import Data.Maybe
import qualified Data.ByteString.Char8 as BS
import Data.Monoid ()
import Data.List (intercalate, (\\), maximumBy,find)
import Control.Arrow ((&&&), (|||))
import qualified Data.Set as S
import qualified Data.Map.Strict as M
import qualified Data.Vector.Unboxed as VU
import qualified Data.Vector.Unboxed.Mutable as VUM
import Control.Monad.Trans.State
-- import Data.Tree
import Data.Array

import Data.Graph.Inductive.PatriciaTree ( UGr ) 
import Data.Graph.Inductive
    ( neighbors', Graph(mkGraph, match), Node, suc' ) 
import Data.Graph.Inductive.Basic
import Data.Graph.Inductive.Query.DFS
import Data.Tree


readInt :: BS.ByteString -> Int
readInt = fst . fromJust . BS.readInt
readIntList :: BS.ByteString -> [Int]
readIntList = map readInt . BS.words
readIntTuple :: BS.ByteString -> (Int, Int)
readIntTuple = (\[x, y] -> (x, y)) . readIntList
getInt :: IO Int
getInt = readInt <$> BS.getLine
getInts :: IO [Int]
getInts = readIntList <$> BS.getLine
getIntTuple :: IO (Int, Int)
getIntTuple = readIntTuple <$> BS.getLine
getIntNLists :: Int -> IO [[Int]]
getIntNLists n = fmap readIntList <$> replicateM n BS.getLine 
getIntMatrix :: IO ([[Int]])
getIntMatrix = fmap readIntList . BS.lines <$> BS.getContents
getIntNTuples :: Int -> IO [(Int, Int)]
getIntNTuples n = fmap readIntTuple <$> replicateM n BS.getLine
getIntTuples :: IO [(Int, Int)]
getIntTuples = fmap readIntTuple . BS.lines <$> BS.getContents




-- data TreeF a x =  Node a [x] deriving (Show, Eq, Ord)

-- newtype Fix f = In { out :: f (Fix f) }

-- type Tree a = Fix (TreeF a)

-- cata :: Functor f => (f b -> b) -> Fix f -> b
-- cata f = f . fmap (cata f) . out

-- newtype AdjacencyMap a = AM { unAM :: M.Map a (S.Set a) } deriving ( Eq, Ord , Show)

-- edgesToUAdj :: Ord a => [(a, a)] -> AdjacencyMap a
-- edgesToUAdj edges = AM $ M.fromListWith S.union $ concatMap (\(x, y) -> [(x, S.singleton y), (y, S.singleton x)]) edges


-- edgesToArray :: Int -> [(Int, Int)] -> Array Int [Int]
-- edgesToArray n edges = accumArray (flip (:)) [] (1, n) $ concatMap (\(x, y) -> [(x, y), (y, x)]) edges

-- nextPath :: Ord a => AdjacencyMap a -> [a] -> [[a]]
-- nextPath g path = [h:path | h <- S.toList ((unAM g) M.! head path) , h `notElem` path]

-- nextPathA :: (Ix i, Num i, Ord i) => Array i [i] -> [i] -> [[i]]
-- nextPathA g path = [h:path | h <- g ! head path , h `notElem` path]

-- dfs (AM g) starts goal = go [starts]  where 
--   go [] = []
--   go (x:xs) 
--     | head x == goal = x : (go xs)
--     | otherwise = go ([h:x | h <- S.toList (g M.! (head x)) , h `notElem` x] ++ xs)

-- dfs' (AM g) starts goal = search [starts] [] where 
--   search path@(x:xs) ys
--     | x == goal = path : ys
--     | otherwise = foldl (flip search) ys [h:path | h <- S.toList (g M.! x) , h `notElem` path]

-- dfsA :: (Ix i, Num i, Ord i) => Array i [i] -> i -> i -> Maybe [i]
-- dfsA g start goal = go [start] where
--   go [] = Nothing
--   go path@(x:xs) 
--     | x == goal = Just $ path
--     | otherwise = msum $ map (\t -> go (t:path)) [h | h <- g ! head path , h `notElem` path]


-- dfs :: (MonadPlus m) => Array Int [Int] -> Int -> Int -> m [Int]
-- dfs g start goal = go [start] S.empty
--   where
--     go [] _ = mzero
--     go path visited
--       | head path == goal = return path
--       | otherwise = msum $ map (\t -> go (t:path) (S.insert t visited)) [h | h <- g ! head path , h `S.notMember` visited]

-- dfs'' :: Ord a => AdjacencyMap a -> a -> a -> Maybe [a]
-- dfs'' g start goal = go [start] S.empty where 
--   go [] _ = Nothing
--   go path@(x:xs) visited
--     | x == goal = Just $ path
--     | otherwise = msum $ map (\t -> go (t:path) (S.insert t visited)) [h | h <- S.toList ((unAM g) M.! x) , h `S.notMember` visited]
--     -- (nextPath g x ++ xs)

-- bfs :: Ord a => AdjacencyMap a -> a -> a -> [[a]]
-- bfs (AM g) start goal = go (push [start] empty) where
--   go q
--     | isEmpty q = []
--     | otherwise = 
--       let (path, q') = fromJust $ pop q
--       in if head path == goal then path : go q' 
--           else go $ foldl (flip push) q' $ [h:path | h <- S.toList (g M.! head path) , h `notElem` path]




-- search :: (a -> Bool) -> (a -> b) -> (b -> [a] -> [a]) -> [a] -> [a]
-- search _ _ _ [] = []
-- search isGoal nextState combine (x:xs) 
--   | isGoal x = x : search isGoal nextState combine xs
--   | otherwise = search isGoal nextState combine $ combine (nextState x) xs

-- search' :: (a -> Bool) -> (a -> b) -> (b -> [a] -> [a]) -> [a] -> Maybe a
-- search' _ _ _ [] = Nothing
-- search' isGoal nextState combine (x:xs) 
--   | isGoal x = Just x
--   | otherwise = search' isGoal nextState combine $ combine (nextState x) xs

-- searchM :: MonadPlus m => (a -> Bool) -> (a -> b) -> (b -> [a] -> [a]) -> [a] -> m a
-- searchM _ _ _ [] = mzero
-- searchM isGoal nextState combine (x:xs) 
--   | isGoal x = return x `mplus` searchM isGoal nextState combine xs
--   | otherwise = searchM isGoal nextState combine $ combine (nextState x) xs

-- dfs''' :: Ord a => AdjacencyMap a -> a -> a -> [[a]]
-- dfs''' g start goal = search ((== goal) . head) (nextPath g) ((++)) [[start]]

-- dfs'''' :: Ord a => AdjacencyMap a -> a -> a -> Maybe [a]
-- dfs'''' g start goal = search' ((== goal) . head) (nextPath g) (flip (++)) [[start]]

-- dfsM :: (MonadPlus m, Ord b) => AdjacencyMap b -> b -> b -> m [b]
-- dfsM g start goal = searchM ((== goal) . head) (nextPath g) (++) [[start]]

-- dfsForestFromImpl ::  Array Int [Int]  -> [Int] -> [Tree Int]
-- dfsForestFromImpl g vs = evalState (explore vs) S.empty
--   where
--     explore (v:vs) = discovered v >>= \case
--       True -> (:) <$> walk v <*> explore vs
--       False -> explore vs
--     explore [] = return []
--     walk v = Node v <$> explore (g ! v)
--     discovered v = do new <- gets (not . S.member v)
--                       when new $ modify' (S.insert v)
--                       return new
                      
-- dfsFrom :: Array Int [Int] -> [Int] -> [Int]
-- dfsFrom g vs = concatMap flatten $ dfsForestFromImpl g vs 


data Queue a = Queue { enqueue :: [a], dequeue :: [a] } deriving (Eq, Show)

empty :: Queue a
empty = Queue [] []

isEmpty :: Queue a -> Bool
isEmpty (Queue [] []) = True
isEmpty _ = False

push :: a -> Queue a -> Queue a
push x (Queue enq deq) = Queue (x:enq) deq

pop :: Queue a -> Maybe (a, Queue a)
pop (Queue [] []) = Nothing
pop (Queue enq []) = pop (Queue [] (reverse enq))
pop (Queue enq (x:xs)) = Just (x, Queue enq xs)

-- dfs :: MonadPlus m => (([Int] , S.Set Int) -> Bool) ->  Array Int [Int] -> Int -> m ([Int], S.Set Int)
-- dfs isGoal g start = runStateT (go [start]) (S.empty) where
--   go :: (MonadPlus m) => [Int] -> StateT (S.Set Int) m [Int]
--   go [] = mzero
--   go path@(x:xs) = do
--     visited <- get
--     if S.member x visited then go xs else do
--       put $ S.insert x visited
--       if isGoal (path , visited) then return path else msum $ map (\t -> go (t:path)) [h | h <- g ! x , h `S.notMember` visited]

-- dfs ::MonadPlus  m => (([Int] , S.Set Int) -> Bool) ->  Array Int [Int] -> Int -> m [Int]
-- dfs isGoal g start = go [start] (S.empty) where
--   go [] _ = mzero
--   go todos@(t:ts) seen 
--     | t `S.member` seen = go ts seen
--     | isGoal (todos, seen) = pure [t]
--     | otherwise = ((t:) <$> (go (g ! t)  (S.insert t seen)))  `mplus` go ts seen



-- dfsPath :: (Graph gr) => gr a b -> Node -> Int -> Maybe [Node]
-- dfsPath g start goal = go [start] g
--   where 
--     go [] _ = Nothing
--     go (v:vs) g = case match v g of
--       (Nothing,_) -> go vs g
--       (Just c@(p,v,l,s),g') -> 
--         if v == goal then Just [v] 
--         else case go (neighbors' c) g' of
--           Nothing -> go vs g'
--           Just path -> Just (v:path)



simplePath :: Eq a => a -> Tree a  -> Maybe [a]
simplePath goal (Node v ts) = go v ts
  where
    go v [] = if v == goal then Just [v] else Nothing
    go v (t:ts) = case simplePath goal t of
      Nothing -> go v ts
      Just path -> Just (v:path)



main :: IO ()
main = do
  [n,m] <- getInts
  es <- getIntTuples
  let g = mkGraph (zip [1..n] (repeat ())) $ map (\(a,b) -> (a,b,())) es :: UGr
  let ans = fromJust $ simplePath n $ head $ udff [1] g
  putStrLn $ (unwords . map show $ ans ) <> " "

Submission Info

Submission Time
Task B62 - Print a Path
User g960059
Language Haskell (GHC 8.8.3)
Score 1000
Code Size 8445 Byte
Status AC
Exec Time 681 ms
Memory 122700 KiB

Compile Error

Loaded package environment from /home/contestant/.ghc/x86_64-linux-8.8.3/environments/default

Judge Result

Set Name Sample All
Score / Max Score 0 / 0 1000 / 1000
Status
AC × 2
AC × 10
Set Name Test Cases
Sample sample00.txt, sample01.txt
All 00.txt, 01.txt, 02.txt, 03.txt, 04.txt, 05.txt, 06.txt, 07.txt, sample00.txt, sample01.txt
Case Name Status Exec Time Memory
00.txt AC 14 ms 7300 KiB
01.txt AC 14 ms 7448 KiB
02.txt AC 233 ms 46748 KiB
03.txt AC 115 ms 20300 KiB
04.txt AC 320 ms 60280 KiB
05.txt AC 468 ms 56140 KiB
06.txt AC 351 ms 63480 KiB
07.txt AC 681 ms 122700 KiB
sample00.txt AC 4 ms 4068 KiB
sample01.txt AC 2 ms 4200 KiB