{-# 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 -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, 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 -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, 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


-- 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

{-# 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 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


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

-- 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

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


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

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 (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"

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) ]