enero 2021 – Exercitium

Terna pitagórica en la que el perímetro es múltiplo de uno de los catetos

PorJosé A. Alonso 29-enero-20215-febrero-2021

La terna (n,a,b) es una terna pitagórica si n² = a²+b² y b < a < n. Por ejemplo, (5,4,3) y (10,8,6) son ternas pitagóricas.

Una terna pitagórica es primitiva si sus tres componentes son primos entre sí. Por ejemplo, (5,4,3) es una terna pitagórica primitiva y (10,8,6) es una terna pitagórica no primitiva (ya que sus tres lados son divisibles por 2).

Los elementos (n,a,b) de una terna pitagórica son las longitudes de los lados de un triágulo rectángulo; concretamente n es la longitud de la hipotenusa, a la del cateto mayor y b la del cateto menor. Su perímetro es n+a+b.

Definir la función

   ternasPPPDC :: [(Integer,Integer,Integer)]

1	ternasPPPDC :: [(Integer,Integer,Integer)]

tal que ternasPPPDC es la lista de las ternas pitagóricas primitivas tales que su perímetro es divisibe por alguno de los catetos. Por ejemplo,

   λ> take 5 ternasPPPDC
   [(5,4,3),(13,12,5),(17,15,8),(25,24,7),(37,35,12)]
   λ> [n | (n,a,b) <- take 15 ternasPPPDC]
   [5,13,17,25,37,41,61,65,85,101,113,145,145,181,197]
   λ> ternasPPPDC !! 80
   (4705,4704,97)

λ> take 5 ternasPPPDC

[(5,4,3),(13,12,5),(17,15,8),(25,24,7),(37,35,12)]

λ> [n | (n,a,b) <- take 15 ternasPPPDC]

[5,13,17,25,37,41,61,65,85,101,113,145,145,181,197]

λ> ternasPPPDC !! 80

(4705,4704,97)

Comprobar con QuickCheck que existen infinitas ternas pitagóricas primitivas tales que su perímetro es divisibe por alguno de los catetos; es decir, para todo x existe alguna terna (n,a,b) en ternasPPPDC tal que n es mayor que x.

Referencia: Este ejercicio está basado en el artículo Terna pitagórica en la que el perímetro es múltiplo de uno de los catetos publicado por Antonio Roldán en «Números y hoja de cálculo» el 21 de enero de 2021.

Soluciones

import Data.Numbers.Primes (primes)
import Test.QuickCheck (quickCheck)

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

ternasPPPDC :: [(Integer,Integer,Integer)]
ternasPPPDC =
  [(n,a,b) | (n,a,b) <- ternasPitagoricasPrimitivas
           , (n+a+b) `mod` a == 0 || (n+a+b) `mod` b == 0]

-- ternasPitagoricasPrimitivas es la lista de las ternas pitagóricas
-- primitivas. Por ejemplo,
--    λ> take 5 ternasPitagoricasPrimitivas
--    [(5,4,3),(13,12,5),(17,15,8),(25,24,7),(29,21,20)]
ternasPitagoricasPrimitivas :: [(Integer,Integer,Integer)]
ternasPitagoricasPrimitivas =
  [(n,a,b) | (n,a,b) <- ternasPitagoricas
           , foldl1 gcd [n,a,b] == 1]

-- ternasPitagoricas es la lista de las ternas pitagóricas. Por ejemplo,
--    λ> take 5 ternasPitagoricas
--    [(5,4,3),(10,8,6),(13,12,5),(15,12,9),(17,15,8)]
ternasPitagoricas :: [(Integer,Integer,Integer)]
ternasPitagoricas =
    [(n,a,b) | n <- [1..],
               a <- [1..n-1],
               let b2 = n^2-a^2,
               let b = round (sqrt (fromIntegral b2)),
               b < a,
               b^2 == b2]

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

ternasPPPDC2 :: [(Integer,Integer,Integer)]
ternasPPPDC2 =
  [(n,a,b) | (n,a,b) <- ternasPitagoricasPrimitivas2
           , (n+a+b) `mod` a == 0 || (n+a+b) `mod` b == 0]

ternasPitagoricasPrimitivas2 :: [(Integer,Integer,Integer)]
ternasPitagoricasPrimitivas2 =
  [(n,a,b) | (n,a,b) <- ternasPitagoricas2
           , foldl1 gcd [n,a,b] == 1]

ternasPitagoricas2 :: [(Integer,Integer,Integer)]
ternasPitagoricas2 =
    [(n,a,b) | n <- [5,9..],
               a <- [1..n-1],
               let b2 = n^2-a^2,
               let b = round (sqrt (fromIntegral b2)),
               b < a,
               b^2 == b2]

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

ternasPPPDC3 :: [(Integer,Integer,Integer)]
ternasPPPDC3 =
  [(n,a,b) | (n,a,b) <- ternasPitagoricasPrimitivas3
           , (n+a+b) `mod` a == 0 || (n+a+b) `mod` b == 0]

ternasPitagoricasPrimitivas3 :: [(Integer,Integer,Integer)]
ternasPitagoricasPrimitivas3 =
  [(n,a,b) | (n,a,b) <- ternasPitagoricas3
           , foldl1 gcd [n,a,b] == 1]

ternasPitagoricas3 :: [(Integer,Integer,Integer)]
ternasPitagoricas3 =
    [(n,a,b) | n <- [5,9..],
               or [x `mod` 4 == 1 | x <- takeWhile (<=n) primes, n `mod` x == 0],
               a <- [1..n-1],
               let b2 = n^2-a^2,
               let b = round (sqrt (fromIntegral b2)),
               b < a,
               b^2 == b2]

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

-- La comparación es
--    λ> ternasPPPDC !! 80
--    (4705,4704,97)
--    (19.66 secs, 21,249,420,072 bytes)
--    λ> ternasPPPDC2 !! 80
--    (4705,4704,97)
--    (5.00 secs, 5,316,680,464 bytes)
--    λ> ternasPPPDC3 !! 80
--    (4705,4704,97)
--    (3.68 secs, 4,234,492,416 bytes)

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

-- La propiedad es
prop_ternasPPPDC :: Integer -> Bool
prop_ternasPPPDC x =
  not (null [(n,a,b) | (n,a,b) <- ternasPPPDC
                     , n > x])

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

100

101

102

103

import Data.Numbers.Primes (primes)

import Test.QuickCheck (quickCheck)

-- 1ª solución

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

ternasPPPDC :: [(Integer,Integer,Integer)]

ternasPPPDC =

[(n,a,b) | (n,a,b) <- ternasPitagoricasPrimitivas

, (n+a+b) `mod` a == 0 || (n+a+b) `mod` b == 0]

-- ternasPitagoricasPrimitivas es la lista de las ternas pitagóricas

-- primitivas. Por ejemplo,

-- λ> take 5 ternasPitagoricasPrimitivas

-- [(5,4,3),(13,12,5),(17,15,8),(25,24,7),(29,21,20)]

ternasPitagoricasPrimitivas :: [(Integer,Integer,Integer)]

ternasPitagoricasPrimitivas =

[(n,a,b) | (n,a,b) <- ternasPitagoricas

, foldl1 gcd [n,a,b] == 1]

-- ternasPitagoricas es la lista de las ternas pitagóricas. Por ejemplo,

-- λ> take 5 ternasPitagoricas

-- [(5,4,3),(10,8,6),(13,12,5),(15,12,9),(17,15,8)]

ternasPitagoricas :: [(Integer,Integer,Integer)]

ternasPitagoricas =

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

a <- [1..n-1],

let b2 = n^2-a^2,

let b = round (sqrt (fromIntegral b2)),

b < a,

b^2 == b2]

-- 2ª solución

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

ternasPPPDC2 :: [(Integer,Integer,Integer)]

ternasPPPDC2 =

[(n,a,b) | (n,a,b) <- ternasPitagoricasPrimitivas2

, (n+a+b) `mod` a == 0 || (n+a+b) `mod` b == 0]

ternasPitagoricasPrimitivas2 :: [(Integer,Integer,Integer)]

ternasPitagoricasPrimitivas2 =

[(n,a,b) | (n,a,b) <- ternasPitagoricas2

, foldl1 gcd [n,a,b] == 1]

ternasPitagoricas2 :: [(Integer,Integer,Integer)]

ternasPitagoricas2 =

[(n,a,b) | n <- [5,9..],

a <- [1..n-1],

let b2 = n^2-a^2,

let b = round (sqrt (fromIntegral b2)),

b < a,

b^2 == b2]

-- 3ª solución

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

ternasPPPDC3 :: [(Integer,Integer,Integer)]

ternasPPPDC3 =

[(n,a,b) | (n,a,b) <- ternasPitagoricasPrimitivas3

, (n+a+b) `mod` a == 0 || (n+a+b) `mod` b == 0]

ternasPitagoricasPrimitivas3 :: [(Integer,Integer,Integer)]

ternasPitagoricasPrimitivas3 =

[(n,a,b) | (n,a,b) <- ternasPitagoricas3

, foldl1 gcd [n,a,b] == 1]

ternasPitagoricas3 :: [(Integer,Integer,Integer)]

ternasPitagoricas3 =

[(n,a,b) | n <- [5,9..],

or [x `mod` 4 == 1 | x <- takeWhile (<=n) primes, n `mod` x == 0],

a <- [1..n-1],

let b2 = n^2-a^2,

let b = round (sqrt (fromIntegral b2)),

b < a,

b^2 == b2]

-- Comparación de eficiencia

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

-- La comparación es

-- λ> ternasPPPDC !! 80

-- (4705,4704,97)

-- (19.66 secs, 21,249,420,072 bytes)

-- λ> ternasPPPDC2 !! 80

-- (4705,4704,97)

-- (5.00 secs, 5,316,680,464 bytes)

-- λ> ternasPPPDC3 !! 80

-- (4705,4704,97)

-- (3.68 secs, 4,234,492,416 bytes)

-- Propiedad

-- =========

-- La propiedad es

prop_ternasPPPDC :: Integer -> Bool

prop_ternasPPPDC x =

not (null [(n,a,b) | (n,a,b) <- ternasPPPDC

, n > x])

-- La comprobación es

-- λ> quickCheck prop_ternasPPPDC

-- +++ 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>

El número de Dottie

PorJosé A. Alonso 28-enero-20214-febrero-2021

La sucesión de Dottie correspondiente a un número x se obtiene a partir de x aplicándole la función coseno al término anterior. Por ejemplo, empezando en el 2021 los términos de la sucesión de Dottie son

   d(0) = 2021
   d(1) = cos(2021)                = -0.5768544484396986
   d(2) = cos(-0.5768544484396986) = 0.8381823464377144
   d(3) = cos(0.8381823464377144)  = 0.6688152257126013
   d(4) = cos(0.6688152257126013)  = 0.7845568438177061
   d(5) = cos(0.7845568438177061)  = 0.7077014336446841
   d(6) = cos(0.7077014336446841)  = 0.7598581544800473
   d(7) = cos(0.7598581544800473)  = 0.7249337238692606
   d(8) = cos(0.7249337238692606)  = 0.7485433703735275

d(0) = 2021

d(1) = cos(2021) = -0.5768544484396986

d(2) = cos(-0.5768544484396986) = 0.8381823464377144

d(3) = cos(0.8381823464377144) = 0.6688152257126013

d(4) = cos(0.6688152257126013) = 0.7845568438177061

d(5) = cos(0.7845568438177061) = 0.7077014336446841

d(6) = cos(0.7077014336446841) = 0.7598581544800473

d(7) = cos(0.7598581544800473) = 0.7249337238692606

d(8) = cos(0.7249337238692606) = 0.7485433703735275

Definir las funciones

   sucesionDottie :: Double -> [Double]
   limite :: [Double] -> Double -> Int -> Double

1 2	sucesionDottie :: Double -> [Double] limite :: [Double] -> Double -> Int -> Double

tales que

(sucesionDottie x) es la lista de los términos de la sucesión de Dottie correspondiente a x. Por ejemplo,

     λ> mapM_ print (take 10 (sucesionDottie 2021))
     2021.0
     -0.5768544484396986
     0.8381823464377144
     0.6688152257126013
     0.7845568438177061
     0.7077014336446841
     0.7598581544800473
     0.7249337238692606
     0.7485433703735275
     0.7326809874975466
     λ> mapM_ print (take 10 (drop 85 (sucesionDottie 2021)))
     0.7390851332151601
     0.739085133215161
     0.7390851332151605
     0.7390851332151608
     0.7390851332151606
     0.7390851332151607
     0.7390851332151607
     0.7390851332151607
     0.7390851332151607
     0.7390851332151607

λ> mapM_ print (take 10 (sucesionDottie 2021))

2021.0

-0.5768544484396986

0.8381823464377144

0.6688152257126013

0.7845568438177061

0.7077014336446841

0.7598581544800473

0.7249337238692606

0.7485433703735275

0.7326809874975466

λ> mapM_ print (take 10 (drop 85 (sucesionDottie 2021)))

0.7390851332151601

0.739085133215161

0.7390851332151605

0.7390851332151608

0.7390851332151606

0.7390851332151607

(limite xs a n) es el límite de xs con aproximación a y amplitud n; es decir, el primer término x de la sucesión tal que el valor absoluto de x y cualquiera de sus n siguentes elementos es menor que a. Por ejemplo,

     λ> limite [(2*n+1)/(n+5) | n <- [1..]] 0.001 300
     1.993991989319092
     λ> limite [(2*n+1)/(n+5) | n <- [1..]] 1e-6 300
     1.9998260062637745
     λ> limite [(1+1/n)**n | n <- [1..]] 0.001 300
     2.7155953364173175
     λ> limite (sucesionDottie 2021) 1e-16 100
     0.7390851332151607
     λ> limite (sucesionDottie 27) 1e-16 100
     0.7390851332151607

λ> limite [(2*n+1)/(n+5) | n <- [1..]] 0.001 300

1.993991989319092

λ> limite [(2*n+1)/(n+5) | n <- [1..]] 1e-6 300

1.9998260062637745

λ> limite [(1+1/n)**n | n <- [1..]] 0.001 300

2.7155953364173175

λ> limite (sucesionDottie 2021) 1e-16 100

0.7390851332151607

λ> limite (sucesionDottie 27) 1e-16 100

0.7390851332151607

Comprobar con QuickCheck que, para todo número x, el límite de la
sucesión de Dottie generada por x es mismo; es decir, si x e y son
dos números cualesquiera, entonces

     limite (sucesionDottie x) 1e-16 100 ==
     limite (sucesionDottie y) 1e-16 100

1 2	limite (sucesionDottie x) 1e-16 100 == limite (sucesionDottie y) 1e-16 100

Dicho límite es el número de Dottie.

Referencia: Este ejercicio está basado en el artículo El número de Dottie publicado por Miguel Ángel Morales en Gaussianos el 20 de enero de 2021.

Soluciones

import Data.List (tails)
import Test.QuickCheck

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

sucesionDottie1 :: Double -> [Double]
sucesionDottie1 x  = map (terminoDottie x) [0..]

terminoDottie :: Double -> Int -> Double
terminoDottie x 0 = x
terminoDottie x n = cos (terminoDottie x (n-1))

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

sucesionDottie2 :: Double -> [Double]
sucesionDottie2 x = iterate cos x

-- Comparación de eficiencia de definiciones de sucesionDottie
-- ===========================================================

-- La comparación es
--    λ> sucesionDottie1 2021 !! (5*10^6)
--    0.7390851332151607
--    (2.13 secs, 1,894,864,000 bytes)
--    λ> sucesionDottie2 2021 !! (5*10^6)
--    0.7390851332151607
--    (0.95 secs, 644,703,256 bytes)

-- En lo que sigue, usaremos la 2ª definición
sucesionDottie :: Double -> [Double]
sucesionDottie = sucesionDottie2

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

limite1 :: [Double] -> Double -> Int -> Double
limite1 xs a n =
  head [ x | (x:ys) <- segmentos xs n
       , all (\y ->  abs (y - x) < a) ys]

-- (segmentos xs n) es la lista de los segmentos de la lista infinita xs
-- con n elementos. Por ejemplo,
--    λ> take 5 (segmentos [1..] 3)
--    [[1,2,3],[2,3,4],[3,4,5],[4,5,6],[5,6,7]]
segmentos :: [a] -> Int -> [[a]]
segmentos xs n = map (take n) (tails xs)

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

limite2 :: [Double] -> Double -> Int -> Double
limite2 (n:ns) x a
  | abs (n - maximum (take (a-1) ns)) < x = n
  | otherwise                             = limite2 ns x a


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

-- La comparación es
--    λ> limite1 [(1+1/n)**n | n <- [1..]] 1e-8 100
--    2.7182700737511185
--    (1.40 secs, 1,044,694,328 bytes)
--    λ> limite2 [(1+1/n)**n | n <- [1..]] 1e-8 100
--    2.7182700737511185
--    (0.47 secs, 1,185,073,072 bytes)

-- En lo que sigue, usaremos la 2ª definición
limite :: [Double] -> Double -> Int -> Double
limite = limite2

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

-- La propiedad es
prop_Dottie :: Double -> Double -> Bool
prop_Dottie x y =
  limite (sucesionDottie x) 1e-16 100 ==
  limite (sucesionDottie y) 1e-16 100

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

import Data.List (tails)

import Test.QuickCheck

-- 1ª definición de sucesionDottie

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

sucesionDottie1 :: Double -> [Double]

sucesionDottie1 x = map (terminoDottie x) [0..]

terminoDottie :: Double -> Int -> Double

terminoDottie x 0 = x

terminoDottie x n = cos (terminoDottie x (n-1))

-- 2ª definición de sucesionDottie

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

sucesionDottie2 :: Double -> [Double]

sucesionDottie2 x = iterate cos x

-- Comparación de eficiencia de definiciones de sucesionDottie

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

-- La comparación es

-- λ> sucesionDottie1 2021 !! (5*10^6)

-- 0.7390851332151607

-- (2.13 secs, 1,894,864,000 bytes)

-- λ> sucesionDottie2 2021 !! (5*10^6)

-- 0.7390851332151607

-- (0.95 secs, 644,703,256 bytes)

-- En lo que sigue, usaremos la 2ª definición

sucesionDottie :: Double -> [Double]

sucesionDottie = sucesionDottie2

-- 1ª definición de limite

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

limite1 :: [Double] -> Double -> Int -> Double

limite1 xs a n =

head [ x | (x:ys) <- segmentos xs n

, all (\y -> abs (y - x) < a) ys]

-- (segmentos xs n) es la lista de los segmentos de la lista infinita xs

-- con n elementos. Por ejemplo,

-- λ> take 5 (segmentos [1..] 3)

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

segmentos :: [a] -> Int -> [[a]]

segmentos xs n = map (take n) (tails xs)

-- 2ª solución

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

limite2 :: [Double] -> Double -> Int -> Double

limite2 (n:ns) x a

| abs (n - maximum (take (a-1) ns)) < x = n

| otherwise = limite2 ns x a

-- Comparación de eficiencia

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

-- La comparación es

-- λ> limite1 [(1+1/n)**n | n <- [1..]] 1e-8 100

-- 2.7182700737511185

-- (1.40 secs, 1,044,694,328 bytes)

-- λ> limite2 [(1+1/n)**n | n <- [1..]] 1e-8 100

-- 2.7182700737511185

-- (0.47 secs, 1,185,073,072 bytes)

-- En lo que sigue, usaremos la 2ª definición

limite :: [Double] -> Double -> Int -> Double

limite = limite2

-- Propiedad

-- =========

-- La propiedad es

prop_Dottie :: Double -> Double -> Bool

prop_Dottie x y =

limite (sucesionDottie x) 1e-16 100 ==

limite (sucesionDottie y) 1e-16 100

-- La comprobación es

-- λ> quickCheck prop_Dottie

-- +++ 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>

Árboles acotados

PorJosé A. Alonso 27-enero-20213-febrero-2021

Los árboles binarios se pueden representar mediante el tipo Arbol definido por

   data Arbol a = H a
                | N a (Arbol a) (Arbol a)
     deriving Show

data Arbol a = H a

| N a (Arbol a) (Arbol a)

deriving Show

Por ejemplo, el árbol

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

/ \

4 9

/ \ / \

1 3 5 6

se puede representar por

   N 7 (N 4 (H 1) (H 3)) (N 9 (H 5) (H 6))

1	N 7 (N 4 (H 1) (H 3)) (N 9 (H 5) (H 6))

Un árbol está acotado por un conjunto ys si todos los valores de sus hojas y sus nodos pertenecen a ys. Por ejemplo, el árbol anterior está acotado por [1..10] pero no lo está por [1..7].

Un árbol es monovalorado si todos sus elementos son iguales. Por ejemplo, de los siguientes árboles sólo son monovalorados los dos primeros

    5          9           5          9
   / \        / \         / \        / \
  5   5      9   9       5   6      9   7
                / \                    / \
               9   9                  9   9

5 9 5 9

/ \ / \ / \ / \

5 5 9 9 5 6 9 7

/ \ / \

9 9 9 9

Definir las funciones

   acotado :: Eq a => Arbol a -> [a] -> Bool
   monovalorados :: Arbol -> [Arbol]

1 2	acotado :: Eq a => Arbol a -> [a] -> Bool monovalorados :: Arbol -> [Arbol]

tales que

(acotado a ys) se verifica si a está acotado por ys. Por ejemplo,

     acotado (N 7 (N 4 (H 1) (H 3)) (N 9 (H 5) (H 6))) [1..10] == True
     acotado (N 7 (N 4 (H 1) (H 3)) (N 9 (H 5) (H 6))) [1..7]  == False

1 2	acotado (N 7 (N 4 (H 1) (H 3)) (N 9 (H 5) (H 6))) [1..10] == True acotado (N 7 (N 4 (H 1) (H 3)) (N 9 (H 5) (H 6))) [1..7] == False

(monovalorado a) se verifica si a es monovalorado. Por ejemplo,

     monovalorado (N 5 (H 5) (H 5))              ==  True
     monovalorado (N 5 (H 5) (H 6))              ==  False
     monovalorado (N 9 (H 9) (N 9 (H 9) (H 9)))  ==  True
     monovalorado (N 9 (H 9) (N 7 (H 9) (H 9)))  ==  False
     monovalorado (N 9 (H 9) (N 9 (H 7) (H 9)))  ==  False

monovalorado (N 5 (H 5) (H 5)) == True

monovalorado (N 5 (H 5) (H 6)) == False

monovalorado (N 9 (H 9) (N 9 (H 9) (H 9))) == True

monovalorado (N 9 (H 9) (N 7 (H 9) (H 9))) == False

monovalorado (N 9 (H 9) (N 9 (H 7) (H 9))) == False

Soluciones

data Arbol a = H a
             | N a (Arbol a) (Arbol a)
  deriving Show

acotado :: Eq a => Arbol a -> [a] -> Bool
acotado (H x) ys     = x `elem` ys
acotado (N x i d) ys = x `elem` ys && acotado i ys && acotado d ys

monovalorado :: Eq a => Arbol a -> Bool
monovalorado (H _) = True
monovalorado (N x i d) = acotado i [x] && acotado d [x]

data Arbol a = H a

| N a (Arbol a) (Arbol a)

deriving Show

acotado :: Eq a => Arbol a -> [a] -> Bool

acotado (H x) ys = x `elem` ys

acotado (N x i d) ys = x `elem` ys && acotado i ys && acotado d ys

monovalorado :: Eq a => Arbol a -> Bool

monovalorado (H _) = True

monovalorado (N x i d) = acotado i [x] && acotado d [x]

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>

Limitación del número de repeticiones

PorJosé A. Alonso 26-enero-20212-febrero-2021

Definir la función

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

1	conRepeticionesAcotadas :: Eq a => [a] -> Int -> [a]

tal que (conRepeticionesAcotadas xs n) es una lista que contiene cada elemento de xs como máximo n veces sin reordenar (se supone que n es un número positivo).. Por ejemplo,

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

conRepeticionesAcotadas [1,2,3,1,2,1,3,2,3,5] 1 == [1,2,3,5]

conRepeticionesAcotadas [1,2,3,1,2,1,3,2,3,5] 2 == [1,2,3,1,2,3,5]

conRepeticionesAcotadas [1,2,3,1,2,1,3,2,3,5] 3 == [1,2,3,1,2,1,3,2,3,5]

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

Soluciones

import Data.List (foldl')
import Data.Maybe (fromJust, isNothing)
import Test.QuickCheck (Property, (==>),quickCheck)

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

conRepeticionesAcotadas :: Eq a => [a] -> Int -> [a]
conRepeticionesAcotadas xs n = reverse (aux [] xs)
  where aux zs []     = zs
        aux zs (y:ys) | m < n     = aux (y:zs) ys
                      | otherwise = aux zs ys
          where m = nOcurrencias y zs

-- (nOcurrencias x ys) es el número de ocurrencias de x en ys. Por
-- ejemplo,
--    nOcurrencias 7 [7,2,7,7,5]  ==  3
nOcurrencias :: Eq a => a -> [a] -> Int
nOcurrencias x ys = length (filter (== x) ys)

-- Se puede simplificar la definición de nOcurrencias:
nOcurrencias2 :: Eq a => a -> [a] -> Int
nOcurrencias2 x = length . filter (== x)

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

conRepeticionesAcotadas2 :: Eq a => [a] -> Int -> [a]
conRepeticionesAcotadas2 xs n = reverse (foldl' aux [] xs)
  where aux zs y | m < n     = y:zs
                 | otherwise = zs
          where m = nOcurrencias y zs

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

conRepeticionesAcotadas3 :: Eq a => [a] -> Int -> [a]
conRepeticionesAcotadas3 xs n = reverse (aux [] [] xs)
  where aux as _ []      = as
        aux as bs (y:ys) | y `elem` bs = aux as bs ys
                         | m < n       = aux (y:as) bs ys
                         | otherwise   = aux as (y:bs) ys
          where m = nOcurrencias y as

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

conRepeticionesAcotadas4 :: Eq a => [a] -> Int -> [a]
conRepeticionesAcotadas4 xs n = aux xs []
  where aux [] _      = []
        aux (y:ys) ps | r == Nothing = y : aux ys ((y,1) : ps)
                      | m < n        = y : aux ys ((y,m+1) : ps)
                      | otherwise    = aux ys ps
                      where r = busca y ps
                            Just m = r

-- (busca x ps) es justamente la segunda componente del primer par de ps
-- cuya primera componente es xs, si ps tiene algún par cuya primera
-- componente es x; y Nothing en caso contrario. Por ejemplo,
--    busca 'a' [('b',2),('a',3),('a',1)]  ==  Just 3
--    busca 'c' [('b',2),('a',3),('a',1)]  ==  Nothing
busca :: Eq a => a -> [(a,b)] -> Maybe b
busca x ps
  | null ys   = Nothing
  | otherwise = Just (head ys)
  where ys = [n | (y,n) <- ps, y == x]

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

conRepeticionesAcotadas5 :: Eq a => [a] -> Int -> [a]
conRepeticionesAcotadas5 xs n = aux xs []
  where aux [] _      = []
        aux (y:ys) ps | isNothing r = y : aux ys ((y,1) : ps)
                      | m < n       = y : aux ys ((y,m+1) : ps)
                      | otherwise   = aux ys ps
                      where r = lookup y ps
                            m = fromJust r

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

-- La propiedad es
prop_conRepeticionesAcotadas :: [Int] -> Int -> Property
prop_conRepeticionesAcotadas xs n =
  n > 0 ==>
  all (==(conRepeticionesAcotadas xs n))
      [ conRepeticionesAcotadas2 xs n
      , conRepeticionesAcotadas3 xs n
      , conRepeticionesAcotadas4 xs n
      , conRepeticionesAcotadas5 xs n]

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

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

-- La comparación es
--    λ> length (conRepeticionesAcotadas (concat [[1..n] | n <- [1..500]]) 2)
--    999
--    (5.14 secs, 64,372,768 bytes)
--    λ> length (conRepeticionesAcotadas2 (concat [[1..n] | n <- [1..500]]) 2)
--    999
--    (4.95 secs, 62,322,880 bytes)
--    λ> length (conRepeticionesAcotadas3 (concat [[1..n] | n <- [1..500]]) 2)
--    999
--    (0.38 secs, 38,764,952 bytes)
--    λ> length (conRepeticionesAcotadas4 (concat [[1..n] | n <- [1..500]]) 2)
--    999
--    (5.66 secs, 2,429,904,144 bytes)
--    λ> length (conRepeticionesAcotadas5 (concat [[1..n] | n <- [1..500]]) 2)
--    999
--    (0.68 secs, 48,536,872 bytes)

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

import Data.List (foldl')

import Data.Maybe (fromJust, isNothing)

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

-- 1ª solución

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

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

conRepeticionesAcotadas xs n = reverse (aux [] xs)

where aux zs [] = zs

aux zs (y:ys) | m < n = aux (y:zs) ys

| otherwise = aux zs ys

where m = nOcurrencias y zs

-- (nOcurrencias x ys) es el número de ocurrencias de x en ys. Por

-- ejemplo,

-- nOcurrencias 7 [7,2,7,7,5] == 3

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

nOcurrencias x ys = length (filter (== x) ys)

-- Se puede simplificar la definición de nOcurrencias:

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

nOcurrencias2 x = length . filter (== x)

-- 2ª solución

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

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

conRepeticionesAcotadas2 xs n = reverse (foldl' aux [] xs)

where aux zs y | m < n = y:zs

| otherwise = zs

where m = nOcurrencias y zs

-- 3ª solución

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

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

conRepeticionesAcotadas3 xs n = reverse (aux [] [] xs)

where aux as _ [] = as

aux as bs (y:ys) | y `elem` bs = aux as bs ys

| m < n = aux (y:as) bs ys

| otherwise = aux as (y:bs) ys

where m = nOcurrencias y as

-- 4ª solución

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

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

conRepeticionesAcotadas4 xs n = aux xs []

where aux [] _ = []

aux (y:ys) ps | r == Nothing = y : aux ys ((y,1) : ps)

| m < n = y : aux ys ((y,m+1) : ps)

| otherwise = aux ys ps

where r = busca y ps

Just m = r

-- (busca x ps) es justamente la segunda componente del primer par de ps

-- cuya primera componente es xs, si ps tiene algún par cuya primera

-- componente es x; y Nothing en caso contrario. Por ejemplo,

-- busca 'a' [('b',2),('a',3),('a',1)] == Just 3

-- busca 'c' [('b',2),('a',3),('a',1)] == Nothing

busca :: Eq a => a -> [(a,b)] -> Maybe b

busca x ps

| null ys = Nothing

| otherwise = Just (head ys)

where ys = [n | (y,n) <- ps, y == x]

-- 5ª solución

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

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

conRepeticionesAcotadas5 xs n = aux xs []

where aux [] _ = []

aux (y:ys) ps | isNothing r = y : aux ys ((y,1) : ps)

| m < n = y : aux ys ((y,m+1) : ps)

| otherwise = aux ys ps

where r = lookup y ps

m = fromJust r

-- Equivalencia de las definiciones

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

-- La propiedad es

prop_conRepeticionesAcotadas :: [Int] -> Int -> Property

prop_conRepeticionesAcotadas xs n =

n > 0 ==>

all (==(conRepeticionesAcotadas xs n))

[ conRepeticionesAcotadas2 xs n

, conRepeticionesAcotadas3 xs n

, conRepeticionesAcotadas4 xs n

, conRepeticionesAcotadas5 xs n]

-- La comprobación es

-- λ> quickCheck prop_conRepeticionesAcotadas

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> length (conRepeticionesAcotadas (concat [[1..n] | n <- [1..500]]) 2)

-- 999

-- (5.14 secs, 64,372,768 bytes)

-- λ> length (conRepeticionesAcotadas2 (concat [[1..n] | n <- [1..500]]) 2)

-- 999

-- (4.95 secs, 62,322,880 bytes)

-- λ> length (conRepeticionesAcotadas3 (concat [[1..n] | n <- [1..500]]) 2)

-- 999

-- (0.38 secs, 38,764,952 bytes)

-- λ> length (conRepeticionesAcotadas4 (concat [[1..n] | n <- [1..500]]) 2)

-- 999

-- (5.66 secs, 2,429,904,144 bytes)

-- λ> length (conRepeticionesAcotadas5 (concat [[1..n] | n <- [1..500]]) 2)

-- 999

-- (0.68 secs, 48,536,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>

Potencias de dos más cercanas

PorJosé A. Alonso 25-enero-20211-febrero-2021

Definir la función

   potenciasDeDosMasCercanas :: [Integer] -> [Integer]

1	potenciasDeDosMasCercanas :: [Integer] -> [Integer]

tal que (potenciasDeDosMasCercanas xs) es la lista sustituyendo cada elemento de xs por su potencia de dos más cercana (en el caso de que haya dos equidistantes se elige la menor). Por ejemplo,

   potenciasDeDosMasCercanas2 [6,7,8,9,2021]  ==  [4,8,8,8,2048]

1	potenciasDeDosMasCercanas2 [6,7,8,9,2021] == [4,8,8,8,2048]

Soluciones

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

potenciasDeDosMasCercanas :: [Integer] -> [Integer]
potenciasDeDosMasCercanas = map potenciaDeDosMasCercana

-- (potenciaDeDosMasCercana n) es la potencia de dos más cercana (en el
-- caso de que haya dos equidistantes se elige la menor). Por ejemplo,
--    potenciaDeDosMasCercana 6  ==  4
--    potenciaDeDosMasCercana 7  ==  8
--    potenciaDeDosMasCercana 8  ==  8
--    potenciaDeDosMasCercana 9  ==  8
potenciaDeDosMasCercana :: Integer -> Integer
potenciaDeDosMasCercana n
  | dx <= dy  = x
  | otherwise = y
  where (x,y) = potenciasDeDosCercanas n
        dx    = n - x
        dy    = y - n

-- (potenciasDeDosMasCercanas n) es par formado por las dos potencias de
-- dos más cercana a n. Por ejemplo,
--    potenciasDeDosCercanas 6  ==  (4,8)
--    potenciasDeDosCercanas 7  ==  (4,8)
--    potenciasDeDosCercanas 8  ==  (4,8)
--    potenciasDeDosCercanas 9  ==  (8,16)
potenciasDeDosCercanas :: Integer -> (Integer, Integer)
potenciasDeDosCercanas n =
  (x `div` 2, x)
  where x = menorPotenciaDeDosMayorOIgual n

-- (menorPotenciaDeDosMayorOIgual n) es la menor potencia de dos mayor o
-- igual que n. Por ejemplo,
--    menorPotenciaDeDosMayorOIgual 6  ==  8
--    menorPotenciaDeDosMayorOIgual 8  ==  8
menorPotenciaDeDosMayorOIgual :: Integer -> Integer
menorPotenciaDeDosMayorOIgual n =
  head [2^x | x <- [0..], 2^x >= n]

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

potenciasDeDosMasCercanas2 :: [Integer] -> [Integer]
potenciasDeDosMasCercanas2 = map potenciaDeDosMasCercana2

potenciaDeDosMasCercana2 :: Integer -> Integer
potenciaDeDosMasCercana2 n =
  snd (min (n-x,x) (y-n,y))
  where (x,y) = potenciasDeDosCercanas2 n

potenciasDeDosCercanas2 :: Integer -> (Integer, Integer)
potenciasDeDosCercanas2 n = (x `div` 2, x)
  where (x:_) = dropWhile (<n) potenciasDeDos

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

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

-- La comparación es
--    λ> maximum (potenciasDeDosMasCercanas [10^5..10^6])
--    1048576
--    (18.28 secs, 20,835,181,624 bytes)
--    λ> maximum (potenciasDeDosMasCercanas2 [10^5..10^6])
--    1048576
--    (2.44 secs, 830,307,736 bytes)

-- 1ª solución

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

potenciasDeDosMasCercanas :: [Integer] -> [Integer]

potenciasDeDosMasCercanas = map potenciaDeDosMasCercana

-- (potenciaDeDosMasCercana n) es la potencia de dos más cercana (en el

-- caso de que haya dos equidistantes se elige la menor). Por ejemplo,

-- potenciaDeDosMasCercana 6 == 4

-- potenciaDeDosMasCercana 7 == 8

-- potenciaDeDosMasCercana 8 == 8

-- potenciaDeDosMasCercana 9 == 8

potenciaDeDosMasCercana :: Integer -> Integer

potenciaDeDosMasCercana n

| dx <= dy = x

| otherwise = y

where (x,y) = potenciasDeDosCercanas n

dx = n - x

dy = y - n

-- (potenciasDeDosMasCercanas n) es par formado por las dos potencias de

-- dos más cercana a n. Por ejemplo,

-- potenciasDeDosCercanas 6 == (4,8)

-- potenciasDeDosCercanas 7 == (4,8)

-- potenciasDeDosCercanas 8 == (4,8)

-- potenciasDeDosCercanas 9 == (8,16)

potenciasDeDosCercanas :: Integer -> (Integer, Integer)

potenciasDeDosCercanas n =

(x `div` 2, x)

where x = menorPotenciaDeDosMayorOIgual n

-- (menorPotenciaDeDosMayorOIgual n) es la menor potencia de dos mayor o

-- igual que n. Por ejemplo,

-- menorPotenciaDeDosMayorOIgual 6 == 8

-- menorPotenciaDeDosMayorOIgual 8 == 8

menorPotenciaDeDosMayorOIgual :: Integer -> Integer

menorPotenciaDeDosMayorOIgual n =

head [2^x | x <- [0..], 2^x >= n]

-- 2ª solución

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

potenciasDeDosMasCercanas2 :: [Integer] -> [Integer]

potenciasDeDosMasCercanas2 = map potenciaDeDosMasCercana2

potenciaDeDosMasCercana2 :: Integer -> Integer

potenciaDeDosMasCercana2 n =

snd (min (n-x,x) (y-n,y))

where (x,y) = potenciasDeDosCercanas2 n

potenciasDeDosCercanas2 :: Integer -> (Integer, Integer)

potenciasDeDosCercanas2 n = (x `div` 2, x)

where (x:_) = dropWhile (<n) potenciasDeDos

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

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

potenciasDeDos :: [Integer]

potenciasDeDos = iterate (*2) 1

-- Comparación de eficiencia

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

-- La comparación es

-- λ> maximum (potenciasDeDosMasCercanas [10^5..10^6])

-- 1048576

-- (18.28 secs, 20,835,181,624 bytes)

-- λ> maximum (potenciasDeDosMasCercanas2 [10^5..10^6])

-- 1048576

-- (2.44 secs, 830,307,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>

La serie 1 – 2 + 3 – 4 + ···

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

En este ejercicio se considerará la serie

   1 - 2 + 3 - 4 + 5 - 6 + 7 - 8 + 9 - 10 + ···

1	1 - 2 + 3 - 4 + 5 - 6 + 7 - 8 + 9 - 10 + ···

Definir las funciones

   serie     :: [Integer]
   sumaSerie :: Integer -> Integer

1 2	serie :: [Integer] sumaSerie :: Integer -> Integer

tales que

serie es lalista de los términos de la serie anterior; es decir,

     take 7 serie  ==  [1,-2,3,-4,5,-6,7]

1	take 7 serie == [1,-2,3,-4,5,-6,7]

(sumaSerie n) es la suma de los n primeros términos de la serie. Por ejemplo,

     sumaSerie 5     ==  3
     sumaSerie 6     ==  -3
     sumaSerie 2021  ==  1011
     length (show (sumaSerie (10^1000)))  ==  1001

sumaSerie 5 == 3

sumaSerie 6 == -3

sumaSerie 2021 == 1011

length (show (sumaSerie (10^1000))) == 1001

Comprobar con QuickCheck que

la suma de la serie se puede hacer tan grande como se desee; es decir, que para todo número a existe un n tal que la suma de los n primeros términos de la serie es mayor que a;
la suma de la serie se puede hacer tan pequeña como se desee; es decir, que para todo número a existe un n tal que la suma de los n primeros términos de la serie es menor que a.

Soluciones

import Data.List (cycle, genericTake)
import Test.QuickCheck (Property, (==>), quickCheck)

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

serie :: [Integer]
serie = [(-1)^(n-1) * n | n <- [1..]]

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

serie2 :: [Integer]
serie2 = zipWith (*) (cycle [1,-1]) [1..]

-- 3ª definición de serie
-- ======================

serie3 :: [Integer]
serie3 = zipWith ($) (cycle [id,negate]) [1..]

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

sumaSerie :: Integer -> Integer
sumaSerie n = sum (genericTake n serie)

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

-- La 2ª definición se basa en la siguiente observación
-- + Si n es par, entonces
--        1 - 2 + 3 - 4 + 5 - 6 + ··· + (n-1) - n
--      = (1 - 2) + (3 - 4) + (5 - 6) + ··· + ((n-1) - n)
--      = -1      - 1       - 1       - ··· - 1
--      = -1 * n/2
-- + Si n es impar, entonces
--        1 - 2 + 3 - 4 + 5 - 6 + ··· + (n-2) - (n-1) + n
--      = (1 - 2) + (3 - 4) + (5 - 6) + ··· + ((n-2) - (n-1)) + n
--      = -1      - 1       - 1       - ··· - 1               + n
--      = -1 * (n-1)/2 + n
--      = n - ((n-1)/2)

sumaSerie2 :: Integer -> Integer
sumaSerie2 n
  | even n    = -(n `div` 2)
  | otherwise = n - ((n - 1) `div` 2)


-- 3ª definición sumaSerie
-- =======================

-- La 3ª definición se basa en la siguiente observación
--    λ> [sumaSerie n | n <- [1..20]]
--    [1,-1,2,-2,3,-3,4,-4,5,-5,6,-6,7,-7,8,-8,9,-9,10,-10]

sumaSerie3 :: Integer -> Integer
sumaSerie3 n = ((-1)^(n-1)*(2*n+1)+1) `div` 4

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

-- La propiedad es
prop_sumaSerie_equiv :: Integer -> Property
prop_sumaSerie_equiv n =
  n > 0 ==>
  sumaSerie  n == sumaSerie2 n &&
  sumaSerie2 n == sumaSerie3 n

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

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

-- La comparación es
--    λ> sumaSerie (10^6)
--    -500000
--    (3.34 secs, 5,106,633,208 bytes)
--    λ> sumaSerie2 (10^6)
--    -500000
--    (0.01 secs, 102,600 bytes)
--    λ> sumaSerie3 (10^6)
--    -500000
--    (0.02 secs, 110,976 bytes)
--    λ> sumaSerie3 (10^6)
--    -500000

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

-- La propiedad es
prop_sumaSerie :: Integer -> Bool
prop_sumaSerie a =
  any (> a) sumas && any (< a) sumas
  where sumas = [sumaSerie2 n | n <- [1..]]

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

100

101

import Data.List (cycle, genericTake)

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

-- 1ª definición de serie

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

serie :: [Integer]

serie = [(-1)^(n-1) * n | n <- [1..]]

-- 2ª definición de serie

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

serie2 :: [Integer]

serie2 = zipWith (*) (cycle [1,-1]) [1..]

-- 3ª definición de serie

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

serie3 :: [Integer]

serie3 = zipWith ($) (cycle [id,negate]) [1..]

-- 1ª definición de sumaSerie

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

sumaSerie :: Integer -> Integer

sumaSerie n = sum (genericTake n serie)

-- 2ª definición sumaSerie

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

-- La 2ª definición se basa en la siguiente observación

-- + Si n es par, entonces

-- 1 - 2 + 3 - 4 + 5 - 6 + ··· + (n-1) - n

-- = (1 - 2) + (3 - 4) + (5 - 6) + ··· + ((n-1) - n)

-- = -1 - 1 - 1 - ··· - 1

-- = -1 * n/2

-- + Si n es impar, entonces

-- 1 - 2 + 3 - 4 + 5 - 6 + ··· + (n-2) - (n-1) + n

-- = (1 - 2) + (3 - 4) + (5 - 6) + ··· + ((n-2) - (n-1)) + n

-- = -1 - 1 - 1 - ··· - 1 + n

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

-- = n - ((n-1)/2)

sumaSerie2 :: Integer -> Integer

sumaSerie2 n

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

| otherwise = n - ((n - 1) `div` 2)

-- 3ª definición sumaSerie

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

-- La 3ª definición se basa en la siguiente observación

-- λ> [sumaSerie n | n <- [1..20]]

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

sumaSerie3 :: Integer -> Integer

sumaSerie3 n = ((-1)^(n-1)*(2*n+1)+1) `div` 4

-- Equivalencia

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

-- La propiedad es

prop_sumaSerie_equiv :: Integer -> Property

prop_sumaSerie_equiv n =

n > 0 ==>

sumaSerie n == sumaSerie2 n &&

sumaSerie2 n == sumaSerie3 n

-- La comprobación es

-- λ> quickCheck prop_sumaSerie_equiv

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> sumaSerie (10^6)

-- -500000

-- (3.34 secs, 5,106,633,208 bytes)

-- λ> sumaSerie2 (10^6)

-- -500000

-- (0.01 secs, 102,600 bytes)

-- λ> sumaSerie3 (10^6)

-- -500000

-- (0.02 secs, 110,976 bytes)

-- λ> sumaSerie3 (10^6)

-- -500000

-- Propiedad

-- =========

-- La propiedad es

prop_sumaSerie :: Integer -> Bool

prop_sumaSerie a =

any (> a) sumas && any (< a) sumas

where sumas = [sumaSerie2 n | n <- [1..]]

-- La comprobación es

-- λ> quickCheck prop_sumaSerie

-- +++ OK, passed 100 tests.

Clausura respecto del valor absoluto de las diferencias

PorJosé A. Alonso 21-enero-202128-enero-2021

Dado un conjunto de números enteros positivos S su clausura del valor absoluto de la diferencia de pares es el menor conjunto T tal que T contiene a S y para cualquier par de elementos x e y de T (con x distinto de y) el valor absoluto de (x-y) también es un elemento de T. Por ejemplo, si S = {12, 30}, entonces

12 ∈ T, porque 12 ∈ S
30 ∈ T, porque 20 ∈ S
18 = |12 – 30| ∈ T
6 = |18 – 12| ∈ T
24 = |30 – 6| ∈ T

Por tanto, T = {12, 30, 18, 6, 24}.

Definir las funciones

   clausura :: [Int] -> [Int]
   longitudClausura :: [Int] -> Int

1 2	clausura :: [Int] -> [Int] longitudClausura :: [Int] -> Int

tales que

(clausura xs) es la clausura del conjunto de enteros positivos xs respecto del valor absoluto de la diferencia de pares. Por ejemplo,

     clausura [12,30]  ==  [12,30,18,6,24]
     clausura [3,5,2]  ==  [3,5,2,1,4]

1 2	clausura [12,30] == [12,30,18,6,24] clausura [3,5,2] == [3,5,2,1,4]

(longitudClausura xs) es el número de elementos de la clausura del conjunto de enteros positivos xs respecto del valor absoluto de la diferencia de pares. Por ejemplo,

     longitudClausura [12,30]        ==  5
     longitudClausura [3,5,2]        ==  5
     longitudClausura [3,23..10^6]   ==  999983

longitudClausura [12,30] == 5

longitudClausura [3,5,2] == 5

longitudClausura [3,23..10^6] == 999983

Soluciones

import Data.List (nub, sort, union)
import Test.QuickCheck

-- Definición de clausura
-- ======================

clausura :: [Int] -> [Int]
clausura xs
  | contenida ys xs = xs
  | otherwise       = clausura (union xs ys)
  where ys = diferencias xs

-- (diferencias xs) es el conjunto de los valores absolutos de las
-- diferencias de pares de elementos distintos de xs. Por ejemplo,
--    diferencias [3,7,11]  ==  [4,8]
diferencias :: [Int] -> [Int]
diferencias xs =
  nub [x - y | x <- xs
             , y <- xs
             , x > y]

-- (contenida xs ys) se verifica si la lista xs esta contenida en
-- ys. Por ejemplo,
--    contenida [2,3] [3,5,2]  ==  True
--    contenida [2,3] [3,5,7]  ==  False
contenida :: [Int] -> [Int] -> Bool
contenida xs ys =
  all (`elem` ys) xs

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

longitudClausura :: [Int] -> Int
longitudClausura = length . clausura

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

--    longitudClausura2 [3,23..10^6]  ==  999983
longitudClausura2 :: [Int] -> Int
longitudClausura2 xs =
  maximum xs `div` mcd xs

-- (mcd xs) es el máximo común divisor de los elememtos de xs. Por
-- ejemplo,
--    mcd [12, 60]      ==  12
--    mcd [12, 60, 42]  ==  6
mcd :: [Int] -> Int
mcd = foldl1 gcd

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

-- La propiedd de equivalencia es
prop_clausura :: [Int] -> Property
prop_clausura xs =
  not (null xs) ==>
  longitudClausura ys == longitudClausura2 ys
  where ys = nub (map ((+1) . abs) xs)

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

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

-- La comparación es
--    λ> longitudClausura [3,23..10^3]
--    983
--    (2.22 secs, 239,761,904 bytes)
--    λ> longitudClausura2 [3,23..10^3]
--    983
--    (0.01 secs, 118,968 bytes)

import Data.List (nub, sort, union)

import Test.QuickCheck

-- Definición de clausura

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

clausura :: [Int] -> [Int]

clausura xs

| contenida ys xs = xs

| otherwise = clausura (union xs ys)

where ys = diferencias xs

-- (diferencias xs) es el conjunto de los valores absolutos de las

-- diferencias de pares de elementos distintos de xs. Por ejemplo,

-- diferencias [3,7,11] == [4,8]

diferencias :: [Int] -> [Int]

diferencias xs =

nub [x - y | x <- xs

, y <- xs

, x > y]

-- (contenida xs ys) se verifica si la lista xs esta contenida en

-- ys. Por ejemplo,

-- contenida [2,3] [3,5,2] == True

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

contenida :: [Int] -> [Int] -> Bool

contenida xs ys =

all (`elem` ys) xs

-- 1ª definición de longitudClausura

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

longitudClausura :: [Int] -> Int

longitudClausura = length . clausura

-- 2ª definición de longitudClausura

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

-- longitudClausura2 [3,23..10^6] == 999983

longitudClausura2 :: [Int] -> Int

longitudClausura2 xs =

maximum xs `div` mcd xs

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

-- ejemplo,

-- mcd [12, 60] == 12

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

mcd :: [Int] -> Int

mcd = foldl1 gcd

-- Equivalencia

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

-- La propiedd de equivalencia es

prop_clausura :: [Int] -> Property

prop_clausura xs =

not (null xs) ==>

longitudClausura ys == longitudClausura2 ys

where ys = nub (map ((+1) . abs) xs)

-- La comprobación es

-- λ> quickCheck prop_clausura

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> longitudClausura [3,23..10^3]

-- 983

-- (2.22 secs, 239,761,904 bytes)

-- λ> longitudClausura2 [3,23..10^3]

-- 983

-- (0.01 secs, 118,968 bytes)

Números en potencias de dos

PorJosé A. Alonso 20-enero-202127-enero-2021

Las potencias de dos son

   1,2,4,8,16,32,64,128,256,512,1024,2048,4096,8192,16384,32768,...

1	1,2,4,8,16,32,64,128,256,512,1024,2048,4096,8192,16384,32768,...

Se observa que la primera potencia de dos que contiene al 638 es la 14 ya que 2^14 = 16384.

Definir la función

   potenciasContenedoras :: Integer -> [Integer]

1	potenciasContenedoras :: Integer -> [Integer]

tal que (potenciasContenedoras x) es la lista de las potencias de 2 que contienen a x. Por ejemplo,

   λ> head (potenciasContenedoras 638)
   14
   λ> head (potenciasContenedoras 2021)
   452
   λ> take 20 (potenciasContenedoras 4)
   [2,6,10,11,12,14,18,19,20,22,25,26,27,28,30,31,32,33,34,35]
   λ> [head (potenciasContenedoras n) | n <- [0..20]]
   [10,4,1,5,2,8,4,15,3,12,10,40,7,17,18,21,4,27,30,13,11]

λ> head (potenciasContenedoras 638)

λ> head (potenciasContenedoras 2021)

452

λ> take 20 (potenciasContenedoras 4)

[2,6,10,11,12,14,18,19,20,22,25,26,27,28,30,31,32,33,34,35]

λ> [head (potenciasContenedoras n) | n <- [0..20]]

[10,4,1,5,2,8,4,15,3,12,10,40,7,17,18,21,4,27,30,13,11]

Comprobar con QuickCheck si todos los números naturales están contenenidos en alguna potencia de 2.

Soluciones

import Data.List (isInfixOf)
import Test.QuickCheck (Property, (==>), quickCheck)

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

potenciasContenedoras :: Integer -> [Integer]
potenciasContenedoras x =
  [n | n <- [1..], x `estaContenidoEn` (2^n)]

-- (estaContenidoEn x y) se verifica si el número x está contenido en
-- y. Por ejemplo,
--    estaContenidoEn 23 42357  ==  True
--    estaContenidoEn 23 42537  ==  False
estaContenidoEn :: Integer -> Integer -> Bool
estaContenidoEn x y = show x `isInfixOf` show y

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

potenciasContenedoras2 :: Integer -> [Integer]
potenciasContenedoras2 x =
  [n | (n,y) <- zip [0..] potenciasDeDos, x `estaContenidoEn` y]

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

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

-- La propiedad es
prop_potenciasContenedoras :: Integer -> Property
prop_potenciasContenedoras n =
  n > 0 ==> not (null (potenciasContenedoras n))

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

import Data.List (isInfixOf)

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

-- 1ª solución

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

potenciasContenedoras :: Integer -> [Integer]

potenciasContenedoras x =

[n | n <- [1..], x `estaContenidoEn` (2^n)]

-- (estaContenidoEn x y) se verifica si el número x está contenido en

-- y. Por ejemplo,

-- estaContenidoEn 23 42357 == True

-- estaContenidoEn 23 42537 == False

estaContenidoEn :: Integer -> Integer -> Bool

estaContenidoEn x y = show x `isInfixOf` show y

-- 2ª solución

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

potenciasContenedoras2 :: Integer -> [Integer]

potenciasContenedoras2 x =

[n | (n,y) <- zip [0..] potenciasDeDos, x `estaContenidoEn` y]

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

-- λ> take 12 potenciasDeDos

-- [1,2,4,8,16,32,64,128,256,512,1024,2048]

potenciasDeDos :: [Integer]

potenciasDeDos = iterate (*2) 1

-- Propiedad

-- =========

-- La propiedad es

prop_potenciasContenedoras :: Integer -> Property

prop_potenciasContenedoras n =

n > 0 ==> not (null (potenciasContenedoras n))

-- La comprobación es

-- λ> quickCheck prop_potenciasContenedoras

-- +++ OK, passed 100 tests.

Buenos primos

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

La sucesión de los números primos es

   2, 3, 5, 7, 11, 13, 17, 19, 23, 29, 31, 37, 41, 43, 47, 53, ...

1	2, 3, 5, 7, 11, 13, 17, 19, 23, 29, 31, 37, 41, 43, 47, 53, ...

Las parejas de primos equidistantes de 5 en dicha sucesión son (3, 7) y (2, 11). Se observa que el cuadrado de 5 es mayor que el producto de los elementos de dichas parejas; es decir,

   5^2 = 25 > 21 = 3 x 7
   5^2 = 25 > 22 = 2 x 11

1 2	5^2 = 25 > 21 = 3 x 7 5^2 = 25 > 22 = 2 x 11

En cambio, el 7 tiene una pareja de primos equidistantes (la (5, 11)) cuyo producto es mayor que el cuadrado de 7.

   7^2 = 49 < 55 = 5 x 11

1	7^2 = 49 < 55 = 5 x 11

Un buen primo es un número primo cuyo cuadrado es mayor que el producto de dos primos cualesquiera equidistantes de él en la sucesión de primos. Por ejemplo, 5 es un buen primo pero 7 no lo es.

Definir las funciones

   esBuenPrimo  :: Integer -> Bool
   buenosPrimos :: [Integer]

1 2	esBuenPrimo :: Integer -> Bool buenosPrimos :: [Integer]

tales que

(esBuenPrimo n) se verifica si n es un buen primo. Por ejemplo,

     esBuenPrimo 5        ==  True
     esBuenPrimo 7        ==  False
     esBuenPrimo 8746811  ==  True

esBuenPrimo 5 == True

esBuenPrimo 7 == False

esBuenPrimo 8746811 == True

buenosPrimos es la lista de los buenos primos. Por ejemplo,

     λ> take 12 buenosPrimos
     [2,5,11,17,29,37,41,53,59,67,71,97]

1 2	λ> take 12 buenosPrimos [2,5,11,17,29,37,41,53,59,67,71,97]

Comprobar con QuickCheck que la lista de los buenos primos es infinita; es decir, para cualquier entero positivo n existe un número mayor que n que es un buen primo.

Soluciones

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

esBuenPrimo :: Integer -> Bool
esBuenPrimo n =
  n == y && and [n^2 > x * y | (x, y) <- zip (reverse xs) ys]
  where (xs,y:ys) = span (< n) primes

buenosPrimos :: [Integer]
buenosPrimos = filter esBuenPrimo [2..]

-- La propiedad es
prop_buenosPrimos :: Integer -> Property
prop_buenosPrimos n =
  n > 0 ==> any esBuenPrimo [n+1..]

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

import Data.Numbers.Primes (primes)

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

esBuenPrimo :: Integer -> Bool

esBuenPrimo n =

n == y && and [n^2 > x * y | (x, y) <- zip (reverse xs) ys]

where (xs,y:ys) = span (< n) primes

buenosPrimos :: [Integer]

buenosPrimos = filter esBuenPrimo [2..]

-- La propiedad es

prop_buenosPrimos :: Integer -> Property

prop_buenosPrimos n =

n > 0 ==> any esBuenPrimo [n+1..]

-- La comprobación es

-- λ> quickCheck prop_buenosPrimos

-- +++ OK, passed 100 tests.

Números equidigitales

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

Un número equidigital es un número natural que tiene el mismo número de dígitos que el número de dígitos en su factorización prima, incluidos los exponentes mayores que 1. Por ejemplo,

10 es equidigital ya que tiene 2 dígitos al igual que su factorización prima (2 x 5).
25 es equidigital ya que tiene 2 dígitos al igual que su factorización prima (5^2).
121 es equidigital ya que tiene 3 dígitos al igual que su factorización prima (11^2).
175 es equidigital ya que tiene 3 dígitos al igual que su factorización prima (5^2 x 7).
1125 es equidigital ya que tiene 4 dígitos al igual que su factorización prima (3^2 x 5^3).
2021 es equidigital ya que tiene 4 dígitos al igual que su factorización prima (43 x 47).
3072 es equidigital ya que tiene 4 dígitos al igual que su factorización prima (3 x 2^10).

Definir las funciones

   esEquidigital :: Int -> Bool
   equidigitales :: [Int]

1 2	esEquidigital :: Int -> Bool equidigitales :: [Int]

tal que

(esEquidigital x) se verifica si x es un número equidigital. Por ejemplo.

     esEquidigital 10    ==  True
     esEquidigital 11    ==  True
     esEquidigital 2021  ==  True
     esEquidigital 2022  ==  False

esEquidigital 10 == True

esEquidigital 11 == True

esEquidigital 2021 == True

esEquidigital 2022 == False

equidigitales es la lista de los números equidigitales. Por ejemplo,

     λ> take 20 equidigitales
     [2,3,5,7,10,11,13,14,15,16,17,19,21,23,25,27,29,31,32,35]
     λ> equidigitales !! 755
     2021
     λ> equidigitales !! 100000
     405341

λ> take 20 equidigitales

[2,3,5,7,10,11,13,14,15,16,17,19,21,23,25,27,29,31,32,35]

λ> equidigitales !! 755

2021

λ> equidigitales !! 100000

405341

Comprobar con QuickChek que el conjunto de los números equidigitales es infinito; es decir, para cada entero n existe un equidigital mayor que n.

Soluciones

import Data.Numbers.Primes
import Data.List
import Test.QuickCheck

esEquidigital :: Int -> Bool
esEquidigital x =
  nDigitos x == nDigitosFactorizacion x

-- (nDigitos n) es el número de dígitos de n. Por ejemplo,
--    nDigitos 2021  ==  4
nDigitos :: Int -> Int
nDigitos = length . show

-- (nDigitosFactorizacion x) es el número de dígitos en la factorización
-- prima de x, incluyendo los exponentes mayores que 1. Por ejemplo,
--    nDigitosFactorizacion 3000  ==  5
--    nDigitosFactorizacion 2021  ==  4
--    nDigitosFactorizacion 3072  ==  4
nDigitosFactorizacion :: Int -> Int
nDigitosFactorizacion x =
  sum [nDigitos y + aux n | (y,n) <- factorizacion x]
  where aux 1 = 0
        aux n = nDigitos n

-- (factorizacion x) es la factorización prima de x expresada como una
-- lista de pares que son las bases y los exponentes. Por ejemplo,
--    factorizacion 3000  ==  [(2,3),(3,1),(5,3)]
--    factorizacion 2021  ==  [(43,1),(47,1)]
--    factorizacion 3072  ==  [(2,10),(3,1)]
factorizacion :: Int -> [(Int,Int)]
factorizacion x =
  [(y, 1 + length ys) | (y:ys) <- group (primeFactors x)]

equidigitales :: [Int]
equidigitales = filter esEquidigital [1..]

-- La propiedad es
prop_equidigitales :: Int -> Property
prop_equidigitales n =
  n > 0 ==> any esEquidigital [n+1..]

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

import Data.Numbers.Primes

import Data.List

import Test.QuickCheck

esEquidigital :: Int -> Bool

esEquidigital x =

nDigitos x == nDigitosFactorizacion x

-- (nDigitos n) es el número de dígitos de n. Por ejemplo,

-- nDigitos 2021 == 4

nDigitos :: Int -> Int

nDigitos = length . show

-- (nDigitosFactorizacion x) es el número de dígitos en la factorización

-- prima de x, incluyendo los exponentes mayores que 1. Por ejemplo,

-- nDigitosFactorizacion 3000 == 5

-- nDigitosFactorizacion 2021 == 4

-- nDigitosFactorizacion 3072 == 4

nDigitosFactorizacion :: Int -> Int

nDigitosFactorizacion x =

sum [nDigitos y + aux n | (y,n) <- factorizacion x]

where aux 1 = 0

aux n = nDigitos n

-- (factorizacion x) es la factorización prima de x expresada como una

-- lista de pares que son las bases y los exponentes. Por ejemplo,

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

-- factorizacion 2021 == [(43,1),(47,1)]

-- factorizacion 3072 == [(2,10),(3,1)]

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

factorizacion x =

[(y, 1 + length ys) | (y:ys) <- group (primeFactors x)]

equidigitales :: [Int]

equidigitales = filter esEquidigital [1..]

-- La propiedad es

prop_equidigitales :: Int -> Property

prop_equidigitales n =

n > 0 ==> any esEquidigital [n+1..]

-- La comprobación es

-- λ> quickCheck prop_equidigitales

-- +++ OK, passed 100 tests.

Números compuestos persistentes

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

Un número compuesto persistente es un número compuesto que no se puede transformar en un número primo cambiando sólo uno de sus dígitos. Por ejemplo,

20 no es un compuesto persistente porque cambiando su último dígito por un 3 se transforma en 23 que es primo.
25 no es un compuesto persistente porque cambiando su primer dígito por un 0 se transforma en 5 que es primo.
200 es un compuesto persistente ya que al cambiar su útimo dígito por un impar se obtienen los números 201, 203, 207, 205 y 209 que no son primos y todos sus demás transformados son pares y, por tanto, tampoco son primos.

Definir las funciones

   esCompuestoPersistente :: Integer -> Bool
   compuestosPersistentes :: [Integer]

1 2	esCompuestoPersistente :: Integer -> Bool compuestosPersistentes :: [Integer]

tales que

(esCompuestoPersistente n) se verifica si n es un número compuesto persistente. Por ejemplo,

     esCompuestoPersistente 20    ==  False
     esCompuestoPersistente 200   ==  True
     esCompuestoPersistente 2021  ==  False

esCompuestoPersistente 20 == False

esCompuestoPersistente 200 == True

esCompuestoPersistente 2021 == False

compuestosPersistentes es la lista de los números compuestos persistentes. Por ejemplo,

     λ> take 10 compuestoPersistentes
     [200,204,206,208,320,322,324,325,326,328]

1 2	λ> take 10 compuestoPersistentes [200,204,206,208,320,322,324,325,326,328]

Comprobar con QuickCheck que todos los números de la forma 510+2310*k son números compuestos persistentes.

Soluciones

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

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

esCompuestoPersistente :: Integer -> Bool
esCompuestoPersistente n =
  esCompuesto n && all (not . isPrime) (transformados n)

-- (eCompuesto n) se verifica si n es un número compuesto. Por ejemplo,
--    esCompuesto 15  ==  True
--    esCompuesto 16  ==  True
--    esCompuesto 17  ==  False
esCompuesto :: Integer -> Bool
esCompuesto n =  n > 1 && not (isPrime n)

-- (transformados n) es la lista delos números obtenidos modificando uno
-- de los dígitos de n. Por ejemplo,
--    λ> transformados 27
--    [7,17,37,47,57,67,77,87,97,20,21,22,23,24,25,26,28,29]
transformados :: Integer -> [Integer]
transformados n = map read (aux (show n))
  where aux []     = []
        aux [x]    = [[y] | y <- ['0'..'9'], y /= x]
        aux (x:xs) = [y:xs | y <- ['0'..'9'], y /= x] ++
                     [x:ys | ys <- aux xs]

compuestosPersistentes :: [Integer]
compuestosPersistentes = filter esCompuestoPersistente [1..]

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

esCompuestoPersistente2 :: Integer -> Bool
esCompuestoPersistente2 n =
  not (any (esTransformadoDe n) (takeWhile (<=10^m-1) primes))
  where m = length (show n)

-- (esTransformadoDe m n) se verifica si n se puede obtener modificando uno
-- de los dígitos de n. Por ejemplo,
--    esTransformadoDe 27 47  ==  True
--    esTransformadoDe 27 25  ==  True
--    esTransformadoDe 27 45  ==  False
--    esTransformadoDe 27 7   ==  True
--    esTransformadoDe 27 2   ==  False
esTransformadoDe :: Integer -> Integer -> Bool
esTransformadoDe m n =
  1 == length (filter (==False) (zipWith (==) xs zs))
  where xs = show m
        ys = show n
        zs = replicate (length xs - length ys) '0' ++ ys

compuestosPersistentes2 :: [Integer]
compuestosPersistentes2 = filter esCompuestoPersistente2 [1..]

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

esCompuestoPersistente3 :: Integer -> Bool
esCompuestoPersistente3 n =
  null (primosTransformados n)

-- (primosTransformados n) es la lista de los números primos que se
-- puede obtener modificando uno de los dígitos de n. Por ejemplo,
--    primosTransformados 27   ==  [17,23,29,37,47,67,97,7]
--    primosTransformados 26   ==  [23,29]
--    primosTransformados 200  ==  []
--    primosTransformados 202  ==  [2]
primosTransformados :: Integer -> [Integer]
primosTransformados n =
  [x | x <- primosNdigitos p, difierenEnUnaPosicion n x] ++
  [x | x <- [read ('0' : tail ns)], isPrime x]
  where ns = show n
        p  = length ns

-- (difierenEnUnaPosicion m n) se verifica si los números m y n difieren
-- en una posición (suponiendo que m y n tienen el mismo número de
-- dígitos). Por ejemplo,
--    difierenEnUnaPosicion 325 375  ==  True
--    difierenEnUnaPosicion 325 357  ==  False
difierenEnUnaPosicion :: Integer -> Integer -> Bool
difierenEnUnaPosicion m n =
  1 == length (filter (==False) (zipWith (==) (show m) (show n)))

-- (primosNdigitos n) es la lista de los primos con n dígitos. Por
-- ejemplo,
--    λ> primosNdigitos 2
--    [11,13,17,19,23,29,31,37,41,43,47,53,59,61,67,71,73,79,83,89,97]
primosNdigitos :: Int -> [Integer]
primosNdigitos n = takeWhile (<=10^n-1) (dropWhile (<=10^(n-1)) primes)

compuestosPersistentes3 :: [Integer]
compuestosPersistentes3 = filter esCompuestoPersistente3 [1..]

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

esCompuestoPersistente4 :: Integer -> Bool
esCompuestoPersistente4 n =
  null (primosTransformados2 n)

-- (primosTransformados2 n) es la lista de los números primos que se
-- puede obtener modificando uno de los dígitos de n. Por ejemplo,
--    primosTransformados2 27   ==  [17,23,29,37,47,67,97,7]
--    primosTransformados2 26   ==  [23,29]
--    primosTransformados2 200  ==  []
--    primosTransformados2 202  ==  [2]
primosTransformados2 :: Integer -> [Integer]
primosTransformados2 n =
  [x | x <- primosEntre (menorTransformado n) (mayorTransformado n)
     , difierenEnUnaPosicion n x] ++
  [x | x <- [read ('0' : tail ns)], isPrime x]
  where ns = show n
        p  = length ns

-- (primosEntre x y) lista de números prios mayores o iguales que x y
-- menores o iguales que y. Por ejemplo,
--    primosEntre 11 41  ==  [11,13,17,19,23,29,31,37,41]
primosEntre ::Integer -> Integer -> [Integer]
primosEntre x y = takeWhile (<= y) (dropWhile (< x) primes)

-- (menorTransformado x) es el menor número, con la misma cantidad de
-- dígitos que x, que se puede obtener modificando uno de los dígitos de
-- n. Por ejemplo,
--    menorTransformado 375   ==  175
--    menorTransformado 14    ==  11
--    menorTransformado 4     ==  1
--    menorTransformado 1145  ==  1115
menorTransformado :: Integer -> Integer
menorTransformado x
  | x <= 9    = 1
  | y > '1'   = read ('1' : ys)
  | otherwise = read ('1' : show (menorTransformado (read ys)))
  where (y:ys) = show x

-- (mayorTransformado x) es el mayor número, con la misma cantidad de
-- dígitos que x, que se puede obtener modificando uno de los dígitos de
-- n. Por ejemplo,
--    mayorTransformado 375   ==  975
--    mayorTransformado 93    ==  99
--    mayorTransformado 4     ==  9
--    mayorTransformado 9945  ==  9995
mayorTransformado :: Integer -> Integer
mayorTransformado x
  | x <= 9    = 9
  | y < '9'   = read ('9' : ys)
  | otherwise = read ('9' : show (mayorTransformado (read ys)))
  where (y:ys) = show x

compuestosPersistentes4 :: [Integer]
compuestosPersistentes4 = filter esCompuestoPersistente4 [1..]

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

-- La comparación es
--    λ> compuestosPersistentes !! 1000
--    8180
--    (0.54 secs, 1,577,628,232 bytes)
--    λ> compuestosPersistentes2 !! 1000
--    8180
--    (10.13 secs, 15,883,929,392 bytes)
--    λ> compuestosPersistentes3 !! 1000
--    8180
--    (7.09 secs, 14,165,470,304 bytes)
--    λ> compuestosPersistentes4 !! 1000
--    8180
--    (6.54 secs, 13,332,608,480 bytes)

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

-- La propiedad es
prop_compuestosPersistentes :: Integer -> Property
prop_compuestosPersistentes k =
  k > 0 ==> esCompuestoPersistente (510 + 2310 * k)

-- La comprobación de la propiedad es
--    λ> quickCheck prop_compuestosPersistentes
--    +++ OK, passed 100 tests.

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

167

168

169

170

171

172

173

174

175

176

177

178

179

180

181

import Data.Numbers.Primes (isPrime, primes)

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

-- 1ª solución

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

esCompuestoPersistente :: Integer -> Bool

esCompuestoPersistente n =

esCompuesto n && all (not . isPrime) (transformados n)

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

-- esCompuesto 15 == True

-- esCompuesto 16 == True

-- esCompuesto 17 == False

esCompuesto :: Integer -> Bool

esCompuesto n = n > 1 && not (isPrime n)

-- (transformados n) es la lista delos números obtenidos modificando uno

-- de los dígitos de n. Por ejemplo,

-- λ> transformados 27

-- [7,17,37,47,57,67,77,87,97,20,21,22,23,24,25,26,28,29]

transformados :: Integer -> [Integer]

transformados n = map read (aux (show n))

where aux [] = []

aux [x] = [[y] | y <- ['0'..'9'], y /= x]

aux (x:xs) = [y:xs | y <- ['0'..'9'], y /= x] ++

[x:ys | ys <- aux xs]

compuestosPersistentes :: [Integer]

compuestosPersistentes = filter esCompuestoPersistente [1..]

-- 2ª solución

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

esCompuestoPersistente2 :: Integer -> Bool

esCompuestoPersistente2 n =

not (any (esTransformadoDe n) (takeWhile (<=10^m-1) primes))

where m = length (show n)

-- (esTransformadoDe m n) se verifica si n se puede obtener modificando uno

-- de los dígitos de n. Por ejemplo,

-- esTransformadoDe 27 47 == True

-- esTransformadoDe 27 25 == True

-- esTransformadoDe 27 45 == False

-- esTransformadoDe 27 7 == True

-- esTransformadoDe 27 2 == False

esTransformadoDe :: Integer -> Integer -> Bool

esTransformadoDe m n =

1 == length (filter (==False) (zipWith (==) xs zs))

where xs = show m

ys = show n

zs = replicate (length xs - length ys) '0' ++ ys

compuestosPersistentes2 :: [Integer]

compuestosPersistentes2 = filter esCompuestoPersistente2 [1..]

-- 3ª solución

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

esCompuestoPersistente3 :: Integer -> Bool

esCompuestoPersistente3 n =

null (primosTransformados n)

-- (primosTransformados n) es la lista de los números primos que se

-- puede obtener modificando uno de los dígitos de n. Por ejemplo,

-- primosTransformados 27 == [17,23,29,37,47,67,97,7]

-- primosTransformados 26 == [23,29]

-- primosTransformados 200 == []

-- primosTransformados 202 == [2]

primosTransformados :: Integer -> [Integer]

primosTransformados n =

[x | x <- primosNdigitos p, difierenEnUnaPosicion n x] ++

[x | x <- [read ('0' : tail ns)], isPrime x]

where ns = show n

p = length ns

-- (difierenEnUnaPosicion m n) se verifica si los números m y n difieren

-- en una posición (suponiendo que m y n tienen el mismo número de

-- dígitos). Por ejemplo,

-- difierenEnUnaPosicion 325 375 == True

-- difierenEnUnaPosicion 325 357 == False

difierenEnUnaPosicion :: Integer -> Integer -> Bool

difierenEnUnaPosicion m n =

1 == length (filter (==False) (zipWith (==) (show m) (show n)))

-- (primosNdigitos n) es la lista de los primos con n dígitos. Por

-- ejemplo,

-- λ> primosNdigitos 2

-- [11,13,17,19,23,29,31,37,41,43,47,53,59,61,67,71,73,79,83,89,97]

primosNdigitos :: Int -> [Integer]

primosNdigitos n = takeWhile (<=10^n-1) (dropWhile (<=10^(n-1)) primes)

compuestosPersistentes3 :: [Integer]

compuestosPersistentes3 = filter esCompuestoPersistente3 [1..]

-- 4ª solución

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

esCompuestoPersistente4 :: Integer -> Bool

esCompuestoPersistente4 n =

null (primosTransformados2 n)

-- (primosTransformados2 n) es la lista de los números primos que se

-- puede obtener modificando uno de los dígitos de n. Por ejemplo,

-- primosTransformados2 27 == [17,23,29,37,47,67,97,7]

-- primosTransformados2 26 == [23,29]

-- primosTransformados2 200 == []

-- primosTransformados2 202 == [2]

primosTransformados2 :: Integer -> [Integer]

primosTransformados2 n =

[x | x <- primosEntre (menorTransformado n) (mayorTransformado n)

, difierenEnUnaPosicion n x] ++

[x | x <- [read ('0' : tail ns)], isPrime x]

where ns = show n

p = length ns

-- (primosEntre x y) lista de números prios mayores o iguales que x y

-- menores o iguales que y. Por ejemplo,

-- primosEntre 11 41 == [11,13,17,19,23,29,31,37,41]

primosEntre ::Integer -> Integer -> [Integer]

primosEntre x y = takeWhile (<= y) (dropWhile (< x) primes)

-- (menorTransformado x) es el menor número, con la misma cantidad de

-- dígitos que x, que se puede obtener modificando uno de los dígitos de

-- n. Por ejemplo,

-- menorTransformado 375 == 175

-- menorTransformado 14 == 11

-- menorTransformado 4 == 1

-- menorTransformado 1145 == 1115

menorTransformado :: Integer -> Integer

menorTransformado x

| x <= 9 = 1

| y > '1' = read ('1' : ys)

| otherwise = read ('1' : show (menorTransformado (read ys)))

where (y:ys) = show x

-- (mayorTransformado x) es el mayor número, con la misma cantidad de

-- dígitos que x, que se puede obtener modificando uno de los dígitos de

-- n. Por ejemplo,

-- mayorTransformado 375 == 975

-- mayorTransformado 93 == 99

-- mayorTransformado 4 == 9

-- mayorTransformado 9945 == 9995

mayorTransformado :: Integer -> Integer

mayorTransformado x

| x <= 9 = 9

| y < '9' = read ('9' : ys)

| otherwise = read ('9' : show (mayorTransformado (read ys)))

where (y:ys) = show x

compuestosPersistentes4 :: [Integer]

compuestosPersistentes4 = filter esCompuestoPersistente4 [1..]

-- Comparación de eficiencia

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

-- La comparación es

-- λ> compuestosPersistentes !! 1000

-- 8180

-- (0.54 secs, 1,577,628,232 bytes)

-- λ> compuestosPersistentes2 !! 1000

-- 8180

-- (10.13 secs, 15,883,929,392 bytes)

-- λ> compuestosPersistentes3 !! 1000

-- 8180

-- (7.09 secs, 14,165,470,304 bytes)

-- λ> compuestosPersistentes4 !! 1000

-- 8180

-- (6.54 secs, 13,332,608,480 bytes)

-- Propiedad

-- =========

-- La propiedad es

prop_compuestosPersistentes :: Integer -> Property

prop_compuestosPersistentes k =

k > 0 ==> esCompuestoPersistente (510 + 2310 * k)

-- La comprobación de la propiedad es

-- λ> quickCheck prop_compuestosPersistentes

-- +++ OK, passed 100 tests.

Números bigenerados

PorJosé A. Alonso 14-enero-202121-enero-2021

Se dice que y es un generador de x si x es igual a la suma de y los dígitos de y. Por ejemplo, 1996 y 2014 son generadores de 2021 ya que

   2021 = 1996 + 1 + 9 + 9 + 6
   2021 = 2014 + 2 + 0 + 1 + 4

1 2	2021 = 1996 + 1 + 9 + 9 + 6 2021 = 2014 + 2 + 0 + 1 + 4

Un número bigenerado es un número que tiene exactamente 2 generadores. Por ejemplo,

2021 es un número bigenerados y sus generadores son 1996 y 2014
20 no es bigenerador porque no tiene ningún generador
21 no es bigenerador porque tiene sólo un generador (el 15).
101 es el menor número bigenerado ysus generadores son 91 y 100.

Definir las funciones

   esBigenerado :: Integer -> Bool
   bigenerados  :: [Integer]

1 2	esBigenerado :: Integer -> Bool bigenerados :: [Integer]

tales que

(esBigenerado x) se verifica si x es bigenerado. Por ejemplo,

     esBigenerado 2021  ==  True
     esBigenerado 20    ==  False
     esBigenerado 21    ==  False
     esBigenerado 101   ==  True

esBigenerado 2021 == True

esBigenerado 20 == False

esBigenerado 21 == False

esBigenerado 101 == True

bigenerados es la lista de los números bigenerados. Por ejemplo,

     λ> take 12 bigenerados
     [101,103,105,107,109,111,113,115,117,202,204,206]

1 2	λ> take 12 bigenerados [101,103,105,107,109,111,113,115,117,202,204,206]

Comprobar con QuickCheck que la lista de los números bigenerados es infinita; es decir, para cualquier número positivo n existe un y mayor que x que es bigenerado.

Soluciones

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

esBigenerado :: Integer -> Bool
esBigenerado x = length (generadores x) == 2

-- (generadores x) es la lista de los generadores de x. Por ejemplo,
--    generadores 2021  ==  [1996,2014]
--    generadores 20    ==  []
--    generadores 21    ==  [15]
--    generadores 101   ==  [91,100]
generadores :: Integer -> [Integer]
generadores x = filter (esGenerador x) [1..x]

-- (esGenerador x y) se verifica si y es un generador de x. Por ejemplo,
--    esGenerador 818 796  ==  True
--    esGenerador 818 805  ==  True
esGenerador :: Integer -> Integer -> Bool
esGenerador x y = x == y + sumaDigitos y

-- (sumaDigitos n) es la suma de los dígitos de n. Por ejemplo,
--    sumaDigitos 2021  ==  5
sumaDigitos :: Integer -> Integer
sumaDigitos = sum . digitos

-- (digitos n) es la lista de los dígitos de n. Por ejemplo,
--    digitos 2021  ==  [2,0,2,1]
digitos :: Integer -> [Integer]
digitos x = [read [c] | c <- show x]

bigenerados :: [Integer]
bigenerados = filter esBigenerado [1..]

-- La propiedad es
prop_bigenerados :: Integer -> Property
prop_bigenerados n =
  n >= 0 ==> any esBigenerado [n+1..]

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

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

esBigenerado :: Integer -> Bool

esBigenerado x = length (generadores x) == 2

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

-- generadores 2021 == [1996,2014]

-- generadores 20 == []

-- generadores 21 == [15]

-- generadores 101 == [91,100]

generadores :: Integer -> [Integer]

generadores x = filter (esGenerador x) [1..x]

-- (esGenerador x y) se verifica si y es un generador de x. Por ejemplo,

-- esGenerador 818 796 == True

-- esGenerador 818 805 == True

esGenerador :: Integer -> Integer -> Bool

esGenerador x y = x == y + sumaDigitos y

-- (sumaDigitos n) es la suma de los dígitos de n. Por ejemplo,

-- sumaDigitos 2021 == 5

sumaDigitos :: Integer -> Integer

sumaDigitos = sum . digitos

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

-- digitos 2021 == [2,0,2,1]

digitos :: Integer -> [Integer]

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

bigenerados :: [Integer]

bigenerados = filter esBigenerado [1..]

-- La propiedad es

prop_bigenerados :: Integer -> Property

prop_bigenerados n =

n >= 0 ==> any esBigenerado [n+1..]

-- La comprobación es

-- λ> quickCheck prop_bigenerados

-- +++ 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>

Números cíclicos

PorJosé A. Alonso 13-enero-202120-enero-2021

La indicatriz de Euler (también llamada función φ de Euler) es una función importante en teoría de números. Si n es un entero positivo, entonces φ(n) se define como el número de enteros positivos menores o iguales a n y coprimos con n. Por ejemplo,

φ(15) = 8 ya que los números menores o iguales a 36 y coprimos con 36 son ocho: 1, 2, 4, 7, 8, 11, 13 y 14.
φ(21) = 12 ya que los números menores o iguales a 36 y coprimos con 36 son doce: 1, 2, 4, 5, 8, 10, 11, 13, 16, 17, 19 y 20.

Un número n es un número cíclico si n y φ(n) no tiene ningún divisor primo común. Por ejemplo, el número 15 es cíclico ya que 15 y 8 (que es φ(15)) no tiene ningún divisor primo común; en cambio, el número 21 no es cíclico ya 21 y 12 (que es φ(21)) son divisibles por 3.

Definir las funciones

   esCiclico :: Integer -> Bool
   ciclicos  :: [Integer]

1 2	esCiclico :: Integer -> Bool ciclicos :: [Integer]

tales que

(esCiclico n) se verifica si n es un número cíclico. Por ejemplo,

     esCiclico 15    ==  True
     esCiclico 16    ==  False
     esCiclico 2021  ==  True
     esCiclico (product [1..10^4])  ==  False

esCiclico 15 == True

esCiclico 16 == False

esCiclico 2021 == True

esCiclico (product [1..10^4]) == False

ciclicos es la lista de los números cíclicos. Por ejemplo,

     λ> take 20 ciclicos
     [2,3,5,7,11,13,15,17,19,23,29,31,33,35,37,41,43,47,51,53]
     λ> ciclicos !! (10^5)
     336059

λ> take 20 ciclicos

[2,3,5,7,11,13,15,17,19,23,29,31,33,35,37,41,43,47,51,53]

λ> ciclicos !! (10^5)

336059

Comprobar con QuickCheck que todos los números primos mayores que 2 son cíclicos.

Soluciones

module Numeros_ciclicos where

import Data.List (genericLength, group)
import Data.Numbers.Primes (primeFactors, primes)
import Test.QuickCheck (Property, (==>), quickCheck)

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

ciclicos1 :: [Integer]
ciclicos1 = filter esCiclico1 [2..]

esCiclico1 :: Integer -> Bool
esCiclico1 n = gcd n (phi1 n) == 1

-- (phi1 n) es igual a φ(n). Por ejemplo,
--    phi1 15    ==  8
--    phi1 21    ==  12
--    phi1 2021  ==  1932
phi1 :: Integer -> Integer
phi1 n = genericLength [x | x <- [1..n], gcd x n == 1]

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

ciclicos2 :: [Integer]
ciclicos2 = filter esCiclico2 [2..]

esCiclico2 :: Integer -> Bool
esCiclico2 n = gcd n (phi2 n) == 1

-- (phi2 n) es igual a φ(n). Por ejemplo,
--    phi2 15    ==  8
--    phi2 21    ==  12
--    phi2 2021  ==  1932
phi2 :: Integer -> Integer
phi2 n = product [(p-1)*p^(e-1) | (p,e) <- factorizacion n]

-- (factorizacion n) es la descomposición de n en factores primos como
-- una lista de pares donde los primeros elementos son la base y los
-- segundo son los exponentes. Por ejemplo,
--    factorizacion 3000  ==  [(2,3),(3,1),(5,3)]
-- ya que 3000 = 2^3*3*5^3
factorizacion :: Integer -> [(Integer,Integer)]
factorizacion n =
  [(head xs,genericLength xs) | xs <- group (primeFactors n)]

-- 3ª definición
-- =============

ciclicos3 :: [Integer]
ciclicos3 = filter esCiclico3 [2..]

esCiclico3 :: Integer -> Bool
esCiclico3 n = gcd n (phi3 n) == 1

-- (phi3 n) es igual a φ(n). Por ejemplo,
--    phi3 15    ==  8
--    phi3 21    ==  12
--    phi3 2021  ==  1932
phi3 :: Integer -> Integer
phi3 n =
  product [(x-1) * product xs | (x:xs) <- group (primeFactors n)]

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

-- La comparación es
--    λ> esCiclico1 (4*10^6)
--    False
--    (3.64 secs, 4,448,223,616 bytes)
--    λ> esCiclico2 (4*10^6)
--    False
--    (0.01 secs, 116,144 bytes)
--    λ> esCiclico3 (4*10^6)
--    False
--    (0.01 secs, 111,336 bytes)
--
--    λ> esCiclico2 (product [1..3*10^4])
--    False
--    (2.49 secs, 5,846,361,904 bytes)
--    λ> esCiclico3 (product [1..3*10^4])
--    False
--    (2.50 secs, 5,947,164,552 bytes)


-- Verificación de la propiedad
-- ============================

-- La propiedad es
prop_ciclicos :: Int -> Property
prop_ciclicos n =
    n > 1 ==> esCiclico3 (primes !! n)

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

verificacion :: IO ()
verificacion = quickCheck prop_ciclicos

100

module Numeros_ciclicos where

import Data.List (genericLength, group)

import Data.Numbers.Primes (primeFactors, primes)

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

-- 1ª definición

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

ciclicos1 :: [Integer]

ciclicos1 = filter esCiclico1 [2..]

esCiclico1 :: Integer -> Bool

esCiclico1 n = gcd n (phi1 n) == 1

-- (phi1 n) es igual a φ(n). Por ejemplo,

-- phi1 15 == 8

-- phi1 21 == 12

-- phi1 2021 == 1932

phi1 :: Integer -> Integer

phi1 n = genericLength [x | x <- [1..n], gcd x n == 1]

-- 2ª definición

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

ciclicos2 :: [Integer]

ciclicos2 = filter esCiclico2 [2..]

esCiclico2 :: Integer -> Bool

esCiclico2 n = gcd n (phi2 n) == 1

-- (phi2 n) es igual a φ(n). Por ejemplo,

-- phi2 15 == 8

-- phi2 21 == 12

-- phi2 2021 == 1932

phi2 :: Integer -> Integer

phi2 n = product [(p-1)*p^(e-1) | (p,e) <- factorizacion n]

-- (factorizacion n) es la descomposición de n en factores primos como

-- una lista de pares donde los primeros elementos son la base y los

-- segundo son los exponentes. Por ejemplo,

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

-- ya que 3000 = 2^3*3*5^3

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

factorizacion n =

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

-- 3ª definición

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

ciclicos3 :: [Integer]

ciclicos3 = filter esCiclico3 [2..]

esCiclico3 :: Integer -> Bool

esCiclico3 n = gcd n (phi3 n) == 1

-- (phi3 n) es igual a φ(n). Por ejemplo,

-- phi3 15 == 8

-- phi3 21 == 12

-- phi3 2021 == 1932

phi3 :: Integer -> Integer

phi3 n =

product [(x-1) * product xs | (x:xs) <- group (primeFactors n)]

-- Comparación de eficiencia

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

-- La comparación es

-- λ> esCiclico1 (4*10^6)

-- False

-- (3.64 secs, 4,448,223,616 bytes)

-- λ> esCiclico2 (4*10^6)

-- False

-- (0.01 secs, 116,144 bytes)

-- λ> esCiclico3 (4*10^6)

-- False

-- (0.01 secs, 111,336 bytes)

-- λ> esCiclico2 (product [1..3*10^4])

-- False

-- (2.49 secs, 5,846,361,904 bytes)

-- λ> esCiclico3 (product [1..3*10^4])

-- False

-- (2.50 secs, 5,947,164,552 bytes)

-- Verificación de la propiedad

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

-- La propiedad es

prop_ciclicos :: Int -> Property

prop_ciclicos n =

n > 1 ==> esCiclico3 (primes !! n)

-- La comprobación es

-- λ> quickCheck prop_ciclicos

-- +++ OK, passed 100 tests.

verificacion :: IO ()

verificacion = quickCheck prop_ciclicos

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 duffinianos

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

Los números duffinianos, llamados así por Richard Duffy, son los números compuestos n que son coprimos con la suma de sus divisores; es decir, n y la suma de los divisores de n no tienen ningún factor primo común.

Por ejemplo, 35 es un número duffiniano ya que la suma de sus divisores es 1 + 5 + 7 + 35 = 48 que es coprimo con 35.

Definir las funciones

   esDuffiniano :: Integer -> Bool
   duffinianos :: [Integer]

1 2	esDuffiniano :: Integer -> Bool duffinianos :: [Integer]

tales que

(esDuffiniano n) se verifica si n es duffiniano. Por ejemplo,

     esDuffiniano 35    ==  True
     esDuffiniano 2021  ==  True
     esDuffiniano 11    ==  False
     esDuffiniano 12    ==  False
     esDuffiniano (product [1..2*10^4])  ==  False

esDuffiniano 35 == True

esDuffiniano 2021 == True

esDuffiniano 11 == False

esDuffiniano 12 == False

esDuffiniano (product [1..2*10^4]) == False

duffinianos es la sucesión de los números duffinianos. Por ejemplo,

     take 12 duffinianos  ==  [4,8,9,16,21,25,27,32,35,36,39,49]
     length (takeWhile (< 10^5) duffinianos)  ==  24434

1 2	take 12 duffinianos == [4,8,9,16,21,25,27,32,35,36,39,49] length (takeWhile (< 10^5) duffinianos) == 24434

Comprobar con QuickCheck que los números de la forma p^k, con p un primo mayor que 2 y k un entero mayor que 1, son duffinianos.

Soluciones

import Data.List (genericLength, group)
import Data.Numbers.Primes (isPrime, primeFactors, primes)
import Test.QuickCheck (Property, (==>), quickCheck)

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

duffinianos :: [Integer]
duffinianos = filter esDuffiniano [1..]

esDuffiniano :: Integer -> Bool
esDuffiniano n =
  n > 1 &&
  not (isPrime n) &&
  gcd n (sumaDivisores n) == 1

-- (sumaDivisores n) es la suma de los divisores de n. Por ejemplo.
--      sumaDivisores 35  ==  48
sumaDivisores :: Integer -> Integer
sumaDivisores = sum . divisores

-- (divisores n) es la lista de los divisores de n. Por ejemplo,
--      divisores 35  ==  [1,5,7,35]
divisores :: Integer -> [Integer]
divisores n = [x | x <- [1..n]
                 , n `mod` x == 0]

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

duffinianos2 :: [Integer]
duffinianos2 = filter esDuffiniano2 [1..]

esDuffiniano2 :: Integer -> Bool
esDuffiniano2 n =
  n > 1 &&
  not (isPrime n) &&
  gcd n (sumaDivisores2 n) == 1

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

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

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

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

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

-- La comparación es
--    λ> esDuffiniano (product [1..11])
--    False
--    (14.09 secs, 7,983,535,608 bytes)
--    λ> esDuffiniano2 (product [1..11])
--    False
--    (0.01 secs, 125,760 bytes)
--
--    λ> head (dropWhile (<10^4) duffinianos)
--    10000
--    (13.45 secs, 8,872,967,976 bytes)
--    λ> head (dropWhile (<10^4) duffinianos2)
--    10000
--    (0.15 secs, 280,668,240 bytes)
--
--    λ> length (takeWhile (<10^4) duffinianos)
--    2370
--    (13.43 secs, 8,966,138,016 bytes)
--    λ> length (takeWhile (<10^4) duffinianos2)
--    2370
--    (0.15 secs, 286,120,048 bytes)

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

-- La propiedad es
prop_duffinianos :: Int -> Int -> Property
prop_duffinianos n k =
  n >= 0 && k > 1 ==> esDuffiniano2 (p^k)
  where p = primes !! n

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

100

101

102

103

import Data.List (genericLength, group)

import Data.Numbers.Primes (isPrime, primeFactors, primes)

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

-- 1ª solución

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

duffinianos :: [Integer]

duffinianos = filter esDuffiniano [1..]

esDuffiniano :: Integer -> Bool

esDuffiniano n =

n > 1 &&

not (isPrime n) &&

gcd n (sumaDivisores n) == 1

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

-- sumaDivisores 35 == 48

sumaDivisores :: Integer -> Integer

sumaDivisores = sum . divisores

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

-- divisores 35 == [1,5,7,35]

divisores :: Integer -> [Integer]

divisores n = [x | x <- [1..n]

, n `mod` x == 0]

-- 2ª solución

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

duffinianos2 :: [Integer]

duffinianos2 = filter esDuffiniano2 [1..]

esDuffiniano2 :: Integer -> Bool

esDuffiniano2 n =

n > 1 &&

not (isPrime n) &&

gcd n (sumaDivisores2 n) == 1

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

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

-- entonces la suma de los divisores de x es

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

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

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

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

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

-- sumaDivisores2 35 == 48

sumaDivisores2 :: Integer -> Integer

sumaDivisores2 x =

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

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

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

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

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

factorizacion = map primeroYlongitud . group . primeFactors

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

-- y la longitud de xs. Por ejemplo,

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

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

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

primeroYlongitud _ = error "No tiene elementos"

-- Comparación de eficiencia

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

-- La comparación es

-- λ> esDuffiniano (product [1..11])

-- False

-- (14.09 secs, 7,983,535,608 bytes)

-- λ> esDuffiniano2 (product [1..11])

-- False

-- (0.01 secs, 125,760 bytes)

-- λ> head (dropWhile (<10^4) duffinianos)

-- 10000

-- (13.45 secs, 8,872,967,976 bytes)

-- λ> head (dropWhile (<10^4) duffinianos2)

-- 10000

-- (0.15 secs, 280,668,240 bytes)

-- λ> length (takeWhile (<10^4) duffinianos)

-- 2370

-- (13.43 secs, 8,966,138,016 bytes)

-- λ> length (takeWhile (<10^4) duffinianos2)

-- 2370

-- (0.15 secs, 286,120,048 bytes)

-- Propiedad

-- =========

-- La propiedad es

prop_duffinianos :: Int -> Int -> Property

prop_duffinianos n k =

n >= 0 && k > 1 ==> esDuffiniano2 (p^k)

where p = primes !! n

-- La comprobación es

-- λ> quickCheck prop_duffinianos

-- +++ 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>

Meses: enero 2021

Terna pitagórica en la que el perímetro es múltiplo de uno de los catetos

Soluciones

Nuevas soluciones

El número de Dottie

Soluciones

Nuevas soluciones

Árboles acotados

Soluciones

Nuevas soluciones

Limitación del número de repeticiones

Soluciones

Nuevas soluciones

Potencias de dos más cercanas

Soluciones

Nuevas soluciones

La serie 1 – 2 + 3 – 4 + ···

Soluciones

Clausura respecto del valor absoluto de las diferencias

Soluciones

Números en potencias de dos

Soluciones

Buenos primos

Soluciones

Números equidigitales

Soluciones

Números compuestos persistentes

Soluciones

Números bigenerados

Soluciones

Nuevas soluciones

Números cíclicos

Soluciones

Nuevas soluciones

Números duffinianos

Soluciones

Nuevas soluciones

Entradas recientes

Buscar

Correo electrónico