marzo 2021 – Exercitium

Lista muy decreciente

PorJosé A. Alonso 31-marzo-20217-abril-2021

Una lista de números es muy decreciente si cada elemento es mayor que la suma de los restantes. Por ejemplo, [19,9,6,2] es muy decreciente ya que

19 > 9 + 6 + 2,
9 > 6 + 2 y
6 > 2

En cambio, [19,8,6,2] no lo es ya que 8 = 6 + 2.

Definir la función

   muyDecreciente :: [Integer] -> Bool

1	muyDecreciente :: [Integer] -> Bool

tal que (muyDecreciente xs) se verifica si xs es muy decreciente. Por ejemplo,

   muyDecreciente [19,9,6,2]  ==  True
   muyDecreciente [19,8,6,2]  ==  False
   muyDecreciente [2^k | k <- [60000,59999..0]]  ==  True

muyDecreciente [19,9,6,2] == True

muyDecreciente [19,8,6,2] == False

muyDecreciente [2^k | k <- [60000,59999..0]] == True

Soluciones

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

muyDecreciente :: [Integer] -> Bool
muyDecreciente []     = True
muyDecreciente (x:xs) = x > sum xs && muyDecreciente xs

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

muyDecreciente2 :: [Integer] -> Bool
muyDecreciente2 = snd . aux
  where aux []     = (0,True)
        aux (x:xs) = (x + s, x > s && b)
          where (s,b) = aux xs

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

muyDecreciente3 :: [Integer] -> Bool
muyDecreciente3 xs =
  and (zipWith (>) xs (tail (scanr1 (+) xs)))

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

-- La comparación es
--    λ> muyDecreciente [2^k | k <- [10000,9999..0]]
--    True
--    (6.72 secs, 48,095,728,720 bytes)
--    λ> muyDecreciente2 [2^k | k <- [10000,9999..0]]
--    True
--    (0.08 secs, 67,222,960 bytes)
--    λ> muyDecreciente3 [2^k | k <- [10000,9999..0]]
--    True
--    (0.10 secs, 66,664,928 bytes)
--
--    λ> muyDecreciente2 [2^k | k <- [50000,49999..0]]
--    True
--    (1.88 secs, 857,128,312 bytes)
--    λ> muyDecreciente3 [2^k | k <- [50000,49999..0]]
--    True
--    (1.67 secs, 854,326,736 bytes)

-- 1ª solución

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

muyDecreciente :: [Integer] -> Bool

muyDecreciente [] = True

muyDecreciente (x:xs) = x > sum xs && muyDecreciente xs

-- 2ª solución

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

muyDecreciente2 :: [Integer] -> Bool

muyDecreciente2 = snd . aux

where aux [] = (0,True)

aux (x:xs) = (x + s, x > s && b)

where (s,b) = aux xs

-- 3ª solución

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

muyDecreciente3 :: [Integer] -> Bool

muyDecreciente3 xs =

and (zipWith (>) xs (tail (scanr1 (+) xs)))

-- Comparación de eficiencia

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

-- La comparación es

-- λ> muyDecreciente [2^k | k <- [10000,9999..0]]

-- True

-- (6.72 secs, 48,095,728,720 bytes)

-- λ> muyDecreciente2 [2^k | k <- [10000,9999..0]]

-- True

-- (0.08 secs, 67,222,960 bytes)

-- λ> muyDecreciente3 [2^k | k <- [10000,9999..0]]

-- True

-- (0.10 secs, 66,664,928 bytes)

-- λ> muyDecreciente2 [2^k | k <- [50000,49999..0]]

-- True

-- (1.88 secs, 857,128,312 bytes)

-- λ> muyDecreciente3 [2^k | k <- [50000,49999..0]]

-- True

-- (1.67 secs, 854,326,736 bytes)

Nuevas soluciones

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

Menor prefijo con suma positiva

PorJosé A. Alonso 30-marzo-20216-abril-2021

Definir la función

   menorPrefijoSumaPositiva1 :: [[Int]] -> Maybe [[Int]]

1	menorPrefijoSumaPositiva1 :: [[Int]] -> Maybe [[Int]]

tal que (menorPrefijoSumaPositiva1 xss) es justamente el menor prejijo de xss tal que la suma de lsas sumas de sus elementos es positivo y es Nothing si tal prefijo no existe. Por ejemplo,

   menorPrefijoSumaPositiva [[1],[-3],[2,4]]     == Just [[1]]
   menorPrefijoSumaPositiva [[-2,1],[-3],[2,4]]  == Just [[-2,1],[-3],[2,4]]
   menorPrefijoSumaPositiva [[-2,1],[3],[2,4]]   == Just [[-2,1],[3]]
   menorPrefijoSumaPositiva [[-2,1],[-3],[2,-4]] == Nothing
   menorPrefijoSumaPositiva [[-k..k] | k <- [1..5000]]              == Nothing
   fmap length (menorPrefijoSumaPositiva [[-3000..k] | k <- [0..]]) == Just 5198

menorPrefijoSumaPositiva [[1],[-3],[2,4]] == Just [[1]]

menorPrefijoSumaPositiva [[-2,1],[-3],[2,4]] == Just [[-2,1],[-3],[2,4]]

menorPrefijoSumaPositiva [[-2,1],[3],[2,4]] == Just [[-2,1],[3]]

menorPrefijoSumaPositiva [[-2,1],[-3],[2,-4]] == Nothing

menorPrefijoSumaPositiva [[-k..k] | k <- [1..5000]] == Nothing

fmap length (menorPrefijoSumaPositiva [[-3000..k] | k <- [0..]]) == Just 5198

Soluciones

import Data.List (inits)
import Data.Maybe (listToMaybe)
import Test.QuickCheck

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

menorPrefijoSumaPositiva1 :: [[Int]] -> Maybe [[Int]]
menorPrefijoSumaPositiva1 xss =
  listToMaybe [xs | xs <- tail (inits xss),
                    sum (concat xs) > 0]

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

menorPrefijoSumaPositiva2 :: [[Int]] -> Maybe [[Int]]
menorPrefijoSumaPositiva2 xss = aux [] xss
  where aux yss _  | sum (concat yss) > 0 = Just (reverse yss)
        aux _   []                        = Nothing
        aux yss (zs:zss)                  = aux (zs : yss) zss

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

menorPrefijoSumaPositiva3 :: [[Int]] -> Maybe [[Int]]
menorPrefijoSumaPositiva3 xss =
  aux (0,[]) (zip (map sum xss) xss)
  where aux (s,yss) _  | s > 0   = Just (reverse yss)
        aux _ []                 = Nothing
        aux (s,yss) ((t,zs):zss) = aux (s+t,zs:yss) zss

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

-- La propiedad es
prop_equivalencia :: [[Int]] -> Bool
prop_equivalencia xss =
  all (== (menorPrefijoSumaPositiva1 xss))
      [ menorPrefijoSumaPositiva2 xss,
        menorPrefijoSumaPositiva3 xss ]

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

-- Comparación de eficiencia
-- =========================
--
-- La comparación es
--    λ> fmap length (menorPrefijoSumaPositiva1 [[-200..k] | k <- [0..]])
--    Just 348
--    (2.40 secs, 2,801,967,392 bytes)
--    λ> fmap length (menorPrefijoSumaPositiva2 [[-200..k] | k <- [0..]])
--    Just 348
--    (2.46 secs, 2,800,717,720 bytes)
--    λ> fmap length (menorPrefijoSumaPositiva3 [[-200..k] | k <- [0..]])
--    Just 348
--    (0.01 secs, 18,128,464 bytes)

--    λ> menorPrefijoSumaPositiva1 [[-k..k] | k <- [1..500]]
--    Nothing
--    (6.39 secs, 6,127,124,136 bytes)
--    λ> menorPrefijoSumaPositiva2 [[-k..k] | k <- [1..500]]
--    Nothing
--    (6.47 secs, 6,124,201,288 bytes)
--    λ> menorPrefijoSumaPositiva3 [[-k..k] | k <- [1..500]]
--    Nothing
--    (0.03 secs, 37,944,760 bytes)

import Data.List (inits)

import Data.Maybe (listToMaybe)

import Test.QuickCheck

-- 1ª solución

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

menorPrefijoSumaPositiva1 :: [[Int]] -> Maybe [[Int]]

menorPrefijoSumaPositiva1 xss =

listToMaybe [xs | xs <- tail (inits xss),

sum (concat xs) > 0]

-- 2ª solución

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

menorPrefijoSumaPositiva2 :: [[Int]] -> Maybe [[Int]]

menorPrefijoSumaPositiva2 xss = aux [] xss

where aux yss _ | sum (concat yss) > 0 = Just (reverse yss)

aux _ [] = Nothing

aux yss (zs:zss) = aux (zs : yss) zss

-- 3ª solución

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

menorPrefijoSumaPositiva3 :: [[Int]] -> Maybe [[Int]]

menorPrefijoSumaPositiva3 xss =

aux (0,[]) (zip (map sum xss) xss)

where aux (s,yss) _ | s > 0 = Just (reverse yss)

aux _ [] = Nothing

aux (s,yss) ((t,zs):zss) = aux (s+t,zs:yss) zss

-- Comprobación de equivalencia

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

-- La propiedad es

prop_equivalencia :: [[Int]] -> Bool

prop_equivalencia xss =

all (== (menorPrefijoSumaPositiva1 xss))

[ menorPrefijoSumaPositiva2 xss,

menorPrefijoSumaPositiva3 xss ]

-- La comprobación es

-- λ> quickCheck prop_equivalencia

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> fmap length (menorPrefijoSumaPositiva1 [[-200..k] | k <- [0..]])

-- Just 348

-- (2.40 secs, 2,801,967,392 bytes)

-- λ> fmap length (menorPrefijoSumaPositiva2 [[-200..k] | k <- [0..]])

-- Just 348

-- (2.46 secs, 2,800,717,720 bytes)

-- λ> fmap length (menorPrefijoSumaPositiva3 [[-200..k] | k <- [0..]])

-- Just 348

-- (0.01 secs, 18,128,464 bytes)

-- λ> menorPrefijoSumaPositiva1 [[-k..k] | k <- [1..500]]

-- Nothing

-- (6.39 secs, 6,127,124,136 bytes)

-- λ> menorPrefijoSumaPositiva2 [[-k..k] | k <- [1..500]]

-- Nothing

-- (6.47 secs, 6,124,201,288 bytes)

-- λ> menorPrefijoSumaPositiva3 [[-k..k] | k <- [1..500]]

-- Nothing

-- (0.03 secs, 37,944,760 bytes)

Nuevas soluciones

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

Autonúmeros

PorJosé A. Alonso 29-marzo-20215-abril-2021

Un autonúmero es un número entero n tal que no existe ningún número entero positivo k tal que n sea igual a la suma de k y los dígitos de k. Por ejemplo, 5 es un autonúmero pero 21 no lo es ya que 21=15+1+5.

Definir la lista

   autonumeros :: [Integer]

1	autonumeros :: [Integer]

cuyos elementos son los autonúmeros. Por ejemplo,

   λ> take 20 autonumeros
   [1,3,5,7,9,20,31,42,53,64,75,86,97,108,110,121,132,143,154,165]
   λ> autonumeros !! 1200
   12236

λ> take 20 autonumeros

[1,3,5,7,9,20,31,42,53,64,75,86,97,108,110,121,132,143,154,165]

λ> autonumeros !! 1200

12236

Soluciones

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

autonumeros :: [Integer]
autonumeros = filter autonumero [1..]

-- (autonumero n) se verifica si n es un autonúmero. Por ejemplo,
--    autonumero 5  == True
--    autonumero 21 == False
autonumero :: Integer -> Bool
autonumero n =
  all (/=n) [k + sum (digitos k) | k <- [1..n]]

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

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

autonumeros2 :: [Integer]
autonumeros2 = map head sucesionSucesionesSumasDigitales

-- sucesionSucesionesSumasDigitales es la lista de las sucesiones de
-- sumas parciales tal que el primer elemento de cada sucesión es el
-- menor elemento que no pertenece a las sucesiones anteriores. Por
-- ejemplo,
--    λ> map (take 4) (take 8 sucesionSucesionesSumasDigitales)
--    [[1,2,4,8],[3,6,12,15],[5,10,11,13],[7,14,19,29],
--     [9,18,27,36],[20,22,26,34],[31,35,43,50],[42,48,60,66]]
sucesionSucesionesSumasDigitales :: [[Integer]]
sucesionSucesionesSumasDigitales = aux [1..]
  where aux xs = sucesion xs : aux (diferencia xs (sucesion xs))
        sucesion xs = sucesionSumasDigitales (head xs)

-- (diferencia xs ys) es la diferencia las listas infinitas ordenadas
-- crecientes xs e ys. Por ejemplo,
--    λ> take 8 (diferencia [1..] [2,4..])
--    [1,3,5,7,9,11,13,15]
diferencia :: [Integer] -> [Integer] -> [Integer]
diferencia (x:xs) (y:ys)
  | x == y    = diferencia xs ys
  | otherwise = x : diferencia xs (y:ys)

-- (sucesionSumasDigitales a) es la sucesión de las sumas digitales
-- definida por un número a. Por ejemplo,
--    λ> take 16 (sucesionSumasDigitales 1)
--    [1,2,4,8,16,23,28,38,49,62,70,77,91,101,103,107]
--    λ> take 16 (sucesionSumasDigitales 3)
--    [3,6,12,15,21,24,30,33,39,51,57,69,84,96,111,114]
--    λ> take 16 (sucesionSumasDigitales 5)
--    [5,10,11,13,17,25,32,37,47,58,71,79,95,109,119,130]
--    λ> take 16 (sucesionSumasDigitales 7)
--    [7,14,19,29,40,44,52,59,73,83,94,107,115,122,127,137]
--    λ> take 16 (sucesionSumasDigitales 9)
--    [9,18,27,36,45,54,63,72,81,90,99,117,126,135,144,153]
--    λ> take 16 (sucesionSumasDigitales 20)
--    [20,22,26,34,41,46,56,67,80,88,104,109,119,130,134,142]
sucesionSumasDigitales :: Integer -> [Integer]
sucesionSumasDigitales a =
  iterate siguienteSumaDigital a

-- (siguienteSumaDigital a) es el siguiente de a en la sucesión de sumas
-- digitales. Por ejemplo,
--    siguienteSumaDigital 23 == 28
siguienteSumaDigital :: Integer -> Integer
siguienteSumaDigital a =
  a + sum (digitos a)

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

-- La comparación es
--    λ> autonumeros !! 150
--    1502
--    (4.54 secs, 13,302,379,936 bytes)
--    λ> autonumeros2 !! 150
--    1502
--    (0.06 secs, 41,794,872 bytes)

-- 1ª solución

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

autonumeros :: [Integer]

autonumeros = filter autonumero [1..]

-- (autonumero n) se verifica si n es un autonúmero. Por ejemplo,

-- autonumero 5 == True

-- autonumero 21 == False

autonumero :: Integer -> Bool

autonumero n =

all (/=n) [k + sum (digitos k) | k <- [1..n]]

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

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

digitos :: Integer -> [Integer]

digitos a = [read [c] | c <-show a]

-- 2ª solución

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

autonumeros2 :: [Integer]

autonumeros2 = map head sucesionSucesionesSumasDigitales

-- sucesionSucesionesSumasDigitales es la lista de las sucesiones de

-- sumas parciales tal que el primer elemento de cada sucesión es el

-- menor elemento que no pertenece a las sucesiones anteriores. Por

-- ejemplo,

-- λ> map (take 4) (take 8 sucesionSucesionesSumasDigitales)

-- [[1,2,4,8],[3,6,12,15],[5,10,11,13],[7,14,19,29],

-- [9,18,27,36],[20,22,26,34],[31,35,43,50],[42,48,60,66]]

sucesionSucesionesSumasDigitales :: [[Integer]]

sucesionSucesionesSumasDigitales = aux [1..]

where aux xs = sucesion xs : aux (diferencia xs (sucesion xs))

sucesion xs = sucesionSumasDigitales (head xs)

-- (diferencia xs ys) es la diferencia las listas infinitas ordenadas

-- crecientes xs e ys. Por ejemplo,

-- λ> take 8 (diferencia [1..] [2,4..])

-- [1,3,5,7,9,11,13,15]

diferencia :: [Integer] -> [Integer] -> [Integer]

diferencia (x:xs) (y:ys)

| x == y = diferencia xs ys

| otherwise = x : diferencia xs (y:ys)

-- (sucesionSumasDigitales a) es la sucesión de las sumas digitales

-- definida por un número a. Por ejemplo,

-- λ> take 16 (sucesionSumasDigitales 1)

-- [1,2,4,8,16,23,28,38,49,62,70,77,91,101,103,107]

-- λ> take 16 (sucesionSumasDigitales 3)

-- [3,6,12,15,21,24,30,33,39,51,57,69,84,96,111,114]

-- λ> take 16 (sucesionSumasDigitales 5)

-- [5,10,11,13,17,25,32,37,47,58,71,79,95,109,119,130]

-- λ> take 16 (sucesionSumasDigitales 7)

-- [7,14,19,29,40,44,52,59,73,83,94,107,115,122,127,137]

-- λ> take 16 (sucesionSumasDigitales 9)

-- [9,18,27,36,45,54,63,72,81,90,99,117,126,135,144,153]

-- λ> take 16 (sucesionSumasDigitales 20)

-- [20,22,26,34,41,46,56,67,80,88,104,109,119,130,134,142]

sucesionSumasDigitales :: Integer -> [Integer]

sucesionSumasDigitales a =

iterate siguienteSumaDigital a

-- (siguienteSumaDigital a) es el siguiente de a en la sucesión de sumas

-- digitales. Por ejemplo,

-- siguienteSumaDigital 23 == 28

siguienteSumaDigital :: Integer -> Integer

siguienteSumaDigital a =

a + sum (digitos a)

-- Comparación de eficiencia

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

-- La comparación es

-- λ> autonumeros !! 150

-- 1502

-- (4.54 secs, 13,302,379,936 bytes)

-- λ> autonumeros2 !! 150

-- 1502

-- (0.06 secs, 41,794,872 bytes)

Nuevas soluciones

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

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>

Sucesiones de sumas digitales

PorJosé A. Alonso 26-marzo-20212-abril-2021

La sucesión de las sumas digitales definida por un número a es sucesión a(n) tal que a(0) = a y a(n+1) es la suma de a(n) y los dígitos de a(n). Por ejemplo, los primeros términos de la sucesión de las sumas digitales definida por 1 son

   1,2,4,8,16,23,28,38,49,62,70,77,91,101,103,107,...

1	1,2,4,8,16,23,28,38,49,62,70,77,91,101,103,107,...

Se observa que el menor número que no pertenece a la sucesión anterior es 3. Los primeros términos de la sucesión de las sumas digitales definida por 3 son

   3,6,12,15,21,24,30,33,39,51,57,69,84,96,111,114,...

1	3,6,12,15,21,24,30,33,39,51,57,69,84,96,111,114,...

Se observa que el menor número que no pertenece a las 2 anteriores es 5. Los primeros términos de la sucesión de las sumas digitales definida por 5 son

   5,10,11,13,17,25,32,37,47,58,71,79,95,109,119,130,...

1	5,10,11,13,17,25,32,37,47,58,71,79,95,109,119,130,...

Se observa que el menor número que no pertenece a las 3 sucesiones anteriores es 7. Los primeros términos de la sucesión de las sumas digitales definida por 7 son

   7,14,19,29,40,44,52,59,73,83,94,107,115,122,127,137,...

1	7,14,19,29,40,44,52,59,73,83,94,107,115,122,127,137,...

Se observa que el menor número que no pertenece a las 4 anteriores es 9. Los primeros términos de la sucesión de las sumas digitales definida por 9 son

   9,18,27,36,45,54,63,72,81,90,99,117,126,135,144,153,...

1	9,18,27,36,45,54,63,72,81,90,99,117,126,135,144,153,...

Se observa que el menor número que no pertenece a las 5 sucesiones anteriores es 20. Los primeros términos de la sucesión de las sumas digitales definida por 20 son

   20,22,26,34,41,46,56,67,80,88,104,109,119,130,134,142,...

1	20,22,26,34,41,46,56,67,80,88,104,109,119,130,134,142,...

Definir la función

   sucesionSucesionesSumasDigitales :: [[Integer]]

1	sucesionSucesionesSumasDigitales :: [[Integer]]

tal que sus elementos son las sucesiones de sumas parciales tal que el primer elemento de cada sucesión es el menor elemento que no pertenece a las sucesiones anteriores. Por ejemplo,

   λ> map (take 4) (take 8 sucesionSucesionesSumasDigitales)
   [[1,2,4,8],[3,6,12,15],[5,10,11,13],[7,14,19,29],
    [9,18,27,36],[20,22,26,34],[31,35,43,50],[42,48,60,66]]
   λ> take 10 (sucesionSucesionesSumasDigitales3 !! 1000)
   [10199,10219,10232,10240,10247,10261,10271,10282,10295,10312]

λ> map (take 4) (take 8 sucesionSucesionesSumasDigitales)

[[1,2,4,8],[3,6,12,15],[5,10,11,13],[7,14,19,29],

[9,18,27,36],[20,22,26,34],[31,35,43,50],[42,48,60,66]]

λ> take 10 (sucesionSucesionesSumasDigitales3 !! 1000)

[10199,10219,10232,10240,10247,10261,10271,10282,10295,10312]

Soluciones

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

sucesionSucesionesSumasDigitales :: [[Integer]]
sucesionSucesionesSumasDigitales =
  map aux [1..]
  where aux 1 = sucesionSumasDigitales 1
        aux n = sucesionSumasDigitales m
          where m = head [a | a <- [1..],
                              all (a `noPertenece`)
                                  [aux k | k <- [1..n-1]]]

-- (sucesionSumasDigitales a) es la sucesión de las sumas digitales
-- definida por un número a. Por ejemplo,
--    λ> take 16 (sucesionSumasDigitales 1)
--    [1,2,4,8,16,23,28,38,49,62,70,77,91,101,103,107]
--    λ> take 16 (sucesionSumasDigitales 3)
--    [3,6,12,15,21,24,30,33,39,51,57,69,84,96,111,114]
--    λ> take 16 (sucesionSumasDigitales 5)
--    [5,10,11,13,17,25,32,37,47,58,71,79,95,109,119,130]
--    λ> take 16 (sucesionSumasDigitales 7)
--    [7,14,19,29,40,44,52,59,73,83,94,107,115,122,127,137]
--    λ> take 16 (sucesionSumasDigitales 9)
--    [9,18,27,36,45,54,63,72,81,90,99,117,126,135,144,153]
--    λ> take 16 (sucesionSumasDigitales 20)
--    [20,22,26,34,41,46,56,67,80,88,104,109,119,130,134,142]
sucesionSumasDigitales :: Integer -> [Integer]
sucesionSumasDigitales a =
  iterate siguienteSumaDigital a

-- (siguienteSumaDigital a) es el siguiente de a en la sucesión de sumas
-- digitales. Por ejemplo,
--    siguienteSumaDigital 23 == 28
siguienteSumaDigital :: Integer -> Integer
siguienteSumaDigital a =
  a + sum (digitos a)

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

-- (noPertenece x ys) se verifica si x no pertenece a la lista infinita
-- ordenada creciente ys. Por ejemplo,
--    noPertenece 2 [1,3..] == True
--    noPertenece 5 [1,3..] == False
noPertenece :: Integer -> [Integer] -> Bool
noPertenece x ys =
  x < head (dropWhile (<x) ys)

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

sucesionSucesionesSumasDigitales2 :: [[Integer]]
sucesionSucesionesSumasDigitales2 =
  map sucesionSumasDigitales autonumeros

-- (autonumero n) se verifica si n es un autonúmero; es decir, números
-- que no se pueden escribir como la suma de un número k y los dígitos
-- de k. Por ejemplo,
--    autonumero 5  == True
--    autonumero 21 == False
autonumero :: Integer -> Bool
autonumero n =
  all (/=n) [k + sum (digitos k) | k <- [1..n]]

-- autonumeros es la lista de los autonúmeros. Por ejemplo,
--    λ> take 20 autonumeros
--    [1,3,5,7,9,20,31,42,53,64,75,86,97,108,110,121,132,143,154,165]
autonumeros :: [Integer]
autonumeros = filter autonumero [1..]

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

sucesionSucesionesSumasDigitales3 :: [[Integer]]
sucesionSucesionesSumasDigitales3 = aux [1..]
  where aux xs = sucesion xs : aux (diferencia xs (sucesion xs))
        sucesion xs = sucesionSumasDigitales (head xs)

-- (diferencia xs ys) es la diferencia las listas infinitas ordenadas
-- crecientes xs e ys. Por ejemplo,
--    λ> take 8 (diferencia [1..] [2,4..])
--    [1,3,5,7,9,11,13,15]
diferencia :: [Integer] -> [Integer] -> [Integer]
diferencia (x:xs) (y:ys)
  | x == y    = diferencia xs ys
  | otherwise = x : diferencia xs (y:ys)

-- 1ª solución

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

sucesionSucesionesSumasDigitales :: [[Integer]]

sucesionSucesionesSumasDigitales =

map aux [1..]

where aux 1 = sucesionSumasDigitales 1

aux n = sucesionSumasDigitales m

where m = head [a | a <- [1..],

all (a `noPertenece`)

[aux k | k <- [1..n-1]]]

-- (sucesionSumasDigitales a) es la sucesión de las sumas digitales

-- definida por un número a. Por ejemplo,

-- λ> take 16 (sucesionSumasDigitales 1)

-- [1,2,4,8,16,23,28,38,49,62,70,77,91,101,103,107]

-- λ> take 16 (sucesionSumasDigitales 3)

-- [3,6,12,15,21,24,30,33,39,51,57,69,84,96,111,114]

-- λ> take 16 (sucesionSumasDigitales 5)

-- [5,10,11,13,17,25,32,37,47,58,71,79,95,109,119,130]

-- λ> take 16 (sucesionSumasDigitales 7)

-- [7,14,19,29,40,44,52,59,73,83,94,107,115,122,127,137]

-- λ> take 16 (sucesionSumasDigitales 9)

-- [9,18,27,36,45,54,63,72,81,90,99,117,126,135,144,153]

-- λ> take 16 (sucesionSumasDigitales 20)

-- [20,22,26,34,41,46,56,67,80,88,104,109,119,130,134,142]

sucesionSumasDigitales :: Integer -> [Integer]

sucesionSumasDigitales a =

iterate siguienteSumaDigital a

-- (siguienteSumaDigital a) es el siguiente de a en la sucesión de sumas

-- digitales. Por ejemplo,

-- siguienteSumaDigital 23 == 28

siguienteSumaDigital :: Integer -> Integer

siguienteSumaDigital a =

a + sum (digitos a)

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

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

digitos :: Integer -> [Integer]

digitos a = [read [c] | c <-show a]

-- (noPertenece x ys) se verifica si x no pertenece a la lista infinita

-- ordenada creciente ys. Por ejemplo,

-- noPertenece 2 [1,3..] == True

-- noPertenece 5 [1,3..] == False

noPertenece :: Integer -> [Integer] -> Bool

noPertenece x ys =

x < head (dropWhile (<x) ys)

-- 2ª solución

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

sucesionSucesionesSumasDigitales2 :: [[Integer]]

sucesionSucesionesSumasDigitales2 =

map sucesionSumasDigitales autonumeros

-- (autonumero n) se verifica si n es un autonúmero; es decir, números

-- que no se pueden escribir como la suma de un número k y los dígitos

-- de k. Por ejemplo,

-- autonumero 5 == True

-- autonumero 21 == False

autonumero :: Integer -> Bool

autonumero n =

all (/=n) [k + sum (digitos k) | k <- [1..n]]

-- autonumeros es la lista de los autonúmeros. Por ejemplo,

-- λ> take 20 autonumeros

-- [1,3,5,7,9,20,31,42,53,64,75,86,97,108,110,121,132,143,154,165]

autonumeros :: [Integer]

autonumeros = filter autonumero [1..]

-- 3ª solución

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

sucesionSucesionesSumasDigitales3 :: [[Integer]]

sucesionSucesionesSumasDigitales3 = aux [1..]

where aux xs = sucesion xs : aux (diferencia xs (sucesion xs))

sucesion xs = sucesionSumasDigitales (head xs)

-- (diferencia xs ys) es la diferencia las listas infinitas ordenadas

-- crecientes xs e ys. Por ejemplo,

-- λ> take 8 (diferencia [1..] [2,4..])

-- [1,3,5,7,9,11,13,15]

diferencia :: [Integer] -> [Integer] -> [Integer]

diferencia (x:xs) (y:ys)

| x == y = diferencia xs ys

| otherwise = x : diferencia xs (y:ys)

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>

Coste del recorrido ordenado

PorJosé A. Alonso 25-marzo-20211-abril-2021

El coste de visitar los elementos de la lista [4,3,2,5,1] de manera creciente empezando en el primer elemento y siendo el coste de dada paso el valor absoluto de la diferencia de las posiciones se calcula de la siguiente manera

Coste de 4 a 1 = |0-4| = 4
Coste de 1 a 2 = |4-2| = 2
Coste de 2 a 3 = |2-1| = 1
Coste de 3 a 4 = |1-0| = 1
Coste de 4 a 5 = |0-3| = 3

Por tanto, el coste del recorrido es 4+2+1+1+3 = 11.

Definir la función coste :: Ord a => [a] -> Int tal que (coste xs) es el coste de visitar los elementos de xs de manera creciente empezando en el primer elemento y siendo el coste de dada paso el valor absoluto de la diferencia de las posiciones (se supone que los elementos de xs son distintos). Por ejemplo,

   coste [4,3,2,5,1] ==  11
   coste "betis"     ==  6

1 2	coste [4,3,2,5,1] == 11 coste "betis" == 6

Soluciones

import Data.List (sort)

coste :: Ord  a => [a] -> Int
coste xs =
  sum [abs (i-j) | (i,j) <- zip aux (tail aux)]
  where aux = recorrido xs

-- (recorrido xs) esla lista de las posiciones al visitar los elementos
-- de xs de manera creciente empezando en el primer elemento. Por
-- ejemplo,
--    recorrido [4,3,2,5,1] == [0,4,2,1,0,3]
recorrido :: Ord  a => [a] -> [Int]
recorrido xs =
  0 : map snd (sort (zip xs [0..]))

import Data.List (sort)

coste :: Ord a => [a] -> Int

coste xs =

sum [abs (i-j) | (i,j) <- zip aux (tail aux)]

where aux = recorrido xs

-- (recorrido xs) esla lista de las posiciones al visitar los elementos

-- de xs de manera creciente empezando en el primer elemento. Por

-- ejemplo,

-- recorrido [4,3,2,5,1] == [0,4,2,1,0,3]

recorrido :: Ord a => [a] -> [Int]

recorrido xs =

0 : map snd (sort (zip xs [0..]))

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>

Mínimo número de divisiones para igualar

PorJosé A. Alonso 24-marzo-202131-marzo-2021

El mínimo número de divisiones por 2, 3 ó 5 que hay que realizar igualar 15 y 20 es 6. En efecto, 15 se reduce a 5 dividiéndolo por 3 y 20 se reduce a 5 diviéndolo dos veces por 2.

Definir la función

   minimoNumeroDivisiones :: Integer -> Integer -> Maybe Int

1	minimoNumeroDivisiones :: Integer -> Integer -> Maybe Int

tal que (minimoNumeroDivisiones x y) es justamente el mínimo número de divisiones por 2, 3 ó 5 que hay que realizar para igualar x e y, o Nothing si no se pueden igualar. Por ejemplo,

   minimoNumeroDivisiones 15 20       ==  Just 3
   minimoNumeroDivisiones 15 15       ==  Just 0
   minimoNumeroDivisiones 15 16       ==  Just 6
   minimoNumeroDivisiones 15 17       ==  Nothing
   minimoNumeroDivisiones (10^99) 21  ==  Nothing

minimoNumeroDivisiones 15 20 == Just 3

minimoNumeroDivisiones 15 15 == Just 0

minimoNumeroDivisiones 15 16 == Just 6

minimoNumeroDivisiones 15 17 == Nothing

minimoNumeroDivisiones (10^99) 21 == Nothing

Soluciones

import Data.List (group, intersect, nub, sort)
import Data.Maybe (fromJust, isNothing, listToMaybe)
import Data.Numbers.Primes (primeFactors)
import Data.Tree (Tree (Node), flatten, levels)
import Test.QuickCheck (Property, (==>), quickCheck)

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

minimoNumeroDivisiones :: Integer -> Integer -> Maybe Int
minimoNumeroDivisiones x y
  | isNothing a = Nothing
  | otherwise   = Just (fst (fromJust a))
  where a = minimoNumeroDivisionesAux x y

-- La definición anterior se puede simplificar
minimoNumeroDivisiones' :: Integer -> Integer -> Maybe Int
minimoNumeroDivisiones' x y =
  Just fst <*> minimoNumeroDivisionesAux x y

-- (minimoNumeroDivisiones x y) es justamente el par formado por el
-- mínimo número de divisiones por 2, 3 ó 5 que hay que realizar para
-- igualar x e y junto con el número al que se reducen, o Nothing si no
-- se pueden igualar. Por ejemplo,
--    minimoNumeroDivisionesAux 15 20  ==  Just (3,5)
--    minimoNumeroDivisionesAux 15 15  ==  Just (0,15)
--    minimoNumeroDivisionesAux 15 16  ==  Just (6,1)
--    minimoNumeroDivisionesAux 15 17  ==  Nothing
minimoNumeroDivisionesAux :: Integer -> Integer -> Maybe (Int,Integer)
minimoNumeroDivisionesAux x y
  | null as   = Nothing
  | otherwise = Just (head as)
  where as = sort [(m+n,z) | (z,(m,n)) <- minimasProfundidadesComunes x y]

-- La definición anterior se puede simplificar
minimoNumeroDivisionesAux2 :: Integer -> Integer -> Maybe (Int,Integer)
minimoNumeroDivisionesAux2 x y =
  listToMaybe (sort [(m+n,z) | (z,(m,n)) <- minimasProfundidadesComunes x y])

-- (arbolDivisiones x) es el árbol de las divisiones enteras de x entre
-- 2, 3 ó 5. Por ejemplo,
--    λ> putStrLn (drawTree (fmap show (arbolDivisiones 30)))
--    30
--    |
--    +- 15
--    |  |
--    |  +- 5
--    |  |  |
--    |  |  `- 1
--    |  |
--    |  `- 3
--    |     |
--    |     `- 1
--    |
--    +- 10
--    |  |
--    |  +- 5
--    |  |  |
--    |  |  `- 1
--    |  |
--    |  `- 2
--    |     |
--    |     `- 1
--    |
--    `- 6
--       |
--       +- 3
--       |  |
--       |  `- 1
--       |
--       `- 2
--          |
--          `- 1
arbolDivisiones :: Integer -> Tree Integer
arbolDivisiones x =
  Node x (map arbolDivisiones (divisiones x))

-- (divisiones x) es la lista de las divisiones enteras de x entre 2, 3
-- y 5. Por ejemplo,
--    divisiones 30  ==  [15,10,6]
--    divisiones 15  ==  [5,3]
divisiones :: Integer -> [Integer]
divisiones x =
  [x `div` y | y <- [2,3,5], x `mod` y == 0]

-- (nodos a) es el conjunto de nodos del árbol a. Por ejemplo,
--    nodos (Node 2 [Node 2 [], Node 5 []])  ==  [2,5]
--    nodos (arbolDivisiones 30)  ==  [30,15,5,1,3,10,2,6]
nodos :: Tree Integer -> [Integer]
nodos = nub . flatten

-- (divisionesComunes x y) es la lista de los nodos comunes de los
-- árboles de las divisiones de x e y entre 2, 3 ó 5. Por ejemplo,
--    divisionesComunes 15 20  ==  [5,1]
divisionesComunes :: Integer -> Integer -> [Integer]
divisionesComunes x y =
  nodos (arbolDivisiones x) `intersect` nodos (arbolDivisiones y)

-- (minimaProfundidad x ns) es justamente la mínima produndidad
-- donde aparece x en el árbol ns, si aparece y Nothing, en caso
-- contrario. Por ejemplo,minimaProfundidad :: Ord a => a -> Tree a -> Maybe Int
--    λ> minimaProfundidad 3 (Node 1 [Node 6 [],Node 3 [Node 1 []]])
--    Just 1
--    λ> minimaProfundidad 4 (Node 1 [Node 6 [],Node 3 [Node 1 []]])
--    Nothing
minimaProfundidad :: Ord a => a -> Tree a -> Maybe Int
minimaProfundidad x ns =
  listToMaybe [z | (z,ys) <- zip [0..] (levels ns), x `elem` ys]

-- (minimasProfundidadesComunes x e y) es la lista de pares formadas por
-- los nodos comunes de los árboles de las divisiones de x e y entre 2,
-- 3 ó 5 junto con las mínimas profundidades en cada uno de los
-- árboles. Por ejemplo,
--    minimasProfundidadesComunes 15 20  ==  [(5,(1,2)),(1,(2,3))]
--    minimasProfundidadesComunes 15 22  ==  []
minimasProfundidadesComunes :: Integer -> Integer -> [(Integer,(Int,Int))]
minimasProfundidadesComunes x1 x2 =
  [(c,(fromJust (minimaProfundidad c a1), fromJust (minimaProfundidad c a2)))
  | c <- cs]
  where a1 = arbolDivisiones x1
        a2 = arbolDivisiones x2
        cs = divisionesComunes x1 x2

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

-- El mínimo número de divisiones se alcanza en el máximo común divisor.
prop_minimoNumeroDivisiones :: Integer -> Integer -> Property
prop_minimoNumeroDivisiones x y =
  x > 0 && y > 0 ==>
  isNothing a || snd (fromJust a) == gcd x y
  where a = minimoNumeroDivisionesAux x y

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

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

minimoNumeroDivisiones2 :: Integer -> Integer -> Maybe Int
minimoNumeroDivisiones2 x y
  | as' == bs' = Just (sum [abs (a - b) | (a,b) <- zip as bs])
  | otherwise  = Nothing
  where (as,as') = factorizacion x
        (bs,bs') = factorizacion y

-- (factorización n) es la lista de pares cuya primera componente es la
-- lista de los exponentes de 2, 3 y 5 en la factorización de n y la
-- segunda esla lista delos restantes divisores primos. Por ejemplo,
--    factorizacion 15   ==  ([0,1,1],[])
--    factorizacion 20   ==  ([2,0,1],[])
--    factorizacion 17   ==  ([0,0,0],[17])
--    factorizacion 147  ==  ([0,1,0],[7,7])
factorizacion :: Integer -> ([Int],[Integer])
factorizacion n =
  (map length [bs,cs,ds], es)
  where as = primeFactors n
        (bs,bs') = span (==2) as
        (cs,cs') = span (==3) bs'
        (ds,es)  = span (==5) cs'

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

-- La propies de la equivalencia de las dos definiciones es
prop_equivalencia :: Integer -> Integer -> Property
prop_equivalencia x y =
  x > 0 && y > 0 ==>
  minimoNumeroDivisiones x y == minimoNumeroDivisiones2 x y

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

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

--    λ> minimoNumeroDivisiones (10^11) (3^10*7)
--    Nothing
--    (6.08 secs, 2,725,931,872 bytes)
--    λ> minimoNumeroDivisiones2(10^11) (3^10*7)
--    Nothing
--    (0.01 secs, 128,944 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

168

169

170

171

172

173

174

175

176

177

178

179

180

181

182

183

184

import Data.List (group, intersect, nub, sort)

import Data.Maybe (fromJust, isNothing, listToMaybe)

import Data.Numbers.Primes (primeFactors)

import Data.Tree (Tree (Node), flatten, levels)

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

-- 1ª solución

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

minimoNumeroDivisiones :: Integer -> Integer -> Maybe Int

minimoNumeroDivisiones x y

| isNothing a = Nothing

| otherwise = Just (fst (fromJust a))

where a = minimoNumeroDivisionesAux x y

-- La definición anterior se puede simplificar

minimoNumeroDivisiones' :: Integer -> Integer -> Maybe Int

minimoNumeroDivisiones' x y =

Just fst <*> minimoNumeroDivisionesAux x y

-- (minimoNumeroDivisiones x y) es justamente el par formado por el

-- mínimo número de divisiones por 2, 3 ó 5 que hay que realizar para

-- igualar x e y junto con el número al que se reducen, o Nothing si no

-- se pueden igualar. Por ejemplo,

-- minimoNumeroDivisionesAux 15 20 == Just (3,5)

-- minimoNumeroDivisionesAux 15 15 == Just (0,15)

-- minimoNumeroDivisionesAux 15 16 == Just (6,1)

-- minimoNumeroDivisionesAux 15 17 == Nothing

minimoNumeroDivisionesAux :: Integer -> Integer -> Maybe (Int,Integer)

minimoNumeroDivisionesAux x y

| null as = Nothing

| otherwise = Just (head as)

where as = sort [(m+n,z) | (z,(m,n)) <- minimasProfundidadesComunes x y]

-- La definición anterior se puede simplificar

minimoNumeroDivisionesAux2 :: Integer -> Integer -> Maybe (Int,Integer)

minimoNumeroDivisionesAux2 x y =

listToMaybe (sort [(m+n,z) | (z,(m,n)) <- minimasProfundidadesComunes x y])

-- (arbolDivisiones x) es el árbol de las divisiones enteras de x entre

-- 2, 3 ó 5. Por ejemplo,

-- λ> putStrLn (drawTree (fmap show (arbolDivisiones 30)))

-- 30

-- |

-- +- 15

-- | |

-- | +- 5

-- | | |

-- | | `- 1

-- | |

-- | `- 3

-- | |

-- | `- 1

-- |

-- +- 10

-- | |

-- | +- 5

-- | | |

-- | | `- 1

-- | |

-- | `- 2

-- | |

-- | `- 1

-- |

-- `- 6

-- |

-- +- 3

-- | |

-- | `- 1

-- |

-- `- 2

-- |

-- `- 1

arbolDivisiones :: Integer -> Tree Integer

arbolDivisiones x =

Node x (map arbolDivisiones (divisiones x))

-- (divisiones x) es la lista de las divisiones enteras de x entre 2, 3

-- y 5. Por ejemplo,

-- divisiones 30 == [15,10,6]

-- divisiones 15 == [5,3]

divisiones :: Integer -> [Integer]

divisiones x =

[x `div` y | y <- [2,3,5], x `mod` y == 0]

-- (nodos a) es el conjunto de nodos del árbol a. Por ejemplo,

-- nodos (Node 2 [Node 2 [], Node 5 []]) == [2,5]

-- nodos (arbolDivisiones 30) == [30,15,5,1,3,10,2,6]

nodos :: Tree Integer -> [Integer]

nodos = nub . flatten

-- (divisionesComunes x y) es la lista de los nodos comunes de los

-- árboles de las divisiones de x e y entre 2, 3 ó 5. Por ejemplo,

-- divisionesComunes 15 20 == [5,1]

divisionesComunes :: Integer -> Integer -> [Integer]

divisionesComunes x y =

nodos (arbolDivisiones x) `intersect` nodos (arbolDivisiones y)

-- (minimaProfundidad x ns) es justamente la mínima produndidad

-- donde aparece x en el árbol ns, si aparece y Nothing, en caso

-- contrario. Por ejemplo,minimaProfundidad :: Ord a => a -> Tree a -> Maybe Int

-- λ> minimaProfundidad 3 (Node 1 [Node 6 [],Node 3 [Node 1 []]])

-- Just 1

-- λ> minimaProfundidad 4 (Node 1 [Node 6 [],Node 3 [Node 1 []]])

-- Nothing

minimaProfundidad :: Ord a => a -> Tree a -> Maybe Int

minimaProfundidad x ns =

listToMaybe [z | (z,ys) <- zip [0..] (levels ns), x `elem` ys]

-- (minimasProfundidadesComunes x e y) es la lista de pares formadas por

-- los nodos comunes de los árboles de las divisiones de x e y entre 2,

-- 3 ó 5 junto con las mínimas profundidades en cada uno de los

-- árboles. Por ejemplo,

-- minimasProfundidadesComunes 15 20 == [(5,(1,2)),(1,(2,3))]

-- minimasProfundidadesComunes 15 22 == []

minimasProfundidadesComunes :: Integer -> Integer -> [(Integer,(Int,Int))]

minimasProfundidadesComunes x1 x2 =

[(c,(fromJust (minimaProfundidad c a1), fromJust (minimaProfundidad c a2)))

| c <- cs]

where a1 = arbolDivisiones x1

a2 = arbolDivisiones x2

cs = divisionesComunes x1 x2

-- Propiedad

-- =========

-- El mínimo número de divisiones se alcanza en el máximo común divisor.

prop_minimoNumeroDivisiones :: Integer -> Integer -> Property

prop_minimoNumeroDivisiones x y =

x > 0 && y > 0 ==>

isNothing a || snd (fromJust a) == gcd x y

where a = minimoNumeroDivisionesAux x y

-- La comprobación es

-- λ> quickCheck prop_minimoNumeroDivisiones

-- +++ OK, passed 100 tests.

-- 2ª solución

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

minimoNumeroDivisiones2 :: Integer -> Integer -> Maybe Int

minimoNumeroDivisiones2 x y

| as' == bs' = Just (sum [abs (a - b) | (a,b) <- zip as bs])

| otherwise = Nothing

where (as,as') = factorizacion x

(bs,bs') = factorizacion y

-- (factorización n) es la lista de pares cuya primera componente es la

-- lista de los exponentes de 2, 3 y 5 en la factorización de n y la

-- segunda esla lista delos restantes divisores primos. Por ejemplo,

-- factorizacion 15 == ([0,1,1],[])

-- factorizacion 20 == ([2,0,1],[])

-- factorizacion 17 == ([0,0,0],[17])

-- factorizacion 147 == ([0,1,0],[7,7])

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

factorizacion n =

(map length [bs,cs,ds], es)

where as = primeFactors n

(bs,bs') = span (==2) as

(cs,cs') = span (==3) bs'

(ds,es) = span (==5) cs'

-- Equivalencia

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

-- La propies de la equivalencia de las dos definiciones es

prop_equivalencia :: Integer -> Integer -> Property

prop_equivalencia x y =

x > 0 && y > 0 ==>

minimoNumeroDivisiones x y == minimoNumeroDivisiones2 x y

-- La comprobación es

-- λ> quickCheck prop_equivalencia

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- λ> minimoNumeroDivisiones (10^11) (3^10*7)

-- Nothing

-- (6.08 secs, 2,725,931,872 bytes)

-- λ> minimoNumeroDivisiones2(10^11) (3^10*7)

-- Nothing

-- (0.01 secs, 128,944 bytes)

Nuevas soluciones

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

Mínima profundidad

PorJosé A. Alonso 23-marzo-202130-marzo-2021

En la librería Data.Tree se definen los árboles y los bosques como sigue

   data Tree a   = Node a (Forest a)
   type Forest a = [Tree a]

1 2	data Tree a = Node a (Forest a) type Forest a = [Tree a]

Por ejemplo, los árboles

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

1 3

/ \ /|\

6 3 / | \

| 5 4 7

1 | /\

3 6 5

se representan por

   ej1, ej2 :: Tree Int
   ej1 = Node 1 [Node 6 [],Node 3 [Node 1 []]]
   ej2 = Node 3 [Node 5 [Node 3 []], Node 4 [], Node 7 [Node 6 [], Node 5 []]]

ej1, ej2 :: Tree Int

ej1 = Node 1 [Node 6 [],Node 3 [Node 1 []]]

ej2 = Node 3 [Node 5 [Node 3 []], Node 4 [], Node 7 [Node 6 [], Node 5 []]]

Definir la función

    minimaProfundidad :: Ord a => a -> Tree a -> Maybe Int

1	minimaProfundidad :: Ord a => a -> Tree a -> Maybe Int

tal que (minimaProfundidad x ns) es justamente la mínima donde aparece x en el árbol ns, si aparece y Nothing, en caso contrario. Por ejemplo,

    minimaProfundidad 1 ej1  ==  Just 0
    minimaProfundidad 3 ej1  ==  Just 1
    minimaProfundidad 2 ej1  ==  Nothing
    minimaProfundidad 3 ej2  ==  Just 0
    minimaProfundidad 4 ej2  ==  Just 1
    minimaProfundidad 6 ej2  ==  Just 2
    minimaProfundidad 9 ej2  ==  Nothing

minimaProfundidad 1 ej1 == Just 0

minimaProfundidad 3 ej1 == Just 1

minimaProfundidad 2 ej1 == Nothing

minimaProfundidad 3 ej2 == Just 0

minimaProfundidad 4 ej2 == Just 1

minimaProfundidad 6 ej2 == Just 2

minimaProfundidad 9 ej2 == Nothing

Soluciones

import Data.Tree (Tree (Node), levels)
import Data.Maybe (isNothing, fromJust, listToMaybe)

ej1, ej2 :: Tree Int
ej1 = Node 1 [Node 6 [],Node 3 [Node 1 []]]
ej2 = Node 3 [Node 5 [Node 3 []], Node 4 [], Node 7 [Node 6 [], Node 5 []]]

-- 1ª definición
minimaProfundidad1 :: Ord a => a -> Tree a -> Maybe Int
minimaProfundidad1 x (Node y ns)
  | x == y    = Just 0
  | null zs   = Nothing
  | otherwise = Just (1 + minimum zs)
  where zs = [z | Just z <- filter (/=Nothing) (map (minimaProfundidad1 x) ns)]

-- 2ª definición
minimaProfundidad2 :: Ord a => a -> Tree a -> Maybe Int
minimaProfundidad2 x (Node y ns)
  | x == y       = Just 0
  | z == Nothing = Nothing
  | otherwise    = Just (1 + fromJust z)
  where z = minimum (map (minimaProfundidad2 x) ns)

-- 3ª definición
minimaProfundidad3 :: Ord a => a -> Tree a -> Maybe Int
minimaProfundidad3 x (Node y ns)
  | x == y       = Just 0
  | otherwise    = Just (+1) <*> minimum (map (minimaProfundidad3 x) ns)

-- 4ª definición
minimaProfundidad4 :: Ord a => a -> Tree a -> Maybe Int
minimaProfundidad4 x ns
  | null zs   = Nothing
  | otherwise = Just (head zs)
  where zs = [z | (z,ys) <- zip [0..] (levels ns), x `elem` ys]

-- 5ª definición
minimaProfundidad5 :: Ord a => a -> Tree a -> Maybe Int
minimaProfundidad5 x ns =
  listToMaybe [z | (z,ys) <- zip [0..] (levels ns), x `elem` ys]

import Data.Tree (Tree (Node), levels)

import Data.Maybe (isNothing, fromJust, listToMaybe)

ej1, ej2 :: Tree Int

ej1 = Node 1 [Node 6 [],Node 3 [Node 1 []]]

ej2 = Node 3 [Node 5 [Node 3 []], Node 4 [], Node 7 [Node 6 [], Node 5 []]]

-- 1ª definición

minimaProfundidad1 :: Ord a => a -> Tree a -> Maybe Int

minimaProfundidad1 x (Node y ns)

| x == y = Just 0

| null zs = Nothing

| otherwise = Just (1 + minimum zs)

where zs = [z | Just z <- filter (/=Nothing) (map (minimaProfundidad1 x) ns)]

-- 2ª definición

minimaProfundidad2 :: Ord a => a -> Tree a -> Maybe Int

minimaProfundidad2 x (Node y ns)

| x == y = Just 0

| z == Nothing = Nothing

| otherwise = Just (1 + fromJust z)

where z = minimum (map (minimaProfundidad2 x) ns)

-- 3ª definición

minimaProfundidad3 :: Ord a => a -> Tree a -> Maybe Int

minimaProfundidad3 x (Node y ns)

| x == y = Just 0

| otherwise = Just (+1) <*> minimum (map (minimaProfundidad3 x) ns)

-- 4ª definición

minimaProfundidad4 :: Ord a => a -> Tree a -> Maybe Int

minimaProfundidad4 x ns

| null zs = Nothing

| otherwise = Just (head zs)

where zs = [z | (z,ys) <- zip [0..] (levels ns), x `elem` ys]

-- 5ª definición

minimaProfundidad5 :: Ord a => a -> Tree a -> Maybe Int

minimaProfundidad5 x ns =

listToMaybe [z | (z,ys) <- zip [0..] (levels ns), x `elem` ys]

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>

Árbol de las divisiones por 2, 3 ó 5

PorJosé A. Alonso 22-marzo-202129-marzo-2021

En la librería Data.Tree se definen los árboles y los bosques como sigue

   data Tree a   = Node a (Forest a)
   type Forest a = [Tree a]

1 2	data Tree a = Node a (Forest a) type Forest a = [Tree a]

Se pueden definir árboles. Por ejemplo,

   ej = Node 3 [Node 5 [Node 9 []], Node 7 []]

1	ej = Node 3 [Node 5 [Node 9 []], Node 7 []]

Y se pueden dibujar con la función drawTree. Por ejemplo,

   λ> putStrLn (drawTree (fmap show ej))
   3
   |
   +- 5
   |  |
   |  `- 9
   |
   `- 7

λ> putStrLn (drawTree (fmap show ej))

+- 5

| |

| `- 9

`- 7

Definir la función

   arbolDivisiones :: Int -> Tree Int

1	arbolDivisiones :: Int -> Tree Int

tal que (arbolDivisiones x) es el árbol de las divisiones enteras de x entre 2, 3 ó 5. Por ejemplo,

   λ> putStrLn (drawTree (fmap show (arbolDivisiones 20)))
   20
   |
   +- 10
   |  |
   |  +- 5
   |  |  |
   |  |  `- 1
   |  |
   |  `- 2
   |     |
   |     `- 1
   |
   `- 4
      |
      `- 2
         |
         `- 1

   λ> putStrLn (drawTree (fmap show (arbolDivisiones 30)))
   30
   |
   +- 15
   |  |
   |  +- 5
   |  |  |
   |  |  `- 1
   |  |
   |  `- 3
   |     |
   |     `- 1
   |
   +- 10
   |  |
   |  +- 5
   |  |  |
   |  |  `- 1
   |  |
   |  `- 2
   |     |
   |     `- 1
   |
   `- 6
      |
      +- 3
      |  |
      |  `- 1
      |
      `- 2
         |
         `- 1

λ> putStrLn (drawTree (fmap show (arbolDivisiones 20)))

+- 10

| |

| +- 5

| | |

| | `- 1

| |

| `- 2

| |

| `- 1

`- 4

`- 2

`- 1

λ> putStrLn (drawTree (fmap show (arbolDivisiones 30)))

+- 15

| |

| +- 5

| | |

| | `- 1

| |

| `- 3

| |

| `- 1

+- 10

| |

| +- 5

| | |

| | `- 1

| |

| `- 2

| |

| `- 1

`- 6

+- 3

| |

| `- 1

`- 2

`- 1

Soluciones

import Data.Tree (Tree (Node), drawTree)

arbolDivisiones :: Int -> Tree Int
arbolDivisiones x =
  Node x (map arbolDivisiones (divisiones x))

-- (divisiones x) es la lista de las divisiones enteras de x entre 2, 3
-- y 5. Por ejemplo,
--    divisiones 30  ==  [15,10,6]
--    divisiones 15  ==  [5,3]
divisiones :: Int -> [Int]
divisiones x =
  [x `div` y | y <- [2,3,5], x `mod` y == 0]

import Data.Tree (Tree (Node), drawTree)

arbolDivisiones :: Int -> Tree Int

arbolDivisiones x =

Node x (map arbolDivisiones (divisiones x))

-- (divisiones x) es la lista de las divisiones enteras de x entre 2, 3

-- y 5. Por ejemplo,

-- divisiones 30 == [15,10,6]

-- divisiones 15 == [5,3]

divisiones :: Int -> [Int]

divisiones x =

[x `div` y | y <- [2,3,5], x `mod` y == 0]

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>

Cálculo de pi mediante la fórmula de Beeler

PorJosé A. Alonso 19-marzo-202126-marzo-2021

El pasado 12 de marzo se publicó en Twitter un mensaje con una fórmula de Beeler para el cálculo de pi

Los primeros valores son

   λ> 2*1
   2
   λ> 2*(1+1/3)
   2.6666666666666665
   λ> 2*(1+1/3+(1*2)/(3*5))
   2.933333333333333
   λ> 2*(1+1/3+(1*2)/(3*5)+(1*2*3)/(3*5*7))
   3.0476190476190474
   λ> 2*(1+1/3+(1*2)/(3*5)+(1*2*3)/(3*5*7)+(1*2*3*4)/(3*5*7*9))
   3.098412698412698

λ> 2*1

λ> 2*(1+1/3)

2.6666666666666665

λ> 2*(1+1/3+(1*2)/(3*5))

2.933333333333333

λ> 2*(1+1/3+(1*2)/(3*5)+(1*2*3)/(3*5*7))

3.0476190476190474

λ> 2*(1+1/3+(1*2)/(3*5)+(1*2*3)/(3*5*7)+(1*2*3*4)/(3*5*7*9))

3.098412698412698

Definir las funciones

   aproximacionPi :: Int -> Double
   grafica        :: [Int] -> IO ()

1 2	aproximacionPi :: Int -> Double grafica :: [Int] -> IO ()

tales que

(aproximacionPi n) es la n-ésima aproximación de pi con la fórmula de Beeler. Por ejemplo,

     aproximacionPi 0    ==  2.0
     aproximacionPi 1    ==  2.6666666666666665
     aproximacionPi 2    ==  2.933333333333333
     aproximacionPi 3    ==  3.0476190476190474
     aproximacionPi 4    ==  3.098412698412698
     aproximacionPi 10   ==  3.141106021601377
     aproximacionPi 100  ==  3.1415926535897922
     pi                  ==  3.141592653589793

aproximacionPi 0 == 2.0

aproximacionPi 1 == 2.6666666666666665

aproximacionPi 2 == 2.933333333333333

aproximacionPi 3 == 3.0476190476190474

aproximacionPi 4 == 3.098412698412698

aproximacionPi 10 == 3.141106021601377

aproximacionPi 100 == 3.1415926535897922

pi == 3.141592653589793

(grafica xs) dibuja la gráfica de las k-ésimas aproximaciones de pi para k en xs. Por ejemplo, (grafica [0..99]) dibuja

Soluciones

import Graphics.Gnuplot.Simple (Attribute (Key, PNG), plotList)

aproximacionPi :: Int -> Double
aproximacionPi n =
  aproximacionesPi !! n

aproximacionesPi :: [Double]
aproximacionesPi =
  map (*2) (scanl1 (+) (1 : scanl1 (*) [(x/y) | (x,y) <- zip [1..] [3,5..]]))


-- Gráfica
-- =======

grafica :: [Int] -> IO ()
grafica xs =
  plotList [ Key Nothing
           -- , PNG "Calculo_de_pi_mediante_la_formula_de_Beeler_1.png"
           ]
           [(k,aproximacionPi k) | k <- xs]

import Graphics.Gnuplot.Simple (Attribute (Key, PNG), plotList)

aproximacionPi :: Int -> Double

aproximacionPi n =

aproximacionesPi !! n

aproximacionesPi :: [Double]

aproximacionesPi =

map (*2) (scanl1 (+) (1 : scanl1 (*) [(x/y) | (x,y) <- zip [1..] [3,5..]]))

-- Gráfica

-- =======

grafica :: [Int] -> IO ()

grafica xs =

plotList [ Key Nothing

-- , PNG "Calculo_de_pi_mediante_la_formula_de_Beeler_1.png"

]

[(k,aproximacionPi k) | k <- xs]

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úmeros ordenados con cuadrados ordenados

PorJosé A. Alonso 18-marzo-202125-marzo-2021

Un número es ordenado si cada uno de sus dígitos es menor o igual el siguiente dígito. Por ejemplo, 116 es un número creciente y su cuadrado es 13456, que también es ordenado. En cambio, 115 es ordenado pero su cuadrado es 13225 que no es ordenado.

Definir la lista

   numerosOrdenadosConCuadradosOrdenados :: [Integer]

1	numerosOrdenadosConCuadradosOrdenados :: [Integer]

cuyos elementos son los números ordenados cuyos cuadrados también lo son. Por ejemplo,

   λ> take 20 numerosOrdenadosConCuadradosOrdenados
   [0,1,2,3,4,5,6,7,12,13,15,16,17,34,35,37,38,67,116,117]
   λ> length (show (numerosOrdenadosConCuadradosOrdenados !! (10^6)))
   1411
   λ> length (show (numerosOrdenadosConCuadradosOrdenados !! (5*10^6)))
   3159

λ> take 20 numerosOrdenadosConCuadradosOrdenados

[0,1,2,3,4,5,6,7,12,13,15,16,17,34,35,37,38,67,116,117]

λ> length (show (numerosOrdenadosConCuadradosOrdenados !! (10^6)))

1411

λ> length (show (numerosOrdenadosConCuadradosOrdenados !! (5*10^6)))

3159

Soluciones

import Data.List

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

numerosOrdenadosConCuadradosOrdenados :: [Integer]
numerosOrdenadosConCuadradosOrdenados =
  filter numeroOrdenadoConCuadradoOrdenado [0..]

-- (numeroOrdenadoConCuadradoOrdenado n) se verifica si n es un número
-- ordenado cuyo cuadrado también lo es. Por ejemplo,
--    numeroOrdenadoConCuadradoOrdenado 116  ==  True
--    numeroOrdenadoConCuadradoOrdenado 115  ==  False
numeroOrdenadoConCuadradoOrdenado :: Integer -> Bool
numeroOrdenadoConCuadradoOrdenado n =
  ordenado n && ordenado (n^2)

-- (ordenado n) se verifica si n es un número ordenado. Por ejemplo,
--    ordenado 115  ==  True
--    ordenado 151  ==  False
ordenado :: Integer -> Bool
ordenado n =
  and [x <= y | (x,y) <- zip xs (tail xs)]
  where xs = show n

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

-- Se basa en la observación de los sisuientes cálculos con la primera
-- solución
--    λ> take 30 numerosOrdenadosConCuadradosOrdenados
--    [0,1,2,3,4,5,6,7,12,13,15,16,17,34,35,37,38,67,116,117,
--     167,334,335,337,367,667,1667,3334,3335,3337]
--    λ> take 21 (dropWhile (<= 117) numerosOrdenadosConCuadradosOrdenados)
--    [167,334,335,337,367,667,
--     1667,3334,3335,3337,3367,3667,6667,
--     16667,33334,33335,33337,33367,33667,36667,66667]
--
-- Se observa que a partir del 167 todos los elementos son de 4 tipos
-- como se ve en la siguente tabla
--    |-------+--------+--------+--------+--------|
--    |       | Tipo A | Tipo B | Tipo C | Tipo D |
--    |-------+--------+--------+--------+--------|
--    |   167 | 16¹7   |        |        |        |
--    |   334 |        | 3²4    |        |        |
--    |   335 |        |        | 3²5    |        |
--    |   337 |        |        |        | 3²6⁰7  |
--    |   367 |        |        |        | 3¹6¹7  |
--    |   667 |        |        |        | 3⁰6²7  |
--    |  1667 | 16²7   |        |        |        |
--    |  3334 |        | 3³4    |        |        |
--    |  3335 |        |        | 3³5    |        |
--    |  3337 |        |        |        | 3³6⁰7  |
--    |  3367 |        |        |        | 3²6¹7  |
--    |  3667 |        |        |        | 3¹6²7  |
--    |  6667 |        |        |        | 3⁰6³7  |
--    | 16667 | 16³7   |        |        |        |
--    | 33334 |        | 3⁴4    |        |        |
--    | 33335 |        |        | 3⁴5    |        |
--    | 33337 |        |        |        | 3⁴6⁰7  |
--    | 33367 |        |        |        | 3³6¹7  |
--    | 33667 |        |        |        | 3²6²7  |
--    | 36667 |        |        |        | 3¹6³7  |
--    | 66667 |        |        |        | 3⁰6⁴7  |
--    |-------+--------+--------+--------+--------|
-- donde el exponente en cad dígito indica el número de repeticiones de
-- dicho dígito.

numerosOrdenadosConCuadradosOrdenados2 :: [Integer]
numerosOrdenadosConCuadradosOrdenados2 =
  [0,1,2,3,4,5,6,7,12,13,15,16,17,34,35,37,38,67,116,117] ++
  map read (concat [['1' : replicate n '6' ++ "7",
                     replicate (n+1) '3' ++ "4",
                     replicate (n+1) '3' ++ "5"] ++
                    [replicate a '3' ++ replicate b '6' ++ "7"
                    | b <- [0..n+1], let a = (n+1) - b]
                   | n <- [1..]])

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

-- La comparación es
--    λ> numerosOrdenadosConCuadradosOrdenados !! 50
--    1666667
--    (2.35 secs, 2,173,983,096 bytes)
--    λ> numerosOrdenadosConCuadradosOrdenados2 !! 50
--    1666667
--    (0.01 secs, 125,296 bytes)

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

-- La comprobación es
--    λ> take 50 numerosOrdenadosConCuadradosOrdenados == take 50 numerosOrdenadosConCuadradosOrdenados2
--    True

import Data.List

-- 1ª solución

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

numerosOrdenadosConCuadradosOrdenados :: [Integer]

numerosOrdenadosConCuadradosOrdenados =

filter numeroOrdenadoConCuadradoOrdenado [0..]

-- (numeroOrdenadoConCuadradoOrdenado n) se verifica si n es un número

-- ordenado cuyo cuadrado también lo es. Por ejemplo,

-- numeroOrdenadoConCuadradoOrdenado 116 == True

-- numeroOrdenadoConCuadradoOrdenado 115 == False

numeroOrdenadoConCuadradoOrdenado :: Integer -> Bool

numeroOrdenadoConCuadradoOrdenado n =

ordenado n && ordenado (n^2)

-- (ordenado n) se verifica si n es un número ordenado. Por ejemplo,

-- ordenado 115 == True

-- ordenado 151 == False

ordenado :: Integer -> Bool

ordenado n =

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

where xs = show n

-- 2ª solución

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

-- Se basa en la observación de los sisuientes cálculos con la primera

-- solución

-- λ> take 30 numerosOrdenadosConCuadradosOrdenados

-- [0,1,2,3,4,5,6,7,12,13,15,16,17,34,35,37,38,67,116,117,

-- 167,334,335,337,367,667,1667,3334,3335,3337]

-- λ> take 21 (dropWhile (<= 117) numerosOrdenadosConCuadradosOrdenados)

-- [167,334,335,337,367,667,

-- 1667,3334,3335,3337,3367,3667,6667,

-- 16667,33334,33335,33337,33367,33667,36667,66667]

-- Se observa que a partir del 167 todos los elementos son de 4 tipos

-- como se ve en la siguente tabla

-- |-------+--------+--------+--------+--------|

-- |-------+--------+--------+--------+--------|

-- | 167 | 16¹7 | | | |

-- | 334 | | 3²4 | | |

-- | 335 | | | 3²5 | |

-- | 337 | | | | 3²6⁰7 |

-- | 367 | | | | 3¹6¹7 |

-- | 667 | | | | 3⁰6²7 |

-- | 1667 | 16²7 | | | |

-- | 3334 | | 3³4 | | |

-- | 3335 | | | 3³5 | |

-- | 3337 | | | | 3³6⁰7 |

-- | 3367 | | | | 3²6¹7 |

-- | 3667 | | | | 3¹6²7 |

-- | 6667 | | | | 3⁰6³7 |

-- | 16667 | 16³7 | | | |

-- | 33334 | | 3⁴4 | | |

-- | 33335 | | | 3⁴5 | |

-- | 33337 | | | | 3⁴6⁰7 |

-- | 33367 | | | | 3³6¹7 |

-- | 33667 | | | | 3²6²7 |

-- | 36667 | | | | 3¹6³7 |

-- | 66667 | | | | 3⁰6⁴7 |

-- |-------+--------+--------+--------+--------|

-- donde el exponente en cad dígito indica el número de repeticiones de

-- dicho dígito.

numerosOrdenadosConCuadradosOrdenados2 :: [Integer]

numerosOrdenadosConCuadradosOrdenados2 =

[0,1,2,3,4,5,6,7,12,13,15,16,17,34,35,37,38,67,116,117] ++

map read (concat [['1' : replicate n '6' ++ "7",

replicate (n+1) '3' ++ "4",

replicate (n+1) '3' ++ "5"] ++

[replicate a '3' ++ replicate b '6' ++ "7"

| b <- [0..n+1], let a = (n+1) - b]

| n <- [1..]])

-- Comparación de eficiencia

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

-- La comparación es

-- λ> numerosOrdenadosConCuadradosOrdenados !! 50

-- 1666667

-- (2.35 secs, 2,173,983,096 bytes)

-- λ> numerosOrdenadosConCuadradosOrdenados2 !! 50

-- 1666667

-- (0.01 secs, 125,296 bytes)

-- Comprobación de equivalencia

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

-- La comprobación es

-- λ> take 50 numerosOrdenadosConCuadradosOrdenados == take 50 numerosOrdenadosConCuadradosOrdenados2

-- True

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úmeros con cuadrados con dígitos pares

PorJosé A. Alonso 17-marzo-202124-marzo-2021

Definir la lista

   numerosConCuadradosConDigitosPares :: [Integer]

1	numerosConCuadradosConDigitosPares :: [Integer]

cuyos elementos son los números cuyos cuadrados tienen todos sus dígitos pares. Por ejemplo,

   λ> take 20 numerosConCuadradosConDigitosPares
   [0,2,8,20,22,68,78,80,92,162,168,200,202,220,262,298,478,492,498,668]

1 2	λ> take 20 numerosConCuadradosConDigitosPares [0,2,8,20,22,68,78,80,92,162,168,200,202,220,262,298,478,492,498,668]

Comprobar con QuickCheck que numerosConCuadradosConDigitosPares es infinita; es decir, para cualquier n posee algún elemento mayor que n.

Soluciones

import Test.QuickCheck

numerosConCuadradosConDigitosPares :: [Integer]
numerosConCuadradosConDigitosPares =
  filter tieneCuadradoConDigitosPares [0..]

-- (tieneCuadradoConDigitosPares n) se verifica si todos los dígitos de
-- n^2 son pares. Por ejemplo,
--    tieneCuadradoConDigitosPares 78  ==  True
--    tieneCuadradoConDigitosPares 76  ==  False
tieneCuadradoConDigitosPares :: Integer -> Bool
tieneCuadradoConDigitosPares n =
  tieneDigitosPares (n^2)

-- (tieneDigitosPares n) se verifica si todos los dígitos de n son
-- pares. Por ejemplo,
--    tieneDigitosPares 426  ==  True
--    tieneDigitosPares 436  ==  False
tieneDigitosPares :: Integer -> Bool
tieneDigitosPares n =
  all even (digitos n)

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

-- La propiedad es
prop_infinito :: Integer -> Bool
prop_infinito n =
  not (null (dropWhile (<= n) numerosConCuadradosConDigitosPares))

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

import Test.QuickCheck

numerosConCuadradosConDigitosPares :: [Integer]

numerosConCuadradosConDigitosPares =

filter tieneCuadradoConDigitosPares [0..]

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

-- n^2 son pares. Por ejemplo,

-- tieneCuadradoConDigitosPares 78 == True

-- tieneCuadradoConDigitosPares 76 == False

tieneCuadradoConDigitosPares :: Integer -> Bool

tieneCuadradoConDigitosPares n =

tieneDigitosPares (n^2)

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

-- pares. Por ejemplo,

-- tieneDigitosPares 426 == True

-- tieneDigitosPares 436 == False

tieneDigitosPares :: Integer -> Bool

tieneDigitosPares n =

all even (digitos n)

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

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

digitos :: Integer -> [Int]

digitos n =

[read [c] | c <- show n]

-- La propiedad es

prop_infinito :: Integer -> Bool

prop_infinito n =

not (null (dropWhile (<= n) numerosConCuadradosConDigitosPares))

-- La comprobación es

-- λ> quickCheck prop_infinito

-- +++ OK, passed 100 tests.

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>

Cálculo de pi mediante la fórmula de Bauer

PorJosé A. Alonso 16-marzo-202123-marzo-2021

El pasado 10 de marzo se publicó en Twitter un mensaje con una fórmula de Bauer para el cálculo de pi

Los primeros valores son

   λ> 2/1
   2.0
   λ> 2/(1 - 5*(1/2)^3)
   5.333333333333333
   λ> 2/(1 - 5*(1/2)^3 + 9*((1*3)/(2*4))^3)
   2.354022988505747
   λ> 2/(1 - 5*(1/2)^3 + 9*((1*3)/(2*4))^3 - 13*((1*3*5)/(2*4*6))^3)
   4.416172506738545

λ> 2/1

2.0

λ> 2/(1 - 5*(1/2)^3)

5.333333333333333

λ> 2/(1 - 5*(1/2)^3 + 9*((1*3)/(2*4))^3)

2.354022988505747

λ> 2/(1 - 5*(1/2)^3 + 9*((1*3)/(2*4))^3 - 13*((1*3*5)/(2*4*6))^3)

4.416172506738545

Definir las funciones

   aproximacionPi :: Int -> Double
   grafica        :: [Int] -> IO ()

1 2	aproximacionPi :: Int -> Double grafica :: [Int] -> IO ()

tales que

(aproximacionPi n) es la n-ésima aproximación de pi con la fórmula de Bauer. Por ejemplo,

     aproximacionPi 0         ==  2.0
     aproximacionPi 1         ==  5.333333333333333
     aproximacionPi 2         ==  2.354022988505747
     aproximacionPi 3         ==  4.416172506738545
     aproximacionPi (10^2)    ==  2.974407762733626
     aproximacionPi (10^2+1)  ==  3.3277148010019233
     aproximacionPi (10^3)    ==  3.0865454975585744
     aproximacionPi (10^3+1)  ==  3.1986099487445463
     aproximacionPi (10^4)    ==  3.1239682112773868
     aproximacionPi (10^4+1)  ==  3.1594161911246594
     aproximacionPi (10^5)    ==  3.135997665507836
     aproximacionPi (10^5+1)  ==  3.147207613460776
     pi                       ==  3.141592653589793

aproximacionPi 0 == 2.0

aproximacionPi 1 == 5.333333333333333

aproximacionPi 2 == 2.354022988505747

aproximacionPi 3 == 4.416172506738545

aproximacionPi (10^2) == 2.974407762733626

aproximacionPi (10^2+1) == 3.3277148010019233

aproximacionPi (10^3) == 3.0865454975585744

aproximacionPi (10^3+1) == 3.1986099487445463

aproximacionPi (10^4) == 3.1239682112773868

aproximacionPi (10^4+1) == 3.1594161911246594

aproximacionPi (10^5) == 3.135997665507836

aproximacionPi (10^5+1) == 3.147207613460776

pi == 3.141592653589793

(grafica xs) dibuja la gráfica de las k-ésimas aproximaciones de pi para k en xs. Por ejemplo, (grafica [0..99]) dibuja

Soluciones

import Graphics.Gnuplot.Simple (Attribute (Key, PNG), plotList)

aproximacionPi :: Int -> Double
aproximacionPi n =
  aproximacionesPi !! n

aproximacionesPi :: [Double]
aproximacionesPi =
  map (2/)
      (scanl1 (+)
              (zipWith (*)
                       [fromIntegral ((-1)^n*(4*n+1))| n <- [0..]]
                       (1 : scanl1 (*) [(x/y)^3 | (x,y) <- zip [1,3..] [2,4..]])))

-- Gráfica
-- =======

grafica :: [Int] -> IO ()
grafica xs =
  plotList [ Key Nothing
           -- , PNG "Calculo_de_pi_mediante_la_formula_de_Bauer_1.png"
           ]
           [(k,aproximacionPi k) | k <- xs]

import Graphics.Gnuplot.Simple (Attribute (Key, PNG), plotList)

aproximacionPi :: Int -> Double

aproximacionPi n =

aproximacionesPi !! n

aproximacionesPi :: [Double]

aproximacionesPi =

map (2/)

(scanl1 (+)

(zipWith (*)

[fromIntegral ((-1)^n*(4*n+1))| n <- [0..]]

(1 : scanl1 (*) [(x/y)^3 | (x,y) <- zip [1,3..] [2,4..]])))

-- Gráfica

-- =======

grafica :: [Int] -> IO ()

grafica xs =

plotList [ Key Nothing

-- , PNG "Calculo_de_pi_mediante_la_formula_de_Bauer_1.png"

]

[(k,aproximacionPi k) | k <- xs]

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>

Cálculo de pi mediante la fórmula de Euler

PorJosé A. Alonso 15-marzo-202122-marzo-2021

El pasado 6 de marzo se publicó en Twitter un mensaje con una fórmula de Euler para el cálculo de pi

Definir las funciones

   aproximacionPi :: Int -> Double
   grafica        :: [Int] -> IO ()

1 2	aproximacionPi :: Int -> Double grafica :: [Int] -> IO ()

tales que

(aproximacionPi n) es la n-ésima aproximación de pi con la fórmula de Euler. Por ejemplo,

     aproximacionPi 1        ==  2.449489742783178
     aproximacionPi 10       ==  3.04936163598207
     aproximacionPi 100      ==  3.1320765318091053
     aproximacionPi 1000     ==  3.1406380562059946
     aproximacionPi 10000    ==  3.1414971639472147
     aproximacionPi 100000   ==  3.141583104326456
     aproximacionPi 1000000  ==  3.1415916986605086
     pi                      ==  3.141592653589793

aproximacionPi 1 == 2.449489742783178

aproximacionPi 10 == 3.04936163598207

aproximacionPi 100 == 3.1320765318091053

aproximacionPi 1000 == 3.1406380562059946

aproximacionPi 10000 == 3.1414971639472147

aproximacionPi 100000 == 3.141583104326456

aproximacionPi 1000000 == 3.1415916986605086

pi == 3.141592653589793

(grafica xs) dibuja la gráfica de las k-ésimas aproximaciones de pi para k en xs. Por ejemplo, (grafica [1..100]) dibuja

Soluciones

import Graphics.Gnuplot.Simple (Attribute (Key, PNG), plotList)

aproximacionPi :: Int -> Double
aproximacionPi n =
  sqrt (6 * sum [1/k^2 | k <- [1.0..fromIntegral n]])

grafica :: [Int] -> IO ()
grafica xs =
  plotList [ Key Nothing
           -- , PNG "Calculo_de_pi_mediante_la_formula_de_Euler_1.png"
           ]
           [(k,aproximacionPi k) | k <- xs]

import Graphics.Gnuplot.Simple (Attribute (Key, PNG), plotList)

aproximacionPi :: Int -> Double

aproximacionPi n =

sqrt (6 * sum [1/k^2 | k <- [1.0..fromIntegral n]])

grafica :: [Int] -> IO ()

grafica xs =

plotList [ Key Nothing

-- , PNG "Calculo_de_pi_mediante_la_formula_de_Euler_1.png"

]

[(k,aproximacionPi k) | k <- xs]

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>

Representaciones de un número como potencia

PorJosé A. Alonso 12-marzo-202119-marzo-2021

El número 512 se puede escribir de tres maneras como potencias:

   512 = 2⁹ = 8³ = 512¹

1	512 = 2⁹ = 8³ = 512¹

Definir las funciones

   potencias       :: Integer -> [(Integer,Integer)]
   numeroPotencias :: Integer -> Int

1 2	potencias :: Integer -> [(Integer,Integer)] numeroPotencias :: Integer -> Int

tales que

(potencias x) es la lista de las representaciones de x como potencias de números enteros positivos. Por ejemplo,

     potencias 7      ==  [(7,1)]
     potencias 8      ==  [(2,3),(8,1)]
     potencias 512    ==  [(2,9),(8,3),(512,1)]
     potencias 16384  ==  [(2,14),(4,7),(128,2),(16384,1)]
     potencias 65536  ==  [(2,16),(4,8),(16,4),(256,2),(65536,1)]

potencias 7 == [(7,1)]

potencias 8 == [(2,3),(8,1)]

potencias 512 == [(2,9),(8,3),(512,1)]

potencias 16384 == [(2,14),(4,7),(128,2),(16384,1)]

potencias 65536 == [(2,16),(4,8),(16,4),(256,2),(65536,1)]

(numeroPotencias x) de las representaciones de x como potencias de números enteros positivos. Por ejemplo,

     numeroPotencias 7          ==  1
     numeroPotencias 8          ==  2
     numeroPotencias 512        ==  3
     numeroPotencias 16384      ==  4
     numeroPotencias 65536      ==  5
     numeroPotencias (2^(10^5)) ==  36

numeroPotencias 7 == 1

numeroPotencias 8 == 2

numeroPotencias 512 == 3

numeroPotencias 16384 == 4

numeroPotencias 65536 == 5

numeroPotencias (2^(10^5)) == 36

Soluciones

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

potencias :: Integer -> [(Integer,Integer)]
potencias x = [(a^d,b `div` d) | d <- divisores b]
  where ps = factorizacionPrima x
        b   = mcd (map snd ps)
        a   = product [c^(e `div` b) | (c,e) <- ps]

-- (divisores x) es la lista de los divisores de x. Por ejemplo,
--    divisores 120  ==  [1,2,3,4,5,6,8,10,12,15,20,24,30,40,60,120]
divisores :: Integer -> [Integer]
divisores x =
  [y | y <- [1..x], x `mod` y == 0]

-- (factorizacionPrima x) es la factorización prima de x. Por ejemplo,
--    factorizacionPrima 1200  ==  [(2,4),(3,1),(5,2)]
factorizacionPrima :: Integer -> [(Integer,Integer)]
factorizacionPrima x =
  [(head xs, genericLength xs) | xs <- group (primeFactors x)]

-- (mcd xs) es el máximo común divisor de xs. Por ejemplo,
--    mcd [12,30,42]  ==  6
mcd :: Integral a => [a] -> a
mcd xs = foldr1 gcd xs

-- 1ª definición de numeroPotencias
-- ================================

--    numeroPotencias 7          ==  1
--    numeroPotencias 8          ==  2
--    numeroPotencias 512        ==  3
--    numeroPotencias 16384      ==  4
--    numeroPotencias 65536      ==  5
--    numeroPotencias (2^(10^5)) ==  36
numeroPotencias :: Integer -> Int
numeroPotencias = length . potencias

-- 2ª definición de numeroPotencias
-- ================================

numeroPotencias2 :: Integer -> Int
numeroPotencias2 n =
  numeroDivisores (mcd (map length (group (primeFactors n))))

-- (numeroDivisores n) es el número de divisores de n. Por ejemplo,
--    numeroDivisores 12  ==  6
--    numeroDivisores 14  ==  4
numeroDivisores :: Int -> Int
numeroDivisores =
  product . map ((+1) . length) . group . primeFactors

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

-- La comparación es
--    λ> numeroPotencias (2^(10^5))
--    36
--    (0.40 secs, 707,287,312 bytes)
--    λ> numeroPotencias2 (2^(10^5))
--    36
--    (0.35 secs, 675,954,872 bytes)

import Data.List (group,genericLength)

import Data.Numbers.Primes (primeFactors)

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

potencias x = [(a^d,b `div` d) | d <- divisores b]

where ps = factorizacionPrima x

b = mcd (map snd ps)

a = product [c^(e `div` b) | (c,e) <- ps]

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

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

divisores :: Integer -> [Integer]

divisores x =

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

-- (factorizacionPrima x) es la factorización prima de x. Por ejemplo,

-- factorizacionPrima 1200 == [(2,4),(3,1),(5,2)]

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

factorizacionPrima x =

[(head xs, genericLength xs) | xs <- group (primeFactors x)]

-- (mcd xs) es el máximo común divisor de xs. Por ejemplo,

-- mcd [12,30,42] == 6

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

mcd xs = foldr1 gcd xs

-- 1ª definición de numeroPotencias

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

-- numeroPotencias 7 == 1

-- numeroPotencias 8 == 2

-- numeroPotencias 512 == 3

-- numeroPotencias 16384 == 4

-- numeroPotencias 65536 == 5

-- numeroPotencias (2^(10^5)) == 36

numeroPotencias :: Integer -> Int

numeroPotencias = length . potencias

-- 2ª definición de numeroPotencias

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

numeroPotencias2 :: Integer -> Int

numeroPotencias2 n =

numeroDivisores (mcd (map length (group (primeFactors n))))

-- (numeroDivisores n) es el número de divisores de n. Por ejemplo,

-- numeroDivisores 12 == 6

-- numeroDivisores 14 == 4

numeroDivisores :: Int -> Int

numeroDivisores =

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

-- Comparación de eficiencia de numeroPotencias

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

-- La comparación es

-- λ> numeroPotencias (2^(10^5))

-- 36

-- (0.40 secs, 707,287,312 bytes)

-- λ> numeroPotencias2 (2^(10^5))

-- 36

-- (0.35 secs, 675,954,872 bytes)

Nuevas soluciones

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

Cálculo de pi mediante la fórmula de Brouncker

PorJosé A. Alonso 11-marzo-202118-marzo-2021

El mes de marzo es el mes de pi, ya que el 14 de marzo (3/14) es el día de pi. Con ese motivo, el pasado 3 de marzo se publicó en Twitter un mensaje con la fórmula de Brouncker para el cálculo de pi

La primeras aproximaciones son

     a(1) = 4                                  =  4
     a(2) = 4/(1+1^2)                          =  2.0
     a(3) = 4/(1+1^2/(2+3^2))                  =  3.666666666666667
     a(4) = 4/(1+1^2/(2+3^2/(2+5^2)))          =  2.8
     a(5) = 4/(1+1^2/(2+3^2/(2+5^2/(2+7^2))))  =  3.395238095238095

a(1) = 4 = 4

a(2) = 4/(1+1^2) = 2.0

a(3) = 4/(1+1^2/(2+3^2)) = 3.666666666666667

a(4) = 4/(1+1^2/(2+3^2/(2+5^2))) = 2.8

a(5) = 4/(1+1^2/(2+3^2/(2+5^2/(2+7^2)))) = 3.395238095238095

Definir las funciones

   aproximacionPi :: Int -> Double
   grafica        :: [Int] -> IO ()

1 2	aproximacionPi :: Int -> Double grafica :: [Int] -> IO ()

tales que

(aproximacionPi n) es la n-ésima aproximación de pi con la fórmula de Brouncker. Por ejemplo,

     aproximacionPi 1      ==  4.0
     aproximacionPi 2      ==  2.0
     aproximacionPi 3      ==  3.666666666666667
     aproximacionPi 4      ==  2.8
     aproximacionPi 5      ==  3.395238095238095
     aproximacionPi 10     ==  3.0301437124966535
     aproximacionPi 1000   ==  3.1405916523380406
     aproximacionPi 1001   ==  3.142592653839793
     aproximacionPi 10000  ==  3.141492643588543
     aproximacionPi 10001  ==  3.1416926535900433
     pi                    ==  3.141592653589793

aproximacionPi 1 == 4.0

aproximacionPi 2 == 2.0

aproximacionPi 3 == 3.666666666666667

aproximacionPi 4 == 2.8

aproximacionPi 5 == 3.395238095238095

aproximacionPi 10 == 3.0301437124966535

aproximacionPi 1000 == 3.1405916523380406

aproximacionPi 1001 == 3.142592653839793

aproximacionPi 10000 == 3.141492643588543

aproximacionPi 10001 == 3.1416926535900433

pi == 3.141592653589793

(grafica xs) dibuja la gráfica de las k-ésimas aproximaciones de pi para k en xs. Por ejemplo, (grafica [10..100]) dibuja

Soluciones

import Graphics.Gnuplot.Simple (Attribute (Key, PNG), plotList)

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

aproximacionPi :: Int -> Double
aproximacionPi 1 = 4
aproximacionPi n = 4/(1 + 1/(aux 1 3))
  where aux a b | a == n-1  = 1
                | otherwise = 2 + (b^2)/(aux (a+1) (b+2))

-- El cálculo es
--    aproximacionPi 2
--      = 4/(1 + 1/(aux 1 3))
--      = 4/(1 + 1/1)
--      = 2.0
--
--    aproximacionPi 3
--      = 4/(1 + 1/(aux 1 3))
--      = 4/(1 + 1/(2 + 3^2/(aux 2 5))
--      = 4/(1 + 1/(2 + 3^2/1))
--      = 3.666666666666667
--
--    aproximacionPi 4
--      = 4/(1 + 1/(aux 1 3))
--      = 4/(1 + 1/(2 + 3^2/(aux 2 5))
--      = 4/(1 + 1/(2 + 3^2/(2 + 5^2/(aux 3 7))))
--      = 4/(1 + 1/(2 + 3^2/(2 + 5^2/1)))
--      = 2.8

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

aproximacionPi2 :: Int -> Double
aproximacionPi2 n =
  aproximacionFC n fraccionPi

-- fraccionPi es la representación de la fracción continua de pi como un
-- par de listas infinitas.
fraccionPi :: [(Integer, Integer)]
fraccionPi = zip (0 : 1 : [2,2..]) (4 : map (^2) [1,3..])

-- (aproximacionFC n fc) es la n-ésima aproximación de la fracción
-- continua fc (como un par de listas).
aproximacionFC :: Int -> [(Integer, Integer)] -> Double
aproximacionFC n =
  foldr (\(a,b) z -> fromIntegral a + fromIntegral b / z) 1 . take n

-- Gráfica
-- =======

grafica :: [Int] -> IO ()
grafica xs =
  plotList [ Key Nothing
           -- , PNG "Calculo_de_pi_mediante_la_formula_de_Brouncker_1.png"
           ]
           [(k,aproximacionPi k) | k <- xs]

import Graphics.Gnuplot.Simple (Attribute (Key, PNG), plotList)

-- 1ª solución

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

aproximacionPi :: Int -> Double

aproximacionPi 1 = 4

aproximacionPi n = 4/(1 + 1/(aux 1 3))

where aux a b | a == n-1 = 1

| otherwise = 2 + (b^2)/(aux (a+1) (b+2))

-- El cálculo es

-- aproximacionPi 2

-- = 4/(1 + 1/(aux 1 3))

-- = 4/(1 + 1/1)

-- = 2.0

-- aproximacionPi 3

-- = 4/(1 + 1/(aux 1 3))

-- = 4/(1 + 1/(2 + 3^2/(aux 2 5))

-- = 4/(1 + 1/(2 + 3^2/1))

-- = 3.666666666666667

-- aproximacionPi 4

-- = 4/(1 + 1/(aux 1 3))

-- = 4/(1 + 1/(2 + 3^2/(aux 2 5))

-- = 4/(1 + 1/(2 + 3^2/(2 + 5^2/(aux 3 7))))

-- = 4/(1 + 1/(2 + 3^2/(2 + 5^2/1)))

-- = 2.8

-- 2ª solución

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

aproximacionPi2 :: Int -> Double

aproximacionPi2 n =

aproximacionFC n fraccionPi

-- fraccionPi es la representación de la fracción continua de pi como un

-- par de listas infinitas.

fraccionPi :: [(Integer, Integer)]

fraccionPi = zip (0 : 1 : [2,2..]) (4 : map (^2) [1,3..])

-- (aproximacionFC n fc) es la n-ésima aproximación de la fracción

-- continua fc (como un par de listas).

aproximacionFC :: Int -> [(Integer, Integer)] -> Double

aproximacionFC n =

foldr (\(a,b) z -> fromIntegral a + fromIntegral b / z) 1 . take n

-- Gráfica

-- =======

grafica :: [Int] -> IO ()

grafica xs =

plotList [ Key Nothing

-- , PNG "Calculo_de_pi_mediante_la_formula_de_Brouncker_1.png"

]

[(k,aproximacionPi k) | k <- xs]

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>

Cálculo de pi mediante la serie de Madhava

PorJosé A. Alonso 10-marzo-202117-marzo-2021

El mes de marzo es el mes de pi, ya que el 14 de marzo (3/14) es el día de pi. Con ese motivo, el pasado 1 de marzo se publicó en Twitter un mensaje con la fórmula de Madhava para el cálculo de pi

Definir las funciones

   aproximacionPi :: Int -> Double
   grafica        :: Int -> IO ()

1 2	aproximacionPi :: Int -> Double grafica :: Int -> IO ()

tales que

(aproximacionPi n) es la n-ésima aproximación de pi con la fórmula de Madhava. Por ejemplo,

     aproximacionPi 0   ==  3.4641016151377544
     aproximacionPi 1   ==  3.0792014356780038
     aproximacionPi 2   ==  3.156181471569954
     aproximacionPi 10  ==  3.1415933045030813
     aproximacionPi 21  ==  3.1415926535879337
     pi                 ==  3.141592653589793

aproximacionPi 0 == 3.4641016151377544

aproximacionPi 1 == 3.0792014356780038

aproximacionPi 2 == 3.156181471569954

aproximacionPi 10 == 3.1415933045030813

aproximacionPi 21 == 3.1415926535879337

pi == 3.141592653589793

(grafica n) dibuja la gráfica de las k-ésimas aproximaciones de pi para k desde 0 a n. Por ejemplo, (grafica 30) dibuja

Soluciones

import Graphics.Gnuplot.Simple (Attribute (Key), plotList)

aproximacionPi :: Int -> Double
aproximacionPi n =
  sqrt 12 * aux (fromIntegral n)
  where
    aux 0 = 1
    aux n = aux (n-1) + (-1)**n/(3**n*(2*n+1))

grafica :: Int -> IO ()
grafica n =
    plotList [ Key Nothing
             -- , PNG "Calculo_de_pi_mediante_la_serie_de_Madhava_1.png"
             ]
             [aproximacionPi n | n <- [0..n]]

import Graphics.Gnuplot.Simple (Attribute (Key), plotList)

aproximacionPi :: Int -> Double

aproximacionPi n =

sqrt 12 * aux (fromIntegral n)

where

aux 0 = 1

aux n = aux (n-1) + (-1)**n/(3**n*(2*n+1))

grafica :: Int -> IO ()

grafica n =

plotList [ Key Nothing

-- , PNG "Calculo_de_pi_mediante_la_serie_de_Madhava_1.png"

]

[aproximacionPi n | n <- [0..n]]

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>

Sucesión de Rowland

PorJosé A. Alonso 9-marzo-202116-marzo-2021

Definir las siguientes sucesiones

   sucesionA       :: [Integer]
   sucesionB       :: [Integer]
   sucesionRowland :: [Integer]

sucesionA :: [Integer]

sucesionB :: [Integer]

sucesionRowland :: [Integer]

tales que

el término n-ésimo de la sucesionA es a(n) definido por a(1) = 7 y a(n) = a(n-1) + mcd(n, a(n-1)), para n > 1. Por ejemplo,

     λ> take 20 sucesionA
     [7,8,9,10,15,18,19,20,21,22,33,36,37,38,39,40,41,42,43,44]

1 2	λ> take 20 sucesionA [7,8,9,10,15,18,19,20,21,22,33,36,37,38,39,40,41,42,43,44]

los términos de la sucesionB son las diferencias de los términos consecutivos de la sucesionA. Por ejemplo,

     λ> take 30 sucesionB
     [1,1,1,5,3,1,1,1,1,11,3,1,1,1,1,1,1,1,1,1,1,23,3,1,1,1,1,1,1,1]

1 2	λ> take 30 sucesionB [1,1,1,5,3,1,1,1,1,11,3,1,1,1,1,1,1,1,1,1,1,23,3,1,1,1,1,1,1,1]

los términos de la sucesionRowland son los términos de la sucesionB distintos de 1. Por ejemplo,\0

      λ> take 20 sucesionRowland
      [5,3,11,3,23,3,47,3,5,3,101,3,7,11,3,13,233,3,467,3]
      λ> sucesionRowland !! 92
      15567089

λ> take 20 sucesionRowland

[5,3,11,3,23,3,47,3,5,3,101,3,7,11,3,13,233,3,467,3]

λ> sucesionRowland !! 92

15567089

Comprobar con QuickCheck que los elementos de la sucesionRowland son números primos.

Nota: Eric S. Rowland demostró en A natural prime-generating recurrence que los elementos de la sucesionRowland son números primos.

Soluciones

import Data.Numbers.Primes (isPrime)
import Test.QuickCheck (Property, (==>), quickCheck)

sucesionA :: [Integer]
sucesionA =
   7 : zipWith (+) sucesionA (zipWith gcd sucesionA [2..])

sucesionB :: [Integer]
sucesionB = zipWith (-) (tail sucesionA) sucesionA

sucesionRowland :: [Integer]
sucesionRowland =  filter (> 1) sucesionB

-- La propiedad es
prop_sucesionRowland :: Int -> Property
prop_sucesionRowland n =
  n >= 0 ==> isPrime (sucesionRowland !! n)

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

import Data.Numbers.Primes (isPrime)

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

sucesionA :: [Integer]

sucesionA =

7 : zipWith (+) sucesionA (zipWith gcd sucesionA [2..])

sucesionB :: [Integer]

sucesionB = zipWith (-) (tail sucesionA) sucesionA

sucesionRowland :: [Integer]

sucesionRowland = filter (> 1) sucesionB

-- La propiedad es

prop_sucesionRowland :: Int -> Property

prop_sucesionRowland n =

n >= 0 ==> isPrime (sucesionRowland !! n)

-- La comprobación es

-- λ> quickCheck prop_sucesionRowland

-- +++ OK, passed 100 tests.

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>

Sumas parciales

PorJosé A. Alonso 8-marzo-202115-marzo-2021

Los sufijos de la lista [3,7,2,5,4,6] son

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

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

[7,2,5,4,6]

[2,5,4,6]

[5,4,6]

[4,6]

[6]

[]

y la lista de sus sumas es [27,24,17,15,10,6,0].

Definir la función

   sumasParciales :: [Integer] -> [Integer]

1	sumasParciales :: [Integer] -> [Integer]

tal que (sumasParciales xs) es la lista de las sumas de los sufijos de xs. Por ejemplo,

   sumasParciales [3,7,2,5,4,6]  ==  [27,24,17,15,10,6,0]
   sumasParciales [1..10]        ==  [55,54,52,49,45,40,34,27,19,10,0]
   sum (sumasParciales [1..5*10^6])  ==  41666679166667500000

sumasParciales [3,7,2,5,4,6] == [27,24,17,15,10,6,0]

sumasParciales [1..10] == [55,54,52,49,45,40,34,27,19,10,0]

sum (sumasParciales [1..5*10^6]) == 41666679166667500000

Soluciones

import Data.List (tails)

-- 1ª solución
sumasParciales1 :: [Integer] -> [Integer]
sumasParciales1 xs = map sum (tails xs)

-- 2ª solución
sumasParciales2 :: [Integer] -> [Integer]
sumasParciales2 []     = [0]
sumasParciales2 (x:xs) = (x + s):s:ss
  where (s:ss) = sumasParciales2 xs

-- 3ª solución
sumasParciales3 :: [Integer] -> [Integer]
sumasParciales3 = foldr (\x (s:ss) -> (x + s) : (s:ss)) [0]

-- 4ª solución
sumasParciales4 :: [Integer] -> [Integer]
sumasParciales4 xs = scanl (-) (sum xs) xs

-- 5ª solución
sumasParciales5 :: [Integer] -> [Integer]
sumasParciales5 xs = reverse (0 : scanl1 (+) (reverse xs))

-- 6ª solución
sumasParciales6 :: [Integer] -> [Integer]
sumasParciales6 = scanr (+) 0

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

-- La comparación es
--    λ> sum (sumasParciales1 [1..3*10^4])
--    9000450005000
--    (19.70 secs, 40,132,872,616 bytes)
--    λ> sum (sumasParciales2 [1..3*10^4])
--    9000450005000
--    (0.04 secs, 16,932,840 bytes)
--    λ> sum (sumasParciales3 [1..3*10^4])
--    9000450005000
--    (0.02 secs, 13,880,608 bytes)
--    λ> sum (sumasParciales4 [1..3*10^4])
--    9000450005000
--    (0.03 secs, 12,178,080 bytes)
--    λ> sum (sumasParciales5 [1..3*10^4])
--    9000450005000
--    (0.02 secs, 9,974,600 bytes)
--    λ> sum (sumasParciales6 [1..3*10^4])
--    9000450005000
--    (0.02 secs, 10,694,368 bytes)
--
--    λ> sum (sumasParciales2 [1..3*10^6])
--    9000004500000500000
--    (3.13 secs, 1,685,139,696 bytes)
--    λ> sum (sumasParciales3 [1..3*10^6])
--    9000004500000500000
--    (2.37 secs, 1,380,492,448 bytes)
--    λ> sum (sumasParciales4 [1..3*10^6])
--    9000004500000500000
--    (1.84 secs, 1,211,188,264 bytes)
--    λ> sum (sumasParciales5 [1..3*10^6])
--    9000004500000500000
--    (1.22 secs, 987,790,392 bytes)
--    λ> sum (sumasParciales6 [1..3*10^6])
--    9000004500000500000
--    (1.34 secs, 1,059,792,344 bytes)
--
--    λ> sum (sumasParciales5 [1..5*10^6])
--    41666679166667500000
--    (2.36 secs, 1,844,332,576 bytes)
--    λ> sum (sumasParciales6 [1..5*10^6])
--    41666679166667500000
--    (2.03 secs, 1,964,365,912 bytes)

import Data.List (tails)

-- 1ª solución

sumasParciales1 :: [Integer] -> [Integer]

sumasParciales1 xs = map sum (tails xs)

-- 2ª solución

sumasParciales2 :: [Integer] -> [Integer]

sumasParciales2 [] = [0]

sumasParciales2 (x:xs) = (x + s):s:ss

where (s:ss) = sumasParciales2 xs

-- 3ª solución

sumasParciales3 :: [Integer] -> [Integer]

sumasParciales3 = foldr (\x (s:ss) -> (x + s) : (s:ss)) [0]

-- 4ª solución

sumasParciales4 :: [Integer] -> [Integer]

sumasParciales4 xs = scanl (-) (sum xs) xs

-- 5ª solución

sumasParciales5 :: [Integer] -> [Integer]

sumasParciales5 xs = reverse (0 : scanl1 (+) (reverse xs))

-- 6ª solución

sumasParciales6 :: [Integer] -> [Integer]

sumasParciales6 = scanr (+) 0

-- Comparación de eficiencia

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

-- La comparación es

-- λ> sum (sumasParciales1 [1..3*10^4])

-- 9000450005000

-- (19.70 secs, 40,132,872,616 bytes)

-- λ> sum (sumasParciales2 [1..3*10^4])

-- 9000450005000

-- (0.04 secs, 16,932,840 bytes)

-- λ> sum (sumasParciales3 [1..3*10^4])

-- 9000450005000

-- (0.02 secs, 13,880,608 bytes)

-- λ> sum (sumasParciales4 [1..3*10^4])

-- 9000450005000

-- (0.03 secs, 12,178,080 bytes)

-- λ> sum (sumasParciales5 [1..3*10^4])

-- 9000450005000

-- (0.02 secs, 9,974,600 bytes)

-- λ> sum (sumasParciales6 [1..3*10^4])

-- 9000450005000

-- (0.02 secs, 10,694,368 bytes)

-- λ> sum (sumasParciales2 [1..3*10^6])

-- 9000004500000500000

-- (3.13 secs, 1,685,139,696 bytes)

-- λ> sum (sumasParciales3 [1..3*10^6])

-- 9000004500000500000

-- (2.37 secs, 1,380,492,448 bytes)

-- λ> sum (sumasParciales4 [1..3*10^6])

-- 9000004500000500000

-- (1.84 secs, 1,211,188,264 bytes)

-- λ> sum (sumasParciales5 [1..3*10^6])

-- 9000004500000500000

-- (1.22 secs, 987,790,392 bytes)

-- λ> sum (sumasParciales6 [1..3*10^6])

-- 9000004500000500000

-- (1.34 secs, 1,059,792,344 bytes)

-- λ> sum (sumasParciales5 [1..5*10^6])

-- 41666679166667500000

-- (2.36 secs, 1,844,332,576 bytes)

-- λ> sum (sumasParciales6 [1..5*10^6])

-- 41666679166667500000

-- (2.03 secs, 1,964,365,912 bytes)

Nuevas soluciones

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

Siguiente equidigital

PorJosé A. Alonso 5-marzo-202112-marzo-2021

Dos números son equidigitales si tienen el mismo multiconjunto de dígitos. Por ejemplo, 2021 y 2120 son equidigitales ya que ambos tiene a {0,1,2,2} como su multiconjunto de dígitos.

Definir la función

   siguienteEquidigital :: Integer -> Maybe Integer

1	siguienteEquidigital :: Integer -> Maybe Integer

tal que (siguienteEquidigital n) es precisamente el menor número equidigital con n que es mayor que n (es decir, (Just x) si x es dicho número o Nothing si no hay ningún número equidigital con n que sea mayor que n). Por ejemplo,

   siguienteEquidigital 12    ==  Just 21
   siguienteEquidigital 21    ==  Nothing
   siguienteEquidigital 513   ==  Just 531
   siguienteEquidigital 531   ==  Nothing
   siguienteEquidigital 2021  ==  Just 2102
   siguienteEquidigital 2102  ==  Just 2120
   siguienteEquidigital 2120  ==  Just 2201
   siguienteEquidigital 2201  ==  Just 2210
   siguienteEquidigital 2210  ==  Nothing
   fmap (`mod` 1000) (siguienteEquidigital (2^(10^5)))  ==  Just 637

siguienteEquidigital 12 == Just 21

siguienteEquidigital 21 == Nothing

siguienteEquidigital 513 == Just 531

siguienteEquidigital 531 == Nothing

siguienteEquidigital 2021 == Just 2102

siguienteEquidigital 2102 == Just 2120

siguienteEquidigital 2120 == Just 2201

siguienteEquidigital 2201 == Just 2210

siguienteEquidigital 2210 == Nothing

fmap (`mod` 1000) (siguienteEquidigital (2^(10^5))) == Just 637

Soluciones

import Data.List (sort)
import Data.Maybe (listToMaybe)

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

siguienteEquidigital :: Integer -> Maybe Integer
siguienteEquidigital n
  | null xs = Nothing
  | otherwise = Just (head xs)
  where xs = equidigitalesMayores n

-- (equidigitalesMayores n) es la lista de los equidigitales mayores que
-- n. Por ejemplo,
--    equidigitalesMayores 2021  ==  [2102,2120,2201,2210]
--    equidigitalesMayores 2210  ==  []
equidigitalesMayores :: Integer -> [Integer]
equidigitalesMayores n =
  [x | x <- [n+1..mayorEquidigital n],
       sort (show x) == ds]
  where ds = sort (show n)

-- (mayorEquidigital n) es el mayor número equidigital con n. Por ejemplo,
--    mayorEquidigital 2021  ==  2210
--    mayorEquidigital 2210  ==  2210
mayorEquidigital :: Integer -> Integer
mayorEquidigital = read . reverse . sort . show

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

siguienteEquidigital2 :: Integer -> Maybe Integer
siguienteEquidigital2 = listToMaybe . equidigitalesMayores

import Data.List (sort)

import Data.Maybe (listToMaybe)

-- 1ª solución

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

siguienteEquidigital :: Integer -> Maybe Integer

siguienteEquidigital n

| null xs = Nothing

| otherwise = Just (head xs)

where xs = equidigitalesMayores n

-- (equidigitalesMayores n) es la lista de los equidigitales mayores que

-- n. Por ejemplo,

-- equidigitalesMayores 2021 == [2102,2120,2201,2210]

-- equidigitalesMayores 2210 == []

equidigitalesMayores :: Integer -> [Integer]

equidigitalesMayores n =

[x | x <- [n+1..mayorEquidigital n],

sort (show x) == ds]

where ds = sort (show n)

-- (mayorEquidigital n) es el mayor número equidigital con n. Por ejemplo,

-- mayorEquidigital 2021 == 2210

-- mayorEquidigital 2210 == 2210

mayorEquidigital :: Integer -> Integer

mayorEquidigital = read . reverse . sort . show

-- 2ª solución

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

siguienteEquidigital2 :: Integer -> Maybe Integer

siguienteEquidigital2 = listToMaybe . equidigitalesMayores

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>

Suma de la lista reducida

PorJosé A. Alonso 4-marzo-202111-marzo-2021

Definir las siguientes funciones

   transformada :: Integral a => [a] -> [a]
   reducida     :: Integral a => [a] -> [a]
   sumaReducida :: Integral a => [a] -> a

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

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

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

tales que

(transformada xs) es la lista obtenida sustituyendo en el primer de elementos consecutivos de xs el mayor por su diferencia, donde se supone que xs es una lista de enteros positivos. Por ejemplo,

     transformada [7,2,6]  ==  [5,2,6]
     transformada [2,7,6]  ==  [2,5,6]
     transformada [2,2,6]  ==  [2,2,4]
     transformada [2,2,2]  ==  [2,2,2]

transformada [7,2,6] == [5,2,6]

transformada [2,7,6] == [2,5,6]

transformada [2,2,6] == [2,2,4]

transformada [2,2,2] == [2,2,2]

(reducida xs) es la lista obtenida aplicando la transformación anterior mientras sea posible (es decir, mientras tenga elementos distintos), donde se supone que xs es una lista de enteros positivos. Por ejemplo,

     reducida [7,2,6]   ==  [1,1,1]
     reducida [6,9,21]  ==  [3,3,3]

1 2	reducida [7,2,6] == [1,1,1] reducida [6,9,21] == [3,3,3]

(sumaReducida xs) es la suma de la reducida de la lista xs. Por ejemplo,

     sumaReducida1 [7,2,6]   ==  3
     sumaReducida1 [6,9,21]  ==  9

1 2	sumaReducida1 [7,2,6] == 3 sumaReducida1 [6,9,21] == 9

Soluciones

import Data.List (genericLength)

-- Definición de transformada
-- ==========================

transformada :: Integral a => [a] -> [a]
transformada []  = []
transformada [x] = [x]
transformada (x:y:zs)
  | x > y = x-y : y : zs
  | x < y = x : y-x : zs
  | otherwise = x : transformada (y:zs)

-- 1ª definición de reducida
-- =========================

reducida1 :: Integral a => [a] -> [a]
reducida1 xs
  | xs == ys  = xs
  | otherwise = reducida ys
  where ys = transformada xs

-- 2ª definición de reducida
-- =========================

reducida2 :: Integral a => [a] -> [a]
reducida2 xs =
  replicate (length xs) (foldl1 gcd xs)

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

-- La comparación es
--    λ> sum (reducida1 [2,4..4*10^6])
--    4000000
--    (1.97 secs, 1,277,797,888 bytes)
--    λ> sum (reducida2 [2,4..4*10^6])
--    4000000
--    (1.92 secs, 1,277,798,344 bytes)

-- Definición de reducida
-- =======================

reducida :: Integral a => [a] -> [a]
reducida = reducida2

-- 1ª definición de sumaReducida
-- =============================

sumaReducida1 :: Integral a => [a] -> a
sumaReducida1 = sum . reducida

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

sumaReducida2 :: Integral a => [a] -> a
sumaReducida2 xs = genericLength xs * foldl1 gcd xs

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

-- La comparación es
--    λ> sumaReducida1 [2,4..4*10^6]
--    4000000
--    (2.53 secs, 1,277,796,760 bytes)
--    λ> sumaReducida2 [2,4..4*10^6]
--    4000000
--    (1.89 secs, 1,214,376,960 bytes)

import Data.List (genericLength)

-- Definición de transformada

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

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

transformada [] = []

transformada [x] = [x]

transformada (x:y:zs)

| x > y = x-y : y : zs

| x < y = x : y-x : zs

| otherwise = x : transformada (y:zs)

-- 1ª definición de reducida

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

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

reducida1 xs

| xs == ys = xs

| otherwise = reducida ys

where ys = transformada xs

-- 2ª definición de reducida

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

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

reducida2 xs =

replicate (length xs) (foldl1 gcd xs)

-- Comparación de eficiencia

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

-- La comparación es

-- λ> sum (reducida1 [2,4..4*10^6])

-- 4000000

-- (1.97 secs, 1,277,797,888 bytes)

-- λ> sum (reducida2 [2,4..4*10^6])

-- 4000000

-- (1.92 secs, 1,277,798,344 bytes)

-- Definición de reducida

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

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

reducida = reducida2

-- 1ª definición de sumaReducida

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

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

sumaReducida1 = sum . reducida

-- 2ª solución

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

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

sumaReducida2 xs = genericLength xs * foldl1 gcd xs

-- Comparación de eficiencia

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

-- La comparación es

-- λ> sumaReducida1 [2,4..4*10^6]

-- 4000000

-- (2.53 secs, 1,277,796,760 bytes)

-- λ> sumaReducida2 [2,4..4*10^6]

-- 4000000

-- (1.89 secs, 1,214,376,960 bytes)

Nuevas soluciones

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

Espirales

PorJosé A. Alonso 3-marzo-202110-marzo-2021

Definir la función

   espiral :: Int -> [[Int]]

1	espiral :: Int -> [[Int]]

tal que (espiral n) es la espiral de orden n (es decir, con n filas y n columnas). Por ejemplo,

   λ> mapM_ print (espiral 5)
   [1,1,1,1,1]
   [0,0,0,0,1]
   [1,1,1,0,1]
   [1,0,0,0,1]
   [1,1,1,1,1]
   λ> mapM_ print (espiral 6)
   [1,1,1,1,1,1]
   [0,0,0,0,0,1]
   [1,1,1,1,0,1]
   [1,0,0,1,0,1]
   [1,0,0,0,0,1]
   [1,1,1,1,1,1]
   λ> mapM_ print (espiral 7)
   [1,1,1,1,1,1,1]
   [0,0,0,0,0,0,1]
   [1,1,1,1,1,0,1]
   [1,0,0,0,1,0,1]
   [1,0,1,1,1,0,1]
   [1,0,0,0,0,0,1]
   [1,1,1,1,1,1,1]
   λ> mapM_ print (espiral 8)
   [1,1,1,1,1,1,1,1]
   [0,0,0,0,0,0,0,1]
   [1,1,1,1,1,1,0,1]
   [1,0,0,0,0,1,0,1]
   [1,0,1,0,0,1,0,1]
   [1,0,1,1,1,1,0,1]
   [1,0,0,0,0,0,0,1]
   [1,1,1,1,1,1,1,1]

λ> mapM_ print (espiral 5)

[1,1,1,1,1]

[0,0,0,0,1]

[1,1,1,0,1]

[1,0,0,0,1]

[1,1,1,1,1]

λ> mapM_ print (espiral 6)

[1,1,1,1,1,1]

[0,0,0,0,0,1]

[1,1,1,1,0,1]

[1,0,0,1,0,1]

[1,0,0,0,0,1]

[1,1,1,1,1,1]

λ> mapM_ print (espiral 7)

[1,1,1,1,1,1,1]

[0,0,0,0,0,0,1]

[1,1,1,1,1,0,1]

[1,0,0,0,1,0,1]

[1,0,1,1,1,0,1]

[1,0,0,0,0,0,1]

[1,1,1,1,1,1,1]

λ> mapM_ print (espiral 8)

[1,1,1,1,1,1,1,1]

[0,0,0,0,0,0,0,1]

[1,1,1,1,1,1,0,1]

[1,0,0,0,0,1,0,1]

[1,0,1,0,0,1,0,1]

[1,0,1,1,1,1,0,1]

[1,0,0,0,0,0,0,1]

[1,1,1,1,1,1,1,1]

Nota: La serpiente (formada por los 1) nunca se puede tocar a ella misma.

Soluciones

import Data.List (transpose)

espiral :: Int -> [[Int]]
espiral n = espiralAux n n

espiralAux :: Int -> Int -> [[Int]]
espiralAux 0 _ = []
espiralAux 1 1 = [[1]]
espiralAux n m = primeraFila n : segundaFila n : filasDesdeTercera n m

-- (primeraFila n) es la primera fila de la espiral de orden n. Por
-- ejemplo,
--    λ> primeraFila 5
--    [1,1,1,1,1]
primeraFila :: Int -> [Int]
primeraFila n = replicate n 1

-- (segundaFila n) es la segunda de la espiral de orden n. Por
-- ejemplo,
--    λ> segundaFila 5
--    [0,0,0,0,1]
segundaFila :: Int -> [Int]
segundaFila n = replicate (n-1) 0 ++ [1]

-- (filasDesdeTercera n m), cuando n = m, es la lista de las filas de la
-- espiral de orden n a partir de la tercera. Por ejemplo,
--    λ> mapM_ print (filasDesdeTercera 5 5)
--    [1,1,1,0,1]
--    [1,0,0,0,1]
--    [1,1,1,1,1]
filasDesdeTercera :: Int -> Int -> [[Int]]
filasDesdeTercera n m = map reverse (transpose (espiralAux (m-2) n))

import Data.List (transpose)

espiral :: Int -> [[Int]]

espiral n = espiralAux n n

espiralAux :: Int -> Int -> [[Int]]

espiralAux 0 _ = []

espiralAux 1 1 = [[1]]

espiralAux n m = primeraFila n : segundaFila n : filasDesdeTercera n m

-- (primeraFila n) es la primera fila de la espiral de orden n. Por

-- ejemplo,

-- λ> primeraFila 5

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

primeraFila :: Int -> [Int]

primeraFila n = replicate n 1

-- (segundaFila n) es la segunda de la espiral de orden n. Por

-- ejemplo,

-- λ> segundaFila 5

-- [0,0,0,0,1]

segundaFila :: Int -> [Int]

segundaFila n = replicate (n-1) 0 ++ [1]

-- (filasDesdeTercera n m), cuando n = m, es la lista de las filas de la

-- espiral de orden n a partir de la tercera. Por ejemplo,

-- λ> mapM_ print (filasDesdeTercera 5 5)

-- [1,1,1,0,1]

-- [1,0,0,0,1]

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

filasDesdeTercera :: Int -> Int -> [[Int]]

filasDesdeTercera n m = map reverse (transpose (espiralAux (m-2) n))

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>

Mínima diferencia de las sumas de las biparticiones de las N primeras potencias de dos

PorJosé A. Alonso 2-marzo-20219-marzo-2021

Se consideran las N primeras potencias de 2 (donde N es un número par). Por ejemplo, para N = 4, las potencias de 2 son 1, 2, 4 y 8. Las biparticiones de dichas potencias en dos conjuntos de igual tamaño son

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

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

Las sumas de los elementos de las biparticiones son

   (3,12), (5,10), (9,6)

1	(3,12), (5,10), (9,6)

Los valores absolutos de las diferencias de dichas sumas son

   9, 5, 3

9, 5, 3

El mínimo de dichas diferencias es 3.

Definir la función

  minimaDiferencia :: Integer -> Integer

1	minimaDiferencia :: Integer -> Integer

tal que (minimaDiferencia n) es la mínima diferencia de las sumas las biparticiones de las n (donde n es un número par) primeras potencias de dos conjuntos con igual número de elementos. Por ejemplo,

   minimaDiferencia 4  ==  3
   minimaDiferencia 6  ==  7
   minimaDiferencia (10^9) `mod` (10^9)  ==  787109375

minimaDiferencia 4 == 3

minimaDiferencia 6 == 7

minimaDiferencia (10^9) `mod` (10^9) == 787109375

Soluciones

import Test.QuickCheck
import Data.List ((\\))

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

minimaDiferencia :: Integer -> Integer
minimaDiferencia n =
  minimum [abs (sum xs - sum ys) | (xs,ys) <- particiones n]

-- (particiones n) es la lista de las particiones de las n (donde n es
-- un número par) de las n primeras potencias de 2 en dos conjuntos de
-- igual tamaño. Por ejemplo,
--   λ> particiones 4
--   [([1,2],[4,8]),([1,4],[2,8]),([1,8],[2,4]),
--    ([2,4],[1,8]),([2,8],[1,4]),([4,8],[1,2])]
particiones :: Integer -> [([Integer],[Integer])]
particiones n =
  [(as,xs \\ as) | as <- kSubconjuntos xs (n `div` 2)]
  where xs = [2^k | k <- [0..n-1]]

-- (kSubconjuntos xs k) es la lista de los subconjuntos de xs con k
-- elementos. Por ejemplo,
--    λ> kSubconjuntos "bcde" 2
--    ["bc","bd","be","cd","ce","de"]
--    λ> kSubconjuntos "bcde" 3
--    ["bcd","bce","bde","cde"]
--    λ> kSubconjuntos "abcde" 3
--    ["abc","abd","abe","acd","ace","ade","bcd","bce","bde","cde"]
kSubconjuntos :: [a] -> Integer -> [[a]]
kSubconjuntos _ 0      = [[]]
kSubconjuntos [] _     = []
kSubconjuntos (x:xs) k =
  [x:ys | ys <- kSubconjuntos xs (k-1)] ++ kSubconjuntos xs k

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

-- Nota: La suma de las primeras (n-1) potencias de 2 es
--    sum [2^i | i <- [0..n-2]] = 2^(n-1) - 1
-- que es menor que la n-ésima potencia de 2 (es decir, 2^(n-1) porque
-- se empieza a contar en 0). Por tanto, para que la diferencia de las
-- suma sea mínima hay que agrupar la última (2^(n-1) con las menores
-- (es decir, desde 0 hasta n/2-2).

minimaDiferencia2 :: Integer -> Integer
minimaDiferencia2 n =
  2^(n-1) + sum [2^i | i <- [0..n `div` 2 - 2]] -
  sum [2^i | i <- [n `div` 2 - 1.. n-2]]

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

-- Nota: Sea m = n/2 - 2. Entonces la suma de la mayor con las menores
-- es
--    s1 = 2^(n-1) + sum [2^i | i <- [0..m]]
--       = 2^(n-1) + (2^(m+1)-1)
-- y, puesto que la suma de las n primeras potencias es 2^n-1, la suma
-- de las restantes es
--    s2 = (2^n-1) - s1

minimaDiferencia3 :: Integer -> Integer
minimaDiferencia3 n = s1 - s2
  where m = n `div` 2 - 2
        s1 = 2^(n-1) + (2^(m+1)-1)
        s2 = (2^n-1) - s1

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

-- Nota: Con la notación de la solución anterior, la mínima diferencia es
--    s1 - s2
--    = s1 - ((2^n-1) - s1)
--    = 2*s1 - (2^n-1)
--    = 2*(2^(n-1) + (2^(m+1)-1)) - (2^n-1)
--    = 2^n + 2^(m+2) - 2 - 2^n + 1
--    = 2^(m+2) - 1

minimaDiferencia4 :: Integer -> Integer
minimaDiferencia4 n = 2^(m+2) - 1
  where m = n `div` 2 - 2

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

-- La comparación es
--    λ> minimaDiferencia 22
--    2047
--    (7.75 secs, 6,597,330,816 bytes)
--    λ> minimaDiferencia2 22
--    2047
--    (0.00 secs, 126,344 bytes)
--    λ> minimaDiferencia3 22
--    2047
--    (0.01 secs, 107,192 bytes)
--    λ> minimaDiferencia4 22
--    2047
--    (0.01 secs, 102,544 bytes)
--
--    λ> minimaDiferencia2 (10^5) `mod` (10^50)
--    9602443968201967760613102289456131085235835109375
--    (8.18 secs, 2,915,200,064 bytes)
--    λ> minimaDiferencia3 (10^5) `mod` (10^50)
--    9602443968201967760613102289456131085235835109375
--    (0.01 secs, 293,640 bytes)
--    λ> minimaDiferencia4 (10^5) `mod` (10^50)
--    9602443968201967760613102289456131085235835109375
--    (0.03 secs, 167,176 bytes)
--
--    λ> minimaDiferencia3 (10^8) `mod` (10^50)
--    30521751870548886367615394702753936894129787109375
--    (2.08 secs, 149,075,824 bytes)
--    λ> minimaDiferencia4 (10^8) `mod` (10^50)
--    30521751870548886367615394702753936894129787109375
--    (0.41 secs, 24,929,696 bytes)

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

-- Como la primera sólo calcula hasta 22, se compara la primera con la
-- cuarta para dichos valores.
prop_equivalencia1 :: Bool
prop_equivalencia1 =
  and [minimaDiferencia n == minimaDiferencia4 n | n <- [0,2..22]]

-- La comprobación es
--    λ> prop_equivalencia1
--    True

-- La propiedad de la equivalencia de las definiciones 2, 3 y 4 es
prop_equivalencia :: Integer -> Bool
prop_equivalencia n =
  all (== (minimaDiferencia2 n'))
      [minimaDiferencia3 n',
       minimaDiferencia4 n']
  where n' = 2 + abs n

-- La comprobación es
--    λ> quickCheck prop_equivalencia
--    +++ 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

import Test.QuickCheck

import Data.List ((\\))

-- 1ª solución

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

minimaDiferencia :: Integer -> Integer

minimaDiferencia n =

minimum [abs (sum xs - sum ys) | (xs,ys) <- particiones n]

-- (particiones n) es la lista de las particiones de las n (donde n es

-- un número par) de las n primeras potencias de 2 en dos conjuntos de

-- igual tamaño. Por ejemplo,

-- λ> particiones 4

-- [([1,2],[4,8]),([1,4],[2,8]),([1,8],[2,4]),

-- ([2,4],[1,8]),([2,8],[1,4]),([4,8],[1,2])]

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

particiones n =

[(as,xs \\ as) | as <- kSubconjuntos xs (n `div` 2)]

where xs = [2^k | k <- [0..n-1]]

-- (kSubconjuntos xs k) es la lista de los subconjuntos de xs con k

-- elementos. Por ejemplo,

-- λ> kSubconjuntos "bcde" 2

-- ["bc","bd","be","cd","ce","de"]

-- λ> kSubconjuntos "bcde" 3

-- ["bcd","bce","bde","cde"]

-- λ> kSubconjuntos "abcde" 3

-- ["abc","abd","abe","acd","ace","ade","bcd","bce","bde","cde"]

kSubconjuntos :: [a] -> Integer -> [[a]]

kSubconjuntos _ 0 = [[]]

kSubconjuntos [] _ = []

kSubconjuntos (x:xs) k =

[x:ys | ys <- kSubconjuntos xs (k-1)] ++ kSubconjuntos xs k

-- 2ª solución

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

-- Nota: La suma de las primeras (n-1) potencias de 2 es

-- sum [2^i | i <- [0..n-2]] = 2^(n-1) - 1

-- que es menor que la n-ésima potencia de 2 (es decir, 2^(n-1) porque

-- se empieza a contar en 0). Por tanto, para que la diferencia de las

-- suma sea mínima hay que agrupar la última (2^(n-1) con las menores

-- (es decir, desde 0 hasta n/2-2).

minimaDiferencia2 :: Integer -> Integer

minimaDiferencia2 n =

2^(n-1) + sum [2^i | i <- [0..n `div` 2 - 2]] -

sum [2^i | i <- [n `div` 2 - 1.. n-2]]

-- 3ª solución

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

-- Nota: Sea m = n/2 - 2. Entonces la suma de la mayor con las menores

-- es

-- s1 = 2^(n-1) + sum [2^i | i <- [0..m]]

-- = 2^(n-1) + (2^(m+1)-1)

-- y, puesto que la suma de las n primeras potencias es 2^n-1, la suma

-- de las restantes es

-- s2 = (2^n-1) - s1

minimaDiferencia3 :: Integer -> Integer

minimaDiferencia3 n = s1 - s2

where m = n `div` 2 - 2

s1 = 2^(n-1) + (2^(m+1)-1)

s2 = (2^n-1) - s1

-- 4ª solución

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

-- Nota: Con la notación de la solución anterior, la mínima diferencia es

-- s1 - s2

-- = s1 - ((2^n-1) - s1)

-- = 2*s1 - (2^n-1)

-- = 2*(2^(n-1) + (2^(m+1)-1)) - (2^n-1)

-- = 2^n + 2^(m+2) - 2 - 2^n + 1

-- = 2^(m+2) - 1

minimaDiferencia4 :: Integer -> Integer

minimaDiferencia4 n = 2^(m+2) - 1

where m = n `div` 2 - 2

-- Comparación de eficiencia

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

-- La comparación es

-- λ> minimaDiferencia 22

-- 2047

-- (7.75 secs, 6,597,330,816 bytes)

-- λ> minimaDiferencia2 22

-- 2047

-- (0.00 secs, 126,344 bytes)

-- λ> minimaDiferencia3 22

-- 2047

-- (0.01 secs, 107,192 bytes)

-- λ> minimaDiferencia4 22

-- 2047

-- (0.01 secs, 102,544 bytes)

-- λ> minimaDiferencia2 (10^5) `mod` (10^50)

-- 9602443968201967760613102289456131085235835109375

-- (8.18 secs, 2,915,200,064 bytes)

-- λ> minimaDiferencia3 (10^5) `mod` (10^50)

-- 9602443968201967760613102289456131085235835109375

-- (0.01 secs, 293,640 bytes)

-- λ> minimaDiferencia4 (10^5) `mod` (10^50)

-- 9602443968201967760613102289456131085235835109375

-- (0.03 secs, 167,176 bytes)

-- λ> minimaDiferencia3 (10^8) `mod` (10^50)

-- 30521751870548886367615394702753936894129787109375

-- (2.08 secs, 149,075,824 bytes)

-- λ> minimaDiferencia4 (10^8) `mod` (10^50)

-- 30521751870548886367615394702753936894129787109375

-- (0.41 secs, 24,929,696 bytes)

-- Comprobación de equivalencia

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

-- Como la primera sólo calcula hasta 22, se compara la primera con la

-- cuarta para dichos valores.

prop_equivalencia1 :: Bool

prop_equivalencia1 =

and [minimaDiferencia n == minimaDiferencia4 n | n <- [0,2..22]]

-- La comprobación es

-- λ> prop_equivalencia1

-- True

-- La propiedad de la equivalencia de las definiciones 2, 3 y 4 es

prop_equivalencia :: Integer -> Bool

prop_equivalencia n =

all (== (minimaDiferencia2 n'))

[minimaDiferencia3 n',

minimaDiferencia4 n']

where n' = 2 + abs n

-- La comprobación es

-- λ> quickCheck prop_equivalencia

-- +++ OK, passed 100 tests.

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>

Índice del menor elemento a eliminar para que la suma sea divisible por K

PorJosé A. Alonso 1-marzo-20218-marzo-2021

Definir la función

   indice :: [Int] -> Int -> Maybe Int

1	indice :: [Int] -> Int -> Maybe Int

tal que (indice xs k) es el índice del menor elemento a eliminar de la lista de enteros positivos xs para que la suma de los restantes sea divisible por k o Nothing, si no existe dicho elemento. Por ejemplo,

   indice [1,8,4,1] 2         ==  Just 2
   indice [4,6,7,5,7] 11      ==  Just 2
   indice [4,6,7,5,7] 12      ==  Just 3
   indice [4,6,7,5,7] 13      ==  Nothing
   indice [1..10^7] 7         ==  Just 5
   indice [10^7,10^7-1..1] 7  ==  Just 9999994

indice [1,8,4,1] 2 == Just 2

indice [4,6,7,5,7] 11 == Just 2

indice [4,6,7,5,7] 12 == Just 3

indice [4,6,7,5,7] 13 == Nothing

indice [1..10^7] 7 == Just 5

indice [10^7,10^7-1..1] 7 == Just 9999994

Soluciones

import Test.QuickCheck
import Data.List (sort)
import Data.Maybe (listToMaybe)

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

indice :: [Int] -> Int -> Maybe Int
indice xs k
  | null ys   = Nothing
  | otherwise = Just (head ys)
  where ys = [i | (_,i,zs) <- sort (eliminaciones xs),
                  sum zs `mod` k == 0]

-- (eliminaciones xs) es la lista de ternas (x,i,zs) tales que x es un
-- elemento de xs, i es la posición de x en xs y zs es la lista de los
-- restantes elementos de xs. Por ejemplo,
--    λ> eliminaciones [5,7,6,5]
--    [(5,0,[7,6,5]),(7,1,[5,6,5]),(6,2,[5,7,5]),(5,3,[5,7,6])]
eliminaciones :: [a] -> [(a,Int,[a])]
eliminaciones xs = [(z,i,zs) | ((z,zs),i) <- zip (aux xs) [0..]]
  where aux []       = []
        aux [x]      = [(x,[])]
        aux (x:y:zs) = (x,y:zs) : [(v,x:vs) | (v,vs) <- aux (y:zs)]

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

indice2 :: [Int] -> Int -> Maybe Int
indice2 xs k
  | null ys   = Nothing
  | otherwise = Just (head ys)
  where d = sum xs `mod` k
        ys = [i | (x,i) <- sort (zip xs [0..]),
                  x `mod` k == d]

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

indice3 :: [Int] -> Int -> Maybe Int
indice3 xs k = listToMaybe ys
  where d = sum xs `mod` k
        ys = [i | (x,i) <- sort (zip xs [0..]),
                  x `mod` k == d]

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

-- La propiedad es
prop_equivalencia :: [Int] -> Int -> Bool
prop_equivalencia xs k =
  indice  xs' k' == indice2 xs' k' &&
  indice2 xs' k' == indice3 xs' k'
  where xs' = map ((+1) . abs) xs
        k'  = 1 + abs k

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

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

-- La comparación es
--    λ> indice [1..5000] 7
--    Just 2
--    (2.82 secs, 2,458,555,104 bytes)
--    λ> indice2 [1..5000] 7
--    Just 2
--    (0.01 secs, 1,991,232 bytes)
--    λ> indice3 [1..5000] 7
--    Just 2
--    (0.01 secs, 1,991,072 bytes)

import Test.QuickCheck

import Data.List (sort)

import Data.Maybe (listToMaybe)

-- 1ª solución

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

indice :: [Int] -> Int -> Maybe Int

indice xs k

| null ys = Nothing

| otherwise = Just (head ys)

where ys = [i | (_,i,zs) <- sort (eliminaciones xs),

sum zs `mod` k == 0]

-- (eliminaciones xs) es la lista de ternas (x,i,zs) tales que x es un

-- elemento de xs, i es la posición de x en xs y zs es la lista de los

-- restantes elementos de xs. Por ejemplo,

-- λ> eliminaciones [5,7,6,5]

-- [(5,0,[7,6,5]),(7,1,[5,6,5]),(6,2,[5,7,5]),(5,3,[5,7,6])]

eliminaciones :: [a] -> [(a,Int,[a])]

eliminaciones xs = [(z,i,zs) | ((z,zs),i) <- zip (aux xs) [0..]]

where aux [] = []

aux [x] = [(x,[])]

aux (x:y:zs) = (x,y:zs) : [(v,x:vs) | (v,vs) <- aux (y:zs)]

-- 2ª solución

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

indice2 :: [Int] -> Int -> Maybe Int

indice2 xs k

| null ys = Nothing

| otherwise = Just (head ys)

where d = sum xs `mod` k

ys = [i | (x,i) <- sort (zip xs [0..]),

x `mod` k == d]

-- 3ª solución

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

indice3 :: [Int] -> Int -> Maybe Int

indice3 xs k = listToMaybe ys

where d = sum xs `mod` k

ys = [i | (x,i) <- sort (zip xs [0..]),

x `mod` k == d]

-- Comprobación de la equivalencia

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

-- La propiedad es

prop_equivalencia :: [Int] -> Int -> Bool

prop_equivalencia xs k =

indice xs' k' == indice2 xs' k' &&

indice2 xs' k' == indice3 xs' k'

where xs' = map ((+1) . abs) xs

k' = 1 + abs k

-- La comprobación es

-- λ> quickCheck prop_equivalencia

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> indice [1..5000] 7

-- Just 2

-- (2.82 secs, 2,458,555,104 bytes)

-- λ> indice2 [1..5000] 7

-- Just 2

-- (0.01 secs, 1,991,232 bytes)

-- λ> indice3 [1..5000] 7

-- Just 2

-- (0.01 secs, 1,991,072 bytes)

Nuevas soluciones

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

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas 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

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Entradas recientes

Buscar

Correo electrónico