-- 1ª solución
-- ===========
data Estado = Abierta | Cerrada
deriving (Eq, Show)
cambia Abierta = Cerrada
cambia Cerrada = Abierta
-- (inicial n) es el estado inicial para el problema de las n
-- habitaciones. Por ejemplo,
-- inicial 5 == [Cerrada,Cerrada,Cerrada,Cerrada,Cerrada]
inicial :: Int -> [Estado]
inicial n = replicate n Cerrada
-- (pase k es) es la lista de los estados de las puertas después de pasar el
-- camarero k que las encuentra en los estados es. Por ejemplo,
-- ghci> pase 1 (inicial 5)
-- [Abierta,Abierta,Abierta,Abierta,Abierta]
-- ghci> pase 2 it
-- [Abierta,Cerrada,Abierta,Cerrada,Abierta]
-- ghci> pase 3 it
-- [Abierta,Cerrada,Cerrada,Cerrada,Abierta]
-- ghci> pase 4 it
-- [Abierta,Cerrada,Cerrada,Abierta,Abierta]
-- ghci> pase 5 it
-- [Abierta,Cerrada,Cerrada,Abierta,Cerrada]
pase :: [Estado] -> Int -> [Estado]
pase es k = zipWith cambiaK es[1..]
where cambiaK e n | n `mod` k == 0 = cambia e
| otherwise = e
final :: Int -> [Estado]
final n = aux [1..n] (inicial n)
where aux [] es = es
aux (k:ks) es = aux ks (pase es k)
-- 2ª solución (con foldl')
-- ========================
final2 :: Int -> [Estado]
final2 n = foldl pase (inicial n) [1..n]
-- 3ª definición (basada en los cambios de cada posición)
-- ======================================================
final3 :: Int -> [Estado]
final3 n = map f [1..n]
where f x | even (length (divisores x)) = Cerrada
| otherwise = Abierta
divisores :: Int -> [Int]
divisores n = [x| x <- [1..n], n `mod` x == 0]
-- 4ª definición (basada en posiciones de abiertas)
-- ================================================
-- En primer lugar, vamos a determinar la lista de las posiciones
-- (comenzando a contar en 1) de las puertas que quedan abierta en el
-- problema de las n puertas.
posicionesAbiertas :: Int -> [Int]
posicionesAbiertas n =
[x | (x,y) <- zip [1..] (final n), y == Abierta]
-- Al calcularlas,
-- ghci> posicionesAbiertas 200
-- [1,4,9,16,25,36,49,64,81,100,121,144,169,196]
-- Se observa las que quedan abiertas son las que sus posiciones son
-- cuadrados perfectos. Usando esta observación se construye la
-- siguiente definición
final4 :: Int -> [Estado]
final4 n = aux [1..n] [k*k | k <- [1..]]
where aux (x:xs) (y:ys) | x == y = Abierta : aux xs ys
aux (x:xs) ys = Cerrada : aux xs ys
aux [] _ = []