gistfile1.hs

import Data.List(findIndex,findIndices)
import Maybe(fromJust)

paso :: (Integral a) => (a -> a) -> a -> a
paso hazpar x = if odd x then div (hazpar x) 2 else div x 2

serieInfinita :: (Integral a) => (a -> a) -> a -> [Bool]
serieInfinita f x = odd x : serieInfinita f siguiente where
    siguiente = paso f x

binarios :: (Integral a) => a -> a
binarios x = x - 1

transformacion' :: Int -> Integer -> (Int, Integer)
transformacion' b x = (n,q) where
    trayectoria = reverse $ take b $ serieInfinita binarios x
    n = length $ filter id trayectoria
    q = sum $ zipWith (*) vector3 vector2
    vector3 = map (3^) $ [(n-1),(n-2)..0]
    vector2 = map (2^) $ findIndices id trayectoria

transformacion :: Int -> Integer -> (Integer -> (Integer,Integer))
transformacion b x = (\ k -> quotRem ((3^n)*k + q) (2^b)) where
    (n,q) = transformacion' b x

nivel :: Int -> [Integer]
nivel n = map g [0..((2^n)-1)] where
    g x = fromIntegral $ fromJust $
          findIndex ((==0).snd) $ map (transformacion n x) [0..(2^n)-1]

cuentaPares :: Integer -> Int
cuentaPares 0 = 0
cuentaPares n = if even n then 1+(cuentaPares (quot n 2)) else 0

nsiguiente :: (Int,[Integer]) -> (Int,[Integer])
nsiguiente (b,xs) = (b+1,concatMap g xxs) where
    xxs = zip xs [0..]
    g (n,indice) = if decide b (n,indice) then [n+2^b,n] else [n,n+2^b]

decide :: Int -> (Integer,Int) -> Bool
decide b (n,indice) = cuentaPares (3^numunos * n + q) == b where
    trayectoria = reverse $ take b $ serieInfinita binarios indice
    numunos = length $ filter id trayectoria
    q = sum $ zipWith (*) vector3 vector2
    vector3 = map (3^) $ [(numunos-1),(numunos-2)..0]
    vector2 = map (2^) $ findIndices id trayectoria

----

alternos :: [a] -> ([a],[a])
alternos (x:y:xs) =
    if null xs then ([x],[y]) else (x:m, y:n) where (m, n) = alternos xs

alternosCon :: (a->a->b) -> [a] -> [b]
alternosCon f xs = zipWith f x y where
    (x, y) = alternos xs

nivelGiros :: [(Int,Integer)] -> [(Int,Integer)]
nivelGiros xs = concatMap g xs where
    g :: (Int,Integer) -> [(Int,Integer)]
    g (n,x) = [(n,izq),(n+1,der)] where
        izq = if even x then par else rimpar
        der = if even x then rpar else impar
        par = quot x 2
        impar = quot (3*x + 1) 2
        rpar = quot (3*x + 3^(n+1) + 1) 2
        rimpar = quot (x + 3^n) 2

test n = t1 == t2 where
    t1 = map (odd.snd) $ (iterate nivelGiros [(1,2)]) !! n
    t2 = alternosCon (>) $ drop (2^(n+1)) $ nivel (n+2)