gistfile1.hs

import Data.List (sortBy)

data Op = UP | DN deriving (Show, Eq)

serie :: Integer -> [Op]
serie 1 = cycle [UP,DN]
serie x 
    | odd x = UP : (serie (div ((3*x)+1) 2))
    | even x = DN : (serie (div x 2))

serie_a_entero :: [Op] -> Integer
serie_a_entero xs = sum $ zipWith (\ j k -> if j == UP then k else 0) xs (map (2^) [0..])

-- auxiliar, 'agrupa n xs' separa la lista xs de n en n elementos

agrupa :: Int -> [a] -> [[a]]
agrupa n xs = a : (if null b then [] else agrupa n b) where (a,b) = splitAt n xs

nivel :: Integer -> [Integer]
nivel n = reordena xs where
    xs = 0 : map (serie_a_entero.reverse.(take $ fromInteger n).serie) [1..((2^n)-1)]
    reordena ys = map fst $ sortBy (\ j k -> compare (snd j) (snd k)) $ zip [0..] ys

torsiones n = map fst $ filter snd $ zip [0..] $ map (\[a,b] -> a > b) $ agrupa 2 $ nivel n

groupseq :: (Integral a) => [a] -> [[a]]
groupseq xs = groupseq' 1 xs where
    groupseq' _ [] = []
    groupseq' n ys = (map (\k -> k - (2^(n-1))) a) : groupseq' (n+1) b where
        (a,b) = break (>= 2^n) ys

dropeven :: [a] -> [a]
dropeven [] = []
dropeven [x] = []
dropeven (x:y:xs) = y : dropeven xs

dropodd :: [a] -> [a]
dropodd [] = []
dropodd [x] = [x]
dropodd (x:y:xs) = x : dropodd xs

-- con 'let' para hacer memoización y que lo calcule una sola vez
-- si 16 tarda demasiado, intentar con 12 o 10
-- > let t16 = torsiones 16 
-- > let a = map (map (\k -> k - 4)) $ dropodd $ groupseq $ t16
-- > let b = dropeven $ groupseq $ t16
-- en este punto todos los elementos en a o en b parecen coincidir en
-- todos sus términos, formando dos nuevas secuencias; mientras más se
-- avanza en a o b se obtienen más elementos de las secuencias nuevas.