tal que (indicesVerdaderos xs) es la lista infinita de booleanos tal que sólo son verdaderos los elementos cuyos índices pertenecen a la lista estrictamente creciente xs. Por ejemplo,
λ> take 6 (indicesVerdaderos [1,4])
[False,True,False,False,True,False]
λ> take 6 (indicesVerdaderos [0,2..])
[True,False,True,False,True,False]
λ> take 3 (indicesVerdaderos [])
[False,False,False]
λ> take 6 (indicesVerdaderos [1..])
[False,True,True,True,True,True]
λ> last (take (8*10^7) (indicesVerdaderos [0,5..]))
False
λ> take 6 (indicesVerdaderos [1,4])
[False,True,False,False,True,False]
λ> take 6 (indicesVerdaderos [0,2..])
[True,False,True,False,True,False]
λ> take 3 (indicesVerdaderos [])
[False,False,False]
λ> take 6 (indicesVerdaderos [1..])
[False,True,True,True,True,True]
λ> last (take (8*10^7) (indicesVerdaderos [0,5..]))
False
se pueden calcular el número pi con la precisión que se desee. Por ejemplo,
λ> import Data.Number.CReal
λ> showCReal 60 pi
"3.141592653589793238462643383279502884197169399375105820974945"
λ> import Data.Number.CReal
λ> showCReal 60 pi
"3.141592653589793238462643383279502884197169399375105820974945"
importa la librería y calcula el número pi con 60 decimales.
La distribución de las diferencias de los dígitos consecutivos para los 18 primeros n dígitos de pi se calcula como sigue: los primeros 18 dígitos de pi son
(graficas ns f) dibuja en el fichero f las gráficas de las distribuciones de las diferencias de los dígitos consecutivos para los primeros n dígitos de pi, para n en ns. Por ejemplo, al evaluar (graficas [100,250..4000] “distribucionDDCpi.png” se escribe en el fichero “distribucionDDCpi.png” la siguiente gráfica
Soluciones
import Data.Number.CReal
import Graphics.Gnuplot.Simple
import Data.Array
-- λ> digitosPi 18-- [3,1,4,1,5,9,2,6,5,3,5,8,9,7,9,3,2,3]
digitosPi ::Int->[Int]
digitosPi n =init[read[c]| c <-(x:xs)]where(x:_:xs)= showCReal n pi-- λ> diferenciasConsecutivos (digitosPi 18)-- [2,-3,3,-4,-4,7,-4,1,2,-2,-3,-1,2,-2,6,1,-1]
diferenciasConsecutivos ::Num a =>[a]->[a]
diferenciasConsecutivos xs =zipWith(-) xs (tail xs)
distribucionDDCpi ::Int->[Int]
distribucionDDCpi =
distribucion . diferenciasConsecutivos . digitosPi
where distribucion xs =
elems (accumArray (+)0(-9,9)(zip xs (repeat1)))
graficas ::[Int]-> FilePath ->IO()
graficas ns f =
plotLists [Key Nothing, PNG f][puntos n | n <- ns]where puntos ::Int->[(Int,Int)]
puntos n =zip[-9..9](distribucionDDCpi n)
import Data.Number.CReal
import Graphics.Gnuplot.Simple
import Data.Array
-- λ> digitosPi 18
-- [3,1,4,1,5,9,2,6,5,3,5,8,9,7,9,3,2,3]
digitosPi :: Int -> [Int]
digitosPi n = init [read [c] | c <- (x:xs)]
where (x:_:xs) = showCReal n pi
-- λ> diferenciasConsecutivos (digitosPi 18)
-- [2,-3,3,-4,-4,7,-4,1,2,-2,-3,-1,2,-2,6,1,-1]
diferenciasConsecutivos :: Num a => [a] -> [a]
diferenciasConsecutivos xs =
zipWith (-) xs (tail xs)
distribucionDDCpi :: Int -> [Int]
distribucionDDCpi =
distribucion . diferenciasConsecutivos . digitosPi
where distribucion xs =
elems (accumArray (+) 0 (-9,9) (zip xs (repeat 1)))
graficas :: [Int] -> FilePath -> IO ()
graficas ns f =
plotLists [Key Nothing, PNG f]
[puntos n | n <- ns]
where puntos :: Int -> [(Int,Int)]
puntos n = zip [-9..9] (distribucionDDCpi n)
Pensamiento
Doy consejo, a fuer de viejo:
nunca sigas mi consejo.
(graficaSucRecaman n) dibuja los n primeros términos de la sucesión de Recamán. Por ejemplo, (graficaSucRecaman 300) dibuja
(graficaInvRecaman n) dibuja los valores de (invRecaman k) para k entre 0 y n. Por ejemplo, (graficaInvRecaman 17) dibuja
y (graficaInvRecaman 100) dibuja
Soluciones
importqualified Data.Set as S
-- 1ª solución-- ===========
sucRecaman1 ::[Int]
sucRecaman1 =map suc1 [0..]
suc1 ::Int->Int
suc1 0=0
suc1 n | y > n && y - n `notElem` ys = y - n
|otherwise= y + n
where y = suc1 (n -1)
ys =[suc1 k | k <-[0..n -1]]-- 2ª solución-- ===========
sucRecaman2 ::[Int]
sucRecaman2 =0:zipWith3 f sucRecaman2 [1..](repeat sucRecaman2)where f y n ys | y > n && y - n `notElem` take n ys = y - n
|otherwise= y + n
-- 3ª solución-- ===========
sucRecaman3 ::[Int]
sucRecaman3 =0: recaman (S.singleton 0)10
recaman :: S.Set Int->Int->Int->[Int]
recaman s n x
| x > n &&(x-n) `S.notMember` s =(x-n): recaman (S.insert (x-n) s)(n+1)(x-n)|otherwise=(x+n):recaman (S.insert (x+n) s)(n+1)(x+n)-- Comparación de eficiencia:-- λ> sucRecaman1 !! 25-- 17-- (3.76 secs, 2,394,593,952 bytes)-- λ> sucRecaman2 !! 25-- 17-- (0.00 secs, 0 bytes)-- λ> sucRecaman3 !! 25-- 17-- (0.00 secs, 0 bytes)---- λ> sucRecaman2 !! (2*10^4)-- 14358-- (2.69 secs, 6,927,559,784 bytes)-- λ> sucRecaman3 !! (2*10^4)-- 14358-- (0.04 secs, 0 bytes)-- Definición de invRecaman
invRecaman ::Int->Int
invRecaman n =length(takeWhile(/=n) sucRecaman3)
graficaSucRecaman ::Int->IO()
graficaSucRecaman n =
plotList [Key Nothing](take n sucRecaman3)
graficaInvRecaman ::Int->IO()
graficaInvRecaman n =
plotList [Key Nothing][invRecaman k | k <-[0..n]]
import qualified Data.Set as S
-- 1ª solución
-- ===========
sucRecaman1 :: [Int]
sucRecaman1 = map suc1 [0..]
suc1 :: Int -> Int
suc1 0 = 0
suc1 n | y > n && y - n `notElem` ys = y - n
| otherwise = y + n
where y = suc1 (n - 1)
ys = [suc1 k | k <- [0..n - 1]]
-- 2ª solución
-- ===========
sucRecaman2 :: [Int]
sucRecaman2 = 0:zipWith3 f sucRecaman2 [1..] (repeat sucRecaman2)
where f y n ys | y > n && y - n `notElem` take n ys = y - n
| otherwise = y + n
-- 3ª solución
-- ===========
sucRecaman3 :: [Int]
sucRecaman3 = 0 : recaman (S.singleton 0) 1 0
recaman :: S.Set Int -> Int -> Int -> [Int]
recaman s n x
| x > n && (x-n) `S.notMember` s =
(x-n) : recaman (S.insert (x-n) s) (n+1) (x-n)
| otherwise =
(x+n):recaman (S.insert (x+n) s) (n+1) (x+n)
-- Comparación de eficiencia:
-- λ> sucRecaman1 !! 25
-- 17
-- (3.76 secs, 2,394,593,952 bytes)
-- λ> sucRecaman2 !! 25
-- 17
-- (0.00 secs, 0 bytes)
-- λ> sucRecaman3 !! 25
-- 17
-- (0.00 secs, 0 bytes)
--
-- λ> sucRecaman2 !! (2*10^4)
-- 14358
-- (2.69 secs, 6,927,559,784 bytes)
-- λ> sucRecaman3 !! (2*10^4)
-- 14358
-- (0.04 secs, 0 bytes)
-- Definición de invRecaman
invRecaman :: Int -> Int
invRecaman n =
length (takeWhile (/=n) sucRecaman3)
graficaSucRecaman :: Int -> IO ()
graficaSucRecaman n =
plotList [Key Nothing]
(take n sucRecaman3)
graficaInvRecaman :: Int -> IO ()
graficaInvRecaman n =
plotList [Key Nothing]
[invRecaman k | k <- [0..n]]
las filas siguientes se construyen sumando los números adyacentes de la fila superior y añadiendo un 1 al principio y al final de la fila.
La matriz de Pascal es la matriz cuyas filas son los elementos de la
correspondiente fila del triángulo de Pascal completadas con ceros. Por ejemplo, la matriz de Pascal de orden 6 es
import Data.Matrix
-- 1ª solución-- ===========
matrizPascal ::Int-> Matrix Integer
matrizPascal 1= fromList 11[1]
matrizPascal n = matrix n n f
where f (i,j)| i < n && j < n = p!(i,j)| i < n && j == n =0| j ==1|| j == n =1|otherwise= p!(i-1,j-1)+ p!(i-1,j)
p = matrizPascal (n-1)-- 2ª solución-- ===========
matrizPascal2 ::Int-> Matrix Integer
matrizPascal2 n = fromLists xss
where yss =take n pascal
xss =map(take n)(map(++repeat0) yss)
pascal ::[[Integer]]
pascal =[1]:map f pascal
where f xs =zipWith(+)(0:xs)(xs ++[0])-- 3ª solución-- ===========
matrizPascal3 ::Int-> Matrix Integer
matrizPascal3 n = matrix n n f
where f (i,j)| i >= j = comb (i-1)(j-1)|otherwise=0-- (comb n k) es el número de combinaciones (o coeficiente binomial) de-- n sobre k. Por ejemplo,
comb ::Int->Int->Integer
comb n k =product[n',n'-1..n'-k'+1] `div` product[1..k']where n' =fromIntegral n
k' =fromIntegral k
-- 4ª solución-- ===========
matrizPascal4 ::Int-> Matrix Integer
matrizPascal4 n = p
where p = matrix n n (\(i,j)-> f i j)
f i 1=1
f i j
| j > i =0| i == j =1|otherwise= p!(i-1,j)+ p!(i-1,j-1)-- Comparación de eficiencia-- =========================-- λ> maximum (matrizPascal 150)-- 46413034868354394849492907436302560970058760-- (2.58 secs, 394,030,504 bytes)-- λ> maximum (matrizPascal2 150)-- 46413034868354394849492907436302560970058760-- (0.03 secs, 8,326,784 bytes)-- λ> maximum (matrizPascal3 150)-- 46413034868354394849492907436302560970058760-- (0.38 secs, 250,072,360 bytes)-- λ> maximum (matrizPascal4 150)-- 46413034868354394849492907436302560970058760-- (0.10 secs, 13,356,360 bytes)-- -- λ> length (show (maximum (matrizPascal2 300)))-- 89-- (0.06 secs, 27,286,296 bytes)-- λ> length (show (maximum (matrizPascal3 300)))-- 89-- (2.74 secs, 2,367,037,536 bytes)-- λ> length (show (maximum (matrizPascal4 300)))-- 89-- (0.36 secs, 53,934,792 bytes)-- -- λ> length (show (maximum (matrizPascal2 700)))-- 209-- (0.83 secs, 207,241,080 bytes)-- λ> length (show (maximum (matrizPascal4 700)))-- 209-- (2.22 secs, 311,413,008 bytes)
import Data.Matrix
-- 1ª solución
-- ===========
matrizPascal :: Int -> Matrix Integer
matrizPascal 1 = fromList 1 1 [1]
matrizPascal n = matrix n n f
where f (i,j) | i < n && j < n = p!(i,j)
| i < n && j == n = 0
| j == 1 || j == n = 1
| otherwise = p!(i-1,j-1) + p!(i-1,j)
p = matrizPascal (n-1)
-- 2ª solución
-- ===========
matrizPascal2 :: Int -> Matrix Integer
matrizPascal2 n = fromLists xss
where yss = take n pascal
xss = map (take n) (map (++ repeat 0) yss)
pascal :: [[Integer]]
pascal = [1] : map f pascal
where f xs = zipWith (+) (0:xs) (xs ++ [0])
-- 3ª solución
-- ===========
matrizPascal3 :: Int -> Matrix Integer
matrizPascal3 n = matrix n n f
where f (i,j) | i >= j = comb (i-1) (j-1)
| otherwise = 0
-- (comb n k) es el número de combinaciones (o coeficiente binomial) de
-- n sobre k. Por ejemplo,
comb :: Int -> Int -> Integer
comb n k = product [n',n'-1..n'-k'+1] `div` product [1..k']
where n' = fromIntegral n
k' = fromIntegral k
-- 4ª solución
-- ===========
matrizPascal4 :: Int -> Matrix Integer
matrizPascal4 n = p
where p = matrix n n (\(i,j) -> f i j)
f i 1 = 1
f i j
| j > i = 0
| i == j = 1
| otherwise = p!(i-1,j) + p!(i-1,j-1)
-- Comparación de eficiencia
-- =========================
-- λ> maximum (matrizPascal 150)
-- 46413034868354394849492907436302560970058760
-- (2.58 secs, 394,030,504 bytes)
-- λ> maximum (matrizPascal2 150)
-- 46413034868354394849492907436302560970058760
-- (0.03 secs, 8,326,784 bytes)
-- λ> maximum (matrizPascal3 150)
-- 46413034868354394849492907436302560970058760
-- (0.38 secs, 250,072,360 bytes)
-- λ> maximum (matrizPascal4 150)
-- 46413034868354394849492907436302560970058760
-- (0.10 secs, 13,356,360 bytes)
--
-- λ> length (show (maximum (matrizPascal2 300)))
-- 89
-- (0.06 secs, 27,286,296 bytes)
-- λ> length (show (maximum (matrizPascal3 300)))
-- 89
-- (2.74 secs, 2,367,037,536 bytes)
-- λ> length (show (maximum (matrizPascal4 300)))
-- 89
-- (0.36 secs, 53,934,792 bytes)
--
-- λ> length (show (maximum (matrizPascal2 700)))
-- 209
-- (0.83 secs, 207,241,080 bytes)
-- λ> length (show (maximum (matrizPascal4 700)))
-- 209
-- (2.22 secs, 311,413,008 bytes)
(graficaSucRecaman n) dibuja los n primeros términos de la sucesión de Recamán. Por ejemplo, (graficaSucRecaman 300) dibuja
(graficaInvRecaman n) dibuja los valores de (invRecaman k) para k entre 0 y n. Por ejemplo, (graficaInvRecaman 17) dibuja
y (graficaInvRecaman 100) dibuja
Soluciones
importqualified Data.Set as S
-- 1ª solución-- ===========
sucRecaman1 ::[Int]
sucRecaman1 =map suc1 [0..]
suc1 ::Int->Int
suc1 0=0
suc1 n | y > n && y - n `notElem` ys = y - n
|otherwise= y + n
where y = suc1 (n -1)
ys =[suc1 k | k <-[0..n -1]]-- 2ª solución-- ===========
sucRecaman2 ::[Int]
sucRecaman2 =0:zipWith3 f sucRecaman2 [1..](repeat sucRecaman2)where f y n ys | y > n && y - n `notElem` take n ys = y - n
|otherwise= y + n
-- 3ª solución-- ===========
sucRecaman3 ::[Int]
sucRecaman3 =0: recaman (S.singleton 0)10
recaman :: S.Set Int->Int->Int->[Int]
recaman s n x
| x > n &&(x-n) `S.notMember` s =(x-n): recaman (S.insert (x-n) s)(n+1)(x-n)|otherwise=(x+n):recaman (S.insert (x+n) s)(n+1)(x+n)-- Comparación de eficiencia:-- λ> sucRecaman1 !! 25-- 17-- (3.76 secs, 2,394,593,952 bytes)-- λ> sucRecaman2 !! 25-- 17-- (0.00 secs, 0 bytes)-- λ> sucRecaman3 !! 25-- 17-- (0.00 secs, 0 bytes)---- λ> sucRecaman2 !! (2*10^4)-- 14358-- (2.69 secs, 6,927,559,784 bytes)-- λ> sucRecaman3 !! (2*10^4)-- 14358-- (0.04 secs, 0 bytes)-- Definición de invRecaman
invRecaman ::Int->Int
invRecaman n =length(takeWhile(/=n) sucRecaman3)
graficaSucRecaman ::Int->IO()
graficaSucRecaman n =
plotList [Key Nothing](take n sucRecaman3)
graficaInvRecaman ::Int->IO()
graficaInvRecaman n =
plotList [Key Nothing][invRecaman k | k <-[0..n]]
import qualified Data.Set as S
-- 1ª solución
-- ===========
sucRecaman1 :: [Int]
sucRecaman1 = map suc1 [0..]
suc1 :: Int -> Int
suc1 0 = 0
suc1 n | y > n && y - n `notElem` ys = y - n
| otherwise = y + n
where y = suc1 (n - 1)
ys = [suc1 k | k <- [0..n - 1]]
-- 2ª solución
-- ===========
sucRecaman2 :: [Int]
sucRecaman2 = 0:zipWith3 f sucRecaman2 [1..] (repeat sucRecaman2)
where f y n ys | y > n && y - n `notElem` take n ys = y - n
| otherwise = y + n
-- 3ª solución
-- ===========
sucRecaman3 :: [Int]
sucRecaman3 = 0 : recaman (S.singleton 0) 1 0
recaman :: S.Set Int -> Int -> Int -> [Int]
recaman s n x
| x > n && (x-n) `S.notMember` s =
(x-n) : recaman (S.insert (x-n) s) (n+1) (x-n)
| otherwise =
(x+n):recaman (S.insert (x+n) s) (n+1) (x+n)
-- Comparación de eficiencia:
-- λ> sucRecaman1 !! 25
-- 17
-- (3.76 secs, 2,394,593,952 bytes)
-- λ> sucRecaman2 !! 25
-- 17
-- (0.00 secs, 0 bytes)
-- λ> sucRecaman3 !! 25
-- 17
-- (0.00 secs, 0 bytes)
--
-- λ> sucRecaman2 !! (2*10^4)
-- 14358
-- (2.69 secs, 6,927,559,784 bytes)
-- λ> sucRecaman3 !! (2*10^4)
-- 14358
-- (0.04 secs, 0 bytes)
-- Definición de invRecaman
invRecaman :: Int -> Int
invRecaman n =
length (takeWhile (/=n) sucRecaman3)
graficaSucRecaman :: Int -> IO ()
graficaSucRecaman n =
plotList [Key Nothing]
(take n sucRecaman3)
graficaInvRecaman :: Int -> IO ()
graficaInvRecaman n =
plotList [Key Nothing]
[invRecaman k | k <- [0..n]]
(graficas ns) dibuja las gráficas de (frecuenciasDistancias k) para k en ns. Por ejemplo, (graficas [10,20,30]) dibuja (graficas [1000,2000,3000]) dibuja
y (graficas [100000,200000,300000]) dibuja
(distanciasMasFrecuentes n) es la lista de las distancias más frecuentes entre los elementos consecutivos de la lista de los n primeros primos. Por ejemplo,
La distribución de las diferencias de los dígitos consecutivos para los 18 primeros dígitos de pi se calcula como sigue: los primeros 18 dígitos de pi son
(graficas ns f) dibuja en el fichero f las gráficas de las distribuciones de las diferencias de los dígitos consecutivos para los primeros n dígitos de pi, para n en ns. Por ejemplo, al evaluar (graficas [100,250..4000] “distribucionDDCpi.png” se escribe en el fichero “distribucionDDCpi.png” la siguiente gráfica
tal que (siembra xs) es la lista ys obtenida al repartir cada elemento x de la lista xs poniendo un 1 en las x siguientes posiciones de la lista ys. Por ejemplo,
El tercer ejemplo se obtiene sumando la siembra de 4 en la posición 0 (como el ejemplo 1) y el 2 en la posición 1 (como el ejemplo 2). Otros ejemplos son
Comprobar con QuickCheck que la suma de los elementos de (siembra xs) es igual que la suma de los de xs.
Nota 1: Se supone que el argumento es una lista de números no negativos y que se puede ampliar tanto como sea necesario para repartir los elementos.
Nota 2: Este ejercicio es parte del examen del grupo 3 del 2 de diciembre.
Soluciones
import Test.QuickCheck
-- 1ª solución-- ===========
siembra1 ::[Int]->[Int]
siembra1 = suma . brotes
-- (brotes xs) es la lista de los brotes obtenido sembrando los-- elementos de xs. Por ejemplo,-- brotes [3,4,2] == [[0,1,1,1],[0,0,1,1,1,1],[0,0,0,1,1]]
brotes ::[Int]->[[Int]]
brotes xs = aux xs 1where aux (x:xs) n =(replicate n 0++ replicate x 1): aux xs (n+1)
aux _ _ =[]-- (suma xss) es la suma de los elementos de xss (suponiendo que al-- final de cada elemento se continua con ceros). Por ejemplo,-- suma [[0,1,1,1],[0,0,1,1,1,1],[0,0,0,1,1]] == [0,1,2,3,2,1]
suma ::[[Int]]->[Int]
suma =foldr1 aux
where aux [] ys = ys
aux xs []= xs
aux (x:xs)(y:ys)=(x+y): aux xs ys
-- 2ª solución-- ===========
siembra2 ::[Int]->[Int]
siembra2 []=[]
siembra2 (x:xs)= mezcla (siembraElemento x)(0: siembra2 xs)
siembraElemento ::Int->[Int]
siembraElemento x =0: replicate x 1
mezcla ::[Int]->[Int]->[Int]
mezcla xs ys =take(max(length xs)(length ys))(zipWith(+)(xs ++repeat0)(ys ++repeat0))-- 3ª solución-- ===========
siembra3 ::[Int]->[Int]
siembra3 []=[]
siembra3 xs = aux xs 0(repeat0)where
aux [] _ ys = cosecha ys
aux (x:xs) n ys = aux xs (n+1)(zipWith(+) brotes ys)where brotes = replicate (n+1)0++ replicate x 1++repeat0-- (cosecha xs) es la lista formada por los ceros iniciales de xs y los-- elementos siguientes hasta que vuelve a aparecer el 0. Por ejemplo,-- cosecha [0,0,3,5,2,0,9] == [0,0,3,5,2]-- cosecha ([0,0,3,5,2] ++ repeat 0) == [0,0,3,5,2]
cosecha ::[Int]->[Int]
cosecha xs = ys ++takeWhile(>0) zs
where(ys,zs)=span(==0) xs
-- 4ª solución-- ===========
siembra4 ::[Int]->[Int]
siembra4 []=[]
siembra4 xs = aux xs [](repeat0)where
aux [] ys zs =reverse ys ++takeWhile(>0) zs
aux (x:xs) ys (z:zs)= aux xs (z:ys)(zipWith(+) brotes zs)where brotes = replicate x 1++repeat0-- Comparación de eficiencia-- =========================-- λ> sum $ siembra1 [1..2000]-- 2001000-- (9.44 secs, 1,894,065,928 bytes)-- ghci> sum $ siembra2 [1..2000]-- 2001000-- (5.92 secs, 936900576 bytes)-- ghci> sum $ siembra3 [1..2000]-- 2001000-- (1.59 secs, 836847072 bytes)-- ghci> sum $ siembra4 [1..2000]-- 2001000-- (1.68 secs, 570492392 bytes)-- En lo que sigue usaremos la 2ª definición
siembra ::[Int]->[Int]
siembra = siembra2
-- Verificación-- ============-- La propiedad es
prop_siembra ::[Int]->Bool
prop_siembra xs =sum(siembra1 ys)==sum ys
where ys =map(\x ->1+abs x) xs
-- La comprobación es-- λ> quickCheck prop_siembra-- +++ OK, passed 100 tests.
import Test.QuickCheck
-- 1ª solución
-- ===========
siembra1 :: [Int] -> [Int]
siembra1 = suma . brotes
-- (brotes xs) es la lista de los brotes obtenido sembrando los
-- elementos de xs. Por ejemplo,
-- brotes [3,4,2] == [[0,1,1,1],[0,0,1,1,1,1],[0,0,0,1,1]]
brotes :: [Int] -> [[Int]]
brotes xs = aux xs 1
where aux (x:xs) n = (replicate n 0 ++ replicate x 1) : aux xs (n+1)
aux _ _ = []
-- (suma xss) es la suma de los elementos de xss (suponiendo que al
-- final de cada elemento se continua con ceros). Por ejemplo,
-- suma [[0,1,1,1],[0,0,1,1,1,1],[0,0,0,1,1]] == [0,1,2,3,2,1]
suma :: [[Int]] -> [Int]
suma = foldr1 aux
where aux [] ys = ys
aux xs [] = xs
aux (x:xs) (y:ys) = (x+y) : aux xs ys
-- 2ª solución
-- ===========
siembra2 :: [Int] -> [Int]
siembra2 [] = []
siembra2 (x:xs) = mezcla (siembraElemento x) (0 : siembra2 xs)
siembraElemento :: Int -> [Int]
siembraElemento x = 0 : replicate x 1
mezcla :: [Int] -> [Int] -> [Int]
mezcla xs ys =
take (max (length xs) (length ys))
(zipWith (+) (xs ++ repeat 0) (ys ++ repeat 0))
-- 3ª solución
-- ===========
siembra3 :: [Int] -> [Int]
siembra3 [] = []
siembra3 xs = aux xs 0 (repeat 0) where
aux [] _ ys = cosecha ys
aux (x:xs) n ys = aux xs (n+1) (zipWith (+) brotes ys)
where brotes = replicate (n+1) 0 ++ replicate x 1 ++ repeat 0
-- (cosecha xs) es la lista formada por los ceros iniciales de xs y los
-- elementos siguientes hasta que vuelve a aparecer el 0. Por ejemplo,
-- cosecha [0,0,3,5,2,0,9] == [0,0,3,5,2]
-- cosecha ([0,0,3,5,2] ++ repeat 0) == [0,0,3,5,2]
cosecha :: [Int] -> [Int]
cosecha xs = ys ++ takeWhile (>0) zs
where (ys,zs) = span (==0) xs
-- 4ª solución
-- ===========
siembra4 :: [Int] -> [Int]
siembra4 [] = []
siembra4 xs = aux xs [] (repeat 0) where
aux [] ys zs = reverse ys ++ takeWhile (>0) zs
aux (x:xs) ys (z:zs) = aux xs (z:ys) (zipWith (+) brotes zs)
where brotes = replicate x 1 ++ repeat 0
-- Comparación de eficiencia
-- =========================
-- λ> sum $ siembra1 [1..2000]
-- 2001000
-- (9.44 secs, 1,894,065,928 bytes)
-- ghci> sum $ siembra2 [1..2000]
-- 2001000
-- (5.92 secs, 936900576 bytes)
-- ghci> sum $ siembra3 [1..2000]
-- 2001000
-- (1.59 secs, 836847072 bytes)
-- ghci> sum $ siembra4 [1..2000]
-- 2001000
-- (1.68 secs, 570492392 bytes)
-- En lo que sigue usaremos la 2ª definición
siembra :: [Int] -> [Int]
siembra = siembra2
-- Verificación
-- ============
-- La propiedad es
prop_siembra :: [Int] -> Bool
prop_siembra xs =
sum (siembra1 ys) == sum ys
where ys = map (\x -> 1 + abs x) xs
-- La comprobación es
-- λ> quickCheck prop_siembra
-- +++ OK, passed 100 tests.