Submission #2406059


Source Code Expand

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
module Main
where

import           Control.Applicative
import           Control.Monad
import           Control.Monad.ST
import           Data.Array
import           Data.Bits
import qualified Data.ByteString.Char8       as BC
import           Data.List
import           Data.Maybe
import           Data.STRef
import qualified Data.Vector                 as V
import qualified Data.Vector.Mutable         as VM
import qualified Data.Vector.Unboxed         as VU
import qualified Data.Vector.Unboxed.Mutable as VUM

{-# INLINE bucketsort #-}
bucketsort :: (Int, Int) -> [Int] -> [Int]
bucketsort = bucketsortBy id

{-# INLINE bucketsortBy #-}
bucketsortBy :: (a -> Int) -> (Int, Int) -> [a] -> [a]
bucketsortBy getkey dom = concatMap reverse . filter (not . null)
    . elems . accumArray (flip (:)) [] dom . map (\x -> (getkey x, x))

{-# INLINE bucketsortDescBy #-}
bucketsortDescBy :: (a -> Int) -> (Int, Int) -> [a] -> [a]
bucketsortDescBy getkey dom = reverse . concat . filter (not . null)
    . elems . accumArray (flip (:)) [] dom . map (\x -> (getkey x, x))

marge :: Ord a => VM.STVector s a -> VM.STVector s a -> VM.STVector s a -> ST s ()
marge u v ret
  | VM.null u = VM.copy ret v
  | VM.null v = VM.copy ret u
  | otherwise = do
        x <- VM.read u 0
        y <- VM.read v 0
        if x > y then marge v u ret else do
            VM.write ret 0 x
            marge (VM.tail u) v (VM.tail ret)

testMarge :: V.Vector Int
testMarge = runST $ do
    x <- V.thaw $ V.fromList ([1, 4] :: [Int])
    y <- V.thaw $ V.fromList ([2, 3] :: [Int])
    res <- VM.new 4
    marge x y res
    V.freeze res

msort :: Ord a => V.Vector a -> V.Vector a
msort v = runST $ do
    v' <- V.thaw v
    work <- VM.new $ VM.length v'
    msort_ v' work
    V.unsafeFreeze v'

msort_ :: Ord a => VM.STVector s a -> VM.STVector s a -> ST s ()
msort_ v work
  | VM.length v <= 1 = return ()
  | otherwise        = do
        VM.copy lwork lv
        VM.copy rwork rv
        msort_ lwork lv
        msort_ rwork rv
        marge lwork rwork v
        where
            toHalf vm = VM.splitAt (VM.length vm `div` 2) vm
            (lv, rv) = toHalf v
            (lwork, rwork) = toHalf work


main :: IO ()
main = do
    n <- readLn :: IO Int
    {-as <- map (read :: String -> Word) . words <$> getLine
    bs <- map (read :: String -> Word) . words <$> getLine-}
    as <- getInts
    bs <- getInts
    --print $ (build 0 bs) `seq` 0
    --print $ foldr1 xor $ zipWith ($) ((\k -> eachFigure k as) <$> [0..]) (build 0 bs)
    print $ sum $ eachFigure' as bs <$> [0..28]

readInts :: BC.ByteString -> [Int]
readInts = map (fst . fromJust . BC.readInt) . BC.words

getInts :: IO [Int]
getInts = readInts <$> BC.getLine

upperBoundImpl :: Int -> (Int, Int) -> VU.Vector Int -> Int
{-upperBoundImpl key (al, ar) f = runST $ do
    l <- newSTRef al
    r <- newSTRef ar
    mid <- newSTRef 0
    let loop = do
            l' <- readSTRef l
            r' <- readSTRef r
            if r' - l' <= 1 then return r' else do
                writeSTRef mid $ shiftR (l' + r') 1
                mid' <- readSTRef mid
                if f mid' <= key
                then writeSTRef l mid'
                else writeSTRef r mid'
                loop
    loop-}
binarySearch :: (Int -> Word) -> (Int, Int) -> Word -> Int
binarySearch xs (al, ar) y = go al ar where
    go l r
        | l == r = l
        | x < y = go (m + 1) r
        | x >= y = go l m
        where m = (r + l) `shiftR` 1
              x = xs m

upperBoundImpl key (l, r) f =
    let mid = (l + r) `unsafeShiftR` 1
    in  if r - l <= 1 then r else
        if f `VU.unsafeIndex` mid <= key
            then upperBoundImpl key (mid, r) f
            else upperBoundImpl key (l, mid) f

upperBound :: Int -> (Int, Int) -> VU.Vector Int -> Int
upperBound key (l, r) = upperBoundImpl key (l - 1, r)

test :: IO()
test = undefined
--test = print $ upperBound 1 (0, 5) $ ((listArray (0, 4) [1, 1, 1, 1, 1] :: Array Int Word) !)

unsafeBit = (1 `unsafeShiftL`)

xorOnFigure :: Int -> Int -> VU.Vector Int -> Int
xorOnFigure a k sorted =
    let n = VU.length sorted
        notCarriers = upperBound (unsafeBit (k + 1) - 1 - a) (0, n) sorted
        i = upperBound (unsafeBit k - 1 - a) (0, notCarriers) sorted
        j = upperBound (unsafeBit k * 3 - 1 - a) (notCarriers, n) sorted
        {-notCarriers = binarySearch sorted (0, n) $ bit (k + 1)
        i = binarySearch sorted (0, notCarriers) $ bit k
        j = binarySearch sorted (notCarriers, n) $ bit (k + 1) + bit k-}
    in  if testBit ((notCarriers - i) + (n - j)) 0 then 1 else 0

eachFigure :: Int -> [Int] -> [Int] -> Int
eachFigure k as sortedBs =
    let v = VU.fromList $ (.&. (unsafeBit (k + 1) - 1)) <$> sortedBs
        f a = xorOnFigure a k v
    in  foldr1 xor $ map f $! (.&. (unsafeBit (k + 1) - 1)) <$> as

eachFigure' :: [Int] -> [Int] -> Int -> Int
eachFigure' as bs k =
    let v = sort' $ VU.fromList $ (.&. (unsafeBit (k + 1) - 1)) <$> bs
        f a = xorOnFigure a k v
    in  if odd $ sum $ map f $ (.&. (unsafeBit (k + 1) - 1)) <$> as
        then unsafeBit k
        else 0

build :: Int -> [Int] -> [[Int]]
build 29 _ = []
build k bs = sorted : build (k + 1) sorted
    where sorted = bucketsortBy (\w -> if testBit w k then 1 else 0) (0, 1) bs :: [Int]

sort' :: VU.Vector Int -> VU.Vector Int
sort' = VU.modify (\v -> quicksort v 0 (VUM.length v))

-- https://github.com/as-capabl/haskell-qsort-pfm/blob/master/src/UV.hs
type IndType = Int

quicksort :: VUM.STVector s Int -> IndType -> IndType -> ST s ()
quicksort work iStart iEnd
    | iEnd - iStart <= 1 = return ()
    | otherwise =
        do
        pivot <- VUM.unsafeRead work ((iEnd + iStart) `shiftR` 1)
        med <- divide pivot iStart (iEnd - 1)
        quicksort work iStart med
        quicksort work med iEnd
    where
    divide pivot iS' iE'
        | iS' > iE' = return iS'
        | otherwise =
            do
            lower <- shrinkLower pivot iS' iE'
            higher <- shrinkHigher pivot lower iE'
            if lower >= higher
                then return lower
                else do
                swapWork lower higher
                divide pivot (lower + 1) (higher - 1)

    shrinkLower pivot iS' iE'
        | iS' > iE' = return iS'
        | otherwise =
            do
            x <- VUM.unsafeRead work iS'
            if x >= pivot
                then
                return iS'
                else
                shrinkLower pivot (iS' + 1) iE'

    shrinkHigher pivot iS' iE'
        | iS' > iE' = return iE'
        | otherwise =
            do
            x <- VUM.unsafeRead work iE'
            if x <= pivot
                then
                return iE'
                else
                shrinkHigher pivot iS' (iE' - 1)

    swapWork = VUM.unsafeSwap work

Submission Info

Submission Time
Task D - Two Sequences
User winjii
Language Haskell (GHC 7.10.3)
Score 0
Code Size 7059 Byte
Status TLE
Exec Time 3158 ms
Memory 58748 KB

Judge Result

Set Name Sample All
Score / Max Score 0 / 0 0 / 500
Status
AC × 4
AC × 12
TLE × 4
Set Name Test Cases
Sample example_0, example_1, example_2, example_3
All N100000_0, N100000_1, N150000_0, N150000_1, N200000_0, N200000_1, N200000_ex_0, N200000_ex_1, example_0, example_1, example_2, example_3, rand_0, rand_1, smallrand_0, smallrand_1
Case Name Status Exec Time Memory
N100000_0 AC 1481 ms 33148 KB
N100000_1 AC 1481 ms 32124 KB
N150000_0 AC 2399 ms 52604 KB
N150000_1 AC 2388 ms 47484 KB
N200000_0 TLE 3158 ms 58748 KB
N200000_1 TLE 3158 ms 58748 KB
N200000_ex_0 TLE 3072 ms 58236 KB
N200000_ex_1 TLE 3126 ms 58236 KB
example_0 AC 2 ms 508 KB
example_1 AC 2 ms 508 KB
example_2 AC 2 ms 508 KB
example_3 AC 2 ms 508 KB
rand_0 AC 69 ms 2940 KB
rand_1 AC 149 ms 4732 KB
smallrand_0 AC 2 ms 508 KB
smallrand_1 AC 2 ms 508 KB