import Data.List
import Data.Bits
import Data.Word
import Data.Array
import Random
import System.Environment
choose 0 _ = [[]]
choose _ [] = [ ]
choose k (x:xs) = choose k xs ++ map (x:) (choose (k-1) xs)
r = 6
simpleComplement a = [1..(2*r)] \\ a
simpleOptions = [a | a <- choose r [1..(2*r-1)], not $ a `simpleLeftOf` (simpleComplement a)]
simpleLeftOf xs ys = all id $ zipWith (<=) xs ys
simpleCount [] = 1
simpleCount (a:as) = simpleCount take + simpleCount leave
where
-- take a
-- all pairs with b < a or b^c < a are forced
-- second case never happens as b^c has 2r but a doesn't
take = [b | b <- as, not $ b `simpleLeftOf` a]
-- leave a, and so take a^c
-- all pairs with b < a^c or b^c < a^c (equivalently, a < b) are forced
c = simpleComplement a
leave = [b | b <- as, not (b `simpleLeftOf` c || a `simpleLeftOf` b)]
interleave [] [] = []
interleave (x:xs) (y:ys) = x : y : interleave xs ys
mask :: Word64
mask = 2^(r*(r+1))-1
odds :: Word64
odds = foldr (flip setBit) 0 [1,3..63]
evens :: Word64
evens = foldr (flip setBit) 0 [0,2..62]
initialState = odds .&. (complement mask)
grid = b
where
-- array mapping grid squares to bit vectors
-- (i,j) and (j,i) are stored in consecutive positions that are fast to swap
-- unused bits are set if and only if odd, so that they are invariant under swapping
-- odd and even bits then complementing
-- diagonal entries use two bits so they are invariant under swapping odd and even bits
lowerHalf = [(i,j) | i <- [0..(r-1)], j <- [0..i]]
upperHalf = [(j,i) | i <- [0..(r-1)], j <- [0..i]]
bits = map bit [0..] :: [Word64]
s = zip (interleave lowerHalf upperHalf) bits
a = accumArray (.|.) 0 ((0,0), (r-1,r-1)) s
t = [((i,j), foldr (.|.) initialState [a!(i,k) | k <- [0..j-1]]) | i <- [0..(r-1)], j <- [0..r]]
b = array ((0,0), (r-1,r)) t
toUnary x = foldr (.|.) 0 [grid ! y | y <- zip [0..] (zipWith (-) x [1..])]
fastLeftOf a b = (a .&. b) == a
-- all id [(simpleLeftOf a b) == fastLeftOf (toUnary a) (toUnary b) | a <- choose r [1..(2*r)], b <- choose r [1..(2*r)]]
fastComplement a = complement ((o `shiftR` 1) .|. (e `shiftL` 1))
where
o = odds .&. a
e = evens .&. a
-- all id [fastComplement (toUnary a) == toUnary (simpleComplement a) | a <- choose r [1..(2*r)]]
fastOptions = map toUnary simpleOptions
fastCount [] = 1
fastCount (a:as) = fastCount take + fastCount leave
where
-- take a
-- all pairs with b < a or b^c < a are forced
-- second case never happens as b^c has 2r but a doesn't
take = [b | b <- as, not $ b `fastLeftOf` a]
-- leave a, and so take a^c
-- all pairs with b < a^c or b^c < a^c (equivalently, a < b) are forced
c = fastComplement a
leave = [b | b <- as, not (b `fastLeftOf` c || a `fastLeftOf` b)]
permute xs = map snd $ sort $ zip noise xs
where
g = mkStdGen 0
noise = randoms g :: [Int]
-- force first i decisions using the bits of x
runUp 0 _ as = fastCount as
runUp _ x [] = if x == 0 then 1 else 0 -- only count one branch that dies out before the target depth
runUp i x (a:as) = if odd x then runUp (i-1) y take else runUp (i-1) y leave
where
y = x `div` 2
take = [b | b <- as, not $ b `fastLeftOf` a]
c = fastComplement a
leave = [b | b <- as, not (b `fastLeftOf` c || a `fastLeftOf` b)]
--main = print $ fastCount $ permute fastOptions
main = do
args <- getArgs
let [i, x] = map read $ args
let n = runUp i x $ permute $ fastOptions
putStrLn $ unwords [show n, show i, show x]