Recursión – Página 14

Listas de igual longitud

PorJosé A. Alonso 23-noviembre-201530-noviembre-2015

Definir la función

   mismaLongitud :: [[a]] -> Bool

1	mismaLongitud :: [[a]] -> Bool

tal que (mismaLongitud xss) se verifica si todas las listas de la lista de listas xss tienen la misma longitud. Por ejemplo,

   mismaLongitud [[1,2],[6,4],[0,0],[7,4]] == True
   mismaLongitud [[1,2],[6,4,5],[0,0]]     == False

1 2	mismaLongitud [[1,2],[6,4],[0,0],[7,4]] == True mismaLongitud [[1,2],[6,4,5],[0,0]] == False

Soluciones

import Data.List (nub)    

-- 1ª solución:
mismaLongitud1 :: [[a]] -> Bool
mismaLongitud1 []       = True
mismaLongitud1 (xs:xss) = and [length ys == n | ys <- xss]
    where n = length xs

-- 2ª solución:
mismaLongitud2 :: [[a]] -> Bool
mismaLongitud2 xss = 
    and [length xs == length ys | (xs,ys) <- zip xss (tail xss)]

-- 3ª solución:
mismaLongitud3 :: [[a]] -> Bool
mismaLongitud3 (xs:ys:xss) = 
    length xs == length ys && mismaLongitud3 (ys:xss)
mismaLongitud3 _ = True           

-- 4ª solución
mismaLongitud4 :: [[a]] -> Bool
mismaLongitud4 [] = True
mismaLongitud4 (xs:xss) =
    all (\ys -> length ys == n) xss
    where n = length xs 

-- 5ª solución
mismaLongitud5 :: [[a]] -> Bool
mismaLongitud5 xss = length (nub [length xs | xs <- xss]) == 1

-- 6ª solución
mismaLongitud6 :: [[a]] -> Bool
mismaLongitud6 = null . drop 1 . nub . map length

-- Comparación de eficiencia
--    λ> mismaLongitud1 (replicate 20000 (replicate 20000 5))
--    True
--    (5.05 secs, 0 bytes)
--    λ> mismaLongitud2 (replicate 20000 (replicate 20000 5))
--    True
--    (9.98 secs, 0 bytes)
--    λ> mismaLongitud3 (replicate 20000 (replicate 20000 5))
--    True
--    (10.17 secs, 0 bytes)
--    λ> mismaLongitud4 (replicate 20000 (replicate 20000 5))
--    True
--    (5.18 secs, 0 bytes)
--    λ> mismaLongitud5 (replicate 20000 (replicate 20000 5))
--    True
--    (4.30 secs, 0 bytes)
--    λ> mismaLongitud6 (replicate 20000 (replicate 20000 5))
--    True
--    (4.19 secs, 0 bytes)

import Data.List (nub)

-- 1ª solución:

mismaLongitud1 :: [[a]] -> Bool

mismaLongitud1 [] = True

mismaLongitud1 (xs:xss) = and [length ys == n | ys <- xss]

where n = length xs

-- 2ª solución:

mismaLongitud2 :: [[a]] -> Bool

mismaLongitud2 xss =

and [length xs == length ys | (xs,ys) <- zip xss (tail xss)]

-- 3ª solución:

mismaLongitud3 :: [[a]] -> Bool

mismaLongitud3 (xs:ys:xss) =

length xs == length ys && mismaLongitud3 (ys:xss)

mismaLongitud3 _ = True

-- 4ª solución

mismaLongitud4 :: [[a]] -> Bool

mismaLongitud4 [] = True

mismaLongitud4 (xs:xss) =

all (\ys -> length ys == n) xss

where n = length xs

-- 5ª solución

mismaLongitud5 :: [[a]] -> Bool

mismaLongitud5 xss = length (nub [length xs | xs <- xss]) == 1

-- 6ª solución

mismaLongitud6 :: [[a]] -> Bool

mismaLongitud6 = null . drop 1 . nub . map length

-- Comparación de eficiencia

-- λ> mismaLongitud1 (replicate 20000 (replicate 20000 5))

-- True

-- (5.05 secs, 0 bytes)

-- λ> mismaLongitud2 (replicate 20000 (replicate 20000 5))

-- True

-- (9.98 secs, 0 bytes)

-- λ> mismaLongitud3 (replicate 20000 (replicate 20000 5))

-- True

-- (10.17 secs, 0 bytes)

-- λ> mismaLongitud4 (replicate 20000 (replicate 20000 5))

-- True

-- (5.18 secs, 0 bytes)

-- λ> mismaLongitud5 (replicate 20000 (replicate 20000 5))

-- True

-- (4.30 secs, 0 bytes)

-- λ> mismaLongitud6 (replicate 20000 (replicate 20000 5))

-- True

-- (4.19 secs, 0 bytes)

Subárboles monovalorados

PorJosé A. Alonso 19-noviembre-201525-abril-2021

Los árboles binarios con valores enteros se pueden representar mediante el tipo Arbol definido por

   data Arbol = H Int 
              | N Int Arbol Arbol
              deriving Show

data Arbol = H Int

| N Int Arbol Arbol

deriving Show

Por ejemplo, el árbol

         7
        / \ 
       /   \
      /     \
     4       9
    / \     / \
   1   3   5   6

/ \

4 9

/ \ / \

1 3 5 6

se puede representar por

   N 7 (N 4 (H 1) (H 3)) (N 9 (H 5) (H 6))

1	N 7 (N 4 (H 1) (H 3)) (N 9 (H 5) (H 6))

Un árbol es monovalorado si todos sus elementos son iguales. Por ejemplo, de los siguientes árboles sólo son monovalorados los dos primeros

    5          9           5          9    
   / \        / \         / \        / \   
  5   5      9   9       5   6      9   7  
                / \                    / \ 
               9   9                  9   9

5 9 5 9

/ \ / \ / \ / \

5 5 9 9 5 6 9 7

/ \ / \

9 9 9 9

Definir la función

   monovalorados :: Arbol -> [Arbol]

1	monovalorados :: Arbol -> [Arbol]

tal que (monovalorados a) es la lista de los subárboles monovalorados de a. Por ejemplo,

   λ> monovalorados (N 5 (H 5) (H 5))
   [N 5 (H 5) (H 5),H 5,H 5]
   λ> monovalorados (N 5 (H 5) (H 6))
   [H 5,H 6]
   λ> monovalorados (N 9 (H 9) (N 9 (H 9) (H 9)))
   [N 9 (H 9) (N 9 (H 9) (H 9)),H 9,N 9 (H 9) (H 9),H 9,H 9]
   λ> monovalorados (N 9 (H 9) (N 7 (H 9) (H 9)))
   [H 9,H 9,H 9]
   λ> monovalorados (N 9 (H 9) (N 9 (H 7) (H 9)))
   [H 9,H 7,H 9]

λ> monovalorados (N 5 (H 5) (H 5))

[N 5 (H 5) (H 5),H 5,H 5]

λ> monovalorados (N 5 (H 5) (H 6))

[H 5,H 6]

λ> monovalorados (N 9 (H 9) (N 9 (H 9) (H 9)))

[N 9 (H 9) (N 9 (H 9) (H 9)),H 9,N 9 (H 9) (H 9),H 9,H 9]

λ> monovalorados (N 9 (H 9) (N 7 (H 9) (H 9)))

[H 9,H 9,H 9]

λ> monovalorados (N 9 (H 9) (N 9 (H 7) (H 9)))

[H 9,H 7,H 9]

Soluciones

data Arbol = H Int 
           | N Int Arbol Arbol
           deriving (Show, Eq)

monovalorados :: Arbol -> [Arbol]
monovalorados (H x) = [H x]
monovalorados (N x i d) 
    | todosIguales i x && todosIguales d x =
        (N x i d) : (subarboles i ++ subarboles d)
    | otherwise = monovalorados i ++ monovalorados d

-- (todosIguales a x) se verifica si todos los valores de los nodos y
-- las hojas del árbol a son iguales a x.
todosIguales :: Arbol -> Int -> Bool
todosIguales (H y) x     = y == x
todosIguales (N y i d) x = y == x && todosIguales i x && todosIguales d x

-- (subarboles a) es la lista de los subárboles de a.
subarboles :: Arbol -> [Arbol]
subarboles (H x)     = [H x]
subarboles (N x i d) = (N x i d) : (subarboles i ++ subarboles d)

data Arbol = H Int

| N Int Arbol Arbol

deriving (Show, Eq)

monovalorados :: Arbol -> [Arbol]

monovalorados (H x) = [H x]

monovalorados (N x i d)

| todosIguales i x && todosIguales d x =

(N x i d) : (subarboles i ++ subarboles d)

| otherwise = monovalorados i ++ monovalorados d

-- (todosIguales a x) se verifica si todos los valores de los nodos y

-- las hojas del árbol a son iguales a x.

todosIguales :: Arbol -> Int -> Bool

todosIguales (H y) x = y == x

todosIguales (N y i d) x = y == x && todosIguales i x && todosIguales d x

-- (subarboles a) es la lista de los subárboles de a.

subarboles :: Arbol -> [Arbol]

subarboles (H x) = [H x]

subarboles (N x i d) = (N x i d) : (subarboles i ++ subarboles d)

Productos de N números consecutivos

PorJosé A. Alonso 17-noviembre-201526-marzo-2022

La semana pasada se planteó en Twitter el siguiente problema

Se observa que

      1x2x3x4 = 2x3x4 
      2x3x4x5 = 4x5x6

1 2	1x2x3x4 = 2x3x4 2x3x4x5 = 4x5x6

¿Existen ejemplos de otros productos de cuatro enteros consecutivos iguales a un producto de tres enteros consecutivos?

Definir la función

   esProductoDeNconsecutivos :: Integer -> Integer -> Maybe Integer

1	esProductoDeNconsecutivos :: Integer -> Integer -> Maybe Integer

tal que (esProductoDeNconsecutivos n x) es (Just m) si x es el producto de n enteros consecutivos a partir de m y es Nothing si x no es el producto de n enteros consecutivos. Por ejemplo,

   esProductoDeNconsecutivos 3   6  == Just 1
   esProductoDeNconsecutivos 4   6  == Nothing
   esProductoDeNconsecutivos 4  24  == Just 1
   esProductoDeNconsecutivos 3  24  == Just 2
   esProductoDeNconsecutivos 3 120  == Just 4
   esProductoDeNconsecutivos 4 120  == Just 2

esProductoDeNconsecutivos 3 6 == Just 1

esProductoDeNconsecutivos 4 6 == Nothing

esProductoDeNconsecutivos 4 24 == Just 1

esProductoDeNconsecutivos 3 24 == Just 2

esProductoDeNconsecutivos 3 120 == Just 4

esProductoDeNconsecutivos 4 120 == Just 2

Para ejemplos mayores,

   λ> esProductoDeNconsecutivos 3 (product [10^20..2+10^20])
   Just 100000000000000000000
   λ> esProductoDeNconsecutivos2 4 (product [10^20..2+10^20])
   Nothing
   λ> esProductoDeNconsecutivos2 4 (product [10^20..3+10^20])
   Just 100000000000000000000

λ> esProductoDeNconsecutivos 3 (product [10^20..2+10^20])

Just 100000000000000000000

λ> esProductoDeNconsecutivos2 4 (product [10^20..2+10^20])

Nothing

λ> esProductoDeNconsecutivos2 4 (product [10^20..3+10^20])

Just 100000000000000000000

Usando la función esProductoDeNconsecutivos resolver el problema.

Soluciones

import Data.Maybe

-- 1ª definición
esProductoDeNconsecutivos1 :: Integer -> Integer -> Maybe Integer
esProductoDeNconsecutivos1 n x 
    | null productos = Nothing
    | otherwise      = Just (head productos)
    where productos = [m | m <- [1..x-n], product [m..m+n-1] == x]

-- 2ª definición
esProductoDeNconsecutivos2 :: Integer -> Integer -> Maybe Integer
esProductoDeNconsecutivos2 n x = aux k
    where k = floor (fromIntegral x ** (1/(fromIntegral n))) - (n `div` 2)
          aux m | y == x    = Just m
                | y <  x    = aux (m+1)
                | otherwise = Nothing
                where y = product [m..m+n-1]

-- Comparación de eficiencia
--    λ> esProductoDeNconsecutivos1 3 (product [10^7..2+10^7])
--    Just 10000000
--    (12.37 secs, 5678433692 bytes)
--    λ> esProductoDeNconsecutivos2 3 (product [10^7..2+10^7])
--    Just 10000000
--    (0.00 secs, 1554932 bytes)

-- Solución del problema
-- =====================

soluciones :: [Integer]
soluciones = [x | x <- [121..]
                , isJust (esProductoDeNconsecutivos2 4 x)
                , isJust (esProductoDeNconsecutivos2 3 x)]

-- El cálculo es
--    λ> head soluciones
--    175560
--    λ> esProductoDeNconsecutivos2 4 175560
--    Just 19
--    λ> esProductoDeNconsecutivos2 3 175560
--    Just 55
--    λ> product [19,20,21,22] 
--    175560
--    λ> product [55,56,57]
--    175560
--    λ> product [19,20,21,22] == product [55,56,57]
--    True

-- Se puede definir una función para automatizar el proceso anterior:
soluciones2 :: [(Integer,[Integer],[Integer])]
soluciones2 = [(x,[a..a+3],[b..b+2]) 
               | x <- [121..]
               , let y = esProductoDeNconsecutivos2 4 x
               , isJust y
               , let z = esProductoDeNconsecutivos2 3 x
               , isJust z
               , let a = fromJust y
               , let b = fromJust z
               ]

-- El cálculo es 
--    λ> head soluciones2
--    (175560,[19,20,21,22],[55,56,57])

import Data.Maybe

-- 1ª definición

esProductoDeNconsecutivos1 :: Integer -> Integer -> Maybe Integer

esProductoDeNconsecutivos1 n x

| null productos = Nothing

| otherwise = Just (head productos)

where productos = [m | m <- [1..x-n], product [m..m+n-1] == x]

-- 2ª definición

esProductoDeNconsecutivos2 :: Integer -> Integer -> Maybe Integer

esProductoDeNconsecutivos2 n x = aux k

where k = floor (fromIntegral x ** (1/(fromIntegral n))) - (n `div` 2)

aux m | y == x = Just m

| y < x = aux (m+1)

| otherwise = Nothing

where y = product [m..m+n-1]

-- Comparación de eficiencia

-- λ> esProductoDeNconsecutivos1 3 (product [10^7..2+10^7])

-- Just 10000000

-- (12.37 secs, 5678433692 bytes)

-- λ> esProductoDeNconsecutivos2 3 (product [10^7..2+10^7])

-- Just 10000000

-- (0.00 secs, 1554932 bytes)

-- Solución del problema

-- =====================

soluciones :: [Integer]

soluciones = [x | x <- [121..]

, isJust (esProductoDeNconsecutivos2 4 x)

, isJust (esProductoDeNconsecutivos2 3 x)]

-- El cálculo es

-- λ> head soluciones

-- 175560

-- λ> esProductoDeNconsecutivos2 4 175560

-- Just 19

-- λ> esProductoDeNconsecutivos2 3 175560

-- Just 55

-- λ> product [19,20,21,22]

-- 175560

-- λ> product [55,56,57]

-- 175560

-- λ> product [19,20,21,22] == product [55,56,57]

-- True

-- Se puede definir una función para automatizar el proceso anterior:

soluciones2 :: [(Integer,[Integer],[Integer])]

soluciones2 = [(x,[a..a+3],[b..b+2])

| x <- [121..]

, let y = esProductoDeNconsecutivos2 4 x

, isJust y

, let z = esProductoDeNconsecutivos2 3 x

, isJust z

, let a = fromJust y

, let b = fromJust z

]

-- El cálculo es

-- λ> head soluciones2

-- (175560,[19,20,21,22],[55,56,57])

Listas decrecientes

PorJosé A. Alonso 10-noviembre-201525-abril-2021

Definir la función

   listasDecrecientesDesde :: Int -> [[Int]]

1	listasDecrecientesDesde :: Int -> [[Int]]

tal que (listasDecrecientesDesde n) es la lista de las sucesiones estrictamente decrecientes cuyo primer elemento es n. Por ejemplo,

   ghci> listasDecrecientesDesde 2
   [[2],[2,1],[2,1,0],[2,0]]
   ghci> listasDecrecientesDesde 3
   [[3],[3,2],[3,2,1],[3,2,1,0],[3,2,0],[3,1],[3,1,0],[3,0]]

ghci> listasDecrecientesDesde 2

[[2],[2,1],[2,1,0],[2,0]]

ghci> listasDecrecientesDesde 3

[[3],[3,2],[3,2,1],[3,2,1,0],[3,2,0],[3,1],[3,1,0],[3,0]]

Soluciones

listasDecrecientesDesde :: Int -> [[Int]]
listasDecrecientesDesde 0 = [[0]]
listasDecrecientesDesde n =
    [n] : [n:ys | m <- [n-1,n-2..0], ys <- listasDecrecientesDesde m]

listasDecrecientesDesde :: Int -> [[Int]]

listasDecrecientesDesde 0 = [[0]]

listasDecrecientesDesde n =

[n] : [n:ys | m <- [n-1,n-2..0], ys <- listasDecrecientesDesde m]

Números muy divisibles por 3

PorJosé A. Alonso 4-noviembre-201511-noviembre-2015

Se dice que un número n es muy divisible por 3 si es divisible por 3 y sigue siendo divisible por 3 si vamos quitando dígitos por la derecha. Por ejemplo, 96060 es muy divisible por 3 porque 96060, 9606, 960, 96 y 9 son todos divisibles por 3.

Definir las funciones

   muyDivPor3             :: Integer -> Bool
   numeroMuyDivPor3Cifras :: Integer -> Integer

1 2	muyDivPor3 :: Integer -> Bool numeroMuyDivPor3Cifras :: Integer -> Integer

tales que

(muyDivPor3 n) se verifica si n es muy divisible por 3. Por ejemplo,

     muyDivPor3 96060 == True
     muyDivPor3 90616 == False

1 2	muyDivPor3 96060 == True muyDivPor3 90616 == False

(numeroMuyDivPor3CifrasC k) es la cantidad de números de k cifras muy divisibles por 3. Por ejemplo,

     numeroMuyDivPor3Cifras 5                    == 768
     numeroMuyDivPor3Cifras 7                    == 12288
     numeroMuyDivPor3Cifras (10^6) `rem` (10^6)  == 332032

numeroMuyDivPor3Cifras 5 == 768

numeroMuyDivPor3Cifras 7 == 12288

numeroMuyDivPor3Cifras (10^6) `rem` (10^6) == 332032

Soluciones

import Data.List (genericLength)

muyDivPor3 :: Integer -> Bool
muyDivPor3 n 
    | n < 10    = n `rem` 3 == 0
    | otherwise = n `rem` 3 == 0 && muyDivPor3 (n `div` 10)

-- 1ª definición
-- =============

numeroMuyDivPor3Cifras :: Integer -> Integer
numeroMuyDivPor3Cifras k = 
    genericLength [x | x <- [10^(k-1)..10^k-1], muyDivPor3 x]

-- 2ª definición
-- =============

numeroMuyDivPor3Cifras2 :: Integer -> Integer
numeroMuyDivPor3Cifras2 k = 
    genericLength [x | x <- [n,n+3..10^k-1], muyDivPor3 x]
    where n = k*10^(k-1)

-- 3ª definición
-- =============

numeroMuyDivPor3Cifras3 :: Integer -> Integer
numeroMuyDivPor3Cifras3 k = genericLength (numeroMuyDivPor3Cifras3a k)

numeroMuyDivPor3Cifras3a :: Integer -> [Integer]
numeroMuyDivPor3Cifras3a 1 = [3,6,9] 
numeroMuyDivPor3Cifras3a k = 
    [10*x+y | x <- numeroMuyDivPor3Cifras3a (k-1),
              y <- [0,3..9]]

-- 4ª definición
-- =============

numeroMuyDivPor3Cifras4 :: Integer -> Integer
numeroMuyDivPor3Cifras4 1 = 3
numeroMuyDivPor3Cifras4 k = 4 * numeroMuyDivPor3Cifras4 (k-1)

-- 5ª definición
-- =============

numeroMuyDivPor3Cifras5 :: Integer -> Integer
numeroMuyDivPor3Cifras5 k = 3 * 4^(k-1)

-- Comparación de eficiencia
-- =========================

--    λ> numeroMuyDivPor3Cifras 6
--    3072
--    (3.47 secs, 534,789,608 bytes)
--    λ> numeroMuyDivPor3Cifras2 6
--    2048
--    (0.88 secs, 107,883,432 bytes)
--    λ> numeroMuyDivPor3Cifras3 6
--    3072
--    (0.01 secs, 0 bytes)
--    
--    λ> numeroMuyDivPor3Cifras2 7
--    0
--    (2.57 secs, 375,999,336 bytes)
--    λ> numeroMuyDivPor3Cifras3 7
--    12288
--    (0.02 secs, 0 bytes)
--    λ> numeroMuyDivPor3Cifras4 7
--    12288
--    (0.00 secs, 0 bytes)
--    λ> numeroMuyDivPor3Cifras5 7
--    12288
--    (0.01 secs, 0 bytes)
--
--    λ> numeroMuyDivPor3Cifras4 (10^5) `rem` 100000
--    32032
--    (5.74 secs, 1,408,600,592 bytes)
--    λ> numeroMuyDivPor3Cifras5 (10^5) `rem` 100000
--    32032
--    (0.02 secs, 0 bytes)

import Data.List (genericLength)

muyDivPor3 :: Integer -> Bool

muyDivPor3 n

| n < 10 = n `rem` 3 == 0

| otherwise = n `rem` 3 == 0 && muyDivPor3 (n `div` 10)

-- 1ª definición

-- =============

numeroMuyDivPor3Cifras :: Integer -> Integer

numeroMuyDivPor3Cifras k =

genericLength [x | x <- [10^(k-1)..10^k-1], muyDivPor3 x]

-- 2ª definición

-- =============

numeroMuyDivPor3Cifras2 :: Integer -> Integer

numeroMuyDivPor3Cifras2 k =

genericLength [x | x <- [n,n+3..10^k-1], muyDivPor3 x]

where n = k*10^(k-1)

-- 3ª definición

-- =============

numeroMuyDivPor3Cifras3 :: Integer -> Integer

numeroMuyDivPor3Cifras3 k = genericLength (numeroMuyDivPor3Cifras3a k)

numeroMuyDivPor3Cifras3a :: Integer -> [Integer]

numeroMuyDivPor3Cifras3a 1 = [3,6,9]

numeroMuyDivPor3Cifras3a k =

[10*x+y | x <- numeroMuyDivPor3Cifras3a (k-1),

y <- [0,3..9]]

-- 4ª definición

-- =============

numeroMuyDivPor3Cifras4 :: Integer -> Integer

numeroMuyDivPor3Cifras4 1 = 3

numeroMuyDivPor3Cifras4 k = 4 * numeroMuyDivPor3Cifras4 (k-1)

-- 5ª definición

-- =============

numeroMuyDivPor3Cifras5 :: Integer -> Integer

numeroMuyDivPor3Cifras5 k = 3 * 4^(k-1)

-- Comparación de eficiencia

-- =========================

-- λ> numeroMuyDivPor3Cifras 6

-- 3072

-- (3.47 secs, 534,789,608 bytes)

-- λ> numeroMuyDivPor3Cifras2 6

-- 2048

-- (0.88 secs, 107,883,432 bytes)

-- λ> numeroMuyDivPor3Cifras3 6

-- 3072

-- (0.01 secs, 0 bytes)

-- λ> numeroMuyDivPor3Cifras2 7

-- 0

-- (2.57 secs, 375,999,336 bytes)

-- λ> numeroMuyDivPor3Cifras3 7

-- 12288

-- (0.02 secs, 0 bytes)

-- λ> numeroMuyDivPor3Cifras4 7

-- 12288

-- (0.00 secs, 0 bytes)

-- λ> numeroMuyDivPor3Cifras5 7

-- 12288

-- (0.01 secs, 0 bytes)

-- λ> numeroMuyDivPor3Cifras4 (10^5) `rem` 100000

-- 32032

-- (5.74 secs, 1,408,600,592 bytes)

-- λ> numeroMuyDivPor3Cifras5 (10^5) `rem` 100000

-- 32032

-- (0.02 secs, 0 bytes)

Lista con repeticiones

PorJosé A. Alonso 27-octubre-20153-noviembre-2015

Definir la función

   tieneRepeticiones :: Eq a => [a] -> Bool

1	tieneRepeticiones :: Eq a => [a] -> Bool

tal que (tieneRepeticiones xs) se verifica si xs tiene algún elemento repetido. Por ejemplo,

   tieneRepeticiones [3,2,5,2,7]          ==  True
   tieneRepeticiones [3,2,5,4,7]          ==  False
   tieneRepeticiones (5:[1..2000000000])  ==  True
   tieneRepeticiones [1..20000]           ==  False

tieneRepeticiones [3,2,5,2,7] == True

tieneRepeticiones [3,2,5,4,7] == False

tieneRepeticiones (5:[1..2000000000]) == True

tieneRepeticiones [1..20000] == False

Soluciones

tieneRepeticiones :: Eq a => [a] -> Bool
tieneRepeticiones []     = False
tieneRepeticiones (x:xs) = x `elem` xs || tieneRepeticiones xs

tieneRepeticiones :: Eq a => [a] -> Bool

tieneRepeticiones [] = False

tieneRepeticiones (x:xs) = x `elem` xs || tieneRepeticiones xs

Refinamiento de listas

PorJosé A. Alonso 21-octubre-201528-octubre-2015

Definir la función

   refinada :: [Float] -> [Float]

1	refinada :: [Float] -> [Float]

tal que (refinada xs) es la lista obtenida intercalando entre cada dos elementos consecutivos de xs su media aritmética. Por ejemplo,

   refinada [2,7,1,8]  ==  [2.0,4.5,7.0,4.0,1.0,4.5,8.0]
   refinada [2]        ==  [2.0]
   refinada []         ==  []

refinada [2,7,1,8] == [2.0,4.5,7.0,4.0,1.0,4.5,8.0]

refinada [2] == [2.0]

refinada [] == []

Soluciones

-- 1ª definición (por recursión):
refinada :: [Float] -> [Float]
refinada (x:y:zs) = x : (x+y)/2 : refinada (y:zs)
refinada xs       = xs

-- 2ª definición (por comprensión);
refinada2 :: [Float] -> [Float]
refinada2 []     = []
refinada2 (x:xs) = x : concat [[(a+b)/2,b] | (a,b) <- zip (x:xs) xs]

-- 1ª definición (por recursión):

refinada :: [Float] -> [Float]

refinada (x:y:zs) = x : (x+y)/2 : refinada (y:zs)

refinada xs = xs

-- 2ª definición (por comprensión);

refinada2 :: [Float] -> [Float]

refinada2 [] = []

refinada2 (x:xs) = x : concat [[(a+b)/2,b] | (a,b) <- zip (x:xs) xs]

Rotaciones de un número

PorJosé A. Alonso 30-abril-20157-mayo-2015

Definir la función

   rotacionesNumero :: Integer -> [Integer]

1	rotacionesNumero :: Integer -> [Integer]

(rotacionesNumero n) es la lista de las rotaciones obtenidas desplazando el primer dígito de n al final. Por ejemplo,

   rotacionesNumero 325  ==  [325,253,532]

1	rotacionesNumero 325 == [325,253,532]

Soluciones

-- 1ª definición (por comprensión)
-- ===============================

rotacionesNumero1 :: Integer -> [Integer]
rotacionesNumero1 n = [read xs | xs <- rotaciones (show n)]

-- (rotaciones xs) es la lista de las rotaciones obtenidas desplazando
-- el primer elemento xs al final. Por ejemplo,
--    rotaciones [2,3,5]  ==  [[2,3,5],[3,5,2],[5,2,3]]
rotaciones :: [a] -> [[a]]
rotaciones xs = take (length xs) (iterate rota xs)

-- (rota xs) es la lista añadiendo el primer elemento de xs al
-- final. Por ejemplo, 
--    rota [3,2,5,7]  ==  [2,5,7,3]
rota :: [a] -> [a]
rota (x:xs) = xs ++ [x]

-- 2ª definición (con map)
-- =======================

rotacionesNumero2 :: Integer -> [Integer]
rotacionesNumero2 n = map read (rotaciones (show n))

-- 3ª definición (sin argumentos)
-- ==============================

rotacionesNumero3 :: Integer -> [Integer]
rotacionesNumero3 = map read . rotaciones . show

-- 1ª definición (por comprensión)

-- ===============================

rotacionesNumero1 :: Integer -> [Integer]

rotacionesNumero1 n = [read xs | xs <- rotaciones (show n)]

-- (rotaciones xs) es la lista de las rotaciones obtenidas desplazando

-- el primer elemento xs al final. Por ejemplo,

-- rotaciones [2,3,5] == [[2,3,5],[3,5,2],[5,2,3]]

rotaciones :: [a] -> [[a]]

rotaciones xs = take (length xs) (iterate rota xs)

-- (rota xs) es la lista añadiendo el primer elemento de xs al

-- final. Por ejemplo,

-- rota [3,2,5,7] == [2,5,7,3]

rota :: [a] -> [a]

rota (x:xs) = xs ++ [x]

-- 2ª definición (con map)

-- =======================

rotacionesNumero2 :: Integer -> [Integer]

rotacionesNumero2 n = map read (rotaciones (show n))

-- 3ª definición (sin argumentos)

-- ==============================

rotacionesNumero3 :: Integer -> [Integer]

rotacionesNumero3 = map read . rotaciones . show

Agrupamiento según valores

PorJosé A. Alonso 29-abril-201525-abril-2021

Definir la función

   agrupa :: Ord c => (a -> c) -> [a] -> Map c [a]

1	agrupa :: Ord c => (a -> c) -> [a] -> Map c [a]

tal que (agrupa f xs) es el diccionario obtenido agrupando los elementos de xs según sus valores mediante la función f. Por ejemplo,

   ghci> agrupa length ["hoy", "ayer", "ana", "cosa"]
   fromList [(3,["hoy","ana"]),(4,["ayer","cosa"])]
   ghci> agrupa head ["claro", "ayer", "ana", "cosa"]
   fromList [('a',["ayer","ana"]),('c',["claro","cosa"])]
   ghci> agrupa length (words "suerte en el examen")
   fromList [(2,["en","el"]),(6,["suerte","examen"])]

ghci> agrupa length ["hoy", "ayer", "ana", "cosa"]

fromList [(3,["hoy","ana"]),(4,["ayer","cosa"])]

ghci> agrupa head ["claro", "ayer", "ana", "cosa"]

fromList [('a',["ayer","ana"]),('c',["claro","cosa"])]

ghci> agrupa length (words "suerte en el examen")

fromList [(2,["en","el"]),(6,["suerte","examen"])]

Soluciones

import qualified Data.List as L
import Data.Map

-- 1ª definición (por recursión)
agrupa1 :: Ord c => (a -> c) -> [a] -> Map c [a]
agrupa1 _ []     = empty
agrupa1 f (x:xs) = insertWith (++) (f x) [x] (agrupa1 f xs)

-- 2ª definición (por plegado)
agrupa2 :: Ord c => (a -> c) -> [a] -> Map c [a]
agrupa2 f = L.foldr (\x -> insertWith (++) (f x) [x]) empty

import qualified Data.List as L

import Data.Map

-- 1ª definición (por recursión)

agrupa1 :: Ord c => (a -> c) -> [a] -> Map c [a]

agrupa1 _ [] = empty

agrupa1 f (x:xs) = insertWith (++) (f x) [x] (agrupa1 f xs)

-- 2ª definición (por plegado)

agrupa2 :: Ord c => (a -> c) -> [a] -> Map c [a]

agrupa2 f = L.foldr (\x -> insertWith (++) (f x) [x]) empty

Distancia invierte y suma hasta capicúa

PorJosé A. Alonso 27-abril-20151-mayo-2016

Un número es capicúa si es igual leído de izquierda a derecha que de derecha a izquierda; por ejemplo, el 4884.

El transformado «invierte y suma» de un número x es la suma de x y su número invertido; es decir, el número resultante de la inversión del orden en el que aparecen sus dígitos. Por ejemplo, el transformado de 124 es 124 + 421 = 545.

Se aplica la transformación «invierte y suma» hasta obtener un capicúa. Por ejemplo, partiendo del número 87, el proceso es

     87 +   78 =  165 
    165 +  561 =  726 
    726 +  627 = 1353 
   1353 + 3531 = 4884

87 + 78 = 165

165 + 561 = 726

726 + 627 = 1353

1353 + 3531 = 4884

El número de pasos de dicho proceso es la distancia capicúa del número; por ejemplo, la distancia capicúa de 87 es 4.

Definir la función

   distanciaIS :: Integer -> Integer

1	distanciaIS :: Integer -> Integer

tal que (distanciaIS x) es la distancia capicúa de x. Por ejemplo,

   distanciaIS 11                   ==    0
   distanciaIS 10                   ==    1
   distanciaIS 19                   ==    2
   distanciaIS 59                   ==    3
   distanciaIS 69                   ==    4
   distanciaIS 166                  ==    5
   distanciaIS 79                   ==    6
   distanciaIS 89                   ==   24
   distanciaIS 10911                ==   55
   distanciaIS 1000000079994144385  ==  259

distanciaIS 11 == 0

distanciaIS 10 == 1

distanciaIS 19 == 2

distanciaIS 59 == 3

distanciaIS 69 == 4

distanciaIS 166 == 5

distanciaIS 79 == 6

distanciaIS 89 == 24

distanciaIS 10911 == 55

distanciaIS 1000000079994144385 == 259

Soluciones

import Data.List (genericLength)

-- 1ª solución (por recursión)
-- ===========================

distanciaIS1 :: Integer -> Integer
distanciaIS1 = genericLength . cadena

-- (cadena x) es la lista de transformados de x que no son capicúas. Por
-- ejemplo, 
--    cadena 87  ==  [87,165,726,1353]
cadena :: Integer -> [Integer]
cadena x | esCapicua x = []
         | otherwise   = x : cadena (transformadoIS x)

-- (esCapicua x) se verifica si x es capicúa. Por ejemplo,
--    esCapicua 42524  ==  True
--    esCapicua 42542  ==  False
esCapicua :: Integer -> Bool
esCapicua x = show x == reverse (show x)

-- (transformadoIS x) es el número obtenido sumándole a x el número con los
-- mismos dígitos que x pero en orden inverso. Por ejemplo,
--    transformadoIS 1325  ==  6556
--    transformadoIS 1375  ==  7106
transformadoIS :: Integer -> Integer
transformadoIS x = x + read (reverse (show x))

-- 2ª solución (por recursión con contador)
distanciaIS2 :: Integer -> Integer
distanciaIS2 x = aux x 0
    where aux x n | esCapicua x = n
                  | otherwise   = aux (transformadoIS x) (n+1)

-- 3ª solución (con iterate)
distanciaIS3 :: Integer -> Integer
distanciaIS3 =
    genericLength . takeWhile (not . esCapicua) . iterate transformadoIS

import Data.List (genericLength)

-- 1ª solución (por recursión)

-- ===========================

distanciaIS1 :: Integer -> Integer

distanciaIS1 = genericLength . cadena

-- (cadena x) es la lista de transformados de x que no son capicúas. Por

-- ejemplo,

-- cadena 87 == [87,165,726,1353]

cadena :: Integer -> [Integer]

cadena x | esCapicua x = []

| otherwise = x : cadena (transformadoIS x)

-- (esCapicua x) se verifica si x es capicúa. Por ejemplo,

-- esCapicua 42524 == True

-- esCapicua 42542 == False

esCapicua :: Integer -> Bool

esCapicua x = show x == reverse (show x)

-- (transformadoIS x) es el número obtenido sumándole a x el número con los

-- mismos dígitos que x pero en orden inverso. Por ejemplo,

-- transformadoIS 1325 == 6556

-- transformadoIS 1375 == 7106

transformadoIS :: Integer -> Integer

transformadoIS x = x + read (reverse (show x))

-- 2ª solución (por recursión con contador)

distanciaIS2 :: Integer -> Integer

distanciaIS2 x = aux x 0

where aux x n | esCapicua x = n

| otherwise = aux (transformadoIS x) (n+1)

-- 3ª solución (con iterate)

distanciaIS3 :: Integer -> Integer

distanciaIS3 =

genericLength . takeWhile (not . esCapicua) . iterate transformadoIS

Caminos reducidos

PorJosé A. Alonso 21-abril-201525-abril-2021

Un camino es una sucesión de pasos en una de las cuatros direcciones Norte, Sur, Este, Oeste. Ir en una dirección y a continuación en la opuesta es un esfuerzo que se puede reducir, Por ejemplo, el camino [Norte,Sur,Este,Sur] se puede reducir a [Este,Sur].

Un camino se dice que es reducido si no tiene dos pasos consecutivos en direcciones opuesta. Por ejemplo, [Este,Sur] es reducido y [Norte,Sur,Este,Sur] no lo es.

En Haskell, las direcciones y los caminos se pueden definir por

   data Direccion = N | S | E | O deriving (Show, Eq)
   type Camino = [Direccion]

1 2	data Direccion = N \| S \| E \| O deriving (Show, Eq) type Camino = [Direccion]

Definir la función

   reducido :: Camino -> Camino

1	reducido :: Camino -> Camino

tal que (reducido ds) es el camino reducido equivalente al camino ds. Por ejemplo,

   reducido []                              ==  []
   reducido [N]                             ==  [N]
   reducido [N,O]                           ==  [N,O]
   reducido [N,O,E]                         ==  [N]
   reducido [N,O,E,S]                       ==  [] 
   reducido [N,O,S,E]                       ==  [N,O,S,E]
   reducido [N,S,S,E,O,N]                   ==  []
   reducido [N,S,S,E,O,N,O]                 ==  [O]
   reducido (take (10^7) (cycle [N,E,O,S])) ==  []

reducido [] == []

reducido [N] == [N]

reducido [N,O] == [N,O]

reducido [N,O,E] == [N]

reducido [N,O,E,S] == []

reducido [N,O,S,E] == [N,O,S,E]

reducido [N,S,S,E,O,N] == []

reducido [N,S,S,E,O,N,O] == [O]

reducido (take (10^7) (cycle [N,E,O,S])) == []

Nótese que en el penúltimo ejemplo las reducciones son

       [N,S,S,E,O,N,O]  
   --> [S,E,O,N,O]  
   --> [S,N,O]  
   --> [O]

[N,S,S,E,O,N,O]

--> [S,E,O,N,O]

--> [S,N,O]

--> [O]

Soluciones

data Direccion = N | S | E | O deriving (Show, Eq)

type Camino = [Direccion]

-- 1ª solución (por recursión):
reducido1 :: Camino -> Camino
reducido1 [] = []
reducido1 (d:ds) | null ds'                = [d]
                 | d == opuesta (head ds') = tail ds'
                 | otherwise               = d:ds'
    where ds' = reducido1 ds

opuesta :: Direccion -> Direccion
opuesta N = S
opuesta S = N
opuesta E = O
opuesta O = E

-- 2ª solución (por plegado)
reducido2 :: Camino -> Camino
reducido2 = foldr aux []
    where aux N (S:xs) = xs
          aux S (N:xs) = xs
          aux E (O:xs) = xs
          aux O (E:xs) = xs
          aux x xs     = x:xs

-- 3ª solución 
reducido3 :: Camino -> Camino
reducido3 []       = []
reducido3 (N:S:ds) = reducido3 ds
reducido3 (S:N:ds) = reducido3 ds
reducido3 (E:O:ds) = reducido3 ds
reducido3 (O:E:ds) = reducido3 ds
reducido3 (d:ds) | null ds'                = [d]
                 | d == opuesta (head ds') = tail ds'
                 | otherwise               = d:ds'
    where ds' = reducido3 ds

-- 4ª solución
reducido4 :: Camino -> Camino
reducido4 ds = reverse (aux ([],ds)) where 
    aux (N:xs, S:ys) = aux (xs,ys)
    aux (S:xs, N:ys) = aux (xs,ys)
    aux (E:xs, O:ys) = aux (xs,ys)
    aux (O:xs, E:ys) = aux (xs,ys)
    aux (  xs, y:ys) = aux (y:xs,ys)
    aux (  xs,   []) = xs

-- Comparación de eficiencia
--    ghci> reducido1 (take (10^6) (cycle [N,E,O,S]))
--    []
--    (3.87 secs, 460160736 bytes)
--    ghci> reducido2 (take (10^6) (cycle [N,E,O,S]))
--    []
--    (1.16 secs, 216582880 bytes)
--    ghci> reducido3 (take (10^6) (cycle [N,E,O,S]))
--    []
--    (0.58 secs, 98561872 bytes)
--    ghci> reducido4 (take (10^6) (cycle [N,E,O,S]))
--    []
--    (0.64 secs, 176154640 bytes)
--    
--    ghci> reducido3 (take (10^7) (cycle [N,E,O,S]))
--    []
--    (5.43 secs, 962694784 bytes)
--    ghci> reducido4 (take (10^7) (cycle [N,E,O,S]))
--    []
--    (9.29 secs, 1722601528 bytes)
-- 
--    ghci> length $ reducido3 (take 2000000 $ cycle [N,O,N,S,E,N,S,O,S,S])
--    400002
--    (4.52 secs, 547004960 bytes)
--    ghci> length $ reducido4 (take 2000000 $ cycle [N,O,N,S,E,N,S,O,S,S])
--    400002
--    (2.17 secs, 379049224 bytes)
--    
--    ghci> let n=10^6 in reducido1 (replicate n N ++ replicate n S)
--    []
--    (7.35 secs, 537797096 bytes)
--    ghci> let n=10^6 in reducido2 (replicate n N ++ replicate n S)
--    []
--    (2.30 secs, 244553404 bytes)
--    ghci> let n=10^6 in reducido3 (replicate n N ++ replicate n S)
--    []
--    (8.08 secs, 545043608 bytes)
--    ghci> let n=10^6 in reducido4 (replicate n N ++ replicate n S)
--    []
--    (1.96 secs, 205552240 bytes)

data Direccion = N | S | E | O deriving (Show, Eq)

type Camino = [Direccion]

-- 1ª solución (por recursión):

reducido1 :: Camino -> Camino

reducido1 [] = []

reducido1 (d:ds) | null ds' = [d]

| d == opuesta (head ds') = tail ds'

| otherwise = d:ds'

where ds' = reducido1 ds

opuesta :: Direccion -> Direccion

opuesta N = S

opuesta S = N

opuesta E = O

opuesta O = E

-- 2ª solución (por plegado)

reducido2 :: Camino -> Camino

reducido2 = foldr aux []

where aux N (S:xs) = xs

aux S (N:xs) = xs

aux E (O:xs) = xs

aux O (E:xs) = xs

aux x xs = x:xs

-- 3ª solución

reducido3 :: Camino -> Camino

reducido3 [] = []

reducido3 (N:S:ds) = reducido3 ds

reducido3 (S:N:ds) = reducido3 ds

reducido3 (E:O:ds) = reducido3 ds

reducido3 (O:E:ds) = reducido3 ds

reducido3 (d:ds) | null ds' = [d]

| d == opuesta (head ds') = tail ds'

| otherwise = d:ds'

where ds' = reducido3 ds

-- 4ª solución

reducido4 :: Camino -> Camino

reducido4 ds = reverse (aux ([],ds)) where

aux (N:xs, S:ys) = aux (xs,ys)

aux (S:xs, N:ys) = aux (xs,ys)

aux (E:xs, O:ys) = aux (xs,ys)

aux (O:xs, E:ys) = aux (xs,ys)

aux ( xs, y:ys) = aux (y:xs,ys)

aux ( xs, []) = xs

-- Comparación de eficiencia

-- ghci> reducido1 (take (10^6) (cycle [N,E,O,S]))

-- []

-- (3.87 secs, 460160736 bytes)

-- ghci> reducido2 (take (10^6) (cycle [N,E,O,S]))

-- []

-- (1.16 secs, 216582880 bytes)

-- ghci> reducido3 (take (10^6) (cycle [N,E,O,S]))

-- []

-- (0.58 secs, 98561872 bytes)

-- ghci> reducido4 (take (10^6) (cycle [N,E,O,S]))

-- []

-- (0.64 secs, 176154640 bytes)

-- ghci> reducido3 (take (10^7) (cycle [N,E,O,S]))

-- []

-- (5.43 secs, 962694784 bytes)

-- ghci> reducido4 (take (10^7) (cycle [N,E,O,S]))

-- []

-- (9.29 secs, 1722601528 bytes)

-- ghci> length $ reducido3 (take 2000000 $ cycle [N,O,N,S,E,N,S,O,S,S])

-- 400002

-- (4.52 secs, 547004960 bytes)

-- ghci> length $ reducido4 (take 2000000 $ cycle [N,O,N,S,E,N,S,O,S,S])

-- 400002

-- (2.17 secs, 379049224 bytes)

-- ghci> let n=10^6 in reducido1 (replicate n N ++ replicate n S)

-- []

-- (7.35 secs, 537797096 bytes)

-- ghci> let n=10^6 in reducido2 (replicate n N ++ replicate n S)

-- []

-- (2.30 secs, 244553404 bytes)

-- ghci> let n=10^6 in reducido3 (replicate n N ++ replicate n S)

-- []

-- (8.08 secs, 545043608 bytes)

-- ghci> let n=10^6 in reducido4 (replicate n N ++ replicate n S)

-- []

-- (1.96 secs, 205552240 bytes)

Las torres de Hanói

PorJosé A. Alonso 13-abril-201525-abril-2021

En la clase de la semana pasada comenté la posibilidad de que los alumnos me enviaran propuestas de ejercicios para publicarlos en Exercitium. La primera que he recibido es la de Javier Linares sobre el problema de las torres de Hanoi que constituye el ejercicio de hoy.

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.

Definir la función

   hanoi :: Int -> [String]

1	hanoi :: Int -> [String]

tal que (hanoi n) es la lista de los movimientos para resolver el problema de las torres de hanoi con n discos. Por ejemplo,

   ghci> hanoi 1
   ["Mueve el disco 1 de A a C"]
   ghci> hanoi 2
   ["Mueve el disco 1 de A a B","Mueve el disco 2 de A a C","Mueve el disco 1 de B a C"]
   ghci> mapM_ putStrLn (hanoi 2)
   Mueve el disco 1 de A a B
   Mueve el disco 2 de A a C
   Mueve el disco 1 de B a C
   ghci> mapM_ putStrLn (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

ghci> hanoi 1

["Mueve el disco 1 de A a C"]

ghci> hanoi 2

["Mueve el disco 1 de A a B","Mueve el disco 2 de A a C","Mueve el disco 1 de B a C"]

ghci> mapM_ putStrLn (hanoi 2)

Mueve el disco 1 de A a B

Mueve el disco 2 de A a C

Mueve el disco 1 de B a C

ghci> mapM_ putStrLn (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

hanoi :: Int -> [String]
hanoi n = aux n "A" "B" "C" where  
    aux n a b c
        | n == 1 = ["Mueve el disco 1 de " ++ a ++ " a " ++ c]
        | otherwise = 
            aux (n-1) a c b ++ 
            ["Mueve el disco "++ show n ++ " de " ++ a ++ " a " ++ c] ++
            aux (n-1) b a c

hanoi :: Int -> [String]

hanoi n = aux n "A" "B" "C" where

aux n a b c

| n == 1 = ["Mueve el disco 1 de " ++ a ++ " a " ++ c]

| otherwise =

aux (n-1) a c b ++

["Mueve el disco "++ show n ++ " de " ++ a ++ " a " ++ c] ++

aux (n-1) b a c

Producto de un número por una lista de números

PorJosé A. Alonso 8-abril-20151-mayo-2015

El producto de un número natural x por una lista de números naturales ys es el número obtenido concatenando los productos de x por cada uno de los elementos de ys. Por ejemplo, el producto de 2 por [3,2,5] es 26410.

Definir la función

   producto :: Integer -> [Integer] -> Integer

1	producto :: Integer -> [Integer] -> Integer

tal que (producto x ys) es el producto de x por ys. Por ejemplo,

   producto  2 [3,2,5]  ==  6410
   producto 10 [3,2,5]  ==  302050

1 2	producto 2 [3,2,5] == 6410 producto 10 [3,2,5] == 302050

Soluciones

-- 1ª definición (por recursión):
producto1 :: Integer -> [Integer] -> Integer
producto1 x ys = read (aux x ys)
    where aux x []     = ""
          aux x (y:ys) = show (x*y) ++ aux x ys

-- 2ª definición (por plegado):
producto2 :: Integer -> [Integer] -> Integer
producto2 x ys = read (aux x ys)
    where aux x = foldr (\y -> (++) (show (x * y))) "" 

-- 3ª definición (por comprensión)
producto3 :: Integer -> [Integer] -> Integer
producto3 x ys = read (concat [show (x*y) | y <- ys])

-- 4ª definición (con map)
producto4 :: Integer -> [Integer] -> Integer
producto4 x ys = read (concat (map (show . (x*)) ys))

-- 5ª definición (con concatMap)
producto5 :: Integer -> [Integer] -> Integer
producto5 x = read . concatMap (show . (x*))

-- 1ª definición (por recursión):

producto1 :: Integer -> [Integer] -> Integer

producto1 x ys = read (aux x ys)

where aux x [] = ""

aux x (y:ys) = show (x*y) ++ aux x ys

-- 2ª definición (por plegado):

producto2 :: Integer -> [Integer] -> Integer

producto2 x ys = read (aux x ys)

where aux x = foldr (\y -> (++) (show (x * y))) ""

-- 3ª definición (por comprensión)

producto3 :: Integer -> [Integer] -> Integer

producto3 x ys = read (concat [show (x*y) | y <- ys])

-- 4ª definición (con map)

producto4 :: Integer -> [Integer] -> Integer

producto4 x ys = read (concat (map (show . (x*)) ys))

-- 5ª definición (con concatMap)

producto5 :: Integer -> [Integer] -> Integer

producto5 x = read . concatMap (show . (x*))

Ramas a las que pertenece un elemento

PorJosé A. Alonso 1-abril-20151-mayo-2015

Representamos los árboles binarios con elementos en las hojas y en los nodos mediante el tipo de dato

   data Arbol a = H a | N a (Arbol a) (Arbol a) deriving Show

1	data Arbol a = H a \| N a (Arbol a) (Arbol a) deriving Show

Por ejemplo,

   ej1 :: Arbol Int
   ej1 = N 5 (N 2 (H 1) (H 2)) (N 3 (H 4) (H 2))

1 2	ej1 :: Arbol Int ej1 = N 5 (N 2 (H 1) (H 2)) (N 3 (H 4) (H 2))

Definir la función

   ramasCon :: Eq a => Arbol a -> a -> [[a]]

1	ramasCon :: Eq a => Arbol a -> a -> [[a]]

tal que (ramasCon a x) es la lista de las ramas del árbol a en las que aparece el elemento x. Por ejemplo,

  ramasCon ej1 2 ==  [[5,2,1],[5,2,2],[5,3,2]]

1	ramasCon ej1 2 == [[5,2,1],[5,2,2],[5,3,2]]

Soluciones

data Arbol a = H a | N a (Arbol a) (Arbol a) deriving Show

ej1 :: Arbol Int
ej1 = N 5 (N 2 (H 1) (H 2)) (N 3 (H 4) (H 2))

-- 1ª definición
-- =============

ramasCon :: Eq a => Arbol a -> a -> [[a]]
ramasCon a x = [ys | ys <- ramas a, x `elem` ys]

ramas :: Arbol a -> [[a]]
ramas (H x)     = [[x]]
ramas (N x i d) = [x:ys | ys <- ramas i ++ ramas d]

-- 2ª definición
-- =============

ramasCon2 :: Eq a => Arbol a -> a -> [[a]]
ramasCon2 a x = filter (x `elem`) (ramas2 a)

ramas2 :: Arbol a -> [[a]]
ramas2 (H x)     = [[x]]
ramas2 (N x i d) = map (x:) (ramas2 i ++ ramas2 d)

data Arbol a = H a | N a (Arbol a) (Arbol a) deriving Show

ej1 :: Arbol Int

ej1 = N 5 (N 2 (H 1) (H 2)) (N 3 (H 4) (H 2))

-- 1ª definición

-- =============

ramasCon :: Eq a => Arbol a -> a -> [[a]]

ramasCon a x = [ys | ys <- ramas a, x `elem` ys]

ramas :: Arbol a -> [[a]]

ramas (H x) = [[x]]

ramas (N x i d) = [x:ys | ys <- ramas i ++ ramas d]

-- 2ª definición

-- =============

ramasCon2 :: Eq a => Arbol a -> a -> [[a]]

ramasCon2 a x = filter (x `elem`) (ramas2 a)

ramas2 :: Arbol a -> [[a]]

ramas2 (H x) = [[x]]

ramas2 (N x i d) = map (x:) (ramas2 i ++ ramas2 d)

Agrupamiento de consecutivos iguales

PorJosé A. Alonso 30-marzo-20151-mayo-2016

Definir las funciones

   agrupa  :: Eq a => [a] -> [(a,Int)]
   expande :: [(a,Int)] -> [a]

1 2	agrupa :: Eq a => [a] -> [(a,Int)] expande :: [(a,Int)] -> [a]

tales que

(agrupa xs) es la lista obtenida agrupando las ocurrencias consecutivas de elementos de xs junto con el número de dichas ocurrencias. Por ejemplo:

     agrupa "aaabzzaa" == [('a',3),('b',1),('z',2),('a',2)]

1	agrupa "aaabzzaa" == [('a',3),('b',1),('z',2),('a',2)]

(expande xs) es la lista expandida correspondiente a ps (es decir, es la lista xs tal que la comprimida de xs es ps. Por ejemplo,

     expande [('a',2),('b',3),('a',1)] == "aabbba"

1	expande [('a',2),('b',3),('a',1)] == "aabbba"

Comprobar con QuickCheck que dada una lista de enteros, si se la agrupa y después se expande se obtiene la lista inicial.

Soluciones

import Data.List (group)
import Test.QuickCheck

-- Definiciones de agrupa
-- ======================

-- 1ª definición (por recursión)
agrupa :: Eq a => [a] -> [(a,Int)]
agrupa xs = aux xs 1
    where aux (x:y:zs) n | x == y    = aux (y:zs) (n+1)
                         | otherwise = (x,n) : aux (y:zs) 1
          aux [x]      n             = [(x,n)]
          aux []       _             = []

-- 2ª definición (por recursión usando takeWhile):
agrupa2 :: Eq a => [a] -> [(a,Int)]
agrupa2 [] = []
agrupa2 (x:xs) = 
    (x,1 + length (takeWhile (==x) xs)) : agrupa2 (dropWhile (==x) xs)

-- 3ª definición (por comprensión usando group):
agrupa3 :: Eq a => [a] -> [(a,Int)]
agrupa3 xs = [(head ys,length ys) | ys <- group xs]

-- 4ª definición (usando map y group):
agrupa4 :: Eq a => [a] -> [(a,Int)]
agrupa4 = map (\xs -> (head xs, length xs)) . group

-- Definiciones de expande
-- =======================

-- 1ª definición (por comprensión)
expande :: [(a,Int)] -> [a]
expande ps = concat [replicate k x | (x,k) <- ps]

-- 2ª definición (por concatMap)
expande2 :: [(a,Int)] -> [a]
expande2 = concatMap (\(x,k) -> replicate k x) 

-- 3ª definición (por recursión)
expande3 :: [(a,Int)] -> [a]
expande3 [] = []
expande3 ((x,n):ps) = replicate n x ++ expande3 ps

-- Comprobación
-- ============

-- La propiedad es
prop_expande_agrupa :: [Int] -> Bool 
prop_expande_agrupa xs = expande (agrupa xs) == xs

-- La comprobación es
--    ghci> quickCheck prop_expande_agrupa
--    +++ OK, passed 100 tests.

import Data.List (group)

import Test.QuickCheck

-- Definiciones de agrupa

-- ======================

-- 1ª definición (por recursión)

agrupa :: Eq a => [a] -> [(a,Int)]

agrupa xs = aux xs 1

where aux (x:y:zs) n | x == y = aux (y:zs) (n+1)

| otherwise = (x,n) : aux (y:zs) 1

aux [x] n = [(x,n)]

aux [] _ = []

-- 2ª definición (por recursión usando takeWhile):

agrupa2 :: Eq a => [a] -> [(a,Int)]

agrupa2 [] = []

agrupa2 (x:xs) =

(x,1 + length (takeWhile (==x) xs)) : agrupa2 (dropWhile (==x) xs)

-- 3ª definición (por comprensión usando group):

agrupa3 :: Eq a => [a] -> [(a,Int)]

agrupa3 xs = [(head ys,length ys) | ys <- group xs]

-- 4ª definición (usando map y group):

agrupa4 :: Eq a => [a] -> [(a,Int)]

agrupa4 = map (\xs -> (head xs, length xs)) . group

-- Definiciones de expande

-- =======================

-- 1ª definición (por comprensión)

expande :: [(a,Int)] -> [a]

expande ps = concat [replicate k x | (x,k) <- ps]

-- 2ª definición (por concatMap)

expande2 :: [(a,Int)] -> [a]

expande2 = concatMap (\(x,k) -> replicate k x)

-- 3ª definición (por recursión)

expande3 :: [(a,Int)] -> [a]

expande3 [] = []

expande3 ((x,n):ps) = replicate n x ++ expande3 ps

-- Comprobación

-- ============

-- La propiedad es

prop_expande_agrupa :: [Int] -> Bool

prop_expande_agrupa xs = expande (agrupa xs) == xs

-- La comprobación es

-- ghci> quickCheck prop_expande_agrupa

-- +++ OK, passed 100 tests.

Números de suma prima hereditarios por la derecha

PorJosé A. Alonso 27-marzo-20151-mayo-2015

Decimos que un número es de suma prima si la suma de todos sus dígitos es un número primo. Por ejemplo el número 562 es de suma prima pues la suma de sus dígitos es el número primo 13; sin embargo, el número 514 no es de suma prima pues la suma de sus dígitos es 10, que no es primo.

Decimos que un número es de suma prima hereditario por la derecha si es de suma prima y los números que se obtienen eliminando sus últimas cifras también son de suma prima. Por ejemplo 7426 es de suma prima hereditario por la derecha pues 7426, 742, 74 y 7 son todos números de suma prima.

Definir la constante

   listaSumaPrimaHD :: [Integer]

1	listaSumaPrimaHD :: [Integer]

cuyo valor es la lista infinita de los números de suma prima hereditarios por la derecha. Por ejemplo,

   take 10 listaSumaPrimaHD     ==  [2,3,5,7,20,21,23,25,29,30]
   listaSumaPrimaHD !! 2000000  ==  3800024668046

1 2	take 10 listaSumaPrimaHD == [2,3,5,7,20,21,23,25,29,30] listaSumaPrimaHD !! 2000000 == 3800024668046

Soluciones

import Data.Char (digitToInt)
import Data.Array
import Data.Numbers.Primes (isPrime)

-- 1ª definición
-- =============

listaSumaPrimaHD1 :: [Integer]
listaSumaPrimaHD1 = filter sumaPrimaHD [1..]

-- (sumaPrimaHD n) se verifica si n es de suma prima hereditario por la
-- derecha. Por ejemplo,
--    sumaPrimaHD 7426  ==  True
--    sumaPrimaHD 7427  ==  False
sumaPrimaHD n
    | n < 10    = isPrime n
    | otherwise = sumaPrima n && sumaPrimaHD (n `div` 10)

-- (sumaPrima n) se verifica si n es un número de suma prima. Por
-- ejemplo, 
--    sumaPrima 562  ==  True
--    sumaPrima 514  ==  False
sumaPrima :: Integer -> Bool
sumaPrima = isPrime . sum . digitos

-- (digitos n) es la lista de los dígitos de n. Por ejemplo,
--    digitos 325  ==  [3,2,5]
digitos :: Integer -> [Integer]
digitos = map (fromIntegral . digitToInt) . show


-- 2ª definición
-- =============

listaSumaPrimaHD2 :: [Integer]
listaSumaPrimaHD2 = map fst paresSumaPrimaHDDigitos

paresSumaPrimaHDDigitos :: [(Integer, Integer)]
paresSumaPrimaHDDigitos =
    paresSumaPrimaHDDigitosAux 1 [(2,2),(3,3),(5,5),(7,7)]

paresSumaPrimaHDDigitosAux :: Integer -> [(Integer,Integer)] -> 
                              [(Integer,Integer)]
paresSumaPrimaHDDigitosAux n ac =
    ac ++ paresSumaPrimaHDDigitosAux (n+1) 
                                     (concatMap extiendeSumaPrimaHD ac)

extiendeSumaPrimaHD :: (Integer,Integer) -> [(Integer,Integer)]
extiendeSumaPrimaHD (n,s) = [(n*10+k,s+k) | k <- [0..9], isPrime (s+k)]

-- 3ª definición
-- =============

listaSumaPrimaHD3 :: [Integer]
listaSumaPrimaHD3 = 
    map fst (concat (iterate (concatMap extiendeSumaPrimaHD3) 
                             [(2,2),(3,3),(5,5),(7,7)]))

extiendeSumaPrimaHD3 :: (Integer,Integer) -> [(Integer,Integer)]
extiendeSumaPrimaHD3 (n,s) = [(n*10+k,s+k) | k <- extensiones ! s]

extensiones :: Array Integer [Integer]
extensiones = array (1,1000) 
              [(n,[k | k <- [0..9], isPrime (n+k)]) | n <- [1..1000]]

-- Comparación de eficiencia
-- =========================

--    ghci> listaSumaPrimaHD1 !! 600
--    34004
--    (2.47 secs, 1565301720 bytes)
--    ghci> listaSumaPrimaHD2 !! 600
--    34004
--    (0.02 secs, 7209000 bytes)
--    ghci> listaSumaPrimaHD3 !! 600
--    34004
--    (0.01 secs, 1579920 bytes)
-- 
--    ghci> listaSumaPrimaHD2 !! 2000000
--    3800024668046
--    (45.41 secs, 29056613824 bytes)
--    ghci> listaSumaPrimaHD3 !! 2000000
--    3800024668046
--    (4.29 secs, 973265400 bytes)

import Data.Char (digitToInt)

import Data.Array

import Data.Numbers.Primes (isPrime)

-- 1ª definición

-- =============

listaSumaPrimaHD1 :: [Integer]

listaSumaPrimaHD1 = filter sumaPrimaHD [1..]

-- (sumaPrimaHD n) se verifica si n es de suma prima hereditario por la

-- derecha. Por ejemplo,

-- sumaPrimaHD 7426 == True

-- sumaPrimaHD 7427 == False

sumaPrimaHD n

| n < 10 = isPrime n

| otherwise = sumaPrima n && sumaPrimaHD (n `div` 10)

-- (sumaPrima n) se verifica si n es un número de suma prima. Por

-- ejemplo,

-- sumaPrima 562 == True

-- sumaPrima 514 == False

sumaPrima :: Integer -> Bool

sumaPrima = isPrime . sum . digitos

-- (digitos n) es la lista de los dígitos de n. Por ejemplo,

-- digitos 325 == [3,2,5]

digitos :: Integer -> [Integer]

digitos = map (fromIntegral . digitToInt) . show

-- 2ª definición

-- =============

listaSumaPrimaHD2 :: [Integer]

listaSumaPrimaHD2 = map fst paresSumaPrimaHDDigitos

paresSumaPrimaHDDigitos :: [(Integer, Integer)]

paresSumaPrimaHDDigitos =

paresSumaPrimaHDDigitosAux 1 [(2,2),(3,3),(5,5),(7,7)]

paresSumaPrimaHDDigitosAux :: Integer -> [(Integer,Integer)] ->

[(Integer,Integer)]

paresSumaPrimaHDDigitosAux n ac =

ac ++ paresSumaPrimaHDDigitosAux (n+1)

(concatMap extiendeSumaPrimaHD ac)

extiendeSumaPrimaHD :: (Integer,Integer) -> [(Integer,Integer)]

extiendeSumaPrimaHD (n,s) = [(n*10+k,s+k) | k <- [0..9], isPrime (s+k)]

-- 3ª definición

-- =============

listaSumaPrimaHD3 :: [Integer]

listaSumaPrimaHD3 =

map fst (concat (iterate (concatMap extiendeSumaPrimaHD3)

[(2,2),(3,3),(5,5),(7,7)]))

extiendeSumaPrimaHD3 :: (Integer,Integer) -> [(Integer,Integer)]

extiendeSumaPrimaHD3 (n,s) = [(n*10+k,s+k) | k <- extensiones ! s]

extensiones :: Array Integer [Integer]

extensiones = array (1,1000)

[(n,[k | k <- [0..9], isPrime (n+k)]) | n <- [1..1000]]

-- Comparación de eficiencia

-- =========================

-- ghci> listaSumaPrimaHD1 !! 600

-- 34004

-- (2.47 secs, 1565301720 bytes)

-- ghci> listaSumaPrimaHD2 !! 600

-- 34004

-- (0.02 secs, 7209000 bytes)

-- ghci> listaSumaPrimaHD3 !! 600

-- 34004

-- (0.01 secs, 1579920 bytes)

-- ghci> listaSumaPrimaHD2 !! 2000000

-- 3800024668046

-- (45.41 secs, 29056613824 bytes)

-- ghci> listaSumaPrimaHD3 !! 2000000

-- 3800024668046

-- (4.29 secs, 973265400 bytes)

Pares como sumas de pares

PorJosé A. Alonso 26-marzo-20151-mayo-2015

Todo número par se puede escribir como suma de números pares de varias formas. Por ejemplo,

   8 = 8 
     = 6 + 2
     = 4 + 4
     = 4 + 2 + 2
     = 2 + 2 + 2 + 2

8 = 8

= 6 + 2

= 4 + 4

= 4 + 2 + 2

= 2 + 2 + 2 + 2

Definir la función

   descomposicionesDecrecientes:: Integer -> [[Integer]]

1	descomposicionesDecrecientes:: Integer -> [[Integer]]

tal que (descomposicionesDecrecientes n) es la lista con las descomposiciones de n como suma de pares, en forma decreciente. Por ejemplo,

   ghci> descomposicionesDecrecientes 8
   [[8],[6,2],[4,4],[4,2,2],[2,2,2,2]]
   ghci> descomposicionesDecrecientes 10
   [[10],[8,2],[6,4],[6,2,2],[4,4,2],[4,2,2,2],[2,2,2,2,2]]
   ghci> length (descomposicionesDecrecientes 100)
   204226

ghci> descomposicionesDecrecientes 8

[[8],[6,2],[4,4],[4,2,2],[2,2,2,2]]

ghci> descomposicionesDecrecientes 10

[[10],[8,2],[6,4],[6,2,2],[4,4,2],[4,2,2,2],[2,2,2,2,2]]

ghci> length (descomposicionesDecrecientes 100)

204226

Soluciones

descomposicionesDecrecientes:: Integer -> [[Integer]]
descomposicionesDecrecientes 0 = [[0]]
descomposicionesDecrecientes n = aux n [n,n-2..2]
    where aux _ [] = []
          aux n (x:xs) | x > n     = aux n xs
                       | x == n    = [n] : aux n xs
                       | otherwise = map (x:) (aux (n-x) (x:xs)) ++ aux n xs

descomposicionesDecrecientes:: Integer -> [[Integer]]

descomposicionesDecrecientes 0 = [[0]]

descomposicionesDecrecientes n = aux n [n,n-2..2]

where aux _ [] = []

aux n (x:xs) | x > n = aux n xs

| x == n = [n] : aux n xs

| otherwise = map (x:) (aux (n-x) (x:xs)) ++ aux n xs

Caminos maximales en árboles binarios

PorJosé A. Alonso 23-marzo-20151-mayo-2015

Consideremos los árboles binarios con etiquetas en las hojas y en los nodos. Por ejemplo,

/ \

2 4

/ \

7 1

/ \

2 3

Un camino es una sucesión de nodos desde la raiz hasta una hoja. Por ejemplo, [5,2] y [5,4,1,2] son caminos que llevan a 2, mientras que [5,4,1] no es un camino, pues no lleva a una hoja.

Definimos el tipo de dato Arbol y el ejemplo por

   data Arbol = H Int | N Arbol Int Arbol 
                deriving Show
   
   arb1:: Arbol 
   arb1 = N (H 2) 5 (N (H 7) 4 (N (H 2) 1 (H 3)))

data Arbol = H Int | N Arbol Int Arbol

deriving Show

arb1:: Arbol

arb1 = N (H 2) 5 (N (H 7) 4 (N (H 2) 1 (H 3)))

Definir la función

   maxLong :: Int -> Arbol -> Int

1	maxLong :: Int -> Arbol -> Int

tal que (maxLong x a) es la longitud máxima de los caminos que terminan en x. Por ejemplo,

   maxLong 3 arb1 == 4
   maxLong 2 arb1 == 4
   maxLong 7 arb1 == 3

maxLong 3 arb1 == 4

maxLong 2 arb1 == 4

maxLong 7 arb1 == 3

Soluciones

data Arbol = H Int | N Arbol Int Arbol 
             deriving Show

arb1:: Arbol 
arb1 = N (H 2) 5 (N (H 7) 4 (N (H 2) 1 (H 3)))

-- 1ª solución (calculando los caminos)
-- ------------------------------------

-- (caminos x a) es la lista de los caminos en el árbol a desde la raíz
-- hasta las hojas x. Por ejemplo,
--    caminos 2 arb1 == [[5,2],[5,4,1,2]]
--    caminos 3 arb1 == [[5,4,1,3]]
--    caminos 1 arb1 == []
caminos :: Int -> Arbol -> [[Int]]
caminos x (H y) | x == y    = [[x]]
                | otherwise = []
caminos x (N i r d) = map (r:) (caminos x i ++ caminos x d)

maxLong1 :: Int -> Arbol -> Int
maxLong1 x a = maximum (0: map length (caminos x a))

-- 2ª solución
-- -----------

maxLong2 :: Int -> Arbol -> Int
maxLong2 x a = maximum (0 : aux x a)
    where aux x (H y) | x == y    = [1]
                      | otherwise = []
          aux x (N i r d) = map (+1) (aux x i ++ aux x d)

data Arbol = H Int | N Arbol Int Arbol

deriving Show

arb1:: Arbol

arb1 = N (H 2) 5 (N (H 7) 4 (N (H 2) 1 (H 3)))

-- 1ª solución (calculando los caminos)

-- ------------------------------------

-- (caminos x a) es la lista de los caminos en el árbol a desde la raíz

-- hasta las hojas x. Por ejemplo,

-- caminos 2 arb1 == [[5,2],[5,4,1,2]]

-- caminos 3 arb1 == [[5,4,1,3]]

-- caminos 1 arb1 == []

caminos :: Int -> Arbol -> [[Int]]

caminos x (H y) | x == y = [[x]]

| otherwise = []

caminos x (N i r d) = map (r:) (caminos x i ++ caminos x d)

maxLong1 :: Int -> Arbol -> Int

maxLong1 x a = maximum (0: map length (caminos x a))

-- 2ª solución

-- -----------

maxLong2 :: Int -> Arbol -> Int

maxLong2 x a = maximum (0 : aux x a)

where aux x (H y) | x == y = [1]

| otherwise = []

aux x (N i r d) = map (+1) (aux x i ++ aux x d)

Árboles con todas sus ramas con algún elemento que cumple una propiedad

PorJosé A. Alonso 19-marzo-20151-mayo-2015

En lógica temporal, la expresión AFp significa que en algún momento en el futuro se cumple la propiedad p. Trasladado a su interpretación en forma de árbol lo que quiere decir es que en todas las ramas (desde la raíz hasta una hoja) hay un nodo que cumple la propiedad p.

Consideramos el siguiente tipo algebraico de los árboles binarios:

   data Arbol a = H a
                | N a (Arbol a) (Arbol a)
                  deriving (Show,Eq)

data Arbol a = H a

| N a (Arbol a) (Arbol a)

deriving (Show,Eq)

y el siguiente árbol

   a1 :: Arbol Int
   a1 = N 9 (N 3 (H 2) (N 4 (H 1) (H 5))) (H 8)

1 2	a1 :: Arbol Int a1 = N 9 (N 3 (H 2) (N 4 (H 1) (H 5))) (H 8)

En este árbol se cumple (AF par); es decir, en todas las ramas hay un número par; pero no se cumple (AF primo); es decir, hay ramas en las que no hay ningún número primo. Donde una rama es la secuencia de nodos desde el nodo inicial o raíz hasta una hoja.

Definir la función

   propiedadAF :: (a -> Bool) -> Arbol a -> Bool

1	propiedadAF :: (a -> Bool) -> Arbol a -> Bool

tal que (propiedadAF p a) se verifica si se cumple (AF p) en el árbol a; es decir, si en todas las ramas hay un nodo (interno u hoja) que cumple la propiedad p. Por ejemplo

   propiedadAF even a1  ==  True
   propiedadAF (<7) a1  ==  False

1 2	propiedadAF even a1 == True propiedadAF (<7) a1 == False

Soluciones

[schedule expon=’2015-03-26′ expat=»06:00″]

data Arbol a = H a
             | N a (Arbol a) (Arbol a)
             deriving (Show,Eq)

a1 :: Arbol Int
a1 = N 9 (N 3 (H 2) (N 4 (H 1) (H 5))) (H 8)

propiedadAF :: (a -> Bool) -> Arbol a -> Bool
propiedadAF p (H a)     = p a
propiedadAF p (N a i d) = p a || (propiedadAF p i && propiedadAF p d)

data Arbol a = H a

| N a (Arbol a) (Arbol a)

deriving (Show,Eq)

a1 :: Arbol Int

a1 = N 9 (N 3 (H 2) (N 4 (H 1) (H 5))) (H 8)

propiedadAF :: (a -> Bool) -> Arbol a -> Bool

propiedadAF p (H a) = p a

propiedadAF p (N a i d) = p a || (propiedadAF p i && propiedadAF p d)

Cociente entero de polinomios

PorJosé A. Alonso 18-marzo-20151-mayo-2015

El cociente entero de un polinomio P(x) por un monomio axⁿ es el polinomio que se obtiene a partir de los términos de P(x) con un grado mayor o igual que n, realizando la división entera entre sus coeficientes y el coeficiente del monomio divisor y restando el valor de n al de sus grados. Por ejemplo,

El cociente entero de 4x⁴ + 6x³ + 7x² + 5x + 2 por el monomio 3x² se obtiene a partir de los términos 4x⁴ + 6x³ + 7x² realizando la división entera entre sus coeficientes y el número 3 y restando 2 a sus grados. De esta forma se obtiene x² + 2x + 2
El cociente entero de 6x⁵ + 2x⁴ + 8x³ + 5x² + 8x + 4 por el monomio 4x³ se obtiene a partir de los términos 6x⁵ + 2x⁴ + 8x³ realizando la división entera entre sus coeficientes y el número 4 y restando 3 a sus grados. De esta forma se obtiene x² + 2

Definir la función

   cocienteEntero :: Polinomio Int -> Int -> Int -> Polinomio Int

1	cocienteEntero :: Polinomio Int -> Int -> Int -> Polinomio Int

tal que (cocienteEntero p a n) es el cociente entero del polinomio p por el monomio de grado n y coeficiente a. Por ejemplo,

   ghci> let listaApol xs = foldr (\(n,b) -> consPol n b) polCero xs
   ghci> cocienteEntero (listaApol [(4,4),(3,6),(2,7),(1,5),(0,2)]) 3 2
   x^2 + 2*x + 2
   ghci> cocienteEntero (listaApol [(5,6),(4,2),(3,8),(2,5),(1,8),(0,4)]) 4 3
   x^2 + 2

ghci> let listaApol xs = foldr (\(n,b) -> consPol n b) polCero xs

ghci> cocienteEntero (listaApol [(4,4),(3,6),(2,7),(1,5),(0,2)]) 3 2

x^2 + 2*x + 2

ghci> cocienteEntero (listaApol [(5,6),(4,2),(3,8),(2,5),(1,8),(0,4)]) 4 3

x^2 + 2

Nota: Este ejercicio debe realizarse usando únicamente las funciones de la librería I1M.Pol que se encuentra aquí y se describe aquí.

Soluciones

import I1M.Pol

cocienteEntero :: Polinomio Int -> Int -> Int -> Polinomio Int
cocienteEntero p a n
    | grado p < n = polCero
    | otherwise   = consPol (grado p - n) (coefLider p `div` a)
                            (cocienteEntero (restoPol p) a n)

import I1M.Pol

cocienteEntero :: Polinomio Int -> Int -> Int -> Polinomio Int

cocienteEntero p a n

| grado p < n = polCero

| otherwise = consPol (grado p - n) (coefLider p `div` a)

(cocienteEntero (restoPol p) a n)

Sucesión de números parientes

PorJosé A. Alonso 17-marzo-20151-mayo-2016

Se dice que dos números naturales son parientes sitienen exactamente un factor primo en común, independientemente de su multiplicidad. Por ejemplo,

Los números 12 (2²·3) y 40 (2³·5) son parientes, pues tienen al 2 como único factor primo en común.
Los números 49 (7²) y 63 (3²·7) son parientes, pues tienen al 7 como único factor primo en común.
Los números 12 (2²·3) y 30 (2·3·5) no son parientes, pues tienen dos factores primos en común.
Los números 49 (7²) y 25 (5²) no son parientes, pues no tienen factores primos en común.

Se dice que una lista de números naturales es una secuencia de parientes si cada par de números consecutivos son parientes. Por ejemplo,

La lista [12,40,35,28] es una secuencia de parientes.
La lista [12,30,21,49] no es una secuencia de parientes.

Definir la función

   secuenciaParientes :: [Integer] -> Bool

1	secuenciaParientes :: [Integer] -> Bool

tal que (secuenciaParientes xs) se verifica si xs es una secuencia de parientes. Por ejemplo,

   secuenciaParientes [12,40,35,28]           ==  True
   secuenciaParientes [12,30,21,49]           ==  False
   secuenciaParientes [2^n | n <- [1..2000]]  ==  True

secuenciaParientes [12,40,35,28] == True

secuenciaParientes [12,30,21,49] == False

secuenciaParientes [2^n | n <- [1..2000]] == True

Soluciones

import Data.List (intersect, nub)
import Data.Numbers.Primes (primes, primeFactors)

-- (parientes x y) se verifica si x e y son parientes. Por ejemplo,
--    parientes 12 40  ==  True
--    parientes 49 63  ==  True
--    parientes 12 30  ==  False
--    parientes 49 25  ==  False

-- 1ª definición (con gcd)
parientes1 :: Integer -> Integer -> Bool
parientes1 x y =
    length [p | p <- takeWhile (<= d) primes, d `mod` p == 0] == 1 
    where d = gcd x y

-- 2ª definición (con primeFactors)
parientes2 :: Integer -> Integer -> Bool
parientes2 0 0 = False
parientes2 x y = 
    length (nub (primeFactors x `intersect` primeFactors y)) == 1

-- Comparación de eficiencia
--    ghci> parientes1 (2^25) (2^25)
--    True
--    (34.34 secs, 15974866184 bytes)
--    ghci> parientes2 (2^25) (2^25)
--    True
--    (0.01 secs, 3093024 bytes)

-- Usaremos la 2ª definición
parientes :: Integer -> Integer -> Bool
parientes = parientes2

-- Definiciones de secuenciaParientes 
-- ==================================

-- 1ª definición (por recursión)
secuenciaParientes :: [Integer] -> Bool
secuenciaParientes []         = True
secuenciaParientes [x]        = True
secuenciaParientes (x1:x2:xs) =
    parientes x1 x2 && secuenciaParientes (x2:xs)

-- 2ª definición (por recursión con 2 ecuaciones)
secuenciaParientes2 :: [Integer] -> Bool
secuenciaParientes2 (x1:x2:xs) =
    parientes x1 x2 && secuenciaParientes2 (x2:xs)
secuenciaParientes2 _         = True

-- 3ª definición (sin recursión):
secuenciaParientes3 :: [Integer] -> Bool
secuenciaParientes3 xs = all (\(x,y) -> parientes x y) (zip xs (tail xs)) 

-- 4ª definición
secuenciaParientes4 :: [Integer] -> Bool
secuenciaParientes4 xs = all (uncurry parientes) (zip xs (tail xs))

import Data.List (intersect, nub)

import Data.Numbers.Primes (primes, primeFactors)

-- (parientes x y) se verifica si x e y son parientes. Por ejemplo,

-- parientes 12 40 == True

-- parientes 49 63 == True

-- parientes 12 30 == False

-- parientes 49 25 == False

-- 1ª definición (con gcd)

parientes1 :: Integer -> Integer -> Bool

parientes1 x y =

length [p | p <- takeWhile (<= d) primes, d `mod` p == 0] == 1

where d = gcd x y

-- 2ª definición (con primeFactors)

parientes2 :: Integer -> Integer -> Bool

parientes2 0 0 = False

parientes2 x y =

length (nub (primeFactors x `intersect` primeFactors y)) == 1

-- Comparación de eficiencia

-- ghci> parientes1 (2^25) (2^25)

-- True

-- (34.34 secs, 15974866184 bytes)

-- ghci> parientes2 (2^25) (2^25)

-- True

-- (0.01 secs, 3093024 bytes)

-- Usaremos la 2ª definición

parientes :: Integer -> Integer -> Bool

parientes = parientes2

-- Definiciones de secuenciaParientes

-- ==================================

-- 1ª definición (por recursión)

secuenciaParientes :: [Integer] -> Bool

secuenciaParientes [] = True

secuenciaParientes [x] = True

secuenciaParientes (x1:x2:xs) =

parientes x1 x2 && secuenciaParientes (x2:xs)

-- 2ª definición (por recursión con 2 ecuaciones)

secuenciaParientes2 :: [Integer] -> Bool

secuenciaParientes2 (x1:x2:xs) =

parientes x1 x2 && secuenciaParientes2 (x2:xs)

secuenciaParientes2 _ = True

-- 3ª definición (sin recursión):

secuenciaParientes3 :: [Integer] -> Bool

secuenciaParientes3 xs = all (\(x,y) -> parientes x y) (zip xs (tail xs))

-- 4ª definición

secuenciaParientes4 :: [Integer] -> Bool

secuenciaParientes4 xs = all (uncurry parientes) (zip xs (tail xs))

Actualización de una lista

PorJosé A. Alonso 10-marzo-20152-mayo-2016

Definir la función

   actualiza :: [a] -> [(Int,a)] -> [a]

1	actualiza :: [a] -> [(Int,a)] -> [a]

tal que (actualiza xs ps) es la lista obtenida sustituyendo en xs los elementos cuyos índices son las primeras componentes de ps por las segundas. Por ejemplo,

   actualiza [3,5,2,4] [(2,1),(0,7)]  ==  [7,5,1,4]
   sum (actualiza [1..10^4] [(i,2*i) | i <- [0..10^4-1]]) == 99990000

1 2	actualiza [3,5,2,4] [(2,1),(0,7)] == [7,5,1,4] sum (actualiza [1..10^4] [(i,2*i) \| i <- [0..10^4-1]]) == 99990000

Soluciones

import qualified Data.Vector as V
import Data.Array 

-- 1ª solución (por recursión)
-- ===========================

actualiza :: [a] -> [(Int,a)] -> [a]
actualiza xs []         = xs
actualiza xs ((n,y):ps) = actualiza (actualizaE xs (n,y)) ps

-- (actualizaE xs (n,y)) es la lista obtenida sustituyendo el  elemento
-- n-ésimo de xs por y. Por ejemplo, 
--    actualiza [3,5,2,4] (2,1) ==  [3,5,1,4]
actualizaE :: [a] -> (Int,a) -> [a]
actualizaE xs (n,y) =
    take n xs ++ y : drop (n+1) xs

-- 2ª solución (por tablas)
-- ========================

actualiza2 :: [a] -> [(Int,a)] -> [a]
actualiza2 xs ps = 
    elems (listArray (0,length xs - 1) xs // ps)

-- 3ª solución (por vectores)
-- ==========================

actualiza3 :: [a] -> [(Int,a)] -> [a]
actualiza3 xs ps = 
    V.toList (V.fromList xs V.// ps)

-- Comparación de eficiencia
--    ghci> let n = 10^2 in sum $ actualiza [1..n] [(i,2*i) | i <- [0..n-1]]
--    9900
--    (0.02 secs, 4668984 bytes)
--    ghci> let n = 10^3 in sum $ actualiza [1..n] [(i,2*i) | i <- [0..n-1]]
--    999000
--    (0.28 secs, 77454496 bytes)
--    ghci> let n = 10^4 in sum $ actualiza [1..n] [(i,2*i) | i <- [0..n-1]]
--    99990000
--    (63.46 secs, 8769501704 bytes)
--    
--    ghci> let n = 10^2 in sum $ actualiza2 [1..n] [(i,2*i) | i <- [0..n-1]]
--    9900
--    (0.02 secs, 4147304 bytes)
--    ghci> let n = 10^3 in sum $ actualiza2 [1..n] [(i,2*i) | i <- [0..n-1]]
--    999000
--    (0.02 secs, 4694784 bytes)
--    ghci> let n = 10^4 in sum $ actualiza2 [1..n] [(i,2*i) | i <- [0..n-1]]
--    99990000
--    (0.05 secs, 12276800 bytes)
--    
--    ghci> let n = 10^2 in sum $ actualiza3 [1..n] [(i,2*i) | i <- [0..n-1]]
--    9900
--    (0.01 secs, 4147304 bytes)
--    ghci> let n = 10^3 in sum $ actualiza3 [1..n] [(i,2*i) | i <- [0..n-1]]
--    999000
--    (0.02 secs, 4682680 bytes)
--    ghci> let n = 10^4 in sum $ actualiza3 [1..n] [(i,2*i) | i <- [0..n-1]]
--    99990000
--    (0.04 secs, 12595224 bytes)

import qualified Data.Vector as V

import Data.Array

-- 1ª solución (por recursión)

-- ===========================

actualiza :: [a] -> [(Int,a)] -> [a]

actualiza xs [] = xs

actualiza xs ((n,y):ps) = actualiza (actualizaE xs (n,y)) ps

-- (actualizaE xs (n,y)) es la lista obtenida sustituyendo el elemento

-- n-ésimo de xs por y. Por ejemplo,

-- actualiza [3,5,2,4] (2,1) == [3,5,1,4]

actualizaE :: [a] -> (Int,a) -> [a]

actualizaE xs (n,y) =

take n xs ++ y : drop (n+1) xs

-- 2ª solución (por tablas)

-- ========================

actualiza2 :: [a] -> [(Int,a)] -> [a]

actualiza2 xs ps =

elems (listArray (0,length xs - 1) xs // ps)

-- 3ª solución (por vectores)

-- ==========================

actualiza3 :: [a] -> [(Int,a)] -> [a]

actualiza3 xs ps =

V.toList (V.fromList xs V.// ps)

-- Comparación de eficiencia

-- ghci> let n = 10^2 in sum $ actualiza [1..n] [(i,2*i) | i <- [0..n-1]]

-- 9900

-- (0.02 secs, 4668984 bytes)

-- ghci> let n = 10^3 in sum $ actualiza [1..n] [(i,2*i) | i <- [0..n-1]]

-- 999000

-- (0.28 secs, 77454496 bytes)

-- ghci> let n = 10^4 in sum $ actualiza [1..n] [(i,2*i) | i <- [0..n-1]]

-- 99990000

-- (63.46 secs, 8769501704 bytes)

-- ghci> let n = 10^2 in sum $ actualiza2 [1..n] [(i,2*i) | i <- [0..n-1]]

-- 9900

-- (0.02 secs, 4147304 bytes)

-- ghci> let n = 10^3 in sum $ actualiza2 [1..n] [(i,2*i) | i <- [0..n-1]]

-- 999000

-- (0.02 secs, 4694784 bytes)

-- ghci> let n = 10^4 in sum $ actualiza2 [1..n] [(i,2*i) | i <- [0..n-1]]

-- 99990000

-- (0.05 secs, 12276800 bytes)

-- ghci> let n = 10^2 in sum $ actualiza3 [1..n] [(i,2*i) | i <- [0..n-1]]

-- 9900

-- (0.01 secs, 4147304 bytes)

-- ghci> let n = 10^3 in sum $ actualiza3 [1..n] [(i,2*i) | i <- [0..n-1]]

-- 999000

-- (0.02 secs, 4682680 bytes)

-- ghci> let n = 10^4 in sum $ actualiza3 [1..n] [(i,2*i) | i <- [0..n-1]]

-- 99990000

-- (0.04 secs, 12595224 bytes)

Orden de divisibilidad

PorJosé A. Alonso 9-marzo-201525-abril-2021

El orden de divisibilidad de un número x es el mayor n tal que para todo i menor o igual que n, los i primeros dígitos de n es divisible por i. Por ejemplo, el orden de divisibilidad de 74156 es 3 porque

   7       es divisible por 1
   74      es divisible por 2
   741     es divisible por 3
   7415 no es divisible por 4

7 es divisible por 1

74 es divisible por 2

741 es divisible por 3

7415 no es divisible por 4

Definir la función

   ordenDeDivisibilidad :: Integer -> Int

1	ordenDeDivisibilidad :: Integer -> Int

tal que (ordenDeDivisibilidad x) es el orden de divisibilidad de x. Por ejemplo,

   ordenDeDivisibilidad 74156                      ==  3
   ordenDeDivisibilidad 3608528850368400786036725  ==  25

1 2	ordenDeDivisibilidad 74156 == 3 ordenDeDivisibilidad 3608528850368400786036725 == 25

Soluciones

import Data.List (inits)

-- 1ª definición de ordenDeDivisibilidad
-- =====================================

ordenDeDivisibilidad :: Integer -> Int
ordenDeDivisibilidad n = 
    length (takeWhile (\(x,k) -> x `mod` k == 0) (zip (sucDigitos n) [1..]))

-- (sucDigitos x) es la sucesión de los dígitos de x. Por ejemplo,
--    sucDigitos 325    ==  [3,32,325]
--    sucDigitos 32050  ==  [3,32,320,3205,32050]
sucDigitos :: Integer -> [Integer]
sucDigitos n = 
    [n `div` (10^i) | i <- [k-1,k-2..0]]
    where k = length (show n)

-- 2ª definición de sucDigitos
sucDigitos2 :: Integer -> [Integer]
sucDigitos2 n = [read xs | xs <- aux (show n)]
    where aux []     = []
          aux (d:ds) = [d] : map (d:) (aux ds)

-- 3ª definición de sucDigitos
sucDigitos3 :: Integer -> [Integer]
sucDigitos3 n = 
    [read (take k ds) | k <- [1..length ds]]
    where ds = show n

-- 4ª definición de sucDigitos
sucDigitos4 :: Integer -> [Integer]
sucDigitos4 n = [read xs | xs <- tail (inits (show n))]

-- 5ª definición de sucDigitos
sucDigitos5 :: Integer -> [Integer]
sucDigitos5 n = map read (tail (inits (show n)))

-- 6ª definición de sucDigitos
sucDigitos6 :: Integer -> [Integer]
sucDigitos6 = map read . (tail . inits . show)

-- Eficiencia de las definiciones de sucDigitos
--    ghci> length (sucDigitos (10^5000))
--    5001
--    (0.01 secs, 1550688 bytes)
--    ghci> length (sucDigitos2 (10^5000))
--    5001
--    (1.25 secs, 729411872 bytes)
--    ghci> length (sucDigitos3 (10^5000))
--    5001
--    (0.02 secs, 2265120 bytes)
--    ghci> length (sucDigitos4 (10^5000))
--    5001
--    (1.10 secs, 728366872 bytes)
--    ghci> length (sucDigitos5 (10^5000))
--    5001
--    (1.12 secs, 728393864 bytes)
--    ghci> length (sucDigitos6 (10^5000))
--    5001
--    (1.20 secs, 728403052 bytes)
-- 
--    ghci> length (sucDigitos (10^3000000))
--    3000001
--    (2.73 secs, 820042696 bytes)
--    ghci> length (sucDigitos3 (10^3000000))
--    3000001
--    (3.69 secs, 820043688 bytes)

-- 2ª definición de ordenDeDivisibilidad
-- =====================================

ordenDeDivisibilidad :: Integer -> Int
ordenDeDivisibilidad x =
    length $ takeWhile (==0) $ zipWith (mod . read) (tail $ inits $ show x) [1..]

import Data.List (inits)

-- 1ª definición de ordenDeDivisibilidad

-- =====================================

ordenDeDivisibilidad :: Integer -> Int

ordenDeDivisibilidad n =

length (takeWhile (\(x,k) -> x `mod` k == 0) (zip (sucDigitos n) [1..]))

-- (sucDigitos x) es la sucesión de los dígitos de x. Por ejemplo,

-- sucDigitos 325 == [3,32,325]

-- sucDigitos 32050 == [3,32,320,3205,32050]

sucDigitos :: Integer -> [Integer]

sucDigitos n =

[n `div` (10^i) | i <- [k-1,k-2..0]]

where k = length (show n)

-- 2ª definición de sucDigitos

sucDigitos2 :: Integer -> [Integer]

sucDigitos2 n = [read xs | xs <- aux (show n)]

where aux [] = []

aux (d:ds) = [d] : map (d:) (aux ds)

-- 3ª definición de sucDigitos

sucDigitos3 :: Integer -> [Integer]

sucDigitos3 n =

[read (take k ds) | k <- [1..length ds]]

where ds = show n

-- 4ª definición de sucDigitos

sucDigitos4 :: Integer -> [Integer]

sucDigitos4 n = [read xs | xs <- tail (inits (show n))]

-- 5ª definición de sucDigitos

sucDigitos5 :: Integer -> [Integer]

sucDigitos5 n = map read (tail (inits (show n)))

-- 6ª definición de sucDigitos

sucDigitos6 :: Integer -> [Integer]

sucDigitos6 = map read . (tail . inits . show)

-- Eficiencia de las definiciones de sucDigitos

-- ghci> length (sucDigitos (10^5000))

-- 5001

-- (0.01 secs, 1550688 bytes)

-- ghci> length (sucDigitos2 (10^5000))

-- 5001

-- (1.25 secs, 729411872 bytes)

-- ghci> length (sucDigitos3 (10^5000))

-- 5001

-- (0.02 secs, 2265120 bytes)

-- ghci> length (sucDigitos4 (10^5000))

-- 5001

-- (1.10 secs, 728366872 bytes)

-- ghci> length (sucDigitos5 (10^5000))

-- 5001

-- (1.12 secs, 728393864 bytes)

-- ghci> length (sucDigitos6 (10^5000))

-- 5001

-- (1.20 secs, 728403052 bytes)

-- ghci> length (sucDigitos (10^3000000))

-- 3000001

-- (2.73 secs, 820042696 bytes)

-- ghci> length (sucDigitos3 (10^3000000))

-- 3000001

-- (3.69 secs, 820043688 bytes)

-- 2ª definición de ordenDeDivisibilidad

-- =====================================

ordenDeDivisibilidad :: Integer -> Int

ordenDeDivisibilidad x =

length $ takeWhile (==0) $ zipWith (mod . read) (tail $ inits $ show x) [1..]

Caminos en un árbol binario

PorJosé A. Alonso 5-marzo-20151-mayo-2016

Los caminos en los árboles binarios

       .          .
      / \        / \
     .   .      /   \
    / \        .     .
   .   .      / \   / \
             .   . .   .

. .

/ \ / \

. . / \

/ \ . .

. . / \ / \

. . . .

son [[I,I],[I,D],[D]] y [[I,I],[I,D],[D,I],[D,D]], donde I indica un movimiento hacia la izquierda y D uno hacia la derecha.

Los árboles binarios se pueden representar por

   data Arbol = H | N Arbol Arbol

1	data Arbol = H \| N Arbol Arbol

los movimientos por

   data Mov    = I | D deriving Show

1	data Mov = I \| D deriving Show

y los caminos por

   type Camino = [Mov]

1	type Camino = [Mov]

Definir la función

   caminos :: Arbol -> [Camino]

1	caminos :: Arbol -> [Camino]

tal que (caminos a) es la lista de los caminos en el árbol binario a. Por ejemplo,

   caminos (N (N H H) H)             == [[I,I],[I,D],[D]]
   caminos (N (N H H) (N H H))       == [[I,I],[I,D],[D,I],[D,D]]
   caminos (N H (N (N H H) (N H H))) == [[I],[D,I,I],[D,I,D],[D,D,I],[D,D,D]]

caminos (N (N H H) H) == [[I,I],[I,D],[D]]

caminos (N (N H H) (N H H)) == [[I,I],[I,D],[D,I],[D,D]]

caminos (N H (N (N H H) (N H H))) == [[I],[D,I,I],[D,I,D],[D,D,I],[D,D,D]]

Soluciones

data Arbol  = H | N Arbol Arbol
data Mov    = I | D deriving Show
type Camino = [Mov]

caminos :: Arbol -> [Camino]
caminos H       = [[]]
caminos (N i d) = [I:xs | xs <- caminos i] ++ [D:xs | xs <- caminos d]

data Arbol = H | N Arbol Arbol

data Mov = I | D deriving Show

type Camino = [Mov]

caminos :: Arbol -> [Camino]

caminos H = [[]]

caminos (N i d) = [I:xs | xs <- caminos i] ++ [D:xs | xs <- caminos d]

Listas con los ceros emparejados

PorJosé A. Alonso 4-marzo-201511-marzo-2015

Sea S un conjunto de números. Las listas de ceros emparejados de S son las listas formadas con los elementos de S y en las cuales los ceros aparecen en sublistas de longitud par. Por ejemplo, si S = {0,1,2} entonces [1], [2], [2,1], [2,0,0,2,0,0,1] y [0,0,0,0,1,2] son listas de ceros emparejados de S; pero [0,0,0,2,1,0,0] y [0,0,1,0,1] no lo son.

Definir las funciones

   cerosEmparejados  :: Integer -> Integer -> [[Integer]]
   nCerosEmparejados :: Integer -> Integer -> Integer

1 2	cerosEmparejados :: Integer -> Integer -> [[Integer]] nCerosEmparejados :: Integer -> Integer -> Integer

tales que
+ (cerosEmparejados m n) es la lista de las listas de longitud n de ceros emparejados con los números 0, 1, 2,…, m. Por ejemplo,

     ghci> cerosEmparejados 2 0
     [[]]
     ghci> cerosEmparejados 2 1
     [[1],[2]]
     ghci> cerosEmparejados 3 1
     [[1],[2],[3]]
     ghci> cerosEmparejados 2 2
     [[1,1],[1,2],[2,1],[2,2],[0,0]]
     ghci> cerosEmparejados 2 3
     [[1,1,1],[1,1,2],[1,2,1],[1,2,2],[1,0,0],[2,1,1],[2,1,2],
      [2,2,1],[2,2,2],[2,0,0],[0,0,1],[0,0,2]]
     ghci> cerosEmparejados 2 4
     [[1,1,1,1],[1,1,1,2],[1,1,2,1],[1,1,2,2],[1,1,0,0],[1,2,1,1],
      [1,2,1,2],[1,2,2,1],[1,2,2,2],[1,2,0,0],[1,0,0,1],[1,0,0,2],
      [2,1,1,1],[2,1,1,2],[2,1,2,1],[2,1,2,2],[2,1,0,0],[2,2,1,1],
      [2,2,1,2],[2,2,2,1],[2,2,2,2],[2,2,0,0],[2,0,0,1],[2,0,0,2],
      [0,0,1,1],[0,0,1,2],[0,0,2,1],[0,0,2,2],[0,0,0,0]]

ghci> cerosEmparejados 2 0

[[]]

ghci> cerosEmparejados 2 1

[[1],[2]]

ghci> cerosEmparejados 3 1

[[1],[2],[3]]

ghci> cerosEmparejados 2 2

[[1,1],[1,2],[2,1],[2,2],[0,0]]

ghci> cerosEmparejados 2 3

[[1,1,1],[1,1,2],[1,2,1],[1,2,2],[1,0,0],[2,1,1],[2,1,2],

[2,2,1],[2,2,2],[2,0,0],[0,0,1],[0,0,2]]

ghci> cerosEmparejados 2 4

[[1,1,1,1],[1,1,1,2],[1,1,2,1],[1,1,2,2],[1,1,0,0],[1,2,1,1],

[1,2,1,2],[1,2,2,1],[1,2,2,2],[1,2,0,0],[1,0,0,1],[1,0,0,2],

[2,1,1,1],[2,1,1,2],[2,1,2,1],[2,1,2,2],[2,1,0,0],[2,2,1,1],

[2,2,1,2],[2,2,2,1],[2,2,2,2],[2,2,0,0],[2,0,0,1],[2,0,0,2],

[0,0,1,1],[0,0,1,2],[0,0,2,1],[0,0,2,2],[0,0,0,0]]

(nCerosEmparejados m n) es el número de listas de longitud n de ceros emparejados con los números 0, 1, 2,…, m. Por ejemplo,

     nCerosEmparejados 2 2   ==  5
     nCerosEmparejados 2 3   ==  12
     nCerosEmparejados 2 4   ==  29
     nCerosEmparejados 9 27  ==  79707842493701635611689499

nCerosEmparejados 2 2 == 5

nCerosEmparejados 2 3 == 12

nCerosEmparejados 2 4 == 29

nCerosEmparejados 9 27 == 79707842493701635611689499

Soluciones

import Data.List (genericIndex)
import Data.List (genericLength) 

cerosEmparejados :: Integer -> Integer -> [[Integer]]
cerosEmparejados m 0 = [[]]
cerosEmparejados m 1 = [[k] | k <- [1..m]]
cerosEmparejados m n = 
    [x:ys | x <- [1..m], ys <- cerosEmparejados m (n-1)] ++
    [0:0:ys | ys <- cerosEmparejados m (n-2)]

-- 1ª definición de nCerosEmparejados: 
nCerosEmparejados1 :: Integer -> Integer -> Integer
nCerosEmparejados1 m n = fromIntegral (length (cerosEmparejados m n))

-- 2ª definición de nCerosEmparejados: 
nCerosEmparejados2 :: Integer -> Integer -> Integer
nCerosEmparejados2 _ 0 = 1
nCerosEmparejados2 m 1 = m
nCerosEmparejados2 m n = 
    m * nCerosEmparejados2 m (n-1) + nCerosEmparejados2 m (n-2)

-- 3ª definición de nCerosEmparejados: 
nCerosEmparejados3 :: Integer -> Integer -> Integer
nCerosEmparejados3 m n = aux `genericIndex` n
    where aux = 1 : m : zipWith (\x y -> x+m*y) aux (tail aux)

-- Comparación de eficiencia
--    ghci> nCerosEmparejados1 9 7
--    5144589
--    (22.30 secs, 6556279384 bytes)
--    ghci> nCerosEmparejados2 9 7
--    5144589
--    (0.01 secs, 515464 bytes)
--    ghci> nCerosEmparejados3 9 7
--    5144589
--    (0.01 secs, 518104 bytes)
--
--    ghci> nCerosEmparejados2 9 33
--    45556060883025783396845717812863
--    (21.59 secs, 2676070480 bytes)
--    ghci> nCerosEmparejados3 9 33
--    45556060883025783396845717812863
--    (0.00 secs, 1017240 bytes)

import Data.List (genericIndex)

import Data.List (genericLength)

cerosEmparejados :: Integer -> Integer -> [[Integer]]

cerosEmparejados m 0 = [[]]

cerosEmparejados m 1 = [[k] | k <- [1..m]]

cerosEmparejados m n =

[x:ys | x <- [1..m], ys <- cerosEmparejados m (n-1)] ++

[0:0:ys | ys <- cerosEmparejados m (n-2)]

-- 1ª definición de nCerosEmparejados:

nCerosEmparejados1 :: Integer -> Integer -> Integer

nCerosEmparejados1 m n = fromIntegral (length (cerosEmparejados m n))

-- 2ª definición de nCerosEmparejados:

nCerosEmparejados2 :: Integer -> Integer -> Integer

nCerosEmparejados2 _ 0 = 1

nCerosEmparejados2 m 1 = m

nCerosEmparejados2 m n =

m * nCerosEmparejados2 m (n-1) + nCerosEmparejados2 m (n-2)

-- 3ª definición de nCerosEmparejados:

nCerosEmparejados3 :: Integer -> Integer -> Integer

nCerosEmparejados3 m n = aux `genericIndex` n

where aux = 1 : m : zipWith (\x y -> x+m*y) aux (tail aux)

-- Comparación de eficiencia

-- ghci> nCerosEmparejados1 9 7

-- 5144589

-- (22.30 secs, 6556279384 bytes)

-- ghci> nCerosEmparejados2 9 7

-- 5144589

-- (0.01 secs, 515464 bytes)

-- ghci> nCerosEmparejados3 9 7

-- 5144589

-- (0.01 secs, 518104 bytes)

-- ghci> nCerosEmparejados2 9 33

-- 45556060883025783396845717812863

-- (21.59 secs, 2676070480 bytes)

-- ghci> nCerosEmparejados3 9 33

-- 45556060883025783396845717812863

-- (0.00 secs, 1017240 bytes)

Mayor diferencia progresiva

PorJosé A. Alonso 26-febrero-20151-mayo-2016

La diferencia progresiva entre dos elementos de una lista es la resta entre el que ocupa la mayor posición y la menor. Por ejemplo, en la lista [1,5,8,2,9] la diferencia entre los elementos 5 y 8 es 3 y entre 5 y 2 es -3.

Definir la función

   mayorDiferencia :: [Int] -> Int

1	mayorDiferencia :: [Int] -> Int

tal que (mayorDiferencia xs) es la mayor diferencia progresiva entre los elementos de xs. Por ejemplo,

   mayorDiferencia [1,5,8,2,9]  ==  8
   mayorDiferencia [9,5,8,2,1]  ==  3
   mayorDiferencia [7,2,6]      ==  4
   mayorDiferencia [3,2,1]      ==  0
   mayorDiferencia [1..10^7]    ==  9999999

mayorDiferencia [1,5,8,2,9] == 8

mayorDiferencia [9,5,8,2,1] == 3

mayorDiferencia [7,2,6] == 4

mayorDiferencia [3,2,1] == 0

mayorDiferencia [1..10^7] == 9999999

Soluciones

import Data.List (inits)

-- 1ª definición (por recursión):
mayorDiferencia :: [Int] -> Int
mayorDiferencia ([_])  = 0
mayorDiferencia (x:xs) = 
    max (maximum [y-x | y <- xs]) (mayorDiferencia xs) 

-- 2ª definición (por comprensión)
mayorDiferencia2 :: [Int] -> Int
mayorDiferencia2 xs = 
    maximum [x-y | (x,y) <- zip xs (map minimum (tail (inits xs)))]

-- 3ª definición:
mayorDiferencia3 :: [Int] -> Int
mayorDiferencia3 xs = maximum (zipWith (-) xs (scanl1 min xs))

-- 4ª definición:
mayorDiferencia4 :: [Int] -> Int
mayorDiferencia4 xs = maximum . zipWith (-) xs $ scanl1 min xs

-- Comparación de eficiencia
--    ghci> mayorDiferencia [1..3000]
--    2999
--    (3.43 secs, 943439560 bytes)
--    
--    ghci> mayorDiferencia2 [1..3000]
--    2999
--    (3.38 secs, 978359192 bytes)
--    
--    ghci> mayorDiferencia3 [1..3000]
--    2999
--    (0.01 secs, 2877960 bytes)
--    
--    ghci> mayorDiferencia4 [1..3000]
--    2999
--    (0.01 secs, 2062616 bytes)

import Data.List (inits)

-- 1ª definición (por recursión):

mayorDiferencia :: [Int] -> Int

mayorDiferencia ([_]) = 0

mayorDiferencia (x:xs) =

max (maximum [y-x | y <- xs]) (mayorDiferencia xs)

-- 2ª definición (por comprensión)

mayorDiferencia2 :: [Int] -> Int

mayorDiferencia2 xs =

maximum [x-y | (x,y) <- zip xs (map minimum (tail (inits xs)))]

-- 3ª definición:

mayorDiferencia3 :: [Int] -> Int

mayorDiferencia3 xs = maximum (zipWith (-) xs (scanl1 min xs))

-- 4ª definición:

mayorDiferencia4 :: [Int] -> Int

mayorDiferencia4 xs = maximum . zipWith (-) xs $ scanl1 min xs

-- Comparación de eficiencia

-- ghci> mayorDiferencia [1..3000]

-- 2999

-- (3.43 secs, 943439560 bytes)

-- ghci> mayorDiferencia2 [1..3000]

-- 2999

-- (3.38 secs, 978359192 bytes)

-- ghci> mayorDiferencia3 [1..3000]

-- 2999

-- (0.01 secs, 2877960 bytes)

-- ghci> mayorDiferencia4 [1..3000]

-- 2999

-- (0.01 secs, 2062616 bytes)

Suma de conjuntos de polinomios

PorJosé A. Alonso 25-febrero-20151-mayo-2016

Los conjuntos de polinomios se pueden representar por listas de listas de la misma longitud. Por ejemplo, los polinomios 3x²+5x+9, 10x³+9 y 8x³+5x²+x-1 se pueden representar por las listas [0,3,5,9], [10,0,0,9] y [8,5,1,-1].

Definir la función

   sumaPolinomios :: Num a => [[a]] -> [a]

1	sumaPolinomios :: Num a => [[a]] -> [a]

tal que (sumaPolinomios ps) es la suma de los polinomios ps. Por ejemplo,

   ghci> sumaPolinomios1 [[0,3,5,9],[10,0,0,9],[8,5,1,-1]]
   [18,8,6,17]
   ghci> sumaPolinomios6 (replicate 1000000 (replicate 3 1))
   [1000000,1000000,1000000]

ghci> sumaPolinomios1 [[0,3,5,9],[10,0,0,9],[8,5,1,-1]]

[18,8,6,17]

ghci> sumaPolinomios6 (replicate 1000000 (replicate 3 1))

[1000000,1000000,1000000]

Soluciones

import Data.List (transpose)
import Data.Array ((!),accumArray,elems,listArray)

-- 1ª definición (por recursión):
sumaPolinomios1 :: Num a => [[a]] -> [a]
sumaPolinomios1 []          = []
sumaPolinomios1 [xs]        = xs
sumaPolinomios1 (xs:ys:zss) = suma xs (sumaPolinomios1 (ys:zss))

-- (suma xs ys) es la suma de los vectores xs e ys. Por ejemplo,
--    suma [4,7,3] [1,2,5]  == [5,9,8]
suma :: Num a => [a] -> [a] -> [a]
suma [] []         = []
suma (x:xs) (y:ys) = x+y : suma xs ys

-- 2ª definición (por recursión con zipWith): 
sumaPolinomios2 :: Num a => [[a]] -> [a]
sumaPolinomios2 []       = []
sumaPolinomios2 [xs]     = xs
sumaPolinomios2 (xs:xss) = zipWith (+) xs (sumaPolinomios2 xss)

-- 3ª definición (por plegado)
sumaPolinomios3 :: Num a => [[a]] -> [a]
sumaPolinomios3 = foldr1 (zipWith (+))

-- 4ª definición (por comprensión con transpose):
sumaPolinomios4 :: Num a => [[a]] -> [a]
sumaPolinomios4 xss = [sum xs | xs <- transpose xss]

-- 5ª definición (con map y transpose):
sumaPolinomios5 :: Num a => [[a]] -> [a]
sumaPolinomios5 = map sum . transpose 

-- 6ª definición (con array)
sumaPolinomios6 :: Num a => [[a]] -> [a]
sumaPolinomios6 xss = [sum [p!(i,j) | i <- [1..m]] | j <- [1..n]] 
    where m = length xss
          n = length (head xss)
          p = listArray ((1,1),(m,n)) (concat xss) 

-- 7ª definición (con accumArray)
sumaPolinomios7 :: Num a => [[a]] -> [a]
sumaPolinomios7 xss = 
    elems $ accumArray (+) 0 (1,n) (concat [zip [1..] xs | xs <- xss])
    where n = length (head xss)

-- Comparación de eficiencia
--    ghci> sumaPolinomios1 (replicate 300000 (replicate 5 1))
--    [300000,300000,300000,300000,300000]
--    (3.94 secs, 354713532 bytes)
--    
--    ghci> sumaPolinomios2 (replicate 300000 (replicate 5 1))
--    [300000,300000,300000,300000,300000]
--    (2.08 secs, 185506908 bytes)
--    
--    ghci> sumaPolinomios3 (replicate 300000 (replicate 5 1))
--    [300000,300000,300000,300000,300000]
--    (1.48 secs, 167026728 bytes)
--    
--    ghci> sumaPolinomios4 (replicate 300000 (replicate 5 1))
--    [300000,300000,300000,300000,300000]
--    (1.08 secs, 148564752 bytes)
--    
--    ghci> sumaPolinomios5 (replicate 300000 (replicate 5 1))
--    [300000,300000,300000,300000,300000]
--    (1.02 secs, 148062764 bytes)
--    
--    ghci> sumaPolinomios6 (replicate 300000 (replicate 5 1))
--    [300000,300000,300000,300000,300000]
--    (3.17 secs, 463756028 bytes)
--    
--    ghci> sumaPolinomios7 (replicate 300000 (replicate 5 1))
--    [300000,300000,300000,300000,300000]
--    (1.50 secs, 291699548 bytes)

import Data.List (transpose)

import Data.Array ((!),accumArray,elems,listArray)

-- 1ª definición (por recursión):

sumaPolinomios1 :: Num a => [[a]] -> [a]

sumaPolinomios1 [] = []

sumaPolinomios1 [xs] = xs

sumaPolinomios1 (xs:ys:zss) = suma xs (sumaPolinomios1 (ys:zss))

-- (suma xs ys) es la suma de los vectores xs e ys. Por ejemplo,

-- suma [4,7,3] [1,2,5] == [5,9,8]

suma :: Num a => [a] -> [a] -> [a]

suma [] [] = []

suma (x:xs) (y:ys) = x+y : suma xs ys

-- 2ª definición (por recursión con zipWith):

sumaPolinomios2 :: Num a => [[a]] -> [a]

sumaPolinomios2 [] = []

sumaPolinomios2 [xs] = xs

sumaPolinomios2 (xs:xss) = zipWith (+) xs (sumaPolinomios2 xss)

-- 3ª definición (por plegado)

sumaPolinomios3 :: Num a => [[a]] -> [a]

sumaPolinomios3 = foldr1 (zipWith (+))

-- 4ª definición (por comprensión con transpose):

sumaPolinomios4 :: Num a => [[a]] -> [a]

sumaPolinomios4 xss = [sum xs | xs <- transpose xss]

-- 5ª definición (con map y transpose):

sumaPolinomios5 :: Num a => [[a]] -> [a]

sumaPolinomios5 = map sum . transpose

-- 6ª definición (con array)

sumaPolinomios6 :: Num a => [[a]] -> [a]

sumaPolinomios6 xss = [sum [p!(i,j) | i <- [1..m]] | j <- [1..n]]

where m = length xss

n = length (head xss)

p = listArray ((1,1),(m,n)) (concat xss)

-- 7ª definición (con accumArray)

sumaPolinomios7 :: Num a => [[a]] -> [a]

sumaPolinomios7 xss =

elems $ accumArray (+) 0 (1,n) (concat [zip [1..] xs | xs <- xss])

where n = length (head xss)

-- Comparación de eficiencia

-- ghci> sumaPolinomios1 (replicate 300000 (replicate 5 1))

-- [300000,300000,300000,300000,300000]

-- (3.94 secs, 354713532 bytes)

-- ghci> sumaPolinomios2 (replicate 300000 (replicate 5 1))

-- [300000,300000,300000,300000,300000]

-- (2.08 secs, 185506908 bytes)

-- ghci> sumaPolinomios3 (replicate 300000 (replicate 5 1))

-- [300000,300000,300000,300000,300000]

-- (1.48 secs, 167026728 bytes)

-- ghci> sumaPolinomios4 (replicate 300000 (replicate 5 1))

-- [300000,300000,300000,300000,300000]

-- (1.08 secs, 148564752 bytes)

-- ghci> sumaPolinomios5 (replicate 300000 (replicate 5 1))

-- [300000,300000,300000,300000,300000]

-- (1.02 secs, 148062764 bytes)

-- ghci> sumaPolinomios6 (replicate 300000 (replicate 5 1))

-- [300000,300000,300000,300000,300000]

-- (3.17 secs, 463756028 bytes)

-- ghci> sumaPolinomios7 (replicate 300000 (replicate 5 1))

-- [300000,300000,300000,300000,300000]

-- (1.50 secs, 291699548 bytes)

Mayor producto de n dígitos consecutivos de un número

PorJosé A. Alonso 12-febrero-201525-abril-2021

Definir la función

   mayorProducto :: Int -> Integer -> Integer

1	mayorProducto :: Int -> Integer -> Integer

tal que (mayorProducto n x) es el mayor producto de n dígitos consecutivos del número x (suponiendo que x tiene al menos n dígitos). Por ejemplo,

   mayorProducto 2 325                  ==  10
   mayorProducto 5 11111                ==  1
   mayorProducto 5 113111               ==  3
   mayorProducto 5 110111               ==  0
   mayorProducto 5 10151112             ==  10
   mayorProducto 5 101511124            ==  10
   mayorProducto 5 (product [1..1000])  ==  41472

mayorProducto 2 325 == 10

mayorProducto 5 11111 == 1

mayorProducto 5 113111 == 3

mayorProducto 5 110111 == 0

mayorProducto 5 10151112 == 10

mayorProducto 5 101511124 == 10

mayorProducto 5 (product [1..1000]) == 41472

Soluciones

import Data.List (inits, tails)
import Data.Char (digitToInt)

-- 1ª solución
-- ===========

mayorProducto1 :: Int -> Integer -> Integer
mayorProducto1 n x = 
    maximum [product xs | xs <- segmentos n (cifras x)]

-- (cifras x) es la lista de las cifras del número x, de derecha a
-- izquierda. Por ejemplo, 
--    cifras 325  ==  [5,2,3]
cifras :: Integer -> [Integer]
cifras x 
    | x < 10    = [x]
    | otherwise = r : cifras q
    where (q,r) = quotRem x 10

-- (segmentos n xs) es la lista de los segmentos de longitud n de la
-- lista xs. Por ejemplo,
--    segmentos 2 [3,5,4,6]  ==  [[3,5],[5,4],[4,6]]
segmentos :: Int -> [Integer] -> [[Integer]]
segmentos n xs = take (length xs - n + 1) (map (take n) (tails xs))

-- 2ª solución
-- ===========

mayorProducto2 :: Int -> Integer -> Integer
mayorProducto2 n x = maximum (aux ns)
    where ns     = [read [d] | d <- show x]
          aux xs | length xs < n = []
                 | otherwise     = product (take n xs) : aux (tail xs)

-- 3ª solución
-- ===========

mayorProducto3 :: Int -> Integer -> Integer
mayorProducto3 n = maximum . 
                   map (product . take n) .
                   filter ((>=n) . length) .
                   tails . 
                   cifras

-- 4ª solución
-- ===========

mayorProducto4 :: Int -> Integer -> Integer
mayorProducto4 n = maximum . 
                   map (product . map (fromIntegral . digitToInt)) . 
                   filter ((==n) . length) . 
                   concatMap inits . 
                   tails .
                   show

-- ---------------------------------------------------------------------
-- Comparación de soluciones                                          --
-- ---------------------------------------------------------------------

-- Tiempo (en segundos) del cálculo de (mayorProducto4 5 (product [1..]))
-- 
--    | Def | 10   | 100  | 1000 | 5000  |
--    |-----+------+------+------+-------|
--    | 1   | 0.01 | 0.01 | 0.04 |  0.34 |
--    | 2   | 0.01 | 0.01 | 0.07 |  2.86 |
--    | 3   | 0.01 | 0.01 | 0.06 | 12.48 |
--    | 4   | 0.00 | 0.12 |      |       |
...

import Data.List (inits, tails)

import Data.Char (digitToInt)

-- 1ª solución

-- ===========

mayorProducto1 :: Int -> Integer -> Integer

mayorProducto1 n x =

maximum [product xs | xs <- segmentos n (cifras x)]

-- (cifras x) es la lista de las cifras del número x, de derecha a

-- izquierda. Por ejemplo,

-- cifras 325 == [5,2,3]

cifras :: Integer -> [Integer]

cifras x

| x < 10 = [x]

| otherwise = r : cifras q

where (q,r) = quotRem x 10

-- (segmentos n xs) es la lista de los segmentos de longitud n de la

-- lista xs. Por ejemplo,

-- segmentos 2 [3,5,4,6] == [[3,5],[5,4],[4,6]]

segmentos :: Int -> [Integer] -> [[Integer]]

segmentos n xs = take (length xs - n + 1) (map (take n) (tails xs))

-- 2ª solución

-- ===========

mayorProducto2 :: Int -> Integer -> Integer

mayorProducto2 n x = maximum (aux ns)

where ns = [read [d] | d <- show x]

aux xs | length xs < n = []

| otherwise = product (take n xs) : aux (tail xs)

-- 3ª solución

-- ===========

mayorProducto3 :: Int -> Integer -> Integer

mayorProducto3 n = maximum .

map (product . take n) .

filter ((>=n) . length) .

tails .

cifras

-- 4ª solución

-- ===========

mayorProducto4 :: Int -> Integer -> Integer

mayorProducto4 n = maximum .

map (product . map (fromIntegral . digitToInt)) .

filter ((==n) . length) .

concatMap inits .

tails .

show

-- ---------------------------------------------------------------------

-- Comparación de soluciones --

-- ---------------------------------------------------------------------

-- Tiempo (en segundos) del cálculo de (mayorProducto4 5 (product [1..]))

-- | Def | 10 | 100 | 1000 | 5000 |

-- |-----+------+------+------+-------|

-- | 1 | 0.01 | 0.01 | 0.04 | 0.34 |

-- | 2 | 0.01 | 0.01 | 0.07 | 2.86 |

-- | 3 | 0.01 | 0.01 | 0.06 | 12.48 |

-- | 4 | 0.00 | 0.12 | | |

...

Segmentos de longitud dada

PorJosé A. Alonso 10-febrero-20151-mayo-2016

Definir la función

   segmentos :: Int -> [a] -> [[a]]

1	segmentos :: Int -> [a] -> [[a]]

tal que (segmentos n xs) es la lista de los segmentos de longitud n de la lista xs. Por ejemplo,

   segmentos 3 [1..5]  ==  [[1,2,3],[2,3,4],[3,4,5]]

1	segmentos 3 [1..5] == [[1,2,3],[2,3,4],[3,4,5]]

Soluciones

import Data.List (tails)

-- 1ª definición (por recursión)
segmentos1 :: Int -> [a] -> [[a]]
segmentos1 n xs 
    | length xs < n = []
    | otherwise     = take n xs : segmentos1 n (tail xs)
                  
-- 2ª definición (con tails):
segmentos2 :: Int -> [a] -> [[a]]
segmentos2 n xs = 
    takeWhile (\ys -> length ys == n) (map (take n) (tails xs))

-- 3ª definición:
segmentos3 :: Int -> [a] -> [[a]]
segmentos3 n xs = 
    take (length xs - n + 1) (map (take n) (tails xs))

--    ghci> length (segmentos1 3 [1..30000])
--    29998
--    (2.99 secs, 13998816 bytes)
--    
--    ghci> length (segmentos2 3 [1..30000])
--    29998
--    (0.05 secs, 16941304 bytes)
--    
--    ghci> length (segmentos3 3 [1..30000])
--    29998
--    (0.04 secs, 10375520 bytes)
--    
--    ghci> length (segmentos2 3 [1..1000000])
--    999998
--    (0.70 secs, 498098336 bytes)
--    
--    ghci> length (segmentos3 3 [1..1000000])
--    999998
--    (0.24 secs, 273979304 bytes)

import Data.List (tails)

-- 1ª definición (por recursión)

segmentos1 :: Int -> [a] -> [[a]]

segmentos1 n xs

| length xs < n = []

| otherwise = take n xs : segmentos1 n (tail xs)

-- 2ª definición (con tails):

segmentos2 :: Int -> [a] -> [[a]]

segmentos2 n xs =

takeWhile (\ys -> length ys == n) (map (take n) (tails xs))

-- 3ª definición:

segmentos3 :: Int -> [a] -> [[a]]

segmentos3 n xs =

take (length xs - n + 1) (map (take n) (tails xs))

-- ghci> length (segmentos1 3 [1..30000])

-- 29998

-- (2.99 secs, 13998816 bytes)

-- ghci> length (segmentos2 3 [1..30000])

-- 29998

-- (0.05 secs, 16941304 bytes)

-- ghci> length (segmentos3 3 [1..30000])

-- 29998

-- (0.04 secs, 10375520 bytes)

-- ghci> length (segmentos2 3 [1..1000000])

-- 999998

-- (0.70 secs, 498098336 bytes)

-- ghci> length (segmentos3 3 [1..1000000])

-- 999998

-- (0.24 secs, 273979304 bytes)

Menor número triangular con más de n divisores

PorJosé A. Alonso 6-febrero-201525-abril-2021

La sucesión de los números triangulares se obtiene sumando los números naturales.

Así, el 7º número triangular es

   1 + 2 + 3 + 4 + 5 + 6 + 7 = 28.

1	1 + 2 + 3 + 4 + 5 + 6 + 7 = 28.

Los primeros 10 números triangulares son

   1, 3, 6, 10, 15, 21, 28, 36, 45, 55, ...

1	1, 3, 6, 10, 15, 21, 28, 36, 45, 55, ...

Los divisores de los primeros 7 números triangulares son:

    1: 1
    3: 1,3
    6: 1,2,3,6
   10: 1,2,5,10
   15: 1,3,5,15
   21: 1,3,7,21
   28: 1,2,4,7,14,28

1: 1

3: 1,3

6: 1,2,3,6

10: 1,2,5,10

15: 1,3,5,15

21: 1,3,7,21

28: 1,2,4,7,14,28

Como se puede observar, 28 es el menor número triangular con más de 5 divisores.

Definir la función

   menorTriangularConAlMenosNDivisores :: Int -> Integer

1	menorTriangularConAlMenosNDivisores :: Int -> Integer

tal que (menorTriangularConAlMenosNDivisores n) es el menor número triangular que tiene al menos n divisores. Por ejemplo,

   menorTriangularConAlMenosNDivisores 5    ==  28
   menorTriangularConAlMenosNDivisores 50   ==  25200
   menorTriangularConAlMenosNDivisores 500  ==  76576500

menorTriangularConAlMenosNDivisores 5 == 28

menorTriangularConAlMenosNDivisores 50 == 25200

menorTriangularConAlMenosNDivisores 500 == 76576500

Soluciones

import Data.List (group)
import Data.Numbers.Primes (primes,primeFactors)

-- 1ª definición
-- =============

menorTriangularConAlMenosNDivisores1 :: Int -> Integer
menorTriangularConAlMenosNDivisores1 n = 
    head [x | x <- triangulares, nDivisores x >= n]

-- triangulares es la sucesión de los números triangulares. Por ejemplo,
--    take 10 triangulares  ==  [1,3,6,10,15,21,28,36,45,55]
triangulares :: [Integer]
triangulares = scanl (+) 1 [2..]

-- (nDivisores x) es el número de divisores de x. Por ejemplo,
--    nDivisores 28  ==  6
nDivisores :: Integer -> Int
nDivisores x = 
    1 + length [y | y <- [1..x `div` 2], mod x y == 0]

-- 2ª solución
-- ===========

menorTriangularConAlMenosNDivisores2 :: Int -> Integer
menorTriangularConAlMenosNDivisores2 n = 
    head [x | x <- triangulares, nDivisores2 x >= n]

-- (nDivisores2 x) es el número de divisores de x. Por ejemplo,
--    nDivisores2 28  ==  6
nDivisores2 :: Integer -> Int
nDivisores2 n = product [1 + length xs | xs <- group (factoresPrimos n)]    

-- (factoresPrimos n) es la lista de los factores primos de n. Por
-- ejemplo, 
--    factoresPrimos 28  ==  [2,2,7]
factoresPrimos :: Integer -> [Integer]
factoresPrimos n = aux n primos
    where aux n (p:ps) 
              | p*p > n        = [n]
              | n `mod` p == 0 = p : aux (n `div` p) (p:ps)
              | otherwise      = aux n ps

-- primos es la lista de los números primos. Por ejemplo,
--    take 10 primos  ==  [2,3,5,7,11,13,17,19,23,29]
primos :: [Integer]
primos = 2 : filter ((==1) . length . factoresPrimos) [3,5..]

-- 3ª solución (usando primes)
-- ===========================

menorTriangularConAlMenosNDivisores3 :: Int -> Integer
menorTriangularConAlMenosNDivisores3 n = 
    head [x | x <- triangulares, nDivisores3 x >= n]

-- (nDivisores3 x) es el número de divisores de x. Por ejemplo,
--    nDivisores3 28  ==  6
nDivisores3 :: Integer -> Int
nDivisores3 n = product [1 + length xs | xs <- group (factoresPrimos3 n)]    

-- (factoresPrimos3 n) es la lista de los factores primos de n. Por
-- ejemplo, 
--    factoresPrimos3 28  ==  [2,2,7]
factoresPrimos3 n = aux n primes
  where
    aux n (p:ps) 
        | p*p > n        = [n]
        | n `mod` p == 0 = p : aux (n `div` p) (p:ps)
        | otherwise      = aux n ps

-- 4ª solución (usando primeFactors)
-- =================================

menorTriangularConAlMenosNDivisores4 :: Int -> Integer
menorTriangularConAlMenosNDivisores4 n = 
    head [x | x <- triangulares, nDivisores4 x >= n]

-- (nDivisores4 x) es el número de divisores de x. Por ejemplo,
--    nDivisores4 28  ==  6
nDivisores4 :: Integer -> Int
nDivisores4 n = product [1 + length xs | xs <- group (primeFactors n)]    

-- ---------------------------------------------------------------------
-- § Comparación de eficiencia                                        --
-- ---------------------------------------------------------------------

-- La comparación es
--    ghci> menorTriangularConAlMenosNDivisores1 50
--    25200
--    (1.25 secs, 200236512 bytes)
--    
--    ghci> menorTriangularConAlMenosNDivisores2 50
--    25200
--    (0.02 secs, 4199904 bytes)
--    
--    ghci> menorTriangularConAlMenosNDivisores3 50
--    25200
--    (0.03 secs, 6265128 bytes)
--    
--    ghci> menorTriangularConAlMenosNDivisores4 50
--    25200
--    (0.01 secs, 5753048 bytes)

100

101

102

import Data.List (group)

import Data.Numbers.Primes (primes,primeFactors)

-- 1ª definición

-- =============

menorTriangularConAlMenosNDivisores1 :: Int -> Integer

menorTriangularConAlMenosNDivisores1 n =

head [x | x <- triangulares, nDivisores x >= n]

-- triangulares es la sucesión de los números triangulares. Por ejemplo,

-- take 10 triangulares == [1,3,6,10,15,21,28,36,45,55]

triangulares :: [Integer]

triangulares = scanl (+) 1 [2..]

-- (nDivisores x) es el número de divisores de x. Por ejemplo,

-- nDivisores 28 == 6

nDivisores :: Integer -> Int

nDivisores x =

1 + length [y | y <- [1..x `div` 2], mod x y == 0]

-- 2ª solución

-- ===========

menorTriangularConAlMenosNDivisores2 :: Int -> Integer

menorTriangularConAlMenosNDivisores2 n =

head [x | x <- triangulares, nDivisores2 x >= n]

-- (nDivisores2 x) es el número de divisores de x. Por ejemplo,

-- nDivisores2 28 == 6

nDivisores2 :: Integer -> Int

nDivisores2 n = product [1 + length xs | xs <- group (factoresPrimos n)]

-- (factoresPrimos n) es la lista de los factores primos de n. Por

-- ejemplo,

-- factoresPrimos 28 == [2,2,7]

factoresPrimos :: Integer -> [Integer]

factoresPrimos n = aux n primos

where aux n (p:ps)

| p*p > n = [n]

| n `mod` p == 0 = p : aux (n `div` p) (p:ps)

| otherwise = aux n ps

-- primos es la lista de los números primos. Por ejemplo,

-- take 10 primos == [2,3,5,7,11,13,17,19,23,29]

primos :: [Integer]

primos = 2 : filter ((==1) . length . factoresPrimos) [3,5..]

-- 3ª solución (usando primes)

-- ===========================

menorTriangularConAlMenosNDivisores3 :: Int -> Integer

menorTriangularConAlMenosNDivisores3 n =

head [x | x <- triangulares, nDivisores3 x >= n]

-- (nDivisores3 x) es el número de divisores de x. Por ejemplo,

-- nDivisores3 28 == 6

nDivisores3 :: Integer -> Int

nDivisores3 n = product [1 + length xs | xs <- group (factoresPrimos3 n)]

-- (factoresPrimos3 n) es la lista de los factores primos de n. Por

-- ejemplo,

-- factoresPrimos3 28 == [2,2,7]

factoresPrimos3 n = aux n primes

where

aux n (p:ps)

| p*p > n = [n]

| n `mod` p == 0 = p : aux (n `div` p) (p:ps)

| otherwise = aux n ps

-- 4ª solución (usando primeFactors)

-- =================================

menorTriangularConAlMenosNDivisores4 :: Int -> Integer

menorTriangularConAlMenosNDivisores4 n =

head [x | x <- triangulares, nDivisores4 x >= n]

-- (nDivisores4 x) es el número de divisores de x. Por ejemplo,

-- nDivisores4 28 == 6

nDivisores4 :: Integer -> Int

nDivisores4 n = product [1 + length xs | xs <- group (primeFactors n)]

-- ---------------------------------------------------------------------

-- § Comparación de eficiencia --

-- ---------------------------------------------------------------------

-- La comparación es

-- ghci> menorTriangularConAlMenosNDivisores1 50

-- 25200

-- (1.25 secs, 200236512 bytes)

-- ghci> menorTriangularConAlMenosNDivisores2 50

-- 25200

-- (0.02 secs, 4199904 bytes)

-- ghci> menorTriangularConAlMenosNDivisores3 50

-- 25200

-- (0.03 secs, 6265128 bytes)

-- ghci> menorTriangularConAlMenosNDivisores4 50

-- 25200

-- (0.01 secs, 5753048 bytes)

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Entradas recientes

Buscar

Correo electrónico