{-# LANGUAGE DataKinds,ScopedTypeVariables,KindSignatures #-}
import Control.Monad
import Data.Monoid
import Data.Maybe ( fromJust )
import Data.Array ( Array, (!), listArray, assocs , elems)
import Data.List ( foldl', sort)
import Data.Array.ST
import Control.Monad.ST
import qualified Data.ByteString.Char8 as BS
import GHC.TypeNats ( KnownNat, Nat, natVal )
import Data.Proxy ( Proxy(..) )
import Data.Ratio ( denominator, numerator )
import Data.Set as S (Set, empty, insert, delete, member)
import Debug.Trace
readInt :: BS.ByteString -> Int
readInt = fst . fromJust . BS.readInt
readIntList :: BS.ByteString -> [Int]
readIntList = map readInt . BS.words
readIntTuple :: BS.ByteString -> (Int, Int)
readIntTuple = (\[x, y] -> (x, y)) . readIntList
getInt :: IO Int
getInt = readInt <$> BS.getLine
getInts :: IO [Int]
getInts = readIntList <$> BS.getLine
getIntTuple :: IO (Int, Int)
getIntTuple = readIntTuple <$> BS.getLine
getIntNLists :: Int -> IO [[Int]]
getIntNLists n = fmap readIntList <$> replicateM n BS.getLine
getIntMatrix :: IO ([[Int]])
getIntMatrix = fmap readIntList . BS.lines <$> BS.getContents
getIntNTuples :: Int -> IO [(Int, Int)]
getIntNTuples n = fmap readIntTuple <$> replicateM n BS.getLine
getIntTuples :: IO [(Int, Int)]
getIntTuples = fmap readIntTuple . BS.lines <$> BS.getContents
newtype ModInt (m :: Nat) = ModInt Integer deriving (Eq)
instance KnownNat m => Num (ModInt m) where
ModInt x + ModInt y = fromInteger $ x + y
ModInt x - ModInt y = fromInteger $ x - y
ModInt x * ModInt y = fromInteger $ x * y
negate (ModInt x) = fromInteger $ negate x
abs a = a
signum _ = 1
fromInteger x = ModInt $ x `mod` (fromIntegral $ natVal (Proxy :: Proxy m))
instance KnownNat m => Fractional (ModInt m) where
recip a@(ModInt x) = fromInteger r where
(_, r, _) = exgcd x (fromIntegral $ natVal (Proxy :: Proxy m))
fromRational x = fromInteger $ numerator x `div` denominator x
exgcd :: Integral a => a -> a -> (a, a, a)
exgcd a b = f $ go a b 1 0 0 1
where
go r0 r1 s0 s1 t0 t1
| r1 == 0 = (r0, s0, t0)
| otherwise = go r1 r2 s1 s2 t1 t2
where
(q, r2) = r0 `divMod` r1
s2 = s0 - q*s1
t2 = t0 - q*t1
f (g,u,v)
| g < 0 = (-g, -u, -v)
| otherwise = (g,u,v)
instance KnownNat m => Bounded (ModInt m) where
minBound = ModInt 0
maxBound = ModInt $ fromIntegral $ natVal (Proxy :: Proxy m) - 1
instance KnownNat m => Enum (ModInt m) where
toEnum = fromInteger . toInteger
fromEnum (ModInt x) = fromInteger x
instance KnownNat m => Ord (ModInt m) where
ModInt x <= ModInt y = x <= y
instance KnownNat m => Show (ModInt m) where
show (ModInt x) = show x
(^) :: (Num a) => a -> Int -> a
(^) a n = go a n 1
where
go _ 0 res = res
go a n res
| even n = go (a*a) (n `div` 2) res
| otherwise = go a (n-1) (res*a)
shakutori :: (Num a, Eq a) =>(t -> p -> Bool) -> (p -> t -> p) -> (p -> t -> p) -> p -> [t] -> [a]
shakutori p op invOp identity as = go as as 0 identity
where
go lls@(l:ls) [] len res = len : (go ls [] (len-1) (invOp res l))
go lls@(l:ls) rrs@(r:rs) len res
| p r res = go lls rs (len + 1) (op res r)
| len == 0 = 0:(go ls rs 0 identity)
| otherwise = len : (go ls rrs (len-1) (invOp res l))
go _ _ len _ = []
newtype MaxPlus a = MaxPlus { unMaxPlus :: a } deriving (Eq, Ord, Show)
newtype MinPlus a = MinPlus { unMinPlus :: a } deriving (Eq, Ord, Show)
class Semiring s where
(<+>) :: s -> s -> s
(<.>) :: s -> s -> s
zero :: s
one :: s
instance (Ord a, Bounded a, Num a) => Semiring (MaxPlus a) where
t1@(MaxPlus v1) <+> t2@(MaxPlus v2) = MaxPlus (max v1 v2)
t1@(MaxPlus v1) <.> t2@(MaxPlus v2)
| t1 == zero = zero
| t2 == zero = zero
| otherwise = MaxPlus (v1 + v2)
zero = MaxPlus minBound
one = MaxPlus 0
instance (Ord a, Bounded a, Num a) => Semiring (MinPlus a) where
t1@(MinPlus v1) <+> t2@(MinPlus v2) = MinPlus (min v1 v2)
t1@(MinPlus v1) <.> t2@(MinPlus v2)
| t1 == zero = zero
| t2 == zero = zero
| otherwise = MinPlus (v1 + v2)
zero = MinPlus maxBound
one = MinPlus 0
instance KnownNat m => Semiring (ModInt m) where
(<+>) = (+)
(<.>) = (*)
zero = 0
one = 1
data DPProblem p sc = DPProblem {
start :: p,
getRange :: (p, p),
isTrivial :: p -> Bool,
subproblems :: p -> [(sc, p)]
}
dpSolve :: forall i sc s. (Semiring sc, Ix i, Eq sc) => DPProblem i sc -> ST s sc
dpSolve dp = do
memo <- newArray (getRange dp) zero :: ST s (STArray s i sc)
go (start dp) memo where
go p memo
| isTrivial dp p = return one
| otherwise = do
res <- readArray memo p
if res /= zero then return res
else do
ret <- foldM (\acc (s, sp) -> (<+>) acc <$> ((<.>) s <$> go sp memo)) zero (subproblems dp p)
writeArray memo p ret
return ret
supplement :: (Array Int Int, Int, Int) -> DPProblem Int (ModInt 1000000007)
supplement (as,n,m) = DPProblem {
start = 1,
getRange = (1, n+1),
isTrivial = (>= n),
subproblems = \i -> [(1, i + j ) | j <- [1.. as ! i]]
}
main :: IO ()
main = do
(n,m) <- getIntTuple
input <- concat <$> getIntNLists n
let as = listArray (1,n) $ shakutori (\r res -> not (S.member r res)) (flip S.insert) (flip S.delete) S.empty input
let ans = runST $ dpSolve $ supplement (as,n,m)
print $ ans