PFH: La semana en Exercitium (del 30 de mayo al 3 de junio de 2022)

Esta semana he publicado en Exercitium las soluciones de los siguientes problemas:

1. Ordenación de los racionales
2. Polinomios de Bell
3. Término ausente en una progresión aritmética
4. Suma de los elementos de las diagonales matrices espirales
5. Descomposiciones con sumandos 1 ó 2

A continuación se muestran las soluciones.

1. Ordenación de los racionales

En este ejercicio, representamos las fracciones mediante pares de números de enteros.

Definir la función

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

1	fraccionesOrd :: Integer -> [(Integer,Integer)]

tal que (fraccionesOrd n) es la lista con las fracciones propias positivas ordenadas, con denominador menor o igual que n. Por ejemplo,

   λ> fraccionesOrd 4
   [(1,4),(1,3),(1,2),(2,3),(3,4)]
   λ> fraccionesOrd 5
   [(1,5),(1,4),(1,3),(2,5),(1,2),(3,5),(2,3),(3,4),(4,5)]

λ> fraccionesOrd 4

[(1,4),(1,3),(1,2),(2,3),(3,4)]

λ> fraccionesOrd 5

[(1,5),(1,4),(1,3),(2,5),(1,2),(3,5),(2,3),(3,4),(4,5)]

Soluciones

import Data.List (sort, sortBy)
import Data.Ratio ((%), numerator, denominator)
import Test.QuickCheck

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

fraccionesOrd1 :: Integer -> [(Integer,Integer)]
fraccionesOrd1 n = 
  [(x,y) | (_,(x,y)) <- sort [(fromIntegral x/fromIntegral y,(x,y))
                              | y <- [2..n], 
                                x <- [1..y-1], 
                                gcd x y == 1]]

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

fraccionesOrd2 :: Integer -> [(Integer,Integer)]
fraccionesOrd2 n = 
  map snd (sort [(fromIntegral x/fromIntegral y,(x,y))
                 | y <- [2..n], 
                   x <- [1..y-1], 
                   gcd x y == 1])

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

fraccionesOrd3 :: Integer -> [(Integer,Integer)]
fraccionesOrd3 n = 
  sortBy comp [(x,y) | y <- [2..n], x <- [1..y-1], gcd x y == 1]
  where comp (a,b) (c,d) = compare (a*d) (b*c)

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

fraccionesOrd4 :: Integer -> [(Integer,Integer)]
fraccionesOrd4 n = 
  [(numerator x, denominator x) | x <- racionalesOrd4 n]
  
-- (racionalesOrd4 n) es la lista con los racionales ordenados, con
-- denominador menor o igual que n. Por ejemplo,
--    λ> racionalesOrd4 4
--    [1 % 4,1 % 3,1 % 2,2 % 3,3 % 4]
racionalesOrd4 :: Integer -> [Rational]
racionalesOrd4 n =
  sort [x % y | y <- [2..n], x <- [1..y-1], gcd x y == 1]

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

-- La propiedad es
prop_fraccionesOrd :: Positive Integer -> Bool 
prop_fraccionesOrd (Positive n) =
  all (== fraccionesOrd1 n)
      [fraccionesOrd2 n,
       fraccionesOrd3 n,
       fraccionesOrd4 n]

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

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

-- La comparación es
--    λ> length (fraccionesOrd1 2000)
--    1216587
--    (3.65 secs, 2,879,842,368 bytes)
--    λ> length (fraccionesOrd2 2000)
--    1216587
--    (3.36 secs, 2,870,109,640 bytes)
--    λ> length (fraccionesOrd3 2000)
--    1216587
--    (8.83 secs, 5,700,519,584 bytes)
--    λ> length (fraccionesOrd4 2000)
--    1216587
--    (4.12 secs, 5,181,904,336 bytes)

import Data.List (sort, sortBy)

import Data.Ratio ((%), numerator, denominator)

import Test.QuickCheck

-- 1ª solución

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

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

fraccionesOrd1 n =

[(x,y) | (_,(x,y)) <- sort [(fromIntegral x/fromIntegral y,(x,y))

| y <- [2..n],

x <- [1..y-1],

gcd x y == 1]]

-- 2ª solución

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

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

fraccionesOrd2 n =

map snd (sort [(fromIntegral x/fromIntegral y,(x,y))

| y <- [2..n],

x <- [1..y-1],

gcd x y == 1])

-- 3ª solución

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

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

fraccionesOrd3 n =

sortBy comp [(x,y) | y <- [2..n], x <- [1..y-1], gcd x y == 1]

where comp (a,b) (c,d) = compare (a*d) (b*c)

-- 4ª solución

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

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

fraccionesOrd4 n =

[(numerator x, denominator x) | x <- racionalesOrd4 n]

-- (racionalesOrd4 n) es la lista con los racionales ordenados, con

-- denominador menor o igual que n. Por ejemplo,

-- λ> racionalesOrd4 4

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

racionalesOrd4 :: Integer -> [Rational]

racionalesOrd4 n =

sort [x % y | y <- [2..n], x <- [1..y-1], gcd x y == 1]

-- Comprobación de equivalencia

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

-- La propiedad es

prop_fraccionesOrd :: Positive Integer -> Bool

prop_fraccionesOrd (Positive n) =

all (== fraccionesOrd1 n)

[fraccionesOrd2 n,

fraccionesOrd3 n,

fraccionesOrd4 n]

-- La comprobación es

-- λ> quickCheck prop_fraccionesOrd

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> length (fraccionesOrd1 2000)

-- 1216587

-- (3.65 secs, 2,879,842,368 bytes)

-- λ> length (fraccionesOrd2 2000)

-- 1216587

-- (3.36 secs, 2,870,109,640 bytes)

-- λ> length (fraccionesOrd3 2000)

-- 1216587

-- (8.83 secs, 5,700,519,584 bytes)

-- λ> length (fraccionesOrd4 2000)

-- 1216587

-- (4.12 secs, 5,181,904,336 bytes)

El código se encuentra en GitHub.

2. Polinomios de Bell

Los polinomios de Bell forman una sucesión de polinomios, definida como sigue:

B₀(x) = 1 (polinomio unidad)
Bₙ(x) = x·[Bₙ(x) + Bₙ'(x)] (donde Bₙ'(x) es la derivada de Bₙ(x))

Por ejemplo,

   B₀(x) = 1                     = 1
   B₁(x) = x·(1+0)               = x     
   B₂(x) = x·(x+1)               = x²+x         
   B₃(x) = x·(x²+x+2x+1)         = x³+3x²+x    
   B₄(x) = x·(x³+3x²+x+3x²+6x+1) = x⁴+6x³+7x²+x

B₀(x) = 1 = 1

B₁(x) = x·(1+0) = x

B₂(x) = x·(x+1) = x²+x

B₃(x) = x·(x²+x+2x+1) = x³+3x²+x

B₄(x) = x·(x³+3x²+x+3x²+6x+1) = x⁴+6x³+7x²+x

Definir la función

   polBell :: Integer -> Polinomio Integer

1	polBell :: Integer -> Polinomio Integer

tal que (polBell n) es el polinomio de Bell de grado n. Por ejemplo,

   polBell 4                    ==  x^4 + 6*x^3 + 7*x^2 + 1*x
   coeficiente 2 (polBell 4)    ==  7
   coeficiente 2 (polBell 30)   ==  536870911
   coeficiente 1 (polBell 1000) == 1
   length (show (coeficiente 9 (polBell 2000)))  ==  1903

polBell 4 == x^4 + 6*x^3 + 7*x^2 + 1*x

coeficiente 2 (polBell 4) == 7

coeficiente 2 (polBell 30) == 536870911

coeficiente 1 (polBell 1000) == 1

length (show (coeficiente 9 (polBell 2000))) == 1903

Notas: Se usa la librería I1M.PolOperaciones que se encuentra aquí y se describe aquí. Además, en el último ejemplo se usa la función coeficiente tal que (coeficiente k p) es el coeficiente del término de grado k en el polinomio p definida por

   coeficiente :: Num a => Int -> Polinomio a -> a
   coeficiente k p | k == n                 = coefLider p
                   | k > grado (restoPol p) = 0
                   | otherwise              = coeficiente k (restoPol p)
                   where n = grado p

coeficiente :: Num a => Int -> Polinomio a -> a

coeficiente k p | k == n = coefLider p

| k > grado (restoPol p) = 0

| otherwise = coeficiente k (restoPol p)

where n = grado p

Soluciones

import Data.List          (genericIndex)
import I1M.PolOperaciones (Polinomio, coefLider, consPol, derivada,
                           grado, multPol, polCero, polUnidad, restoPol,
                           sumaPol) 
import Test.QuickCheck    (Positive (Positive), quickCheck)

-- Función auxiliar
-- ================

-- (coeficiente k p) es el coeficiente del término de grado k en el
-- polinomio p.
coeficiente :: Num a => Int -> Polinomio a -> a
coeficiente k p | k == n                 = coefLider p
                | k > grado (restoPol p) = 0
                | otherwise              = coeficiente k (restoPol p)
                where n = grado p

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

polBell1 :: Integer -> Polinomio Integer
polBell1 0 = polUnidad
polBell1 n = multPol (consPol 1 1 polCero) (sumaPol p (derivada p))
  where p = polBell1 (n-1)

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

polBell2 :: Integer -> Polinomio Integer
polBell2 n = sucPolinomiosBell `genericIndex` n

sucPolinomiosBell :: [Polinomio Integer]
sucPolinomiosBell = iterate f polUnidad
  where f p = multPol (consPol 1 1 polCero) (sumaPol p (derivada p))

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

-- La propiedad es
prop_polBell :: Positive Integer -> Bool 
prop_polBell (Positive n) =
  polBell1 n == polBell2 n

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

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

-- La comparación es
--    λ> length (show (coeficiente 9 (polBell1 2000)))
--    1903
--    (5.37 secs, 4,829,322,368 bytes)
--    λ> length (show (coeficiente 9 (polBell2 2000)))
--    1903
--    (4.03 secs, 4,825,094,064 bytes)

import Data.List (genericIndex)

import I1M.PolOperaciones (Polinomio, coefLider, consPol, derivada,

grado, multPol, polCero, polUnidad, restoPol,

sumaPol)

import Test.QuickCheck (Positive (Positive), quickCheck)

-- Función auxiliar

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

-- (coeficiente k p) es el coeficiente del término de grado k en el

-- polinomio p.

coeficiente :: Num a => Int -> Polinomio a -> a

coeficiente k p | k == n = coefLider p

| k > grado (restoPol p) = 0

| otherwise = coeficiente k (restoPol p)

where n = grado p

-- 1ª solución

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

polBell1 :: Integer -> Polinomio Integer

polBell1 0 = polUnidad

polBell1 n = multPol (consPol 1 1 polCero) (sumaPol p (derivada p))

where p = polBell1 (n-1)

-- 2ª solución

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

polBell2 :: Integer -> Polinomio Integer

polBell2 n = sucPolinomiosBell `genericIndex` n

sucPolinomiosBell :: [Polinomio Integer]

sucPolinomiosBell = iterate f polUnidad

where f p = multPol (consPol 1 1 polCero) (sumaPol p (derivada p))

-- Comprobación de equivalencia

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

-- La propiedad es

prop_polBell :: Positive Integer -> Bool

prop_polBell (Positive n) =

polBell1 n == polBell2 n

-- La comprobación es

-- λ> quickCheck prop_polBell

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> length (show (coeficiente 9 (polBell1 2000)))

-- 1903

-- (5.37 secs, 4,829,322,368 bytes)

-- λ> length (show (coeficiente 9 (polBell2 2000)))

-- 1903

-- (4.03 secs, 4,825,094,064 bytes)

El código se encuentra en GitHub.

3. Término ausente en una progresión aritmética

Una progresión aritmética es una sucesión de números tales que la diferencia de dos términos sucesivos cualesquiera de la sucesión es constante.

Definir la función

   ausente :: Integral a => [a] -> a

1	ausente :: Integral a => [a] -> a

tal que (ausente xs) es el único término ausente de la progresión aritmética xs. Por ejemplo,

   ausente [3,7,9,11]               ==  5
   ausente [3,5,9,11]               ==  7
   ausente [3,5,7,11]               ==  9
   ausente ([1..9]++[11..])         ==  10
   ausente ([1..10^6] ++ [2+10^6])  ==  1000001

ausente [3,7,9,11] == 5

ausente [3,5,9,11] == 7

ausente [3,5,7,11] == 9

ausente ([1..9]++[11..]) == 10

ausente ([1..10^6] ++ [2+10^6]) == 1000001

Nota. Se supone que la lista tiene al menos 3 elementos, que puede ser infinita y que sólo hay un término de la progresión aritmética que no está en la lista.

Soluciones

import Data.List (group, genericLength)
import Test.QuickCheck (Arbitrary, Gen,
                        arbitrary, frequency, suchThat, quickCheck) 

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

ausente1 :: Integral a => [a] -> a
ausente1 (x1:xs@(x2:x3:_))
  | d1 == d2     = ausente1 xs
  | d1 == 2 * d2 = x1 + d2
  | d2 == 2 * d1 = x2 + d1
  where d1 = x2 - x1
        d2 = x3 - x2          

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

ausente2 :: Integral a => [a] -> a
ausente2 s@(x1:x2:x3:_) 
  | x1 + x3 /= 2 * x2 = x1 + (x3 - x2)
  | otherwise         = head [a | (a,b) <- zip [x1,x2..] s
                                , a /= b]

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

ausente3 :: Integral a => [a] -> a
ausente3  xs@(x1:x2:_) 
  | null us   = x1 + v
  | otherwise = x2 + u * genericLength (u:us) 
  where ((u:us):(v:_):_) = group (zipWith (-) (tail xs) xs)

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

-- Tipo de progresiones aritméticas con un término ausente.
newtype PAconAusente = PA [Integer]
  deriving Show

-- Generación de progresiones aritméticas con un término ausente. 
progresionConAusenteArbitraria :: Gen PAconAusente
progresionConAusenteArbitraria = do
  x <- arbitrary
  d <- arbitrary `suchThat` (/= 0)
  n <- arbitrary `suchThat` (> 2)
  k <- arbitrary `suchThat` (> 0)
  let (as,_:bs) = splitAt k [x,x+d..]
  frequency [(1,return (PA (as ++ bs))),
             (1,return (PA (take (length as + n) (as ++ bs))))]

-- Inclusión del tipo PAconAusente en Arbitrary.
instance Arbitrary PAconAusente where
  arbitrary = progresionConAusenteArbitraria

-- La propiedad es
prop_ausente :: PAconAusente -> Bool 
prop_ausente (PA xs) =
  all (== ausente1 xs)
      [ausente2 xs,
       ausente3 xs]

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

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

-- La comparación es
--    λ> let n = 10^6 in ausente1 ([1..n] ++ [n+2])
--    1000001
--    (1.15 secs, 560,529,520 bytes)
--    λ> let n = 10^6 in ausente2 ([1..n] ++ [n+2])
--    1000001
--    (0.33 secs, 336,530,680 bytes)
--    λ> let n = 10^6 in ausente3 ([1..n] ++ [n+2])
--    1000001
--    (0.50 secs, 498,047,584 bytes)

import Data.List (group, genericLength)

import Test.QuickCheck (Arbitrary, Gen,

arbitrary, frequency, suchThat, quickCheck)

-- 1ª solución

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

ausente1 :: Integral a => [a] -> a

ausente1 (x1:xs@(x2:x3:_))

| d1 == d2 = ausente1 xs

| d1 == 2 * d2 = x1 + d2

| d2 == 2 * d1 = x2 + d1

where d1 = x2 - x1

d2 = x3 - x2

-- 2ª solución

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

ausente2 :: Integral a => [a] -> a

ausente2 s@(x1:x2:x3:_)

| x1 + x3 /= 2 * x2 = x1 + (x3 - x2)

| otherwise = head [a | (a,b) <- zip [x1,x2..] s

, a /= b]

-- 3ª solución

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

ausente3 :: Integral a => [a] -> a

ausente3 xs@(x1:x2:_)

| null us = x1 + v

| otherwise = x2 + u * genericLength (u:us)

where ((u:us):(v:_):_) = group (zipWith (-) (tail xs) xs)

-- Comprobación de equivalencia

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

-- Tipo de progresiones aritméticas con un término ausente.

newtype PAconAusente = PA [Integer]

deriving Show

-- Generación de progresiones aritméticas con un término ausente.

progresionConAusenteArbitraria :: Gen PAconAusente

progresionConAusenteArbitraria = do

x <- arbitrary

d <- arbitrary `suchThat` (/= 0)

n <- arbitrary `suchThat` (> 2)

k <- arbitrary `suchThat` (> 0)

let (as,_:bs) = splitAt k [x,x+d..]

frequency [(1,return (PA (as ++ bs))),

(1,return (PA (take (length as + n) (as ++ bs))))]

-- Inclusión del tipo PAconAusente en Arbitrary.

instance Arbitrary PAconAusente where

arbitrary = progresionConAusenteArbitraria

-- La propiedad es

prop_ausente :: PAconAusente -> Bool

prop_ausente (PA xs) =

all (== ausente1 xs)

[ausente2 xs,

ausente3 xs]

-- La comprobación es

-- λ> quickCheck prop_ausente

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> let n = 10^6 in ausente1 ([1..n] ++ [n+2])

-- 1000001

-- (1.15 secs, 560,529,520 bytes)

-- λ> let n = 10^6 in ausente2 ([1..n] ++ [n+2])

-- 1000001

-- (0.33 secs, 336,530,680 bytes)

-- λ> let n = 10^6 in ausente3 ([1..n] ++ [n+2])

-- 1000001

-- (0.50 secs, 498,047,584 bytes)

El código se encuentra en GitHub.

4. Suma de los elementos de las diagonales matrices espirales

Empezando con el número 1 y moviéndose en el sentido de las agujas del reloj se obtienen las matrices espirales

   |1 2|   |7 8 9|   | 7  8  9 10|   |21 22 23 24 25|
   |4 3|   |6 1 2|   | 6  1  2 11|   |20  7  8  9 10|
           |5 4 3|   | 5  4  3 12|   |19  6  1  2 11|
                     |16 15 14 13|   |18  5  4  3 12|
                                     |17 16 15 14 13|

|1 2| |7 8 9| | 7 8 9 10| |21 22 23 24 25|

|4 3| |6 1 2| | 6 1 2 11| |20 7 8 9 10|

|5 4 3| | 5 4 3 12| |19 6 1 2 11|

|16 15 14 13| |18 5 4 3 12|

|17 16 15 14 13|

La suma los elementos de sus diagonales es

   + en la 2x2: 1+3+2+4               =  10
   + en la 3x3: 1+3+5+7+9             =  25
   + en la 4x4: 1+2+3+4+7+10+13+16    =  56
   + en la 5x5: 1+3+5+7+9+13+17+21+25 = 101

+ en la 2x2: 1+3+2+4 = 10

+ en la 3x3: 1+3+5+7+9 = 25

+ en la 4x4: 1+2+3+4+7+10+13+16 = 56

+ en la 5x5: 1+3+5+7+9+13+17+21+25 = 101

Definir la función

   sumaDiagonales :: Integer -> Integer

1	sumaDiagonales :: Integer -> Integer

tal que (sumaDiagonales n) es la suma de los elementos en las diagonales de la matriz espiral de orden nxn. Por ejemplo.

   sumaDiagonales 1         ==  1
   sumaDiagonales 2         ==  10
   sumaDiagonales 3         ==  25
   sumaDiagonales 4         ==  56
   sumaDiagonales 5         ==  101
   sumaDiagonales (10^6)    ==  666667166668000000
   sumaDiagonales (1+10^6)  ==  666669166671000001

   sumaDiagonales (10^2)  ==         671800
   sumaDiagonales (10^3)  ==        667168000
   sumaDiagonales (10^4)  ==       666716680000
   sumaDiagonales (10^5)  ==      666671666800000
   sumaDiagonales (10^6)  ==     666667166668000000
   sumaDiagonales (10^7)  ==    666666716666680000000
   sumaDiagonales (10^8)  ==   666666671666666800000000
   sumaDiagonales (10^9)  ==  666666667166666668000000000

sumaDiagonales 1 == 1

sumaDiagonales 2 == 10

sumaDiagonales 3 == 25

sumaDiagonales 4 == 56

sumaDiagonales 5 == 101

sumaDiagonales (10^6) == 666667166668000000

sumaDiagonales (1+10^6) == 666669166671000001

sumaDiagonales (10^2) == 671800

sumaDiagonales (10^3) == 667168000

sumaDiagonales (10^4) == 666716680000

sumaDiagonales (10^5) == 666671666800000

sumaDiagonales (10^6) == 666667166668000000

sumaDiagonales (10^7) == 666666716666680000000

sumaDiagonales (10^8) == 666666671666666800000000

sumaDiagonales (10^9) == 666666667166666668000000000

Comprobar con QuickCheck que el último dígito de (sumaDiagonales n) es 0, 4 ó 6 si n es par y es 1, 5 ó 7 en caso contrario.

Soluciones

import Test.QuickCheck (Positive (Positive), quickCheck)

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

sumaDiagonales1 :: Integer -> Integer
sumaDiagonales1 = sum . elementosEnDiagonales

-- (elementosEnDiagonales n) es la lista de los elementos en las
-- diagonales de la matriz espiral de orden nxn. Por ejemplo,
--    elementosEnDiagonales 1  ==  [1]
--    elementosEnDiagonales 2  ==  [1,2,3,4]
--    elementosEnDiagonales 3  ==  [1,3,5,7,9]
--    elementosEnDiagonales 4  ==  [1,2,3,4,7,10,13,16]
--    elementosEnDiagonales 5  ==  [1,3,5,7,9,13,17,21,25]
elementosEnDiagonales :: Integer -> [Integer]
elementosEnDiagonales n 
  | even n    = tail (scanl (+) 0 (concatMap (replicate 4) [1,3..n-1]))
  | otherwise = scanl (+) 1 (concatMap (replicate 4) [2,4..n-1])

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

sumaDiagonales2 :: Integer -> Integer
sumaDiagonales2 n
  | even n    = (-1) + n `div` 2 + sum [2*k^2-k+1 | k <- [0..n]]
  | otherwise = 1 + sum [4*k^2-6*k+6 | k <- [3,5..n]]

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

sumaDiagonales3 :: Integer -> Integer
sumaDiagonales3 n
  | even n    = n * (4*n^2 + 3*n + 8) `div` 6
  | otherwise = (4*n^3 + 3*n^2 + 8*n - 9) `div` 6

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

-- La propiedad es
prop_sumaDiagonales :: Positive Integer -> Bool
prop_sumaDiagonales (Positive n) =
  all (== sumaDiagonales1 n)
      [sumaDiagonales2 n,
       sumaDiagonales3 n]

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

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

-- La comparación es
--    λ> sumaDiagonales (2*10^6)
--    5333335333336000000
--    (2.30 secs, 1,521,955,848 bytes)
--    λ> sumaDiagonales2 (2*10^6)
--    5333335333336000000
--    (2.77 secs, 1,971,411,440 bytes)
--    λ> sumaDiagonales3 (2*10^6)
--    5333335333336000000
--    (0.01 secs, 139,520 bytes)

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

-- La propiedad es
prop_sumaDiagonales2 :: Positive Integer -> Bool
prop_sumaDiagonales2 (Positive n) 
  | even n    = x `elem` [0,4,6] 
  | otherwise = x `elem` [1,5,7] 
  where x = sumaDiagonales1 n `mod` 10

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

import Test.QuickCheck (Positive (Positive), quickCheck)

-- 1ª solución

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

sumaDiagonales1 :: Integer -> Integer

sumaDiagonales1 = sum . elementosEnDiagonales

-- (elementosEnDiagonales n) es la lista de los elementos en las

-- diagonales de la matriz espiral de orden nxn. Por ejemplo,

-- elementosEnDiagonales 1 == [1]

-- elementosEnDiagonales 2 == [1,2,3,4]

-- elementosEnDiagonales 3 == [1,3,5,7,9]

-- elementosEnDiagonales 4 == [1,2,3,4,7,10,13,16]

-- elementosEnDiagonales 5 == [1,3,5,7,9,13,17,21,25]

elementosEnDiagonales :: Integer -> [Integer]

elementosEnDiagonales n

| even n = tail (scanl (+) 0 (concatMap (replicate 4) [1,3..n-1]))

| otherwise = scanl (+) 1 (concatMap (replicate 4) [2,4..n-1])

-- 2ª solución

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

sumaDiagonales2 :: Integer -> Integer

sumaDiagonales2 n

| even n = (-1) + n `div` 2 + sum [2*k^2-k+1 | k <- [0..n]]

| otherwise = 1 + sum [4*k^2-6*k+6 | k <- [3,5..n]]

-- 3ª solución

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

sumaDiagonales3 :: Integer -> Integer

sumaDiagonales3 n

| even n = n * (4*n^2 + 3*n + 8) `div` 6

| otherwise = (4*n^3 + 3*n^2 + 8*n - 9) `div` 6

-- Equivalencia de las definiciones

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

-- La propiedad es

prop_sumaDiagonales :: Positive Integer -> Bool

prop_sumaDiagonales (Positive n) =

all (== sumaDiagonales1 n)

[sumaDiagonales2 n,

sumaDiagonales3 n]

-- La comprobación es

-- λ> quickCheck prop_sumaDiagonales_equiv

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> sumaDiagonales (2*10^6)

-- 5333335333336000000

-- (2.30 secs, 1,521,955,848 bytes)

-- λ> sumaDiagonales2 (2*10^6)

-- 5333335333336000000

-- (2.77 secs, 1,971,411,440 bytes)

-- λ> sumaDiagonales3 (2*10^6)

-- 5333335333336000000

-- (0.01 secs, 139,520 bytes)

-- Propiedad

-- =========

-- La propiedad es

prop_sumaDiagonales2 :: Positive Integer -> Bool

prop_sumaDiagonales2 (Positive n)

| even n = x `elem` [0,4,6]

| otherwise = x `elem` [1,5,7]

where x = sumaDiagonales1 n `mod` 10

-- La comprobación es

-- λ> quickCheck prop_sumaDiagonales2

-- +++ OK, passed 100 tests.

El código se encuentra en GitHub.

5. Descomposiciones con sumandos 1 ó 2

Definir la funciones

   sumas  :: Int -> [[Int]]
   nSumas :: Int -> Integer

1 2	sumas :: Int -> [[Int]] nSumas :: Int -> Integer

tales que

(sumas n) es la lista de las descomposiciones de n como sumas cuyos sumandos son 1 ó 2. Por ejemplo,

      sumas 1            ==  [[1]]
      sumas 2            ==  [[1,1],[2]]
      sumas 3            ==  [[1,1,1],[1,2],[2,1]]
      sumas 4            ==  [[1,1,1,1],[1,1,2],[1,2,1],[2,1,1],[2,2]]
      length (sumas 26)  ==  196418
      length (sumas 33)  ==  5702887

sumas 1 == [[1]]

sumas 2 == [[1,1],[2]]

sumas 3 == [[1,1,1],[1,2],[2,1]]

sumas 4 == [[1,1,1,1],[1,1,2],[1,2,1],[2,1,1],[2,2]]

length (sumas 26) == 196418

length (sumas 33) == 5702887

(nSumas n) es el número de descomposiciones de n como sumas cuyos sumandos son 1 ó 2. Por ejemplo,

      nSumas 4                      ==  5
      nSumas 123                    ==  36726740705505779255899443
      length (show (nSumas 123456)) ==  25801

nSumas 4 == 5

nSumas 123 == 36726740705505779255899443

length (show (nSumas 123456)) == 25801

Soluciones

import Data.List  (genericIndex, genericLength)
import Data.Array ((!), array)
import Test.QuickCheck (Positive(Positive), quickCheckWith)

-- 1ª solución de sumas
-- ====================

sumas1 :: Int -> [[Int]]
sumas1 0 = [[]]
sumas1 1 = [[1]]
sumas1 n = [1:xs | xs <- sumas1 (n-1)] ++ [2:xs | xs <- sumas1 (n-2)]

-- 2ª solución de sumas
-- ====================

sumas2 :: Int -> [[Int]]
sumas2 0 = [[]]
sumas2 1 = [[1]]
sumas2 n = map (1:) (sumas2 (n-1)) ++ map (2:) (sumas2 (n-2))

-- 3ª solución de sumas
-- ====================

sumas3 :: Int -> [[Int]]
sumas3 n = v ! n
  where v = array (0,n) [(i, f i) | i <- [0..n]]
        f 0 = [[]]
        f 1 = [[1]]
        f k = map (1:) (v!(k-1)) ++ map (2:) (v!(k-2))
 
-- 4ª solución de sumas
-- ====================

sumas4 :: Int -> [[Int]]
sumas4 n = sucSumas !! n

-- sucSumas es la sucesión cuyo n-ésimo elemento es la lista de las
-- descomposiciones de n como sumas cuyos sumandos son 1 ó 2. Por
-- ejemplo,
--    λ> take 4 sucSumas
--    [[[]],[[1]],[[1,1],[2]],[[1,1,1],[1,2],[2,1]]]
--    λ> mapM_ print (take 5 sucSumas)
--    [[]]
--    [[1]]
--    [[1,1],[2]]
--    [[1,1,1],[1,2],[2,1]]
--    [[1,1,1,1],[1,1,2],[1,2,1],[2,1,1],[2,2]]
sucSumas :: [[[Int]]]
sucSumas = [[]] : [[1]] : zipWith f (tail sucSumas) sucSumas
  where f xs ys = map (1:) xs ++ map (2:) ys

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

-- La propiedad es
prop_sumas :: Positive Int -> Bool
prop_sumas (Positive n) =
  all (== sumas1 n)
      [sumas2 n,
       sumas3 n,
       sumas4 n]

-- La comprobación es
--    λ> quickCheckWith (stdArgs {maxSize=20}) prop_sumas
--    +++ OK, passed 100 tests.

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

-- La comparación es
--    λ> length (sumas1 28)
--    514229
--    (2.79 secs, 1,739,784,512 bytes)
--    λ> length (sumas2 28)
--    514229
--    (1.33 secs, 1,512,291,248 bytes)
--    λ> length (sumas3 28)
--    514229
--    (0.20 secs, 165,215,800 bytes)
--    λ> length (sumas4 28)
--    514229
--    (0.17 secs, 165,201,592 bytes)
--
--    λ> length (sumas3 33)
--    5702887
--    (2.16 secs, 1,830,761,864 bytes)
--    λ> length (sumas4 33)
--    5702887
--    (1.44 secs, 1,830,749,832 bytes)

-- Definición de sumas
-- ===================

-- La cuarta solución es más eficiente y es la que usaremos en lo
-- sucesivo:
sumas :: Int -> [[Int]]
sumas = sumas4

-- 1ª solución de nSumas
-- =====================

nSumas1 :: Int -> Integer
nSumas1 = genericLength . sumas2

-- 2ª solución de nSumas
-- =====================

nSumas2 :: Int -> Integer
nSumas2 0 = 1
nSumas2 1 = 1
nSumas2 n = nSumas2 (n-1) + nSumas2 (n-2)

-- 3ª solución de nSumas
-- =====================

nSumas3 :: Int -> Integer
nSumas3 n = v ! n
  where v = array (0,n) [(i,f i) | i <- [0..n]]
        f 0 = 1
        f 1 = 1
        f k = v ! (k-1) + v ! (k-2)

-- 4ª solución de nSumas
-- =====================

nSumas4 :: Int -> Integer
nSumas4 n = aux `genericIndex` n
  where aux = 1 : 1 : zipWith (+) aux (tail aux) 

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

-- La propiedad es
prop_nSumas :: Positive Int -> Bool
prop_nSumas (Positive n) =
  all (== nSumas1 n)
      [nSumas2 n,
       nSumas3 n,
       nSumas4 n]

-- La comprobación es
--    λ> quickCheckWith (stdArgs {maxSize=20}) prop_nSumas
--    +++ OK, passed 100 tests.

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

-- La comparación es
--    λ> nSumas1 33
--    5702887
--    (17.32 secs, 23,140,562,600 bytes)
--    λ> nSumas2 33
--    5702887
--    (3.48 secs, 1,870,676,904 bytes)
--    λ> nSumas3 33
--    5702887
--    (0.00 secs, 152,960 bytes)
--    λ> nSumas4 33
--    5702887
--    (0.00 secs, 139,456 bytes)
--    
--    λ> length (show (nSumas3 (2*10^5)))
--    41798
--    (1.41 secs, 1,895,295,528 bytes)
--    λ> length (show (nSumas4 (2*10^5)))
--    41798
--    (2.39 secs, 1,834,998,800 bytes)

-- Nota. El valor de (nSumas n) es el n-ésimo término de la sucesión de
-- Fibonacci 1, 1, 2, 3, 5, 8, ...

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

167

168

169

170

import Data.List (genericIndex, genericLength)

import Data.Array ((!), array)

import Test.QuickCheck (Positive(Positive), quickCheckWith)

-- 1ª solución de sumas

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

sumas1 :: Int -> [[Int]]

sumas1 0 = [[]]

sumas1 1 = [[1]]

sumas1 n = [1:xs | xs <- sumas1 (n-1)] ++ [2:xs | xs <- sumas1 (n-2)]

-- 2ª solución de sumas

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

sumas2 :: Int -> [[Int]]

sumas2 0 = [[]]

sumas2 1 = [[1]]

sumas2 n = map (1:) (sumas2 (n-1)) ++ map (2:) (sumas2 (n-2))

-- 3ª solución de sumas

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

sumas3 :: Int -> [[Int]]

sumas3 n = v ! n

where v = array (0,n) [(i, f i) | i <- [0..n]]

f 0 = [[]]

f 1 = [[1]]

f k = map (1:) (v!(k-1)) ++ map (2:) (v!(k-2))

-- 4ª solución de sumas

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

sumas4 :: Int -> [[Int]]

sumas4 n = sucSumas !! n

-- sucSumas es la sucesión cuyo n-ésimo elemento es la lista de las

-- descomposiciones de n como sumas cuyos sumandos son 1 ó 2. Por

-- ejemplo,

-- λ> take 4 sucSumas

-- [[[]],[[1]],[[1,1],[2]],[[1,1,1],[1,2],[2,1]]]

-- λ> mapM_ print (take 5 sucSumas)

-- [[]]

-- [[1]]

-- [[1,1],[2]]

-- [[1,1,1],[1,2],[2,1]]

-- [[1,1,1,1],[1,1,2],[1,2,1],[2,1,1],[2,2]]

sucSumas :: [[[Int]]]

sucSumas = [[]] : [[1]] : zipWith f (tail sucSumas) sucSumas

where f xs ys = map (1:) xs ++ map (2:) ys

-- Comprobación de equivalencia de sumas

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

-- La propiedad es

prop_sumas :: Positive Int -> Bool

prop_sumas (Positive n) =

all (== sumas1 n)

[sumas2 n,

sumas3 n,

sumas4 n]

-- La comprobación es

-- λ> quickCheckWith (stdArgs {maxSize=20}) prop_sumas

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia de sumas

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

-- La comparación es

-- λ> length (sumas1 28)

-- 514229

-- (2.79 secs, 1,739,784,512 bytes)

-- λ> length (sumas2 28)

-- 514229

-- (1.33 secs, 1,512,291,248 bytes)

-- λ> length (sumas3 28)

-- 514229

-- (0.20 secs, 165,215,800 bytes)

-- λ> length (sumas4 28)

-- 514229

-- (0.17 secs, 165,201,592 bytes)

-- λ> length (sumas3 33)

-- 5702887

-- (2.16 secs, 1,830,761,864 bytes)

-- λ> length (sumas4 33)

-- 5702887

-- (1.44 secs, 1,830,749,832 bytes)

-- Definición de sumas

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

-- La cuarta solución es más eficiente y es la que usaremos en lo

-- sucesivo:

sumas :: Int -> [[Int]]

sumas = sumas4

-- 1ª solución de nSumas

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

nSumas1 :: Int -> Integer

nSumas1 = genericLength . sumas2

-- 2ª solución de nSumas

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

nSumas2 :: Int -> Integer

nSumas2 0 = 1

nSumas2 1 = 1

nSumas2 n = nSumas2 (n-1) + nSumas2 (n-2)

-- 3ª solución de nSumas

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

nSumas3 :: Int -> Integer

nSumas3 n = v ! n

where v = array (0,n) [(i,f i) | i <- [0..n]]

f 0 = 1

f 1 = 1

f k = v ! (k-1) + v ! (k-2)

-- 4ª solución de nSumas

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

nSumas4 :: Int -> Integer

nSumas4 n = aux `genericIndex` n

where aux = 1 : 1 : zipWith (+) aux (tail aux)

-- Comprobación de equivalencia de nSumas

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

-- La propiedad es

prop_nSumas :: Positive Int -> Bool

prop_nSumas (Positive n) =

all (== nSumas1 n)

[nSumas2 n,

nSumas3 n,

nSumas4 n]

-- La comprobación es

-- λ> quickCheckWith (stdArgs {maxSize=20}) prop_nSumas

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia de nSumas

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

-- La comparación es

-- λ> nSumas1 33

-- 5702887

-- (17.32 secs, 23,140,562,600 bytes)

-- λ> nSumas2 33

-- 5702887

-- (3.48 secs, 1,870,676,904 bytes)

-- λ> nSumas3 33

-- 5702887

-- (0.00 secs, 152,960 bytes)

-- λ> nSumas4 33

-- 5702887

-- (0.00 secs, 139,456 bytes)

-- λ> length (show (nSumas3 (2*10^5)))

-- 41798

-- (1.41 secs, 1,895,295,528 bytes)

-- λ> length (show (nSumas4 (2*10^5)))

-- 41798

-- (2.39 secs, 1,834,998,800 bytes)

-- Nota. El valor de (nSumas n) es el n-ésimo término de la sucesión de

-- Fibonacci 1, 1, 2, 3, 5, 8, ...

El código se encuentra en GitHub.

1. Ordenación de los racionales

Soluciones

2. Polinomios de Bell

Soluciones

3. Término ausente en una progresión aritmética

Soluciones

4. Suma de los elementos de las diagonales matrices espirales

Soluciones

5. Descomposiciones con sumandos 1 ó 2

Soluciones

Se puede imprimir o compartir con