Test.QuickCheck – Exercitium

Suma de divisores

PorJosé A. Alonso 16-mayo-2022

Definir la función

   sumaDivisores :: Integer -> Integer

1	sumaDivisores :: Integer -> Integer

tal que (sumaDivisores x) es la suma de los divisores de x. Por ejemplo,

   sumaDivisores 12  ==  28
   sumaDivisores 25  ==  31
   sumaDivisores (product [1..25])  ==  93383273455325195473152000
   length (show (sumaDivisores (product [1..30000])))  ==  121289
   maximum (map sumaDivisores [1..10^5])  ==  403200

sumaDivisores 12 == 28

sumaDivisores 25 == 31

sumaDivisores (product [1..25]) == 93383273455325195473152000

length (show (sumaDivisores (product [1..30000]))) == 121289

maximum (map sumaDivisores [1..10^5]) == 403200

Soluciones

import Data.List (genericLength, group, inits)
import Data.Numbers.Primes (primeFactors)
import Test.QuickCheck

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

sumaDivisores1 :: Integer -> Integer
sumaDivisores1 = sum . divisores

-- (divisores x) es la lista de los divisores de x. Por ejemplo,
--    divisores 60  ==  [1,5,3,15,2,10,6,30,4,20,12,60]
divisores :: Integer -> [Integer]
divisores = map (product . concat)
          . productoCartesiano
          . map inits
          . group
          . primeFactors

-- (productoCartesiano xss) es el producto cartesiano de los conjuntos
-- xss. Por ejemplo,
--    λ> producto [[1,3],[2,5],[6,4]]
--    [[1,2,6],[1,2,4],[1,5,6],[1,5,4],[3,2,6],[3,2,4],[3,5,6],[3,5,4]]
productoCartesiano :: [[a]] -> [[a]]
productoCartesiano []       = [[]]
productoCartesiano (xs:xss) =
  [x:ys | x <- xs, ys <- productoCartesiano xss]

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

sumaDivisores2 :: Integer -> Integer
sumaDivisores2 = sum
               . map (product . concat)
               . sequence
               . map inits
               . group
               . primeFactors

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

-- Si la descomposición de x en factores primos es
--    x = p(1)^e(1) . p(2)^e(2) . .... . p(n)^e(n)
-- entonces la suma de los divisores de x es
--    p(1)^(e(1)+1) - 1     p(2)^(e(2)+1) - 1       p(n)^(e(2)+1) - 1
--   ------------------- . ------------------- ... -------------------
--        p(1)-1                p(2)-1                  p(n)-1
-- Ver la demostración en http://bit.ly/2zUXZPc

sumaDivisores3 :: Integer -> Integer
sumaDivisores3 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)

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

-- La propiedad es
prop_sumaDivisores :: Positive Integer -> Bool
prop_sumaDivisores (Positive x) =
  all (== sumaDivisores1 x)
      [ sumaDivisores2 x
      , sumaDivisores3 x
      ]

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

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

-- La comparación es
--   λ> sumaDivisores1 251888923423315469521109880000000
--   1471072204661054993275791673480320
--   (10.63 secs, 10,614,618,080 bytes)
--   λ> sumaDivisores2 251888923423315469521109880000000
--   1471072204661054993275791673480320
--   (2.51 secs, 5,719,399,056 bytes)
--   λ> sumaDivisores3 251888923423315469521109880000000
--   1471072204661054993275791673480320
--   (0.01 secs, 177,480 bytes)

import Data.List (genericLength, group, inits)

import Data.Numbers.Primes (primeFactors)

import Test.QuickCheck

-- 1ª solución

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

sumaDivisores1 :: Integer -> Integer

sumaDivisores1 = sum . divisores

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

-- divisores 60 == [1,5,3,15,2,10,6,30,4,20,12,60]

divisores :: Integer -> [Integer]

divisores = map (product . concat)

. productoCartesiano

. map inits

. group

. primeFactors

-- (productoCartesiano xss) es el producto cartesiano de los conjuntos

-- xss. Por ejemplo,

-- λ> producto [[1,3],[2,5],[6,4]]

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

productoCartesiano :: [[a]] -> [[a]]

productoCartesiano [] = [[]]

productoCartesiano (xs:xss) =

[x:ys | x <- xs, ys <- productoCartesiano xss]

-- 2ª solución

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

sumaDivisores2 :: Integer -> Integer

sumaDivisores2 = sum

. map (product . concat)

. sequence

. map inits

. group

. primeFactors

-- 3ª solución

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

-- Si la descomposición de x en factores primos es

-- x = p(1)^e(1) . p(2)^e(2) . .... . p(n)^e(n)

-- entonces la suma de los divisores de x es

-- p(1)^(e(1)+1) - 1 p(2)^(e(2)+1) - 1 p(n)^(e(2)+1) - 1

-- ------------------- . ------------------- ... -------------------

-- p(1)-1 p(2)-1 p(n)-1

-- Ver la demostración en http://bit.ly/2zUXZPc

sumaDivisores3 :: Integer -> Integer

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

-- Comprobación de equivalencia

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

-- La propiedad es

prop_sumaDivisores :: Positive Integer -> Bool

prop_sumaDivisores (Positive x) =

all (== sumaDivisores1 x)

[ sumaDivisores2 x

, sumaDivisores3 x

]

-- La comprobación es

-- λ> quickCheck prop_sumaDivisores

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> sumaDivisores1 251888923423315469521109880000000

-- 1471072204661054993275791673480320

-- (10.63 secs, 10,614,618,080 bytes)

-- λ> sumaDivisores2 251888923423315469521109880000000

-- 1471072204661054993275791673480320

-- (2.51 secs, 5,719,399,056 bytes)

-- λ> sumaDivisores3 251888923423315469521109880000000

-- 1471072204661054993275791673480320

-- (0.01 secs, 177,480 bytes)

El código se encuentra en GitHub.

Número de divisores

PorJosé A. Alonso 13-mayo-2022

Definir la función

   numeroDivisores :: Integer -> Integer

1	numeroDivisores :: Integer -> Integer

tal que (numeroDivisores x) es el número de divisores de x. Por ejemplo,

   numeroDivisores 12  ==  6
   numeroDivisores 25  ==  3
   length (show (numeroDivisores (product [1..3*10^4])))  ==  1948

numeroDivisores 12 == 6

numeroDivisores 25 == 3

length (show (numeroDivisores (product [1..3*10^4]))) == 1948

Soluciones

import Data.List (genericLength, group, inits)
import Data.Numbers.Primes (primeFactors)
import Test.QuickCheck

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

numeroDivisores1 :: Integer -> Integer
numeroDivisores1 x =
  genericLength [y | y <- [1..x], x `mod` y == 0]

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

numeroDivisores2 :: Integer -> Integer
numeroDivisores2 1 = 1
numeroDivisores2 x
  | esCuadrado x = 2 * genericLength [y | y <- [1..raizEntera x], x `mod` y == 0] - 1
  | otherwise    = 2 * genericLength [y | y <- [1..raizEntera x], x `mod` y == 0]

-- (raizEntera x) es el mayor número entero cuyo cuadrado es menor o
-- igual que x. Por ejemplo,
--    raizEntera 3  ==  1
--    raizEntera 4  ==  2
--    raizEntera 5  ==  2
--    raizEntera 8  ==  2
--    raizEntera 9  ==  3
raizEntera :: Integer -> Integer
raizEntera x = floor (sqrt (fromInteger x))

-- (esCuadrado x) se verifica si x es un cuadrado perfecto. Por ejemplo,
--    esCuadrado 9  ==  True
--    esCuadrado 7  ==  False
esCuadrado :: Integer -> Bool
esCuadrado x =
  x == (raizEntera x)^2

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

numeroDivisores3 :: Integer -> Integer
numeroDivisores3 =
  genericLength . divisores

-- (divisores x) es la lista de los divisores de x. Por ejemplo,
--    divisores 12  ==  [1,3,2,6,4,12]
--    divisores 25  ==  [1,5,25]
divisores :: Integer -> [Integer]
divisores = map (product . concat)
          . productoCartesiano
          . map inits
          . group
          . primeFactors

-- (productoCartesiano xss) es el producto cartesiano de los conjuntos
-- xss. Por ejemplo,
--    λ> productoCartesiano [[1,3],[2,5],[6,4]]
--    [[1,2,6],[1,2,4],[1,5,6],[1,5,4],[3,2,6],[3,2,4],[3,5,6],[3,5,4]]
productoCartesiano :: [[a]] -> [[a]]
productoCartesiano []       = [[]]
productoCartesiano (xs:xss) =
  [x:ys | x <- xs, ys <- productoCartesiano xss]

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

numeroDivisores4 :: Integer -> Integer
numeroDivisores4 = genericLength
                 . map (product . concat)
                 . sequence
                 . map inits
                 . group
                 . primeFactors

-- 5ª solución
-- ===========

numeroDivisores5 :: Integer -> Integer
numeroDivisores5 =
  product . map ((+1) . genericLength) . group . primeFactors

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

-- La propiedad es
prop_numeroDivisores :: Positive Integer -> Bool
prop_numeroDivisores (Positive x) =
  all (== numeroDivisores1 x)
      [ numeroDivisores2 x
      , numeroDivisores3 x
      , numeroDivisores4 x
      , numeroDivisores5 x]

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

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

-- La comparación es
--    λ> numeroDivisores1 (product [1..10])
--    270
--    (1.67 secs, 726,327,208 bytes)
--    λ> numeroDivisores2 (product [1..10])
--    270
--    (0.01 secs, 929,000 bytes)
--
--    λ> numeroDivisores2 (product [1..16])
--    5376
--    (2.10 secs, 915,864,664 bytes)
--    λ> numeroDivisores3 (product [1..16])
--    5376
--    (0.01 secs, 548,472 bytes)
--
--    λ> numeroDivisores3 (product [1..30])
--    2332800
--    (3.80 secs, 4,149,811,688 bytes)
--    λ> numeroDivisores4 (product [1..30])
--    2332800
--    (0.59 secs, 722,253,848 bytes)
--    λ> numeroDivisores5 (product [1..30])
--    2332800
--    (0.00 secs, 587,856 bytes)

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

import Data.List (genericLength, group, inits)

import Data.Numbers.Primes (primeFactors)

import Test.QuickCheck

-- 1ª solución

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

numeroDivisores1 :: Integer -> Integer

numeroDivisores1 x =

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

-- 2ª solución

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

numeroDivisores2 :: Integer -> Integer

numeroDivisores2 1 = 1

numeroDivisores2 x

| esCuadrado x = 2 * genericLength [y | y <- [1..raizEntera x], x `mod` y == 0] - 1

| otherwise = 2 * genericLength [y | y <- [1..raizEntera x], x `mod` y == 0]

-- (raizEntera x) es el mayor número entero cuyo cuadrado es menor o

-- igual que x. Por ejemplo,

-- raizEntera 3 == 1

-- raizEntera 4 == 2

-- raizEntera 5 == 2

-- raizEntera 8 == 2

-- raizEntera 9 == 3

raizEntera :: Integer -> Integer

raizEntera x = floor (sqrt (fromInteger x))

-- (esCuadrado x) se verifica si x es un cuadrado perfecto. Por ejemplo,

-- esCuadrado 9 == True

-- esCuadrado 7 == False

esCuadrado :: Integer -> Bool

esCuadrado x =

x == (raizEntera x)^2

-- 3ª solución

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

numeroDivisores3 :: Integer -> Integer

numeroDivisores3 =

genericLength . divisores

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

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

-- divisores 25 == [1,5,25]

divisores :: Integer -> [Integer]

divisores = map (product . concat)

. productoCartesiano

. map inits

. group

. primeFactors

-- (productoCartesiano xss) es el producto cartesiano de los conjuntos

-- xss. Por ejemplo,

-- λ> productoCartesiano [[1,3],[2,5],[6,4]]

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

productoCartesiano :: [[a]] -> [[a]]

productoCartesiano [] = [[]]

productoCartesiano (xs:xss) =

[x:ys | x <- xs, ys <- productoCartesiano xss]

-- 4ª solución

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

numeroDivisores4 :: Integer -> Integer

numeroDivisores4 = genericLength

. map (product . concat)

. sequence

. map inits

. group

. primeFactors

-- 5ª solución

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

numeroDivisores5 :: Integer -> Integer

numeroDivisores5 =

product . map ((+1) . genericLength) . group . primeFactors

-- Comprobación de equivalencia

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

-- La propiedad es

prop_numeroDivisores :: Positive Integer -> Bool

prop_numeroDivisores (Positive x) =

all (== numeroDivisores1 x)

[ numeroDivisores2 x

, numeroDivisores3 x

, numeroDivisores4 x

, numeroDivisores5 x]

-- La comprobación es

-- λ> quickCheck prop_numeroDivisores

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> numeroDivisores1 (product [1..10])

-- 270

-- (1.67 secs, 726,327,208 bytes)

-- λ> numeroDivisores2 (product [1..10])

-- 270

-- (0.01 secs, 929,000 bytes)

-- λ> numeroDivisores2 (product [1..16])

-- 5376

-- (2.10 secs, 915,864,664 bytes)

-- λ> numeroDivisores3 (product [1..16])

-- 5376

-- (0.01 secs, 548,472 bytes)

-- λ> numeroDivisores3 (product [1..30])

-- 2332800

-- (3.80 secs, 4,149,811,688 bytes)

-- λ> numeroDivisores4 (product [1..30])

-- 2332800

-- (0.59 secs, 722,253,848 bytes)

-- λ> numeroDivisores5 (product [1..30])

-- 2332800

-- (0.00 secs, 587,856 bytes)

El código se encuentra en GitHub.

Conjunto de divisores

PorJosé A. Alonso 12-mayo-202212-mayo-2022

Definir la función

   divisores :: Integer -> [Integer]

1	divisores :: Integer -> [Integer]

tal que (divisores x) es el conjunto de divisores de x. Por ejemplo,

  divisores 30  ==  [1,2,3,5,6,10,15,30]
  length (divisores (product [1..10]))  ==  270
  length (divisores (product [1..25]))  ==  340032

divisores 30 == [1,2,3,5,6,10,15,30]

length (divisores (product [1..10])) == 270

length (divisores (product [1..25])) == 340032

Soluciones

import Data.List (group, inits, nub, sort, subsequences)
import Data.Numbers.Primes (primeFactors)
import Test.QuickCheck

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

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

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

divisores2 :: Integer -> [Integer]
divisores2 n = filter ((== 0) . mod n) [1..n]

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

divisores3 :: Integer -> [Integer]
divisores3 =
  nub . sort . map product . subsequences . primeFactors

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

divisores4 :: Integer -> [Integer]
divisores4 =
  sort
  . map (product . concat)
  . productoCartesiano
  . map inits
  . group
  . primeFactors

-- (productoCartesiano xss) es el producto cartesiano de los conjuntos
-- xss. Por ejemplo,
--    λ> productoCartesiano [[1,3],[2,5],[6,4]]
--    [[1,2,6],[1,2,4],[1,5,6],[1,5,4],[3,2,6],[3,2,4],[3,5,6],[3,5,4]]
productoCartesiano :: [[a]] -> [[a]]
productoCartesiano []       = [[]]
productoCartesiano (xs:xss) =
  [x:ys | x <- xs, ys <- productoCartesiano xss]

-- 5ª solución
-- ===========

divisores5 :: Integer -> [Integer]
divisores5 = sort
           . map (product . concat)
           . sequence
           . map inits
           . group
           . primeFactors

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

-- La propiedad es
prop_divisores :: Positive Integer -> Bool
prop_divisores (Positive n) =
  all (== divisores1 n)
      [ divisores2 n
      , divisores3 n
      , divisores4 n
      , divisores5 n
      ]

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

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

--    λ> length (divisores (product [1..11]))
--    540
--    (12.51 secs, 7,983,499,736 bytes)
--    λ> length (divisores2 (product [1..11]))
--    540
--    (4.81 secs, 4,790,146,656 bytes)
--    λ> length (divisores3 (product [1..11]))
--    540
--    (0.10 secs, 107,339,848 bytes)
--    λ> length (divisores4 (product [1..11]))
--    540
--    (0.02 secs, 1,702,616 bytes)
--    λ> length (divisores5 (product [1..11]))
--    540
--    (0.02 secs, 1,205,824 bytes)
--
--    λ> length (divisores3 (product [1..14]))
--    2592
--    (7.89 secs, 9,378,454,912 bytes)
--    λ> length (divisores4 (product [1..14]))
--    2592
--    (0.03 secs, 9,426,528 bytes)
--    λ> length (divisores5 (product [1..14]))
--    2592
--    (0.02 secs, 6,636,608 bytes)
--    
--    λ> length (divisores4 (product [1..25]))
--    340032
--    (1.65 secs, 2,055,558,208 bytes)
--    λ> length (divisores5 (product [1..25]))
--    340032
--    (0.88 secs, 1,532,515,304 bytes)

100

101

102

103

104

105

106

107

import Data.List (group, inits, nub, sort, subsequences)

import Data.Numbers.Primes (primeFactors)

import Test.QuickCheck

-- 1ª solución

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

divisores1 :: Integer -> [Integer]

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

-- 2ª solución

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

divisores2 :: Integer -> [Integer]

divisores2 n = filter ((== 0) . mod n) [1..n]

-- 3ª solución

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

divisores3 :: Integer -> [Integer]

divisores3 =

nub . sort . map product . subsequences . primeFactors

-- 4ª solución

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

divisores4 :: Integer -> [Integer]

divisores4 =

sort

. map (product . concat)

. productoCartesiano

. map inits

. group

. primeFactors

-- (productoCartesiano xss) es el producto cartesiano de los conjuntos

-- xss. Por ejemplo,

-- λ> productoCartesiano [[1,3],[2,5],[6,4]]

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

productoCartesiano :: [[a]] -> [[a]]

productoCartesiano [] = [[]]

productoCartesiano (xs:xss) =

[x:ys | x <- xs, ys <- productoCartesiano xss]

-- 5ª solución

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

divisores5 :: Integer -> [Integer]

divisores5 = sort

. map (product . concat)

. sequence

. map inits

. group

. primeFactors

-- Comprobación de equivalencia

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

-- La propiedad es

prop_divisores :: Positive Integer -> Bool

prop_divisores (Positive n) =

all (== divisores1 n)

[ divisores2 n

, divisores3 n

, divisores4 n

, divisores5 n

]

-- La comprobación es

-- λ> quickCheck prop_divisores

-- +++ OK, passed 100 tests.

-- Comparación de la eficiencia

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

-- λ> length (divisores (product [1..11]))

-- 540

-- (12.51 secs, 7,983,499,736 bytes)

-- λ> length (divisores2 (product [1..11]))

-- 540

-- (4.81 secs, 4,790,146,656 bytes)

-- λ> length (divisores3 (product [1..11]))

-- 540

-- (0.10 secs, 107,339,848 bytes)

-- λ> length (divisores4 (product [1..11]))

-- 540

-- (0.02 secs, 1,702,616 bytes)

-- λ> length (divisores5 (product [1..11]))

-- 540

-- (0.02 secs, 1,205,824 bytes)

-- λ> length (divisores3 (product [1..14]))

-- 2592

-- (7.89 secs, 9,378,454,912 bytes)

-- λ> length (divisores4 (product [1..14]))

-- 2592

-- (0.03 secs, 9,426,528 bytes)

-- λ> length (divisores5 (product [1..14]))

-- 2592

-- (0.02 secs, 6,636,608 bytes)

-- λ> length (divisores4 (product [1..25]))

-- 340032

-- (1.65 secs, 2,055,558,208 bytes)

-- λ> length (divisores5 (product [1..25]))

-- 340032

-- (0.88 secs, 1,532,515,304 bytes)

El código se encuentra en GitHub.

Reconocimiento de potencias de 2

PorJosé A. Alonso 11-mayo-2022

Definir la función

   esPotenciaDeDos :: Integer -> Bool

1	esPotenciaDeDos :: Integer -> Bool

tal que (esPotenciaDeDos n) se verifica si n es una potencia de dos (suponiendo que n es mayor que 0). Por ejemplo.

   esPotenciaDeDos    1        == True
   esPotenciaDeDos    2        == True
   esPotenciaDeDos    6        == False
   esPotenciaDeDos    8        == True
   esPotenciaDeDos 1024        == True
   esPotenciaDeDos 1026        == False
   esPotenciaDeDos (2^(10^8))  == True

esPotenciaDeDos 1 == True

esPotenciaDeDos 2 == True

esPotenciaDeDos 6 == False

esPotenciaDeDos 8 == True

esPotenciaDeDos 1024 == True

esPotenciaDeDos 1026 == False

esPotenciaDeDos (2^(10^8)) == True

Soluciones

import Data.Bits ((.&.))
import Data.Numbers.Primes (primeFactors)
import Test.QuickCheck (Positive (Positive), quickCheck)

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

esPotenciaDeDos1 :: Integer -> Bool
esPotenciaDeDos1 1 = True
esPotenciaDeDos1 n
  | even n    = esPotenciaDeDos1 (n `div` 2)
  | otherwise = False

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

esPotenciaDeDos2 :: Integer -> Bool
esPotenciaDeDos2 n = n ==
  head (dropWhile (<n) potenciasDeDos)

-- potenciasDeDos es la lista de las potencias de dos. Por ejemplo,
--    take 10 potenciasDeDos  == [1,2,4,8,16,32,64,128,256,512]
potenciasDeDos :: [Integer]
potenciasDeDos = iterate (*2) 1

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

esPotenciaDeDos3 :: Integer -> Bool
esPotenciaDeDos3 x = all (==2) (primeFactors x)

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

-- Usando la función (.&.) de la librería Data.Bits. Dicha función
-- calcula el número correspondiente a la conjunción de las
-- representaciones binarias de sus argumentos. Por ejemplo,
--    6 .&. 3 == 2
-- ya que
--    la representación binaria de 6 es     [1,1,0]
--    la representación binaria de 3 es       [1,1]
--    la conjunción es                        [1,0]
--    la representación decimal de [1,0] es   2
--
-- Otros ejemplos:
--    4 .&. 3 ==   [1,0,0] .&.   [1,1] == 0
--    8 .&. 7 == [1,0,0,0] .&. [1,1,1] = 0

esPotenciaDeDos4 :: Integer -> Bool
esPotenciaDeDos4 n = n .&. (n-1) == 0

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

-- La propiedad es
prop_esPotenciaDeDos :: Positive Integer -> Bool
prop_esPotenciaDeDos (Positive n) =
  all (== esPotenciaDeDos1 n)
      [ esPotenciaDeDos2 n
      , esPotenciaDeDos3 n
      , esPotenciaDeDos4 n
      ]

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

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

-- La comparación es
--    λ> esPotenciaDeDos1 (2^(3*10^5))
--    True
--    (3.51 secs, 5,730,072,544 bytes)
--    λ> esPotenciaDeDos2 (2^(3*10^5))
--    True
--    (3.12 secs, 5,755,639,952 bytes)
--    λ> esPotenciaDeDos3 (2^(3*10^5))
--    True
--    (2.92 secs, 5,758,872,040 bytes)
--    λ> esPotenciaDeDos4 (2^(3*10^5))
--    True
--    (0.03 secs, 715,152 bytes)

import Data.Bits ((.&.))

import Data.Numbers.Primes (primeFactors)

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

-- 1ª solución

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

esPotenciaDeDos1 :: Integer -> Bool

esPotenciaDeDos1 1 = True

esPotenciaDeDos1 n

| even n = esPotenciaDeDos1 (n `div` 2)

| otherwise = False

-- 2ª solución

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

esPotenciaDeDos2 :: Integer -> Bool

esPotenciaDeDos2 n = n ==

head (dropWhile (<n) potenciasDeDos)

-- potenciasDeDos es la lista de las potencias de dos. Por ejemplo,

-- take 10 potenciasDeDos == [1,2,4,8,16,32,64,128,256,512]

potenciasDeDos :: [Integer]

potenciasDeDos = iterate (*2) 1

-- 3ª solución

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

esPotenciaDeDos3 :: Integer -> Bool

esPotenciaDeDos3 x = all (==2) (primeFactors x)

-- 4ª solución

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

-- Usando la función (.&.) de la librería Data.Bits. Dicha función

-- calcula el número correspondiente a la conjunción de las

-- representaciones binarias de sus argumentos. Por ejemplo,

-- 6 .&. 3 == 2

-- ya que

-- la representación binaria de 6 es [1,1,0]

-- la representación binaria de 3 es [1,1]

-- la conjunción es [1,0]

-- la representación decimal de [1,0] es 2

-- Otros ejemplos:

-- 4 .&. 3 == [1,0,0] .&. [1,1] == 0

-- 8 .&. 7 == [1,0,0,0] .&. [1,1,1] = 0

esPotenciaDeDos4 :: Integer -> Bool

esPotenciaDeDos4 n = n .&. (n-1) == 0

-- Comprobación de equivalencia

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

-- La propiedad es

prop_esPotenciaDeDos :: Positive Integer -> Bool

prop_esPotenciaDeDos (Positive n) =

all (== esPotenciaDeDos1 n)

[ esPotenciaDeDos2 n

, esPotenciaDeDos3 n

, esPotenciaDeDos4 n

]

-- La comprobación es

-- λ> quickCheck prop_esPotenciaDeDos

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> esPotenciaDeDos1 (2^(3*10^5))

-- True

-- (3.51 secs, 5,730,072,544 bytes)

-- λ> esPotenciaDeDos2 (2^(3*10^5))

-- True

-- (3.12 secs, 5,755,639,952 bytes)

-- λ> esPotenciaDeDos3 (2^(3*10^5))

-- True

-- (2.92 secs, 5,758,872,040 bytes)

-- λ> esPotenciaDeDos4 (2^(3*10^5))

-- True

-- (0.03 secs, 715,152 bytes)

El código se encuentra en GitHub.

Particiones de enteros positivos

PorJosé A. Alonso 10-mayo-202210-mayo-2022

Una partición de un entero positivo n es una manera de escribir n como una suma de enteros positivos. Dos sumas que sólo difieren en el orden de sus sumandos se consideran la misma partición. Por ejemplo, 4 tiene cinco particiones: 4, 3+1, 2+2, 2+1+1 y 1+1+1+1.

Definir la función

   particiones :: Int -> [[Int]]

1	particiones :: Int -> [[Int]]

tal que (particiones n) es la lista de las particiones del número n. Por ejemplo,

   particiones 4  ==  [[4],[3,1],[2,2],[2,1,1],[1,1,1,1]]
   particiones 5  ==  [[5],[4,1],[3,2],[3,1,1],[2,2,1],[2,1,1,1],[1,1,1,1,1]]
   length (particiones 50)  ==  204226

particiones 4 == [[4],[3,1],[2,2],[2,1,1],[1,1,1,1]]

particiones 5 == [[5],[4,1],[3,2],[3,1,1],[2,2,1],[2,1,1,1],[1,1,1,1,1]]

length (particiones 50) == 204226

Soluciones

module Particiones_de_enteros_positivos where

import Test.QuickCheck

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

particiones1 :: Int -> [[Int]]
particiones1 0 = [[]]
particiones1 n = [x:y | x <- [n,n-1..1],
                        y <- particiones1 (n-x),
                        [x] >= take 1 y]

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

particiones2 :: Int -> [[Int]]
particiones2 n = aux !! n
  where
    aux = [] : map particiones [1..]
    particiones m = [m] : [x:p | x <- [m,m-1..1],
                                 p <- aux !! (m-x),
                                 x >= head p]

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

particiones3 :: Int -> [[Int]]
particiones3 n = aux n n
  where aux 0 _ = [[]]
        aux n' m = concat [map (i:) (aux (n'-i) i)
                          | i <- [n',n'-1..1], i <= m]

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

particiones4 :: Int -> [[Int]]
particiones4 n = aux n n
  where aux 0 _ = [[]]
        aux n' m = concat [map (i:) (aux (n'-i) i)
                          | i <- [k,k-1..1]]
          where k = min m n'

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

-- La propiedad es
prop_particiones :: Positive Int -> Bool
prop_particiones (Positive n) =
  all (== particiones1 n)
      [ particiones2 n
      , particiones3 n
      , particiones4 n
      ]

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

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

-- La comparación es
--    λ> length (particiones1 23)
--    1255
--    (12.50 secs, 6,614,487,992 bytes)
--    λ> length (particiones2 23)
--    1255
--    (0.04 secs, 3,071,104 bytes)
--    λ> length (particiones3 23)
--    1255
--    (0.02 secs, 9,163,544 bytes)
--    λ> length (particiones4 23)
--    1255
--    (0.01 secs, 7,149,512 bytes)
--
--    λ> length (particiones2 50)
--    204226
--    (2.50 secs, 758,729,104 bytes)
--    λ> length (particiones3 50)
--    204226
--    (4.26 secs, 2,359,121,096 bytes)
--    λ> length (particiones4 50)
--    204226
--    (2.67 secs, 1,598,588,040 bytes)

module Particiones_de_enteros_positivos where

import Test.QuickCheck

-- 1ª solución

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

particiones1 :: Int -> [[Int]]

particiones1 0 = [[]]

particiones1 n = [x:y | x <- [n,n-1..1],

y <- particiones1 (n-x),

[x] >= take 1 y]

-- 2ª solución

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

particiones2 :: Int -> [[Int]]

particiones2 n = aux !! n

where

aux = [] : map particiones [1..]

particiones m = [m] : [x:p | x <- [m,m-1..1],

p <- aux !! (m-x),

x >= head p]

-- 3ª solución

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

particiones3 :: Int -> [[Int]]

particiones3 n = aux n n

where aux 0 _ = [[]]

aux n' m = concat [map (i:) (aux (n'-i) i)

| i <- [n',n'-1..1], i <= m]

-- 4ª solución

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

particiones4 :: Int -> [[Int]]

particiones4 n = aux n n

where aux 0 _ = [[]]

aux n' m = concat [map (i:) (aux (n'-i) i)

| i <- [k,k-1..1]]

where k = min m n'

-- Comprobación de equivalencia

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

-- La propiedad es

prop_particiones :: Positive Int -> Bool

prop_particiones (Positive n) =

all (== particiones1 n)

[ particiones2 n

, particiones3 n

, particiones4 n

]

-- La comprobación es

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

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia --

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

-- La comparación es

-- λ> length (particiones1 23)

-- 1255

-- (12.50 secs, 6,614,487,992 bytes)

-- λ> length (particiones2 23)

-- 1255

-- (0.04 secs, 3,071,104 bytes)

-- λ> length (particiones3 23)

-- 1255

-- (0.02 secs, 9,163,544 bytes)

-- λ> length (particiones4 23)

-- 1255

-- (0.01 secs, 7,149,512 bytes)

-- λ> length (particiones2 50)

-- 204226

-- (2.50 secs, 758,729,104 bytes)

-- λ> length (particiones3 50)

-- 204226

-- (4.26 secs, 2,359,121,096 bytes)

-- λ> length (particiones4 50)

-- 204226

-- (2.67 secs, 1,598,588,040 bytes)

El código se encuentra en GitHub.

Mínimo producto escalar

PorJosé A. Alonso 9-mayo-202214-mayo-2022

El producto escalar de los vectores [a1,a2,…,an] y [b1,b2,…, bn] es

   a1 * b1 + a2 * b2 + ··· + an * bn.

1	a1 * b1 + a2 * b2 + ··· + an * bn.

Definir la función

   menorProductoEscalar :: (Ord a, Num a) => [a] -> [a] -> a

1	menorProductoEscalar :: (Ord a, Num a) => [a] -> [a] -> a

tal que (menorProductoEscalar xs ys) es el mínimo de los productos escalares de las permutaciones de xs y de las permutaciones de ys. Por ejemplo,

   menorProductoEscalar [3,2,5]  [1,4,6]    == 29
   menorProductoEscalar [3,2,5]  [1,4,-6]   == -19
   menorProductoEscalar [1..10^2] [1..10^2] == 171700
   menorProductoEscalar [1..10^3] [1..10^3] == 167167000
   menorProductoEscalar [1..10^4] [1..10^4] == 166716670000
   menorProductoEscalar [1..10^5] [1..10^5] == 166671666700000
   menorProductoEscalar [1..10^6] [1..10^6] == 166667166667000000

menorProductoEscalar [3,2,5] [1,4,6] == 29

menorProductoEscalar [3,2,5] [1,4,-6] == -19

menorProductoEscalar [1..10^2] [1..10^2] == 171700

menorProductoEscalar [1..10^3] [1..10^3] == 167167000

menorProductoEscalar [1..10^4] [1..10^4] == 166716670000

menorProductoEscalar [1..10^5] [1..10^5] == 166671666700000

menorProductoEscalar [1..10^6] [1..10^6] == 166667166667000000

Soluciones

module Minimo_producto_escalar where

import Data.List (sort, permutations)
import Test.QuickCheck (quickCheck)

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

menorProductoEscalar1 :: (Ord a, Num a) => [a] -> [a] -> a
menorProductoEscalar1 xs ys =
  minimum [sum (zipWith (*) pxs pys) | pxs <- permutations xs,
                                       pys <- permutations ys]

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

menorProductoEscalar2 :: (Ord a, Num a) => [a] -> [a] -> a
menorProductoEscalar2 xs ys =
  minimum [sum (zipWith (*) pxs ys) | pxs <- permutations xs]

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

menorProductoEscalar3 :: (Ord a, Num a) => [a] -> [a] -> a
menorProductoEscalar3 xs ys =
  sum (zipWith (*) (sort xs) (reverse (sort ys)))

-- Equivalencia
-- ============

-- La propiedad es
prop_menorProductoEscalar :: [Integer] -> [Integer] -> Bool
prop_menorProductoEscalar xs ys =
  all (== menorProductoEscalar1 xs' ys')
      [menorProductoEscalar2 xs' ys',
       menorProductoEscalar3 xs' ys']
  where n   = min (length xs) (length ys)
        xs' = take n xs
        ys' = take n ys

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

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

-- La comparación es
--    λ> menorProductoEscalar1 [0..5] [0..5]
--    20
--    (3.24 secs, 977385528 bytes)
--    λ> menorProductoEscalar2 [0..5] [0..5]
--    20
--    (0.01 secs, 4185776 bytes)
--
--    λ> menorProductoEscalar2 [0..9] [0..9]
--    120
--    (23.86 secs, 9342872784 bytes)
--    λ> menorProductoEscalar3 [0..9] [0..9]
--    120
--    (0.01 secs, 2580824 bytes)
--
--    λ> menorProductoEscalar3 [0..10^6] [0..10^6]
--    166666666666500000
--    (2.46 secs, 473,338,912 bytes)

module Minimo_producto_escalar where

import Data.List (sort, permutations)

import Test.QuickCheck (quickCheck)

-- 1ª solución

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

menorProductoEscalar1 :: (Ord a, Num a) => [a] -> [a] -> a

menorProductoEscalar1 xs ys =

minimum [sum (zipWith (*) pxs pys) | pxs <- permutations xs,

pys <- permutations ys]

-- 2ª solución

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

menorProductoEscalar2 :: (Ord a, Num a) => [a] -> [a] -> a

menorProductoEscalar2 xs ys =

minimum [sum (zipWith (*) pxs ys) | pxs <- permutations xs]

-- 3ª solución

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

menorProductoEscalar3 :: (Ord a, Num a) => [a] -> [a] -> a

menorProductoEscalar3 xs ys =

sum (zipWith (*) (sort xs) (reverse (sort ys)))

-- Equivalencia

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

-- La propiedad es

prop_menorProductoEscalar :: [Integer] -> [Integer] -> Bool

prop_menorProductoEscalar xs ys =

all (== menorProductoEscalar1 xs' ys')

[menorProductoEscalar2 xs' ys',

menorProductoEscalar3 xs' ys']

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

xs' = take n xs

ys' = take n ys

-- La comprobación es

-- λ> quickCheckWith (stdArgs {maxSize=7}) prop_menorProductoEscalar

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> menorProductoEscalar1 [0..5] [0..5]

-- 20

-- (3.24 secs, 977385528 bytes)

-- λ> menorProductoEscalar2 [0..5] [0..5]

-- 20

-- (0.01 secs, 4185776 bytes)

-- λ> menorProductoEscalar2 [0..9] [0..9]

-- 120

-- (23.86 secs, 9342872784 bytes)

-- λ> menorProductoEscalar3 [0..9] [0..9]

-- 120

-- (0.01 secs, 2580824 bytes)

-- λ> menorProductoEscalar3 [0..10^6] [0..10^6]

-- 166666666666500000

-- (2.46 secs, 473,338,912 bytes)

El código se encuentra en GitHub.

Puntos en regiones rectangulares

PorJosé A. Alonso 5-mayo-20225-mayo-2022

Los puntos se puede representar mediante pares de números

   type Punto = (Int,Int)

1	type Punto = (Int,Int)

y las regiones rectangulares mediante el siguiente tipo de dato

   data Region = Rectangulo Punto  Punto
               | Union      Region Region
               | Diferencia Region Region
     deriving (Eq, Show)

data Region = Rectangulo Punto Punto

| Union Region Region

| Diferencia Region Region

deriving (Eq, Show)

donde

(Rectangulo p1 p2) es la región formada por un rectángulo cuyo vértice superior izquierdo es p1 y su vértice inferior derecho es p2.
(Union r1 r2) es la región cuyos puntos pertenecen a alguna de las regiones r1 y r2.
(Diferencia r1 r2) es la región cuyos puntos pertenecen a la región r1 pero no pertenecen a la r2.

Definir la función

   enRegion :: Punto -> Region -> Bool

1	enRegion :: Punto -> Region -> Bool

tal que (enRegion p r) se verifica si el punto p pertenece a la región r. Por ejemplo, usando las regiones definidas por

   r0021, r3051, r4162 :: Region
   r0021 = Rectangulo (0,0) (2,1)
   r3051 = Rectangulo (3,0) (5,1)
   r4162 = Rectangulo (4,1) (6,2)

r0021, r3051, r4162 :: Region

r0021 = Rectangulo (0,0) (2,1)

r3051 = Rectangulo (3,0) (5,1)

r4162 = Rectangulo (4,1) (6,2)

se tiene

   enRegion (1,0) r0021                                   ==  True
   enRegion (3,0) r0021                                   ==  False
   enRegion (1,1) (Union r0021 r3051)                     ==  True
   enRegion (4,0) (Union r0021 r3051)                     ==  True
   enRegion (4,2) (Union r0021 r3051)                     ==  False
   enRegion (3,1) (Diferencia r3051 r4162)                ==  True
   enRegion (4,1) (Diferencia r3051 r4162)                ==  False
   enRegion (4,2) (Diferencia r3051 r4162)                ==  False
   enRegion (4,2) (Union (Diferencia r3051 r4162) r4162)  ==  True

enRegion (1,0) r0021 == True

enRegion (3,0) r0021 == False

enRegion (1,1) (Union r0021 r3051) == True

enRegion (4,0) (Union r0021 r3051) == True

enRegion (4,2) (Union r0021 r3051) == False

enRegion (3,1) (Diferencia r3051 r4162) == True

enRegion (4,1) (Diferencia r3051 r4162) == False

enRegion (4,2) (Diferencia r3051 r4162) == False

enRegion (4,2) (Union (Diferencia r3051 r4162) r4162) == True

Comprobar con QuickCheck que si el punto p está en la región r1, entonces, para cualquier región r2, p está en (Union r1 r2) y en (Union r2 r1), pero no está en (Diferencia r2 r1).

Soluciones

module Puntos_en_regiones_rectangulares where

import Test.QuickCheck (Arbitrary, Gen, Property, (==>), arbitrary, oneof,
                        sized, generate, quickCheck, quickCheckWith, stdArgs,
                        Args(maxDiscardRatio))

type Punto = (Int,Int)

data Region = Rectangulo Punto  Punto
            | Union      Region Region
            | Diferencia Region Region
  deriving (Eq, Show)

r0021, r3051, r4162 :: Region
r0021 = Rectangulo (0,0) (2,1)
r3051 = Rectangulo (3,0) (5,1)
r4162 = Rectangulo (4,1) (6,2)

enRegion :: Punto -> Region -> Bool
enRegion (x,y) (Rectangulo (x1,y1) (x2,y2)) =
  x1 <= x && x <= x2 &&
  y1 <= y && y <= y2
enRegion p (Union  r1 r2) =
  enRegion p r1 || enRegion p r2
enRegion p (Diferencia r1 r2) =
  enRegion p r1 && not (enRegion p r2)

-- (regionArbitraria n) es un generador de regiones arbitrarias de orden
-- n. Por ejemplo,
--    λ> generate (regionArbitraria 2)
--    Rectangulo (30,-26) (-2,-8)
--    λ> generate (regionArbitraria 2)
--    Union (Union (Rectangulo (-2,-5) (6,1)) (Rectangulo(3,7) (11,15)))
--          (Diferencia (Rectangulo (9,8) (-2,6)) (Rectangulo (-2,2) (7,8)))
regionArbitraria :: Int -> Gen Region
regionArbitraria 0 =
  Rectangulo <$> arbitrary <*> arbitrary
regionArbitraria n =
  oneof [Rectangulo <$> arbitrary <*> arbitrary,
         Union <$> subregion <*> subregion,
         Diferencia <$> subregion <*> subregion]
  where subregion = regionArbitraria (n `div` 2)

-- Region está contenida en Arbitrary
instance Arbitrary Region where
  arbitrary = sized regionArbitraria

-- La propiedad es
prop_enRegion :: Punto -> Region -> Region -> Property
prop_enRegion p r1 r2 =
  enRegion p r1 ==>
  (enRegion p (Union  r1 r2) &&
   enRegion p (Union  r2 r1) &&
   not (enRegion p (Diferencia r2 r1)))

-- La comprobación es
--    λ> quickCheck prop_enRegion
--    *** Gave up! Passed only 78 tests; 1000 discarded tests.
--
--    λ> quickCheckWith (stdArgs {maxDiscardRatio=20}) prop_enRegion
--    +++ OK, passed 100 tests.

module Puntos_en_regiones_rectangulares where

import Test.QuickCheck (Arbitrary, Gen, Property, (==>), arbitrary, oneof,

sized, generate, quickCheck, quickCheckWith, stdArgs,

Args(maxDiscardRatio))

type Punto = (Int,Int)

data Region = Rectangulo Punto Punto

| Union Region Region

| Diferencia Region Region

deriving (Eq, Show)

r0021, r3051, r4162 :: Region

r0021 = Rectangulo (0,0) (2,1)

r3051 = Rectangulo (3,0) (5,1)

r4162 = Rectangulo (4,1) (6,2)

enRegion :: Punto -> Region -> Bool

enRegion (x,y) (Rectangulo (x1,y1) (x2,y2)) =

x1 <= x && x <= x2 &&

y1 <= y && y <= y2

enRegion p (Union r1 r2) =

enRegion p r1 || enRegion p r2

enRegion p (Diferencia r1 r2) =

enRegion p r1 && not (enRegion p r2)

-- (regionArbitraria n) es un generador de regiones arbitrarias de orden

-- n. Por ejemplo,

-- λ> generate (regionArbitraria 2)

-- Rectangulo (30,-26) (-2,-8)

-- λ> generate (regionArbitraria 2)

-- Union (Union (Rectangulo (-2,-5) (6,1)) (Rectangulo(3,7) (11,15)))

-- (Diferencia (Rectangulo (9,8) (-2,6)) (Rectangulo (-2,2) (7,8)))

regionArbitraria :: Int -> Gen Region

regionArbitraria 0 =

Rectangulo <$> arbitrary <*> arbitrary

regionArbitraria n =

oneof [Rectangulo <$> arbitrary <*> arbitrary,

Union <$> subregion <*> subregion,

Diferencia <$> subregion <*> subregion]

where subregion = regionArbitraria (n `div` 2)

-- Region está contenida en Arbitrary

instance Arbitrary Region where

arbitrary = sized regionArbitraria

-- La propiedad es

prop_enRegion :: Punto -> Region -> Region -> Property

prop_enRegion p r1 r2 =

enRegion p r1 ==>

(enRegion p (Union r1 r2) &&

enRegion p (Union r2 r1) &&

not (enRegion p (Diferencia r2 r1)))

-- La comprobación es

-- λ> quickCheck prop_enRegion

-- *** Gave up! Passed only 78 tests; 1000 discarded tests.

-- λ> quickCheckWith (stdArgs {maxDiscardRatio=20}) prop_enRegion

-- +++ OK, passed 100 tests.

El código se encuentra en GitHub.

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

Clausura de un conjunto respecto de una función

PorJosé A. Alonso 2-mayo-20223-mayo-2022

Un conjunto A está cerrado respecto de una función f si para elemento x de A se tiene que f(x) pertenece a A. La clausura de un conjunto B respecto de una función f es el menor conjunto A que contiene a B y es cerrado respecto de f. Por ejemplo, la clausura de {0,1,2] respecto del opuesto es {-2,-1,0,1,2}.

Definir la función

   clausura :: Ord a => (a -> a) -> [a] -> [a]

1	clausura :: Ord a => (a -> a) -> [a] -> [a]

tal que (clausura f xs) es la clausura de xs respecto de f. Por ejemplo,

   clausura (\x -> -x) [0,1,2]         ==  [-2,-1,0,1,2]
   clausura (\x -> (x+1) `mod` 5) [0]  ==  [0,1,2,3,4]
   length (clausura (\x -> (x+1) `mod` (10^6)) [0]) == 1000000

clausura (\x -> -x) [0,1,2] == [-2,-1,0,1,2]

clausura (\x -> (x+1) `mod` 5) [0] == [0,1,2,3,4]

length (clausura (\x -> (x+1) `mod` (10^6)) [0]) == 1000000

Soluciones

module Clausura where

import Data.List ((\\), nub, sort, union)
import Test.QuickCheck.HigherOrder (quickCheck')
import qualified Data.Set as S (Set, difference, fromList, map, null, toList, union)

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

clausura1 :: Ord a => (a -> a) -> [a] -> [a]
clausura1 f xs
  | esCerrado f xs = sort xs
  | otherwise      = clausura1 f (expansion f xs)

-- (esCerrado f xs) se verifica si al aplicar f a cualquier elemento de
-- xs se obtiene un elemento de xs. Por ejemplo,
--    λ> esCerrado (\x -> -x) [0,1,2]
--    False
--    λ> esCerrado (\x -> -x) [0,1,2,-2,-1]
--    True
esCerrado :: Ord a => (a -> a) -> [a] -> Bool
esCerrado f xs = all (`elem` xs) (map f xs)

-- (expansion f xs) es la lista (sin repeticiones) obtenidas añadiéndole
-- a xs el resulta de aplicar f a sus elementos. Por ejemplo,
--    expansion (\x -> -x) [0,1,2]  ==  [0,1,2,-1,-2]
expansion :: Ord a => (a -> a) -> [a] -> [a]
expansion f xs = xs `union` map f xs

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

clausura2 :: Ord a => (a -> a) -> [a] -> [a]
clausura2 f xs = sort (until (esCerrado f) (expansion f) xs)

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

clausura3 :: Ord a => (a -> a) -> [a] -> [a]
clausura3 f xs = aux xs xs
  where aux ys vs | null ns   = sort vs
                  | otherwise = aux ns (vs ++ ns)
          where ns = nub (map f ys) \\ vs

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

clausura4 :: Ord a => (a -> a) -> [a] -> [a]
clausura4 f xs = S.toList (clausura4' f (S.fromList xs))

clausura4' :: Ord a => (a -> a) -> S.Set a -> S.Set a
clausura4' f xs = aux xs xs
  where aux ys vs | S.null ns = vs
                  | otherwise = aux ns (vs `S.union` ns)
          where ns = S.map f ys `S.difference` vs

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

-- La propiedad es
prop_clausura :: (Int -> Int) -> [Int] -> Bool
prop_clausura f xs =
  all (== clausura1 f xs')
      [ clausura2 f xs'
      , clausura3 f xs'
      , clausura4 f xs'
      ]
  where xs' = sort (nub xs)

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

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

-- La comparación es
--    λ> length (clausura1 (\x -> (x+1) `mod` 800) [0])
--    800
--    (1.95 secs, 213,481,560 bytes)
--    λ> length (clausura2 (\x -> (x+1) `mod` 800) [0])
--    800
--    (1.96 secs, 213,372,824 bytes)
--    λ> length (clausura3 (\x -> (x+1) `mod` 800) [0])
--    800
--    (0.03 secs, 42,055,128 bytes)
--    λ> length (clausura4 (\x -> (x+1) `mod` 800) [0])
--    800
--    (0.01 secs, 1,779,768 bytes)
--
--    λ> length (clausura3 (\x -> (x+1) `mod` (10^4)) [0])
--    10000
--    (2.50 secs, 8,080,105,816 bytes)
--    λ> length (clausura4 (\x -> (x+1) `mod` (10^4)) [0])
--    10000
--    (0.05 secs, 27,186,920 bytes)

module Clausura where

import Data.List ((\\), nub, sort, union)

import Test.QuickCheck.HigherOrder (quickCheck')

import qualified Data.Set as S (Set, difference, fromList, map, null, toList, union)

-- 1ª solución

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

clausura1 :: Ord a => (a -> a) -> [a] -> [a]

clausura1 f xs

| esCerrado f xs = sort xs

| otherwise = clausura1 f (expansion f xs)

-- (esCerrado f xs) se verifica si al aplicar f a cualquier elemento de

-- xs se obtiene un elemento de xs. Por ejemplo,

-- λ> esCerrado (\x -> -x) [0,1,2]

-- False

-- λ> esCerrado (\x -> -x) [0,1,2,-2,-1]

-- True

esCerrado :: Ord a => (a -> a) -> [a] -> Bool

esCerrado f xs = all (`elem` xs) (map f xs)

-- (expansion f xs) es la lista (sin repeticiones) obtenidas añadiéndole

-- a xs el resulta de aplicar f a sus elementos. Por ejemplo,

-- expansion (\x -> -x) [0,1,2] == [0,1,2,-1,-2]

expansion :: Ord a => (a -> a) -> [a] -> [a]

expansion f xs = xs `union` map f xs

-- 2ª solución

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

clausura2 :: Ord a => (a -> a) -> [a] -> [a]

clausura2 f xs = sort (until (esCerrado f) (expansion f) xs)

-- 3ª solución

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

clausura3 :: Ord a => (a -> a) -> [a] -> [a]

clausura3 f xs = aux xs xs

where aux ys vs | null ns = sort vs

| otherwise = aux ns (vs ++ ns)

where ns = nub (map f ys) \\ vs

-- 4ª solución

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

clausura4 :: Ord a => (a -> a) -> [a] -> [a]

clausura4 f xs = S.toList (clausura4' f (S.fromList xs))

clausura4' :: Ord a => (a -> a) -> S.Set a -> S.Set a

clausura4' f xs = aux xs xs

where aux ys vs | S.null ns = vs

| otherwise = aux ns (vs `S.union` ns)

where ns = S.map f ys `S.difference` vs

-- Comprobación de equivalencia

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

-- La propiedad es

prop_clausura :: (Int -> Int) -> [Int] -> Bool

prop_clausura f xs =

all (== clausura1 f xs')

[ clausura2 f xs'

, clausura3 f xs'

, clausura4 f xs'

]

where xs' = sort (nub xs)

-- La comprobación es

-- λ> quickCheck' prop_clausura

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> length (clausura1 (\x -> (x+1) `mod` 800) [0])

-- 800

-- (1.95 secs, 213,481,560 bytes)

-- λ> length (clausura2 (\x -> (x+1) `mod` 800) [0])

-- 800

-- (1.96 secs, 213,372,824 bytes)

-- λ> length (clausura3 (\x -> (x+1) `mod` 800) [0])

-- 800

-- (0.03 secs, 42,055,128 bytes)

-- λ> length (clausura4 (\x -> (x+1) `mod` 800) [0])

-- 800

-- (0.01 secs, 1,779,768 bytes)

-- λ> length (clausura3 (\x -> (x+1) `mod` (10^4)) [0])

-- 10000

-- (2.50 secs, 8,080,105,816 bytes)

-- λ> length (clausura4 (\x -> (x+1) `mod` (10^4)) [0])

-- 10000

-- (0.05 secs, 27,186,920 bytes)

El código se encuentra en GitHub.

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

Números con todos sus dígitos primos

PorJosé A. Alonso 29-abril-20221-mayo-2022

Definir la lista

   numerosConDigitosPrimos :: [Integer]

1	numerosConDigitosPrimos :: [Integer]

cuyos elementos son los números con todos sus dígitos primos. Por ejemplo,

   λ> take 22 numerosConDigitosPrimos
   [2,3,5,7,22,23,25,27,32,33,35,37,52,53,55,57,72,73,75,77,222,223]
   λ> numerosConDigitosPrimos !! (10^7)
   322732232572

λ> take 22 numerosConDigitosPrimos

[2,3,5,7,22,23,25,27,32,33,35,37,52,53,55,57,72,73,75,77,222,223]

λ> numerosConDigitosPrimos !! (10^7)

322732232572

Soluciones

module Numeros_con_digitos_primos where

import Test.QuickCheck (NonNegative (NonNegative), quickCheck)
import Data.Char (intToDigit)

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

numerosConDigitosPrimos1 :: [Integer]
numerosConDigitosPrimos1 = [n | n <- [2..], digitosPrimos n]

-- (digitosPrimos n) se verifica si todos los dígitos de n son
-- primos. Por ejemplo,
--    digitosPrimos 352  ==  True
--    digitosPrimos 362  ==  False
digitosPrimos :: Integer -> Bool
digitosPrimos n = subconjunto (digitos n) [2,3,5,7]

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

-- (subconjunto xs ys) se verifica si xs es un subconjunto de ys. Por
-- ejemplo,
--    subconjunto [3,2,5,2] [2,7,3,5]  ==  True
--    subconjunto [3,2,5,2] [2,7,2,5]  ==  False
subconjunto :: Eq a => [a] -> [a] -> Bool
subconjunto xs ys = and [x `elem` ys | x <- xs]

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

numerosConDigitosPrimos2 :: [Integer]
numerosConDigitosPrimos2 =
  filter (all (`elem` "2357") . show) [2..]

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

--    λ> take 60 numerosConDigitosPrimos2
--    [  2,  3,  5,  7,
--      22, 23, 25, 27,
--      32, 33, 35, 37,
--      52, 53, 55, 57,
--      72, 73, 75, 77,
--     222,223,225,227,
--     232,233,235,237,
--     252,253,255,257,
--     272,273,275,277,
--     322,323,325,327,
--     332,333,335,337,
--     352,353,355,357,
--     372,373,375,377,
--     522,523,525,527,
--     532,533,535,537]

numerosConDigitosPrimos3 :: [Integer]
numerosConDigitosPrimos3 =
  [2,3,5,7] ++ [10*n+d | n <- numerosConDigitosPrimos3, d <- [2,3,5,7]]

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

--    λ> take 60 numerosConDigitosPrimos2
--    [ 2, 3, 5, 7,
--     22,23,25,27,
--     32,33,35,37,
--     52,53,55,57,
--     72,73,75,77,
--     222,223,225,227, 232,233,235,237, 252,253,255,257, 272,273,275,277,
--     322,323,325,327, 332,333,335,337, 352,353,355,357, 372,373,375,377,
--     522,523,525,527, 532,533,535,537]

numerosConDigitosPrimos4 :: [Integer]
numerosConDigitosPrimos4 = concat (iterate siguiente [2,3,5,7])

-- (siguiente xs) es la lista obtenida añadiendo delante de cada
-- elemento de xs los dígitos 2, 3, 5 y 7. Por ejemplo,
--    λ> siguiente [5,6,8]
--    [25,26,28,
--     35,36,38,
--     55,56,58,
--     75,76,78]
siguiente :: [Integer] -> [Integer]
siguiente xs = concat [map (pega d) xs | d <- [2,3,5,7]]

-- (pega d n) es el número obtenido añadiendo el dígito d delante del
-- número n. Por ejemplo,
--    pega 3 35  ==  335
pega :: Int -> Integer -> Integer
pega d n = read (intToDigit d : show n)

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

-- La propiedad es
prop_numerosConDigitosPrimos :: NonNegative Int -> Bool
prop_numerosConDigitosPrimos (NonNegative n) =
  all (== numerosConDigitosPrimos1 !! n)
      [ numerosConDigitosPrimos2 !! n
      , numerosConDigitosPrimos3 !! n
      , numerosConDigitosPrimos4 !! n
      ]

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

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

-- La comparación es
--    λ> numerosConDigitosPrimos1 !! 5000
--    752732
--    (2.45 secs, 6,066,926,272 bytes)
--    λ> numerosConDigitosPrimos2 !! 5000
--    752732
--    (0.34 secs, 387,603,456 bytes)
--    λ> numerosConDigitosPrimos3 !! 5000
--    752732
--    (0.01 secs, 1,437,624 bytes)
--    λ> numerosConDigitosPrimos4 !! 5000
--    752732
--    (0.00 secs, 1,556,104 bytes)
--
--    λ> numerosConDigitosPrimos3 !! (10^7)
--    322732232572
--    (3.94 secs, 1,820,533,328 bytes)
--    λ> numerosConDigitosPrimos4 !! (10^7)
--    322732232572
--    (1.84 secs, 2,000,606,640 bytes)

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

module Numeros_con_digitos_primos where

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

import Data.Char (intToDigit)

-- 1ª solución

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

numerosConDigitosPrimos1 :: [Integer]

numerosConDigitosPrimos1 = [n | n <- [2..], digitosPrimos n]

-- (digitosPrimos n) se verifica si todos los dígitos de n son

-- primos. Por ejemplo,

-- digitosPrimos 352 == True

-- digitosPrimos 362 == False

digitosPrimos :: Integer -> Bool

digitosPrimos n = subconjunto (digitos n) [2,3,5,7]

-- (digitos n) es la lista de las digitos de n. Por ejemplo,

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

digitos :: Integer -> [Integer]

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

-- (subconjunto xs ys) se verifica si xs es un subconjunto de ys. Por

-- ejemplo,

-- subconjunto [3,2,5,2] [2,7,3,5] == True

-- subconjunto [3,2,5,2] [2,7,2,5] == False

subconjunto :: Eq a => [a] -> [a] -> Bool

subconjunto xs ys = and [x `elem` ys | x <- xs]

-- 2ª solución

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

numerosConDigitosPrimos2 :: [Integer]

numerosConDigitosPrimos2 =

filter (all (`elem` "2357") . show) [2..]

-- 3ª solución

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

-- λ> take 60 numerosConDigitosPrimos2

-- [ 2, 3, 5, 7,

-- 22, 23, 25, 27,

-- 32, 33, 35, 37,

-- 52, 53, 55, 57,

-- 72, 73, 75, 77,

-- 222,223,225,227,

-- 232,233,235,237,

-- 252,253,255,257,

-- 272,273,275,277,

-- 322,323,325,327,

-- 332,333,335,337,

-- 352,353,355,357,

-- 372,373,375,377,

-- 522,523,525,527,

-- 532,533,535,537]

numerosConDigitosPrimos3 :: [Integer]

numerosConDigitosPrimos3 =

[2,3,5,7] ++ [10*n+d | n <- numerosConDigitosPrimos3, d <- [2,3,5,7]]

-- 4ª solución

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

-- λ> take 60 numerosConDigitosPrimos2

-- [ 2, 3, 5, 7,

-- 22,23,25,27,

-- 32,33,35,37,

-- 52,53,55,57,

-- 72,73,75,77,

-- 222,223,225,227, 232,233,235,237, 252,253,255,257, 272,273,275,277,

-- 322,323,325,327, 332,333,335,337, 352,353,355,357, 372,373,375,377,

-- 522,523,525,527, 532,533,535,537]

numerosConDigitosPrimos4 :: [Integer]

numerosConDigitosPrimos4 = concat (iterate siguiente [2,3,5,7])

-- (siguiente xs) es la lista obtenida añadiendo delante de cada

-- elemento de xs los dígitos 2, 3, 5 y 7. Por ejemplo,

-- λ> siguiente [5,6,8]

-- [25,26,28,

-- 35,36,38,

-- 55,56,58,

-- 75,76,78]

siguiente :: [Integer] -> [Integer]

siguiente xs = concat [map (pega d) xs | d <- [2,3,5,7]]

-- (pega d n) es el número obtenido añadiendo el dígito d delante del

-- número n. Por ejemplo,

-- pega 3 35 == 335

pega :: Int -> Integer -> Integer

pega d n = read (intToDigit d : show n)

-- Comprobación de equivalencia

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

-- La propiedad es

prop_numerosConDigitosPrimos :: NonNegative Int -> Bool

prop_numerosConDigitosPrimos (NonNegative n) =

all (== numerosConDigitosPrimos1 !! n)

[ numerosConDigitosPrimos2 !! n

, numerosConDigitosPrimos3 !! n

, numerosConDigitosPrimos4 !! n

]

-- La comprobación es

-- λ> quickCheck prop_numerosConDigitosPrimos

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> numerosConDigitosPrimos1 !! 5000

-- 752732

-- (2.45 secs, 6,066,926,272 bytes)

-- λ> numerosConDigitosPrimos2 !! 5000

-- 752732

-- (0.34 secs, 387,603,456 bytes)

-- λ> numerosConDigitosPrimos3 !! 5000

-- 752732

-- (0.01 secs, 1,437,624 bytes)

-- λ> numerosConDigitosPrimos4 !! 5000

-- 752732

-- (0.00 secs, 1,556,104 bytes)

-- λ> numerosConDigitosPrimos3 !! (10^7)

-- 322732232572

-- (3.94 secs, 1,820,533,328 bytes)

-- λ> numerosConDigitosPrimos4 !! (10^7)

-- 322732232572

-- (1.84 secs, 2,000,606,640 bytes)

El código se encuentra en GitHub.

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

Producto cartesiano de una familia de conjuntos

PorJosé A. Alonso 27-abril-20221-mayo-2022

Definir la función

   producto :: [[a]] -> [[a]]

1	producto :: [[a]] -> [[a]]

tal que (producto xss) es el producto cartesiano de los conjuntos xss. Por ejemplo,

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

λ> producto [[1,3],[2,5]]

[[1,2],[1,5],[3,2],[3,5]]

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

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

λ> producto [[1,3,5],[2,4]]

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

λ> producto []

[[]]

Comprobar con QuickCheck que para toda lista de listas de números enteros, xss, se verifica que el número de elementos de (producto xss) es igual al producto de los números de elementos de cada una de las listas de xss.

Soluciones

module Producto_cartesiano where

import Test.QuickCheck (quickCheck)
import Control.Monad (liftM2)
import Control.Applicative (liftA2)

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

producto1 :: [[a]] -> [[a]]
producto1 []       = [[]]
producto1 (xs:xss) = [x:ys | x <- xs, ys <- producto1 xss]

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

producto2 :: [[a]] -> [[a]]
producto2 []       = [[]]
producto2 (xs:xss) = [x:ys | x <- xs, ys <- ps]
  where ps = producto2 xss

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

producto3 :: [[a]] -> [[a]]
producto3 []       = [[]]
producto3 (xs:xss) = inserta3 xs (producto3 xss)

-- (inserta xs xss) inserta cada elemento de xs en los elementos de
-- xss. Por ejemplo,
--    λ> inserta [1,2] [[3,4],[5,6]]
--    [[1,3,4],[1,5,6],[2,3,4],[2,5,6]]
inserta3 :: [a] -> [[a]] -> [[a]]
inserta3 [] _       = []
inserta3 (x:xs) yss = [x:ys | ys <- yss] ++ inserta3 xs yss

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

producto4 :: [[a]] -> [[a]]
producto4 = foldr inserta4 [[]]

inserta4 :: [a] -> [[a]] -> [[a]]
inserta4 []     _   = []
inserta4 (x:xs) yss = map (x:) yss ++ inserta4 xs yss

-- 5ª solución
-- ===========

producto5 :: [[a]] -> [[a]]
producto5 = foldr inserta5 [[]]

inserta5 :: [a] -> [[a]] -> [[a]]
inserta5 xs yss = [x:ys | x <- xs, ys <- yss]

-- 6ª solución
-- ===========

producto6 :: [[a]] -> [[a]]
producto6 = foldr inserta6 [[]]

inserta6 :: [a] -> [[a]] -> [[a]]
inserta6 xs yss = concatMap (\x -> map (x:) yss) xs

-- 7ª solución
-- ===========

producto7 :: [[a]] -> [[a]]
producto7 = foldr inserta7 [[]]

inserta7 :: [a] -> [[a]] -> [[a]]
inserta7 xs yss = xs >>= (\x -> map (x:) yss)

-- 8ª solución
-- ===========

producto8 :: [[a]] -> [[a]]
producto8 = foldr inserta8 [[]]

inserta8 :: [a] -> [[a]] -> [[a]]
inserta8 xs yss = (:) <$> xs <*> yss

-- 9ª solución
-- ===========

producto9 :: [[a]] -> [[a]]
producto9 = foldr inserta9 [[]]

inserta9 :: [a] -> [[a]] -> [[a]]
inserta9 = liftA2 (:)

-- 10ª solución
-- ============

producto10 :: [[a]] -> [[a]]
producto10 = foldr (liftM2 (:)) [[]]

-- 11ª solución
-- ============

producto11 :: [[a]] -> [[a]]
producto11 = sequence

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

-- La propiedad es
prop_producto :: [[Int]] -> Bool
prop_producto xss =
  all (== producto1 xss)
      [ producto2 xss
      , producto3 xss
      , producto4 xss
      , producto5 xss
      , producto6 xss
      , producto7 xss
      , producto8 xss
      , producto9 xss
      , producto10 xss
      , producto11 xss
      ]

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

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

-- La comparación es
--    λ> length (producto1 (replicate 7 [0..9]))
--    10000000
--    (10.51 secs, 10,169,418,496 bytes)
--    λ> length (producto2 (replicate 7 [0..9]))
--    10000000
--    (2.14 secs, 1,333,870,712 bytes)
--    λ> length (producto3 (replicate 7 [0..9]))
--    10000000
--    (3.33 secs, 1,956,102,056 bytes)
--    λ> length (producto4 (replicate 7 [0..9]))
--    10000000
--    (0.98 secs, 1,600,542,752 bytes)
--    λ> length (producto5 (replicate 7 [0..9]))
--    10000000
--    (2.10 secs, 1,333,870,288 bytes)
--    λ> length (producto6 (replicate 7 [0..9]))
--    10000000
--    (1.17 secs, 1,600,534,632 bytes)
--    λ> length (producto7 (replicate 7 [0..9]))
--    10000000
--    (0.35 secs, 1,600,534,352 bytes)
--    λ> length (producto8 (replicate 7 [0..9]))
--    10000000
--    (0.87 secs, 978,317,848 bytes)
--    λ> length (producto9 (replicate 7 [0..9]))
--    10000000
--    (1.38 secs, 1,067,201,016 bytes)
--    λ> length (producto10 (replicate 7 [0..9]))
--    10000000
--    (0.54 secs, 2,311,645,392 bytes)
--    λ> length (producto11 (replicate 7 [0..9]))
--    10000000
--    (1.32 secs, 1,067,200,992 bytes)
--
--    λ> length (producto7 (replicate 7 [1..14]))
--    105413504
--    (3.77 secs, 16,347,739,040 bytes)
--    λ> length (producto10 (replicate 7 [1..14]))
--    105413504
--    (5.11 secs, 23,613,162,016 bytes)

-- Comprobación de la propiedad
-- ============================

-- La propiedad es
prop_longitud :: [[Int]] -> Bool
prop_longitud xss =
  length (producto7 xss) == product (map length xss)

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

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

171

172

173

174

175

176

177

178

179

180

181

182

module Producto_cartesiano where

import Test.QuickCheck (quickCheck)

import Control.Monad (liftM2)

import Control.Applicative (liftA2)

-- 1ª solución

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

producto1 :: [[a]] -> [[a]]

producto1 [] = [[]]

producto1 (xs:xss) = [x:ys | x <- xs, ys <- producto1 xss]

-- 2ª solución

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

producto2 :: [[a]] -> [[a]]

producto2 [] = [[]]

producto2 (xs:xss) = [x:ys | x <- xs, ys <- ps]

where ps = producto2 xss

-- 3ª solución

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

producto3 :: [[a]] -> [[a]]

producto3 [] = [[]]

producto3 (xs:xss) = inserta3 xs (producto3 xss)

-- (inserta xs xss) inserta cada elemento de xs en los elementos de

-- xss. Por ejemplo,

-- λ> inserta [1,2] [[3,4],[5,6]]

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

inserta3 :: [a] -> [[a]] -> [[a]]

inserta3 [] _ = []

inserta3 (x:xs) yss = [x:ys | ys <- yss] ++ inserta3 xs yss

-- 4ª solución

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

producto4 :: [[a]] -> [[a]]

producto4 = foldr inserta4 [[]]

inserta4 :: [a] -> [[a]] -> [[a]]

inserta4 [] _ = []

inserta4 (x:xs) yss = map (x:) yss ++ inserta4 xs yss

-- 5ª solución

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

producto5 :: [[a]] -> [[a]]

producto5 = foldr inserta5 [[]]

inserta5 :: [a] -> [[a]] -> [[a]]

inserta5 xs yss = [x:ys | x <- xs, ys <- yss]

-- 6ª solución

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

producto6 :: [[a]] -> [[a]]

producto6 = foldr inserta6 [[]]

inserta6 :: [a] -> [[a]] -> [[a]]

inserta6 xs yss = concatMap (\x -> map (x:) yss) xs

-- 7ª solución

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

producto7 :: [[a]] -> [[a]]

producto7 = foldr inserta7 [[]]

inserta7 :: [a] -> [[a]] -> [[a]]

inserta7 xs yss = xs >>= (\x -> map (x:) yss)

-- 8ª solución

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

producto8 :: [[a]] -> [[a]]

producto8 = foldr inserta8 [[]]

inserta8 :: [a] -> [[a]] -> [[a]]

inserta8 xs yss = (:) <$> xs <*> yss

-- 9ª solución

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

producto9 :: [[a]] -> [[a]]

producto9 = foldr inserta9 [[]]

inserta9 :: [a] -> [[a]] -> [[a]]

inserta9 = liftA2 (:)

-- 10ª solución

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

producto10 :: [[a]] -> [[a]]

producto10 = foldr (liftM2 (:)) [[]]

-- 11ª solución

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

producto11 :: [[a]] -> [[a]]

producto11 = sequence

-- Comprobación de equivalencia

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

-- La propiedad es

prop_producto :: [[Int]] -> Bool

prop_producto xss =

all (== producto1 xss)

[ producto2 xss

, producto3 xss

, producto4 xss

, producto5 xss

, producto6 xss

, producto7 xss

, producto8 xss

, producto9 xss

, producto10 xss

, producto11 xss

]

-- La comprobación es

-- λ> quickCheckWith (stdArgs {maxSize = 9}) prop_producto

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> length (producto1 (replicate 7 [0..9]))

-- 10000000

-- (10.51 secs, 10,169,418,496 bytes)

-- λ> length (producto2 (replicate 7 [0..9]))

-- 10000000

-- (2.14 secs, 1,333,870,712 bytes)

-- λ> length (producto3 (replicate 7 [0..9]))

-- 10000000

-- (3.33 secs, 1,956,102,056 bytes)

-- λ> length (producto4 (replicate 7 [0..9]))

-- 10000000

-- (0.98 secs, 1,600,542,752 bytes)

-- λ> length (producto5 (replicate 7 [0..9]))

-- 10000000

-- (2.10 secs, 1,333,870,288 bytes)

-- λ> length (producto6 (replicate 7 [0..9]))

-- 10000000

-- (1.17 secs, 1,600,534,632 bytes)

-- λ> length (producto7 (replicate 7 [0..9]))

-- 10000000

-- (0.35 secs, 1,600,534,352 bytes)

-- λ> length (producto8 (replicate 7 [0..9]))

-- 10000000

-- (0.87 secs, 978,317,848 bytes)

-- λ> length (producto9 (replicate 7 [0..9]))

-- 10000000

-- (1.38 secs, 1,067,201,016 bytes)

-- λ> length (producto10 (replicate 7 [0..9]))

-- 10000000

-- (0.54 secs, 2,311,645,392 bytes)

-- λ> length (producto11 (replicate 7 [0..9]))

-- 10000000

-- (1.32 secs, 1,067,200,992 bytes)

-- λ> length (producto7 (replicate 7 [1..14]))

-- 105413504

-- (3.77 secs, 16,347,739,040 bytes)

-- λ> length (producto10 (replicate 7 [1..14]))

-- 105413504

-- (5.11 secs, 23,613,162,016 bytes)

-- Comprobación de la propiedad

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

-- La propiedad es

prop_longitud :: [[Int]] -> Bool

prop_longitud xss =

length (producto7 xss) == product (map length xss)

-- La comprobación es

-- λ> quickCheckWith (stdArgs {maxSize = 7}) prop_longitud

-- +++ OK, passed 100 tests.

El código se encuentra en GitHub.

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

Representación de Zeckendorf

PorJosé A. Alonso 25-abril-20221-mayo-2022

Los primeros números de Fibonacci son

   1, 1, 2, 3, 5, 8, 13, 21, 34, 55, 89, 144, 233, ...

1	1, 1, 2, 3, 5, 8, 13, 21, 34, 55, 89, 144, 233, ...

tales que los dos primeros son iguales a 1 y los siguientes se obtienen sumando los dos anteriores.

El teorema de Zeckendorf establece que todo entero positivo n se puede representar, de manera única, como la suma de números de Fibonacci no consecutivos decrecientes. Dicha suma se llama la representación de Zeckendorf de n. Por ejemplo, la representación de Zeckendorf de 100 es

   100 = 89 + 8 + 3

1	100 = 89 + 8 + 3

Hay otras formas de representar 100 como sumas de números de Fibonacci; por ejemplo,

   100 = 89 +  8 + 2 + 1
   100 = 55 + 34 + 8 + 3

1 2	100 = 89 + 8 + 2 + 1 100 = 55 + 34 + 8 + 3

pero no son representaciones de Zeckendorf porque 1 y 2 son números de Fibonacci consecutivos, al igual que 34 y 55.

Definir la función

   zeckendorf :: Integer -> [Integer]

1	zeckendorf :: Integer -> [Integer]

tal que (zeckendorf n) es la representación de Zeckendorf de n. Por ejemplo,

   zeckendorf 100 == [89,8,3]
   zeckendorf 200 == [144,55,1]
   zeckendorf 300 == [233,55,8,3,1]
   length (zeckendorf (10^50000)) == 66097

zeckendorf 100 == [89,8,3]

zeckendorf 200 == [144,55,1]

zeckendorf 300 == [233,55,8,3,1]

length (zeckendorf (10^50000)) == 66097

Soluciones

module Representacion_de_Zeckendorf where

import Data.List (subsequences)
import Test.QuickCheck

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

zeckendorf1 :: Integer -> [Integer]
zeckendorf1 = head . zeckendorf1Aux

zeckendorf1Aux :: Integer -> [[Integer]]
zeckendorf1Aux n =
  [xs | xs <- subsequences (reverse (takeWhile (<= n) (tail fibs))),
        sum xs == n,
        sinFibonacciConsecutivos xs]

-- fibs es la la sucesión de los números de Fibonacci. Por ejemplo,
--    take 14 fibs  == [1,1,2,3,5,8,13,21,34,55,89,144,233,377]
fibs :: [Integer]
fibs = 1 : scanl (+) 1 fibs
-- (sinFibonacciConsecutivos xs) se verifica si en la sucesión
-- decreciente de número de Fibonacci xs no hay dos consecutivos. Por
-- ejemplo, 

-- (sinFibonacciConsecutivos xs) se verifica si en la sucesión
-- decreciente de número de Fibonacci xs no hay dos consecutivos. Por
-- ejemplo, 
--    sinFibonacciConsecutivos [89, 8, 3]      ==  True
--    sinFibonacciConsecutivos [55, 34, 8, 3]  ==  False
sinFibonacciConsecutivos :: [Integer] -> Bool
sinFibonacciConsecutivos xs =
  and [x /= siguienteFibonacci y | (x,y) <- zip xs (tail xs)]

-- (siguienteFibonacci n) es el menor número de Fibonacci mayor que
-- n. Por ejemplo, 
--    siguienteFibonacci 34  ==  55
siguienteFibonacci :: Integer -> Integer
siguienteFibonacci n =
  head (dropWhile (<= n) fibs)

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

zeckendorf2 :: Integer -> [Integer]
zeckendorf2 = head . zeckendorf2Aux

zeckendorf2Aux :: Integer -> [[Integer]]
zeckendorf2Aux n = map reverse (aux n (tail fibs))
  where aux 0 _ = [[]]
        aux m (x:y:zs)
            | x <= m     = [x:xs | xs <- aux (m-x) zs] ++ aux m (y:zs)
            | otherwise  = []

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

zeckendorf3 :: Integer -> [Integer]
zeckendorf3 0 = []
zeckendorf3 n = x : zeckendorf3 (n - x)
  where x = last (takeWhile (<= n) fibs)

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

zeckendorf4 :: Integer -> [Integer]
zeckendorf4 n = aux n (reverse (takeWhile (<= n) fibs))
  where aux 0 _      = []
        aux m (x:xs) = x : aux (m-x) (dropWhile (>m-x) xs)

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

-- La propiedad es
prop_zeckendorf :: Positive Integer -> Bool
prop_zeckendorf (Positive n) =
  all (== zeckendorf1 n)
      [zeckendorf2 n,
       zeckendorf3 n,
       zeckendorf4 n]

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

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

-- La comparación es
--    λ> zeckendorf1 (7*10^4)
--    [46368,17711,4181,1597,89,34,13,5,2]
--    (1.49 secs, 2,380,707,744 bytes)
--    λ> zeckendorf2 (7*10^4)
--    [46368,17711,4181,1597,89,34,13,5,2]
--    (0.07 secs, 21,532,008 bytes)
--
--    λ> zeckendorf2 (10^6)
--    [832040,121393,46368,144,55]
--    (1.40 secs, 762,413,432 bytes)
--    λ> zeckendorf3 (10^6)
--    [832040,121393,46368,144,55]
--    (0.01 secs, 542,488 bytes)
--    λ> zeckendorf4 (10^6)
--    [832040,121393,46368,144,55]
--    (0.01 secs, 536,424 bytes)
--
--    λ> length (zeckendorf3 (10^3000))
--    3947
--    (3.02 secs, 1,611,966,408 bytes)
--    λ> length (zeckendorf4 (10^2000))
--    2611
--    (0.02 secs, 10,434,336 bytes)
--
--    λ> length (zeckendorf4 (10^50000))
--    66097
--    (2.84 secs, 3,976,483,760 bytes)

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

module Representacion_de_Zeckendorf where

import Data.List (subsequences)

import Test.QuickCheck

-- 1ª solución

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

zeckendorf1 :: Integer -> [Integer]

zeckendorf1 = head . zeckendorf1Aux

zeckendorf1Aux :: Integer -> [[Integer]]

zeckendorf1Aux n =

[xs | xs <- subsequences (reverse (takeWhile (<= n) (tail fibs))),

sum xs == n,

sinFibonacciConsecutivos xs]

-- fibs es la la sucesión de los números de Fibonacci. Por ejemplo,

-- take 14 fibs == [1,1,2,3,5,8,13,21,34,55,89,144,233,377]

fibs :: [Integer]

fibs = 1 : scanl (+) 1 fibs

-- (sinFibonacciConsecutivos xs) se verifica si en la sucesión

-- decreciente de número de Fibonacci xs no hay dos consecutivos. Por

-- ejemplo,

-- (sinFibonacciConsecutivos xs) se verifica si en la sucesión

-- decreciente de número de Fibonacci xs no hay dos consecutivos. Por

-- ejemplo,

-- sinFibonacciConsecutivos [89, 8, 3] == True

-- sinFibonacciConsecutivos [55, 34, 8, 3] == False

sinFibonacciConsecutivos :: [Integer] -> Bool

sinFibonacciConsecutivos xs =

and [x /= siguienteFibonacci y | (x,y) <- zip xs (tail xs)]

-- (siguienteFibonacci n) es el menor número de Fibonacci mayor que

-- n. Por ejemplo,

-- siguienteFibonacci 34 == 55

siguienteFibonacci :: Integer -> Integer

siguienteFibonacci n =

head (dropWhile (<= n) fibs)

-- 2ª solución

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

zeckendorf2 :: Integer -> [Integer]

zeckendorf2 = head . zeckendorf2Aux

zeckendorf2Aux :: Integer -> [[Integer]]

zeckendorf2Aux n = map reverse (aux n (tail fibs))

where aux 0 _ = [[]]

aux m (x:y:zs)

| x <= m = [x:xs | xs <- aux (m-x) zs] ++ aux m (y:zs)

| otherwise = []

-- 3ª solución

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

zeckendorf3 :: Integer -> [Integer]

zeckendorf3 0 = []

zeckendorf3 n = x : zeckendorf3 (n - x)

where x = last (takeWhile (<= n) fibs)

-- 4ª solución

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

zeckendorf4 :: Integer -> [Integer]

zeckendorf4 n = aux n (reverse (takeWhile (<= n) fibs))

where aux 0 _ = []

aux m (x:xs) = x : aux (m-x) (dropWhile (>m-x) xs)

-- Comprobación de equivalencia

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

-- La propiedad es

prop_zeckendorf :: Positive Integer -> Bool

prop_zeckendorf (Positive n) =

all (== zeckendorf1 n)

[zeckendorf2 n,

zeckendorf3 n,

zeckendorf4 n]

-- La comprobación es

-- λ> quickCheck prop_zeckendorf

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> zeckendorf1 (7*10^4)

-- [46368,17711,4181,1597,89,34,13,5,2]

-- (1.49 secs, 2,380,707,744 bytes)

-- λ> zeckendorf2 (7*10^4)

-- [46368,17711,4181,1597,89,34,13,5,2]

-- (0.07 secs, 21,532,008 bytes)

-- λ> zeckendorf2 (10^6)

-- [832040,121393,46368,144,55]

-- (1.40 secs, 762,413,432 bytes)

-- λ> zeckendorf3 (10^6)

-- [832040,121393,46368,144,55]

-- (0.01 secs, 542,488 bytes)

-- λ> zeckendorf4 (10^6)

-- [832040,121393,46368,144,55]

-- (0.01 secs, 536,424 bytes)

-- λ> length (zeckendorf3 (10^3000))

-- 3947

-- (3.02 secs, 1,611,966,408 bytes)

-- λ> length (zeckendorf4 (10^2000))

-- 2611

-- (0.02 secs, 10,434,336 bytes)

-- λ> length (zeckendorf4 (10^50000))

-- 66097

-- (2.84 secs, 3,976,483,760 bytes)

El código se encuentra en GitHub.

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

Ordenada cíclicamente

PorJosé A. Alonso 22-abril-202230-abril-2022

Se dice que una sucesión x(1), …, x(n) está ordenada cíclicamente si existe un índice i tal que la sucesión

   x(i), x(i+1), ..., x(n), x(1), ..., x(i-1)

1	x(i), x(i+1), ..., x(n), x(1), ..., x(i-1)

está ordenada crecientemente de forma estricta.

Definir la función

   ordenadaCiclicamente :: Ord a => [a] -> Maybe Int

1	ordenadaCiclicamente :: Ord a => [a] -> Maybe Int

tal que (ordenadaCiclicamente xs) es el índice a partir del cual está ordenada, si la lista está ordenado cíclicamente y Nothing en caso contrario. Por ejemplo,

   ordenadaCiclicamente [1,2,3,4]      ==  Just 0
   ordenadaCiclicamente [5,8,1,3]      ==  Just 2
   ordenadaCiclicamente [4,6,7,5,1,3]  ==  Nothing
   ordenadaCiclicamente [1,0,3,2]      ==  Nothing
   ordenadaCiclicamente [1,2,0]        ==  Just 2
   ordenadaCiclicamente "cdeab"        ==  Just 3

ordenadaCiclicamente [1,2,3,4] == Just 0

ordenadaCiclicamente [5,8,1,3] == Just 2

ordenadaCiclicamente [4,6,7,5,1,3] == Nothing

ordenadaCiclicamente [1,0,3,2] == Nothing

ordenadaCiclicamente [1,2,0] == Just 2

ordenadaCiclicamente "cdeab" == Just 3

Nota: Se supone que el argumento es una lista no vacía sin elementos repetidos.

Soluciones

module Ordenada_ciclicamente where

import Test.QuickCheck (Arbitrary, Gen, NonEmptyList (NonEmpty), Property,
                        arbitrary, chooseInt, collect, quickCheck)
import Data.List       (nub, sort)
import Data.Maybe      (isJust, listToMaybe)

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

ordenadaCiclicamente1 :: Ord a => [a] -> Maybe Int
ordenadaCiclicamente1 xs = aux 0 xs
  where n = length xs
        aux i zs
          | i == n      = Nothing
          | ordenada zs = Just i
          | otherwise   = aux (i+1) (siguienteCiclo zs)

-- (ordenada xs) se verifica si la lista xs está ordenada
-- crecientemente. Por ejemplo,
--   ordenada "acd"   ==  True
--   ordenada "acdb"  ==  False
ordenada :: Ord a => [a] -> Bool
ordenada []     = True
ordenada (x:xs) = all (x <) xs && ordenada xs

-- (siguienteCiclo xs) es la lista obtenida añadiendo el primer elemento
-- de xs al final del resto de xs. Por ejemplo,
--   siguienteCiclo [3,2,5]  =>  [2,5,3]
siguienteCiclo :: [a] -> [a]
siguienteCiclo []     = []
siguienteCiclo (x:xs) = xs ++ [x]

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

ordenadaCiclicamente2 :: Ord a => [a] -> Maybe Int
ordenadaCiclicamente2 xs =
  listToMaybe [n | n <- [0..length xs-1],
                   ordenada (drop n xs ++ take n xs)]

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

ordenadaCiclicamente3 :: Ord a => [a] -> Maybe Int
ordenadaCiclicamente3 xs
  | ordenada (bs ++ as) = Just k
  | otherwise           = Nothing
  where (_,k)   = minimum (zip xs [0..])
        (as,bs) = splitAt k xs

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

-- La propiedad es
prop_ordenadaCiclicamente1 :: NonEmptyList Int -> Bool
prop_ordenadaCiclicamente1 (NonEmpty xs) =
  ordenadaCiclicamente1 xs == ordenadaCiclicamente2 xs

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

-- La propiedad para analizar los casos de prueba
prop_ordenadaCiclicamente2 :: NonEmptyList Int -> Property
prop_ordenadaCiclicamente2 (NonEmpty xs) =
  collect (isJust (ordenadaCiclicamente1 xs)) $
  ordenadaCiclicamente1 xs == ordenadaCiclicamente2 xs

-- El análisis es
--    λ> quickCheck prop_ordenadaCiclicamente2
--    +++ OK, passed 100 tests:
--    89% False
--    11% True

-- Tipo para generar listas
newtype Lista = L [Int]
  deriving Show

-- Generador de listas.
listaArbitraria :: Gen Lista
listaArbitraria = do
  x <- arbitrary
  xs <- arbitrary
  let ys = x : xs
  k <- chooseInt (0, length ys)
  let (as,bs) = splitAt k (sort (nub ys))
  return (L (bs ++ as))

-- Lista es una subclase de Arbitrary.
instance Arbitrary Lista where
  arbitrary = listaArbitraria

-- La propiedad para analizar los casos de prueba
prop_ordenadaCiclicamente3 :: Lista -> Property
prop_ordenadaCiclicamente3 (L xs) =
  collect (isJust (ordenadaCiclicamente1 xs)) $
  ordenadaCiclicamente1 xs == ordenadaCiclicamente2 xs

-- El análisis es
--    λ> quickCheck prop_ordenadaCiclicamente3
--    +++ OK, passed 100 tests (100% True).

-- Tipo para generar
newtype Lista2 = L2 [Int]
  deriving Show

-- Generador de listas
listaArbitraria2 :: Gen Lista2
listaArbitraria2 = do
  x' <- arbitrary
  xs <- arbitrary
  let ys = x' : xs
  k <- chooseInt (0, length ys)
  let (as,bs) = splitAt k (sort (nub ys))
  n <- chooseInt (0,1)
  return (if even n
          then L2 (bs ++ as)
          else L2 ys)

-- Lista es una subclase de Arbitrary.
instance Arbitrary Lista2 where
  arbitrary = listaArbitraria2

-- La propiedad para analizar los casos de prueba
prop_ordenadaCiclicamente4 :: Lista2 -> Property
prop_ordenadaCiclicamente4 (L2 xs) =
  collect (isJust (ordenadaCiclicamente1 xs)) $
  ordenadaCiclicamente1 xs == ordenadaCiclicamente2 xs

-- El análisis es
--    λ> quickCheck prop_ordenadaCiclicamente4
--    +++ OK, passed 100 tests:
--    51% True
--    49% False

-- La propiedad es
prop_ordenadaCiclicamente :: Lista2 -> Bool
prop_ordenadaCiclicamente (L2 xs) =
  all (== ordenadaCiclicamente1 xs)
      [ordenadaCiclicamente2 xs,
       ordenadaCiclicamente3 xs]

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

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

-- La comparación es
--    λ> ordenadaCiclicamente1 ([100..4000] ++ [1..99])
--    Just 3901
--    (3.27 secs, 2,138,864,568 bytes)
--    λ> ordenadaCiclicamente2 ([100..4000] ++ [1..99])
--    Just 3901
--    (2.44 secs, 1,430,040,008 bytes)
--    λ> ordenadaCiclicamente3 ([100..4000] ++ [1..99])
--    Just 3901
--    (1.18 secs, 515,549,200 bytes)

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

module Ordenada_ciclicamente where

import Test.QuickCheck (Arbitrary, Gen, NonEmptyList (NonEmpty), Property,

arbitrary, chooseInt, collect, quickCheck)

import Data.List (nub, sort)

import Data.Maybe (isJust, listToMaybe)

-- 1ª solución

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

ordenadaCiclicamente1 :: Ord a => [a] -> Maybe Int

ordenadaCiclicamente1 xs = aux 0 xs

where n = length xs

aux i zs

| i == n = Nothing

| ordenada zs = Just i

| otherwise = aux (i+1) (siguienteCiclo zs)

-- (ordenada xs) se verifica si la lista xs está ordenada

-- crecientemente. Por ejemplo,

-- ordenada "acd" == True

-- ordenada "acdb" == False

ordenada :: Ord a => [a] -> Bool

ordenada [] = True

ordenada (x:xs) = all (x <) xs && ordenada xs

-- (siguienteCiclo xs) es la lista obtenida añadiendo el primer elemento

-- de xs al final del resto de xs. Por ejemplo,

-- siguienteCiclo [3,2,5] => [2,5,3]

siguienteCiclo :: [a] -> [a]

siguienteCiclo [] = []

siguienteCiclo (x:xs) = xs ++ [x]

-- 2ª solución

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

ordenadaCiclicamente2 :: Ord a => [a] -> Maybe Int

ordenadaCiclicamente2 xs =

listToMaybe [n | n <- [0..length xs-1],

ordenada (drop n xs ++ take n xs)]

-- 3ª solución

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

ordenadaCiclicamente3 :: Ord a => [a] -> Maybe Int

ordenadaCiclicamente3 xs

| ordenada (bs ++ as) = Just k

| otherwise = Nothing

where (_,k) = minimum (zip xs [0..])

(as,bs) = splitAt k xs

-- Comprobación de equivalencia

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

-- La propiedad es

prop_ordenadaCiclicamente1 :: NonEmptyList Int -> Bool

prop_ordenadaCiclicamente1 (NonEmpty xs) =

ordenadaCiclicamente1 xs == ordenadaCiclicamente2 xs

-- La comprobación es

-- λ> quickCheck prop_ordenadaCiclicamente1

-- +++ OK, passed 100 tests.

-- La propiedad para analizar los casos de prueba

prop_ordenadaCiclicamente2 :: NonEmptyList Int -> Property

prop_ordenadaCiclicamente2 (NonEmpty xs) =

collect (isJust (ordenadaCiclicamente1 xs)) $

ordenadaCiclicamente1 xs == ordenadaCiclicamente2 xs

-- El análisis es

-- λ> quickCheck prop_ordenadaCiclicamente2

-- +++ OK, passed 100 tests:

-- 89% False

-- 11% True

-- Tipo para generar listas

newtype Lista = L [Int]

deriving Show

-- Generador de listas.

listaArbitraria :: Gen Lista

listaArbitraria = do

x <- arbitrary

xs <- arbitrary

let ys = x : xs

k <- chooseInt (0, length ys)

let (as,bs) = splitAt k (sort (nub ys))

return (L (bs ++ as))

-- Lista es una subclase de Arbitrary.

instance Arbitrary Lista where

arbitrary = listaArbitraria

-- La propiedad para analizar los casos de prueba

prop_ordenadaCiclicamente3 :: Lista -> Property

prop_ordenadaCiclicamente3 (L xs) =

collect (isJust (ordenadaCiclicamente1 xs)) $

ordenadaCiclicamente1 xs == ordenadaCiclicamente2 xs

-- El análisis es

-- λ> quickCheck prop_ordenadaCiclicamente3

-- +++ OK, passed 100 tests (100% True).

-- Tipo para generar

newtype Lista2 = L2 [Int]

deriving Show

-- Generador de listas

listaArbitraria2 :: Gen Lista2

listaArbitraria2 = do

x' <- arbitrary

xs <- arbitrary

let ys = x' : xs

k <- chooseInt (0, length ys)

let (as,bs) = splitAt k (sort (nub ys))

n <- chooseInt (0,1)

return (if even n

then L2 (bs ++ as)

else L2 ys)

-- Lista es una subclase de Arbitrary.

instance Arbitrary Lista2 where

arbitrary = listaArbitraria2

-- La propiedad para analizar los casos de prueba

prop_ordenadaCiclicamente4 :: Lista2 -> Property

prop_ordenadaCiclicamente4 (L2 xs) =

collect (isJust (ordenadaCiclicamente1 xs)) $

ordenadaCiclicamente1 xs == ordenadaCiclicamente2 xs

-- El análisis es

-- λ> quickCheck prop_ordenadaCiclicamente4

-- +++ OK, passed 100 tests:

-- 51% True

-- 49% False

-- La propiedad es

prop_ordenadaCiclicamente :: Lista2 -> Bool

prop_ordenadaCiclicamente (L2 xs) =

all (== ordenadaCiclicamente1 xs)

[ordenadaCiclicamente2 xs,

ordenadaCiclicamente3 xs]

-- La comprobación es

-- λ> quickCheck prop_ordenadaCiclicamente

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> ordenadaCiclicamente1 ([100..4000] ++ [1..99])

-- Just 3901

-- (3.27 secs, 2,138,864,568 bytes)

-- λ> ordenadaCiclicamente2 ([100..4000] ++ [1..99])

-- Just 3901

-- (2.44 secs, 1,430,040,008 bytes)

-- λ> ordenadaCiclicamente3 ([100..4000] ++ [1..99])

-- Just 3901

-- (1.18 secs, 515,549,200 bytes)

El código se encuentra en GitHub.

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

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>

Eliminación de las ocurrencias aisladas.

PorJosé A. Alonso 20-abril-202230-abril-2022

Definir la función

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

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

tal que (eliminaAisladas x ys) es la lista obtenida eliminando en ys las ocurrencias aisladas de x (es decir, aquellas ocurrencias de x tales que su elemento anterior y posterior son distintos de x). Por ejemplo,

   eliminaAisladas 'X' ""                  == ""
   eliminaAisladas 'X' "X"                 == ""
   eliminaAisladas 'X' "XX"                == "XX"
   eliminaAisladas 'X' "XXX"               == "XXX"
   eliminaAisladas 'X' "abcd"              == "abcd"
   eliminaAisladas 'X' "Xabcd"             == "abcd"
   eliminaAisladas 'X' "XXabcd"            == "XXabcd"
   eliminaAisladas 'X' "XXXabcd"           == "XXXabcd"
   eliminaAisladas 'X' "abcdX"             == "abcd"
   eliminaAisladas 'X' "abcdXX"            == "abcdXX"
   eliminaAisladas 'X' "abcdXXX"           == "abcdXXX"
   eliminaAisladas 'X' "abXcd"             == "abcd"
   eliminaAisladas 'X' "abXXcd"            == "abXXcd"
   eliminaAisladas 'X' "abXXXcd"           == "abXXXcd"
   eliminaAisladas 'X' "XabXcdX"           == "abcd"
   eliminaAisladas 'X' "XXabXXcdXX"        == "XXabXXcdXX"
   eliminaAisladas 'X' "XXXabXXXcdXXX"     == "XXXabXXXcdXXX"
   eliminaAisladas 'X' "XabXXcdXeXXXfXx"   == "abXXcdeXXXfx"

eliminaAisladas 'X' "" == ""

eliminaAisladas 'X' "X" == ""

eliminaAisladas 'X' "XX" == "XX"

eliminaAisladas 'X' "XXX" == "XXX"

eliminaAisladas 'X' "abcd" == "abcd"

eliminaAisladas 'X' "Xabcd" == "abcd"

eliminaAisladas 'X' "XXabcd" == "XXabcd"

eliminaAisladas 'X' "XXXabcd" == "XXXabcd"

eliminaAisladas 'X' "abcdX" == "abcd"

eliminaAisladas 'X' "abcdXX" == "abcdXX"

eliminaAisladas 'X' "abcdXXX" == "abcdXXX"

eliminaAisladas 'X' "abXcd" == "abcd"

eliminaAisladas 'X' "abXXcd" == "abXXcd"

eliminaAisladas 'X' "abXXXcd" == "abXXXcd"

eliminaAisladas 'X' "XabXcdX" == "abcd"

eliminaAisladas 'X' "XXabXXcdXX" == "XXabXXcdXX"

eliminaAisladas 'X' "XXXabXXXcdXXX" == "XXXabXXXcdXXX"

eliminaAisladas 'X' "XabXXcdXeXXXfXx" == "abXXcdeXXXfx"

Soluciones

module Elimina_aisladas where

import Data.List (group)
import Test.QuickCheck

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

eliminaAisladas1 :: Eq a => a -> [a] -> [a]
eliminaAisladas1 _ [] = []
eliminaAisladas1 x [y]
  | x == y    = []
  | otherwise = [y]
eliminaAisladas1 x (y1:y2:ys)
  | y1 /= x   = y1 : eliminaAisladas1 x (y2:ys)
  | y2 /= x   = y2 : eliminaAisladas1 x ys
  | otherwise = takeWhile (==x) (y1:y2:ys) ++
                eliminaAisladas1 x (dropWhile (==x) ys)

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

eliminaAisladas2 :: Eq a => a -> [a] -> [a]
eliminaAisladas2 _ [] = []
eliminaAisladas2 x ys
  | cs == [x] = as ++ eliminaAisladas2 x ds
  | otherwise = as ++ cs ++ eliminaAisladas2 x ds
  where (as,bs) = span (/=x) ys
        (cs,ds) = span (==x) bs

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

eliminaAisladas3 :: Eq a => a -> [a] -> [a]
eliminaAisladas3 x ys = concat [zs | zs <- group ys, zs /= [x]]

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

eliminaAisladas4 :: Eq a => a -> [a] -> [a]
eliminaAisladas4 x = concat . filter (/= [x]) . group


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

-- La propiedad es
prop_eliminaAisladas :: Int -> [Int] -> Bool
prop_eliminaAisladas x ys =
  all (== eliminaAisladas1 x ys)
      [eliminaAisladas2 x ys,
       eliminaAisladas3 x ys,
       eliminaAisladas4 x ys]

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

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

-- La comparación es
--    λ> length (eliminaAisladas1 'a' (take (5*10^6) (cycle "abca")))
--    4999998
--    (3.86 secs, 2,030,515,400 bytes)
--    λ> length (eliminaAisladas2 'a' (take (5*10^6) (cycle "abca")))
--    4999998
--    (3.41 secs, 2,210,516,832 bytes)
--    λ> length (eliminaAisladas3 'a' (take (5*10^6) (cycle "abca")))
--    4999998
--    (2.11 secs, 2,280,516,448 bytes)
--    λ> length (eliminaAisladas4 'a' (take (5*10^6) (cycle "abca")))
--    4999998
--    (0.92 secs, 1,920,516,704 bytes)

module Elimina_aisladas where

import Data.List (group)

import Test.QuickCheck

-- 1ª solución

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

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

eliminaAisladas1 _ [] = []

eliminaAisladas1 x [y]

| x == y = []

| otherwise = [y]

eliminaAisladas1 x (y1:y2:ys)

| y1 /= x = y1 : eliminaAisladas1 x (y2:ys)

| y2 /= x = y2 : eliminaAisladas1 x ys

| otherwise = takeWhile (==x) (y1:y2:ys) ++

eliminaAisladas1 x (dropWhile (==x) ys)

-- 2ª solución

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

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

eliminaAisladas2 _ [] = []

eliminaAisladas2 x ys

| cs == [x] = as ++ eliminaAisladas2 x ds

| otherwise = as ++ cs ++ eliminaAisladas2 x ds

where (as,bs) = span (/=x) ys

(cs,ds) = span (==x) bs

-- 3ª solución

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

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

eliminaAisladas3 x ys = concat [zs | zs <- group ys, zs /= [x]]

-- 4ª solución

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

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

eliminaAisladas4 x = concat . filter (/= [x]) . group

-- Comprobación de equivalencia

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

-- La propiedad es

prop_eliminaAisladas :: Int -> [Int] -> Bool

prop_eliminaAisladas x ys =

all (== eliminaAisladas1 x ys)

[eliminaAisladas2 x ys,

eliminaAisladas3 x ys,

eliminaAisladas4 x ys]

-- La comprobación es

-- λ> quickCheck prop_eliminaAisladas

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> length (eliminaAisladas1 'a' (take (5*10^6) (cycle "abca")))

-- 4999998

-- (3.86 secs, 2,030,515,400 bytes)

-- λ> length (eliminaAisladas2 'a' (take (5*10^6) (cycle "abca")))

-- 4999998

-- (3.41 secs, 2,210,516,832 bytes)

-- λ> length (eliminaAisladas3 'a' (take (5*10^6) (cycle "abca")))

-- 4999998

-- (2.11 secs, 2,280,516,448 bytes)

-- λ> length (eliminaAisladas4 'a' (take (5*10^6) (cycle "abca")))

-- 4999998

-- (0.92 secs, 1,920,516,704 bytes)

El código se encuentra en GitHub.

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

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>

Emparejamiento de árboles

PorJosé A. Alonso 18-abril-202230-abril-2022

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

   data Arbol a = N a [Arbol a]
     deriving (Show, Eq)

1 2	data Arbol a = N a [Arbol a] deriving (Show, Eq)

Por ejemplo, los árboles

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

1 3

/ \ /|\

6 3 / | \

| 5 4 7

5 | /\

6 2 1

se representan por

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

ej1, ej2 :: Arbol Int

ej1 = N 1 [N 6 [],N 3 [N 5 []]]

ej2 = N 3 [N 5 [N 6 []], N 4 [], N 7 [N 2 [], N 1 []]]

Definir la función

   emparejaArboles :: (a -> b -> c) -> Arbol a -> Arbol b -> Arbol c

1	emparejaArboles :: (a -> b -> c) -> Arbol a -> Arbol b -> Arbol c

tal que (emparejaArboles f a1 a2) es el árbol obtenido aplicando la función f a los elementos de los árboles a1 y a2 que se encuentran en la misma posición. Por ejemplo,

   λ> emparejaArboles (+) (N 1 [N 2 [], N 3[]]) (N 1 [N 6 []])
   N 2 [N 8 []]
   λ> emparejaArboles (+) ej1 ej2
   N 4 [N 11 [],N 7 []]
   λ> emparejaArboles (+) ej1 ej1
   N 2 [N 12 [],N 6 [N 10 []]]

λ> emparejaArboles (+) (N 1 [N 2 [], N 3[]]) (N 1 [N 6 []])

N 2 [N 8 []]

λ> emparejaArboles (+) ej1 ej2

N 4 [N 11 [],N 7 []]

λ> emparejaArboles (+) ej1 ej1

N 2 [N 12 [],N 6 [N 10 []]]

Soluciones

module Emparejamiento_de_arboles where

import Data.Tree (Tree (..))
import Control.Monad.Zip (mzipWith)
import Test.QuickCheck (Arbitrary, Gen, arbitrary, sublistOf, sized, quickCheck)

data Arbol a = N a [Arbol a]
  deriving (Show, Eq)

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

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

emparejaArboles1 :: (a -> b -> c) -> Arbol a -> Arbol b -> Arbol c
emparejaArboles1 f (N x xs) (N y ys) =
  N (f x y) (zipWith (emparejaArboles1 f) xs ys)

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

emparejaArboles2 :: (a -> b -> c) -> Arbol a -> Arbol b -> Arbol c
emparejaArboles2 f x y =
  treeAarbol (mzipWith f (arbolAtree x) (arbolAtree y))

arbolAtree :: Arbol a -> Tree a
arbolAtree (N x xs) = Node x (map arbolAtree xs)

treeAarbol :: Tree a -> Arbol a
treeAarbol (Node x xs) = N x (map treeAarbol xs)

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

-- (arbolArbitrario n) es un árbol aleatorio de orden n. Por ejemplo,
--    λ> generate (arbolArbitrario 5 :: Gen (Arbol Int))
--    N (-26) [N 8 [N 6 [N 11 []]],N 7 []]
--    λ> generate (arbolArbitrario 5 :: Gen (Arbol Int))
--    N 1 []
--    λ> generate (arbolArbitrario 5 :: Gen (Arbol Int))
--    N (-19) [N (-11) [],N 25 [],N 19 [N (-27) [],N (-19) [N 17 []]]]
arbolArbitrario :: Arbitrary a => Int -> Gen (Arbol a)
arbolArbitrario n = do
  x  <- arbitrary
  ms <- sublistOf [0 .. n `div` 2]
  as <- mapM arbolArbitrario ms
  return (N x as)

-- Arbol es una subclase de Arbitraria
instance Arbitrary a => Arbitrary (Arbol a) where
  arbitrary = sized arbolArbitrario

-- La propiedad es
prop_emparejaArboles :: Arbol Int -> Arbol Int -> Bool
prop_emparejaArboles x y =
  emparejaArboles1 (+) x y == emparejaArboles2 (+) x y &&
  emparejaArboles1 (*) x y == emparejaArboles2 (*) x y

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

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

-- La comparación es
--    λ> a500 <- generate (arbolArbitrario 500 :: Gen (Arbol Int))
--    λ> emparejaArboles1 (+) a500 a500 == emparejaArboles1 (+) a500 a500
--    True
--    (1.92 secs, 1,115,813,352 bytes)
--    λ> emparejaArboles2 (+) a500 a500 == emparejaArboles2 (+) a500 a500
--    True
--    (3.28 secs, 2,212,257,928 bytes)
--
--    λ> b500 = arbolAtree a500
--    λ> mzipWith (+) b500 b500 == mzipWith (+) b500 b500
--    True
--    (0.21 secs, 563,503,112 bytes)

module Emparejamiento_de_arboles where

import Data.Tree (Tree (..))

import Control.Monad.Zip (mzipWith)

import Test.QuickCheck (Arbitrary, Gen, arbitrary, sublistOf, sized, quickCheck)

data Arbol a = N a [Arbol a]

deriving (Show, Eq)

ej1, ej2 :: Arbol Int

ej1 = N 1 [N 6 [],N 3 [N 5 []]]

ej2 = N 3 [N 5 [N 6 []], N 4 [], N 7 [N 2 [], N 1 []]]

-- 1ª solución

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

emparejaArboles1 :: (a -> b -> c) -> Arbol a -> Arbol b -> Arbol c

emparejaArboles1 f (N x xs) (N y ys) =

N (f x y) (zipWith (emparejaArboles1 f) xs ys)

-- 2ª solución

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

emparejaArboles2 :: (a -> b -> c) -> Arbol a -> Arbol b -> Arbol c

emparejaArboles2 f x y =

treeAarbol (mzipWith f (arbolAtree x) (arbolAtree y))

arbolAtree :: Arbol a -> Tree a

arbolAtree (N x xs) = Node x (map arbolAtree xs)

treeAarbol :: Tree a -> Arbol a

treeAarbol (Node x xs) = N x (map treeAarbol xs)

-- Comprobación de equivalencia

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

-- (arbolArbitrario n) es un árbol aleatorio de orden n. Por ejemplo,

-- λ> generate (arbolArbitrario 5 :: Gen (Arbol Int))

-- N (-26) [N 8 [N 6 [N 11 []]],N 7 []]

-- λ> generate (arbolArbitrario 5 :: Gen (Arbol Int))

-- N 1 []

-- λ> generate (arbolArbitrario 5 :: Gen (Arbol Int))

-- N (-19) [N (-11) [],N 25 [],N 19 [N (-27) [],N (-19) [N 17 []]]]

arbolArbitrario :: Arbitrary a => Int -> Gen (Arbol a)

arbolArbitrario n = do

x <- arbitrary

ms <- sublistOf [0 .. n `div` 2]

as <- mapM arbolArbitrario ms

return (N x as)

-- Arbol es una subclase de Arbitraria

instance Arbitrary a => Arbitrary (Arbol a) where

arbitrary = sized arbolArbitrario

-- La propiedad es

prop_emparejaArboles :: Arbol Int -> Arbol Int -> Bool

prop_emparejaArboles x y =

emparejaArboles1 (+) x y == emparejaArboles2 (+) x y &&

emparejaArboles1 (*) x y == emparejaArboles2 (*) x y

-- La comprobación es

-- λ> quickCheck prop_emparejaArboles

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> a500 <- generate (arbolArbitrario 500 :: Gen (Arbol Int))

-- λ> emparejaArboles1 (+) a500 a500 == emparejaArboles1 (+) a500 a500

-- True

-- (1.92 secs, 1,115,813,352 bytes)

-- λ> emparejaArboles2 (+) a500 a500 == emparejaArboles2 (+) a500 a500

-- True

-- (3.28 secs, 2,212,257,928 bytes)

-- λ> b500 = arbolAtree a500

-- λ> mzipWith (+) b500 b500 == mzipWith (+) b500 b500

-- True

-- (0.21 secs, 563,503,112 bytes)

El código se encuentra en GitHub.

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

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>

Separación por posición

PorJosé A. Alonso 15-abril-202230-abril-2022

Definir la función

   particion :: [a] -> ([a],[a])

1	particion :: [a] -> ([a],[a])

tal que (particion xs) es el par cuya primera componente son los elementos de xs en posiciones pares y su segunda componente son los restantes elementos. Por ejemplo,

   particion [3,5,6,2]    ==  ([3,6],[5,2])
   particion [3,5,6,2,7]  ==  ([3,6,7],[5,2])
   particion "particion"  ==  ("priin","atco")

particion [3,5,6,2] == ([3,6],[5,2])

particion [3,5,6,2,7] == ([3,6,7],[5,2])

particion "particion" == ("priin","atco")

Soluciones

module Separacion_por_posicion where

import Data.List (partition)
import qualified Data.Vector as V ((!), fromList, length)
import Test.QuickCheck (quickCheck)

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

particion1 :: [a] -> ([a],[a])
particion1 xs = ([x | (n,x) <- nxs, even n],
                 [x | (n,x) <- nxs, odd n])
  where nxs = enumeracion xs

--(numeracion xs) es la enumeración de xs. Por ejemplo,
--    enumeracion [7,9,6,8]  ==  [(0,7),(1,9),(2,6),(3,8)]
enumeracion :: [a] -> [(Int,a)]
enumeracion = zip [0..]

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

particion2 :: [a] -> ([a],[a])
particion2 []     = ([],[])
particion2 (x:xs) = (x:zs,ys)
  where (ys,zs) = particion2 xs

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

particion3 :: [a] -> ([a],[a])
particion3 = foldr f ([],[])
  where f x (ys,zs) = (x:zs,ys)

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

particion4 :: [a] -> ([a],[a])
particion4 = foldr (\x (ys,zs) -> (x:zs,ys)) ([],[])

-- 5ª solución
-- ===========

particion5 :: [a] -> ([a],[a])
particion5 xs =
  ([xs!!k | k <- [0,2..n]],
   [xs!!k | k <- [1,3..n]])
  where n = length xs - 1

-- 6ª solución
-- ===========

particion6 :: [a] -> ([a],[a])
particion6 xs = (pares xs, impares xs)

-- (pares xs) es la lista de los elementos de xs en posiciones
-- pares. Por ejemplo,
--    pares [3,5,6,2]  ==  [3,6]
pares :: [a] -> [a]
pares []     = []
pares (x:xs) = x : impares xs

-- (impares xs) es la lista de los elementos de xs en posiciones
-- impares. Por ejemplo,
--    impares [3,5,6,2]  ==  [5,2]
impares :: [a] -> [a]
impares []     = []
impares (_:xs) = pares xs

-- 7ª solución
-- ===========

particion7 :: [a] -> ([a],[a])
particion7 [] = ([],[])
particion7 xs =
  ([v V.! k | k <- [0,2..n-1]],
   [v V.! k | k <- [1,3..n-1]])
  where v = V.fromList xs
        n = V.length v

-- 8ª solución
-- ===========

particion8 :: [a] -> ([a],[a])
particion8 xs =
  (map snd ys, map snd zs)
  where (ys,zs) = partition posicionPar (zip [0..] xs)

posicionPar :: (Int,a) -> Bool
posicionPar = even . fst

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

-- La propiedad es
prop_particion :: [Int] -> Bool
prop_particion xs =
  all (== particion1 xs)
      [particion2 xs,
       particion3 xs,
       particion4 xs,
       particion5 xs,
       particion6 xs,
       particion7 xs,
       particion8 xs]

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

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

-- La comparación es
--    λ> last (snd (particion1 [1..6*10^6]))
--    6000000
--    (2.74 secs, 2,184,516,080 bytes)
--    λ> last (snd (particion2 [1..6*10^6]))
--    6000000
--    (2.02 secs, 1,992,515,880 bytes)
--    λ> last (snd (particion3 [1..6*10^6]))
--    6000000
--    (3.17 secs, 1,767,423,240 bytes)
--    λ> last (snd (particion4 [1..6*10^6]))
--    6000000
--    (3.23 secs, 1,767,423,240 bytes)
--    λ> last (snd (particion5 [1..6*10^6]))
--    6000000
--    (1.62 secs, 1,032,516,192 bytes)
--    λ> last (snd (particion5 [1..6*10^6]))
--    6000000
--    (1.33 secs, 1,032,516,192 bytes)
--    λ> last (snd (particion6 [1..6*10^6]))
--    6000000
--    (1.80 secs, 888,515,960 bytes)
--    λ> last (snd (particion7 [1..6*10^6]))
--    6000000
--    (1.29 secs, 1,166,865,672 bytes)
--    λ> last (snd (particion8 [1..6*10^6]))
--    6000000
--    (0.87 secs, 3,384,516,616 bytes)
--
--    λ> last (snd (particion5 [1..10^7]))
--    10000000
--    (1.94 secs, 1,720,516,872 bytes)
--    λ> last (snd (particion7 [1..10^7]))
--    10000000
--    (2.54 secs, 1,989,215,176 bytes)
--    λ> last (snd (particion8 [1..10^7]))
--    10000000
--    (1.33 secs, 5,640,516,960 bytes)

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

module Separacion_por_posicion where

import Data.List (partition)

import qualified Data.Vector as V ((!), fromList, length)

import Test.QuickCheck (quickCheck)

-- 1ª solución

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

particion1 :: [a] -> ([a],[a])

particion1 xs = ([x | (n,x) <- nxs, even n],

[x | (n,x) <- nxs, odd n])

where nxs = enumeracion xs

--(numeracion xs) es la enumeración de xs. Por ejemplo,

-- enumeracion [7,9,6,8] == [(0,7),(1,9),(2,6),(3,8)]

enumeracion :: [a] -> [(Int,a)]

enumeracion = zip [0..]

-- 2ª solución

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

particion2 :: [a] -> ([a],[a])

particion2 [] = ([],[])

particion2 (x:xs) = (x:zs,ys)

where (ys,zs) = particion2 xs

-- 3ª solución

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

particion3 :: [a] -> ([a],[a])

particion3 = foldr f ([],[])

where f x (ys,zs) = (x:zs,ys)

-- 4ª solución

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

particion4 :: [a] -> ([a],[a])

particion4 = foldr (\x (ys,zs) -> (x:zs,ys)) ([],[])

-- 5ª solución

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

particion5 :: [a] -> ([a],[a])

particion5 xs =

([xs!!k | k <- [0,2..n]],

[xs!!k | k <- [1,3..n]])

where n = length xs - 1

-- 6ª solución

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

particion6 :: [a] -> ([a],[a])

particion6 xs = (pares xs, impares xs)

-- (pares xs) es la lista de los elementos de xs en posiciones

-- pares. Por ejemplo,

-- pares [3,5,6,2] == [3,6]

pares :: [a] -> [a]

pares [] = []

pares (x:xs) = x : impares xs

-- (impares xs) es la lista de los elementos de xs en posiciones

-- impares. Por ejemplo,

-- impares [3,5,6,2] == [5,2]

impares :: [a] -> [a]

impares [] = []

impares (_:xs) = pares xs

-- 7ª solución

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

particion7 :: [a] -> ([a],[a])

particion7 [] = ([],[])

particion7 xs =

([v V.! k | k <- [0,2..n-1]],

[v V.! k | k <- [1,3..n-1]])

where v = V.fromList xs

n = V.length v

-- 8ª solución

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

particion8 :: [a] -> ([a],[a])

particion8 xs =

(map snd ys, map snd zs)

where (ys,zs) = partition posicionPar (zip [0..] xs)

posicionPar :: (Int,a) -> Bool

posicionPar = even . fst

-- Comprobación de equivalencia

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

-- La propiedad es

prop_particion :: [Int] -> Bool

prop_particion xs =

all (== particion1 xs)

[particion2 xs,

particion3 xs,

particion4 xs,

particion5 xs,

particion6 xs,

particion7 xs,

particion8 xs]

-- La comprobación es

-- λ> quickCheck prop_particion

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> last (snd (particion1 [1..6*10^6]))

-- 6000000

-- (2.74 secs, 2,184,516,080 bytes)

-- λ> last (snd (particion2 [1..6*10^6]))

-- 6000000

-- (2.02 secs, 1,992,515,880 bytes)

-- λ> last (snd (particion3 [1..6*10^6]))

-- 6000000

-- (3.17 secs, 1,767,423,240 bytes)

-- λ> last (snd (particion4 [1..6*10^6]))

-- 6000000

-- (3.23 secs, 1,767,423,240 bytes)

-- λ> last (snd (particion5 [1..6*10^6]))

-- 6000000

-- (1.62 secs, 1,032,516,192 bytes)

-- λ> last (snd (particion5 [1..6*10^6]))

-- 6000000

-- (1.33 secs, 1,032,516,192 bytes)

-- λ> last (snd (particion6 [1..6*10^6]))

-- 6000000

-- (1.80 secs, 888,515,960 bytes)

-- λ> last (snd (particion7 [1..6*10^6]))

-- 6000000

-- (1.29 secs, 1,166,865,672 bytes)

-- λ> last (snd (particion8 [1..6*10^6]))

-- 6000000

-- (0.87 secs, 3,384,516,616 bytes)

-- λ> last (snd (particion5 [1..10^7]))

-- 10000000

-- (1.94 secs, 1,720,516,872 bytes)

-- λ> last (snd (particion7 [1..10^7]))

-- 10000000

-- (2.54 secs, 1,989,215,176 bytes)

-- λ> last (snd (particion8 [1..10^7]))

-- 10000000

-- (1.33 secs, 5,640,516,960 bytes)

El código se encuentra en GitHub.

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

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>

Número de inversiones

PorJosé A. Alonso 14-abril-202213-abril-2022

Se dice que en una sucesión de números x(1), x(2), …, x(n) hay una inversión cuando existe un par de números x(i) > x(j), siendo i < j. Por ejemplo, en la permutación 2, 1, 4, 3 hay dos inversiones (2 antes que 1 y 4 antes que 3) y en la permutación 4, 3, 1, 2 hay cinco inversiones (4 antes 3, 4 antes 1, 4 antes 2, 3 antes 1, 3 antes 2).

Definir la función

   numeroInversiones :: Ord a => [a] -> Int

1	numeroInversiones :: Ord a => [a] -> Int

tal que (numeroInversiones xs) es el número de inversiones de xs. Por ejemplo,

   numeroInversiones [2,1,4,3]  ==  2
   numeroInversiones [4,3,1,2]  ==  5

1 2	numeroInversiones [2,1,4,3] == 2 numeroInversiones [4,3,1,2] == 5

Soluciones

[schedule expon=’2022-04-21′ expat=»06:00″]

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

[/schedule]

[schedule on=’2022-04-21′ at=»06:00″]

import Test.QuickCheck (quickCheck)
import Data.Array ((!), listArray)

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

numeroInversiones1 :: Ord a => [a] -> Int
numeroInversiones1 = length . indicesInversiones

-- (indicesInversiones xs) es la lista de los índices de las inversiones
-- de xs. Por ejemplo,
--    indicesInversiones [2,1,4,3]  ==  [(0,1),(2,3)]
--    indicesInversiones [4,3,1,2]  ==  [(0,1),(0,2),(0,3),(1,2),(1,3)]
indicesInversiones :: Ord a => [a] -> [(Int,Int)]
indicesInversiones xs = [(i,j) | i <- [0..n-2],
                                 j <- [i+1..n-1],
                                 xs!!i > xs!!j]
  where n = length xs

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

numeroInversiones2 :: Ord a => [a] -> Int
numeroInversiones2 = length . indicesInversiones2

indicesInversiones2 :: Ord a => [a] -> [(Int,Int)]
indicesInversiones2 xs = [(i,j) | i <- [0..n-2],
                                  j <- [i+1..n-1],
                                  v!i > v!j]
  where n = length xs
        v = listArray (0,n-1) xs

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

numeroInversiones3 :: Ord a => [a] -> Int
numeroInversiones3 = length . inversiones

-- (inversiones xs) es la lista de las inversiones  de xs. Por ejemplo,
--    Inversiones [2,1,4,3]  ==  [(2,1),(4,3)]
--    Inversiones [4,3,1,2]  ==  [(4,3),(4,1),(4,2),(3,1),(3,2)]
inversiones :: Ord a => [a] -> [(a,a)]
inversiones []     = []
inversiones (x:xs) = [(x,y) | y <- xs, y < x] ++ inversiones xs

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

numeroInversiones4 :: Ord a => [a] -> Int
numeroInversiones4 []     = 0
numeroInversiones4 (x:xs) = length (filter (x>) xs) + numeroInversiones4 xs

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

-- La propiedad es
prop_numeroInversiones :: [Int] -> Bool
prop_numeroInversiones xs =
  all (== numeroInversiones1 xs)
      [numeroInversiones2 xs,
       numeroInversiones3 xs,
       numeroInversiones4 xs]

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

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

-- La comparación es
--    λ> numeroInversiones1 [1200,1199..1]
--    719400
--    (2.30 secs, 236,976,776 bytes)
--    λ> numeroInversiones2 [1200,1199..1]
--    719400
--    (0.61 secs, 294,538,488 bytes)
--    λ> numeroInversiones3 [1200,1199..1]
--    719400
--    (0.26 secs, 150,543,056 bytes)
--    λ> numeroInversiones4 [1200,1199..1]
--    719400
--    (0.10 secs, 41,274,888 bytes)
--
--    λ> numeroInversiones3 [3000,2999..1]
--    4498500
--    (1.35 secs, 937,186,992 bytes)
--    λ> numeroInversiones4 [3000,2999..1]
--    4498500
--    (0.61 secs, 253,665,928 bytes)

import Test.QuickCheck (quickCheck)

import Data.Array ((!), listArray)

-- 1ª solución

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

numeroInversiones1 :: Ord a => [a] -> Int

numeroInversiones1 = length . indicesInversiones

-- (indicesInversiones xs) es la lista de los índices de las inversiones

-- de xs. Por ejemplo,

-- indicesInversiones [2,1,4,3] == [(0,1),(2,3)]

-- indicesInversiones [4,3,1,2] == [(0,1),(0,2),(0,3),(1,2),(1,3)]

indicesInversiones :: Ord a => [a] -> [(Int,Int)]

indicesInversiones xs = [(i,j) | i <- [0..n-2],

j <- [i+1..n-1],

xs!!i > xs!!j]

where n = length xs

-- 2ª solución

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

numeroInversiones2 :: Ord a => [a] -> Int

numeroInversiones2 = length . indicesInversiones2

indicesInversiones2 :: Ord a => [a] -> [(Int,Int)]

indicesInversiones2 xs = [(i,j) | i <- [0..n-2],

j <- [i+1..n-1],

v!i > v!j]

where n = length xs

v = listArray (0,n-1) xs

-- 3ª solución

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

numeroInversiones3 :: Ord a => [a] -> Int

numeroInversiones3 = length . inversiones

-- (inversiones xs) es la lista de las inversiones de xs. Por ejemplo,

-- Inversiones [2,1,4,3] == [(2,1),(4,3)]

-- Inversiones [4,3,1,2] == [(4,3),(4,1),(4,2),(3,1),(3,2)]

inversiones :: Ord a => [a] -> [(a,a)]

inversiones [] = []

inversiones (x:xs) = [(x,y) | y <- xs, y < x] ++ inversiones xs

-- 4ª solución

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

numeroInversiones4 :: Ord a => [a] -> Int

numeroInversiones4 [] = 0

numeroInversiones4 (x:xs) = length (filter (x>) xs) + numeroInversiones4 xs

-- Comprobación de equivalencia

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

-- La propiedad es

prop_numeroInversiones :: [Int] -> Bool

prop_numeroInversiones xs =

all (== numeroInversiones1 xs)

[numeroInversiones2 xs,

numeroInversiones3 xs,

numeroInversiones4 xs]

-- La comprobación es

-- λ> quickCheck prop_numeroInversiones

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> numeroInversiones1 [1200,1199..1]

-- 719400

-- (2.30 secs, 236,976,776 bytes)

-- λ> numeroInversiones2 [1200,1199..1]

-- 719400

-- (0.61 secs, 294,538,488 bytes)

-- λ> numeroInversiones3 [1200,1199..1]

-- 719400

-- (0.26 secs, 150,543,056 bytes)

-- λ> numeroInversiones4 [1200,1199..1]

-- 719400

-- (0.10 secs, 41,274,888 bytes)

-- λ> numeroInversiones3 [3000,2999..1]

-- 4498500

-- (1.35 secs, 937,186,992 bytes)

-- λ> numeroInversiones4 [3000,2999..1]

-- 4498500

-- (0.61 secs, 253,665,928 bytes)

El código se encuentra en [GitHub](https://github.com/jaalonso/Exercitium/blob/main/src/

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

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>

[/schedule]

Descomposiciones triangulares

PorJosé A. Alonso 13-abril-202215-abril-2022

Los números triangulares se forman como sigue

   *     *      *
        * *    * *
              * * *
   1     3      6

* * *

* * * *

* * *

1 3 6

La sucesión de los números triangulares se obtiene sumando los números naturales. Así, los 5 primeros números triangulares son

    1 = 1
    3 = 1 + 2
    6 = 1 + 2 + 3
   10 = 1 + 2 + 3 + 4
   15 = 1 + 2 + 3 + 4 + 5

1 = 1

3 = 1 + 2

6 = 1 + 2 + 3

10 = 1 + 2 + 3 + 4

15 = 1 + 2 + 3 + 4 + 5

Definir la función

   descomposicionesTriangulares :: Int -> [(Int, Int, Int)]

1	descomposicionesTriangulares :: Int -> [(Int, Int, Int)]

tal que (descomposicionesTriangulares n) es la lista de las ternas correspondientes a las descomposiciones de n en tres sumandos formados por números triangulares. Por ejemplo,

   descomposicionesTriangulares  4 == []
   descomposicionesTriangulares  5 == [(1,1,3)]
   descomposicionesTriangulares 12 == [(1,1,10),(3,3,6)]
   descomposicionesTriangulares 30 == [(1,1,28),(3,6,21),(10,10,10)]
   descomposicionesTriangulares 61 == [(1,15,45),(3,3,55),(6,10,45),(10,15,36)]
   descomposicionesTriangulares 52 == [(1,6,45),(1,15,36),(3,21,28),(6,10,36),(10,21,21)]
   descomposicionesTriangulares 82 == [(1,3,78),(1,15,66),(1,36,45),(6,10,66),(6,21,55),(10,36,36)]
   length (descomposicionesTriangulares (5*10^5)) == 124

descomposicionesTriangulares 4 == []

descomposicionesTriangulares 5 == [(1,1,3)]

descomposicionesTriangulares 12 == [(1,1,10),(3,3,6)]

descomposicionesTriangulares 30 == [(1,1,28),(3,6,21),(10,10,10)]

descomposicionesTriangulares 61 == [(1,15,45),(3,3,55),(6,10,45),(10,15,36)]

descomposicionesTriangulares 52 == [(1,6,45),(1,15,36),(3,21,28),(6,10,36),(10,21,21)]

descomposicionesTriangulares 82 == [(1,3,78),(1,15,66),(1,36,45),(6,10,66),(6,21,55),(10,36,36)]

length (descomposicionesTriangulares (5*10^5)) == 124

Soluciones

[schedule expon=’2022-04-20′ expat=»06:00″]

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

[/schedule]

[schedule on=’2022-04-20′ at=»06:00″]

import Test.QuickCheck

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

descomposicionesTriangulares1 :: Int -> [(Int, Int, Int)]
descomposicionesTriangulares1 n =
  [(x,y,z) | x <- xs,
             y <- xs,
             z <- xs,
             x <= y && y <= z,
             x + y + z == n]
  where xs = takeWhile (<=n) triangulares

-- triangulares es la lista de los números triangulares. Por ejemplo,
--    take 9 triangulares  ==  [1,3,6,10,15,21,28,36,45]
triangulares :: [Int]
triangulares = scanl (+) 1 [2..]

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

descomposicionesTriangulares2 :: Int -> [(Int, Int, Int)]
descomposicionesTriangulares2 n =
  [(x,y,z) | x <- xs,
             y <- xs,
             x <= y,
             z <- xs,
             y <= z,
             x + y + z == n]
  where xs = takeWhile (<=n) triangulares

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

descomposicionesTriangulares3 :: Int -> [(Int, Int, Int)]
descomposicionesTriangulares3 n =
  [(x,y,z) | x <- xs,
             y <- xs,
             x <= y,
             let z = n - x - y,
             y <= z,
             z `elem` xs]
  where xs = takeWhile (<=n) triangulares

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

descomposicionesTriangulares4 :: Int -> [(Int, Int, Int)]
descomposicionesTriangulares4 n =
  [(x,y,n-x-y) | x <- xs,
                 y <- dropWhile (<x) xs,
                 let z = n - x - y,
                 y <= z,
                 z `elem` xs]
  where xs = takeWhile (<=n) triangulares

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

-- La propiedad es
prop_descomposicionesTriangulares ::  Positive Int -> Bool
prop_descomposicionesTriangulares (Positive n) =
  all (== descomposicionesTriangulares1 n)
      [descomposicionesTriangulares2 n,
       descomposicionesTriangulares3 n,
       descomposicionesTriangulares4 n]

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

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

-- La comparación es
--   λ> last (descomposicionesTriangulares1 (2*10^4))
--   (5671,6328,8001)
--   (3.34 secs, 1,469,517,168 bytes)
--   λ> last (descomposicionesTriangulares2 (2*10^4))
--   (5671,6328,8001)
--   (1.29 secs, 461,433,928 bytes)
--   λ> last (descomposicionesTriangulares3 (2*10^4))
--   (5671,6328,8001)
--   (0.08 secs, 6,574,056 bytes)
--
--   λ> last (descomposicionesTriangulares3 (5*10^5))
--   (140185,148240,211575)
--   (2.12 secs, 151,137,280 bytes)
--   λ> last (descomposicionesTriangulares4 (5*10^5))
--   (140185,148240,211575)
--   (2.30 secs, 103,280,216 bytes)

import Test.QuickCheck

-- 1ª solución

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

descomposicionesTriangulares1 :: Int -> [(Int, Int, Int)]

descomposicionesTriangulares1 n =

[(x,y,z) | x <- xs,

y <- xs,

z <- xs,

x <= y && y <= z,

x + y + z == n]

where xs = takeWhile (<=n) triangulares

-- triangulares es la lista de los números triangulares. Por ejemplo,

-- take 9 triangulares == [1,3,6,10,15,21,28,36,45]

triangulares :: [Int]

triangulares = scanl (+) 1 [2..]

-- 2ª solución

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

descomposicionesTriangulares2 :: Int -> [(Int, Int, Int)]

descomposicionesTriangulares2 n =

[(x,y,z) | x <- xs,

y <- xs,

x <= y,

z <- xs,

y <= z,

x + y + z == n]

where xs = takeWhile (<=n) triangulares

-- 3ª solución

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

descomposicionesTriangulares3 :: Int -> [(Int, Int, Int)]

descomposicionesTriangulares3 n =

[(x,y,z) | x <- xs,

y <- xs,

x <= y,

let z = n - x - y,

y <= z,

z `elem` xs]

where xs = takeWhile (<=n) triangulares

-- 4ª solución

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

descomposicionesTriangulares4 :: Int -> [(Int, Int, Int)]

descomposicionesTriangulares4 n =

[(x,y,n-x-y) | x <- xs,

y <- dropWhile (<x) xs,

let z = n - x - y,

y <= z,

z `elem` xs]

where xs = takeWhile (<=n) triangulares

-- Comprobación de equivalencia

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

-- La propiedad es

prop_descomposicionesTriangulares :: Positive Int -> Bool

prop_descomposicionesTriangulares (Positive n) =

all (== descomposicionesTriangulares1 n)

[descomposicionesTriangulares2 n,

descomposicionesTriangulares3 n,

descomposicionesTriangulares4 n]

-- La comprobación es

-- λ> quickCheck prop_descomposicionesTriangulares

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> last (descomposicionesTriangulares1 (2*10^4))

-- (5671,6328,8001)

-- (3.34 secs, 1,469,517,168 bytes)

-- λ> last (descomposicionesTriangulares2 (2*10^4))

-- (5671,6328,8001)

-- (1.29 secs, 461,433,928 bytes)

-- λ> last (descomposicionesTriangulares3 (2*10^4))

-- (5671,6328,8001)

-- (0.08 secs, 6,574,056 bytes)

-- λ> last (descomposicionesTriangulares3 (5*10^5))

-- (140185,148240,211575)

-- (2.12 secs, 151,137,280 bytes)

-- λ> last (descomposicionesTriangulares4 (5*10^5))

-- (140185,148240,211575)

-- (2.30 secs, 103,280,216 bytes)

El código se encuentra en [GitHub](https://github.com/jaalonso/Exercitium/blob/main/src/Descomposiciones_triangulares.hs).

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

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>

[/schedule]

Índices de valores verdaderos

PorJosé A. Alonso 12-abril-202211-abril-2022

Definir la función

   indicesVerdaderos :: [Int] -> [Bool]

1	indicesVerdaderos :: [Int] -> [Bool]

tal que (indicesVerdaderos xs) es la lista infinita de booleanos tal que sólo son verdaderos los elementos cuyos índices pertenecen a la lista estrictamente creciente xs. Por ejemplo,

   λ> take 6 (indicesVerdaderos [1,4])
   [False,True,False,False,True,False]
   λ> take 6 (indicesVerdaderos [0,2..])
   [True,False,True,False,True,False]
   λ> take 3 (indicesVerdaderos [])
   [False,False,False]
   λ> take 6 (indicesVerdaderos [1..])
   [False,True,True,True,True,True]
   λ> last (take (8*10^7) (indicesVerdaderos [0,5..]))
   False

λ> take 6 (indicesVerdaderos [1,4])

[False,True,False,False,True,False]

λ> take 6 (indicesVerdaderos [0,2..])

[True,False,True,False,True,False]

λ> take 3 (indicesVerdaderos [])

[False,False,False]

λ> take 6 (indicesVerdaderos [1..])

[False,True,True,True,True,True]

λ> last (take (8*10^7) (indicesVerdaderos [0,5..]))

False

Soluciones

[schedule expon=’2022-04-19′ expat=»06:00″]

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

[/schedule]

[schedule on=’2022-04-19′ at=»06:00″]

import Data.List.Ordered (member)
import Test.QuickCheck

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

indicesVerdaderos1 :: [Int] -> [Bool]
indicesVerdaderos1 []     = repeat False
indicesVerdaderos1 (x:ys) =
  replicate x False ++ [True] ++ indicesVerdaderos1 [y-x-1 | y <- ys]

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

indicesVerdaderos2 :: [Int] -> [Bool]
indicesVerdaderos2 = aux 0
  where aux _ []     = repeat False
        aux n (x:xs) | x == n    = True  : aux (n+1) xs
                     | otherwise = False : aux (n+1) (x:xs)

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

indicesVerdaderos3 :: [Int] -> [Bool]
indicesVerdaderos3 = aux [0..]
  where aux _      []                 = repeat False
        aux (i:is) (x:xs) | i == x    = True  : aux is xs
                          | otherwise = False : aux is (x:xs)

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

indicesVerdaderos4 :: [Int] -> [Bool]
indicesVerdaderos4 xs = [pertenece x xs | x <- [0..]]

-- (pertenece x ys) se verifica si x pertenece a la lista estrictamente
-- creciente (posiblemente infinita) ys. Por ejemplo,
--    pertenece 9 [1,3..]  ==  True
--    pertenece 6 [1,3..]  ==  False
pertenece :: Int -> [Int] -> Bool
pertenece x ys = x `elem` takeWhile (<=x) ys

-- 5ª solución
-- ===========

indicesVerdaderos5 :: [Int] -> [Bool]
indicesVerdaderos5 xs = map (`pertenece2` xs) [0..]

pertenece2 :: Int -> [Int] -> Bool
pertenece2 x = aux
  where aux [] = False
        aux (y:ys) = case compare x y of
                       LT -> False
                       EQ -> True
                       GT -> aux ys

-- 6ª solución
-- ===========

indicesVerdaderos6 :: [Int] -> [Bool]
indicesVerdaderos6 xs = map (`member` xs) [0..]

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

-- ListaCreciente es un tipo de dato para generar lista de enteros
-- crecientes arbitrarias.
newtype ListaCreciente = LC [Int]
  deriving Show

-- listaCrecienteArbitraria es un generador de lista de enteros
-- crecientes arbitrarias. Por ejemplo,
--    λ> sample listaCrecienteArbitraria
--    LC []
--    LC [2,5]
--    LC [4,8]
--    LC [6,13]
--    LC [7,15,20,28,33]
--    LC [11,15,20,29,35,40]
--    LC [5,17,25,36,42,50,52,64]
--    LC [9,16,31,33,46,59,74,83,85,89,104,113,118]
--    LC [9,22,29,35,37,49,53,62,68,77,83,100]
--    LC []
--    LC [3,22,25,34,36,51,72,75,89]
listaCrecienteArbitraria :: Gen ListaCreciente
listaCrecienteArbitraria = do
  xs <- arbitrary
  return (LC (listaCreciente xs))

-- (listaCreciente xs) es la lista creciente correspondiente a xs. Por ejemplo,
--    listaCreciente [-1,3,-4,3,0]   ==  [2,6,11,15,16]
listaCreciente :: [Int] -> [Int]
listaCreciente xs =
  scanl1 (+) (map (succ . abs) xs)

-- ListaCreciente está contenida en Arbitrary
instance Arbitrary ListaCreciente where
  arbitrary = listaCrecienteArbitraria

-- La propiedad es
prop_indicesVerdaderos :: ListaCreciente -> Bool
prop_indicesVerdaderos (LC xs) =
  all (== take n (indicesVerdaderos1 xs))
      [take n (f xs) | f <-[indicesVerdaderos2,
                            indicesVerdaderos3,
                            indicesVerdaderos4,
                            indicesVerdaderos5,
                            indicesVerdaderos6]]
  where n = length xs

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

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

-- La comparación es
--    λ> last (take (2*10^4) (indicesVerdaderos1 [0,5..]))
--    False
--    (2.69 secs, 2,611,031,544 bytes)
--    λ> last (take (2*10^4) (indicesVerdaderos2 [0,5..]))
--    False
--    (0.03 secs, 10,228,880 bytes)
--
--    λ> last (take (4*10^6) (indicesVerdaderos2 [0,5..]))
--    False
--    (2.37 secs, 1,946,100,856 bytes)
--    λ> last (take (4*10^6) (indicesVerdaderos3 [0,5..]))
--    False
--    (1.54 secs, 1,434,100,984 bytes)
--
--    λ> last (take (6*10^6) (indicesVerdaderos3 [0,5..]))
--    False
--    (2.30 secs, 2,150,900,984 bytes)
--    λ> last (take (6*10^6) (indicesVerdaderos4 [0,5..]))
--    False
--    (1.55 secs, 1,651,701,184 bytes)
--    λ> last (take (6*10^6) (indicesVerdaderos5 [0,5..]))
--    False
--    (0.58 secs, 1,584,514,304 bytes)
--
--    λ> last (take (3*10^7) (indicesVerdaderos5 [0,5..]))
--    False
--    (2.74 secs, 7,920,514,360 bytes)
--    λ> last (take (3*10^7) (indicesVerdaderos6 [0,5..]))
--    False
--    (0.82 secs, 6,960,514,136 bytes)

--    λ> last (take (2*10^4) (indicesVerdaderos1 [0,5..]))
--    False
--    (2.69 secs, 2,611,031,544 bytes)
--    λ> last (take (2*10^4) (indicesVerdaderos6 [0,5..]))
--    False
--    (0.01 secs, 5,154,040 bytes)

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

import Data.List.Ordered (member)

import Test.QuickCheck

-- 1ª solución

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

indicesVerdaderos1 :: [Int] -> [Bool]

indicesVerdaderos1 [] = repeat False

indicesVerdaderos1 (x:ys) =

replicate x False ++ [True] ++ indicesVerdaderos1 [y-x-1 | y <- ys]

-- 2ª solución

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

indicesVerdaderos2 :: [Int] -> [Bool]

indicesVerdaderos2 = aux 0

where aux _ [] = repeat False

aux n (x:xs) | x == n = True : aux (n+1) xs

| otherwise = False : aux (n+1) (x:xs)

-- 3ª solución

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

indicesVerdaderos3 :: [Int] -> [Bool]

indicesVerdaderos3 = aux [0..]

where aux _ [] = repeat False

aux (i:is) (x:xs) | i == x = True : aux is xs

| otherwise = False : aux is (x:xs)

-- 4ª solución

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

indicesVerdaderos4 :: [Int] -> [Bool]

indicesVerdaderos4 xs = [pertenece x xs | x <- [0..]]

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

-- creciente (posiblemente infinita) ys. Por ejemplo,

-- pertenece 9 [1,3..] == True

-- pertenece 6 [1,3..] == False

pertenece :: Int -> [Int] -> Bool

pertenece x ys = x `elem` takeWhile (<=x) ys

-- 5ª solución

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

indicesVerdaderos5 :: [Int] -> [Bool]

indicesVerdaderos5 xs = map (`pertenece2` xs) [0..]

pertenece2 :: Int -> [Int] -> Bool

pertenece2 x = aux

where aux [] = False

aux (y:ys) = case compare x y of

LT -> False

EQ -> True

GT -> aux ys

-- 6ª solución

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

indicesVerdaderos6 :: [Int] -> [Bool]

indicesVerdaderos6 xs = map (`member` xs) [0..]

-- Comprobación de equivalencia

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

-- ListaCreciente es un tipo de dato para generar lista de enteros

-- crecientes arbitrarias.

newtype ListaCreciente = LC [Int]

deriving Show

-- listaCrecienteArbitraria es un generador de lista de enteros

-- crecientes arbitrarias. Por ejemplo,

-- λ> sample listaCrecienteArbitraria

-- LC []

-- LC [2,5]

-- LC [4,8]

-- LC [6,13]

-- LC [7,15,20,28,33]

-- LC [11,15,20,29,35,40]

-- LC [5,17,25,36,42,50,52,64]

-- LC [9,16,31,33,46,59,74,83,85,89,104,113,118]

-- LC [9,22,29,35,37,49,53,62,68,77,83,100]

-- LC []

-- LC [3,22,25,34,36,51,72,75,89]

listaCrecienteArbitraria :: Gen ListaCreciente

listaCrecienteArbitraria = do

xs <- arbitrary

return (LC (listaCreciente xs))

-- (listaCreciente xs) es la lista creciente correspondiente a xs. Por ejemplo,

-- listaCreciente [-1,3,-4,3,0] == [2,6,11,15,16]

listaCreciente :: [Int] -> [Int]

listaCreciente xs =

scanl1 (+) (map (succ . abs) xs)

-- ListaCreciente está contenida en Arbitrary

instance Arbitrary ListaCreciente where

arbitrary = listaCrecienteArbitraria

-- La propiedad es

prop_indicesVerdaderos :: ListaCreciente -> Bool

prop_indicesVerdaderos (LC xs) =

all (== take n (indicesVerdaderos1 xs))

[take n (f xs) | f <-[indicesVerdaderos2,

indicesVerdaderos3,

indicesVerdaderos4,

indicesVerdaderos5,

indicesVerdaderos6]]

where n = length xs

-- La comprobación es

-- λ> quickCheck prop_indicesVerdaderos

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> last (take (2*10^4) (indicesVerdaderos1 [0,5..]))

-- False

-- (2.69 secs, 2,611,031,544 bytes)

-- λ> last (take (2*10^4) (indicesVerdaderos2 [0,5..]))

-- False

-- (0.03 secs, 10,228,880 bytes)

-- λ> last (take (4*10^6) (indicesVerdaderos2 [0,5..]))

-- False

-- (2.37 secs, 1,946,100,856 bytes)

-- λ> last (take (4*10^6) (indicesVerdaderos3 [0,5..]))

-- False

-- (1.54 secs, 1,434,100,984 bytes)

-- λ> last (take (6*10^6) (indicesVerdaderos3 [0,5..]))

-- False

-- (2.30 secs, 2,150,900,984 bytes)

-- λ> last (take (6*10^6) (indicesVerdaderos4 [0,5..]))

-- False

-- (1.55 secs, 1,651,701,184 bytes)

-- λ> last (take (6*10^6) (indicesVerdaderos5 [0,5..]))

-- False

-- (0.58 secs, 1,584,514,304 bytes)

-- λ> last (take (3*10^7) (indicesVerdaderos5 [0,5..]))

-- False

-- (2.74 secs, 7,920,514,360 bytes)

-- λ> last (take (3*10^7) (indicesVerdaderos6 [0,5..]))

-- False

-- (0.82 secs, 6,960,514,136 bytes)

-- λ> last (take (2*10^4) (indicesVerdaderos1 [0,5..]))

-- False

-- (2.69 secs, 2,611,031,544 bytes)

-- λ> last (take (2*10^4) (indicesVerdaderos6 [0,5..]))

-- False

-- (0.01 secs, 5,154,040 bytes)

El código se encuentra en [GitHub](https://github.com/jaalonso/Exercitium/blob/main/src/Indices_verdaderos.hs).

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

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>

[/schedule]

Código de las alergias

PorJosé A. Alonso 11-abril-2022

Para la determinación de las alergia se utiliza los siguientes códigos para los alérgenos:

   Huevos ........   1
   Cacahuetes ....   2
   Mariscos ......   4
   Fresas ........   8
   Tomates .......  16
   Chocolate .....  32
   Polen .........  64
   Gatos ......... 128

Huevos ........ 1

Cacahuetes .... 2

Mariscos ...... 4

Fresas ........ 8

Tomates ....... 16

Chocolate ..... 32

Polen ......... 64

Gatos ......... 128

Así, si Juan es alérgico a los cacahuetes y al chocolate, su puntuación es 34 (es decir, 2+32).

Los alérgenos se representan mediante el siguiente tipo de dato

  data Alergeno = Huevos
                | Cacahuetes
                | Mariscos
                | Fresas
                | Tomates
                | Chocolate
                | Polen
                | Gatos
    deriving (Enum, Eq, Show, Bounded)

data Alergeno = Huevos

| Cacahuetes

| Mariscos

| Fresas

| Tomates

| Chocolate

| Polen

| Gatos

deriving (Enum, Eq, Show, Bounded)

Definir la función

   alergias :: Int -> [Alergeno]

1	alergias :: Int -> [Alergeno]

tal que (alergias n) es la lista de alergias correspondiente a una puntuación n. Por ejemplo,

   λ> alergias 1
   [Huevos]
   λ> alergias 2
   [Cacahuetes]
   λ> alergias 3
   [Huevos,Cacahuetes]
   λ> alergias 5
   [Huevos,Mariscos]
   λ> alergias 255
   [Huevos,Cacahuetes,Mariscos,Fresas,Tomates,Chocolate,Polen,Gatos]

λ> alergias 1

[Huevos]

λ> alergias 2

[Cacahuetes]

λ> alergias 3

[Huevos,Cacahuetes]

λ> alergias 5

[Huevos,Mariscos]

λ> alergias 255

[Huevos,Cacahuetes,Mariscos,Fresas,Tomates,Chocolate,Polen,Gatos]

Soluciones

[schedule expon=’2022-04-18′ expat=»06:00″]

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

[/schedule]

[schedule on=’2022-04-18′ at=»06:00″]

import Data.List (subsequences)
import Test.QuickCheck

data Alergeno =
    Huevos
  | Cacahuetes
  | Mariscos
  | Fresas
  | Tomates
  | Chocolate
  | Polen
  | Gatos
  deriving (Enum, Eq, Show, Bounded)

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

alergias1 :: Int -> [Alergeno]
alergias1 n =
  [a | (a,c) <- zip alergenos codigos, c `elem` descomposicion n]

-- codigos es la lista de los códigos de los alergenos.
codigos :: [Int]
codigos = [2^x| x <- [0..7]]

-- (descomposicion n) es la descomposición de n como sumas de potencias
-- de 2. Por ejemplo,
--    descomposicion 3    ==  [1,2]
--    descomposicion 5    ==  [1,4]
--    descomposicion 248  ==  [8,16,32,64,128]
--    descomposicion 255  ==  [1,2,4,8,16,32,64,128]
descomposicion :: Int -> [Int]
descomposicion n =
  head [xs | xs <- subsequences codigos, sum xs == n]

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

alergias2 :: Int -> [Alergeno]
alergias2 = map toEnum . codigosAlergias

-- (codigosAlergias n) es la lista de códigos de alergias
-- correspondiente a una puntuación n. Por ejemplo,
--    codigosAlergias 1  ==  [0]
--    codigosAlergias 2  ==  [1]
--    codigosAlergias 3  ==  [0,1]
--    codigosAlergias 4  ==  [2]
--    codigosAlergias 5  ==  [0,2]
--    codigosAlergias 6  ==  [1,2]
codigosAlergias :: Int -> [Int]
codigosAlergias = aux [0..7]
  where aux []     _             = []
        aux (x:xs) n | odd n     = x : aux xs (n `div` 2)
                     | otherwise = aux xs (n `div` 2)

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

alergias3 :: Int -> [Alergeno]
alergias3 = map toEnum . codigosAlergias3

codigosAlergias3 :: Int -> [Int]
codigosAlergias3 n =
  [x | (x,y) <- zip [0..7] (int2bin n), y == 1]

-- (int2bin n) es la representación binaria del número n. Por ejemplo,
--    int2bin 10  ==  [0,1,0,1]
-- ya que 10 = 0*1 + 1*2 + 0*4 + 1*8
int2bin :: Int -> [Int]
int2bin n | n < 2     = [n]
          | otherwise = n `rem` 2 : int2bin (n `div` 2)

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

alergias4 :: Int -> [Alergeno]
alergias4 = map toEnum . codigosAlergias4

codigosAlergias4 :: Int -> [Int]
codigosAlergias4 n =
  map fst (filter ((== 1) . snd) (zip  [0..7] (int2bin n)))

-- 5ª solución
-- ===========

alergias5 :: Int -> [Alergeno]
alergias5 = map (toEnum . fst)
          . filter ((1 ==) . snd)
          . zip [0..7]
          . int2bin

-- 6ª solución
-- ===========

alergias6 :: Int -> [Alergeno]
alergias6 = aux alergenos
  where aux []     _             = []
        aux (x:xs) n | odd n     = x : aux xs (n `div` 2)
                     | otherwise = aux xs (n `div` 2)

-- alergenos es la lista de los alergenos. Por ejemplo.
--    take 3 alergenos  ==  [Huevos,Cacahuetes,Mariscos]
alergenos :: [Alergeno]
alergenos = [minBound..maxBound]

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

-- La propiedad es
prop_alergias :: Property
prop_alergias =
  forAll (arbitrary `suchThat` esValido) $ \n ->
  all (== alergias1 n)
      [alergias2 n,
       alergias3 n,
       alergias4 n,
       alergias5 n,
       alergias6 n]
  where esValido x = 1 <= x && x <= 255

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

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

-- La comparación es
--    λ> last (map alergias1 [1..255])
--    [Huevos,Cacahuetes,Mariscos,Fresas,Tomates,Chocolate,Polen,Gatos]
--    (0.02 secs, 1,657,912 bytes)
--    λ> last (map alergias2 [1..255])
--    [Huevos,Cacahuetes,Mariscos,Fresas,Tomates,Chocolate,Polen,Gatos]
--    (0.01 secs, 597,080 bytes)
--    λ> last (map alergias3 [1..255])
--    [Huevos,Cacahuetes,Mariscos,Fresas,Tomates,Chocolate,Polen,Gatos]
--    (0.01 secs, 597,640 bytes)
--    λ> last (map alergias4 [1..255])
--    [Huevos,Cacahuetes,Mariscos,Fresas,Tomates,Chocolate,Polen,Gatos]
--    (0.01 secs, 598,152 bytes)
--    λ> last (map alergias5 [1..255])
--    [Huevos,Cacahuetes,Mariscos,Fresas,Tomates,Chocolate,Polen,Gatos]
--    (0.01 secs, 596,888 bytes)

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

import Data.List (subsequences)

import Test.QuickCheck

data Alergeno =

Huevos

| Cacahuetes

| Mariscos

| Fresas

| Tomates

| Chocolate

| Polen

| Gatos

deriving (Enum, Eq, Show, Bounded)

-- 1ª solución

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

alergias1 :: Int -> [Alergeno]

alergias1 n =

[a | (a,c) <- zip alergenos codigos, c `elem` descomposicion n]

-- codigos es la lista de los códigos de los alergenos.

codigos :: [Int]

codigos = [2^x| x <- [0..7]]

-- (descomposicion n) es la descomposición de n como sumas de potencias

-- de 2. Por ejemplo,

-- descomposicion 3 == [1,2]

-- descomposicion 5 == [1,4]

-- descomposicion 248 == [8,16,32,64,128]

-- descomposicion 255 == [1,2,4,8,16,32,64,128]

descomposicion :: Int -> [Int]

descomposicion n =

head [xs | xs <- subsequences codigos, sum xs == n]

-- 2ª solución

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

alergias2 :: Int -> [Alergeno]

alergias2 = map toEnum . codigosAlergias

-- (codigosAlergias n) es la lista de códigos de alergias

-- correspondiente a una puntuación n. Por ejemplo,

-- codigosAlergias 1 == [0]

-- codigosAlergias 2 == [1]

-- codigosAlergias 3 == [0,1]

-- codigosAlergias 4 == [2]

-- codigosAlergias 5 == [0,2]

-- codigosAlergias 6 == [1,2]

codigosAlergias :: Int -> [Int]

codigosAlergias = aux [0..7]

where aux [] _ = []

aux (x:xs) n | odd n = x : aux xs (n `div` 2)

| otherwise = aux xs (n `div` 2)

-- 3ª solución

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

alergias3 :: Int -> [Alergeno]

alergias3 = map toEnum . codigosAlergias3

codigosAlergias3 :: Int -> [Int]

codigosAlergias3 n =

[x | (x,y) <- zip [0..7] (int2bin n), y == 1]

-- (int2bin n) es la representación binaria del número n. Por ejemplo,

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

-- ya que 10 = 0*1 + 1*2 + 0*4 + 1*8

int2bin :: Int -> [Int]

int2bin n | n < 2 = [n]

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

-- 4ª solución

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

alergias4 :: Int -> [Alergeno]

alergias4 = map toEnum . codigosAlergias4

codigosAlergias4 :: Int -> [Int]

codigosAlergias4 n =

map fst (filter ((== 1) . snd) (zip [0..7] (int2bin n)))

-- 5ª solución

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

alergias5 :: Int -> [Alergeno]

alergias5 = map (toEnum . fst)

. filter ((1 ==) . snd)

. zip [0..7]

. int2bin

-- 6ª solución

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

alergias6 :: Int -> [Alergeno]

alergias6 = aux alergenos

where aux [] _ = []

aux (x:xs) n | odd n = x : aux xs (n `div` 2)

| otherwise = aux xs (n `div` 2)

-- alergenos es la lista de los alergenos. Por ejemplo.

-- take 3 alergenos == [Huevos,Cacahuetes,Mariscos]

alergenos :: [Alergeno]

alergenos = [minBound..maxBound]

-- Comprobación de equivalencia

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

-- La propiedad es

prop_alergias :: Property

prop_alergias =

forAll (arbitrary `suchThat` esValido) $ \n ->

all (== alergias1 n)

[alergias2 n,

alergias3 n,

alergias4 n,

alergias5 n,

alergias6 n]

where esValido x = 1 <= x && x <= 255

-- La comprobación es

-- λ> quickCheck prop_alergias

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> last (map alergias1 [1..255])

-- [Huevos,Cacahuetes,Mariscos,Fresas,Tomates,Chocolate,Polen,Gatos]

-- (0.02 secs, 1,657,912 bytes)

-- λ> last (map alergias2 [1..255])

-- [Huevos,Cacahuetes,Mariscos,Fresas,Tomates,Chocolate,Polen,Gatos]

-- (0.01 secs, 597,080 bytes)

-- λ> last (map alergias3 [1..255])

-- [Huevos,Cacahuetes,Mariscos,Fresas,Tomates,Chocolate,Polen,Gatos]

-- (0.01 secs, 597,640 bytes)

-- λ> last (map alergias4 [1..255])

-- [Huevos,Cacahuetes,Mariscos,Fresas,Tomates,Chocolate,Polen,Gatos]

-- (0.01 secs, 598,152 bytes)

-- λ> last (map alergias5 [1..255])

-- [Huevos,Cacahuetes,Mariscos,Fresas,Tomates,Chocolate,Polen,Gatos]

-- (0.01 secs, 596,888 bytes)

El código se encuentra en [GitHub](https://github.com/jaalonso/Exercitium/blob/main/src/Alergias.hs).

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

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>

[/schedule]

Reiteración de una función

PorJosé A. Alonso 8-abril-202216-abril-2022

Definir la función

   reiteracion :: (a -> a) -> Int -> a -> a

1	reiteracion :: (a -> a) -> Int -> a -> a

tal que (reiteracion f n x) es el resultado de aplicar n veces la función f a x. Por ejemplo,

   reiteracion (+1) 10 5  ==  15
   reiteracion (+5) 10 0  ==  50
   reiteracion (*2)  4 1  ==  16
   reiteracion (5:)  4 [] ==  [5,5,5,5]

reiteracion (+1) 10 5 == 15

reiteracion (+5) 10 0 == 50

reiteracion (*2) 4 1 == 16

reiteracion (5:) 4 [] == [5,5,5,5]

Soluciones

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

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

reiteracion1 :: (a -> a) -> Int -> a -> a
reiteracion1 _ 0 x = x
reiteracion1 f n x = f (reiteracion1 f (n-1) x)

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

reiteracion2 :: (a -> a) -> Int -> a -> a
reiteracion2 _ 0 = id
reiteracion2 f n = f . reiteracion2 f (n-1)

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

reiteracion3 :: (a -> a) -> Int -> a -> a
reiteracion3 _ 0 = id
reiteracion3 f n
  | even n    = reiteracion3 (f . f) (n `div` 2)
  | otherwise = f . reiteracion3 (f . f) (n `div` 2)

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

reiteracion4 :: (a -> a) -> Int -> a -> a
reiteracion4 f n x = reiteraciones f x !! n

reiteraciones :: (a -> a) -> a -> [a]
reiteraciones f x = x : reiteraciones f (f x)

-- 5ª solución
-- ===========

reiteracion5 :: (a -> a) -> Int -> a -> a
reiteracion5 f n x = (iterate f x) !! n

-- 6ª solución
-- ===========

-- Se puede eliminar los argumentos de la definición anterior como sigue:
--    reiteracion4 f n x = iterate f x !! n
--    reiteracion4 f n x = ((!!) (iterate f x)) n
--    reiteracion4 f n x = (((!!) . (iterate f)) x) n
--    reiteracion4 f n x = ((!!) . (iterate f)) x n
--    reiteracion4 f n x = flip ((!!) . (iterate f)) n x
--    reiteracion4 f = flip ((!!) . (iterate f))
--    reiteracion4 f = flip (((!!) .) (iterate f))
--    reiteracion4 f = flip (((!!) .) . iterate) f
--    reiteracion4 f = (flip . ((!!) .) . iterate) f
--    reiteracion4   = flip . ((!!) .) . iterate

reiteracion6 :: (a -> a) -> Int -> a -> a
reiteracion6 = flip . ((!!) .) . iterate

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

-- La propiedad es
prop_reiteracion :: Fun Int Int -> Positive Int -> Int -> Bool
prop_reiteracion (Fun _ f) (Positive n) x =
  all (== reiteracion1 f n x)
      [reiteracion2 f n x,
       reiteracion3 f n x,
       reiteracion4 f n x,
       reiteracion5 f n x,
       reiteracion6 f n x]

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

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

-- La comparación es
--    λ> reiteracion1 (+1) (10^7) 0
--    10000000
--    (5.09 secs, 2,505,392,792 bytes)
--    λ> reiteracion2 (+1) (10^7) 0
--    10000000
--    (5.45 secs, 2,896,899,728 bytes)
--    λ> reiteracion3 (+1) (10^7) 0
--    10000000
--    (2.14 secs, 816,909,416 bytes)
--    λ> reiteracion4 (+1) (10^7) 0
--    10000000
--    (4.24 secs, 1,696,899,816 bytes)
--    λ> reiteracion5 (+1) (10^7) 0
--    10000000
--    (2.53 secs, 1,376,899,800 bytes)
--    λ> reiteracion6 (+1) (10^7) 0
--    10000000
--    (2.34 secs, 1,376,899,984 bytes)

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

-- 1ª solución

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

reiteracion1 :: (a -> a) -> Int -> a -> a

reiteracion1 _ 0 x = x

reiteracion1 f n x = f (reiteracion1 f (n-1) x)

-- 2ª solución

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

reiteracion2 :: (a -> a) -> Int -> a -> a

reiteracion2 _ 0 = id

reiteracion2 f n = f . reiteracion2 f (n-1)

-- 3ª solución

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

reiteracion3 :: (a -> a) -> Int -> a -> a

reiteracion3 _ 0 = id

reiteracion3 f n

| even n = reiteracion3 (f . f) (n `div` 2)

| otherwise = f . reiteracion3 (f . f) (n `div` 2)

-- 4ª solución

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

reiteracion4 :: (a -> a) -> Int -> a -> a

reiteracion4 f n x = reiteraciones f x !! n

reiteraciones :: (a -> a) -> a -> [a]

reiteraciones f x = x : reiteraciones f (f x)

-- 5ª solución

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

reiteracion5 :: (a -> a) -> Int -> a -> a

reiteracion5 f n x = (iterate f x) !! n

-- 6ª solución

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

-- Se puede eliminar los argumentos de la definición anterior como sigue:

-- reiteracion4 f n x = iterate f x !! n

-- reiteracion4 f n x = ((!!) (iterate f x)) n

-- reiteracion4 f n x = (((!!) . (iterate f)) x) n

-- reiteracion4 f n x = ((!!) . (iterate f)) x n

-- reiteracion4 f n x = flip ((!!) . (iterate f)) n x

-- reiteracion4 f = flip ((!!) . (iterate f))

-- reiteracion4 f = flip (((!!) .) (iterate f))

-- reiteracion4 f = flip (((!!) .) . iterate) f

-- reiteracion4 f = (flip . ((!!) .) . iterate) f

-- reiteracion4 = flip . ((!!) .) . iterate

reiteracion6 :: (a -> a) -> Int -> a -> a

reiteracion6 = flip . ((!!) .) . iterate

-- Comprobación de equivalencia

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

-- La propiedad es

prop_reiteracion :: Fun Int Int -> Positive Int -> Int -> Bool

prop_reiteracion (Fun _ f) (Positive n) x =

all (== reiteracion1 f n x)

[reiteracion2 f n x,

reiteracion3 f n x,

reiteracion4 f n x,

reiteracion5 f n x,

reiteracion6 f n x]

-- La comprobación es

-- λ> quickCheck prop_reiteracion

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> reiteracion1 (+1) (10^7) 0

-- 10000000

-- (5.09 secs, 2,505,392,792 bytes)

-- λ> reiteracion2 (+1) (10^7) 0

-- 10000000

-- (5.45 secs, 2,896,899,728 bytes)

-- λ> reiteracion3 (+1) (10^7) 0

-- 10000000

-- (2.14 secs, 816,909,416 bytes)

-- λ> reiteracion4 (+1) (10^7) 0

-- 10000000

-- (4.24 secs, 1,696,899,816 bytes)

-- λ> reiteracion5 (+1) (10^7) 0

-- 10000000

-- (2.53 secs, 1,376,899,800 bytes)

-- λ> reiteracion6 (+1) (10^7) 0

-- 10000000

-- (2.34 secs, 1,376,899,984 bytes)

El código se encuentra en GitHub.

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

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>

Elementos de una matriz con algún vecino menor

PorJosé A. Alonso 7-abril-202215-abril-2022

Las matrices pueden representarse mediante tablas cuyos índices son pares de números naturales. Su tipo se define por

   type Matriz = Array (Int,Int) Int

1	type Matriz = Array (Int,Int) Int

Por ejemplo, la matriz

   |9 4 6 5|
   |8 1 7 3|
   |4 2 5 4|

|9 4 6 5|

|8 1 7 3|

|4 2 5 4|

se define por

   ej :: Matriz
   ej = listArray ((1,1),(3,4)) [9,4,6,5,8,1,7,3,4,2,5,4]

1 2	ej :: Matriz ej = listArray ((1,1),(3,4)) [9,4,6,5,8,1,7,3,4,2,5,4]

Los vecinos de un elemento son los que están a un paso en la misma fila, columna o diagonal. Por ejemplo, en la matriz anterior, el 1 tiene 8 vecinos (el 9, 4, 6, 8, 7, 4, 2 y 5) pero el 9 sólo tiene 3 vecinos (el 4, 8 y 1).

Definir la función

   algunoMenor :: Matriz -> [Int]

1	algunoMenor :: Matriz -> [Int]

tal que (algunoMenor p) es la lista de los elementos de p que tienen algún vecino menor que él. Por ejemplo,

   algunoMenor ej == [9,4,6,5,8,7,4,2,5,4]

1	algunoMenor ej == [9,4,6,5,8,7,4,2,5,4]

pues sólo el 1 y el 3 no tienen ningún vecino menor en la matriz.

Soluciones

import Data.Array (Array, (!), bounds, indices, inRange, listArray)
import Test.QuickCheck (Arbitrary, Gen, arbitrary, chooseInt, quickCheck,
                        vectorOf)

type Matriz = Array (Int,Int) Int

ej :: Matriz
ej = listArray ((1,1),(3,4)) [9,4,6,5,8,1,7,3,4,2,5,4]

type Pos = (Int,Int)

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

algunoMenor1 :: Matriz -> [Int]
algunoMenor1 a =
  [a!p| p <- indices a,
        any (< a!p) (vecinos1 a p)]

-- (vecinos q p) es la lista de los vecinos en la matriz a de la
-- posición p. Por ejemplo,
--    vecinos1 ej (2,2)  ==  [9,4,6,8,7,4,2,5]
--    vecinos1 ej (1,1)  ==  [4,8,1]
vecinos1 :: Matriz -> Pos -> [Int]
vecinos1 a p =
  [a!p' | p' <- posicionesVecinos1 a p]

-- (posicionesVecinos a p) es la lista de las posiciones de los
-- vecino de p en la matriz a. Por ejemplo,
--    λ> posicionesVecinos1 3 3 (2,2)
--    [(1,1),(1,2),(1,3),(2,1),(2,3),(3,1),(3,2),(3,3)]
--    λ> posicionesVecinos1 3 3 (1,1)
--    [(1,2),(2,1),(2,2)]
posicionesVecinos1 :: Matriz -> Pos -> [Pos]
posicionesVecinos1 a (i,j) =
  [(i+di,j+dj) | (di,dj) <- [(-1,-1),(-1,0),(-1,1),
                             ( 0,-1),       ( 0,1),
                             ( 1,-1),( 1,0),( 1,1)],
                 inRange (bounds a) (i+di,j+dj)]

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

algunoMenor2 :: Matriz -> [Int]
algunoMenor2 a =
  [a!p | p <- indices a,
         any (<a!p) (vecinos2 p)]
  where
    vecinos2 p =
      [a!p' | p' <- posicionesVecinos2 p]
    posicionesVecinos2 (i,j) =
      [(i+di,j+dj) | (di,dj) <- [(-1,-1),(-1,0),(-1,1),
                                 ( 0,-1),       ( 0,1),
                                 ( 1,-1),( 1,0),( 1,1)],
                     inRange (bounds a) (i+di,j+dj)]

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

algunoMenor3 :: Matriz -> [Int]
algunoMenor3 a =
  [a!p | p <- indices a,
         any (<a!p) (vecinos3 p)]
  where
    vecinos3 p =
      [a!p' | p' <- posicionesVecinos3 p]
    posicionesVecinos3 (i,j) =
      [(i',j') | i' <- [i-1..i+1],
                 j' <- [j-1..j+1],
                 (i',j') /= (i,j),
                 inRange (bounds a) (i',j')]

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

algunoMenor4 :: Matriz -> [Int]
algunoMenor4 a =
  [a!p | p <- indices a,
         any (<a!p) (vecinos4 p)]
  where
    vecinos4 p =
      [a!p' | p' <- posicionesVecinos4 p]
    posicionesVecinos4 (i,j) =
      [(i',j') | i' <- [max 1 (i-1)..min m (i+1)],
                 j' <- [max 1 (j-1)..min n (j+1)],
                 (i',j') /= (i,j)]
      where (_,(m,n)) = bounds a


-- 5ª solución
-- ===========

algunoMenor5 :: Matriz -> [Int]
algunoMenor5 a =
  [a!p | p <- indices a,
         any (<a!p) (vecinos5 p)]
  where
    vecinos5 p =
      [a!p' | p' <- posicionesVecinos5 p]
    posicionesVecinos5 (i,j) =
      [(i-1,j-1) | i > 1, j > 1] ++
      [(i-1,j)   | i > 1]        ++
      [(i-1,j+1) | i > 1, j < n] ++
      [(i,j-1)   | j > 1]        ++
      [(i,j+1)   | j < n]        ++
      [(i+1,j-1) | i < m, j > 1] ++
      [(i+1,j)   | i < m]        ++
      [(i+1,j+1) | i < m, j < n]
      where (_,(m,n)) = bounds a

-- ---------------------------------------------------------------------

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

newtype Matriz2 = M Matriz
  deriving Show

-- Generador de matrices arbitrarias. Por ejemplo,
--    λ> generate matrizArbitraria
--    M (array ((1,1),(3,4))
--             [((1,1),18),((1,2),6), ((1,3),-23),((1,4),-13),
--              ((2,1),-2),((2,2),22),((2,3),-25),((2,4),-5),
--              ((3,1),2), ((3,2),16),((3,3),-15),((3,4),7)])
matrizArbitraria :: Gen Matriz2
matrizArbitraria = do
  m  <- chooseInt (1,10)
  n  <- chooseInt (1,10)
  xs <- vectorOf (m*n) arbitrary
  return (M (listArray ((1,1),(m,n)) xs))

-- Matriz es una subclase de Arbitrary.
instance Arbitrary Matriz2 where
  arbitrary = matrizArbitraria

-- La propiedad es
prop_algunoMenor :: Matriz2 -> Bool
prop_algunoMenor (M p) =
  all (== algunoMenor1 p)
      [algunoMenor2 p,
       algunoMenor3 p,
       algunoMenor4 p,
       algunoMenor5 p]

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

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

-- La comparación es
--    λ> maximum (algunoMenor1 (listArray ((1,1),(600,800)) [0..]))
--    479999
--    (2.20 secs, 1,350,075,240 bytes)
--    λ> maximum (algunoMenor2 (listArray ((1,1),(600,800)) [0..]))
--    479999
--    (2.24 secs, 1,373,139,968 bytes)
--    λ> maximum (algunoMenor3 (listArray ((1,1),(600,800)) [0..]))
--    479999
--    (2.08 secs, 1,200,734,112 bytes)
--    λ> maximum (algunoMenor4 (listArray ((1,1),(600,800)) [0..]))
--    479999
--    (2.76 secs, 1,287,653,136 bytes)
--    λ> maximum (algunoMenor5 (listArray ((1,1),(600,800)) [0..]))
--    479999
--    (1.67 secs, 953,937,600 bytes)

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

import Data.Array (Array, (!), bounds, indices, inRange, listArray)

import Test.QuickCheck (Arbitrary, Gen, arbitrary, chooseInt, quickCheck,

vectorOf)

type Matriz = Array (Int,Int) Int

ej :: Matriz

ej = listArray ((1,1),(3,4)) [9,4,6,5,8,1,7,3,4,2,5,4]

type Pos = (Int,Int)

-- 1ª solución

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

algunoMenor1 :: Matriz -> [Int]

algunoMenor1 a =

[a!p| p <- indices a,

any (< a!p) (vecinos1 a p)]

-- (vecinos q p) es la lista de los vecinos en la matriz a de la

-- posición p. Por ejemplo,

-- vecinos1 ej (2,2) == [9,4,6,8,7,4,2,5]

-- vecinos1 ej (1,1) == [4,8,1]

vecinos1 :: Matriz -> Pos -> [Int]

vecinos1 a p =

[a!p' | p' <- posicionesVecinos1 a p]

-- (posicionesVecinos a p) es la lista de las posiciones de los

-- vecino de p en la matriz a. Por ejemplo,

-- λ> posicionesVecinos1 3 3 (2,2)

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

-- λ> posicionesVecinos1 3 3 (1,1)

-- [(1,2),(2,1),(2,2)]

posicionesVecinos1 :: Matriz -> Pos -> [Pos]

posicionesVecinos1 a (i,j) =

[(i+di,j+dj) | (di,dj) <- [(-1,-1),(-1,0),(-1,1),

( 0,-1), ( 0,1),

( 1,-1),( 1,0),( 1,1)],

inRange (bounds a) (i+di,j+dj)]

-- 2ª solución

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

algunoMenor2 :: Matriz -> [Int]

algunoMenor2 a =

[a!p | p <- indices a,

any (<a!p) (vecinos2 p)]

where

vecinos2 p =

[a!p' | p' <- posicionesVecinos2 p]

posicionesVecinos2 (i,j) =

[(i+di,j+dj) | (di,dj) <- [(-1,-1),(-1,0),(-1,1),

( 0,-1), ( 0,1),

( 1,-1),( 1,0),( 1,1)],

inRange (bounds a) (i+di,j+dj)]

-- 3ª solución

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

algunoMenor3 :: Matriz -> [Int]

algunoMenor3 a =

[a!p | p <- indices a,

any (<a!p) (vecinos3 p)]

where

vecinos3 p =

[a!p' | p' <- posicionesVecinos3 p]

posicionesVecinos3 (i,j) =

[(i',j') | i' <- [i-1..i+1],

j' <- [j-1..j+1],

(i',j') /= (i,j),

inRange (bounds a) (i',j')]

-- 4ª solución

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

algunoMenor4 :: Matriz -> [Int]

algunoMenor4 a =

[a!p | p <- indices a,

any (<a!p) (vecinos4 p)]

where

vecinos4 p =

[a!p' | p' <- posicionesVecinos4 p]

posicionesVecinos4 (i,j) =

[(i',j') | i' <- [max 1 (i-1)..min m (i+1)],

j' <- [max 1 (j-1)..min n (j+1)],

(i',j') /= (i,j)]

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

-- 5ª solución

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

algunoMenor5 :: Matriz -> [Int]

algunoMenor5 a =

[a!p | p <- indices a,

any (<a!p) (vecinos5 p)]

where

vecinos5 p =

[a!p' | p' <- posicionesVecinos5 p]

posicionesVecinos5 (i,j) =

[(i-1,j-1) | i > 1, j > 1] ++

[(i-1,j) | i > 1] ++

[(i-1,j+1) | i > 1, j < n] ++

[(i,j-1) | j > 1] ++

[(i,j+1) | j < n] ++

[(i+1,j-1) | i < m, j > 1] ++

[(i+1,j) | i < m] ++

[(i+1,j+1) | i < m, j < n]

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

-- ---------------------------------------------------------------------

-- Comprobación de equivalencia

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

newtype Matriz2 = M Matriz

deriving Show

-- Generador de matrices arbitrarias. Por ejemplo,

-- λ> generate matrizArbitraria

-- M (array ((1,1),(3,4))

-- [((1,1),18),((1,2),6), ((1,3),-23),((1,4),-13),

-- ((2,1),-2),((2,2),22),((2,3),-25),((2,4),-5),

-- ((3,1),2), ((3,2),16),((3,3),-15),((3,4),7)])

matrizArbitraria :: Gen Matriz2

matrizArbitraria = do

m <- chooseInt (1,10)

n <- chooseInt (1,10)

xs <- vectorOf (m*n) arbitrary

return (M (listArray ((1,1),(m,n)) xs))

-- Matriz es una subclase de Arbitrary.

instance Arbitrary Matriz2 where

arbitrary = matrizArbitraria

-- La propiedad es

prop_algunoMenor :: Matriz2 -> Bool

prop_algunoMenor (M p) =

all (== algunoMenor1 p)

[algunoMenor2 p,

algunoMenor3 p,

algunoMenor4 p,

algunoMenor5 p]

-- La comprobación es

-- λ> quickCheck prop_algunoMenor

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> maximum (algunoMenor1 (listArray ((1,1),(600,800)) [0..]))

-- 479999

-- (2.20 secs, 1,350,075,240 bytes)

-- λ> maximum (algunoMenor2 (listArray ((1,1),(600,800)) [0..]))

-- 479999

-- (2.24 secs, 1,373,139,968 bytes)

-- λ> maximum (algunoMenor3 (listArray ((1,1),(600,800)) [0..]))

-- 479999

-- (2.08 secs, 1,200,734,112 bytes)

-- λ> maximum (algunoMenor4 (listArray ((1,1),(600,800)) [0..]))

-- 479999

-- (2.76 secs, 1,287,653,136 bytes)

-- λ> maximum (algunoMenor5 (listArray ((1,1),(600,800)) [0..]))

-- 479999

-- (1.67 secs, 953,937,600 bytes)

El código se encuentra en GitHub.

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

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>

Enumeración de árboles binarios

PorJosé A. Alonso 6-abril-202213-abril-2022

Los árboles binarios se pueden representar mediante el tipo Arbol definido por

   data Arbol a = H a
                | N (Arbol a) a (Arbol a)
      deriving Show

data Arbol a = H a

| N (Arbol a) a (Arbol a)

deriving Show

Por ejemplo, el árbol

        "B"
        / \
       /   \
      /     \
    "B"     "A"
    / \     / \
  "A" "B" "C" "C"

"B"

/ \

"B" "A"

/ \ / \

"A" "B" "C" "C"

se puede definir por

   ej1 :: Arbol String
   ej1 = N (N (H "A") "B" (H "B")) "B" (N (H "C") "A" (H "C"))

1 2	ej1 :: Arbol String ej1 = N (N (H "A") "B" (H "B")) "B" (N (H "C") "A" (H "C"))

Definir la función

   enumeraArbol :: Arbol t -> Arbol Int

1	enumeraArbol :: Arbol t -> Arbol Int

tal que (enumeraArbol a) es el árbol obtenido numerando las hojas y los nodos de a desde la hoja izquierda hasta la raíz. Por ejemplo,

   λ> enumeraArbol ej1
   N (N (H 0) 1 (H 2)) 3 (N (H 4) 5 (H 6))

1 2	λ> enumeraArbol ej1 N (N (H 0) 1 (H 2)) 3 (N (H 4) 5 (H 6))

Gráficamente,

         3
        / \
       /   \
      /     \
     1       5
    / \     / \
   0   2   4   6

/ \

1 5

/ \ / \

0 2 4 6

Soluciones

import Test.QuickCheck (Arbitrary, Gen, arbitrary, quickCheck, sized)
import Control.Monad.State (State, evalState, get, put)

data Arbol a = H a
             | N (Arbol a) a (Arbol a)
  deriving (Show, Eq)

ej1 :: Arbol String
ej1 = N (N (H "A") "B" (H "B")) "B" (N (H "C") "A" (H "C"))

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

enumeraArbol1 :: Arbol t -> Arbol Int
enumeraArbol1 a = fst (aux a 0)
  where aux :: Arbol t -> Int -> (Arbol Int, Int)
        aux (H _) n     = (H n, n+1)
        aux (N i _ d) n = (N i' n1 d', n2)
          where (i', n1) = aux i n
                (d', n2) = aux d (n1+1)

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

enumeraArbol2 :: Arbol t -> Arbol Int
enumeraArbol2 a = evalState (aux a) 0
  where aux :: Arbol t -> State Int (Arbol Int)
        aux (H _)     = H <$> contador
        aux (N i _ d) = do
          i' <- aux i
          n1 <- contador
          d' <- aux d
          return (N i' n1 d')

contador :: State Int Int
contador = do
  n <- get
  put (n+1)
  return n

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

enumeraArbol3 :: Arbol t -> Arbol Int
enumeraArbol3 a = evalState (aux a) 0
  where aux :: Arbol t -> State Int (Arbol Int)
        aux (H _)     = H <$> contador
        aux (N i _ d) = N <$> aux i <*> contador <*> aux d

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

-- (arbolArbitrario n) genera un árbol aleatorio de orden n. Por
-- ejemplo,
--    λ> generate (arbolArbitrario 3 :: Gen (Arbol Int))
--    N (N (H 19) 0 (H (-27))) 21 (N (H 2) 17 (H 26))
arbolArbitrario :: Arbitrary a => Int -> Gen (Arbol a)
arbolArbitrario n
  | n <= 0    = H <$> arbitrary
  | otherwise = N <$> subarbol <*> arbitrary <*> subarbol
  where subarbol = arbolArbitrario (n `div` 2)

-- Arbol es una subclase de Arbitrary.
instance Arbitrary a => Arbitrary (Arbol a) where
  arbitrary = sized arbolArbitrario

-- La propiedad es
prop_enumeraArbol :: Arbol Int -> Bool
prop_enumeraArbol a =
  all (== enumeraArbol1 a)
      [enumeraArbol2 a,
       enumeraArbol3 a]

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

import Test.QuickCheck (Arbitrary, Gen, arbitrary, quickCheck, sized)

import Control.Monad.State (State, evalState, get, put)

data Arbol a = H a

| N (Arbol a) a (Arbol a)

deriving (Show, Eq)

ej1 :: Arbol String

ej1 = N (N (H "A") "B" (H "B")) "B" (N (H "C") "A" (H "C"))

-- 1ª solución

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

enumeraArbol1 :: Arbol t -> Arbol Int

enumeraArbol1 a = fst (aux a 0)

where aux :: Arbol t -> Int -> (Arbol Int, Int)

aux (H _) n = (H n, n+1)

aux (N i _ d) n = (N i' n1 d', n2)

where (i', n1) = aux i n

(d', n2) = aux d (n1+1)

-- 2ª solución

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

enumeraArbol2 :: Arbol t -> Arbol Int

enumeraArbol2 a = evalState (aux a) 0

where aux :: Arbol t -> State Int (Arbol Int)

aux (H _) = H <$> contador

aux (N i _ d) = do

i' <- aux i

n1 <- contador

d' <- aux d

return (N i' n1 d')

contador :: State Int Int

contador = do

n <- get

put (n+1)

return n

-- 3ª solución

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

enumeraArbol3 :: Arbol t -> Arbol Int

enumeraArbol3 a = evalState (aux a) 0

where aux :: Arbol t -> State Int (Arbol Int)

aux (H _) = H <$> contador

aux (N i _ d) = N <$> aux i <*> contador <*> aux d

-- Comprobación de equivalencia

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

-- (arbolArbitrario n) genera un árbol aleatorio de orden n. Por

-- ejemplo,

-- λ> generate (arbolArbitrario 3 :: Gen (Arbol Int))

-- N (N (H 19) 0 (H (-27))) 21 (N (H 2) 17 (H 26))

arbolArbitrario :: Arbitrary a => Int -> Gen (Arbol a)

arbolArbitrario n

| n <= 0 = H <$> arbitrary

| otherwise = N <$> subarbol <*> arbitrary <*> subarbol

where subarbol = arbolArbitrario (n `div` 2)

-- Arbol es una subclase de Arbitrary.

instance Arbitrary a => Arbitrary (Arbol a) where

arbitrary = sized arbolArbitrario

-- La propiedad es

prop_enumeraArbol :: Arbol Int -> Bool

prop_enumeraArbol a =

all (== enumeraArbol1 a)

[enumeraArbol2 a,

enumeraArbol3 a]

-- La comprobación es

-- λ> quickCheck prop_enumeraArbol

-- +++ OK, passed 100 tests.

El código se encuentra en GitHub.

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

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>

[/schedule]

Números triangulares con n cifras distintas

PorJosé A. Alonso 5-abril-202212-abril-2022

Los números triangulares se forman como sigue

   *     *      *
        * *    * *
              * * *
   1     3      6

* * *

* * * *

* * *

1 3 6

La sucesión de los números triangulares se obtiene sumando los números naturales. Así, los 5 primeros números triangulares son

    1 = 1
    3 = 1 + 2
    6 = 1 + 2 + 3
   10 = 1 + 2 + 3 + 4
   15 = 1 + 2 + 3 + 4 + 5

1 = 1

3 = 1 + 2

6 = 1 + 2 + 3

10 = 1 + 2 + 3 + 4

15 = 1 + 2 + 3 + 4 + 5

Definir la función

   triangularesConCifras :: Int -> [Integer]

1	triangularesConCifras :: Int -> [Integer]

tal que (triangulares n) es la lista de los números triangulares con n cifras distintas. Por ejemplo,

   take 6 (triangularesConCifras 1)   ==  [1,3,6,55,66,666]
   take 6 (triangularesConCifras 2)   ==  [10,15,21,28,36,45]
   take 6 (triangularesConCifras 3)   ==  [105,120,136,153,190,210]
   take 5 (triangularesConCifras 4)   ==  [1035,1275,1326,1378,1485]
   take 2 (triangularesConCifras 10)  ==  [1062489753,1239845706]

take 6 (triangularesConCifras 1) == [1,3,6,55,66,666]

take 6 (triangularesConCifras 2) == [10,15,21,28,36,45]

take 6 (triangularesConCifras 3) == [105,120,136,153,190,210]

take 5 (triangularesConCifras 4) == [1035,1275,1326,1378,1485]

take 2 (triangularesConCifras 10) == [1062489753,1239845706]

Soluciones

import Data.List (nub)
import Test.QuickCheck

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

triangularesConCifras1 :: Int -> [Integer]
triangularesConCifras1 n =
  [x | x <- triangulares1,
       nCifras x == n]

-- triangulares1 es la lista de los números triangulares. Por ejemplo,
--    take 10 triangulares1 == [1,3,6,10,15,21,28,36,45,55]
triangulares1 :: [Integer]
triangulares1 = map triangular [1..]

triangular :: Integer -> Integer
triangular 1 = 1
triangular n = triangular (n-1) + n

-- (nCifras x) es el número de cifras distintas del número x. Por
-- ejemplo,
--    nCifras 325275  ==  4
nCifras :: Integer -> Int
nCifras = length . nub . show

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

triangularesConCifras2 :: Int -> [Integer]
triangularesConCifras2 n =
  [x | x <- triangulares2,
       nCifras x == n]

triangulares2 :: [Integer]
triangulares2 = [(n*(n+1)) `div` 2 | n <- [1..]]

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

triangularesConCifras3 :: Int -> [Integer]
triangularesConCifras3 n =
  [x | x <- triangulares3,
       nCifras x == n]

triangulares3 :: [Integer]
triangulares3 = 1 : [x+y | (x,y) <- zip [2..] triangulares3]

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

triangularesConCifras4 :: Int -> [Integer]
triangularesConCifras4 n =
  [x | x <- triangulares4,
       nCifras x == n]

triangulares4 :: [Integer]
triangulares4 = 1 : zipWith (+) [2..] triangulares4

-- 5ª solución
-- ===========

triangularesConCifras5 :: Int -> [Integer]
triangularesConCifras5 n =
  [x | x <- triangulares5,
       nCifras x == n]

triangulares5 :: [Integer]
triangulares5 = scanl (+) 1 [2..]

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

-- La 1ª propiedad es
prop_triangularesConCifras1 :: Bool
prop_triangularesConCifras1 =
  [take 2 (triangularesConCifras1 n) | n <- [1..7]] ==
  [take 2 (triangularesConCifras2 n) | n <- [1..7]]

-- La comprobación es
--    λ> prop_triangularesConCifras1
--    True

-- La 2ª propiedad es
prop_triangularesConCifras2 :: Int -> Bool
prop_triangularesConCifras2 n =
  all (== take 5 (triangularesConCifras2 n'))
      [take 5 (triangularesConCifras3 n'),
       take 5 (triangularesConCifras4 n'),
       take 5 (triangularesConCifras5 n')]
  where n' = 1 + n `mod` 9

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

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

-- La comparación es
--    λ> (triangularesConCifras1 3) !! 220
--    5456556
--    (2.48 secs, 1,228,690,120 bytes)
--    λ> (triangularesConCifras2 3) !! 220
--    5456556
--    (0.01 secs, 4,667,288 bytes)
--
--    λ> (triangularesConCifras2 3) !! 600
--    500010500055
--    (1.76 secs, 1,659,299,872 bytes)
--    λ> (triangularesConCifras3 3) !! 600
--    500010500055
--    (1.67 secs, 1,603,298,648 bytes)
--    λ> (triangularesConCifras4 3) !! 600
--    500010500055
--    (1.20 secs, 1,507,298,248 bytes)
--    λ> (triangularesConCifras5 3) !! 600
--    500010500055
--    (1.15 secs, 1,507,298,256 bytes)

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

import Data.List (nub)

import Test.QuickCheck

-- 1ª solución

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

triangularesConCifras1 :: Int -> [Integer]

triangularesConCifras1 n =

[x | x <- triangulares1,

nCifras x == n]

-- triangulares1 es la lista de los números triangulares. Por ejemplo,

-- take 10 triangulares1 == [1,3,6,10,15,21,28,36,45,55]

triangulares1 :: [Integer]

triangulares1 = map triangular [1..]

triangular :: Integer -> Integer

triangular 1 = 1

triangular n = triangular (n-1) + n

-- (nCifras x) es el número de cifras distintas del número x. Por

-- ejemplo,

-- nCifras 325275 == 4

nCifras :: Integer -> Int

nCifras = length . nub . show

-- 2ª solución

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

triangularesConCifras2 :: Int -> [Integer]

triangularesConCifras2 n =

[x | x <- triangulares2,

nCifras x == n]

triangulares2 :: [Integer]

triangulares2 = [(n*(n+1)) `div` 2 | n <- [1..]]

-- 3ª solución

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

triangularesConCifras3 :: Int -> [Integer]

triangularesConCifras3 n =

[x | x <- triangulares3,

nCifras x == n]

triangulares3 :: [Integer]

triangulares3 = 1 : [x+y | (x,y) <- zip [2..] triangulares3]

-- 4ª solución

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

triangularesConCifras4 :: Int -> [Integer]

triangularesConCifras4 n =

[x | x <- triangulares4,

nCifras x == n]

triangulares4 :: [Integer]

triangulares4 = 1 : zipWith (+) [2..] triangulares4

-- 5ª solución

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

triangularesConCifras5 :: Int -> [Integer]

triangularesConCifras5 n =

[x | x <- triangulares5,

nCifras x == n]

triangulares5 :: [Integer]

triangulares5 = scanl (+) 1 [2..]

-- Comprobación de equivalencia

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

-- La 1ª propiedad es

prop_triangularesConCifras1 :: Bool

prop_triangularesConCifras1 =

[take 2 (triangularesConCifras1 n) | n <- [1..7]] ==

[take 2 (triangularesConCifras2 n) | n <- [1..7]]

-- La comprobación es

-- λ> prop_triangularesConCifras1

-- True

-- La 2ª propiedad es

prop_triangularesConCifras2 :: Int -> Bool

prop_triangularesConCifras2 n =

all (== take 5 (triangularesConCifras2 n'))

[take 5 (triangularesConCifras3 n'),

take 5 (triangularesConCifras4 n'),

take 5 (triangularesConCifras5 n')]

where n' = 1 + n `mod` 9

-- La comprobación es

-- λ> quickCheck prop_triangularesConCifras

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> (triangularesConCifras1 3) !! 220

-- 5456556

-- (2.48 secs, 1,228,690,120 bytes)

-- λ> (triangularesConCifras2 3) !! 220

-- 5456556

-- (0.01 secs, 4,667,288 bytes)

-- λ> (triangularesConCifras2 3) !! 600

-- 500010500055

-- (1.76 secs, 1,659,299,872 bytes)

-- λ> (triangularesConCifras3 3) !! 600

-- 500010500055

-- (1.67 secs, 1,603,298,648 bytes)

-- λ> (triangularesConCifras4 3) !! 600

-- 500010500055

-- (1.20 secs, 1,507,298,248 bytes)

-- λ> (triangularesConCifras5 3) !! 600

-- 500010500055

-- (1.15 secs, 1,507,298,256 bytes)

El código se encuentra en GitHub.

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

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>

Trenzado de listas

PorJosé A. Alonso 4-abril-202211-abril-2022

Definir la función

   trenza :: [a] -> [a] -> [a]

1	trenza :: [a] -> [a] -> [a]

tal que (trenza xs ys) es la lista obtenida intercalando los elementos de xs e ys. Por ejemplo,

   trenza [5,1] [2,7,4]             ==  [5,2,1,7]
   trenza [5,1,7] [2..]             ==  [5,2,1,3,7,4]
   trenza [2..] [5,1,7]             ==  [2,5,3,1,4,7]
   take 8 (trenza [2,4..] [1,5..])  ==  [2,1,4,5,6,9,8,13]

trenza [5,1] [2,7,4] == [5,2,1,7]

trenza [5,1,7] [2..] == [5,2,1,3,7,4]

trenza [2..] [5,1,7] == [2,5,3,1,4,7]

take 8 (trenza [2,4..] [1,5..]) == [2,1,4,5,6,9,8,13]

Soluciones

import Test.QuickCheck (quickCheck)

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

trenza1 :: [a] -> [a] -> [a]
trenza1 []     _      = []
trenza1 _      []     = []
trenza1 (x:xs) (y:ys) = x : y : trenza1 xs ys

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

trenza2 :: [a] -> [a] -> [a]
trenza2 (x:xs) (y:ys) = x : y : trenza2 xs ys
trenza2 _      _      = []

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

trenza3 :: [a] -> [a] -> [a]
trenza3 xs ys = concat [[x,y] | (x,y) <- zip xs ys]

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

trenza4 :: [a] -> [a] -> [a]
trenza4 xs ys = concat (zipWith par xs ys)

par :: a -> a -> [a]
par x y = [x,y]

-- 5ª solución
-- ===========

-- Explicación de eliminación de argumentos en composiciones con varios
-- argumentos:

f :: Int -> Int
f x = x + 1

g :: Int -> Int -> Int
g x y = x + y

h1, h2, h3, h4, h5, h6, h7 :: Int -> Int -> Int
h1 x y  = f (g x y)
h2 x y  = f ((g x) y)
h3 x y  = (f . (g x)) y
h4 x    = f . (g x)
h5 x    = (f .) (g x)
h6 x    = ((f .) . g) x
h7      = (f .) . g

prop_composicion :: Int -> Int -> Bool
prop_composicion x y =
  all (== h1 x y)
      [p x y | p <- [h2, h3, h4, h5, h6, h7]]

-- λ> quickCheck prop_composicion
-- +++ OK, passed 100 tests.

-- En general,
--    f . g             --> \x -> f (g x)
--    (f .) . g         --> \x y -> f (g x y)
--    ((f .) .) . g     --> \x y z -> f (g x y z)
--    (((f .) .) .) . g --> \w x y z -> f (g w x y z)

trenza5 :: [a] -> [a] -> [a]
trenza5 = (concat .) . zipWith par

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

-- La propiedad es
prop_trenza :: [Int] -> [Int] -> Bool
prop_trenza xs ys =
  all (== trenza1 xs ys)
      [trenza2 xs ys,
       trenza3 xs ys,
       trenza4 xs ys,
       trenza5 xs ys]

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

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

-- La comparación es
--    λ> last (trenza1 [1,1..] [1..4*10^6])
--    4000000
--    (2.33 secs, 1,472,494,952 bytes)
--    λ> last (trenza2 [1,1..] [1..4*10^6])
--    4000000
--    (2.24 secs, 1,376,494,928 bytes)
--    λ> last (trenza3 [1,1..] [1..4*10^6])
--    4000000
--    (1.33 secs, 1,888,495,048 bytes)
--    λ> last (trenza4 [1,1..] [1..4*10^6])
--    4000000
--    (0.76 secs, 1,696,494,968 bytes)
--    λ> last (trenza5 [1,1..] [1..4*10^6])
--    4000000
--    (0.76 secs, 1,696,495,064 bytes)

100

101

102

103

104

105

import Test.QuickCheck (quickCheck)

-- 1ª solución

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

trenza1 :: [a] -> [a] -> [a]

trenza1 [] _ = []

trenza1 _ [] = []

trenza1 (x:xs) (y:ys) = x : y : trenza1 xs ys

-- 2ª solución

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

trenza2 :: [a] -> [a] -> [a]

trenza2 (x:xs) (y:ys) = x : y : trenza2 xs ys

trenza2 _ _ = []

-- 3ª solución

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

trenza3 :: [a] -> [a] -> [a]

trenza3 xs ys = concat [[x,y] | (x,y) <- zip xs ys]

-- 4ª solución

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

trenza4 :: [a] -> [a] -> [a]

trenza4 xs ys = concat (zipWith par xs ys)

par :: a -> a -> [a]

par x y = [x,y]

-- 5ª solución

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

-- Explicación de eliminación de argumentos en composiciones con varios

-- argumentos:

f :: Int -> Int

f x = x + 1

g :: Int -> Int -> Int

g x y = x + y

h1, h2, h3, h4, h5, h6, h7 :: Int -> Int -> Int

h1 x y = f (g x y)

h2 x y = f ((g x) y)

h3 x y = (f . (g x)) y

h4 x = f . (g x)

h5 x = (f .) (g x)

h6 x = ((f .) . g) x

h7 = (f .) . g

prop_composicion :: Int -> Int -> Bool

prop_composicion x y =

all (== h1 x y)

[p x y | p <- [h2, h3, h4, h5, h6, h7]]

-- λ> quickCheck prop_composicion

-- +++ OK, passed 100 tests.

-- En general,

-- f . g --> \x -> f (g x)

-- (f .) . g --> \x y -> f (g x y)

-- ((f .) .) . g --> \x y z -> f (g x y z)

-- (((f .) .) .) . g --> \w x y z -> f (g w x y z)

trenza5 :: [a] -> [a] -> [a]

trenza5 = (concat .) . zipWith par

-- Comprobación de equivalencia

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

-- La propiedad es

prop_trenza :: [Int] -> [Int] -> Bool

prop_trenza xs ys =

all (== trenza1 xs ys)

[trenza2 xs ys,

trenza3 xs ys,

trenza4 xs ys,

trenza5 xs ys]

-- La comprobación es

-- λ> quickCheck prop_trenza

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> last (trenza1 [1,1..] [1..4*10^6])

-- 4000000

-- (2.33 secs, 1,472,494,952 bytes)

-- λ> last (trenza2 [1,1..] [1..4*10^6])

-- 4000000

-- (2.24 secs, 1,376,494,928 bytes)

-- λ> last (trenza3 [1,1..] [1..4*10^6])

-- 4000000

-- (1.33 secs, 1,888,495,048 bytes)

-- λ> last (trenza4 [1,1..] [1..4*10^6])

-- 4000000

-- (0.76 secs, 1,696,494,968 bytes)

-- λ> last (trenza5 [1,1..] [1..4*10^6])

-- 4000000

-- (0.76 secs, 1,696,495,064 bytes)

El código se encuentra en GitHub.

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

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>

Biparticiones de una lista

PorJosé A. Alonso 1-abril-20228-abril-2022

Definir la función

   biparticiones :: [a] -> [([a],[a])]

1	biparticiones :: [a] -> [([a],[a])]

tal que (biparticiones xs) es la lista de pares formados por un prefijo de xs y el resto de xs. Por ejemplo,

   λ> biparticiones [3,2,5]
   [([],[3,2,5]),([3],[2,5]),([3,2],[5]),([3,2,5],[])]
   λ> biparticiones "Roma"
   [("","Roma"),("R","oma"),("Ro","ma"),("Rom","a"),("Roma","")]

λ> biparticiones [3,2,5]

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

λ> biparticiones "Roma"

[("","Roma"),("R","oma"),("Ro","ma"),("Rom","a"),("Roma","")]

Soluciones

import Data.List (inits, tails)
import Control.Applicative (liftA2)
import Test.QuickCheck (quickCheck)

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

biparticiones1 :: [a] -> [([a],[a])]
biparticiones1 [] = [([],[])]
biparticiones1 (x:xs) =
  ([],(x:xs)) : [(x:ys,zs) | (ys,zs) <- biparticiones1 xs]

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

biparticiones2 :: [a] -> [([a],[a])]
biparticiones2 xs =
  [(take i xs, drop i xs) | i <- [0..length xs]]

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

biparticiones3 :: [a] -> [([a],[a])]
biparticiones3 xs =
  [splitAt i xs | i <- [0..length xs]]

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

biparticiones4 :: [a] -> [([a],[a])]
biparticiones4 xs =
  zip (inits xs) (tails xs)

-- 5ª solución
-- ===========

biparticiones5 :: [a] -> [([a],[a])]
biparticiones5 = liftA2 zip inits tails

-- 6ª solución
-- ===========

biparticiones6 :: [a] -> [([a],[a])]
biparticiones6 = zip <$> inits <*> tails

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

-- La propiedad es
prop_biparticiones :: [Int] -> Bool
prop_biparticiones xs =
  all (== biparticiones1 xs)
      [biparticiones2 xs,
       biparticiones3 xs,
       biparticiones4 xs,
       biparticiones5 xs,
       biparticiones6 xs]

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

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

-- La comparación es
--    λ> length (biparticiones1 [1..6*10^3])
--    6001
--    (2.21 secs, 3,556,073,552 bytes)
--    λ> length (biparticiones2 [1..6*10^3])
--    6001
--    (0.01 secs, 2,508,448 bytes)
--
--    λ> length (biparticiones2 [1..6*10^6])
--    6000001
--    (2.26 secs, 2,016,494,864 bytes)
--    λ> length (biparticiones3 [1..6*10^6])
--    6000001
--    (2.12 secs, 1,584,494,792 bytes)
--    λ> length (biparticiones4 [1..6*10^6])
--    6000001
--    (0.78 secs, 1,968,494,704 bytes)
--    λ> length (biparticiones5 [1..6*10^6])
--    6000001
--    (0.79 secs, 1,968,494,688 bytes)
--    λ> length (biparticiones6 [1..6*10^6])
--    6000001
--    (0.77 secs, 1,968,494,720 bytes)
--
--    λ> length (biparticiones4 [1..10^7])
--    10000001
--    (1.30 secs, 3,280,495,432 bytes)
--    λ> length (biparticiones5 [1..10^7])
--    10000001
--    (1.42 secs, 3,280,495,416 bytes)
--    λ> length (biparticiones6 [1..10^7])
--    10000001
--    (1.30 secs, 3,280,495,448 bytes)

import Data.List (inits, tails)

import Control.Applicative (liftA2)

import Test.QuickCheck (quickCheck)

-- 1ª solución

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

biparticiones1 :: [a] -> [([a],[a])]

biparticiones1 [] = [([],[])]

biparticiones1 (x:xs) =

([],(x:xs)) : [(x:ys,zs) | (ys,zs) <- biparticiones1 xs]

-- 2ª solución

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

biparticiones2 :: [a] -> [([a],[a])]

biparticiones2 xs =

[(take i xs, drop i xs) | i <- [0..length xs]]

-- 3ª solución

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

biparticiones3 :: [a] -> [([a],[a])]

biparticiones3 xs =

[splitAt i xs | i <- [0..length xs]]

-- 4ª solución

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

biparticiones4 :: [a] -> [([a],[a])]

biparticiones4 xs =

zip (inits xs) (tails xs)

-- 5ª solución

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

biparticiones5 :: [a] -> [([a],[a])]

biparticiones5 = liftA2 zip inits tails

-- 6ª solución

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

biparticiones6 :: [a] -> [([a],[a])]

biparticiones6 = zip <$> inits <*> tails

-- Comprobación de equivalencia

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

-- La propiedad es

prop_biparticiones :: [Int] -> Bool

prop_biparticiones xs =

all (== biparticiones1 xs)

[biparticiones2 xs,

biparticiones3 xs,

biparticiones4 xs,

biparticiones5 xs,

biparticiones6 xs]

-- La comprobación es

-- λ> quickCheck prop_biparticiones

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> length (biparticiones1 [1..6*10^3])

-- 6001

-- (2.21 secs, 3,556,073,552 bytes)

-- λ> length (biparticiones2 [1..6*10^3])

-- 6001

-- (0.01 secs, 2,508,448 bytes)

-- λ> length (biparticiones2 [1..6*10^6])

-- 6000001

-- (2.26 secs, 2,016,494,864 bytes)

-- λ> length (biparticiones3 [1..6*10^6])

-- 6000001

-- (2.12 secs, 1,584,494,792 bytes)

-- λ> length (biparticiones4 [1..6*10^6])

-- 6000001

-- (0.78 secs, 1,968,494,704 bytes)

-- λ> length (biparticiones5 [1..6*10^6])

-- 6000001

-- (0.79 secs, 1,968,494,688 bytes)

-- λ> length (biparticiones6 [1..6*10^6])

-- 6000001

-- (0.77 secs, 1,968,494,720 bytes)

-- λ> length (biparticiones4 [1..10^7])

-- 10000001

-- (1.30 secs, 3,280,495,432 bytes)

-- λ> length (biparticiones5 [1..10^7])

-- 10000001

-- (1.42 secs, 3,280,495,416 bytes)

-- λ> length (biparticiones6 [1..10^7])

-- 10000001

-- (1.30 secs, 3,280,495,448 bytes)

El código se encuentra en GitHub.

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

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>

Familias de números con algún dígito en común

PorJosé A. Alonso 31-marzo-20227-abril-2022

Una familia de números es una lista de números tal que todos tienen la misma cantidad de dígitos y, además, dichos números tienen al menos un dígito común.

Por ejemplo, los números 72, 32, 25 y 22 pertenecen a la misma familia ya que son números de dos dígitos y todos tienen el dígito 2, mientras que los números 123, 245 y 568 no pertenecen a la misma familia, ya que no hay un dígito que aparezca en los tres números.

Definir la función

   esFamilia :: [Integer] -> Bool

1	esFamilia :: [Integer] -> Bool

tal que (esFamilia ns) se verifica si ns es una familia de números. Por ejemplo,

   esFamilia [72, 32, 25, 22]  ==  True
   esFamilia [123,245,568]     ==  False
   esFamilia [72, 32, 25, 223] ==  False
   esFamilia [56]              ==  True
   esFamilia []                ==  True

esFamilia [72, 32, 25, 22] == True

esFamilia [123,245,568] == False

esFamilia [72, 32, 25, 223] == False

esFamilia [56] == True

esFamilia [] == True

Soluciones

import Data.List (intersect, nub)
import Test.QuickCheck (quickCheck)

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

esFamilia1 :: [Integer] -> Bool
esFamilia1 [] = True
esFamilia1 ns =
  igualNumeroElementos dss && tieneElementoComun dss
  where dss = map show ns

-- (igualNumeroElementos xss) se verifica si todas las listas de xss
-- tienen el mismo número de elementos. Por ejemplo,
--    igualNumeroElementos [[1,3],[2,2],[4,9]]    ==  True
--    igualNumeroElementos [[1,3],[2,1,2],[4,9]]  ==  False
igualNumeroElementos :: [[a]] -> Bool
igualNumeroElementos xss =
  iguales (map length xss)

-- (iguales xs) se verifica si todos los elementos de xs son
-- iguales. Por ejemplo,
--    iguales [3,3,3,3]  ==  True
--    iguales [3,3,7,3]  ==  False
iguales :: Eq a => [a] -> Bool
iguales []     = True
iguales (x:xs) = all (==x) xs

-- (tieneElementoComun xss) se verifican si todas las listas de xss
-- tienen algún elemento común. Por ejemplo,
--    tieneElementoComun [[1,2],[2,3],[4,2,7]]  ==  True
--    tieneElementoComun [[1,2],[2,3],[4,3,7]]  ==  False
tieneElementoComun :: Eq a => [[a]] -> Bool
tieneElementoComun []       = False
tieneElementoComun (xs:xss) = any (`esElementoComun` xss) xs

-- (esElementoComun x yss) se verifica si x pertenece a todos los
-- elementos de yss. Por ejemplo,
--    esElementoComun 2 [[1,2],[2,3],[4,2,7]]  ==  True
--    esElementoComun 2 [[1,2],[2,3],[4,3,7]]  ==  False
esElementoComun :: Eq a => a -> [[a]] -> Bool
esElementoComun x = all (x `elem`)

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

esFamilia2 :: [Integer] -> Bool
esFamilia2 [] = True
esFamilia2 ns =
  igualNumeroElementos2 dss && tieneElementoComun2 dss
  where dss = map show ns

igualNumeroElementos2 :: [[a]] -> Bool
igualNumeroElementos2 xss =
  length (nub (map length xss)) == 1

tieneElementoComun2 :: Eq a => [[a]] -> Bool
tieneElementoComun2 xss =
  not (null (foldl1 intersect xss))

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

esFamilia3 :: [Integer] -> Bool
esFamilia3 [] = True
esFamilia3 ns =
  igualNumeroElementos3 dss && tieneElementoComun3 dss
  where dss = map show ns

igualNumeroElementos3 :: [[a]] -> Bool
igualNumeroElementos3 = ((==1) . length) . nub . map length

tieneElementoComun3 :: Eq a => [[a]] -> Bool
tieneElementoComun3 = (not . null) . foldl1 intersect

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

-- La propiedad es
prop_esFamilia :: [Integer] -> Bool
prop_esFamilia xss =
  all (== esFamilia1 xss)
      [esFamilia2 xss,
       esFamilia3 xss]

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

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

-- La comparación es
--    λ> esFamilia1 [10^6..4*10^6]
--    False
--    (1.85 secs, 1,931,162,984 bytes)
--    λ> esFamilia2 [10^6..4*10^6]
--    False
--    (2.31 secs, 2,288,177,752 bytes)
--    λ> esFamilia3 [10^6..4*10^6]
--    False
--    (2.23 secs, 2,288,177,864 bytes)

100

101

102

import Data.List (intersect, nub)

import Test.QuickCheck (quickCheck)

-- 1ª solución

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

esFamilia1 :: [Integer] -> Bool

esFamilia1 [] = True

esFamilia1 ns =

igualNumeroElementos dss && tieneElementoComun dss

where dss = map show ns

-- (igualNumeroElementos xss) se verifica si todas las listas de xss

-- tienen el mismo número de elementos. Por ejemplo,

-- igualNumeroElementos [[1,3],[2,2],[4,9]] == True

-- igualNumeroElementos [[1,3],[2,1,2],[4,9]] == False

igualNumeroElementos :: [[a]] -> Bool

igualNumeroElementos xss =

iguales (map length xss)

-- (iguales xs) se verifica si todos los elementos de xs son

-- iguales. Por ejemplo,

-- iguales [3,3,3,3] == True

-- iguales [3,3,7,3] == False

iguales :: Eq a => [a] -> Bool

iguales [] = True

iguales (x:xs) = all (==x) xs

-- (tieneElementoComun xss) se verifican si todas las listas de xss

-- tienen algún elemento común. Por ejemplo,

-- tieneElementoComun [[1,2],[2,3],[4,2,7]] == True

-- tieneElementoComun [[1,2],[2,3],[4,3,7]] == False

tieneElementoComun :: Eq a => [[a]] -> Bool

tieneElementoComun [] = False

tieneElementoComun (xs:xss) = any (`esElementoComun` xss) xs

-- (esElementoComun x yss) se verifica si x pertenece a todos los

-- elementos de yss. Por ejemplo,

-- esElementoComun 2 [[1,2],[2,3],[4,2,7]] == True

-- esElementoComun 2 [[1,2],[2,3],[4,3,7]] == False

esElementoComun :: Eq a => a -> [[a]] -> Bool

esElementoComun x = all (x `elem`)

-- 2ª solución

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

esFamilia2 :: [Integer] -> Bool

esFamilia2 [] = True

esFamilia2 ns =

igualNumeroElementos2 dss && tieneElementoComun2 dss

where dss = map show ns

igualNumeroElementos2 :: [[a]] -> Bool

igualNumeroElementos2 xss =

length (nub (map length xss)) == 1

tieneElementoComun2 :: Eq a => [[a]] -> Bool

tieneElementoComun2 xss =

not (null (foldl1 intersect xss))

-- 3ª solución

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

esFamilia3 :: [Integer] -> Bool

esFamilia3 [] = True

esFamilia3 ns =

igualNumeroElementos3 dss && tieneElementoComun3 dss

where dss = map show ns

igualNumeroElementos3 :: [[a]] -> Bool

igualNumeroElementos3 = ((==1) . length) . nub . map length

tieneElementoComun3 :: Eq a => [[a]] -> Bool

tieneElementoComun3 = (not . null) . foldl1 intersect

-- Comprobación de equivalencia

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

-- La propiedad es

prop_esFamilia :: [Integer] -> Bool

prop_esFamilia xss =

all (== esFamilia1 xss)

[esFamilia2 xss,

esFamilia3 xss]

-- La comprobación es

-- λ> quickCheck prop_esFamilia

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> esFamilia1 [10^6..4*10^6]

-- False

-- (1.85 secs, 1,931,162,984 bytes)

-- λ> esFamilia2 [10^6..4*10^6]

-- False

-- (2.31 secs, 2,288,177,752 bytes)

-- λ> esFamilia3 [10^6..4*10^6]

-- False

-- (2.23 secs, 2,288,177,864 bytes)

El código se encuentra en GitHub.

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

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>

Conjunto de primos relativos

PorJosé A. Alonso 30-marzo-20226-abril-2022

Dos números enteros positivos son primos relativos si no tienen ningún factor primo en común; es decit, si 1 es su único divisor común. Por ejemplo, 6 y 35 son primos entre sí, pero 6 y 27 no lo son porque ambos son divisibles por 3.

Definir la función

   primosRelativos :: [Int] -> Bool

1	primosRelativos :: [Int] -> Bool

tal que (primosRelativos xs) se verifica si los elementos de xs son primos relativos dos a dos. Por ejemplo,

   primosRelativos [6,35]         ==  True
   primosRelativos [6,27]         ==  False
   primosRelativos [2,3,4]        ==  False
   primosRelativos [6,35,11]      ==  True
   primosRelativos [6,35,11,221]  ==  True
   primosRelativos [6,35,11,231]  ==  False

primosRelativos [6,35] == True

primosRelativos [6,27] == False

primosRelativos [2,3,4] == False

primosRelativos [6,35,11] == True

primosRelativos [6,35,11,221] == True

primosRelativos [6,35,11,231] == False

Soluciones

import Test.QuickCheck
import Data.List (delete, intersect)
import Data.Numbers.Primes (primeFactors, primes)
import qualified Data.Set as S (disjoint, fromList)

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

primosRelativos1 :: [Int] -> Bool
primosRelativos1 []     = True
primosRelativos1 (x:xs) =
  and [sonPrimosRelativos1 x y | y <- xs] && primosRelativos1 xs

-- (sonPrimosRelativos x y) se verifica si x e y son primos
-- relativos. Por ejemplo,
--    sonPrimosRelativos1 6 35  ==  True
--    sonPrimosRelativos1 6 27  ==  False
sonPrimosRelativos1 :: Int -> Int -> Bool
sonPrimosRelativos1 x y =
  null (divisoresPrimos x `intersect` divisoresPrimos y)

-- (divisoresPrimos x) es la lista de los divisores primos de x. Por
-- ejemplo,
--    divisoresPrimos 600  ==  [2,2,2,3,5,5]
divisoresPrimos :: Int -> [Int]
divisoresPrimos 1 = []
divisoresPrimos x =
  y : divisoresPrimos (x `div` y)
  where y = menorDivisorPrimo x

-- (menorDivisorPrimo x) es el menor divisor primo de x. Por ejemplo,
--    menorDivisorPrimo 15  ==  3
--    menorDivisorPrimo 11  ==  11
menorDivisorPrimo :: Int -> Int
menorDivisorPrimo x =
  head [y | y <- [2..], x `mod` y == 0]

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

primosRelativos2 :: [Int] -> Bool
primosRelativos2 []     = True
primosRelativos2 (x:xs) =
  all (sonPrimosRelativos1 x) xs && primosRelativos2 xs

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

primosRelativos3 :: [Int] -> Bool
primosRelativos3 []     = True
primosRelativos3 (x:xs) =
  all (sonPrimosRelativos2 x) xs && primosRelativos3 xs

sonPrimosRelativos2 :: Int -> Int -> Bool
sonPrimosRelativos2 x y =
  null (primeFactors x `intersect` primeFactors y)

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

primosRelativos4 :: [Int] -> Bool
primosRelativos4 []     = True
primosRelativos4 (x:xs) =
  all (sonPrimosRelativos3 x) xs && primosRelativos4 xs

sonPrimosRelativos3 :: Int -> Int -> Bool
sonPrimosRelativos3 x y =
  S.fromList (primeFactors x) `S.disjoint` S.fromList (primeFactors y)

-- 5ª solución
-- ===========

primosRelativos5 :: [Int] -> Bool
primosRelativos5 []     = True
primosRelativos5 (x:xs) =
  all (sonPrimosRelativos5 x) xs && primosRelativos5 xs

sonPrimosRelativos5 :: Int -> Int -> Bool
sonPrimosRelativos5 x y =
  gcd x y == 1

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

-- La propiedad es
prop_primosRelativos :: [Positive Int] -> Bool
prop_primosRelativos xs =
  all (== primosRelativos1 ys)
      [primosRelativos2 ys,
       primosRelativos3 ys,
       primosRelativos4 ys,
       primosRelativos5 ys]
  where ys = getPositive <$> xs

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

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

-- La comparación es
--    λ> primosRelativos1 (take 120 primes)
--    True
--    (1.92 secs, 869,909,416 bytes)
--    λ> primosRelativos2 (take 120 primes)
--    True
--    (1.99 secs, 869,045,656 bytes)
--    λ> primosRelativos3 (take 120 primes)
--    True
--    (0.09 secs, 221,183,200 bytes)
--
--    λ> primosRelativos3 (take 600 primes)
--    True
--    (2.62 secs, 11,196,690,856 bytes)
--    λ> primosRelativos4 (take 600 primes)
--    True
--    (2.66 secs, 11,190,940,456 bytes)
--    λ> primosRelativos5 (take 600 primes)
--    True
--    (0.14 secs, 123,673,648 bytes)

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

import Test.QuickCheck

import Data.List (delete, intersect)

import Data.Numbers.Primes (primeFactors, primes)

import qualified Data.Set as S (disjoint, fromList)

-- 1ª solución

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

primosRelativos1 :: [Int] -> Bool

primosRelativos1 [] = True

primosRelativos1 (x:xs) =

and [sonPrimosRelativos1 x y | y <- xs] && primosRelativos1 xs

-- (sonPrimosRelativos x y) se verifica si x e y son primos

-- relativos. Por ejemplo,

-- sonPrimosRelativos1 6 35 == True

-- sonPrimosRelativos1 6 27 == False

sonPrimosRelativos1 :: Int -> Int -> Bool

sonPrimosRelativos1 x y =

null (divisoresPrimos x `intersect` divisoresPrimos y)

-- (divisoresPrimos x) es la lista de los divisores primos de x. Por

-- ejemplo,

-- divisoresPrimos 600 == [2,2,2,3,5,5]

divisoresPrimos :: Int -> [Int]

divisoresPrimos 1 = []

divisoresPrimos x =

y : divisoresPrimos (x `div` y)

where y = menorDivisorPrimo x

-- (menorDivisorPrimo x) es el menor divisor primo de x. Por ejemplo,

-- menorDivisorPrimo 15 == 3

-- menorDivisorPrimo 11 == 11

menorDivisorPrimo :: Int -> Int

menorDivisorPrimo x =

head [y | y <- [2..], x `mod` y == 0]

-- 2ª solución

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

primosRelativos2 :: [Int] -> Bool

primosRelativos2 [] = True

primosRelativos2 (x:xs) =

all (sonPrimosRelativos1 x) xs && primosRelativos2 xs

-- 3ª solución

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

primosRelativos3 :: [Int] -> Bool

primosRelativos3 [] = True

primosRelativos3 (x:xs) =

all (sonPrimosRelativos2 x) xs && primosRelativos3 xs

sonPrimosRelativos2 :: Int -> Int -> Bool

sonPrimosRelativos2 x y =

null (primeFactors x `intersect` primeFactors y)

-- 4ª solución

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

primosRelativos4 :: [Int] -> Bool

primosRelativos4 [] = True

primosRelativos4 (x:xs) =

all (sonPrimosRelativos3 x) xs && primosRelativos4 xs

sonPrimosRelativos3 :: Int -> Int -> Bool

sonPrimosRelativos3 x y =

S.fromList (primeFactors x) `S.disjoint` S.fromList (primeFactors y)

-- 5ª solución

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

primosRelativos5 :: [Int] -> Bool

primosRelativos5 [] = True

primosRelativos5 (x:xs) =

all (sonPrimosRelativos5 x) xs && primosRelativos5 xs

sonPrimosRelativos5 :: Int -> Int -> Bool

sonPrimosRelativos5 x y =

gcd x y == 1

-- Comprobación de equivalencia

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

-- La propiedad es

prop_primosRelativos :: [Positive Int] -> Bool

prop_primosRelativos xs =

all (== primosRelativos1 ys)

[primosRelativos2 ys,

primosRelativos3 ys,

primosRelativos4 ys,

primosRelativos5 ys]

where ys = getPositive <$> xs

-- La comprobación es

-- λ> quickCheck prop_primosRelativos

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> primosRelativos1 (take 120 primes)

-- True

-- (1.92 secs, 869,909,416 bytes)

-- λ> primosRelativos2 (take 120 primes)

-- True

-- (1.99 secs, 869,045,656 bytes)

-- λ> primosRelativos3 (take 120 primes)

-- True

-- (0.09 secs, 221,183,200 bytes)

-- λ> primosRelativos3 (take 600 primes)

-- True

-- (2.62 secs, 11,196,690,856 bytes)

-- λ> primosRelativos4 (take 600 primes)

-- True

-- (2.66 secs, 11,190,940,456 bytes)

-- λ> primosRelativos5 (take 600 primes)

-- True

-- (0.14 secs, 123,673,648 bytes)

El código se encuentra en GitHub.

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

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>

Diferencia simétrica

PorJosé A. Alonso 29-marzo-20225-abril-2022

La diferencia simétrica de dos conjuntos es el conjunto cuyos elementos son aquellos que pertenecen a alguno de los conjuntos iniciales, sin pertenecer a ambos a la vez. Por ejemplo, la diferencia simétrica de {2,5,3} y {4,2,3,7} es {5,4,7}.

Definir la función

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

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

tal que (diferenciaSimetrica xs ys) es la diferencia simétrica de xs e ys. Por ejemplo,

   diferenciaSimetrica [2,5,3] [4,2,3,7]    ==  [4,5,7]
   diferenciaSimetrica [2,5,3] [5,2,3]      ==  []
   diferenciaSimetrica [2,5,2] [4,2,3,7]    ==  [3,4,5,7]
   diferenciaSimetrica [2,5,2] [4,2,4,7]    ==  [4,5,7]
   diferenciaSimetrica [2,5,2,4] [4,2,4,7]  ==  [5,7]

diferenciaSimetrica [2,5,3] [4,2,3,7] == [4,5,7]

diferenciaSimetrica [2,5,3] [5,2,3] == []

diferenciaSimetrica [2,5,2] [4,2,3,7] == [3,4,5,7]

diferenciaSimetrica [2,5,2] [4,2,4,7] == [4,5,7]

diferenciaSimetrica [2,5,2,4] [4,2,4,7] == [5,7]

Soluciones

import Test.QuickCheck
import Data.List ((\\), intersect, nub, sort, union)
import qualified Data.Set as S

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

diferenciaSimetrica1 :: Ord a => [a] -> [a] -> [a]
diferenciaSimetrica1 xs ys =
  sort (nub ([x | x <- xs, x `notElem` ys] ++ [y | y <- ys, y `notElem` xs]))

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

diferenciaSimetrica2 :: Ord a => [a] -> [a] -> [a]
diferenciaSimetrica2 xs ys =
  sort (nub (filter (`notElem` ys) xs ++ filter (`notElem` xs) ys))

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

diferenciaSimetrica3 :: Ord a => [a] -> [a] -> [a]
diferenciaSimetrica3 xs ys =
  sort (nub (union xs ys \\ intersect xs ys))

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

diferenciaSimetrica4 :: Ord a => [a] -> [a] -> [a]
diferenciaSimetrica4 xs ys =
  [x | x <- sort (nub (xs ++ ys))
     , x `notElem` xs || x `notElem` ys]

-- 5ª solución
-- ===========

diferenciaSimetrica5 :: Ord a => [a] -> [a] -> [a]
diferenciaSimetrica5 xs ys =
  S.elems ((xs' `S.union` ys') `S.difference` (xs' `S.intersection` ys'))
  where xs' = S.fromList xs
        ys' = S.fromList ys

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

-- La propiedad es
prop_diferenciaSimetrica :: [Int] -> [Int] -> Bool
prop_diferenciaSimetrica xs ys =
  all (== diferenciaSimetrica1 xs ys)
      [diferenciaSimetrica2 xs ys,
       diferenciaSimetrica3 xs ys,
       diferenciaSimetrica4 xs ys,
       diferenciaSimetrica5 xs ys]

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

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

-- La comparación es
--    λ> length (diferenciaSimetrica1 [1..2*10^4] [2,4..2*10^4])
--    10000
--    (2.34 secs, 10,014,360 bytes)
--    λ> length (diferenciaSimetrica2 [1..2*10^4] [2,4..2*10^4])
--    10000
--    (2.41 secs, 8,174,264 bytes)
--    λ> length (diferenciaSimetrica3 [1..2*10^4] [2,4..2*10^4])
--    10000
--    (5.84 secs, 10,232,006,288 bytes)
--    λ> length (diferenciaSimetrica4 [1..2*10^4] [2,4..2*10^4])
--    10000
--    (5.83 secs, 14,814,184 bytes)
--    λ> length (diferenciaSimetrica5 [1..2*10^4] [2,4..2*10^4])
--    10000
--    (0.02 secs, 7,253,496 bytes)

import Test.QuickCheck

import Data.List ((\\), intersect, nub, sort, union)

import qualified Data.Set as S

-- 1ª solución

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

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

diferenciaSimetrica1 xs ys =

sort (nub ([x | x <- xs, x `notElem` ys] ++ [y | y <- ys, y `notElem` xs]))

-- 2ª solución

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

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

diferenciaSimetrica2 xs ys =

sort (nub (filter (`notElem` ys) xs ++ filter (`notElem` xs) ys))

-- 3ª solución

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

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

diferenciaSimetrica3 xs ys =

sort (nub (union xs ys \\ intersect xs ys))

-- 4ª solución

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

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

diferenciaSimetrica4 xs ys =

[x | x <- sort (nub (xs ++ ys))

, x `notElem` xs || x `notElem` ys]

-- 5ª solución

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

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

diferenciaSimetrica5 xs ys =

S.elems ((xs' `S.union` ys') `S.difference` (xs' `S.intersection` ys'))

where xs' = S.fromList xs

ys' = S.fromList ys

-- Comprobación de equivalencia

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

-- La propiedad es

prop_diferenciaSimetrica :: [Int] -> [Int] -> Bool

prop_diferenciaSimetrica xs ys =

all (== diferenciaSimetrica1 xs ys)

[diferenciaSimetrica2 xs ys,

diferenciaSimetrica3 xs ys,

diferenciaSimetrica4 xs ys,

diferenciaSimetrica5 xs ys]

-- La comprobación es

-- λ> quickCheck prop_diferenciaSimetrica

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> length (diferenciaSimetrica1 [1..2*10^4] [2,4..2*10^4])

-- 10000

-- (2.34 secs, 10,014,360 bytes)

-- λ> length (diferenciaSimetrica2 [1..2*10^4] [2,4..2*10^4])

-- 10000

-- (2.41 secs, 8,174,264 bytes)

-- λ> length (diferenciaSimetrica3 [1..2*10^4] [2,4..2*10^4])

-- 10000

-- (5.84 secs, 10,232,006,288 bytes)

-- λ> length (diferenciaSimetrica4 [1..2*10^4] [2,4..2*10^4])

-- 10000

-- (5.83 secs, 14,814,184 bytes)

-- λ> length (diferenciaSimetrica5 [1..2*10^4] [2,4..2*10^4])

-- 10000

-- (0.02 secs, 7,253,496 bytes)

El código se encuentra en GitHub.

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

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>

Mayor producto de las ramas de un árbol

PorJosé A. Alonso 28-marzo-20224-abril-2022

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

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

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

Por ejemplo, los árboles

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

1 3

/ \ /|\

2 3 / | \

| 5 4 7

4 | /\

6 2 1

se representan por

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

ej1, ej2 :: Arbol Int

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

ej2 = N 3 [N 5 [N 6 []], N 4 [], N 7 [N 2 [], N 1 []]]

Definir la función

   mayorProducto :: (Ord a, Num a) => Arbol a -> a

1	mayorProducto :: (Ord a, Num a) => Arbol a -> a

tal que (mayorProducto a) es el mayor producto de las ramas del árbol a. Por ejemplo,

   λ> mayorProducto (N 1 [N 2 [], N  3 []])
   3
   λ> mayorProducto (N 1 [N 8 [], N  4 [N 3 []]])
   12
   λ> mayorProducto (N 1 [N 2 [],N 3 [N 4 []]])
   12
   λ> mayorProducto (N 3 [N 5 [N 6 []], N 4 [], N 7 [N 2 [], N 1 []]])
   90
   λ> mayorProducto (N (-8) [N 0 [N (-9) []],N 6 []])
   0
   λ> a = N (-4) [N (-7) [],N 14 [N 19 []],N (-1) [N (-6) [],N 21 []],N (-4) []]
   λ> mayorProducto a
   84

λ> mayorProducto (N 1 [N 2 [], N 3 []])

λ> mayorProducto (N 1 [N 8 [], N 4 [N 3 []]])

λ> mayorProducto (N 1 [N 2 [],N 3 [N 4 []]])

λ> mayorProducto (N 3 [N 5 [N 6 []], N 4 [], N 7 [N 2 [], N 1 []]])

λ> mayorProducto (N (-8) [N 0 [N (-9) []],N 6 []])

λ> a = N (-4) [N (-7) [],N 14 [N 19 []],N (-1) [N (-6) [],N 21 []],N (-4) []]

λ> mayorProducto a

Soluciones

import Test.QuickCheck

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

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

mayorProducto1 :: (Ord a, Num a) => Arbol a -> a
mayorProducto1 a = maximum [product xs | xs <- ramas a]

-- (ramas a) es la lista de las ramas del árbol a. Por ejemplo,
--    λ> ramas (N 3 [N 5 [N 6 []], N 4 [], N 7 [N 2 [], N 1 []]])
--    [[3,5,6],[3,4],[3,7,2],[3,7,1]]
ramas :: Arbol b -> [[b]]
ramas (N x []) = [[x]]
ramas (N x as) = [x : xs | a <- as, xs <- ramas a]

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

mayorProducto2 :: (Ord a, Num a) => Arbol a -> a
mayorProducto2 a = maximum (map product (ramas a))

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

mayorProducto3 :: (Ord a, Num a) => Arbol a -> a
mayorProducto3 = maximum . map product . ramas

-- 4º solución
-- ===========

mayorProducto4 :: (Ord a, Num a) => Arbol a -> a
mayorProducto4 = maximum . productosRamas

-- (productosRamas a) es la lista de los productos de las ramas
-- del árbol a. Por ejemplo,
--    λ> productosRamas (N 3 [N 5 [N 6 []], N 4 [], N 7 [N 2 [], N 1 []]])
--    [90,12,42,21]
productosRamas :: (Ord a, Num a) => Arbol a -> [a]
productosRamas (N x []) = [x]
productosRamas (N x xs) = [x * y | a <- xs, y <- productosRamas a]

-- 5ª solución
-- ===========

mayorProducto5 :: (Ord a, Num a) => Arbol a -> a
mayorProducto5 (N x []) = x
mayorProducto5 (N x xs)
  | x > 0     = x * maximum (map mayorProducto5 xs)
  | x == 0    = 0
  | otherwise = x * minimum (map menorProducto xs)

-- (menorProducto a) es el menor producto de las ramas del árbol
-- a. Por ejemplo,
--    λ> menorProducto (N 1 [N 2 [], N  3 []])
--    2
--    λ> menorProducto (N 1 [N 8 [], N  4 [N 3 []]])
--    8
--    λ> menorProducto (N 1 [N 2 [],N 3 [N 4 []]])
--    2
--    λ> menorProducto (N 3 [N 5 [N 6 []], N 4 [], N 7 [N 2 [], N 1 []]])
--    12
menorProducto :: (Ord a, Num a) => Arbol a -> a
menorProducto (N x []) = x
menorProducto (N x xs)
  | x > 0     = x * minimum (map menorProducto xs)
  | x == 0    = 0
  | otherwise = x * maximum (map mayorProducto2 xs)

-- 6ª solución
-- ===========

mayorProducto6 :: (Ord a, Num a) => Arbol a -> a
mayorProducto6 = maximum . aux
  where aux (N a []) = [a]
        aux (N a b)  = [v,u]
          where u = maximum g
                v = minimum g
                g = map (*a) (concatMap aux b)

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

-- (arbolArbitrario n) es un árbol aleatorio de orden n. Por ejemplo,
--   > sample (arbolArbitrario 5 :: Gen (Arbol Int))
--   N 0 [N 0 []]
--   N (-2) []
--   N 4 []
--   N 2 [N 4 []]
--   N 8 []
--   N (-2) [N (-9) [],N 7 []]
--   N 11 []
--   N (-11) [N 4 [],N 14 []]
--   N 10 [N (-3) [],N 13 []]
--   N 12 [N 11 []]
--   N 20 [N (-18) [],N (-13) []]
arbolArbitrario :: Arbitrary a => Int -> Gen (Arbol a)
arbolArbitrario n = do
  x  <- arbitrary
  ms <- sublistOf [0 .. n `div` 2]
  as <- mapM arbolArbitrario ms
  return (N x as)

-- Arbol es una subclase de Arbitraria
instance Arbitrary a => Arbitrary (Arbol a) where
  arbitrary = sized arbolArbitrario

-- La propiedad es
prop_mayorProducto :: Arbol Integer -> Bool
prop_mayorProducto a =
  all (== mayorProducto1 a)
      [f a | f <- [ mayorProducto2
                  , mayorProducto3
                  , mayorProducto4
                  , mayorProducto5
                  , mayorProducto6
                  ]]

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

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

-- La comparación es
--    λ> ejArbol <- generate (arbolArbitrario 600 :: Gen (Arbol Integer))
--    λ> mayorProducto1 ejArbol
--    2419727651266241493467136000
--    (1.87 secs, 1,082,764,480 bytes)
--    λ> mayorProducto2 ejArbol
--    2419727651266241493467136000
--    (1.57 secs, 1,023,144,008 bytes)
--    λ> mayorProducto3 ejArbol
--    2419727651266241493467136000
--    (1.55 secs, 1,023,144,248 bytes)
--    λ> mayorProducto4 ejArbol
--    2419727651266241493467136000
--    (1.60 secs, 824,473,800 bytes)
--    λ> mayorProducto5 ejArbol
--    2419727651266241493467136000
--    (0.83 secs, 732,370,352 bytes)
--    λ> mayorProducto6 ejArbol
--    2419727651266241493467136000
--    (0.98 secs, 817,473,344 bytes)
--
--    λ> ejArbol2 <- generate (arbolArbitrario 700 :: Gen (Arbol Integer))
--    λ> mayorProducto5 ejArbol2
--    1044758937398026715504640000000
--    (4.94 secs, 4,170,324,376 bytes)
--    λ> mayorProducto6 ejArbol2
--    1044758937398026715504640000000
--    (5.88 secs, 4,744,782,024 bytes)

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

import Test.QuickCheck

data Arbol a = N a [Arbol a]

deriving Show

-- 1ª solución

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

mayorProducto1 :: (Ord a, Num a) => Arbol a -> a

mayorProducto1 a = maximum [product xs | xs <- ramas a]

-- (ramas a) es la lista de las ramas del árbol a. Por ejemplo,

-- λ> ramas (N 3 [N 5 [N 6 []], N 4 [], N 7 [N 2 [], N 1 []]])

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

ramas :: Arbol b -> [[b]]

ramas (N x []) = [[x]]

ramas (N x as) = [x : xs | a <- as, xs <- ramas a]

-- 2ª solución

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

mayorProducto2 :: (Ord a, Num a) => Arbol a -> a

mayorProducto2 a = maximum (map product (ramas a))

-- 3ª solución

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

mayorProducto3 :: (Ord a, Num a) => Arbol a -> a

mayorProducto3 = maximum . map product . ramas

-- 4º solución

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

mayorProducto4 :: (Ord a, Num a) => Arbol a -> a

mayorProducto4 = maximum . productosRamas

-- (productosRamas a) es la lista de los productos de las ramas

-- del árbol a. Por ejemplo,

-- λ> productosRamas (N 3 [N 5 [N 6 []], N 4 [], N 7 [N 2 [], N 1 []]])

-- [90,12,42,21]

productosRamas :: (Ord a, Num a) => Arbol a -> [a]

productosRamas (N x []) = [x]

productosRamas (N x xs) = [x * y | a <- xs, y <- productosRamas a]

-- 5ª solución

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

mayorProducto5 :: (Ord a, Num a) => Arbol a -> a

mayorProducto5 (N x []) = x

mayorProducto5 (N x xs)

| x > 0 = x * maximum (map mayorProducto5 xs)

| x == 0 = 0

| otherwise = x * minimum (map menorProducto xs)

-- (menorProducto a) es el menor producto de las ramas del árbol

-- a. Por ejemplo,

-- λ> menorProducto (N 1 [N 2 [], N 3 []])

-- 2

-- λ> menorProducto (N 1 [N 8 [], N 4 [N 3 []]])

-- 8

-- λ> menorProducto (N 1 [N 2 [],N 3 [N 4 []]])

-- 2

-- λ> menorProducto (N 3 [N 5 [N 6 []], N 4 [], N 7 [N 2 [], N 1 []]])

-- 12

menorProducto :: (Ord a, Num a) => Arbol a -> a

menorProducto (N x []) = x

menorProducto (N x xs)

| x > 0 = x * minimum (map menorProducto xs)

| x == 0 = 0

| otherwise = x * maximum (map mayorProducto2 xs)

-- 6ª solución

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

mayorProducto6 :: (Ord a, Num a) => Arbol a -> a

mayorProducto6 = maximum . aux

where aux (N a []) = [a]

aux (N a b) = [v,u]

where u = maximum g

v = minimum g

g = map (*a) (concatMap aux b)

-- Comprobación de equivalencia

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

-- (arbolArbitrario n) es un árbol aleatorio de orden n. Por ejemplo,

-- > sample (arbolArbitrario 5 :: Gen (Arbol Int))

-- N 0 [N 0 []]

-- N (-2) []

-- N 4 []

-- N 2 [N 4 []]

-- N 8 []

-- N (-2) [N (-9) [],N 7 []]

-- N 11 []

-- N (-11) [N 4 [],N 14 []]

-- N 10 [N (-3) [],N 13 []]

-- N 12 [N 11 []]

-- N 20 [N (-18) [],N (-13) []]

arbolArbitrario :: Arbitrary a => Int -> Gen (Arbol a)

arbolArbitrario n = do

x <- arbitrary

ms <- sublistOf [0 .. n `div` 2]

as <- mapM arbolArbitrario ms

return (N x as)

-- Arbol es una subclase de Arbitraria

instance Arbitrary a => Arbitrary (Arbol a) where

arbitrary = sized arbolArbitrario

-- La propiedad es

prop_mayorProducto :: Arbol Integer -> Bool

prop_mayorProducto a =

all (== mayorProducto1 a)

[f a | f <- [ mayorProducto2

, mayorProducto3

, mayorProducto4

, mayorProducto5

, mayorProducto6

]]

-- La comprobación es

-- λ> quickCheck prop_mayorProducto

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> ejArbol <- generate (arbolArbitrario 600 :: Gen (Arbol Integer))

-- λ> mayorProducto1 ejArbol

-- 2419727651266241493467136000

-- (1.87 secs, 1,082,764,480 bytes)

-- λ> mayorProducto2 ejArbol

-- 2419727651266241493467136000

-- (1.57 secs, 1,023,144,008 bytes)

-- λ> mayorProducto3 ejArbol

-- 2419727651266241493467136000

-- (1.55 secs, 1,023,144,248 bytes)

-- λ> mayorProducto4 ejArbol

-- 2419727651266241493467136000

-- (1.60 secs, 824,473,800 bytes)

-- λ> mayorProducto5 ejArbol

-- 2419727651266241493467136000

-- (0.83 secs, 732,370,352 bytes)

-- λ> mayorProducto6 ejArbol

-- 2419727651266241493467136000

-- (0.98 secs, 817,473,344 bytes)

-- λ> ejArbol2 <- generate (arbolArbitrario 700 :: Gen (Arbol Integer))

-- λ> mayorProducto5 ejArbol2

-- 1044758937398026715504640000000

-- (4.94 secs, 4,170,324,376 bytes)

-- λ> mayorProducto6 ejArbol2

-- 1044758937398026715504640000000

-- (5.88 secs, 4,744,782,024 bytes)

El código se encuentra en GitHub.

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

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>

Ampliación de matrices por columnas

PorJosé A. Alonso 22-marzo-202215-abril-2022

Las matrices enteras se pueden representar mediante tablas con índices enteros:

   type Matriz = Array (Int,Int) Int

1	type Matriz = Array (Int,Int) Int

Definir la función

   ampliaColumnas :: Matriz -> Matriz -> Matriz

1	ampliaColumnas :: Matriz -> Matriz -> Matriz

tal que (ampliaColumnas p q) es la matriz construida añadiendo las columnas de la matriz q a continuación de las de p (se supone que tienen el mismo número de filas). Por ejemplo, si p y q representa las dos primeras matrices, entonces (ampliaColumnas p q) es la tercera

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

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

En Haskell, se definen las dos primeras matrices se definen por

   ej1 = listArray ((1,1),(2,2)) [0..3]
   ej2 = listArray ((1,1),(2,3)) [4..9]

1 2	ej1 = listArray ((1,1),(2,2)) [0..3] ej2 = listArray ((1,1),(2,3)) [4..9]

y el cálculo de la tercera es

   λ> ampliaColumnas ej1 ej2
   array ((1,1),(2,5)) [((1,1),0),((1,2),1),((1,3),4),((1,4),5),((1,5),6),
                        ((2,1),2),((2,2),3),((2,3),7),((2,4),8),((2,5),9)]
   λ> elems (ampliaColumnas ej1 ej2)
   [0,1,4,5,6,2,3,7,8,9]

λ> ampliaColumnas ej1 ej2

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

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

λ> elems (ampliaColumnas ej1 ej2)

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

Soluciones

import Data.Array (Array, (!), array, bounds, elems, listArray)
import Data.Matrix (Matrix, (<|>), fromList, ncols, nrows, toList)
import Test.QuickCheck

type Matriz = Array (Int,Int) Int

ej1, ej2 :: Matriz
ej1 = listArray ((1,1),(2,2)) [0..3]
ej2 = listArray ((1,1),(2,3)) [4..9]

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

ampliaColumnas1 :: Matriz -> Matriz -> Matriz
ampliaColumnas1 p1 p2 =
  array ((1,1),(m,n1+n2)) [((i,j), f i j) | i <- [1..m], j <- [1..n1+n2]]
    where ((_,_),(m,n1)) = bounds p1
          ((_,_),(_,n2)) = bounds p2
          f i j | j <= n1   = p1!(i,j)
                | otherwise = p2!(i,j-n1)

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

ampliaColumnas2 :: Matriz -> Matriz -> Matriz
ampliaColumnas2 p1 p2 =
  matriz (matrix p1 <|> matrix p2)

-- (matrix p) es la matriz p en el formatao de Data.Matrix. Por ejemplo,
--    λ> ej1
--    array ((1,1),(2,2)) [((1,1),0),((1,2),1),((2,1),2),((2,2),3)]
--    λ> matrix ej1
--    ┌     ┐
--    │ 0 1 │
--    │ 2 3 │
--    └     ┘
--    λ> matrix (ampliaColumnas1 ej1 ej2)
--    ┌           ┐
--    │ 0 1 4 5 6 │
--    │ 2 3 7 8 9 │
--    └           ┘
matrix :: Matriz -> Matrix Int
matrix p = fromList m n (elems p)
  where (_,(m,n)) = bounds p

-- (matriz p) es la matriz p en el formato de Data.Array. Por ejemplo,
--    λ> matriz (fromList 2 3 [1..])
--    array ((1,1),(2,3)) [((1,1),1),((1,2),2),((1,3),3),((2,1),4),((2,2),5),((2,3),6)]
matriz :: Matrix Int -> Matriz
matriz p = listArray ((1,1),(nrows p,ncols p)) (toList p)

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

data ParMatrices = P Matriz Matriz
  deriving Show

-- parMatricesArbitrario es un generador de pares de matrices con el
-- mismo número de filas.
parMatricesArbitrario :: Gen ParMatrices
parMatricesArbitrario = do
  m  <- arbitrary `suchThat` (> 0)
  n1 <- arbitrary `suchThat` (> 0)
  n2 <- arbitrary `suchThat` (> 0)
  xs <- vector (m * n1)
  ys <- vector (m * n2)
  return (P (listArray ((1,1),(m,n1)) xs)
            (listArray ((1,1),(m,n2)) ys))

-- ParMatrices es una subclase de Arbitrary
instance Arbitrary ParMatrices where
  arbitrary = parMatricesArbitrario

-- La propiedad es
prop_ampliaColumna :: ParMatrices -> Bool
prop_ampliaColumna (P p q) =
  ampliaColumnas1 p q == ampliaColumnas2 p q

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

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

-- La comparación es
--    λ> let p = listArray ((1,1),(10^3,10^3)) [1..] in maximum (ampliaColumnas1 p p)
--    1000000
--    (2.04 secs, 1,562,652,704 bytes)
--    λ> let p = listArray ((1,1),(10^3,10^3)) [1..] in maximum (ampliaColumnas2 p p)
--    1000000
--    (0.69 secs, 738,508,624 bytes)

import Data.Array (Array, (!), array, bounds, elems, listArray)

import Data.Matrix (Matrix, (<|>), fromList, ncols, nrows, toList)

import Test.QuickCheck

type Matriz = Array (Int,Int) Int

ej1, ej2 :: Matriz

ej1 = listArray ((1,1),(2,2)) [0..3]

ej2 = listArray ((1,1),(2,3)) [4..9]

-- 1ª solución

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

ampliaColumnas1 :: Matriz -> Matriz -> Matriz

ampliaColumnas1 p1 p2 =

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

where ((_,_),(m,n1)) = bounds p1

((_,_),(_,n2)) = bounds p2

f i j | j <= n1 = p1!(i,j)

| otherwise = p2!(i,j-n1)

-- 2ª solución

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

ampliaColumnas2 :: Matriz -> Matriz -> Matriz

ampliaColumnas2 p1 p2 =

matriz (matrix p1 <|> matrix p2)

-- (matrix p) es la matriz p en el formatao de Data.Matrix. Por ejemplo,

-- λ> ej1

-- array ((1,1),(2,2)) [((1,1),0),((1,2),1),((2,1),2),((2,2),3)]

-- λ> matrix ej1

-- ┌ ┐

-- │ 0 1 │

-- │ 2 3 │

-- └ ┘

-- λ> matrix (ampliaColumnas1 ej1 ej2)

-- ┌ ┐

-- │ 0 1 4 5 6 │

-- │ 2 3 7 8 9 │

-- └ ┘

matrix :: Matriz -> Matrix Int

matrix p = fromList m n (elems p)

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

-- (matriz p) es la matriz p en el formato de Data.Array. Por ejemplo,

-- λ> matriz (fromList 2 3 [1..])

-- array ((1,1),(2,3)) [((1,1),1),((1,2),2),((1,3),3),((2,1),4),((2,2),5),((2,3),6)]

matriz :: Matrix Int -> Matriz

matriz p = listArray ((1,1),(nrows p,ncols p)) (toList p)

-- Comprobación de equivalencia

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

data ParMatrices = P Matriz Matriz

deriving Show

-- parMatricesArbitrario es un generador de pares de matrices con el

-- mismo número de filas.

parMatricesArbitrario :: Gen ParMatrices

parMatricesArbitrario = do

m <- arbitrary `suchThat` (> 0)

n1 <- arbitrary `suchThat` (> 0)

n2 <- arbitrary `suchThat` (> 0)

xs <- vector (m * n1)

ys <- vector (m * n2)

return (P (listArray ((1,1),(m,n1)) xs)

(listArray ((1,1),(m,n2)) ys))

-- ParMatrices es una subclase de Arbitrary

instance Arbitrary ParMatrices where

arbitrary = parMatricesArbitrario

-- La propiedad es

prop_ampliaColumna :: ParMatrices -> Bool

prop_ampliaColumna (P p q) =

ampliaColumnas1 p q == ampliaColumnas2 p q

-- La comprobación es

-- λ> quickCheck prop_ampliaColumna

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> let p = listArray ((1,1),(10^3,10^3)) [1..] in maximum (ampliaColumnas1 p p)

-- 1000000

-- (2.04 secs, 1,562,652,704 bytes)

-- λ> let p = listArray ((1,1),(10^3,10^3)) [1..] in maximum (ampliaColumnas2 p p)

-- 1000000

-- (0.69 secs, 738,508,624 bytes)

El código se encuentra en GitHub.

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

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>

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Entradas recientes

Buscar

Correo electrónico