gistfile1.hs

-- CollatzBool.hs

module CollatzBool where                                                     
                                                                                                                                                      
porTresMasUno :: [Bool] -> [Bool]                                            
porTresMasUno xs = False : ys ++ residuo where                               
    cs = True : zipWith3 gc cs (tail xs) xs                                  
    gc b = if b then (||) else (&&)                                          
    ys = zipWith3 gy cs (tail xs ++ [False]) xs                              
    gy p q r = (p /= q) /= r                                                 
    residuo = if last cs then [True] else []                                 
                                                                             
serie :: String -> [[Bool]]                                                  
serie s = takeWhile (not.alto) $ iterate paso $ leer s where                 
    leer = map (\k -> if k == '0' then False else True)                      
    paso xs = ceros ++ siguiente where                                       
        (ceros,actual) = break id xs                                         
        siguiente = porTresMasUno actual                                     
    alto xs = (length $ filter id xs) == 1

-- otro

import CollatzBool(serie)                                                       
import Codec.BMP(writeBMP, packRGBA32ToBMP)                                     
import Data.ByteString(pack)                                                                                         
                                                                                
-- dibuja de abajo hacia arriba                                                 
dibujar :: [[Bool]] -> IO ()                                                    
dibujar xss = writeBMP "collatz.bmp" bmp where                                  
    w = maximum $ map length xss                                                
    h = length xss                                                              
    aRGBA b = if b then [0,0,0,0] else [255,255,255,0]                          
    raw = map (\k -> let (ceros,bits) = break id k in                                                                                           
            map (const [191,191,191,0]) ceros ++ map aRGBA bits) xss            
    extiende n xs = xs ++ replicate (n - (length xs)) [191,191,191,0]           
    rectangular = map (extiende w) raw                                          
    final = pack $ concat $ map concat $ rectangular                            
    bmp = packRGBA32ToBMP w h final