show – Exercitium

Números con todos sus dígitos primos

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

Definir la lista

   numerosConDigitosPrimos :: [Integer]

1	numerosConDigitosPrimos :: [Integer]

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

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

λ> take 22 numerosConDigitosPrimos

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

λ> numerosConDigitosPrimos !! (10^7)

322732232572

Soluciones

module Numeros_con_digitos_primos where

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

module Numeros_con_digitos_primos where

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

import Data.Char (intToDigit)

-- 1ª solución

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

numerosConDigitosPrimos1 :: [Integer]

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

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

-- primos. Por ejemplo,

-- digitosPrimos 352 == True

-- digitosPrimos 362 == False

digitosPrimos :: Integer -> Bool

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

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

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

digitos :: Integer -> [Integer]

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

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

-- ejemplo,

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

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

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

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

-- 2ª solución

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

numerosConDigitosPrimos2 :: [Integer]

numerosConDigitosPrimos2 =

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

-- 3ª solución

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

-- λ> take 60 numerosConDigitosPrimos2

-- [ 2, 3, 5, 7,

-- 22, 23, 25, 27,

-- 32, 33, 35, 37,

-- 52, 53, 55, 57,

-- 72, 73, 75, 77,

-- 222,223,225,227,

-- 232,233,235,237,

-- 252,253,255,257,

-- 272,273,275,277,

-- 322,323,325,327,

-- 332,333,335,337,

-- 352,353,355,357,

-- 372,373,375,377,

-- 522,523,525,527,

-- 532,533,535,537]

numerosConDigitosPrimos3 :: [Integer]

numerosConDigitosPrimos3 =

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

-- 4ª solución

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

-- λ> take 60 numerosConDigitosPrimos2

-- [ 2, 3, 5, 7,

-- 22,23,25,27,

-- 32,33,35,37,

-- 52,53,55,57,

-- 72,73,75,77,

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

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

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

numerosConDigitosPrimos4 :: [Integer]

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

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

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

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

-- [25,26,28,

-- 35,36,38,

-- 55,56,58,

-- 75,76,78]

siguiente :: [Integer] -> [Integer]

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

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

-- número n. Por ejemplo,

-- pega 3 35 == 335

pega :: Int -> Integer -> Integer

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

-- Comprobación de equivalencia

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

-- La propiedad es

prop_numerosConDigitosPrimos :: NonNegative Int -> Bool

prop_numerosConDigitosPrimos (NonNegative n) =

all (== numerosConDigitosPrimos1 !! n)

[ numerosConDigitosPrimos2 !! n

, numerosConDigitosPrimos3 !! n

, numerosConDigitosPrimos4 !! n

]

-- La comprobación es

-- λ> quickCheck prop_numerosConDigitosPrimos

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> numerosConDigitosPrimos1 !! 5000

-- 752732

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

-- λ> numerosConDigitosPrimos2 !! 5000

-- 752732

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

-- λ> numerosConDigitosPrimos3 !! 5000

-- 752732

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

-- λ> numerosConDigitosPrimos4 !! 5000

-- 752732

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

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

-- 322732232572

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

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

-- 322732232572

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

El código se encuentra en GitHub.

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

Números triangulares con n cifras distintas

PorJosé A. Alonso 5-abril-202212-abril-2022

Los números triangulares se forman como sigue

   *     *      *
        * *    * *
              * * *
   1     3      6

* * *

* * * *

* * *

1 3 6

La sucesión de los números triangulares se obtiene sumando los números naturales. Así, los 5 primeros números triangulares son

    1 = 1
    3 = 1 + 2
    6 = 1 + 2 + 3
   10 = 1 + 2 + 3 + 4
   15 = 1 + 2 + 3 + 4 + 5

1 = 1

3 = 1 + 2

6 = 1 + 2 + 3

10 = 1 + 2 + 3 + 4

15 = 1 + 2 + 3 + 4 + 5

Definir la función

   triangularesConCifras :: Int -> [Integer]

1	triangularesConCifras :: Int -> [Integer]

tal que (triangulares n) es la lista de los números triangulares con n cifras distintas. Por ejemplo,

   take 6 (triangularesConCifras 1)   ==  [1,3,6,55,66,666]
   take 6 (triangularesConCifras 2)   ==  [10,15,21,28,36,45]
   take 6 (triangularesConCifras 3)   ==  [105,120,136,153,190,210]
   take 5 (triangularesConCifras 4)   ==  [1035,1275,1326,1378,1485]
   take 2 (triangularesConCifras 10)  ==  [1062489753,1239845706]

take 6 (triangularesConCifras 1) == [1,3,6,55,66,666]

take 6 (triangularesConCifras 2) == [10,15,21,28,36,45]

take 6 (triangularesConCifras 3) == [105,120,136,153,190,210]

take 5 (triangularesConCifras 4) == [1035,1275,1326,1378,1485]

take 2 (triangularesConCifras 10) == [1062489753,1239845706]

Soluciones

import Data.List (nub)
import Test.QuickCheck

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

triangularesConCifras1 :: Int -> [Integer]
triangularesConCifras1 n =
  [x | x <- triangulares1,
       nCifras x == n]

-- triangulares1 es la lista de los números triangulares. Por ejemplo,
--    take 10 triangulares1 == [1,3,6,10,15,21,28,36,45,55]
triangulares1 :: [Integer]
triangulares1 = map triangular [1..]

triangular :: Integer -> Integer
triangular 1 = 1
triangular n = triangular (n-1) + n

-- (nCifras x) es el número de cifras distintas del número x. Por
-- ejemplo,
--    nCifras 325275  ==  4
nCifras :: Integer -> Int
nCifras = length . nub . show

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

triangularesConCifras2 :: Int -> [Integer]
triangularesConCifras2 n =
  [x | x <- triangulares2,
       nCifras x == n]

triangulares2 :: [Integer]
triangulares2 = [(n*(n+1)) `div` 2 | n <- [1..]]

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

triangularesConCifras3 :: Int -> [Integer]
triangularesConCifras3 n =
  [x | x <- triangulares3,
       nCifras x == n]

triangulares3 :: [Integer]
triangulares3 = 1 : [x+y | (x,y) <- zip [2..] triangulares3]

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

triangularesConCifras4 :: Int -> [Integer]
triangularesConCifras4 n =
  [x | x <- triangulares4,
       nCifras x == n]

triangulares4 :: [Integer]
triangulares4 = 1 : zipWith (+) [2..] triangulares4

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

triangularesConCifras5 :: Int -> [Integer]
triangularesConCifras5 n =
  [x | x <- triangulares5,
       nCifras x == n]

triangulares5 :: [Integer]
triangulares5 = scanl (+) 1 [2..]

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

-- La 1ª propiedad es
prop_triangularesConCifras1 :: Bool
prop_triangularesConCifras1 =
  [take 2 (triangularesConCifras1 n) | n <- [1..7]] ==
  [take 2 (triangularesConCifras2 n) | n <- [1..7]]

-- La comprobación es
--    λ> prop_triangularesConCifras1
--    True

-- La 2ª propiedad es
prop_triangularesConCifras2 :: Int -> Bool
prop_triangularesConCifras2 n =
  all (== take 5 (triangularesConCifras2 n'))
      [take 5 (triangularesConCifras3 n'),
       take 5 (triangularesConCifras4 n'),
       take 5 (triangularesConCifras5 n')]
  where n' = 1 + n `mod` 9

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

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

-- La comparación es
--    λ> (triangularesConCifras1 3) !! 220
--    5456556
--    (2.48 secs, 1,228,690,120 bytes)
--    λ> (triangularesConCifras2 3) !! 220
--    5456556
--    (0.01 secs, 4,667,288 bytes)
--
--    λ> (triangularesConCifras2 3) !! 600
--    500010500055
--    (1.76 secs, 1,659,299,872 bytes)
--    λ> (triangularesConCifras3 3) !! 600
--    500010500055
--    (1.67 secs, 1,603,298,648 bytes)
--    λ> (triangularesConCifras4 3) !! 600
--    500010500055
--    (1.20 secs, 1,507,298,248 bytes)
--    λ> (triangularesConCifras5 3) !! 600
--    500010500055
--    (1.15 secs, 1,507,298,256 bytes)

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

import Data.List (nub)

import Test.QuickCheck

-- 1ª solución

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

triangularesConCifras1 :: Int -> [Integer]

triangularesConCifras1 n =

[x | x <- triangulares1,

nCifras x == n]

-- triangulares1 es la lista de los números triangulares. Por ejemplo,

-- take 10 triangulares1 == [1,3,6,10,15,21,28,36,45,55]

triangulares1 :: [Integer]

triangulares1 = map triangular [1..]

triangular :: Integer -> Integer

triangular 1 = 1

triangular n = triangular (n-1) + n

-- (nCifras x) es el número de cifras distintas del número x. Por

-- ejemplo,

-- nCifras 325275 == 4

nCifras :: Integer -> Int

nCifras = length . nub . show

-- 2ª solución

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

triangularesConCifras2 :: Int -> [Integer]

triangularesConCifras2 n =

[x | x <- triangulares2,

nCifras x == n]

triangulares2 :: [Integer]

triangulares2 = [(n*(n+1)) `div` 2 | n <- [1..]]

-- 3ª solución

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

triangularesConCifras3 :: Int -> [Integer]

triangularesConCifras3 n =

[x | x <- triangulares3,

nCifras x == n]

triangulares3 :: [Integer]

triangulares3 = 1 : [x+y | (x,y) <- zip [2..] triangulares3]

-- 4ª solución

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

triangularesConCifras4 :: Int -> [Integer]

triangularesConCifras4 n =

[x | x <- triangulares4,

nCifras x == n]

triangulares4 :: [Integer]

triangulares4 = 1 : zipWith (+) [2..] triangulares4

-- 5ª solución

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

triangularesConCifras5 :: Int -> [Integer]

triangularesConCifras5 n =

[x | x <- triangulares5,

nCifras x == n]

triangulares5 :: [Integer]

triangulares5 = scanl (+) 1 [2..]

-- Comprobación de equivalencia

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

-- La 1ª propiedad es

prop_triangularesConCifras1 :: Bool

prop_triangularesConCifras1 =

[take 2 (triangularesConCifras1 n) | n <- [1..7]] ==

[take 2 (triangularesConCifras2 n) | n <- [1..7]]

-- La comprobación es

-- λ> prop_triangularesConCifras1

-- True

-- La 2ª propiedad es

prop_triangularesConCifras2 :: Int -> Bool

prop_triangularesConCifras2 n =

all (== take 5 (triangularesConCifras2 n'))

[take 5 (triangularesConCifras3 n'),

take 5 (triangularesConCifras4 n'),

take 5 (triangularesConCifras5 n')]

where n' = 1 + n `mod` 9

-- La comprobación es

-- λ> quickCheck prop_triangularesConCifras

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> (triangularesConCifras1 3) !! 220

-- 5456556

-- (2.48 secs, 1,228,690,120 bytes)

-- λ> (triangularesConCifras2 3) !! 220

-- 5456556

-- (0.01 secs, 4,667,288 bytes)

-- λ> (triangularesConCifras2 3) !! 600

-- 500010500055

-- (1.76 secs, 1,659,299,872 bytes)

-- λ> (triangularesConCifras3 3) !! 600

-- 500010500055

-- (1.67 secs, 1,603,298,648 bytes)

-- λ> (triangularesConCifras4 3) !! 600

-- 500010500055

-- (1.20 secs, 1,507,298,248 bytes)

-- λ> (triangularesConCifras5 3) !! 600

-- 500010500055

-- (1.15 secs, 1,507,298,256 bytes)

El código se encuentra en GitHub.

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

Nuevas soluciones

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

Familias de números con algún dígito en común

PorJosé A. Alonso 31-marzo-20227-abril-2022

Una familia de números es una lista de números tal que todos tienen la misma cantidad de dígitos y, además, dichos números tienen al menos un dígito común.

Por ejemplo, los números 72, 32, 25 y 22 pertenecen a la misma familia ya que son números de dos dígitos y todos tienen el dígito 2, mientras que los números 123, 245 y 568 no pertenecen a la misma familia, ya que no hay un dígito que aparezca en los tres números.

Definir la función

   esFamilia :: [Integer] -> Bool

1	esFamilia :: [Integer] -> Bool

tal que (esFamilia ns) se verifica si ns es una familia de números. Por ejemplo,

   esFamilia [72, 32, 25, 22]  ==  True
   esFamilia [123,245,568]     ==  False
   esFamilia [72, 32, 25, 223] ==  False
   esFamilia [56]              ==  True
   esFamilia []                ==  True

esFamilia [72, 32, 25, 22] == True

esFamilia [123,245,568] == False

esFamilia [72, 32, 25, 223] == False

esFamilia [56] == True

esFamilia [] == True

Soluciones

import Data.List (intersect, nub)
import Test.QuickCheck (quickCheck)

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

esFamilia1 :: [Integer] -> Bool
esFamilia1 [] = True
esFamilia1 ns =
  igualNumeroElementos dss && tieneElementoComun dss
  where dss = map show ns

-- (igualNumeroElementos xss) se verifica si todas las listas de xss
-- tienen el mismo número de elementos. Por ejemplo,
--    igualNumeroElementos [[1,3],[2,2],[4,9]]    ==  True
--    igualNumeroElementos [[1,3],[2,1,2],[4,9]]  ==  False
igualNumeroElementos :: [[a]] -> Bool
igualNumeroElementos xss =
  iguales (map length xss)

-- (iguales xs) se verifica si todos los elementos de xs son
-- iguales. Por ejemplo,
--    iguales [3,3,3,3]  ==  True
--    iguales [3,3,7,3]  ==  False
iguales :: Eq a => [a] -> Bool
iguales []     = True
iguales (x:xs) = all (==x) xs

-- (tieneElementoComun xss) se verifican si todas las listas de xss
-- tienen algún elemento común. Por ejemplo,
--    tieneElementoComun [[1,2],[2,3],[4,2,7]]  ==  True
--    tieneElementoComun [[1,2],[2,3],[4,3,7]]  ==  False
tieneElementoComun :: Eq a => [[a]] -> Bool
tieneElementoComun []       = False
tieneElementoComun (xs:xss) = any (`esElementoComun` xss) xs

-- (esElementoComun x yss) se verifica si x pertenece a todos los
-- elementos de yss. Por ejemplo,
--    esElementoComun 2 [[1,2],[2,3],[4,2,7]]  ==  True
--    esElementoComun 2 [[1,2],[2,3],[4,3,7]]  ==  False
esElementoComun :: Eq a => a -> [[a]] -> Bool
esElementoComun x = all (x `elem`)

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

esFamilia2 :: [Integer] -> Bool
esFamilia2 [] = True
esFamilia2 ns =
  igualNumeroElementos2 dss && tieneElementoComun2 dss
  where dss = map show ns

igualNumeroElementos2 :: [[a]] -> Bool
igualNumeroElementos2 xss =
  length (nub (map length xss)) == 1

tieneElementoComun2 :: Eq a => [[a]] -> Bool
tieneElementoComun2 xss =
  not (null (foldl1 intersect xss))

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

esFamilia3 :: [Integer] -> Bool
esFamilia3 [] = True
esFamilia3 ns =
  igualNumeroElementos3 dss && tieneElementoComun3 dss
  where dss = map show ns

igualNumeroElementos3 :: [[a]] -> Bool
igualNumeroElementos3 = ((==1) . length) . nub . map length

tieneElementoComun3 :: Eq a => [[a]] -> Bool
tieneElementoComun3 = (not . null) . foldl1 intersect

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

-- La propiedad es
prop_esFamilia :: [Integer] -> Bool
prop_esFamilia xss =
  all (== esFamilia1 xss)
      [esFamilia2 xss,
       esFamilia3 xss]

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

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

-- La comparación es
--    λ> esFamilia1 [10^6..4*10^6]
--    False
--    (1.85 secs, 1,931,162,984 bytes)
--    λ> esFamilia2 [10^6..4*10^6]
--    False
--    (2.31 secs, 2,288,177,752 bytes)
--    λ> esFamilia3 [10^6..4*10^6]
--    False
--    (2.23 secs, 2,288,177,864 bytes)

100

101

102

import Data.List (intersect, nub)

import Test.QuickCheck (quickCheck)

-- 1ª solución

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

esFamilia1 :: [Integer] -> Bool

esFamilia1 [] = True

esFamilia1 ns =

igualNumeroElementos dss && tieneElementoComun dss

where dss = map show ns

-- (igualNumeroElementos xss) se verifica si todas las listas de xss

-- tienen el mismo número de elementos. Por ejemplo,

-- igualNumeroElementos [[1,3],[2,2],[4,9]] == True

-- igualNumeroElementos [[1,3],[2,1,2],[4,9]] == False

igualNumeroElementos :: [[a]] -> Bool

igualNumeroElementos xss =

iguales (map length xss)

-- (iguales xs) se verifica si todos los elementos de xs son

-- iguales. Por ejemplo,

-- iguales [3,3,3,3] == True

-- iguales [3,3,7,3] == False

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

iguales [] = True

iguales (x:xs) = all (==x) xs

-- (tieneElementoComun xss) se verifican si todas las listas de xss

-- tienen algún elemento común. Por ejemplo,

-- tieneElementoComun [[1,2],[2,3],[4,2,7]] == True

-- tieneElementoComun [[1,2],[2,3],[4,3,7]] == False

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

tieneElementoComun [] = False

tieneElementoComun (xs:xss) = any (`esElementoComun` xss) xs

-- (esElementoComun x yss) se verifica si x pertenece a todos los

-- elementos de yss. Por ejemplo,

-- esElementoComun 2 [[1,2],[2,3],[4,2,7]] == True

-- esElementoComun 2 [[1,2],[2,3],[4,3,7]] == False

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

esElementoComun x = all (x `elem`)

-- 2ª solución

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

esFamilia2 :: [Integer] -> Bool

esFamilia2 [] = True

esFamilia2 ns =

igualNumeroElementos2 dss && tieneElementoComun2 dss

where dss = map show ns

igualNumeroElementos2 :: [[a]] -> Bool

igualNumeroElementos2 xss =

length (nub (map length xss)) == 1

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

tieneElementoComun2 xss =

not (null (foldl1 intersect xss))

-- 3ª solución

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

esFamilia3 :: [Integer] -> Bool

esFamilia3 [] = True

esFamilia3 ns =

igualNumeroElementos3 dss && tieneElementoComun3 dss

where dss = map show ns

igualNumeroElementos3 :: [[a]] -> Bool

igualNumeroElementos3 = ((==1) . length) . nub . map length

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

tieneElementoComun3 = (not . null) . foldl1 intersect

-- Comprobación de equivalencia

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

-- La propiedad es

prop_esFamilia :: [Integer] -> Bool

prop_esFamilia xss =

all (== esFamilia1 xss)

[esFamilia2 xss,

esFamilia3 xss]

-- La comprobación es

-- λ> quickCheck prop_esFamilia

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> esFamilia1 [10^6..4*10^6]

-- False

-- (1.85 secs, 1,931,162,984 bytes)

-- λ> esFamilia2 [10^6..4*10^6]

-- False

-- (2.31 secs, 2,288,177,752 bytes)

-- λ> esFamilia3 [10^6..4*10^6]

-- False

-- (2.23 secs, 2,288,177,864 bytes)

El código se encuentra en GitHub.

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

Nuevas soluciones

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

Número como suma de sus dígitos

PorJosé A. Alonso 3-junio-20202-enero-2021

El número 23 se puede escribir de 4 formas como suma de sus dígitos

   2 + 2 + 2 + 2 + 2 + 2 + 2 + 2 + 2 + 2 + 3
   2 + 2 + 2 + 2 + 2 + 2 + 2 + 3 + 3 + 3
   2 + 2 + 2 + 2 + 3 + 3 + 3 + 3 + 3
   2 + 3 + 3 + 3 + 3 + 3 + 3 + 3

2 + 2 + 2 + 2 + 2 + 2 + 2 + 2 + 2 + 2 + 3

2 + 2 + 2 + 2 + 2 + 2 + 2 + 3 + 3 + 3

2 + 2 + 2 + 2 + 3 + 3 + 3 + 3 + 3

2 + 3 + 3 + 3 + 3 + 3 + 3 + 3

La de menor número de sumando es la última, que tiene 8 sumandos.

Definir las funciones

   minimoSumandosDigitos        :: Integer -> Integer
   graficaMinimoSumandosDigitos :: Integer -> IO ()

1 2	minimoSumandosDigitos :: Integer -> Integer graficaMinimoSumandosDigitos :: Integer -> IO ()

tales que

(minimoSumandosDigitos n) es el menor número de dígitos de n cuya suma es n. Por ejemplo,

     minimoSumandosDigitos 23    ==  8
     minimoSumandosDigitos 232   ==  78
     minimoSumandosDigitos 2323  ==  775
     map minimoSumandosDigitos [10..20] == [10,11,6,5,5,3,6,5,4,3,10]

minimoSumandosDigitos 23 == 8

minimoSumandosDigitos 232 == 78

minimoSumandosDigitos 2323 == 775

map minimoSumandosDigitos [10..20] == [10,11,6,5,5,3,6,5,4,3,10]

(graficaMinimoSumandosDigitos n) dibuja la gráfica de (minimoSumandosDigitos k) par los k primeros números naturales. Por ejemplo, (graficaMinimoSumandosDigitos 300) dibuja

Soluciones

import Test.QuickCheck
import Graphics.Gnuplot.Simple
import Data.List (nub, genericLength, sort)
import Data.Array (array, (!))

minimoSumandosDigitos :: Integer -> Integer
minimoSumandosDigitos n =
  minimoSumandos (digitos n) n

-- (digitos n) es el conjunto de los dígitos no nulos de n. Por ejemplo,
--    digitos 2032  ==  [2,3]
digitos :: Integer -> [Integer]
digitos n =
  nub [read [c] | c <- show n, c /= '0']

-- (minimoSumandos xs n) es el menor número de elementos de la lista de
-- enteros positivos xs (con posibles repeticiones) cuya suma es n. Por
-- ejemplo, 
--    minimoSumandos [7,2,4] 11  ==  2
minimoSumandos :: [Integer] -> Integer -> Integer
minimoSumandos xs n =
  minimum (map genericLength (sumas xs n))

-- (sumas xs n) es la lista de elementos de la lista de enteros
-- positivos xs (con posibles repeticiones) cuya suma es n. Por ejemplo,  
--    sumas [7,2,4] 11  ==  [[7,2,2],[7,4]]
sumas :: [Integer] -> Integer -> [[Integer]]
sumas [] 0 = [[]]
sumas [] _ = []
sumas (x:xs) n
  | x <= n    = map (x:) (sumas (x:xs) (n-x)) ++ sumas xs n
  | otherwise = sumas xs n

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

minimoSumandosDigitos2 :: Integer -> Integer
minimoSumandosDigitos2 n = aux n 
  where
    aux 0 = 0
    aux k = 1 + minimo [aux (k - x) | x <- ds,  k >= x]
    ds    = digitos n
    infinito = 10^100
    minimo xs | null xs   = infinito
              | otherwise = minimum xs

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

minimoSumandosDigitos3 :: Integer -> Integer
minimoSumandosDigitos3 n = v ! n
  where
    v   = array (0,n) [(i,f i) | i <- [0..n]]
    f 0 = 0
    f k = 1 + minimo [v ! (k - x) | x <- ds, k >= x]
    ds       = digitos n
    infinito = 10^100
    minimo xs | null xs   = infinito
              | otherwise = minimum xs
        
-- Equivalencia de las definiciones
-- ================================

-- La propiedad es
prop_minimoSumandosDigitos :: Positive Integer -> Bool
prop_minimoSumandosDigitos (Positive n) =
  r1 == r2 && r2 == r3
  where
    r1 = minimoSumandosDigitos n
    r2 = minimoSumandosDigitos n
    r3 = minimoSumandosDigitos n

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

-- Definición de graficaMinimoSumandosDigitos
-- ==========================================

graficaMinimoSumandosDigitos :: Integer -> IO ()
graficaMinimoSumandosDigitos n =
  plotList [ Key Nothing
           -- , PNG "Numero_como_suma_de_sus_digitos.png"
           ]
           [minimoSumandosDigitos k | k <- [0..n-1]]

import Test.QuickCheck

import Graphics.Gnuplot.Simple

import Data.List (nub, genericLength, sort)

import Data.Array (array, (!))

minimoSumandosDigitos :: Integer -> Integer

minimoSumandosDigitos n =

minimoSumandos (digitos n) n

-- (digitos n) es el conjunto de los dígitos no nulos de n. Por ejemplo,

-- digitos 2032 == [2,3]

digitos :: Integer -> [Integer]

digitos n =

nub [read [c] | c <- show n, c /= '0']

-- (minimoSumandos xs n) es el menor número de elementos de la lista de

-- enteros positivos xs (con posibles repeticiones) cuya suma es n. Por

-- ejemplo,

-- minimoSumandos [7,2,4] 11 == 2

minimoSumandos :: [Integer] -> Integer -> Integer

minimoSumandos xs n =

minimum (map genericLength (sumas xs n))

-- (sumas xs n) es la lista de elementos de la lista de enteros

-- positivos xs (con posibles repeticiones) cuya suma es n. Por ejemplo,

-- sumas [7,2,4] 11 == [[7,2,2],[7,4]]

sumas :: [Integer] -> Integer -> [[Integer]]

sumas [] 0 = [[]]

sumas [] _ = []

sumas (x:xs) n

| x <= n = map (x:) (sumas (x:xs) (n-x)) ++ sumas xs n

| otherwise = sumas xs n

-- 2ª solución

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

minimoSumandosDigitos2 :: Integer -> Integer

minimoSumandosDigitos2 n = aux n

where

aux 0 = 0

aux k = 1 + minimo [aux (k - x) | x <- ds, k >= x]

ds = digitos n

infinito = 10^100

minimo xs | null xs = infinito

| otherwise = minimum xs

-- 3ª solución

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

minimoSumandosDigitos3 :: Integer -> Integer

minimoSumandosDigitos3 n = v ! n

where

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

f 0 = 0

f k = 1 + minimo [v ! (k - x) | x <- ds, k >= x]

ds = digitos n

infinito = 10^100

minimo xs | null xs = infinito

| otherwise = minimum xs

-- Equivalencia de las definiciones

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

-- La propiedad es

prop_minimoSumandosDigitos :: Positive Integer -> Bool

prop_minimoSumandosDigitos (Positive n) =

r1 == r2 && r2 == r3

where

r1 = minimoSumandosDigitos n

r2 = minimoSumandosDigitos n

r3 = minimoSumandosDigitos n

-- La comprobación es

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

-- +++ OK, passed 100 tests.

-- Definición de graficaMinimoSumandosDigitos

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

graficaMinimoSumandosDigitos :: Integer -> IO ()

graficaMinimoSumandosDigitos n =

plotList [ Key Nothing

-- , PNG "Numero_como_suma_de_sus_digitos.png"

]

[minimoSumandosDigitos k | k <- [0..n-1]]

Cadenas de primos complementarios

PorJosé A. Alonso 25-mayo-20201-junio-2020

El complemento de un número positivo x se calcula por el siguiente procedimiento:

si x es mayor que 9, se toma cada dígito por su valor posicional y se resta del mayor los otro dígitos. Por ejemplo, el complemento de 1448 es 1000 – 400 – 40 – 8 = 552. Para
si x es menor que 10, su complemento es x.

Definir las funciones

   cadena    :: Integer -> [Integer]
   conCadena :: Int -> [Integer]

1 2	cadena :: Integer -> [Integer] conCadena :: Int -> [Integer]

tales que

(cadena x) es la cadena de primos a partir de x tal que cada uno es el complemento del anterior. Por ejemplo,

     cadena 8         == []
     cadena 7         == [7]
     cadena 13        == [13,7]
     cadena 643       == [643,557,443]
     cadena 18127     == [18127,1873,127,73,67,53,47]
     cadena 18181213  == [18181213,1818787,181213,18787,1213,787,613,587]

cadena 8 == []

cadena 7 == [7]

cadena 13 == [13,7]

cadena 643 == [643,557,443]

cadena 18127 == [18127,1873,127,73,67,53,47]

cadena 18181213 == [18181213,1818787,181213,18787,1213,787,613,587]

(conCadena n) es la lista de números cuyas cadenas tienen n elementos. Por ejemplo,

     take 6 (conCadena 3)                == [23,31,61,67,103,307]
     [head (conCadena n) | n <- [4..8]]  == [37,43,157,18127,181873]

1 2	take 6 (conCadena 3) == [23,31,61,67,103,307] [head (conCadena n) \| n <- [4..8]] == [37,43,157,18127,181873]

Soluciones

import Data.Numbers.Primes

-- (complemento x) es le complemento de x. Por ejemplo,
--    complemento 1448  == 552
--    complemento  639  == 561
--    complemento    7  == 7
complemento :: Integer -> Integer
complemento x = (div x c)*c - (rem x c)
  where c = 10^(length (show x) - 1)          

cadena :: Integer -> [Integer]
cadena x    
  | x < 10 && isPrime x = [x]
  | otherwise           = takeWhile isPrime (iterate f x)
  where f x | x < 10 && isPrime x = 0
            | otherwise           = complemento x

conCadena :: Int -> [Integer]
conCadena n =
  [y | y <- primes, length (cadena y) == n]

import Data.Numbers.Primes

-- (complemento x) es le complemento de x. Por ejemplo,

-- complemento 1448 == 552

-- complemento 639 == 561

-- complemento 7 == 7

complemento :: Integer -> Integer

complemento x = (div x c)*c - (rem x c)

where c = 10^(length (show x) - 1)

cadena :: Integer -> [Integer]

cadena x

| x < 10 && isPrime x = [x]

| otherwise = takeWhile isPrime (iterate f x)

where f x | x < 10 && isPrime x = 0

| otherwise = complemento x

conCadena :: Int -> [Integer]

conCadena n =

[y | y <- primes, length (cadena y) == n]

Las sucesiones de Loomis

PorJosé A. Alonso 22-mayo-202029-mayo-2020

La sucesión de Loomis generada por un número entero positivo x es la sucesión cuyos términos se definen por

f(0) es x
f(n) es la suma de f(n-1) y el producto de los dígitos no nulos de f(n-1)

Los primeros términos de las primeras sucesiones de Loomis son

Generada por 1: 1, 2, 4, 8, 16, 22, 26, 38, 62, 74, 102, 104, 108, 116, 122, …
Generada por 2: 2, 4, 8, 16, 22, 26, 38, 62, 74, 102, 104, 108, 116, 122, 126, …
Generada por 3: 3, 6, 12, 14, 18, 26, 38, 62, 74, 102, 104, 108, 116, 122, 126, …
Generada por 4: 4, 8, 16, 22, 26, 38, 62, 74, 102, 104, 108, 116, 122, 126, 138, …
Generada por 5: 5, 10, 11, 12, 14, 18, 26, 38, 62, 74, 102, 104, 108, 116, 122, …

Se observa que a partir de un término todas coinciden con la generada por 1. Dicho término se llama el punto de convergencia. Por ejemplo,

la generada por 2 converge a 2
la generada por 3 converge a 26
la generada por 4 converge a 4
la generada por 5 converge a 26

Definir las siguientes funciones

   sucLoomis           :: Integer -> [Integer]
   convergencia        :: Integer -> Integer
   graficaConvergencia :: [Integer] -> IO ()

sucLoomis :: Integer -> [Integer]

convergencia :: Integer -> Integer

graficaConvergencia :: [Integer] -> IO ()

tales que

(sucLoomis x) es la sucesión de Loomis generada por x. Por ejemplo,

     λ> take 15 (sucLoomis 1)
     [1,2,4,8,16,22,26,38,62,74,102,104,108,116,122]
     λ> take 15 (sucLoomis 2)
     [2,4,8,16,22,26,38,62,74,102,104,108,116,122,126]
     λ> take 15 (sucLoomis 3)
     [3,6,12,14,18,26,38,62,74,102,104,108,116,122,126]
     λ> take 15 (sucLoomis 4)
     [4,8,16,22,26,38,62,74,102,104,108,116,122,126,138]
     λ> take 15 (sucLoomis 5)
     [5,10,11,12,14,18,26,38,62,74,102,104,108,116,122]
     λ> take 15 (sucLoomis 20)
     [20,22,26,38,62,74,102,104,108,116,122,126,138,162,174]
     λ> take 15 (sucLoomis 100)
     [100,101,102,104,108,116,122,126,138,162,174,202,206,218,234]
     λ> sucLoomis 1 !! (2*10^5)
     235180736652

λ> take 15 (sucLoomis 1)

[1,2,4,8,16,22,26,38,62,74,102,104,108,116,122]

λ> take 15 (sucLoomis 2)

[2,4,8,16,22,26,38,62,74,102,104,108,116,122,126]

λ> take 15 (sucLoomis 3)

[3,6,12,14,18,26,38,62,74,102,104,108,116,122,126]

λ> take 15 (sucLoomis 4)

[4,8,16,22,26,38,62,74,102,104,108,116,122,126,138]

λ> take 15 (sucLoomis 5)

[5,10,11,12,14,18,26,38,62,74,102,104,108,116,122]

λ> take 15 (sucLoomis 20)

[20,22,26,38,62,74,102,104,108,116,122,126,138,162,174]

λ> take 15 (sucLoomis 100)

[100,101,102,104,108,116,122,126,138,162,174,202,206,218,234]

λ> sucLoomis 1 !! (2*10^5)

235180736652

(convergencia x) es el término de convergencia de la sucesioń de Loomis generada por x xon la geerada por 1. Por ejemplo,

     convergencia  2      ==  2
     convergencia  3      ==  26
     convergencia  4      ==  4
     convergencia 17      ==  38
     convergencia 19      ==  102
     convergencia 43      ==  162
     convergencia 27      ==  202
     convergencia 58      ==  474
     convergencia 63      ==  150056
     convergencia 81      ==  150056
     convergencia 89      ==  150056
     convergencia (10^12) ==  1000101125092

convergencia 2 == 2

convergencia 3 == 26

convergencia 4 == 4

convergencia 17 == 38

convergencia 19 == 102

convergencia 43 == 162

convergencia 27 == 202

convergencia 58 == 474

convergencia 63 == 150056

convergencia 81 == 150056

convergencia 89 == 150056

convergencia (10^12) == 1000101125092

(graficaConvergencia xs) dibuja la gráfica de los términos de convergencia de las sucesiones de Loomis generadas por los elementos de xs. Por ejemplo, (graficaConvergencia ([1..50]) dibuja

y graficaConvergencia ([1..148] \ [63,81,89,137]) dibuja

Soluciones

import Data.List               ((\\))
import Data.Char               (digitToInt)
import Graphics.Gnuplot.Simple (plotList, Attribute (Key, Title, XRange, PNG))

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

sucLoomis :: Integer -> [Integer]
sucLoomis x = map (loomis x) [0..]

loomis :: Integer -> Integer -> Integer
loomis x 0 = x
loomis x n = y + productoDigitosNoNulos y
  where y = loomis x (n-1)

productoDigitosNoNulos :: Integer -> Integer
productoDigitosNoNulos = product . digitosNoNulos

digitosNoNulos :: Integer -> [Integer]
digitosNoNulos x =
  [read [c] | c <- show x, c /= '0']

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

sucLoomis2 :: Integer -> [Integer]
sucLoomis2 = iterate siguienteLoomis 

siguienteLoomis :: Integer -> Integer
siguienteLoomis y = y + productoDigitosNoNulos y

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

sucLoomis3 :: Integer -> [Integer]
sucLoomis3 =
  iterate ((+) <*> product .
           map (toInteger . digitToInt) .
           filter (/= '0') . show)

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

--    λ> sucLoomis 1 !! 30000
--    6571272766
--    (2.45 secs, 987,955,944 bytes)
--    λ> sucLoomis2 1 !! 30000
--    6571272766
--    (2.26 secs, 979,543,328 bytes)
--    λ> sucLoomis3 1 !! 30000
--    6571272766
--    (0.31 secs, 88,323,832 bytes)

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

convergencia1 :: Integer -> Integer
convergencia1 x =
  head (dropWhile noEnSucLoomisDe1 (sucLoomis x))

noEnSucLoomisDe1 :: Integer -> Bool
noEnSucLoomisDe1 x = not (pertenece x sucLoomisDe1)

sucLoomisDe1 :: [Integer]
sucLoomisDe1 = sucLoomis 1

pertenece :: Integer -> [Integer] -> Bool
pertenece x ys =
  x == head (dropWhile (<x) ys)

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

convergencia2 :: Integer -> Integer
convergencia2 = aux (sucLoomis3 1) . sucLoomis3
 where aux as@(x:xs) bs@(y:ys) | x == y    = x
                               | x < y     = aux xs bs
                               | otherwise = aux as ys

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

convergencia3 :: Integer -> Integer
convergencia3 = head . interseccion (sucLoomis3 1) . sucLoomis3
 
-- (interseccion xs ys) es la intersección entre las listas ordenadas xs
-- e ys. Por ejemplo,
--    λ> take 10 (interseccion (sucLoomis3 1) (sucLoomis3 2))
--    [2,4,8,16,22,26,38,62,74,102]
interseccion :: Ord a => [a] -> [a] -> [a]
interseccion = aux
  where aux as@(x:xs) bs@(y:ys) = case compare x y of
                                    LT ->     aux xs bs
                                    EQ -> x : aux xs ys
                                    GT ->     aux as ys
        aux _         _         = []                           

-- 4ª definición de convergencia
-- =============================

convergencia4 :: Integer -> Integer
convergencia4 x = perteneceA (sucLoomis3 x) 1
  where perteneceA (y:ys) n | y == c    = y
                            | otherwise = perteneceA ys c
          where c = head $ dropWhile (< y) $ sucLoomis3 n

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

--    λ> convergencia1 (10^4)
--    150056
--    (2.94 secs, 1,260,809,808 bytes)
--    λ> convergencia2 (10^4)
--    150056
--    (0.03 secs, 700,240 bytes)
--    λ> convergencia3 (10^4)
--    150056
--    (0.03 secs, 1,165,496 bytes)
--    λ> convergencia4 (10^4)
--    150056
--    (0.02 secs, 1,119,648 bytes)
--    
--    λ> convergencia2 (10^12)
--    1000101125092
--    (1.81 secs, 714,901,080 bytes)
--    λ> convergencia3 (10^12)
--    1000101125092
--    (1.92 secs, 744,932,184 bytes)
--    λ> convergencia4 (10^12)
--    1000101125092
--    (1.82 secs, 941,053,328 bytes)

-- Definición de graficaConvergencia
-- ==================================

graficaConvergencia :: [Integer] -> IO ()
graficaConvergencia xs =
  plotList [ Key Nothing
           , Title "Convergencia de sucesiones de Loomis"
           , XRange (fromIntegral (minimum xs),fromIntegral (maximum xs))
           , PNG "Las_sucesiones_de_Loomis_2.png"
           ]
           [(x,convergencia2 x) | x <- xs]

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

import Data.List ((\\))

import Data.Char (digitToInt)

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

-- 1ª definición de sucLoomis

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

sucLoomis :: Integer -> [Integer]

sucLoomis x = map (loomis x) [0..]

loomis :: Integer -> Integer -> Integer

loomis x 0 = x

loomis x n = y + productoDigitosNoNulos y

where y = loomis x (n-1)

productoDigitosNoNulos :: Integer -> Integer

productoDigitosNoNulos = product . digitosNoNulos

digitosNoNulos :: Integer -> [Integer]

digitosNoNulos x =

[read [c] | c <- show x, c /= '0']

-- 2ª definición de sucLoomis

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

sucLoomis2 :: Integer -> [Integer]

sucLoomis2 = iterate siguienteLoomis

siguienteLoomis :: Integer -> Integer

siguienteLoomis y = y + productoDigitosNoNulos y

-- 3ª definición de sucLoomis

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

sucLoomis3 :: Integer -> [Integer]

sucLoomis3 =

iterate ((+) <*> product .

map (toInteger . digitToInt) .

filter (/= '0') . show)

-- Comparación de eficiencia

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

-- λ> sucLoomis 1 !! 30000

-- 6571272766

-- (2.45 secs, 987,955,944 bytes)

-- λ> sucLoomis2 1 !! 30000

-- 6571272766

-- (2.26 secs, 979,543,328 bytes)

-- λ> sucLoomis3 1 !! 30000

-- 6571272766

-- (0.31 secs, 88,323,832 bytes)

-- 1ª definición de convergencia

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

convergencia1 :: Integer -> Integer

convergencia1 x =

head (dropWhile noEnSucLoomisDe1 (sucLoomis x))

noEnSucLoomisDe1 :: Integer -> Bool

noEnSucLoomisDe1 x = not (pertenece x sucLoomisDe1)

sucLoomisDe1 :: [Integer]

sucLoomisDe1 = sucLoomis 1

pertenece :: Integer -> [Integer] -> Bool

pertenece x ys =

x == head (dropWhile (<x) ys)

-- 2ª definición de convergencia

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

convergencia2 :: Integer -> Integer

convergencia2 = aux (sucLoomis3 1) . sucLoomis3

where aux as@(x:xs) bs@(y:ys) | x == y = x

| x < y = aux xs bs

| otherwise = aux as ys

-- 3ª definición de convergencia

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

convergencia3 :: Integer -> Integer

convergencia3 = head . interseccion (sucLoomis3 1) . sucLoomis3

-- (interseccion xs ys) es la intersección entre las listas ordenadas xs

-- e ys. Por ejemplo,

-- λ> take 10 (interseccion (sucLoomis3 1) (sucLoomis3 2))

-- [2,4,8,16,22,26,38,62,74,102]

interseccion :: Ord a => [a] -> [a] -> [a]

interseccion = aux

where aux as@(x:xs) bs@(y:ys) = case compare x y of

LT -> aux xs bs

EQ -> x : aux xs ys

GT -> aux as ys

aux _ _ = []

-- 4ª definición de convergencia

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

convergencia4 :: Integer -> Integer

convergencia4 x = perteneceA (sucLoomis3 x) 1

where perteneceA (y:ys) n | y == c = y

| otherwise = perteneceA ys c

where c = head $ dropWhile (< y) $ sucLoomis3 n

-- Comparación de eficiencia

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

-- λ> convergencia1 (10^4)

-- 150056

-- (2.94 secs, 1,260,809,808 bytes)

-- λ> convergencia2 (10^4)

-- 150056

-- (0.03 secs, 700,240 bytes)

-- λ> convergencia3 (10^4)

-- 150056

-- (0.03 secs, 1,165,496 bytes)

-- λ> convergencia4 (10^4)

-- 150056

-- (0.02 secs, 1,119,648 bytes)

-- λ> convergencia2 (10^12)

-- 1000101125092

-- (1.81 secs, 714,901,080 bytes)

-- λ> convergencia3 (10^12)

-- 1000101125092

-- (1.92 secs, 744,932,184 bytes)

-- λ> convergencia4 (10^12)

-- 1000101125092

-- (1.82 secs, 941,053,328 bytes)

-- Definición de graficaConvergencia

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

graficaConvergencia :: [Integer] -> IO ()

graficaConvergencia xs =

plotList [ Key Nothing

, Title "Convergencia de sucesiones de Loomis"

, XRange (fromIntegral (minimum xs),fromIntegral (maximum xs))

, PNG "Las_sucesiones_de_Loomis_2.png"

]

[(x,convergencia2 x) | x <- xs]

La sucesión de Sylvester

PorJosé A. Alonso 6-mayo-202013-mayo-2020

La sucesión de Sylvester es la sucesión que comienza en 2 y sus restantes términos se obtienen multiplicando los anteriores y sumándole 1.

Definir las funciones

   sylvester        :: Integer -> Integer
   graficaSylvester :: Integer -> Integer -> IO ()

1 2	sylvester :: Integer -> Integer graficaSylvester :: Integer -> Integer -> IO ()

tales que

(sylvester n) es el n-ésimo término de la sucesión de Sylvester. Por ejemplo,

     λ> [sylvester n | n <- [0..7]]
     [2,3,7,43,1807,3263443,10650056950807,113423713055421844361000443]
     λ> length (show (sylvester 25))
     6830085

λ> [sylvester n | n <- [0..7]]

[2,3,7,43,1807,3263443,10650056950807,113423713055421844361000443]

λ> length (show (sylvester 25))

6830085

(graficaSylvester d n) dibuja la gráfica de los d últimos dígitos de los n primeros términos de la sucesión de Sylvester. Por ejemplo,
- (graficaSylvester 3 30) dibuja
- (graficaSylvester 4 30) dibuja
- (graficaSylvester 5 30) dibuja

Nota: Se puede usar programación dinámica para aumentar la eficiencia.

Soluciones

import Data.List               (genericIndex)
import Data.Array              ((!), array)
import Graphics.Gnuplot.Simple (plotList, Attribute (Key, PNG))

-- 1ª solución (por recursión)
-- ===========================

sylvester1 :: Integer -> Integer
sylvester1 0 = 2
sylvester1 n = 1 + product [sylvester1 k | k <- [0..n-1]]

-- 2ª solución (con programación dinámica)
-- =======================================

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

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

-- Observando que
--    S(n) = 1 + S(0)*S(1)*...*S(n-2)*S(n-1)
--         = 1 + (1 + S(0)*S(1)*...*S(n-2))*S(n-1) - S(n-1)
--         = 1 + S(n-1)*S(n-1) - S(n-1)
--         = 1 + S(n-1)^2 - S(n-1)
-- se obtiene la siguiente definición.
sylvester3 :: Integer -> Integer
sylvester3 0 = 2
sylvester3 n = 1 + x^2 - x
  where x = sylvester3 (n-1)

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

sylvester4 :: Integer -> Integer
sylvester4 n = v ! n where
  v = array (0,n) [(i,f i) | i <- [0..n]]
  f 0 = 2
  f m = 1 + x^2 - x
    where x = v ! (m-1)

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

sylvester5 :: Integer -> Integer
sylvester5 n = sucSylvester5 `genericIndex` n

sucSylvester5 :: [Integer]
sucSylvester5 = iterate (\x -> (x-1)*x+1) 2 

-- La comparación es
--    λ> length (show (sylvester1 23))
--    1707522
--    (6.03 secs, 4,090,415,704 bytes)
--    λ> length (show (sylvester2 23))
--    1707522
--    (0.33 secs, 109,477,296 bytes)
--    λ> length (show (sylvester3 23))
--    1707522
--    (0.35 secs, 109,395,136 bytes)
--    λ> length (show (sylvester4 23))
--    1707522
--    (0.33 secs, 109,402,440 bytes)
--    λ> length (show (sylvester5 23))
--    1707522
--    (0.30 secs, 108,676,256 bytes)

graficaSylvester :: Integer -> Integer -> IO ()
graficaSylvester d n =
  plotList [ Key Nothing
           , PNG ("La_sucesion_de_Sylvester_" ++ show (d,n) ++ ".png")
           ]
           [sylvester5 k `mod` (10^d) | k <- [0..n]]

import Data.List (genericIndex)

import Data.Array ((!), array)

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

-- 1ª solución (por recursión)

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

sylvester1 :: Integer -> Integer

sylvester1 0 = 2

sylvester1 n = 1 + product [sylvester1 k | k <- [0..n-1]]

-- 2ª solución (con programación dinámica)

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

sylvester2 :: Integer -> Integer

sylvester2 n = v ! n where

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

f 0 = 2

f m = 1 + product [v!k | k <- [0..m-1]]

-- 3ª solución

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

-- Observando que

-- S(n) = 1 + S(0)*S(1)*...*S(n-2)*S(n-1)

-- = 1 + (1 + S(0)*S(1)*...*S(n-2))*S(n-1) - S(n-1)

-- = 1 + S(n-1)*S(n-1) - S(n-1)

-- = 1 + S(n-1)^2 - S(n-1)

-- se obtiene la siguiente definición.

sylvester3 :: Integer -> Integer

sylvester3 0 = 2

sylvester3 n = 1 + x^2 - x

where x = sylvester3 (n-1)

-- 4ª solución

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

sylvester4 :: Integer -> Integer

sylvester4 n = v ! n where

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

f 0 = 2

f m = 1 + x^2 - x

where x = v ! (m-1)

-- 5ª solución

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

sylvester5 :: Integer -> Integer

sylvester5 n = sucSylvester5 `genericIndex` n

sucSylvester5 :: [Integer]

sucSylvester5 = iterate (\x -> (x-1)*x+1) 2

-- La comparación es

-- λ> length (show (sylvester1 23))

-- 1707522

-- (6.03 secs, 4,090,415,704 bytes)

-- λ> length (show (sylvester2 23))

-- 1707522

-- (0.33 secs, 109,477,296 bytes)

-- λ> length (show (sylvester3 23))

-- 1707522

-- (0.35 secs, 109,395,136 bytes)

-- λ> length (show (sylvester4 23))

-- 1707522

-- (0.33 secs, 109,402,440 bytes)

-- λ> length (show (sylvester5 23))

-- 1707522

-- (0.30 secs, 108,676,256 bytes)

graficaSylvester :: Integer -> Integer -> IO ()

graficaSylvester d n =

plotList [ Key Nothing

, PNG ("La_sucesion_de_Sylvester_" ++ show (d,n) ++ ".png")

]

[sylvester5 k `mod` (10^d) | k <- [0..n]]

Conjuntos de primos emparejables

PorJosé A. Alonso 5-mayo-202017-agosto-2020

Un conjunto de primos emparejables es un conjunto S de números primos tales que al concatenar cualquier par de elementos de S se obtiene un número primo. Por ejemplo, {3, 7, 109, 673} es un conjunto de primos emparejables ya que sus elementos son primos y las concatenaciones de sus parejas son 37, 3109, 3673, 73, 7109, 7673, 1093, 1097, 109673, 6733, 6737 y 673109 son primos.

Definir la función

   emparejables :: Integer -> Integer -> [[Integer]]

1	emparejables :: Integer -> Integer -> [[Integer]]

tal que (emparejables n m) es el conjunto de los conjuntos emparejables de n elementos menores que n. Por ejemplo,

   take 5 (emparejables 2   10)  ==  [[3,7]]
   take 5 (emparejables 3   10)  ==  []
   take 5 (emparejables 2  100)  ==  [[3,7],[3,11],[3,17],[3,31],[3,37]]
   take 5 (emparejables 3  100)  ==  [[3,37,67],[7,19,97]]
   take 5 (emparejables 4  100)  ==  []
   take 5 (emparejables 4 1000)  ==  [[3,7,109,673],[23,311,677,827]]

take 5 (emparejables 2 10) == [[3,7]]

take 5 (emparejables 3 10) == []

take 5 (emparejables 2 100) == [[3,7],[3,11],[3,17],[3,31],[3,37]]

take 5 (emparejables 3 100) == [[3,37,67],[7,19,97]]

take 5 (emparejables 4 100) == []

take 5 (emparejables 4 1000) == [[3,7,109,673],[23,311,677,827]]

Mayor capicúa producto de dos números de n cifras

PorJosé A. Alonso 29-abril-202012-mayo-2020

Un capicúa es un número que es igual leído de izquierda a derecha que de derecha a izquierda.

Definir la función

   mayorCapicuaP :: Integer -> Integer

1	mayorCapicuaP :: Integer -> Integer

tal que (mayorCapicuaP n) es el mayor capicúa que es el producto de dos números de n cifras. Por ejemplo,

   mayorCapicuaP 2  ==  9009
   mayorCapicuaP 3  ==  906609
   mayorCapicuaP 4  ==  99000099
   mayorCapicuaP 5  ==  9966006699
   mayorCapicuaP 6  ==  999000000999
   mayorCapicuaP 7  ==  99956644665999

mayorCapicuaP 2 == 9009

mayorCapicuaP 3 == 906609

mayorCapicuaP 4 == 99000099

mayorCapicuaP 5 == 9966006699

mayorCapicuaP 6 == 999000000999

mayorCapicuaP 7 == 99956644665999

Soluciones

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

mayorCapicuaP1 :: Integer -> Integer
mayorCapicuaP1 n = head (capicuasP n)

-- (capicuasP n) es la lista de las capicúas de 2*n cifras que
-- pueden escribirse como productos de dos números de n cifras. Por
-- ejemplo, Por ejemplo,
--    ghci> capicuasP 2
--    [9009,8448,8118,8008,7227,7007,6776,6336,6006,5775,5445,5335,
--     5225,5115,5005,4884,4774,4664,4554,4224,4004,3773,3663,3003,
--     2992,2772,2552,2442,2332,2112,2002,1881,1771,1551,1221,1001]
capicuasP n = [x | x <- capicuas n,
                        not (null (productosDosNumerosCifras n x))]

-- (capicuas n) es la lista de las capicúas de 2*n cifras de mayor a
-- menor. Por ejemplo, 
--    capicuas 1           ==  [99,88,77,66,55,44,33,22,11]
--    take 7 (capicuas 2)  ==  [9999,9889,9779,9669,9559,9449,9339]
capicuas :: Integer -> [Integer]
capicuas n = [capicua x | x <- numerosCifras n]

-- (numerosCifras n) es la lista de los números de n cifras de mayor a
-- menor. Por ejemplo,
--    numerosCifras 1           ==  [9,8,7,6,5,4,3,2,1]
--    take 7 (numerosCifras 2)  ==  [99,98,97,96,95,94,93]
--    take 7 (numerosCifras 3)  ==  [999,998,997,996,995,994,993]
numerosCifras :: Integer -> [Integer]
numerosCifras n = [a,a-1..b]
  where a = 10^n-1
        b = 10^(n-1) 

-- (capicua n) es la capicúa formada añadiendo el inverso de n a
--  continuación de n. Por ejemplo,
--    capicua 93  ==  9339
capicua :: Integer -> Integer
capicua n = read (xs ++ (reverse xs))
  where xs = show n

-- (productosDosNumerosCifras n x) es la lista de los números y de n
-- cifras tales que existe un z de n cifras y x es el producto de y por
-- z. Por ejemplo, 
--    productosDosNumerosCifras 2 9009  ==  [99,91]
productosDosNumerosCifras n x = [y | y <- numeros,
                                     mod x y == 0,
                                     div x y `elem` numeros]
  where numeros = numerosCifras n

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

mayorCapicuaP2 :: Integer -> Integer
mayorCapicuaP2 n = maximum [x*y | x <- [a,a-1..b],
                                  y <- [a,a-1..b],
                                  esCapicua (x*y)] 
  where a = 10^n-1
        b = 10^(n-1)

-- (esCapicua x) se verifica si x es capicúa. Por ejemplo,
--    esCapicua 353  ==  True
--    esCapicua 357  ==  False
esCapicua :: Integer -> Bool
esCapicua n = xs == reverse xs
  where xs = show n

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

mayorCapicuaP3 :: Integer -> Integer
mayorCapicuaP3 n = maximum [x*y | (x,y) <- pares a b, 
                                  esCapicua (x*y)] 
  where a = 10^n-1
        b = 10^(n-1)

-- (pares a b) es la lista de los pares de números entre a y b de forma
-- que su suma es decreciente. Por ejemplo,
--    pares 9 7  ==  [(9,9),(8,9),(8,8),(7,9),(7,8),(7,7)]
pares a b = [(x,z-x) | z <- [a1,a1-1..b1],
                       x <- [a,a-1..b],
                       x <= z-x, z-x <= a]
  where a1 = 2*a
        b1 = 2*b

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

mayorCapicuaP4 :: Integer -> Integer
mayorCapicuaP4 n = maximum [x | y <- [a..b],
                                z <- [y..b],
                                let x = y * z,
                                let s = show x,
                                s == reverse s]
  where a = 10^(n-1)
        b = 10^n-1
     
-- 5ª solución
-- ===========

mayorCapicuaP5 :: Integer -> Integer
mayorCapicuaP5 n = maximum [x*y | (x,y) <- pares2 b a, esCapicua (x*y)]
  where a = 10^(n-1)
        b = 10^n-1
                       
-- (pares2 a b) es la lista de los pares de números entre a y b de forma
-- que su suma es decreciente. Por ejemplo,
--    pares2 9 7  ==  [(9,9),(8,9),(8,8),(7,9),(7,8),(7,7)]
pares2 a b = [(x,y) | x <- [a,a-1..b], y <- [a,a-1..x]]

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

mayorCapicuaP6 :: Integer -> Integer
mayorCapicuaP6 n = maximum [x*y | x <- [a..b], 
                                  y <- [x..b] , 
                                  esCapicua (x*y)]
  where a = 10^(n-1)
        b = 10^n-1
 
-- (cifras n) es la lista de las cifras de n en orden inverso. Por
-- ejemplo,  
--    cifras 325  == [5,2,3]
cifras :: Integer -> [Integer]
cifras n 
    | n < 10    = [n]
    | otherwise = (ultima n) : (cifras (quitarUltima n))

-- (ultima n) es la última cifra de n. Por ejemplo,
--    ultima 325  ==  5
ultima  :: Integer -> Integer
ultima n =  n - (n `div` 10)*10

-- (quitarUltima n) es el número obtenido al quitarle a n su última
-- cifra. Por ejemplo,
--    quitarUltima 325  =>  32 
quitarUltima :: Integer -> Integer
quitarUltima n = (n - (ultima n)) `div` 10

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

mayorCapicuaP7 :: Integer -> Integer
mayorCapicuaP7 n = head [x | x <- capicuas n, esFactorizable x n]

-- (esFactorizable x n) se verifica si x se puede escribir como producto
-- de dos números de n dígitos. Por ejemplo,
--    esFactorizable 1219 2  ==  True
--    esFactorizable 1217 2  ==  False
esFactorizable x n = aux i x
  where b = 10^n-1
        i = floor (sqrt (fromIntegral x))
        aux i x | i > b          = False
                | x `mod` i == 0 = x `div` i < b 
                | otherwise      = aux (i+1) x

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

--    λ> mayorCapicuaP1 3
--    906609
--    (0.07 secs, 18,248,224 bytes)
--    λ> mayorCapicuaP2 3
--    906609
--    (0.51 secs, 555,695,720 bytes)
--    λ> mayorCapicuaP3 3
--    906609
--    (0.96 secs, 780,794,768 bytes)
--    λ> mayorCapicuaP4 3
--    906609
--    (0.24 secs, 255,445,448 bytes)
--    λ> mayorCapicuaP5 3
--    906609
--    (0.33 secs, 317,304,080 bytes)
--    λ> mayorCapicuaP6 3
--    906609
--    (0.26 secs, 274,987,472 bytes)
--    λ> mayorCapicuaP7 3
--    906609
--    (0.02 secs, 1,807,720 bytes)
--    
--    λ> mayorCapicuaP1 5
--    9966006699
--    (9.90 secs, 6,349,454,544 bytes)
--    λ> mayorCapicuaP7 5
--    9966006699
--    (0.06 secs, 15,958,616 bytes)

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

167

168

169

170

171

172

173

174

175

176

177

178

179

180

181

182

183

184

185

186

-- 1ª solución

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

mayorCapicuaP1 :: Integer -> Integer

mayorCapicuaP1 n = head (capicuasP n)

-- (capicuasP n) es la lista de las capicúas de 2*n cifras que

-- pueden escribirse como productos de dos números de n cifras. Por

-- ejemplo, Por ejemplo,

-- ghci> capicuasP 2

-- [9009,8448,8118,8008,7227,7007,6776,6336,6006,5775,5445,5335,

-- 5225,5115,5005,4884,4774,4664,4554,4224,4004,3773,3663,3003,

-- 2992,2772,2552,2442,2332,2112,2002,1881,1771,1551,1221,1001]

capicuasP n = [x | x <- capicuas n,

not (null (productosDosNumerosCifras n x))]

-- (capicuas n) es la lista de las capicúas de 2*n cifras de mayor a

-- menor. Por ejemplo,

-- capicuas 1 == [99,88,77,66,55,44,33,22,11]

-- take 7 (capicuas 2) == [9999,9889,9779,9669,9559,9449,9339]

capicuas :: Integer -> [Integer]

capicuas n = [capicua x | x <- numerosCifras n]

-- (numerosCifras n) es la lista de los números de n cifras de mayor a

-- menor. Por ejemplo,

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

-- take 7 (numerosCifras 2) == [99,98,97,96,95,94,93]

-- take 7 (numerosCifras 3) == [999,998,997,996,995,994,993]

numerosCifras :: Integer -> [Integer]

numerosCifras n = [a,a-1..b]

where a = 10^n-1

b = 10^(n-1)

-- (capicua n) es la capicúa formada añadiendo el inverso de n a

-- continuación de n. Por ejemplo,

-- capicua 93 == 9339

capicua :: Integer -> Integer

capicua n = read (xs ++ (reverse xs))

where xs = show n

-- (productosDosNumerosCifras n x) es la lista de los números y de n

-- cifras tales que existe un z de n cifras y x es el producto de y por

-- z. Por ejemplo,

-- productosDosNumerosCifras 2 9009 == [99,91]

productosDosNumerosCifras n x = [y | y <- numeros,

mod x y == 0,

div x y `elem` numeros]

where numeros = numerosCifras n

-- 2ª solución

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

mayorCapicuaP2 :: Integer -> Integer

mayorCapicuaP2 n = maximum [x*y | x <- [a,a-1..b],

y <- [a,a-1..b],

esCapicua (x*y)]

where a = 10^n-1

b = 10^(n-1)

-- (esCapicua x) se verifica si x es capicúa. Por ejemplo,

-- esCapicua 353 == True

-- esCapicua 357 == False

esCapicua :: Integer -> Bool

esCapicua n = xs == reverse xs

where xs = show n

-- 3ª solución

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

mayorCapicuaP3 :: Integer -> Integer

mayorCapicuaP3 n = maximum [x*y | (x,y) <- pares a b,

esCapicua (x*y)]

where a = 10^n-1

b = 10^(n-1)

-- (pares a b) es la lista de los pares de números entre a y b de forma

-- que su suma es decreciente. Por ejemplo,

-- pares 9 7 == [(9,9),(8,9),(8,8),(7,9),(7,8),(7,7)]

pares a b = [(x,z-x) | z <- [a1,a1-1..b1],

x <- [a,a-1..b],

x <= z-x, z-x <= a]

where a1 = 2*a

b1 = 2*b

-- 4ª solución

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

mayorCapicuaP4 :: Integer -> Integer

mayorCapicuaP4 n = maximum [x | y <- [a..b],

z <- [y..b],

let x = y * z,

let s = show x,

s == reverse s]

where a = 10^(n-1)

b = 10^n-1

-- 5ª solución

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

mayorCapicuaP5 :: Integer -> Integer

mayorCapicuaP5 n = maximum [x*y | (x,y) <- pares2 b a, esCapicua (x*y)]

where a = 10^(n-1)

b = 10^n-1

-- (pares2 a b) es la lista de los pares de números entre a y b de forma

-- que su suma es decreciente. Por ejemplo,

-- pares2 9 7 == [(9,9),(8,9),(8,8),(7,9),(7,8),(7,7)]

pares2 a b = [(x,y) | x <- [a,a-1..b], y <- [a,a-1..x]]

-- 6ª solución

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

mayorCapicuaP6 :: Integer -> Integer

mayorCapicuaP6 n = maximum [x*y | x <- [a..b],

y <- [x..b] ,

esCapicua (x*y)]

where a = 10^(n-1)

b = 10^n-1

-- (cifras n) es la lista de las cifras de n en orden inverso. Por

-- ejemplo,

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

cifras :: Integer -> [Integer]

cifras n

| n < 10 = [n]

| otherwise = (ultima n) : (cifras (quitarUltima n))

-- (ultima n) es la última cifra de n. Por ejemplo,

-- ultima 325 == 5

ultima :: Integer -> Integer

ultima n = n - (n `div` 10)*10

-- (quitarUltima n) es el número obtenido al quitarle a n su última

-- cifra. Por ejemplo,

-- quitarUltima 325 => 32

quitarUltima :: Integer -> Integer

quitarUltima n = (n - (ultima n)) `div` 10

-- 7ª solución

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

mayorCapicuaP7 :: Integer -> Integer

mayorCapicuaP7 n = head [x | x <- capicuas n, esFactorizable x n]

-- (esFactorizable x n) se verifica si x se puede escribir como producto

-- de dos números de n dígitos. Por ejemplo,

-- esFactorizable 1219 2 == True

-- esFactorizable 1217 2 == False

esFactorizable x n = aux i x

where b = 10^n-1

i = floor (sqrt (fromIntegral x))

aux i x | i > b = False

| x `mod` i == 0 = x `div` i < b

| otherwise = aux (i+1) x

-- Comparación de eficiencia

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

-- λ> mayorCapicuaP1 3

-- 906609

-- (0.07 secs, 18,248,224 bytes)

-- λ> mayorCapicuaP2 3

-- 906609

-- (0.51 secs, 555,695,720 bytes)

-- λ> mayorCapicuaP3 3

-- 906609

-- (0.96 secs, 780,794,768 bytes)

-- λ> mayorCapicuaP4 3

-- 906609

-- (0.24 secs, 255,445,448 bytes)

-- λ> mayorCapicuaP5 3

-- 906609

-- (0.33 secs, 317,304,080 bytes)

-- λ> mayorCapicuaP6 3

-- 906609

-- (0.26 secs, 274,987,472 bytes)

-- λ> mayorCapicuaP7 3

-- 906609

-- (0.02 secs, 1,807,720 bytes)

-- λ> mayorCapicuaP1 5

-- 9966006699

-- (9.90 secs, 6,349,454,544 bytes)

-- λ> mayorCapicuaP7 5

-- 9966006699

-- (0.06 secs, 15,958,616 bytes)

Orden de divisibilidad

PorJosé A. Alonso 14-abril-202021-abril-2020

El orden de divisibilidad de un número x es el mayor n tal que para todo i menor o igual que n, los i primeros dígitos de n es divisible por i. Por ejemplo, el orden de divisibilidad de 74156 es 3 porque

   7       es divisible por 1
   74      es divisible por 2
   741     es divisible por 3
   7415 no es divisible por 4

7 es divisible por 1

74 es divisible por 2

741 es divisible por 3

7415 no es divisible por 4

Definir la función

   ordenDeDivisibilidad :: Integer -> Int

1	ordenDeDivisibilidad :: Integer -> Int

tal que (ordenDeDivisibilidad x) es el orden de divisibilidad de x. Por ejemplo,

   ordenDeDivisibilidad 74156                      ==  3
   ordenDeDivisibilidad 12                         ==  2
   ordenDeDivisibilidad 7                          ==  1
   ordenDeDivisibilidad 3608528850368400786036725  ==  25

ordenDeDivisibilidad 74156 == 3

ordenDeDivisibilidad 12 == 2

ordenDeDivisibilidad 7 == 1

ordenDeDivisibilidad 3608528850368400786036725 == 25

Soluciones

import Data.List (inits)

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

ordenDeDivisibilidad :: Integer -> Int
ordenDeDivisibilidad n = 
  length (takeWhile (\(x,k) -> x `mod` k == 0) (zip (sucDigitos n) [1..]))

-- (sucDigitos x) es la sucesión de los dígitos de x. Por ejemplo,
--    sucDigitos 325    ==  [3,32,325]
--    sucDigitos 32050  ==  [3,32,320,3205,32050]
sucDigitos :: Integer -> [Integer]
sucDigitos n = 
    [n `div` (10^i) | i <- [k-1,k-2..0]]
    where k = length (show n)

-- 2ª definición de sucDigitos
sucDigitos2 :: Integer -> [Integer]
sucDigitos2 n = [read xs | xs <- aux (show n)]
  where aux []     = []
        aux (d:ds) = [d] : map (d:) (aux ds)

-- 3ª definición de sucDigitos
sucDigitos3 :: Integer -> [Integer]
sucDigitos3 n = 
  [read (take k ds) | k <- [1..length ds]]
  where ds = show n

-- 4ª definición de sucDigitos
sucDigitos4 :: Integer -> [Integer]
sucDigitos4 n = [read xs | xs <- tail (inits (show n))]

-- 5ª definición de sucDigitos
sucDigitos5 :: Integer -> [Integer]
sucDigitos5 n = map read (tail (inits (show n)))

-- 6ª definición de sucDigitos
sucDigitos6 :: Integer -> [Integer]
sucDigitos6 = map read . (tail . inits . show)

-- Eficiencia de las definiciones de sucDigitos
--    ghci> length (sucDigitos (10^5000))
--    5001
--    (0.01 secs, 1550688 bytes)
--    ghci> length (sucDigitos2 (10^5000))
--    5001
--    (1.25 secs, 729411872 bytes)
--    ghci> length (sucDigitos3 (10^5000))
--    5001
--    (0.02 secs, 2265120 bytes)
--    ghci> length (sucDigitos4 (10^5000))
--    5001
--    (1.10 secs, 728366872 bytes)
--    ghci> length (sucDigitos5 (10^5000))
--    5001
--    (1.12 secs, 728393864 bytes)
--    ghci> length (sucDigitos6 (10^5000))
--    5001
--    (1.20 secs, 728403052 bytes)
-- 
--    ghci> length (sucDigitos (10^3000000))
--    3000001
--    (2.73 secs, 820042696 bytes)
--    ghci> length (sucDigitos3 (10^3000000))
--    3000001
--    (3.69 secs, 820043688 bytes)

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

ordenDeDivisibilidad2 :: Integer -> Int
ordenDeDivisibilidad2 x =
  length
  $ takeWhile (==0)
  $ zipWith (mod . read) (tail $ inits $ show x) [1..]

import Data.List (inits)

-- 1ª definición de ordenDeDivisibilidad

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

ordenDeDivisibilidad :: Integer -> Int

ordenDeDivisibilidad n =

length (takeWhile (\(x,k) -> x `mod` k == 0) (zip (sucDigitos n) [1..]))

-- (sucDigitos x) es la sucesión de los dígitos de x. Por ejemplo,

-- sucDigitos 325 == [3,32,325]

-- sucDigitos 32050 == [3,32,320,3205,32050]

sucDigitos :: Integer -> [Integer]

sucDigitos n =

[n `div` (10^i) | i <- [k-1,k-2..0]]

where k = length (show n)

-- 2ª definición de sucDigitos

sucDigitos2 :: Integer -> [Integer]

sucDigitos2 n = [read xs | xs <- aux (show n)]

where aux [] = []

aux (d:ds) = [d] : map (d:) (aux ds)

-- 3ª definición de sucDigitos

sucDigitos3 :: Integer -> [Integer]

sucDigitos3 n =

[read (take k ds) | k <- [1..length ds]]

where ds = show n

-- 4ª definición de sucDigitos

sucDigitos4 :: Integer -> [Integer]

sucDigitos4 n = [read xs | xs <- tail (inits (show n))]

-- 5ª definición de sucDigitos

sucDigitos5 :: Integer -> [Integer]

sucDigitos5 n = map read (tail (inits (show n)))

-- 6ª definición de sucDigitos

sucDigitos6 :: Integer -> [Integer]

sucDigitos6 = map read . (tail . inits . show)

-- Eficiencia de las definiciones de sucDigitos

-- ghci> length (sucDigitos (10^5000))

-- 5001

-- (0.01 secs, 1550688 bytes)

-- ghci> length (sucDigitos2 (10^5000))

-- 5001

-- (1.25 secs, 729411872 bytes)

-- ghci> length (sucDigitos3 (10^5000))

-- 5001

-- (0.02 secs, 2265120 bytes)

-- ghci> length (sucDigitos4 (10^5000))

-- 5001

-- (1.10 secs, 728366872 bytes)

-- ghci> length (sucDigitos5 (10^5000))

-- 5001

-- (1.12 secs, 728393864 bytes)

-- ghci> length (sucDigitos6 (10^5000))

-- 5001

-- (1.20 secs, 728403052 bytes)

-- ghci> length (sucDigitos (10^3000000))

-- 3000001

-- (2.73 secs, 820042696 bytes)

-- ghci> length (sucDigitos3 (10^3000000))

-- 3000001

-- (3.69 secs, 820043688 bytes)

-- 2ª definición de ordenDeDivisibilidad

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

ordenDeDivisibilidad2 :: Integer -> Int

ordenDeDivisibilidad2 x =

length

$ takeWhile (==0)

$ zipWith (mod . read) (tail $ inits $ show x) [1..]

Otras soluciones

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

Primos magnánimos

PorJosé A. Alonso 20-marzo-202027-marzo-2020

Un número magnánimo es un número tal que las sumas obtenidas insertando un «+» entre sus dígitos en cualquier posición son números primos. Por ejemplo, 4001 es un número magnánimo porque los números 4+001=5, 40+01=41 y 400+1=401 son primos.

Definir las funciones

   esMagnanimo :: Integer -> Bool
   primosMagnanimos :: [Integer]

1 2	esMagnanimo :: Integer -> Bool primosMagnanimos :: [Integer]

tales que

(esMagnanimo n) se verifica si n es un número magnánimo. Por ejemplo,

     esMagnanimo 4001  ==  True
     esMagnanimo 2019  ==  False

1 2	esMagnanimo 4001 == True esMagnanimo 2019 == False

primosMagnanimos es la lista de los números primos magnánimos. Por ejemplo,

     λ> take 20 primosMagnanimos
     [2,3,5,7,11,23,29,41,43,47,61,67,83,89,101,227,229,281,401,443]

1 2	λ> take 20 primosMagnanimos [2,3,5,7,11,23,29,41,43,47,61,67,83,89,101,227,229,281,401,443]

Soluciones

import Data.Numbers.Primes (isPrime, primes)

esMagnanimo :: Integer -> Bool
esMagnanimo n =
  all isPrime [x + y | (x, y) <- divisionesNumero n]

-- (divisionesNumero n) es la lista de las divisiones de n en dos
-- números. Por ejemplo,
--    divisionesNumero 1234  ==  [(1,234),(12,34),(123,4)]
--    divisionesNumero 234   ==  [(2,34),(23,4)]
--    divisionesNumero 34    ==  [(3,4)]
--    divisionesNumero 4     ==  []
divisionesNumero :: Integer -> [(Integer,Integer)]
divisionesNumero n =
  [(read xs, read ys) | (xs,ys) <- divisiones (show n)]

-- (divisiones xs) es la lista de las divisiones de xs en dos listas no
-- vacías. Por ejemplo,
--    divisiones "abcd"  ==  [("a","bcd"),("ab","cd"),("abc","d")]
--    divisiones "bcd"   ==  [("b","cd"),("bc","d")]
--    divisiones "cd"    ==  [("c","d")]
--    divisiones "d"     ==  []
--    divisiones ""      ==  []
divisiones :: [a] -> [([a],[a])]
divisiones []     = []
divisiones [_]    = []
divisiones (x:xs) = ([x],xs) : [(x:is,ds) | (is,ds) <- divisiones xs]

primosMagnanimos :: [Integer]
primosMagnanimos = filter esMagnanimo primes

import Data.Numbers.Primes (isPrime, primes)

esMagnanimo :: Integer -> Bool

esMagnanimo n =

all isPrime [x + y | (x, y) <- divisionesNumero n]

-- (divisionesNumero n) es la lista de las divisiones de n en dos

-- números. Por ejemplo,

-- divisionesNumero 1234 == [(1,234),(12,34),(123,4)]

-- divisionesNumero 234 == [(2,34),(23,4)]

-- divisionesNumero 34 == [(3,4)]

-- divisionesNumero 4 == []

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

divisionesNumero n =

[(read xs, read ys) | (xs,ys) <- divisiones (show n)]

-- (divisiones xs) es la lista de las divisiones de xs en dos listas no

-- vacías. Por ejemplo,

-- divisiones "abcd" == [("a","bcd"),("ab","cd"),("abc","d")]

-- divisiones "bcd" == [("b","cd"),("bc","d")]

-- divisiones "cd" == [("c","d")]

-- divisiones "d" == []

-- divisiones "" == []

divisiones :: [a] -> [([a],[a])]

divisiones [] = []

divisiones [_] = []

divisiones (x:xs) = ([x],xs) : [(x:is,ds) | (is,ds) <- divisiones xs]

primosMagnanimos :: [Integer]

primosMagnanimos = filter esMagnanimo primes

Otras soluciones

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

Pensamiento

«Existe una distinción entre lo que se puede llamar un problema y lo que puede considerar un ejercicio. Este último sirve para entrenar al en alguna técnica o procedimiento, y requiere poco o ningún original. A diferencia de un ejercicio, un problema, si es apropiado para nivel, debe requerir pensamiento por parte del estudiante. Es imposible exagerar la importancia de los problemas en las matemáticas. Es por medio de los problemas que las matemáticas se desarrollan y se levantan por sí mismas. Cada nuevo descubrimiento en matemáticas es el resultado de un intento de resolver algún problema.»

Howard Eves.

Medias de dígitos de pi

PorJosé A. Alonso 16-marzo-202023-marzo-2020

El fichero Digitos_de_pi.txt contiene el número pi con un millón de decimales; es decir,

   3.1415926535897932384626433832 ... 83996346460422090106105779458151

1	3.1415926535897932384626433832 ... 83996346460422090106105779458151

Definir las funciones

   mediasDigitosDePi        :: IO [Double]
   graficaMediasDigitosDePi :: Int -> IO ()

1 2	mediasDigitosDePi :: IO [Double] graficaMediasDigitosDePi :: Int -> IO ()

tales que

mediasDigitosDePi es la sucesión cuyo n-ésimo elemento es la media de los n primeros dígitos de pi. Por ejemplo,

     λ> xs <- mediasDigitosDePi
     λ> take 5 xs
     [1.0,2.5,2.0,2.75,4.0]
     λ> take 10 xs
     [1.0,2.5,2.0,2.75,4.0,3.6666666666666665,4.0,4.125,4.0,4.1]
     λ> take 10 <$> mediasDigitosDePi
     [1.0,2.5,2.0,2.75,4.0,3.6666666666666665,4.0,4.125,4.0,4.1]

λ> xs <- mediasDigitosDePi

λ> take 5 xs

[1.0,2.5,2.0,2.75,4.0]

λ> take 10 xs

[1.0,2.5,2.0,2.75,4.0,3.6666666666666665,4.0,4.125,4.0,4.1]

λ> take 10 <$> mediasDigitosDePi

[1.0,2.5,2.0,2.75,4.0,3.6666666666666665,4.0,4.125,4.0,4.1]

(graficaMediasDigitosDePi n) dibuja la gráfica de los n primeros términos de mediasDigitosDePi. Por ejemplo,
- (graficaMediasDigitosDePi 20) dibuja
- (graficaMediasDigitosDePi 200) dibuja
- (graficaMediasDigitosDePi 2000) dibuja

Soluciones

import Data.Char (digitToInt)
import Data.List (genericLength, inits, tails)
import Graphics.Gnuplot.Simple ( Attribute (Key, PNG)
                               , plotList )

-- Definición de mediasDigitosDePi
-- ===============================

mediasDigitosDePi :: IO [Double]
mediasDigitosDePi = do
  (_:_:ds) <- readFile "Digitos_de_pi.txt"
  return (medias (digitos ds))

-- (digitos cs) es la lista de los digitos de cs. Por ejempplo,
--    digitos "1415926535"  ==  [1,4,1,5,9,2,6,5,3,5]
digitos :: String -> [Int]
digitos = map digitToInt

-- (medias xs) es la lista de las medias de los segmentos iniciales de
-- xs. Por ejemplo,
--    λ> medias [1,4,1,5,9,2,6,5,3,5]
--    [1.0,2.5,2.0,2.75,4.0,3.6666666666666665,4.0,4.125,4.0,4.1]
medias :: [Int] -> [Double]
medias xs = map media (tail (inits xs))

-- (media xs) es la media aritmética de xs. Por ejemplo,
--    media [1,4,1,5,9]  ==  4.0
media :: [Int] -> Double
media xs = fromIntegral (sum xs) / genericLength xs

-- Definición de graficaMediasDigitosDePi
-- ======================================

graficaMediasDigitosDePi :: Int -> IO ()
graficaMediasDigitosDePi n = do
  xs <- mediasDigitosDePi
  plotList [ Key Nothing
           , PNG ("Medias_de_digitos_de_pi_" ++ show n ++ ".png")
           ]
           (take n xs)

import Data.Char (digitToInt)

import Data.List (genericLength, inits, tails)

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

, plotList )

-- Definición de mediasDigitosDePi

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

mediasDigitosDePi :: IO [Double]

mediasDigitosDePi = do

(_:_:ds) <- readFile "Digitos_de_pi.txt"

return (medias (digitos ds))

-- (digitos cs) es la lista de los digitos de cs. Por ejempplo,

-- digitos "1415926535" == [1,4,1,5,9,2,6,5,3,5]

digitos :: String -> [Int]

digitos = map digitToInt

-- (medias xs) es la lista de las medias de los segmentos iniciales de

-- xs. Por ejemplo,

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

-- [1.0,2.5,2.0,2.75,4.0,3.6666666666666665,4.0,4.125,4.0,4.1]

medias :: [Int] -> [Double]

medias xs = map media (tail (inits xs))

-- (media xs) es la media aritmética de xs. Por ejemplo,

-- media [1,4,1,5,9] == 4.0

media :: [Int] -> Double

media xs = fromIntegral (sum xs) / genericLength xs

-- Definición de graficaMediasDigitosDePi

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

graficaMediasDigitosDePi :: Int -> IO ()

graficaMediasDigitosDePi n = do

xs <- mediasDigitosDePi

plotList [ Key Nothing

, PNG ("Medias_de_digitos_de_pi_" ++ show n ++ ".png")

]

(take n xs)

Otras soluciones

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

Pensamiento

Es el mejor de los buenos
quien sabe que en esta vida
todo es cuestión de medida:
un poco más, algo menos.

Antonio Machado

Mayor equidigital

PorJosé A. Alonso 3-marzo-202010-marzo-2020

Definir la función

   mayorEquidigital :: Integer -> Integer

1	mayorEquidigital :: Integer -> Integer

tal que (mayorEquidigital n) es el mayor número que se puede formar con los dígitos de n. Por ejemplo,

   mayorEquidigital 325271  ==  753221

1	mayorEquidigital 325271 == 753221

Soluciones

import Data.List (sort)

mayorEquidigital :: Integer -> Integer
mayorEquidigital = read . reverse . sort . show

import Data.List (sort)

mayorEquidigital :: Integer -> Integer

mayorEquidigital = read . reverse . sort . show

Otras soluciones

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

Pensamiento

«Un matemático, como un pintor o un poeta, es un creador de patrones. Si sus patrones son más permanentes que los de ellos, es porque están hechos con ideas.»

G. H. Hardy.

Números de Munchausen

PorJosé A. Alonso 13-enero-202020-enero-2020

Un número de Munchausen es un número entero positivo tal que es igual a la suma de sus dígitos elevados a sí mismo. Por ejemplo, 3435 es un número de Munchausen ya que

   3³ + 4⁴ + 3³ + 5⁵ = 27 + 256 + 27 + 3125 = 3435

1	3³ + 4⁴ + 3³ + 5⁵ = 27 + 256 + 27 + 3125 = 3435

Definir la función

   esMunchausen :: Integer -> Bool

1	esMunchausen :: Integer -> Bool

tal que (esMunchausen n) se verifica si n es un número de Munchausen. Por ejemplo,

   esMunchausen 3435  ==  True
   esMunchausen 2020  ==  False

1 2	esMunchausen 3435 == True esMunchausen 2020 == False

Comprobar con QuickCheck que que los únicos números de Munchausen son 1 y 3435.

Nota 1: No usar la propiedad en la definición.

Nota 2: El ejercicio está basado en el artículo ¿Por qué 3435 es uno de mis números favoritos? de Miguel Ángel Morales en El Aleph.

Soluciones

import Test.QuickCheck

esMunchausen :: Integer -> Bool
esMunchausen n =
  n == sum [x^x | x <- digitos n]

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

-- La propiedad es
prop_Munchausen :: Integer -> Property
prop_Munchausen n =
  n > 0
  ==>
  esMunchausen n == elem n [1, 3435]

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

import Test.QuickCheck

esMunchausen :: Integer -> Bool

esMunchausen n =

n == sum [x^x | x <- digitos n]

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

-- digitos 3435 == [3,4,3,5]

digitos :: Integer -> [Integer]

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

-- La propiedad es

prop_Munchausen :: Integer -> Property

prop_Munchausen n =

n > 0

==>

esMunchausen n == elem n [1, 3435]

-- La comprobación es

-- λ> quickCheck prop_Munchausen

-- +++ OK, passed 100 tests.

Pensamiento

Escribiré en tu abanico:
te quiero para olvidarte,
para quererte te olvido.

Antonio Machado

Múltiplos palíndromos

PorJosé A. Alonso 2-diciembre-201911-diciembre-2019

Los números 545, 5995 y 15151 son los tres menores palíndromos (capicúas) que son divisibles por 109.

Definir las funciones

   multiplosPalindromos :: Integer -> [Integer]
   multiplosPalindromosMenores :: Integer -> Integer -> [Integer]

1 2	multiplosPalindromos :: Integer -> [Integer] multiplosPalindromosMenores :: Integer -> Integer -> [Integer]

tales que

(multiplosPalindromos n) es la lista de los palíndromos divisibles por n. Por ejemplo,

     take 5 (multiplosPalindromos 109) == [545,5995,15151,64746,74447]

1	take 5 (multiplosPalindromos 109) == [545,5995,15151,64746,74447]

(multiplosPalindromosMenores x n) es la lista de los palíndromos divisibles por n, menores que x. Por ejemplo,

     λ> multiplosPalindromosMenores (10^5) 109
     [545,5995,15151,64746,74447,79897,84148,89598,99299]

1 2	λ> multiplosPalindromosMenores (10^5) 109 [545,5995,15151,64746,74447,79897,84148,89598,99299]

Nota: Este ejercicio está basado en el problema 655 del Proyecto Euler.

Soluciones

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

multiplosPalindromos :: Integer -> [Integer]
multiplosPalindromos n =
  [x | x <- multiplos n
     , esPalindromo x]

-- (esPalindromo n) se verifica si n es palíndromo. Por ejemplo, 
--    esPalindromo 32523  ==  True
--    esPalindromo 32533  ==  False
esPalindromo :: Integer -> Bool
esPalindromo n = reverse xs == xs
  where xs = show n

-- (multiplos n) es la lista de los múltiplos de n. Por ejemplo, 
--    take 12 (multiplos 5)  ==  [5,10,15,20,25,30,35,40,45,50,55,60]
multiplos :: Integer -> [Integer]
multiplos n = [n,2*n..]

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

multiplosPalindromos2 :: Integer -> [Integer]
multiplosPalindromos2 = filter esPalindromo . multiplos 

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

multiplosPalindromosMenores :: Integer -> Integer -> [Integer]
multiplosPalindromosMenores x n =
  takeWhile (<x) (multiplosPalindromos n)

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

multiplosPalindromosMenores2 :: Integer -> Integer -> [Integer]
multiplosPalindromosMenores2 x =
  takeWhile (<x) . multiplosPalindromos

-- 1ª definición de multiplosPalindromos

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

multiplosPalindromos :: Integer -> [Integer]

multiplosPalindromos n =

[x | x <- multiplos n

, esPalindromo x]

-- (esPalindromo n) se verifica si n es palíndromo. Por ejemplo,

-- esPalindromo 32523 == True

-- esPalindromo 32533 == False

esPalindromo :: Integer -> Bool

esPalindromo n = reverse xs == xs

where xs = show n

-- (multiplos n) es la lista de los múltiplos de n. Por ejemplo,

-- take 12 (multiplos 5) == [5,10,15,20,25,30,35,40,45,50,55,60]

multiplos :: Integer -> [Integer]

multiplos n = [n,2*n..]

-- 2ª definición de multiplosPalindromos

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

multiplosPalindromos2 :: Integer -> [Integer]

multiplosPalindromos2 = filter esPalindromo . multiplos

-- 1ª definición de multiplosPalindromosMenores

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

multiplosPalindromosMenores :: Integer -> Integer -> [Integer]

multiplosPalindromosMenores x n =

takeWhile (<x) (multiplosPalindromos n)

-- 2ª definición de multiplosPalindromosMenores

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

multiplosPalindromosMenores2 :: Integer -> Integer -> [Integer]

multiplosPalindromosMenores2 x =

takeWhile (<x) . multiplosPalindromos

Pensamiento

Esta luz de Sevilla… Es el palacio
donde nací, con su rumor de fuente.

Antonio Machado

Mayor producto de n dígitos consecutivos de un número

PorJosé A. Alonso 29-noviembre-20196-diciembre-2019

Definir la función

   mayorProducto :: Int -> Integer -> Integer

1	mayorProducto :: Int -> Integer -> Integer

tal que (mayorProducto n x) es el mayor producto de n dígitos consecutivos del número x (suponiendo que x tiene al menos n dígitos). Por ejemplo,

   mayorProducto 2 325                  ==  10
   mayorProducto 5 11111                ==  1
   mayorProducto 5 113111               ==  3
   mayorProducto 5 110111               ==  0
   mayorProducto 5 10151112             ==  10
   mayorProducto 5 101511124            ==  10
   mayorProducto 5 (product [1..1000])  ==  41472

mayorProducto 2 325 == 10

mayorProducto 5 11111 == 1

mayorProducto 5 113111 == 3

mayorProducto 5 110111 == 0

mayorProducto 5 10151112 == 10

mayorProducto 5 101511124 == 10

mayorProducto 5 (product [1..1000]) == 41472

Nota: Este ejercicio está basado en el problema 8 del Proyecto Euler

Soluciones

import Data.List (inits, tails)
import Data.Char (digitToInt)

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

mayorProducto :: Int -> Integer -> Integer
mayorProducto n x =
  maximum [product xs | xs <- segmentos n (digitos x)]

-- (digitos x) es la lista de las digitos del número x. Por ejemplo, 
--    digitos 325  ==  [3,2,5]
digitos :: Integer -> [Integer]
digitos x = map (toInteger . digitToInt) (show x)

-- (segmentos n xs) es la lista de los segmentos de longitud n de la
-- lista xs. Por ejemplo,
--    segmentos 2 [3,5,4,6]  ==  [[3,5],[5,4],[4,6]]
segmentos :: Int -> [Integer] -> [[Integer]]
segmentos n xs = take (length xs - n + 1) (map (take n) (tails xs))

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

mayorProducto2 :: Int -> Integer -> Integer
mayorProducto2 n x = maximum (aux ns)
    where ns     = [read [d] | d <- show x]
          aux xs | length xs < n = []
                 | otherwise     = product (take n xs) : aux (tail xs)

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

mayorProducto3 :: Int -> Integer -> Integer
mayorProducto3 n = maximum
                 . map (product . take n)
                 . filter ((>=n) . length) 
                 . tails
                 . digitos

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

mayorProducto4 :: Int -> Integer -> Integer
mayorProducto4 n = maximum  
                 . map (product . map (fromIntegral . digitToInt)) 
                 . filter ((==n) . length) 
                 . concatMap inits
                 . tails 
                 . show

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

--    λ> mayorProducto 5 (product [1..500])
--    28224
--    (0.01 secs, 1,645,256 bytes)
--    λ> mayorProducto2 5 (product [1..500])
--    28224
--    (0.03 secs, 5,848,416 bytes)
--    λ> mayorProducto3 5 (product [1..500])
--    28224
--    (0.03 secs, 1,510,640 bytes)
--    λ> mayorProducto4 5 (product [1..500])
--    28224
--    (1.85 secs, 10,932,551,216 bytes)
--    
--    λ> mayorProducto 5 (product [1..7000])
--    46656
--    (0.10 secs, 68,590,808 bytes)
--    λ> mayorProducto2 5 (product [1..7000])
--    46656
--    (1.63 secs, 157,031,432 bytes)
--    λ> mayorProducto3 5 (product [1..7000])
--    46656
--    (1.55 secs, 65,727,176 bytes)

import Data.List (inits, tails)

import Data.Char (digitToInt)

-- 1ª solución

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

mayorProducto :: Int -> Integer -> Integer

mayorProducto n x =

maximum [product xs | xs <- segmentos n (digitos x)]

-- (digitos x) es la lista de las digitos del número x. Por ejemplo,

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

digitos :: Integer -> [Integer]

digitos x = map (toInteger . digitToInt) (show x)

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

-- lista xs. Por ejemplo,

-- segmentos 2 [3,5,4,6] == [[3,5],[5,4],[4,6]]

segmentos :: Int -> [Integer] -> [[Integer]]

segmentos n xs = take (length xs - n + 1) (map (take n) (tails xs))

-- 2ª solución

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

mayorProducto2 :: Int -> Integer -> Integer

mayorProducto2 n x = maximum (aux ns)

where ns = [read [d] | d <- show x]

aux xs | length xs < n = []

| otherwise = product (take n xs) : aux (tail xs)

-- 3ª solución

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

mayorProducto3 :: Int -> Integer -> Integer

mayorProducto3 n = maximum

. map (product . take n)

. filter ((>=n) . length)

. tails

. digitos

-- 4ª solución

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

mayorProducto4 :: Int -> Integer -> Integer

mayorProducto4 n = maximum

. map (product . map (fromIntegral . digitToInt))

. filter ((==n) . length)

. concatMap inits

. tails

. show

-- Comparación de eficiencia

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

-- λ> mayorProducto 5 (product [1..500])

-- 28224

-- (0.01 secs, 1,645,256 bytes)

-- λ> mayorProducto2 5 (product [1..500])

-- 28224

-- (0.03 secs, 5,848,416 bytes)

-- λ> mayorProducto3 5 (product [1..500])

-- 28224

-- (0.03 secs, 1,510,640 bytes)

-- λ> mayorProducto4 5 (product [1..500])

-- 28224

-- (1.85 secs, 10,932,551,216 bytes)

-- λ> mayorProducto 5 (product [1..7000])

-- 46656

-- (0.10 secs, 68,590,808 bytes)

-- λ> mayorProducto2 5 (product [1..7000])

-- 46656

-- (1.63 secs, 157,031,432 bytes)

-- λ> mayorProducto3 5 (product [1..7000])

-- 46656

-- (1.55 secs, 65,727,176 bytes)

Pensamiento

«El control de la complejidad es la esencia de la programación.» ~ B.W. Kernigan

Las sucesiones de Loomis

PorJosé A. Alonso 15-mayo-201925-abril-2021

La sucesión de Loomis generada por un número entero positivo x es la sucesión cuyos términos se definen por

f(0) es x
f(n) es la suma de f(n-1) y el producto de los dígitos no nulos de f(n-1)

Los primeros términos de las primeras sucesiones de Loomis son

Generada por 1: 1, 2, 4, 8, 16, 22, 26, 38, 62, 74, 102, 104, 108, 116, 122, …
Generada por 2: 2, 4, 8, 16, 22, 26, 38, 62, 74, 102, 104, 108, 116, 122, 126, …
Generada por 3: 3, 6, 12, 14, 18, 26, 38, 62, 74, 102, 104, 108, 116, 122, 126, …
Generada por 4: 4, 8, 16, 22, 26, 38, 62, 74, 102, 104, 108, 116, 122, 126, 138, …
Generada por 5: 5, 10, 11, 12, 14, 18, 26, 38, 62, 74, 102, 104, 108, 116, 122, …

Se observa que a partir de un término todas coinciden con la generada por 1. Dicho término se llama el punto de convergencia. Por ejemplo,

la generada por 2 converge a 2
la generada por 3 converge a 26
la generada por 4 converge a 4
la generada por 5 converge a 26

Definir las siguientes funciones

   sucLoomis           :: Integer -> [Integer]
   convergencia        :: Integer -> Integer
   graficaConvergencia :: [Integer] -> IO ()

sucLoomis :: Integer -> [Integer]

convergencia :: Integer -> Integer

graficaConvergencia :: [Integer] -> IO ()

tales que

(sucLoomis x) es la sucesión de Loomis generada por x. Por ejemplo,

     λ> take 15 (sucLoomis 1)
     [1,2,4,8,16,22,26,38,62,74,102,104,108,116,122]
     λ> take 15 (sucLoomis 2)
     [2,4,8,16,22,26,38,62,74,102,104,108,116,122,126]
     λ> take 15 (sucLoomis 3)
     [3,6,12,14,18,26,38,62,74,102,104,108,116,122,126]
     λ> take 15 (sucLoomis 4)
     [4,8,16,22,26,38,62,74,102,104,108,116,122,126,138]
     λ> take 15 (sucLoomis 5)
     [5,10,11,12,14,18,26,38,62,74,102,104,108,116,122]
     λ> take 15 (sucLoomis 20)
     [20,22,26,38,62,74,102,104,108,116,122,126,138,162,174]
     λ> take 15 (sucLoomis 100)
     [100,101,102,104,108,116,122,126,138,162,174,202,206,218,234]
     λ> sucLoomis 1 !! (2*10^5)
     235180736652

λ> take 15 (sucLoomis 1)

[1,2,4,8,16,22,26,38,62,74,102,104,108,116,122]

λ> take 15 (sucLoomis 2)

[2,4,8,16,22,26,38,62,74,102,104,108,116,122,126]

λ> take 15 (sucLoomis 3)

[3,6,12,14,18,26,38,62,74,102,104,108,116,122,126]

λ> take 15 (sucLoomis 4)

[4,8,16,22,26,38,62,74,102,104,108,116,122,126,138]

λ> take 15 (sucLoomis 5)

[5,10,11,12,14,18,26,38,62,74,102,104,108,116,122]

λ> take 15 (sucLoomis 20)

[20,22,26,38,62,74,102,104,108,116,122,126,138,162,174]

λ> take 15 (sucLoomis 100)

[100,101,102,104,108,116,122,126,138,162,174,202,206,218,234]

λ> sucLoomis 1 !! (2*10^5)

235180736652

(convergencia x) es el término de convergencia de la sucesioń de Loomis generada por x xon la geerada por 1. Por ejemplo,

     convergencia  2      ==  2
     convergencia  3      ==  26
     convergencia  4      ==  4
     convergencia 17      ==  38
     convergencia 19      ==  102
     convergencia 43      ==  162
     convergencia 27      ==  202
     convergencia 58      ==  474
     convergencia 63      ==  150056
     convergencia 81      ==  150056
     convergencia 89      ==  150056
     convergencia (10^12) ==  1000101125092

convergencia 2 == 2

convergencia 3 == 26

convergencia 4 == 4

convergencia 17 == 38

convergencia 19 == 102

convergencia 43 == 162

convergencia 27 == 202

convergencia 58 == 474

convergencia 63 == 150056

convergencia 81 == 150056

convergencia 89 == 150056

convergencia (10^12) == 1000101125092

(graficaConvergencia xs) dibuja la gráfica de los términos de convergencia de las sucesiones de Loomis generadas por los elementos de xs. Por ejemplo, (graficaConvergencia ([1..50]) dibuja

y graficaConvergencia ([1..148] \ [63,81,89,137]) dibuja

Soluciones

import Data.List               ((\\))
import Data.Char               (digitToInt)
import Graphics.Gnuplot.Simple (plotList, Attribute (Key, Title, XRange, PNG))

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

sucLoomis :: Integer -> [Integer]
sucLoomis x = map (loomis x) [0..]

loomis :: Integer -> Integer -> Integer
loomis x 0 = x
loomis x n = y + productoDigitosNoNulos y
  where y = loomis x (n-1)

productoDigitosNoNulos :: Integer -> Integer
productoDigitosNoNulos = product . digitosNoNulos

digitosNoNulos :: Integer -> [Integer]
digitosNoNulos x =
  [read [c] | c <- show x, c /= '0']

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

sucLoomis2 :: Integer -> [Integer]
sucLoomis2 = iterate siguienteLoomis 

siguienteLoomis :: Integer -> Integer
siguienteLoomis y = y + productoDigitosNoNulos y

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

sucLoomis3 :: Integer -> [Integer]
sucLoomis3 =
  iterate ((+) <*> product .
           map (toInteger . digitToInt) .
           filter (/= '0') . show)

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

--    λ> sucLoomis 1 !! 30000
--    6571272766
--    (2.45 secs, 987,955,944 bytes)
--    λ> sucLoomis2 1 !! 30000
--    6571272766
--    (2.26 secs, 979,543,328 bytes)
--    λ> sucLoomis3 1 !! 30000
--    6571272766
--    (0.31 secs, 88,323,832 bytes)

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

convergencia1 :: Integer -> Integer
convergencia1 x =
  head (dropWhile noEnSucLoomisDe1 (sucLoomis x))

noEnSucLoomisDe1 :: Integer -> Bool
noEnSucLoomisDe1 x = not (pertenece x sucLoomisDe1)

sucLoomisDe1 :: [Integer]
sucLoomisDe1 = sucLoomis 1

pertenece :: Integer -> [Integer] -> Bool
pertenece x ys =
  x == head (dropWhile (<x) ys)

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

convergencia2 :: Integer -> Integer
convergencia2 = aux (sucLoomis3 1) . sucLoomis3
 where aux as@(x:xs) bs@(y:ys) | x == y    = x
                               | x < y     = aux xs bs
                               | otherwise = aux as ys

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

convergencia3 :: Integer -> Integer
convergencia3 = head . interseccion (sucLoomis3 1) . sucLoomis3
 
-- (interseccion xs ys) es la intersección entre las listas ordenadas xs
-- e ys. Por ejemplo,
--    λ> take 10 (interseccion (sucLoomis3 1) (sucLoomis3 2))
--    [2,4,8,16,22,26,38,62,74,102]
interseccion :: Ord a => [a] -> [a] -> [a]
interseccion = aux
  where aux as@(x:xs) bs@(y:ys) = case compare x y of
                                    LT ->     aux xs bs
                                    EQ -> x : aux xs ys
                                    GT ->     aux as ys
        aux _         _         = []                           

-- 4ª definición de convergencia
-- =============================

convergencia4 :: Integer -> Integer
convergencia4 x = perteneceA (sucLoomis3 x) 1
  where perteneceA (y:ys) n | y == c    = y
                            | otherwise = perteneceA ys c
          where c = head $ dropWhile (< y) $ sucLoomis3 n

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

--    λ> convergencia1 (10^4)
--    150056
--    (2.94 secs, 1,260,809,808 bytes)
--    λ> convergencia2 (10^4)
--    150056
--    (0.03 secs, 700,240 bytes)
--    λ> convergencia3 (10^4)
--    150056
--    (0.03 secs, 1,165,496 bytes)
--    λ> convergencia4 (10^4)
--    150056
--    (0.02 secs, 1,119,648 bytes)
--    
--    λ> convergencia2 (10^12)
--    1000101125092
--    (1.81 secs, 714,901,080 bytes)
--    λ> convergencia3 (10^12)
--    1000101125092
--    (1.92 secs, 744,932,184 bytes)
--    λ> convergencia4 (10^12)
--    1000101125092
--    (1.82 secs, 941,053,328 bytes)

-- Definición de graficaConvergencia
-- ==================================

graficaConvergencia :: [Integer] -> IO ()
graficaConvergencia xs =
  plotList [ Key Nothing
           , Title "Convergencia de sucesiones de Loomis"
           , XRange (fromIntegral (minimum xs),fromIntegral (maximum xs))
           , PNG "Las_sucesiones_de_Loomis_2.png"
           ]
           [(x,convergencia2 x) | x <- xs]

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

import Data.List ((\\))

import Data.Char (digitToInt)

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

-- 1ª definición de sucLoomis

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

sucLoomis :: Integer -> [Integer]

sucLoomis x = map (loomis x) [0..]

loomis :: Integer -> Integer -> Integer

loomis x 0 = x

loomis x n = y + productoDigitosNoNulos y

where y = loomis x (n-1)

productoDigitosNoNulos :: Integer -> Integer

productoDigitosNoNulos = product . digitosNoNulos

digitosNoNulos :: Integer -> [Integer]

digitosNoNulos x =

[read [c] | c <- show x, c /= '0']

-- 2ª definición de sucLoomis

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

sucLoomis2 :: Integer -> [Integer]

sucLoomis2 = iterate siguienteLoomis

siguienteLoomis :: Integer -> Integer

siguienteLoomis y = y + productoDigitosNoNulos y

-- 3ª definición de sucLoomis

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

sucLoomis3 :: Integer -> [Integer]

sucLoomis3 =

iterate ((+) <*> product .

map (toInteger . digitToInt) .

filter (/= '0') . show)

-- Comparación de eficiencia

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

-- λ> sucLoomis 1 !! 30000

-- 6571272766

-- (2.45 secs, 987,955,944 bytes)

-- λ> sucLoomis2 1 !! 30000

-- 6571272766

-- (2.26 secs, 979,543,328 bytes)

-- λ> sucLoomis3 1 !! 30000

-- 6571272766

-- (0.31 secs, 88,323,832 bytes)

-- 1ª definición de convergencia

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

convergencia1 :: Integer -> Integer

convergencia1 x =

head (dropWhile noEnSucLoomisDe1 (sucLoomis x))

noEnSucLoomisDe1 :: Integer -> Bool

noEnSucLoomisDe1 x = not (pertenece x sucLoomisDe1)

sucLoomisDe1 :: [Integer]

sucLoomisDe1 = sucLoomis 1

pertenece :: Integer -> [Integer] -> Bool

pertenece x ys =

x == head (dropWhile (<x) ys)

-- 2ª definición de convergencia

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

convergencia2 :: Integer -> Integer

convergencia2 = aux (sucLoomis3 1) . sucLoomis3

where aux as@(x:xs) bs@(y:ys) | x == y = x

| x < y = aux xs bs

| otherwise = aux as ys

-- 3ª definición de convergencia

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

convergencia3 :: Integer -> Integer

convergencia3 = head . interseccion (sucLoomis3 1) . sucLoomis3

-- (interseccion xs ys) es la intersección entre las listas ordenadas xs

-- e ys. Por ejemplo,

-- λ> take 10 (interseccion (sucLoomis3 1) (sucLoomis3 2))

-- [2,4,8,16,22,26,38,62,74,102]

interseccion :: Ord a => [a] -> [a] -> [a]

interseccion = aux

where aux as@(x:xs) bs@(y:ys) = case compare x y of

LT -> aux xs bs

EQ -> x : aux xs ys

GT -> aux as ys

aux _ _ = []

-- 4ª definición de convergencia

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

convergencia4 :: Integer -> Integer

convergencia4 x = perteneceA (sucLoomis3 x) 1

where perteneceA (y:ys) n | y == c = y

| otherwise = perteneceA ys c

where c = head $ dropWhile (< y) $ sucLoomis3 n

-- Comparación de eficiencia

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

-- λ> convergencia1 (10^4)

-- 150056

-- (2.94 secs, 1,260,809,808 bytes)

-- λ> convergencia2 (10^4)

-- 150056

-- (0.03 secs, 700,240 bytes)

-- λ> convergencia3 (10^4)

-- 150056

-- (0.03 secs, 1,165,496 bytes)

-- λ> convergencia4 (10^4)

-- 150056

-- (0.02 secs, 1,119,648 bytes)

-- λ> convergencia2 (10^12)

-- 1000101125092

-- (1.81 secs, 714,901,080 bytes)

-- λ> convergencia3 (10^12)

-- 1000101125092

-- (1.92 secs, 744,932,184 bytes)

-- λ> convergencia4 (10^12)

-- 1000101125092

-- (1.82 secs, 941,053,328 bytes)

-- Definición de graficaConvergencia

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

graficaConvergencia :: [Integer] -> IO ()

graficaConvergencia xs =

plotList [ Key Nothing

, Title "Convergencia de sucesiones de Loomis"

, XRange (fromIntegral (minimum xs),fromIntegral (maximum xs))

, PNG "Las_sucesiones_de_Loomis_2.png"

]

[(x,convergencia2 x) | x <- xs]

Pensamiento

Era una noche del mes
de mayo, azul y serena.
Sobre el agudo ciprés
brillaba la luna llena.

Antonio Machado

Mayor producto de n dígitos consecutivos de un número

PorJosé A. Alonso 14-mayo-201925-abril-2021

Definir la función

   mayorProducto :: Int -> Integer -> Integer

1	mayorProducto :: Int -> Integer -> Integer

tal que (mayorProducto n x) es el mayor producto de n dígitos consecutivos del número x (suponiendo que x tiene al menos n dígitos). Por ejemplo,

   mayorProducto 2 325                  ==  10
   mayorProducto 5 11111                ==  1
   mayorProducto 5 113111               ==  3
   mayorProducto 5 110111               ==  0
   mayorProducto 5 10151112             ==  10
   mayorProducto 5 101511124            ==  10
   mayorProducto 5 (product [1..1000])  ==  41472

mayorProducto 2 325 == 10

mayorProducto 5 11111 == 1

mayorProducto 5 113111 == 3

mayorProducto 5 110111 == 0

mayorProducto 5 10151112 == 10

mayorProducto 5 101511124 == 10

mayorProducto 5 (product [1..1000]) == 41472

Soluciones

import Test.QuickCheck
import Data.List (inits, tails)
import Data.Char (digitToInt)

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

mayorProducto1 :: Int -> Integer -> Integer
mayorProducto1 n x =
  maximum [product xs | xs <- segmentos n (cifras x)]

-- (cifras x) es la lista de las cifras del número x. Por ejemplo, 
--    cifras 325  ==  [3,2,5]
cifras :: Integer -> [Integer]
cifras x = map (toInteger . digitToInt) (show x)

-- (segmentos n xs) es la lista de los segmentos de longitud n de la
-- lista xs. Por ejemplo,
--    segmentos 2 [3,5,4,6]  ==  [[3,5],[5,4],[4,6]]
segmentos :: Int -> [Integer] -> [[Integer]]
segmentos n xs = take (length xs - n + 1) (map (take n) (tails xs))

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

mayorProducto2 :: Int -> Integer -> Integer
mayorProducto2 n x = maximum (aux ns)
    where ns     = [read [d] | d <- show x]
          aux xs | length xs < n = []
                 | otherwise     = product (take n xs) : aux (tail xs)

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

mayorProducto3 :: Int -> Integer -> Integer
mayorProducto3 n = maximum
                 . map (product . take n)
                 . filter ((>=n) . length) 
                 . tails
                 . cifras

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

mayorProducto4 :: Int -> Integer -> Integer
mayorProducto4 n = maximum  
                 . map (product . map (fromIntegral . digitToInt)) 
                 . filter ((==n) . length) 
                 . concatMap inits
                 . tails 
                 . show

-- ---------------------------------------------------------------------
-- Comparación de soluciones                                          --
-- ---------------------------------------------------------------------

-- Tiempo (en segundos) del cálculo de (mayorProducto 5 (product [1..n]))
-- 
--    | Def | 500  | 1000 | 5000 | 10000 
--    | 1   | 0.01 | 0.02 | 0.06 | 0.11
--    | 2   | 0.01 | 0.03 | 0.80 | 3.98
--    | 3   | 0.01 | 0.03 | 0.82 | 4.13
--    | 4   | 2.77 |      |      |

import Test.QuickCheck

import Data.List (inits, tails)

import Data.Char (digitToInt)

-- 1ª solución

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

mayorProducto1 :: Int -> Integer -> Integer

mayorProducto1 n x =

maximum [product xs | xs <- segmentos n (cifras x)]

-- (cifras x) es la lista de las cifras del número x. Por ejemplo,

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

cifras :: Integer -> [Integer]

cifras x = map (toInteger . digitToInt) (show x)

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

-- lista xs. Por ejemplo,

-- segmentos 2 [3,5,4,6] == [[3,5],[5,4],[4,6]]

segmentos :: Int -> [Integer] -> [[Integer]]

segmentos n xs = take (length xs - n + 1) (map (take n) (tails xs))

-- 2ª solución

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

mayorProducto2 :: Int -> Integer -> Integer

mayorProducto2 n x = maximum (aux ns)

where ns = [read [d] | d <- show x]

aux xs | length xs < n = []

| otherwise = product (take n xs) : aux (tail xs)

-- 3ª solución

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

mayorProducto3 :: Int -> Integer -> Integer

mayorProducto3 n = maximum

. map (product . take n)

. filter ((>=n) . length)

. tails

. cifras

-- 4ª solución

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

mayorProducto4 :: Int -> Integer -> Integer

mayorProducto4 n = maximum

. map (product . map (fromIntegral . digitToInt))

. filter ((==n) . length)

. concatMap inits

. tails

. show

-- ---------------------------------------------------------------------

-- Comparación de soluciones --

-- ---------------------------------------------------------------------

-- Tiempo (en segundos) del cálculo de (mayorProducto 5 (product [1..n]))

-- | Def | 500 | 1000 | 5000 | 10000

-- | 1 | 0.01 | 0.02 | 0.06 | 0.11

-- | 2 | 0.01 | 0.03 | 0.80 | 3.98

-- | 3 | 0.01 | 0.03 | 0.82 | 4.13

-- | 4 | 2.77 | | |

Pensamiento

A las palabras de amor
les sienta bien su poquito
de exageración.

Antonio Machado

Mayor capicúa producto de dos números de n cifras

PorJosé A. Alonso 25-abril-201925-abril-2021

Un capicúa es un número que es igual leído de izquierda a derecha que de derecha a izquierda.

Definir la función

   mayorCapicuaP :: Integer -> Integer

1	mayorCapicuaP :: Integer -> Integer

tal que (mayorCapicuaP n) es el mayor capicúa que es el producto de dos números de n cifras. Por ejemplo,

   mayorCapicuaP 2  ==  9009
   mayorCapicuaP 3  ==  906609
   mayorCapicuaP 4  ==  99000099
   mayorCapicuaP 5  ==  9966006699

mayorCapicuaP 2 == 9009

mayorCapicuaP 3 == 906609

mayorCapicuaP 4 == 99000099

mayorCapicuaP 5 == 9966006699

Soluciones

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

mayorCapicuaP1 :: Integer -> Integer
mayorCapicuaP1 n = head (capicuasP n)

-- (capicuasP n) es la lista de las capicúas de 2*n cifras que
-- pueden escribirse como productos de dos números de n cifras. Por
-- ejemplo, Por ejemplo,
--    ghci> capicuasP 2
--    [9009,8448,8118,8008,7227,7007,6776,6336,6006,5775,5445,5335,
--     5225,5115,5005,4884,4774,4664,4554,4224,4004,3773,3663,3003,
--     2992,2772,2552,2442,2332,2112,2002,1881,1771,1551,1221,1001]
capicuasP n = [x | x <- capicuas n,
                        not (null (productosDosNumerosCifras n x))]

-- (capicuas n) es la lista de las capicúas de 2*n cifras de mayor a
-- menor. Por ejemplo, 
--    capicuas 1           ==  [99,88,77,66,55,44,33,22,11]
--    take 7 (capicuas 2)  ==  [9999,9889,9779,9669,9559,9449,9339]
capicuas :: Integer -> [Integer]
capicuas n = [capicua x | x <- numerosCifras n]

-- (numerosCifras n) es la lista de los números de n cifras de mayor a
-- menor. Por ejemplo,
--    numerosCifras 1           ==  [9,8,7,6,5,4,3,2,1]
--    take 7 (numerosCifras 2)  ==  [99,98,97,96,95,94,93]
--    take 7 (numerosCifras 3)  ==  [999,998,997,996,995,994,993]
numerosCifras :: Integer -> [Integer]
numerosCifras n = [a,a-1..b]
  where a = 10^n-1
        b = 10^(n-1) 

-- (capicua n) es la capicúa formada añadiendo el inverso de n a
--  continuación de n. Por ejemplo,
--    capicua 93  ==  9339
capicua :: Integer -> Integer
capicua n = read (xs ++ (reverse xs))
  where xs = show n

-- (productosDosNumerosCifras n x) es la lista de los números y de n
-- cifras tales que existe un z de n cifras y x es el producto de y por
-- z. Por ejemplo, 
--    productosDosNumerosCifras 2 9009  ==  [99,91]
productosDosNumerosCifras n x = [y | y <- numeros,
                                     mod x y == 0,
                                     div x y `elem` numeros]
  where numeros = numerosCifras n

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

mayorCapicuaP2 :: Integer -> Integer
mayorCapicuaP2 n = maximum [x*y | x <- [a,a-1..b],
                                  y <- [a,a-1..b],
                                  esCapicua (x*y)] 
  where a = 10^n-1
        b = 10^(n-1)

-- (esCapicua x) se verifica si x es capicúa. Por ejemplo,
--    esCapicua 353  ==  True
--    esCapicua 357  ==  False
esCapicua :: Integer -> Bool
esCapicua n = xs == reverse xs
  where xs = show n

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

mayorCapicuaP3 :: Integer -> Integer
mayorCapicuaP3 n = maximum [x*y | (x,y) <- pares a b, 
                                  esCapicua (x*y)] 
  where a = 10^n-1
        b = 10^(n-1)

-- (pares a b) es la lista de los pares de números entre a y b de forma
-- que su suma es decreciente. Por ejemplo,
--    pares 9 7  ==  [(9,9),(8,9),(8,8),(7,9),(7,8),(7,7)]
pares a b = [(x,z-x) | z <- [a1,a1-1..b1],
                       x <- [a,a-1..b],
                       x <= z-x, z-x <= a]
  where a1 = 2*a
        b1 = 2*b

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

mayorCapicuaP4 :: Integer -> Integer
mayorCapicuaP4 n = maximum [x | y <- [a..b],
                                z <- [y..b],
                                let x = y * z,
                                let s = show x,
                                s == reverse s]
  where a = 10^(n-1)
        b = 10^n-1
     
-- 5ª solución
-- ===========

mayorCapicuaP5 :: Integer -> Integer
mayorCapicuaP5 n = maximum [x*y | (x,y) <- pares2 b a, esCapicua (x*y)]
  where a = 10^(n-1)
        b = 10^n-1
                       
-- (pares2 a b) es la lista de los pares de números entre a y b de forma
-- que su suma es decreciente. Por ejemplo,
--    pares2 9 7  ==  [(9,9),(8,9),(8,8),(7,9),(7,8),(7,7)]
pares2 a b = [(x,y) | x <- [a,a-1..b], y <- [a,a-1..x]]

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

mayorCapicuaP6 :: Integer -> Integer
mayorCapicuaP6 n = maximum [x*y | x <- [a..b], 
                                  y <- [x..b] , 
                                  esCapicua (x*y)]
  where a = 10^(n-1)
        b = 10^n-1
 
-- (cifras n) es la lista de las cifras de n en orden inverso. Por
-- ejemplo,  
--    cifras 325  == [5,2,3]
cifras :: Integer -> [Integer]
cifras n 
    | n < 10    = [n]
    | otherwise = (ultima n) : (cifras (quitarUltima n))

-- (ultima n) es la última cifra de n. Por ejemplo,
--    ultima 325  ==  5
ultima  :: Integer -> Integer
ultima n =  n - (n `div` 10)*10

-- (quitarUltima n) es el número obtenido al quitarle a n su última
-- cifra. Por ejemplo,
--    quitarUltima 325  =>  32 
quitarUltima :: Integer -> Integer
quitarUltima n = (n - (ultima n)) `div` 10

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

mayorCapicuaP7 :: Integer -> Integer
mayorCapicuaP7 n = head [x | x <- capicuas n, esFactorizable x n]

-- (esFactorizable x n) se verifica si x se puede escribir como producto
-- de dos números de n dígitos. Por ejemplo,
--    esFactorizable 1219 2  ==  True
--    esFactorizable 1217 2  ==  False
esFactorizable x n = aux i x
  where b = 10^n-1
        i = floor (sqrt (fromIntegral x))
        aux i x | i > b          = False
                | x `mod` i == 0 = x `div` i < b 
                | otherwise      = aux (i+1) x

-- ---------------------------------------------------------------------
-- Comparación de soluciones                                          --
-- ---------------------------------------------------------------------

-- El tiempo de cálculo de (mayorCapicuaP n) para las 7 definiciones es
--    +------+------+------+------+
--    | Def. | 2    | 3    | 4    |
--    |------+------+------+------|
--    |    1 | 0.01 | 0.13 | 1.39 |
--    |    2 | 0.03 | 2.07 |      |
--    |    3 | 0.05 | 3.86 |      |
--    |    4 | 0.01 | 0.89 |      |
--    |    5 | 0.03 | 1.23 |      |
--    |    6 | 0.02 | 1.03 |      |
--    |    7 | 0.01 | 0.02 | 0.02 |
--    +------+------+------+------+

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

-- 1ª solución

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

mayorCapicuaP1 :: Integer -> Integer

mayorCapicuaP1 n = head (capicuasP n)

-- (capicuasP n) es la lista de las capicúas de 2*n cifras que

-- pueden escribirse como productos de dos números de n cifras. Por

-- ejemplo, Por ejemplo,

-- ghci> capicuasP 2

-- [9009,8448,8118,8008,7227,7007,6776,6336,6006,5775,5445,5335,

-- 5225,5115,5005,4884,4774,4664,4554,4224,4004,3773,3663,3003,

-- 2992,2772,2552,2442,2332,2112,2002,1881,1771,1551,1221,1001]

capicuasP n = [x | x <- capicuas n,

not (null (productosDosNumerosCifras n x))]

-- (capicuas n) es la lista de las capicúas de 2*n cifras de mayor a

-- menor. Por ejemplo,

-- capicuas 1 == [99,88,77,66,55,44,33,22,11]

-- take 7 (capicuas 2) == [9999,9889,9779,9669,9559,9449,9339]

capicuas :: Integer -> [Integer]

capicuas n = [capicua x | x <- numerosCifras n]

-- (numerosCifras n) es la lista de los números de n cifras de mayor a

-- menor. Por ejemplo,

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

-- take 7 (numerosCifras 2) == [99,98,97,96,95,94,93]

-- take 7 (numerosCifras 3) == [999,998,997,996,995,994,993]

numerosCifras :: Integer -> [Integer]

numerosCifras n = [a,a-1..b]

where a = 10^n-1

b = 10^(n-1)

-- (capicua n) es la capicúa formada añadiendo el inverso de n a

-- continuación de n. Por ejemplo,

-- capicua 93 == 9339

capicua :: Integer -> Integer

capicua n = read (xs ++ (reverse xs))

where xs = show n

-- (productosDosNumerosCifras n x) es la lista de los números y de n

-- cifras tales que existe un z de n cifras y x es el producto de y por

-- z. Por ejemplo,

-- productosDosNumerosCifras 2 9009 == [99,91]

productosDosNumerosCifras n x = [y | y <- numeros,

mod x y == 0,

div x y `elem` numeros]

where numeros = numerosCifras n

-- 2ª solución

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

mayorCapicuaP2 :: Integer -> Integer

mayorCapicuaP2 n = maximum [x*y | x <- [a,a-1..b],

y <- [a,a-1..b],

esCapicua (x*y)]

where a = 10^n-1

b = 10^(n-1)

-- (esCapicua x) se verifica si x es capicúa. Por ejemplo,

-- esCapicua 353 == True

-- esCapicua 357 == False

esCapicua :: Integer -> Bool

esCapicua n = xs == reverse xs

where xs = show n

-- 3ª solución

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

mayorCapicuaP3 :: Integer -> Integer

mayorCapicuaP3 n = maximum [x*y | (x,y) <- pares a b,

esCapicua (x*y)]

where a = 10^n-1

b = 10^(n-1)

-- (pares a b) es la lista de los pares de números entre a y b de forma

-- que su suma es decreciente. Por ejemplo,

-- pares 9 7 == [(9,9),(8,9),(8,8),(7,9),(7,8),(7,7)]

pares a b = [(x,z-x) | z <- [a1,a1-1..b1],

x <- [a,a-1..b],

x <= z-x, z-x <= a]

where a1 = 2*a

b1 = 2*b

-- 4ª solución

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

mayorCapicuaP4 :: Integer -> Integer

mayorCapicuaP4 n = maximum [x | y <- [a..b],

z <- [y..b],

let x = y * z,

let s = show x,

s == reverse s]

where a = 10^(n-1)

b = 10^n-1

-- 5ª solución

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

mayorCapicuaP5 :: Integer -> Integer

mayorCapicuaP5 n = maximum [x*y | (x,y) <- pares2 b a, esCapicua (x*y)]

where a = 10^(n-1)

b = 10^n-1

-- (pares2 a b) es la lista de los pares de números entre a y b de forma

-- que su suma es decreciente. Por ejemplo,

-- pares2 9 7 == [(9,9),(8,9),(8,8),(7,9),(7,8),(7,7)]

pares2 a b = [(x,y) | x <- [a,a-1..b], y <- [a,a-1..x]]

-- 6ª solución

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

mayorCapicuaP6 :: Integer -> Integer

mayorCapicuaP6 n = maximum [x*y | x <- [a..b],

y <- [x..b] ,

esCapicua (x*y)]

where a = 10^(n-1)

b = 10^n-1

-- (cifras n) es la lista de las cifras de n en orden inverso. Por

-- ejemplo,

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

cifras :: Integer -> [Integer]

cifras n

| n < 10 = [n]

| otherwise = (ultima n) : (cifras (quitarUltima n))

-- (ultima n) es la última cifra de n. Por ejemplo,

-- ultima 325 == 5

ultima :: Integer -> Integer

ultima n = n - (n `div` 10)*10

-- (quitarUltima n) es el número obtenido al quitarle a n su última

-- cifra. Por ejemplo,

-- quitarUltima 325 => 32

quitarUltima :: Integer -> Integer

quitarUltima n = (n - (ultima n)) `div` 10

-- 7ª solución

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

mayorCapicuaP7 :: Integer -> Integer

mayorCapicuaP7 n = head [x | x <- capicuas n, esFactorizable x n]

-- (esFactorizable x n) se verifica si x se puede escribir como producto

-- de dos números de n dígitos. Por ejemplo,

-- esFactorizable 1219 2 == True

-- esFactorizable 1217 2 == False

esFactorizable x n = aux i x

where b = 10^n-1

i = floor (sqrt (fromIntegral x))

aux i x | i > b = False

| x `mod` i == 0 = x `div` i < b

| otherwise = aux (i+1) x

-- ---------------------------------------------------------------------

-- Comparación de soluciones --

-- ---------------------------------------------------------------------

-- El tiempo de cálculo de (mayorCapicuaP n) para las 7 definiciones es

-- +------+------+------+------+

-- | Def. | 2 | 3 | 4 |

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

-- | 1 | 0.01 | 0.13 | 1.39 |

-- | 2 | 0.03 | 2.07 | |

-- | 3 | 0.05 | 3.86 | |

-- | 4 | 0.01 | 0.89 | |

-- | 5 | 0.03 | 1.23 | |

-- | 6 | 0.02 | 1.03 | |

-- | 7 | 0.01 | 0.02 | 0.02 |

-- +------+------+------+------+

Pensamiento

Mi corazón está donde ha nacido,
no a la vida, al amor, cerca del Duero.

Antonio Machado

Números como suma de sus dígitos

PorJosé A. Alonso 6-marzo-201925-abril-2021

El número 23 se puede escribir de 4 formas como suma de sus dígitos

   2 + 2 + 2 + 2 + 2 + 2 + 2 + 2 + 2 + 2 + 3
   2 + 2 + 2 + 2 + 2 + 2 + 2 + 3 + 3 + 3
   2 + 2 + 2 + 2 + 3 + 3 + 3 + 3 + 3
   2 + 3 + 3 + 3 + 3 + 3 + 3 + 3

2 + 2 + 2 + 2 + 2 + 2 + 2 + 2 + 2 + 2 + 3

2 + 2 + 2 + 2 + 2 + 2 + 2 + 3 + 3 + 3

2 + 2 + 2 + 2 + 3 + 3 + 3 + 3 + 3

2 + 3 + 3 + 3 + 3 + 3 + 3 + 3

La de menor número de sumando es la última, que tiene 8 sumandos.

Definir las funciones

   minimoSumandosDigitos        :: Integer -> Integer
   graficaMinimoSumandosDigitos :: Integer -> IO ()

1 2	minimoSumandosDigitos :: Integer -> Integer graficaMinimoSumandosDigitos :: Integer -> IO ()

tales que

(minimoSumandosDigitos n) es el menor número de dígitos de n cuya suma es n. Por ejemplo,

     minimoSumandosDigitos 23    ==  8
     minimoSumandosDigitos 232   ==  78
     minimoSumandosDigitos 2323  ==  775
     map minimoSumandosDigitos [10..20] == [10,11,6,5,5,3,6,5,4,3,10]

minimoSumandosDigitos 23 == 8

minimoSumandosDigitos 232 == 78

minimoSumandosDigitos 2323 == 775

map minimoSumandosDigitos [10..20] == [10,11,6,5,5,3,6,5,4,3,10]

(graficaMinimoSumandosDigitos n) dibuja la gráfica de (minimoSumandosDigitos k) par los k primeros números naturales. Por ejemplo, (graficaMinimoSumandosDigitos 300) dibuja

Soluciones

import Data.List (nub, genericLength, sort)
import Graphics.Gnuplot.Simple

minimoSumandosDigitos :: Integer -> Integer
minimoSumandosDigitos n =
  minimoSumandos (digitos n) n

-- (digitos n) es el conjunto de los dígitos no nulos de n. Por ejemplo,
--    digitos 2032  ==  [2,3]
digitos :: Integer -> [Integer]
digitos n =
  nub [read [c] | c <- show n, c /= '0']

-- (minimoSumandos xs n) es el menor número de elementos de la lista de
-- enteros positivos xs (con posibles repeticiones) cuya suma es n. Por
-- ejemplo, 
--    minimoSumandos [7,2,4] 11  ==  2
minimoSumandos :: [Integer] -> Integer -> Integer
minimoSumandos xs n =
  minimum (mapo genericLength (sumas xs n))

-- (sumas xs n) es la lista de elementos de la lista de enteros
-- positivos xs (con posibles repeticiones) cuya suma es n. Por ejemplo,  
--    sumas [7,2,4] 11  ==  [[7,2,2],[7,4]]
sumas :: [Integer] -> Integer -> [[Integer]]
sumas [] 0 = [[]]
sumas [] _ = []
sumas (x:xs) n
  | x <= n    = map (x:) (sumas (x:xs) (n-x)) ++ sumas xs n
  | otherwise = sumas xs n

graficaMinimoSumandosDigitos :: Integer -> IO ()
graficaMinimoSumandosDigitos n =
  plotList [ Key Nothing
           , PNG "Numero_como_suma_de_sus_digitos.png"
           ]
           [minimoSumandosDigitos k | k <- [0..n-1]]

import Data.List (nub, genericLength, sort)

import Graphics.Gnuplot.Simple

minimoSumandosDigitos :: Integer -> Integer

minimoSumandosDigitos n =

minimoSumandos (digitos n) n

-- (digitos n) es el conjunto de los dígitos no nulos de n. Por ejemplo,

-- digitos 2032 == [2,3]

digitos :: Integer -> [Integer]

digitos n =

nub [read [c] | c <- show n, c /= '0']

-- (minimoSumandos xs n) es el menor número de elementos de la lista de

-- enteros positivos xs (con posibles repeticiones) cuya suma es n. Por

-- ejemplo,

-- minimoSumandos [7,2,4] 11 == 2

minimoSumandos :: [Integer] -> Integer -> Integer

minimoSumandos xs n =

minimum (mapo genericLength (sumas xs n))

-- (sumas xs n) es la lista de elementos de la lista de enteros

-- positivos xs (con posibles repeticiones) cuya suma es n. Por ejemplo,

-- sumas [7,2,4] 11 == [[7,2,2],[7,4]]

sumas :: [Integer] -> Integer -> [[Integer]]

sumas [] 0 = [[]]

sumas [] _ = []

sumas (x:xs) n

| x <= n = map (x:) (sumas (x:xs) (n-x)) ++ sumas xs n

| otherwise = sumas xs n

graficaMinimoSumandosDigitos :: Integer -> IO ()

graficaMinimoSumandosDigitos n =

plotList [ Key Nothing

, PNG "Numero_como_suma_de_sus_digitos.png"

]

[minimoSumandosDigitos k | k <- [0..n-1]]

Pensamiento

Caminante, son tus huellas
el camino, y nada más;
caminante no hay camino,
se hace camino al andar.

Antonio Machado

Sucesión de Cantor de números innombrables

PorJosé A. Alonso 15-febrero-201922-febrero-2019

Un número es innombrable si es divisible por 7 o alguno de sus dígitos es un 7. Un juego infantil consiste en contar saltándose los números innombrables:

   1 2 3 4 5 6 ( ) 8 9 10 11 12 13 ( ) 15 16 ( ) 18 ...

1	1 2 3 4 5 6 ( ) 8 9 10 11 12 13 ( ) 15 16 ( ) 18 ...

La sucesión de Cantor se obtiene llenando los huecos de la sucesión anterior:

  1 2 3 4 5 6 (1) 8 9 10 11 12 13 (2) 15 16 (3) 18 19 20 (4) 22 23
  24 25 26 (5) (6) 29 30 31 32 33 34 (1) 36 (8) 38 39 40 41  (9) 43
  44 45 46 (10) 48 (11) 50 51 52 53 54 55 (12) (13) 58 59 60 61 62
  (2) 64 65 66 (15) 68 69 (16) (3) (18) (19) (20) (4) (22) (23) (24)
  (25) 80 81 82 83 (26) 85 86 (5) 88 89 90 (6) 92 93 94 95 96 (29)
  (30) 99 100

1 2 3 4 5 6 (1) 8 9 10 11 12 13 (2) 15 16 (3) 18 19 20 (4) 22 23

24 25 26 (5) (6) 29 30 31 32 33 34 (1) 36 (8) 38 39 40 41 (9) 43

44 45 46 (10) 48 (11) 50 51 52 53 54 55 (12) (13) 58 59 60 61 62

(2) 64 65 66 (15) 68 69 (16) (3) (18) (19) (20) (4) (22) (23) (24)

(25) 80 81 82 83 (26) 85 86 (5) 88 89 90 (6) 92 93 94 95 96 (29)

(30) 99 100

Definir las funciones

   sucCantor        :: [Integer]
   graficaSucCantor :: Int -> IO ()

1 2	sucCantor :: [Integer] graficaSucCantor :: Int -> IO ()

tales que

sucCantor es la lista cuyos elementos son los términos de la sucesión de Cantor. Por ejemplo,

     λ> take 100 sucCantor
     [1,2,3,4,5,6, 1 ,8,9,10,11,12,13, 2, 15,16, 3, 18,19,20, 4,
      22,23,24,25,26, 5 , 6 ,29,30,31,32,33,34, 1 ,36 , 8 ,38,39,
      40,41, 9 ,43,44,45,46, 10 ,48, 11 ,50,51,52,53,54,55 , 12 ,
      13, 58,59,60,61,62, 2 ,64,65,66, 15 ,68,69, 16 , 3 , 18, 19,
      20, 4, 22, 23, 24 ,25 ,80,81,82,83, 26 ,85,86, 5 ,88,89,90,
      6, 92,93,94,95,96, 29, 30 ,99,100]
     λ> sucCantor2 !! (5+10^6)
     544480
     λ> sucCantor2 !! (6+10^6)
     266086

λ> take 100 sucCantor

[1,2,3,4,5,6, 1 ,8,9,10,11,12,13, 2, 15,16, 3, 18,19,20, 4,

22,23,24,25,26, 5 , 6 ,29,30,31,32,33,34, 1 ,36 , 8 ,38,39,

40,41, 9 ,43,44,45,46, 10 ,48, 11 ,50,51,52,53,54,55 , 12 ,

13, 58,59,60,61,62, 2 ,64,65,66, 15 ,68,69, 16 , 3 , 18, 19,

20, 4, 22, 23, 24 ,25 ,80,81,82,83, 26 ,85,86, 5 ,88,89,90,

6, 92,93,94,95,96, 29, 30 ,99,100]

λ> sucCantor2 !! (5+10^6)

544480

λ> sucCantor2 !! (6+10^6)

266086

(graficaSucCantor n) es la gráfica de los n primeros términos de la sucesión de Cantor. Por ejemplo, (graficaSucCantor 200) dibuja

Soluciones

import Graphics.Gnuplot.Simple

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

sucCantor1 :: [Integer]
sucCantor1 = map fst $ scanl f (1,0) [2..]
  where f (a,i) x
          | esInnombrable x = (sucCantor1 !! i, i+1)
          | otherwise       = (x,i)

esInnombrable :: Integer -> Bool
esInnombrable x =
  rem x 7 == 0 || '7' `elem` show x

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

sucCantor2 :: [Integer]
sucCantor2 = aux 0 1
  where aux i x
          | esInnombrable x = sucCantor2 !! i : aux (i+1) (x+1)
          | otherwise       = x : aux i (x+1) 

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

sucCantor3 :: [Integer]
sucCantor3 = 1 : aux [2..] sucCantor3
  where aux [] _ = []
        aux (x:xs) a@(y:ys)
          | esInnombrable x = y : aux xs ys
          | otherwise       = x : aux xs a

-- Definición de graficaSucCantor
-- ========================================

graficaSucCantor :: Int -> IO ()
graficaSucCantor n =
  plotList [ Key Nothing
           , PNG ("Sucesion_de_Cantor_de_numeros_innombrables.png")
           ]
           (take n sucCantor3)

import Graphics.Gnuplot.Simple

-- 1ª solución

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

sucCantor1 :: [Integer]

sucCantor1 = map fst $ scanl f (1,0) [2..]

where f (a,i) x

| esInnombrable x = (sucCantor1 !! i, i+1)

| otherwise = (x,i)

esInnombrable :: Integer -> Bool

esInnombrable x =

rem x 7 == 0 || '7' `elem` show x

-- 2ª solución

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

sucCantor2 :: [Integer]

sucCantor2 = aux 0 1

where aux i x

| esInnombrable x = sucCantor2 !! i : aux (i+1) (x+1)

| otherwise = x : aux i (x+1)

-- 3ª solución

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

sucCantor3 :: [Integer]

sucCantor3 = 1 : aux [2..] sucCantor3

where aux [] _ = []

aux (x:xs) a@(y:ys)

| esInnombrable x = y : aux xs ys

| otherwise = x : aux xs a

-- Definición de graficaSucCantor

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

graficaSucCantor :: Int -> IO ()

graficaSucCantor n =

plotList [ Key Nothing

, PNG ("Sucesion_de_Cantor_de_numeros_innombrables.png")

]

(take n sucCantor3)

Pensamiento

Dices que nada se pierde
y acaso dices verdad;
pero todo lo perdemos
y todo nos perderá.

Antonio Machado

Medias de dígitos de pi

PorJosé A. Alonso 5-febrero-201925-abril-2021

El fichero Digitos_de_pi.txt contiene el número pi con un millón de decimales; es decir,

   3.1415926535897932384626433832 ... 83996346460422090106105779458151

1	3.1415926535897932384626433832 ... 83996346460422090106105779458151

Definir las funciones

   mediasDigitosDePi        :: IO [Double]
   graficaMediasDigitosDePi :: Int -> IO ()

1 2	mediasDigitosDePi :: IO [Double] graficaMediasDigitosDePi :: Int -> IO ()

tales que

mediasDigitosDePi es la sucesión cuyo n-ésimo elemento es la media de los n primeros dígitos de pi. Por ejemplo,

     λ> xs <- mediasDigitosDePi
     λ> take 5 xs
     [1.0,2.5,2.0,2.75,4.0]
     λ> take 10 xs
     [1.0,2.5,2.0,2.75,4.0,3.6666666666666665,4.0,4.125,4.0,4.1]
     λ> take 10 <$> mediasDigitosDePi
     [1.0,2.5,2.0,2.75,4.0,3.6666666666666665,4.0,4.125,4.0,4.1]

λ> xs <- mediasDigitosDePi

λ> take 5 xs

[1.0,2.5,2.0,2.75,4.0]

λ> take 10 xs

[1.0,2.5,2.0,2.75,4.0,3.6666666666666665,4.0,4.125,4.0,4.1]

λ> take 10 <$> mediasDigitosDePi

[1.0,2.5,2.0,2.75,4.0,3.6666666666666665,4.0,4.125,4.0,4.1]

(graficaMediasDigitosDePi n) dibuja la gráfica de los n primeros términos de mediasDigitosDePi. Por ejemplo,
- (graficaMediasDigitosDePi 20) dibuja
- (graficaMediasDigitosDePi 200) dibuja
- (graficaMediasDigitosDePi 2000) dibuja

Soluciones

import Data.Char (digitToInt)
import Data.List (genericLength, inits, tails)
import Graphics.Gnuplot.Simple ( Attribute (Key, PNG)
                               , plotList )

-- Definición de mediasDigitosDePi
-- ===============================

mediasDigitosDePi :: IO [Double]
mediasDigitosDePi = do
  (_:_:ds) <- readFile "Digitos_de_pi.txt"
  return (medias (digitos ds))

-- (digitos cs) es la lista de los digitos de cs. Por ejempplo,
--    digitos "1415926535"  ==  [1,4,1,5,9,2,6,5,3,5]
digitos :: String -> [Int]
digitos = map digitToInt

-- (medias xs) es la lista de las medias de los segmentos iniciales de
-- xs. Por ejemplo,
--    λ> medias [1,4,1,5,9,2,6,5,3,5]
--    [1.0,2.5,2.0,2.75,4.0,3.6666666666666665,4.0,4.125,4.0,4.1]
medias :: [Int] -> [Double]
medias xs = map media (tail (inits xs))

-- (media xs) es la media aritmética de xs. Por ejemplo,
--    media [1,4,1,5,9]  ==  4.0
media :: [Int] -> Double
media xs = fromIntegral (sum xs) / genericLength xs

-- Definición de graficaMediasDigitosDePi
-- ======================================

graficaMediasDigitosDePi :: Int -> IO ()
graficaMediasDigitosDePi n = do
  xs <- mediasDigitosDePi
  plotList [ Key Nothing
           , PNG ("Medias_de_digitos_de_pi_" ++ show n ++ ".png")
           ]
           (take n xs)

import Data.Char (digitToInt)

import Data.List (genericLength, inits, tails)

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

, plotList )

-- Definición de mediasDigitosDePi

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

mediasDigitosDePi :: IO [Double]

mediasDigitosDePi = do

(_:_:ds) <- readFile "Digitos_de_pi.txt"

return (medias (digitos ds))

-- (digitos cs) es la lista de los digitos de cs. Por ejempplo,

-- digitos "1415926535" == [1,4,1,5,9,2,6,5,3,5]

digitos :: String -> [Int]

digitos = map digitToInt

-- (medias xs) es la lista de las medias de los segmentos iniciales de

-- xs. Por ejemplo,

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

-- [1.0,2.5,2.0,2.75,4.0,3.6666666666666665,4.0,4.125,4.0,4.1]

medias :: [Int] -> [Double]

medias xs = map media (tail (inits xs))

-- (media xs) es la media aritmética de xs. Por ejemplo,

-- media [1,4,1,5,9] == 4.0

media :: [Int] -> Double

media xs = fromIntegral (sum xs) / genericLength xs

-- Definición de graficaMediasDigitosDePi

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

graficaMediasDigitosDePi :: Int -> IO ()

graficaMediasDigitosDePi n = do

xs <- mediasDigitosDePi

plotList [ Key Nothing

, PNG ("Medias_de_digitos_de_pi_" ++ show n ++ ".png")

]

(take n xs)

Pensamiento

Es el mejor de los buenos
quien sabe que en esta vida
todo es cuestión de medida:
un poco más, algo menos.

Antonio Machado

Dígitos en las posiciones pares de cuadrados

PorJosé A. Alonso 1-febrero-20198-febrero-2019

Definir las funciones

   digitosPosParesCuadrado    :: Integer -> ([Integer],Int)
   invDigitosPosParesCuadrado :: ([Integer],Int) -> [Integer]

1 2	digitosPosParesCuadrado :: Integer -> ([Integer],Int) invDigitosPosParesCuadrado :: ([Integer],Int) -> [Integer]

tales que

(digitosPosParesCuadrado n) es el par formados por los dígitos de n² en la posiciones pares y por el número de dígitos de n². Por ejemplo,

     digitosPosParesCuadrado 8     ==  ([6],2)
     digitosPosParesCuadrado 14    ==  ([1,6],3)
     digitosPosParesCuadrado 36    ==  ([1,9],4)
     digitosPosParesCuadrado 116   ==  ([1,4,6],5)
     digitosPosParesCuadrado 2019  ==  ([4,7,3,1],7)

digitosPosParesCuadrado 8 == ([6],2)

digitosPosParesCuadrado 14 == ([1,6],3)

digitosPosParesCuadrado 36 == ([1,9],4)

digitosPosParesCuadrado 116 == ([1,4,6],5)

digitosPosParesCuadrado 2019 == ([4,7,3,1],7)

(invDigitosPosParesCuadrado (xs,k)) es la lista de los números n tales que xs es la lista de los dígitos de n² en la posiciones pares y k es el número de dígitos de n². Por ejemplo,

     invDigitosPosParesCuadrado ([6],2)             ==  [8]
     invDigitosPosParesCuadrado ([1,6],3)           ==  [14]
     invDigitosPosParesCuadrado ([1,9],4)           ==  [36]
     invDigitosPosParesCuadrado ([1,4,6],5)         ==  [116,136]
     invDigitosPosParesCuadrado ([4,7,3,1],7)       ==  [2019,2139,2231]
     invDigitosPosParesCuadrado ([1,2],3)           ==  []
     invDigitosPosParesCuadrado ([1,2],4)           ==  [32,35,39]
     invDigitosPosParesCuadrado ([1,2,3,4,5,6],11)  ==  [115256,127334,135254]

invDigitosPosParesCuadrado ([6],2) == [8]

invDigitosPosParesCuadrado ([1,6],3) == [14]

invDigitosPosParesCuadrado ([1,9],4) == [36]

invDigitosPosParesCuadrado ([1,4,6],5) == [116,136]

invDigitosPosParesCuadrado ([4,7,3,1],7) == [2019,2139,2231]

invDigitosPosParesCuadrado ([1,2],3) == []

invDigitosPosParesCuadrado ([1,2],4) == [32,35,39]

invDigitosPosParesCuadrado ([1,2,3,4,5,6],11) == [115256,127334,135254]

Comprobar con QuickCheck que para todo entero positivo n se verifica que para todo entero positivo m, m pertenece a (invDigitosPosParesCuadrado (digitosPosParesCuadrado n)) si, y sólo si, (digitosPosParesCuadrado m) es igual a (digitosPosParesCuadrado n)

Soluciones

import Test.QuickCheck

-- Definición de digitosPosParesCuadrado
-- =====================================

digitosPosParesCuadrado :: Integer -> ([Integer],Int)
digitosPosParesCuadrado n =
  (digitosPosPares (n^2),length (show (n^2)))

-- (digitosPosPares n) es la lista de los dígitos de n en posiciones
-- pares. Por ejemplo,
--    digitosPosPares 24012019  ==  [2,0,2,1]
digitosPosPares :: Integer -> [Integer]
digitosPosPares n = elementosPosPares (digitos n)

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

-- (elementosPosPares xs) es la lista de los elementos de xs en
-- posiciones pares. Por ejemplo,
--    elementosPosPares [3,2,5,7,6,4]  ==  [3,5,6]
elementosPosPares :: [a] -> [a]
elementosPosPares []       = []
elementosPosPares [x]      = [x]
elementosPosPares (x:_:zs) = x : elementosPosPares zs

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

invDigitosPosParesCuadrado :: ([Integer],Int) -> [Integer]
invDigitosPosParesCuadrado (xs, a) =
  [x | x <- [ceiling (sqrt 10^(a-1))..ceiling (sqrt 10^a)]
     , digitosPosParesCuadrado x == (xs,a)]

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

invDigitosPosParesCuadrado2 :: ([Integer],Int) -> [Integer]
invDigitosPosParesCuadrado2 x =
  [n | n <- [a..b], digitosPosParesCuadrado n == x]
  where a = floor (sqrt (fromIntegral (completaNum x 0)))
        b = ceiling (sqrt (fromIntegral (completaNum x 9)))

-- (completaNum (xs,k) n) es el número cuyos dígitos en las posiciones
-- pares son los de xs y los de las posiciones impares son iguales a n
-- (se supone que k es igual al doble de la longitud de xs o un
-- menos). Por ejemplo, 
--    completaNum ([1,3,8],5) 4  ==  14348
--    completaNum ([1,3,8],6) 4  ==  143484
completaNum :: ([Integer],Int) -> Integer -> Integer
completaNum x n = digitosAnumero (completa x n)

-- (completa (xs,k) n) es la lista cuyos elementos en las posiciones
-- pares son los de xs y los de las posiciones impares son iguales a n
-- (se supone que k es igual al doble de la longitud de xs o un
-- menos). Por ejemplo, 
--    completa ([1,3,8],5) 4  ==  [1,4,3,4,8]
--    completa ([1,3,8],6) 4  ==  [1,4,3,4,8,4]
completa :: ([Integer],Int) -> Integer -> [Integer]
completa (xs,k) n
  | even k    = ys
  | otherwise = init ys
  where ys = concat [[x,n] | x <- xs]

-- (digitosAnumero ds) es el número cuyos dígitos son ds. Por ejemplo,
--    digitosAnumero [2,0,1,9]  ==  2019
digitosAnumero :: [Integer] -> Integer
digitosAnumero = read . concatMap show

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

--    λ> invDigitosPosParesCuadrado ([1,2,1,5,7,4,9],13)
--    [1106393,1234567,1314597]
--    (7.55 secs, 13,764,850,536 bytes)
--    λ> invDigitosPosParesCuadrado2 ([1,2,1,5,7,4,9],13)
--    [1106393,1234567,1314597]
--    (1.96 secs, 3,780,368,816 bytes)

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

-- La propiedad es  
prop_digitosPosParesCuadrado :: Positive Integer -> Positive Integer -> Bool
prop_digitosPosParesCuadrado (Positive n) (Positive m) =
  (digitosPosParesCuadrado m == x)
  == (m `elem` invDigitosPosParesCuadrado x)
  where x = digitosPosParesCuadrado n

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

import Test.QuickCheck

-- Definición de digitosPosParesCuadrado

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

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

digitosPosParesCuadrado n =

(digitosPosPares (n^2),length (show (n^2)))

-- (digitosPosPares n) es la lista de los dígitos de n en posiciones

-- pares. Por ejemplo,

-- digitosPosPares 24012019 == [2,0,2,1]

digitosPosPares :: Integer -> [Integer]

digitosPosPares n = elementosPosPares (digitos n)

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

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

digitos :: Integer -> [Integer]

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

-- (elementosPosPares xs) es la lista de los elementos de xs en

-- posiciones pares. Por ejemplo,

-- elementosPosPares [3,2,5,7,6,4] == [3,5,6]

elementosPosPares :: [a] -> [a]

elementosPosPares [] = []

elementosPosPares [x] = [x]

elementosPosPares (x:_:zs) = x : elementosPosPares zs

-- 1ª definición de invDigitosPosParesCuadrado

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

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

invDigitosPosParesCuadrado (xs, a) =

[x | x <- [ceiling (sqrt 10^(a-1))..ceiling (sqrt 10^a)]

, digitosPosParesCuadrado x == (xs,a)]

-- 2ª definición de invDigitosPosParesCuadrado

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

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

invDigitosPosParesCuadrado2 x =

[n | n <- [a..b], digitosPosParesCuadrado n == x]

where a = floor (sqrt (fromIntegral (completaNum x 0)))

b = ceiling (sqrt (fromIntegral (completaNum x 9)))

-- (completaNum (xs,k) n) es el número cuyos dígitos en las posiciones

-- pares son los de xs y los de las posiciones impares son iguales a n

-- (se supone que k es igual al doble de la longitud de xs o un

-- menos). Por ejemplo,

-- completaNum ([1,3,8],5) 4 == 14348

-- completaNum ([1,3,8],6) 4 == 143484

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

completaNum x n = digitosAnumero (completa x n)

-- (completa (xs,k) n) es la lista cuyos elementos en las posiciones

-- pares son los de xs y los de las posiciones impares son iguales a n

-- (se supone que k es igual al doble de la longitud de xs o un

-- menos). Por ejemplo,

-- completa ([1,3,8],5) 4 == [1,4,3,4,8]

-- completa ([1,3,8],6) 4 == [1,4,3,4,8,4]

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

completa (xs,k) n

| even k = ys

| otherwise = init ys

where ys = concat [[x,n] | x <- xs]

-- (digitosAnumero ds) es el número cuyos dígitos son ds. Por ejemplo,

-- digitosAnumero [2,0,1,9] == 2019

digitosAnumero :: [Integer] -> Integer

digitosAnumero = read . concatMap show

-- Comparación de eficiencia

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

-- λ> invDigitosPosParesCuadrado ([1,2,1,5,7,4,9],13)

-- [1106393,1234567,1314597]

-- (7.55 secs, 13,764,850,536 bytes)

-- λ> invDigitosPosParesCuadrado2 ([1,2,1,5,7,4,9],13)

-- [1106393,1234567,1314597]

-- (1.96 secs, 3,780,368,816 bytes)

-- Comprobación de la propiedad

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

-- La propiedad es

prop_digitosPosParesCuadrado :: Positive Integer -> Positive Integer -> Bool

prop_digitosPosParesCuadrado (Positive n) (Positive m) =

(digitosPosParesCuadrado m == x)

== (m `elem` invDigitosPosParesCuadrado x)

where x = digitosPosParesCuadrado n

-- La comprobación es

-- λ> quickCheck prop_digitosPosParesCuadrado

-- +++ OK, passed 100 tests.

Pensamiento

¡Ojos que a la luz se abrieron
un día para, después,
ciegos tornar a la tierra,
hartos de mirar sin ver.

Antonio Machado

Números con dígitos 1 y 2

PorJosé A. Alonso 28-enero-201926-marzo-2022

Definir las funciones

   numerosCon1y2               :: Int -> [Int]
   restosNumerosCon1y2         :: Int -> [Int]
   grafica_restosNumerosCon1y2 :: Int -> IO ()

numerosCon1y2 :: Int -> [Int]

restosNumerosCon1y2 :: Int -> [Int]

grafica_restosNumerosCon1y2 :: Int -> IO ()

tales que

(numerosCon1y2 n) es la lista ordenada de números de n dígitos que se pueden formar con los dígitos 1 y 2. Por ejemplo,

     numerosCon1y2 2  ==  [11,12,21,22] 
     numerosCon1y2 3  ==  [111,112,121,122,211,212,221,222]

1 2	numerosCon1y2 2 == [11,12,21,22] numerosCon1y2 3 == [111,112,121,122,211,212,221,222]

(restosNumerosCon1y2 n) es la lista de los restos de dividir los elementos de (restosNumerosCon1y2 n) entre 2^n. Por ejemplo,

     restosNumerosCon1y2 2 == [3,0,1,2]
     restosNumerosCon1y2 3 == [7,0,1,2,3,4,5,6]
     restosNumerosCon1y2 4 == [7,8,1,2,11,12,5,6,15,0,9,10,3,4,13,14]

restosNumerosCon1y2 2 == [3,0,1,2]

restosNumerosCon1y2 3 == [7,0,1,2,3,4,5,6]

restosNumerosCon1y2 4 == [7,8,1,2,11,12,5,6,15,0,9,10,3,4,13,14]

(graficaRestosNumerosCon1y2 n) dibuja la gráfica de los restos de dividir los elementos de (restosNumerosCon1y2 n) entre 2^n. Por ejemplo, (graficaRestosNumerosCon1y2 3) dibuja

(graficaRestosNumerosCon1y2 4) dibuja

y (graficaRestosNumerosCon1y2 5) dibuja

Nota: En la definición usar la función plotListStyle y como su segundo argumento (el PloStyle) usar

     (defaultStyle {plotType = LinesPoints,
                    lineSpec = CustomStyle [PointType 7]})

1 2	(defaultStyle {plotType = LinesPoints, lineSpec = CustomStyle [PointType 7]})

Comprobar con QuickCheck que todos los elementos de (restosNumerosCon1y2 n) son distintos.

Soluciones

import Test.QuickCheck
import Graphics.Gnuplot.Simple

-- Definición de numerosCon1y2
-- ===========================

numerosCon1y2 :: Int -> [Int]
numerosCon1y2 = map digitosAnumero . digitos

-- (dígitos n) es la lista ordenada de de listas de n elementos que
-- se pueden formar con los dígitos 1 y 2. Por ejemplo,
--    λ> digitos 2
--    [[1,1],[1,2],[2,1],[2,2]]
--    λ> digitos 3
--    [[1,1,1],[1,1,2],[1,2,1],[1,2,2],[2,1,1],[2,1,2],[2,2,1],[2,2,2]]
digitos :: Int -> [[Int]]
digitos 0 = [[]]
digitos n = map (1:) xss ++ map (2:) xss
  where xss = digitos (n-1)

-- (digitosAnumero ds) es el número cuyos dígitos son ds. Por ejemplo,
--    digitosAnumero [2,0,1,9]  ==  2019
digitosAnumero :: [Int] -> Int
digitosAnumero = read . concatMap show

-- Definición de restosNumerosCon1y2
-- =================================

restosNumerosCon1y2 :: Int -> [Int]
restosNumerosCon1y2 n =
  [x `mod` m | x <- numerosCon1y2 n]
  where m = 2^n

-- Definición de graficaRestosNumerosCon1y2
-- =========================================

graficaRestosNumerosCon1y2 :: Int -> IO ()
graficaRestosNumerosCon1y2 n =
  plotListStyle
    [ Key Nothing
    , PNG ("Numeros_con_digitos_1_y_2_" ++ show n ++ ".png")
    ]
    (defaultStyle {plotType = LinesPoints,
                   lineSpec = CustomStyle [PointType 7]})
    (restosNumerosCon1y2 n)

-- Propiedad de restosNumerosCon1y2
-- ================================

-- La propiedad
prop_restosNumerosCon1y2 :: Positive Int -> Bool
prop_restosNumerosCon1y2 (Positive n) =
  todosDistintos (restosNumerosCon1y2 n)
  where todosDistintos xs = xs == nub xs

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

import Test.QuickCheck

import Graphics.Gnuplot.Simple

-- Definición de numerosCon1y2

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

numerosCon1y2 :: Int -> [Int]

numerosCon1y2 = map digitosAnumero . digitos

-- (dígitos n) es la lista ordenada de de listas de n elementos que

-- se pueden formar con los dígitos 1 y 2. Por ejemplo,

-- λ> digitos 2

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

-- λ> digitos 3

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

digitos :: Int -> [[Int]]

digitos 0 = [[]]

digitos n = map (1:) xss ++ map (2:) xss

where xss = digitos (n-1)

-- (digitosAnumero ds) es el número cuyos dígitos son ds. Por ejemplo,

-- digitosAnumero [2,0,1,9] == 2019

digitosAnumero :: [Int] -> Int

digitosAnumero = read . concatMap show

-- Definición de restosNumerosCon1y2

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

restosNumerosCon1y2 :: Int -> [Int]

restosNumerosCon1y2 n =

[x `mod` m | x <- numerosCon1y2 n]

where m = 2^n

-- Definición de graficaRestosNumerosCon1y2

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

graficaRestosNumerosCon1y2 :: Int -> IO ()

graficaRestosNumerosCon1y2 n =

plotListStyle

[ Key Nothing

, PNG ("Numeros_con_digitos_1_y_2_" ++ show n ++ ".png")

]

(defaultStyle {plotType = LinesPoints,

lineSpec = CustomStyle [PointType 7]})

(restosNumerosCon1y2 n)

-- Propiedad de restosNumerosCon1y2

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

-- La propiedad

prop_restosNumerosCon1y2 :: Positive Int -> Bool

prop_restosNumerosCon1y2 (Positive n) =

todosDistintos (restosNumerosCon1y2 n)

where todosDistintos xs = xs == nub xs

-- La comprobación es

-- λ> quickCheckWith (stdArgs {maxSize=12}) prop_restosNumerosCon1y2

-- +++ OK, passed 100 tests.

Pensamiento

¿Para qué llamar caminos
a los surcos del azar? …
Todo el que camina anda,
como Jesús, sobre el mar.

Antonio Machado

Números primos en pi

PorJosé A. Alonso 24-enero-201931-enero-2019

El fichero Digitos_de_pi.txt contiene el número pi con un millón de decimales; es decir,

   3.1415926535897932384626433832 ... 83996346460422090106105779458151

1	3.1415926535897932384626433832 ... 83996346460422090106105779458151

Definir las funciones

   nOcurrenciasPrimosEnPi :: Int -> Int -> IO [Int]
   graficaPrimosEnPi      :: Int -> Int -> IO ()

1 2	nOcurrenciasPrimosEnPi :: Int -> Int -> IO [Int] graficaPrimosEnPi :: Int -> Int -> IO ()

tales que

(nOcurrenciasPrimosEnPi n k) es la lista de longitud n cuyo i-ésimo elemento es el número de ocurrencias del i-ésimo número primo en los k primeros decimales del número pi. Por ejemplo,

   nOcurrenciasPrimosEnPi 4 20 == [2,3,3,1]

1	nOcurrenciasPrimosEnPi 4 20 == [2,3,3,1]

ya que los 20 primeros decimales de pi son 14159265358979323846 y en ellos ocurre el 2 dos veces, el 3 ocurre 3 veces, el 5 ocurre 3 veces y el 7 ocurre 1 vez. Otros ejemplos son

     λ> nOcurrenciasPrimosEnPi 10 100
     [12,11,8,8,1,0,1,1,2,0]
     λ> nOcurrenciasPrimosEnPi 10 (10^4)
     [1021,974,1046,970,99,102,90,113,99,95]
     λ> nOcurrenciasPrimosEnPi 10 (10^6)
     [100026,100229,100359,99800,10064,10012,9944,10148,9951,9912]

λ> nOcurrenciasPrimosEnPi 10 100

[12,11,8,8,1,0,1,1,2,0]

λ> nOcurrenciasPrimosEnPi 10 (10^4)

[1021,974,1046,970,99,102,90,113,99,95]

λ> nOcurrenciasPrimosEnPi 10 (10^6)

[100026,100229,100359,99800,10064,10012,9944,10148,9951,9912]

(graficaPrimosEnPi n k) dibuja la gráfica del número de ocurrencias de los n primeros números primos en los k primeros dígitos de pi. Por ejemplo, (graficaPrimosEnPi 10 (10^4)) dibuja

(graficaPrimosEnPi 10 (10^6)) dibuja

y (graficaPrimosEnPi 50 (10^5)) dibuja

Soluciones

import Data.List               ( isPrefixOf
                               , findIndices
                               , tails )
import Data.Numbers.Primes     ( primes)
import Graphics.Gnuplot.Simple ( Attribute (Key, PNG)
                               , plotList )

-- Definición de nOcurrenciasPrimosEnPi
-- ====================================

nOcurrenciasPrimosEnPi :: Int -> Int -> IO [Int]
nOcurrenciasPrimosEnPi n k = do
  (_:_:ds) <- readFile "Digitos_de_pi.txt"
  let ps = take n primes
  let es = take k ds
  return [nOcurrencias (show x) es | x <- ps]

-- (nOcurrencias xs yss) es el número de ocurrencias de xs en yss. Por
-- ejemplo,
--    nOcurrencias "ac" "acbadcacaac"  ==  3
nOcurrencias :: Eq a => [a] -> [a] -> Int
nOcurrencias xs yss = length (ocurrencias xs yss)

-- (ocurrencias xs yss) es el índice de las posiciones del primer
-- elemento de xs en las ocurrencias de xs en yss. Por ejemplo,
--    ocurrencias "ac" "acbadcacaac"  ==  [0,6,9]
ocurrencias :: Eq a => [a] -> [a] -> [Int]
ocurrencias xs yss =
  findIndices (xs `isPrefixOf`) (tails yss)

-- Definición de graficaPrimosEnPi
-- ===============================

graficaPrimosEnPi :: Int -> Int -> IO ()
graficaPrimosEnPi n k = do
  xs <- nOcurrenciasPrimosEnPi n k
  plotList [ Key Nothing
           , PNG ("Numeros_primos_en_pi_" ++ show (n,k) ++ ".png")  
           ]
           xs

import Data.List ( isPrefixOf

, findIndices

, tails )

import Data.Numbers.Primes ( primes)

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

, plotList )

-- Definición de nOcurrenciasPrimosEnPi

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

nOcurrenciasPrimosEnPi :: Int -> Int -> IO [Int]

nOcurrenciasPrimosEnPi n k = do

(_:_:ds) <- readFile "Digitos_de_pi.txt"

let ps = take n primes

let es = take k ds

return [nOcurrencias (show x) es | x <- ps]

-- (nOcurrencias xs yss) es el número de ocurrencias de xs en yss. Por

-- ejemplo,

-- nOcurrencias "ac" "acbadcacaac" == 3

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

nOcurrencias xs yss = length (ocurrencias xs yss)

-- (ocurrencias xs yss) es el índice de las posiciones del primer

-- elemento de xs en las ocurrencias de xs en yss. Por ejemplo,

-- ocurrencias "ac" "acbadcacaac" == [0,6,9]

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

ocurrencias xs yss =

findIndices (xs `isPrefixOf`) (tails yss)

-- Definición de graficaPrimosEnPi

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

graficaPrimosEnPi :: Int -> Int -> IO ()

graficaPrimosEnPi n k = do

xs <- nOcurrenciasPrimosEnPi n k

plotList [ Key Nothing

, PNG ("Numeros_primos_en_pi_" ++ show (n,k) ++ ".png")

]

Pensamiento

Al borde del sendero un día nos sentamos.
Ya nuestra vida es tiempo, y nuestra sola cuita
son las desesperantes posturas que tomamos
para aguardar … Mas ella no faltará a la cita.

Antonio Machado

Cadena descendiente de subnúmeros

PorJosé A. Alonso 7-enero-201914-enero-2019

Una particularidad del 2019 es que se puede escribir como una cadena de dos subnúmeros consecutivos (el 20 y el 19).

Definir la función

   cadena :: Integer -> [Integer]

1	cadena :: Integer -> [Integer]

tal que (cadena n) es la cadena de subnúmeros consecutivos de n cuya unión es n; es decir, es la lista de números [x,x-1,…x-k] tal que su concatenación es n. Por ejemplo,

   cadena 2019         == [20,19]
   cadena 2018         == [2018]
   cadena 1009         == [1009]
   cadena 110109       == [110,109]
   cadena 201200199198 == [201,200,199,198] 
   cadena 3246         == [3246]            
   cadena 87654        == [8,7,6,5,4]       
   cadena 123456       == [123456]          
   cadena 1009998      == [100,99,98]       
   cadena 100908       == [100908]          
   cadena 1110987      == [11,10,9,8,7]     
   cadena 210          == [2,1,0]           
   cadena 1            == [1]               
   cadena 0            == [0]               
   cadena 312          == [312]             
   cadena 191          == [191]
   length (cadena (read (concatMap show [2019,2018..0])))  ==  2020

cadena 2019 == [20,19]

cadena 2018 == [2018]

cadena 1009 == [1009]

cadena 110109 == [110,109]

cadena 201200199198 == [201,200,199,198]

cadena 3246 == [3246]

cadena 87654 == [8,7,6,5,4]

cadena 123456 == [123456]

cadena 1009998 == [100,99,98]

cadena 100908 == [100908]

cadena 1110987 == [11,10,9,8,7]

cadena 210 == [2,1,0]

cadena 1 == [1]

cadena 0 == [0]

cadena 312 == [312]

cadena 191 == [191]

length (cadena (read (concatMap show [2019,2018..0]))) == 2020

Nota: Los subnúmeros no pueden empezar por cero. Por ejemplo, [10,09] no es una cadena de 1009 como se observa en el tercer ejemplo.

Soluciones

import Test.QuickCheck
import Data.List (inits)

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

cadena :: Integer -> [Integer]
cadena = head . cadenasL . digitos

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

-- (cadenasL xs) son las cadenas descendientes del número cuyos dígitos
-- son xs. Por ejemplo,
--    cadenasL [2,0,1,9]      == [[20,19],[2019]]
--    cadenasL [1,0,0,9]      == [[1009]]
--    cadenasL [1,1,0,1,0,9]  == [[110,109],[110109]]
cadenasL :: [Integer] -> [[Integer]] 
cadenasL []       = []
cadenasL [x]      = [[x]]
cadenasL [1,0]    = [[1,0],[10]]
cadenasL (x:0:zs) = cadenasL (10*x:zs) 
cadenasL (x:y:zs) =
     [x:a:as | (a:as) <- cadenasL (y:zs), a == x-1]
  ++ cadenasL (10*x+y:zs)

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

cadena2 :: Integer -> [Integer]
cadena2 n = (head . concatMap aux . iniciales) n 
  where aux x = [[x,x-1..x-k] | k <- [0..x]
                              , concatMap show [x,x-1..x-k] == ds]
        ds    = show n

-- (iniciales n) es la lista de los subnúmeros iniciales de n. Por
-- ejemplo, 
--    iniciales 2019  ==  [2,20,201,2019]
iniciales :: Integer -> [Integer]
iniciales = map read . tail . inits . show

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

-- La propiedad es
prop_cadena :: (Positive Integer) -> Bool
prop_cadena (Positive n) =
  cadena n == cadena2 n 
  
-- La comprobación es
--    λ> quickCheck prop_cadena
--    +++ OK, passed 100 tests.

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

--    λ> length (cadena (read (concatMap show [15,14..0])))
--    16
--    (3.28 secs, 452,846,008 bytes)
--    λ> length (cadena2 (read (concatMap show [15,14..0])))
--    16
--    (0.03 secs, 176,360 bytes)

import Test.QuickCheck

import Data.List (inits)

-- 1ª solución

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

cadena :: Integer -> [Integer]

cadena = head . cadenasL . digitos

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

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

digitos :: Integer -> [Integer]

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

-- (cadenasL xs) son las cadenas descendientes del número cuyos dígitos

-- son xs. Por ejemplo,

-- cadenasL [2,0,1,9] == [[20,19],[2019]]

-- cadenasL [1,0,0,9] == [[1009]]

-- cadenasL [1,1,0,1,0,9] == [[110,109],[110109]]

cadenasL :: [Integer] -> [[Integer]]

cadenasL [] = []

cadenasL [x] = [[x]]

cadenasL [1,0] = [[1,0],[10]]

cadenasL (x:0:zs) = cadenasL (10*x:zs)

cadenasL (x:y:zs) =

[x:a:as | (a:as) <- cadenasL (y:zs), a == x-1]

++ cadenasL (10*x+y:zs)

-- 2ª solución

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

cadena2 :: Integer -> [Integer]

cadena2 n = (head . concatMap aux . iniciales) n

where aux x = [[x,x-1..x-k] | k <- [0..x]

, concatMap show [x,x-1..x-k] == ds]

ds = show n

-- (iniciales n) es la lista de los subnúmeros iniciales de n. Por

-- ejemplo,

-- iniciales 2019 == [2,20,201,2019]

iniciales :: Integer -> [Integer]

iniciales = map read . tail . inits . show

-- Equivalencia

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

-- La propiedad es

prop_cadena :: (Positive Integer) -> Bool

prop_cadena (Positive n) =

cadena n == cadena2 n

-- La comprobación es

-- λ> quickCheck prop_cadena

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- λ> length (cadena (read (concatMap show [15,14..0])))

-- 16

-- (3.28 secs, 452,846,008 bytes)

-- λ> length (cadena2 (read (concatMap show [15,14..0])))

-- 16

-- (0.03 secs, 176,360 bytes)

Pensamiento

La inseguridad, la incertidumbre, la desconfianza, son acaso nuestras únicas verdades. Hay que aferrarse a ellas.

Antonio Machado

El 2019 es apocalíptico

PorJosé A. Alonso 1-enero-20198-enero-2019

Un número natural n es apocalíptico si 2^n contiene la secuencia 666. Por ejemplo, 157 es apocalíptico porque 2^157 es 182687704666362864775460604089535377456991567872 que contiene la secuencia 666.

Definir las funciones

   esApocaliptico       :: Integer -> Bool
   apocalipticos        :: [Integer]
   posicionApocaliptica :: Integer -> Maybe Int

esApocaliptico :: Integer -> Bool

apocalipticos :: [Integer]

posicionApocaliptica :: Integer -> Maybe Int

tales que

(esApocaliptico n) se verifica si n es un número apocalíptico. Por ejemplo,

     esApocaliptico 157   ==  True
     esApocaliptico 2019  ==  True
     esApocaliptico 2018  ==  False

esApocaliptico 157 == True

esApocaliptico 2019 == True

esApocaliptico 2018 == False

apocalipticos es la lista de los números apocalípticos. Por ejemplo,

     take 9 apocalipticos  ==  [157,192,218,220,222,224,226,243,245]
     apocalipticos !! 450  ==  2019

1 2	take 9 apocalipticos == [157,192,218,220,222,224,226,243,245] apocalipticos !! 450 == 2019

(posicionApocalitica n) es justo la posición de n en la sucesión de números apocalípticos, si n es apocalíptico o Nothing, en caso contrario. Por ejemplo,

     posicionApocaliptica 157   ==  Just 0
     posicionApocaliptica 2019  ==  Just 450
     posicionApocaliptica 2018  ==  Nothing

posicionApocaliptica 157 == Just 0

posicionApocaliptica 2019 == Just 450

posicionApocaliptica 2018 == Nothing

Soluciones

import Data.List (isInfixOf, elemIndex)

-- 1ª definición de esApocaliptico
esApocaliptico :: Integer -> Bool
esApocaliptico n = "666" `isInfixOf` show (2^n)

-- 2ª definición de esApocaliptico
esApocaliptico2 :: Integer -> Bool
esApocaliptico2 = isInfixOf "666" . show . (2^)

-- 1ª definición de apocalipticos
apocalipticos :: [Integer]
apocalipticos = [n | n <- [1..], esApocaliptico n]

-- 2ª definición de apocalipticos
apocalipticos2 :: [Integer]
apocalipticos2 = filter esApocaliptico [1..]

-- 1ª definición de posicionApocaliptica
posicionApocaliptica :: Integer -> Maybe Int
posicionApocaliptica n
  | y == n    = Just (length xs)
  | otherwise = Nothing
  where (xs,y:_) = span (<n) apocalipticos

-- 2ª definición de posicionApocaliptica
posicionApocaliptica2 :: Integer -> Maybe Int
posicionApocaliptica2 n
  | esApocaliptico n = elemIndex n apocalipticos
  | otherwise        = Nothing

import Data.List (isInfixOf, elemIndex)

-- 1ª definición de esApocaliptico

esApocaliptico :: Integer -> Bool

esApocaliptico n = "666" `isInfixOf` show (2^n)

-- 2ª definición de esApocaliptico

esApocaliptico2 :: Integer -> Bool

esApocaliptico2 = isInfixOf "666" . show . (2^)

-- 1ª definición de apocalipticos

apocalipticos :: [Integer]

apocalipticos = [n | n <- [1..], esApocaliptico n]

-- 2ª definición de apocalipticos

apocalipticos2 :: [Integer]

apocalipticos2 = filter esApocaliptico [1..]

-- 1ª definición de posicionApocaliptica

posicionApocaliptica :: Integer -> Maybe Int

posicionApocaliptica n

| y == n = Just (length xs)

| otherwise = Nothing

where (xs,y:_) = span (<n) apocalipticos

-- 2ª definición de posicionApocaliptica

posicionApocaliptica2 :: Integer -> Maybe Int

posicionApocaliptica2 n

| esApocaliptico n = elemIndex n apocalipticos

| otherwise = Nothing

Pensamiento

A vosotros no os importe pensar lo que habéis leído ochenta veces y oído
quinientas, porque no es lo mismo pensar que haber leído.

Antonio Machado

Grado exponencial

PorJosé A. Alonso 19-diciembre-201826-diciembre-2018

El grado exponencial de un número n es el menor número x mayor que 1 tal que n es una subcadena de $n^x$ . Por ejemplo, el grado exponencial de 2 es 5 ya que 2 es una subcadena de 32 (que es $2^5$ ) y no es subcadena de las anteriores potencias de 2 (2, 4 y 16). El grado exponencial de 25 es 2 porque 25 es una subcadena de 625 (que es $25^2$ ).

Definir la función

   gradoExponencial :: Integer -> Integer

1	gradoExponencial :: Integer -> Integer

tal que (gradoExponencial n) es el grado exponencial de n. Por ejemplo,

   gradoExponencial 2      ==  5
   gradoExponencial 25     ==  2
   gradoExponencial 15     ==  26
   gradoExponencial 1093   ==  100
   gradoExponencial 10422  ==  200
   gradoExponencial 11092  ==  300

gradoExponencial 2 == 5

gradoExponencial 25 == 2

gradoExponencial 15 == 26

gradoExponencial 1093 == 100

gradoExponencial 10422 == 200

gradoExponencial 11092 == 300

Soluciones

import Test.QuickCheck
import Data.List (genericLength, isInfixOf)

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

gradoExponencial :: Integer -> Integer
gradoExponencial n =
  head [e | e <- [2..]
          , show n `isInfixOf` show (n^e)]

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

gradoExponencial2 :: Integer -> Integer
gradoExponencial2 n =
  2 + genericLength (takeWhile noSubcadena (potencias n))
  where c             = show n
        noSubcadena x = not (c `isInfixOf`show x)

-- (potencias n) es la lista de las potencias de n a partir de n^2. Por
-- ejemplo, 
--    λ> take 10 (potencias 2)
--    [4,8,16,32,64,128,256,512,1024,2048]
potencias :: Integer -> [Integer]
potencias n =
  iterate (*n) (n^2)

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

gradoExponencial3 :: Integer -> Integer
gradoExponencial3 n = aux 2
  where aux x
          | cs `isInfixOf` show (n^x) = x
          | otherwise                 = aux (x+1)
        cs = show n

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

-- La propiedad es
prop_gradosExponencial_equiv :: (Positive Integer) -> Bool
prop_gradosExponencial_equiv (Positive n) =
  gradoExponencial n == gradoExponencial2 n &&
  gradoExponencial n == gradoExponencial3 n

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

import Test.QuickCheck

import Data.List (genericLength, isInfixOf)

-- 1ª solución

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

gradoExponencial :: Integer -> Integer

gradoExponencial n =

head [e | e <- [2..]

, show n `isInfixOf` show (n^e)]

-- 2ª solución

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

gradoExponencial2 :: Integer -> Integer

gradoExponencial2 n =

2 + genericLength (takeWhile noSubcadena (potencias n))

where c = show n

noSubcadena x = not (c `isInfixOf`show x)

-- (potencias n) es la lista de las potencias de n a partir de n^2. Por

-- ejemplo,

-- λ> take 10 (potencias 2)

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

potencias :: Integer -> [Integer]

potencias n =

iterate (*n) (n^2)

-- 3ª solución

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

gradoExponencial3 :: Integer -> Integer

gradoExponencial3 n = aux 2

where aux x

| cs `isInfixOf` show (n^x) = x

| otherwise = aux (x+1)

cs = show n

-- Equivalencia

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

-- La propiedad es

prop_gradosExponencial_equiv :: (Positive Integer) -> Bool

prop_gradosExponencial_equiv (Positive n) =

gradoExponencial n == gradoExponencial2 n &&

gradoExponencial n == gradoExponencial3 n

-- La comprobación es

-- λ> quickCheck prop_gradosExponencial_equiv

-- +++ OK, passed 100 tests.

Referencia

Basado en la sucesión A045537 de la OEIS.

Pensamiento

«De cada diez novedades que pretenden descubrirnos, nueve son
tonterías. La décima y última, que no es necedad, resulta a última hora
que tampoco es nueva.»

Antonio Machado

Menor contenedor de primos

PorJosé A. Alonso 10-diciembre-201817-enero-2019

El n-ésimo menor contenenedor de primos es el menor número que contiene como subcadenas los primeros n primos. Por ejemplo, el 6º menor contenedor de primos es 113257 ya que es el menor que contiene como subcadenas los 6 primeros primos (2, 3, 5, 7, 11 y 13).

Definir la función

   menorContenedor :: Int -> Int

1	menorContenedor :: Int -> Int

tal que (menorContenedor n) es el n-ésimo menor contenenedor de primos. Por ejemplo,

   menorContenedor 1  ==  2
   menorContenedor 2  ==  23
   menorContenedor 3  ==  235
   menorContenedor 4  ==  2357
   menorContenedor 5  ==  112357
   menorContenedor 6  ==  113257

menorContenedor 1 == 2

menorContenedor 2 == 23

menorContenedor 3 == 235

menorContenedor 4 == 2357

menorContenedor 5 == 112357

menorContenedor 6 == 113257

Soluciones

import Data.List           (isInfixOf)
import Data.Numbers.Primes (primes)

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

menorContenedor :: Int -> Int
menorContenedor n =
  head [x | x <- [2..]
          , and [contenido y x | y <- take n primes]]

contenido :: Int -> Int -> Bool
contenido x y =
  show x `isInfixOf` show y

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

menorContenedor2 :: Int -> Int
menorContenedor2 n =
  head [x | x <- [2..]
          , all (`contenido` x) (take n primes)]

import Data.List (isInfixOf)

import Data.Numbers.Primes (primes)

-- 1ª solución

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

menorContenedor :: Int -> Int

menorContenedor n =

head [x | x <- [2..]

, and [contenido y x | y <- take n primes]]

contenido :: Int -> Int -> Bool

contenido x y =

show x `isInfixOf` show y

-- 2ª solución

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

menorContenedor2 :: Int -> Int

menorContenedor2 n =

head [x | x <- [2..]

, all (`contenido` x) (take n primes)]

Pensamiento

¡Ya hay hombres activos!
Soñaba la charca
con sus mosquitos.

Antonio Machado

Números colinas

PorJosé A. Alonso 29-noviembre-201819-enero-2019

Se dice que un número natural n es una colina si su primer dígito es igual a su último dígito, los primeros dígitos son estrictamente creciente hasta llegar al máximo, el máximo se puede repetir y los dígitos desde el máximo al final son estrictamente decrecientes.

Definir la función

   esColina :: Integer -> Bool

1	esColina :: Integer -> Bool

tal que (esColina n) se verifica si n es un número colina. Por ejemplo,

   esColina 12377731  ==  True
   esColina 1237731   ==  True
   esColina 123731    ==  True
   esColina 122731    ==  False
   esColina 12377730  ==  False
   esColina 12377730  ==  False
   esColina 10377731  ==  False
   esColina 12377701  ==  False
   esColina 33333333  ==  True

esColina 12377731 == True

esColina 1237731 == True

esColina 123731 == True

esColina 122731 == False

esColina 12377730 == False

esColina 10377731 == False

esColina 12377701 == False

esColina 33333333 == True

Soluciones

import Data.Char (digitToInt)

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

esColina :: Integer -> Bool
esColina n =
  head ds == last ds &&
  esCreciente xs &&
  esDecreciente ys
  where ds = digitos n
        m  = maximum ds
        xs = takeWhile (<m) ds
        ys = dropWhile (==m) (dropWhile (<m) ds)

-- (digitos n) es la lista de los dígitos de n. Por ejemplo,
--    digitos 425  ==  [4,2,5]
digitos :: Integer -> [Int]
digitos n = map digitToInt (show n)

-- (esCreciente xs) se verifica si la lista xs es estrictamente
-- creciente. Por ejemplo,
--    esCreciente [2,4,7]  ==  True
--    esCreciente [2,2,7]  ==  False
--    esCreciente [2,1,7]  ==  False
esCreciente :: [Int] -> Bool
esCreciente xs = and [x < y | (x,y) <- zip xs (tail xs)]

-- (esDecreciente xs) se verifica si la lista xs es estrictamente
-- decreciente. Por ejemplo,
--    esDecreciente [7,4,2]  ==  True
--    esDecreciente [7,2,2]  ==  False
--    esDecreciente [7,1,2]  ==  False
esDecreciente :: [Int] -> Bool
esDecreciente xs = and [x > y | (x,y) <- zip xs (tail xs)]

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

esColina2 :: Integer -> Bool
esColina2 n =
  head ds == last ds &&
  null (dropWhile (==(-1)) (dropWhile (==0) (dropWhile (==1) xs)))
  where ds = digitos n
        xs = [signum (y-x) | (x,y) <- zip ds (tail ds)] 

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

-- La propiedad de equivalencia es
prop_esColina :: Integer -> Property
prop_esColina n =
  n >= 0 ==> esColina n == esColina2 n 

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

import Data.Char (digitToInt)

-- 1ª definición

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

esColina :: Integer -> Bool

esColina n =

head ds == last ds &&

esCreciente xs &&

esDecreciente ys

where ds = digitos n

m = maximum ds

xs = takeWhile (<m) ds

ys = dropWhile (==m) (dropWhile (<m) ds)

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

-- digitos 425 == [4,2,5]

digitos :: Integer -> [Int]

digitos n = map digitToInt (show n)

-- (esCreciente xs) se verifica si la lista xs es estrictamente

-- creciente. Por ejemplo,

-- esCreciente [2,4,7] == True

-- esCreciente [2,2,7] == False

-- esCreciente [2,1,7] == False

esCreciente :: [Int] -> Bool

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

-- (esDecreciente xs) se verifica si la lista xs es estrictamente

-- decreciente. Por ejemplo,

-- esDecreciente [7,4,2] == True

-- esDecreciente [7,2,2] == False

-- esDecreciente [7,1,2] == False

esDecreciente :: [Int] -> Bool

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

-- 2ª definición

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

esColina2 :: Integer -> Bool

esColina2 n =

head ds == last ds &&

null (dropWhile (==(-1)) (dropWhile (==0) (dropWhile (==1) xs)))

where ds = digitos n

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

-- Equivalencia

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

-- La propiedad de equivalencia es

prop_esColina :: Integer -> Property

prop_esColina n =

n >= 0 ==> esColina n == esColina2 n

-- La comprobación es

-- λ> quickCheck prop_esColina

-- +++ OK, passed 100 tests.

Referencia

Basado en el problema Is this number a hill number? de Code Golf

Pensamiento

Si me tengo que morir
poco me importa aprender.
Y si no puedo saber,
poco me importa vivir.

Antonio Machado

Soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Otras soluciones

Soluciones

Otras soluciones

Pensamiento

Soluciones

Otras soluciones

Pensamiento

Soluciones

Otras soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Referencia

Pensamiento

Soluciones

Pensamiento

Soluciones

Referencia

Pensamiento

Entradas recientes

Buscar

Correo electrónico