sum

Suma de elementos en posiciones dadas

PorJosé A. Alonso 17-diciembre-201524-diciembre-2015

Definir la función

   sumaEnPosicion :: [Int] -> [Int] -> Int

1	sumaEnPosicion :: [Int] -> [Int] -> Int

tal que (sumaEnPosicion xs ys) es la suma de todos los elementos de xs cuyas posiciones se indican en ys. Por ejemplo,

   sumaEnPosicion [1,2,3] [0,2]  ==  4
   sumaEnPosicion [4,6,2] [1,3]  ==  6
   sumaEnPosicion [3,5,1] [0,1]  ==  8

sumaEnPosicion [1,2,3] [0,2] == 4

sumaEnPosicion [4,6,2] [1,3] == 6

sumaEnPosicion [3,5,1] [0,1] == 8

Soluciones

-- 1ª solución
sumaEnPosicion1 :: [Int] -> [Int] -> Int
sumaEnPosicion1 xs ys = sum [xs !! y | y <- ys, 0 <= y, y < n]
    where n = length xs

-- 2ª solución
sumaEnPosicion2 :: [Int] -> [Int] -> Int
sumaEnPosicion2 xs ys = aux xs [y | y <- ys, 0 <= y, y < n] 0
    where n = length xs
          aux _  []     r = r
          aux xs (y:ys) r = aux xs ys (r + xs!!y)

-- 1ª solución

sumaEnPosicion1 :: [Int] -> [Int] -> Int

sumaEnPosicion1 xs ys = sum [xs !! y | y <- ys, 0 <= y, y < n]

where n = length xs

-- 2ª solución

sumaEnPosicion2 :: [Int] -> [Int] -> Int

sumaEnPosicion2 xs ys = aux xs [y | y <- ys, 0 <= y, y < n] 0

where n = length xs

aux _ [] r = r

aux xs (y:ys) r = aux xs ys (r + xs!!y)

Año cúbico

PorJosé A. Alonso 14-diciembre-201525-marzo-2022

El año 2016 será un año cúbico porque se puede escribir como la suma de los cubos de 7 números consecutivos; en efecto,

   2016 = 3³+ 4³ +...+ 9³

1	2016 = 3³+ 4³ +...+ 9³

Definir la función

   esCubico :: Integer -> Bool

1	esCubico :: Integer -> Bool

tal que (esCubico x) se verifica si x se puede escribir como la suma de los cubos de 7 números consecutivos. Por ejemplo,

   esCubico 2016                ==  True
   esCubico 2017                ==  False
   esCubico 189005670081900441  ==  True
   esCubico 189005670081900442  ==  False

esCubico 2016 == True

esCubico 2017 == False

esCubico 189005670081900441 == True

esCubico 189005670081900442 == False

Soluciones

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

esCubico1 :: Integer -> Bool
esCubico1 x = pertenece x cubicos

-- cubicos es la lista de los números que se pueden escribir como la
-- suma de los cubos de 7 números consecutivos. Por ejemplo,
--    take 5 cubicos  ==  [784,1295,2016,2989,4256]
cubicos :: [Integer]
cubicos = [sum [x^3 | x <- [y..y+6]] | y <- [1..]]

-- (pertenece x ys) se verifica si x pertenece a la lista ordenada
-- ys. Por ejemplo,
--    pertenece 25 [0,3..]  ==  False
--    pertenece 27 [0,3..]  ==  True
pertenece :: Integer -> [Integer] ->  Bool
pertenece x ys = x == head (dropWhile (<x) ys)

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

esCubico2 :: Integer -> Bool
esCubico2 x = pertenece x (cubicosDesde k)
    where k = floor ((fromIntegral x/7)**(1/3))

cubicosDesde :: Integer -> [Integer]
cubicosDesde k = [sum [x^3 | x <- [y..y+6]] | y <- [k..]]

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

--    λ> esCubico1 189005670081900441
--    True
--    (7.49 secs, 1,917,868,024 bytes)
--    λ> esCubico2 189005670081900441
--    True
--    (0.01 secs, 0 bytes)

-- 1ª definición

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

esCubico1 :: Integer -> Bool

esCubico1 x = pertenece x cubicos

-- cubicos es la lista de los números que se pueden escribir como la

-- suma de los cubos de 7 números consecutivos. Por ejemplo,

-- take 5 cubicos == [784,1295,2016,2989,4256]

cubicos :: [Integer]

cubicos = [sum [x^3 | x <- [y..y+6]] | y <- [1..]]

-- (pertenece x ys) se verifica si x pertenece a la lista ordenada

-- ys. Por ejemplo,

-- pertenece 25 [0,3..] == False

-- pertenece 27 [0,3..] == True

pertenece :: Integer -> [Integer] -> Bool

pertenece x ys = x == head (dropWhile (<x) ys)

-- 2ª definición

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

esCubico2 :: Integer -> Bool

esCubico2 x = pertenece x (cubicosDesde k)

where k = floor ((fromIntegral x/7)**(1/3))

cubicosDesde :: Integer -> [Integer]

cubicosDesde k = [sum [x^3 | x <- [y..y+6]] | y <- [k..]]

-- Comparación de eficiencia

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

-- λ> esCubico1 189005670081900441

-- True

-- (7.49 secs, 1,917,868,024 bytes)

-- λ> esCubico2 189005670081900441

-- True

-- (0.01 secs, 0 bytes)

Los números de Smith

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

Un número de Smith es un número natural compuesto que cumple que la suma de sus dígitos es igual a la suma de los dígitos de todos sus factores primos (si tenemos algún factor primo repetido lo sumamos tantas veces como aparezca). Por ejemplo, el 22 es un número de Smith ya que

    22 = 2*11 y
   2+2 = 2+(1+1)

1 2	22 = 2*11 y 2+2 = 2+(1+1)

y el 4937775 también lo es ya que

   4937775       = 3*5*5*65837 y 
   4+9+3+7+7+7+5 = 3+5+5+(6+5+8+3+7)

1 2	4937775 = 355*65837 y 4+9+3+7+7+7+5 = 3+5+5+(6+5+8+3+7)

Definir las funciones

   esSmith :: Integer -> Bool
   smith :: [Integer]

1 2	esSmith :: Integer -> Bool smith :: [Integer]

tales que

(esSmith x) se verifica si x es un número de Smith. Por ejemplo,

     esSmith 22          ==  True
     esSmith 29          ==  False
     esSmith 2015        ==  False
     esSmith 4937775     ==  True
     esSmith 4567597056  ==  True

esSmith 22 == True

esSmith 29 == False

esSmith 2015 == False

esSmith 4937775 == True

esSmith 4567597056 == True

smith es la lista cuyos elementos son los números de Smith. Por ejemplo,

     λ> take 17 smith
     [4,22,27,58,85,94,121,166,202,265,274,319,346,355,378,382,391]
     λ> smith !! 2000
     62158

λ> take 17 smith

[4,22,27,58,85,94,121,166,202,265,274,319,346,355,378,382,391]

λ> smith !! 2000

62158

Soluciones

import Data.Numbers.Primes

esSmith :: Integer -> Bool
esSmith x = 
    not (isPrime x) && 
    sumaDigitos x == sum (map sumaDigitos (primeFactors x))

sumaDigitos :: Integer -> Integer
sumaDigitos x | x < 10 = x
              | otherwise = x `mod` 10 + sumaDigitos (x `div` 10)

smith :: [Integer]
smith = [x | x <- [1..], esSmith x]

import Data.Numbers.Primes

esSmith :: Integer -> Bool

esSmith x =

not (isPrime x) &&

sumaDigitos x == sum (map sumaDigitos (primeFactors x))

sumaDigitos :: Integer -> Integer

sumaDigitos x | x < 10 = x

| otherwise = x `mod` 10 + sumaDigitos (x `div` 10)

smith :: [Integer]

smith = [x | x <- [1..], esSmith x]

Los números de Armstrong

PorJosé A. Alonso 3-diciembre-201510-diciembre-2015

Un número de n dígitos es un número de Armstrong si es igual a la suma de las n-ésimas potencias de sus dígitos. Por ejemplo, 371, 8208 y 4210818 son números de Armstrong ya que

       371 = 3^3 + 7 + 1³ y  
      8208 = 8^4 + 2^4 + 0^4 + 8^4 
   4210818 = 4^7 + 2^7 + 1^7 + 0^7 + 8^7 + 1^7 + 8^7

371 = 3^3 + 7 + 1³ y

8208 = 8^4 + 2^4 + 0^4 + 8^4

4210818 = 4^7 + 2^7 + 1^7 + 0^7 + 8^7 + 1^7 + 8^7

Definir las funciones

   esArmstrong :: Integer -> Bool
   armstrong   :: [Integer]

1 2	esArmstrong :: Integer -> Bool armstrong :: [Integer]

tales que

(esArmstrong x) se verifica si x es un número de Armstrong. Por ejemplo,

     esArmstrong 371                                      ==  True
     esArmstrong 8208                                     ==  True
     esArmstrong 4210818                                  ==  True
     esArmstrong 2015                                     ==  False
     esArmstrong 115132219018763992565095597973971522401  ==  True
     esArmstrong 115132219018763992565095597973971522402  ==  False

esArmstrong 371 == True

esArmstrong 8208 == True

esArmstrong 4210818 == True

esArmstrong 2015 == False

esArmstrong 115132219018763992565095597973971522401 == True

esArmstrong 115132219018763992565095597973971522402 == False

armstrong es la lista cuyos elementos son los números de Armstrong. Por ejemplo,

     λ> take 18 armstrong
     [1,2,3,4,5,6,7,8,9,153,370,371,407,1634,8208,9474,54748,92727]

1 2	λ> take 18 armstrong [1,2,3,4,5,6,7,8,9,153,370,371,407,1634,8208,9474,54748,92727]

Comprobar con QuickCheck que los números mayores que
115132219018763992565095597973971522401 no son números de Armstrong.

Soluciones

import Test.QuickCheck

esArmstrong :: Integer -> Bool
esArmstrong x = 
    x == sum [d^n | d <- digitos x]
    where n = length (show x)

-- (digitos x) es la lista de los dígitos de x. Por ejemplo,
--    digitos 325  ==  [3,2,5]
digitos :: Integer -> [Integer]
digitos x = [read [d] | d <- show x]

armstrong :: [Integer]
armstrong = [n | n <- [1..], esArmstrong n]

-- La propiedad es
prop_Armstrong :: Integer -> Bool
prop_Armstrong n =
    not (esArmstrong (115132219018763992565095597973971522401 + abs n + 1))

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

import Test.QuickCheck

esArmstrong :: Integer -> Bool

esArmstrong x =

x == sum [d^n | d <- digitos x]

where n = length (show x)

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

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

digitos :: Integer -> [Integer]

digitos x = [read [d] | d <- show x]

armstrong :: [Integer]

armstrong = [n | n <- [1..], esArmstrong n]

-- La propiedad es

prop_Armstrong :: Integer -> Bool

prop_Armstrong n =

not (esArmstrong (115132219018763992565095597973971522401 + abs n + 1))

-- La comprobación es

-- λ> quickCheck prop_Armstrong

-- +++ OK, passed 100 tests.

Entero positivo con ciertas propiedades

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

El 6 de octubre, se propuso en el blog Gaussianos el siguiente problema

Demostrar que para todo entero positivo n, existe otro entero positivo que tiene las siguientes propiedades:

Tiene exactamente n dígitos.

Ninguno de sus dígitos es 0.

Es divisible por la suma de sus dígitos.

Definir la función

   especiales :: Integer -> [Integer]

1	especiales :: Integer -> [Integer]

tal que (especiales n) es la lista de los números enteros que cumplen las 3 propiedades anteriores para n. Por ejemplo,

   take 3 (especiales 2)  ==  [12,18,21]
   take 3 (especiales 3)  ==  [111,112,114]
   head (especiales 30)   ==  111111111111111111111111111125
   length (especiales 3)  ==  108
   null (especiales 1000) ==  False

take 3 (especiales 2) == [12,18,21]

take 3 (especiales 3) == [111,112,114]

head (especiales 30) == 111111111111111111111111111125

length (especiales 3) == 108

null (especiales 1000) == False

En el primer ejemplo, 12 es un número especial para 2 ya que tiene exactamente 2 dígitos, ninguno de sus dígitos es 0 y 12 es divisible por la suma de sus dígitos.

Soluciones

especiales :: Integer -> [Integer]
especiales n = [x | x <- [(10^n-1) `div` 9..10^n-1]
                  , esEspecial x]

esEspecial :: Integer -> Bool
esEspecial x = 
    notElem 0 digitos &&
    x `mod` sum digitos == 0        
    where digitos = [read [d] | d <- show x]

especiales :: Integer -> [Integer]

especiales n = [x | x <- [(10^n-1) `div` 9..10^n-1]

, esEspecial x]

esEspecial :: Integer -> Bool

esEspecial x =

notElem 0 digitos &&

x `mod` sum digitos == 0

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

Ampliación de una matriz sumando sus filas

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

Representamos las matrices mediante el tipo de dato

   type Matriz a = Array (Int,Int) a

1	type Matriz a = Array (Int,Int) a

Por ejemplo,

   ejM :: Matriz Int
   ejM = listArray ((1,1),(2,4)) [1,2,3,0,4,5,6,7]

1 2	ejM :: Matriz Int ejM = listArray ((1,1),(2,4)) [1,2,3,0,4,5,6,7]

representa la matriz

   |1 2 3 0|
   |4 5 6 7|

1 2	\|1 2 3 0\| \|4 5 6 7\|

Definir la función

   ampliada :: Num a => Matriz a -> Matriz a

1	ampliada :: Num a => Matriz a -> Matriz a

tal que (ampliada p) es la matriz obtenida al añadir una nueva fila a p cuyo elemento i-ésimo es la suma de la columna i-ésima de p. Por ejemplo,

   |1 2 3 0|        |1 2 3 0|
   |4 5 6 7| ==>    |4 5 6 7| 
                    |5 7 9 7|

|1 2 3 0| |1 2 3 0|

|4 5 6 7| ==> |4 5 6 7|

|5 7 9 7|

En Haskell,

   ghci> ampliada ejM
   array ((1,1),(3,4)) [((1,1),1),((1,2),2),((1,3),3),((1,4),0),
                        ((2,1),4),((2,2),5),((2,3),6),((2,4),7),
                        ((3,1),5),((3,2),7),((3,3),9),((3,4),7)]

ghci> ampliada ejM

array ((1,1),(3,4)) [((1,1),1),((1,2),2),((1,3),3),((1,4),0),

((2,1),4),((2,2),5),((2,3),6),((2,4),7),

((3,1),5),((3,2),7),((3,3),9),((3,4),7)]

Soluciones

import Data.Array

type Matriz a = Array (Int,Int) a

ejM :: Matriz Int
ejM = listArray ((1,1),(2,4)) [1,2,3,0,4,5,6,7]

ampliada :: Num a => Matriz a -> Matriz a
ampliada p = 
    array ((1,1),(m+1,n)) [((i,j),f i j) | i <- [1..m+1], j <- [1..n]]
    where (_,(m,n)) = bounds p
          f i j | i <= m    = p!(i,j)
                | otherwise = sum [p!(i,j) | i <- [1..m]]

import Data.Array

type Matriz a = Array (Int,Int) a

ejM :: Matriz Int

ejM = listArray ((1,1),(2,4)) [1,2,3,0,4,5,6,7]

ampliada :: Num a => Matriz a -> Matriz a

ampliada p =

array ((1,1),(m+1,n)) [((i,j),f i j) | i <- [1..m+1], j <- [1..n]]

where (_,(m,n)) = bounds p

f i j | i <= m = p!(i,j)

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

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)

Suma de conjuntos de polinomios

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

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

Definir la función

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

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

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

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

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

[18,8,6,17]

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

[1000000,1000000,1000000]

Soluciones

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

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

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

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

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

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

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

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

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

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

import Data.List (transpose)

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

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

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

sumaPolinomios1 [] = []

sumaPolinomios1 [xs] = xs

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

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

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

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

suma [] [] = []

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

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

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

sumaPolinomios2 [] = []

sumaPolinomios2 [xs] = xs

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

-- 3ª definición (por plegado)

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

sumaPolinomios3 = foldr1 (zipWith (+))

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

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

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

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

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

sumaPolinomios5 = map sum . transpose

-- 6ª definición (con array)

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

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

where m = length xss

n = length (head xss)

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

-- 7ª definición (con accumArray)

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

sumaPolinomios7 xss =

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

where n = length (head xss)

-- Comparación de eficiencia

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

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

-- (3.94 secs, 354713532 bytes)

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

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

-- (2.08 secs, 185506908 bytes)

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

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

-- (1.48 secs, 167026728 bytes)

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

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

-- (1.08 secs, 148564752 bytes)

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

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

-- (1.02 secs, 148062764 bytes)

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

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

-- (3.17 secs, 463756028 bytes)

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

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

-- (1.50 secs, 291699548 bytes)

Suma de una lista de vectores

PorJosé A. Alonso 19-enero-201530-noviembre-2015

Definir la función

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

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

tal que (sumaVec xss) es la suma de los vectores de xss. Por ejemplo,

   sumaVec [[4,7,3],[3,1,4],[2,2,5]]  ==  [9,10,12]
   sumaVec [[4,7],[3,3],[1,4],[2,5]]  ==  [10,19]

1 2	sumaVec [[4,7,3],[3,1,4],[2,2,5]] == [9,10,12] sumaVec [[4,7],[3,3],[1,4],[2,5]] == [10,19]

Soluciones

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

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

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

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

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

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

-- 5ª definición (con array)
-- =========================

sumaVec5 :: Num a => [[a]] -> [a]
sumaVec5 xss = [sum [p!(i,j) | i <- [1..m]] | j <- [1..n]] 
    where m = length xss
          n = length (head xss)
          p = listArray ((1,1),(m,n)) (concat xss)

import Data.List (transpose)

import Data.Array (listArray,(!))

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

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

sumaVec1 [] = []

sumaVec1 [xs] = xs

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

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

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

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

suma [] [] = []

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

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

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

sumaVec2 [] = []

sumaVec2 [xs] = xs

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

-- 3ª definición (por plegado)

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

sumaVec3 = foldr1 (zipWith (+))

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

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

sumaVec4 = map sum . transpose

-- 5ª definición (con array)

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

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

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

where m = length xss

n = length (head xss)

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

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í

Precio total

PorJosé A. Alonso 11-noviembre-20141-mayo-2016

Enunciado

-- Una función de precio determina el precio de cada elemento; por
-- ejemplo,
--    precioCI :: String -> Int
--    precioCI "leche"       = 10
--    precioCI "mantequilla" = 18
--    precioCI "patatas"     = 22
--    precioCI "chocolate"   = 16
-- 
-- Definir la función
--    precioTotal :: (String -> Int) -> [String] -> Int
-- tal que (precioTotal f xs) es el precio total de los elementos de xs
-- respecto de la función de precio f. Por ejemplo,
--    precioTotal precioCI ["leche", "leche", "mantequilla"]  ==  38
--    precioTotal precioCI ["chocolate", "mantequilla"]       ==  34

-- Una función de precio determina el precio de cada elemento; por

-- ejemplo,

-- precioCI :: String -> Int

-- precioCI "leche" = 10

-- precioCI "mantequilla" = 18

-- precioCI "patatas" = 22

-- precioCI "chocolate" = 16

-- Definir la función

-- precioTotal :: (String -> Int) -> [String] -> Int

-- tal que (precioTotal f xs) es el precio total de los elementos de xs

-- respecto de la función de precio f. Por ejemplo,

-- precioTotal precioCI ["leche", "leche", "mantequilla"] == 38

-- precioTotal precioCI ["chocolate", "mantequilla"] == 34

Soluciones

-- 1ª solución (por comprensión):
precioTotal1 :: (String -> Int) -> [String] -> Int
precioTotal1 f xs = sum [precioCI x | x <- xs]

-- 2ª solución (por recursión):
precioTotal2 :: (String -> Int) -> [String] -> Int
precioTotal2 f []     = 0
precioTotal2 f (x:xs) = f x + precioTotal2 f xs

-- 3ª solución (por plegado)
precioTotal3 :: (String -> Int) -> [String] -> Int
precioTotal3 f = foldr g 0
    where g x y = f x + y

-- 4ª solución (por plegado y lambda)
precioTotal4 :: (String -> Int) -> [String] -> Int
precioTotal4 f = foldr (\x y -> f x + y) 0

-- 5ª solución (por plegado y composición)
precioTotal5 :: (String -> Int) -> [String] -> Int
precioTotal5 f = foldr ((+) . f) 0

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

precioTotal1 :: (String -> Int) -> [String] -> Int

precioTotal1 f xs = sum [precioCI x | x <- xs]

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

precioTotal2 :: (String -> Int) -> [String] -> Int

precioTotal2 f [] = 0

precioTotal2 f (x:xs) = f x + precioTotal2 f xs

-- 3ª solución (por plegado)

precioTotal3 :: (String -> Int) -> [String] -> Int

precioTotal3 f = foldr g 0

where g x y = f x + y

-- 4ª solución (por plegado y lambda)

precioTotal4 :: (String -> Int) -> [String] -> Int

precioTotal4 f = foldr (\x y -> f x + y) 0

-- 5ª solución (por plegado y composición)

precioTotal5 :: (String -> Int) -> [String] -> Int

precioTotal5 f = foldr ((+) . f) 0

Distancia de Hamming

PorJosé A. Alonso 7-noviembre-201425-abril-2021

Enunciado

-- La distancia de Hamming entre dos listas es el número de posiciones
-- en que los correspondientes elementos son distintos. Por ejemplo, la
-- distancia de Hamming entre "roma" y "loba" es 2 (porque hay 2
-- posiciones en las que los elementos correspondientes son distintos:
-- la 1ª y la 3ª). 
-- 
-- Definir la función
--    distancia :: Eq a => [a] -> [a] -> Int
-- tal que (distancia xs ys) es la distancia de Hamming entre xs e
-- ys. Por ejemplo,
--    distancia "romano" "comino"  ==  2
--    distancia "romano" "camino"  ==  3
--    distancia "roma"   "comino"  ==  2
--    distancia "roma"   "camino"  ==  3
--    distancia "romano" "ron"     ==  1
--    distancia "romano" "cama"    ==  2
--    distancia "romano" "rama"    ==  1
--
-- Comprobar con QuickCheck si la distancia de Hamming tiene la
-- siguiente propiedad
--    distancia(xs,ys) = 0 si, y sólo si, xs = ys
-- y, en el caso de que no se verifique, modificar ligeramente la
-- propiedad para obtener una condición necesaria y suficiente de 
-- distancia(xs,ys) = 0.

-- La distancia de Hamming entre dos listas es el número de posiciones

-- en que los correspondientes elementos son distintos. Por ejemplo, la

-- distancia de Hamming entre "roma" y "loba" es 2 (porque hay 2

-- posiciones en las que los elementos correspondientes son distintos:

-- la 1ª y la 3ª).

-- Definir la función

-- distancia :: Eq a => [a] -> [a] -> Int

-- tal que (distancia xs ys) es la distancia de Hamming entre xs e

-- ys. Por ejemplo,

-- distancia "romano" "comino" == 2

-- distancia "romano" "camino" == 3

-- distancia "roma" "comino" == 2

-- distancia "roma" "camino" == 3

-- distancia "romano" "ron" == 1

-- distancia "romano" "cama" == 2

-- distancia "romano" "rama" == 1

-- Comprobar con QuickCheck si la distancia de Hamming tiene la

-- siguiente propiedad

-- distancia(xs,ys) = 0 si, y sólo si, xs = ys

-- y, en el caso de que no se verifique, modificar ligeramente la

-- propiedad para obtener una condición necesaria y suficiente de

-- distancia(xs,ys) = 0.

Soluciones

import Test.QuickCheck

-- 1ª definición (por comprensión):
distancia :: Eq a => [a] -> [a] -> Int
distancia xs ys = sum [1 | (x,y) <- zip xs ys, x /= y] 

-- 2ª definición (por recursión):
distancia2 :: Eq a => [a] -> [a] -> Int
distancia2 [] ys = 0
distancia2 xs [] = 0
distancia2 (x:xs) (y:ys) | x /= y    = 1 + distancia2 xs ys
                         | otherwise = distancia2 xs ys

-- La propiedad es
prop_distancia1 :: [Int] -> [Int] -> Bool
prop_distancia1 xs ys =
    (distancia xs ys == 0) == (xs == ys)

-- La comprobación es
--    ghci> quickCheck prop_distancia1
--    *** Failed! Falsifiable (after 2 tests and 1 shrink): 
--    []
--    [1]
-- En efecto,
--    ghci> distancia [] [1] == 0
--    True
--    ghci> [] == [1]
--    False

-- La primera modificación es restringir la propiedad a lista de igual
-- longitud: 
prop_distancia2 :: [Int] -> [Int] -> Property
prop_distancia2 xs ys =
    length xs == length ys ==> 
    (distancia xs ys == 0) == (xs == ys)

-- La comprobación es
--    ghci> quickCheck prop_distancia2
--    *** Gave up! Passed only 33 tests.

-- Nota. La propiedad se verifica, pero al ser la condición demasiado
-- restringida sólo 33 de los casos la cumple.

-- La segunda restricción es limitar las listas a la longitud de la más
-- corta: 
prop_distancia3 :: [Int] -> [Int] -> Bool
prop_distancia3 xs ys =
    (distancia xs ys == 0) == (take n xs == take n ys)
    where n = min (length xs) (length ys)

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

import Test.QuickCheck

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

distancia :: Eq a => [a] -> [a] -> Int

distancia xs ys = sum [1 | (x,y) <- zip xs ys, x /= y]

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

distancia2 :: Eq a => [a] -> [a] -> Int

distancia2 [] ys = 0

distancia2 xs [] = 0

distancia2 (x:xs) (y:ys) | x /= y = 1 + distancia2 xs ys

| otherwise = distancia2 xs ys

-- La propiedad es

prop_distancia1 :: [Int] -> [Int] -> Bool

prop_distancia1 xs ys =

(distancia xs ys == 0) == (xs == ys)

-- La comprobación es

-- ghci> quickCheck prop_distancia1

-- *** Failed! Falsifiable (after 2 tests and 1 shrink):

-- []

-- [1]

-- En efecto,

-- ghci> distancia [] [1] == 0

-- True

-- ghci> [] == [1]

-- False

-- La primera modificación es restringir la propiedad a lista de igual

-- longitud:

prop_distancia2 :: [Int] -> [Int] -> Property

prop_distancia2 xs ys =

length xs == length ys ==>

(distancia xs ys == 0) == (xs == ys)

-- La comprobación es

-- ghci> quickCheck prop_distancia2

-- *** Gave up! Passed only 33 tests.

-- Nota. La propiedad se verifica, pero al ser la condición demasiado

-- restringida sólo 33 de los casos la cumple.

-- La segunda restricción es limitar las listas a la longitud de la más

-- corta:

prop_distancia3 :: [Int] -> [Int] -> Bool

prop_distancia3 xs ys =

(distancia xs ys == 0) == (take n xs == take n ys)

where n = min (length xs) (length ys)

-- La comprobación es

-- ghci> quickCheck prop_distancia3

-- +++ OK, passed 100 tests.

Suma de todos los anteriores.

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

Enunciado

-- Definir la función
--    sumaAnteriores :: [Integer] -> Bool
-- tal que (sumaAnteriores xs) se verifica si cada elemento de la lista
-- xs (excepto el primero) es la suma de sus anteriores elementos en la
-- lista. Por ejemplo,  
--    sumaAnteriores [3,3,6,12]  ==  True
--    sumaAnteriores [3,3,7,10]  ==  False
--    sumaAnteriores [3]         ==  True
--    sumaAnteriores []          ==  True

-- Definir la función

-- sumaAnteriores :: [Integer] -> Bool

-- tal que (sumaAnteriores xs) se verifica si cada elemento de la lista

-- xs (excepto el primero) es la suma de sus anteriores elementos en la

-- lista. Por ejemplo,

-- sumaAnteriores [3,3,6,12] == True

-- sumaAnteriores [3,3,7,10] == False

-- sumaAnteriores [3] == True

-- sumaAnteriores [] == True

Soluciones

import Test.QuickCheck

-- 1ª definición (por recursión):
sumaAnteriores :: [Integer] -> Bool
sumaAnteriores xs = aux (reverse xs)
    where aux []     = True
          aux [_]    = True
          aux (x:xs) = x == sum xs && aux xs

-- 2ª definición (por comprensión):
sumaAnteriores2 :: [Integer] -> Bool
sumaAnteriores2 (x:y:zs) = 
    x == y && and [b == 2*a | (a,b) <- adyacentes (y:zs)]
    where adyacentes xs = zip xs (tail xs)
sumaAnteriores2 _ = True

-- La propiedad de equivalencia es
prop_equiv_sumaAnteriores :: [Integer] -> Bool
prop_equiv_sumaAnteriores xs = 
    sumaAnteriores xs == sumaAnteriores2 xs

import Test.QuickCheck

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

sumaAnteriores :: [Integer] -> Bool

sumaAnteriores xs = aux (reverse xs)

where aux [] = True

aux [_] = True

aux (x:xs) = x == sum xs && aux xs

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

sumaAnteriores2 :: [Integer] -> Bool

sumaAnteriores2 (x:y:zs) =

x == y && and [b == 2*a | (a,b) <- adyacentes (y:zs)]

where adyacentes xs = zip xs (tail xs)

sumaAnteriores2 _ = True

-- La propiedad de equivalencia es

prop_equiv_sumaAnteriores :: [Integer] -> Bool

prop_equiv_sumaAnteriores xs =

sumaAnteriores xs == sumaAnteriores2 xs

Órbita prima

PorJosé A. Alonso 13-junio-20141-mayo-2016

Enunciado

-- La órbita prima de un número n es la sucesión construida de la
-- siguiente forma: 
--    * si n es compuesto su órbita no tiene elementos 
--    * si n es primo, entonces n está en su órbita; además, sumamos n y
--      sus dígitos, si el resultado es un número primo repetimos el
--      proceso hasta obtener un número compuesto. 
-- Por ejemplo, con el 11 podemos repetir el proceso dos veces
--    13 = 11+1+1
--    17 = 13+1+3
-- Así, la órbita prima de 11 es 11, 13, 17. 
-- 
-- Definir la función
--    orbita :: Integer -> [Integer]
-- tal que (orbita n) es la órbita prima de n. Por ejemplo,
--    orbita 11 == [11,13,17]
--    orbita 59 == [59,73,83]
-- Calcular el menor número cuya órbita prima tiene más de 3 elementos.

-- La órbita prima de un número n es la sucesión construida de la

-- siguiente forma:

-- * si n es compuesto su órbita no tiene elementos

-- * si n es primo, entonces n está en su órbita; además, sumamos n y

-- sus dígitos, si el resultado es un número primo repetimos el

-- proceso hasta obtener un número compuesto.

-- Por ejemplo, con el 11 podemos repetir el proceso dos veces

-- 13 = 11+1+1

-- 17 = 13+1+3

-- Así, la órbita prima de 11 es 11, 13, 17.

-- Definir la función

-- orbita :: Integer -> [Integer]

-- tal que (orbita n) es la órbita prima de n. Por ejemplo,

-- orbita 11 == [11,13,17]

-- orbita 59 == [59,73,83]

-- Calcular el menor número cuya órbita prima tiene más de 3 elementos.

Soluciones

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

orbita1 :: Integer -> [Integer]
orbita1 n | not (esPrimo n) = []
          | otherwise       = n : orbita1 (n + sum (cifras n))

esPrimo :: Integer -> Bool
esPrimo n = [x | x <- [1..n], n `rem` x == 0] == [1,n] 

cifras :: Integer -> [Integer]
cifras n = [read [x]| x <- show n]

-- El cálculo es
--    ghci> head [x | x <- [1,3..], length (orbita x) > 3]
--    277
-- 
--    ghci> orbita 277
--    [277,293,307,317]

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

orbita2 :: Integer -> [Integer]
orbita2 n = takeWhile esPrimo (iterate f n)
    where f x = x + sum (cifras x)

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

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

orbita1 :: Integer -> [Integer]

orbita1 n | not (esPrimo n) = []

| otherwise = n : orbita1 (n + sum (cifras n))

esPrimo :: Integer -> Bool

esPrimo n = [x | x <- [1..n], n `rem` x == 0] == [1,n]

cifras :: Integer -> [Integer]

cifras n = [read [x]| x <- show n]

-- El cálculo es

-- ghci> head [x | x <- [1,3..], length (orbita x) > 3]

-- 277

-- ghci> orbita 277

-- [277,293,307,317]

-- 2ª definición (con iterate)

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

orbita2 :: Integer -> [Integer]

orbita2 n = takeWhile esPrimo (iterate f n)

where f x = x + sum (cifras x)

Suma de elementos en posiciones dadas

Soluciones

Año cúbico

Soluciones

Los números de Smith

Soluciones

Los números de Armstrong

Soluciones

Entero positivo con ciertas propiedades

Soluciones

Ampliación de una matriz sumando sus filas

Soluciones

Números de suma prima hereditarios por la derecha

Soluciones

Suma de conjuntos de polinomios

Soluciones

Suma de una lista de vectores

Soluciones

Máxima suma de los segmentos

Soluciones

Referencias

Precio total

Enunciado

Soluciones

Distancia de Hamming

Enunciado

Soluciones

Suma de todos los anteriores.

Enunciado

Soluciones

Órbita prima

Enunciado

Soluciones

Entradas recientes

Buscar

Correo electrónico