import Control.Monad (replicateM,foldM)
import Control.Monad.ST (ST,runST)
import Data.List (sortBy)
import Data.Array (Array,array,listArray,(!),assocs)
import qualified Data.Array.ST as STArr

main = do
    [n,m,h,k] <- getLine >>= return . map read . words
    if all (==0) [n,m,h,k] then return 0 else do
        ps <- replicateM n readLn >>= return . listArray (1,n)
        ls <- replicateM m (getLine >>= return . line)
        print $ solve n ps ls k
        main
    where
    line = (\[a,b] -> (a,b)) . map read . words

solve :: Int -> Array Int Int -> [(Int,Int)] -> Int -> Int
solve n ps ls k =
    goals `seq` swaps `seq`
    (sum $ map pointOf [1..k]) + (minimum (0:(map (uncurry diff) swaps)))
    where
    ls' = sortBy (\x y -> compare (snd x) (snd y)) ls

    (goals,swaps) = runST $ do
        reach <- STArr.newListArray (1,n) [1..n]
            :: ST s (STArr.STArray s Int Int)
        (reach, swaps) <- foldM update (reach,[]) ls'
        reach <- STArr.freeze reach
        let goals = array (1,n) (map (\(a,b)->(b,a)) $ assocs reach)
        return (goals,swaps)

    update (goals,swaps) (a,_) = do
        s1 <- STArr.readArray goals a
        s2 <- STArr.readArray goals (a+1)
        STArr.writeArray goals a s2
        STArr.writeArray goals (a+1) s1
        return (goals, (s1,s2):swaps)

    diff x y
        | (min x y) <= k && (max x y) > k
            = (pointOf (max x y)) - (pointOf (min x y))
        | otherwise
            = 0

    pointOf start = ps ! (goals ! start)