Menu Close

Etiqueta: putStrLn

Las torres de Hanói

José A. Alonso, ,

Las torres de Hanoi es un rompecabeza que consta de tres postes que llamaremos A, B y C. Hay N discos de distintos tamaños en el poste A, de forma que no hay un disco situado sobre otro de menor tamaño. Los postes B y C están vacíos. Sólo puede moverse un disco a la vez y todos los discos deben de estar ensartados en algún poste. Ningún disco puede situarse sobre otro de menor tamaño. El problema consiste en colocar los N discos en el poste C.

Los postes se pueden representar mediante el siguiente tipo de datos

   data Poste = A | B | C
     deriving Show

Definir las funciones

   movimientos :: Integer -> [(Integer,Poste,Poste)]
   hanoi       :: Integer -> IO ()

tales que

  • (movimientos n) es la lista de los movimientos para resolver el problema de las torres de hanoi con n discos. Por ejemplo,
     λ> movimientos 1
     [(1,A,C)]
     λ> movimientos 2
     [(1,A,B),(2,A,C),(1,B,C)]
     λ> movimientos 3
     [(1,A,C),(2,A,B),(1,C,B),(3,A,C),(1,B,A),(2,B,C),(1,A,C)]
  • (hanoi n) escribe los mensajes de los movimientos para resolver el problema de las torres de hanoi con n discos. Por ejemplo,
     λ> hanoi 3
     Mueve el disco 1 de A a C
     Mueve el disco 2 de A a B
     Mueve el disco 1 de C a B
     Mueve el disco 3 de A a C
     Mueve el disco 1 de B a A
     Mueve el disco 2 de B a C
     Mueve el disco 1 de A a C

Soluciones

data Poste = A | B | C
  deriving (Eq, Show)
 
movimientos :: Integer -> [(Integer,Poste,Poste)]
movimientos n = aux n A B C
  where  
    aux n a b c
      | n == 1    = [(1,a,c)]
      | otherwise = aux (n-1) a c b ++ (n,a,c) : aux (n-1) b a c
 
hanoi :: Integer -> IO ()
hanoi n = 
  putStrLn (unlines (map mensaje (movimientos n)))
 
-- (mensaje (n.x.y)) es la cadena indicando que el disco n se ha movido
-- desde el poste x al poste y. Por ejemplo, 
--    λ> mensaje (1,A,B)
--    "Mueve el disco 1 de A a B"
mensaje :: (Integer,Poste,Poste) -> String
mensaje (n,x,y) =
  "Mueve el disco " ++ show n ++ " de " ++ show x ++ " a " ++ show y

Pensamiento

En preguntar lo que sabes
el tiempo no has de perder …
Y a preguntas sin respuesta
¿quién te podrá responder?

Antonio Machado

Leer más →

Árbol de subconjuntos

José A. Alonso, ,

Definir las siguientes funciones

   arbolSubconjuntos       :: [a] -> Tree [a]
   nNodosArbolSubconjuntos :: Integer -> Integer
   sumaNNodos              :: Integer -> Integer

tales que

  • (arbolSubconjuntos xs) es el árbol de los subconjuntos de xs. Por ejemplo. 
     λ> putStrLn (drawTree (arbolSubconjuntos "abc"))
     abc
     |
     +- bc
     |  |
     |  +- c
     |  |
     |  `- b
     |
     +- ac
     |  |
     |  +- c
     |  |
     |  `- a
     |
     `- ab
        |
        +- b
        |
        `- a
  • (nNodosArbolSubconjuntos xs) es el número de nodos del árbol de xs. Por ejemplo 
     nNodosArbolSubconjuntos "abc"  ==  10
     nNodosArbolSubconjuntos [1..4*10^4] `mod` (7+10^9) == 546503960
  • (sumaNNodos n) es la suma del número de nodos de los árboles de los subconjuntos de [1..k] para 1 <= k <= n. Por ejemplo,
     λ> sumaNNodos 3  ==  14
     sumaNNodos (4*10^4) `mod` (7+10^9)  ==  249479844

Soluciones

import Data.List (genericLength, genericTake)
import Data.Tree (Tree (Node))
 
-- Definición de arbolSubconjuntos
-- ===============================
 
arbolSubconjuntos :: [a] -> Tree [a]
arbolSubconjuntos [x] = Node [x] []
arbolSubconjuntos xs =
  Node xs (map arbolSubconjuntos (sinUno xs))
 
-- (sinUno xs) es la lista obtenidas eliminando un elemento de xs. Por
-- ejemplo, 
--    sinUno "abcde"  ==  ["bcde","acde","abde","abce","abcd"]
sinUno :: [a] -> [[a]]
sinUno xs =
  [ys ++ zs | n <- [0..length xs - 1]
            , let (ys,_:zs) = splitAt n xs]       
 
-- 1ª definición de nNodosArbolSubconjuntos
-- ========================================
 
nNodosArbolSubconjuntos :: [a] -> Integer
nNodosArbolSubconjuntos =
  fromIntegral . length . arbolSubconjuntos 
 
-- 2ª definición de nNodosArbolSubconjuntos
-- ========================================
 
nNodosArbolSubconjuntos2 :: [a] -> Integer
nNodosArbolSubconjuntos2 = aux . genericLength
  where aux 1 = 1
        aux n = 1 + n * aux (n-1)
 
-- 3ª definición de nNodosArbolSubconjuntos
-- ========================================
 
nNodosArbolSubconjuntos3 :: [a] -> Integer
nNodosArbolSubconjuntos3 xs =
  sucNNodos !! (n-1)
  where n = length xs
 
-- sucNNodos es la sucesión de los números de nodos de los árboles de
-- los subconjuntos con 1, 2, ... elementos. Por ejemplo.
--    λ> take 10 sucNNodos
--    [1,3,10,41,206,1237,8660,69281,623530,6235301]
sucNNodos :: [Integer]
sucNNodos =
  1 : map (+ 1) (zipWith (*) [2..] sucNNodos)
 
-- Comparación de eficiencia de nNodosArbolSubconjuntos
-- ====================================================
 
--    λ> nNodosArbolSubconjuntos 10
--    6235301
--    (9.66 secs, 5,491,704,944 bytes)
--    λ> nNodosArbolSubconjuntos2 10
--    6235301
--    (0.00 secs, 145,976 bytes)
--
--    λ> length (show (nNodosArbolSubconjuntos2 (4*10^4)))
--    166714
--    (1.07 secs, 2,952,675,472 bytes)
--    λ> length (show (nNodosArbolSubconjuntos3 (4*10^4)))
--    166714
--    (1.53 secs, 2,959,020,680 bytes)
 
-- 1ª definición de sumaNNodos
-- ===========================
 
sumaNNodos :: Integer -> Integer
sumaNNodos n =
  sum [nNodosArbolSubconjuntos [1..k] | k <- [1..n]]
 
-- 2ª definición de sumaNNodos
-- ===========================
 
sumaNNodos2 :: Integer -> Integer
sumaNNodos2 n =
  sum [nNodosArbolSubconjuntos2 [1..k] | k <- [1..n]]
 
-- 3ª definición de sumaNNodos
-- ===========================
 
sumaNNodos3 :: Integer -> Integer
sumaNNodos3 n =
  sum (genericTake n sucNNodos)
 
-- Comparación de eficiencia de sumaNNodos
-- =======================================
 
--    λ> sumaNNodos 10 `mod` (7+10^9)
--    6938270
--    (16.00 secs, 9,552,410,688 bytes)
--    λ> sumaNNodos2 10 `mod` (7+10^9)
--    6938270
--    (0.00 secs, 177,632 bytes)
-- 
--    λ> sumaNNodos2 (2*10^3) `mod` (7+10^9)
--    851467820
--    (2.62 secs, 4,622,117,976 bytes)
--    λ> sumaNNodos3 (2*10^3) `mod` (7+10^9)
--    851467820
--    (0.01 secs, 8,645,336 bytes)
Leer más →

Subrayado de un carácter

José A. Alonso, ,

Definir el procedimiento

   subraya :: String -> Char -> IO ()

tal que (subraya cs c) escribe la cadena cs y debajo otra subrayando las ocurrencias de c. Por ejemplo,

   λ> subraya "Salamanca es castellana" 'a'
   Salamanca es castellana
    ^ ^ ^  ^     ^     ^ ^
   λ> subraya "Salamanca es castellana" 'n'
   Salamanca es castellana
         ^              ^ 
   λ> subraya "Salamanca es castellana" ' '
   Salamanca es castellana
            ^  ^

Soluciones

-- 1ª definición
subraya :: String -> Char -> IO ()
subraya cs c = do
  putStrLn cs
  putStrLn (subrayado cs c)
 
subrayado :: String -> Char -> String
subrayado cs c = map procesa cs
  where procesa x | x == c    = '^'
                  | otherwise = ' '
 
-- 2ª definición
subraya2 :: String -> Char -> IO ()
subraya2 cs c = 
  mapM_ putStrLn [cs, subrayado cs c]
Leer más →

Árbol de Navidad

José A. Alonso, ,

Definir el procedimiento

   arbol :: Int -> IO ()

tal que (arbol n) dibuja el árbol de Navidad con una copa de altura n y un tronco de altura la mitad de n. Por ejemplo,

   λ> arbol 5
 
        X
       XXX
      XXXXX
     XXXXXXX
    XXXXXXXXX
        X
        X
 
   λ> arbol 6
 
         X
        XXX
       XXXXX
      XXXXXXX
     XXXXXXXXX
    XXXXXXXXXXX
         X
         X
         X
 
   λ> arbol 7
 
          X
         XXX
        XXXXX
       XXXXXXX
      XXXXXXXXX
     XXXXXXXXXXX
    XXXXXXXXXXXXX
          X
          X
          X

Soluciones

arbol :: Int -> IO ()
arbol n = do
  putStrLn ""
  sequence_ [putStrLn c | c <- triangulo n]
  sequence_ [putStrLn c | c <- rectangulo n]
  putStrLn ""
 
triangulo :: Int -> [String]
triangulo n =
    [replicate (n-k) ' ' ++ replicate (1+2*k) 'X' | k <- [0..n-1]]
 
rectangulo :: Int -> [String]
rectangulo n =
    [replicate n ' ' ++ "X" | _ <- [1..n `div` 2]]
Leer más →