Rick and his co-workers have made a new radioactive formula and a lot of bad guys are after them. So Rick wants to give his legacy to Morty before bad guys catch them. There are n planets in their universe numbered from 1 to n. Rick is in planet number s (the earth) and he doesn't know where Morty is. As we all know, Rick owns a portal gun. With this gun he can open one-way portal from a planet he is in to any other planet (including that planet). But there are limits on this gun because he's still using its free trial.  By default he can not open any portal by this gun. There are q plans in the website that sells these guns. Every time you purchase a plan you can only use it once but you can purchase it again if you want to use it more.Plans on the website have three types:  With a plan of this type you can open a portal from planet v to planet u.  With a plan of this type you can open a portal from planet v to any planet with index in range [l, r].  With a plan of this type you can open a portal from any planet with index in range [l, r] to planet v. Rick doesn't known where Morty is, but Unity is going to inform him and he wants to be prepared for when he finds and start his journey immediately. So for each planet (including earth itself) he wants to know the minimum amount of money he needs to get from earth to that planet.

The first line of input contains three integers n, q and s (1 ≤ n, q ≤ 105, 1 ≤ s ≤ n) — number of planets, number of plans and index of earth respectively. The next q lines contain the plans. Each line starts with a number t, type of that plan (1 ≤ t ≤ 3). If t = 1 then it is followed by three integers v, u and w where w is the cost of that plan (1 ≤ v, u ≤ n, 1 ≤ w ≤ 109). Otherwise it is followed by four integers v, l, r and w where w is the cost of that plan (1 ≤ v ≤ n, 1 ≤ l ≤ r ≤ n, 1 ≤ w ≤ 109).

In the first and only line of output print n integers separated by spaces. i-th of them should be minimum money to get from earth to i-th planet, or  - 1 if it's impossible to get to that planet.

NoteIn the first sample testcase, Rick can purchase 4th plan once and then 2nd plan in order to get to get to planet number 2.

{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TupleSections    #-}

import           Control.Applicative
import           Control.Monad.ST.Safe
import           Control.Monad.State.Strict
import           Data.Array.ST.Safe
import           Data.Array.Unboxed
import qualified Data.ByteString.Char8      as BS
import           Data.List                  (unfoldr)
import           Data.STRef

type Cost = Integer

data Edge      = Edge !Cost !Int deriving (Eq, Ord, Show)
type EdgeArr s = STArray s Int [Edge]
type Graph     = Array Int [Edge]
type SegArr  s = STUArray s Int Int

data Prio  s   = Prio (STArray s Int Cost) (STRef s Int) (STUArray s Int Int) (STUArray s Int Int)

putPrio::Prio s->Int->Int->ST s ()
putPrio (Prio _ _ arr idx) i x = do
  writeArray arr i x
  writeArray idx x i

newPrio::STArray s Int Cost->ST s (Prio s)
newPrio values = do
    bs <-  getBounds values
    let n  = rangeSize bs
    len <- newSTRef 0
    arr <- newArray_ (0, n)
    idx <- newArray  bs (-1)
    return $ Prio values len arr idx

pushPrio::Prio s->Int->ST s ()
pushPrio prio@(Prio _ ref _ _) x = do
  n <- readSTRef ref
  writeSTRef ref (n + 1)
  putPrio prio n x
  fixUp prio n

deletePrio::Prio s->Int->ST s ()
deletePrio prio@(Prio val ref arr idx) x = do
  n <- readSTRef ref
  writeSTRef ref (n - 1)
  i <- readArray idx x
  xv <- readArray val x
  w <- readArray arr (n - 1)
  wv <- readArray val w
  putPrio prio i w
  case compare xv wv of
    EQ -> return ()
    LT -> fixDown prio i
    GT -> void $ fixUp prio i

pullPrio::Prio s->ST s Int
pullPrio prio@(Prio _ ref arr _) = do
  n <- readSTRef ref
  writeSTRef ref (n - 1)
  x <- readArray arr 0
  w <- readArray arr (n - 1)
  putPrio prio 0 w
  fixDown prio 0
  return x

nullPrio::Prio s->ST s Bool
nullPrio (Prio _ ref _ _) = (== 0) <$> readSTRef ref

fixUp::Prio s->Int->ST s ()
fixUp _ 0     = return ()
fixUp prio@(Prio val _ arr _) start  = do
  x <- readArray arr start
  xv <- readArray val x
  let go 0 = return 0
      go i = do
        let p = quot (i - 1)  2
        px <- readArray arr p
        pv <- readArray val px
        if xv >= pv then return i else putPrio prio i px >> go p
  top <- go start
  unless (top == start) $ putPrio prio top x

fixDown::Prio s->Int->ST s ()
fixDown prio@(Prio val ref arr _) start = do
  size <- readSTRef ref
  x <- readArray arr start
  xv <- readArray val x
  let go i | 2 * i + 1 >= size = return i
           | 2 * i + 2 == size = do
             let c = 2 * i + 1
             cx <- readArray arr c
             cv <- readArray val cx
             if xv <= cv then return i else putPrio prio i cx >> return c
           | otherwise  = do
            let l = 2 * i + 1
                r = 2 * i + 2
            lx <- readArray arr l
            rx <- readArray arr r
            lv <- readArray val lx
            rv <- readArray val rx
            let goLeft  = putPrio prio i lx >> go l
                goRight = putPrio prio i rx >> go r
            if xv <= lv then
              if xv <= rv then return i else goRight
            else
              if lv <= rv then goLeft else goRight
  bottom <- go start
  unless(bottom == start) $ putPrio prio bottom x

getInts::IO [Int]
getInts = fmap (unfoldr readOne) BS.getLine where
  readOne s = do
    (x , s') <- BS.readInt s
    return (x, BS.drop 1 s')

addEdge::Int->Int->Cost->EdgeArr s->ST s ()
addEdge a b p arr = do
  lst <- readArray arr a
  writeArray arr a $ Edge p b : lst

buildSegTree::Int->ST s (SegArr s, EdgeArr s)
buildSegTree n = do
  edges <- newArray (-maxIdx, maxIdx) []
  segs  <- newArray_ (0, n)
  let link l r i j = do
        addEdge i j 0 edges
        addEdge (-j) (-i) 0 edges
        go l r j
      go l r idx | l+1>=r    = do
                    writeArray segs r idx
                    addEdge idx (-idx) 0 edges
                 | otherwise = do
                   let mid = quot (l + r + 1) 2
                   link l mid idx (2*idx)
                   link mid r idx (2*idx + 1)
  go 0 n 1
  return (segs, edges)
  where
    calcMax l r u | l + 1 >= r = u
                  | otherwise = let m = quot (l+r+1) 2
                                in calcMax l m (2*u) `max` calcMax m r (2*u+1)
    maxIdx = calcMax 0 n 1

multiEdge::Bool->Int->Int->Int->Int->Cost->SegArr s->EdgeArr s->ST s ()
multiEdge inverse n start endL endR c seg edge = go 0 n 1 where
  go l r idx | l >= endR || r < endL   = return () -- fully outside
             | l >= endL - 1 && r <= endR = do        -- fully inside
                 u <- readArray seg start
                 unless inverse $ addEdge (-u) idx c edge
                 when   inverse $ addEdge (-idx) u c edge
             | otherwise              = do
                let mid = quot (l + r + 1) 2
                go l mid  (idx*2)
                go mid r  (idx*2 + 1)

buildGraph::Int->[[Int]]->(Array Int [Edge], UArray Int Int)
buildGraph n queries = runST $ do
  (seg, edge) <- buildSegTree n
  let runQuery [1, v, u, w]    = do
        f <- readArray seg v
        t <- readArray seg u
        addEdge (- f) t (fromIntegral w) edge
      runQuery [2, v, l, r, w] = multiEdge False n v l r (fromIntegral w) seg edge
      runQuery [3, v, l, r, w] = multiEdge True  n v l r (fromIntegral w) seg edge
      runQuery _               = return ()
  forM_ queries runQuery
  graph <- freeze edge
  segMap <- freeze seg
  return (graph, segMap)

dijkstra::Graph->Int->Array Int Cost
dijkstra graph s = runSTArray $ do
  best <- newArray (bounds graph) (-1)
  prio <- newPrio best
  writeArray best s 0
  pushPrio prio s
  let go = do
         end <- nullPrio prio
         unless end $ do
           num  <- pullPrio prio
           dist <- readArray best num
           let edges = graph ! num
           check dist edges
           go
      better _ (-1)  = True
      better price x = price < x
      check _   [] = return ()
      check acc (Edge cost to: rest) = do
        let price = acc + cost
        current <- readArray best to
        when (price `better` current) $ do
          when (current /= -1) $ deletePrio prio to
          writeArray best to price
          void $ pushPrio prio to
        check acc rest
  go
  return best

main :: IO ()
main = do
  [n,q,s] <- getInts
  qs <- replicateM q getInts
  let (graph, segMap)  = buildGraph n qs
  -- forM_ (assocs graph) $ \(i, es) -> putStrLn $ show i <> ": " <> show es
  let best = dijkstra graph $ segMap ! s
  putStrLn $ unwords  [show $ best ! (segMap ! i) | i <- [1..n]]
--
-- validatePrio::Prio s->ST s Bool
-- validatePrio (Prio cmp ref arr _) = do
--   size <- readSTRef ref
--   let go i | 2 *i + 1>= size = return True
--            | 2* i + 2 == size = do
--         x <- readArray arr i
--         c <- readArray arr (2 * i + 1)
--         res <- cmp x c
--         unless res $ traceShowM $ show (x, c)
--         return res
--            | otherwise = do
--         x <- readArray arr i
--         l <- readArray arr (2 * i + 1)
--         r <- readArray arr (2 * i + 2)
--         vl <- cmp x l
--         vr <- cmp x r
--         unless vl $ traceShowM $ show (x, l)
--         unless vr $ traceShowM $ show (x, r)
--         vvl <- go (2 * i + 1)
--         vvr <- go (2 * i + 2)
--         return $ vl && vr && vvl && vvr
--   go 0

{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TupleSections    #-}

import           Control.Applicative
import           Control.Monad.ST.Safe
import           Control.Monad.State.Strict
import           Data.Array.ST.Safe
import           Data.Array.Unboxed
import qualified Data.ByteString.Char8      as BS
import           Data.List                  (unfoldr)
import           Data.STRef

type Cost = Integer

data Edge      = Edge !Cost !Int deriving (Eq, Ord, Show)
type EdgeArr s = STArray s Int [Edge]
type Graph     = Array Int [Edge]
type SegArr  s = STUArray s Int Int

data Prio  s   = Prio (STArray s Int Cost) (STRef s Int) (STUArray s Int Int) (STUArray s Int Int)

putPrio::Prio s->Int->Int->ST s ()
putPrio (Prio _ _ arr idx) i x = do
  writeArray arr i x
  writeArray idx x i

newPrio::STArray s Int Cost->ST s (Prio s)
newPrio values = do
    bs <-  getBounds values
    let n  = rangeSize bs
    len <- newSTRef 0
    arr <- newArray_ (0, n)
    idx <- newArray  bs (-1)
    return $ Prio values len arr idx

pushPrio::Prio s->Int->ST s ()
pushPrio prio@(Prio _ ref _ _) x = do
  n <- readSTRef ref
  writeSTRef ref (n + 1)
  putPrio prio n x
  fixUp prio n

deletePrio::Prio s->Int->ST s ()
deletePrio prio@(Prio val ref arr idx) x = do
  n <- readSTRef ref
  writeSTRef ref (n - 1)
  i <- readArray idx x
  xv <- readArray val x
  w <- readArray arr (n - 1)
  wv <- readArray val w
  putPrio prio i w
  case compare xv wv of
    EQ -> return ()
    LT -> fixDown prio i
    GT -> void $ fixUp prio i

pullPrio::Prio s->ST s Int
pullPrio prio@(Prio _ ref arr _) = do
  n <- readSTRef ref
  writeSTRef ref (n - 1)
  x <- readArray arr 0
  w <- readArray arr (n - 1)
  putPrio prio 0 w
  fixDown prio 0
  return x

nullPrio::Prio s->ST s Bool
nullPrio (Prio _ ref _ _) = (== 0) <$> readSTRef ref

fixUp::Prio s->Int->ST s ()
fixUp _ 0     = return ()
fixUp prio@(Prio val _ arr _) start  = do
  x <- readArray arr start
  xv <- readArray val x
  let go 0 = return 0
      go i = do
        let p = quot (i - 1)  2
        px <- readArray arr p
        pv <- readArray val px
        if xv >= pv then return i else putPrio prio i px >> go p
  top <- go start
  unless (top == start) $ putPrio prio top x

fixDown::Prio s->Int->ST s ()
fixDown prio@(Prio val ref arr _) start = do
  size <- readSTRef ref
  x <- readArray arr start
  xv <- readArray val x
  let go i | 2 * i + 1 >= size = return i
           | 2 * i + 2 == size = do
             let c = 2 * i + 1
             cx <- readArray arr c
             cv <- readArray val cx
             if xv <= cv then return i else putPrio prio i cx >> return c
           | otherwise  = do
            let l = 2 * i + 1
                r = 2 * i + 2
            lx <- readArray arr l
            rx <- readArray arr r
            lv <- readArray val lx
            rv <- readArray val rx
            let goLeft  = putPrio prio i lx >> go l
                goRight = putPrio prio i rx >> go r
            if xv <= lv then
              if xv <= rv then return i else goRight
            else
              if lv <= rv then goLeft else goRight
  bottom <- go start
  unless(bottom == start) $ putPrio prio bottom x

getInts::IO [Int]
getInts = fmap (unfoldr readOne) BS.getLine where
  readOne s = do
    (x , s') <- BS.readInt s
    return (x, BS.drop 1 s')

addEdge::Int->Int->Cost->EdgeArr s->ST s ()
addEdge a b p arr = do
  lst <- readArray arr a
  writeArray arr a $ Edge p b : lst

buildSegTree::Int->ST s (SegArr s, EdgeArr s)
buildSegTree n = do
  edges <- newArray (-maxIdx, maxIdx) []
  segs  <- newArray_ (0, n)
  let link l r i j = do
        addEdge i j 0 edges
        addEdge (-j) (-i) 0 edges
        go l r j
      go l r idx | l+1>=r    = do
                    writeArray segs r idx
                    addEdge idx (-idx) 0 edges
                 | otherwise = do
                   let mid = quot (l + r + 1) 2
                   link l mid idx (2*idx)
                   link mid r idx (2*idx + 1)
  go 0 n 1
  return (segs, edges)
  where
    calcMax l r u | l + 1 >= r = u
                  | otherwise = let m = quot (l+r+1) 2
                                in calcMax l m (2*u) `max` calcMax m r (2*u+1)
    maxIdx = calcMax 0 n 1

multiEdge::Bool->Int->Int->Int->Int->Cost->SegArr s->EdgeArr s->ST s ()
multiEdge inverse n start endL endR c seg edge = go 0 n 1 where
  go l r idx | l >= endR || r < endL   = return () -- fully outside
             | l >= endL - 1 && r <= endR = do        -- fully inside
                 u <- readArray seg start
                 unless inverse $ addEdge (-u) idx c edge
                 when   inverse $ addEdge (-idx) u c edge
             | otherwise              = do
                let mid = quot (l + r + 1) 2
                go l mid  (idx*2)
                go mid r  (idx*2 + 1)

buildGraph::Int->[[Int]]->(Array Int [Edge], UArray Int Int)
buildGraph n queries = runST $ do
  (seg, edge) <- buildSegTree n
  let runQuery [1, v, u, w]    = do
        f <- readArray seg v
        t <- readArray seg u
        addEdge (- f) t (fromIntegral w) edge
      runQuery [2, v, l, r, w] = multiEdge False n v l r (fromIntegral w) seg edge
      runQuery [3, v, l, r, w] = multiEdge True  n v l r (fromIntegral w) seg edge
      runQuery _               = return ()
  forM_ queries runQuery
  graph <- freeze edge
  segMap <- freeze seg
  return (graph, segMap)

dijkstra::Graph->Int->Array Int Cost
dijkstra graph s = runSTArray $ do
  best <- newArray (bounds graph) (-1)
  prio <- newPrio best
  writeArray best s 0
  pushPrio prio s
  let go = do
         end <- nullPrio prio
         unless end $ do
           num  <- pullPrio prio
           dist <- readArray best num
           let edges = graph ! num
           mapM_ (check dist) edges
           go
      better _ (-1)  = True
      better price x = price < x
      check acc (Edge cost to) = do
        let price = acc + cost
        current <- readArray best to
        when (price `better` current) $ do
          when (current /= -1) $ deletePrio prio to
          writeArray best to price
          void $ pushPrio prio to
  go
  return best

main :: IO ()
main = do
  [n,q,s] <- getInts
  qs <- replicateM q getInts
  let (graph, segMap)  = buildGraph n qs
  -- forM_ (assocs graph) $ \(i, es) -> putStrLn $ show i <> ": " <> show es
  let best = dijkstra graph $ segMap ! s
  putStrLn $ unwords  [show $ best ! (segMap ! i) | i <- [1..n]]
--
-- validatePrio::Prio s->ST s Bool
-- validatePrio (Prio cmp ref arr _) = do
--   size <- readSTRef ref
--   let go i | 2 *i + 1>= size = return True
--            | 2* i + 2 == size = do
--         x <- readArray arr i
--         c <- readArray arr (2 * i + 1)
--         res <- cmp x c
--         unless res $ traceShowM $ show (x, c)
--         return res
--            | otherwise = do
--         x <- readArray arr i
--         l <- readArray arr (2 * i + 1)
--         r <- readArray arr (2 * i + 2)
--         vl <- cmp x l
--         vr <- cmp x r
--         unless vl $ traceShowM $ show (x, l)
--         unless vr $ traceShowM $ show (x, r)
--         vvl <- go (2 * i + 1)
--         vvr <- go (2 * i + 2)
--         return $ vl && vr && vvl && vvr
--   go 0

{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TupleSections    #-}

import           Control.Applicative
import           Control.Monad.ST.Safe
import           Control.Monad.State.Strict
import           Data.Array.ST.Safe
import           Data.Array.Unboxed
import qualified Data.ByteString.Char8      as BS
import           Data.List                  (unfoldr)
import           Data.STRef

type Cost = Integer

data Edge      = Edge !Cost !Int deriving (Eq, Ord, Show)
type EdgeArr s = STArray s Int [Edge]
type Graph     = Array Int [Edge]
type SegArr  s = STUArray s Int Int

data Prio  s   = Prio (STArray s Int Cost) (STRef s Int) (STUArray s Int Int) (STUArray s Int Int)

putPrio::Prio s->Int->Int->ST s ()
putPrio (Prio _ _ arr idx) i x = do
  writeArray arr i x
  writeArray idx x i

newPrio::STArray s Int Cost->ST s (Prio s)
newPrio values = do
    bs <-  getBounds values
    let n  = rangeSize bs
    len <- newSTRef 0
    arr <- newArray_ (0, n)
    idx <- newArray  bs (-1)
    return $ Prio values len arr idx

pushPrio::Prio s->Int->ST s ()
pushPrio prio@(Prio _ ref _ _) x = do
  n <- readSTRef ref
  writeSTRef ref (n + 1)
  putPrio prio n x
  fixUp prio n

deletePrio::Prio s->Int->ST s ()
deletePrio prio@(Prio val ref arr idx) x = do
  n <- readSTRef ref
  writeSTRef ref (n - 1)
  i <- readArray idx x
  xv <- readArray val x
  w <- readArray arr (n - 1)
  wv <- readArray val w
  putPrio prio i w
  case compare xv wv of
    GT -> void $ fixUp prio i
    EQ -> return ()
    LT -> fixDown prio i

pullPrio::Prio s->ST s Int
pullPrio prio@(Prio _ ref arr _) = do
  n <- readSTRef ref
  writeSTRef ref (n - 1)
  x <- readArray arr 0
  w <- readArray arr (n - 1)
  putPrio prio 0 w
  fixDown prio 0
  return x

nullPrio::Prio s->ST s Bool
nullPrio (Prio _ ref _ _) = (== 0) <$> readSTRef ref

fixUp::Prio s->Int->ST s ()
fixUp _ 0     = return ()
fixUp prio@(Prio val _ arr _) start  = do
  x <- readArray arr start
  xv <- readArray val x
  let go 0 = return 0
      go i = do
        let p = quot (i - 1)  2
        px <- readArray arr p
        pv <- readArray val px
        if xv >= pv then return i else putPrio prio i px >> go p
  top <- go start
  unless (top == start) $ putPrio prio top x

fixDown::Prio s->Int->ST s ()
fixDown prio@(Prio val ref arr _) start = do
  size <- readSTRef ref
  x <- readArray arr start
  xv <- readArray val x
  let go i | 2 * i + 1 >= size = return i
           | 2 * i + 2 == size = do
             let c = 2 * i + 1
             cx <- readArray arr c
             cv <- readArray val cx
             if xv <= cv then return i else putPrio prio i cx >> return c
           | otherwise  = do
            let l = 2 * i + 1
                r = 2 * i + 2
            lx <- readArray arr l
            rx <- readArray arr r
            lv <- readArray val lx
            rv <- readArray val rx
            let goLeft  = putPrio prio i lx >> go l
                goRight = putPrio prio i rx >> go r
            if xv <= lv then
              if xv <= rv then return i else goRight
            else
              if lv <= rv then goLeft else goRight
  bottom <- go start
  unless(bottom == start) $ putPrio prio bottom x

getInts::IO [Int]
getInts = fmap (unfoldr readOne) BS.getLine where
  readOne s = do
    (x , s') <- BS.readInt s
    return (x, BS.drop 1 s')

addEdge::Int->Int->Cost->EdgeArr s->ST s ()
addEdge a b p arr = do
  lst <- readArray arr a
  writeArray arr a $ Edge p b : lst

buildSegTree::Int->ST s (SegArr s, EdgeArr s)
buildSegTree n = do
  edges <- newArray (-maxIdx, maxIdx) []
  segs  <- newArray_ (0, n)
  let link l r i j = do
        addEdge i j 0 edges
        addEdge (-j) (-i) 0 edges
        go l r j
      go l r idx | l+1>=r    = do
                    writeArray segs r idx
                    addEdge idx (-idx) 0 edges
                 | otherwise = do
                   let mid = quot (l + r + 1) 2
                   link l mid idx (2*idx)
                   link mid r idx (2*idx + 1)
  go 0 n 1
  return (segs, edges)
  where
    calcMax l r u | l + 1 >= r = u
                  | otherwise = let m = quot (l+r+1) 2
                                in calcMax l m (2*u) `max` calcMax m r (2*u+1)
    maxIdx = calcMax 0 n 1

multiEdge::Bool->Int->Int->Int->Int->Cost->SegArr s->EdgeArr s->ST s ()
multiEdge inverse n start endL endR c seg edge = go 0 n 1 where
  go l r idx | l >= endR || r < endL   = return () -- fully outside
             | l >= endL - 1 && r <= endR = do        -- fully inside
                 u <- readArray seg start
                 unless inverse $ addEdge (-u) idx c edge
                 when   inverse $ addEdge (-idx) u c edge
             | otherwise              = do
                let mid = quot (l + r + 1) 2
                go l mid  (idx*2)
                go mid r  (idx*2 + 1)

buildGraph::Int->[[Int]]->(Array Int [Edge], UArray Int Int)
buildGraph n queries = runST $ do
  (seg, edge) <- buildSegTree n
  let runQuery [1, v, u, w]    = do
        f <- readArray seg v
        t <- readArray seg u
        addEdge (- f) t (fromIntegral w) edge
      runQuery [2, v, l, r, w] = multiEdge False n v l r (fromIntegral w) seg edge
      runQuery [3, v, l, r, w] = multiEdge True  n v l r (fromIntegral w) seg edge
      runQuery _               = return ()
  forM_ queries runQuery
  graph <- freeze edge
  segMap <- freeze seg
  return (graph, segMap)

dijkstra::Graph->Int->Array Int Cost
dijkstra graph s = runSTArray $ do
  best <- newArray (bounds graph) (-1)
  prio <- newPrio best
  writeArray best s 0
  pushPrio prio s
  let go = do
         end <- nullPrio prio
         unless end $ do
           num  <- pullPrio prio
           dist <- readArray best num
           let edges = graph ! num
           check dist edges
           go
      better _ (-1)  = True
      better price x = price < x
      check _   [] = return ()
      check acc (Edge cost to: rest) = do
        let price = acc + cost
        current <- readArray best to
        when (price `better` current) $ do
          when (current /= -1) $ deletePrio prio to
          writeArray best to price
          void $ pushPrio prio to
        check acc rest
  go
  return best

main :: IO ()
main = do
  [n,q,s] <- getInts
  qs <- replicateM q getInts
  let (graph, segMap)  = buildGraph n qs
  -- forM_ (assocs graph) $ \(i, es) -> putStrLn $ show i <> ": " <> show es
  let best = dijkstra graph $ segMap ! s
  putStrLn $ unwords  [show $ best ! (segMap ! i) | i <- [1..n]]
--
-- validatePrio::Prio s->ST s Bool
-- validatePrio (Prio cmp ref arr _) = do
--   size <- readSTRef ref
--   let go i | 2 *i + 1>= size = return True
--            | 2* i + 2 == size = do
--         x <- readArray arr i
--         c <- readArray arr (2 * i + 1)
--         res <- cmp x c
--         unless res $ traceShowM $ show (x, c)
--         return res
--            | otherwise = do
--         x <- readArray arr i
--         l <- readArray arr (2 * i + 1)
--         r <- readArray arr (2 * i + 2)
--         vl <- cmp x l
--         vr <- cmp x r
--         unless vl $ traceShowM $ show (x, l)
--         unless vr $ traceShowM $ show (x, r)
--         vvl <- go (2 * i + 1)
--         vvr <- go (2 * i + 2)
--         return $ vl && vr && vvl && vvr
--   go 0

{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TupleSections    #-}

import           Control.Applicative
import           Control.Monad.ST.Safe
import           Control.Monad.State.Strict
import           Data.Array.ST.Safe
import           Data.Array.Unboxed
import qualified Data.ByteString.Char8      as BS
import           Data.List                  (unfoldr)
import qualified Data.Set                   as Set
import           Data.STRef

type Cost = Integer

data Edge      = Edge !Cost !Int deriving (Eq, Ord, Show)
type EdgeArr s = STArray s Int [Edge]
type Graph     = Array Int [Edge]
type SegArr  s = STUArray s Int Int

type STCmp s   = Int->Int->ST s Bool
type STNotify s = Int->Int->ST s ()
data Prio  s   = Prio (STCmp s) (STRef s Int) (STUArray s Int Int) (STNotify s)

putPrio::Prio s->Int->Int->ST s ()
putPrio (Prio _ _ arr notify) i x = writeArray arr i x >> notify i x

newPrio::Int->STCmp s->STNotify s->ST s (Prio s)
newPrio n cmp notify = do
    len <- newSTRef 0
    arr <- newArray_ (0, n)
    return $ Prio cmp len arr notify

newPrio'::Int->STCmp s->ST s (Prio s)
newPrio' n cmp = newPrio n cmp (const $ const $ return ())

pushPrio::Prio s->Int->ST s Int
pushPrio prio@(Prio _ ref arr notify) x = do
  n <- readSTRef ref
  writeSTRef ref (n + 1)
  putPrio prio n x
  fixUp prio n

deletePrio::Prio s->Int->ST s Int
deletePrio prio@(Prio cmp ref arr notify) i = do
  n <- readSTRef ref
  writeSTRef ref (n - 1)
  x <- readArray arr i
  w <- readArray arr (n - 1)
  putPrio prio i w
  descent <- cmp x w
  if descent then fixDown prio i else void $ fixUp prio i
  return x

pullPrio::Prio s->ST s Int
pullPrio prio@(Prio _ ref arr _) = do
  n <- readSTRef ref
  writeSTRef ref (n - 1)
  x <- readArray arr 0
  w <- readArray arr (n - 1)
  putPrio prio 0 w
  fixDown prio 0
  return x

nullPrio::Prio s->ST s Bool
nullPrio (Prio _ ref _ _) = (== 0) <$> readSTRef ref

fixUp::Prio s->Int->ST s Int
fixUp _ 0     = return 0
fixUp prio@(Prio cmp _ arr _) start  = do
  x <- readArray arr start
  let go 0 = return 0
      go i = do
        let p = quot (i - 1)  2
        px <- readArray arr p
        correct <- cmp px x
        if correct then return i else putPrio prio i px >> go p
  top <- go start
  writeArray arr top x
  return top

fixDown::Prio s->Int->ST s ()
fixDown prio@(Prio cmp ref arr _) start = do
  size <- readSTRef ref
  x <- readArray arr start
  let go i | 2 * i + 1 >= size = return i
           | 2 * i + 2 == size = do
             let c = 2 * i + 1
             cx <- readArray arr c
             correct <- cmp x cx
             if correct then return i else putPrio prio i cx >> return c
           | otherwise  = do
            let l = 2 * i + 1
                r = 2 * i + 2
            lx <- readArray arr l
            rx <- readArray arr r
            let goLeft = writeArray arr i lx >> go l
                goRight = writeArray arr i rx >> go r
            correctL <- cmp x lx
            if correctL then do
              correctR <- cmp x rx
              if correctR then return i else goRight
            else do
              bestL <- cmp lx rx
              if bestL then goLeft else goRight
  bottom <- go start
  writeArray arr bottom x

getInts::IO [Int]
getInts = fmap (unfoldr readOne) BS.getLine where
  readOne s = do
    (x , s') <- BS.readInt s
    return (x, BS.drop 1 s')

addEdge::Int->Int->Cost->EdgeArr s->ST s ()
addEdge a b p arr = do
  lst <- readArray arr a
  writeArray arr a $ Edge p b : lst

buildSegTree::Int->ST s (SegArr s, EdgeArr s)
buildSegTree n = do
  edges <- newArray (-maxIdx, maxIdx) []
  segs  <- newArray_ (0, n)
  let link l r i j = do
        addEdge i j 0 edges
        addEdge (-j) (-i) 0 edges
        go l r j
      go l r idx | l+1>=r    = do
                    writeArray segs r idx
                    addEdge idx (-idx) 0 edges
                 | otherwise = do
                   let mid = quot (l + r + 1) 2
                   link l mid idx (2*idx)
                   link mid r idx (2*idx + 1)
  go 0 n 1
  return (segs, edges)
  where
    calcMax l r u | l + 1 >= r = u
                  | otherwise = let m = quot (l+r+1) 2
                                in calcMax l m (2*u) `max` calcMax m r (2*u+1)
    maxIdx = calcMax 0 n 1

multiEdge::Bool->Int->Int->Int->Int->Cost->SegArr s->EdgeArr s->ST s ()
multiEdge inverse n start endL endR c seg edge = go 0 n 1 where
  go l r idx | l >= endR || r < endL   = return () -- fully outside
             | l >= endL - 1 && r <= endR = do        -- fully inside
                 u <- readArray seg start
                 unless inverse $ addEdge (-u) idx c edge
                 when   inverse $ addEdge (-idx) u c edge
             | otherwise              = do
                let mid = quot (l + r + 1) 2
                go l mid  (idx*2)
                go mid r  (idx*2 + 1)

buildGraph::Int->[[Int]]->(Array Int [Edge], UArray Int Int)
buildGraph n queries = runST $ do
  (seg, edge) <- buildSegTree n
  let runQuery [1, v, u, w]    = do
        f <- readArray seg v
        t <- readArray seg u
        addEdge (- f) t (fromIntegral w) edge
      runQuery [2, v, l, r, w] = multiEdge False n v l r (fromIntegral w) seg edge
      runQuery [3, v, l, r, w] = multiEdge True  n v l r (fromIntegral w) seg edge
      runQuery _               = return ()
  forM_ queries runQuery
  graph <- freeze edge
  segMap <- freeze seg
  return (graph, segMap)

dijkstra::Graph->Int->Array Int Cost
dijkstra graph s = runSTArray $ do
  best <- newArray (bounds graph) (-1)
  let mkArray::ST s (STUArray s Int Int)
      mkArray = newArray_ (bounds graph)
  ind  <- mkArray
  let cmp x y = do
        cx <- readArray best x
        cy <- readArray best y
        return $ cx <= cy
      notify i x = writeArray ind x i
  prio <- newPrio (rangeSize $ bounds graph) cmp notify
  void $ pushPrio prio s
  writeArray best s 0
  let go = do
         end <- nullPrio prio
         unless end $ do
           num  <- pullPrio prio
           dist <- readArray best num
           let edges = graph ! num
           mapM_ (check dist) edges
           go
      better _ (-1)  = True
      better price x = price < x
      check acc (Edge cost to) = do
        let price = acc + cost
        current <- readArray best to
        when (price `better` current) $ do
          when (current /= -1) $ do
            ix <- readArray ind to
            void $ deletePrio prio ix
          writeArray best to price
          void $ pushPrio prio to
  go
  return best

main :: IO ()
main = do
  [n,q,s] <- getInts
  qs <- replicateM q getInts
  let (graph, segMap)  = buildGraph n qs
  -- forM_ (assocs graph) $ \(i, es) -> putStrLn $ show i <> ": " <> show es
  let best = dijkstra graph $ segMap ! s
  putStrLn $ unwords  [show $ best ! (segMap ! i) | i <- [1..n]]
--
-- validatePrio::Prio s->ST s Bool
-- validatePrio (Prio cmp ref arr _) = do
--   size <- readSTRef ref
--   let go i | 2 *i + 1>= size = return True
--            | 2* i + 2 == size = do
--         x <- readArray arr i
--         c <- readArray arr (2 * i + 1)
--         res <- cmp x c
--         unless res $ traceShowM $ show (x, c)
--         return res
--            | otherwise = do
--         x <- readArray arr i
--         l <- readArray arr (2 * i + 1)
--         r <- readArray arr (2 * i + 2)
--         vl <- cmp x l
--         vr <- cmp x r
--         unless vl $ traceShowM $ show (x, l)
--         unless vr $ traceShowM $ show (x, r)
--         vvl <- go (2 * i + 1)
--         vvr <- go (2 * i + 2)
--         return $ vl && vr && vvl && vvr
--   go 0

{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TupleSections    #-}

import           Control.Applicative
import           Control.Monad.ST.Safe
import           Control.Monad.State.Strict
import           Data.Array.ST.Safe
import           Data.Array.Unboxed
import qualified Data.ByteString.Char8      as BS
import           Data.List                  (unfoldr)
import           Data.Ord
import qualified Data.Set                   as Set
import           Data.STRef

type Cost = Integer

data Edge      = Edge !Cost !Int deriving (Eq, Ord, Show)
type EdgeArr s = STArray s Int [Edge]
type Graph     = Array Int [Edge]
type SegArr  s = STUArray s Int Int

type STCmp s   = Int->Int->ST s Bool
type STNotify s = Int->Int->ST s ()
data Prio  s   = Prio (STArray s Int Cost) (STRef s Int) (STUArray s Int Int) (STUArray s Int Int)

putPrio::Prio s->Int->Int->ST s ()
putPrio (Prio _ _ arr idx) i x = do
  writeArray arr i x
  writeArray idx x i

newPrio::STArray s Int Cost->ST s (Prio s)
newPrio values = do
    bs <-  getBounds values
    let n  = rangeSize bs
    len <- newSTRef 0
    arr <- newArray_ (0, n)
    idx <- newArray_ bs
    return $ Prio values len arr idx

pushPrio::Prio s->Int->ST s Int
pushPrio prio@(Prio _ ref _ _) x = do
  n <- readSTRef ref
  writeSTRef ref (n + 1)
  putPrio prio n x
  fixUp prio n

deletePrio::Prio s->Int->ST s Int
deletePrio prio@(Prio val ref arr _) i = do
  n <- readSTRef ref
  writeSTRef ref (n - 1)
  x <- readArray arr i
  xv <- readArray val x
  w <- readArray arr (n - 1)
  wv <- readArray val w
  putPrio prio i w
  case compare xv wv of
    EQ -> return ()
    GT -> fixDown prio i
    LT -> void $ fixUp prio i
  return x

pullPrio::Prio s->ST s Int
pullPrio prio@(Prio _ ref arr _) = do
  n <- readSTRef ref
  writeSTRef ref (n - 1)
  x <- readArray arr 0
  w <- readArray arr (n - 1)
  putPrio prio 0 w
  fixDown prio 0
  return x

nullPrio::Prio s->ST s Bool
nullPrio (Prio _ ref _ _) = (== 0) <$> readSTRef ref

fixUp::Prio s->Int->ST s Int
fixUp _ 0     = return 0
fixUp prio@(Prio val _ arr _) start  = do
  x <- readArray arr start
  xv <- readArray val x
  let go 0 = return 0
      go i = do
        let p = quot (i - 1)  2
        px <- readArray arr p
        pv <- readArray val px
        if xv >= pv then return i else putPrio prio i px >> go p
  top <- go start
  putPrio prio top x
  return top

fixDown::Prio s->Int->ST s ()
fixDown prio@(Prio val ref arr _) start = do
  size <- readSTRef ref
  x <- readArray arr start
  xv <- readArray val x
  let go i | 2 * i + 1 >= size = return i
           | 2 * i + 2 == size = do
             let c = 2 * i + 1
             cx <- readArray arr c
             cv <- readArray val cx
             if xv <= cv then return i else putPrio prio i cx >> return c
           | otherwise  = do
            let l = 2 * i + 1
                r = 2 * i + 2
            lx <- readArray arr l
            rx <- readArray arr r
            lv <- readArray val lx
            rv <- readArray val rx
            let goLeft = putPrio prio i lx >> go l
                goRight = putPrio prio i rx >> go r
            if xv <= lv then
              if xv <= rv then return i else goRight
            else
              if lv <= rv then goLeft else goRight
  bottom <- go start
  putPrio prio bottom x

getInts::IO [Int]
getInts = fmap (unfoldr readOne) BS.getLine where
  readOne s = do
    (x , s') <- BS.readInt s
    return (x, BS.drop 1 s')

addEdge::Int->Int->Cost->EdgeArr s->ST s ()
addEdge a b p arr = do
  lst <- readArray arr a
  writeArray arr a $ Edge p b : lst

buildSegTree::Int->ST s (SegArr s, EdgeArr s)
buildSegTree n = do
  edges <- newArray (-maxIdx, maxIdx) []
  segs  <- newArray_ (0, n)
  let link l r i j = do
        addEdge i j 0 edges
        addEdge (-j) (-i) 0 edges
        go l r j
      go l r idx | l+1>=r    = do
                    writeArray segs r idx
                    addEdge idx (-idx) 0 edges
                 | otherwise = do
                   let mid = quot (l + r + 1) 2
                   link l mid idx (2*idx)
                   link mid r idx (2*idx + 1)
  go 0 n 1
  return (segs, edges)
  where
    calcMax l r u | l + 1 >= r = u
                  | otherwise = let m = quot (l+r+1) 2
                                in calcMax l m (2*u) `max` calcMax m r (2*u+1)
    maxIdx = calcMax 0 n 1

multiEdge::Bool->Int->Int->Int->Int->Cost->SegArr s->EdgeArr s->ST s ()
multiEdge inverse n start endL endR c seg edge = go 0 n 1 where
  go l r idx | l >= endR || r < endL   = return () -- fully outside
             | l >= endL - 1 && r <= endR = do        -- fully inside
                 u <- readArray seg start
                 unless inverse $ addEdge (-u) idx c edge
                 when   inverse $ addEdge (-idx) u c edge
             | otherwise              = do
                let mid = quot (l + r + 1) 2
                go l mid  (idx*2)
                go mid r  (idx*2 + 1)

buildGraph::Int->[[Int]]->(Array Int [Edge], UArray Int Int)
buildGraph n queries = runST $ do
  (seg, edge) <- buildSegTree n
  let runQuery [1, v, u, w]    = do
        f <- readArray seg v
        t <- readArray seg u
        addEdge (- f) t (fromIntegral w) edge
      runQuery [2, v, l, r, w] = multiEdge False n v l r (fromIntegral w) seg edge
      runQuery [3, v, l, r, w] = multiEdge True  n v l r (fromIntegral w) seg edge
      runQuery _               = return ()
  forM_ queries runQuery
  graph <- freeze edge
  segMap <- freeze seg
  return (graph, segMap)

dijkstra::Graph->Int->Array Int Cost
dijkstra graph s = runSTArray $ do
  best <- newArray (bounds graph) (-1)
  let mkArray::ST s (STUArray s Int Int)
      mkArray = newArray_ (bounds graph)
  ind  <- mkArray
  prio <- newPrio best
  void $ pushPrio prio s
  writeArray best s 0
  let go = do
         end <- nullPrio prio
         unless end $ do
           num  <- pullPrio prio
           dist <- readArray best num
           let edges = graph ! num
           mapM_ (check dist) edges
           go
      better _ (-1)  = True
      better price x = price < x
      check acc (Edge cost to) = do
        let price = acc + cost
        current <- readArray best to
        when (price `better` current) $ do
          when (current /= -1) $ do
            ix <- readArray ind to
            void $ deletePrio prio ix
          writeArray best to price
          void $ pushPrio prio to
  go
  return best

main :: IO ()
main = do
  [n,q,s] <- getInts
  qs <- replicateM q getInts
  let (graph, segMap)  = buildGraph n qs
  -- forM_ (assocs graph) $ \(i, es) -> putStrLn $ show i <> ": " <> show es
  let best = dijkstra graph $ segMap ! s
  putStrLn $ unwords  [show $ best ! (segMap ! i) | i <- [1..n]]
--
-- validatePrio::Prio s->ST s Bool
-- validatePrio (Prio cmp ref arr _) = do
--   size <- readSTRef ref
--   let go i | 2 *i + 1>= size = return True
--            | 2* i + 2 == size = do
--         x <- readArray arr i
--         c <- readArray arr (2 * i + 1)
--         res <- cmp x c
--         unless res $ traceShowM $ show (x, c)
--         return res
--            | otherwise = do
--         x <- readArray arr i
--         l <- readArray arr (2 * i + 1)
--         r <- readArray arr (2 * i + 2)
--         vl <- cmp x l
--         vr <- cmp x r
--         unless vl $ traceShowM $ show (x, l)
--         unless vr $ traceShowM $ show (x, r)
--         vvl <- go (2 * i + 1)
--         vvr <- go (2 * i + 2)
--         return $ vl && vr && vvl && vvr
--   go 0

{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ViewPatterns     #-}

import           Control.Applicative
import           Control.Monad.ST.Safe
import           Control.Monad.State.Strict
import           Data.Array.ST.Safe
import           Data.Array.Unboxed
import qualified Data.ByteString.Char8      as BS
import           Data.Int
import           Data.List                  (unfoldr)
import           Data.Maybe
import qualified Data.Set                   as Set

type Cost = Int64

data Edge      = Edge {-# UNPACK #-} !Cost {-# UNPACK #-}  !Int deriving Eq
type Graph  s  = STArray s Int EdgeList
type SegArr  s = STUArray s Int Int
data EdgeList  = EdgeCons {-# UNPACK #-}  !Cost {-# UNPACK #-} !Int !EdgeList | EdgeNil deriving (Eq, Ord)

instance Ord Edge where Edge cost1 _ `compare` Edge cost2 _ = compare cost1 cost2

getInts::IO [Int]
getInts = fmap (unfoldr readOne) BS.getLine where
  readOne s = do
    (x , s') <- BS.readInt s
    return (x, BS.drop 1 s')

addEdge::Int->Int->Cost->Graph s->ST s ()
addEdge a b p arr = do
  lst <- readArray arr a
  writeArray arr a $ EdgeCons p b lst

buildSegTree::Int->ST s (SegArr s, Graph s)
buildSegTree n = do
  edges <- newArray (-maxIdx, maxIdx) EdgeNil
  segs  <- newArray_ (0, n)
  let link l r i j = do
        addEdge i j 0 edges
        addEdge (-j) (-i) 0 edges
        go l r j
      go l r idx | l+1>=r    = do
                    writeArray segs r idx
                    addEdge idx (-idx) 0 edges
                 | otherwise = do
                   let mid = quot (l + r + 1) 2
                   link l mid idx (2*idx)
                   link mid r idx (2*idx + 1)
  go 0 n 1
  return (segs, edges)
  where
    calcMax l r u | l + 1 >= r = u
                  | otherwise = let m = quot (l+r+1) 2
                                in calcMax l m (2*u) `max` calcMax m r (2*u+1)
    maxIdx = calcMax 0 n 1

multiEdge::Bool->Int->Int->Int->Int->Cost->SegArr s->Graph s->ST s ()
multiEdge inverse n start endL endR c seg edge = go 0 n 1 where
  go l r idx | l >= endR || r < endL   = return () -- fully outside
             | l >= endL - 1 && r <= endR = do        -- fully inside
                 u <- readArray seg start
                 unless inverse $ addEdge (-u) idx c edge
                 when   inverse $ addEdge (-idx) u c edge
             | otherwise              = do
                let mid = quot (l + r + 1) 2
                go l mid  (idx*2)
                go mid r  (idx*2 + 1)

buildGraph::Int->[[Int]]->ST s (Graph s, SegArr s)
buildGraph n queries = do
  (seg, edge) <- buildSegTree n
  let runQuery [1, v, u, w]    = do
        f <- readArray seg v
        t <- readArray seg u
        addEdge (- f) t (fromIntegral w) edge
      runQuery [2, v, l, r, w] = multiEdge False n v l r (fromIntegral w) seg edge
      runQuery [3, v, l, r, w] = multiEdge True  n v l r (fromIntegral w) seg edge
      runQuery _               = return ()
  forM_ queries runQuery
  return (edge, seg)

dijkstra::Graph s->Int->ST s (STArray s Int (Maybe Cost))
dijkstra graph s = do
  bs <- getBounds graph
  best <- newArray bs Nothing
  writeArray best s (Just 0)
  let go (Set.minView -> Just (Edge dist num, rest)) = do
           edges <- readArray graph num
           dists <- check dist rest edges
           go dists
      go _ = return ()
      check acc dists (EdgeCons cost to rest) = do
        let price = acc + cost
        current <- readArray best to
        if maybe True (price < ) current then do
          let dists' = maybe dists remove current
              remove u = Set.delete (Edge u to) dists
          writeArray best to (Just price)
          let dists'' = Set.insert (Edge price to) dists'
          check acc dists'' rest
        else check acc dists rest
      check _   dists  EdgeNil = return dists
  go $ Set.singleton $ Edge 0 s
  return best

main :: IO ()
main = do
  [n,q,s] <- getInts
  qs <- replicateM q getInts
  let best = runSTArray $ do
        (graph, segMap)  <- buildGraph n qs
        si <- readArray segMap s
        res <- dijkstra graph si
        arr <- newArray_ (1, n)
        forM_ [1..n] $ \i -> do
           segI <- readArray segMap i
           resI <- readArray res segI
           writeArray arr i resI
        return arr
  putStrLn $ unwords [show $ fromMaybe (-1) $ best ! i | i <- [1..n]]

{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TupleSections    #-}

import           Control.Applicative
import           Control.Monad.ST.Safe
import           Control.Monad.State.Strict
import           Data.Array.ST.Safe
import           Data.Array.Unboxed
import qualified Data.ByteString.Char8      as BS
import           Data.List                  (unfoldr)
import           Data.Ord
import qualified Data.Set                   as Set
import           Data.STRef

type Cost = Integer

data Edge      = Edge !Cost !Int deriving (Eq, Ord, Show)
type EdgeArr s = STArray s Int [Edge]
type Graph     = Array Int [Edge]
type SegArr  s = STUArray s Int Int

type STCmp s   = Int->Int->ST s Bool
type STNotify s = Int->Int->ST s ()
data Prio  s   = Prio (STArray s Int Cost) (STRef s Int) (STUArray s Int Int) (STUArray s Int Int)

putPrio::Prio s->Int->Int->ST s ()
putPrio (Prio _ _ arr idx) i x = do
  writeArray arr i x
  writeArray idx x i

newPrio::STArray s Int Cost->ST s (Prio s)
newPrio values = do
    bs <-  getBounds values
    let n  = rangeSize bs
    len <- newSTRef 0
    arr <- newArray_ (0, n)
    idx <- newArray_ bs
    return $ Prio values len arr idx

pushPrio::Prio s->Int->ST s Int
pushPrio prio@(Prio _ ref _ _) x = do
  n <- readSTRef ref
  writeSTRef ref (n + 1)
  putPrio prio n x
  fixUp prio n

deletePrio::Prio s->Int->ST s Int
deletePrio prio@(Prio val ref arr idx) x = do
  n <- readSTRef ref
  writeSTRef ref (n - 1)
  i <- readArray idx x
  xv <- readArray val x
  w <- readArray arr (n - 1)
  wv <- readArray val w
  putPrio prio i w
  case compare xv wv of
    EQ -> return ()
    GT -> fixDown prio i
    LT -> void $ fixUp prio i
  return x

pullPrio::Prio s->ST s Int
pullPrio prio@(Prio _ ref arr _) = do
  n <- readSTRef ref
  writeSTRef ref (n - 1)
  x <- readArray arr 0
  w <- readArray arr (n - 1)
  putPrio prio 0 w
  fixDown prio 0
  return x

nullPrio::Prio s->ST s Bool
nullPrio (Prio _ ref _ _) = (== 0) <$> readSTRef ref

fixUp::Prio s->Int->ST s Int
fixUp _ 0     = return 0
fixUp prio@(Prio val _ arr _) start  = do
  x <- readArray arr start
  xv <- readArray val x
  let go 0 = return 0
      go i = do
        let p = quot (i - 1)  2
        px <- readArray arr p
        pv <- readArray val px
        if xv >= pv then return i else putPrio prio i px >> go p
  top <- go start
  putPrio prio top x
  return top

fixDown::Prio s->Int->ST s ()
fixDown prio@(Prio val ref arr _) start = do
  size <- readSTRef ref
  x <- readArray arr start
  xv <- readArray val x
  let go i | 2 * i + 1 >= size = return i
           | 2 * i + 2 == size = do
             let c = 2 * i + 1
             cx <- readArray arr c
             cv <- readArray val cx
             if xv <= cv then return i else putPrio prio i cx >> return c
           | otherwise  = do
            let l = 2 * i + 1
                r = 2 * i + 2
            lx <- readArray arr l
            rx <- readArray arr r
            lv <- readArray val lx
            rv <- readArray val rx
            let goLeft = putPrio prio i lx >> go l
                goRight = putPrio prio i rx >> go r
            if xv <= lv then
              if xv <= rv then return i else goRight
            else
              if lv <= rv then goLeft else goRight
  bottom <- go start
  putPrio prio bottom x

getInts::IO [Int]
getInts = fmap (unfoldr readOne) BS.getLine where
  readOne s = do
    (x , s') <- BS.readInt s
    return (x, BS.drop 1 s')

addEdge::Int->Int->Cost->EdgeArr s->ST s ()
addEdge a b p arr = do
  lst <- readArray arr a
  writeArray arr a $ Edge p b : lst

buildSegTree::Int->ST s (SegArr s, EdgeArr s)
buildSegTree n = do
  edges <- newArray (-maxIdx, maxIdx) []
  segs  <- newArray_ (0, n)
  let link l r i j = do
        addEdge i j 0 edges
        addEdge (-j) (-i) 0 edges
        go l r j
      go l r idx | l+1>=r    = do
                    writeArray segs r idx
                    addEdge idx (-idx) 0 edges
                 | otherwise = do
                   let mid = quot (l + r + 1) 2
                   link l mid idx (2*idx)
                   link mid r idx (2*idx + 1)
  go 0 n 1
  return (segs, edges)
  where
    calcMax l r u | l + 1 >= r = u
                  | otherwise = let m = quot (l+r+1) 2
                                in calcMax l m (2*u) `max` calcMax m r (2*u+1)
    maxIdx = calcMax 0 n 1

multiEdge::Bool->Int->Int->Int->Int->Cost->SegArr s->EdgeArr s->ST s ()
multiEdge inverse n start endL endR c seg edge = go 0 n 1 where
  go l r idx | l >= endR || r < endL   = return () -- fully outside
             | l >= endL - 1 && r <= endR = do        -- fully inside
                 u <- readArray seg start
                 unless inverse $ addEdge (-u) idx c edge
                 when   inverse $ addEdge (-idx) u c edge
             | otherwise              = do
                let mid = quot (l + r + 1) 2
                go l mid  (idx*2)
                go mid r  (idx*2 + 1)

buildGraph::Int->[[Int]]->(Array Int [Edge], UArray Int Int)
buildGraph n queries = runST $ do
  (seg, edge) <- buildSegTree n
  let runQuery [1, v, u, w]    = do
        f <- readArray seg v
        t <- readArray seg u
        addEdge (- f) t (fromIntegral w) edge
      runQuery [2, v, l, r, w] = multiEdge False n v l r (fromIntegral w) seg edge
      runQuery [3, v, l, r, w] = multiEdge True  n v l r (fromIntegral w) seg edge
      runQuery _               = return ()
  forM_ queries runQuery
  graph <- freeze edge
  segMap <- freeze seg
  return (graph, segMap)

dijkstra::Graph->Int->Array Int Cost
dijkstra graph s = runSTArray $ do
  best <- newArray (bounds graph) (-1)
  prio <- newPrio best
  void $ pushPrio prio s
  writeArray best s 0
  let go = do
         end <- nullPrio prio
         unless end $ do
           num  <- pullPrio prio
           dist <- readArray best num
           let edges = graph ! num
           mapM_ (check dist) edges
           go
      better _ (-1)  = True
      better price x = price < x
      check acc (Edge cost to) = do
        let price = acc + cost
        current <- readArray best to
        when (price `better` current) $ do
          when (current /= -1) $ void $ deletePrio prio to
          writeArray best to price
          void $ pushPrio prio to
  go
  return best

main :: IO ()
main = do
  [n,q,s] <- getInts
  qs <- replicateM q getInts
  let (graph, segMap)  = buildGraph n qs
  -- forM_ (assocs graph) $ \(i, es) -> putStrLn $ show i <> ": " <> show es
  let best = dijkstra graph $ segMap ! s
  putStrLn $ unwords  [show $ best ! (segMap ! i) | i <- [1..n]]
--
-- validatePrio::Prio s->ST s Bool
-- validatePrio (Prio cmp ref arr _) = do
--   size <- readSTRef ref
--   let go i | 2 *i + 1>= size = return True
--            | 2* i + 2 == size = do
--         x <- readArray arr i
--         c <- readArray arr (2 * i + 1)
--         res <- cmp x c
--         unless res $ traceShowM $ show (x, c)
--         return res
--            | otherwise = do
--         x <- readArray arr i
--         l <- readArray arr (2 * i + 1)
--         r <- readArray arr (2 * i + 2)
--         vl <- cmp x l
--         vr <- cmp x r
--         unless vl $ traceShowM $ show (x, l)
--         unless vr $ traceShowM $ show (x, r)
--         vvl <- go (2 * i + 1)
--         vvr <- go (2 * i + 2)
--         return $ vl && vr && vvl && vvr
--   go 0

{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TupleSections    #-}

import           Control.Applicative
import           Control.Monad.ST.Safe
import           Control.Monad.State.Strict
import           Data.Array.ST.Safe
import           Data.Array.Unboxed
import qualified Data.ByteString.Char8      as BS
import           Data.List                  (unfoldr)
import           Data.Ord
import qualified Data.Set                   as Set
import           Data.STRef

type Cost = Integer

data Edge      = Edge !Cost !Int deriving (Eq, Ord, Show)
type EdgeArr s = STArray s Int [Edge]
type Graph     = Array Int [Edge]
type SegArr  s = STUArray s Int Int

type STCmp s   = Int->Int->ST s Bool
type STNotify s = Int->Int->ST s ()
data Prio  s   = Prio (STArray s Int Cost) (STRef s Int) (STUArray s Int Int) (STUArray s Int Int)

putPrio::Prio s->Int->Int->ST s ()
putPrio (Prio _ _ arr idx) i x = do
  writeArray arr i x
  writeArray idx x i

newPrio::STArray s Int Cost->ST s (Prio s)
newPrio values = do
    bs <-  getBounds values
    let n  = rangeSize bs
    len <- newSTRef 0
    arr <- newArray_ (0, n)
    idx <- newArray_ bs
    return $ Prio values len arr idx

pushPrio::Prio s->Int->ST s Int
pushPrio prio@(Prio _ ref _ _) x = do
  n <- readSTRef ref
  writeSTRef ref (n + 1)
  putPrio prio n x
  fixUp prio n

deletePrio::Prio s->Int->ST s Int
deletePrio prio@(Prio val ref arr _) i = do
  n <- readSTRef ref
  writeSTRef ref (n - 1)
  x <- readArray arr i
  xv <- readArray val x
  w <- readArray arr (n - 1)
  wv <- readArray val w
  putPrio prio i w
  case compare xv wv of
    EQ -> return ()
    GT -> fixDown prio i
    LT -> void $ fixUp prio i
  return x

pullPrio::Prio s->ST s Int
pullPrio prio@(Prio _ ref arr _) = do
  n <- readSTRef ref
  writeSTRef ref (n - 1)
  x <- readArray arr 0
  w <- readArray arr (n - 1)
  putPrio prio 0 w
  fixDown prio 0
  return x

nullPrio::Prio s->ST s Bool
nullPrio (Prio _ ref _ _) = (== 0) <$> readSTRef ref

fixUp::Prio s->Int->ST s Int
fixUp _ 0     = return 0
fixUp prio@(Prio val _ arr _) start  = do
  x <- readArray arr start
  xv <- readArray val x
  let go 0 = return 0
      go i = do
        let p = quot (i - 1)  2
        px <- readArray arr p
        pv <- readArray val px
        if xv <= pv then return i else putPrio prio i px >> go p
  top <- go start
  putPrio prio top x
  return top

fixDown::Prio s->Int->ST s ()
fixDown prio@(Prio val ref arr _) start = do
  size <- readSTRef ref
  x <- readArray arr start
  xv <- readArray val x
  let go i | 2 * i + 1 >= size = return i
           | 2 * i + 2 == size = do
             let c = 2 * i + 1
             cx <- readArray arr c
             cv <- readArray val cx
             if xv <= cv then return i else putPrio prio i cx >> return c
           | otherwise  = do
            let l = 2 * i + 1
                r = 2 * i + 2
            lx <- readArray arr l
            rx <- readArray arr r
            lv <- readArray val lx
            rv <- readArray val rx
            let goLeft = putPrio prio i lx >> go l
                goRight = putPrio prio i rx >> go r
            if xv <= lv then
              if xv <= rv then return i else goRight
            else
              if lv <= rv then goLeft else goRight
  bottom <- go start
  putPrio prio bottom x

getInts::IO [Int]
getInts = fmap (unfoldr readOne) BS.getLine where
  readOne s = do
    (x , s') <- BS.readInt s
    return (x, BS.drop 1 s')

addEdge::Int->Int->Cost->EdgeArr s->ST s ()
addEdge a b p arr = do
  lst <- readArray arr a
  writeArray arr a $ Edge p b : lst

buildSegTree::Int->ST s (SegArr s, EdgeArr s)
buildSegTree n = do
  edges <- newArray (-maxIdx, maxIdx) []
  segs  <- newArray_ (0, n)
  let link l r i j = do
        addEdge i j 0 edges
        addEdge (-j) (-i) 0 edges
        go l r j
      go l r idx | l+1>=r    = do
                    writeArray segs r idx
                    addEdge idx (-idx) 0 edges
                 | otherwise = do
                   let mid = quot (l + r + 1) 2
                   link l mid idx (2*idx)
                   link mid r idx (2*idx + 1)
  go 0 n 1
  return (segs, edges)
  where
    calcMax l r u | l + 1 >= r = u
                  | otherwise = let m = quot (l+r+1) 2
                                in calcMax l m (2*u) `max` calcMax m r (2*u+1)
    maxIdx = calcMax 0 n 1

multiEdge::Bool->Int->Int->Int->Int->Cost->SegArr s->EdgeArr s->ST s ()
multiEdge inverse n start endL endR c seg edge = go 0 n 1 where
  go l r idx | l >= endR || r < endL   = return () -- fully outside
             | l >= endL - 1 && r <= endR = do        -- fully inside
                 u <- readArray seg start
                 unless inverse $ addEdge (-u) idx c edge
                 when   inverse $ addEdge (-idx) u c edge
             | otherwise              = do
                let mid = quot (l + r + 1) 2
                go l mid  (idx*2)
                go mid r  (idx*2 + 1)

buildGraph::Int->[[Int]]->(Array Int [Edge], UArray Int Int)
buildGraph n queries = runST $ do
  (seg, edge) <- buildSegTree n
  let runQuery [1, v, u, w]    = do
        f <- readArray seg v
        t <- readArray seg u
        addEdge (- f) t (fromIntegral w) edge
      runQuery [2, v, l, r, w] = multiEdge False n v l r (fromIntegral w) seg edge
      runQuery [3, v, l, r, w] = multiEdge True  n v l r (fromIntegral w) seg edge
      runQuery _               = return ()
  forM_ queries runQuery
  graph <- freeze edge
  segMap <- freeze seg
  return (graph, segMap)

dijkstra::Graph->Int->Array Int Cost
dijkstra graph s = runSTArray $ do
  best <- newArray (bounds graph) (-1)
  let mkArray::ST s (STUArray s Int Int)
      mkArray = newArray_ (bounds graph)
  ind  <- mkArray
  prio <- newPrio best
  void $ pushPrio prio s
  writeArray best s 0
  let go = do
         end <- nullPrio prio
         unless end $ do
           num  <- pullPrio prio
           dist <- readArray best num
           let edges = graph ! num
           mapM_ (check dist) edges
           go
      better _ (-1)  = True
      better price x = price < x
      check acc (Edge cost to) = do
        let price = acc + cost
        current <- readArray best to
        when (price `better` current) $ do
          when (current /= -1) $ do
            ix <- readArray ind to
            void $ deletePrio prio ix
          writeArray best to price
          void $ pushPrio prio to
  go
  return best

main :: IO ()
main = do
  [n,q,s] <- getInts
  qs <- replicateM q getInts
  let (graph, segMap)  = buildGraph n qs
  -- forM_ (assocs graph) $ \(i, es) -> putStrLn $ show i <> ": " <> show es
  let best = dijkstra graph $ segMap ! s
  putStrLn $ unwords  [show $ best ! (segMap ! i) | i <- [1..n]]
--
-- validatePrio::Prio s->ST s Bool
-- validatePrio (Prio cmp ref arr _) = do
--   size <- readSTRef ref
--   let go i | 2 *i + 1>= size = return True
--            | 2* i + 2 == size = do
--         x <- readArray arr i
--         c <- readArray arr (2 * i + 1)
--         res <- cmp x c
--         unless res $ traceShowM $ show (x, c)
--         return res
--            | otherwise = do
--         x <- readArray arr i
--         l <- readArray arr (2 * i + 1)
--         r <- readArray arr (2 * i + 2)
--         vl <- cmp x l
--         vr <- cmp x r
--         unless vl $ traceShowM $ show (x, l)
--         unless vr $ traceShowM $ show (x, r)
--         vvl <- go (2 * i + 1)
--         vvr <- go (2 * i + 2)
--         return $ vl && vr && vvl && vvr
--   go 0

{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ViewPatterns     #-}

import           Control.Applicative
import           Control.Monad.ST.Safe
import           Control.Monad.State.Strict
import           Data.Array.ST.Safe
import           Data.Array.Unboxed
import qualified Data.ByteString.Char8      as BS
import           Data.Int
import           Data.List                  (unfoldr)
import           Data.Maybe
import qualified Data.Set                   as Set

type Cost = Int64

data Edge      = Edge {-# UNPACK #-} !Cost {-# UNPACK #-}  !Int
type Graph  s  = STArray s Int EdgeList
type SegArr  s = STUArray s Int Int
data EdgeList  = EdgeCons {-# UNPACK #-}  !Cost {-# UNPACK #-} !Int !EdgeList | EdgeNil deriving (Eq, Ord)

instance Eq Edge where Edge cost1 _ == Edge cost2 _ = cost1 == cost2
instance Ord Edge where Edge cost1 _ `compare` Edge cost2 _ = compare cost1 cost2

getInts::IO [Int]
getInts = fmap (unfoldr readOne) BS.getLine where
  readOne s = do
    (x , s') <- BS.readInt s
    return (x, BS.drop 1 s')

addEdge::Int->Int->Cost->Graph s->ST s ()
addEdge a b p arr = do
  lst <- readArray arr a
  writeArray arr a $ EdgeCons p b lst

buildSegTree::Int->ST s (SegArr s, Graph s)
buildSegTree n = do
  edges <- newArray (-maxIdx, maxIdx) EdgeNil
  segs  <- newArray_ (0, n)
  let link l r i j = do
        addEdge i j 0 edges
        addEdge (-j) (-i) 0 edges
        go l r j
      go l r idx | l+1>=r    = do
                    writeArray segs r idx
                    addEdge idx (-idx) 0 edges
                 | otherwise = do
                   let mid = quot (l + r + 1) 2
                   link l mid idx (2*idx)
                   link mid r idx (2*idx + 1)
  go 0 n 1
  return (segs, edges)
  where
    calcMax l r u | l + 1 >= r = u
                  | otherwise = let m = quot (l+r+1) 2
                                in calcMax l m (2*u) `max` calcMax m r (2*u+1)
    maxIdx = calcMax 0 n 1

multiEdge::Bool->Int->Int->Int->Int->Cost->SegArr s->Graph s->ST s ()
multiEdge inverse n start endL endR c seg edge = go 0 n 1 where
  go l r idx | l >= endR || r < endL   = return () -- fully outside
             | l >= endL - 1 && r <= endR = do        -- fully inside
                 u <- readArray seg start
                 unless inverse $ addEdge (-u) idx c edge
                 when   inverse $ addEdge (-idx) u c edge
             | otherwise              = do
                let mid = quot (l + r + 1) 2
                go l mid  (idx*2)
                go mid r  (idx*2 + 1)

buildGraph::Int->[[Int]]->ST s (Graph s, SegArr s)
buildGraph n queries = do
  (seg, edge) <- buildSegTree n
  let runQuery [1, v, u, w]    = do
        f <- readArray seg v
        t <- readArray seg u
        addEdge (- f) t (fromIntegral w) edge
      runQuery [2, v, l, r, w] = multiEdge False n v l r (fromIntegral w) seg edge
      runQuery [3, v, l, r, w] = multiEdge True  n v l r (fromIntegral w) seg edge
      runQuery _               = return ()
  forM_ queries runQuery
  return (edge, seg)

dijkstra::Graph s->Int->ST s (STArray s Int (Maybe Cost))
dijkstra graph s = do
  bs <- getBounds graph
  best <- newArray bs Nothing
  writeArray best s (Just 0)
  let go (Set.minView -> Just (Edge dist num, rest)) = do
           edges <- readArray graph num
           dists <- check dist rest edges
           go dists
      go _ = return ()
      check acc dists (EdgeCons cost to rest) = do
        let price = acc + cost
        current <- readArray best to
        if maybe True (price < ) current then do
          let dists' = maybe dists remove current
              remove u = Set.delete (Edge u to) dists
          writeArray best to (Just price)
          let dists'' = Set.insert (Edge price to) dists'
          check acc dists'' rest
        else check acc dists rest
      check _   dists  EdgeNil = return dists
  go $ Set.singleton $ Edge 0 s
  return best

main :: IO ()
main = do
  [n,q,s] <- getInts
  qs <- replicateM q getInts
  let best = runSTArray $ do
        (graph, segMap)  <- buildGraph n qs
        si <- readArray segMap s
        res <- dijkstra graph si
        arr <- newArray_ (1, n)
        forM_ [1..n] $ \i -> do
           segI <- readArray segMap i
           resI <- readArray res segI
           writeArray arr i resI
        return arr
  putStrLn $ unwords [show $ fromMaybe (-1) $ best ! i | i <- [1..n]]

{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TupleSections    #-}

import           Control.Applicative
import           Control.Monad.ST.Safe
import           Control.Monad.State.Strict
import           Data.Array.ST.Safe
import           Data.Array.Unboxed
import qualified Data.ByteString.Char8      as BS
import           Data.List                  (unfoldr)
import           Data.Ord
import qualified Data.Set                   as Set
import           Data.STRef

type Cost = Integer

data Edge      = Edge !Cost !Int deriving (Eq, Ord, Show)
type EdgeArr s = STArray s Int [Edge]
type Graph     = Array Int [Edge]
type SegArr  s = STUArray s Int Int

type STCmp s   = Int->Int->ST s Bool
type STNotify s = Int->Int->ST s ()
data Prio  s   = Prio (STArray s Int Cost) (STRef s Int) (STUArray s Int Int) (STUArray s Int Int)

putPrio::Prio s->Int->Int->ST s ()
putPrio (Prio _ _ arr idx) i x = do
  writeArray arr i x
  writeArray idx x i

newPrio::STArray s Int Cost->ST s (Prio s)
newPrio values = do
    bs <-  getBounds values
    let n  = rangeSize bs
    len <- newSTRef 0
    arr <- newArray_ (0, n)
    idx <- newArray_ bs
    return $ Prio values len arr idx

pushPrio::Prio s->Int->ST s Int
pushPrio prio@(Prio _ ref arr notify) x = do
  n <- readSTRef ref
  writeSTRef ref (n + 1)
  putPrio prio n x
  fixUp prio n

deletePrio::Prio s->Int->ST s Int
deletePrio prio@(Prio val ref arr idx) i = do
  n <- readSTRef ref
  writeSTRef ref (n - 1)
  x <- readArray arr i
  xv <- readArray val x
  w <- readArray arr (n - 1)
  wv <- readArray val w
  putPrio prio i w
  case compare xv wv of
    EQ -> return ()
    LT -> fixDown prio i
    GT -> void $ fixUp prio i
  return x

pullPrio::Prio s->ST s Int
pullPrio prio@(Prio _ ref arr _) = do
  n <- readSTRef ref
  writeSTRef ref (n - 1)
  x <- readArray arr 0
  w <- readArray arr (n - 1)
  putPrio prio 0 w
  fixDown prio 0
  return x

nullPrio::Prio s->ST s Bool
nullPrio (Prio _ ref _ _) = (== 0) <$> readSTRef ref

fixUp::Prio s->Int->ST s Int
fixUp _ 0     = return 0
fixUp prio@(Prio val _ arr _) start  = do
  x <- readArray arr start
  xv <- readArray val x
  let go 0 = return 0
      go i = do
        let p = quot (i - 1)  2
        px <- readArray arr p
        pv <- readArray val px
        if xv <= pv then return i else putPrio prio i px >> go p
  top <- go start
  putPrio prio top x
  return top

fixDown::Prio s->Int->ST s ()
fixDown prio@(Prio val ref arr _) start = do
  size <- readSTRef ref
  x <- readArray arr start
  xv <- readArray val x
  let go i | 2 * i + 1 >= size = return i
           | 2 * i + 2 == size = do
             let c = 2 * i + 1
             cx <- readArray arr c
             cv <- readArray val cx
             if xv <= cv then return i else putPrio prio i cx >> return c
           | otherwise  = do
            let l = 2 * i + 1
                r = 2 * i + 2
            lx <- readArray arr l
            rx <- readArray arr r
            lv <- readArray val lx
            rv <- readArray val rx
            let goLeft = putPrio prio i lx >> go l
                goRight = putPrio prio i rx >> go r
            if xv <= lv then
              if xv <= rv then return i else goRight
            else
              if lv <= rv then goLeft else goRight
  bottom <- go start
  putPrio prio bottom x

getInts::IO [Int]
getInts = fmap (unfoldr readOne) BS.getLine where
  readOne s = do
    (x , s') <- BS.readInt s
    return (x, BS.drop 1 s')

addEdge::Int->Int->Cost->EdgeArr s->ST s ()
addEdge a b p arr = do
  lst <- readArray arr a
  writeArray arr a $ Edge p b : lst

buildSegTree::Int->ST s (SegArr s, EdgeArr s)
buildSegTree n = do
  edges <- newArray (-maxIdx, maxIdx) []
  segs  <- newArray_ (0, n)
  let link l r i j = do
        addEdge i j 0 edges
        addEdge (-j) (-i) 0 edges
        go l r j
      go l r idx | l+1>=r    = do
                    writeArray segs r idx
                    addEdge idx (-idx) 0 edges
                 | otherwise = do
                   let mid = quot (l + r + 1) 2
                   link l mid idx (2*idx)
                   link mid r idx (2*idx + 1)
  go 0 n 1
  return (segs, edges)
  where
    calcMax l r u | l + 1 >= r = u
                  | otherwise = let m = quot (l+r+1) 2
                                in calcMax l m (2*u) `max` calcMax m r (2*u+1)
    maxIdx = calcMax 0 n 1

multiEdge::Bool->Int->Int->Int->Int->Cost->SegArr s->EdgeArr s->ST s ()
multiEdge inverse n start endL endR c seg edge = go 0 n 1 where
  go l r idx | l >= endR || r < endL   = return () -- fully outside
             | l >= endL - 1 && r <= endR = do        -- fully inside
                 u <- readArray seg start
                 unless inverse $ addEdge (-u) idx c edge
                 when   inverse $ addEdge (-idx) u c edge
             | otherwise              = do
                let mid = quot (l + r + 1) 2
                go l mid  (idx*2)
                go mid r  (idx*2 + 1)

buildGraph::Int->[[Int]]->(Array Int [Edge], UArray Int Int)
buildGraph n queries = runST $ do
  (seg, edge) <- buildSegTree n
  let runQuery [1, v, u, w]    = do
        f <- readArray seg v
        t <- readArray seg u
        addEdge (- f) t (fromIntegral w) edge
      runQuery [2, v, l, r, w] = multiEdge False n v l r (fromIntegral w) seg edge
      runQuery [3, v, l, r, w] = multiEdge True  n v l r (fromIntegral w) seg edge
      runQuery _               = return ()
  forM_ queries runQuery
  graph <- freeze edge
  segMap <- freeze seg
  return (graph, segMap)

dijkstra::Graph->Int->Array Int Cost
dijkstra graph s = runSTArray $ do
  best <- newArray (bounds graph) (-1)
  let mkArray::ST s (STUArray s Int Int)
      mkArray = newArray_ (bounds graph)
  ind  <- mkArray
  prio <- newPrio best
  void $ pushPrio prio s
  writeArray best s 0
  let go = do
         end <- nullPrio prio
         unless end $ do
           num  <- pullPrio prio
           dist <- readArray best num
           let edges = graph ! num
           mapM_ (check dist) edges
           go
      better _ (-1)  = True
      better price x = price < x
      check acc (Edge cost to) = do
        let price = acc + cost
        current <- readArray best to
        when (price `better` current) $ do
          when (current /= -1) $ do
            ix <- readArray ind to
            void $ deletePrio prio ix
          writeArray best to price
          void $ pushPrio prio to
  go
  return best

main :: IO ()
main = do
  [n,q,s] <- getInts
  qs <- replicateM q getInts
  let (graph, segMap)  = buildGraph n qs
  -- forM_ (assocs graph) $ \(i, es) -> putStrLn $ show i <> ": " <> show es
  let best = dijkstra graph $ segMap ! s
  putStrLn $ unwords  [show $ best ! (segMap ! i) | i <- [1..n]]
--
-- validatePrio::Prio s->ST s Bool
-- validatePrio (Prio cmp ref arr _) = do
--   size <- readSTRef ref
--   let go i | 2 *i + 1>= size = return True
--            | 2* i + 2 == size = do
--         x <- readArray arr i
--         c <- readArray arr (2 * i + 1)
--         res <- cmp x c
--         unless res $ traceShowM $ show (x, c)
--         return res
--            | otherwise = do
--         x <- readArray arr i
--         l <- readArray arr (2 * i + 1)
--         r <- readArray arr (2 * i + 2)
--         vl <- cmp x l
--         vr <- cmp x r
--         unless vl $ traceShowM $ show (x, l)
--         unless vr $ traceShowM $ show (x, r)
--         vvl <- go (2 * i + 1)
--         vvr <- go (2 * i + 2)
--         return $ vl && vr && vvl && vvr
--   go 0

{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TupleSections    #-}

import           Control.Applicative
import           Control.Monad.ST.Safe
import           Control.Monad.State.Strict
import           Data.Array.ST.Safe
import           Data.Array.Unboxed
import qualified Data.ByteString.Char8      as BS
import           Data.List                  (unfoldr)
import           Data.STRef

type Cost = Integer

data Edge      = Edge !Cost !Int deriving (Eq, Ord, Show)
type EdgeArr s = STArray s Int [Edge]
type Graph     = Array Int [Edge]
type SegArr  s = STUArray s Int Int

data Prio  s   = Prio (STArray s Int Cost) (STRef s Int) (STUArray s Int Int) (STUArray s Int Int)

putPrio::Prio s->Int->Int->ST s ()
putPrio (Prio _ _ arr idx) i x = do
  writeArray arr i x
  writeArray idx x i

newPrio::STArray s Int Cost->ST s (Prio s)
newPrio values = do
    bs <-  getBounds values
    let n  = rangeSize bs
    len <- newSTRef 0
    arr <- newArray_ (0, n)
    idx <- newArray  bs (-1)
    return $ Prio values len arr idx

pushPrio::Prio s->Int->ST s ()
pushPrio prio@(Prio _ ref _ _) x = do
  n <- readSTRef ref
  writeSTRef ref (n + 1)
  putPrio prio n x
  fixUp prio n

deletePrio::Prio s->Int->ST s ()
deletePrio prio@(Prio val ref arr idx) x = do
  n <- readSTRef ref
  writeSTRef ref (n - 1)
  i <- readArray idx x
  xv <- readArray val x
  w <- readArray arr (n - 1)
  wv <- readArray val w
  putPrio prio i w
  case compare xv wv of
    EQ -> return ()
    GT -> fixDown prio i
    LT -> void $ fixUp prio i

pullPrio::Prio s->ST s Int
pullPrio prio@(Prio _ ref arr _) = do
  n <- readSTRef ref
  writeSTRef ref (n - 1)
  x <- readArray arr 0
  w <- readArray arr (n - 1)
  putPrio prio 0 w
  fixDown prio 0
  return x

nullPrio::Prio s->ST s Bool
nullPrio (Prio _ ref _ _) = (== 0) <$> readSTRef ref

fixUp::Prio s->Int->ST s ()
fixUp _ 0     = return ()
fixUp prio@(Prio val _ arr _) start  = do
  x <- readArray arr start
  xv <- readArray val x
  let go 0 = return 0
      go i = do
        let p = quot (i - 1)  2
        px <- readArray arr p
        pv <- readArray val px
        if xv >= pv then return i else putPrio prio i px >> go p
  top <- go start
  unless (top == start) $ putPrio prio top x

fixDown::Prio s->Int->ST s ()
fixDown prio@(Prio val ref arr _) start = do
  size <- readSTRef ref
  x <- readArray arr start
  xv <- readArray val x
  let go i | 2 * i + 1 >= size = return i
           | 2 * i + 2 == size = do
             let c = 2 * i + 1
             cx <- readArray arr c
             cv <- readArray val cx
             if xv <= cv then return i else putPrio prio i cx >> return c
           | otherwise  = do
            let l = 2 * i + 1
                r = 2 * i + 2
            lx <- readArray arr l
            rx <- readArray arr r
            lv <- readArray val lx
            rv <- readArray val rx
            let goLeft  = putPrio prio i lx >> go l
                goRight = putPrio prio i rx >> go r
            if xv <= lv then
              if xv <= rv then return i else goRight
            else
              if lv <= rv then goLeft else goRight
  bottom <- go start
  unless(bottom == start) $ putPrio prio bottom x

getInts::IO [Int]
getInts = fmap (unfoldr readOne) BS.getLine where
  readOne s = do
    (x , s') <- BS.readInt s
    return (x, BS.drop 1 s')

addEdge::Int->Int->Cost->EdgeArr s->ST s ()
addEdge a b p arr = do
  lst <- readArray arr a
  writeArray arr a $ Edge p b : lst

buildSegTree::Int->ST s (SegArr s, EdgeArr s)
buildSegTree n = do
  edges <- newArray (-maxIdx, maxIdx) []
  segs  <- newArray_ (0, n)
  let link l r i j = do
        addEdge i j 0 edges
        addEdge (-j) (-i) 0 edges
        go l r j
      go l r idx | l+1>=r    = do
                    writeArray segs r idx
                    addEdge idx (-idx) 0 edges
                 | otherwise = do
                   let mid = quot (l + r + 1) 2
                   link l mid idx (2*idx)
                   link mid r idx (2*idx + 1)
  go 0 n 1
  return (segs, edges)
  where
    calcMax l r u | l + 1 >= r = u
                  | otherwise = let m = quot (l+r+1) 2
                                in calcMax l m (2*u) `max` calcMax m r (2*u+1)
    maxIdx = calcMax 0 n 1

multiEdge::Bool->Int->Int->Int->Int->Cost->SegArr s->EdgeArr s->ST s ()
multiEdge inverse n start endL endR c seg edge = go 0 n 1 where
  go l r idx | l >= endR || r < endL   = return () -- fully outside
             | l >= endL - 1 && r <= endR = do        -- fully inside
                 u <- readArray seg start
                 unless inverse $ addEdge (-u) idx c edge
                 when   inverse $ addEdge (-idx) u c edge
             | otherwise              = do
                let mid = quot (l + r + 1) 2
                go l mid  (idx*2)
                go mid r  (idx*2 + 1)

buildGraph::Int->[[Int]]->(Array Int [Edge], UArray Int Int)
buildGraph n queries = runST $ do
  (seg, edge) <- buildSegTree n
  let runQuery [1, v, u, w]    = do
        f <- readArray seg v
        t <- readArray seg u
        addEdge (- f) t (fromIntegral w) edge
      runQuery [2, v, l, r, w] = multiEdge False n v l r (fromIntegral w) seg edge
      runQuery [3, v, l, r, w] = multiEdge True  n v l r (fromIntegral w) seg edge
      runQuery _               = return ()
  forM_ queries runQuery
  graph <- freeze edge
  segMap <- freeze seg
  return (graph, segMap)

dijkstra::Graph->Int->Array Int Cost
dijkstra graph s = runSTArray $ do
  best <- newArray (bounds graph) (-1)
  prio <- newPrio best
  writeArray best s 0
  pushPrio prio s
  let go = do
         end <- nullPrio prio
         unless end $ do
           num  <- pullPrio prio
           dist <- readArray best num
           let edges = graph ! num
           mapM_ (check dist) edges
           go
      better _ (-1)  = True
      better price x = price < x
      check acc (Edge cost to) = do
        let price = acc + cost
        current <- readArray best to
        when (price `better` current) $ do
          when (current /= -1) $ deletePrio prio to
          writeArray best to price
          void $ pushPrio prio to
  go
  return best

main :: IO ()
main = do
  [n,q,s] <- getInts
  qs <- replicateM q getInts
  let (graph, segMap)  = buildGraph n qs
  -- forM_ (assocs graph) $ \(i, es) -> putStrLn $ show i <> ": " <> show es
  let best = dijkstra graph $ segMap ! s
  putStrLn $ unwords  [show $ best ! (segMap ! i) | i <- [1..n]]
--
-- validatePrio::Prio s->ST s Bool
-- validatePrio (Prio cmp ref arr _) = do
--   size <- readSTRef ref
--   let go i | 2 *i + 1>= size = return True
--            | 2* i + 2 == size = do
--         x <- readArray arr i
--         c <- readArray arr (2 * i + 1)
--         res <- cmp x c
--         unless res $ traceShowM $ show (x, c)
--         return res
--            | otherwise = do
--         x <- readArray arr i
--         l <- readArray arr (2 * i + 1)
--         r <- readArray arr (2 * i + 2)
--         vl <- cmp x l
--         vr <- cmp x r
--         unless vl $ traceShowM $ show (x, l)
--         unless vr $ traceShowM $ show (x, r)
--         vvl <- go (2 * i + 1)
--         vvr <- go (2 * i + 2)
--         return $ vl && vr && vvl && vvr
--   go 0

{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE UnboxedTuples    #-}
{-# LANGUAGE ViewPatterns     #-}

import           Control.Applicative
import           Control.Monad.ST.Safe
import           Control.Monad.State.Strict
import           Data.Array.ST.Safe
import           Data.Array.Unboxed
import           Data.Bits
import qualified Data.ByteString.Char8      as BS
import           Data.Int
import qualified Data.IntMap                as IntMap
import           Data.IntMap.Strict         (IntMap)
import           Data.IntSet                (IntSet)
import qualified Data.IntSet                as IntSet
import           Data.List                  (unfoldr)
import           Data.Maybe

type Cost = Int64

data Edge      = Edge {-# UNPACK #-} !Cost {-# UNPACK #-}  !Int deriving (Eq, Ord, Show)
type Graph  s  = STArray s Int EdgeList
type SegArr  s = STUArray s Int Int
data EdgeList  = EdgeCons {-# UNPACK #-}  !Cost {-# UNPACK #-} !Int !EdgeList | EdgeNil deriving (Eq, Ord)

type CostQue = IntMap (IntMap IntSet)

base::Cost
base = shiftL 1 32

mask::Cost
mask = base - 1

queInit::Int->CostQue
queInit s = IntMap.singleton 0 $ IntMap.singleton 0 $ IntSet.singleton s

comb::Int->Int->Cost
comb h l= (fromIntegral h `shiftL` 32) .|. fromIntegral l

split::Cost->(# Int, Int #)
split n = let x = fromIntegral $ n `shiftR` 32
              y = fromIntegral $ n .&. mask
          in (# x, y #)

quePull::CostQue->Maybe (Edge, CostQue)
quePull q = do
  ((hk, hv), h) <- IntMap.minViewWithKey q
  ((lk, lv), l) <- IntMap.minViewWithKey hv
  (i, s) <- IntSet.minView lv
  let l' = if IntSet.null s then l else IntMap.insert lk s l
  let h' = if IntMap.null l' then h else IntMap.insert hk l' h
  return (Edge (comb hk lk) i, h')

quePush::Edge->CostQue->CostQue
quePush (Edge cost i ) q =
  let (# x, y #) = split cost
      l = fromMaybe IntMap.empty $ IntMap.lookup x q
      s  = fromMaybe IntSet.empty $ IntMap.lookup y l
      s' = IntSet.insert i s
      l' = IntMap.insert y s' l
  in IntMap.insert x l' q

queDel::Edge->CostQue->CostQue
queDel (Edge cost i) q =
  let (# x, y #) = split cost
      high l     = if IntMap.null l' then Nothing else Just l' where
         l' = IntMap.update low y l
      low s   = if IntSet.null s' then Nothing else Just s' where
         s' = IntSet.delete i s
  in IntMap.update high x q

getInts::IO [Int]
getInts = fmap (unfoldr readOne) BS.getLine where
  readOne s = do
    (x , s') <- BS.readInt s
    return (x, BS.drop 1 s')

addEdge::Int->Int->Cost->Graph s->ST s ()
addEdge a b p arr = do
  lst <- readArray arr a
  writeArray arr a $ EdgeCons p b lst

buildSegTree::Int->ST s (SegArr s, Graph s)
buildSegTree n = do
  edges <- newArray (-maxIdx, maxIdx) EdgeNil
  segs  <- newArray_ (0, n)
  let link l r i j = do
        addEdge i j 0 edges
        addEdge (-j) (-i) 0 edges
        go l r j
      go l r idx | l+1>=r    = do
                    writeArray segs r idx
                    addEdge idx (-idx) 0 edges
                 | otherwise = do
                   let mid = quot (l + r + 1) 2
                   link l mid idx (2*idx)
                   link mid r idx (2*idx + 1)
  go 0 n 1
  return (segs, edges)
  where
    calcMax l r u | l + 1 >= r = u
                  | otherwise = let m = quot (l+r+1) 2
                                in calcMax l m (2*u) `max` calcMax m r (2*u+1)
    maxIdx = calcMax 0 n 1

multiEdge::Bool->Int->Int->Int->Int->Cost->SegArr s->Graph s->ST s ()
multiEdge inverse n start endL endR c seg edge = go 0 n 1 where
  go l r idx | l >= endR || r < endL   = return () -- fully outside
             | l >= endL - 1 && r <= endR = do        -- fully inside
                 u <- readArray seg start
                 unless inverse $ addEdge (-u) idx c edge
                 when   inverse $ addEdge (-idx) u c edge
             | otherwise              = do
                let mid = quot (l + r + 1) 2
                go l mid  (idx*2)
                go mid r  (idx*2 + 1)

buildGraph::Int->[[Int]]->ST s (Graph s, SegArr s)
buildGraph n queries = do
  (seg, edge) <- buildSegTree n
  let runQuery [1, v, u, w]    = do
        f <- readArray seg v
        t <- readArray seg u
        addEdge (- f) t (fromIntegral w) edge
      runQuery [2, v, l, r, w] = multiEdge False n v l r (fromIntegral w) seg edge
      runQuery [3, v, l, r, w] = multiEdge True  n v l r (fromIntegral w) seg edge
      runQuery _               = return ()
  forM_ queries runQuery
  return (edge, seg)

dijkstra::Graph s->Int->ST s (STArray s Int (Maybe Cost))
dijkstra graph s = do
  bs <- getBounds graph
  best <- newArray bs Nothing
  writeArray best s (Just 0)
  let go (quePull -> Just (Edge dist num, rest)) = do
           edges <- readArray graph num
           dists <- check dist rest edges
           go dists
      go _ = return ()
      check acc dists (EdgeCons cost to rest) = do
        let price = acc + cost
        current <- readArray best to
        if maybe True (price < ) current then do
          let dists' = maybe dists remove current
              remove u = queDel (Edge u to) dists
          writeArray best to (Just price)
          let dists'' = quePush (Edge price to) dists'
          check acc dists'' rest
        else check acc dists rest
      check _   dists  EdgeNil = return dists
  go $ queInit s
  return best

main :: IO ()
main = do
  [n,q,s] <- getInts
  qs <- replicateM q getInts
  let best = runSTArray $ do
        (graph, segMap)  <- buildGraph n qs
        si <- readArray segMap s
        res <- dijkstra graph si
        arr <- newArray_ (1, n)
        forM_ [1..n] $ \i -> do
           segI <- readArray segMap i
           resI <- readArray res segI
           writeArray arr i resI
        return arr
  putStrLn $ unwords [show $ fromMaybe (-1) $ best ! i | i <- [1..n]]


You have n distinct points on a plane, none of them lie on OY axis. Check that there is a point after removal of which the remaining points are located on one side of the OY axis.

The first line contains a single positive integer n (2 ≤ n ≤ 105). The following n lines contain coordinates of the points. The i-th of these lines contains two single integers xi and yi (|xi|, |yi| ≤ 109, xi ≠ 0). No two points coincide.

Print "Yes" if there is such a point, "No" — otherwise. You can print every letter in any case (upper or lower).

NoteIn the first example the second point can be removed.In the second example there is no suitable for the condition point.In the third example any point can be removed.

module Main where
import qualified Data.ByteString.Char8 as B
import Control.Monad
import Control.Monad.Trans.State.Lazy
import Data.List
import Data.Bool

main = B.interact exec
exec = B.pack . evalState app . B.words
app = (bool "No" "Yes" . solve) `fmap` (flip replicateM (liftM2 (,) poi poi) =<< poi)
  where
  pop = state $ \(x:xs) -> (x, xs)
  poi = fmap int pop
  int = maybe undefined fst . B.readInt

solve = (\(ls, rs) -> case (ls, rs) of { ([_], _) -> True; (_, [_]) -> True; ([], _) -> True; (_, []) -> True; _ -> False }) . partition ((< 0) . fst)

main = getLine >> getContents >>= putStrLn . solve . map (read.head.words) . lines

solve xs
    | judge xs = "No"
    | otherwise = "Yes"
    where judge = (>1) . minimum . foldl (\[p,n] x -> if x > 0 then [p+1,n] else [p,n+1]) [0,0]

import Data.List

f::[String]->[Int]
f []=[]
f (x:xs)=let (a:b:[])=map read (words x)::[Int]
         in (if a>0 then 1 else (-1)):f xs

main = do
       e<-getLine
       es<-getContents
       let n=read e::Int
           xs=lines es
           zs=sort $ f xs
           t1=tail $ reverse zs
           t2=tail zs
       putStrLn $ if (minimum t2)==(maximum t2) || (minimum t1)==(maximum t1) then "Yes" else "No"

import Control.Applicative
import Control.Monad
import Data.List
import Data.Array

main = do
	n<-read <$> getLine ::IO Int
	a<-map (read.head.words) <$> replicateM n getLine:: IO [Int]
	let p = length $ filter (>0) a
	putStrLn $ if (min p (n-p)) >1 then "No" else "Yes"

import           Control.Monad
import           Data.List

main :: IO ()
main = do
  n <- (read :: String -> Int) <$> getLine
  points <- partition (<0) . map (head . map (read :: String -> Int) . words) <$> replicateM n getLine
  putStrLn $ if length (fst points) < 2 || length (snd points) < 2 then "Yes" else "No"

groupOn :: Int -> [a] -> [[a]]
groupOn _ [] = []
groupOn n xs = let (sts, nds) = splitAt n xs in sts : groupOn n nds
-------------------------------------------------------------------------------

main = interact $ unlines . parse . lines

parse (_:ops') = sol ops
  where
    ops = map (fn . words) ops'
    fn :: [String] -> Int
    fn [b, e] = read b

sol pts = [ if res then "Yes" else "No" ]
  where
    res = cnt+1 >= length pts || cnt <= 1
    cnt = length $ filter (<0) pts


It turns out that the meaning of life is a permutation $$$p_1, p_2, \ldots, p_n$$$ of the integers $$$1, 2, \ldots, n$$$ ($$$2 \leq n \leq 100$$$). Omkar, having created all life, knows this permutation, and will allow you to figure it out using some queries.A query consists of an array $$$a_1, a_2, \ldots, a_n$$$ of integers between $$$1$$$ and $$$n$$$. $$$a$$$ is not required to be a permutation. Omkar will first compute the pairwise sum of $$$a$$$ and $$$p$$$, meaning that he will compute an array $$$s$$$ where $$$s_j = p_j + a_j$$$ for all $$$j = 1, 2, \ldots, n$$$. Then, he will find the smallest index $$$k$$$ such that $$$s_k$$$ occurs more than once in $$$s$$$, and answer with $$$k$$$. If there is no such index $$$k$$$, then he will answer with $$$0$$$.You can perform at most $$$2n$$$ queries. Figure out the meaning of life $$$p$$$.

NoteIn the sample, the hidden permutation $$$p$$$ is $$$[3, 2, 1, 5, 4]$$$. Three queries were made.The first query is $$$a = [4, 4, 2, 3, 2]$$$. This yields $$$s = [3 + 4, 2 + 4, 1 + 2, 5 + 3, 4 + 2] = [7, 6, 3, 8, 6]$$$. $$$6$$$ is the only number that appears more than once, and it appears first at index $$$2$$$, making the answer to the query $$$2$$$.The second query is $$$a = [3, 5, 1, 5, 5]$$$. This yields $$$s = [3 + 3, 2 + 5, 1 + 1, 5 + 5, 4 + 5] = [6, 7, 2, 10, 9]$$$. There are no numbers that appear more than once here, so the answer to the query is $$$0$$$.The third query is $$$a = [5, 2, 4, 3, 1]$$$. This yields $$$s = [3 + 5, 2 + 2, 1 + 4, 5 + 3, 4 + 1] = [8, 4, 5, 8, 5]$$$. $$$5$$$ and $$$8$$$ both occur more than once here. $$$5$$$ first appears at index $$$3$$$, while $$$8$$$ first appears at index $$$1$$$, and $$$1 < 3$$$, making the answer to the query $$$1$$$.Note that the sample is only meant to provide an example of how the interaction works; it is not guaranteed that the above queries represent a correct strategy with which to determine the answer.

-- Clyring's code tweaked
import qualified Data.ByteString.Lazy.Char8 as P
import Data.ByteString.Builder
import qualified Data.ByteString.Builder.Prim as Prim
import System.IO
import Control.Monad.Trans.State

import Data.ByteString.Builder.Extra (flush) -- for interactive problems
import Data.Array.Unboxed

mainFun :: SO
mainFun = do
  ~[n] <- getInts 1
  let
    query p q = string7 "? " <> putInts (replicate (n - 1) q ++ [p])
    loQueries = mconcat [query s n | s <- [n-1,n-2 .. 1]]
    hiQueries = mconcat [query s 1 | s <- [2 .. n]]
  loNums <- getInts (n - 1)
  hiNums  <- getInts (n - 1)
  let
    pinv = reverse (takeWhile (/= 0) loNums) ++ [n] ++ takeWhile (/= 0) hiNums
    p :: UArray Int Int
    p = array (1, n) $ zip pinv [1..]
  pure $ loQueries <> hiQueries <> flush <> string7 "! " <> putInts (elems p)

type SP = State [P.ByteString]
type SO = SP Builder

getNext :: Int -> SP [P.ByteString]
getNext = state . splitAt

getInts :: Int -> SP [Int]
getInts k = do
  vs <- getNext k
  pure [v | Just (v, _) <- map P.readInt vs]

putInts :: [Int] -> Builder
putInts vs = let
  sepPrim = (,) ' ' Prim.>$<
    Prim.liftFixedToBounded Prim.char7 Prim.>*< Prim.intDec
  in  case  vs  of
  [] -> char7 '\n'
  x : xs -> intDec x <> Prim.primMapListBounded sepPrim xs <> char7 '\n'

main :: IO ()
main = do
  hSetBuffering stdout NoBuffering
  inp <- P.getContents
  let  outp = evalState mainFun $ P.words inp
  P.putStr $ toLazyByteString outp

import qualified Data.ByteString.Lazy.Char8 as P
import Data.ByteString.Builder
import qualified Data.ByteString.Builder.Prim as Prim
import System.IO
import Control.Monad.Trans.State

import Data.ByteString.Builder.Extra (flush) -- for interactive problems
import Data.Array.Unboxed

mainFun :: SO
mainFun = do
  ~[n] <- getInts 1
  let
    query p q = string7 "? " <> putInts (replicate (n - 1) q ++ [p])
    loQueries = mconcat [query s n | s <- [1 .. n-1]]
    hiQueries = mconcat [query s 1 | s <- [2 .. n]]
  loNums <- getInts (n - 1)
  hiNums  <- getInts (n - 1)
  let
    pinv = filter (/= 0) loNums ++ [n] ++ filter (/= 0) hiNums
    p :: UArray Int Int
    p = array (1, n) $ zip pinv [1..]
  pure $ loQueries <> hiQueries <> flush <> string7 "! " <> putInts (elems p)

type SP = State [P.ByteString]
type SO = SP Builder

getNext :: Int -> SP [P.ByteString]
getNext = state . splitAt

getInts :: Int -> SP [Int]
getInts k = do
  vs <- getNext k
  pure [v | Just (v, _) <- map P.readInt vs]

putInts :: [Int] -> Builder
putInts vs = let
  sepPrim = (,) ' ' Prim.>$<
    Prim.liftFixedToBounded Prim.char7 Prim.>*< Prim.intDec
  in  case  vs  of
  [] -> char7 '\n'
  x : xs -> intDec x <> Prim.primMapListBounded sepPrim xs <> char7 '\n'

main :: IO ()
main = do
  hSetBuffering stdout NoBuffering
  inp <- P.getContents
  let  outp = evalState mainFun $ P.words inp
  P.putStr $ toLazyByteString outp


You are given two positive integers $$$n$$$ ($$$1 \le n \le 10^9$$$) and $$$k$$$ ($$$1 \le k \le 100$$$). Represent the number $$$n$$$ as the sum of $$$k$$$ positive integers of the same parity (have the same remainder when divided by $$$2$$$).In other words, find $$$a_1, a_2, \ldots, a_k$$$ such that all $$$a_i>0$$$, $$$n = a_1 + a_2 + \ldots + a_k$$$ and either all $$$a_i$$$ are even or all $$$a_i$$$ are odd at the same time.If such a representation does not exist, then report it.

The first line contains an integer $$$t$$$ ($$$1 \le t \le 1000$$$) — the number of test cases in the input. Next, $$$t$$$ test cases are given, one per line. Each test case is two positive integers $$$n$$$ ($$$1 \le n \le 10^9$$$) and $$$k$$$ ($$$1 \le k \le 100$$$).

For each test case print:   YES and the required values $$$a_i$$$, if the answer exists (if there are several answers, print any of them);  NO if the answer does not exist.  The letters in the words YES and NO can be printed in any case.

import           Control.Arrow

main = interact $
  lines >>> drop 1 >>> map (words >>> map read >>> solve >>> format) >>> concat >>> unlines

solve :: [Int] -> Maybe [Int]
solve [n,k]
  | even k && odd n = Nothing
  | odd n || (even n && even k) = solveOdd k n
  | otherwise                   = solveEven k n

solveOdd k n
  | n < k     = Nothing
  | otherwise = Just $ (n - k + 1) : replicate (k-1) 1

solveEven k n
  | n < 2*k   = Nothing
  | otherwise = Just $ (n - 2*(k-1)) : replicate (k-1) 2

format Nothing   = ["NO"]
format (Just xs) = ["YES", unwords (map show xs)]

{-# LANGUAGE LambdaCase #-}

import Control.Monad (replicateM_)
import Data.Maybe (fromMaybe)

main = readLn >>= flip replicateM_ ioSolve

ioSolve :: IO ()
ioSolve = getLine >>= maybe (putStrLn "NO") (\x -> putStrLn "YES" >> (putStrLn . unwords . map show) x) .
    (\[x,y] ->  solve x y) . map read . words

solve ::  Int -> Int -> Maybe [Int]
solve n k | odd n && even k = Nothing
          | odd n == odd k = let a = n - (k - 1) in if a > 0 then Just $ a : replicate (k-1) 1 else Nothing
          | even n && odd k = let a = n - 2*(k - 1) in if a > 0 then Just $ a : replicate (k-1) 2 else Nothing

solve :: Int -> Int -> [Int]
solve n k
    | even k && odd n   = []
    | even k && even n && k > n = []
    | even k && even n = (n-k+1):replicate (k-1) 1
    | odd k && even n && 2*k > n = []
    | odd k && even n  = (n-2*k+2):replicate (k-1) 2
    | odd k && odd k && k > n = []
    | otherwise        = (n-k+1):replicate (k-1) 1

testCases :: Int -> IO ()
testCases 0 = return ()
testCases t = do
    (n:k:_) <- readNums
    let ans = solve n k
    case ans of
        [] -> putStrLn "NO"
        _ -> do
            putStrLn "YES"
            putStrLn $ unwords $ map show ans
    testCases (t-1)

main :: IO ()
main = do
    (t:_) <- readNums
    testCases t

readNums :: (Read n) => IO [n]
readNums = map read . words <$> getLine

main :: IO ()
main = do
    getLine
    ans <- map (solve . map read . words) . lines <$> getContents
    mapM_ putStrLn ans

solve :: [Int] -> String
solve [x,y]
  | odd x && even y = "NO"
  | even x && odd y = case x >= (2 * y) of
                        False -> "NO"
                        _ -> let twos = y - 1 in
                                "YES\n" ++ (unwords $ (map show $ replicate twos 2) ++ [show $ x - (2* twos)])
  | otherwise = case x>= y of
                        False -> "NO"
                        _ -> let ones = y - 1 in -- x odd y odd or x even y even we can use 1's
                                 "YES\n" ++ (unwords $ (map show $ replicate ones 1) ++ [show $ x - ones])

{-# LANGUAGE LambdaCase #-}

import Control.Monad (replicateM_)
import Data.Maybe (fromMaybe)

main = readLn >>= flip replicateM_ ioSolve

ioSolve :: IO ()
ioSolve = getLine >>= maybe (putStrLn "NO") (\x -> putStrLn "YES" >> (putStrLn . unwords . map show) x) .
    (\[x,y] ->  solve x y) . map read . words

solve ::  Int -> Int -> Maybe [Int]
solve n k | odd n && even k = Nothing
          | odd n == odd k = let a = n - (k - 1) in if a > 0 then Just $ a : replicate (k-1) 1 else Nothing
          | even n && odd k = let a = n - 2*(k - 1) in if a > 0 then Just $ a : replicate ((k-1) `div` 2) 2 else Nothing

solve :: Int -> Int -> [Int]
solve n k
    | even k && odd n   = []
    | even k && even n && k > n = []
    | even k && even n = (n-k+1):replicate (k-1) 1
    | odd k && even n && 2*k > n = []
    | odd k && even n  = (n-2*k+1):replicate (k-1) 2
    | odd k && odd k && k > n = []
    | otherwise        = (n-k+1):replicate (k-1) 1

testCases :: Int -> IO ()
testCases 0 = return ()
testCases t = do
    (n:k:_) <- readNums
    let ans = solve n k
    case ans of
        [] -> putStrLn "NO"
        _ -> do
            putStrLn "YES"
            putStrLn $ unwords $ map show ans
    testCases (t-1)

main :: IO ()
main = do
    (t:_) <- readNums
    testCases t

readNums :: (Read n) => IO [n]
readNums = map read . words <$> getLine