Problem:
Score : 400 points

Problem Statement

Takahashi will play a game using a piece on an array of squares numbered 1, 2, \cdots, N. Square i has an integer C_i written on it. Also, he is given a permutation of 1, 2, \cdots, N: P_1, P_2, \cdots, P_N.

Now, he will choose one square and place the piece on that square. Then, he will make the following move some number of times between 1 and K (inclusive):

In one move, if the piece is now on Square i (1 \leq i \leq N), move it to Square P_i. Here, his score increases by C_{P_i}.

Help him by finding the maximum possible score at the end of the game. (The score is 0 at the beginning of the game.)

Constraints

2 \leq N \leq 5000

1 \leq K \leq 10^9

1 \leq P_i \leq N

P_i \neq i

P_1, P_2, \cdots, P_N are all different.

-10^9 \leq C_i \leq 10^9

All values in input are integers.

Input

Input is given from Standard Input in the following format:

N K
P_1 P_2 \cdots P_N
C_1 C_2 \cdots C_N

Output

Print the maximum possible score at the end of the game.

Sample Input 1

5 2
2 4 5 1 3
3 4 -10 -8 8

Sample Output 1

8

When we start at some square of our choice and make at most two moves, we have the following options:

If we start at Square 1, making one move sends the piece to Square 2, after which the score is 4. Making another move sends the piece to Square 4, after which the score is 4 + (-8) = -4.

If we start at Square 2, making one move sends the piece to Square 4, after which the score is -8. Making another move sends the piece to Square 1, after which the score is -8 + 3 = -5.

If we start at Square 3, making one move sends the piece to Square 5, after which the score is 8. Making another move sends the piece to Square 3, after which the score is 8 + (-10) = -2.

If we start at Square 4, making one move sends the piece to Square 1, after which the score is 3. Making another move sends the piece to Square 2, after which the score is 3 + 4 = 7.

If we start at Square 5, making one move sends the piece to Square 3, after which the score is -10. Making another move sends the piece to Square 5, after which the score is -10 + 8 = -2.

The maximum score achieved is 8.

Sample Input 2

2 3
2 1
10 -7

Sample Output 2

13

Sample Input 3

3 3
3 1 2
-1000 -2000 -3000

Sample Output 3

-1000

We have to make at least one move.

Sample Input 4

10 58
9 1 6 7 8 4 3 2 10 5
695279662 988782657 -119067776 382975538 -151885171 -177220596 -169777795 37619092 389386780 980092719

Sample Output 4

29507023469

The absolute value of the answer may be enormous.

Solution in Haskell (GHC 8.8.3) (judge verdict: Time Limit Exceeded)

{-# LANGUAGE MultiWayIf #-}

module Main where

import Control.Monad
import qualified Data.Array as A
import qualified Data.Array.IO as AIO
import qualified Data.Array.Unboxed as AU
--import qualified Data.Heap                     as H

import Data.Bits
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BSC8
import Data.Char
import qualified Data.Graph.Inductive.Graph as G
import qualified Data.Graph.Inductive.PatriciaTree as G
import Data.Int
import Data.List
import qualified Data.Map.Strict as M
import Data.Maybe
import Data.Monoid
import Data.Ord
import qualified Data.Sequence as SQ
import qualified Data.Set as S
import qualified Data.Vector as V
import Data.Vector.Algorithms.Search
import qualified Data.Vector.Mutable as VM
import qualified Data.Vector.Unboxed as VU
import qualified Data.Vector.Unboxed.Mutable as VUM
import Debug.Trace
import Prelude

main =
  do
    --aN       <- getI
    --[aA, aB] <- getIL
    --aS       <- getLine
    [aN, aK] <- getIL
    aP <- getVUI
    aC <- getVUI

    let answer =
          maximum $
            map
              ( \x ->
                  let (l, sumC) = scanLoop aP aC x 0 0 S.empty
                      re = div aK l + if mod aK l == 0 then -1 else 0
                   in scan aP aC (aK - l * re) x + if sumC > 0 then (re * sumC) else 0
              )
              [1 .. VU.length aP]
    print answer
    return ()

scanLoop pl cl x l p s =
  if S.member x s
    then (l, p)
    else
      let ns = pl VU.! (x -1)
          np = (p + cl VU.! (ns -1))
       in scanLoop pl cl ns (l + 1) np (S.insert x s)

scan pl cl num x =
  let answer = maximum $ map (\y -> sumP pl cl y x 0) [1 .. num]
   in answer

sumP pl cl num s p
  | num == 0 = p
  | otherwise =
    let ns = pl VU.! (s -1)
     in sumP pl cl (num -1) ns (p + cl VU.! (ns -1))

{-
hMaxPoint :: Int
hMaxPoint = 101
hMaximum :: H.Heap Int -> Int
hMaximum h = hMaxPoint - (H.minimum h)
hInsertMax :: Int -> H.Heap Int -> H.Heap Int
hInsertMax x = H.insert (hMaxPoint - x)
hDeleteMax :: H.Heap Int -> H.Heap Int
hDeleteMax = H.deleteMin
-}

{-
aroundSquare y x h w =
  [ aYX
  | aYX@(aY, aX) <- [(y - 1, x), (y, x - 1), (y + 1, x), (y, x + 1), (y, x)]
  , aY >= 0
  , aY <= (h - 1)
  , aX >= 0
  , aX <= (w - 1)
  ]
-}

splitReadBSC8 :: BSC8.ByteString -> [Int]
splitReadBSC8 bs =
  let (bs1, newBs) = BSC8.splitAt 1 bs
   in if newBs == BSC8.empty
        then [test $ BSC8.readInt bs1]
        else (test $ BSC8.readInt bs1) : (splitReadBSC8 newBs)
  where
    test (Just (i, _)) = i

read2DimChar :: VM.IOVector (VUM.IOVector Char) -> Int -> Int -> IO Char
read2DimChar vec y x = do
  vecY <- VM.read vec y
  VUM.read vecY x

write2DimChar :: VM.IOVector (VUM.IOVector Char) -> Int -> Int -> Char -> IO ()
write2DimChar vec y x t = do
  vecY <- VM.read vec y
  VUM.write vecY x t

readTwoDimVec :: VM.IOVector (VUM.IOVector Int) -> Int -> Int -> IO Int
readTwoDimVec vec y x = do
  vecY <- VM.read vec y
  VUM.read vecY x

writeTwoDimVec :: VM.IOVector (VUM.IOVector Int) -> Int -> Int -> Int -> IO ()
writeTwoDimVec vec y x t = do
  vecY <- VM.read vec y
  VUM.write vecY x t

getVUI :: IO (VU.Vector Int)
getVUI = VU.unfoldr (BSC8.readInt . BSC8.dropWhile isSpace) <$> BSC8.getLine

getRepVUI :: Int -> IO (VU.Vector Int)
getRepVUI n =
  VU.unfoldr (BSC8.readInt . BSC8.dropWhile isSpace)
    . BSC8.unlines
    <$> replicateM n BSC8.getLine

getVS :: IO (V.Vector Char)
getVS = V.fromList <$> getLine

getVUC :: IO (VU.Vector Char)
getVUC = VU.fromList <$> getLine

readI :: BSC8.ByteString -> Int
readI = fst . fromJust . BSC8.readInt

readIL :: BSC8.ByteString -> [Int]
readIL = map readI . BSC8.words

readIT2 :: BSC8.ByteString -> (Int, Int)
readIT2 bs =
  let words = BSC8.words bs in (readI $ head words, readI $ last words)

getI :: IO Int
getI = readI <$> BSC8.getLine

getIL :: IO [Int]
getIL = readIL <$> BSC8.getLine

getIT2 :: IO (Int, Int)
getIT2 = readIT2 <$> BSC8.getLine

getIT2Order :: IO (Int, Int)
getIT2Order =
  getIL
    >>= \x@[xz, xo] -> if xz > xo then return (xo, xz) else return (xz, xo)

getNIS :: Int -> IO [(Int, BSC8.ByteString)]
getNIS 0 = return []
getNIS n = do
  [aFst, aSnd] <- BSC8.words <$> BSC8.getLine
  next <- getNIS (n - 1)
  return ((readI aFst, aSnd) : next)

il2Words :: [Int] -> String
il2Words = unwords . map show

il2Lines :: [Int] -> String
il2Lines = unlines . map show

p :: Int -> Int
p x = x - 1

--modNum = 10 ^ 9 + 7
--modulus = 1000000007
modulus = 2019

newtype MInt = M Int

instance Num MInt where
  (M a) + (M b) = M $ mod (a + b) modulus

  (M a) - (M b) = M $ mod (a - b) modulus

  (M a) * (M b) = M $ mod (a * b) modulus

  fromInteger a = M $ mod (fromInteger a) modulus

  abs (M a) = M $ abs a

  signum (M a) = M $ signum a

instance Show MInt where
  show (M a) = show (mod a modulus)

int2MInt :: Int -> MInt
int2MInt a = M (mod a modulus)

mInt2Int :: MInt -> Int
mInt2Int (M a) = a

{-
factsMod :: V.Vector MInt
factsMod = V.scanl (\acc x -> M x * acc) 1 $ V.generate 2000000 (+ 1)

factMod :: Int -> MInt
factMod = (factsMod V.!)
-}

factMod :: Int -> MInt
factMod n
  | n == 0 = 1
  | n == 1 = 1
  | otherwise = M n * (factMod (n - 1))

factDivMod :: Int -> Int -> MInt
factDivMod n k
  | n == k = M 1
  | otherwise = M n * (factDivMod (n - 1) k)

powMod :: MInt -> MInt -> MInt
powMod n mK@(M k)
  | k == 0 = M 1
  | k == 1 = n
  | mod k 2 == 0 = powMod (n ^ 2) (M (div k 2))
  | otherwise = n * powMod (n ^ 2) (M (div k 2))

invMod :: MInt -> MInt
invMod (M 0) = error "inverse of 0"
invMod x = powMod x (M (modulus - 2))

{-
combiMod :: Int -> Int -> MInt
combiMod n k
  | n < 0 || k < 0 || k > n = 0
  | otherwise = factMod n * invMod (factMod (n - k)) * invMod (factMod k)
-}
combiMod :: Int -> Int -> MInt
combiMod n k
  | n < 0 || k < 0 || k > n = 0
  | k > n - k = factDivMod n k * invMod (factMod (n - k))
  | otherwise = factDivMod n (n - k) * invMod (factMod k)

combi :: Int -> Int -> Int
combi n k
  | n < 0 || k < 0 || k > n = 0
  | k == n = 1
  | otherwise = div (div (fact n) (fact (n - k))) (fact k)

{-w
primes :: Integral a => [a]
primes = map fromIntegral $ [2, 3] ++ primes'
 where
  primes' = [5] ++ f 1 7 primes'
  f m s (p : ps) = [ n | n <- ns, gcd m n == 1 ] ++ f (m * p) (p * p) ps
    where ns = [ x + y | x <- [s, s + 6 .. p * p - 2], y <- [0, 4] ]

prime n = primes !! n
primes = sieve [2 ..]
sieve (p : xs) = p : sieve [ x | x <- xs, x `mod` p /= 0 ]
-}
fact :: Int -> Int
fact 0 = 1
fact n | n > 0 = n * fact (n - 1)

knappsackWDP :: Int -> [(Int, Int)] -> VU.Vector Int
knappsackWDP maxW [] = VU.replicate (maxW + 1) 0
knappsackWDP maxW ((w, v) : xs) =
  let tailDP = knappsackWDP maxW xs
   in VU.generate (maxW + 1) $ \i ->
        if w <= i
          then max (tailDP VU.! i) (tailDP VU.! (i - w) + v)
          else tailDP VU.! i

knappsackVDP :: Int -> Int -> Int -> [(Int, Int)] -> VU.Vector Int
knappsackVDP maxW maxV n [] = VU.cons 0 $ VU.replicate (n * maxV) maxW
knappsackVDP maxW maxV n ((w, v) : xs) =
  let tailDP = knappsackVDP maxW maxV n xs
   in VU.generate (n * maxV + 1) $ \i ->
        if v <= i
          then min (tailDP VU.! i) (tailDP VU.! (i - v) + w)
          else tailDP VU.! i

knappsackMinVol ::
  AIO.IOArray (Int, Int) Int ->
  VU.Vector Int ->
  VU.Vector Int ->
  Int ->
  Int ->
  IO Int
knappsackMinVol dp volumeVec valueVec dpSize maxVolume = do
  mapM_
    ( \i ->
        mapM_
          ( \v -> do
              let volume = volumeVec VU.! i
                  value = valueVec VU.! i
              newdp <-
                if (v + value) > dpSize
                  then AIO.readArray dp (i, v)
                  else do
                    dpIVm <- AIO.readArray dp (i, v + value)
                    dpIV <- AIO.readArray dp (i, v)
                    return (min (dpIVm - volume) dpIV)
              AIO.writeArray dp (i + 1, v) newdp
          )
          (reverse [0 .. dpSize])
    )
    [0 .. VU.length valueVec - 1]
  foldM
    ( \acc x -> do
        num <- AIO.readArray dp (VU.length volumeVec, x)
        return $ if num <= maxVolume then x else acc
    )
    0
    [0 .. dpSize]

lcsTable :: BS.ByteString -> BS.ByteString -> V.Vector (VU.Vector Int)
lcsTable xs ys = V.scanl step (VU.replicate (m + 1) 0) xs'
  where
    n = BS.length xs
    m = BS.length ys
    xs' = V.generate n $ BSC8.index xs :: V.Vector Char
    ys' = VU.generate m $ BSC8.index ys :: VU.Vector Char
    step :: VU.Vector Int -> Char -> VU.Vector Int
    step v x = VU.scanl innerStep 0 (VU.zip3 v (VU.tail v) ys')
      where
        innerStep :: Int -> (Int, Int, Char) -> Int
        innerStep a (b, c, y)
          | x == y = 1 + b
          | otherwise = max a c

{-
main = do
xs <- BS.getLine
ys <- BS.getLine
print $ VU.last $ V.last $ lcsTable xs ys
-}

myFilter :: (a -> Bool) -> [a] -> ([a], [a])
myFilter _pred [] = ([], [])
myFilter pred (x : xs)
  | pred x = let (l, r) = myFilter pred xs in (x : l, r)
  | otherwise = let (l, r) = myFilter pred xs in (l, x : r)

--UnionFindデータ構造

type UF_PARENT = VUM.IOVector Int

type UF_RANK = VUM.IOVector Int

type UF = (UF_PARENT, UF_RANK)

uf_makeSet :: Int -> IO UF
uf_makeSet n = do
  parent <- VU.thaw $ VU.generate n id
  rank <- VUM.replicate n 0
  return (parent, rank)

uf_union :: UF -> Int -> Int -> IO ()
uf_union unionFind@(parents, ranks) x y = do
  xRoot <- uf_find unionFind x
  yRoot <- uf_find unionFind y

  xRootRank <- VUM.read ranks xRoot
  yRootRank <- VUM.read ranks yRoot
  if
      | xRootRank > yRootRank -> VUM.write parents yRoot xRoot
      | xRootRank < yRootRank -> VUM.write parents xRoot yRoot
      | xRoot /= yRoot -> do
        VUM.write parents yRoot xRoot
        VUM.write ranks xRoot (xRootRank + 1)
      | otherwise -> return ()

uf_find :: UF -> Int -> IO Int
uf_find unionFind@(parents, ranks) x = do
  xParent <- VUM.read parents x
  if xParent == x
    then return x
    else do
      xRootParent <- uf_find unionFind xParent
      VUM.write parents x xRootParent
      return xRootParent

--UnDirectedGraph(無向グラフ)データ構造

type UDG = M.Map Int [Int]

list2UDG :: [(Int, Int)] -> M.Map Int [Int]
list2UDG =
  foldl
    ( \acc x ->
        let lr = M.insertWith (++) (fst x) [snd x] acc
         in M.insertWith (++) (snd x) [fst x] lr
    )
    M.empty