José A. Alonso

Suma de cadenas

PorJosé A. Alonso 27-enero-202223-febrero-2022

Definir la función

   sumaCadenas :: String -> String -> String

1	sumaCadenas :: String -> String -> String

tal que (sumaCadenas xs ys) es la cadena formada por el número entero que es la suma de los números enteros cuyas cadenas que lo representan son xs e ys; además, se supone que la cadena vacía representa al cero. Por ejemplo,

   sumaCadenas "2"   "6"  == "8"
   sumaCadenas "14"  "2"  == "16"
   sumaCadenas "14"  "-5" == "9"
   sumaCadenas "-14" "-5" == "-19"
   sumaCadenas "5"   "-5" == "0"
   sumaCadenas ""    "5"  == "5"
   sumaCadenas "6"   ""   == "6"
   sumaCadenas ""    ""   == "0"

sumaCadenas "2" "6" == "8"

sumaCadenas "14" "2" == "16"

sumaCadenas "14" "-5" == "9"

sumaCadenas "-14" "-5" == "-19"

sumaCadenas "5" "-5" == "0"

sumaCadenas "" "5" == "5"

sumaCadenas "6" "" == "6"

sumaCadenas "" "" == "0"

Soluciones

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

sumaCadenas1 :: String -> String -> String
sumaCadenas1 xs ys =
  show (sum (map read (filter (not . null) [xs, ys])))

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

sumaCadenas2 :: String -> String -> String
sumaCadenas2 =
  ((show . sum . map read . filter (not . null)) .) . (. return) . (:)

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

sumaCadenas3 :: String -> String -> String
sumaCadenas3 "" "" = "0"
sumaCadenas3 "" ys = ys
sumaCadenas3 xs "" = xs
sumaCadenas3 xs ys = show (read xs + read ys)

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

sumaCadenas4 :: String -> String -> String
sumaCadenas4 xs ys = show (numero xs + numero ys)

-- (numero xs) es el número entero representado por la cadena xs
-- suponiendo que la cadena vacía representa al cero.. Por ejemplo,
--    numero "12"   ==  12
--    numero "-12"  ==  -12
--    numero "0"    ==  0
--    numero ""     ==  0
numero :: String -> Int
numero "" = 0
numero xs = read xs

-- 1ª solución

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

sumaCadenas1 :: String -> String -> String

sumaCadenas1 xs ys =

show (sum (map read (filter (not . null) [xs, ys])))

-- 2ª solución

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

sumaCadenas2 :: String -> String -> String

sumaCadenas2 =

((show . sum . map read . filter (not . null)) .) . (. return) . (:)

-- 3ª solución

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

sumaCadenas3 :: String -> String -> String

sumaCadenas3 "" "" = "0"

sumaCadenas3 "" ys = ys

sumaCadenas3 xs "" = xs

sumaCadenas3 xs ys = show (read xs + read ys)

-- 4ª solución

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

sumaCadenas4 :: String -> String -> String

sumaCadenas4 xs ys = show (numero xs + numero ys)

-- (numero xs) es el número entero representado por la cadena xs

-- suponiendo que la cadena vacía representa al cero.. Por ejemplo,

-- numero "12" == 12

-- numero "-12" == -12

-- numero "0" == 0

-- numero "" == 0

numero :: String -> Int

numero "" = 0

numero xs = read xs

El código se encuentra en GitHub.

Cuadrado más cercano

PorJosé A. Alonso 26-enero-202216-marzo-2022

Definir la función

   cuadradoCercano :: Integer -> Integer

1	cuadradoCercano :: Integer -> Integer

tal que (cuadradoCercano n) es el número cuadrado más cercano a n, donde n es un entero positivo. Por ejemplo,

   cuadradoCercano 2       == 1
   cuadradoCercano 6       == 4
   cuadradoCercano 8       == 9
   cuadradoCercano (10^46) == 10000000000000000000000000000000000000000000000

cuadradoCercano 2 == 1

cuadradoCercano 6 == 4

cuadradoCercano 8 == 9

cuadradoCercano (10^46) == 10000000000000000000000000000000000000000000000

Soluciones

import Test.QuickCheck

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

cuadradoCercano1 :: Integer -> Integer
cuadradoCercano1 n
  | n - b < c - n = b
  | otherwise     = c
  where a = raizEntera1 n
        b = a^2
        c = (a+1)^2

-- (raizEntera x) es el mayor entero cuyo cuadrado no es mayor que
-- x. Por ejemplo,
--    raizEntera 8   ==  2
--    raizEntera 9   ==  3
--    raizEntera 10  ==  3
raizEntera1 :: Integer -> Integer
raizEntera1 x =
  last (takeWhile (\n -> n^2 <= x) [1..])

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

cuadradoCercano2 :: Integer -> Integer
cuadradoCercano2 n
  | n - b < c - n = b
  | otherwise     = c
  where a = raizEntera2 n
        b = a^2
        c = (a+1)^2

raizEntera2 :: Integer -> Integer
raizEntera2 x = aux (1,x)
    where aux (a,b) | d == x    = c
                    | c == a    = c
                    | x <= d    = aux (a,c)
                    | otherwise = aux (c,b)
            where c = (a+b) `div` 2
                  d = c^2

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

cuadradoCercano3 :: Integer -> Integer
cuadradoCercano3 n
  | n - b < c - n = b
  | otherwise     = c
  where a = raizEntera3 n
        b = a^2
        c = (a+1)^2

raizEntera3 :: Integer -> Integer
raizEntera3 0 = 0
raizEntera3 1 = 1
raizEntera3 n = until aceptable mejora n
  where mejora x    = (x + n `div` x) `div` 2
        aceptable x = x^2 <= n

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

cuadradoCercano4 :: Integer -> Integer
cuadradoCercano4 = (^ 2) . round . sqrt . fromIntegral

-- Equivalencia de las definiciones
-- ================================

-- La propiedad es
prop_cuadradoCercano :: Positive Integer -> Bool
prop_cuadradoCercano (Positive x) =
  all (== cuadradoCercano1 x)
      [cuadradoCercano2 x,
       cuadradoCercano3 x,
       cuadradoCercano4 x]

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

-- Aunque ha pasado los 100 tests, las definiciones no son
-- equivalentes. Por ejemplo,
--    λ> cuadradoCercano3 (10^46) == cuadradoCercano (10^46)
--    False
--    λ> cuadradoCercano3 (10^46)
--    9999999999999998322278400000000070368744177664
--    λ> cuadradoCercano (10^46)
--    10000000000000000000000000000000000000000000000

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

-- La comparación es
--    λ> cuadradoCercano1 (10^14)
--    100000000000000
--    (4.59 secs, 5,920,475,784 bytes)
--    λ> cuadradoCercano2 (10^14)
--    100000000000000
--    (0.01 secs, 512,472 bytes)
--    λ> cuadradoCercano3 (10^14)
--    100000000000000
--    (0.01 secs, 494,248 bytes)
--    λ> cuadradoCercano4 (10^14)
--    100000000000000
--    (0.01 secs, 475,152 bytes)
--
--    λ> length (show (cuadradoCercano2 (10^20000)))
--    20001
--    (3.94 secs, 1,446,675,504 bytes)
--    λ> length (show (cuadradoCercano3 (10^20000)))
--    20001
--    (4.50 secs, 926,647,904 bytes)

100

101

102

103

104

105

106

107

108

109

110

111

112

113

import Test.QuickCheck

-- 1ª solución

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

cuadradoCercano1 :: Integer -> Integer

cuadradoCercano1 n

| n - b < c - n = b

| otherwise = c

where a = raizEntera1 n

b = a^2

c = (a+1)^2

-- (raizEntera x) es el mayor entero cuyo cuadrado no es mayor que

-- x. Por ejemplo,

-- raizEntera 8 == 2

-- raizEntera 9 == 3

-- raizEntera 10 == 3

raizEntera1 :: Integer -> Integer

raizEntera1 x =

last (takeWhile (\n -> n^2 <= x) [1..])

-- 2ª solución

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

cuadradoCercano2 :: Integer -> Integer

cuadradoCercano2 n

| n - b < c - n = b

| otherwise = c

where a = raizEntera2 n

b = a^2

c = (a+1)^2

raizEntera2 :: Integer -> Integer

raizEntera2 x = aux (1,x)

where aux (a,b) | d == x = c

| c == a = c

| x <= d = aux (a,c)

| otherwise = aux (c,b)

where c = (a+b) `div` 2

d = c^2

-- 3ª solución

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

cuadradoCercano3 :: Integer -> Integer

cuadradoCercano3 n

| n - b < c - n = b

| otherwise = c

where a = raizEntera3 n

b = a^2

c = (a+1)^2

raizEntera3 :: Integer -> Integer

raizEntera3 0 = 0

raizEntera3 1 = 1

raizEntera3 n = until aceptable mejora n

where mejora x = (x + n `div` x) `div` 2

aceptable x = x^2 <= n

-- 4ª solución

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

cuadradoCercano4 :: Integer -> Integer

cuadradoCercano4 = (^ 2) . round . sqrt . fromIntegral

-- Equivalencia de las definiciones

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

-- La propiedad es

prop_cuadradoCercano :: Positive Integer -> Bool

prop_cuadradoCercano (Positive x) =

all (== cuadradoCercano1 x)

[cuadradoCercano2 x,

cuadradoCercano3 x,

cuadradoCercano4 x]

-- La comprobación es

-- λ> quickCheck prop_cuadradoCercano

-- +++ OK, passed 100 tests.

-- Aunque ha pasado los 100 tests, las definiciones no son

-- equivalentes. Por ejemplo,

-- λ> cuadradoCercano3 (10^46) == cuadradoCercano (10^46)

-- False

-- λ> cuadradoCercano3 (10^46)

-- 9999999999999998322278400000000070368744177664

-- λ> cuadradoCercano (10^46)

-- 10000000000000000000000000000000000000000000000

-- Comparación de eficiencia

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

-- La comparación es

-- λ> cuadradoCercano1 (10^14)

-- 100000000000000

-- (4.59 secs, 5,920,475,784 bytes)

-- λ> cuadradoCercano2 (10^14)

-- 100000000000000

-- (0.01 secs, 512,472 bytes)

-- λ> cuadradoCercano3 (10^14)

-- 100000000000000

-- (0.01 secs, 494,248 bytes)

-- λ> cuadradoCercano4 (10^14)

-- 100000000000000

-- (0.01 secs, 475,152 bytes)

-- λ> length (show (cuadradoCercano2 (10^20000)))

-- 20001

-- (3.94 secs, 1,446,675,504 bytes)

-- λ> length (show (cuadradoCercano3 (10^20000)))

-- 20001

-- (4.50 secs, 926,647,904 bytes)

El código se encuentra en GitHub

La elaboración de las soluciones se muestra en el siguiente vídeo:

9º curso de Exercitium (2021-22)

PorJosé A. Alonso 26-enero-202226-enero-2022

Hoy (26 de enero de 2022) comienza el noveno curso de Exercitium con los mismos objetivos

complementar el aprendizaje del curso de programación funcional con Haskell,
mantener el hábito de resolver problemas usando programación funcional con Haskell.

También el procedimiento es el mismo que en los cursos anteriores:

diariamente se propone un nuevo ejercicio,
en los comentarios se pueden escribir distintas soluciones
a los siete días de la propuesta, se publican las soluciones seleccionadas.

Tanto la publicación del enunciado como la solución se anuncian en Twitter.

En cada curso, los contenidos de los ejercicios avanzan conforme se iban introduciendo en el curso.

En la siguiente tabla se resume los cursos anteriores, donde

en la 1ª columna hay un enlace al diario de clase del curso de (las entradas están en orden cronológico inverso),
en la 2ª un enlace al primer ejercicio del curso,
en la 3ª un enlace al último ejercicio del curso y
en la 4ª el número de ejercicios propuesto en el curso.

La tabla es

Curso	Desde	Hasta	Ejercicios
2013-14	21-abril-2014	25-julio-2014	70
2014-15	30-octubre-2014	26-junio-2015	171
2015-16	21-octubre-2015	02-junio-2016	176
2016-17	03-noviembre-2016	09-junio-2017	149
2017-18	03-noviembre-2017	12-junio-2018	151
2018-19	09-noviembre-2018	10-junio-2019	143
2019-20	11-noviembre-2019	05-junio-2020	176
2020-21	12-enero-2021	24-junio-2021	110

En la tabla anterior el último enlace a los diarios de los cursos es el de 2019-10 ya que es el último curso que impartí antes de jubilarme. Por ello, aunque mantenga la misma dinámica, el número de soluciones de los alumnos de la asignatura sea menor.

Sucesiones conteniendo al producto de consecutivos

PorJosé A. Alonso 24-junio-202126-enero-2022

El enunciado de un problema para la IMO (Olimpiada Internacional de Matemáticas) de 1984 es

Sea c un entero positivo. La sucesión f(n) está definida por

f(1) = 1, f(2) = c, f(n+1) = 2f(n) – f(n-1) + 2 (n ≥ 2).

Demostrar que para cada k ∈ N exist un r ∈ N tal que f(k)f(k+1) = f(r).

Definir la función

   sucesion :: Integer -> [Integer]

1	sucesion :: Integer -> [Integer]

tal que los elementos de (sucesion c) son los términos de la suceción f(n) definida en el enunciado del problema. Por ejemplo,

   take 7 (sucesion 2)   ==  [1,2,5,10,17,26,37]
   take 7 (sucesion 3)   ==  [1,3,7,13,21,31,43]
   take 7 (sucesion 4)   ==  [1,4,9,16,25,36,49]
   sucesion 2 !! 30      ==  901
   sucesion 3 !! 30      ==  931
   sucesion 4 !! 30      ==  961
   sucesion 2 !! (10^2)  ==  10001
   sucesion 2 !! (10^3)  ==  1000001
   sucesion 2 !! (10^4)  ==  100000001
   sucesion 2 !! (10^5)  ==  10000000001
   sucesion 2 !! (10^6)  ==  1000000000001
   sucesion 2 !! (10^7)  ==  100000000000001
   sucesion 3 !! (10^7)  ==  100000010000001
   sucesion 4 !! (10^7)  ==  100000020000001
   sucesion 2 !! (10^8)  ==  10000000000000001
   sucesion 3 !! (10^8)  ==  10000000100000001
   sucesion 4 !! (10^8)  ==  10000000200000001
   sucesion 2 !! (10^9)  ==  1000000000000000001

take 7 (sucesion 2) == [1,2,5,10,17,26,37]

take 7 (sucesion 3) == [1,3,7,13,21,31,43]

take 7 (sucesion 4) == [1,4,9,16,25,36,49]

sucesion 2 !! 30 == 901

sucesion 3 !! 30 == 931

sucesion 4 !! 30 == 961

sucesion 2 !! (10^2) == 10001

sucesion 2 !! (10^3) == 1000001

sucesion 2 !! (10^4) == 100000001

sucesion 2 !! (10^5) == 10000000001

sucesion 2 !! (10^6) == 1000000000001

sucesion 2 !! (10^7) == 100000000000001

sucesion 3 !! (10^7) == 100000010000001

sucesion 4 !! (10^7) == 100000020000001

sucesion 2 !! (10^8) == 10000000000000001

sucesion 3 !! (10^8) == 10000000100000001

sucesion 4 !! (10^8) == 10000000200000001

sucesion 2 !! (10^9) == 1000000000000000001

Comprobar con QuickCheck que para cada k ∈ N existe un r ∈ N tal que f(k)f(k+1) = f(r).

Soluciones

import Test.QuickCheck (Property, (==>), quickCheck)

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

sucesion :: Integer -> [Integer]
sucesion c =
  map (termino c) [1..]

termino :: Integer -> Integer -> Integer
termino c 1 = 1
termino c 2 = c
termino c n = 2 * termino c (n-1) - termino c (n-2) + 2

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

sucesion2 :: Integer -> [Integer]
sucesion2 c =
  1 : c : [2*y-x+2 | (x,y) <- zip (sucesion3 c) (tail (sucesion3 c))]

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

sucesion3 :: Integer -> [Integer]
sucesion3 c =
  map (termino3 c) [1..]

termino3 :: Integer -> Integer -> Integer
termino3 c 1 = 1
termino3 c 2 = c
termino3 c n = n^2 + b*n - b
  where b = c - 4

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

-- La comparación es
--    λ> sucesion 2 !! 32
--    1025
--    (3.95 secs, 1,991,299,256 bytes)
--    λ> sucesion2 2 !! 32
--    1025
--    (0.01 secs, 119,856 bytes)
--    λ> sucesion3 2 !! 32
--    1025
--    (0.01 secs, 111,176 bytes)
--
--    λ> sucesion2 2 !! (10^7)
--    100000000000001
--    (2.26 secs, 5,200,111,128 bytes)
--    λ> sucesion3 2 !! (10^7)
--    100000000000001
--    (0.27 secs, 1,600,111,568 bytes)

-- Comprobación de equivalencia
-- ============================

-- La propiedad es
prop_equivalencia :: Integer -> Int -> Property
prop_equivalencia c k =
  c > 0 && k >= 0 ==>
  take 20 (sucesion c) == take 20 (sucesion2 c) &&
  sucesion2 c !! k == sucesion3 c !! k

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

-- Propiedad
-- =========

-- La propiedad es
prop_sucesion :: Integer -> Int -> Property
prop_sucesion c k =
  c > 0 && k >= 0 ==>
  (ys !! k) `elem` xs
  where xs = sucesion2 c
        ys = zipWith (*) xs (tail xs)

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

import Test.QuickCheck (Property, (==>), quickCheck)

-- 1ª solución

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

sucesion :: Integer -> [Integer]

sucesion c =

map (termino c) [1..]

termino :: Integer -> Integer -> Integer

termino c 1 = 1

termino c 2 = c

termino c n = 2 * termino c (n-1) - termino c (n-2) + 2

-- 2ª solución

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

sucesion2 :: Integer -> [Integer]

sucesion2 c =

1 : c : [2*y-x+2 | (x,y) <- zip (sucesion3 c) (tail (sucesion3 c))]

-- 2ª solución

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

sucesion3 :: Integer -> [Integer]

sucesion3 c =

map (termino3 c) [1..]

termino3 :: Integer -> Integer -> Integer

termino3 c 1 = 1

termino3 c 2 = c

termino3 c n = n^2 + b*n - b

where b = c - 4

-- Comparación de eficiencia

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

-- La comparación es

-- λ> sucesion 2 !! 32

-- 1025

-- (3.95 secs, 1,991,299,256 bytes)

-- λ> sucesion2 2 !! 32

-- 1025

-- (0.01 secs, 119,856 bytes)

-- λ> sucesion3 2 !! 32

-- 1025

-- (0.01 secs, 111,176 bytes)

-- λ> sucesion2 2 !! (10^7)

-- 100000000000001

-- (2.26 secs, 5,200,111,128 bytes)

-- λ> sucesion3 2 !! (10^7)

-- 100000000000001

-- (0.27 secs, 1,600,111,568 bytes)

-- Comprobación de equivalencia

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

-- La propiedad es

prop_equivalencia :: Integer -> Int -> Property

prop_equivalencia c k =

c > 0 && k >= 0 ==>

take 20 (sucesion c) == take 20 (sucesion2 c) &&

sucesion2 c !! k == sucesion3 c !! k

-- La comprobación es

-- λ> quickCheck prop_equivalencia

-- +++ OK, passed 100 tests.

-- Propiedad

-- =========

-- La propiedad es

prop_sucesion :: Integer -> Int -> Property

prop_sucesion c k =

c > 0 && k >= 0 ==>

(ys !! k) `elem` xs

where xs = sucesion2 c

ys = zipWith (*) xs (tail xs)

-- La comprobación es

-- λ> quickCheck prop_sucesion

-- +++ OK, passed 100 tests.

En los comentarios se pueden escribir otras soluciones, escribiendo el código entre una línea con <pre lang="haskell"> y otra con </pre>

Números superabundantes

PorJosé A. Alonso 22-junio-202126-enero-2022

El enunciado de un problema para la IMO (Olimpiada Internacional de Matemáticas) de 1983 es

Sea n un número entero positivo. Sea σ(n) la suma de los divisores positivos de n (incluyendo al 1 y al n). Se dice que un entero m ≥ 1 es superabundante (P. Erdös, 1944) si ∀k ∈ {1, 2, …, m-1}, σ(m)/m > σ(k)/k. Demostrar que esisten infinitos números superabundantes.

Definir la lista

   superabundantes :: [Integer]

1	superabundantes :: [Integer]

cuyos elementos son los números superabundantes. Por ejemplo,

   take 7 superabundantes == [1,2,4,6,12,24,36]
   superabundantes !! 25  ==  166320

1 2	take 7 superabundantes == [1,2,4,6,12,24,36] superabundantes !! 25 == 166320

Soluciones

import Data.Numbers.Primes (primeFactors)
import Data.List (genericLength, group)
import Data.Ratio ((%))

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

superabundantes :: [Integer]
superabundantes =
  filter esSuperabundante [1..]

-- (esSuperabundante n) se verifica si n es superabundante. Por ejemplo,
--    esSuperabundante 4  ==  True
--    esSuperabundante 5  ==  False
--    esSuperabundante 6  ==  True
esSuperabundante :: Integer -> Bool
esSuperabundante n =
  and [k * n' > n * sumaDivisores k | k <- [1..n-1]]
  where n' = sumaDivisores n

-- (sumaDivisores n) es la suma de los divisores de n. Por ejemplo.
--      sumaDivisores 35  ==  48
sumaDivisores :: Integer -> Integer
sumaDivisores x =
  product [(p^(e+1)-1) `div` (p-1) | (p,e) <- factorizacion x]

-- (factorizacion x) es la lista de las bases y exponentes de la
-- descomposición prima de x. Por ejemplo,
--    factorizacion 600  ==  [(2,3),(3,1),(5,2)]
factorizacion :: Integer -> [(Integer,Integer)]
factorizacion = map primeroYlongitud . group . primeFactors

-- (primeroYlongitud xs) es el par formado por el primer elemento de xs
-- y la longitud de xs. Por ejemplo,
--    primeroYlongitud [3,2,5,7] == (3,4)
primeroYlongitud :: [a] -> (a,Integer)
primeroYlongitud (x:xs) = (x, 1 + genericLength xs)
primeroYlongitud _      = error "No tiene elementos"

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

superabundantes2 :: [Integer]
superabundantes2 =
  [n | (n,a,b) <- zip3 [1..] cocientes maximosCocientes,
        a == b]
-- cocientes es la lista de los cocientes σ(k)/k. Por ejemplo,
--    λ> take 7 cocientes
--    [1 % 1,3 % 2,4 % 3,7 % 4,6 % 5,2 % 1,8 % 7]
cocientes :: [Rational]
cocientes =
  [sumaDivisores n % n | n <- [1..]]

-- maximosCocientes es la lista de los máximos de los cocientes
-- σ(k)/k. Por ejemplo,
--    λ> take 7 maximosCocientes
--    [1 % 1,3 % 2,3 % 2,7 % 4,7 % 4,2 % 1,2 % 1]
maximosCocientes :: [Rational]
maximosCocientes = scanl1 max cocientes

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

-- La comparación es
--    λ> superabundantes !! 22
--    27720
--    (6.72 secs, 11,453,705,704 bytes)
--    λ> superabundantes2 !! 22
--    27720
--    (0.54 secs, 902,054,096 bytes)

import Data.Numbers.Primes (primeFactors)

import Data.List (genericLength, group)

import Data.Ratio ((%))

-- 1ª solución

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

superabundantes :: [Integer]

superabundantes =

filter esSuperabundante [1..]

-- (esSuperabundante n) se verifica si n es superabundante. Por ejemplo,

-- esSuperabundante 4 == True

-- esSuperabundante 5 == False

-- esSuperabundante 6 == True

esSuperabundante :: Integer -> Bool

esSuperabundante n =

and [k * n' > n * sumaDivisores k | k <- [1..n-1]]

where n' = sumaDivisores n

-- (sumaDivisores n) es la suma de los divisores de n. Por ejemplo.

-- sumaDivisores 35 == 48

sumaDivisores :: Integer -> Integer

sumaDivisores x =

product [(p^(e+1)-1) `div` (p-1) | (p,e) <- factorizacion x]

-- (factorizacion x) es la lista de las bases y exponentes de la

-- descomposición prima de x. Por ejemplo,

-- factorizacion 600 == [(2,3),(3,1),(5,2)]

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

factorizacion = map primeroYlongitud . group . primeFactors

-- (primeroYlongitud xs) es el par formado por el primer elemento de xs

-- y la longitud de xs. Por ejemplo,

-- primeroYlongitud [3,2,5,7] == (3,4)

primeroYlongitud :: [a] -> (a,Integer)

primeroYlongitud (x:xs) = (x, 1 + genericLength xs)

primeroYlongitud _ = error "No tiene elementos"

-- 2ª solución

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

superabundantes2 :: [Integer]

superabundantes2 =

[n | (n,a,b) <- zip3 [1..] cocientes maximosCocientes,

a == b]

-- cocientes es la lista de los cocientes σ(k)/k. Por ejemplo,

-- λ> take 7 cocientes

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

cocientes :: [Rational]

cocientes =

[sumaDivisores n % n | n <- [1..]]

-- maximosCocientes es la lista de los máximos de los cocientes

-- σ(k)/k. Por ejemplo,

-- λ> take 7 maximosCocientes

-- [1 % 1,3 % 2,3 % 2,7 % 4,7 % 4,2 % 1,2 % 1]

maximosCocientes :: [Rational]

maximosCocientes = scanl1 max cocientes

-- Comparación de eficiencia

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

-- La comparación es

-- λ> superabundantes !! 22

-- 27720

-- (6.72 secs, 11,453,705,704 bytes)

-- λ> superabundantes2 !! 22

-- 27720

-- (0.54 secs, 902,054,096 bytes)

Nuevas soluciones

En los comentarios se pueden escribir nuevas soluciones.
El código se debe escribir entre una línea con <pre lang="haskell"> y otra con </pre>

Autor: José A. Alonso

Suma de cadenas

Soluciones

Cuadrado más cercano

Soluciones

9º curso de Exercitium (2021-22)

Sucesiones conteniendo al producto de consecutivos

Soluciones

Números superabundantes

Soluciones

Nuevas soluciones

Entradas recientes

Buscar

Correo electrónico