Menu Close

Etiqueta: concat

Tablas de operaciones binarias

Para representar las operaciones binarias en un conjunto finito A con n elementos se pueden numerar sus elementos desde el 0 al n-1. Entonces cada operación binaria en A se puede ver como una lista de listas xss tal que el valor de aplicar la operación a los elementos i y j es el j-ésimo elemento del i-ésimo elemento de xss. Por ejemplo, si A = {0,1,2} entonces las tabla de la suma y de la resta módulo 3 en A son

   0 1 2    0 2 1
   1 2 0    1 0 2
   2 0 1    2 1 0
   Suma     Resta

Definir las funciones

   tablaOperacion :: (Int -> Int -> Int) -> Int -> [[Int]]
   tablaSuma      :: Int -> [[Int]]
   tablaResta     :: Int -> [[Int]]
   tablaProducto  :: Int -> [[Int]]

tales que

  • (tablaOperacion f n) es la tabla de la operación f módulo n en [0..n-1]. Por ejemplo,
     tablaOperacion (+) 3  ==  [[0,1,2],[1,2,0],[2,0,1]]
     tablaOperacion (-) 3  ==  [[0,2,1],[1,0,2],[2,1,0]]
     tablaOperacion (-) 4  ==  [[0,3,2,1],[1,0,3,2],[2,1,0,3],[3,2,1,0]]
     tablaOperacion (\x y -> abs (x-y)) 3  ==  [[0,1,2],[1,0,1],[2,1,0]]
  • (tablaSuma n) es la tabla de la suma módulo n en [0..n-1]. Por ejemplo,
     tablaSuma 3  ==  [[0,1,2],[1,2,0],[2,0,1]]
     tablaSuma 4  ==  [[0,1,2,3],[1,2,3,0],[2,3,0,1],[3,0,1,2]]
  • (tablaResta n) es la tabla de la resta módulo n en [0..n-1]. Por ejemplo,
     tablaResta 3  ==  [[0,2,1],[1,0,2],[2,1,0]]
     tablaResta 4  ==  [[0,3,2,1],[1,0,3,2],[2,1,0,3],[3,2,1,0]]
  • (tablaProducto n) es la tabla del producto módulo n en [0..n-1]. Por ejemplo,
     tablaProducto 3  ==  [[0,0,0],[0,1,2],[0,2,1]]
     tablaProducto 4  ==  [[0,0,0,0],[0,1,2,3],[0,2,0,2],[0,3,2,1]]

Comprobar con QuickCheck, si parato entero positivo n de verificar las siguientes propiedades:

  • La suma, módulo n, de todos los números de (tablaSuma n) es 0.
  • La suma, módulo n, de todos los números de (tablaResta n) es 0.
  • La suma, módulo n, de todos los números de (tablaProducto n) es n/2 si n es el doble de un número impar y es 0, en caso contrario.

Soluciones

import Test.QuickCheck
 
tablaOperacion :: (Int -> Int -> Int) -> Int -> [[Int]]
tablaOperacion f n =
  [[f i j `mod` n | j <- [0..n-1]] | i <- [0..n-1]]
 
tablaSuma :: Int -> [[Int]]
tablaSuma = tablaOperacion (+)
 
tablaResta :: Int -> [[Int]]
tablaResta = tablaOperacion (-)
 
tablaProducto :: Int -> [[Int]]
tablaProducto = tablaOperacion (*)
 
-- (sumaTabla xss) es la suma, módulo n, de los elementos de la tabla de
-- operación xss (donde n es el número de elementos de xss). Por
-- ejemplo, 
--    sumaTabla [[0,2,1],[1,1,2],[2,1,0]]  ==  1
sumaTabla :: [[Int]] -> Int
sumaTabla = sum . concat
 
-- La propiedad de la tabla de la suma es
prop_tablaSuma :: (Positive Int) -> Bool
prop_tablaSuma (Positive n) =
  sumaTabla (tablaSuma n) == 0
 
-- La comprobación es
--    λ> quickCheck prop_tablaSuma
--    +++ OK, passed 100 tests.
 
-- La propiedad de la tabla de la resta es
prop_tablaResta :: (Positive Int) -> Bool
prop_tablaResta (Positive n) =
  sumaTabla (tablaResta n) == 0
 
-- La comprobación es
--    λ> quickCheck prop_tablaResta
--    +++ OK, passed 100 tests.
 
-- La propiedad de la tabla del producto es
prop_tablaProducto :: (Positive Int) -> Bool
prop_tablaProducto (Positive n)
  | even n && odd (n `div` 2) = suma == n `div` 2
  | otherwise                 = suma == 0
  where suma = sumaTabla (tablaProducto n)

Pensamiento

¿Tu verdad? No, la Verdad,
y ven conmigo a buscarla.
La tuya guárdatela.

Antonio Machado

Número de divisores compuestos

Definir la función

   nDivisoresCompuestos :: Integer -> Integer

tal que (nDivisoresCompuestos x) es el número de divisores de x que son compuestos (es decir, números mayores que 1 que no son primos). Por ejemplo,

   nDivisoresCompuestos 30  ==  4
   nDivisoresCompuestos (product [1..11])  ==  534
   nDivisoresCompuestos (product [1..25])  ==  340022
   length (show (nDivisoresCompuestos (product [1..3*10^4]))) == 1948

Soluciones

import Data.List (genericLength, group, inits, sort)
import Data.Numbers.Primes (primeFactors)
import Test.QuickCheck
 
-- 1ª solución
-- ===========
 
--    nDivisoresCompuestos 30  ==  4
nDivisoresCompuestos :: Integer -> Integer
nDivisoresCompuestos =
  genericLength . divisoresCompuestos
 
-- (divisoresCompuestos x) es la lista de los divisores de x que
-- son números compuestos (es decir, números mayores que 1 que no son
-- primos). Por ejemplo,
--    divisoresCompuestos 30  ==  [6,10,15,30]
divisoresCompuestos :: Integer -> [Integer]
divisoresCompuestos =
  sort
  . map product
  . compuestos
  . map concat
  . productoCartesiano
  . map inits
  . group
  . primeFactors
  where compuestos xss = [xs | xs <- xss, length xs > 1]  
 
-- (productoCartesiano xss) es el producto cartesiano de los conjuntos xss. Por
-- ejemplo, 
--    λ> productoCartesiano [[1,3],[2,5],[6,4]]
--    [[1,2,6],[1,2,4],[1,5,6],[1,5,4],[3,2,6],[3,2,4],[3,5,6],[3,5,4]]
productoCartesiano :: [[a]] -> [[a]]
productoCartesiano []       = [[]]
productoCartesiano (xs:xss) =
  [x:ys | x <- xs, ys <- productoCartesiano xss]
 
-- 2ª solución
-- ===========
 
nDivisoresCompuestos2 :: Integer -> Integer
nDivisoresCompuestos2 x =
  nDivisores x - nDivisoresPrimos x - 1
 
-- (nDivisores x) es el número de divisores de x. Por ejemplo, 
--    nDivisores 30  ==  8
nDivisores :: Integer -> Integer
nDivisores x =
  product [1 + genericLength xs | xs <- group (primeFactors x)]
 
-- (nDivisoresPrimos x) es el número de divisores primos de x. Por
-- ejemplo,  
--    nDivisoresPrimos 30  ==  3
nDivisoresPrimos :: Integer -> Integer
nDivisoresPrimos =
  genericLength . group . primeFactors 
 
-- 3ª solución
-- ===========
 
nDivisoresCompuestos3 :: Integer -> Integer
nDivisoresCompuestos3 x =
  nDivisores - nDivisoresPrimos - 1
  where xss              = group (primeFactors x)
        nDivisores       = product [1 + genericLength xs | xs <-xss]
        nDivisoresPrimos = genericLength xss
 
-- Equivalencia de las definiciones
-- ================================
 
-- La propiedad es
prop_nDivisoresCompuestos :: (Positive Integer) -> Bool
prop_nDivisoresCompuestos (Positive x) =
  all (== nDivisoresCompuestos x) [f x | f <- [ nDivisoresCompuestos2
                                              , nDivisoresCompuestos3 ]]
 
-- La comprobación es
--    λ> quickCheck prop_nDivisoresCompuestos
--    +++ OK, passed 100 tests.
 
-- Comparación de eficiencia
-- =========================
 
--    λ> nDivisoresCompuestos (product [1..25])
--    340022
--    (2.04 secs, 2,232,146,776 bytes)
--    λ> nDivisoresCompuestos2 (product [1..25])
--    340022
--    (0.00 secs, 220,192 bytes)
--    
--    λ> length (show (nDivisoresCompuestos2 (product [1..3*10^4])))
--    1948
--    (5.22 secs, 8,431,630,288 bytes)
--    λ> length (show (nDivisoresCompuestos3 (product [1..3*10^4])))
--    1948
--    (3.06 secs, 4,662,277,664 bytes)

Pensamiento

“Lo corriente en el hombre es la tendencia a creer verdadero cuanto le
reporta alguna utilidad. Por eso hay tantos hombres capaces de comulgar
con ruedas de molino.”

Antonio Machado

Divisores compuestos

Definir la función

   divisoresCompuestos :: Integer -> [Integer]

tal que (divisoresCompuestos x) es la lista de los divisores de x que son números compuestos (es decir, números mayores que 1 que no son primos). Por ejemplo,

   divisoresCompuestos 30  ==  [6,10,15,30]
   length (divisoresCompuestos (product [1..11]))  ==  534
   length (divisoresCompuestos (product [1..14]))  ==  2585
   length (divisoresCompuestos (product [1..16]))  ==  5369
   length (divisoresCompuestos (product [1..25]))  ==  340022

Soluciones

import Data.List (group, inits, nub, sort, subsequences)
import Data.Numbers.Primes (isPrime, primeFactors)
import Test.QuickCheck
 
-- 1ª solución
-- ===========
 
divisoresCompuestos :: Integer -> [Integer]
divisoresCompuestos x =
  [y | y <- divisores x
     , y > 1
     , not (isPrime y)]
 
-- (divisores x) es la lista de los divisores de x. Por ejemplo,
--    divisores 30  ==  [1,2,3,5,6,10,15,30]
divisores :: Integer -> [Integer]
divisores x =
  [y | y <- [1..x]
     , x `mod` y == 0]
 
-- 2ª solución
-- ===========
 
divisoresCompuestos2 :: Integer -> [Integer]
divisoresCompuestos2 x =
  [y | y <- divisores2 x
     , y > 1
     , not (isPrime y)]
 
-- (divisores2 x) es la lista de los divisores de x. Por ejemplo,
--    divisores2 30  ==  [1,2,3,5,6,10,15,30]
divisores2 :: Integer -> [Integer]
divisores2 x =
  [y | y <- [1..x `div` 2], x `mod` y == 0] ++ [x] 
 
-- 2ª solución
-- ===========
 
divisoresCompuestos3 :: Integer -> [Integer]
divisoresCompuestos3 x =
  [y | y <- divisores2 x
     , y > 1
     , not (isPrime y)]
 
-- (divisores3 x) es la lista de los divisores de x. Por ejemplo,
--    divisores2 30  ==  [1,2,3,5,6,10,15,30]
divisores3 :: Integer -> [Integer]
divisores3 x =
  nub (sort (ys ++ [x `div` y | y <- ys]))
  where ys = [y | y <- [1..floor (sqrt (fromIntegral x))]
                , x `mod` y == 0]
 
-- 4ª solución
-- ===========
 
divisoresCompuestos4 :: Integer -> [Integer]
divisoresCompuestos4 x =
  [y | y <- divisores4 x
     , y > 1
     , not (isPrime y)]
 
-- (divisores4 x) es la lista de los divisores de x. Por ejemplo,
--    divisores4 30  ==  [1,2,3,5,6,10,15,30]
divisores4 :: Integer -> [Integer]
divisores4 =
  nub . sort . map product . subsequences . primeFactors
 
-- 5ª solución
-- ===========
 
divisoresCompuestos5 :: Integer -> [Integer]
divisoresCompuestos5 x =
  [y | y <- divisores5 x
     , y > 1
     , not (isPrime y)]
 
-- (divisores5 x) es la lista de los divisores de x. Por ejemplo,
--    divisores5 30  ==  [1,2,3,5,6,10,15,30]
divisores5 :: Integer -> [Integer]
divisores5 =
  sort
  . map (product . concat)
  . productoCartesiano
  . map inits
  . group
  . primeFactors
 
-- (productoCartesiano xss) es el producto cartesiano de los conjuntos
-- xss. Por ejemplo, 
--    λ> productoCartesiano [[1,3],[2,5],[6,4]]
--    [[1,2,6],[1,2,4],[1,5,6],[1,5,4],[3,2,6],[3,2,4],[3,5,6],[3,5,4]]
productoCartesiano :: [[a]] -> [[a]]
productoCartesiano []       = [[]]
productoCartesiano (xs:xss) =
  [x:ys | x <- xs, ys <- productoCartesiano xss]
 
-- 6ª solución
-- ===========
 
divisoresCompuestos6 :: Integer -> [Integer]
divisoresCompuestos6 =
  sort
  . map product
  . compuestos
  . map concat
  . productoCartesiano
  . map inits
  . group
  . primeFactors
  where compuestos xss = [xs | xs <- xss, length xs > 1]  
 
-- Equivalencia de las definiciones
-- ================================
 
-- La propiedad es
prop_divisoresCompuestos :: (Positive Integer) -> Bool
prop_divisoresCompuestos (Positive x) =
  all (== divisoresCompuestos x) [f x | f <- [ divisoresCompuestos2
                                             , divisoresCompuestos3
                                             , divisoresCompuestos4
                                             , divisoresCompuestos5
                                             , divisoresCompuestos6 ]]
 
-- La comprobación es
--    λ> quickCheck prop_divisoresCompuestos
--    +++ OK, passed 100 tests.
 
-- Comparación de eficiencia
-- =========================
 
--    λ> length (divisoresCompuestos (product [1..11]))
--    534
--    (14.59 secs, 7,985,108,976 bytes)
--    λ> length (divisoresCompuestos2 (product [1..11]))
--    534
--    (7.36 secs, 3,993,461,168 bytes)
--    λ> length (divisoresCompuestos3 (product [1..11]))
--    534
--    (7.35 secs, 3,993,461,336 bytes)
--    λ> length (divisoresCompuestos4 (product [1..11]))
--    534
--    (0.07 secs, 110,126,392 bytes)
--    λ> length (divisoresCompuestos5 (product [1..11]))
--    534
--    (0.01 secs, 3,332,224 bytes)
--    λ> length (divisoresCompuestos6 (product [1..11]))
--    534
--    (0.01 secs, 1,869,776 bytes)
--    
--    λ> length (divisoresCompuestos4 (product [1..14]))
--    2585
--    (9.11 secs, 9,461,570,720 bytes)
--    λ> length (divisoresCompuestos5 (product [1..14]))
--    2585
--    (0.04 secs, 17,139,872 bytes)
--    λ> length (divisoresCompuestos6 (product [1..14]))
--    2585
--    (0.02 secs, 10,140,744 bytes)
--    
--    λ> length (divisoresCompuestos2 (product [1..16]))
--    5369
--    (1.97 secs, 932,433,176 bytes)
--    λ> length (divisoresCompuestos5 (product [1..16]))
--    5369
--    (0.03 secs, 37,452,088 bytes)
--    λ> length (divisoresCompuestos6 (product [1..16]))
--    5369
--    (0.03 secs, 23,017,480 bytes)
--    
--    λ> length (divisoresCompuestos5 (product [1..25]))
--    340022
--    (2.43 secs, 3,055,140,056 bytes)
--    λ> length (divisoresCompuestos6 (product [1..25]))
--    340022
--    (1.94 secs, 2,145,440,904 bytes)

Pensamiento

“La verdad del hombre empieza donde acaba su propia tontería, pero la
tontería del hombre es inagotable.”

Antonio Machado

Tren de potencias

Si n es el número natural cuya expansión decimal es abc… , el tren de potencias de n es a^bc^d… donde el último exponente es 1, si n tiene un número impar de dígitos. Por ejemplo

   trenDePotencias 2453  = 2^4*5^3     = 2000
   trenDePotencias 24536 = 2^4*5^3*6^1 = 12000

Definir las funciones

   trenDePotencias            :: Integer -> Integer
   esPuntoFijoTrenDePotencias :: Integer -> Bool
   puntosFijosTrenDePotencias :: [Integer]
   tablaTrenDePotencias       :: Integer -> Integer -> IO ()

tales que

  • (trenDePotencias n) es el tren de potencia de n. Por ejemplo.
     trenDePotencias 20   ==  1
     trenDePotencias 21   ==  2
     trenDePotencias 24   ==  16
     trenDePotencias 39   ==  19683
     trenDePotencias 623  ==  108
  • (esPuntoFijoTrenDePotencias n) se verifica si n es un punto fijo de trenDePotencias; es decir, (trenDePotencias n) es igual a n. Por ejemplo,
     esPuntoFijoTrenDePotencias 2592                        ==  True
     esPuntoFijoTrenDePotencias 24547284284866560000000000  ==  True
  • puntosFijosTrenDePotencias es la lista de los puntso fijos de trenDePotencias. Por ejemplo,
     take 10 puntosFijosTrenDePotencias  ==  [1,2,3,4,5,6,7,8,9,2592]
  • (tablaTrenDePotencias a b) es la tabla de los trenes de potencias de los números entre a y b. Por ejemplo,
     λ> tablaTrenDePotencias 20 39
     | 20 |     1 |
     | 21 |     2 |
     | 22 |     4 |
     | 23 |     8 |
     | 24 |    16 |
     | 25 |    32 |
     | 26 |    64 |
     | 27 |   128 |
     | 28 |   256 |
     | 29 |   512 |
     | 30 |     1 |
     | 31 |     3 |
     | 32 |     9 |
     | 33 |    27 |
     | 34 |    81 |
     | 35 |   243 |
     | 36 |   729 |
     | 37 |  2187 |
     | 38 |  6561 |
     | 39 | 19683 |
     λ> tablaTrenDePotencias 2340 2359
     | 2340 |        8 |
     | 2341 |       32 |
     | 2342 |      128 |
     | 2343 |      512 |
     | 2344 |     2048 |
     | 2345 |     8192 |
     | 2346 |    32768 |
     | 2347 |   131072 |
     | 2348 |   524288 |
     | 2349 |  2097152 |
     | 2350 |        8 |
     | 2351 |       40 |
     | 2352 |      200 |
     | 2353 |     1000 |
     | 2354 |     5000 |
     | 2355 |    25000 |
     | 2356 |   125000 |
     | 2357 |   625000 |
     | 2358 |  3125000 |
     | 2359 | 15625000 |

Comprobar con QuickCheck que entre 2593 y 24547284284866559999999999 la función trenDePotencias no tiene puntos fijos.

Soluciones

Puedes escribir tus soluciones en los comentarios o ver las soluciones propuestas pulsando aquí

import Test.QuickCheck
import Text.Printf
 
-- 1ª definición de trenDePotencias
-- ================================
 
trenDePotencias :: Integer -> Integer
trenDePotencias = trenDePotenciasLN . digitos
 
-- (digitos n) es la lista de los dígitos del número n. Por ejemplo,
--    digitos 2018  ==   [2,0,1,8]
digitos :: Integer -> [Integer]
digitos n =
  [read [c] | c <- show n]
 
-- (trenDePotenciasLN xs) es el tren de potencias de la lista de números
-- xs. Por ejemplo,
--    trenDePotenciasLN [2,4,5,3]    ==   2000
--    trenDePotenciasLN [2,4,5,3,6]  ==   12000
trenDePotenciasLN :: [Integer] -> Integer
trenDePotenciasLN []       = 1
trenDePotenciasLN [x]      = x
trenDePotenciasLN (u:v:ws) = u ^ v * (trenDePotenciasLN ws) 
 
-- 2ª definición de trenDePotencias
-- ================================
 
trenDePotencias2 :: Integer -> Integer
trenDePotencias2 = trenDePotenciasLN2 . digitos
 
-- (trenDePotenciasLN2 xs) es el tren de potencias de la lista de números
-- xs. Por ejemplo,
--    trenDePotenciasLN2 [2,4,5,3]    ==   2000
--    trenDePotenciasLN2 [2,4,5,3,6]  ==   12000
trenDePotenciasLN2 :: [Integer] -> Integer
trenDePotenciasLN2 xs =
  product [x^y | (x,y) <- pares xs]
 
-- (pares xs) es la lista de los pares de elementos en la posiciones
-- pares y sus siguientes; si la longitud de xs es impar, la segunda
-- componente del último par es 1. Por ejemplo,
--    pares [2,4,5,3]    ==   [(2,4),(5,3)]
--    pares [2,4,5,3,6]  ==   [(2,4),(5,3),(6,1)]
pares :: [Integer] -> [(Integer,Integer)]
pares []       = []
pares [x]      = [(x,1)]
pares (x:y:zs) = (x,y) : pares zs
 
-- Equivalencia
-- ============
 
-- La propiedad es
prop_equivalencia :: (Positive Integer) -> Bool
prop_equivalencia (Positive n) =
  trenDePotencias n == trenDePotencias2 n
 
-- La comprobación es
--    λ> quickCheck prop_equivalencia
--    +++ OK, passed 100 tests.
 
-- Comparación de eficiencia
-- =========================
 
--    λ> let n = 2*10^5 in trenDePotencias (read (replicate n '2')) == 2^n
--    True
--    (2.11 secs, 2,224,301,136 bytes)
--    λ> let n = 2*10^5 in trenDePotencias2 (read (replicate n '2')) == 2^n
--    True
--    (2.08 secs, 2,237,749,216 bytes)
 
-- Definición de esPuntoFijoTrenDePotencias
-- ========================================
 
esPuntoFijoTrenDePotencias :: Integer -> Bool
esPuntoFijoTrenDePotencias n =
  trenDePotencias n == n
 
-- Definición de puntosFijosTrenDePotencias
-- ========================================
 
puntosFijosTrenDePotencias :: [Integer]
puntosFijosTrenDePotencias =
  filter esPuntoFijoTrenDePotencias [1..]
 
-- Definición de tablaTrenDePotencias
-- ==================================
 
tablaTrenDePotencias :: Integer -> Integer -> IO ()
tablaTrenDePotencias a b =
  sequence_ [printf cabecera x y | (x,y) <- trenes]
  where trenes  = [(n,trenDePotencias n) | n <- [a..b]]
        m1      = show (1 + length (show b))
        m2      = show (length (show (maximum (map snd trenes))))
        cabecera = concat ["|% ",m1,"d | %", m2,"d |\n"]
 
-- Comprobación
-- ============
 
-- La propiedad es
prop_puntosFijos :: Positive Integer -> Property
prop_puntosFijos (Positive n) =
  x < 24547284284866560000000000 ==> not (esPuntoFijoTrenDePotencias x)
  where x = 2593 + n 
 
-- La comprobación es
--    λ> quickCheck prop_puntosFijos
--    +++ OK, passed 100 tests.

Recorrido en ZigZag

El recorrido en ZigZag de una matriz consiste en pasar de la primera fila hasta la última, de izquierda a derecha en las filas impares y de derecha a izquierda en las filas pares, como se indica en la figura.

         /             \
         | 1 -> 2 -> 3 |
         |           | |
         |           v |
         | 4 <- 5 <- 6 |   =>  Recorrido ZigZag: [1,2,3,6,5,4,7,8,9]
         | |           |
         | v           |
         | 7 -> 8 -> 9 |
         \             /

Definir la función

   recorridoZigZag :: Matrix a -> [a]

tal que (recorridoZigZag m) es la lista con los elementos de la matriz m cuando se recorre esta en ZigZag. Por ejemplo,

   λ> recorridoZigZag (fromLists [[1,2,3],[4,5,6],[7,8,9]])
   [1,2,3,6,5,4,7,8,9]
   λ> recorridoZigZag (fromLists [[1,2],[3,4],[5,6],[7,8]])
   [1,2,4,3,5,6,8,7]
   λ> recorridoZigZag (fromLists [[1,2,3,4],[5,6,7,8],[9,10,11,12]])
   [1,2,3,4,8,7,6,5,9,10,11,12]
   λ> recorridoZigZag (fromList 5 4 "Cada paso es la meta")
   "Cadasap o es al meta"
   λ> recorridoZigZag (fromList 4 5 "Cada paso es la meta")
   "Cada  osapes laatem "
   λ> recorridoZigZag (fromList 10 2 "Cada paso es la meta")
   "Caad psao se l ameat"
   λ> recorridoZigZag (fromList 2 10 "Cada paso es la meta")
   "Cada paso atem al se"

Soluciones

import Data.Matrix (Matrix, toLists, fromLists, fromList)
 
recorridoZigZag :: Matrix a -> [a]
recorridoZigZag m =
  concat [f xs | (f,xs) <- zip (cycle [id,reverse]) (toLists m)]

Sucesiones suaves

Una sucesión es suave si valor absoluto de la diferencia de sus términos consecutivos es 1.

Definir la función

   suaves :: Int -> [[Int]]

tal que (suaves n) es la lista de las sucesiones suaves de longitud n cuyo último término es 0. Por ejemplo,

   suaves 2  ==  [[1,0],[-1,0]]
   suaves 3  ==  [[2,1,0],[0,1,0],[0,-1,0],[-2,-1,0]]

Soluciones

suaves :: Int -> [[Int]]
suaves 0 = []
suaves 1 = [[0]]
suaves n = concat [[x+1:x:xs,x-1:x:xs] | (x:xs) <- suaves (n-1)]

Cálculo de pi mediante la serie de Nilakantha

Una serie infinita para el cálculo de pi, publicada por Nilakantha en el siglo XV, es
Calculo_de_pi_mediante_la_serie_de_Nilakantha

Definir las funciones

   aproximacionPi :: Int -> Double
   tabla          :: FilePath -> [Int] -> IO ()

tales que

  • (aproximacionPi n) es la n-ésima aproximación de pi obtenido sumando los n primeros términos de la serie de Nilakantha. Por ejemplo,
     aproximacionPi 0        ==  3.0
     aproximacionPi 1        ==  3.1666666666666665
     aproximacionPi 2        ==  3.1333333333333333
     aproximacionPi 3        ==  3.145238095238095
     aproximacionPi 4        ==  3.1396825396825396
     aproximacionPi 5        ==  3.1427128427128426
     aproximacionPi 10       ==  3.1414067184965018
     aproximacionPi 100      ==  3.1415924109719824
     aproximacionPi 1000     ==  3.141592653340544
     aproximacionPi 10000    ==  3.141592653589538
     aproximacionPi 100000   ==  3.1415926535897865
     aproximacionPi 1000000  ==  3.141592653589787
     pi                      ==  3.141592653589793
  • (tabla f ns) escribe en el fichero f las n-ésimas aproximaciones de pi, donde n toma los valores de la lista ns, junto con sus errores. Por ejemplo, al evaluar la expresión
     tabla "AproximacionesPi.txt" [0,10..100]

hace que el contenido del fichero “AproximacionesPi.txt” sea

+------+----------------+----------------+
| n    | Aproximación   | Error          |
+------+----------------+----------------+
|    0 | 3.000000000000 | 0.141592653590 |
|   10 | 3.141406718497 | 0.000185935093 |
|   20 | 3.141565734659 | 0.000026918931 |
|   30 | 3.141584272675 | 0.000008380915 |
|   40 | 3.141589028941 | 0.000003624649 |
|   50 | 3.141590769850 | 0.000001883740 |
|   60 | 3.141591552546 | 0.000001101044 |
|   70 | 3.141591955265 | 0.000000698325 |
|   80 | 3.141592183260 | 0.000000470330 |
|   90 | 3.141592321886 | 0.000000331704 |
|  100 | 3.141592410972 | 0.000000242618 |
+------+----------------+----------------+

al evaluar la expresión

     tabla "AproximacionesPi.txt" [0,500..5000]

hace que el contenido del fichero “AproximacionesPi.txt” sea

+------+----------------+----------------+
| n    | Aproximación   | Error          |
+------+----------------+----------------+
|    0 | 3.000000000000 | 0.141592653590 |
|  500 | 3.141592651602 | 0.000000001988 |
| 1000 | 3.141592653341 | 0.000000000249 |
| 1500 | 3.141592653516 | 0.000000000074 |
| 2000 | 3.141592653559 | 0.000000000031 |
| 2500 | 3.141592653574 | 0.000000000016 |
| 3000 | 3.141592653581 | 0.000000000009 |
| 3500 | 3.141592653584 | 0.000000000006 |
| 4000 | 3.141592653586 | 0.000000000004 |
| 4500 | 3.141592653587 | 0.000000000003 |
| 5000 | 3.141592653588 | 0.000000000002 |
+------+----------------+----------------+

Soluciones

import Text.Printf
 
-- 1ª solución
-- ===========
 
aproximacionPi :: Int -> Double
aproximacionPi n = serieNilakantha !! n
 
serieNilakantha :: [Double]
serieNilakantha = scanl1 (+) terminosNilakantha
 
terminosNilakantha :: [Double]
terminosNilakantha = zipWith (/) numeradores denominadores
  where numeradores   = 3 : cycle [4,-4]
        denominadores = 1 : [n*(n+1)*(n+2) | n <- [2,4..]]
 
-- 2ª solución
-- ===========
 
aproximacionPi2 :: Int -> Double
aproximacionPi2 = aux 3 2 1
  where aux x _ _ 0 = x
        aux x y z m =
          aux (x+4/product[y..y+2]*z) (y+2) (negate z) (m-1)
 
-- Comparación de eficiencia
-- =========================
 
--    λ> aproximacionPi (2*10^5)
--    3.141592653589787
--    (0.82 secs, 145,964,728 bytes)
--    λ> aproximacionPi2 (2*10^5)
--    3.141592653589787
--    (2.27 secs, 432,463,496 bytes)
--    λ> aproximacionPi (3*10^5)
--    3.141592653589787
--    (0.34 secs, 73,056,488 bytes)
--    λ> aproximacionPi2 (3*10^5)
--    3.141592653589787
--    (3.24 secs, 648,603,824 bytes)
 
-- Definicioń de tabla
-- ===================
 
tabla :: FilePath -> [Int] -> IO ()
tabla f ns = do
  writeFile f (tablaAux ns)
 
tablaAux :: [Int] -> String
tablaAux ns =
     linea
  ++ cabecera
  ++ linea
  ++ concat [printf "| %4d | %.12f | %.12f |\n" n a e
            | n <- ns
            , let a = aproximacionPi n
            , let e = abs (pi - a)]
  ++ linea
 
linea :: String
linea = "+------+----------------+----------------+\n"
 
cabecera :: String
cabecera = "| n    | Aproximación   | Error          |\n"

Mayor número obtenido intercambiando dos dígitos

Definir la función

   maximoIntercambio :: Int -> Int

tal que (maximoIntercambio x) es el máximo número que se puede obtener intercambiando dos dígitos de x. Por ejemplo,

   maximoIntercambio 983562  ==  986532
   maximoIntercambio 31524   ==  51324
   maximoIntercambio 897     ==  987

Soluciones

import Data.Array
 
-- 1ª solución
-- ===========
 
maximoIntercambio :: Int -> Int
maximoIntercambio = maximum . intercambios
 
-- (intercambios x) es la lista de los números obtenidos intercambiando
-- dos dígitos de x. Por ejemplo,
--    intercambios 1234  ==  [2134,3214,4231,1324,1432,1243]
intercambios :: Int -> [Int]
intercambios x = [intercambio i j x | i <- [0..n-2], j <- [i+1..n-1]]
    where n = length (show x)
 
-- (intercambio i j x) es el número obtenido intercambiando las cifras
-- que ocupan las posiciones i y j (empezando a contar en cero) del
-- número x. Por ejemplo,
--    intercambio 2 5 123456789  ==  126453789
intercambio :: Int -> Int -> Int -> Int
intercambio i j x = read (concat [as,[d],cs,[b],ds])
    where xs        = show x
          (as,b:bs) = splitAt i xs 
          (cs,d:ds) = splitAt (j-i-1) bs
 
-- 2ª solución (con vectores)
-- ==========================
 
maximoIntercambio2 :: Int -> Int
maximoIntercambio2 = read . elems . maximum . intercambios2
 
-- (intercambios2 x) es la lista de los vectores obtenidos
-- intercambiando dos elementos del vector de dígitos de x. Por ejemplo, 
--    ghci> intercambios2 1234
--    [array (0,3) [(0,'2'),(1,'1'),(2,'3'),(3,'4')],
--     array (0,3) [(0,'3'),(1,'2'),(2,'1'),(3,'4')],
--     array (0,3) [(0,'4'),(1,'2'),(2,'3'),(3,'1')],
--     array (0,3) [(0,'1'),(1,'3'),(2,'2'),(3,'4')],
--     array (0,3) [(0,'1'),(1,'4'),(2,'3'),(3,'2')],
--     array (0,3) [(0,'1'),(1,'2'),(2,'4'),(3,'3')]]
intercambios2 :: Int -> [Array Int Char]
intercambios2 x = [intercambioV i j v | i <- [0..n-2], j <- [i+1..n-1]]
    where xs = show x
          n  = length xs
          v  = listArray (0,n-1) xs
 
-- (intercambioV i j v) es el vector obtenido intercambiando los
-- elementos de v que ocupan las posiciones i y j. Por ejemplo,
--    ghci> intercambioV 2 4 (listArray (0,4) [3..8])
--    array (0,4) [(0,3),(1,4),(2,7),(3,6),(4,5)]
intercambioV :: Int -> Int -> Array Int a -> Array Int a
intercambioV i j v = v // [(i,v!j),(j,v!i)]

Suma de los dígitos de las repeticiones de un número

Dados dos números naturales n y x, su suma reducida se obtiene a partir del número obtenido repitiendo n veces el x sumando sus dígitos hasta obtener un número con sólo un dígito. Por ejemplo, si n es 3 y x es 24 las transformaciones son

   242424 ==> 18 ==> 9

Análogamente, si n es 4 y x es 7988 las transformaciones son

   7988798879887988 ==> 128 ==> 11 ==> 2

Definir las funciones

   sumaReducidaDigitosRepeticiones :: Integer -> Integer -> Integer
   grafica                         :: Integer -> IO ()

tales que

  • (sumaReducidaDigitosRepeticiones n x) es la suma reducida de n repeticiones de x. Por ejemplo
     sumaReducidaDigitosRepeticiones 3 24                    ==  9
     sumaReducidaDigitosRepeticiones 4 7988                  == 2
     sumaReducidaDigitosRepeticiones (12^(10^7)) (12^(10^7)) == 9
  • (grafica n) dibuja la gráfica de los n primeros elementos de la sucesión cuyo elementos k-ésimo es (sumaReducidaDigitosRepeticiones k k). Por ejemplo, (grafica 50) dibuja
    Suma_de_los_digitos_de_las_repeticiones_de_un_numero50

Soluciones

import Data.List (genericReplicate)
import Graphics.Gnuplot.Simple
import Test.QuickCheck
 
-- 1ª solución
-- ===========
 
sumaReducidaDigitosRepeticiones :: Integer -> Integer -> Integer
sumaReducidaDigitosRepeticiones n x =
  sumaReducidaDigitos (repeticiones n x) 
 
-- (repeticiones n x) es el número obtenido repitiendo n veces el x. Por
-- ejemplo, 
--    repeticiones 3 24   ==  242424
--    repeticiones 4 325  ==  325325325325
repeticiones :: Integer -> Integer -> Integer
repeticiones n x = read (concat (genericReplicate n (show x)))
 
-- (sumaDigitos x) es la suma de los dígitos de x. Por ejemplo,
--    sumaDigitos 325  ==  10
sumaDigitos :: Integer -> Integer
sumaDigitos x | x < 10    = x
              | otherwise = b + sumaDigitos a
  where (a,b) = divMod x 10
 
-- (sumaReducidaDigitos x) es el número obtenido a partir de x
-- reiterando la suma de los dígitos hasta obtener un número con sólo un
-- dígito. Por ejemplo,
--    sumaReducidaDigitos 24   ==  6
--    sumaReducidaDigitos 325  ==  1
sumaReducidaDigitos :: Integer -> Integer
sumaReducidaDigitos x | x < 10    = x
                      | otherwise = sumaReducidaDigitos (sumaDigitos x)
 
-- 2ª solución
-- ===========
 
sumaReducidaDigitosRepeticiones2 :: Integer -> Integer -> Integer
sumaReducidaDigitosRepeticiones2 n x =
  sumaReducidaDigitos2 (n * sumaReducidaDigitos2 x) 
 
sumaReducidaDigitos2 :: Integer -> Integer
sumaReducidaDigitos2 0 = 0
sumaReducidaDigitos2 x | y == 0    = 9
                       | otherwise = y
  where y = x `mod` 9
 
-- Equivalencia de las definiciones
-- ================================
 
-- La propiedad es
prop_equiv :: Positive Integer -> Positive Integer -> Bool
prop_equiv (Positive n) (Positive x) =
  sumaReducidaDigitosRepeticiones n x == sumaReducidaDigitosRepeticiones2 n x 
 
-- La comprobación es
--    λ> quickCheck prop_equiv
--    +++ OK, passed 100 tests.
 
-- Comparación de eficiencia
-- =========================
 
--    λ> sumaReducidaDigitosRepeticiones (10^4) (10^4)
--    1
--    (2.00 secs, 574,667,384 bytes)
--    λ> sumaReducidaDigitosRepeticiones2 (10^4) (10^4)
--    1
--    (0.03 secs, 141,120 bytes)
 
-- Gráfica
-- =======
 
grafica :: Integer -> IO ()
grafica n =
  plotList [Key Nothing]
           [sumaReducidaDigitosRepeticiones2 k k | k <- [1..n]]

Recorrido de árboles en espiral

Los árboles se pueden representar mediante el siguiente tipo de datos

   data Arbol a = N a [Arbol a]
     deriving Show

Por ejemplo, los árboles

         1             1             1  
        /  \          / \           / \ 
       /    \        8   3         8   3
      2      3          /|\       /|\  |
     / \    / \        4 5 6     4 5 6 7
    4   5  6   7

se representan por

   ej1, ej2, ej3 :: Arbol Int
   ej1 = N 1 [N 2 [N 4 [], N 5 []], N 3 [N 6 [], N 7 []]]
   ej2 = N 1 [N 8 [], N 3 [N 4 [], N 5 [], N 6 []]]
   ej3 = N 1 [N 8 [N 4 [], N 5 [], N 6 []], N 3 [N 7 []]]

Definir la función

   espiral :: Arbol a -> [a]

tal que (espiral x) es la lista de los nodos del árbol x recorridos en espiral; es decir, la raíz de x, los nodos del primer nivel de izquierda a derecha, los nodos del segundo nivel de derecha a izquierda y así sucesivamente. Por ejemplo,

   espiral ej1  ==  [1,2,3,7,6,5,4]
   espiral ej2  ==  [1,8,3,6,5,4]
   espiral ej3  ==  [1,8,3,7,6,5,4]

Soluciones

data Arbol a = N a [Arbol a]
  deriving Show
 
ej1, ej2, ej3 :: Arbol Int
ej1 = N 1 [N 2 [N 4 [], N 5 []], N 3 [N 6 [], N 7 []]]
ej2 = N 1 [N 8 [], N 3 [N 4 [], N 5 [], N 6 []]]
ej3 = N 1 [N 8 [N 4 [], N 5 [], N 6 []], N 3 [N 7 []]]
 
-- 1ª solución
-- ===========
 
espiral :: Arbol a -> [a]
espiral x =
  concat [f xs | (f,xs) <- zip (cycle [reverse,id]) (niveles x)]
 
-- (niveles x) es la lista de los niveles del árbol x. Por ejemplo, 
--    niveles ej1 == [[1],[8,3],[4]]
--    niveles ej2 == [[1],[8,3],[4,5,6]]
--    niveles ej3 == [[1],[8,3],[4,5,6,7]]
niveles :: Arbol a -> [[a]]
niveles x = takeWhile (not . null) [nivel n x | n <- [0..]]
 
-- (nivel n x) es el nivel de nivel n del árbol x. Por ejemplo,
--    nivel 0 ej1  ==  [1]
--    nivel 1 ej1  ==  [8,3]
--    nivel 2 ej1  ==  [4]
--    nivel 4 ej1  ==  []
nivel :: Int -> Arbol a ->  [a]
nivel 0 (N x _)  = [x]
nivel n (N _ xs) = concatMap (nivel (n-1)) xs
 
-- 2ª solución
-- ===========
 
espiral2 :: Arbol a -> [a]
espiral2 = 
  concat . zipWith ($) (cycle [reverse,id]) . niveles
 
-- 3ª solución
-- ===========
 
espiral3 :: Arbol a -> [a]
espiral3 = concat . zipWith ($) (cycle [reverse,id]) . niveles3
 
niveles3 :: Arbol a -> [[a]]
niveles3 t = map (map raiz)
           . takeWhile (not . null)
           . iterate (concatMap subBosque) $ [t]
 
raiz :: Arbol a -> a
raiz (N x _) = x
 
subBosque :: Arbol a -> [Arbol a]
subBosque (N _ ts) = ts
 
-- 4ª solución
-- ===========
 
espiral4 :: Arbol a -> [a]
espiral4 = concat . zipWith ($) (cycle [reverse,id]) . niveles4
 
niveles4 :: Arbol a -> [[a]]
niveles4 = map (map raiz)
         . takeWhile (not . null)
         . iterate (concatMap subBosque)
         . return  
 
-- 5ª definición
-- =============
 
espiral5 :: Arbol a -> [a]
espiral5 x = concat $ zipWith ($) (cycle [reverse,id]) $ niveles5 [x]
 
niveles5 :: [Arbol a] -> [[a]]
niveles5 [] = []
niveles5 xs = a : niveles5 (concat b)
  where (a,b) = unzip $ map (\(N x y) -> (x,y)) xs
 
-- 6ª definición
-- =============
 
espiral6 :: Arbol a -> [a]
espiral6 = concat . zipWith ($) (cycle [reverse,id]) . niveles5 . return