結果

問題 No.5002 stick xor
ユーザー LeonardoneLeonardone
提出日時 2018-05-31 06:07:41
言語 Haskell
(9.8.2)
結果
AC  
実行時間 118 ms / 1,000 ms
コード長 1,336 bytes
コンパイル時間 13,549 ms
実行使用メモリ 4,048 KB
スコア 36,817
最終ジャッジ日時 2018-05-31 06:07:57
ジャッジサーバーID
（参考情報） 		judge8 /
純コード判定しない問題か言語
このコードへのチャレンジ
（要ログイン）

テストケース

テストケース表示
入力 結果 実行時間
実行使用メモリ
testcase_00 AC 115 ms
3,968 KB
testcase_01 AC 118 ms
4,008 KB
testcase_02 AC 91 ms
3,968 KB
testcase_03 AC 91 ms
3,996 KB
testcase_04 AC 91 ms
3,968 KB
testcase_05 AC 92 ms
4,024 KB
testcase_06 AC 92 ms
3,968 KB
testcase_07 AC 94 ms
4,040 KB
testcase_08 AC 100 ms
3,988 KB
testcase_09 AC 92 ms
4,016 KB
testcase_10 AC 91 ms
3,964 KB
testcase_11 AC 90 ms
3,964 KB
testcase_12 AC 90 ms
3,992 KB
testcase_13 AC 91 ms
4,012 KB
testcase_14 AC 90 ms
4,000 KB
testcase_15 AC 93 ms
4,044 KB
testcase_16 AC 91 ms
3,968 KB
testcase_17 AC 91 ms
3,980 KB
testcase_18 AC 91 ms
3,996 KB
testcase_19 AC 92 ms
4,048 KB
testcase_20 AC 92 ms
3,988 KB
testcase_21 AC 90 ms
3,972 KB
testcase_22 AC 92 ms
4,032 KB
testcase_23 AC 91 ms
4,008 KB
testcase_24 AC 91 ms
3,996 KB
testcase_25 AC 92 ms
3,976 KB
testcase_26 AC 90 ms
3,988 KB
testcase_27 AC 90 ms
4,016 KB
testcase_28 AC 90 ms
4,008 KB
testcase_29 AC 90 ms
3,968 KB
testcase_30 AC 90 ms
3,996 KB
testcase_31 AC 94 ms
4,036 KB
権限があれば一括ダウンロードができます
コンパイルメッセージ
[1 of 1] Compiling Main             ( Main.hs, Main.o )
Linking a.out ...

ソースコード

diff # 

-- Try yukicoder
-- author: Leonardone @ NEETSDKASU

import Data.Char (digitToInt)
import Data.Word (Word64)
import Data.Bits

main = interact $ unlines . map format . solve . parse . lines

parse (nkstr:lsstr:tbstr) = ret where
    [n, k] = map read $ words nkstr
    ls = map read $ words lsstr
    tb = zip [1..] $ map mf tbstr :: [(Int, Word64)]
    ret = (n, k, ls, tb)
    mf = fromInteger . foldl f 0
    f a b = shiftL a 1 .|. (toInteger $ digitToInt b)

format (l, (y, x)) = unwords $ map show [y, x, y, x + l - 1]
    
solve (n, k, ls, tb) = zip ls $ reverse ans where
    (ans, _) = foldl (fix n) ([], tb) ls

fullbits n = shiftL 1 n - 1
    
setbits t x s = t `xor` shiftL x s

getbits x (s, t) = shiftR t s .&. x

find n l t = ret where
    fb = fullbits l
    mf1 s = (s, setbits t fb s)
    mf2 nb = (popCount . getbits fb $ snd nb, nb)
    bs = map mf1 [0..n-l]
    nbs = zip [n-l+1-i | i <- [0..]] bs
    ret = foldl1 f $ map mf2 nbs
    f a b = if fst a < fst b then a else b

get tb n l = ret where
    ret = foldl1 f $ map mf tb
    mf (y, t) = (y, find n l t)
    f a b = if fst (snd a) < fst (snd b) then a else b
    
fix n (r, tb) l = ret where
    (y, (_, (x, (_, b)))) = get tb n l
    ret = ((y, x):r, swap b (y-1) tb)
    swap u 0 ((i, _):es) = (i, u) : es
    swap u p (e:es) = e : swap u (p-1) es
0