Problema de las puertas

PorJosé A. Alonso 13-mayo-201625-abril-2021

Un hotel dispone de n habitaciones y n camareros. Los camareros tienen la costumbre de cambiar de estado las puestas (es decir, abrir las cerradas y cerrar las abiertas). El proceso es el siguiente:

Inicialmente todas las puertas están cerradas.
El primer camarero cambia de estado las puertas de todas las habitaciones.
El segundo cambia de estado de las puertas de las habitaciones pares.
El tercero cambia de estado todas las puertas que son múltiplos de 3.
El cuarto cambia de estado todas las puertas que son múltiplos de 4
Así, hasta que ha pasado el último camarero.

Por ejemplo, para n = 5

   Pase    | Puerta 1 | Puerta 2 | Puerta 3 | Puerta 4 | Puerta 5
   --------+----------+----------+----------+----------+----------
   Inicial | Cerrada  | Cerrada  | Cerrada  | Cerrada  | Cerrada
   Pase 1  | Abierta  | Abierta  | Abierta  | Abierta  | Abierta
   Pase 2  | Abierta  | Cerrada  | Abierta  | Cerrada  | Abierta
   Pase 3  | Abierta  | Cerrada  | Cerrada  | Cerrada  | Abierta
   Pase 4  | Abierta  | Cerrada  | Cerrada  | Abierta  | Abierta
   Pase 5  | Abierta  | Cerrada  | Cerrada  | Abierta  | Cerrada

--------+----------+----------+----------+----------+----------

Los estados de las puertas se representan por el siguiente tipo de datos

   data Estado = Abierta | Cerrada 
                 deriving (Eq, Show)

1 2	data Estado = Abierta \| Cerrada deriving (Eq, Show)

Definir la función

   final :: Int -> [Estado]

1	final :: Int -> [Estado]

tal que (final n) es la lista de los estados de las n puertas después
de que hayan pasado los n camareros. Por
ejemplo,

   ghci> final 5
   [Abierta,Cerrada,Cerrada,Abierta,Cerrada]
   ghci> final 7
   [Abierta,Cerrada,Cerrada,Abierta,Cerrada,Cerrada,Cerrada]

ghci> final 5

[Abierta,Cerrada,Cerrada,Abierta,Cerrada]

ghci> final 7

[Abierta,Cerrada,Cerrada,Abierta,Cerrada,Cerrada,Cerrada]

Soluciones

-- 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 []     _                =  []

-- 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 [] _ = []

11 Comentarios

data Estado = Abierta | Cerrada 
  deriving (Eq, Show)

final :: Int -> [Estado]
final 0 = [Cerrada]
final n = Abierta: checkEstado 2 n
  where checkEstado :: Int -> Int -> [Estado]
        checkEstado m n 
            | m > n     = []
            | otherwise = paridad l : checkEstado (m+1) n
          where xs = filter (\x -> m `mod` x == 0) [2..n]
                l  = length xs
        paridad :: Int -> Estado
        paridad l | even l    = Abierta
                  | otherwise = Cerrada

data Estado = Abierta | Cerrada

deriving (Eq, Show)

final :: Int -> [Estado]

final 0 = [Cerrada]

final n = Abierta: checkEstado 2 n

where checkEstado :: Int -> Int -> [Estado]

checkEstado m n

| m > n = []

| otherwise = paridad l : checkEstado (m+1) n

where xs = filter (\x -> m `mod` x == 0) [2..n]

l = length xs

paridad :: Int -> Estado

paridad l | even l = Abierta

| otherwise = Cerrada

Responder

Mejora de la eficiencia en el conteo de los numeros que dividen a uno dado

import Data.Numbers.Primes
import Data.List

data Estado = Abierta | Cerrada 
  deriving (Eq, Show)
 
final :: Int -> [Estado]
final 0 = [Cerrada]
final n = Abierta: checkEstado 2 n
  where checkEstado :: Int -> Int -> [Estado]
        checkEstado m n 
            | m > n     = []
            | otherwise = paridad l : checkEstado (m+1) n
          where l = product [length xs + 1 |
                             xs <- group $ primeFactors m]
        paridad :: Int -> Estado
        paridad l | even l    = Cerrada
                  | otherwise = Abierta

import Data.Numbers.Primes

import Data.List

data Estado = Abierta | Cerrada

deriving (Eq, Show)

final :: Int -> [Estado]

final 0 = [Cerrada]

final n = Abierta: checkEstado 2 n

where checkEstado :: Int -> Int -> [Estado]

checkEstado m n

| m > n = []

| otherwise = paridad l : checkEstado (m+1) n

where l = product [length xs + 1 |

xs <- group $ primeFactors m]

paridad :: Int -> Estado

paridad l | even l = Cerrada

| otherwise = Abierta

Responder

final :: Int -> [Estado]
final n = aux 1 (replicate n Cerrada)
          where aux y xs | y  == n+1 = xs
                         | otherwise = aux (y+1) 
                                       [if mod h y == 0 then cambia x
                                        else x | (x,h) <- zip xs [1..]]

cambia :: Estado -> Estado
cambia Cerrada = Abierta
cambia Abierta = Cerrada

final :: Int -> [Estado]

final n = aux 1 (replicate n Cerrada)

where aux y xs | y == n+1 = xs

| otherwise = aux (y+1)

[if mod h y == 0 then cambia x

else x | (x,h) <- zip xs [1..]]

cambia :: Estado -> Estado

cambia Cerrada = Abierta

cambia Abierta = Cerrada

Responder

data Estado = Abierta | Cerrada 
                 deriving (Eq, Show)


final :: Int -> [Estado]
final n = [if x == 1 then Abierta else Cerrada | x <- take n (iteraCambia n)]


iteraCambia 1 = repeat 1
iteraCambia n = cambia n [1..] (iteraCambia (n-1))

cambia n [] _    = []
cambia n _ []    = []
cambia n (x:xs) (y:ys) | x `rem` n == 0 = (if y == 1 then 0 else 1) : cambia n xs ys
                       | otherwise      = y : cambia n xs ys

data Estado = Abierta | Cerrada

deriving (Eq, Show)

final :: Int -> [Estado]

final n = [if x == 1 then Abierta else Cerrada | x <- take n (iteraCambia n)]

iteraCambia 1 = repeat 1

iteraCambia n = cambia n [1..] (iteraCambia (n-1))

cambia n [] _ = []

cambia n _ [] = []

cambia n (x:xs) (y:ys) | x `rem` n == 0 = (if y == 1 then 0 else 1) : cambia n xs ys

| otherwise = y : cambia n xs ys

Responder

data Estado = Abierta | Cerrada 
                 deriving (Eq, Show)

final :: Int -> [Estado]
final n = map snd (aux n)
    where aux 0 = zip [1..] (replicate n Cerrada)
          aux m = map (f m) (aux (m-1))
          f m (k,x) | rem k m /= 0 = (k,x)
                    | x == Abierta = (k,Cerrada)
                    | otherwise = (k,Abierta)

data Estado = Abierta | Cerrada

deriving (Eq, Show)

final :: Int -> [Estado]

final n = map snd (aux n)

where aux 0 = zip [1..] (replicate n Cerrada)

aux m = map (f m) (aux (m-1))

f m (k,x) | rem k m /= 0 = (k,x)

| x == Abierta = (k,Cerrada)

| otherwise = (k,Abierta)

Responder

data Estado = Abierta | Cerrada 
                 deriving (Eq, Show)

final :: Int -> [Estado]
final 0 = [Cerrada]
final 1 = [Abierta]
final n = final (n-1) ++ [aux n]
        where aux n | even (length [x | x <- [1..n], rem n x == 0]) = Cerrada
                    | otherwise = Abierta

data Estado = Abierta | Cerrada

deriving (Eq, Show)

final :: Int -> [Estado]

final 0 = [Cerrada]

final 1 = [Abierta]

final n = final (n-1) ++ [aux n]

where aux n | even (length [x | x <- [1..n], rem n x == 0]) = Cerrada

| otherwise = Abierta

Responder

Creo que revisando los primos podría reducirse a O(n^2 log(log(n)) / log(n)) aunque no parece merecer la pena el esfuerzo xD. La función solicitada y los infinitos finales para n=1,2,3,…

import Control.Monad
import Data.Array.ST
import Data.Array.Base (elems)

data Estado = Abierta | Cerrada deriving (Eq, Show, Enum)



-- Directo sumando en un array
final :: Int → [Estado]
final n = map (toEnum ∘ (`mod` 2)) $ elems $ runSTUArray $ do
  a ← newArray (1, n) 0
  ↰_[2 … n] $ λi → ↰_[i, i+i … n] $ λj → readArray a j ↪ writeArray a j ∘ (1+)
  η a



-- Infinitas puertas incrementando el sumador 1, 01, 001, 0001, 00001, ...
infinitas :: [[Estado]]
infinitas = [Abierta]: i 2 [1] [0,0…]
  where i n zs ss = let zs' = 0: zs
                        ss' = zipWith (+) ss (cycle zs')
                    in  take n (map (toEnum ∘ (`mod` 2)) ss'): i (n + 1) zs' ss'

{-

> mapM_ (print . final) [1..7]
[Abierta]
[Abierta,Cerrada]
[Abierta,Cerrada,Cerrada]
[Abierta,Cerrada,Cerrada,Abierta]
[Abierta,Cerrada,Cerrada,Abierta,Cerrada]
[Abierta,Cerrada,Cerrada,Abierta,Cerrada,Cerrada]
[Abierta,Cerrada,Cerrada,Abierta,Cerrada,Cerrada,Cerrada]

> mapM_ print $ take 7 infinitas
[Abierta]
[Abierta,Cerrada]
[Abierta,Cerrada,Cerrada]
[Abierta,Cerrada,Cerrada,Abierta]
[Abierta,Cerrada,Cerrada,Abierta,Cerrada]
[Abierta,Cerrada,Cerrada,Abierta,Cerrada,Cerrada]
[Abierta,Cerrada,Cerrada,Abierta,Cerrada,Cerrada,Cerrada]
>

-}

import Control.Monad

import Data.Array.ST

import Data.Array.Base (elems)

data Estado = Abierta | Cerrada deriving (Eq, Show, Enum)

-- Directo sumando en un array

final :: Int → [Estado]

final n = map (toEnum ∘ (`mod` 2)) $ elems $ runSTUArray $ do

a ← newArray (1, n) 0

↰_[2 … n] $ λi → ↰_[i, i+i … n] $ λj → readArray a j ↪ writeArray a j ∘ (1+)

η a

-- Infinitas puertas incrementando el sumador 1, 01, 001, 0001, 00001, ...

infinitas :: [[Estado]]

infinitas = [Abierta]: i 2 [1] [0,0…]

where i n zs ss = let zs' = 0: zs

ss' = zipWith (+) ss (cycle zs')

in take n (map (toEnum ∘ (`mod` 2)) ss'): i (n + 1) zs' ss'

> mapM_ (print . final) [1..7]

[Abierta]

[Abierta,Cerrada]

[Abierta,Cerrada,Cerrada]

[Abierta,Cerrada,Cerrada,Abierta]

[Abierta,Cerrada,Cerrada,Abierta,Cerrada]

[Abierta,Cerrada,Cerrada,Abierta,Cerrada,Cerrada]

[Abierta,Cerrada,Cerrada,Abierta,Cerrada,Cerrada,Cerrada]

> mapM_ print $ take 7 infinitas

[Abierta]

[Abierta,Cerrada]

[Abierta,Cerrada,Cerrada]

[Abierta,Cerrada,Cerrada,Abierta]

[Abierta,Cerrada,Cerrada,Abierta,Cerrada]

[Abierta,Cerrada,Cerrada,Abierta,Cerrada,Cerrada]

[Abierta,Cerrada,Cerrada,Abierta,Cerrada,Cerrada,Cerrada]

Responder

Pues sorprendentemente (para mi) se pueden calcular todos los números de divisores de cada número entre 1 y n en tan sólo O(n log^3 n), por tanto, igual para las puertas:

-- Calcula el número de divisores de cada número entre 1 y n
-- Coste O(n log^3 n)
-- Fuente: Algorithmic Number Theory: Efficient algorithms, Vol 1 Pág 298
divisores :: Int → [Int]
divisores n = elems $ runSTUArray $ do
  a ← newArray (1, n) 0
  ↰_[1…floor (√(fromIntegral n))] $ λj → do
    readArray a (j²) ↪ writeArray a (j²) ∘ (1+)
    ↰_[j+1 … n ÷ j] $ λk → 
      readArray a (j × k) ↪ writeArray a (j × k) ∘ (2+)
  η a 

final :: Int → [Estado]
final = map (toEnum ∘ (`mod` 2) ∘ (1+)) ∘ divisores

-- Calcula el número de divisores de cada número entre 1 y n

-- Coste O(n log^3 n)

-- Fuente: Algorithmic Number Theory: Efficient algorithms, Vol 1 Pág 298

divisores :: Int → [Int]

divisores n = elems $ runSTUArray $ do

a ← newArray (1, n) 0

↰_[1…floor (√(fromIntegral n))] $ λj → do

readArray a (j²) ↪ writeArray a (j²) ∘ (1+)

↰_[j+1 … n ÷ j] $ λk →

readArray a (j × k) ↪ writeArray a (j × k) ∘ (2+)

η a

final :: Int → [Estado]

final = map (toEnum ∘ (`mod` 2) ∘ (1+)) ∘ divisores

Responder

data Estado = Abierta | Cerrada 
              deriving (Eq, Show)

final :: Int -> [Estado]
final n = map (estFinal n) [1..n]

estFinal :: Int    -- ^ El número de camareros
         -> Int    -- ^ El número de la habitación
         -> Estado -- ^ El estado final de la habitación
estFinal n hab = cambiar (length $ filter (\x -> hab `mod` x == 0) [2..hab]) Abierta

cambiar 0 e = e
cambiar n Abierta = cambiar (n-1) Cerrada
cambiar n Cerrada = cambiar (n-1) Abierta

data Estado = Abierta | Cerrada

deriving (Eq, Show)

final :: Int -> [Estado]

final n = map (estFinal n) [1..n]

estFinal :: Int -- ^ El número de camareros

-> Int -- ^ El número de la habitación

-> Estado -- ^ El estado final de la habitación

estFinal n hab = cambiar (length $ filter (\x -> hab `mod` x == 0) [2..hab]) Abierta

cambiar 0 e = e

cambiar n Abierta = cambiar (n-1) Cerrada

cambiar n Cerrada = cambiar (n-1) Abierta

Responder

data Estado = Abierta | Cerrada
              deriving (Eq, Show)

final :: Int -> [Estado]
final n = final' n n

final' :: Int -> Int -> [Estado]
final' x 1 = replicate x Abierta
final' x y = camarero  x y (final' x (y-1))
             
                  
camarero :: Int -> Int -> [Estado] -> [Estado]
camarero x y xs = map f (zip xs [1..])
    where f :: (Estado,Int) -> Estado
          f (e, n) | n `notElem` [y*w | w <- [1..x]] = e
          f (Cerrada, n) = Abierta
          f (Abierta, n) = Cerrada

data Estado = Abierta | Cerrada

deriving (Eq, Show)

final :: Int -> [Estado]

final n = final' n n

final' :: Int -> Int -> [Estado]

final' x 1 = replicate x Abierta

final' x y = camarero x y (final' x (y-1))

camarero :: Int -> Int -> [Estado] -> [Estado]

camarero x y xs = map f (zip xs [1..])

where f :: (Estado,Int) -> Estado

f (e, n) | n `notElem` [y*w | w <- [1..x]] = e

f (Cerrada, n) = Abierta

f (Abierta, n) = Cerrada

Responder

import Data.List

data Estado = Abierta | Cerrada
              deriving (Eq, Show)

final :: Int -> [Estado]
final = map estadoFinal . cambios

-- Calcula cuantos cambios sufre cada una de la n puertas
cambios :: Int -> [Int]
cambios n = map length . group . sort
          $ concatMap pase [1..n]
    where pase p = [p,2*p..n] -- puertas que cambian en un pase

-- Deduce el estado final de la puerta según el número de cambios
estadoFinal :: Int -> Estado
estadoFinal n | odd n     = Abierta
              | otherwise = Cerrada

import Data.List

data Estado = Abierta | Cerrada

deriving (Eq, Show)

final :: Int -> [Estado]

final = map estadoFinal . cambios

-- Calcula cuantos cambios sufre cada una de la n puertas

cambios :: Int -> [Int]

cambios n = map length . group . sort

$ concatMap pase [1..n]

where pase p = [p,2*p..n] -- puertas que cambian en un pase

-- Deduce el estado final de la puerta según el número de cambios

estadoFinal :: Int -> Estado

estadoFinal n | odd n = Abierta

| otherwise = Cerrada

Responder

Problema de las puertas

Soluciones

11 Comentarios

Escribe tu soluciónCancel reply

Entradas recientes

Buscar

Correo electrónico

Soluciones

Se puede imprimir o compartir con

11 Comentarios

Escribe tu soluciónCancel reply

Entradas recientes

Buscar

Correo electrónico