Menu Close

Categoría: Avanzado

Representaciones de un número como potencia

El número 512 se puede escribir de tres maneras como potencias:

   512 = 2⁹ = 8³ = 512¹

Definir las funciones

   potencias       :: Integer -> [(Integer,Integer)]
   numeroPotencias :: Integer -> Int

tales que

  • (potencias x) es la lista de las representaciones de x como potencias de números enteros positivos. Por ejemplo,
     potencias 7      ==  [(7,1)]
     potencias 8      ==  [(2,3),(8,1)]
     potencias 512    ==  [(2,9),(8,3),(512,1)]
     potencias 16384  ==  [(2,14),(4,7),(128,2),(16384,1)]
     potencias 65536  ==  [(2,16),(4,8),(16,4),(256,2),(65536,1)]
  • (numeroPotencias x) de las representaciones de x como potencias de números enteros positivos. Por ejemplo,
     numeroPotencias 7          ==  1
     numeroPotencias 8          ==  2
     numeroPotencias 512        ==  3
     numeroPotencias 16384      ==  4
     numeroPotencias 65536      ==  5
     numeroPotencias (2^(10^5)) ==  36

Soluciones

import Data.List (group,genericLength)
import Data.Numbers.Primes (primeFactors)
 
potencias :: Integer -> [(Integer,Integer)]
potencias x = [(a^d,b `div` d) | d <- divisores b]
  where ps = factorizacionPrima x
        b   = mcd (map snd ps)
        a   = product [c^(e `div` b) | (c,e) <- ps]
 
-- (divisores x) es la lista de los divisores de x. Por ejemplo,
--    divisores 120  ==  [1,2,3,4,5,6,8,10,12,15,20,24,30,40,60,120]
divisores :: Integer -> [Integer]
divisores x =
  [y | y <- [1..x], x `mod` y == 0]
 
-- (factorizacionPrima x) es la factorización prima de x. Por ejemplo,
--    factorizacionPrima 1200  ==  [(2,4),(3,1),(5,2)]
factorizacionPrima :: Integer -> [(Integer,Integer)]
factorizacionPrima x =
  [(head xs, genericLength xs) | xs <- group (primeFactors x)]
 
-- (mcd xs) es el máximo común divisor de xs. Por ejemplo,
--    mcd [12,30,42]  ==  6
mcd :: Integral a => [a] -> a
mcd xs = foldr1 gcd xs
 
-- 1ª definición de numeroPotencias
-- ================================
 
--    numeroPotencias 7          ==  1
--    numeroPotencias 8          ==  2
--    numeroPotencias 512        ==  3
--    numeroPotencias 16384      ==  4
--    numeroPotencias 65536      ==  5
--    numeroPotencias (2^(10^5)) ==  36
numeroPotencias :: Integer -> Int
numeroPotencias = length . potencias
 
-- 2ª definición de numeroPotencias
-- ================================
 
numeroPotencias2 :: Integer -> Int
numeroPotencias2 n =
  numeroDivisores (mcd (map length (group (primeFactors n))))
 
-- (numeroDivisores n) es el número de divisores de n. Por ejemplo,
--    numeroDivisores 12  ==  6
--    numeroDivisores 14  ==  4
numeroDivisores :: Int -> Int
numeroDivisores =
  product . map ((+1) . length) . group . primeFactors
 
-- Comparación de eficiencia de numeroPotencias
-- ============================================
 
-- La comparación es
--    λ> numeroPotencias (2^(10^5))
--    36
--    (0.40 secs, 707,287,312 bytes)
--    λ> numeroPotencias2 (2^(10^5))
--    36
--    (0.35 secs, 675,954,872 bytes)

Nuevas soluciones

  • En los comentarios se pueden escribir nuevas soluciones.
  • El código se debe escribir entre una línea con <pre lang="haskell"> y otra con </pre>

Espirales

Definir la función

   espiral :: Int -> [[Int]]

tal que (espiral n) es la espiral de orden n (es decir, con n filas y n columnas). Por ejemplo,

   λ> mapM_ print (espiral 5)
   [1,1,1,1,1]
   [0,0,0,0,1]
   [1,1,1,0,1]
   [1,0,0,0,1]
   [1,1,1,1,1]
   λ> mapM_ print (espiral 6)
   [1,1,1,1,1,1]
   [0,0,0,0,0,1]
   [1,1,1,1,0,1]
   [1,0,0,1,0,1]
   [1,0,0,0,0,1]
   [1,1,1,1,1,1]
   λ> mapM_ print (espiral 7)
   [1,1,1,1,1,1,1]
   [0,0,0,0,0,0,1]
   [1,1,1,1,1,0,1]
   [1,0,0,0,1,0,1]
   [1,0,1,1,1,0,1]
   [1,0,0,0,0,0,1]
   [1,1,1,1,1,1,1]
   λ> mapM_ print (espiral 8)
   [1,1,1,1,1,1,1,1]
   [0,0,0,0,0,0,0,1]
   [1,1,1,1,1,1,0,1]
   [1,0,0,0,0,1,0,1]
   [1,0,1,0,0,1,0,1]
   [1,0,1,1,1,1,0,1]
   [1,0,0,0,0,0,0,1]
   [1,1,1,1,1,1,1,1]

Nota: La serpiente (formada por los 1) nunca se puede tocar a ella misma.

Soluciones

import Data.List (transpose)
 
espiral :: Int -> [[Int]]
espiral n = espiralAux n n
 
espiralAux :: Int -> Int -> [[Int]]
espiralAux 0 _ = []
espiralAux 1 1 = [[1]]
espiralAux n m = primeraFila n : segundaFila n : filasDesdeTercera n m
 
-- (primeraFila n) es la primera fila de la espiral de orden n. Por
-- ejemplo,
--    λ> primeraFila 5
--    [1,1,1,1,1]
primeraFila :: Int -> [Int]
primeraFila n = replicate n 1
 
-- (segundaFila n) es la segunda de la espiral de orden n. Por
-- ejemplo,
--    λ> segundaFila 5
--    [0,0,0,0,1]
segundaFila :: Int -> [Int]
segundaFila n = replicate (n-1) 0 ++ [1]
 
-- (filasDesdeTercera n m), cuando n = m, es la lista de las filas de la
-- espiral de orden n a partir de la tercera. Por ejemplo,
--    λ> mapM_ print (filasDesdeTercera 5 5)
--    [1,1,1,0,1]
--    [1,0,0,0,1]
--    [1,1,1,1,1]
filasDesdeTercera :: Int -> Int -> [[Int]]
filasDesdeTercera n m = map reverse (transpose (espiralAux (m-2) n))

Nuevas soluciones

  • En los comentarios se pueden escribir nuevas soluciones.
  • El código se debe escribir entre una línea con <pre lang="haskell"> y otra con </pre>

Mayor número borrando k dígitos

Definir la función

   mayorBorrando :: Int -> Integer -> Integer

tal que (mayorBorrando k n) es el mayor número obtenido borrando k dígitos de n (se supone que n tiene más de k dígitos). Por ejemplo,

   mayorBorrando 1 6782334  ==  782334
   mayorBorrando 3 6782334  ==  8334
   mayorBorrando 3 10020    ==  20
   mayorBorrando 1000000 (4256 + 10^1000004) == 14256

Soluciones

import Data.List (subsequences)
 
-- 1ª definición
-- =============
 
mayorBorrando :: Int -> Integer -> Integer
mayorBorrando k n = read (mayorBorrandoLista1 k (show n))
 
-- (mayorBorrandoLista1 k xs) es la mayor lista obtenida borrando k elementos de
-- xs (se supone que xs tiene más de k elementos). Por ejemplo,
--    mayorBorrandoLista1 1 "6782334"  ==  "782334"
--    mayorBorrandoLista1 3 "6782334"  ==  "8334"
mayorBorrandoLista1 :: Ord a => Int -> [a] -> [a]
mayorBorrandoLista1 k xs = maximum (borra1 k xs)
 
-- (borra1 k xs) es la lista de las listas obtenidas borrando k elementos
-- de xs. Por ejemplo,
--    borra1 1 "abcd"  ==  ["abc","abd","acd","bcd"]
--    borra1 2 "abcd"  ==  ["ab","ac","bc","ad","bd","cd"]
--    borra1 3 "abcd"  ==  ["a","b","c","d"]
borra1 n xs = [ys | ys <- subsequences xs, length ys == k]
  where k = length xs - n
 
-- 2ª definición
-- =============
 
mayorBorrando2 :: Int -> Integer -> Integer
mayorBorrando2 k n = read (mayorBorrandoLista2 k (show n))
 
-- (mayorBorrandoLista2 k xs) es la mayor lista obtenida borrando k elementos de
-- xs (se supone que xs tiene más de k elementos). Por ejemplo,
--    mayorBorrandoLista2 1 "6782334"  ==  "782334"
--    mayorBorrandoLista2 3 "6782334"  ==  "8334"
mayorBorrandoLista2 :: Ord a => Int -> [a] -> [a]
mayorBorrandoLista2 k xs = maximum (borra2 k xs)
 
-- (borra2 k xs) es la lista de las listas obtenidas borrando k elementos
-- de xs. Por ejemplo,
--    borra2 1 "abcd"  ==  ["abc","abd","acd","bcd"]
--    borra2 2 "abcd"  ==  ["ab","ac","ad","bc","bd","cd"]
--    borra2 3 "abcd"  ==  ["a","b","c","d"]
borra2 :: Eq a => Int -> [a] -> [[a]]
borra2 0 xs     = [xs]
borra2 n []     = []
borra2 n (x:xs) = [x:ys | ys <- borra2 n xs] ++ borra2 (n-1) xs
 
-- 3ª definición
-- =============
 
mayorBorrando3 :: Int -> Integer -> Integer
mayorBorrando3 k n = read (mayorBorrandoLista3 k (show n))
 
-- (mayorBorrandoLista3 k xs) es la mayor lista obtenida borrando k elementos de
-- xs (se supone que xs tiene más de k elementos). Por ejemplo,
--    mayorBorrandoLista3 1 "6782334"  ==  "782334"
--    mayorBorrandoLista3 3 "6782334"  ==  "8334"
mayorBorrandoLista3 :: Ord a => Int -> [a] -> [a]
mayorBorrandoLista3 k xs = maximum (itera k borraUnoListas [xs])
 
-- (borraUnoListas xss) es la lista obtenida borrando un elemento (de
-- todas las formas posibles de la lista de listas no vacías xss. Por
-- ejemplo,
--    borraUnoListas ["abc","def"]  ==  ["bc","ac","ab","ef","df","de"]
borraUnoListas :: [[a]] -> [[a]]
borraUnoListas = concatMap borraUno
 
-- (borraUno xs) es la lista de listas obtenidas borrando un elemento de la
-- lista no vacía xs de todas las formas posibles. Por ejemplo,
--    borraUno "abcde"  ==  ["bcde","acde","abde","abce","abcd"]
borraUno :: [a] -> [[a]]
borraUno [x] = [[]]
borraUno (x:xs) = xs : map (x:) (borraUno xs)
 
-- (itera k f x) es el resultado de aplicar k veces la función f al
-- elemento x. Por ejmplo,
--    itera 3 (*2) 1   ==  8
--    itera 4 (+2) 10  ==  18
itera :: Eq a => Int -> (a -> a) -> a -> a
itera 0 _ x = x
itera n f x = itera (n-1) f (f x)
 
-- 4ª definición
-- =============
 
mayorBorrando4 :: Int -> Integer -> Integer
mayorBorrando4 k n = read (mayorBorrandoLista4 k (show n))
 
-- (mayorBorrandoLista4 k xs) es la mayor lista obtenida borrando k elementos de
-- xs (se supone que xs tiene más de k elementos). Por ejemplo,
--    mayorBorrandoLista4 1 "6782334"  ==  "782334"
--    mayorBorrandoLista4 3 "6782334"  ==  "8334"
mayorBorrandoLista4 :: Ord a => Int -> [a] -> [a]
mayorBorrandoLista4 k = itera k mayorBorraUno
 
-- (mayorBorraUno xs) es la mayor lista obtenida eliminando un elemento de
-- xs. Por ejemplo,
--    mayorBorraUno "6782334"  ==  "782334"
--    mayorBorraUno "782334"   ==  "82334"
--    mayorBorraUno "82334"    ==  "8334"
mayorBorraUno :: Ord a => [a] -> [a]
mayorBorraUno = maximum . borraUno
 
-- 5ª definición
-- =============
 
mayorBorrando5 :: Int -> Integer -> Integer
mayorBorrando5 k n = read (mayorBorrandoLista5 k (show n))
 
-- (mayorBorrandoLista5 k xs) es la mayor lista obtenida borrando k elementos de
-- xs (se supone que xs tiene más de k elementos). Por ejemplo,
--    mayorBorrandoLista5 1 "6782334"  ==  "782334"
--    mayorBorrandoLista5 3 "6782334"  ==  "8334"
mayorBorrandoLista5 :: Ord a => Int -> [a] -> [a]
mayorBorrandoLista5 k = itera k mayorBorraUno2
 
-- (mayorBorraUno2 xs) es la mayor lista obtenida eliminando un elemento de
-- xs. Por ejemplo,
--    mayorBorraUno2 "6782334"  ==  "782334"
--    mayorBorraUno2 "782334"   ==  "82334"
--    mayorBorraUno2 "82334"    ==  "8334"
mayorBorraUno2 :: Ord a => [a] -> [a]
mayorBorraUno2 [x]      = []
mayorBorraUno2 (x:y:xs) | x < y     = y:xs
                        | otherwise = x : mayorBorraUno2 (y:xs)
 
-- 6ª definición
-- =============
 
mayorBorrando6 :: Int -> Integer -> Integer
mayorBorrando6 k n = read (mayorBorrandoLista6 k (show n))
 
-- (mayorBorrandoLista6 k xs) es la mayor lista obtenida borrando k elementos de
-- xs (se supone que xs tiene más de k elementos). Por ejemplo,
--    mayorBorrandoLista6 1 "6782334"  ==  "782334"
--    mayorBorrandoLista6 3 "6782334"  ==  "8334"
mayorBorrandoLista6 :: Ord a => Int -> [a] -> [a]
mayorBorrandoLista6 k xs = aux k [] xs
 
aux 0 ys     xs     = reverse ys ++ xs
aux k ys     []     = reverse (drop k ys)
aux k []     (x:xs) = aux k [x] xs
aux k (y:ys) (x:xs) | y >= x    = aux k     (x:y:ys) xs
                    | otherwise = aux (k-1) ys       (x:xs)
 
-- Comparación de eficiencia
-- =========================
 
-- La comparación es
--    λ> mayorBorrando 6 (product [1..18])
--    7705728000
--    (0.06 secs, 15,165,496 bytes)
--    λ> mayorBorrando2 6 (product [1..18])
--    7705728000
--    (0.04 secs, 19,662,816 bytes)
--    λ> mayorBorrando3 6 (product [1..18])
--    7705728000
--    (6.93 secs, 5,143,807,064 bytes)
--    λ> mayorBorrando4 6 (product [1..18])
--    7705728000
--    (0.01 secs, 183,728 bytes)
--    λ> mayorBorrando5 6 (product [1..18])
--    7705728000
--    (0.01 secs, 118,984 bytes)
--    λ> mayorBorrando6 6 (product [1..18])
--    7705728000
--
--    λ> mayorBorrando 17 (product [1..25])
--    998400000
--    (19.09 secs, 14,516,359,464 bytes)
--    λ> mayorBorrando2 17 (product [1..25])
--    998400000
--    (47.39 secs, 30,066,413,608 bytes)
--    λ> mayorBorrando4 17 (product [1..25])
--    998400000
--    (0.01 secs, 458,320 bytes)
--    λ> mayorBorrando5 17 (product [1..25])
--    998400000
--    (0.01 secs, 134,424 bytes)
--    λ> mayorBorrando6 17 (product [1..25])
--    984000000
--    (0.01 secs, 124,600 bytes)
--
--    λ> mayorBorrando4 600 (product [1..300])
--    999999999999999
--    (3.29 secs, 4,421,841,944 bytes)
--    λ> mayorBorrando5 600 (product [1..300])
--    999999999999999
--    (0.03 secs, 6,690,440 bytes)
--    λ> mayorBorrando6 600 (product [1..300])
--    960000000000000
--    (0.01 secs, 593,864 bytes)
--
--    λ> mayorBorrando5 10000 (4256 + 10^10004)
--    14256
--    (16.04 secs, 18,221,784,872 bytes)
--    λ> mayorBorrando6 10000 (4256 + 10^10004)
--    14256
--    (0.02 secs, 6,669,592 bytes)
--
--    λ> mayorBorrando6 1000000 (4256 + 10^1000004)
--    14256
--    (1.04 secs, 655,561,656 bytes)

Nuevas soluciones

  • En los comentarios se pueden escribir nuevas soluciones.
  • El código se debe escribir entre una línea con <pre lang="haskell"> y otra con </pre>

Cambio con el menor número de monedas

El problema del cambio con el menor número de monedas consiste en, dada una lista ms de tipos de monedas (con infinitas monedas de cada tipo) y una cantidad objetivo x, calcular el menor número de monedas de ms cuya suma es x. Por ejemplo, con monedas de 1, 3 y 4 céntimos se puede obtener 6 céntimos de 4 formas

   1, 1, 1, 1, 1, 1
   1, 1, 1, 3
   1, 1, 4
   3, 3

El menor número de monedas que se necesita es 2. En cambio, con monedas de 2, 5 y 10 es imposible obtener 3.

Definir

   monedas :: [Int] -> Int -> Maybe Int

tal que (monedas ms x) es el menor número de monedas de ms cuya suma es x, si es posible obtener dicha suma y es Nothing en caso contrario. Por ejemplo,

   monedas [1,3,4]  6                    ==  Just 2
   monedas [2,5,10] 3                    ==  Nothing
   monedas [1,2,5,10,20,50,100,200] 520  ==  Just 4

Soluciones

import Data.Array ((!), array)
 
-- 1ª solución
-- ===========
 
monedas :: [Int] -> Int -> Maybe Int
monedas ms x
  | null cs   = Nothing
  | otherwise = Just (minimum (map length cs))
  where cs = cambios ms x
 
-- (cambios ms x) es la lista de las foemas de obtener x sumando monedas
-- de ms. Por ejemplo,
--   λ> cambios [1,5,10] 12
--   [[1,1,1,1,1,1,1,1,1,1,1,1],[1,1,1,1,1,1,1,5],[1,1,5,5],[1,1,10]]
--   λ> cambios [2,5,10] 3
--   []
--   λ> cambios [1,3,4] 6
--   [[1,1,1,1,1,1],[1,1,1,3],[1,1,4],[3,3]]
cambios :: [Int] -> Int -> [[Int]]
cambios _      0 = [[]]
cambios []     _ = []
cambios (k:ks) m
  | m < k     = []
  | otherwise = [k:zs | zs <- cambios (k:ks) (m - k)] ++
                cambios ks m
 
-- 2ª solución
-- ===========
 
monedas2 :: [Int] -> Int -> Maybe Int
monedas2 ms n
  | sol == infinito = Nothing
  | otherwise       = Just sol
  where
    sol = aux n
    aux 0 = 0
    aux k = siguiente (minimo [aux (k - x) | x <- ms,  k >= x])
 
infinito :: Int
infinito = 10^30
 
minimo :: [Int] -> Int
minimo [] = infinito
minimo xs = minimum xs
 
siguiente :: Int -> Int
siguiente x | x == infinito = infinito
            | otherwise     = 1 + x
 
-- 3ª solución
-- ===========
 
monedas3 :: [Int] -> Int -> Maybe Int
monedas3 ms n  
  | sol == infinito = Nothing
  | otherwise       = Just sol
  where
    sol = v ! n
    v   = array (0,n) [(i,f i) | i <- [0..n]]
    f 0 = 0
    f k = siguiente (minimo [v ! (k - x) | x <- ms, k >= x])
 
-- Comparación de eficiencia
-- =========================
 
--    λ> monedas [1,2,5,10,20,50,100,200] 27
--    Just 3
--    (0.02 secs, 871,144 bytes)
--    λ> monedas2 [1,2,5,10,20,50,100,200] 27
--    Just 3
--    (15.44 secs, 1,866,519,080 bytes)
--    λ> monedas3 [1,2,5,10,20,50,100,200] 27
--    Just 3
--    (0.01 secs, 157,232 bytes)
--    
--    λ> monedas [1,2,5,10,20,50,100,200] 188
--    Just 7
--    (14.20 secs, 1,845,293,080 bytes)
--    λ> monedas3 [1,2,5,10,20,50,100,200] 188
--    Just 7
--    (0.01 secs, 623,376 bytes)

Caminos en un grafo

Definir las funciones

   grafo   :: [(Int,Int)] -> Grafo Int Int
   caminos :: Grafo Int Int -> Int -> Int -> [[Int]]

tales que

  • (grafo as) es el grafo no dirigido definido cuyas aristas son as. Por ejemplo,
     ghci> grafo [(2,4),(4,5)]
     G ND (array (2,5) [(2,[(4,0)]),(3,[]),(4,[(2,0),(5,0)]),(5,[(4,0)])])
  • (caminos g a b) es la lista los caminos en el grafo g desde a hasta b sin pasar dos veces por el mismo nodo. Por ejemplo,
     ghci> sort (caminos (grafo [(1,3),(2,5),(3,5),(3,7),(5,7)]) 1 7)
     [[1,3,5,7],[1,3,7]]
     ghci> sort (caminos (grafo [(1,3),(2,5),(3,5),(3,7),(5,7)]) 2 7)
     [[2,5,3,7],[2,5,7]]
     ghci> sort (caminos (grafo [(1,3),(2,5),(3,5),(3,7),(5,7)]) 1 2)
     [[1,3,5,2],[1,3,7,5,2]]
     ghci> caminos (grafo [(1,3),(2,5),(3,5),(3,7),(5,7)]) 1 4
     []
     ghci> length (caminos (grafo [(i,j) | i <- [1..10], j <- [i..10]]) 1 10)
     109601

Soluciones

import Data.List (sort)
import I1M.Grafo
import I1M.BusquedaEnEspaciosDeEstados
 
grafo :: [(Int,Int)] -> Grafo Int Int
grafo as = creaGrafo ND (m,n) [(x,y,0) | (x,y) <- as]
  where ns = map fst as ++ map snd as
        m  = minimum ns
        n  = maximum ns
 
-- 1ª solución
-- ===========
 
caminos :: Grafo Int Int -> Int -> Int -> [[Int]]
caminos g a b = aux [[b]] where 
  aux [] = []
  aux ((x:xs):yss)
    | x == a    = (x:xs) : aux yss
    | otherwise = aux ([z:x:xs | z <- adyacentes g x
                               , z `notElem` (x:xs)] 
                       ++ yss) 
 
-- 2ª solución (mediante espacio de estados)
-- =========================================
 
caminos2 :: Grafo Int Int -> Int -> Int -> [[Int]]
caminos2 g a b = buscaEE sucesores esFinal inicial
  where inicial          = [b]
        sucesores (x:xs) = [z:x:xs | z <- adyacentes g x
                                   , z `notElem` (x:xs)] 
        esFinal (x:xs)   = x == a
 
-- Comparación de eficiencia
-- =========================
 
--    ghci> length (caminos (grafo [(i,j) | i <- [1..10], j <- [i..10]]) 1 10)
--    109601
--    (3.57 secs, 500533816 bytes)
--    ghci> length (caminos2 (grafo [(i,j) | i <- [1..10], j <- [i..10]]) 1 10)
--    109601
--    (3.53 secs, 470814096 bytes)

Espacio de estados del problema de las N reinas

El problema de las N reinas consiste en colocar N reinas en tablero rectangular de dimensiones N por N de forma que no se encuentren más de una en la misma línea: horizontal, vertical o diagonal. Por ejemplo, una solución para el problema de las 4 reinas es

   |---|---|---|---|
   |   | R |   |   |
   |---|---|---|---|
   |   |   |   | R |
   |---|---|---|---|
   | R |   |   |   |
   |---|---|---|---|
   |   |   | R |   |
   |---|---|---|---|

Los estados del problema de las N reinas son los tableros con las reinas colocadas. Inicialmente el tablero está vacío y, en cda paso se coloca una reina en la primera columna en la que aún no hay ninguna reina.

Cada estado se representa por una lista de números que indican las filas donde se han colocado las reinas. Por ejemplo, el tablero anterior se representa por [2,4,1,3].

Usando la librería de árboles Data.Tree, definir las funciones

   arbolReinas :: Int -> Tree [Int]
   nEstados    :: Int -> Int
   soluciones  :: Int -> [[Int]]
   nSoluciones :: Int -> Int

tales que

  • (arbolReinas n) es el árbol de estados para el problema de las n reinas. Por ejemplo,
     λ> putStrLn (drawTree (fmap show (arbolReinas 4)))
     []
     |
     +- [1]
     |  |
     |  +- [3,1]
     |  |
     |  `- [4,1]
     |     |
     |     `- [2,4,1]
     |
     +- [2]
     |  |
     |  `- [4,2]
     |     |
     |     `- [1,4,2]
     |        |
     |        `- [3,1,4,2]
     |
     +- [3]
     |  |
     |  `- [1,3]
     |     |
     |     `- [4,1,3]
     |        |
     |        `- [2,4,1,3]
     |
     `- [4]
        |
        +- [1,4]
        |  |
        |  `- [3,1,4]
        |
        `- [2,4]
 
     λ> putStrLn (drawTree (fmap show (arbolReinas 5)))
     []
     |
     +- [1]
     |  |
     |  +- [3,1]
     |  |  |
     |  |  `- [5,3,1]
     |  |     |
     |  |     `- [2,5,3,1]
     |  |        |
     |  |        `- [4,2,5,3,1]
     |  |
     |  +- [4,1]
     |  |  |
     |  |  `- [2,4,1]
     |  |     |
     |  |     `- [5,2,4,1]
     |  |        |
     |  |        `- [3,5,2,4,1]
     |  |
     |  `- [5,1]
     |     |
     |     `- [2,5,1]
     |
     +- [2]
     |  |
     |  +- [4,2]
     |  |  |
     |  |  `- [1,4,2]
     |  |     |
     |  |     `- [3,1,4,2]
     |  |        |
     |  |        `- [5,3,1,4,2]
     |  |
     |  `- [5,2]
     |     |
     |     +- [1,5,2]
     |     |  |
     |     |  `- [4,1,5,2]
     |     |
     |     `- [3,5,2]
     |        |
     |        `- [1,3,5,2]
     |           |
     |           `- [4,1,3,5,2]
     |
     +- [3]
     |  |
     |  +- [1,3]
     |  |  |
     |  |  `- [4,1,3]
     |  |     |
     |  |     `- [2,4,1,3]
     |  |        |
     |  |        `- [5,2,4,1,3]
     |  |
     |  `- [5,3]
     |     |
     |     `- [2,5,3]
     |        |
     |        `- [4,2,5,3]
     |           |
     |           `- [1,4,2,5,3]
     |
     +- [4]
     |  |
     |  +- [1,4]
     |  |  |
     |  |  +- [3,1,4]
     |  |  |  |
     |  |  |  `- [5,3,1,4]
     |  |  |     |
     |  |  |     `- [2,5,3,1,4]
     |  |  |
     |  |  `- [5,1,4]
     |  |     |
     |  |     `- [2,5,1,4]
     |  |
     |  `- [2,4]
     |     |
     |     `- [5,2,4]
     |        |
     |        `- [3,5,2,4]
     |           |
     |           `- [1,3,5,2,4]
     |
     `- [5]
        |
        +- [1,5]
        |  |
        |  `- [4,1,5]
        |
        +- [2,5]
        |  |
        |  `- [4,2,5]
        |     |
        |     `- [1,4,2,5]
        |        |
        |        `- [3,1,4,2,5]
        |
        `- [3,5]
           |
           `- [1,3,5]
              |
              `- [4,1,3,5]
                 |
                 `- [2,4,1,3,5]
  • (nEstados n) es el número de estados en el problema de las n reinas. Por ejemplo,
     nEstados 4            ==  17
     nEstados 5            ==  54
     map nEstados [0..10]  ==  [1,2,3,6,17,54,153,552,2057,8394,35539]
  • (soluciones n) es la lista de estados que son soluciones del problema de las n reinas. Por ejemplo,
     λ> soluciones 4
     [[3,1,4,2],[2,4,1,3]]
     λ> soluciones 5
     [[4,2,5,3,1],[3,5,2,4,1],[5,3,1,4,2],[4,1,3,5,2],[5,2,4,1,3],
      [1,4,2,5,3],[2,5,3,1,4],[1,3,5,2,4],[3,1,4,2,5],[2,4,1,3,5]]
  • (nSoluciones n) es el número de soluciones del problema de las n reinas. Por ejemplo,
     nSoluciones 4            ==  2
     nSoluciones 5            ==  10
     map nSoluciones [0..10]  ==  [1,1,0,0,2,10,4,40,92,352,724]

Soluciones

import Data.List ((\\))
import Data.Tree
 
-- Definición de arbolReinas
-- =========================
 
arbolReinas :: Int -> Tree [Int]
arbolReinas n = expansion n []
  where
    expansion m xs = Node xs [expansion (m-1) ys | ys <- sucesores n xs]
 
-- (sucesores n xs) es la lista de los sucesores del estado xs en el
-- problema de las n reinas. Por ejemplo,
--    sucesores 4 []       ==  [[1],[2],[3],[4]]
--    sucesores 4 [1]      ==  [[3,1],[4,1]]
--    sucesores 4 [4,1]    ==  [[2,4,1]]
--    sucesores 4 [2,4,1]  ==  []
sucesores :: Int -> [Int] -> [[Int]]
sucesores n xs = [y:xs | y <- [1..n] \\ xs
                       , noAtaca y xs 1]
 
-- (noAtaca y xs d) se verifica si la reina en la fila y no ataca a las
-- colocadas en las filas xs donde d es el número de columnas desde la
-- de la posición de x a la primera de xs.
noAtaca :: Int -> [Int] -> Int -> Bool
noAtaca _ [] _ = True
noAtaca y (x:xs) distH = abs(y-x) /= distH &&
                         noAtaca y xs (distH + 1)               
 
-- Definición de nEstados
-- ======================
 
nEstados :: Int -> Int
nEstados = length . arbolReinas
 
-- Definición de solucionesReinas
-- ==============================
 
--    λ> soluciones 4
--    [[3,1,4,2],[2,4,1,3]]
--    λ> soluciones 5
--    [[4,2,5,3,1],[3,5,2,4,1],[5,3,1,4,2],[4,1,3,5,2],[5,2,4,1,3],
--     [1,4,2,5,3],[2,5,3,1,4],[1,3,5,2,4],[3,1,4,2,5],[2,4,1,3,5]]
soluciones :: Int -> [[Int]]
soluciones n =
  filter (\xs -> length xs == n) (estados n)
 
-- (estados n) es la lista de estados del problema de las n reinas. Por
-- ejemplo, 
--   λ> estados 4
--   [[],
--    [1],[2],[3],[4],
--    [3,1],[4,1],[4,2],[1,3],[1,4],[2,4],
--    [2,4,1],[1,4,2],[4,1,3],[3,1,4],
--    [3,1,4,2],[2,4,1,3]]
estados :: Int -> [[Int]]
estados = concat . levels . arbolReinas
 
-- Definición de nSoluciones
-- =========================
 
nSoluciones :: Int -> Int
nSoluciones = length . soluciones

Conjuntos de primos emparejables

Un conjunto de primos emparejables es un conjunto S de números primos tales que al concatenar cualquier par de elementos de S se obtiene un número primo. Por ejemplo, {3, 7, 109, 673} es un conjunto de primos emparejables ya que sus elementos son primos y las concatenaciones de sus parejas son 37, 3109, 3673, 73, 7109, 7673, 1093, 1097, 109673, 6733, 6737 y 673109 son primos.

Definir la función

   emparejables :: Integer -> Integer -> [[Integer]]

tal que (emparejables n m) es el conjunto de los conjuntos emparejables de n elementos menores que n. Por ejemplo,

   take 5 (emparejables 2   10)  ==  [[3,7]]
   take 5 (emparejables 3   10)  ==  []
   take 5 (emparejables 2  100)  ==  [[3,7],[3,11],[3,17],[3,31],[3,37]]
   take 5 (emparejables 3  100)  ==  [[3,37,67],[7,19,97]]
   take 5 (emparejables 4  100)  ==  []
   take 5 (emparejables 4 1000)  ==  [[3,7,109,673],[23,311,677,827]]

Conjetura de las familias estables por uniones

La conjetura de las familias estables por uniones fue planteada por Péter Frankl en 1979 y aún sigue abierta.

Una familia de conjuntos es estable por uniones si la unión de dos conjuntos cualesquiera de la familia pertenece a la familia. Por ejemplo, {∅, {1}, {2}, {1,2}, {1,3}, {1,2,3}} es estable por uniones; pero {{1}, {2}, {1,3}, {1,2,3}} no lo es.

La conjetura afirma que toda familia no vacía estable por uniones y distinta de {∅} posee algún elemento que pertenece al menos a la mitad de los conjuntos de la familia.

Definir las funciones

   esEstable :: Ord a => Set (Set a) -> Bool
   familiasEstables :: Ord a => Set a -> Set (Set (Set a))
   mayoritarios :: Ord a => Set (Set a) -> [a]
   conjeturaFrankl :: Int -> Bool

tales que

  • (esEstable f) se verifica si la familia f es estable por uniones. Por ejemplo,
     λ> esEstable (fromList [empty, fromList [1,2], fromList [1..5]])
     True
     λ> esEstable (fromList [empty, fromList [1,7], fromList [1..5]])
     False
     λ> esEstable (fromList [fromList [1,2], singleton 3, fromList [1..3]])
     True
  • (familiasEstables c) es el conjunto de las familias estables por uniones formadas por elementos del conjunto c. Por ejemplo,
     λ> familiasEstables (fromList [1..2])
     fromList
       [ fromList []
       , fromList [fromList []]
       , fromList [fromList [],fromList [1]]
       , fromList [fromList [],fromList [1],fromList [1,2]],
         fromList [fromList [],fromList [1],fromList [1,2],fromList [2]]
       , fromList [fromList [],fromList [1,2]]
       , fromList [fromList [],fromList [1,2],fromList [2]]
       , fromList [fromList [],fromList [2]]
       , fromList [fromList [1]]
       , fromList [fromList [1],fromList [1,2]]
       , fromList [fromList [1],fromList [1,2],fromList [2]]
       , fromList [fromList [1,2]]
       , fromList [fromList [1,2],fromList [2]]
       , fromList [fromList [2]]]
     λ> size (familiasEstables (fromList [1,2]))
     14
     λ> size (familiasEstables (fromList [1..3]))
     122
     λ> size (familiasEstables (fromList [1..4]))
     4960
  • (mayoritarios f) es la lista de elementos que pertenecen al menos a la mitad de los conjuntos de la familia f. Por ejemplo,
     mayoritarios (fromList [empty, fromList [1,3], fromList [3,5]]) == [3]
     mayoritarios (fromList [empty, fromList [1,3], fromList [4,5]]) == []
  • (conjeturaFrankl n) se verifica si para toda familia f formada por elementos del conjunto {1,2,…,n} no vacía, estable por uniones y distinta de {∅} posee algún elemento que pertenece al menos a la mitad de los conjuntos de f. Por ejemplo.
     conjeturaFrankl 2  ==  True
     conjeturaFrankl 3  ==  True
     conjeturaFrankl 4  ==  True

Soluciones

 
import Data.Set  as S ( Set
                      , delete
                      , deleteFindMin
                      , empty
                      , filter
                      , fromList
                      , insert
                      , map
                      , member
                      , null
                      , singleton
                      , size
                      , toList
                      , union
                      , unions
                      )
import Data.List as L ( filter
                      , null
                      )
 
esEstable :: Ord a => Set (Set a) -> Bool
esEstable xss =
  and [ys `S.union` zs `member` xss | (ys,yss) <- selecciones xss
                                    , zs <- toList yss]
 
-- (seleccciones xs) es la lista de los pares formada por un elemento de
-- xs y los restantes elementos. Por ejemplo,
--    λ> selecciones (fromList [3,2,5])
--    [(2,fromList [3,5]),(3,fromList [2,5]),(5,fromList [2,3])]
selecciones :: Ord a => Set a -> [(a,Set a)]
selecciones xs =
  [(x,delete x xs) | x <- toList xs] 
 
familiasEstables :: Ord a => Set a -> Set (Set (Set a))
familiasEstables xss =
  S.filter esEstable (familias xss)
 
-- (familias c) es la familia formadas con elementos de c. Por ejemplo,
--    λ> mapM_ print (familias (fromList [1,2]))
--    fromList []
--    fromList [fromList []]
--    fromList [fromList [],fromList [1]]
--    fromList [fromList [],fromList [1],fromList [1,2]]
--    fromList [fromList [],fromList [1],fromList [1,2],fromList [2]]
--    fromList [fromList [],fromList [1],fromList [2]]
--    fromList [fromList [],fromList [1,2]]
--    fromList [fromList [],fromList [1,2],fromList [2]]
--    fromList [fromList [],fromList [2]]
--    fromList [fromList [1]]
--    fromList [fromList [1],fromList [1,2]]
--    fromList [fromList [1],fromList [1,2],fromList [2]]
--    fromList [fromList [1],fromList [2]]
--    fromList [fromList [1,2]]
--    fromList [fromList [1,2],fromList [2]]
--    fromList [fromList [2]]
--    λ> size (familias (fromList [1,2]))
--    16
--    λ> size (familias (fromList [1,2,3]))
--    256
--    λ> size (familias (fromList [1,2,3,4]))
--    65536
familias :: Ord a => Set a -> Set (Set (Set a))
familias c =
  subconjuntos (subconjuntos c)
 
-- (subconjuntos c) es el conjunto de los subconjuntos de c. Por ejemplo,
--    λ> mapM_ print (subconjuntos (fromList [1,2,3]))
--    fromList []
--    fromList [1]
--    fromList [1,2]
--    fromList [1,2,3]
--    fromList [1,3]
--    fromList [2]
--    fromList [2,3]
--    fromList [3]
subconjuntos :: Ord a => Set a -> Set (Set a)
subconjuntos c
  | S.null c  = singleton empty
  | otherwise = S.map (insert x) sr `union` sr
  where (x,rc) = deleteFindMin c
        sr     = subconjuntos rc
 
-- (elementosFamilia f) es el conjunto de los elementos de los elementos
-- de la familia f. Por ejemplo, 
--    λ> elementosFamilia (fromList [empty, fromList [1,2], fromList [2,5]])
--    fromList [1,2,5]
elementosFamilia :: Ord a => Set (Set a) -> Set a
elementosFamilia = unions . toList
 
-- (nOcurrencias f x) es el número de conjuntos de la familia f a los
-- que pertenece el elemento x. Por ejemplo,
--    nOcurrencias (fromList [empty, fromList [1,3], fromList [3,5]]) 3 == 2
--    nOcurrencias (fromList [empty, fromList [1,3], fromList [3,5]]) 4 == 0
--    nOcurrencias (fromList [empty, fromList [1,3], fromList [3,5]]) 5 == 1
nOcurrencias :: Ord a => Set (Set a) -> a -> Int
nOcurrencias f x =
  length (L.filter (x `member`) (toList f))
 
mayoritarios :: Ord a => Set (Set a) -> [a]
mayoritarios f =
  [x | x <- toList (elementosFamilia f)
     , nOcurrencias f x >= n]
  where n = (1 + size f) `div` 2
 
conjeturaFrankl :: Int -> Bool
conjeturaFrankl n =
  and [ not (L.null (mayoritarios f))
      | f <- fs
      , f /= fromList []
      , f /= fromList [empty]]
  where fs = toList (familiasEstables (fromList [1..n]))
 
 
-- conjeturaFrankl' :: Int -> Bool
conjeturaFrankl' n =
  [f | f <- fs
     , L.null (mayoritarios f)
     , f /= fromList []
     , f /= fromList [empty]]
  where fs = toList (familiasEstables (fromList [1..n]))

Otras soluciones

  • Se pueden escribir otras soluciones en los comentarios.
  • El código se debe escribir entre una línea con <pre lang="haskell"> y otra con </pre>

Menor no expresable como suma

Definir la función

   menorNoSuma :: [Integer] -> Integer

tal que (menorNoSuma xs) es el menor número que no se puede escribir como suma de un subconjunto de xs, donde se supone que xs es un conjunto de números enteros positivos. Por ejemplo,

   menorNoSuma [6,1,2]    ==  4
   menorNoSuma [1,2,3,9]  ==  7
   menorNoSuma [5]        ==  1
   menorNoSuma [1..20]    ==  211
   menorNoSuma [1..10^6]  ==  500000500001

Comprobar con QuickCheck que para todo n,

   menorNoSuma [1..n] == 1 + sum [1..n]

Soluciones

-- 1ª definición
-- =============
 
import Data.List (sort, subsequences)
import Test.QuickCheck
 
menorNoSuma1 :: [Integer] -> Integer
menorNoSuma1 xs =
  head [n | n <- [1..], n `notElem` sumas xs]
 
-- (sumas xs) es la lista de las sumas de los subconjuntos de xs. Por ejemplo,
--    sumas [1,2,6]  ==  [0,1,2,3,6,7,8,9]
--    sumas [6,1,2]  ==  [0,6,1,7,2,8,3,9]
sumas :: [Integer] -> [Integer]
sumas xs = map sum (subsequences xs)
 
-- 2ª definición
-- =============
 
menorNoSuma2 :: [Integer] -> Integer
menorNoSuma2  = menorNoSumaOrd . reverse . sort 
 
-- (menorNoSumaOrd xs) es el menor número que no se puede escribir como
-- suma de un subconjunto de xs, donde xs es una lista de números
-- naturales ordenada de mayor a menor. Por ejemplo,
--    menorNoSumaOrd [6,2,1]  ==  4
menorNoSumaOrd [] = 1
menorNoSumaOrd (x:xs) | x > y     = y
                      | otherwise = y+x
  where y = menorNoSumaOrd xs
 
-- Comparación de eficiencia
-- =========================
 
--    λ> menorNoSuma1 [1..20]
--    211
--    (20.40 secs, 28,268,746,320 bytes)
--    λ> menorNoSuma2 [1..20]
--    211
--    (0.01 secs, 0 bytes)
 
-- Propiedad
-- =========
 
-- La propiedad es
prop_menorNoSuma :: (Positive Integer) -> Bool
prop_menorNoSuma (Positive n) =
  menorNoSuma2 [1..n] == 1 + sum [1..n]
 
-- La comprobación es
--    λ> quickCheckWith (stdArgs {maxSize=7}) prop_menorNoSuma
--    +++ OK, passed 100 tests.

Otras soluciones

  • Se pueden escribir otras soluciones en los comentarios.
  • El código se debe escribir entre una línea con <pre lang="haskell"> y otra con </pre>

Cálculo de pi mediante los métodos de Gregory-Leibniz y de Beeler

La fórmula de Gregory-Leibniz para calcular pi es
Calculo_de_pi_mediante_los_metodos_de_Gregory-Leibniz_y_de_Beeler_1
y la de Beeler es
Calculo_de_pi_mediante_los_metodos_de_Gregory-Leibniz_y_de_Beeler_2

Definir las funciones

   aproximaPiGL     :: Int -> Double
   aproximaPiBeeler :: Int -> Double
   graficas         :: [Int] -> IO ()

tales que

  • (aproximaPiGL n) es la aproximación de pi con los primeros n términos de la fórmula de Gregory-Leibniz. Por ejemplo,
     aproximaPiGL 1       ==  4.0
     aproximaPiGL 2       ==  2.666666666666667
     aproximaPiGL 3       ==  3.466666666666667
     aproximaPiGL 10      ==  3.0418396189294032
     aproximaPiGL 100     ==  3.1315929035585537
     aproximaPiGL 1000    ==  3.140592653839794
     aproximaPiGL 10000   ==  3.1414926535900345
     aproximaPiGL 100000  ==  3.1415826535897198
  • (aproximaPiBeeler n) es la aproximación de pi con los primeros n términos de la fórmula de Beeler. Por ejemplo,
     aproximaPiBeeler 1   ==  2.0
     aproximaPiBeeler 2   ==  2.6666666666666665
     aproximaPiBeeler 3   ==  2.933333333333333
     aproximaPiBeeler 10  ==  3.140578169680337
     aproximaPiBeeler 60  ==  3.141592653589793
     pi                   ==  3.141592653589793
  • (graficas xs) dibuja la gráfica de las k-ésimas aproximaciones de pi, donde k toma los valores de la lista xs, con las fórmulas de Gregory-Leibniz y de Beeler. Por ejemplo, (graficas [1..25]) dibuja
    Calculo_de_pi_mediante_los_metodos_de_Gregory-Leibniz_y_de_Beeler_3
    donde la línea morada corresponde a la aproximación de Gregory-Leibniz y la verde a la de Beeler.

Soluciones

import Graphics.Gnuplot.Simple
 
-- Definiciones de aproximaPiGL
-- ============================
 
-- 1ª definición de aproximaPiGL
aproximaPiGL :: Int -> Double
aproximaPiGL n = 4 * (sum . take n . sumaA . zipWith (/) [1,1..]) [1,3..]
  where sumaA (x:y:xs) = x:(-y):sumaA xs
 
-- 2ª definición de aproximaPiGL
aproximaPiGL2 :: Int -> Double
aproximaPiGL2 n =
  4 * (sum (take n (zipWith (/) (cycle [1,-1]) [1,3..])))
 
-- 3ª definición de aproximaPiGL
aproximaPiGL3 :: Int -> Double
aproximaPiGL3 n =
  4 * (sum . take n . zipWith (/) (cycle [1,-1])) [1,3..]
 
-- 4ª definición de aproximaPiGL
aproximaPiGL4 :: Int -> Double
aproximaPiGL4 n = serieGL !! (n-1)
 
serieGL :: [Double]
serieGL = scanl1 (+) (zipWith (/) numeradores denominadores)
  where numeradores   = cycle [4,-4]
        denominadores = [1,3..]
 
-- Definición de aproximaPiBeeler
aproximaPiBeeler :: Int -> Double
aproximaPiBeeler n = 2 * aux (fromIntegral n) 1
  where
    aux :: Double -> Double -> Double 
    aux n k | n == k    = 1
            | otherwise = 1 + (k/(2*k+1)) * aux n (1+k)
 
-- Definición de graficas
graficas :: [Int] -> IO ()
graficas xs = 
    plotLists [Key Nothing]
             [[(k,aproximaPiGL k)     | k <- xs],
              [(k,aproximaPiBeeler k) | k <- xs]]

Otras soluciones

  • Se pueden escribir otras soluciones en los comentarios.
  • El código se debe escribir entre una línea con <pre lang="haskell"> y otra con </pre>