Ir al contenido principal

Problema de las bolas de Dijkstra

En el juego de las bolas de Dijkstra se dispone de una bolsa con bolas blancas y negras. El juego consiste en elegir al azar dos bolas de la bolsa y añadir una bola negra si las dos bolas elegidas son del mismo color o una bola blanca en caso contrario. El juego termina cuando queda sólo una bola en la bolsa.

Vamos a representar las bolas blancas por 0, las negras por 1 y la bolsa la representaremos por una lista cuyos elementos son 0 ó 1.

Definir las funciones

juego  :: [Int] -> [[Int]]
ultima :: [Int] -> Int

tales que

  • (juego xs) es la lista de los pasos aleatorios de un juego de Dijkstra a partir de la lista xs. Por ejemplo,
juego [1,1,0,0,1]  ==  [[1,1,0,0,1],[1,1,0,0],[1,1,1],[1,1],[1]]
juego [1,1,0,0,1]  ==  [[1,1,0,0,1],[0,1,1,0],[0,0,1],[1,1],[1]]
juego [1,0,0,0,1]  ==  [[1,0,0,0,1],[0,0,0,1],[0,1,1],[1,0],[0]]
juego [1,0,1,1,1]  ==  [[1,0,1,1,1],[1,1,0,1],[1,0,1],[0,1],[0]]
  • (ultima xs) es la bola que queda en la bolsa al final del juego de Dijkstra a partir de xs. Por ejemplo,
ultima [1,1,0,0,1]  ==  1
ultima [1,0,0,0,1]  ==  0
ultima [1,0,1,1,1]  ==  0

Comprobar con QuickCheck que la bola que queda en la bolsa al final del juego de Dijkstra es blanca si, y sólo si, el número de bolas blancas en la bolsa inicial es impar.

Soluciones

import System.IO.Unsafe
import System.Random
import Test.QuickCheck

-- (aleatorio a b) es un número aleatorio entre a y b. Por ejemplo,
--    λ> aleatorio 0 1000
--    681
--    λ> aleatorio 0 1000
--    66
aleatorio :: Random t => t -> t -> t
aleatorio a b = unsafePerformIO $
                getStdRandom (randomR (a,b))

-- (aleatorios m n) es una lista infinita de números aleatorios entre m y
-- n. Por ejemplo,
--    λ> take 20 (aleatorios 2 9)
--    [6,5,3,9,6,3,6,6,2,7,9,6,8,6,2,4,2,6,9,4]
--    λ> take 20 (aleatorios 2 9)
--    [3,7,7,5,7,7,5,8,6,4,7,2,8,8,2,8,7,6,5,5]
aleatorios :: Random t => t -> t -> [t]
aleatorios m n = aleatorio m n : aleatorios m n

-- (selecciona n x) es el par formado por el n-ésimo elemento de xs y
-- los restantes elementos. Por ejemplo,
--    selecciona 0 "abc"  ==  ('a',"bc")
--    selecciona 1 "abc"  ==  ('b',"ac")
--    selecciona 2 "abc"  ==  ('c',"ab")
selecciona :: Int -> [a] -> (a,[a])
selecciona n xs = (z,ys++zs)
    where (ys,z:zs) = splitAt n xs

-- (extraeAleatorio xs) es el par formado aleatoriamente por un elemento
-- de xs y las restantes. Por ejemplo,
--    extraeAleatorio [1,0,0,1,1]  ==  (0,[1,0,1,1])
--    extraeAleatorio [1,0,0,1,1]  ==  (1,[0,0,1,1])
--    extraeAleatorio [1,0,0,1,1]  ==  (0,[1,0,1,1])
--    extraeAleatorio [1,0,0,1,1]  ==  (1,[1,0,0,1])
extraeAleatorio :: [a] -> (a,[a])
extraeAleatorio xs = selecciona n xs
    where n = aleatorio 0 (length xs - 1)

-- (inserta n x xs) inserta, en la posición n, el elemento x en la lista
-- xs. Por ejemplo,
--    inserta 0 'a' "bcd"  ==  "abcd"
--    inserta 1 'a' "bcd"  ==  "bacd"
--    inserta 2 'a' "bcd"  ==  "bcad"
--    inserta 3 'a' "bcd"  ==  "bcda"
inserta :: Int -> a -> [a] -> [a]
inserta n x xs = us ++ (x:vs)
    where (us,vs) = splitAt n xs

-- (insertaAleatorio x xs) inserta aleatoriamente el elemento x en la
-- lista xs. Por ejemplo,
--    insertaAleatorio 9 [0..8]  ==  [0,1,2,3,4,9,5,6,7,8]
--    insertaAleatorio 9 [0..8]  ==  [0,1,9,2,3,4,5,6,7,8]
--    insertaAleatorio 9 [0..8]  ==  [0,1,2,3,4,5,6,9,7,8]
insertaAleatorio :: a -> [a] -> [a]
insertaAleatorio x xs = inserta n x xs
    where n = aleatorio 0 (length xs - 1)

-- (paso xs) elige aleatoriamente dos bolas de xs e inserta
-- aleatoriamente una bola negra si las dos extraídas son del mismo
-- color o una blanca, en caso contrario. Por ejemplo,
--    paso [1,0,1,1,0,0,1,1,1,0,0,0]  ==  [0,1,1,0,0,1,1,0,1,0,0]
--    paso [1,0,1,1,0,0,1,1,1,0,0,0]  ==  [1,0,0,0,1,1,1,0,0,1,0]
paso :: [Int] -> [Int]
paso [x] = []
paso xs | x == y    = insertaAleatorio 1 zs
        | otherwise = insertaAleatorio 0 zs
    where (x,ys) = extraeAleatorio xs
          (y,zs) = extraeAleatorio ys

-- (juego xs) es la lista de los pasos aleatorios de un juego a partir
-- de la lista xs. Por ejemplo,
--    juego [1,1,0,0,1]  ==  [[1,1,0,0,1],[1,1,0,0],[1,1,1],[1,1],[1]]
--    juego [1,1,0,0,1]  ==  [[1,1,0,0,1],[0,1,1,0],[0,0,1],[1,1],[1]]
--    juego [1,1,0,0,0]  ==  [[1,1,0,0,0],[0,1,0,0],[1,1,0],[0,1],[0]]
juego :: [Int] -> [[Int]]
juego xs = takeWhile (not . null) (iterate paso xs)

-- (ultima xs) es la bola que queda en la bolsa al final del juego de
-- Dijkstra. Por ejemplo,
--    ultima [1,0,0,1]  ==  1
ultima :: [Int] -> Int
ultima = head . last . juego

-- (numeroDeCeros xs) es el número de ceros en xs. Por ejemplo,
--    numeroDeCeros [1,0,0,1,0]  ==  3
numeroDeCeros :: [Int] -> Int
numeroDeCeros xs = length (filter (==0) xs)

-- Propiedad. La bola que queda en la bolsa al final del juego de
-- Dijkstra es blanca si, y sólo si, el número de bolas blancas en la
-- bolsa inicial es impar.
prop_Dijkstra :: [Int] -> Property
prop_Dijkstra xs =
    not (null xs) ==> (ultima ys == 0) == odd (numeroDeCeros ys)
    where ys = [x `mod` 2 | x <- xs]

-- La comprobación es
--    λ> quickCheck prop_Dijkstra
--    +++ OK, passed 100 tests.