concatMap – Página 2

Ampliación de una matriz

PorJosé A. Alonso 12-abril-201720-abril-2017

Definir, usando Data.Matrix, la función

   ampliaMatriz :: Matrix a -> Int -> Int -> Matrix a

1	ampliaMatriz :: Matrix a -> Int -> Int -> Matrix a

tal que (ampliaMatriz p f c) es la matriz obtenida a partir de p repitiendo cada fila f veces y cada columna c veces. Por ejemplo, si ej1 es la matriz definida por

   ej1 :: Matrix Char
   ej1 = fromLists [" x ",
                    "x x",
                    " x "]

ej1 :: Matrix Char

ej1 = fromLists [" x ",

"x x",

" x "]

entonces

   λ> ampliaMatriz ej1 1 2
   ( ' ' ' ' 'x' 'x' ' ' ' ' )
   ( 'x' 'x' ' ' ' ' 'x' 'x' )
   ( ' ' ' ' 'x' 'x' ' ' ' ' )
   
   λ> (putStr . unlines . toLists) (ampliaMatriz ej1 1 2)
     xx  
   xx  xx
     xx  
   λ> (putStr . unlines . toLists) (ampliaMatriz ej1 2 1)
    x 
    x 
   x x
   x x
    x 
    x 
   λ> (putStr . unlines . toLists) (ampliaMatriz ej1 2 2)
     xx  
     xx  
   xx  xx
   xx  xx
     xx  
     xx  
   λ> (putStr . unlines . toLists) (ampliaMatriz ej1 2 3)
      xxx   
      xxx   
   xxx   xxx
   xxx   xxx
      xxx   
      xxx

λ> ampliaMatriz ej1 1 2

( ' ' ' ' 'x' 'x' ' ' ' ' )

( 'x' 'x' ' ' ' ' 'x' 'x' )

( ' ' ' ' 'x' 'x' ' ' ' ' )

λ> (putStr . unlines . toLists) (ampliaMatriz ej1 1 2)

xx xx

λ> (putStr . unlines . toLists) (ampliaMatriz ej1 2 1)

x x

λ> (putStr . unlines . toLists) (ampliaMatriz ej1 2 2)

xx xx

λ> (putStr . unlines . toLists) (ampliaMatriz ej1 2 3)

xxx

xxx xxx

xxx

Nota: Este ejercicio está basado en el problema Skener de Kattis.

Soluciones

import Data.Matrix

ej1 :: Matrix Char
ej1 = fromLists [" x ",
                 "x x",
                 " x "]

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

ampliaMatriz :: Matrix a -> Int -> Int -> Matrix a
ampliaMatriz p f c =
  ampliaColumnas (ampliaFilas p f) c

ampliaFilas :: Matrix a -> Int -> Matrix a
ampliaFilas p f =
  matrix (f*m) n (\(i,j) -> p!(1 + (i-1) `div` f, j))
  where m = nrows p
        n = ncols p

ampliaColumnas :: Matrix a -> Int -> Matrix a
ampliaColumnas p c =
  matrix m (c*n) (\(i,j) -> p!(i,1 + (j-1) `div` c))
  where m = nrows p
        n = ncols p

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

ampliaMatriz2 :: Matrix a -> Int -> Int -> Matrix a
ampliaMatriz2 p f c =
  ampliaColumnas2 (ampliaFilas2 p f) c

ampliaFilas2 :: Matrix a -> Int -> Matrix a
ampliaFilas2 p f =
  fromLists (concatMap (replicate f) (toLists p))

ampliaColumnas2 :: Matrix a -> Int -> Matrix a
ampliaColumnas2 p c =
  fromLists (map (concatMap (replicate c)) (toLists p))

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

ampliaMatriz3 :: Matrix a -> Int -> Int -> Matrix a
ampliaMatriz3 p f c =
  ( fromLists
  . concatMap (map (concatMap (replicate c)) . replicate f)
  . toLists) p

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

ejemplo :: Int -> Matrix Int
ejemplo n = fromList n n [1..]

--    λ> maximum (ampliaMatriz (ejemplo 10) 100 200)
--    100
--    (6.64 secs, 1,026,559,296 bytes)
--    λ> maximum (ampliaMatriz2 (ejemplo 10) 100 200)
--    100
--    (1.90 secs, 513,211,144 bytes)
--    λ> maximum (ampliaMatriz3 (ejemplo 10) 100 200)
--    100
--    (1.89 secs, 644,928,024 bytes)
--    λ> maximum (ampliaMatriz2 (ejemplo 10) 200 200)
--    100
--    (5.13 secs, 1,248,173,384 bytes)
--    λ> maximum (ampliaMatriz3 (ejemplo 10) 200 200)
--    100
--    (4.67 secs, 1,431,540,344 bytes)

import Data.Matrix

ej1 :: Matrix Char

ej1 = fromLists [" x ",

"x x",

" x "]

-- 1ª definición

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

ampliaMatriz :: Matrix a -> Int -> Int -> Matrix a

ampliaMatriz p f c =

ampliaColumnas (ampliaFilas p f) c

ampliaFilas :: Matrix a -> Int -> Matrix a

ampliaFilas p f =

matrix (f*m) n (\(i,j) -> p!(1 + (i-1) `div` f, j))

where m = nrows p

n = ncols p

ampliaColumnas :: Matrix a -> Int -> Matrix a

ampliaColumnas p c =

matrix m (c*n) (\(i,j) -> p!(i,1 + (j-1) `div` c))

where m = nrows p

n = ncols p

-- 2ª definición

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

ampliaMatriz2 :: Matrix a -> Int -> Int -> Matrix a

ampliaMatriz2 p f c =

ampliaColumnas2 (ampliaFilas2 p f) c

ampliaFilas2 :: Matrix a -> Int -> Matrix a

ampliaFilas2 p f =

fromLists (concatMap (replicate f) (toLists p))

ampliaColumnas2 :: Matrix a -> Int -> Matrix a

ampliaColumnas2 p c =

fromLists (map (concatMap (replicate c)) (toLists p))

-- 3ª definición

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

ampliaMatriz3 :: Matrix a -> Int -> Int -> Matrix a

ampliaMatriz3 p f c =

( fromLists

. concatMap (map (concatMap (replicate c)) . replicate f)

. toLists) p

-- Comparación de eficiencia

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

ejemplo :: Int -> Matrix Int

ejemplo n = fromList n n [1..]

-- λ> maximum (ampliaMatriz (ejemplo 10) 100 200)

-- 100

-- (6.64 secs, 1,026,559,296 bytes)

-- λ> maximum (ampliaMatriz2 (ejemplo 10) 100 200)

-- 100

-- (1.90 secs, 513,211,144 bytes)

-- λ> maximum (ampliaMatriz3 (ejemplo 10) 100 200)

-- 100

-- (1.89 secs, 644,928,024 bytes)

-- λ> maximum (ampliaMatriz2 (ejemplo 10) 200 200)

-- 100

-- (5.13 secs, 1,248,173,384 bytes)

-- λ> maximum (ampliaMatriz3 (ejemplo 10) 200 200)

-- 100

-- (4.67 secs, 1,431,540,344 bytes)

Caminos minimales en un arbol numérico

PorJosé A. Alonso 10-marzo-201725-abril-2021

En la librería Data.Tree se definen los árboles y los bosques como sigue

   data Tree a   = Node a (Forest a)
   type Forest a = [Tree a]

1 2	data Tree a = Node a (Forest a) type Forest a = [Tree a]

Se pueden definir árboles. Por ejemplo,

   ej = Node 3 [Node 5 [Node 9 []], Node 7 []]

1	ej = Node 3 [Node 5 [Node 9 []], Node 7 []]

Y se pueden dibujar con la función drawTree. Por ejemplo,

   λ> putStrLn (drawTree (fmap show ej))
   3
   |
   +- 5
   |  |
   |  `- 9
   |
   `- 7

λ> putStrLn (drawTree (fmap show ej))

+- 5

| |

| `- 9

`- 7

Los mayores divisores de un número x son los divisores u tales que u > 1 y existe un v tal que 1 < v < u y u*v = x. Por ejemplo, los mayores divisores de 24 son 12, 8 y 6.

El árbol de los predecesores y mayores divisores de un número x es el árbol cuya raíz es x y los sucesores de cada nodo y > 1 es el conjunto formado por y-1 junto con los mayores divisores de y. Los nodos con valor 1 no tienen sucesores. Por ejemplo, el árbol de los predecesores y mayores divisores del número 6 es

/ \

5 3

| |

4 2

/ \ |

3 2 1

| |

2 1

Definir las siguientes funciones

   mayoresDivisores :: Int -> [Int]
   arbol            :: Int -> Tree Int
   caminos          :: Int -> [[Int]]
   caminosMinimales :: Int -> [[Int]]

mayoresDivisores :: Int -> [Int]

arbol :: Int -> Tree Int

caminos :: Int -> [[Int]]

caminosMinimales :: Int -> [[Int]]

tales que

(mayoresDivisores x) es la lista de los mayores divisores de x. Por ejemplo,

     mayoresDivisores 24  ==  [12,8,6]
     mayoresDivisores 16  ==  [8,4]
     mayoresDivisores 10  ==  [5]
     mayoresDivisores 17  ==  []

mayoresDivisores 24 == [12,8,6]

mayoresDivisores 16 == [8,4]

mayoresDivisores 10 == [5]

mayoresDivisores 17 == []

(arbol x) es el árbol de los predecesores y mayores divisores del número x. Por ejemplo,

     λ> putStrLn (drawTree (fmap show (arbol 6)))
     6
     |
     +- 5
     |  |
     |  `- 4
     |     |
     |     +- 3
     |     |  |
     |     |  `- 2
     |     |     |
     |     |     `- 1
     |     |
     |     `- 2
     |        |
     |        `- 1
     |
     `- 3
        |
        `- 2
           |
           `- 1

λ> putStrLn (drawTree (fmap show (arbol 6)))

+- 5

| |

| `- 4

| |

| +- 3

| | |

| | `- 2

| | |

| | `- 1

| |

| `- 2

| |

| `- 1

`- 3

`- 2

`- 1

(caminos x) es la lista de los caminos en el árbol de los predecesores y mayores divisores del número x. Por ejemplo,

     λ> caminos 6
     [[6,5,4,3,2,1],[6,5,4,2,1],[6,3,2,1]]

1 2	λ> caminos 6 [[6,5,4,3,2,1],[6,5,4,2,1],[6,3,2,1]]

(caminosMinimales x) es la lista de los caminos en de menor longitud en el árbol de los predecesores y mayores divisores del número x. Por ejemplo,

     λ> caminosMinimales 6
     [[6,3,2,1]]
     λ> caminosMinimales 17
     [[17,16,4,2,1]]
     λ> caminosMinimales 50
     [[50,25,5,4,2,1],[50,10,9,3,2,1],[50,10,5,4,2,1]]

λ> caminosMinimales 6

[[6,3,2,1]]

λ> caminosMinimales 17

[[17,16,4,2,1]]

λ> caminosMinimales 50

[[50,25,5,4,2,1],[50,10,9,3,2,1],[50,10,5,4,2,1]]

Soluciones

import Data.Tree

mayoresDivisores :: Int -> [Int]
mayoresDivisores x =
  [max u v | u <- [2..floor (sqrt (fromIntegral x))]
           , x `mod` u == 0
           , let v = x `div` u]  

arbol :: Int -> Tree Int
arbol 1 = Node 1 []
arbol x = Node x (arbol (x-1) : [arbol y | y <- mayoresDivisores x])

caminos :: Int -> [[Int]]
caminos = caminosArbol . arbol

--    λ> caminosArbol (arbol 6)
--    [[6,5,4,3,2,1],[6,5,4,2,1],[6,3,2,1]]
caminosArbol :: Tree a -> [[a]]
caminosArbol (Node x []) = [[x]]
caminosArbol (Node x as) = [x:ys | ys <- caminosBosque as]

caminosBosque :: Forest a -> [[a]]
caminosBosque = concatMap caminosArbol

caminosMinimales :: Int -> [[Int]]
caminosMinimales x = [ys | ys <- yss, length ys == m]
  where yss = caminos x
        m   = minimum (map length yss)

import Data.Tree

mayoresDivisores :: Int -> [Int]

mayoresDivisores x =

[max u v | u <- [2..floor (sqrt (fromIntegral x))]

, x `mod` u == 0

, let v = x `div` u]

arbol :: Int -> Tree Int

arbol 1 = Node 1 []

arbol x = Node x (arbol (x-1) : [arbol y | y <- mayoresDivisores x])

caminos :: Int -> [[Int]]

caminos = caminosArbol . arbol

-- λ> caminosArbol (arbol 6)

-- [[6,5,4,3,2,1],[6,5,4,2,1],[6,3,2,1]]

caminosArbol :: Tree a -> [[a]]

caminosArbol (Node x []) = [[x]]

caminosArbol (Node x as) = [x:ys | ys <- caminosBosque as]

caminosBosque :: Forest a -> [[a]]

caminosBosque = concatMap caminosArbol

caminosMinimales :: Int -> [[Int]]

caminosMinimales x = [ys | ys <- yss, length ys == m]

where yss = caminos x

m = minimum (map length yss)

La sucesión «Mira y di»

PorJosé A. Alonso 24-enero-201731-enero-2017

La sucesión «Mira y di» (en inglés, Look-and-Say) es una sucesión de números naturales en donde cada término se obtiene agrupando las cifras iguales del anterior y recitándolas. Por ejemplo, si x(0) = 1 se lee como «un uno» y por tanto x(1) = 11. Análogamente,

   x(1) = 11     ("dos unos                          --> "21")
   x(2) = 21     ("un dos un uno                     --> "1211")
   x(3) = 1211   ("un uno un dos dos unos            --> "111221")
   x(4) = 111221 ("tres unos dos doses un uno        --> "312211")
   x(5) = 312211 ("un tres un uno dos doses dos unos --> "13112221")

x(1) = 11 ("dos unos --> "21")

x(2) = 21 ("un dos un uno --> "1211")

x(3) = 1211 ("un uno un dos dos unos --> "111221")

x(4) = 111221 ("tres unos dos doses un uno --> "312211")

x(5) = 312211 ("un tres un uno dos doses dos unos --> "13112221")

Definir la función

  sucMiraYDi :: Integer -> [Integer]

1	sucMiraYDi :: Integer -> [Integer]

tal que (sucMiraYDi n) es la sucesión «Mira y di» cuyo primer término es n. Por ejemplo,

   λ> take 9 (sucMiraYdi 1)
   [1,11,21,1211,111221,312211,13112221,1113213211,31131211131221]
   λ> take 5 (sucMiraYdi 2017)
   [2017,12101117,111211103117,31123110132117,1321121321101113122117]
   λ> take 7 (sucMiraYDi 22)
   [22,22,22,22,22,22,22]
   λ> (sucMiraYDi 1) !! 11
   3113112221232112111312211312113211
   λ> (sucMiraYDi 1) !! 12
   1321132132111213122112311311222113111221131221

λ> take 9 (sucMiraYdi 1)

[1,11,21,1211,111221,312211,13112221,1113213211,31131211131221]

λ> take 5 (sucMiraYdi 2017)

[2017,12101117,111211103117,31123110132117,1321121321101113122117]

λ> take 7 (sucMiraYDi 22)

[22,22,22,22,22,22,22]

λ> (sucMiraYDi 1) !! 11

3113112221232112111312211312113211

λ> (sucMiraYDi 1) !! 12

1321132132111213122112311311222113111221131221

Independientemente del término inicial x(0) elegido (con la única salvedad del 22), la sucesión diverge y la razón entre el número de cifras de x(n) y el de x(n-1) tiende a un valor fijo que es la constante de Conway λ ≈ 1.303577269. Por ejemplo, para x(0) = 1, las razones son

   2, 1, 2, 1.5, 1, 1.3333333333333333, 1.25, 1.4, 1.4285714285714286, 1.3

1	2, 1, 2, 1.5, 1, 1.3333333333333333, 1.25, 1.4, 1.4285714285714286, 1.3

Definir la función

   aproximacionConway :: Integer -> Double -> Int

1	aproximacionConway :: Integer -> Double -> Int

tal que (aproximacionConway n e) es el menor k tal que la diferencia entre la constante de Conway y la razón entre el número de cifras de x(k) x(k-1) es, en valor absoluto, menor que e. Por ejemplo,

   aproximacionConway 1 0.3     ==  3
   aproximacionConway 1 0.1     ==  5
   aproximacionConway 1 0.01    ==  9
   aproximacionConway 1 0.001   ==  24
   aproximacionConway 1 0.0001  ==  43
   aproximacionConway 2 0.0001  ==  47

aproximacionConway 1 0.3 == 3

aproximacionConway 1 0.1 == 5

aproximacionConway 1 0.01 == 9

aproximacionConway 1 0.001 == 24

aproximacionConway 1 0.0001 == 43

aproximacionConway 2 0.0001 == 47

Nota: Este ejercicio ha sido propuesto por Elías Guisado.

Soluciones

import Data.List (genericLength, group)

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

sucMiraYdi :: Integer -> [Integer]
sucMiraYdi = iterate di

-- (di x) es el número correspondiente a la lectura de x. Por ejemplo.
--    di 1       ==  11
--    di 11      ==  21
--    di 21      ==  1211
--    di 1211    ==  111221
--    di 111221  ==  312211
--    di 312211  ==  13112221
di :: Integer -> Integer
di = read . concatMap aux . group . show
  where aux s = show (length s) ++ [head s]

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

sucMiraYdi2 :: Integer -> [Integer]
sucMiraYdi2 = iterate (read . concatMap aux . group . show)
  where aux s = show (length s) ++ [head s]

-- Constante de Conway
-- ===================

aproximacionConway :: Integer -> Double -> Int
aproximacionConway n e =
  length (takeWhile aux (razonesMiraYdi n))
  where aux x = abs (x - constanteConway) > e 

constanteConway :: Double
constanteConway = 1.303577269

-- (razonesMiraYdi n) es la sucesión de las razones entre de cada
-- elemento de la sucesión "Mira y di" con elemento inicial n y su
-- anterior. Por ejemplo,
--    λ> take 10 (razonesMiraYdi 1)
--    [2.0,1.0,2.0,1.5,1.0,1.3333333333333333,1.25,1.4,1.4285714285714286,1.3]
--    λ> take 7 (razonesMiraYdi 10)
--    [2.0,1.0,1.5,1.6666666666666667,1.2,1.1666666666666667,1.5714285714285714]
razonesMiraYdi :: Integer -> [Double]
razonesMiraYdi n =
  zipWith (/) (tail xs) xs
  where xs = map (genericLength . show) (sucMiraYdi n)

import Data.List (genericLength, group)

-- 1ª solución

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

sucMiraYdi :: Integer -> [Integer]

sucMiraYdi = iterate di

-- (di x) es el número correspondiente a la lectura de x. Por ejemplo.

-- di 1 == 11

-- di 11 == 21

-- di 21 == 1211

-- di 1211 == 111221

-- di 111221 == 312211

-- di 312211 == 13112221

di :: Integer -> Integer

di = read . concatMap aux . group . show

where aux s = show (length s) ++ [head s]

-- 2ª solución

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

sucMiraYdi2 :: Integer -> [Integer]

sucMiraYdi2 = iterate (read . concatMap aux . group . show)

where aux s = show (length s) ++ [head s]

-- Constante de Conway

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

aproximacionConway :: Integer -> Double -> Int

aproximacionConway n e =

length (takeWhile aux (razonesMiraYdi n))

where aux x = abs (x - constanteConway) > e

constanteConway :: Double

constanteConway = 1.303577269

-- (razonesMiraYdi n) es la sucesión de las razones entre de cada

-- elemento de la sucesión "Mira y di" con elemento inicial n y su

-- anterior. Por ejemplo,

-- λ> take 10 (razonesMiraYdi 1)

-- [2.0,1.0,2.0,1.5,1.0,1.3333333333333333,1.25,1.4,1.4285714285714286,1.3]

-- λ> take 7 (razonesMiraYdi 10)

-- [2.0,1.0,1.5,1.6666666666666667,1.2,1.1666666666666667,1.5714285714285714]

razonesMiraYdi :: Integer -> [Double]

razonesMiraYdi n =

zipWith (/) (tail xs) xs

where xs = map (genericLength . show) (sucMiraYdi n)

Nodos con k sucesores

PorJosé A. Alonso 10-enero-201717-enero-2017

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

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

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

Por ejemplo, los árboles

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

1 1 1

/ \ / \ / \

8 3 8 3 8 3

| /|\ /|\ |

4 4 5 6 4 5 6 7

se representan por

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

ej1, ej2, ej3 :: Arbol Int

ej1 = N 1 [N 8 [],N 3 [N 4 []]]

ej2 = N 1 [N 8 [], N 3 [N 4 [], N 5 [], N 6 []]]

ej3 = N 1 [N 8 [N 4 [], N 5 [], N 6 []], N 3 [N 7 []]]

Definir la función

   nodos :: Int -> Arbol a -> [a]

1	nodos :: Int -> Arbol a -> [a]

tal que (nodos k x) es la lista de los nodos del árbol x que tienen k sucesores. Por ejemplo,

   nodos 0 ej1  ==  [8,4]
   nodos 1 ej1  ==  [3]
   nodos 2 ej1  ==  [1]
   nodos 3 ej1  ==  []
   nodos 3 ej2  ==  [3]

nodos 0 ej1 == [8,4]

nodos 1 ej1 == [3]

nodos 2 ej1 == [1]

nodos 3 ej1 == []

nodos 3 ej2 == [3]

Soluciones

data Arbol a = N a [Arbol a]
  deriving Show
           
ej1, ej2, ej3 :: Arbol Int
ej1 = N 1 [N 8 [],N 3 [N 4 []]]
ej2 = N 1 [N 8 [], N 3 [N 4 [], N 5 [], N 6 []]]
ej3 = N 1 [N 8 [N 4 [], N 5 [], N 6 []], N 3 [N 7 []]]

nodos :: Int -> Arbol a -> [a]
nodos k (N x ys)
  | k == length ys = x : concatMap (nodos k) ys
  | otherwise      = concatMap (nodos k) ys

data Arbol a = N a [Arbol a]

deriving Show

ej1, ej2, ej3 :: Arbol Int

ej1 = N 1 [N 8 [],N 3 [N 4 []]]

ej2 = N 1 [N 8 [], N 3 [N 4 [], N 5 [], N 6 []]]

ej3 = N 1 [N 8 [N 4 [], N 5 [], N 6 []], N 3 [N 7 []]]

nodos :: Int -> Arbol a -> [a]

nodos k (N x ys)

| k == length ys = x : concatMap (nodos k) ys

| otherwise = concatMap (nodos k) ys

Estratificación de un árbol

PorJosé A. Alonso 3-enero-201710-enero-2017

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

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

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

Por ejemplo, los árboles

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

1 1 1

/ \ / \ / \

8 3 8 3 8 3

| /|\ /|\ |

4 4 5 6 4 5 6 7

se representan por

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

ej1, ej2, ej3 :: Arbol Int

ej1 = N 1 [N 8 [],N 3 [N 4 []]]

ej2 = N 1 [N 8 [], N 3 [N 4 [], N 5 [], N 6 []]]

ej3 = N 1 [N 8 [N 4 [], N 5 [], N 6 []], N 3 [N 7 []]]

Un estrato de un árbol es la lista de nodos que se encuentran al mismo nivel de profundidad. Por ejemplo, los estratos del árbol ej1 son [1], [8,3] y [4].

Definir la función

   estratos :: Arbol a -> [[a]]

1	estratos :: Arbol a -> [[a]]

tal que (estratos x) es la lista de los estratos del árbol x. Por ejemplo,

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

estratos ej1 == [[1],[8,3],[4]]

estratos ej2 == [[1],[8,3],[4,5,6]]

estratos ej3 == [[1],[8,3],[4,5,6,7]]

Soluciones

data Arbol a = N a [Arbol a]
  deriving Show
           
ej1, ej2, ej3 :: Arbol Int
ej1 = N 1 [N 8 [],N 3 [N 4 []]]
ej2 = N 1 [N 8 [], N 3 [N 4 [], N 5 [], N 6 []]]
ej3 = N 1 [N 8 [N 4 [], N 5 [], N 6 []], N 3 [N 7 []]]

estratos :: Arbol a -> [[a]]
estratos x = takeWhile (not . null) [estrato n x | n <- [0..]]

-- (estrato n x) es el estrato de nivel n del árbol x. Por ejemplo,
--    estrato 0 ej1  ==  [1]
--    estrato 1 ej1  ==  [8,3]
--    estrato 2 ej1  ==  [4]
--    estrato 4 ej1  ==  []
estrato :: Int -> Arbol a ->  [a]
estrato 0 (N x _)  = [x]
estrato n (N _ xs) = concatMap (estrato (n-1)) xs

data Arbol a = N a [Arbol a]

deriving Show

ej1, ej2, ej3 :: Arbol Int

ej1 = N 1 [N 8 [],N 3 [N 4 []]]

ej2 = N 1 [N 8 [], N 3 [N 4 [], N 5 [], N 6 []]]

ej3 = N 1 [N 8 [N 4 [], N 5 [], N 6 []], N 3 [N 7 []]]

estratos :: Arbol a -> [[a]]

estratos x = takeWhile (not . null) [estrato n x | n <- [0..]]

-- (estrato n x) es el estrato de nivel n del árbol x. Por ejemplo,

-- estrato 0 ej1 == [1]

-- estrato 1 ej1 == [8,3]

-- estrato 2 ej1 == [4]

-- estrato 4 ej1 == []

estrato :: Int -> Arbol a -> [a]

estrato 0 (N x _) = [x]

estrato n (N _ xs) = concatMap (estrato (n-1)) xs

Segmentos comunes maximales

PorJosé A. Alonso 30-diciembre-20167-enero-2017

Los segmentos de «abcd» son

   ["","a","ab","abc","abcd","b","bc","bcd","c","cd","d"]

1	["","a","ab","abc","abcd","b","bc","bcd","c","cd","d"]

Los segmentos comunes de «abcd» y «axbce» son

   ["","a","b","bc","c"]

1	["","a","b","bc","c"]

Los segmentos comunes maximales (es decir, no contenidos en otros segmentos) de «abcd» y «axbce» son

   ["a","bc"]

1	["a","bc"]

Definir la función

   segmentosComunesMaximales :: Eq a => [a] -> [a] -> [[a]]

1	segmentosComunesMaximales :: Eq a => [a] -> [a] -> [[a]]

tal que (segmentosComunesMaximales xs ys) es la lista de los segmentos comunes maximales de xs e ys. Por ejemplo,

   segmentosComunesMaximales "abcd" "axbce"  ==  ["a","bc"]
   segmentosComunesMaximales [8,8] [8]       ==  [[8]]

1 2	segmentosComunesMaximales "abcd" "axbce" == ["a","bc"] segmentosComunesMaximales [8,8] [8] == [[8]]

Soluciones

import Data.List (inits, tails, isInfixOf)

segmentosComunesMaximales :: Eq a => [a] -> [a] -> [[a]]
segmentosComunesMaximales xs ys =
  nub [zs | zs <- zss
          , null [us | us <- zss, zs `isInfixOf` us, us /= zs]]
  where zss = segmentosComunes xs ys

segmentosComunes :: Eq a => [a] -> [a] -> [[a]]
segmentosComunes xs ys =
  [zs | zs <- segmentos xs
      , zs `isInfixOf` ys]

-- (segmentos xs) es la lista de los segmentos de xs. Por ejemplo,
--    segmentos "abc"  ==  ["","a","ab","abc","b","bc","c"]
segmentos :: [a] -> [[a]]
segmentos xs =
  [] : concatMap (tail . inits) (init (tails xs))

import Data.List (inits, tails, isInfixOf)

segmentosComunesMaximales :: Eq a => [a] -> [a] -> [[a]]

segmentosComunesMaximales xs ys =

nub [zs | zs <- zss

, null [us | us <- zss, zs `isInfixOf` us, us /= zs]]

where zss = segmentosComunes xs ys

segmentosComunes :: Eq a => [a] -> [a] -> [[a]]

segmentosComunes xs ys =

[zs | zs <- segmentos xs

, zs `isInfixOf` ys]

-- (segmentos xs) es la lista de los segmentos de xs. Por ejemplo,

-- segmentos "abc" == ["","a","ab","abc","b","bc","c"]

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

segmentos xs =

[] : concatMap (tail . inits) (init (tails xs))

Distancia a Erdős

PorJosé A. Alonso 14-diciembre-201621-diciembre-2016

Una de las razones por la que el matemático húngaro Paul Erdős es conocido es por la multitud de colaboraciones que realizó durante toda su carrera, un total de 511. Tal es así que se establece la distancia a Erdős como la distancia que has estado de coautoría con Erdős. Por ejemplo, si eres Paul Erdős tu distancia a Erdős es 0, si has escrito un artículo con Erdős tu distancia es 1, si has escrito un artículo con alguien que ha escrito un artículo con Erdős tu distancia es 2, etc. El objetivo de este problema es definir una función que a partir de una lista de pares de coautores y un número natural n calcular la lista de los matemáticos a una distancia n de Erdős.

Para el problema se considerará la siguiente lista de coautores

   coautores :: [(String,String)]
   coautores =
     [("Paul Erdos","Ernst Straus"),("Paul Erdos","Pascual Jordan"),
      ("Paul Erdos","D. Kleitman"),("Albert Einstein","Ernst Straus"),
      ("John von Newmann","David Hilbert"),("S. Glashow","D. Kleitman"),
      ("John von Newmann","Pascual Jordan"), ("David Pines","D. Bohm"),
      ("Albert Einstein","Otto Stern"),("S. Glashow", "M. Gell-Mann"),
      ("Richar Feynman","M. Gell-Mann"),("M. Gell-Mann","David Pines"),
      ("David Pines","A. Bohr"),("Wolfgang Pauli","Albert Einstein"),
      ("D. Bohm","L. De Broglie"), ("Paul Erdos","J. Conway"),
      ("J. Conway", "P. Doyle"),("Paul Erdos","A. J. Granville"),
      ("A. J. Granville","B. Mazur"),("B. Mazur","Andrew Wiles")]

coautores :: [(String,String)]

coautores =

[("Paul Erdos","Ernst Straus"),("Paul Erdos","Pascual Jordan"),

("Paul Erdos","D. Kleitman"),("Albert Einstein","Ernst Straus"),

("John von Newmann","David Hilbert"),("S. Glashow","D. Kleitman"),

("John von Newmann","Pascual Jordan"), ("David Pines","D. Bohm"),

("Albert Einstein","Otto Stern"),("S. Glashow", "M. Gell-Mann"),

("Richar Feynman","M. Gell-Mann"),("M. Gell-Mann","David Pines"),

("David Pines","A. Bohr"),("Wolfgang Pauli","Albert Einstein"),

("D. Bohm","L. De Broglie"), ("Paul Erdos","J. Conway"),

("J. Conway", "P. Doyle"),("Paul Erdos","A. J. Granville"),

("A. J. Granville","B. Mazur"),("B. Mazur","Andrew Wiles")]

La lista anterior es real y se ha obtenido del artículo Famous trails to Paul Erdős.

Definir la función

   numeroDeErdos :: [(String, String)] -> Int -> [String]

1	numeroDeErdos :: [(String, String)] -> Int -> [String]

tal que (numeroDeErdos xs n) es la lista de lista de los matemáticos de la
lista de coautores xs que se encuentran a una distancia n de Erdős. Por ejemplo,

   λ> numeroDeErdos coautores 0
   ["Paul Erdos"]
   λ> numeroDeErdos coautores 1
   ["Ernst Straus","Pascual Jordan","D. Kleitman","J. Conway","A. J. Granville"]
   λ> numeroDeErdos coautores 2
   ["Albert Einstein","John von Newmann","S. Glashow","P. Doyle","B. Mazur"]

λ> numeroDeErdos coautores 0

["Paul Erdos"]

λ> numeroDeErdos coautores 1

["Ernst Straus","Pascual Jordan","D. Kleitman","J. Conway","A. J. Granville"]

λ> numeroDeErdos coautores 2

["Albert Einstein","John von Newmann","S. Glashow","P. Doyle","B. Mazur"]

Nota: Este ejercicio ha sido propuesto por Enrique Naranjo.

Soluciones

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

coautores :: [(String,String)]
coautores =
  [("Paul Erdos","Ernst Straus"),("Paul Erdos","Pascual Jordan"),
   ("Paul Erdos","D. Kleitman"),("Albert Einstein","Ernst Straus"),
   ("John von Newmann","David Hilbert"),("S. Glashow","D. Kleitman"),
   ("John von Newmann","Pascual Jordan"), ("David Pines","D. Bohm"),
   ("Albert Einstein","Otto Stern"),("S. Glashow", "M. Gell-Mann"),
   ("Richar Feynman","M. Gell-Mann"),("M. Gell-Mann","David Pines"),
   ("David Pines","A. Bohr"),("Wolfgang Pauli","Albert Einstein"),
   ("D. Bohm","L. De Broglie"), ("Paul Erdos","J. Conway"),
   ("J. Conway", "P. Doyle"),("Paul Erdos","A. J. Granville"),
   ("A. J. Granville","B. Mazur"),("B. Mazur","Andrew Wiles")]

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

numeroDeErdos :: [(String, String)] -> Int -> [String]
numeroDeErdos xs n = nivel n (arbolDeErdos xs "Paul Erdos")

-- (arbolDeErdos xs a) es el árbol de coautores de a según la lista de
-- coautores xs. Por ejemplo,
--    λ> arbolDeErdos coautores "Paul Erdos"
--    N "Paul Erdos"
--      [N "Ernst Straus"
--         [N "Albert Einstein"
--           [N "Wolfgang Pauli" [],
--            N "Otto Stern" []]],
--          N "Pascual Jordan"
--            [N "John von Newmann"
--               [N "David Hilbert" []]],
--          N "D. Kleitman"
--            [N "S. Glashow"
--               [N "M. Gell-Mann"
--                  [N "Richar Feynman" [],
--                   N "David Pines"
--                     [N "A. Bohr" [],
--                      N "D. Bohm"
--                        [N "L. De Broglie" []]]]]],
--          N "J. Conway"
--            [N "P. Doyle" []],
--             N "A. J. Granville"
--               [N "B. Mazur"
--                  [N "Andrew Wiles" []]]]
arbolDeErdos :: [(String, String)] -> String -> Arbol String
arbolDeErdos xs a =
  N a [arbolDeErdos noColaboradores n | n <- colaboradores]
  where
    colaboradores   = [filtra a (x,y) | (x,y) <- xs, x == a || y == a]
    filtra a (x,y) | a == x    = y
                   | otherwise = x
    noColaboradores = [(x,y) | (x,y) <- xs, x /= a, y /= a]

-- (nivel n a) es la lista de los elementos del árbol a en el nivel
-- n. Por ejemplo,      
--    nivel 0 (N 3 [N 5 [N 6 []], N 7 [N 9 []]])   ==  [3]
--    nivel 1 (N 3 [N 5 [N 6 []], N 7 [N 9 []]])   ==  [5,7]
--    nivel 2 (N 3 [N 5 [N 6 []], N 7 [N 9 []]])   ==  [6,9]
nivel :: Int -> Arbol a -> [a]
nivel 0 (N a xs) = [a]
nivel n (N a xs) = concatMap (nivel (n-1)) xs

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

numeroDeErdos2 :: [(String, String)] -> Int -> [String]
numeroDeErdos2 = auxC ["Paul Erdos"] 
  where
    auxC v xs 0 = v
    auxC v xs x = auxC  (n v) (m v xs) (x-1)
      where n v =     [a | (a,b) <- xs, elem b v] ++
                      [b | (a,b) <- xs, elem a v]
            m ys xs = [(a,b) | (a,b) <- xs
                             , notElem a ys && notElem b ys]

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

numeroDeErdos3 :: [(String, String)] -> Int -> [String]
numeroDeErdos3 ps n = (sucCoautores "Paul Erdos" ps) !! n

-- (sucCoautores a ps) es la sucesión de coautores de a en ps ordenados
-- por diatancia. Por ejemplo, 
--    λ> take 3 (sucCoautores "Paul Erdos" coautores)
--    [["Paul Erdos"],
--     ["Ernst Straus","Pascual Jordan","D. Kleitman","J. Conway",
--      "A. J. Granville"],
--     ["Albert Einstein","John von Newmann","S. Glashow","P. Doyle",
--      "B. Mazur"]]
--    λ> sucCoautores "Albert Einstein" coautores
--    [["Albert Einstein"],
--     ["Ernst Straus","Otto Stern","Wolfgang Pauli"],
--     ["Paul Erdos"],
--     ["Pascual Jordan","D. Kleitman","J. Conway", "A. J. Granville"],
--     ["John von Newmann","S. Glashow","P. Doyle","B. Mazur"],
--     ["David Hilbert","M. Gell-Mann","Andrew Wiles"],
--     ["David Pines","Richar Feynman"],
--     ["D. Bohm","A. Bohr"],
--     ["L. De Broglie"]]
sucCoautores :: String -> [(String, String)] -> [[String]]
sucCoautores a ps =
  takeWhile (not . null) (map fst (iterate sig ([a], as \\ [a])))
  where as = elementos ps
        sig (xs,ys) = (zs,ys \\ zs)
          where zs = [y | y <- ys
                        , or [elem (x,y) ps || elem (y,x) ps | x <- xs]]

-- (elementos ps) es la lista de los elementos de los pares ps. Por
-- ejemplo,
--    elementos [(1,3),(3,2),(1,5)]  ==  [1,3,2,5]
elementos :: Eq a => [(a, a)] -> [a]
elementos = nub . (concatMap (\(x,y) -> [x,y]))

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

data Arbol a = N a [Arbol a]

deriving Show

coautores :: [(String,String)]

coautores =

[("Paul Erdos","Ernst Straus"),("Paul Erdos","Pascual Jordan"),

("Paul Erdos","D. Kleitman"),("Albert Einstein","Ernst Straus"),

("John von Newmann","David Hilbert"),("S. Glashow","D. Kleitman"),

("John von Newmann","Pascual Jordan"), ("David Pines","D. Bohm"),

("Albert Einstein","Otto Stern"),("S. Glashow", "M. Gell-Mann"),

("Richar Feynman","M. Gell-Mann"),("M. Gell-Mann","David Pines"),

("David Pines","A. Bohr"),("Wolfgang Pauli","Albert Einstein"),

("D. Bohm","L. De Broglie"), ("Paul Erdos","J. Conway"),

("J. Conway", "P. Doyle"),("Paul Erdos","A. J. Granville"),

("A. J. Granville","B. Mazur"),("B. Mazur","Andrew Wiles")]

-- 1ª solución

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

numeroDeErdos :: [(String, String)] -> Int -> [String]

numeroDeErdos xs n = nivel n (arbolDeErdos xs "Paul Erdos")

-- (arbolDeErdos xs a) es el árbol de coautores de a según la lista de

-- coautores xs. Por ejemplo,

-- λ> arbolDeErdos coautores "Paul Erdos"

-- N "Paul Erdos"

-- [N "Ernst Straus"

-- [N "Albert Einstein"

-- [N "Wolfgang Pauli" [],

-- N "Otto Stern" []]],

-- N "Pascual Jordan"

-- [N "John von Newmann"

-- [N "David Hilbert" []]],

-- N "D. Kleitman"

-- [N "S. Glashow"

-- [N "M. Gell-Mann"

-- [N "Richar Feynman" [],

-- N "David Pines"

-- [N "A. Bohr" [],

-- N "D. Bohm"

-- [N "L. De Broglie" []]]]]],

-- N "J. Conway"

-- [N "P. Doyle" []],

-- N "A. J. Granville"

-- [N "B. Mazur"

-- [N "Andrew Wiles" []]]]

arbolDeErdos :: [(String, String)] -> String -> Arbol String

arbolDeErdos xs a =

N a [arbolDeErdos noColaboradores n | n <- colaboradores]

where

colaboradores = [filtra a (x,y) | (x,y) <- xs, x == a || y == a]

filtra a (x,y) | a == x = y

| otherwise = x

noColaboradores = [(x,y) | (x,y) <- xs, x /= a, y /= a]

-- (nivel n a) es la lista de los elementos del árbol a en el nivel

-- n. Por ejemplo,

-- nivel 0 (N 3 [N 5 [N 6 []], N 7 [N 9 []]]) == [3]

-- nivel 1 (N 3 [N 5 [N 6 []], N 7 [N 9 []]]) == [5,7]

-- nivel 2 (N 3 [N 5 [N 6 []], N 7 [N 9 []]]) == [6,9]

nivel :: Int -> Arbol a -> [a]

nivel 0 (N a xs) = [a]

nivel n (N a xs) = concatMap (nivel (n-1)) xs

-- 2ª solución

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

numeroDeErdos2 :: [(String, String)] -> Int -> [String]

numeroDeErdos2 = auxC ["Paul Erdos"]

where

auxC v xs 0 = v

auxC v xs x = auxC (n v) (m v xs) (x-1)

where n v = [a | (a,b) <- xs, elem b v] ++

[b | (a,b) <- xs, elem a v]

m ys xs = [(a,b) | (a,b) <- xs

, notElem a ys && notElem b ys]

-- 3ª solución

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

numeroDeErdos3 :: [(String, String)] -> Int -> [String]

numeroDeErdos3 ps n = (sucCoautores "Paul Erdos" ps) !! n

-- (sucCoautores a ps) es la sucesión de coautores de a en ps ordenados

-- por diatancia. Por ejemplo,

-- λ> take 3 (sucCoautores "Paul Erdos" coautores)

-- [["Paul Erdos"],

-- ["Ernst Straus","Pascual Jordan","D. Kleitman","J. Conway",

-- "A. J. Granville"],

-- ["Albert Einstein","John von Newmann","S. Glashow","P. Doyle",

-- "B. Mazur"]]

-- λ> sucCoautores "Albert Einstein" coautores

-- [["Albert Einstein"],

-- ["Ernst Straus","Otto Stern","Wolfgang Pauli"],

-- ["Paul Erdos"],

-- ["Pascual Jordan","D. Kleitman","J. Conway", "A. J. Granville"],

-- ["John von Newmann","S. Glashow","P. Doyle","B. Mazur"],

-- ["David Hilbert","M. Gell-Mann","Andrew Wiles"],

-- ["David Pines","Richar Feynman"],

-- ["D. Bohm","A. Bohr"],

-- ["L. De Broglie"]]

sucCoautores :: String -> [(String, String)] -> [[String]]

sucCoautores a ps =

takeWhile (not . null) (map fst (iterate sig ([a], as \\ [a])))

where as = elementos ps

sig (xs,ys) = (zs,ys \\ zs)

where zs = [y | y <- ys

, or [elem (x,y) ps || elem (y,x) ps | x <- xs]]

-- (elementos ps) es la lista de los elementos de los pares ps. Por

-- ejemplo,

-- elementos [(1,3),(3,2),(1,5)] == [1,3,2,5]

elementos :: Eq a => [(a, a)] -> [a]

elementos = nub . (concatMap (\(x,y) -> [x,y]))

Representación binaria de los números de Carol

PorJosé A. Alonso 28-noviembre-20165-diciembre-2016

Un número de Carol es un número entero de la forma $4^n-2^{n+1}-1$ o, equivalentemente, $(2^n-1)^2-2$ . Los primeros números de Carol son -1, 7, 47, 223, 959, 3967, 16127, 65023, 261119, 1046527.

Definir las funciones

   carol        :: Integer -> Integer
   carolBinario :: Integer -> Integer

1 2	carol :: Integer -> Integer carolBinario :: Integer -> Integer

tales que

(carol n) es el n-ésimo número de Carol. Por ejemplo,

     carol  3  ==  47
     carol  4  ==  223
     carol 25  ==  1125899839733759

carol 3 == 47

carol 4 == 223

carol 25 == 1125899839733759

(carolBinario n) es la representación binaria del n-ésimo número de Carol. Por ejemplo,

     carolBinario 3  ==  101111
     carolBinario 4  ==  11011111
     carolBinario 5  ==  1110111111

carolBinario 3 == 101111

carolBinario 4 == 11011111

carolBinario 5 == 1110111111

Comprobar con QuickCheck que, para n > 2, la representación binaria del n-ésimo número de Carol es el número formado por n-2 veces el dígito 1, seguido por un 0 y a continuación n+1 veces el dígito 1.

Soluciones

import Test.QuickCheck

carol :: Integer -> Integer
carol n = x^2 - 2
  where x = 2^n - 1

carolBinario :: Integer -> Integer
carolBinario = binario . carol

-- (binario x) es el número binario correspondiente al número decimal
-- x. Por ejemplo, 
--    binario 223  ==  11011111
binario :: Integer -> Integer 
binario = digitosAnumero . reverse . int2bin

-- (int2bin x) es el número binario (representado como la lista
-- invertida de sus dígitos) correspondiente al número decimal
-- x. Por ejemplo, 
--    int2bin 223  ==  [1,1,1,1,1,0,1,1]
int2bin :: Integer -> [Integer]
int2bin n | n < 2     = [n]
          | otherwise = n `mod` 2 : int2bin (n `div` 2)

-- (digitosAnumero xs) es el número cuya lista de dígitos es xs. Por
-- ejemplo,  
--    digitosAnumero [3,2,5]  ==  325
digitosAnumero :: [Integer] -> Integer
digitosAnumero xs =
  read (concatMap show xs)

-- En la definición anterior se pueden eliminar el argumento
digitosAnumero2 :: [Integer] -> Integer
digitosAnumero2 = read . (concatMap show)

-- La propiedad es
prop_carol :: Integer -> Property
prop_carol n =
  n > 2 ==> carolBinario n == carolBinario2 n
  where
    carolBinario2 n =
      digitosAnumero ((replicate (m-2) 1) ++ [0] ++ (replicate (m+1) 1))
      where m = fromIntegral n

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

import Test.QuickCheck

carol :: Integer -> Integer

carol n = x^2 - 2

where x = 2^n - 1

carolBinario :: Integer -> Integer

carolBinario = binario . carol

-- (binario x) es el número binario correspondiente al número decimal

-- x. Por ejemplo,

-- binario 223 == 11011111

binario :: Integer -> Integer

binario = digitosAnumero . reverse . int2bin

-- (int2bin x) es el número binario (representado como la lista

-- invertida de sus dígitos) correspondiente al número decimal

-- x. Por ejemplo,

-- int2bin 223 == [1,1,1,1,1,0,1,1]

int2bin :: Integer -> [Integer]

int2bin n | n < 2 = [n]

| otherwise = n `mod` 2 : int2bin (n `div` 2)

-- (digitosAnumero xs) es el número cuya lista de dígitos es xs. Por

-- ejemplo,

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

digitosAnumero :: [Integer] -> Integer

digitosAnumero xs =

read (concatMap show xs)

-- En la definición anterior se pueden eliminar el argumento

digitosAnumero2 :: [Integer] -> Integer

digitosAnumero2 = read . (concatMap show)

-- La propiedad es

prop_carol :: Integer -> Property

prop_carol n =

n > 2 ==> carolBinario n == carolBinario2 n

where

carolBinario2 n =

digitosAnumero ((replicate (m-2) 1) ++ [0] ++ (replicate (m+1) 1))

where m = fromIntegral n

-- La comprobación es

-- λ> quickCheck prop_carol

-- +++ OK, passed 100 tests.

Referencias

Carol number por Shashank Mishra en GeeksforGeeks.
Carol number en la Wikipedia.

Cadenas de divisores

PorJosé A. Alonso 6-mayo-201625-abril-2021

Una cadena de divisores de un número n es una lista donde cada elemento es un divisor de su siguiente elemento en la lista. Por ejemplo, las cadenas de divisores de 12 son [2,4,12], [2,6,12], [2,12], [3,6,12], [3,12], [4,12], [6,12] y [12].

Definir la función

   cadenasDivisores :: Int -> [[Int]]

1	cadenasDivisores :: Int -> [[Int]]

tal que (cadenasDivisores n) es la lista de las cadenas de divisores de n. Por ejemplo,

   λ> cadenasDivisores 12
   [[2,4,12],[2,6,12],[2,12],[3,6,12],[3,12],[4,12],[6,12],[12]]
   λ> length (cadenaDivisores 48)
   48
   λ> length (cadenaDivisores 120)
   132

λ> cadenasDivisores 12

[[2,4,12],[2,6,12],[2,12],[3,6,12],[3,12],[4,12],[6,12],[12]]

λ> length (cadenaDivisores 48)

λ> length (cadenaDivisores 120)

132

Soluciones

import Data.List (sort)
import Data.Numbers.Primes (isPrime)

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

cadenasDivisores :: Int -> [[Int]]
cadenasDivisores n = sort (extiendeLista [[n]])
    where extiendeLista []           = []
          extiendeLista ((1:xs):yss) = xs : extiendeLista yss
          extiendeLista ((x:xs):yss) =
              extiendeLista ([y:x:xs | y <- divisores x] ++ yss)

-- (divisores x) es la lista decreciente de los divisores de x distintos
-- de x. Por ejemplo,
--    divisores 12  ==  [6,4,3,2,1]
divisores :: Int -> [Int]
divisores x = 
    [y | y <- [a,a-1..1], x `mod` y == 0]
    where a = x `div` 2

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

cadenasDivisores2 :: Int -> [[Int]]
cadenasDivisores2 = sort . aux
    where aux 1 = [[]]
          aux n = [xs ++ [n] | xs <- concatMap aux (divisores n)]

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

cadenasDivisores3 :: Int -> [[Int]]
cadenasDivisores3 = sort . map reverse . aux
    where aux 1 = [[]]
          aux n = map (n:) (concatMap aux (divisores3 n))

-- (divisores3 x) es la lista creciente de los divisores de x distintos
-- de x. Por ejemplo,
--    divisores3 12  ==  [1,2,3,4,6]
divisores3 :: Int -> [Int]
divisores3 x = 
    [y | y <- [1..a], x `mod` y == 0]
    where a = x `div` 2

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

nCadenasDivisores1 :: Int -> Int
nCadenasDivisores1 = length . cadenasDivisores

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

nCadenasDivisores2 :: Int -> Int
nCadenasDivisores2 1 = 1
nCadenasDivisores2 n = 
    sum [nCadenasDivisores2 x | x <- divisores n]

import Data.List (sort)

import Data.Numbers.Primes (isPrime)

-- 1ª definición

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

cadenasDivisores :: Int -> [[Int]]

cadenasDivisores n = sort (extiendeLista [[n]])

where extiendeLista [] = []

extiendeLista ((1:xs):yss) = xs : extiendeLista yss

extiendeLista ((x:xs):yss) =

extiendeLista ([y:x:xs | y <- divisores x] ++ yss)

-- (divisores x) es la lista decreciente de los divisores de x distintos

-- de x. Por ejemplo,

-- divisores 12 == [6,4,3,2,1]

divisores :: Int -> [Int]

divisores x =

[y | y <- [a,a-1..1], x `mod` y == 0]

where a = x `div` 2

-- 2ª definición

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

cadenasDivisores2 :: Int -> [[Int]]

cadenasDivisores2 = sort . aux

where aux 1 = [[]]

aux n = [xs ++ [n] | xs <- concatMap aux (divisores n)]

-- 3ª definición

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

cadenasDivisores3 :: Int -> [[Int]]

cadenasDivisores3 = sort . map reverse . aux

where aux 1 = [[]]

aux n = map (n:) (concatMap aux (divisores3 n))

-- (divisores3 x) es la lista creciente de los divisores de x distintos

-- de x. Por ejemplo,

-- divisores3 12 == [1,2,3,4,6]

divisores3 :: Int -> [Int]

divisores3 x =

[y | y <- [1..a], x `mod` y == 0]

where a = x `div` 2

-- 1ª definición de nCadenasDivisores

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

nCadenasDivisores1 :: Int -> Int

nCadenasDivisores1 = length . cadenasDivisores

-- 2ª definición de nCadenasDivisores

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

nCadenasDivisores2 :: Int -> Int

nCadenasDivisores2 1 = 1

nCadenasDivisores2 n =

sum [nCadenasDivisores2 x | x <- divisores n]

Referencias

Sucesión A163272 de OEIS.
Ordered and unordered factorizations of integers por A. Knopfmacher y M. Mays

Números cuyos dígitos coinciden con los de sus factores primos

PorJosé A. Alonso 30-marzo-201625-marzo-2022

Un número n es especial si al unir los dígitos de sus factores primos, se obtienen exactamente los dígitos de n, aunque puede ser en otro orden. Por ejemplo, 1255 es especial, pues los factores primos de 1255 son 5 y 251.

Definir la función

   esEspecial :: Integer -> Bool

1	esEspecial :: Integer -> Bool

tal que (esEspecial n) se verifica si un número n es especial. Por ejemplo,

   esEspecial 1255 == True
   esEspecial 125  == False
   esEspecial 132  == False

esEspecial 1255 == True

esEspecial 125 == False

esEspecial 132 == False

Comprobar con QuickCheck que todo número primo es especial.

Calcular los 5 primeros números especiales que no son primos.

Soluciones

import Data.List (nub, sort)
import Data.Numbers.Primes (isPrime, primeFactors)
import Test.QuickCheck

esEspecial :: Integer -> Bool
esEspecial n = 
    sort (show n) == sort (concatMap show (nub (primeFactors n)))

-- La propiedad es
prop_primos:: Integer -> Property
prop_primos n = 
    isPrime (abs n) ==> esEspecial (abs n)

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

-- El cálculo es
--    ghci> take 5 [n | n <- [2..], esEspecial n, not (isPrime n)]
--    [735,1255,3792,7236,11913]

import Data.List (nub, sort)

import Data.Numbers.Primes (isPrime, primeFactors)

import Test.QuickCheck

esEspecial :: Integer -> Bool

esEspecial n =

sort (show n) == sort (concatMap show (nub (primeFactors n)))

-- La propiedad es

prop_primos:: Integer -> Property

prop_primos n =

isPrime (abs n) ==> esEspecial (abs n)

-- La comprobación es

-- ghci> quickCheck prop_primos

-- +++ OK, passed 100 tests.

-- El cálculo es

-- ghci> take 5 [n | n <- [2..], esEspecial n, not (isPrime n)]

-- [735,1255,3792,7236,11913]

Ordenación por frecuencia

PorJosé A. Alonso 2-febrero-201625-abril-2021

Definir la función

   ordPorFrecuencia :: Ord a => [a] -> [a]

1	ordPorFrecuencia :: Ord a => [a] -> [a]

tal que (ordPorFrecuencia xs) es la lista obtenidas ordenando los elementos de xs por su frecuencia, de los que aparecen menos a los que aparecen más. Por ejemplo,

   ordPorFrecuencia "canalDePanama"  ==  "DPcelmnnaaaaa"
   ordPorFrecuencia "20012016"       ==  "61122000"

1 2	ordPorFrecuencia "canalDePanama" == "DPcelmnnaaaaa" ordPorFrecuencia "20012016" == "61122000"

Soluciones

import Data.List (group, sort)

ordPorFrecuencia :: Ord a => [a] -> [a]
ordPorFrecuencia xs =
    concatMap snd (sort [(length xs,xs) | xs <- group (sort xs)])

import Data.List (group, sort)

ordPorFrecuencia :: Ord a => [a] -> [a]

ordPorFrecuencia xs =

concatMap snd (sort [(length xs,xs) | xs <- group (sort xs)])

Números cuyas cifras coinciden con las de sus factores primos

PorJosé A. Alonso 4-mayo-201525-marzo-2022

Un número n es especial si al unir las cifras de sus factores primos, se obtienen exactamente las cifras de n, aunque puede ser en otro orden. Por ejemplo, 1255 es especial, pues los factores primos de 1255 son 5 y 251.

Definir la función

   esEspecial :: Integer -> Bool

1	esEspecial :: Integer -> Bool

tal que (esEspecial n) se verifica si un número n es especial. Por ejemplo,

   esEspecial 1255 == True
   esEspecial 125  == False

1 2	esEspecial 1255 == True esEspecial 125 == False

Comprobar con QuickCheck que todo número primo es especial.

Calcular los 5 primeros números especiales que no son primos.

Soluciones

import Data.List (nub, sort)
import Data.Numbers.Primes (isPrime, primeFactors)
import Test.QuickCheck

esEspecial :: Integer -> Bool
esEspecial n = 
    sort (show n) == sort (concatMap show (nub (primeFactors n)))

-- La propiedad es
prop_primos:: Integer -> Property
prop_primos n = 
    isPrime (abs n) ==> esEspecial (abs n)

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

-- El cálculo es
--    ghci> take 5 [n | n <- [2..], esEspecial n, not (isPrime n)]
--    [735,1255,3792,7236,11913]

import Data.List (nub, sort)

import Data.Numbers.Primes (isPrime, primeFactors)

import Test.QuickCheck

esEspecial :: Integer -> Bool

esEspecial n =

sort (show n) == sort (concatMap show (nub (primeFactors n)))

-- La propiedad es

prop_primos:: Integer -> Property

prop_primos n =

isPrime (abs n) ==> esEspecial (abs n)

-- La comprobación es

-- ghci> quickCheck prop_primos

-- +++ OK, passed 100 tests.

-- El cálculo es

-- ghci> take 5 [n | n <- [2..], esEspecial n, not (isPrime n)]

-- [735,1255,3792,7236,11913]

Constante de Champernowne

PorJosé A. Alonso 15-abril-201525-marzo-2022

La constante de Champernowne es el número irracional

   0.12345678910111213141516171819202122232425262728293031323334 ...

1	0.12345678910111213141516171819202122232425262728293031323334 ...

cuya parte entera es 0 y la parte decimal se obtiene concatenado los números naturales a partir de 1.

Definir la función

   productoChampernowne :: [Int] -> Int

1	productoChampernowne :: [Int] -> Int

tal que (productoChampernowne ns) es el producto de los dígitos de la constante de Champernowne que ocupan las posiciones ns. Por ejemplo,

   productoChampernowne [0,1,2]                 ==  6
   productoChampernowne [8,20]                  ==  45
   productoChampernowne [10^i-1 | i <- [0..7]]  ==  1470

productoChampernowne [0,1,2] == 6

productoChampernowne [8,20] == 45

productoChampernowne [10^i-1 | i <- [0..7]] == 1470

Soluciones

import Data.Char (digitToInt)

productoChampernowne :: [Int] -> Int
productoChampernowne ns = product [champernowne !! n | n <- ns] 

-- champernowne  es la sucesión de champernowne. Por ejemplo,
--    ghci> take 20 champernowne
--    [1,2,3,4,5,6,7,8,9,1,0,1,1,1,2,1,3,1,4,1]
champernowne :: [Int] 
champernowne = map digitToInt (concatMap show [1..])

import Data.Char (digitToInt)

productoChampernowne :: [Int] -> Int

productoChampernowne ns = product [champernowne !! n | n <- ns]

-- champernowne es la sucesión de champernowne. Por ejemplo,

-- ghci> take 20 champernowne

-- [1,2,3,4,5,6,7,8,9,1,0,1,1,1,2,1,3,1,4,1]

champernowne :: [Int]

champernowne = map digitToInt (concatMap show [1..])

Pandigitales múltiplos de un número por una lista de números

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

Un número pandigital es un número que contiene todos los dígitos del 1 al 9 sólo una vez. Por ejemplo, 192384576 es un número pandigital.

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 6410.

Un número pandigital x es un múltiplo si existe un y y un n > 1 tales que x es el producto de y por [1,2,3,…,n]. Por ejemplo, 192384576 es un pandigital múltiplo ya que

   192 × 1 = 192
   192 × 2 = 384
   192 × 3 = 576

192 × 1 = 192

192 × 2 = 384

192 × 3 = 576

por tanto, 192384576 es el producto de 192 por [1,2,3]. Otro pandgital múltiplo es el 918273645 ya que es el producto de 9 por [1,2,3,4,5].

Definir la sucesión

   pandigitalesMultiplos :: [Integer]

1	pandigitalesMultiplos :: [Integer]

tal que sus elementos son los números pandigitales múltiplos. Por ejemplo,

   ghci> take 5 pandigitalesMultiplos
   [123456789,192384576,219438657,273546819,327654981]

1 2	ghci> take 5 pandigitalesMultiplos [123456789,192384576,219438657,273546819,327654981]

Soluciones

import Data.List (sort)

pandigitalesMultiplos :: [Integer]
pandigitalesMultiplos =
    sort [y | x <- [1..a],
              y <- productosCon9Digitos x,
              esPandigital y]
    where a = head [x | x <- [1..], producto x [1,2] > 987654321]

-- (productosCon9Digitos x) es la lista de los productos de x por una
-- lista [1,2,...,n] (con n > 1) que tienen 9 dígitos, Por ejemplo, 
--    productosCon9Digitos 3  ==  [369121518]
--    productosCon9Digitos 2  ==  []
productosCon9Digitos :: Integer -> [Integer]
productosCon9Digitos x | numeroDeDigitos z == 9 = [z]
                       | otherwise              = []
    where z = head [y | n <- [2..], 
                        let y = producto x [1..n], 
                        numeroDeDigitos y >= 9]

-- (producto x ys) es el producto de x por ys. Por ejemplo,
--    producto 2 [3,2,5]  ==  6410
producto :: Integer -> [Integer] -> Integer
producto x = read . concatMap (show . (x*))

-- (numeroDeDigitos x) es el número de dígitos de x. Por ejemplo,
--    numeroDeDigitos 425  ==  3
numeroDeDigitos :: Integer -> Int
numeroDeDigitos = length . show

-- (esPandigital x) se verifica si x es pandigital. Por ejemplo,
--    esPandigital 192384576   ==  True
--    esPandigital 192314576   ==  False
--    esPandigital 1923145761  ==  False
esPandigital :: Integer -> Bool
esPandigital n = sort (show n) == "123456789"

-- La lista de los pandigitales múltiplos se calcula por
--    ghci> pandigitalesMultiplos
--    [123456789, 192384576, 219438657, 273546819, 327654981, 672913458,
--     679213584, 692713854, 726914538, 729314586, 732914658, 769215384,
--     792315846, 793215864, 918273645, 926718534, 927318546, 932718654]

import Data.List (sort)

pandigitalesMultiplos :: [Integer]

pandigitalesMultiplos =

sort [y | x <- [1..a],

y <- productosCon9Digitos x,

esPandigital y]

where a = head [x | x <- [1..], producto x [1,2] > 987654321]

-- (productosCon9Digitos x) es la lista de los productos de x por una

-- lista [1,2,...,n] (con n > 1) que tienen 9 dígitos, Por ejemplo,

-- productosCon9Digitos 3 == [369121518]

-- productosCon9Digitos 2 == []

productosCon9Digitos :: Integer -> [Integer]

productosCon9Digitos x | numeroDeDigitos z == 9 = [z]

| otherwise = []

where z = head [y | n <- [2..],

let y = producto x [1..n],

numeroDeDigitos y >= 9]

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

-- producto 2 [3,2,5] == 6410

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

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

-- (numeroDeDigitos x) es el número de dígitos de x. Por ejemplo,

-- numeroDeDigitos 425 == 3

numeroDeDigitos :: Integer -> Int

numeroDeDigitos = length . show

-- (esPandigital x) se verifica si x es pandigital. Por ejemplo,

-- esPandigital 192384576 == True

-- esPandigital 192314576 == False

-- esPandigital 1923145761 == False

esPandigital :: Integer -> Bool

esPandigital n = sort (show n) == "123456789"

-- La lista de los pandigitales múltiplos se calcula por

-- ghci> pandigitalesMultiplos

-- [123456789, 192384576, 219438657, 273546819, 327654981, 672913458,

-- 679213584, 692713854, 726914538, 729314586, 732914658, 769215384,

-- 792315846, 793215864, 918273645, 926718534, 927318546, 932718654]

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

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

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*))

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)

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 | | |

...

Máxima suma de los segmentos

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

Un segmento de una lista xs es una sublista de xs formada por elementos consecutivos en la lista. El problema de la máxima suma de segmentos consiste en dada una lista de números enteros calcular el máximo de las sumas de todos los segmentos de la lista. Por ejemplo, para la lista [-1,2,-3,5,-2,1,3,-2,-2,-3,6] la máxima suma de segmentos es 7 que es la suma del segmento [5,-2,1,3] y para la lista [-1,-2,-3] es 0 que es la suma de la lista vacía.

Definir la función

   mss :: [Integer] -> Integer

1	mss :: [Integer] -> Integer

tal que (mss xs) es la máxima suma de los segmentos de xs. Por ejemplo,

   mss [-1,2,-3,5,-2,1,3,-2,-2,-3,6]  ==  7
   mss [-1,-2,-3]                     ==  0
   mss [1..500]                       ==  125250
   mss [1..1000]                      ==  500500
   mss [-500..3]                      ==  6
   mss [-1000..3]                     ==  6

mss [-1,2,-3,5,-2,1,3,-2,-2,-3,6] == 7

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

mss [1..500] == 125250

mss [1..1000] == 500500

mss [-500..3] == 6

mss [-1000..3] == 6

Soluciones

import Data.List (inits,tails)

-- 1ª solución
mss :: [Integer] -> Integer
mss = maximum . map sum . segmentos

-- (segmentos xs) es la lista de los segmentos de xs. Por ejemplo,
--    ghci> segmentos "abc"
--    ["","a","ab","abc","","b","bc","","c",""]
segmentos :: [a] -> [[a]]
segmentos = concat . map inits . tails

-- 2ª definición:
mss2 :: [Integer] -> Integer
mss2 = maximum . map (maximum . scanl (+) 0) . tails

-- 3ª definición:
mss3 :: [Integer] -> Integer
mss3 = maximum . map sum . concatMap tails . inits 

-- 4ª definición
mss4 :: [Integer] -> Integer
mss4  = fst . foldr (\x (b,a) -> (max (a+x) b, max 0 (a+x))) (0,0) 

-- 5ª definición (con scanl):
mss5 :: [Integer] -> Integer
mss5 = maximum . scanl (\a x -> max 0 a + x) 0

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

--    ghci> mss [1..500]
--    125250
--    (7.52 secs, 2022130824 bytes)
--    
--    ghci> mss2 [1..500]
--    125250
--    (0.01 secs, 10474956 bytes)
--    
--    ghci> mss3 [1..500]
--    125250
--    (0.98 secs, 841862016 bytes)
--    
--    ghci> mss4 [1..500]
--    125250
--    (0.01 secs, 552252 bytes)
--    
--    ghci> mss2 [1..1000]
--    500500
--    (0.06 secs, 54575712 bytes)
--    
--    ghci> mss3 [1..1000]
--    500500
--    (7.87 secs, 7061347900 bytes)
--
--    ghci> mss4 [1..1000]
--    500500
--    (0.01 secs, 549700 bytes)
--    
--    ghci> mss2 [1..2000]
--    2001000
--    (0.29 secs, 216424336 bytes)
--    
--    ghci> mss2 [1..5000]
--    12502500
--    (2.37 secs, 1356384840 bytes)
--    
--    ghci> mss4 [1..5000]
--    12502500
--    (0.02 secs, 1913548 bytes)
--
--    ghci> mss5 [1..5000]
--    12502500
--    (0.01 secs, 2886360 bytes)

import Data.List (inits,tails)

-- 1ª solución

mss :: [Integer] -> Integer

mss = maximum . map sum . segmentos

-- (segmentos xs) es la lista de los segmentos de xs. Por ejemplo,

-- ghci> segmentos "abc"

-- ["","a","ab","abc","","b","bc","","c",""]

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

segmentos = concat . map inits . tails

-- 2ª definición:

mss2 :: [Integer] -> Integer

mss2 = maximum . map (maximum . scanl (+) 0) . tails

-- 3ª definición:

mss3 :: [Integer] -> Integer

mss3 = maximum . map sum . concatMap tails . inits

-- 4ª definición

mss4 :: [Integer] -> Integer

mss4 = fst . foldr (\x (b,a) -> (max (a+x) b, max 0 (a+x))) (0,0)

-- 5ª definición (con scanl):

mss5 :: [Integer] -> Integer

mss5 = maximum . scanl (\a x -> max 0 a + x) 0

-- Comparación de eficiencia

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

-- ghci> mss [1..500]

-- 125250

-- (7.52 secs, 2022130824 bytes)

-- ghci> mss2 [1..500]

-- 125250

-- (0.01 secs, 10474956 bytes)

-- ghci> mss3 [1..500]

-- 125250

-- (0.98 secs, 841862016 bytes)

-- ghci> mss4 [1..500]

-- 125250

-- (0.01 secs, 552252 bytes)

-- ghci> mss2 [1..1000]

-- 500500

-- (0.06 secs, 54575712 bytes)

-- ghci> mss3 [1..1000]

-- 500500

-- (7.87 secs, 7061347900 bytes)

-- ghci> mss4 [1..1000]

-- 500500

-- (0.01 secs, 549700 bytes)

-- ghci> mss2 [1..2000]

-- 2001000

-- (0.29 secs, 216424336 bytes)

-- ghci> mss2 [1..5000]

-- 12502500

-- (2.37 secs, 1356384840 bytes)

-- ghci> mss4 [1..5000]

-- 12502500

-- (0.02 secs, 1913548 bytes)

-- ghci> mss5 [1..5000]

-- 12502500

-- (0.01 secs, 2886360 bytes)

Referencias

El ejercicio está basado en la función mss del libro de Bird Thinking functionally with Haskell (página 127).
Las soluciones 3ª y 4ª las publicó josejuan aquí

Repetición de elementos

PorJosé A. Alonso 13-noviembre-201427-diciembre-2014

Enunciado

-- Definir la función
--    repiteElementos :: Int -> [a] -> [a]
-- tal que (repiteElementos k xs) es la lista obtenida repitiendo cada
-- elemento de xs k veces. Por ejemplo,
--    repiteElementos 3 [5,2,7,4]  ==  [5,5,5,2,2,2,7,7,7,4,4,4]
--
-- Comprobar con QuickCheck que, para todo número natural k y toda lista
-- xs, el número de elementos de (repiteElementos k xs) es k veces el
-- número de elementos de xs.
--
-- Nota. Al hacer la comprobación limitar el tamaño de las pruebas como
-- se indica a continuación
--    ghci> quickCheckWith (stdArgs {maxSize=7}) prop_repiteElementos
--    +++ OK, passed 100 tests.

-- Definir la función

-- repiteElementos :: Int -> [a] -> [a]

-- tal que (repiteElementos k xs) es la lista obtenida repitiendo cada

-- elemento de xs k veces. Por ejemplo,

-- repiteElementos 3 [5,2,7,4] == [5,5,5,2,2,2,7,7,7,4,4,4]

-- Comprobar con QuickCheck que, para todo número natural k y toda lista

-- xs, el número de elementos de (repiteElementos k xs) es k veces el

-- número de elementos de xs.

-- Nota. Al hacer la comprobación limitar el tamaño de las pruebas como

-- se indica a continuación

-- ghci> quickCheckWith (stdArgs {maxSize=7}) prop_repiteElementos

-- +++ OK, passed 100 tests.

Soluciones

import Test.QuickCheck

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

-- 2ª definición (con map)
repiteElementos2 :: Int -> [a] -> [a]
repiteElementos2 k xs = concat (map (replicate k) xs)

-- 3ª definición (con concatMap):
repiteElementos3 :: Int -> [a] -> [a]
repiteElementos3 k = concatMap (replicate k)

-- 4ª definición (por recursión):
repiteElementos4 :: Int -> [a] -> [a]
repiteElementos4 k [] = []
repiteElementos4 k (x:xs) = replicate k x ++ repiteElementos4 k xs

-- 5ª definición (por plegado):
repiteElementos5 :: Int -> [a] -> [a]
repiteElementos5 k = foldr ((++) . replicate k) []

-- Propiedad de equivalencia
prop_equivalencia :: Int -> [Int] -> Bool
prop_equivalencia k xs =
    repiteElementos2 k xs == ys &&
    repiteElementos3 k xs == ys &&
    repiteElementos4 k xs == ys &&
    repiteElementos5 k xs == ys 
    where ys = repiteElementos1 k xs

-- Su comprobación es
--    ghci> quickCheckWith (stdArgs {maxSize=10}) prop_equivalencia
--    +++ OK, passed 100 tests.

-- La propiedad es
prop_repiteElementos :: Int -> [Int] -> Property
prop_repiteElementos k xs =
    k >= 0 ==> length (repiteElementos1 k xs) == k * length xs 

-- La comprobación es
--    ghci> quickCheckWith (stdArgs {maxSize=7}) prop_repiteElementos
--    +++ OK, passed 100 tests.

import Test.QuickCheck

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

repiteElementos1 :: Int -> [a] -> [a]

repiteElementos1 k xs = concat [replicate k x | x <- xs]

-- 2ª definición (con map)

repiteElementos2 :: Int -> [a] -> [a]

repiteElementos2 k xs = concat (map (replicate k) xs)

-- 3ª definición (con concatMap):

repiteElementos3 :: Int -> [a] -> [a]

repiteElementos3 k = concatMap (replicate k)

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

repiteElementos4 :: Int -> [a] -> [a]

repiteElementos4 k [] = []

repiteElementos4 k (x:xs) = replicate k x ++ repiteElementos4 k xs

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

repiteElementos5 :: Int -> [a] -> [a]

repiteElementos5 k = foldr ((++) . replicate k) []

-- Propiedad de equivalencia

prop_equivalencia :: Int -> [Int] -> Bool

prop_equivalencia k xs =

repiteElementos2 k xs == ys &&

repiteElementos3 k xs == ys &&

repiteElementos4 k xs == ys &&

repiteElementos5 k xs == ys

where ys = repiteElementos1 k xs

-- Su comprobación es

-- ghci> quickCheckWith (stdArgs {maxSize=10}) prop_equivalencia

-- +++ OK, passed 100 tests.

-- La propiedad es

prop_repiteElementos :: Int -> [Int] -> Property

prop_repiteElementos k xs =

k >= 0 ==> length (repiteElementos1 k xs) == k * length xs

-- La comprobación es

-- ghci> quickCheckWith (stdArgs {maxSize=7}) prop_repiteElementos

-- +++ OK, passed 100 tests.

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Referencias

Soluciones

Referencias

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Referencias

Enunciado

Soluciones

Entradas recientes

Buscar

Correo electrónico