You are given n strings ti. Each string has cost ci.Let's define the function of string , where ps, i is the number of occurrences of s in ti, |s| is the length of the string s. Find the maximal value of function f(s) over all strings.Note that the string s is not necessarily some string from t.

The first line contains the only integer n (1 ≤ n ≤ 105) — the number of strings in t. Each of the next n lines contains contains a non-empty string ti. ti contains only lowercase English letters. It is guaranteed that the sum of lengths of all strings in t is not greater than 5·105. The last line contains n integers ci ( - 107 ≤ ci ≤ 107) — the cost of the i-th string.

Print the only integer a — the maximal value of the function f(s) over all strings s. Note one more time that the string s is not necessarily from t.

{-# LANGUAGE FlexibleContexts #-}
{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}

import Control.Applicative ((<$>))
import Control.Monad (forM, foldM_, replicateM)
import Control.Monad.ST.Safe (ST, runST)
import Data.Array (listArray, (!))
import Data.Array.MArray.Safe (newArray, readArray, writeArray, newArray_)
import Data.Array.ST.Safe (STArray, STUArray, runSTArray, runSTUArray)
import Data.STRef (newSTRef, readSTRef, writeSTRef, modifySTRef)
import Data.Int (Int64)
import Data.Map (Map)
import qualified Data.Map as Map

data SuffixTree a = Node [Edge a]
data Edge a = Edge !Int !Int (SuffixTree a)

suffixTree :: (Ord a) => [a] -> SuffixTree a
suffixTree s = runST $ do
  let n = length s
  lens <- newArray (0, 2*n-1) 0 :: ST s (STUArray s Int Int)
  maps <- newArray (0, 2*n-1) Map.empty :: ST s (STArray s Int (Map a Int))
  starts <- newArray (0, 2*n-1) 0 :: ST s (STUArray s Int Int)
  links <- newArray (0, 2*n-1) 0 :: ST s (STUArray s Int Int)
  let a = listArray (0, n-1) s

  m' <- newSTRef 1
  writeArray lens 0 (10^9)

  let
    makeNode i l = do
      m <- readSTRef m'
      writeArray starts m i
      writeArray lens m l
      modifySTRef m' (+1)
      return m

  foldM_ (\(node, pos) (n, c) -> do
      let
        loop node 0 _ = return (node, 0)
        loop node pos last = do
          let
            move node pos = do
              map <- readArray maps node
              let node' = Map.findWithDefault 0 (a ! (n - pos)) map
              l <- readArray lens node'
              if pos > l
                 then move node' (pos - l)
                 else return (node, pos)

          (node', pos') <- move node pos

          let cc = a ! (n-pos')
          map <- readArray maps node'
          let v = Map.findWithDefault 0 cc map
          start <- readArray starts v
          let t = a ! (start + pos' - 1)

          if v == 0
            then do
              v <- makeNode (n-pos') (10^9 :: Int)
              writeArray links last node'

              let map' = Map.insert cc v map
              writeArray maps node' map'

              if node' == 0
                 then loop node' (pos'-1) 0
                 else do
                   link <- readArray links node'
                   loop link pos' 0
            else if t == c -- && start+pos-1 < n
              then do
                writeArray links last node'
                return (node', pos')
              else do
                u <- makeNode start (pos'-1)
                w <- makeNode (n-1) (10^9)
                writeArray maps u (Map.fromList [(c, w), (t, v)])
                writeArray starts v (start+pos'-1)

                readArray lens v >>= \l -> writeArray lens v (l-pos'+1)

                let map' = Map.insert cc u map
                writeArray maps node' map'

                writeArray links last u

                if node' == 0
                   then loop node' (pos'-1) u
                   else do
                     link <- readArray links node'
                     loop link pos' u

      loop node (pos+1) 0
    ) (0, 0) (zip [1..] s)

  let
    traverse i = do
      map <- readArray maps i
      l <- forM (Map.toList map) $ \(_, i) -> do
          start <- readArray starts i
          len <- readArray lens i
          t <- traverse i
          return $ Edge (start+1) len t
      return $ Node l

  traverse 0

data Item = CharItem !Char | DelimItem !Int deriving (Eq, Ord)

main = do
  n <- readLn
  ts <- replicateM n getLine
  cs <- map read . words <$> getLine

  let
    (r, _) = dfs 0 t
      where
        t = suffixTree s
          where
            s = concat . map (\(t, c) -> map CharItem t ++ [DelimItem c]) $ zip ts [1..]

        cs' = listArray (1, length cs) cs
        places = Map.fromList $ zip (scanl1 (+) $ map ((+1) . length) ts) [1..]

        dfs :: Int -> SuffixTree a -> (Int64, Int64)
        dfs _ (Node []) = (-10^9, 0)
        dfs d (Node es) = (max m (s * (fromIntegral d)), s)
          where
            s = sum $ map snd rs
            m = maximum $ map fst rs

            rs = map f es
              where
                f (Edge s l t') = f' $ Map.lookupGE s places
                  where
                    f' Nothing = dfs (d+l) t'
                    f' (Just (k, _)) | k > s+l-1 = dfs (d+l) t'
                    f' (Just (k, v)) =
                        if p == 0 then (0, c) else ((fromIntegral (d+p))*c, c)
                      where
                        p = k - s
                        c = fromIntegral (cs' ! v)

  print r

{-# LANGUAGE FlexibleContexts #-}
{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}

import Control.Applicative ((<$>))
import Control.Monad (forM, forM_, replicateM)
import Control.Monad.ST.Safe (ST, runST)
import Data.Array (listArray, (!))
import Data.Array.MArray.Safe (newArray, readArray, writeArray, newArray_)
import Data.Array.ST.Safe (STArray, STUArray, runSTArray, runSTUArray)
import Data.List (find, elemIndex)
import Data.Maybe (fromJust)
import Data.STRef (newSTRef, readSTRef, writeSTRef, modifySTRef)
import Data.Int (Int64)
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
import Data.Map (Map)
import qualified Data.Map as Map

data SuffixTree a = Node [Edge a] deriving (Show)
data Edge a = Edge !Int !Int (SuffixTree a) deriving (Show)

suffixTree :: (Ord a) => [a] -> SuffixTree a
suffixTree s = runST $ do
  let n = length s
  lens <- newArray (0, 2*n-1) 0 :: ST s (STArray s Int Int)
  maps <- newArray (0, 2*n-1) Map.empty :: ST s (STArray s Int (Map a Int))
  starts <- newArray (0, 2*n-1) 0 :: ST s (STUArray s Int Int)
  links <- newArray (0, 2*n-1) 0 :: ST s (STUArray s Int Int)
  let a = listArray (0, n-1) s

  m' <- newSTRef 1
  writeArray lens 0 (10^9)

  node' <- newSTRef 0
  pos' <- newSTRef 0

  let
    makeNode i l = do
      m <- readSTRef m'
      writeArray starts m i
      writeArray lens m l
      modifySTRef m' (+1)
      return m

  forM_ (zip [1..] s) $ \(n, c) -> do
    node <- readSTRef node'
    pos <- readSTRef pos'

    let
      loop node 0 _ = return (node, 0)
      loop node pos last = do
        let
          move node pos = do
            map <- readArray maps node
            let node' = Map.findWithDefault 0 (a ! (n - pos)) map
            l <- readArray lens node'
            if pos > l
               then move node' (pos - l)
               else return (node, pos)

        (node', pos') <- move node pos

        let cc = a ! (n-pos')
        map <- readArray maps node'
        let v = Map.findWithDefault 0 cc map
        start <- readArray starts v
        let t = a ! (start + pos' - 1)

        if v == 0
          then do
            v <- makeNode (n-pos') (10^9 :: Int)
            writeArray links last node'

            let map' = Map.insert cc v map
            writeArray maps node' map'

            if node' == 0
               then loop node' (pos'-1) 0
               else do
                 link <- readArray links node'
                 loop link pos' 0
          else if t == c -- && start+pos-1 < n
            then do
              writeArray links last node'
              return (node', pos')
            else do
              u <- makeNode start (pos'-1)
              w <- makeNode (n-1) (10^9)
              writeArray maps u (Map.fromList [(c, w), (t, v)])
              writeArray starts v (start+pos'-1)

              readArray lens v >>= \l -> writeArray lens v (l-pos'+1)

              let map' = Map.insert cc u map
              writeArray maps node' map'

              writeArray links last u

              if node' == 0
                 then loop node' (pos'-1) u
                 else do
                   link <- readArray links node'
                   loop link pos' u

    (node2, pos2) <- loop node (pos+1) 0
    writeSTRef node' node2
    writeSTRef pos' pos2

  let
    traverse i = do
      map <- readArray maps i
      l <- forM (Map.toList map) $ \(_, i) -> do
          start <- readArray starts i
          len <- readArray lens i
          t <- traverse i
          return $ Edge (start+1) len t
      return $ Node l

  traverse 0

data Item = CharItem !Char | DelimItem !Int deriving (Eq, Ord, Show)

main = do
  n <- readLn
  ts <- replicateM n getLine
  cs <- map read . words <$> getLine :: IO [Int]

  let
    t = suffixTree s
    s = concat . map (\(t, c) -> map CharItem t ++ [DelimItem c]) $ zip ts [1..]

    cs' = listArray (1, length cs) cs
    places = IntMap.fromList $ zip (scanl1 (+) $ map ((+1) . length) ts) [1..]

    (r, _) = dfs 0 t
      where
        dfs :: Int -> SuffixTree a -> (Int64, Int64)
        dfs _ (Node []) = (-10^9, 0)
        dfs d (Node es) = (max m (s * (fromIntegral d)), s)
          where
            s = sum $ map snd rs
            m = maximum $ map fst rs

            rs = map f es
              where
                f (Edge s l t') = f' $ IntMap.lookupGE s places
                  where
                    f' Nothing = dfs (d+l) t'
                    f' (Just (k, _)) | k > s+l-1 = dfs (d+l) t'
                    f' (Just (k, v)) =
                        if p == 0 then (0, c) else ((fromIntegral (d+p))*c, c)
                      where
                        p = k - s
                        c = fromIntegral (cs' ! v)

  print r

{-# LANGUAGE FlexibleContexts #-}
{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}

import Control.Applicative ((<$>))
import Control.Monad (forM, foldM_, replicateM)
import Control.Monad.ST.Safe (ST, runST)
import Data.Array (listArray, (!))
import Data.Array.MArray.Safe (newArray, readArray, writeArray, newArray_)
import Data.Array.ST.Safe (STArray, STUArray, runSTArray, runSTUArray)
import Data.STRef (newSTRef, readSTRef, writeSTRef, modifySTRef)
import Data.Int (Int64)
import Data.Map (Map)
import qualified Data.Map as Map

data SuffixTree a = Node [Edge a]
data Edge a = Edge !Int !Int (SuffixTree a)

suffixTree :: (Ord a) => [a] -> SuffixTree a
suffixTree s = runST $ do
  let n = length s
  lens <- newArray (0, 2*n-1) 0 :: ST s (STUArray s Int Int)
  maps <- newArray (0, 2*n-1) Map.empty :: ST s (STArray s Int (Map a Int))
  starts <- newArray (0, 2*n-1) 0 :: ST s (STUArray s Int Int)
  links <- newArray (0, 2*n-1) 0 :: ST s (STUArray s Int Int)
  let a = listArray (0, n-1) s

  m' <- newSTRef 1
  writeArray lens 0 (10^9)

  let
    makeNode i l = do
      m <- readSTRef m'
      writeArray starts m i
      writeArray lens m l
      modifySTRef m' (+1)
      return m

  foldM_ (\(node, pos) (n, c) -> do
      let
        loop node 0 _ = return (node, 0)
        loop node pos last = do
          let
            move node pos = do
              map <- readArray maps node
              let node' = Map.findWithDefault 0 (a ! (n - pos)) map
              l <- readArray lens node'
              if pos > l
                 then move node' (pos - l)
                 else return (node, pos)

          (node', pos') <- move node pos

          let cc = a ! (n-pos')
          map <- readArray maps node'
          let v = Map.findWithDefault 0 cc map
          start <- readArray starts v
          let t = a ! (start + pos' - 1)

          if v == 0
            then do
              v <- makeNode (n-pos') (10^9 :: Int)
              writeArray links last node'

              let map' = Map.insert cc v map
              writeArray maps node' map'

              if node' == 0
                 then loop node' (pos'-1) 0
                 else do
                   link <- readArray links node'
                   loop link pos' 0
            else if t == c -- && start+pos-1 < n
              then do
                writeArray links last node'
                return (node', pos')
              else do
                u <- makeNode start (pos'-1)
                w <- makeNode (n-1) (10^9)
                writeArray maps u (Map.fromList [(c, w), (t, v)])
                writeArray starts v (start+pos'-1)

                readArray lens v >>= \l -> writeArray lens v (l-pos'+1)

                let map' = Map.insert cc u map
                writeArray maps node' map'

                writeArray links last u

                if node' == 0
                   then loop node' (pos'-1) u
                   else do
                     link <- readArray links node'
                     loop link pos' u

      loop node (pos+1) 0
    ) (0, 0) (zip [1..] s)

  let
    traverse i = do
      map <- readArray maps i
      l <- forM (Map.toList map) $ \(_, i) -> do
          start <- readArray starts i
          len <- readArray lens i
          t <- traverse i
          return $ Edge (start+1) len t
      return $ Node l

  traverse 0

data Item = CharItem !Char | DelimItem !Int deriving (Eq, Ord)

main = do
  n <- readLn
  ts <- replicateM n getLine
  cs <- map read . words <$> getLine

  let
    (r, _) = dfs 0 t
      where
        t = suffixTree s
          where
            s = concat . map (\(t, c) -> map CharItem t ++ [DelimItem c]) $ zip ts [1..]

        cs' = listArray (1, length cs) cs
        places = Map.fromList $ zip (scanl1 (+) $ map ((+1) . length) ts) [1..]

        dfs :: Int -> SuffixTree a -> (Int64, Int64)
        dfs _ (Node []) = (-10^9, 0)
        dfs d (Node es) = (max m (s * (fromIntegral d)), s)
          where
            m = maximum ms
            s = sum ss

            (ms, ss) = unzip $ map f es
              where
                f (Edge s l t') = f' $ Map.lookupGE s places
                  where
                    f' (Just (k, v)) | k <= s+l-1 =
                        if p == 0 then (0, c) else ((fromIntegral (d+p))*c, c)
                      where
                        p = k - s
                        c = fromIntegral (cs' ! v)
                    f' _ = dfs (d+l) t'

  print r

{-# LANGUAGE FlexibleContexts #-}
{-# OPTIONS_GHC -O -funbox-strict-fields #-}

import Control.Applicative ((<$>))
import Control.Monad (forM, foldM_, replicateM)
import Control.Monad.ST.Safe (ST, runST)
import Data.Array (listArray, (!))
import Data.Array.MArray.Safe (newArray, readArray, writeArray, newArray_)
import Data.Array.ST.Safe (STArray, STUArray, runSTArray, runSTUArray)
import Data.STRef (newSTRef, readSTRef, writeSTRef, modifySTRef)
import Data.Int (Int64)
import Data.Map (Map)
import qualified Data.Map as Map

data SuffixTree a = Node [Edge a]
data Edge a = Edge !Int !Int (SuffixTree a)

suffixTree :: (Ord a) => [a] -> SuffixTree a
suffixTree s = runST $ do
  let n = length s
  lens <- newArray (0, 2*n-1) 0 :: ST s (STUArray s Int Int)
  maps <- newArray (0, 2*n-1) Map.empty :: ST s (STArray s Int (Map a Int))
  starts <- newArray (0, 2*n-1) 0 :: ST s (STUArray s Int Int)
  links <- newArray (0, 2*n-1) 0 :: ST s (STUArray s Int Int)
  let a = listArray (0, n-1) s

  m' <- newSTRef 1
  writeArray lens 0 (10^9)

  let
    makeNode i l = do
      m <- readSTRef m'
      writeArray starts m i
      writeArray lens m l
      modifySTRef m' (+1)
      return m

  foldM_ (\(node, pos) (n, c) -> do
      let
        loop node 0 _ = return (node, 0)
        loop node pos last = do
          let
            move node pos = do
              map <- readArray maps node
              let node' = Map.findWithDefault 0 (a ! (n - pos)) map
              l <- readArray lens node'
              if pos > l
                 then move node' (pos - l)
                 else return (node, pos)

          (node', pos') <- move node pos

          let cc = a ! (n-pos')
          map <- readArray maps node'
          let v = Map.findWithDefault 0 cc map
          start <- readArray starts v
          let t = a ! (start + pos' - 1)

          if v == 0
            then do
              v <- makeNode (n-pos') (10^9 :: Int)
              writeArray links last node'

              let map' = Map.insert cc v map
              writeArray maps node' map'

              if node' == 0
                 then loop node' (pos'-1) 0
                 else do
                   link <- readArray links node'
                   loop link pos' 0
            else if t == c -- && start+pos-1 < n
              then do
                writeArray links last node'
                return (node', pos')
              else do
                u <- makeNode start (pos'-1)
                w <- makeNode (n-1) (10^9)
                writeArray maps u (Map.fromList [(c, w), (t, v)])
                writeArray starts v (start+pos'-1)

                readArray lens v >>= \l -> writeArray lens v (l-pos'+1)

                let map' = Map.insert cc u map
                writeArray maps node' map'

                writeArray links last u

                if node' == 0
                   then loop node' (pos'-1) u
                   else do
                     link <- readArray links node'
                     loop link pos' u

      loop node (pos+1) 0
    ) (0, 0) (zip [1..] s)

  let
    traverse i = do
      map <- readArray maps i
      l <- forM (Map.toList map) $ \(_, i) -> do
          start <- readArray starts i
          len <- readArray lens i
          t <- traverse i
          return $ Edge (start+1) len t
      return $ Node l

  traverse 0

data Item = CharItem !Char | DelimItem !Int deriving (Eq, Ord)

main = do
  n <- readLn
  ts <- replicateM n getLine
  cs <- map read . words <$> getLine

  let
    (r, _) = dfs 0 t
      where
        t = suffixTree s
          where
            s = concat . map (\(t, c) -> map CharItem t ++ [DelimItem c]) $ zip ts [1..]

        cs' = listArray (1, length cs) cs
        places = Map.fromList $ zip (scanl1 (+) $ map ((+1) . length) ts) [1..]

        dfs :: Int -> SuffixTree a -> (Int64, Int64)
        dfs _ (Node []) = (-10^9, 0)
        dfs d (Node es) = (max m (s * (fromIntegral d)), s)
          where
            s = sum $ map snd rs
            m = maximum $ map fst rs

            rs = map f es
              where
                f (Edge s l t') = f' $ Map.lookupGE s places
                  where
                    f' Nothing = dfs (d+l) t'
                    f' (Just (k, _)) | k > s+l-1 = dfs (d+l) t'
                    f' (Just (k, v)) =
                        if p == 0 then (0, c) else ((fromIntegral (d+p))*c, c)
                      where
                        p = k - s
                        c = fromIntegral (cs' ! v)

  print r

{-# LANGUAGE FlexibleContexts #-}
{-# OPTIONS_GHC -O3 -funbox-strict-fields #-}

import Control.Applicative ((<$>))
import Control.Monad (forM, foldM_, replicateM)
import Control.Monad.ST.Safe (ST, runST)
import Data.Array (listArray, (!))
import Data.Array.MArray.Safe (newArray, readArray, writeArray, newArray_)
import Data.Array.ST.Safe (STArray, STUArray, runSTArray, runSTUArray)
import Data.STRef (newSTRef, readSTRef, writeSTRef, modifySTRef)
import Data.Int (Int64)
import Data.Map (Map)
import qualified Data.Map as Map

data SuffixTree a = Node [Edge a]
data Edge a = Edge !Int !Int (SuffixTree a)

suffixTree :: (Ord a) => [a] -> SuffixTree a
suffixTree s = runST $ do
  let n = length s
  lens <- newArray (0, 2*n-1) 0 :: ST s (STUArray s Int Int)
  maps <- newArray (0, 2*n-1) Map.empty :: ST s (STArray s Int (Map a Int))
  starts <- newArray (0, 2*n-1) 0 :: ST s (STUArray s Int Int)
  links <- newArray (0, 2*n-1) 0 :: ST s (STUArray s Int Int)
  let a = listArray (0, n-1) s

  m' <- newSTRef 1
  writeArray lens 0 (10^9)

  let
    makeNode i l = do
      m <- readSTRef m'
      writeArray starts m i
      writeArray lens m l
      modifySTRef m' (+1)
      return m

  foldM_ (\(node, pos) (n, c) -> do
      let
        loop node 0 _ = return (node, 0)
        loop node pos last = do
          let
            move node pos = do
              map <- readArray maps node
              let node' = Map.findWithDefault 0 (a ! (n - pos)) map
              l <- readArray lens node'
              if pos > l
                 then move node' (pos - l)
                 else return (node, pos)

          (node', pos') <- move node pos

          let cc = a ! (n-pos')
          map <- readArray maps node'
          let v = Map.findWithDefault 0 cc map
          start <- readArray starts v
          let t = a ! (start + pos' - 1)

          if v == 0
            then do
              v <- makeNode (n-pos') (10^9 :: Int)
              writeArray links last node'

              let map' = Map.insert cc v map
              writeArray maps node' map'

              if node' == 0
                 then loop node' (pos'-1) 0
                 else do
                   link <- readArray links node'
                   loop link pos' 0
            else if t == c -- && start+pos-1 < n
              then do
                writeArray links last node'
                return (node', pos')
              else do
                u <- makeNode start (pos'-1)
                w <- makeNode (n-1) (10^9)
                writeArray maps u (Map.fromList [(c, w), (t, v)])
                writeArray starts v (start+pos'-1)

                readArray lens v >>= \l -> writeArray lens v (l-pos'+1)

                let map' = Map.insert cc u map
                writeArray maps node' map'

                writeArray links last u

                if node' == 0
                   then loop node' (pos'-1) u
                   else do
                     link <- readArray links node'
                     loop link pos' u

      loop node (pos+1) 0
    ) (0, 0) (zip [1..] s)

  let
    traverse i = do
      map <- readArray maps i
      l <- forM (Map.toList map) $ \(_, i) -> do
          start <- readArray starts i
          len <- readArray lens i
          t <- traverse i
          return $ Edge (start+1) len t
      return $ Node l

  traverse 0

data Item = CharItem !Char | DelimItem !Int deriving (Eq, Ord)

main = do
  n <- readLn
  ts <- replicateM n getLine
  cs <- map read . words <$> getLine

  let
    (r, _) = dfs 0 t
      where
        t = suffixTree s
          where
            s = concat . map (\(t, c) -> map CharItem t ++ [DelimItem c]) $ zip ts [1..]

        cs' = listArray (1, length cs) cs
        places = Map.fromList $ zip (scanl1 (+) $ map ((+1) . length) ts) [1..]

        dfs :: Int -> SuffixTree a -> (Int64, Int64)
        dfs _ (Node []) = (-10^9, 0)
        dfs d (Node es) = (max m (s * (fromIntegral d)), s)
          where
            s = sum $ map snd rs
            m = maximum $ map fst rs

            rs = map f es
              where
                f (Edge s l t') = f' $ Map.lookupGE s places
                  where
                    f' Nothing = dfs (d+l) t'
                    f' (Just (k, _)) | k > s+l-1 = dfs (d+l) t'
                    f' (Just (k, v)) =
                        if p == 0 then (0, c) else ((fromIntegral (d+p))*c, c)
                      where
                        p = k - s
                        c = fromIntegral (cs' ! v)

  print r

{-# LANGUAGE FlexibleContexts #-}
{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}

import Control.Applicative ((<$>))
import Control.Monad (forM, forM_, replicateM)
import Control.Monad.ST.Safe (ST, runST)
import Data.Array.IArray (listArray, (!))
import Data.Array.MArray.Safe (newArray, readArray, writeArray, newArray_)
import Data.Array.ST.Safe (STArray, STUArray, runSTArray, runSTUArray)
import Data.Array.Unboxed (UArray)
import Data.List (find, elemIndex)
import Data.Maybe (fromJust)
import Data.Char (ord)
import Data.STRef (newSTRef, readSTRef, writeSTRef, modifySTRef)
import Data.IntMap (IntMap)
import Data.Int (Int64)
import Data.Set (Set)
import qualified Data.Set as Set

import qualified Data.IntMap as IntMap
-- import Debug.Trace (trace)

solve :: [Int] -> UArray Int Int -> IntMap Int -> (Int64, Int64)
solve s cs' places = runST $ do
  let n = length s
  let nnn = n
  lens <- newArray (0, 2*n-1) 0 :: ST s (STUArray s Int Int)
  maps <- newArray (0, 2*n-1) IntMap.empty :: ST s (STArray s Int (IntMap Int))
  starts <- newArray (0, 2*n-1) 0 :: ST s (STUArray s Int Int)
  links <- newArray (0, 2*n-1) 0 :: ST s (STUArray s Int Int)
  let a = listArray (0, n-1) s :: UArray Int Int

  m' <- newSTRef 1
  writeArray lens 0 (10^9)

  node' <- newSTRef 0
  pos' <- newSTRef 0

  let
    makeNode i l = do
      m <- readSTRef m'
      writeArray starts m i
      writeArray lens m l
      modifySTRef m' (+1)
      return m

  forM_ (zip [1..] s) $ \(n, c) -> do
    node <- readSTRef node'
    pos <- readSTRef pos'

    let
      loop node 0 _ = return (node, 0)
      loop node pos last = do
        let
          move node pos = do
            map <- readArray maps node
            let node' = IntMap.findWithDefault 0 (a ! (n - pos)) map
            l <- readArray lens node'
            if pos > l
               then move node' (pos - l)
               else return (node, pos)

        (node', pos') <- move node pos

        let cc = a ! (n-pos')
        map <- readArray maps node'
        let v = IntMap.findWithDefault 0 cc map
        start <- readArray starts v
        let t = a ! (start + pos' - 1)

        if v == 0
          then do
            v <- makeNode (n-pos') (10^9 :: Int)
            writeArray links last node'

            let map' = IntMap.insert cc v map
            writeArray maps node' map'

            if node' == 0
               then loop node' (pos'-1) 0
               else do
                 link <- readArray links node'
                 loop link pos' 0
          else if t == c -- && start+pos-1 < n
            then do
              writeArray links last node'
              return (node', pos')
            else do
              u <- makeNode start (pos'-1)
              w <- makeNode (n-1) (10^9)
              writeArray maps u (IntMap.fromList [(c, w), (t, v)])
              writeArray starts v (start+pos'-1)

              readArray lens v >>= \l -> writeArray lens v (l-pos'+1)

              let map' = IntMap.insert cc u map
              writeArray maps node' map'

              writeArray links last u

              if node' == 0
                 then loop node' (pos'-1) u
                 else do
                   link <- readArray links node'
                   loop link pos' u

    (node2, pos2) <- loop node (pos+1) 0
    writeSTRef node' node2
    writeSTRef pos' pos2

  let
    dfs d i = do
      m <- readArray maps i
      if IntMap.null m
        then return $ (-10^9 :: Int64, 0 :: Int64)
        else do
          rs <- forM (IntMap.elems m) $ \i -> do
            s <- readArray starts i
            l <- readArray lens i

            let
              r = min nnn (s+l)
              delim = IntMap.lookupGE (s+1) places

              f' Nothing = dfs (d + (fromIntegral l)) i
              f' (Just (k, _)) | k > r = dfs (d + (fromIntegral l)) i
              f' (Just (k, v)) = return $ if p == 0 then (0 :: Int64, c) else (((fromIntegral d)+p)*c, c)
                where
                  p = fromIntegral $ k - 1 - s :: Int64
                  c = fromIntegral (cs' ! (v - (10^6 :: Int))) :: Int64

            f' delim

          let
            s = sum $ map snd rs
            m = maximum $ map fst rs

          return $ (max m (s * (fromIntegral d)), s)

  dfs (0 :: Int) 0

-- data Item = CharItem !Char | DelimItem !Int deriving (Eq, Ord, Show)

main = do
  n <- readLn
  ts <- replicateM n getLine
  cs <- map read . words <$> getLine :: IO [Int]

  let
    s' = concat . map (\(t, i) -> map ord t ++ [i + 10^6]) $ zip ts [1..] :: [Int]
    places :: IntMap Int
    places = IntMap.fromList $ filter (\(a, b) -> b > 10^6) $ zip [1..] s'
    cs' = listArray (1, length cs) cs :: UArray Int Int

    (r, _) = solve s' cs' places

  -- print t

  -- let
  --   p k (Node es) =
  --     forM_ es $ \(Edge (i, l) t) -> do
  --       putStrLn $ (replicate k ' ') ++ (concat $ map show $ take l $ drop i s')
  --       p (k + 2) t

  -- p 0 t

  print r

{-# LANGUAGE FlexibleContexts #-}
{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}

import Control.Applicative ((<$>))
import Control.Monad (forM, foldM_, replicateM)
import Control.Monad.ST.Safe (ST, runST)
import Data.Array (listArray, (!))
import Data.Array.MArray.Safe (newArray, readArray, writeArray, newArray_)
import Data.Array.ST.Safe (STArray, STUArray, runSTArray, runSTUArray)
import Data.STRef (newSTRef, readSTRef, writeSTRef, modifySTRef)
import Data.Int (Int64)
import Data.Map (Map)
import qualified Data.Map as Map

data SuffixTree a = Node [Edge a]
data Edge a = Edge !Int !Int (SuffixTree a)

suffixTree :: (Ord a) => [a] -> SuffixTree a
suffixTree s = runST $ do
  let n = length s
  lens <- newArray (0, 2*n-1) 0 :: ST s (STUArray s Int Int)
  maps <- newArray (0, 2*n-1) Map.empty :: ST s (STArray s Int (Map a Int))
  starts <- newArray (0, 2*n-1) 0 :: ST s (STUArray s Int Int)
  links <- newArray (0, 2*n-1) 0 :: ST s (STUArray s Int Int)
  let a = listArray (0, n-1) s

  m' <- newSTRef 1
  writeArray lens 0 (10^9)

  let
    makeNode i l = do
      m <- readSTRef m'
      writeArray starts m i
      writeArray lens m l
      modifySTRef m' (+1)
      return m

  foldM_ (\(node, pos) (n, c) -> do
      let
        loop node 0 _ = return (node, 0)
        loop node pos last = do
          let
            move node pos = do
              map <- readArray maps node
              let node' = Map.findWithDefault 0 (a ! (n - pos)) map
              l <- readArray lens node'
              if pos > l
                 then move node' (pos - l)
                 else return (node, pos)

          (node', pos') <- move node pos

          let cc = a ! (n-pos')
          map <- readArray maps node'
          let v = Map.findWithDefault 0 cc map
          start <- readArray starts v
          let t = a ! (start + pos' - 1)

          if v == 0
            then do
              v <- makeNode (n-pos') (10^9 :: Int)
              writeArray links last node'

              let map' = Map.insert cc v map
              writeArray maps node' map'

              if node' == 0
                 then loop node' (pos'-1) 0
                 else do
                   link <- readArray links node'
                   loop link pos' 0
            else if t == c -- && start+pos-1 < n
              then do
                writeArray links last node'
                return (node', pos')
              else do
                u <- makeNode start (pos'-1)
                w <- makeNode (n-1) (10^9)
                writeArray maps u (Map.fromList [(c, w), (t, v)])
                writeArray starts v (start+pos'-1)

                readArray lens v >>= \l -> writeArray lens v (l-pos'+1)

                let map' = Map.insert cc u map
                writeArray maps node' map'

                writeArray links last u

                if node' == 0
                   then loop node' (pos'-1) u
                   else do
                     link <- readArray links node'
                     loop link pos' u

      loop node (pos+1) 0
    ) (0, 0) (zip [1..] s)

  let
    traverse i = do
      map <- readArray maps i
      l <- forM (Map.toList map) $ \(_, i) -> do
          start <- readArray starts i
          len <- readArray lens i
          t <- traverse i
          return $ Edge (start+1) len t
      return $ Node l

  traverse 0

data Item = CharItem !Char | DelimItem !Int deriving (Eq, Ord)

main = do
  n <- readLn
  ts <- replicateM n getLine
  cs <- map read . words <$> getLine

  let
    (r, _) = dfs 0 t
      where
        t = suffixTree s
          where
            s = concat . map (\(t, c) -> map CharItem t ++ [DelimItem c]) $ zip ts [1..]

        cs' = listArray (1, length cs) cs
        places = Map.fromList $ zip (scanl1 (+) $ map ((+1) . length) ts) [1..]

        dfs :: Int -> SuffixTree a -> (Int64, Int64)
        dfs _ (Node []) = (-10^9, 0)
        dfs d (Node es) = (max m (s * (fromIntegral d)), s)
          where
            (m, s) = foldl1 (\(a, b) (c, d) -> (max a c, b + d)) $ map f es
              where
                f (Edge s l t') = f' $ Map.lookupGE s places
                  where
                    f' (Just (k, v)) | k <= s+l-1 =
                        if p == 0 then (0, c) else ((fromIntegral (d+p))*c, c)
                      where
                        p = k - s
                        c = fromIntegral (cs' ! v)
                    f' _ = dfs (d+l) t'

  print r

{-# LANGUAGE FlexibleContexts #-}
{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}

import Control.Applicative ((<$>))
import Control.Monad (forM, forM_, replicateM)
import Control.Monad.ST.Safe (ST, runST)
import Data.Array (listArray, (!))
import Data.Array.MArray.Safe (newArray, readArray, writeArray, newArray_)
import Data.Array.ST.Safe (STArray, STUArray, runSTArray, runSTUArray)
import Data.STRef (newSTRef, readSTRef, writeSTRef, modifySTRef)
import Data.Int (Int64)
import Data.Map (Map)
import qualified Data.Map as Map

data SuffixTree a = Node [Edge a]
data Edge a = Edge !Int !Int (SuffixTree a)

suffixTree :: (Ord a) => [a] -> SuffixTree a
suffixTree s = runST $ do
  let n = length s
  lens <- newArray (0, 2*n-1) 0 :: ST s (STArray s Int Int)
  maps <- newArray (0, 2*n-1) Map.empty :: ST s (STArray s Int (Map a Int))
  starts <- newArray (0, 2*n-1) 0 :: ST s (STUArray s Int Int)
  links <- newArray (0, 2*n-1) 0 :: ST s (STUArray s Int Int)
  let a = listArray (0, n-1) s

  m' <- newSTRef 1
  writeArray lens 0 (10^9)

  node' <- newSTRef 0
  pos' <- newSTRef 0

  let
    makeNode i l = do
      m <- readSTRef m'
      writeArray starts m i
      writeArray lens m l
      modifySTRef m' (+1)
      return m

  forM_ (zip [1..] s) $ \(n, c) -> do
    node <- readSTRef node'
    pos <- readSTRef pos'

    let
      loop node 0 _ = return (node, 0)
      loop node pos last = do
        let
          move node pos = do
            map <- readArray maps node
            let node' = Map.findWithDefault 0 (a ! (n - pos)) map
            l <- readArray lens node'
            if pos > l
               then move node' (pos - l)
               else return (node, pos)

        (node', pos') <- move node pos

        let cc = a ! (n-pos')
        map <- readArray maps node'
        let v = Map.findWithDefault 0 cc map
        start <- readArray starts v
        let t = a ! (start + pos' - 1)

        if v == 0
          then do
            v <- makeNode (n-pos') (10^9 :: Int)
            writeArray links last node'

            let map' = Map.insert cc v map
            writeArray maps node' map'

            if node' == 0
               then loop node' (pos'-1) 0
               else do
                 link <- readArray links node'
                 loop link pos' 0
          else if t == c -- && start+pos-1 < n
            then do
              writeArray links last node'
              return (node', pos')
            else do
              u <- makeNode start (pos'-1)
              w <- makeNode (n-1) (10^9)
              writeArray maps u (Map.fromList [(c, w), (t, v)])
              writeArray starts v (start+pos'-1)

              readArray lens v >>= \l -> writeArray lens v (l-pos'+1)

              let map' = Map.insert cc u map
              writeArray maps node' map'

              writeArray links last u

              if node' == 0
                 then loop node' (pos'-1) u
                 else do
                   link <- readArray links node'
                   loop link pos' u

    (node2, pos2) <- loop node (pos+1) 0
    writeSTRef node' node2
    writeSTRef pos' pos2

  let
    traverse i = do
      map <- readArray maps i
      l <- forM (Map.toList map) $ \(_, i) -> do
          start <- readArray starts i
          len <- readArray lens i
          t <- traverse i
          return $ Edge (start+1) len t
      return $ Node l

  traverse 0

data Item = CharItem !Char | DelimItem !Int deriving (Eq, Ord, Show)

main = do
  n <- readLn
  ts <- replicateM n getLine
  cs <- map read . words <$> getLine

  let
    (r, _) = dfs 0 t
      where
        t = suffixTree s
          where
            s = concat . map (\(t, c) -> map CharItem t ++ [DelimItem c]) $ zip ts [1..]

        cs' = listArray (1, length cs) cs
        places = Map.fromList $ zip (scanl1 (+) $ map ((+1) . length) ts) [1..]

        dfs :: Int -> SuffixTree a -> (Int64, Int64)
        dfs _ (Node []) = (-10^9, 0)
        dfs d (Node es) = (max m (s * (fromIntegral d)), s)
          where
            s = sum $ map snd rs
            m = maximum $ map fst rs

            rs = map f es
              where
                f (Edge s l t') = f' $ Map.lookupGE s places
                  where
                    f' Nothing = dfs (d+l) t'
                    f' (Just (k, _)) | k > s+l-1 = dfs (d+l) t'
                    f' (Just (k, v)) =
                        if p == 0 then (0, c) else ((fromIntegral (d+p))*c, c)
                      where
                        p = k - s
                        c = fromIntegral (cs' ! v)

  print r

{-# LANGUAGE FlexibleContexts #-}
{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}

import Control.Applicative ((<$>))
import Control.Monad (forM, forM_, replicateM)
import Control.Monad.ST.Safe (ST, runST)
import Data.Array (listArray, (!))
import Data.Array.MArray.Safe (newArray, readArray, writeArray, newArray_)
import Data.Array.ST.Safe (STArray, STUArray, runSTArray, runSTUArray)
import Data.List (find, elemIndex)
import Data.Maybe (fromJust)
import Data.STRef (newSTRef, readSTRef, writeSTRef, modifySTRef)
import Data.Map (Map)
import Data.Int (Int64)
import qualified Data.Map as Map
-- import Debug.Trace (trace)

data SuffixTree a = Node [Edge a] deriving (Show)
data Edge a = Edge (Int, Int) (SuffixTree a) deriving (Show)

suffixTree s = runST $ do
  let n = length s
  lens <- newArray (0, 2*n-1) 0 :: ST s (STUArray s Int Int)
  maps <- newArray (0, 2*n-1) Map.empty :: ST s (STArray s Int (Map a Int))
  starts <- newArray (0, 2*n-1) 0 :: ST s (STUArray s Int Int)
  links <- newArray (0, 2*n-1) 0 :: ST s (STUArray s Int Int)
  let a = listArray (0, n-1) s

  m' <- newSTRef 1
  writeArray lens 0 (10^9)

  node' <- newSTRef 0
  pos' <- newSTRef 0

  let
    makeNode i l = do
      m <- readSTRef m'
      writeArray starts m i
      writeArray lens m l
      modifySTRef m' (+1)
      return m

  forM_ (zip [1..] s) $ \(n, c) -> do
    node <- readSTRef node'
    pos <- readSTRef pos'

    let
      loop node 0 _ = return (node, 0)
      loop node pos last = do
        let
          move node pos = do
            map <- readArray maps node
            let node' = Map.findWithDefault 0 (a ! (n - pos)) map
            l <- readArray lens node'
            if pos > l
               then move node' (pos - l)
               else return (node, pos)

        (node', pos') <- move node pos

        let cc = a ! (n-pos')
        map <- readArray maps node'
        let v = Map.findWithDefault 0 cc map
        start <- readArray starts v
        let t = a ! (start + pos' - 1)

        if v == 0
          then do
            v <- makeNode (n-pos') (10^9 :: Int)
            writeArray links last node'

            let map' = Map.insert cc v map
            writeArray maps node' map'

            if node' == 0
               then loop node' (pos'-1) 0
               else do
                 link <- readArray links node'
                 loop link pos' 0
          else if t == c && start+pos-1 < n
            then do
              writeArray links last node'
              return (node', pos')
            else do
              u <- makeNode start (pos'-1)
              w <- makeNode (n-1) (10^9)
              writeArray maps u (Map.fromList [(c, w), (t, v)])
              writeArray starts v (start+pos'-1)

              readArray lens v >>= \l -> writeArray lens v (l-pos'+1)

              let map' = Map.insert cc u map
              writeArray maps node' map'

              writeArray links last u

              if node' == 0
                 then loop node' (pos'-1) u
                 else do
                   link <- readArray links node'
                   loop link pos' u

    (node2, pos2) <- loop node (pos+1) 0
    writeSTRef node' node2
    writeSTRef pos' pos2

  let
    traverse i = do
      map <- readArray maps i
      l <- forM (Map.toList map) $ \(_, i) -> do
          start <- readArray starts i
          len <- readArray lens i
          t <- traverse i
          return $ Edge (start, len) t
      return $ Node l

  traverse 0

data Item = CharItem !Char | DelimItem !Int deriving (Eq, Ord, Show)

main = do
  n <- readLn
  ts <- replicateM n getLine
  cs <- map read . words <$> getLine :: IO [Int]

  let
    s' = concat . map (\(t, c) -> map CharItem t ++ [DelimItem c]) $ zip ts [1..]
    sa = listArray (1, length s') s'
    cs' = listArray (1, length cs) cs

    t = suffixTree s'

    dfs _ (Node []) = (0 :: Int64, 0 :: Int64)
    dfs d (Node es) = -- trace ("es = " ++ show es ++ " s = " ++ show s ++ " m = " ++ show m) $
        (max m (s * d), s)
      where
        s = sum $ map snd rs
        m = maximum $ map fst rs

        rs = map f es
          where
            f (Edge (s, l) t') = f' delim
              where
                ss = map (sa !) [s+1..s+l]

                delim = find is ss
                  where
                    is (CharItem _) = False
                    is (DelimItem _) = True

                f' Nothing = dfs (d + (fromIntegral l)) t'
                f' (Just e@(DelimItem i)) = ((d+p)*c, c)
                  where
                    p = fromIntegral $ fromJust $ elemIndex e ss
                    c = fromIntegral (cs' ! i) :: Int64

    (r, _) = dfs 0 t

  -- print t

  -- let
  --   p k (Node es) =
  --     forM_ es $ \(Edge (i, l) t) -> do
  --       putStrLn $ (replicate k ' ') ++ (concat $ map show $ take l $ drop i s')
  --       p (k + 2) t

  -- p 0 t

  print r

{-# LANGUAGE NPlusKPatterns, FlexibleContexts #-}

import Control.Applicative ((<$>))
import Control.Monad (forM_, replicateM)
import Data.Array (listArray, (!))
import Data.List (find, elemIndex)
import Data.Maybe (fromJust)

data STree a = Leaf | Branch [(Label a, STree a)] deriving (Eq, Show)
type Label a = ([a], Int)

isTword :: (Eq a) => (Label a) -> (STree a) -> Bool
isTword (a:w, 0) (Branch es) = [] /= [0 | ((c:_,_),_) <- es, a == c]
isTword (a:w, wlen+1) (Branch es)
  | Leaf == node || wlen < ulen = w !! wlen == u !! wlen
  | otherwise = isTword (drop ulen w, wlen-ulen) node
  where (u, ulen, node) = head [(u, culen-1, node) | ((c:u, culen), node) <- es, a == c]

update :: (Ord a) => (STree a, Label a) -> (STree a, Label a)
update (root, (s, slen))
  | isTword (s, slen) root = (root, (s, slen+1))
  | 0 == slen = (root', (tail s, 0))
  | otherwise = update (root', (tail s, slen-1))
  where root' = insRelStuff (s, slen) root

insRelStuff :: (Ord a) => (Label a) -> (STree a) -> (STree a)
insRelStuff (aw@(a:w), 0) (Branch es)
    = Branch (g es)
  where
    g [] = [((aw, length aw), Leaf)]
    g (cusn@((c:u, culen), node):es')
      | a > c = cusn:g es'
      | otherwise = ((aw, length aw), Leaf):cusn:es'
insRelStuff (aw@(a:w), slen) (Branch es)
    = Branch (g es)
  where
    g (cusn@(cus@(cu@(c:_), culen), node):es')
      | a /= c = cusn:g es'
      | Leaf /= node && slen >= culen = (cus, node'):es'
      | head x < head y = ((cu, slen), Branch [ex, ey]):es'
      | otherwise = ((cu,slen), Branch [ey, ex]):es'
      where
        node' = insRelStuff (drop culen aw, slen-culen) node
        x = drop slen cu
        y = drop slen aw
        ex | Leaf == node = ((x, length x), Leaf)
           | otherwise = ((x, culen-slen), node)
        ey = ((y, length y), Leaf)

stree :: (Ord a) => [a] -> STree a
stree t = fst (until stop update (Branch [],(t,0)))
  where stop (_,(s, slen)) = [] == drop slen s

data Item = CharItem Char | DelimItem Int deriving (Eq, Ord, Show)

p i Leaf = return ()
p i (Branch es) =
  forM_ es $ \((s, k), e) -> do
    putStrLn $ (replicate i ' ') ++ show (take k s)
    p (i + 2) e

main = do
  n <- readLn
  ts <- replicateM n getLine
  cs <- map read . words <$> getLine :: IO [Int]

  let
    s' = concat . map (\(t, c) -> map CharItem t ++ [DelimItem c]) $ zip ts [1..]
    cs' = listArray (1, length cs) cs

    t = stree s'

    dfs _ Leaf = (0, 0)
    dfs d (Branch es) = (max m (s * d), s)
      where
        s = sum $ map snd rs
        m = maximum $ map fst rs

        rs = map f es
          where
            f ((s, l), t') = f' delim
              where
                delim = find is $ take l s
                  where
                    is (CharItem _) = False
                    is (DelimItem _) = True

                f' Nothing = dfs (d + l) t'
                f' (Just e@(DelimItem i)) = (d + p*c, c)
                  where
                    p = fromJust $ elemIndex e s
                    c = cs' ! i

    (r, _) = dfs 0 t

  print r

{-# LANGUAGE FlexibleContexts #-}
{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}

import Control.Applicative ((<$>))
import Control.Monad (forM, forM_, replicateM)
import Control.Monad.ST.Safe (ST, runST)
import Data.Array (listArray, (!))
import Data.Array.MArray.Safe (newArray, readArray, writeArray, newArray_)
import Data.Array.ST.Safe (STArray, STUArray, runSTArray, runSTUArray)
import Data.STRef (newSTRef, readSTRef, writeSTRef, modifySTRef)
import Data.Int (Int)
import Data.Map (Map)
import qualified Data.Map as Map

data SuffixTree a = Node [Edge a]
data Edge a = Edge !Int !Int (SuffixTree a)

suffixTree :: (Ord a) => [a] -> SuffixTree a
suffixTree s = runST $ do
  let n = length s
  lens <- newArray (0, 2*n-1) 0 :: ST s (STArray s Int Int)
  maps <- newArray (0, 2*n-1) Map.empty :: ST s (STArray s Int (Map a Int))
  starts <- newArray (0, 2*n-1) 0 :: ST s (STUArray s Int Int)
  links <- newArray (0, 2*n-1) 0 :: ST s (STUArray s Int Int)
  let a = listArray (0, n-1) s

  m' <- newSTRef 1
  writeArray lens 0 (10^9)

  node' <- newSTRef 0
  pos' <- newSTRef 0

  let
    makeNode i l = do
      m <- readSTRef m'
      writeArray starts m i
      writeArray lens m l
      modifySTRef m' (+1)
      return m

  forM_ (zip [1..] s) $ \(n, c) -> do
    node <- readSTRef node'
    pos <- readSTRef pos'

    let
      loop node 0 _ = return (node, 0)
      loop node pos last = do
        let
          move node pos = do
            map <- readArray maps node
            let node' = Map.findWithDefault 0 (a ! (n - pos)) map
            l <- readArray lens node'
            if pos > l
               then move node' (pos - l)
               else return (node, pos)

        (node', pos') <- move node pos

        let cc = a ! (n-pos')
        map <- readArray maps node'
        let v = Map.findWithDefault 0 cc map
        start <- readArray starts v
        let t = a ! (start + pos' - 1)

        if v == 0
          then do
            v <- makeNode (n-pos') (10^9 :: Int)
            writeArray links last node'

            let map' = Map.insert cc v map
            writeArray maps node' map'

            if node' == 0
               then loop node' (pos'-1) 0
               else do
                 link <- readArray links node'
                 loop link pos' 0
          else if t == c -- && start+pos-1 < n
            then do
              writeArray links last node'
              return (node', pos')
            else do
              u <- makeNode start (pos'-1)
              w <- makeNode (n-1) (10^9)
              writeArray maps u (Map.fromList [(c, w), (t, v)])
              writeArray starts v (start+pos'-1)

              readArray lens v >>= \l -> writeArray lens v (l-pos'+1)

              let map' = Map.insert cc u map
              writeArray maps node' map'

              writeArray links last u

              if node' == 0
                 then loop node' (pos'-1) u
                 else do
                   link <- readArray links node'
                   loop link pos' u

    (node2, pos2) <- loop node (pos+1) 0
    writeSTRef node' node2
    writeSTRef pos' pos2

  let
    traverse i = do
      map <- readArray maps i
      l <- forM (Map.toList map) $ \(_, i) -> do
          start <- readArray starts i
          len <- readArray lens i
          t <- traverse i
          return $ Edge (start+1) len t
      return $ Node l

  traverse 0

data Item = CharItem !Char | DelimItem !Int deriving (Eq, Ord, Show)

main = do
  n <- readLn
  ts <- replicateM n getLine
  cs <- map read . words <$> getLine :: IO [Int]

  let
    t = suffixTree s
    s = concat . map (\(t, c) -> map CharItem t ++ [DelimItem c]) $ zip ts [1..]

    cs' = listArray (1, length cs) cs
    places = Map.fromList $ zip (scanl1 (+) $ map ((+1) . length) ts) [1..]

    (r, _) = dfs 0 t
      where
        dfs :: Int -> SuffixTree a -> (Int, Int)
        dfs _ (Node []) = (-10^9, 0)
        dfs d (Node es) = (max m (s * (fromIntegral d)), s)
          where
            s = sum $ map snd rs
            m = maximum $ map fst rs

            rs = map f es
              where
                f (Edge s l t') = f' $ Map.lookupGE s places
                  where
                    f' Nothing = dfs (d+l) t'
                    f' (Just (k, _)) | k > s+l-1 = dfs (d+l) t'
                    f' (Just (k, v)) =
                        if p == 0 then (0, c) else ((fromIntegral (d+p))*c, c)
                      where
                        p = k - s
                        c = fromIntegral (cs' ! v)

  print r

{-# LANGUAGE FlexibleContexts #-}
{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}

import Control.Applicative ((<$>))
import Control.Monad (forM, foldM_, replicateM)
import Control.Monad.ST.Safe (ST, runST)
import Data.Array (listArray, (!))
import Data.Array.MArray.Safe (newArray, readArray, writeArray, newArray_)
import Data.Array.ST.Safe (STArray, STUArray, runSTArray, runSTUArray)
import Data.STRef (newSTRef, readSTRef, writeSTRef, modifySTRef)
import Data.Int (Int64)
import Data.Map (Map)
import qualified Data.Map as Map

data SuffixTree a = Node [Edge a]
data Edge a = Edge !Int !Int (SuffixTree a)

suffixTree :: (Ord a) => [a] -> SuffixTree a
suffixTree s = runST $ do
  let n = length s
  lens <- newArray (0, 2*n-1) 0 :: ST s (STUArray s Int Int)
  maps <- newArray (0, 2*n-1) Map.empty :: ST s (STArray s Int (Map a Int))
  starts <- newArray (0, 2*n-1) 0 :: ST s (STUArray s Int Int)
  links <- newArray (0, 2*n-1) 0 :: ST s (STUArray s Int Int)
  let a = listArray (0, n-1) s

  m' <- newSTRef 1
  writeArray lens 0 (10^9)

  let
    makeNode i l = do
      m <- readSTRef m'
      writeArray starts m i
      writeArray lens m l
      modifySTRef m' (+1)
      return m

  foldM_ (\(node, pos) (n, c) -> do
      let
        loop node 0 _ = return (node, 0)
        loop node pos last = do
          let
            move node pos = do
              map <- readArray maps node
              let node' = Map.findWithDefault 0 (a ! (n - pos)) map
              l <- readArray lens node'
              if pos > l
                 then move node' (pos - l)
                 else return (node, pos)

          (node', pos') <- move node pos

          let cc = a ! (n-pos')
          map <- readArray maps node'
          let v = Map.findWithDefault 0 cc map
          start <- readArray starts v
          let t = a ! (start + pos' - 1)

          if v == 0
            then do
              v <- makeNode (n-pos') (10^9 :: Int)
              writeArray links last node'

              let map' = Map.insert cc v map
              writeArray maps node' map'

              if node' == 0
                 then loop node' (pos'-1) 0
                 else do
                   link <- readArray links node'
                   loop link pos' 0
            else if t == c -- && start+pos-1 < n
              then do
                writeArray links last node'
                return (node', pos')
              else do
                u <- makeNode start (pos'-1)
                w <- makeNode (n-1) (10^9)
                writeArray maps u (Map.fromList [(c, w), (t, v)])
                writeArray starts v (start+pos'-1)

                readArray lens v >>= \l -> writeArray lens v (l-pos'+1)

                let map' = Map.insert cc u map
                writeArray maps node' map'

                writeArray links last u

                if node' == 0
                   then loop node' (pos'-1) u
                   else do
                     link <- readArray links node'
                     loop link pos' u

      loop node (pos+1) 0
    ) (0, 0) (zip [1..] s)

  let
    traverse i = do
      map <- readArray maps i
      l <- forM (Map.toList map) $ \(_, i) -> do
          start <- readArray starts i
          len <- readArray lens i
          t <- traverse i
          return $ Edge (start+1) len t
      return $ Node l

  traverse 0

data Item = CharItem !Char | DelimItem !Int deriving (Eq, Ord)

main = do
  n <- readLn
  ts <- replicateM n getLine
  cs <- map read . words <$> getLine

  let
    (r, _) = dfs 0 t
      where
        t = suffixTree s
          where
            s = concat . map (\(t, c) -> map CharItem t ++ [DelimItem c]) $ zip ts [1..]

        cs' = listArray (1, length cs) cs
        places = Map.fromList $ zip (scanl1 (+) $ map ((+1) . length) ts) [1..]

        dfs :: Int -> SuffixTree a -> (Int64, Int64)
        dfs _ (Node []) = (-10^9, 0)
        dfs d (Node es) = (max m (s * (fromIntegral d)), s)
          where
            s = sum ss
            m = maximum ms

            (ms, ss) = unzip $ map f es
              where
                f (Edge s l t') = f' $ Map.lookupGE s places
                  where
                    f' (Just (k, v)) | k <= s+l-1 =
                        ((fromIntegral (d+p))*c, c)
                      where
                        p = k - s
                        c = fromIntegral (cs' ! v)
                    f' _ = dfs (d+l) t'

  print r

{-# LANGUAGE FlexibleContexts #-}
{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}

import Control.Applicative ((<$>))
import Control.Monad (forM, forM_, replicateM)
import Control.Monad.ST.Safe (ST, runST)
import Data.Array (listArray, (!))
import Data.Array.MArray.Safe (newArray, readArray, writeArray, newArray_)
import Data.Array.ST.Safe (STArray, STUArray, runSTArray, runSTUArray)
import Data.List (find, elemIndex)
import Data.Maybe (fromJust)
import Data.STRef (newSTRef, readSTRef, writeSTRef, modifySTRef)
import Data.Map (Map)
import Data.Int (Int64)
import qualified Data.Map as Map
-- import Debug.Trace (trace)

data SuffixTree a = Node [Edge a] deriving (Show)
data Edge a = Edge (Int, Int) (SuffixTree a) deriving (Show)

suffixTree s = runST $ do
  let n = length s
  lens <- newArray (0, 2*n-1) 0 :: ST s (STUArray s Int Int)
  maps <- newArray (0, 2*n-1) Map.empty :: ST s (STArray s Int (Map a Int))
  starts <- newArray (0, 2*n-1) 0 :: ST s (STUArray s Int Int)
  links <- newArray (0, 2*n-1) 0 :: ST s (STUArray s Int Int)
  let a = listArray (0, n-1) s

  m' <- newSTRef 1
  writeArray lens 0 (10^9)

  node' <- newSTRef 0
  pos' <- newSTRef 0

  let
    makeNode i l = do
      m <- readSTRef m'
      writeArray starts m i
      writeArray lens m l
      modifySTRef m' (+1)
      return m

  forM_ (zip [1..] s) $ \(n, c) -> do
    node <- readSTRef node'
    pos <- readSTRef pos'

    let
      loop node 0 _ = return (node, 0)
      loop node pos last = do
        let
          move node pos = do
            map <- readArray maps node
            let node' = Map.findWithDefault 0 (a ! (n - pos)) map
            l <- readArray lens node'
            if pos > l
               then move node' (pos - l)
               else return (node, pos)

        (node', pos') <- move node pos

        let cc = a ! (n-pos')
        map <- readArray maps node'
        let v = Map.findWithDefault 0 cc map
        start <- readArray starts v
        let t = a ! (start + pos' - 1)

        if v == 0
          then do
            v <- makeNode (n-pos') (10^9 :: Int)
            writeArray links last node'

            let map' = Map.insert cc v map
            writeArray maps node' map'

            if node' == 0
               then loop node' (pos'-1) 0
               else do
                 link <- readArray links node'
                 loop link pos' 0
          else if t == c -- && start+pos-1 < n
            then do
              writeArray links last node'
              return (node', pos')
            else do
              u <- makeNode start (pos'-1)
              w <- makeNode (n-1) (10^9)
              writeArray maps u (Map.fromList [(c, w), (t, v)])
              writeArray starts v (start+pos'-1)

              readArray lens v >>= \l -> writeArray lens v (l-pos'+1)

              let map' = Map.insert cc u map
              writeArray maps node' map'

              writeArray links last u

              if node' == 0
                 then loop node' (pos'-1) u
                 else do
                   link <- readArray links node'
                   loop link pos' u

    (node2, pos2) <- loop node (pos+1) 0
    writeSTRef node' node2
    writeSTRef pos' pos2

  let
    traverse i = do
      map <- readArray maps i
      l <- forM (Map.toList map) $ \(_, i) -> do
          start <- readArray starts i
          len <- readArray lens i
          t <- traverse i
          return $ Edge (start, len) t
      return $ Node l

  traverse 0

data Item = CharItem !Char | DelimItem !Int deriving (Eq, Ord, Show)

main = do
  n <- readLn
  ts <- replicateM n getLine
  cs <- map read . words <$> getLine :: IO [Int]

  let
    s' = concat . map (\(t, c) -> map CharItem t ++ [DelimItem c]) $ zip ts [1..]
    sa = listArray (1, length s') s'
    cs' = listArray (1, length cs) cs

    t = suffixTree s'

    dfs _ (Node []) = (0 :: Int64, 0 :: Int64)
    dfs d (Node es) = -- trace ("es = " ++ show es ++ " s = " ++ show s ++ " m = " ++ show m) $
        (max m (s * d), s)
      where
        s = sum $ map snd rs
        m = maximum $ map fst rs

        rs = map f es
          where
            f (Edge (s, l) t') = f' delim
              where
                ss = map (sa !) [s+1..s+l]

                delim = find is ss
                  where
                    is (CharItem _) = False
                    is (DelimItem _) = True

                f' Nothing = dfs (d + (fromIntegral l)) t'
                f' (Just e@(DelimItem i)) = ((d+p)*c, c)
                  where
                    p = fromIntegral $ fromJust $ elemIndex e ss
                    c = fromIntegral (cs' ! i) :: Int64

    (r, _) = dfs 0 t

  -- print t

  -- let
  --   p k (Node es) =
  --     forM_ es $ \(Edge (i, l) t) -> do
  --       putStrLn $ (replicate k ' ') ++ (concat $ map show $ take l $ drop i s')
  --       p (k + 2) t

  -- p 0 t

  print r

{-# LANGUAGE FlexibleContexts #-}
{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}

import Control.Applicative ((<$>))
import Control.Monad (forM, forM_, replicateM)
import Control.Monad.ST.Safe (ST, runST)
import Data.Array (listArray, (!))
import Data.Array.MArray.Safe (newArray, readArray, writeArray, newArray_)
import Data.Array.ST.Safe (STArray, STUArray, runSTArray, runSTUArray)
import Data.List (find, elemIndex)
import Data.Maybe (fromJust)
import Data.STRef (newSTRef, readSTRef, writeSTRef, modifySTRef)
import Data.Map (Map)
import qualified Data.Map as Map
-- import Debug.Trace (trace)

data SuffixTree a = Node [Edge a] deriving (Show)
data Edge a = Edge (Int, Int) (SuffixTree a) deriving (Show)

suffixTree s = runST $ do
  let n = length s
  lens <- newArray (0, 2*n-1) 0 :: ST s (STUArray s Int Int)
  maps <- newArray (0, 2*n-1) Map.empty :: ST s (STArray s Int (Map a Int))
  starts <- newArray (0, 2*n-1) 0 :: ST s (STUArray s Int Int)
  links <- newArray (0, 2*n-1) 0 :: ST s (STUArray s Int Int)
  let a = listArray (0, n-1) s

  m' <- newSTRef 1
  writeArray lens 0 (10^9)

  node' <- newSTRef 0
  pos' <- newSTRef 0

  let
    makeNode i l = do
      m <- readSTRef m'
      writeArray starts m i
      writeArray lens m l
      modifySTRef m' (+1)
      return m

  forM_ (zip [1..] s) $ \(n, c) -> do
    node <- readSTRef node'
    pos <- readSTRef pos'

    let
      loop node 0 _ = return (node, 0)
      loop node pos last = do
        let
          move node pos = do
            map <- readArray maps node
            let node' = Map.findWithDefault 0 (a ! (n - pos)) map
            l <- readArray lens node'
            if pos > l
               then move node' (pos - l)
               else return (node, pos)

        (node', pos') <- move node pos

        let cc = a ! (n-pos')
        map <- readArray maps node'
        let v = Map.findWithDefault 0 cc map
        start <- readArray starts v
        let t = a ! (start + pos' - 1)

        if v == 0
          then do
            v <- makeNode (n-pos') (10^9 :: Int)
            writeArray links last node'

            let map' = Map.insert cc v map
            writeArray maps node' map'

            if node' == 0
               then loop node' (pos'-1) 0
               else do
                 link <- readArray links node'
                 loop link pos' 0
          else if t == c && start+pos-1 < n
            then do
              writeArray links last node'
              return (node', pos')
            else do
              u <- makeNode start (pos'-1)
              w <- makeNode (n-1) (10^9)
              writeArray maps u (Map.fromList [(c, w), (t, v)])
              writeArray starts v (start+pos'-1)

              readArray lens v >>= \l -> writeArray lens v (l-pos'+1)

              let map' = Map.insert cc u map
              writeArray maps node' map'

              writeArray links last u

              if node' == 0
                 then loop node' (pos'-1) u
                 else do
                   link <- readArray links node'
                   loop link pos' u

    (node2, pos2) <- loop node (pos+1) 0
    writeSTRef node' node2
    writeSTRef pos' pos2

  let
    traverse i = do
      map <- readArray maps i
      l <- forM (Map.toList map) $ \(_, i) -> do
          start <- readArray starts i
          len <- readArray lens i
          t <- traverse i
          return $ Edge (start, len) t
      return $ Node l

  traverse 0

data Item = CharItem !Char | DelimItem !Int deriving (Eq, Ord, Show)

main = do
  n <- readLn
  ts <- replicateM n getLine
  cs <- map read . words <$> getLine :: IO [Int]

  let
    s' = concat . map (\(t, c) -> map CharItem t ++ [DelimItem c]) $ zip ts [1..]
    sa = listArray (1, length s') s'
    cs' = listArray (1, length cs) cs

    t = suffixTree s'

    dfs _ (Node []) = (0, 0)
    dfs d (Node es) = -- trace ("es = " ++ show es ++ " s = " ++ show s ++ " m = " ++ show m) $
        (max m (s * d), s)
      where
        s = sum $ map snd rs
        m = maximum $ map fst rs

        rs = map f es
          where
            f (Edge (s, l) t') = f' delim
              where
                ss = map (sa !) [s+1..s+l]

                delim = find is ss
                  where
                    is (CharItem _) = False
                    is (DelimItem _) = True

                f' Nothing = dfs (d + l) t'
                f' (Just e@(DelimItem i)) = ((d+p)*c, c)
                  where
                    p = fromJust $ elemIndex e ss
                    c = cs' ! i

    (r, _) = dfs 0 t

  -- print t

  -- let
  --   p k (Node es) =
  --     forM_ es $ \(Edge (i, l) t) -> do
  --       putStrLn $ (replicate k ' ') ++ (concat $ map show $ take l $ drop i s')
  --       p (k + 2) t

  -- p 0 t

  print r


Slastyona and her loyal dog Pushok are playing a meaningless game that is indeed very interesting.The game consists of multiple rounds. Its rules are very simple: in each round, a natural number k is chosen. Then, the one who says (or barks) it faster than the other wins the round. After that, the winner's score is multiplied by k2, and the loser's score is multiplied by k. In the beginning of the game, both Slastyona and Pushok have scores equal to one.Unfortunately, Slastyona had lost her notepad where the history of all n games was recorded. She managed to recall the final results for each games, though, but all of her memories of them are vague. Help Slastyona verify their correctness, or, to put it another way, for each given pair of scores determine whether it was possible for a game to finish with such result or not.

In the first string, the number of games n (1 ≤ n ≤ 350000) is given. Each game is represented by a pair of scores a, b (1 ≤ a, b ≤ 109) – the results of Slastyona and Pushok, correspondingly.

For each pair of scores, answer "Yes" if it's possible for a game to finish with given score, and "No" otherwise. You can output each letter in arbitrary case (upper or lower).

NoteFirst game might have been consisted of one round, in which the number 2 would have been chosen and Pushok would have won.The second game needs exactly two rounds to finish with such result: in the first one, Slastyona would have said the number 5, and in the second one, Pushok would have barked the number 3.

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -funfolding-use-threshold=16 -fexcess-precision -funbox-strict-fields #-}
module Main where
import qualified Data.ByteString.Char8 as B
import Control.Monad
import Data.Int
import Data.Bool

main = do
  n <- fmap readInt B.getLine
  replicateM n $ B.getLine >>= putStrLn . bool "No" "Yes" . (\[a, b] -> solve (to64 a) (to64 b)) . readInts

solve a b = r1 == 0 && r2 == 0 && isCube q1 && isCube q2
  where
    (q1, r1) = (a * a) `quotRem` b
    (q2, r2) = (b * b) `quotRem` a

isCube :: Int64 -> Bool
isCube x = round (fromIntegral x ** (1/3)) ^ 3 == x
to64 x = fromIntegral x :: Int64

readInt = maybe undefined fst . B.readInt
readInts = fmap readInt . B.words

{-
a = k^x
b = k^y

x = 2w + l
y = w + 2l

,nnnn
-}

-- Codeforces My Practice
-- author: Leonardone @ NEETSDKASU

import Control.Applicative
import Control.Monad
import qualified Data.ByteString.Char8 as B
import Data.Maybe (fromJust)
import Data.Int

readB = fst . fromJust . B.readInt
readX x = fromInteger . fst . fromJust . B.readInteger $ x :: Int64

main = do
    n <- readB <$> B.getLine :: IO Int
    replicateM_ n $ B.getLine >>= putStrLn . calc . map readX . B.words

solve xs = map calc xs

cubrt x = round $ fromIntegral x ** (1/3)

calc (a:b:_) = if ans then "Yes" else "No"
    where
        (da, ma) = divMod (a*a) b
        (db, mb) = divMod (b*b) a
        ans = ma == 0 && mb == 0 && da == cubrt da ^ 3 && db == cubrt db ^ 3

-- Codeforces My Practice
-- author: Leonardone @ NEETSDKASU

import Control.Applicative
import Control.Monad
import qualified Data.ByteString.Char8 as B
import Data.Maybe (fromJust)
import Data.Int

readB x = fromInteger . fst . fromJust . B.readInteger $ x :: Int64

main = putStrLn . unlines . solve . map (map readB . B.words) . tail . B.lines =<< B.getContents

solve xs = map calc xs

cubrt x = round $ fromIntegral x ** (1 / 3)

calc (a:b:_) = if ans then "Yes" else "No"
    where
        c = gcd a b
        xa = div a c
        xb = div b c
        x = xa * xb
        zc = div c x
        cu = cubrt zc
        ans = if mod c x /= 0 then False
              else zc == cu ^ 3

-- Codeforces My Practice
-- author: Leonardone @ NEETSDKASU

import qualified Data.ByteString.Char8 as B
import Data.Maybe (fromJust)

readB = fst . fromJust . B.readInt

main = putStrLn . unlines . solve . map (map readB . B.words) . tail . B.lines =<< B.getContents

solve xs = map calc xs

cubrt x = round $ fromIntegral x ** (1/3)

calc (a:b:_) = if ans then "Yes" else "No"
    where
        (da, ma) = divMod (a*a) b
        (db, mb) = divMod (b*b) a
        ans = ma == 0 && mb == 0 && da == cubrt da ^ 3 && db == cubrt db ^ 3

-- Codeforces My Practice
-- author: Leonardone @ NEETSDKASU

main = putStrLn . unlines . solve . map (map read . words) . tail . lines =<< getContents

solve xs = map calc xs

cubrt x = round $ fromIntegral x ** (1/3)

calc (a:b:_) = if ans then "Yes" else "No"
    where
        (da, ma) = divMod (a*a) b
        ans = ma == 0 && da == cubrt da ^ 3

-- Codeforces My Practice
-- author: Leonardone @ NEETSDKASU

import qualified Data.ByteString.Char8 as B
import Data.Maybe (fromJust)

readB = fst . fromJust . B.readInt

main = putStrLn . unlines . solve . map (map readB . B.words) . tail . B.lines =<< B.getContents

solve xs = map calc xs

cubrt x = lp 1 x where
    lp i j | i >= j    = i
           | otherwise =
                let k = div (i + j) 2
                    v = k * k * k
                in case compare v x of
                    LT -> lp (k+1) j
                    EQ -> k
                    GT -> lp i k

calc (a:b:_) = if ans then "Yes" else "No"
    where
        c = gcd a b
        xa = div a c
        xb = div b c
        x = xa * xb
        zc = div c x
        ans = if mod c x /= 0 then False
              else zc == cubrt zc ^ 3

-- Codeforces My Practice
-- author: Leonardone @ NEETSDKASU

main = putStrLn . unlines . solve . map (map read . words) . tail . lines =<< getContents

solve xs = map calc xs

cubrt x = floor $ fromIntegral x ** (1 / 3)

calc (a:b:_) = if ans then "Yes" else "No"
    where
        c = gcd a b
        xa = div a c
        xb = div b c
        x = xa * xb
        zc = div c x
        cu = cubrt zc
        ans = if mod c x /= 0 then False
              else zc == cu ^ 3

-- Codeforces My Practice
-- author: Leonardone @ NEETSDKASU

import Control.Applicative
import Control.Monad
import qualified Data.ByteString.Char8 as B
import Data.Maybe (fromJust)

readB = fst . fromJust . B.readInt

main = do
    n <- readB <$> B.getLine
    replicateM_ n $ B.getLine >>= putStrLn . calc . map readB . B.words

solve xs = map calc xs

cubrt x = round $ fromIntegral x ** (1/3)

calc (a:b:_) = if ans then "Yes" else "No"
    where
        (da, ma) = divMod (a*a) b
        (db, mb) = divMod (b*b) a
        ans = ma == 0 && mb == 0 && da == cubrt da ^ 3 && db == cubrt db ^ 3

-- Codeforces My Practice
-- author: Leonardone @ NEETSDKASU

import qualified Data.ByteString.Char8 as B
import Data.Maybe

readB = fst . fromJust . B.readInt

main = putStrLn . unlines . solve . map (map readB . B.words) . tail . B.lines =<< B.getContents

solve xs = map calc xs

cubrt x = lp 1 x where
    lp i j | i >= j    = i
           | otherwise =
                let k = div (i + j) 2
                    v = k * k * k
                in case compare v x of
                    LT -> lp (k+1) j
                    EQ -> k
                    GT -> lp i k

calc (a:b:_) = if ans then "Yes" else "No"
    where
        c = gcd a b
        xa = div a c
        xb = div b c
        x = xa * xb
        zc = div c x
        cu = cubrt zc
        ans = if mod c x /= 0 then False
              else zc == cu ^ 3

-- Codeforces My Practice
-- author: Leonardone @ NEETSDKASU

import qualified Data.ByteString.Char8 as B
import Data.Maybe (fromJust)

readB = fst . fromJust . B.readInt

main = putStrLn . unlines . solve . map (map readB . B.words) . tail . B.lines =<< B.getContents

solve xs = map calc xs

cubrt x = round $ fromIntegral x ** (1/3)

calc (a:b:_) = if ans then "Yes" else "No"
    where
        (da, ma) = divMod (a*a) b
        ans = ma == 0 && da == cubrt da ^ 3

-- Codeforces My Practice
-- author: Leonardone @ NEETSDKASU

import Control.Applicative
import Control.Monad
import qualified Data.ByteString.Char8 as B
import Data.Maybe (fromJust)
import Data.Int

readB x = fromInteger . fst . fromJust . B.readInteger $ x :: Int64

main = putStrLn . unlines . solve . map (map readB . B.words) . tail . B.lines =<< B.getContents

solve xs = map calc xs

cubrt x = lp 1 x where
    lp i j | i >= j    = i
           | otherwise =
                let k = div (i + j) 2
                    v = k * k * k
                in case compare v x of
                    LT -> lp (k+1) j
                    EQ -> k
                    GT -> lp i k

calc (a:b:_) = if ans then "Yes" else "No"
    where
        c = gcd a b
        xa = div a c
        xb = div b c
        x = xa * xb
        zc = div c x
        cu = cubrt zc
        ans = if mod c x /= 0 then False
              else zc == cu ^ 3


Bash wants to become a Pokemon master one day. Although he liked a lot of Pokemon, he has always been fascinated by Bulbasaur the most. Soon, things started getting serious and his fascination turned into an obsession. Since he is too young to go out and catch Bulbasaur, he came up with his own way of catching a Bulbasaur.Each day, he takes the front page of the newspaper. He cuts out the letters one at a time, from anywhere on the front page of the newspaper to form the word "Bulbasaur" (without quotes) and sticks it on his wall. Bash is very particular about case — the first letter of "Bulbasaur" must be upper case and the rest must be lower case. By doing this he thinks he has caught one Bulbasaur. He then repeats this step on the left over part of the newspaper. He keeps doing this until it is not possible to form the word "Bulbasaur" from the newspaper.Given the text on the front page of the newspaper, can you tell how many Bulbasaurs he will catch today?Note: uppercase and lowercase letters are considered different.

Input contains a single line containing a string s (1  ≤  |s|  ≤  105) — the text on the front page of the newspaper without spaces and punctuation marks. |s| is the length of the string s. The string s contains lowercase and uppercase English letters, i.e. .

Output a single integer, the answer to the problem.

NoteIn the first case, you could pick: Bulbbasaur.In the second case, there is no way to pick even a single Bulbasaur.In the third case, you can rearrange the string to BulbasaurBulbasauraddrgndgddgargndbb to get two words "Bulbasaur".

-- Codecraft-17 and Codeforces Round #391 (Div. 1 + Div. 2, combined)
-- Problem A

import Data.List

main = do
    s <- getLine
    print $ minimum $ zipWith div (map (cnt s) "Bulbasr") [1,2,1,1,2,1,1]

cnt s ch = length $ filter (== ch) s

cnt xs val = length $ filter (== val) xs

bulb = "Bulbasaur"

solve s = minimum [ (cnt s t) `div` (cnt bulb t) | t <- bulb ]

main :: IO ()
main = do
    s <- getLine
    print $ solve s

import qualified Data.Map as Map
import Data.List
import Control.Monad

type Freq = Map.Map Char Int

target = "Bulbasaur"

freqOf :: Freq -> String -> Freq
freqOf = foldl' (flip $ Map.update (return . (+1)))

solve :: Freq -> Freq -> Int
solve f1 f2 = minimum $ Map.elems $ Map.intersectionWith (flip div) f1 f2

main = do
  s <- getLine
  let f = Map.fromList $ zip target (repeat 0)
  print $ solve (freqOf f target) (freqOf f s)

import qualified Data.Map as Map
import Data.List
import Control.Monad

type Freq = Map.Map Char Int

target = "Bulbasaur"

freqOf :: Freq -> String -> Freq
freqOf = foldr (Map.update (return . (+1)))

solve :: Freq -> Freq -> Int
solve f1 f2 = minimum $ Map.elems $ Map.intersectionWith (flip div) f1 f2

main = do
  s <- getLine
  let f = Map.fromList $ zip target (repeat 0)
  print $ solve (freqOf f target) (freqOf f s)

module Main where

import           Data.Map.Strict
import           Data.Maybe
import           Prelude         hiding (lookup)

countEls::Ord a=>[a]->Map a Int
countEls =  fromListWith (+) . (`zip` repeat 1)

quotEls::Ord a=>[a]->[a]->Int
quotEls word text = let wass = toList (countEls word)
                        tels = countEls text
                        quotCount (el, cnt) = fromMaybe 0 (lookup el tels) `quot` cnt
                        wcounts = fmap quotCount wass
                    in minimum wcounts

main :: IO ()
main = getLine >>= print . quotEls "Bulbasaur"

import qualified Data.Map as Map

update :: Char -> Map.Map Char Int -> Map.Map Char Int
update c m = case Map.lookup c m of
    Nothing -> Map.insert c 1 m
    Just v -> Map.insert c (v + 1) m

solve :: String -> Map.Map Char Int
solve [] = Map.empty
solve (x:xs) = update x rest
    where rest = solve xs

maybeToZero :: Maybe Int -> Int
maybeToZero Nothing = 0
maybeToZero (Just x) = x

solve' :: Char -> Map.Map Char Int -> Int
solve' 'B' m = maybeToZero $ Map.lookup 'B' m
solve' 'u' m = (maybeToZero $ Map.lookup 'u' m) `div` 2
solve' 'l' m = maybeToZero $ Map.lookup 'l' m
solve' 'b' m = maybeToZero $ Map.lookup 'b' m
solve' 'a' m = (maybeToZero $ Map.lookup 'a' m) `div` 2
solve' 's' m = maybeToZero $ Map.lookup 's' m
solve' 'r' m = maybeToZero $ Map.lookup 'r' m

main :: IO ()
main = do
    line <- getLine
    let freq = solve line
        smallest = foldr (\ c m -> min m $ solve' c freq) 1000000 "Bulbasr"
    putStrLn . show $ smallest

import Data.List( partition, group, sort)
main = do
    s_ <- getLine
    let
	p c = c `elem` "Bulbasaur"
	(bulbasaur,_) = partition p s_
	value = case map length . group $ sort bulbasaur of
	    [nB,na,nb,nl,nr,ns,nu]  ->
		    [(min na nu) `div` 2,nB,nb,nl,nr,ns]
	    _			    -> [0,0,0,0,0,0,0]
	--Baablrsuu
    print $ minimum value

-- Codecraft-17 and Codeforces Round #391 (Div. 1 + Div. 2, combined)
-- Problem A

main = do
	s <- getLine
	print $ catch s "Bulbassaur"

catch src poke = f src (cycle poke) 0 0 where
	end = length poke
	f _ [] _ acc = acc
	f [] _ _ acc = acc
	f (x:xs) (y:ys) pos acc
		| x == y	= f xs ys pos' acc'
		| otherwise	= f xs (y:ys) pos acc
		where
			pos' = if pos < end then (pos + 1) else 0
			acc' = if pos' < pos then (acc + 1) else acc

-- Codecraft-17 and Codeforces Round #391 (Div. 1 + Div. 2, combined)
-- Problem A

main = do
	s <- getLine
	print $ catch s "Bulbasaur"

catch src poke = f src (cycle poke) 0 0 where
	end = length poke
	f _ [] _ acc = acc
	f [] _ _ acc = acc
	f (x:xs) (y:ys) pos acc
		| x == y	= f xs ys pos' acc'
		| otherwise	= f xs (y:ys) pos acc
		where
			pos' = if pos < (end - 1) then (pos + 1) else 0
			acc' = if pos' < pos then (acc + 1) else acc

-- Codecraft-17 and Codeforces Round #391 (Div. 1 + Div. 2, combined)
-- Problem A

main = do
	s <- getLine
	print $ catch s "Bulbasaur"

catch src poke = f src (cycle poke) 0 0 where
	end = length poke
	f _ [] _ acc = acc
	f [] _ _ acc = acc
	f (x:xs) (y:ys) pos acc
		| x == y	= f xs ys pos' acc'
		| otherwise	= f xs (y:ys) pos acc
		where
			pos' = if pos < end then (pos + 1) else 0
			acc' = if pos' < pos then (acc + 1) else acc


You are given three integers $$$a$$$, $$$b$$$, $$$k$$$.Find two binary integers $$$x$$$ and $$$y$$$ ($$$x \ge y$$$) such that   both $$$x$$$ and $$$y$$$ consist of $$$a$$$ zeroes and $$$b$$$ ones;  $$$x - y$$$ (also written in binary form) has exactly $$$k$$$ ones.  You are not allowed to use leading zeros for $$$x$$$ and $$$y$$$.

The only line contains three integers $$$a$$$, $$$b$$$, and $$$k$$$ ($$$0 \leq a$$$; $$$1 \leq b$$$; $$$0 \leq k \leq a + b \leq 2 \cdot 10^5$$$) — the number of zeroes, ones, and the number of ones in the result.

If it's possible to find two suitable integers, print "Yes" followed by $$$x$$$ and $$$y$$$ in base-2. Otherwise print "No". If there are multiple possible answers, print any of them.

import qualified Data.ByteString.Lazy.Char8 as P
import qualified Data.ByteString.Builder as B
import System.IO

import Control.Monad
import Control.Monad.Trans.State
import Control.Monad.Trans.Class
import Data.List
import Data.Semigroup

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [a, b, k] <- readInts
  lift $ if  k == 0
    then  do
      putStrLn "Yes"
      replicateM_ 2 $ putStrLn $ replicate b '1' ++ replicate a '0'
    else  if  a == 0 || b == 1 || k > a + b - 2
    then  putStrLn "No"
    else  do
    putStrLn "Yes"
    let
      initZero = max 0 (a-k)
      midZero = a - 1 - initZero
      lateShift = max 0 (k-a)
      x = take (a+b) $ '1' : replicate initZero '0'
        ++ '1' : replicate midZero '0'
        ++ replicate lateShift '1' ++ '0' : repeat '1'
      y = '1' : replicate a '0' ++ replicate (b-1) '1'
    putStrLn x
    putStrLn y

type SIO = StateT P.ByteString IO

readLine :: SIO P.ByteString
readLine = do
  (out, next) <- P.break (<= '\r') <$> get
  put $ P.dropWhile (<= '\r') next
  pure out

readInts :: SIO [Int]
readInts = do
  currLine <- readLine
  pure [x | Just (x, _) <- P.readInt <$> P.words currLine]

putInts :: [Int] -> SIO ()
putInts li = let
  outBuilder = foldr (<>) (B.char7 '\n')
    $ intersperse (B.char7 ' ') (map B.intDec li)
  in  lift $ B.hPutBuilder stdout outBuilder


ZS the Coder and Chris the Baboon has arrived at Udayland! They walked in the park where n trees grow. They decided to be naughty and color the trees in the park. The trees are numbered with integers from 1 to n from left to right.Initially, tree i has color ci. ZS the Coder and Chris the Baboon recognizes only m different colors, so 0 ≤ ci ≤ m, where ci = 0 means that tree i is uncolored.ZS the Coder and Chris the Baboon decides to color only the uncolored trees, i.e. the trees with ci = 0. They can color each of them them in any of the m colors from 1 to m. Coloring the i-th tree with color j requires exactly pi, j litres of paint.The two friends define the beauty of a coloring of the trees as the minimum number of contiguous groups (each group contains some subsegment of trees) you can split all the n trees into so that each group contains trees of the same color. For example, if the colors of the trees from left to right are 2, 1, 1, 1, 3, 2, 2, 3, 1, 3, the beauty of the coloring is 7, since we can partition the trees into 7 contiguous groups of the same color : {2}, {1, 1, 1}, {3}, {2, 2}, {3}, {1}, {3}. ZS the Coder and Chris the Baboon wants to color all uncolored trees so that the beauty of the coloring is exactly k. They need your help to determine the minimum amount of paint (in litres) needed to finish the job.Please note that the friends can't color the trees that are already colored.

The first line contains three integers, n, m and k (1 ≤ k ≤ n ≤ 100, 1 ≤ m ≤ 100) — the number of trees, number of colors and beauty of the resulting coloring respectively. The second line contains n integers c1, c2, ..., cn (0 ≤ ci ≤ m), the initial colors of the trees. ci equals to 0 if the tree number i is uncolored, otherwise the i-th tree has color ci. Then n lines follow. Each of them contains m integers. The j-th number on the i-th of them line denotes pi, j (1 ≤ pi, j ≤ 109) — the amount of litres the friends need to color i-th tree with color j. pi, j's are specified even for the initially colored trees, but such trees still can't be colored.

Print a single integer, the minimum amount of paint needed to color the trees. If there are no valid tree colorings of beauty k, print  - 1.

NoteIn the first sample case, coloring the trees with colors 2, 1, 1 minimizes the amount of paint used, which equals to 2 + 3 + 5 = 10. Note that 1, 1, 1 would not be valid because the beauty of such coloring equals to 1 ({1, 1, 1} is a way to group the trees into a single group of the same color).In the second sample case, all the trees are colored, but the beauty of the coloring is 3, so there is no valid coloring, and the answer is  - 1.In the last sample case, all the trees are colored and the beauty of the coloring matches k, so no paint is used and the answer is 0.

{-# OPTIONS_GHC -O #-}
import qualified Data.ByteString.Char8 as B
import Data.Array
import Control.Monad
import Data.Set (fromList , minView)
import Control.Applicative

readIntList = fmap ((map fn) . B.words) B.getLine :: IO [I]
    where fn x = let (Just (y,_)) = B.readInteger x in fromIntegral y

inf = round 1e18 :: (Integral a => a)

type I = Integer

replicateM' n = replicateM (fromInteger n)
take' n = take (fromIntegral n)
replicate' n = replicate (fromInteger n)

main = do
    [n,m,k] <- readIntList
    a <- readIntList
    b <- replicateM' n readIntList
    let ans = case head a of
                0 -> nloop m k (tail a) (tail b) [head b]
                x -> nloop m k (tail a) (tail b) [map (\i -> if i==x then 0 else inf) [1..m]]
    if ans >= inf
        then print (-1)
        else print ans

nloop :: I -> I -> [I] -> [[I]] -> [[I]] -> I
nloop _ _ [] [] ans = minimum . last $ ans
nloop m k (a:as) (b:bs) pre
 |a /= 0 =
    let new1 = map (\ls -> map (\(e,i) -> if i==a then e else inf) $ zip ls [1..m]) pre ++ [replicate' m inf]
        new2 = head new1: zipWith (fn [1..m]) pre (tail new1)
        fn [] _ [] = []
        fn  (i:is) (x:xs) (y:ys)
         |i==a = min y (minimum . (inf:) . snd . unzip . filter (\(i,e) -> i/=a) $ (zip [1..m] (x:xs))): fn is (x:xs) ys
         |otherwise = min y inf: fn is (x:xs) ys
    in nloop m k as bs (take' k new2)
 |otherwise =
    let new1 = map (zipWith (+) b) pre ++ [replicate' m inf]
        new2 = head new1: zipWith (fn b) pre (tail new1)
        fn [] [] [] = []
        fn (b:bs) (x:xs) (y:ys) =
            let Just (mn,next) = minView $ fromList $ zip (x:xs) [1..m]
                go [] [] [] = []
                go (b:bs) (y:ys) (i:is) = case (i == snd mn) of
                                        False -> min y (fst mn + b): go bs ys is
                                        True -> case minView next of
                                                    Just (mn2,_) -> min y (fst mn2 + b): go bs ys is
                                                    Nothing -> y: go bs ys is
            in go (b:bs) (y:ys) [1..m]
    in nloop m k as bs (take' k new2)

{-
3 2 3
0 0 0
10 30000
20000 1000000000
1000000000 50000

3 2 3
2 1 2
1 3
2 4
3 5
-}

{-# OPTIONS_GHC -O #-}
import qualified Data.ByteString.Char8 as B
import Data.Array
import Control.Monad
import Data.Set (fromList , minView)
import Control.Applicative

readIntList = fmap ((map fn) . B.words) B.getLine
    where fn x = let (Just (y,_)) = B.readInteger x in fromIntegral y

inf = round 1e18

main = do
    [n,m,k] <- readIntList
    a <- readIntList
    b <- replicateM n readIntList
    let ans = case head a of
                0 -> nloop m k (tail a) (tail b) [head b]
                x -> nloop m k (tail a) (tail b) [map (\i -> if i==x then 0 else inf) [1..m]]
    if ans == inf
        then print (-1)
        else print ans

nloop _ _ [] [] ans = minimum . last $ ans
nloop m k (a:as) (b:bs) pre
 |a /= 0 =
    let new1 = map (\ls -> map (\(e,i) -> if i==a then e else inf) $ zip ls [1..m]) pre ++ [replicate m inf]
        new2 = head new1: zipWith (fn [1..m]) pre (tail new1)
        fn [] _ [] = []
        fn  (i:is) (x:xs) (y:ys)
         |i==a = min y (minimum . (inf:) . snd . unzip . filter (\(i,e) -> i/=a) $ (zip [1..m] (x:xs))): fn is (x:xs) ys
         |otherwise = min y inf: fn is (x:xs) ys
    in nloop m k as bs (take k new2)
 |otherwise =
    let new1 = map (zipWith (+) b) pre ++ [replicate m inf]
        new2 = head new1: zipWith (fn b) pre (tail new1)
        fn [] [] [] = []
        fn (b:bs) (x:xs) (y:ys) =
            let Just (mn,next) = minView $ fromList (x:xs)
            in case (x==mn) of
                False -> min y (mn+b): fn bs xs ys
                True -> case minView next of
                            Just (mn2,_) -> min y (mn2+b): fn bs xs ys
                            Nothing -> y: fn bs xs ys
    in nloop m k as bs (take k new2)

{-
3 2 3
2 1 2
1 3
2 4
3 5
-}

{-# OPTIONS_GHC -O #-}
import qualified Data.ByteString.Char8 as B
import Data.Array
import Control.Monad
import Data.Set (fromList , minView)
import Control.Applicative

readIntList = fmap ((map fn) . B.words) B.getLine :: IO [I]
    where fn x = let (Just (y,_)) = B.readInteger x in fromIntegral y

inf = round 1e18 :: (Integral a => a)

type I = Integer

replicateM' n = replicateM (fromInteger n)
take' n = take (fromIntegral n)
replicate' n = replicate (fromInteger n)

main = do
    [n,m,k] <- readIntList
    a <- readIntList
    b <- replicateM' n readIntList
    let ans = case head a of
                0 -> nloop m k (tail a) (tail b) [head b]
                x -> nloop m k (tail a) (tail b) [map (\i -> if i==x then 0 else inf) [1..m]]
    if ans == inf
        then print (-1)
        else print ans

nloop :: I -> I -> [I] -> [[I]] -> [[I]] -> I
nloop _ _ [] [] ans = minimum . last $ ans
nloop m k (a:as) (b:bs) pre
 |a /= 0 =
    let new1 = map (\ls -> map (\(e,i) -> if i==a then e else inf) $ zip ls [1..m]) pre ++ [replicate' m inf]
        new2 = head new1: zipWith (fn [1..m]) pre (tail new1)
        fn [] _ [] = []
        fn  (i:is) (x:xs) (y:ys)
         |i==a = min y (minimum . (inf:) . snd . unzip . filter (\(i,e) -> i/=a) $ (zip [1..m] (x:xs))): fn is (x:xs) ys
         |otherwise = min y inf: fn is (x:xs) ys
    in nloop m k as bs (take' k new2)
 |otherwise =
    let new1 = map (zipWith (+) b) pre ++ [replicate' m inf]
        new2 = head new1: zipWith (fn b) pre (tail new1)
        fn [] [] [] = []
        fn (b:bs) (x:xs) (y:ys) =
            let Just (mn,next) = minView $ fromList $ zip (x:xs) [1..m]
                go [] [] [] = []
                go (b:bs) (y:ys) (i:is) = case (i == snd mn) of
                                        False -> min y (fst mn + b): go bs ys is
                                        True -> case minView next of
                                                    Just (mn2,_) -> min y (fst mn2 + b): go bs ys is
                                                    Nothing -> y: go bs ys is
            in go (b:bs) (y:ys) [1..m]
    in nloop m k as bs (take' k new2)

{-
3 2 3
0 0 0
10 30000
20000 1000000000
1000000000 50000

3 2 3
2 1 2
1 3
2 4
3 5
-}

{-# OPTIONS_GHC -O #-}
import qualified Data.ByteString.Char8 as B
import Data.Array
import Control.Monad
import Data.Set (fromList , minView)
import Control.Applicative

readIntList = fmap ((map fn) . B.words) B.getLine :: IO [I]
    where fn x = let (Just (y,_)) = B.readInteger x in fromIntegral y

inf = round 1e18 :: (Integral a => a)

type I = Integer

replicateM' n = replicateM (fromInteger n)
take' n = take (fromIntegral n)
replicate' n = replicate (fromInteger n)

main = do
    [n,m,k] <- readIntList
    a <- readIntList
    b <- replicateM' n readIntList
    let ans = case head a of
                0 -> nloop m k (tail a) (tail b) [head b]
                x -> nloop m k (tail a) (tail b) [map (\i -> if i==x then 0 else inf) [1..m]]
    if ans == inf
        then print (-1)
        else print ans

nloop :: I -> I -> [I] -> [[I]] -> [[I]] -> I
nloop _ _ [] [] ans = minimum . last $ ans
nloop m k (a:as) (b:bs) pre
 |a /= 0 =
    let new1 = map (\ls -> map (\(e,i) -> if i==a then e else inf) $ zip ls [1..m]) pre ++ [replicate' m inf]
        new2 = head new1: zipWith (fn [1..m]) pre (tail new1)
        fn [] _ [] = []
        fn  (i:is) (x:xs) (y:ys)
         |i==a = min y (minimum . (inf:) . snd . unzip . filter (\(i,e) -> i/=a) $ (zip [1..m] (x:xs))): fn is (x:xs) ys
         |otherwise = min y inf: fn is (x:xs) ys
    in nloop m k as bs (take' k new2)
 |otherwise =
    let new1 = map (zipWith (+) b) pre ++ [replicate' m inf]
        new2 = head new1: zipWith (fn b) pre (tail new1)
        fn [] [] [] = []
        fn (b:bs) (x:xs) (y:ys) =
            let Just (mn,next) = minView $ fromList (x:xs)
            in case (x==mn) of
                False -> min y (mn+b): fn bs xs ys
                True -> case minView next of
                            Just (mn2,_) -> min y (mn2+b): fn bs xs ys
                            Nothing -> y: fn bs xs ys
    in nloop m k as bs (take' k new2)

{-
3 2 3
2 1 2
1 3
2 4
3 5
-}


You are given a correct solution of the sudoku puzzle. If you don't know what is the sudoku, you can read about it here.The picture showing the correct sudoku solution:Blocks are bordered with bold black color.Your task is to change at most $$$9$$$ elements of this field (i.e. choose some $$$1 \le i, j \le 9$$$ and change the number at the position $$$(i, j)$$$ to any other number in range $$$[1; 9]$$$) to make it anti-sudoku. The anti-sudoku is the $$$9 \times 9$$$ field, in which:  Any number in this field is in range $$$[1; 9]$$$;  each row contains at least two equal elements;  each column contains at least two equal elements;  each $$$3 \times 3$$$ block (you can read what is the block in the link above) contains at least two equal elements. It is guaranteed that the answer exists.You have to answer $$$t$$$ independent test cases.

The first line of the input contains one integer $$$t$$$ ($$$1 \le t \le 10^4$$$) — the number of test cases. Then $$$t$$$ test cases follow. Each test case consists of $$$9$$$ lines, each line consists of $$$9$$$ characters from $$$1$$$ to $$$9$$$ without any whitespaces — the correct solution of the sudoku puzzle.

For each test case, print the answer — the initial field with at most $$$9$$$ changed elements so that the obtained field is anti-sudoku. If there are several solutions, you can print any. It is guaranteed that the answer exists.

import Control.Monad

mutations :: [(Int,Int)]
mutations = [(0,0),(1,3),(2,6),(3,1),(4,4),(5,7),(6,2),(7,5),(8,8)]

solve :: [String] -> [String]
solve grid = [[cell i j | j <- [0..8]] | i <- [0..8]]
  where
    cell i j = let old = grid !! i !! j
               in if (i,j) `elem` mutations then inc old else old
    inc x = if x == '9' then '1' else succ x

main :: IO ()
main = do
  tc <- readLn
  replicateM_ tc $ do
    grid <- replicateM 9 getLine
    mapM_ putStrLn $ solve grid

import Control.Monad (forM_, mapM_, sequence)
import Data.Char (ord, chr)

solve :: [String] -> [String]
solve rows = nrows where
	rows' = map (\row -> map (\c -> ord c - ord '1') row) rows
	nrows' = [ [ if (i,j) `elem` positions then (c+1) `mod` 9 else c | (j,c) <- zip [0..8] row] | (i, row) <- zip [0..8] rows']
	nrows = map (\row -> map (\c -> chr (c + ord '1')) row) nrows'
	positions = [(0,0),(3,1),(6,2),(1,3),(4,4),(7,5),(2,6),(5,7),(8,8)]

main = do
	t <- fmap read getLine
	forM_ [1..t] $ \i -> do
		rows <- sequence (replicate 9 getLine) :: IO [String]
		mapM_ putStrLn (solve rows)

s = "154873296\n386592714\n729641835\n863725149\n975314628\n412968357\n631457982\n598236471\n247189563"

switch :: Char -> Char
switch '1' = '2'
switch _   = '1'

switchNth :: Int -> String -> String
switchNth 0 (s:ss) = switch s : ss
switchNth n (s:ss) = s : switchNth (n-1) ss

testCases :: Integer -> IO ()
testCases 0 = return ()
testCases t = do
    s0 <- getLine
    putStrLn $ switchNth 0 s0
    s1 <- getLine
    putStrLn $ switchNth 4 s1
    s2 <- getLine
    putStrLn $ switchNth 8 s2
    s3 <- getLine
    putStrLn $ switchNth 1 s3
    s4 <- getLine
    putStrLn $ switchNth 5 s4
    s5 <- getLine
    putStrLn $ switchNth 6 s5
    s6 <- getLine
    putStrLn $ switchNth 2 s6
    s7 <- getLine
    putStrLn $ switchNth 3 s7
    s8 <- getLine
    putStrLn $ switchNth 7 s8
    testCases (t-1)

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

readInts :: IO [Integer]
readInts = map read . words <$> getLine

import Data.List

type Sudoku = [[Int]]

main :: IO ()
main = do
    getLine
    sudokus <- map (modifySudoku coords) <$> mkSudoku <$> lines <$> getContents
    let sudokuStrings = concat $ map (map (concat.map show)) sudokus
    mapM_ putStrLn sudokuStrings

mkSudoku :: [String] -> [Sudoku]
mkSudoku [] = []
mkSudoku str = let (pre,suf) = splitAt 9 str
                   sudoku = map (map read . words . intersperse ' ') $  pre
                in sudoku : mkSudoku suf

modifySudoku :: [(Int, Int)] -> Sudoku -> Sudoku
modifySudoku [] su = su
modifySudoku ((y,x):co) su = modifySudoku co su'
    where (pre,rest) = splitAt y su
          (row, suf) = splitAt 1 rest
          (prerow, restrow) = splitAt x $ head row
          (cell, sufrow) = splitAt 1 restrow
          cell' = head cell `mod` 9 + 1
          su' = pre ++ [prerow ++ [cell'] ++ sufrow] ++ suf

coords :: [(Int, Int)]
coords = [
    (0,0),
    (1,3),
    (2,6),
    (3,1),
    (4,4),
    (5,7),
    (6,2),
    (7,5),
    (8,8) ]

import Control.Monad

mutations :: [(Int,Int)]
mutations = [(0,0),(1,3),(2,6),(3,1),(4,4),(5,7),(6,2),(7,5),(9,9)]

solve :: [String] -> [String]
solve grid = [[cell i j | j <- [0..8]] | i <- [0..8]]
  where
    cell i j = let old = grid !! i !! j
               in if (i,j) `elem` mutations then inc old else old
    inc x = if x == '9' then '1' else succ x

main :: IO ()
main = do
  tc <- readLn
  replicateM_ tc $ do
    grid <- replicateM 9 getLine
    mapM_ putStrLn $ solve grid

import Data.List

type Sudoku = [[Int]]

main :: IO ()
main = do
    getLine
    sudokus <- map (modifySudoku coords) <$> mkSudoku <$> lines <$> getContents
    mapM_ print sudokus

mkSudoku :: [String] -> [Sudoku]
mkSudoku [] = []
mkSudoku str = let (pre,suf) = splitAt 9 str
                   sudoku = map (map read . words . intersperse ' ') $  pre
                in sudoku : mkSudoku suf

modifySudoku :: [(Int, Int)] -> Sudoku -> Sudoku
modifySudoku [] su = su
modifySudoku ((y,x):co) su = modifySudoku co su'
    where (pre,rest) = splitAt y su
          (row, suf) = splitAt 1 rest
          (prerow, restrow) = splitAt x $ head row
          (cell, sufrow) = splitAt 1 restrow
          cell' = head cell `mod` 9 + 1
          su' = pre ++ [prerow ++ [cell'] ++ sufrow] ++ suf

coords :: [(Int, Int)]
coords = [
    (0,0),
    (1,3),
    (2,6),
    (3,1),
    (4,4),
    (5,7),
    (6,2),
    (7,5),
    (8,8) ]