Medio

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>

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>

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)

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.

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

Limitación del número de repeticiones

Soluciones

Nuevas soluciones

Clausura respecto del valor absoluto de las diferencias

Soluciones

Buenos primos

Soluciones

Entradas recientes

Buscar

Correo electrónico