#586964 (Haskell) No.1136 Four Points Tour

提出ソース

結果

問題	No.1136 Four Points Tour
ユーザー	こまる
提出日時	2020-11-29 14:32:34
言語	Haskell (9.10.1)
結果	CE (最新) AC (最初)
実行時間	-
コード長	12,438 bytes
コンパイル時間	1,742 ms
コンパイル使用メモリ	203,264 KB
最終ジャッジ日時	2024-11-14 23:55:33
合計ジャッジ時間	2,180 ms
ジャッジサーバーID （参考情報）	judge4 / judge5

このコードへのチャレンジ
（要ログイン）

コンパイルエラー時のメッセージ・ソースコードは、提出者また管理者しか表示できないようにしております。（リジャッジ後のコンパイルエラーは公開されます）
ただし、clay言語の場合は開発者のデバッグのため、公開されます。

コンパイルメッセージ

Loaded package environment from /home/judge/.ghc/x86_64-linux-9.8.2/environments/default

Main.hs:11:14: warning: [GHC-53692] [-Wdeprecated-flags]
    -XTypeInType is deprecated: use -XDataKinds and -XPolyKinds instead
   |
11 | {-# LANGUAGE TypeInType                 #-}
   |              ^^^^^^^^^^
[1 of 2] Compiling Main             ( Main.hs, Main.o )

Main.hs:120:10: error: [GHC-88464]
    Variable not in scope: lift :: ST s Int -> ContT () (ST s) Int
    |
120 |     c <- lift $ check b (-1) i
    |          ^^^^

Main.hs:123:9: error: [GHC-88464]
    Variable not in scope: lift :: ST s () -> ContT () (ST s) a5
    |
123 |         lift $ writeSTRef retRef 0
    |         ^^^^

Main.hs:126:9: error: [GHC-88464]
    Variable not in scope: when :: Bool -> a3 -> ContT () (ST s) a4
    |
126 |         when (c /= i) $ lift $ modifySTRef retRef (*(-1))
    |         ^^^^

Main.hs:126:25: error: [GHC-88464]
    Variable not in scope: lift :: ST s () -> a3
    |
126 |         when (c /= i) $ lift $ modifySTRef retRef (*(-1))
    |                         ^^^^

Main.hs:127:24: error: [GHC-88464]
    Variable not in scope: lift :: m0 () -> ContT () (ST s) ()
    |
127 |         rep sz $ \j -> lift $ VUM.unsafeSwap b (c * sz + j) (i * sz + j)
    |                        ^^^^

Main.hs:129:9: error: [GHC-88464]
    Variable not in scope: lift :: ST s () -> ContT () (ST s) a2
    |
129 |         lift $ modifySTRef retRef (*itemii)
    |         ^^^^

Main.hs:143:9: error: [GHC-88464]
    Variable not in scope:
      when :: Bool -> ContT () (ST s) b2 -> ContT () (ST s) ()
    |
143 |         when (item /= 0) $ do
    |         ^^^^

Main.hs:144:11: error: [GHC-88464]
    Variable not in scope: lift :: ST s () -> ContT () (ST s) a1
    |
144 |           lift $ writeSTRef pRef j
    |           ^^^^

ソースコード

raw source code

{-# OPTIONS_GHC -mavx2                  #-}
{-# OPTIONS_GHC -O3                     #-}
{-# LANGUAGE BangPatterns               #-}
{-# LANGUAGE CPP                        #-}
{-# LANGUAGE DerivingStrategies         #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MagicHash                  #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE TypeApplications           #-}
{-# LANGUAGE TypeFamilies               #-}
{-# LANGUAGE TypeInType                 #-}
{-# LANGUAGE UnboxedTuples              #-}

import           Control.Monad.Cont
import           Control.Monad.ST
import           Data.Bits
import           Data.Bool
import           Data.Coerce
import           Data.STRef.Strict
import qualified Data.Ratio                        as R
import           GHC.Exts
import qualified Data.Vector.Fusion.Stream.Monadic as VFSM
import qualified Data.Vector.Generic               as VG
import qualified Data.Vector.Generic.Mutable       as VGM
import qualified Data.Vector.Unboxed               as VU
import qualified Data.Vector.Unboxed.Mutable       as VUM

main :: IO ()
main = do
  n <- readLn :: IO Int
  let x = buildMatrix $ VU.fromList [0,1,1,1,1,0,1,1,1,1,0,1,1,1,1,0]
  print $ (x <|^|> n) VU.! 0
-------------------------------------------------------------------------------
-- square matrix
-------------------------------------------------------------------------------
type SquareMatrixMint = VU.Vector Mint

infixr 8 <|^|>
infixr 7 <|#|>
infixl 7 <|*|>
infixl 6 <|+|>, <|-|>

matO :: Int -> SquareMatrixMint
matO sz = VU.replicate sz (0 :: Mint) 
{-# INLINE matO #-}

matE :: Int -> SquareMatrixMint
matE sz = VU.imap (\i _ -> bool 0 1 (i `mod` (sz + 1) == 0)) $ VU.replicate (sz * sz) (0 :: Mint)
{-# INLINE matE #-}

buildMatrix :: VU.Vector Int -> SquareMatrixMint
buildMatrix = VU.map mint
{-# INLINE buildMatrix #-}

(<|+|>) :: SquareMatrixMint -> SquareMatrixMint -> SquareMatrixMint
a <|+|> b = VU.zipWith (+) a b
{-# INLINE (<|+|>) #-}

(<|-|>) :: SquareMatrixMint -> SquareMatrixMint -> SquareMatrixMint
a <|-|> b = VU.zipWith (-) a b
{-# INLINE (<|-|>) #-}

(<|*|>) :: SquareMatrixMint -> SquareMatrixMint -> SquareMatrixMint
a <|*|> b = VU.create $ do
  c <- VUM.unsafeNew m :: ST s (VUM.STVector s Mint)
  rep sz $ \i -> rep sz $ \j -> rep sz $ \k -> VUM.unsafeModify c (+ (a VU.! (i * sz + k)) * (b VU.! (k * sz + j))) (i * sz + j)
  return c
  where
    !m  = VU.length a
    !sz = floor . sqrt . fromIntegral $ m

(<|^|>) :: SquareMatrixMint -> Int -> SquareMatrixMint
a <|^|> n
  | n == 1    = a
  | n == 0    = matE sz
  | even n    = z <|*|> z
  | otherwise = a <|*|> (z <|*|> z)
  where
    z   = a <|^|> (n `div` 2)
    !m  = VU.length a
    !sz = floor . sqrt . fromIntegral $ m

(<|#|>) :: Int -> SquareMatrixMint -> SquareMatrixMint
n <|#|> a = VU.map (* mint n) a
{-# INLINE (<|#|>) #-}

transposeMat :: SquareMatrixMint -> SquareMatrixMint
transposeMat a = VU.create $ do
  let
    !n  = VU.length a
    !sz = floor . sqrt . fromIntegral $ n
  b <- VUM.unsafeNew n :: ST s (VUM.STVector s Mint)
  rep sz $ \i -> rep sz $ \j -> do
    VUM.unsafeWrite b (j * sz + i) (a VU.! (i * sz + j))
  return b

takeNthRow :: Int -> SquareMatrixMint -> VU.Vector Mint
takeNthRow n a = VU.create $ do
  let
    !m  = VU.length a
    !sz = floor . sqrt . fromIntegral $ m
  b <- VUM.unsafeNew sz :: ST s (VUM.STVector s Mint)
  rep sz $ \i -> VUM.unsafeWrite b i (a VU.! ((n - 1) * sz + i))
  return b

takeNthCol :: Int -> SquareMatrixMint -> VU.Vector Mint
takeNthCol n a = VU.create $ do
  let
    !m  = VU.length a
    !sz = floor . sqrt . fromIntegral $ m
  b <- VUM.unsafeNew sz :: ST s (VUM.STVector s Mint)
  rep sz $ \i -> VUM.unsafeWrite b i (a VU.! (i * sz + (n - 1)))
  return b

determinant :: Int -> SquareMatrixMint -> Mint
determinant sz a = runST $ do
  retRef <- newSTRef (1 :: Mint)
  b      <- VU.unsafeThaw a
  withBreakST $ \break -> rep sz $ \i -> do
    c <- lift $ check b (-1) i
    if c == (-1)
      then do
        lift $ writeSTRef retRef 0
        break ()
      else do
        when (c /= i) $ lift $ modifySTRef retRef (*(-1))
        rep sz $ \j -> lift $ VUM.unsafeSwap b (c * sz + j) (i * sz + j)
        itemii <- VUM.unsafeRead b (i * sz + i)
        lift $ modifySTRef retRef (*itemii)
        let inva = (1 :: Mint) / itemii
        range (i + 1) (sz - 1) $ \j -> do
          a0 <- VUM.unsafeRead b (j * sz + i)
          range i (sz - 1) $ \k -> do
            item <- VUM.unsafeRead b (i * sz + k)
            VUM.unsafeModify b (subtract (inva * a0 * item)) (j * sz + k)
  readSTRef retRef
  where
    check :: VUM.STVector s Mint -> Int -> Int -> ST s Int
    check mvec ptr idx = do
      pRef <- newSTRef ptr
      withBreakST $ \break -> range idx (sz - 1) $ \j -> do
        item <- VUM.unsafeRead mvec (j * sz + idx)
        when (item /= 0) $ do
          lift $ writeSTRef pRef j
          break ()
      readSTRef pRef

trace :: Int -> SquareMatrixMint -> Mint
trace n = VU.ifoldl' (\a i b -> if i `mod` (n + 1) == 0 then a + b else a) (0 :: Mint)

-------------------------------------------------------------------------------
-- mint
-------------------------------------------------------------------------------
#define MOD 1000000007

modulus :: Num a => a
modulus = MOD
{-# INLINE modulus #-}

infixr 8 ^%
infixl 7 *%, /%
infixl 6 +%, -%

(+%) :: Int -> Int -> Int
(I# x#) +% (I# y#) = case x# +# y# of
  r# -> I# (r# -# ((r# >=# MOD#) *# MOD#))
{-# INLINE (+%) #-}
(-%) :: Int -> Int -> Int
(I# x#) -% (I# y#) = case x# -# y# of
  r# -> I# (r# +# ((r# <# 0#) *# MOD#))
{-# INLINE (-%) #-}
(*%) :: Int -> Int -> Int
(I# x#) *% (I# y#) = case timesWord# (int2Word# x#) (int2Word# y#) of
  z# -> case timesWord2# z# im# of
    (# q#, _ #) -> case minusWord# z# (timesWord# q# m#) of
      v#  | isTrue# (geWord# v# m#) -> I# (word2Int# (plusWord# v# m#))
          | otherwise -> I# (word2Int# v#)
  where
    m#  = int2Word# MOD#
    im# = plusWord# (quotWord# 0xffffffffffffffff## m#) 1##
{-# INLINE (*%) #-}
(/%) :: Int -> Int -> Int
(I# x#) /% (I# y#) = go# y# MOD# 1# 0#
  where
    go# a# b# u# v#
      | isTrue# (b# ># 0#) = case a# `quotInt#` b# of
        q# -> go# b# (a# -# (q# *# b#)) v# (u# -# (q# *# v#))
      | otherwise = I# ((x# *# (u# +# MOD#)) `remInt#` MOD#)
{-# INLINE (/%) #-}
(^%) :: Int -> Int -> Int
x ^% n
  | n > 0  = go 1 x n
  | n == 0 = 1
  | otherwise = go 1 (1 /% x) (-n)
  where
    go !acc !y !m
      | m .&. 1 == 0 = go acc (y *% y) (unsafeShiftR m 1)
      | m == 1       = acc *% y
      | otherwise    = go (acc *% y) (y *% y) (unsafeShiftR (m - 1) 1)

newtype Mint = Mint { getMint :: Int }
  deriving newtype (Eq, Ord, Read, Show, Real)

mint :: Integral a => a -> Mint
mint x = fromIntegral $ mod (fromIntegral x) MOD
{-# INLINE mint #-}

mintValidate :: Mint -> Bool
mintValidate (Mint x) = 0 <= x && x < MOD
{-# INLINE mintValidate #-}

instance Bounded Mint where
  minBound = Mint 0
  maxBound = Mint $ modulus - 1

instance Enum Mint where
  toEnum = mint
  fromEnum = coerce

instance Integral Mint where
  quotRem x y = (x / y, x - x / y * y)
  toInteger = coerce (toInteger @Int)

instance Num Mint where
  (+) = coerce (+%)
  (-) = coerce (-%)
  (*) = coerce (*%)
  abs = id
  signum = const (Mint 1)
  fromInteger x = coerce @Int @Mint . fromInteger $ mod x modulus

instance Fractional Mint where
  (/) = coerce (/%)
  fromRational q = fromInteger (R.numerator q) / fromInteger (R.denominator q)

newtype instance VUM.MVector s Mint = MV_Mint (VUM.MVector s Int)
newtype instance VU.Vector Mint = V_Mint (VU.Vector Int)

instance VU.Unbox Mint

instance VGM.MVector VUM.MVector Mint where
  basicLength (MV_Mint v) = VGM.basicLength v
  {-# INLINE basicLength #-}
  basicUnsafeSlice i n (MV_Mint v) = MV_Mint $ VGM.basicUnsafeSlice i n v
  {-# INLINE basicUnsafeSlice #-}
  basicOverlaps (MV_Mint v1) (MV_Mint v2) = VGM.basicOverlaps v1 v2
  {-# INLINE basicOverlaps #-}
  basicUnsafeNew n = MV_Mint `fmap` VGM.basicUnsafeNew n
  {-# INLINE basicUnsafeNew #-}
  basicInitialize (MV_Mint v) = VGM.basicInitialize v
  {-# INLINE basicInitialize #-}
  basicUnsafeReplicate n x = MV_Mint `fmap` VGM.basicUnsafeReplicate n (coerce x)
  {-# INLINE basicUnsafeReplicate #-}
  basicUnsafeRead (MV_Mint v) i = coerce `fmap` VGM.basicUnsafeRead v i
  {-# INLINE basicUnsafeRead #-}
  basicUnsafeWrite (MV_Mint v) i x = VGM.basicUnsafeWrite v i (coerce x)
  {-# INLINE basicUnsafeWrite #-}
  basicClear (MV_Mint v) = VGM.basicClear v
  {-# INLINE basicClear #-}
  basicSet (MV_Mint v) x = VGM.basicSet v (coerce x)
  {-# INLINE basicSet #-}
  basicUnsafeCopy (MV_Mint v1) (MV_Mint v2) = VGM.basicUnsafeCopy v1 v2
  {-# INLINE basicUnsafeCopy #-}
  basicUnsafeMove (MV_Mint v1) (MV_Mint v2) = VGM.basicUnsafeMove v1 v2
  {-# INLINE basicUnsafeMove #-}
  basicUnsafeGrow (MV_Mint v) n = MV_Mint `fmap` VGM.basicUnsafeGrow v n
  {-# INLINE basicUnsafeGrow #-}

instance VG.Vector VU.Vector Mint where
  basicUnsafeFreeze (MV_Mint v) = V_Mint `fmap` VG.basicUnsafeFreeze v
  {-# INLINE basicUnsafeFreeze #-}
  basicUnsafeThaw (V_Mint v) = MV_Mint `fmap` VG.basicUnsafeThaw v
  {-# INLINE basicUnsafeThaw #-}
  basicLength (V_Mint v) = VG.basicLength v
  {-# INLINE basicLength #-}
  basicUnsafeSlice i n (V_Mint v) = V_Mint $ VG.basicUnsafeSlice i n v
  {-# INLINE basicUnsafeSlice #-}
  basicUnsafeIndexM (V_Mint v) i = coerce `fmap` VG.basicUnsafeIndexM v i
  {-# INLINE basicUnsafeIndexM #-}
  basicUnsafeCopy (MV_Mint mv) (V_Mint v) = VG.basicUnsafeCopy mv v
  elemseq _ = seq
  {-# INLINE elemseq #-}

-------------------------------------------------------------------------------
-- for
-------------------------------------------------------------------------------
rep :: Monad m => Int -> (Int -> m ()) -> m ()
rep n = flip VFSM.mapM_ (streamG 0 (n - 1) const 0 (+) 1)
{-# INLINE rep #-}

rep' :: Monad m => Int -> (Int -> m ()) -> m ()
rep' n = flip VFSM.mapM_ (streamG 0 n const 0 (+) 1)
{-# INLINE rep' #-}

rep1 :: Monad m => Int -> (Int -> m ()) -> m ()
rep1 n = flip VFSM.mapM_ (streamG 1 (n - 1) const 0 (+) 1)
{-# INLINE rep1 #-}

rep1' :: Monad m => Int -> (Int -> m ()) -> m ()
rep1' n = flip VFSM.mapM_ (streamG 1 n const 0 (+) 1)
{-# INLINE rep1' #-}

rev :: Monad m => Int -> (Int -> m ()) -> m ()
rev n = flip VFSM.mapM_ (streamRG (n - 1) 0 const 0 (-) 1)
{-# INLINE rev #-}

rev' :: Monad m => Int -> (Int -> m ()) -> m ()
rev' n = flip VFSM.mapM_ (streamRG n 0 const 0 (-) 1)
{-# INLINE rev' #-}

rev1 :: Monad m => Int -> (Int -> m ()) -> m ()
rev1 n = flip VFSM.mapM_ (streamRG (n - 1) 1 const 0 (-) 1)
{-# INLINE rev1 #-}

rev1' :: Monad m => Int -> (Int -> m ()) -> m ()
rev1' n = flip VFSM.mapM_ (streamRG n 1 const 0 (-) 1)
{-# INLINE rev1' #-}

range :: Monad m => Int -> Int -> (Int -> m ()) -> m ()
range l r = flip VFSM.mapM_ (streamG l r const 0 (+) 1)
{-# INLINE range #-}

rangeR :: Monad m => Int -> Int -> (Int -> m ()) -> m ()
rangeR r l = flip VFSM.mapM_ (streamRG r l const 0 (-) 1)
{-# INLINE rangeR #-}

forP :: Monad m => Int -> (Int -> m ()) -> m ()
forP p = flip VFSM.mapM_ (streamG 2 p (^) 2 (+) 1)
{-# INLINE forP #-}

forG :: Monad m => Int -> Int -> (Int -> Int -> Int) -> Int -> (Int -> Int -> Int) -> Int -> (Int -> m ()) -> m ()
forG l r f p g d = flip VFSM.mapM_ (streamG l r f p g d)
{-# INLINE forG #-}

forRG :: Monad m => Int -> Int -> (Int -> Int -> Int) -> Int -> (Int -> Int -> Int) -> Int -> (Int -> m ()) -> m ()
forRG r l f p g d = flip VFSM.mapM_ (streamRG r l f p g d)
{-# INLINE forRG #-}

streamG :: Monad m => Int -> Int -> (Int -> Int -> Int) -> Int -> (Int -> Int -> Int) -> Int -> VFSM.Stream m Int
streamG !l !r !f !p !g !d = VFSM.Stream step l
  where
    step x
      | f x p <= r = return $ VFSM.Yield x (g x d)
      | otherwise  = return VFSM.Done
    {-# INLINE [0] step #-}
{-# INLINE [1] streamG #-}

streamRG :: Monad m => Int -> Int -> (Int -> Int -> Int) -> Int -> (Int -> Int -> Int) -> Int -> VFSM.Stream m Int
streamRG !r !l !f !p !g !d = VFSM.Stream step r
  where
    step x
      | f x p >= l = return $ VFSM.Yield x (g x d)
      | otherwise  = return VFSM.Done
    {-# INLINE [0] step #-}
{-# INLINE [1] streamRG #-}

withBreakIO :: ((r -> ContT r IO b) -> ContT r IO r) -> IO r
withBreakIO = flip runContT pure . callCC
{-# INLINE withBreakIO #-}

withBreakST :: ((r -> ContT r (ST s) b) -> ContT r (ST s) r) -> (ST s) r
withBreakST = flip runContT pure . callCC
{-# INLINE withBreakST #-}

yukicoder

結果

コンパイルメッセージ

ソースコード