gistfile1.hs

module Main where
 
import Control.Monad.State
import Control.Monad

-- funciones base del generador de programas al azar
 
import System.Random
import System.Random.Shuffle

import Data.Ratio

import FuncionesGAP
 
-- by danzat
-- http://projecteuler.net/index.php?section=forum&id=24&page=5 
 
length'::[a]->Integer
length' [] = 0
length' (_:xs) = 1 + length'(xs)
 
factorial::Integer->Integer
factorial 0 = 1
factorial n = n * factorial (n-1)
 
lexico :: [a] -> Integer -> [a]
lexico [] _ = []
lexico x n = (index x i) : lexico (remove x i) m
    where
        l = (length' x)
        i = div n (factorial (l-1))
        m = mod n (factorial (l-1))
        index::[a]->Integer->a
        index (x:_) 0 = x
        index (_:xs) n = index xs (n-1)
        remove::[a]->Integer->[a]
        remove (_:xs) 0 = xs
        remove (x:xs) n = x : remove xs (n-1)

-- fin

enteros :: IO [Integer]
enteros =  newStdGen >>= return . randoms
 
dado :: Integer -> IO [Integer]
dado n = enteros >>= return . (map (flip mod n))
 
espacio :: Integer -> IO [Integer]
espacio n = enteros >>= return . map (flip mod (2^n))
 
decToBin x = decToBin' x
  where
    decToBin' 0 = []
    decToBin' y = let (a,b) = quotRem y 2 in [b] ++ decToBin' a
 
permutables :: Integer -> IO [[Integer]]
permutables n = do
    e <- espacio n
    return $ map (\k -> fst . unzip $ filter snd $ zip [0..] (map (==1) $ decToBin k)) e
 
mezclador :: Integer -> [Integer] -> [Integer]
mezclador x xs = lexico xs (mod x (factorial $ length' xs))
 
permutaciones :: IO [String]
permutaciones = do
    e <- enteros
    p <- permutables 12
    return $ showparentesis $ zipWith mezclador e p

showparentesis :: [[Integer]] -> [String]
showparentesis xs = map (parentesis.show) xs where
    parentesis [] = []
    parentesis ('[':str) = '(':(parentesis str)
    parentesis (']':str) = ')':(parentesis str)
    parentesis (x:str) = x:(parentesis str)

extrae_argumentos :: [String] -> Dato -> IO String
extrae_argumentos obj OBJETO = do
    escoger:_ <- dado 20
    numidentificador:_ <- dado $ fromIntegral $ length obj
    let identificador = obj !! (fromInteger numidentificador)
    salida:_ <- (if escoger < 6 || null obj then permutaciones else return [identificador])
    return salida

extrae_argumentos obj LISTA = do
    escoger:_ <- dado 20
    k:_ <- dado 3
    salida <- intercala obj
    mezclado <- remix $ take (fromInteger $ (k + 1)) salida
    return $ "[" ++ reconcat mezclado ++ "]"

reconcat :: [String] -> String
reconcat [] = []
reconcat (x:[]) = x
reconcat (x:xs) = x ++ ", " ++ reconcat xs

remix :: [String] -> IO [String]
remix  = mapM remixer where
    remixer :: String -> IO String
    remixer x = do
        escoger:_ <- dado 20
        permtemp:_ <- permutaciones
        if (escoger < 18) then return x else return permtemp 
    
intercala :: [String] -> IO [String]
intercala objs = do
    tempperm:_ <- permutaciones
    generador <- newStdGen
    return $ if null objs then [tempperm] else  shuffle' objs (length objs) generador

empaca :: [String] -> String
empaca xs = subempaca xs where
    subempaca :: [String] -> String
    subempaca = foldr (\ j k -> if null k then j else j ++ ", " ++ k) [] 

paso :: Estado -> IO Estado
paso e = do
    finalizar:_ <- dado 20
    con_nombre:_ <- dado 20
    seleccionado:_ <- dado (fromIntegral $ length funciones)
    let identificador = "obj" ++ (show $ indice e)
    argumentos <- mapM (extrae_argumentos (objetos e)) (argumentos $ funciones !! fromInteger seleccionado)
    if con_nombre < 12 
        then putStrLn $ identificador ++ " := " ++ (nombre $ funciones !! (fromInteger seleccionado)) ++ "(" ++ empaca argumentos ++ ")"
        else putStrLn $ (nombre $ funciones !! (fromInteger seleccionado)) ++ "(" ++ empaca argumentos ++ ");"
    if (indice e) > (finalizar + 15) 
        then 
            return $ E (indice e + 1) (if con_nombre < 12 then identificador:(objetos e) else (objetos e))
        else
            paso $ E (indice e + 1) (if con_nombre < 12 then identificador:(objetos e) else (objetos e))
        

main :: IO ()
main = do
    paso $ E 0 [] 
    return ()