takeWhile – Página 3

Máxima potencia que divide al factorial

PorJosé A. Alonso 26-enero-20172-febrero-2017

La máxima potencia de 2 que divide al factorial de 5 es 3, ya que 5! = 120, 120 es divisible por 2^3 y no lo es por 2^4.

Definir la función

   maxPotDivFact :: Integer -> Integer -> Integer

1	maxPotDivFact :: Integer -> Integer -> Integer

tal que (maxPotDivFact p n), para cada primo p, es el mayor k tal que p^k divide al factorial de n. Por ejemplo,

   maxPotDivFact 2 5       ==  3
   maxPotDivFact 3 6       ==  2
   maxPotDivFact 2 10      ==  8
   maxPotDivFact 3 10      ==  4
   maxPotDivFact 2 (10^2)  ==  97
   maxPotDivFact 2 (10^3)  ==  994
   maxPotDivFact 2 (10^4)  ==  9995
   maxPotDivFact 2 (10^5)  ==  99994
   maxPotDivFact 2 (10^6)  ==  999993
   maxPotDivFact 3 (10^5)  ==  49995
   maxPotDivFact 3 (10^6)  ==  499993
   maxPotDivFact 7 (10^5)  ==  16662
   maxPotDivFact 7 (10^6)  ==  166664
   length (show (maxPotDivFact 2 (10^20000)))  ==  20000

maxPotDivFact 2 5 == 3

maxPotDivFact 3 6 == 2

maxPotDivFact 2 10 == 8

maxPotDivFact 3 10 == 4

maxPotDivFact 2 (10^2) == 97

maxPotDivFact 2 (10^3) == 994

maxPotDivFact 2 (10^4) == 9995

maxPotDivFact 2 (10^5) == 99994

maxPotDivFact 2 (10^6) == 999993

maxPotDivFact 3 (10^5) == 49995

maxPotDivFact 3 (10^6) == 499993

maxPotDivFact 7 (10^5) == 16662

maxPotDivFact 7 (10^6) == 166664

length (show (maxPotDivFact 2 (10^20000))) == 20000

Soluciones

import Data.List (genericIndex, genericTake)
import Data.Numbers.Primes (primes)
import Test.QuickCheck

-- 1ª definición
maxPotDivFact :: Integer -> Integer -> Integer
maxPotDivFact p n =
  head [k | k <- [0..], f `mod` (p^k) /= 0] - 1
  where f = product [1..n]

-- 1ª definición
maxPotDivFact2 :: Integer -> Integer -> Integer
maxPotDivFact2 p n
  | n < p     = 0
  | otherwise = m + maxPotDivFact2 p m
  where m = n `div` p  
  
-- 3ª definición
maxPotDivFact3 :: Integer -> Integer -> Integer
maxPotDivFact3 p = sum . takeWhile (> 0) . tail . iterate (`div` p)

-- Comparación de eficiencia
--    λ> maxPotDivFact 2 (10^4)
--    9995
--    (5.47 secs, 161,040,624 bytes)
--    λ> maxPotDivFact2 2 (10^4)
--    9995
--    (0.01 secs, 0 bytes)
--    λ> maxPotDivFact2 2 (10^4)
--    9995
--    (0.01 secs, 0 bytes)
--
--    λ> length (show (maxPotDivFact2 2 (10^20000)))
--    20000
--    (1.93 secs, 592,168,544 bytes)
--    λ> length (show (maxPotDivFact3 2 (10^20000)))
--    20000
--    (2.93 secs, 861,791,504 bytes)

import Data.List (genericIndex, genericTake)

import Data.Numbers.Primes (primes)

import Test.QuickCheck

-- 1ª definición

maxPotDivFact :: Integer -> Integer -> Integer

maxPotDivFact p n =

head [k | k <- [0..], f `mod` (p^k) /= 0] - 1

where f = product [1..n]

-- 1ª definición

maxPotDivFact2 :: Integer -> Integer -> Integer

maxPotDivFact2 p n

| n < p = 0

| otherwise = m + maxPotDivFact2 p m

where m = n `div` p

-- 3ª definición

maxPotDivFact3 :: Integer -> Integer -> Integer

maxPotDivFact3 p = sum . takeWhile (> 0) . tail . iterate (`div` p)

-- Comparación de eficiencia

-- λ> maxPotDivFact 2 (10^4)

-- 9995

-- (5.47 secs, 161,040,624 bytes)

-- λ> maxPotDivFact2 2 (10^4)

-- 9995

-- (0.01 secs, 0 bytes)

-- λ> maxPotDivFact2 2 (10^4)

-- 9995

-- (0.01 secs, 0 bytes)

-- λ> length (show (maxPotDivFact2 2 (10^20000)))

-- 20000

-- (1.93 secs, 592,168,544 bytes)

-- λ> length (show (maxPotDivFact3 2 (10^20000)))

-- 20000

-- (2.93 secs, 861,791,504 bytes)

La sucesión «Mira y di»

PorJosé A. Alonso 24-enero-201731-enero-2017

La sucesión «Mira y di» (en inglés, Look-and-Say) es una sucesión de números naturales en donde cada término se obtiene agrupando las cifras iguales del anterior y recitándolas. Por ejemplo, si x(0) = 1 se lee como «un uno» y por tanto x(1) = 11. Análogamente,

   x(1) = 11     ("dos unos                          --> "21")
   x(2) = 21     ("un dos un uno                     --> "1211")
   x(3) = 1211   ("un uno un dos dos unos            --> "111221")
   x(4) = 111221 ("tres unos dos doses un uno        --> "312211")
   x(5) = 312211 ("un tres un uno dos doses dos unos --> "13112221")

x(1) = 11 ("dos unos --> "21")

x(2) = 21 ("un dos un uno --> "1211")

x(3) = 1211 ("un uno un dos dos unos --> "111221")

x(4) = 111221 ("tres unos dos doses un uno --> "312211")

x(5) = 312211 ("un tres un uno dos doses dos unos --> "13112221")

Definir la función

  sucMiraYDi :: Integer -> [Integer]

1	sucMiraYDi :: Integer -> [Integer]

tal que (sucMiraYDi n) es la sucesión «Mira y di» cuyo primer término es n. Por ejemplo,

   λ> take 9 (sucMiraYdi 1)
   [1,11,21,1211,111221,312211,13112221,1113213211,31131211131221]
   λ> take 5 (sucMiraYdi 2017)
   [2017,12101117,111211103117,31123110132117,1321121321101113122117]
   λ> take 7 (sucMiraYDi 22)
   [22,22,22,22,22,22,22]
   λ> (sucMiraYDi 1) !! 11
   3113112221232112111312211312113211
   λ> (sucMiraYDi 1) !! 12
   1321132132111213122112311311222113111221131221

λ> take 9 (sucMiraYdi 1)

[1,11,21,1211,111221,312211,13112221,1113213211,31131211131221]

λ> take 5 (sucMiraYdi 2017)

[2017,12101117,111211103117,31123110132117,1321121321101113122117]

λ> take 7 (sucMiraYDi 22)

[22,22,22,22,22,22,22]

λ> (sucMiraYDi 1) !! 11

3113112221232112111312211312113211

λ> (sucMiraYDi 1) !! 12

1321132132111213122112311311222113111221131221

Independientemente del término inicial x(0) elegido (con la única salvedad del 22), la sucesión diverge y la razón entre el número de cifras de x(n) y el de x(n-1) tiende a un valor fijo que es la constante de Conway λ ≈ 1.303577269. Por ejemplo, para x(0) = 1, las razones son

   2, 1, 2, 1.5, 1, 1.3333333333333333, 1.25, 1.4, 1.4285714285714286, 1.3

1	2, 1, 2, 1.5, 1, 1.3333333333333333, 1.25, 1.4, 1.4285714285714286, 1.3

Definir la función

   aproximacionConway :: Integer -> Double -> Int

1	aproximacionConway :: Integer -> Double -> Int

tal que (aproximacionConway n e) es el menor k tal que la diferencia entre la constante de Conway y la razón entre el número de cifras de x(k) x(k-1) es, en valor absoluto, menor que e. Por ejemplo,

   aproximacionConway 1 0.3     ==  3
   aproximacionConway 1 0.1     ==  5
   aproximacionConway 1 0.01    ==  9
   aproximacionConway 1 0.001   ==  24
   aproximacionConway 1 0.0001  ==  43
   aproximacionConway 2 0.0001  ==  47

aproximacionConway 1 0.3 == 3

aproximacionConway 1 0.1 == 5

aproximacionConway 1 0.01 == 9

aproximacionConway 1 0.001 == 24

aproximacionConway 1 0.0001 == 43

aproximacionConway 2 0.0001 == 47

Nota: Este ejercicio ha sido propuesto por Elías Guisado.

Soluciones

import Data.List (genericLength, group)

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

sucMiraYdi :: Integer -> [Integer]
sucMiraYdi = iterate di

-- (di x) es el número correspondiente a la lectura de x. Por ejemplo.
--    di 1       ==  11
--    di 11      ==  21
--    di 21      ==  1211
--    di 1211    ==  111221
--    di 111221  ==  312211
--    di 312211  ==  13112221
di :: Integer -> Integer
di = read . concatMap aux . group . show
  where aux s = show (length s) ++ [head s]

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

sucMiraYdi2 :: Integer -> [Integer]
sucMiraYdi2 = iterate (read . concatMap aux . group . show)
  where aux s = show (length s) ++ [head s]

-- Constante de Conway
-- ===================

aproximacionConway :: Integer -> Double -> Int
aproximacionConway n e =
  length (takeWhile aux (razonesMiraYdi n))
  where aux x = abs (x - constanteConway) > e 

constanteConway :: Double
constanteConway = 1.303577269

-- (razonesMiraYdi n) es la sucesión de las razones entre de cada
-- elemento de la sucesión "Mira y di" con elemento inicial n y su
-- anterior. Por ejemplo,
--    λ> take 10 (razonesMiraYdi 1)
--    [2.0,1.0,2.0,1.5,1.0,1.3333333333333333,1.25,1.4,1.4285714285714286,1.3]
--    λ> take 7 (razonesMiraYdi 10)
--    [2.0,1.0,1.5,1.6666666666666667,1.2,1.1666666666666667,1.5714285714285714]
razonesMiraYdi :: Integer -> [Double]
razonesMiraYdi n =
  zipWith (/) (tail xs) xs
  where xs = map (genericLength . show) (sucMiraYdi n)

import Data.List (genericLength, group)

-- 1ª solución

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

sucMiraYdi :: Integer -> [Integer]

sucMiraYdi = iterate di

-- (di x) es el número correspondiente a la lectura de x. Por ejemplo.

-- di 1 == 11

-- di 11 == 21

-- di 21 == 1211

-- di 1211 == 111221

-- di 111221 == 312211

-- di 312211 == 13112221

di :: Integer -> Integer

di = read . concatMap aux . group . show

where aux s = show (length s) ++ [head s]

-- 2ª solución

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

sucMiraYdi2 :: Integer -> [Integer]

sucMiraYdi2 = iterate (read . concatMap aux . group . show)

where aux s = show (length s) ++ [head s]

-- Constante de Conway

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

aproximacionConway :: Integer -> Double -> Int

aproximacionConway n e =

length (takeWhile aux (razonesMiraYdi n))

where aux x = abs (x - constanteConway) > e

constanteConway :: Double

constanteConway = 1.303577269

-- (razonesMiraYdi n) es la sucesión de las razones entre de cada

-- elemento de la sucesión "Mira y di" con elemento inicial n y su

-- anterior. Por ejemplo,

-- λ> take 10 (razonesMiraYdi 1)

-- [2.0,1.0,2.0,1.5,1.0,1.3333333333333333,1.25,1.4,1.4285714285714286,1.3]

-- λ> take 7 (razonesMiraYdi 10)

-- [2.0,1.0,1.5,1.6666666666666667,1.2,1.1666666666666667,1.5714285714285714]

razonesMiraYdi :: Integer -> [Double]

razonesMiraYdi n =

zipWith (/) (tail xs) xs

where xs = map (genericLength . show) (sucMiraYdi n)

La conjetura de Rodolfo

PorJosé A. Alonso 19-enero-201726-enero-2017

El pasado 1 de enero, Claudio Meller publicó el artículo La conjetura de Rodolfo que afirma que

Todos los números naturales se pueden números pueden expresarse como la suma de un capicúa y un capicúa especial (siendo los capicúas especiales los números que al quitarles los ceros finales son capicúas; por ejemplo, 32300, 50500 y 78987).

Definir las funciones

   descomposiciones               :: Integer -> [(Integer, Integer)]
   contraejemplosConjeturaRodolfo :: [Integer]

1 2	descomposiciones :: Integer -> [(Integer, Integer)] contraejemplosConjeturaRodolfo :: [Integer]

tales que

(descomposiciones x) es la lista de las descomposiciones de x como la suma de un capicúa y un capicúa especial. Por ejemplo,

     descomposiciones 1980  ==  [(99,1881),(979,1001)]
     descomposiciones 2016  ==  [(575,1441),(606,1410)]
     descomposiciones 1971  ==  [(161,1810),(1771,200),(1881,90)]

descomposiciones 1980 == [(99,1881),(979,1001)]

descomposiciones 2016 == [(575,1441),(606,1410)]

descomposiciones 1971 == [(161,1810),(1771,200),(1881,90)]

contraejemplosConjeturaRodolfo es la lista de contraejemplos de la conjetura de Rodolfo; es decir, de los números que no pueden expresarse com la suma de un capicúa y un capicúa especial. Por ejemplo,

     λ> take 12 contraejemplosConjeturaRodolfo
     [1200,1220,1240,1250,1260,1270,1280,1290,1300,1330,1350,1360]
     λ> take 12 (dropWhile (< 2000) contraejemplosConjeturaRodolfo)
     [3020,3240,3350,3460,3570,3680,3920,4030,4250,4360,4470,4580]

λ> take 12 contraejemplosConjeturaRodolfo

[1200,1220,1240,1250,1260,1270,1280,1290,1300,1330,1350,1360]

λ> take 12 (dropWhile (< 2000) contraejemplosConjeturaRodolfo)

[3020,3240,3350,3460,3570,3680,3920,4030,4250,4360,4470,4580]

Soluciones

import Data.List (nub)

descomposiciones :: Integer -> [(Integer, Integer)]
descomposiciones x =
  reducida [(y,z) | y <- takeWhile (<= x) capicuas
                  , let z = x - y
                  , esCapicuaG z]

-- capicuas es la sucesión de los números capicúas. Por ejemplo,
--    λ> take 45 capicuas
--    [0,1,2,3,4,5,6,7,8,9,11,22,33,44,55,66,77,88,99,101,111,121,131,
--     141,151,161,171,181,191,202,212,222,232,242,252,262,272,282,292,
--     303,313,323,333,343,353]
-- Se usará la 2ª definición del ejercicio "Sucesión de capicúas".
capicuas :: [Integer]
capicuas = capicuasImpares `mezcla` capicuasPares

-- capicuasPares es la sucesión del cero y las capicúas con un número
-- par de dígitos. Por ejemplo,  
--    λ> take 17 capicuasPares
--    [0,11,22,33,44,55,66,77,88,99,1001,1111,1221,1331,1441,1551,1661]
capicuasPares :: [Integer]
capicuasPares =
  [read (ns ++ reverse ns) | n <- [0..]
                           , let ns = show n]   

-- capicuasImpares es la sucesión de las capicúas con un número
-- impar de dígitos a partir de 1. Por ejemplo,  
--    λ> take 20 capicuasImpares
--    [1,2,3,4,5,6,7,8,9,101,111,121,131,141,151,161,171,181,191,202]
capicuasImpares :: [Integer]
capicuasImpares =
  [1..9] ++ [read (ns ++ [z] ++ reverse ns)
            | n <- [1..]
            , let ns = show n
            , z <- "0123456789"]   

-- (mezcla xs ys) es la lista ordenada obtenida mezclando las dos listas
-- ordenadas xs e ys, suponiendo que ambas son infinitas y con elementos
-- distintos. Por ejemplo,
--    take 10 (mezcla [2,12..] [5,15..])  ==  [2,5,12,15,22,25,32,35,42,45]
--    take 10 (mezcla [2,22..] [5,15..])  ==  [2,5,15,22,25,35,42,45,55,62]
mezcla :: Ord a => [a] -> [a] -> [a]
mezcla us@(x:xs) vs@(y:ys)
  | x < y     = x : mezcla xs vs
  | otherwise = y : mezcla us ys

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

esCapicuaG :: Integer -> Bool
esCapicuaG x =
  x == 0 || esCapicua (sinCerosFinales x)

--    sinCerosFinales 3405000  ==  3405
sinCerosFinales :: Integer -> Integer
sinCerosFinales x =
  read (reverse (dropWhile (== '0') (reverse (show x))))

reducida :: [(Integer, Integer)] -> [(Integer, Integer)]
reducida ps =
  nub [(x,y) | (x,y) <- ps
             , x <= y]

--    λ> take 12 contraejemplosConjeturaRodolfo
--    [1200,1220,1240,1250,1260,1270,1280,1290,1300,1330,1350,1360]
--    λ> take 12 (dropWhile (< 2000) contraejemplosConjeturaRodolfo)
--    [3020,3240,3350,3460,3570,3680,3920,4030,4250,4360,4470,4580]
contraejemplosConjeturaRodolfo :: [Integer]
contraejemplosConjeturaRodolfo =
  [x | x <- [0..]
  , null (descomposiciones x)]

import Data.List (nub)

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

descomposiciones x =

reducida [(y,z) | y <- takeWhile (<= x) capicuas

, let z = x - y

, esCapicuaG z]

-- capicuas es la sucesión de los números capicúas. Por ejemplo,

-- λ> take 45 capicuas

-- [0,1,2,3,4,5,6,7,8,9,11,22,33,44,55,66,77,88,99,101,111,121,131,

-- 141,151,161,171,181,191,202,212,222,232,242,252,262,272,282,292,

-- 303,313,323,333,343,353]

-- Se usará la 2ª definición del ejercicio "Sucesión de capicúas".

capicuas :: [Integer]

capicuas = capicuasImpares `mezcla` capicuasPares

-- capicuasPares es la sucesión del cero y las capicúas con un número

-- par de dígitos. Por ejemplo,

-- λ> take 17 capicuasPares

-- [0,11,22,33,44,55,66,77,88,99,1001,1111,1221,1331,1441,1551,1661]

capicuasPares :: [Integer]

capicuasPares =

[read (ns ++ reverse ns) | n <- [0..]

, let ns = show n]

-- capicuasImpares es la sucesión de las capicúas con un número

-- impar de dígitos a partir de 1. Por ejemplo,

-- λ> take 20 capicuasImpares

-- [1,2,3,4,5,6,7,8,9,101,111,121,131,141,151,161,171,181,191,202]

capicuasImpares :: [Integer]

capicuasImpares =

[1..9] ++ [read (ns ++ [z] ++ reverse ns)

| n <- [1..]

, let ns = show n

, z <- "0123456789"]

-- (mezcla xs ys) es la lista ordenada obtenida mezclando las dos listas

-- ordenadas xs e ys, suponiendo que ambas son infinitas y con elementos

-- distintos. Por ejemplo,

-- take 10 (mezcla [2,12..] [5,15..]) == [2,5,12,15,22,25,32,35,42,45]

-- take 10 (mezcla [2,22..] [5,15..]) == [2,5,15,22,25,35,42,45,55,62]

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

mezcla us@(x:xs) vs@(y:ys)

| x < y = x : mezcla xs vs

| otherwise = y : mezcla us ys

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

-- esCapicua 353 == True

-- esCapicua 3553 == True

-- esCapicua 3535 == False

esCapicua :: Integer -> Bool

esCapicua x =

xs == reverse xs

where xs = show x

esCapicuaG :: Integer -> Bool

esCapicuaG x =

x == 0 || esCapicua (sinCerosFinales x)

-- sinCerosFinales 3405000 == 3405

sinCerosFinales :: Integer -> Integer

sinCerosFinales x =

read (reverse (dropWhile (== '0') (reverse (show x))))

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

reducida ps =

nub [(x,y) | (x,y) <- ps

, x <= y]

-- λ> take 12 contraejemplosConjeturaRodolfo

-- [1200,1220,1240,1250,1260,1270,1280,1290,1300,1330,1350,1360]

-- λ> take 12 (dropWhile (< 2000) contraejemplosConjeturaRodolfo)

-- [3020,3240,3350,3460,3570,3680,3920,4030,4250,4360,4470,4580]

contraejemplosConjeturaRodolfo :: [Integer]

contraejemplosConjeturaRodolfo =

[x | x <- [0..]

, null (descomposiciones x)]

Sumas de dos capicúas

PorJosé A. Alonso 17-enero-201724-enero-2017

Definir las funciones

   sumas2Capicuas  :: Integer -> [(Integer, Integer)]
   noSuma2Capicuas :: [Integer]

1 2	sumas2Capicuas :: Integer -> [(Integer, Integer)] noSuma2Capicuas :: [Integer]

tales que

(sumas2Capicuas x) es la lista de las descomposiciones de x como suma de dos capicúas (con el primer sumando menor o igual que el segundo). Por ejemplo,

      sumas2Capicuas 17  == [(6,11),(8,9)]
      sumas2Capicuas 187 == [(6,181),(66,121),(88,99)]
      sumas2Capicuas 165 == [(4,161),(44,121),(66,99),(77,88)]
      sumas2Capicuas 382 == [(9,373),(191,191)]
      sumas2Capicuas 151 == [(0,151)]
      sumas2Capicuas 201 == []

sumas2Capicuas 17 == [(6,11),(8,9)]

sumas2Capicuas 187 == [(6,181),(66,121),(88,99)]

sumas2Capicuas 165 == [(4,161),(44,121),(66,99),(77,88)]

sumas2Capicuas 382 == [(9,373),(191,191)]

sumas2Capicuas 151 == [(0,151)]

sumas2Capicuas 201 == []

noSuma2Capicuas es la sucesión de los números que no se pueden escribir como suma de dos capicúas. Por ejemplo,

      λ> take 15 noSuma2Capicuas
      [21,32,43,54,65,76,87,98,201,1031,1041,1042,1051,1052,1053]
      λ> noSuma2Capicuas !! 3000
      19941

λ> take 15 noSuma2Capicuas

[21,32,43,54,65,76,87,98,201,1031,1041,1042,1051,1052,1053]

λ> noSuma2Capicuas !! 3000

19941

Soluciones

sumas2Capicuas :: Integer -> [(Integer, Integer)]
sumas2Capicuas x =
  [(y,z) | y <- takeWhile (<= (x `div` 2)) capicuas
         , let z = x - y
         , esCapicua z]

-- capicuas es la sucesión de los números capicúas. Por ejemplo,
--    λ> take 45 capicuas
--    [0,1,2,3,4,5,6,7,8,9,11,22,33,44,55,66,77,88,99,101,111,121,131,
--     141,151,161,171,181,191,202,212,222,232,242,252,262,272,282,292,
--     303,313,323,333,343,353]
-- Se usará la 2ª definición del ejercicio "Sucesión de capicúas".
capicuas :: [Integer]
capicuas = capicuasImpares `mezcla` capicuasPares

-- capicuasPares es la sucesión del cero y las capicúas con un número
-- par de dígitos. Por ejemplo,  
--    λ> take 17 capicuasPares
--    [0,11,22,33,44,55,66,77,88,99,1001,1111,1221,1331,1441,1551,1661]
capicuasPares :: [Integer]
capicuasPares =
  [read (ns ++ reverse ns) | n <- [0..]
                           , let ns = show n]   

-- capicuasImpares es la sucesión de las capicúas con un número
-- impar de dígitos a partir de 1. Por ejemplo,  
--    λ> take 20 capicuasImpares
--    [1,2,3,4,5,6,7,8,9,101,111,121,131,141,151,161,171,181,191,202]
capicuasImpares :: [Integer]
capicuasImpares =
  [1..9] ++ [read (ns ++ [z] ++ reverse ns)
            | n <- [1..]
            , let ns = show n
            , z <- "0123456789"]   

-- (mezcla xs ys) es la lista ordenada obtenida mezclando las dos listas
-- ordenadas xs e ys, suponiendo que ambas son infinitas y con elementos
-- distintos. Por ejemplo,
--    take 10 (mezcla [2,12..] [5,15..])  ==  [2,5,12,15,22,25,32,35,42,45]
--    take 10 (mezcla [2,22..] [5,15..])  ==  [2,5,15,22,25,35,42,45,55,62]
mezcla :: Ord a => [a] -> [a] -> [a]
mezcla us@(x:xs) vs@(y:ys)
  | x < y     = x : mezcla xs vs
  | otherwise = y : mezcla us ys

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

noSuma2Capicuas :: [Integer]
noSuma2Capicuas =
  [x | x <- [0..]
     , null (sumas2Capicuas x)]

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

sumas2Capicuas x =

[(y,z) | y <- takeWhile (<= (x `div` 2)) capicuas

, let z = x - y

, esCapicua z]

-- capicuas es la sucesión de los números capicúas. Por ejemplo,

-- λ> take 45 capicuas

-- [0,1,2,3,4,5,6,7,8,9,11,22,33,44,55,66,77,88,99,101,111,121,131,

-- 141,151,161,171,181,191,202,212,222,232,242,252,262,272,282,292,

-- 303,313,323,333,343,353]

-- Se usará la 2ª definición del ejercicio "Sucesión de capicúas".

capicuas :: [Integer]

capicuas = capicuasImpares `mezcla` capicuasPares

-- capicuasPares es la sucesión del cero y las capicúas con un número

-- par de dígitos. Por ejemplo,

-- λ> take 17 capicuasPares

-- [0,11,22,33,44,55,66,77,88,99,1001,1111,1221,1331,1441,1551,1661]

capicuasPares :: [Integer]

capicuasPares =

[read (ns ++ reverse ns) | n <- [0..]

, let ns = show n]

-- capicuasImpares es la sucesión de las capicúas con un número

-- impar de dígitos a partir de 1. Por ejemplo,

-- λ> take 20 capicuasImpares

-- [1,2,3,4,5,6,7,8,9,101,111,121,131,141,151,161,171,181,191,202]

capicuasImpares :: [Integer]

capicuasImpares =

[1..9] ++ [read (ns ++ [z] ++ reverse ns)

| n <- [1..]

, let ns = show n

, z <- "0123456789"]

-- (mezcla xs ys) es la lista ordenada obtenida mezclando las dos listas

-- ordenadas xs e ys, suponiendo que ambas son infinitas y con elementos

-- distintos. Por ejemplo,

-- take 10 (mezcla [2,12..] [5,15..]) == [2,5,12,15,22,25,32,35,42,45]

-- take 10 (mezcla [2,22..] [5,15..]) == [2,5,15,22,25,35,42,45,55,62]

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

mezcla us@(x:xs) vs@(y:ys)

| x < y = x : mezcla xs vs

| otherwise = y : mezcla us ys

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

-- esCapicua 353 == True

-- esCapicua 3553 == True

-- esCapicua 3535 == False

esCapicua :: Integer -> Bool

esCapicua x =

xs == reverse xs

where xs = show x

noSuma2Capicuas :: [Integer]

noSuma2Capicuas =

[x | x <- [0..]

, null (sumas2Capicuas x)]

Sumas de tres capicúas

PorJosé A. Alonso 12-enero-201719-enero-2017

Definir la función

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

1	sumas3Capicuas :: Integer -> [(Integer, Integer, Integer)]

tales que (sumas3Capicuas x) es la lista de las descomposiciones de x como suma de tres capicúas (con los sumandos no decrecientes). Por ejemplo,

   sumas3Capicuas 0  ==  [(0,0,0)]
   sumas3Capicuas 1  ==  [(0,0,1)]
   sumas3Capicuas 2  ==  [(0,0,2),(0,1,1)]
   sumas3Capicuas 3  ==  [(0,0,3),(0,1,2),(1,1,1)]
   sumas3Capicuas 4  ==  [(0,0,4),(0,1,3),(0,2,2),(1,1,2)]
   length (sumas3Capicuas 17)      ==  17
   length (sumas3Capicuas 2017)    ==  47
   length (sumas3Capicuas 999999)  ==  15266

sumas3Capicuas 0 == [(0,0,0)]

sumas3Capicuas 1 == [(0,0,1)]

sumas3Capicuas 2 == [(0,0,2),(0,1,1)]

sumas3Capicuas 3 == [(0,0,3),(0,1,2),(1,1,1)]

sumas3Capicuas 4 == [(0,0,4),(0,1,3),(0,2,2),(1,1,2)]

length (sumas3Capicuas 17) == 17

length (sumas3Capicuas 2017) == 47

length (sumas3Capicuas 999999) == 15266

Comprobar con QuickCheck que todo número natural se puede escribir como suma de tres capicúas.

Soluciones

import Test.QuickCheck

sumas3Capicuas :: Integer -> [(Integer, Integer, Integer)]
sumas3Capicuas x =
  [(a,b,c) | a <- as
           , b <- dropWhile (< a) as
           , let c = x - a - b
           , b <= c 
           , esCapicua c]
  where as = takeWhile (<= x) capicuas

-- capicuas es la sucesión de los números capicúas. Por ejemplo,
--    λ> take 45 capicuas
--    [0,1,2,3,4,5,6,7,8,9,11,22,33,44,55,66,77,88,99,101,111,121,131,
--     141,151,161,171,181,191,202,212,222,232,242,252,262,272,282,292,
--     303,313,323,333,343,353]
-- Se usará la 2ª definición del ejercicio "Sucesión de capicúas".
capicuas :: [Integer]
capicuas = capicuasImpares `mezcla` capicuasPares

-- capicuasPares es la sucesión del cero y las capicúas con un número
-- par de dígitos. Por ejemplo,  
--    λ> take 17 capicuasPares
--    [0,11,22,33,44,55,66,77,88,99,1001,1111,1221,1331,1441,1551,1661]
capicuasPares :: [Integer]
capicuasPares =
  [read (ns ++ reverse ns) | n <- [0..]
                           , let ns = show n]   

-- capicuasImpares es la sucesión de las capicúas con un número
-- impar de dígitos a partir de 1. Por ejemplo,  
--    λ> take 20 capicuasImpares
--    [1,2,3,4,5,6,7,8,9,101,111,121,131,141,151,161,171,181,191,202]
capicuasImpares :: [Integer]
capicuasImpares =
  [1..9] ++ [read (ns ++ [z] ++ reverse ns)
            | n <- [1..]
            , let ns = show n
            , z <- "0123456789"]   

-- (mezcla xs ys) es la lista ordenada obtenida mezclando las dos listas
-- ordenadas xs e ys, suponiendo que ambas son infinitas y con elementos
-- distintos. Por ejemplo,
--    take 10 (mezcla [2,12..] [5,15..])  ==  [2,5,12,15,22,25,32,35,42,45]
--    take 10 (mezcla [2,22..] [5,15..])  ==  [2,5,15,22,25,35,42,45,55,62]
mezcla :: Ord a => [a] -> [a] -> [a]
mezcla us@(x:xs) vs@(y:ys)
  | x < y     = x : mezcla xs vs
  | otherwise = y : mezcla us ys

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

-- La propiedad es
prop_sumas3Capicuas :: Integer -> Property
prop_sumas3Capicuas x =
  x >= 0 ==> not (null (sumas3Capicuas x))

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

import Test.QuickCheck

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

sumas3Capicuas x =

[(a,b,c) | a <- as

, b <- dropWhile (< a) as

, let c = x - a - b

, b <= c

, esCapicua c]

where as = takeWhile (<= x) capicuas

-- capicuas es la sucesión de los números capicúas. Por ejemplo,

-- λ> take 45 capicuas

-- [0,1,2,3,4,5,6,7,8,9,11,22,33,44,55,66,77,88,99,101,111,121,131,

-- 141,151,161,171,181,191,202,212,222,232,242,252,262,272,282,292,

-- 303,313,323,333,343,353]

-- Se usará la 2ª definición del ejercicio "Sucesión de capicúas".

capicuas :: [Integer]

capicuas = capicuasImpares `mezcla` capicuasPares

-- capicuasPares es la sucesión del cero y las capicúas con un número

-- par de dígitos. Por ejemplo,

-- λ> take 17 capicuasPares

-- [0,11,22,33,44,55,66,77,88,99,1001,1111,1221,1331,1441,1551,1661]

capicuasPares :: [Integer]

capicuasPares =

[read (ns ++ reverse ns) | n <- [0..]

, let ns = show n]

-- capicuasImpares es la sucesión de las capicúas con un número

-- impar de dígitos a partir de 1. Por ejemplo,

-- λ> take 20 capicuasImpares

-- [1,2,3,4,5,6,7,8,9,101,111,121,131,141,151,161,171,181,191,202]

capicuasImpares :: [Integer]

capicuasImpares =

[1..9] ++ [read (ns ++ [z] ++ reverse ns)

| n <- [1..]

, let ns = show n

, z <- "0123456789"]

-- (mezcla xs ys) es la lista ordenada obtenida mezclando las dos listas

-- ordenadas xs e ys, suponiendo que ambas son infinitas y con elementos

-- distintos. Por ejemplo,

-- take 10 (mezcla [2,12..] [5,15..]) == [2,5,12,15,22,25,32,35,42,45]

-- take 10 (mezcla [2,22..] [5,15..]) == [2,5,15,22,25,35,42,45,55,62]

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

mezcla us@(x:xs) vs@(y:ys)

| x < y = x : mezcla xs vs

| otherwise = y : mezcla us ys

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

-- esCapicua 353 == True

-- esCapicua 3553 == True

-- esCapicua 3535 == False

esCapicua :: Integer -> Bool

esCapicua x =

xs == reverse xs

where xs = show x

-- La propiedad es

prop_sumas3Capicuas :: Integer -> Property

prop_sumas3Capicuas x =

x >= 0 ==> not (null (sumas3Capicuas x))

-- La comprobación es

-- λ> quickCheck prop_sumas3Capicuas

-- +++ OK, passed 100 tests.

Sucesión de capicúas

PorJosé A. Alonso 11-enero-201718-enero-2017

Definir las funciones

   capicuas        :: [Integer] 
   posicionCapicua :: Integer -> Integer

1 2	capicuas :: [Integer] posicionCapicua :: Integer -> Integer

tales que

capicuas es la sucesión de los números capicúas. Por ejemplo,

   λ> take 45 capicuas
   [0,1,2,3,4,5,6,7,8,9,11,22,33,44,55,66,77,88,99,101,111,121,131,
    141,151,161,171,181,191,202,212,222,232,242,252,262,272,282,292,
    303,313,323,333,343,353]
   λ> capicuas !! (10^5)  
   900010009

λ> take 45 capicuas

[0,1,2,3,4,5,6,7,8,9,11,22,33,44,55,66,77,88,99,101,111,121,131,

141,151,161,171,181,191,202,212,222,232,242,252,262,272,282,292,

303,313,323,333,343,353]

λ> capicuas !! (10^5)

900010009

(posicionCapicua x) es la posición del número capicúa x en la sucesión de los capicúas. Por ejemplo,

   λ> posicionCapicua 353
   44
   λ> posicionCapicua 900010009
   100000
   λ> let xs = show (123^30)
   λ> posicionCapicua (read (xs ++ reverse xs))
   1497912859868342793044999075260564303046944727069807798026337448
   λ> posicionCapicua (read (xs ++ "7" ++ reverse xs))
   5979128598683427930449990752605643030469447270698077980263374496

λ> posicionCapicua 353

λ> posicionCapicua 900010009

100000

λ> let xs = show (123^30)

λ> posicionCapicua (read (xs ++ reverse xs))

1497912859868342793044999075260564303046944727069807798026337448

λ> posicionCapicua (read (xs ++ "7" ++ reverse xs))

5979128598683427930449990752605643030469447270698077980263374496

Soluciones

import Data.List (genericLength)

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

capicuas1 :: [Integer]
capicuas1 = [n | n <- [0..]
               , esCapicua n]

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


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

capicuas2 :: [Integer]
capicuas2 = capicuasImpares `mezcla` capicuasPares

-- capicuasPares es la sucesión del cero y las capicúas con un número
-- par de dígitos. Por ejemplo,  
--    λ> take 17 capicuasPares
--    [0,11,22,33,44,55,66,77,88,99,1001,1111,1221,1331,1441,1551,1661]
capicuasPares :: [Integer]
capicuasPares =
  [read (ns ++ reverse ns) | n <- [0..]
                           , let ns = show n]   

-- capicuasImpares es la sucesión de las capicúas con un número
-- impar de dígitos a partir de 1. Por ejemplo,  
--    λ> take 20 capicuasImpares
--    [1,2,3,4,5,6,7,8,9,101,111,121,131,141,151,161,171,181,191,202]
capicuasImpares :: [Integer]
capicuasImpares =
  [1..9] ++ [read (ns ++ [z] ++ reverse ns)
            | n <- [1..]
            , let ns = show n
            , z <- "0123456789"]   

-- (mezcla xs ys) es la lista ordenada obtenida mezclando las dos listas
-- ordenadas xs e ys, suponiendo que ambas son infinitas y con elementos
-- distintos. Por ejemplo,
--    take 10 (mezcla [2,12..] [5,15..])  ==  [2,5,12,15,22,25,32,35,42,45]
--    take 10 (mezcla [2,22..] [5,15..])  ==  [2,5,15,22,25,35,42,45,55,62]
mezcla :: Ord a => [a] -> [a] -> [a]
mezcla us@(x:xs) vs@(y:ys)
  | x < y     = x : mezcla xs vs
  | otherwise = y : mezcla us ys

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

capicuas3 :: [Integer]
capicuas3 = iterate sigCapicua 0

-- (sigCapicua x) es el capicúa siguiente del número x. Por ejemplo,
--    sigCapicua 12321           == 12421
--    sigCapicua 1298921         == 1299921
--    sigCapicua 999             == 1001
--    sigCapicua 9999            == 10001
--    sigCapicua 898             == 909
--    sigCapicua 123456777654321 == 123456787654321
sigCapicua :: Integer -> Integer
sigCapicua n = read cs
    where l  = length (show (n+1))
          k  = l `div` 2
          xs = show ((n `div` (10^k)) + 1) 
          cs = xs ++ drop (l `rem` 2) (reverse xs)

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

capicuas4 :: [Integer]
capicuas4 =
  concatMap generaCapicuas4 [1..]

generaCapicuas4 :: Integer -> [Integer]
generaCapicuas4 1 = [0..9]
generaCapicuas4 n
  | even n    = [read (xs ++ reverse xs)
                | xs <- map show [10^(m-1)..10^m-1]]
  | otherwise = [read (xs ++ (y : reverse xs))
                | xs <- map show [10^(m-1)..10^m-1]
                , y <- "0123456789"]
  where m = n `div` 2

-- 5ª definición de capicuas
-- =========================

capicuas5 :: [Integer]
capicuas5 = 0 : aux 1
  where aux n =    [read (show x ++ tail (reverse (show x)))
                   | x <- [10^(n-1)..10^n-1]]
                ++ [read (show x ++ reverse (show x))
                   | x <- [10^(n-1)..10^n-1]]
                ++ aux (n+1)

-- 6ª definición de capicuas
-- =========================

capicuas6 :: [Integer]
capicuas6 = 0 : map read (capicuas6Aux [1..9])
 
capicuas6Aux :: [Integer] -> [String]
capicuas6Aux xs =  map duplica1 ys
                ++ map duplica2 ys
                ++ capicuas6Aux [head xs * 10 .. last xs * 10 + 9]
  where
    ys          = map show xs
    duplica1 cs = cs ++ tail (reverse cs)
    duplica2 cs = cs ++ reverse cs

-- 7ª definición de capicuas
-- =========================

capicuas7 :: [Integer]
capicuas7 = 0 : map read (capicuas7Aux [1..9])
 
capicuas7Aux :: [Integer] -> [String]
capicuas7Aux xs =  map duplica1 ys
                ++ map duplica2 ys
                ++ capicuas7Aux [head xs * 10 .. last xs * 10 + 9]
  where
    ys       = map show xs
    duplica1 = (++) <$> id <*> tail . reverse
    duplica2 = (++) <$> id <*> reverse

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

--    λ> capicuas1 !! 2000
--    1001001
--    (2.25 secs, 598,879,552 bytes)
--    λ> capicuas2 !! 2000
--    1001001
--    (0.05 secs, 28,630,552 bytes)
--    λ> capicuas3 !! 2000
--    1001001
--    (0.06 secs, 14,721,360 bytes)
--    λ> capicuas4 !! 2000
--    1001001
--    (0.01 secs, 0 bytes)
--    λ> capicuas5 !! 2000
--    1001001
--    (0.01 secs, 0 bytes)
--    λ> capicuas6 !! 2000
--    1001001
--    (0.01 secs, 0 bytes)
--    λ> capicuas7 !! 2000
--    1001001
--    (0.01 secs, 0 bytes)
--    
--    λ> capicuas2 !! (10^5)
--    900010009
--    (2.03 secs, 1,190,503,952 bytes)
--    λ> capicuas3 !! (10^5)
--    900010009
--    (5.12 secs, 1,408,876,328 bytes)
--    λ> capicuas4 !! (10^5)
--    900010009
--    (0.21 secs, 8,249,296 bytes)
--    λ> capicuas5 !! (10^5)
--    900010009
--    (0.10 secs, 31,134,176 bytes)
--    λ> capicuas6 !! (10^5)
--    900010009
--    (0.14 secs, 55,211,272 bytes)
--    λ> capicuas7 !! (10^5)
--    900010009
--    (0.03 secs, 0 bytes)

-- 1ª definición de posicionCapicua
posicionCapicua1 :: Integer -> Integer
posicionCapicua1 x =
  genericLength (takeWhile (< x) capicuas7)

-- 2ª definición
posicionCapicua2 :: Integer -> Integer
posicionCapicua2 x
  | even n    = read ('1' : take (n `div` 2) xs) - 1
  | otherwise = read (show (1 + read [y]) ++ take (n `div` 2) ys) - 1
  where xs@(y:ys) = show x
        n         = genericLength xs

-- Comparación de eficiencia
--    λ> posicionCapicua1 (10^9 - 1)
--    109998
--    (1.98 secs, 1,112,991,520 bytes)
--    λ> posicionCapicua2 (10^9 - 1)
--    109998
--    (0.01 secs, 0 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

187

188

189

190

191

192

193

194

195

196

197

import Data.List (genericLength)

-- 1ª definición de capicuas

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

capicuas1 :: [Integer]

capicuas1 = [n | n <- [0..]

, esCapicua n]

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

-- esCapicua 353 == True

-- esCapicua 3553 == True

-- esCapicua 3535 == False

esCapicua :: Integer -> Bool

esCapicua x =

xs == reverse xs

where xs = show x

-- 2ª definición de capicuas

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

capicuas2 :: [Integer]

capicuas2 = capicuasImpares `mezcla` capicuasPares

-- capicuasPares es la sucesión del cero y las capicúas con un número

-- par de dígitos. Por ejemplo,

-- λ> take 17 capicuasPares

-- [0,11,22,33,44,55,66,77,88,99,1001,1111,1221,1331,1441,1551,1661]

capicuasPares :: [Integer]

capicuasPares =

[read (ns ++ reverse ns) | n <- [0..]

, let ns = show n]

-- capicuasImpares es la sucesión de las capicúas con un número

-- impar de dígitos a partir de 1. Por ejemplo,

-- λ> take 20 capicuasImpares

-- [1,2,3,4,5,6,7,8,9,101,111,121,131,141,151,161,171,181,191,202]

capicuasImpares :: [Integer]

capicuasImpares =

[1..9] ++ [read (ns ++ [z] ++ reverse ns)

| n <- [1..]

, let ns = show n

, z <- "0123456789"]

-- (mezcla xs ys) es la lista ordenada obtenida mezclando las dos listas

-- ordenadas xs e ys, suponiendo que ambas son infinitas y con elementos

-- distintos. Por ejemplo,

-- take 10 (mezcla [2,12..] [5,15..]) == [2,5,12,15,22,25,32,35,42,45]

-- take 10 (mezcla [2,22..] [5,15..]) == [2,5,15,22,25,35,42,45,55,62]

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

mezcla us@(x:xs) vs@(y:ys)

| x < y = x : mezcla xs vs

| otherwise = y : mezcla us ys

-- 3ª definición de capicuas

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

capicuas3 :: [Integer]

capicuas3 = iterate sigCapicua 0

-- (sigCapicua x) es el capicúa siguiente del número x. Por ejemplo,

-- sigCapicua 12321 == 12421

-- sigCapicua 1298921 == 1299921

-- sigCapicua 999 == 1001

-- sigCapicua 9999 == 10001

-- sigCapicua 898 == 909

-- sigCapicua 123456777654321 == 123456787654321

sigCapicua :: Integer -> Integer

sigCapicua n = read cs

where l = length (show (n+1))

k = l `div` 2

xs = show ((n `div` (10^k)) + 1)

cs = xs ++ drop (l `rem` 2) (reverse xs)

-- 4ª definición de capicuas

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

capicuas4 :: [Integer]

capicuas4 =

concatMap generaCapicuas4 [1..]

generaCapicuas4 :: Integer -> [Integer]

generaCapicuas4 1 = [0..9]

generaCapicuas4 n

| even n = [read (xs ++ reverse xs)

| xs <- map show [10^(m-1)..10^m-1]]

| otherwise = [read (xs ++ (y : reverse xs))

| xs <- map show [10^(m-1)..10^m-1]

, y <- "0123456789"]

where m = n `div` 2

-- 5ª definición de capicuas

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

capicuas5 :: [Integer]

capicuas5 = 0 : aux 1

where aux n = [read (show x ++ tail (reverse (show x)))

| x <- [10^(n-1)..10^n-1]]

++ [read (show x ++ reverse (show x))

| x <- [10^(n-1)..10^n-1]]

++ aux (n+1)

-- 6ª definición de capicuas

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

capicuas6 :: [Integer]

capicuas6 = 0 : map read (capicuas6Aux [1..9])

capicuas6Aux :: [Integer] -> [String]

capicuas6Aux xs = map duplica1 ys

++ map duplica2 ys

++ capicuas6Aux [head xs * 10 .. last xs * 10 + 9]

where

ys = map show xs

duplica1 cs = cs ++ tail (reverse cs)

duplica2 cs = cs ++ reverse cs

-- 7ª definición de capicuas

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

capicuas7 :: [Integer]

capicuas7 = 0 : map read (capicuas7Aux [1..9])

capicuas7Aux :: [Integer] -> [String]

capicuas7Aux xs = map duplica1 ys

++ map duplica2 ys

++ capicuas7Aux [head xs * 10 .. last xs * 10 + 9]

where

ys = map show xs

duplica1 = (++) <$> id <*> tail . reverse

duplica2 = (++) <$> id <*> reverse

-- Comparación de eficiencia

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

-- λ> capicuas1 !! 2000

-- 1001001

-- (2.25 secs, 598,879,552 bytes)

-- λ> capicuas2 !! 2000

-- 1001001

-- (0.05 secs, 28,630,552 bytes)

-- λ> capicuas3 !! 2000

-- 1001001

-- (0.06 secs, 14,721,360 bytes)

-- λ> capicuas4 !! 2000

-- 1001001

-- (0.01 secs, 0 bytes)

-- λ> capicuas5 !! 2000

-- 1001001

-- (0.01 secs, 0 bytes)

-- λ> capicuas6 !! 2000

-- 1001001

-- (0.01 secs, 0 bytes)

-- λ> capicuas7 !! 2000

-- 1001001

-- (0.01 secs, 0 bytes)

-- λ> capicuas2 !! (10^5)

-- 900010009

-- (2.03 secs, 1,190,503,952 bytes)

-- λ> capicuas3 !! (10^5)

-- 900010009

-- (5.12 secs, 1,408,876,328 bytes)

-- λ> capicuas4 !! (10^5)

-- 900010009

-- (0.21 secs, 8,249,296 bytes)

-- λ> capicuas5 !! (10^5)

-- 900010009

-- (0.10 secs, 31,134,176 bytes)

-- λ> capicuas6 !! (10^5)

-- 900010009

-- (0.14 secs, 55,211,272 bytes)

-- λ> capicuas7 !! (10^5)

-- 900010009

-- (0.03 secs, 0 bytes)

-- 1ª definición de posicionCapicua

posicionCapicua1 :: Integer -> Integer

posicionCapicua1 x =

genericLength (takeWhile (< x) capicuas7)

-- 2ª definición

posicionCapicua2 :: Integer -> Integer

posicionCapicua2 x

| even n = read ('1' : take (n `div` 2) xs) - 1

| otherwise = read (show (1 + read [y]) ++ take (n `div` 2) ys) - 1

where xs@(y:ys) = show x

n = genericLength xs

-- Comparación de eficiencia

-- λ> posicionCapicua1 (10^9 - 1)

-- 109998

-- (1.98 secs, 1,112,991,520 bytes)

-- λ> posicionCapicua2 (10^9 - 1)

-- 109998

-- (0.01 secs, 0 bytes)

Estratificación de un árbol

PorJosé A. Alonso 3-enero-201710-enero-2017

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

   data Arbol a = N a [Arbol a]
     deriving Show

1 2	data Arbol a = N a [Arbol a] deriving Show

Por ejemplo, los árboles

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

1 1 1

/ \ / \ / \

8 3 8 3 8 3

| /|\ /|\ |

4 4 5 6 4 5 6 7

se representan por

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

ej1, ej2, ej3 :: Arbol Int

ej1 = N 1 [N 8 [],N 3 [N 4 []]]

ej2 = N 1 [N 8 [], N 3 [N 4 [], N 5 [], N 6 []]]

ej3 = N 1 [N 8 [N 4 [], N 5 [], N 6 []], N 3 [N 7 []]]

Un estrato de un árbol es la lista de nodos que se encuentran al mismo nivel de profundidad. Por ejemplo, los estratos del árbol ej1 son [1], [8,3] y [4].

Definir la función

   estratos :: Arbol a -> [[a]]

1	estratos :: Arbol a -> [[a]]

tal que (estratos x) es la lista de los estratos del árbol x. Por ejemplo,

   estratos ej1 == [[1],[8,3],[4]]
   estratos ej2 == [[1],[8,3],[4,5,6]]
   estratos ej3 == [[1],[8,3],[4,5,6,7]]

estratos ej1 == [[1],[8,3],[4]]

estratos ej2 == [[1],[8,3],[4,5,6]]

estratos ej3 == [[1],[8,3],[4,5,6,7]]

Soluciones

data Arbol a = N a [Arbol a]
  deriving Show
           
ej1, ej2, ej3 :: Arbol Int
ej1 = N 1 [N 8 [],N 3 [N 4 []]]
ej2 = N 1 [N 8 [], N 3 [N 4 [], N 5 [], N 6 []]]
ej3 = N 1 [N 8 [N 4 [], N 5 [], N 6 []], N 3 [N 7 []]]

estratos :: Arbol a -> [[a]]
estratos x = takeWhile (not . null) [estrato n x | n <- [0..]]

-- (estrato n x) es el estrato de nivel n del árbol x. Por ejemplo,
--    estrato 0 ej1  ==  [1]
--    estrato 1 ej1  ==  [8,3]
--    estrato 2 ej1  ==  [4]
--    estrato 4 ej1  ==  []
estrato :: Int -> Arbol a ->  [a]
estrato 0 (N x _)  = [x]
estrato n (N _ xs) = concatMap (estrato (n-1)) xs

data Arbol a = N a [Arbol a]

deriving Show

ej1, ej2, ej3 :: Arbol Int

ej1 = N 1 [N 8 [],N 3 [N 4 []]]

ej2 = N 1 [N 8 [], N 3 [N 4 [], N 5 [], N 6 []]]

ej3 = N 1 [N 8 [N 4 [], N 5 [], N 6 []], N 3 [N 7 []]]

estratos :: Arbol a -> [[a]]

estratos x = takeWhile (not . null) [estrato n x | n <- [0..]]

-- (estrato n x) es el estrato de nivel n del árbol x. Por ejemplo,

-- estrato 0 ej1 == [1]

-- estrato 1 ej1 == [8,3]

-- estrato 2 ej1 == [4]

-- estrato 4 ej1 == []

estrato :: Int -> Arbol a -> [a]

estrato 0 (N x _) = [x]

estrato n (N _ xs) = concatMap (estrato (n-1)) xs

Distancia a Erdős

PorJosé A. Alonso 14-diciembre-201621-diciembre-2016

Una de las razones por la que el matemático húngaro Paul Erdős es conocido es por la multitud de colaboraciones que realizó durante toda su carrera, un total de 511. Tal es así que se establece la distancia a Erdős como la distancia que has estado de coautoría con Erdős. Por ejemplo, si eres Paul Erdős tu distancia a Erdős es 0, si has escrito un artículo con Erdős tu distancia es 1, si has escrito un artículo con alguien que ha escrito un artículo con Erdős tu distancia es 2, etc. El objetivo de este problema es definir una función que a partir de una lista de pares de coautores y un número natural n calcular la lista de los matemáticos a una distancia n de Erdős.

Para el problema se considerará la siguiente lista de coautores

   coautores :: [(String,String)]
   coautores =
     [("Paul Erdos","Ernst Straus"),("Paul Erdos","Pascual Jordan"),
      ("Paul Erdos","D. Kleitman"),("Albert Einstein","Ernst Straus"),
      ("John von Newmann","David Hilbert"),("S. Glashow","D. Kleitman"),
      ("John von Newmann","Pascual Jordan"), ("David Pines","D. Bohm"),
      ("Albert Einstein","Otto Stern"),("S. Glashow", "M. Gell-Mann"),
      ("Richar Feynman","M. Gell-Mann"),("M. Gell-Mann","David Pines"),
      ("David Pines","A. Bohr"),("Wolfgang Pauli","Albert Einstein"),
      ("D. Bohm","L. De Broglie"), ("Paul Erdos","J. Conway"),
      ("J. Conway", "P. Doyle"),("Paul Erdos","A. J. Granville"),
      ("A. J. Granville","B. Mazur"),("B. Mazur","Andrew Wiles")]

coautores :: [(String,String)]

coautores =

[("Paul Erdos","Ernst Straus"),("Paul Erdos","Pascual Jordan"),

("Paul Erdos","D. Kleitman"),("Albert Einstein","Ernst Straus"),

("John von Newmann","David Hilbert"),("S. Glashow","D. Kleitman"),

("John von Newmann","Pascual Jordan"), ("David Pines","D. Bohm"),

("Albert Einstein","Otto Stern"),("S. Glashow", "M. Gell-Mann"),

("Richar Feynman","M. Gell-Mann"),("M. Gell-Mann","David Pines"),

("David Pines","A. Bohr"),("Wolfgang Pauli","Albert Einstein"),

("D. Bohm","L. De Broglie"), ("Paul Erdos","J. Conway"),

("J. Conway", "P. Doyle"),("Paul Erdos","A. J. Granville"),

("A. J. Granville","B. Mazur"),("B. Mazur","Andrew Wiles")]

La lista anterior es real y se ha obtenido del artículo Famous trails to Paul Erdős.

Definir la función

   numeroDeErdos :: [(String, String)] -> Int -> [String]

1	numeroDeErdos :: [(String, String)] -> Int -> [String]

tal que (numeroDeErdos xs n) es la lista de lista de los matemáticos de la
lista de coautores xs que se encuentran a una distancia n de Erdős. Por ejemplo,

   λ> numeroDeErdos coautores 0
   ["Paul Erdos"]
   λ> numeroDeErdos coautores 1
   ["Ernst Straus","Pascual Jordan","D. Kleitman","J. Conway","A. J. Granville"]
   λ> numeroDeErdos coautores 2
   ["Albert Einstein","John von Newmann","S. Glashow","P. Doyle","B. Mazur"]

λ> numeroDeErdos coautores 0

["Paul Erdos"]

λ> numeroDeErdos coautores 1

["Ernst Straus","Pascual Jordan","D. Kleitman","J. Conway","A. J. Granville"]

λ> numeroDeErdos coautores 2

["Albert Einstein","John von Newmann","S. Glashow","P. Doyle","B. Mazur"]

Nota: Este ejercicio ha sido propuesto por Enrique Naranjo.

Soluciones

data Arbol a = N a [Arbol a]
             deriving Show 

coautores :: [(String,String)]
coautores =
  [("Paul Erdos","Ernst Straus"),("Paul Erdos","Pascual Jordan"),
   ("Paul Erdos","D. Kleitman"),("Albert Einstein","Ernst Straus"),
   ("John von Newmann","David Hilbert"),("S. Glashow","D. Kleitman"),
   ("John von Newmann","Pascual Jordan"), ("David Pines","D. Bohm"),
   ("Albert Einstein","Otto Stern"),("S. Glashow", "M. Gell-Mann"),
   ("Richar Feynman","M. Gell-Mann"),("M. Gell-Mann","David Pines"),
   ("David Pines","A. Bohr"),("Wolfgang Pauli","Albert Einstein"),
   ("D. Bohm","L. De Broglie"), ("Paul Erdos","J. Conway"),
   ("J. Conway", "P. Doyle"),("Paul Erdos","A. J. Granville"),
   ("A. J. Granville","B. Mazur"),("B. Mazur","Andrew Wiles")]

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

numeroDeErdos :: [(String, String)] -> Int -> [String]
numeroDeErdos xs n = nivel n (arbolDeErdos xs "Paul Erdos")

-- (arbolDeErdos xs a) es el árbol de coautores de a según la lista de
-- coautores xs. Por ejemplo,
--    λ> arbolDeErdos coautores "Paul Erdos"
--    N "Paul Erdos"
--      [N "Ernst Straus"
--         [N "Albert Einstein"
--           [N "Wolfgang Pauli" [],
--            N "Otto Stern" []]],
--          N "Pascual Jordan"
--            [N "John von Newmann"
--               [N "David Hilbert" []]],
--          N "D. Kleitman"
--            [N "S. Glashow"
--               [N "M. Gell-Mann"
--                  [N "Richar Feynman" [],
--                   N "David Pines"
--                     [N "A. Bohr" [],
--                      N "D. Bohm"
--                        [N "L. De Broglie" []]]]]],
--          N "J. Conway"
--            [N "P. Doyle" []],
--             N "A. J. Granville"
--               [N "B. Mazur"
--                  [N "Andrew Wiles" []]]]
arbolDeErdos :: [(String, String)] -> String -> Arbol String
arbolDeErdos xs a =
  N a [arbolDeErdos noColaboradores n | n <- colaboradores]
  where
    colaboradores   = [filtra a (x,y) | (x,y) <- xs, x == a || y == a]
    filtra a (x,y) | a == x    = y
                   | otherwise = x
    noColaboradores = [(x,y) | (x,y) <- xs, x /= a, y /= a]

-- (nivel n a) es la lista de los elementos del árbol a en el nivel
-- n. Por ejemplo,      
--    nivel 0 (N 3 [N 5 [N 6 []], N 7 [N 9 []]])   ==  [3]
--    nivel 1 (N 3 [N 5 [N 6 []], N 7 [N 9 []]])   ==  [5,7]
--    nivel 2 (N 3 [N 5 [N 6 []], N 7 [N 9 []]])   ==  [6,9]
nivel :: Int -> Arbol a -> [a]
nivel 0 (N a xs) = [a]
nivel n (N a xs) = concatMap (nivel (n-1)) xs

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

numeroDeErdos2 :: [(String, String)] -> Int -> [String]
numeroDeErdos2 = auxC ["Paul Erdos"] 
  where
    auxC v xs 0 = v
    auxC v xs x = auxC  (n v) (m v xs) (x-1)
      where n v =     [a | (a,b) <- xs, elem b v] ++
                      [b | (a,b) <- xs, elem a v]
            m ys xs = [(a,b) | (a,b) <- xs
                             , notElem a ys && notElem b ys]

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

numeroDeErdos3 :: [(String, String)] -> Int -> [String]
numeroDeErdos3 ps n = (sucCoautores "Paul Erdos" ps) !! n

-- (sucCoautores a ps) es la sucesión de coautores de a en ps ordenados
-- por diatancia. Por ejemplo, 
--    λ> take 3 (sucCoautores "Paul Erdos" coautores)
--    [["Paul Erdos"],
--     ["Ernst Straus","Pascual Jordan","D. Kleitman","J. Conway",
--      "A. J. Granville"],
--     ["Albert Einstein","John von Newmann","S. Glashow","P. Doyle",
--      "B. Mazur"]]
--    λ> sucCoautores "Albert Einstein" coautores
--    [["Albert Einstein"],
--     ["Ernst Straus","Otto Stern","Wolfgang Pauli"],
--     ["Paul Erdos"],
--     ["Pascual Jordan","D. Kleitman","J. Conway", "A. J. Granville"],
--     ["John von Newmann","S. Glashow","P. Doyle","B. Mazur"],
--     ["David Hilbert","M. Gell-Mann","Andrew Wiles"],
--     ["David Pines","Richar Feynman"],
--     ["D. Bohm","A. Bohr"],
--     ["L. De Broglie"]]
sucCoautores :: String -> [(String, String)] -> [[String]]
sucCoautores a ps =
  takeWhile (not . null) (map fst (iterate sig ([a], as \\ [a])))
  where as = elementos ps
        sig (xs,ys) = (zs,ys \\ zs)
          where zs = [y | y <- ys
                        , or [elem (x,y) ps || elem (y,x) ps | x <- xs]]

-- (elementos ps) es la lista de los elementos de los pares ps. Por
-- ejemplo,
--    elementos [(1,3),(3,2),(1,5)]  ==  [1,3,2,5]
elementos :: Eq a => [(a, a)] -> [a]
elementos = nub . (concatMap (\(x,y) -> [x,y]))

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

data Arbol a = N a [Arbol a]

deriving Show

coautores :: [(String,String)]

coautores =

[("Paul Erdos","Ernst Straus"),("Paul Erdos","Pascual Jordan"),

("Paul Erdos","D. Kleitman"),("Albert Einstein","Ernst Straus"),

("John von Newmann","David Hilbert"),("S. Glashow","D. Kleitman"),

("John von Newmann","Pascual Jordan"), ("David Pines","D. Bohm"),

("Albert Einstein","Otto Stern"),("S. Glashow", "M. Gell-Mann"),

("Richar Feynman","M. Gell-Mann"),("M. Gell-Mann","David Pines"),

("David Pines","A. Bohr"),("Wolfgang Pauli","Albert Einstein"),

("D. Bohm","L. De Broglie"), ("Paul Erdos","J. Conway"),

("J. Conway", "P. Doyle"),("Paul Erdos","A. J. Granville"),

("A. J. Granville","B. Mazur"),("B. Mazur","Andrew Wiles")]

-- 1ª solución

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

numeroDeErdos :: [(String, String)] -> Int -> [String]

numeroDeErdos xs n = nivel n (arbolDeErdos xs "Paul Erdos")

-- (arbolDeErdos xs a) es el árbol de coautores de a según la lista de

-- coautores xs. Por ejemplo,

-- λ> arbolDeErdos coautores "Paul Erdos"

-- N "Paul Erdos"

-- [N "Ernst Straus"

-- [N "Albert Einstein"

-- [N "Wolfgang Pauli" [],

-- N "Otto Stern" []]],

-- N "Pascual Jordan"

-- [N "John von Newmann"

-- [N "David Hilbert" []]],

-- N "D. Kleitman"

-- [N "S. Glashow"

-- [N "M. Gell-Mann"

-- [N "Richar Feynman" [],

-- N "David Pines"

-- [N "A. Bohr" [],

-- N "D. Bohm"

-- [N "L. De Broglie" []]]]]],

-- N "J. Conway"

-- [N "P. Doyle" []],

-- N "A. J. Granville"

-- [N "B. Mazur"

-- [N "Andrew Wiles" []]]]

arbolDeErdos :: [(String, String)] -> String -> Arbol String

arbolDeErdos xs a =

N a [arbolDeErdos noColaboradores n | n <- colaboradores]

where

colaboradores = [filtra a (x,y) | (x,y) <- xs, x == a || y == a]

filtra a (x,y) | a == x = y

| otherwise = x

noColaboradores = [(x,y) | (x,y) <- xs, x /= a, y /= a]

-- (nivel n a) es la lista de los elementos del árbol a en el nivel

-- n. Por ejemplo,

-- nivel 0 (N 3 [N 5 [N 6 []], N 7 [N 9 []]]) == [3]

-- nivel 1 (N 3 [N 5 [N 6 []], N 7 [N 9 []]]) == [5,7]

-- nivel 2 (N 3 [N 5 [N 6 []], N 7 [N 9 []]]) == [6,9]

nivel :: Int -> Arbol a -> [a]

nivel 0 (N a xs) = [a]

nivel n (N a xs) = concatMap (nivel (n-1)) xs

-- 2ª solución

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

numeroDeErdos2 :: [(String, String)] -> Int -> [String]

numeroDeErdos2 = auxC ["Paul Erdos"]

where

auxC v xs 0 = v

auxC v xs x = auxC (n v) (m v xs) (x-1)

where n v = [a | (a,b) <- xs, elem b v] ++

[b | (a,b) <- xs, elem a v]

m ys xs = [(a,b) | (a,b) <- xs

, notElem a ys && notElem b ys]

-- 3ª solución

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

numeroDeErdos3 :: [(String, String)] -> Int -> [String]

numeroDeErdos3 ps n = (sucCoautores "Paul Erdos" ps) !! n

-- (sucCoautores a ps) es la sucesión de coautores de a en ps ordenados

-- por diatancia. Por ejemplo,

-- λ> take 3 (sucCoautores "Paul Erdos" coautores)

-- [["Paul Erdos"],

-- ["Ernst Straus","Pascual Jordan","D. Kleitman","J. Conway",

-- "A. J. Granville"],

-- ["Albert Einstein","John von Newmann","S. Glashow","P. Doyle",

-- "B. Mazur"]]

-- λ> sucCoautores "Albert Einstein" coautores

-- [["Albert Einstein"],

-- ["Ernst Straus","Otto Stern","Wolfgang Pauli"],

-- ["Paul Erdos"],

-- ["Pascual Jordan","D. Kleitman","J. Conway", "A. J. Granville"],

-- ["John von Newmann","S. Glashow","P. Doyle","B. Mazur"],

-- ["David Hilbert","M. Gell-Mann","Andrew Wiles"],

-- ["David Pines","Richar Feynman"],

-- ["D. Bohm","A. Bohr"],

-- ["L. De Broglie"]]

sucCoautores :: String -> [(String, String)] -> [[String]]

sucCoautores a ps =

takeWhile (not . null) (map fst (iterate sig ([a], as \\ [a])))

where as = elementos ps

sig (xs,ys) = (zs,ys \\ zs)

where zs = [y | y <- ys

, or [elem (x,y) ps || elem (y,x) ps | x <- xs]]

-- (elementos ps) es la lista de los elementos de los pares ps. Por

-- ejemplo,

-- elementos [(1,3),(3,2),(1,5)] == [1,3,2,5]

elementos :: Eq a => [(a, a)] -> [a]

elementos = nub . (concatMap (\(x,y) -> [x,y]))

Huecos de Euclides

PorJosé A. Alonso 29-noviembre-20166-diciembre-2016

El teorema de Euclides afirma que existen infinitos números primos. En palabras de Euclides,

«Hay más números primos que cualquier cantidad propuesta de números primos.» (Proposición 20 del Libro IX de «Los Elementos»)

Su demostración se basa en que si p₁,…,pₙ son los primeros n números primos, entonces entre 1+pₙ y 1+p₁·p₂·…·pₙ hay algún número primo. La cantidad de dichos números primos se llama el n-ésimo hueco de Euclides. Por ejemplo, para n = 3 se tiene que p₁ = 2, p₂ = 3 y p₃ = 5 entre 1+p₃ = 6 y 1+p₁·p₂·p₃ = 31 hay 8 números primos (7, 11, 13, 17, 19, 23, 29 y 31), por lo que el valor del tercer hueco de Euclides es 8.

Definir la función

   hueco :: Int -> Integer

1	hueco :: Int -> Integer

tal que (hueco n) es el n-ésimo hueco de Eulides. Por ejemplo,

   hueco 3                   ==  8
   [hueco n | n <- [1..8]]   ==  [1,2,8,43,339,3242,42324,646021]

1 2	hueco 3 == 8 [hueco n \| n <- [1..8]] == [1,2,8,43,339,3242,42324,646021]

Soluciones

import Data.List
import Data.Numbers.Primes

hueco :: Int -> Integer
hueco n = nPrimosEntre (primes !! (n-1)) (1 + product (take n primes))

-- (nPrimosEntre x y) es el número de primos entre x e y. Por ejemplo, 
--    nPrimosEntre 3 7  ==  2
nPrimosEntre :: Integer -> Integer -> Integer
nPrimosEntre x y = genericLength (primosEntre x y)

-- (primosEntre x y) es la lista de los números de primos entre x e
-- y. Por ejemplo,  
--    primosEntre 3 7  ==  [5,7]
primosEntre :: Integer -> Integer -> [Integer]
primosEntre x y =
  takeWhile (<=y) (dropWhile (<=x) primes)

import Data.List

import Data.Numbers.Primes

hueco :: Int -> Integer

hueco n = nPrimosEntre (primes !! (n-1)) (1 + product (take n primes))

-- (nPrimosEntre x y) es el número de primos entre x e y. Por ejemplo,

-- nPrimosEntre 3 7 == 2

nPrimosEntre :: Integer -> Integer -> Integer

nPrimosEntre x y = genericLength (primosEntre x y)

-- (primosEntre x y) es la lista de los números de primos entre x e

-- y. Por ejemplo,

-- primosEntre 3 7 == [5,7]

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

primosEntre x y =

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

Referencias

Euclid’s theorem en la ProofWiki.

Variación de la conjetura de Goldbach

PorJosé A. Alonso 9-noviembre-201625-abril-2021

La conjetura de Goldbach afirma que

Todo número entero mayor que 5 se puede escribir como suma de tres números primos.

En este ejercicio consideraremos la variación consistente en exigir que los tres sumandos sean distintos.

Definir las funciones

   sumas3PrimosDistintos      :: Int -> [(Int,Int,Int)]
   conKsumas3PrimosDistintos  :: Int -> Int -> [Int]
   noSonSumas3PrimosDistintos :: Int -> [Int]

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

conKsumas3PrimosDistintos :: Int -> Int -> [Int]

noSonSumas3PrimosDistintos :: Int -> [Int]

tales que

(sumas3PrimosDistintos n) es la lista de las descomposiciones decrecientes de n como tres primos distintos. Por ejemplo,

   sumas3PrimosDistintos 26  ==  [(13,11,2),(17,7,2),(19,5,2)]
   sumas3PrimosDistintos 18  ==  [(11,5,2),(13,3,2)]
   sumas3PrimosDistintos 10  ==  [(5,3,2)]
   sumas3PrimosDistintos 11  ==  []

sumas3PrimosDistintos 26 == [(13,11,2),(17,7,2),(19,5,2)]

sumas3PrimosDistintos 18 == [(11,5,2),(13,3,2)]

sumas3PrimosDistintos 10 == [(5,3,2)]

sumas3PrimosDistintos 11 == []

(conKsumas3PrimosDistintos k n) es la lista de los números menores o iguales que n que se pueden escribir en k forma distintas como suma de tres primos distintos. Por ejemplo,

   conKsumas3PrimosDistintos 3 99  ==  [26,27,29,32,36,42,46,48,54,58,60]
   conKsumas3PrimosDistintos 2 99  ==  [18,20,21,22,23,24,25,28,30,34,64,70]
   conKsumas3PrimosDistintos 1 99  ==  [10,12,14,15,16,19,40]
   conKsumas3PrimosDistintos 0 99  ==  [11,13,17]

conKsumas3PrimosDistintos 3 99 == [26,27,29,32,36,42,46,48,54,58,60]

conKsumas3PrimosDistintos 2 99 == [18,20,21,22,23,24,25,28,30,34,64,70]

conKsumas3PrimosDistintos 1 99 == [10,12,14,15,16,19,40]

conKsumas3PrimosDistintos 0 99 == [11,13,17]

(noSonSumas3PrimosDistintos n) es la lista de los números menores o iguales que n que no se pueden escribir como suma de tres primos distintos. Por ejemplo,

   noSonSumas3PrimosDistintos 99   ==  [11,13,17]
   noSonSumas3PrimosDistintos 500  ==  [11,13,17]

1 2	noSonSumas3PrimosDistintos 99 == [11,13,17] noSonSumas3PrimosDistintos 500 == [11,13,17]

Soluciones

import Data.Numbers.Primes

sumas3PrimosDistintos :: Int -> [(Int,Int,Int)]
sumas3PrimosDistintos n =
  [(a,b,c) | a <- takeWhile (<=n-5) primes
           , b <- takeWhile (<a) primes
           , let c = n - a - b
           , c < b
           , isPrime c]

conKsumas3PrimosDistintos :: Int -> Int -> [Int]
conKsumas3PrimosDistintos k n =
  [x | x <- [10..n]
     , length (sumas3PrimosDistintos x) == k]

noSonSumas3PrimosDistintos :: Int -> [Int]
noSonSumas3PrimosDistintos = conKsumas3PrimosDistintos 0

import Data.Numbers.Primes

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

sumas3PrimosDistintos n =

[(a,b,c) | a <- takeWhile (<=n-5) primes

, b <- takeWhile (<a) primes

, let c = n - a - b

, c < b

, isPrime c]

conKsumas3PrimosDistintos :: Int -> Int -> [Int]

conKsumas3PrimosDistintos k n =

[x | x <- [10..n]

, length (sumas3PrimosDistintos x) == k]

noSonSumas3PrimosDistintos :: Int -> [Int]

noSonSumas3PrimosDistintos = conKsumas3PrimosDistintos 0

Referencias

Basado en el artículo Derivaciones de la conjetura de Goldbach de Claudio Meller en el blog Números y algo más.

Conjetura de Rassias

PorJosé A. Alonso 8-noviembre-201615-noviembre-2016

El artículo de esta semana del blog Números y hoja de cálculo está dedicado a la Conjetura de Rassias. Dicha conjetura afirma que

Para cada número primo p > 2 existen dos primos a y b, con a < b, tales que
(p-1)a = b+1

Dado un primo p > 2, los pares de Rassia de p son los pares de primos (a,b), con a < b, tales que (p-1)a = b+1. Por ejemplo, (2,7) y (3,11) son pares de Rassia de 5 ya que

2 y 7 son primos, 2 < 7 y (5-1)·2 = 7+1
3 y 11 son primos, 3 < 11 y (5-1)·3 = 11+1

Definir las siguientes funciones

   paresRassias     :: Integer -> [(Integer,Integer)]
   conjeturaRassias :: Integer -> Bool

1 2	paresRassias :: Integer -> [(Integer,Integer)] conjeturaRassias :: Integer -> Bool

tales que

(paresRassias p) es la lista de los pares de Rassias del primo p (que se supone que es mayor que 2). Por ejemplo,

     take 3 (paresRassias 5)    == [(2,7),(3,11),(5,19)]
     take 3 (paresRassias 1229) == [(71,87187),(113,138763),(191,234547)]

1 2	take 3 (paresRassias 5) == [(2,7),(3,11),(5,19)] take 3 (paresRassias 1229) == [(71,87187),(113,138763),(191,234547)]

(conjeturaRassia x) se verifica si para todos los primos menores que x (y mayores que 2) se cumple la conjetura de Rassia. Por ejemplo,

     conjeturaRassias (10^5)  ==  True

1	conjeturaRassias (10^5) == True

Soluciones

import Data.Numbers.Primes (primes, isPrime)

paresRassias :: Integer -> [(Integer,Integer)]
paresRassias p =
  [(a,b) | a <- primes
         , let b = (p - 1) * a - 1
         , isPrime b]

conjeturaRassias :: Integer -> Bool
conjeturaRassias x =
  and [(not . null . paresRassias) p | p <- tail (takeWhile (<x) primes)]

import Data.Numbers.Primes (primes, isPrime)

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

paresRassias p =

[(a,b) | a <- primes

, let b = (p - 1) * a - 1

, isPrime b]

conjeturaRassias :: Integer -> Bool

conjeturaRassias x =

and [(not . null . paresRassias) p | p <- tail (takeWhile (<x) primes)]

Referencias

Conjetura de Rassias por Antonio Roldán en el blog «Números y hoja de cálculo»
Rassias’ conjecture en Wikipedia

Primo anterior

PorJosé A. Alonso 7-noviembre-201614-noviembre-2016

Definir la función

   primoAnterior :: Integer -> Integer

1	primoAnterior :: Integer -> Integer

tal que (primoAnterior n) es el mayor primo menor que n (donde n > 2). Por ejemplo,

   primoAnterior 10     ==  7
   primoAnterior 17     ==  13
   primoAnterior 30     ==  29
   primoAnterior 2016   ==  2011
   primoAnterior 15726  ==  15683

primoAnterior 10 == 7

primoAnterior 17 == 13

primoAnterior 30 == 29

primoAnterior 2016 == 2011

primoAnterior 15726 == 15683

Calcular el menor número cuya distancia a su primo anterior es mayor que 40.

Soluciones

import Data.Numbers.Primes ( isPrime
                           , primes
                           )

-- 1ª definición
primoAnterior1 :: Integer -> Integer
primoAnterior1 n =
  last (takeWhile (<n) primes)

-- 2ª definición
primoAnterior2 :: Integer -> Integer
primoAnterior2 3 = 2
primoAnterior2 n =
  head [x | x <- [a,a-2..]
          , isPrime x]
  where a | even n    = n-1
          | otherwise = n-2

-- Comparación de eficiencia  
--    λ> primoAnterior1 3000000
--    2999999
--    (1.80 secs, 1,148,572,848 bytes)
--    λ> primoAnterior2 3000000
--    2999999
--    (0.00 secs, 0 bytes)
--    
--    λ> head [n | n <- [3..], n - primoAnterior1 n > 34]
--    9586
--    (28.08 secs, 14,396,008,560 bytes)
--    λ> head [n | n <- [3..], n - primoAnterior2 n > 34]
--    9586
--    (1.10 secs, 625,247,632 bytes)

-- El cálculo es
--    λ> head [n | n <- [3..], n - primoAnterior2 n > 40]
--    15724

import Data.Numbers.Primes ( isPrime

, primes

)

-- 1ª definición

primoAnterior1 :: Integer -> Integer

primoAnterior1 n =

last (takeWhile (<n) primes)

-- 2ª definición

primoAnterior2 :: Integer -> Integer

primoAnterior2 3 = 2

primoAnterior2 n =

head [x | x <- [a,a-2..]

, isPrime x]

where a | even n = n-1

| otherwise = n-2

-- Comparación de eficiencia

-- λ> primoAnterior1 3000000

-- 2999999

-- (1.80 secs, 1,148,572,848 bytes)

-- λ> primoAnterior2 3000000

-- 2999999

-- (0.00 secs, 0 bytes)

-- λ> head [n | n <- [3..], n - primoAnterior1 n > 34]

-- 9586

-- (28.08 secs, 14,396,008,560 bytes)

-- λ> head [n | n <- [3..], n - primoAnterior2 n > 34]

-- 9586

-- (1.10 secs, 625,247,632 bytes)

-- El cálculo es

-- λ> head [n | n <- [3..], n - primoAnterior2 n > 40]

-- 15724

Sucesión duplicadora

PorJosé A. Alonso 16-mayo-201625-abril-2021

Para cada entero positivo n, existe una única sucesión que empieza en 1, termina en n y en la que cada uno de sus elementos es el doble de su anterior o el doble más uno. Dicha sucesión se llama la sucesión duplicadora de n. Por ejemplo, la sucesión duplicadora de 13 es [1, 3, 6, 13], ya que

    3 = 2*1 +1
    6 = 2*3
   13 = 2*6 +1

3 = 2*1 +1

6 = 2*3

13 = 2*6 +1

Definir la función

   duplicadora :: Integer -> [Integer]

1	duplicadora :: Integer -> [Integer]

tal que (duplicadora n) es la sucesión duplicadora de n. Por ejemplo,

   duplicadora 13                   ==  [1,3,6,13]
   duplicadora 17                   ==  [1,2,4,8,17]
   length (duplicadora (10^40000))  ==  132878

duplicadora 13 == [1,3,6,13]

duplicadora 17 == [1,2,4,8,17]

length (duplicadora (10^40000)) == 132878

Soluciones

-- 1ª solución
duplicadora :: Integer -> [Integer]
duplicadora x =
    reverse (takeWhile (>=1) (iterate (`div` 2) x))

-- 2ª definición
duplicadora2 :: Integer -> [Integer]
duplicadora2  =
    reverse . takeWhile (>=1) . iterate (`div` 2)

-- 1ª solución

duplicadora :: Integer -> [Integer]

duplicadora x =

reverse (takeWhile (>=1) (iterate (`div` 2) x))

-- 2ª definición

duplicadora2 :: Integer -> [Integer]

duplicadora2 =

reverse . takeWhile (>=1) . iterate (`div` 2)

Conjuntos de primos emparejables

PorJosé A. Alonso 9-mayo-201625-abril-2021

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

Soluciones

import Data.Numbers.Primes (primes, isPrime)
import Data.List (nub, sort)
import qualified Data.Set as S

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

emparejables :: Integer -> Integer -> [[Integer]]
emparejables 0 _ = [[]]
emparejables n m = 
    nub [sort (x:xs) | x <- takeWhile (<=m) primes,
                       xs <- xss,
                       all (x `emparejable`) xs]
    where xss = emparejables (n-1) m

emparejable :: Integer -> Integer -> Bool
emparejable x y =
    isPrime (concatenacion x y) &&
    isPrime (concatenacion y x)

concatenacion :: Integer -> Integer -> Integer
concatenacion x y =
    read (show x ++ show y)

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

emparejables2 :: Integer -> Integer -> [[Integer]]
emparejables2 n m = map reverse (aux n m)
    where aux 1 m = [[x] | x <- takeWhile (<=m) primes]
          aux n m = 
              [p:ys | ys@(x:xs) <- xss,
                      p <- dropWhile (<x) ps,
                      all (p `emparejable`) ys]
              where ps  = takeWhile (<=m) primes
                    xss = aux (n-1) m

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

emparejables3 :: Integer -> Integer -> [[Integer]]
emparejables3 n m = map S.toList (aux n m)
    where aux 1 m = [S.singleton x | x <- takeWhile (<=m) primes]
          aux n m = [S.insert x xs | x <- takeWhile (<=m) primes,
                                     xs <- xss,
                                     all (x `emparejable`) xs]
              where xss = aux (n-1) m

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

emparejables4 :: Integer -> Integer -> [[Integer]]
emparejables4 n m = map S.toList (aux n m)
    where aux 1 m = [S.singleton x | x <- takeWhile (<=m) primes]
          aux n m = 
              [S.insert p ys | ys <- xss,
                               let (x,xs) = S.deleteFindMax ys,
                               p <- dropWhile (<x) ps,
                               all (p `emparejable`) ys]
              where ps  = takeWhile (<=m) primes
                    xss = aux (n-1) m

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

--    λ> head (emparejables 4 1000)
--    [3,7,109,673]
--    (20.36 secs, 11,781,891,120 bytes)
--    
--    λ> head (emparejables2 4 1000)
--    [3,7,109,673]
--    (0.02 secs, 0 bytes)
--    
--    λ> head (emparejables3 4 1000)
--    [3,7,109,673]
--    (38.04 secs, 21,542,334,024 bytes)
--    
--    λ> head (emparejables4 4 1000)
--    [3,7,109,673]
--    (0.03 secs, 0 bytes)

import Data.Numbers.Primes (primes, isPrime)

import Data.List (nub, sort)

import qualified Data.Set as S

-- 1ª definición

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

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

emparejables 0 _ = [[]]

emparejables n m =

nub [sort (x:xs) | x <- takeWhile (<=m) primes,

xs <- xss,

all (x `emparejable`) xs]

where xss = emparejables (n-1) m

emparejable :: Integer -> Integer -> Bool

emparejable x y =

isPrime (concatenacion x y) &&

isPrime (concatenacion y x)

concatenacion :: Integer -> Integer -> Integer

concatenacion x y =

read (show x ++ show y)

-- 2ª definición

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

emparejables2 :: Integer -> Integer -> [[Integer]]

emparejables2 n m = map reverse (aux n m)

where aux 1 m = [[x] | x <- takeWhile (<=m) primes]

aux n m =

[p:ys | ys@(x:xs) <- xss,

p <- dropWhile (<x) ps,

all (p `emparejable`) ys]

where ps = takeWhile (<=m) primes

xss = aux (n-1) m

-- 3ª definición

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

emparejables3 :: Integer -> Integer -> [[Integer]]

emparejables3 n m = map S.toList (aux n m)

where aux 1 m = [S.singleton x | x <- takeWhile (<=m) primes]

aux n m = [S.insert x xs | x <- takeWhile (<=m) primes,

xs <- xss,

all (x `emparejable`) xs]

where xss = aux (n-1) m

-- 2ª definición

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

emparejables4 :: Integer -> Integer -> [[Integer]]

emparejables4 n m = map S.toList (aux n m)

where aux 1 m = [S.singleton x | x <- takeWhile (<=m) primes]

aux n m =

[S.insert p ys | ys <- xss,

let (x,xs) = S.deleteFindMax ys,

p <- dropWhile (<x) ps,

all (p `emparejable`) ys]

where ps = takeWhile (<=m) primes

xss = aux (n-1) m

-- Comparación de eficiencia

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

-- λ> head (emparejables 4 1000)

-- [3,7,109,673]

-- (20.36 secs, 11,781,891,120 bytes)

-- λ> head (emparejables2 4 1000)

-- [3,7,109,673]

-- (0.02 secs, 0 bytes)

-- λ> head (emparejables3 4 1000)

-- [3,7,109,673]

-- (38.04 secs, 21,542,334,024 bytes)

-- λ> head (emparejables4 4 1000)

-- [3,7,109,673]

-- (0.03 secs, 0 bytes)

Números como sumas de primos consecutivos

PorJosé A. Alonso 15-abril-201625-abril-2021

En el artículo Integers as a sum of consecutive primes in 2,3,4,.. ways se presentan números que se pueden escribir como sumas de primos consecutivos de varias formas. Por ejemplo, el 41 se puede escribir de dos formas distintas

   41 =  2 +  3 +  5 + 7 + 11 + 13
   41 = 11 + 13 + 17

1 2	41 = 2 + 3 + 5 + 7 + 11 + 13 41 = 11 + 13 + 17

el 240 se puede escribir de tres formas

   240 =  17 +  19 + 23 + 29 + 31 + 37 + 41 + 43
   240 =  53 +  59 + 61 + 67
   240 = 113 + 127

240 = 17 + 19 + 23 + 29 + 31 + 37 + 41 + 43

240 = 53 + 59 + 61 + 67

240 = 113 + 127

y el 311 se puede escribir de 4 formas

   311 =  11 +  13 +  17 + 19 + 23 + 29 + 31 + 37 + 41 + 43 + 47
   311 =  31 +  37 +  41 + 43 + 47 + 53 + 59
   311 =  53 +  59 +  61 + 67 + 71
   311 = 101 + 103 + 107

311 = 11 + 13 + 17 + 19 + 23 + 29 + 31 + 37 + 41 + 43 + 47

311 = 31 + 37 + 41 + 43 + 47 + 53 + 59

311 = 53 + 59 + 61 + 67 + 71

311 = 101 + 103 + 107

Definir la función

   sumas :: Integer -> [[Integer]]

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

tal que (sumas x) es la lista de las formas de escribir x como suma
de dos o más números primos consecutivos. Por ejemplo,

   ghci> sumas 41
   [[2,3,5,7,11,13],[11,13,17]]
   ghci> sumas 240
   [[17,19,23,29,31,37,41,43],[53,59,61,67],[113,127]]
   ghci> sumas 311
   [[11,13,17,19,23,29,31,37,41,43,47],[31,37,41,43,47,53,59],[53,59,61,67,71],[101,103,107]]
   ghci> maximum [length (sumas n) | n <- [1..600]]
   4

ghci> sumas 41

[[2,3,5,7,11,13],[11,13,17]]

ghci> sumas 240

[[17,19,23,29,31,37,41,43],[53,59,61,67],[113,127]]

ghci> sumas 311

[[11,13,17,19,23,29,31,37,41,43,47],[31,37,41,43,47,53,59],[53,59,61,67,71],[101,103,107]]

ghci> maximum [length (sumas n) | n <- [1..600]]

Soluciones

import Data.Numbers.Primes (primes)
import Data.List (span)

sumas :: Integer -> [[Integer]]
sumas x = [ys | n <- takeWhile (< x) primes, 
                let ys = sumaDesde x n,
                not (null ys)]

-- (sumaDesde x n) es la lista de al menos dos números primos
-- consecutivos a partir del número primo n cuya suma es x, si existen y
-- la lista vacía en caso contrario. Por ejemplo,
--    sumaDesde 15 3  ==  [3,5,7]
--    sumaDesde  7 3  ==  []
sumaDesde :: Integer -> Integer -> [Integer]
sumaDesde x n | x == y    = take (1 + length us) ys
              | otherwise = []
    where ys       = dropWhile (<n) primes
          (us,y:_) = span (<x) (scanl1 (+) ys)

import Data.Numbers.Primes (primes)

import Data.List (span)

sumas :: Integer -> [[Integer]]

sumas x = [ys | n <- takeWhile (< x) primes,

let ys = sumaDesde x n,

not (null ys)]

-- (sumaDesde x n) es la lista de al menos dos números primos

-- consecutivos a partir del número primo n cuya suma es x, si existen y

-- la lista vacía en caso contrario. Por ejemplo,

-- sumaDesde 15 3 == [3,5,7]

-- sumaDesde 7 3 == []

sumaDesde :: Integer -> Integer -> [Integer]

sumaDesde x n | x == y = take (1 + length us) ys

| otherwise = []

where ys = dropWhile (<n) primes

(us,y:_) = span (<x) (scanl1 (+) ys)

Raíz entera

PorJosé A. Alonso 8-abril-20161-mayo-2016

Definir la función

   raizEnt :: Integer -> Integer -> Integer

1	raizEnt :: Integer -> Integer -> Integer

tal que (raizEnt x n) es la raíz entera n-ésima de x; es decir, el mayor número entero y tal que y^n <= x. Por ejemplo,

   raizEnt  8 3      ==  2
   raizEnt  9 3      ==  2
   raizEnt 26 3      ==  2
   raizEnt 27 3      ==  3
   raizEnt (10^50) 2 ==  10000000000000000000000000

raizEnt 8 3 == 2

raizEnt 9 3 == 2

raizEnt 26 3 == 2

raizEnt 27 3 == 3

raizEnt (10^50) 2 == 10000000000000000000000000

Comprobar con QuickCheck que para todo número natural n,

    raizEnt (10^(2*n)) 2 == 10^n

1	raizEnt (10^(2*n)) 2 == 10^n

Soluciones

import Test.QuickCheck

-- 1ª definición
raizEnt1 :: Integer -> Integer -> Integer
raizEnt1 x n =
    last (takeWhile (\y -> y^n <= x) [0..])

-- 2ª definición         
raizEnt2 :: Integer -> Integer -> Integer
raizEnt2 x n =
    floor ((fromIntegral x)**(1 / fromIntegral n))

-- Nota. La definición anterior falla para números grandes. Por ejemplo,
--    λ> raizEnt2 (10^50) 2 == 10^25
--    False
          
-- 3ª definición          
raizEnt3 :: Integer -> Integer -> Integer
raizEnt3 x n = aux (1,x)
    where aux (a,b) | d == x    = c
                    | c == a    = c
                    | d < x     = aux (c,b)
                    | otherwise = aux (a,c) 
              where c = (a+b) `div` 2
                    d = c^n

-- Comparación de eficiencia
--    λ> raizEnt1 (10^14) 2
--    10000000
--    (6.15 secs, 6,539,367,976 bytes)
--    λ> raizEnt2 (10^14) 2
--    10000000
--    (0.00 secs, 0 bytes)
--    λ> raizEnt3 (10^14) 2
--    10000000
--    (0.00 secs, 25,871,944 bytes)
--    
--    λ> raizEnt2 (10^50) 2
--    9999999999999998758486016
--    (0.00 secs, 0 bytes)
--    λ> raizEnt3 (10^50) 2
--    10000000000000000000000000
--    (0.00 secs, 0 bytes)
                        
-- La propiedad es                        
prop_raizEnt :: Integer -> Bool
prop_raizEnt n =
    raizEnt3 (10^(2*m)) 2 == 10^m
    where m = abs n

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

import Test.QuickCheck

-- 1ª definición

raizEnt1 :: Integer -> Integer -> Integer

raizEnt1 x n =

last (takeWhile (\y -> y^n <= x) [0..])

-- 2ª definición

raizEnt2 :: Integer -> Integer -> Integer

raizEnt2 x n =

floor ((fromIntegral x)**(1 / fromIntegral n))

-- Nota. La definición anterior falla para números grandes. Por ejemplo,

-- λ> raizEnt2 (10^50) 2 == 10^25

-- False

-- 3ª definición

raizEnt3 :: Integer -> Integer -> Integer

raizEnt3 x n = aux (1,x)

where aux (a,b) | d == x = c

| c == a = c

| d < x = aux (c,b)

| otherwise = aux (a,c)

where c = (a+b) `div` 2

d = c^n

-- Comparación de eficiencia

-- λ> raizEnt1 (10^14) 2

-- 10000000

-- (6.15 secs, 6,539,367,976 bytes)

-- λ> raizEnt2 (10^14) 2

-- 10000000

-- (0.00 secs, 0 bytes)

-- λ> raizEnt3 (10^14) 2

-- 10000000

-- (0.00 secs, 25,871,944 bytes)

-- λ> raizEnt2 (10^50) 2

-- 9999999999999998758486016

-- (0.00 secs, 0 bytes)

-- λ> raizEnt3 (10^50) 2

-- 10000000000000000000000000

-- (0.00 secs, 0 bytes)

-- La propiedad es

prop_raizEnt :: Integer -> Bool

prop_raizEnt n =

raizEnt3 (10^(2*m)) 2 == 10^m

where m = abs n

-- La comprobación es

-- λ> quickCheck prop_raizEnt

-- +++ OK, passed 100 tests.

Soluciones en Maxima

raizEnt (x,n) := inrt (x,n)$

1	raizEnt (x,n) := inrt (x,n)$

Integración por el método de los rectángulos

PorJosé A. Alonso 1-marzo-20161-mayo-2016

La integral definida de una función f entre los límites a y b puede calcularse mediante la regla del rectángulo usando la fórmula

   h * (f(a+h/2) + f(a+h+h/2) + f(a+2h+h/2) + ... + f(a+nh+h/2))

1	h * (f(a+h/2) + f(a+h+h/2) + f(a+2h+h/2) + ... + f(a+nh+h/2))

con a+nh+h/2 ≤ b < a+(n+1)h+h/2 y usando valores pequeños para h.

Definir la función

   integral :: (Fractional a, Ord a) => a -> a -> (a -> a) -> a -> a

1	integral :: (Fractional a, Ord a) => a -> a -> (a -> a) -> a -> a

tal que (integral a b f h) es el valor de dicha expresión. Por ejemplo, el cálculo de la integral de f(x) = x^3 entre 0 y 1, con paso 0.01, es

   integral 0 1 (^3) 0.01  ==  0.24998750000000042

1	integral 0 1 (^3) 0.01 == 0.24998750000000042

Otros ejemplos son

   integral 0 1 (^4) 0.01                        ==  0.19998333362500048
   integral 0 1 (\x -> 3*x^2 + 4*x^3) 0.01       ==  1.9999250000000026
   log 2 - integral 1 2 (\x -> 1/x) 0.01         ==  3.124931644782336e-6
   pi - 4 * integral 0 1 (\x -> 1/(x^2+1)) 0.01  ==  -8.333333331389525e-6

integral 0 1 (^4) 0.01 == 0.19998333362500048

integral 0 1 (\x -> 3*x^2 + 4*x^3) 0.01 == 1.9999250000000026

log 2 - integral 1 2 (\x -> 1/x) 0.01 == 3.124931644782336e-6

pi - 4 * integral 0 1 (\x -> 1/(x^2+1)) 0.01 == -8.333333331389525e-6

Nota: Definir la función también en Maxima. Por ejemplo,

   (%i3) integral (0,1,lambda ([x],x^3),0.01);
   (%o3) 0.2499875

1 2	(%i3) integral (0,1,lambda ([x],x^3),0.01); (%o3) 0.2499875

Soluciones

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

integral :: (Fractional a, Ord a) => a -> a -> (a -> a) -> a -> a
integral a b f h = h * suma (a+h/2) b (+h) f

-- (suma a b s f) es l valor de
--    f(a) + f(s(a)) + f(s(s(a)) + ... + f(s(...(s(a))...))
-- hasta que s(s(...(s(a))...)) > b. Por ejemplo,
--    suma 2 5 (1+) (^3)  ==  224
suma :: (Ord t, Num a) => t -> t -> (t -> t) -> (t -> a) -> a
suma a b s f = sum [f x | x <- sucesion a b s]

-- (sucesion x y s) es la lista
--    [a, s(a), s(s(a), ..., s(...(s(a))...)]
-- hasta que s(s(...(s(a))...)) > b. Por ejemplo,
--    sucesion 3 20 (+2)  ==  [3,5,7,9,11,13,15,17,19]
sucesion :: Ord a => a -> a -> (a -> a) -> [a]
sucesion a b s = takeWhile (<=b) (iterate s a)

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

integral2 :: (Fractional a, Ord a) => a -> a -> (a -> a) -> a -> a
integral2 a b f h
    | a+h/2 > b = 0
    | otherwise = h * f (a+h/2) + integral2 (a+h) b f h

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

integral3 :: (Fractional a, Ord a) => a -> a -> (a -> a) -> a -> a
integral3 a b f h = aux a where
    aux x | x+h/2 > b = 0
          | otherwise = h * f (x+h/2) + aux (x+h)

-- 1ª solución

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

integral :: (Fractional a, Ord a) => a -> a -> (a -> a) -> a -> a

integral a b f h = h * suma (a+h/2) b (+h) f

-- (suma a b s f) es l valor de

-- f(a) + f(s(a)) + f(s(s(a)) + ... + f(s(...(s(a))...))

-- hasta que s(s(...(s(a))...)) > b. Por ejemplo,

-- suma 2 5 (1+) (^3) == 224

suma :: (Ord t, Num a) => t -> t -> (t -> t) -> (t -> a) -> a

suma a b s f = sum [f x | x <- sucesion a b s]

-- (sucesion x y s) es la lista

-- [a, s(a), s(s(a), ..., s(...(s(a))...)]

-- hasta que s(s(...(s(a))...)) > b. Por ejemplo,

-- sucesion 3 20 (+2) == [3,5,7,9,11,13,15,17,19]

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

sucesion a b s = takeWhile (<=b) (iterate s a)

-- 2ª solución

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

integral2 :: (Fractional a, Ord a) => a -> a -> (a -> a) -> a -> a

integral2 a b f h

| a+h/2 > b = 0

| otherwise = h * f (a+h/2) + integral2 (a+h) b f h

-- 3ª solución

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

integral3 :: (Fractional a, Ord a) => a -> a -> (a -> a) -> a -> a

integral3 a b f h = aux a where

aux x | x+h/2 > b = 0

| otherwise = h * f (x+h/2) + aux (x+h)

Solución en Maxima

integral (a,b,f,h) := block ([c:a+h/2, s:0],
  while c <= b do
    ( s : s + f(c),
      c : c+h),
  float(h*s))$

integral (a,b,f,h) := block ([c:a+h/2, s:0],

while c <= b do

( s : s + f(c),

c : c+h),

float(h*s))$

Nota: En Maxima esta definida la función integrate para calcular integrales definidas. Por ejemplo,

     (%i7) integrate (x^3,x,0,1);
           1
     (%o7) -
           4
     (%i8) %, numer;
     (%o8) 0.25

(%i7) integrate (x^3,x,0,1);

(%o7) -

(%i8) %, numer;

(%o8) 0.25

Particiones en sumas de cuadrados

PorJosé A. Alonso 26-febrero-20161-mayo-2016

Definir las funciones

   particionesCuadradas        :: Integer -> [[Integer]]
   nParticionesCuadradas       :: Integer -> Integer
   graficaParticionesCuadradas :: Integer -> IO ()

particionesCuadradas :: Integer -> [[Integer]]

nParticionesCuadradas :: Integer -> Integer

graficaParticionesCuadradas :: Integer -> IO ()

tales que

(particionesCuadradas n) es la listas de conjuntos de cuadrados cuya suma es n. Por ejemplo,

      particionesCuadradas 3  ==  [[1,1,1]]
      particionesCuadradas 4  ==  [[4],[1,1,1,1]]
      particionesCuadradas 9  ==  [[9],[4,4,1],[4,1,1,1,1,1],[1,1,1,1,1,1,1,1,1]]

particionesCuadradas 3 == [[1,1,1]]

particionesCuadradas 4 == [[4],[1,1,1,1]]

particionesCuadradas 9 == [[9],[4,4,1],[4,1,1,1,1,1],[1,1,1,1,1,1,1,1,1]]

(nParticionesCuadradas n) es el número de conjuntos de cuadrados cuya suma es n. Por ejemplo,

      nParticionesCuadradas 3    ==  1
      nParticionesCuadradas 4    ==  2
      nParticionesCuadradas 9    ==  4
      nParticionesCuadradas 50   ==  104
      nParticionesCuadradas 100  ==  1116
      nParticionesCuadradas 200  ==  27482

nParticionesCuadradas 3 == 1

nParticionesCuadradas 4 == 2

nParticionesCuadradas 9 == 4

nParticionesCuadradas 50 == 104

nParticionesCuadradas 100 == 1116

nParticionesCuadradas 200 == 27482

(graficaParticionesCuadradas n) dibuja la gráfica de la sucesión

      [nParticionesCuadradas k | k <- [0..n]]

1	[nParticionesCuadradas k \| k <- [0..n]]

Por ejemplo, con (graficaParticionesCuadradas 100) se obtiene

Soluciones

import Data.List (genericLength)
import Graphics.Gnuplot.Simple

-- Definición de particiones cuadradas
-- ===================================

particionesCuadradas :: Integer -> [[Integer]]
particionesCuadradas n = 
    particiones n (reverse $ takeWhile (<=n) cuadrados)

-- cuadrados es la lista de los cuadrados. Por ejemplo,
--    take 12 cuadrados  ==  [1,4,9,16,25,36,49,64,81,100,121,144]
cuadrados :: [Integer]
cuadrados = map (^2) [1..]

-- (particiones n xs) es la lista de las particiones de n como suma de
-- elementos de xs, donde xs es una lista no creciente. Por ejemplo,
--    particiones 10 [7,4,2]  ==  [[4,4,2],[4,2,2,2],[2,2,2,2,2]]
--    particiones 11 [7,4,2]  ==  [[7,4],[7,2,2]]
--    particiones  5 [7,4,2]  ==  []
particiones:: Integer -> [Integer] -> [[Integer]]
particiones _ [] = []
particiones n (x:xs)
    | x >  n    = particiones n xs
    | x == n    = [n] : particiones n xs
    | otherwise = map (x:) (particiones (n-x) (x:xs)) ++ particiones n xs

-- 1ª definición de nParticionesCuadradas       
nParticionesCuadradas1 :: Integer -> Integer
nParticionesCuadradas1 = genericLength . particionesCuadradas

-- 2ª definición nParticionesCuadradas   
nParticionesCuadradas2 :: Integer -> Integer
nParticionesCuadradas2 n = aux n (reverse $ takeWhile (<=n) cuadrados) where
    aux _ [] = 0
    aux n ys@(x:xs) | x >  n    = aux n xs
                    | x == n    = 1 + aux n xs
                    | otherwise = aux (n-x) ys + aux n xs

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

--    λ> nParticionesCuadradas1 250
--    94987
--    (4.21 secs, 3,256,031,528 bytes)
--    λ> nParticionesCuadradas2 250
--    94987
--    (2.93 secs, 1,714,701,504 bytes)

-- Definición de graficaParticionesCuadradas
-- =========================================
                                  
graficaParticionesCuadradas :: Integer  -> IO ()
graficaParticionesCuadradas n = 
    plotList [Key Nothing] [nParticionesCuadradas2 k | k <- [0..n]]

import Data.List (genericLength)

import Graphics.Gnuplot.Simple

-- Definición de particiones cuadradas

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

particionesCuadradas :: Integer -> [[Integer]]

particionesCuadradas n =

particiones n (reverse $ takeWhile (<=n) cuadrados)

-- cuadrados es la lista de los cuadrados. Por ejemplo,

-- take 12 cuadrados == [1,4,9,16,25,36,49,64,81,100,121,144]

cuadrados :: [Integer]

cuadrados = map (^2) [1..]

-- (particiones n xs) es la lista de las particiones de n como suma de

-- elementos de xs, donde xs es una lista no creciente. Por ejemplo,

-- particiones 10 [7,4,2] == [[4,4,2],[4,2,2,2],[2,2,2,2,2]]

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

-- particiones 5 [7,4,2] == []

particiones:: Integer -> [Integer] -> [[Integer]]

particiones _ [] = []

particiones n (x:xs)

| x > n = particiones n xs

| x == n = [n] : particiones n xs

| otherwise = map (x:) (particiones (n-x) (x:xs)) ++ particiones n xs

-- 1ª definición de nParticionesCuadradas

nParticionesCuadradas1 :: Integer -> Integer

nParticionesCuadradas1 = genericLength . particionesCuadradas

-- 2ª definición nParticionesCuadradas

nParticionesCuadradas2 :: Integer -> Integer

nParticionesCuadradas2 n = aux n (reverse $ takeWhile (<=n) cuadrados) where

aux _ [] = 0

aux n ys@(x:xs) | x > n = aux n xs

| x == n = 1 + aux n xs

| otherwise = aux (n-x) ys + aux n xs

-- Comparación de eficiencia

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

-- λ> nParticionesCuadradas1 250

-- 94987

-- (4.21 secs, 3,256,031,528 bytes)

-- λ> nParticionesCuadradas2 250

-- 94987

-- (2.93 secs, 1,714,701,504 bytes)

-- Definición de graficaParticionesCuadradas

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

graficaParticionesCuadradas :: Integer -> IO ()

graficaParticionesCuadradas n =

plotList [Key Nothing] [nParticionesCuadradas2 k | k <- [0..n]]

Referencias

Sucesión A001156 de OEIS.

Sumas de potencias de 3 primos

PorJosé A. Alonso 24-febrero-201625-marzo-2022

Los primeros números de la forma p²+q³+r⁴, con p, q y r primos son

   28 = 2² + 2³ + 2⁴
   33 = 3² + 2³ + 2⁴
   47 = 2² + 3³ + 2⁴
   49 = 5² + 2³ + 2⁴

28 = 2² + 2³ + 2⁴

33 = 3² + 2³ + 2⁴

47 = 2² + 3³ + 2⁴

49 = 5² + 2³ + 2⁴

Definir la sucesión

   sumas3potencias :: [Integer]

1	sumas3potencias :: [Integer]

cuyos elementos son los números que se pueden escribir de la forma p²+q³+r⁴, con p, q y r primos. Por ejemplo,

   λ> take 15 sumas3potencias
   [28,33,47,49,52,68,73,92,93,98,112,114,117,133,138]
   λ> sumas3potencias !! 234567
   8953761

λ> take 15 sumas3potencias

[28,33,47,49,52,68,73,92,93,98,112,114,117,133,138]

λ> sumas3potencias !! 234567

8953761

Soluciones

import Data.Numbers.Primes (primes)

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

sumas3potencias1 :: [Integer]
sumas3potencias1 = filter esTripleSuma [1..]
 
-- (esTripleSuma n) se verifica si n se puede escribir de la forma
-- p²+q³+r⁴, con p, q y r primos. Por ejemplo, 
--    esTripleSuma 33  ==  True
--    esTripleSuma 45  ==  False
esTripleSuma :: Integer -> Bool
esTripleSuma = not . null . triplesSumas  

-- (triplesSumas n) es la lista de las ternas de primos (p,q,r) tales
-- que p²+q³+r⁴ = n. Por ejemplo,
--    triplesSumas 33   ==  [(3,2,2)]
--    triplesSumas 145  ==  [(11,2,2),(2,5,2)]
--    triplesSumas 45   ==  []
triplesSumas :: Integer -> [(Integer,Integer,Integer)]
triplesSumas n =  
    [(p,q,r) 
    | r <- xs, 
      q <- xs, 
      let p2 = n - q^3 - r^4,
      let p = (floor . sqrt . fromIntegral) p2,
      p*p == p2,
      isPrime p]
    where xs = takeWhile (< (ceiling $ sqrt $ fromIntegral n)) primes

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

sumas3potencias2 :: [Integer]
sumas3potencias2 = sumaOrdenadaInf as (sumaOrdenadaInf bs cs)

sumaOrdenadaInf:: [Integer] -> [Integer] -> [Integer]
sumaOrdenadaInf xs ys = mezclaTodas [map (+x) ys | x <- xs]

mezclaTodas :: Ord a => [[a]] -> [a]
mezclaTodas = foldr1 xmezcla
    where xmezcla (x:xs) ys = x : mezcla xs ys

mezcla :: Ord a => [a] -> [a] -> [a]
mezcla (x:xs) (y:ys) | x < y  = x : mezcla xs (y:ys)
                     | x == y = x : mezcla xs ys
                     | x > y  = y : mezcla (x:xs) ys
 
as = map (^2) primes
bs = map (^3) primes
cs = map (^4) primes

import Data.Numbers.Primes (primes)

-- 1ª solución

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

sumas3potencias1 :: [Integer]

sumas3potencias1 = filter esTripleSuma [1..]

-- (esTripleSuma n) se verifica si n se puede escribir de la forma

-- p²+q³+r⁴, con p, q y r primos. Por ejemplo,

-- esTripleSuma 33 == True

-- esTripleSuma 45 == False

esTripleSuma :: Integer -> Bool

esTripleSuma = not . null . triplesSumas

-- (triplesSumas n) es la lista de las ternas de primos (p,q,r) tales

-- que p²+q³+r⁴ = n. Por ejemplo,

-- triplesSumas 33 == [(3,2,2)]

-- triplesSumas 145 == [(11,2,2),(2,5,2)]

-- triplesSumas 45 == []

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

triplesSumas n =

[(p,q,r)

| r <- xs,

q <- xs,

let p2 = n - q^3 - r^4,

let p = (floor . sqrt . fromIntegral) p2,

p*p == p2,

isPrime p]

where xs = takeWhile (< (ceiling $ sqrt $ fromIntegral n)) primes

-- 2ª solución

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

sumas3potencias2 :: [Integer]

sumas3potencias2 = sumaOrdenadaInf as (sumaOrdenadaInf bs cs)

sumaOrdenadaInf:: [Integer] -> [Integer] -> [Integer]

sumaOrdenadaInf xs ys = mezclaTodas [map (+x) ys | x <- xs]

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

mezclaTodas = foldr1 xmezcla

where xmezcla (x:xs) ys = x : mezcla xs ys

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

mezcla (x:xs) (y:ys) | x < y = x : mezcla xs (y:ys)

| x == y = x : mezcla xs ys

| x > y = y : mezcla (x:xs) ys

as = map (^2) primes

bs = map (^3) primes

cs = map (^4) primes

Números primos de Hilbert

PorJosé A. Alonso 4-febrero-20161-mayo-2016

Un número de Hilbert es un entero positivo de la forma 4n+1. Los primeros números de Hilbert son 1, 5, 9, 13, 17, 21, 25, 29, 33, 37, 41, 45, 49, 53, 57, 61, 65, 69, …

Un primo de Hilbert es un número de Hilbert n que no es divisible por ningún número de Hilbert menor que n (salvo el 1). Los primeros primos de Hilbert son 5, 9, 13, 17, 21, 29, 33, 37, 41, 49, 53, 57, 61, 69, 73, 77, 89, 93, 97, 101, 109, 113, 121, 129, 133, 137, …

Definir la sucesión

   primosH :: [Integer]

1	primosH :: [Integer]

tal que sus elementos son los primos de Hilbert. Por ejemplo,

   take 15 primosH  == [5,9,13,17,21,29,33,37,41,49,53,57,61,69,73]
   primosH !! 20000 == 203221

1 2	take 15 primosH == [5,9,13,17,21,29,33,37,41,49,53,57,61,69,73] primosH !! 20000 == 203221

Soluciones

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

-- numerosH es la sucesión de los números de Hilbert. Por ejemplo,
--    take 15 numerosH  ==  [1,5,9,13,17,21,25,29,33,37,41,45,49,53,57]
numerosH :: [Integer]
numerosH = [1,5..]

-- (divisoresH n) es la lista de los números de Hilbert que dividen a
-- n. Por ejemplo,
--   divisoresH 117  ==  [1,9,13,117]
--   divisoresH  21  ==  [1,21]
divisoresH :: Integer -> [Integer]
divisoresH n = [x | x <- takeWhile (<=n) numerosH,
                    n `mod` x == 0]

primosH1 :: [Integer]
primosH1 = [n | n <- tail numerosH,
                divisoresH n == [1,n]]

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

primosH2 :: [Integer]
primosH2 = filter esPrimoH (tail numerosH) 
    where esPrimoH n = all noDivideAn [5,9..m]
              where noDivideAn x = n `mod` x /= 0
                    m            = ceiling (sqrt (fromIntegral n))

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

--    λ> primosH1 !! 2000
--    16957
--    (6.93 secs, 750,291,352 bytes)
--    λ> primosH2 !! 2000
--    16957
--    (0.13 secs, 18,066,288 bytes)

-- 1ª definición

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

-- numerosH es la sucesión de los números de Hilbert. Por ejemplo,

-- take 15 numerosH == [1,5,9,13,17,21,25,29,33,37,41,45,49,53,57]

numerosH :: [Integer]

numerosH = [1,5..]

-- (divisoresH n) es la lista de los números de Hilbert que dividen a

-- n. Por ejemplo,

-- divisoresH 117 == [1,9,13,117]

-- divisoresH 21 == [1,21]

divisoresH :: Integer -> [Integer]

divisoresH n = [x | x <- takeWhile (<=n) numerosH,

n `mod` x == 0]

primosH1 :: [Integer]

primosH1 = [n | n <- tail numerosH,

divisoresH n == [1,n]]

-- 2ª definición

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

primosH2 :: [Integer]

primosH2 = filter esPrimoH (tail numerosH)

where esPrimoH n = all noDivideAn [5,9..m]

where noDivideAn x = n `mod` x /= 0

m = ceiling (sqrt (fromIntegral n))

-- Comparación de eficiencia

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

-- λ> primosH1 !! 2000

-- 16957

-- (6.93 secs, 750,291,352 bytes)

-- λ> primosH2 !! 2000

-- 16957

-- (0.13 secs, 18,066,288 bytes)

Antiimágenes en una función creciente

PorJosé A. Alonso 20-enero-201626-marzo-2022

Definir la función

   antiimagen :: (Int -> Int) -> Int -> Maybe Int

1	antiimagen :: (Int -> Int) -> Int -> Maybe Int

tal que (antiimagen f y) es justo el x tal que f(x) = y, si y pertenece a la imagen de la función creciente f, o nada, en caso contrario. Por ejemplo,

   antiimagen (^2) 25  ==  Just 5
   antiimagen (^3) 25  ==  Nothing

1 2	antiimagen (^2) 25 == Just 5 antiimagen (^3) 25 == Nothing

Nota. Se supone que f está definida sobre los números naturales.

Soluciones

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

antiimagen1 :: (Int -> Int) -> Int -> Maybe Int
antiimagen1 f y 
    | estaEnImagen f y = Just x
    | otherwise        = Nothing
    where x = head [x | x <- [0..], f x == y]

-- (estaEnImagen f y) se verifica si pertenece a la imagen de f. Por
-- ejemplo, 
--    estaEnImagen (^2) 25 == True
--    estaEnImagen (^2) 30 == False
estaEnImagen :: (Int -> Int) -> Int -> Bool
estaEnImagen f y = elem y (takeWhile (<=y) (imagen f)) 

-- (imagen f) es la imagen de f. Por ejemplo,
--    take 10 (imagen (^2))  ==  [0,1,4,9,16,25,36,49,64,81]
--    take 10 (imagen (*3))  ==  [0,3,6,9,12,15,18,21,24,27]
imagen :: (Int -> Int) -> [Int]
imagen f = map f [0..]

-- 2ª definición (con lookup y maxBound)
-- =====================================

antiimagen2 :: (Int -> Int) -> Int -> Maybe Int
antiimagen2 f y =
    lookup y (takeWhile (<= (y,maxBound)) [(f x, x) | x <- [0..]])

-- 1ª definición

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

antiimagen1 :: (Int -> Int) -> Int -> Maybe Int

antiimagen1 f y

| estaEnImagen f y = Just x

| otherwise = Nothing

where x = head [x | x <- [0..], f x == y]

-- (estaEnImagen f y) se verifica si pertenece a la imagen de f. Por

-- ejemplo,

-- estaEnImagen (^2) 25 == True

-- estaEnImagen (^2) 30 == False

estaEnImagen :: (Int -> Int) -> Int -> Bool

estaEnImagen f y = elem y (takeWhile (<=y) (imagen f))

-- (imagen f) es la imagen de f. Por ejemplo,

-- take 10 (imagen (^2)) == [0,1,4,9,16,25,36,49,64,81]

-- take 10 (imagen (*3)) == [0,3,6,9,12,15,18,21,24,27]

imagen :: (Int -> Int) -> [Int]

imagen f = map f [0..]

-- 2ª definición (con lookup y maxBound)

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

antiimagen2 :: (Int -> Int) -> Int -> Maybe Int

antiimagen2 f y =

lookup y (takeWhile (<= (y,maxBound)) [(f x, x) | x <- [0..]])

Puntos en una región

PorJosé A. Alonso 5-enero-20161-mayo-2016

Definir la función

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

1	puntos :: Integer -> [(Integer,Integer)]

tal que (puntos n) es la lista de los puntos (x,y) con coordenadas enteras de
la cuadrícula [1..n]x[1..n] (es decir, 1 ≤ x,y ≤ n) tales que |x²-xy-y²| = 1. Por ejemplo,

   length (puntos 10)          ==  5
   length (puntos 100)         ==  10
   length (puntos 1000)        ==  15
   length (puntos (10^50000))  ==  239249

length (puntos 10) == 5

length (puntos 100) == 10

length (puntos 1000) == 15

length (puntos (10^50000)) == 239249

Soluciones

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

puntos1 :: Integer -> [(Integer,Integer)]
puntos1 n =
    [(x,y) | x <- [1..n],
             y <- [1..n],
             abs (x^2-x*y-y^2) == 1] 

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

-- Calculando algunos elementos
--    λ> puntos1 10
--    [(1,1),(2,1),(3,2),(5,3),(8,5)]
--    λ> puntos1 20
--    [(1,1),(2,1),(3,2),(5,3),(8,5),(13,8)]
--    λ> puntos1 100
--    [(1,1),(2,1),(3,2),(5,3),(8,5),(13,8),(21,13),(34,21),(55,34),(89,55)]
--    λ> puntos1 89
--    [(1,1),(2,1),(3,2),(5,3),(8,5),(13,8),(21,13),(34,21),(55,34),(89,55)]
-- se observa una ley de construcción de cada elemento a partir del anterior.

puntos2 :: Integer -> [(Integer,Integer)]
puntos2 n = takeWhile menor (iterate siguiente (1,1))
    where siguiente (x,y) = (x+y,x)
          menor (x,y)     = x <= n

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

-- Se observa que la lista de las segundas componentes
--    1,1,2,3,5,8,13,21,34,55,89,...
-- y la lista de las primeras componentes es el resto de la segunda. 

puntos3 :: Integer -> [(Integer,Integer)]
puntos3 n = zip (tail xs) xs
    where xs = takeWhile (<=n) fibonacci

-- fibonacci es la sucesión de Fibonacci. Por ejemplo,
--    take 11 fibonacci  ==  [1,1,2,3,5,8,13,21,34,55,89]
fibonacci :: [Integer]
fibonacci = 1 : 1 : zipWith (+) fibonacci (tail fibonacci)

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

-- λ> length (puntos1 (10^3))
-- 15
-- (7.96 secs, 1,092,368,200 bytes)
-- λ> length (puntos2 (10^3))
-- 15
-- (0.02 secs, 0 bytes)
-- 
-- λ> length (puntos2 (10^30000))
-- 143549
-- (1.14 secs, 974,239,544 bytes)
-- λ> length (puntos3 (10^30000))
-- 143549
-- (3.28 secs, 967,206,560 bytes)

-- 1ª definición

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

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

puntos1 n =

[(x,y) | x <- [1..n],

y <- [1..n],

abs (x^2-x*y-y^2) == 1]

-- 2ª definición

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

-- Calculando algunos elementos

-- λ> puntos1 10

-- [(1,1),(2,1),(3,2),(5,3),(8,5)]

-- λ> puntos1 20

-- [(1,1),(2,1),(3,2),(5,3),(8,5),(13,8)]

-- λ> puntos1 100

-- [(1,1),(2,1),(3,2),(5,3),(8,5),(13,8),(21,13),(34,21),(55,34),(89,55)]

-- λ> puntos1 89

-- [(1,1),(2,1),(3,2),(5,3),(8,5),(13,8),(21,13),(34,21),(55,34),(89,55)]

-- se observa una ley de construcción de cada elemento a partir del anterior.

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

puntos2 n = takeWhile menor (iterate siguiente (1,1))

where siguiente (x,y) = (x+y,x)

menor (x,y) = x <= n

-- 3ª definición

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

-- Se observa que la lista de las segundas componentes

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

-- y la lista de las primeras componentes es el resto de la segunda.

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

puntos3 n = zip (tail xs) xs

where xs = takeWhile (<=n) fibonacci

-- fibonacci es la sucesión de Fibonacci. Por ejemplo,

-- take 11 fibonacci == [1,1,2,3,5,8,13,21,34,55,89]

fibonacci :: [Integer]

fibonacci = 1 : 1 : zipWith (+) fibonacci (tail fibonacci)

-- Comparación de eficiencia

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

-- λ> length (puntos1 (10^3))

-- 15

-- (7.96 secs, 1,092,368,200 bytes)

-- λ> length (puntos2 (10^3))

-- 15

-- (0.02 secs, 0 bytes)

-- λ> length (puntos2 (10^30000))

-- 143549

-- (1.14 secs, 974,239,544 bytes)

-- λ> length (puntos3 (10^30000))

-- 143549

-- (3.28 secs, 967,206,560 bytes)

2016 es un número práctico

PorJosé A. Alonso 4-enero-20161-mayo-2016

Un entero positivo n es un número práctico si todos los enteros positivos menores que él se pueden expresar como suma de distintos divisores de n. Por ejemplo, el 12 es un número práctico, ya que todos los enteros positivos menores que 12 se pueden expresar como suma de divisores de 12 (1, 2, 3, 4 y 6) sin usar ningún divisor más de una vez en cada suma:

    1 = 1
    2 = 2
    3 = 3
    4 = 4
    5 = 2 + 3
    6 = 6
    7 = 1 + 6
    8 = 2 + 6
    9 = 3 + 6
   10 = 4 + 6
   11 = 1 + 4 + 6

1 = 1

2 = 2

3 = 3

4 = 4

5 = 2 + 3

6 = 6

7 = 1 + 6

8 = 2 + 6

9 = 3 + 6

10 = 4 + 6

11 = 1 + 4 + 6

En cambio, 14 no es un número práctico ya que 6 no se puede escribir como suma, con sumandos distintos, de divisores de 14.

Definir la función

   esPractico :: Integer -> Bool

1	esPractico :: Integer -> Bool

tal que (esPractico n) se verifica si n es un número práctico. Por ejemplo,

   esPractico 12                                      ==  True
   esPractico 14                                      ==  False
   esPractico 2016                                    ==  True
   esPractico 42535295865117307932921825928971026432  ==  True

esPractico 12 == True

esPractico 14 == False

esPractico 2016 == True

esPractico 42535295865117307932921825928971026432 == True

Soluciones

import Data.List (genericLength, group, nub, sort, subsequences)
import Data.Numbers.Primes (primeFactors)
import Graphics.Gnuplot.Simple

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

esPractico1 :: Integer -> Bool
esPractico1 n =
    takeWhile (<n) (sumas (divisores n)) == [0..n-1]

-- (divisores n) es la lista de los divisores de n. Por ejemplo,
--    divisores 12  ==  [1,2,3,4,6]
--    divisores 14  ==  [1,2,7]
divisores :: Integer -> [Integer]
divisores n = [k | k <- [1..n-1], n `mod` k == 0]

-- (sumas xs) es la lista ordenada de números que se pueden obtener como
-- sumas de elementos de xs sin usar ningún elemento más de una vez en
-- cada suma. Por ejemplo,  
--    sumas [1,2,3]  ==  [0,1,2,3,4,5,6]
--    sumas [1,2,7]  ==  [0,1,2,3,7,8,9,10]
sumas :: [Integer] -> [Integer]
sumas xs = sort (nub (map sum (subsequences xs)))

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

esPractico2 :: Integer -> Bool
esPractico2 n = all (esSumable (divisores n)) [1..n-1]

-- (esSumable xs n) se verifica si n se puede escribir como una suma de
-- elementos distintos de la lista creciente xs. Por ejemplo,
--    esSumable [1,2,7] 8  ==  True
--    esSumable [1,2,7] 6  ==  False
--    esSumable [1,2,7] 4  ==  False
--    esSumable [1,2,7] 2  ==  True
--    esSumable [1,2,7] 0  ==  True
esSumable :: [Integer] -> Integer -> Bool
esSumable _ 0  = True
esSumable [] _ = False
esSumable (x:xs) n = x <= n && (esSumable xs (n-x) || esSumable xs n)

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

-- Usando la caracterización de Stewart y Sierpiński: un entero n >= 2
-- es práctico syss para su factorización prima
--    n = p(1)^e(1) * p(2)*e(2) *...* p(k)^e(k)
-- se cumple que p(1) = 2 y, para cada i de 2 a k se cumple que
--                         1+e(j) 
--                i-1  p(j)       - 1
--    p(i) <= 1 +  ∏  ----------------
--                j=1     p(j) - 1

esPractico3 :: Integer -> Bool
esPractico3 1 = True
esPractico3 n = 
    x == 2 &&
    and [p <= 1 + c | (p,c) <- zip bases cotas]
    where xss       = factorizacion n
          (x:bases) = map fst xss
          cotas     = scanl1 (*) [(p^(1+e)-1) `div` (p-1) | (p,e) <- xss]

-- (factorizacion n) es la factorización de n. Por ejemplo, 
--    factorizacion  600  ==  [(2,3),(3,1),(5,2)]
--    factorizacion 1400  ==  [(2,3),(5,2),(7,1)]
factorizacion :: Integer -> [(Integer,Integer)]
factorizacion n =
    [(head xs,genericLength xs) | xs <- group (primeFactors n)]

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

--    λ> length [n | n <- [1..400], esPractico1 n]
--    92
--    (40.21 secs, 8,378,539,464 bytes)
--    λ> length [n | n <- [1..400], esPractico2 n]
--    92
--    (8.29 secs, 1,109,669,760 bytes)
--    λ> length [n | n <- [1..400], esPractico3 n]
--    92
--    (0.02 secs, 0 bytes)

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

import Data.Numbers.Primes (primeFactors)

import Graphics.Gnuplot.Simple

-- 1ª definición

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

esPractico1 :: Integer -> Bool

esPractico1 n =

takeWhile (<n) (sumas (divisores n)) == [0..n-1]

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

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

-- divisores 14 == [1,2,7]

divisores :: Integer -> [Integer]

divisores n = [k | k <- [1..n-1], n `mod` k == 0]

-- (sumas xs) es la lista ordenada de números que se pueden obtener como

-- sumas de elementos de xs sin usar ningún elemento más de una vez en

-- cada suma. Por ejemplo,

-- sumas [1,2,3] == [0,1,2,3,4,5,6]

-- sumas [1,2,7] == [0,1,2,3,7,8,9,10]

sumas :: [Integer] -> [Integer]

sumas xs = sort (nub (map sum (subsequences xs)))

-- 2ª definición

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

esPractico2 :: Integer -> Bool

esPractico2 n = all (esSumable (divisores n)) [1..n-1]

-- (esSumable xs n) se verifica si n se puede escribir como una suma de

-- elementos distintos de la lista creciente xs. Por ejemplo,

-- esSumable [1,2,7] 8 == True

-- esSumable [1,2,7] 6 == False

-- esSumable [1,2,7] 4 == False

-- esSumable [1,2,7] 2 == True

-- esSumable [1,2,7] 0 == True

esSumable :: [Integer] -> Integer -> Bool

esSumable _ 0 = True

esSumable [] _ = False

esSumable (x:xs) n = x <= n && (esSumable xs (n-x) || esSumable xs n)

-- 3ª definición

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

-- Usando la caracterización de Stewart y Sierpiński: un entero n >= 2

-- es práctico syss para su factorización prima

-- n = p(1)^e(1) * p(2)*e(2) *...* p(k)^e(k)

-- se cumple que p(1) = 2 y, para cada i de 2 a k se cumple que

-- 1+e(j)

-- i-1 p(j) - 1

-- p(i) <= 1 + ∏ ----------------

-- j=1 p(j) - 1

esPractico3 :: Integer -> Bool

esPractico3 1 = True

esPractico3 n =

x == 2 &&

and [p <= 1 + c | (p,c) <- zip bases cotas]

where xss = factorizacion n

(x:bases) = map fst xss

cotas = scanl1 (*) [(p^(1+e)-1) `div` (p-1) | (p,e) <- xss]

-- (factorizacion n) es la factorización de n. Por ejemplo,

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

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

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

factorizacion n =

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

-- Comparación de eficiencia

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

-- λ> length [n | n <- [1..400], esPractico1 n]

-- 92

-- (40.21 secs, 8,378,539,464 bytes)

-- λ> length [n | n <- [1..400], esPractico2 n]

-- 92

-- (8.29 secs, 1,109,669,760 bytes)

-- λ> length [n | n <- [1..400], esPractico3 n]

-- 92

-- (0.02 secs, 0 bytes)

Referencias

Basado en el artículo de Gaussianos Feliz Navidad y Feliz Año (número práctico) 2016.

Otras referencias

M. Margenstern (1991), Les nombres pratiques: théorie, observations et conjectures.
G. Melfi, Practical numbers.
G. Melfi (2008), A survey on practical numbers.
OEIS, Sucesión A005153.
PlanetMath.org, Practical number.
E.W. Weisstein, Practical number.
A. Weingartner (2015), Practical numbers and the distribution of divisors.
Wikipedia, Practical number.

Reconocimiento de anterior

PorJosé A. Alonso 29-diciembre-20151-mayo-2016

Definir la función

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

1	esAnterior :: Eq a => [a] -> a -> a -> Bool

tal que (esAnterior xs y z) se verifica si y ocurre en xs antes que z (que puede no pertenecer a xs). Por ejemplo,

   esAnterior [1,3,7,2] 3 2  ==  True
   esAnterior [1,3,7,2] 3 1  ==  False
   esAnterior [1,3,7,2] 3 5  ==  True
   esAnterior [1,3,7,2] 5 3  ==  False

esAnterior [1,3,7,2] 3 2 == True

esAnterior [1,3,7,2] 3 1 == False

esAnterior [1,3,7,2] 3 5 == True

esAnterior [1,3,7,2] 5 3 == False

Soluciones

-- 1ª definición (por recursión)
esAnterior1 :: Eq a => [a] -> a -> a -> Bool
esAnterior1 [] _ _     = False
esAnterior1 (x:xs) y z = x /= z && (x == y || esAnterior1 xs y z) 

-- 2ª definición
esAnterior2 :: Eq a => [a] -> a -> a -> Bool
esAnterior2 xs y z = z `notElem` (takeWhile (/=y) xs)

-- Comparación de eficiencia
--    λ> let n = 1000000 in esAnterior1 [1..n] (n-1) n
--    True
--    (2.19 secs, 384,717,008 bytes)
--    λ> let n = 1000000 in esAnterior2 [1..n] (n-1) n
--    True
--    (0.34 secs, 135,479,936 bytes)

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

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

esAnterior1 [] _ _ = False

esAnterior1 (x:xs) y z = x /= z && (x == y || esAnterior1 xs y z)

-- 2ª definición

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

esAnterior2 xs y z = z `notElem` (takeWhile (/=y) xs)

-- Comparación de eficiencia

-- λ> let n = 1000000 in esAnterior1 [1..n] (n-1) n

-- True

-- (2.19 secs, 384,717,008 bytes)

-- λ> let n = 1000000 in esAnterior2 [1..n] (n-1) n

-- True

-- (0.34 secs, 135,479,936 bytes)

Siembra de listas

PorJosé A. Alonso 23-diciembre-201525-marzo-2022

Definir la función

   siembra :: [Int] -> [Int]

1	siembra :: [Int] -> [Int]

tal que (siembra xs) es la lista ys obtenida al repartir cada elemento x de la lista xs poniendo un 1 en las x siguientes posiciones de la lista ys. Por ejemplo,

   siembra [4]      ==  [0,1,1,1,1] 
   siembra [0,2]    ==  [0,0,1,1]
   siembra [4,2]    ==  [0,1,2,2,1]

siembra [4] == [0,1,1,1,1]

siembra [0,2] == [0,0,1,1]

siembra [4,2] == [0,1,2,2,1]

El tercer ejemplo se obtiene sumando la siembra de 4 en la posición 0 (como el ejemplo 1) y el 2 en la posición 1 (como el ejemplo 2). Otros ejemplos son

   siembra [0,4,2]          ==  [0,0,1,2,2,1]
   siembra [3]              ==  [0,1,1,1]
   siembra [3,4,2]          ==  [0,1,2,3,2,1]
   siembra [3,2,1]          ==  [0,1,2,3]
   sum $ siembra [1..2500]  ==  3126250

siembra [0,4,2] == [0,0,1,2,2,1]

siembra [3] == [0,1,1,1]

siembra [3,4,2] == [0,1,2,3,2,1]

siembra [3,2,1] == [0,1,2,3]

sum $ siembra [1..2500] == 3126250

Comprobar con QuickCheck que la suma de los elementos de (siembra xs) es igual que la suma de los de xs.

Nota 1: Se supone que el argumento es una lista de números no negativos y que se puede ampliar tanto como sea necesario para repartir los elementos.

Nota 2: Este ejercicio es parte del examen del grupo 3 del 2 de diciembre.

Soluciones

import Test.QuickCheck

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

siembra1 :: [Int] -> [Int]
siembra1 = suma . brotes

-- (brotes xs) es la lista de los brotes obtenido sembrando los
-- elementos de xs. Por ejemplo,
--    brotes [3,4,2]  ==  [[0,1,1,1],[0,0,1,1,1,1],[0,0,0,1,1]]
brotes :: [Int] -> [[Int]]
brotes xs = aux xs 1
    where aux (x:xs) n = (replicate n 0 ++ replicate x 1) : aux xs (n+1)
          aux _ _      = []

-- (suma xss) es la suma de los elementos de xss (suponiendo que al
-- final de cada elemento se continua con ceros). Por ejemplo,
--    suma [[0,1,1,1],[0,0,1,1,1,1],[0,0,0,1,1]]  ==  [0,1,2,3,2,1]
suma :: [[Int]] -> [Int]
suma = foldr1 aux
    where aux [] ys = ys
          aux xs [] = xs
          aux (x:xs) (y:ys) = (x+y) : aux xs ys

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

siembra2 :: [Int] -> [Int]
siembra2 [] = []
siembra2 (x:xs) = mezcla (siembraElemento x) (0 : siembra2 xs)

siembraElemento :: Int -> [Int]
siembraElemento x = 0 : replicate x 1

mezcla :: [Int] -> [Int] -> [Int]
mezcla xs ys =
    take (max (length xs) (length ys))
         (zipWith (+) (xs ++ repeat 0) (ys ++ repeat 0))

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

siembra3 :: [Int] -> [Int]
siembra3 [] = []
siembra3 xs = aux xs 0 (repeat 0) where
    aux []     _ ys = cosecha ys
    aux (x:xs) n ys = aux xs (n+1) (zipWith (+) brotes ys) 
        where brotes = replicate (n+1) 0 ++ replicate x 1 ++ repeat 0

-- (cosecha xs) es la lista formada por los ceros iniciales de xs y los
-- elementos siguientes hasta que vuelve a aparecer el 0. Por ejemplo,
--    cosecha [0,0,3,5,2,0,9]            ==  [0,0,3,5,2]
--    cosecha ([0,0,3,5,2] ++ repeat 0)  ==  [0,0,3,5,2]
cosecha :: [Int] -> [Int]              
cosecha xs = ys ++ takeWhile (>0) zs
    where (ys,zs) = span (==0) xs

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

siembra4 :: [Int] -> [Int]
siembra4 [] = []
siembra4 xs = aux xs [] (repeat 0) where
    aux []     ys zs     = reverse ys ++ takeWhile (>0) zs
    aux (x:xs) ys (z:zs) = aux xs (z:ys) (zipWith (+) brotes zs) 
        where brotes = replicate x 1 ++ repeat 0

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

--    λ> sum $ siembra1 [1..2000]
--    2001000
--    (9.44 secs, 1,894,065,928 bytes)
--    ghci> sum $ siembra2 [1..2000]
--    2001000
--    (5.92 secs, 936900576 bytes)
--    ghci> sum $ siembra3 [1..2000]
--    2001000
--    (1.59 secs, 836847072 bytes)
--    ghci> sum $ siembra4 [1..2000]
--    2001000
--    (1.68 secs, 570492392 bytes)

-- En lo que sigue usaremos la 2ª definición
siembra :: [Int] -> [Int]
siembra = siembra2

-- Verificación
-- ============

-- La propiedad es
prop_siembra :: [Int] -> Bool
prop_siembra xs =
    sum (siembra1 ys) == sum ys
    where ys = map (\x -> 1 + abs x) xs

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

100

import Test.QuickCheck

-- 1ª solución

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

siembra1 :: [Int] -> [Int]

siembra1 = suma . brotes

-- (brotes xs) es la lista de los brotes obtenido sembrando los

-- elementos de xs. Por ejemplo,

-- brotes [3,4,2] == [[0,1,1,1],[0,0,1,1,1,1],[0,0,0,1,1]]

brotes :: [Int] -> [[Int]]

brotes xs = aux xs 1

where aux (x:xs) n = (replicate n 0 ++ replicate x 1) : aux xs (n+1)

aux _ _ = []

-- (suma xss) es la suma de los elementos de xss (suponiendo que al

-- final de cada elemento se continua con ceros). Por ejemplo,

-- suma [[0,1,1,1],[0,0,1,1,1,1],[0,0,0,1,1]] == [0,1,2,3,2,1]

suma :: [[Int]] -> [Int]

suma = foldr1 aux

where aux [] ys = ys

aux xs [] = xs

aux (x:xs) (y:ys) = (x+y) : aux xs ys

-- 2ª solución

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

siembra2 :: [Int] -> [Int]

siembra2 [] = []

siembra2 (x:xs) = mezcla (siembraElemento x) (0 : siembra2 xs)

siembraElemento :: Int -> [Int]

siembraElemento x = 0 : replicate x 1

mezcla :: [Int] -> [Int] -> [Int]

mezcla xs ys =

take (max (length xs) (length ys))

(zipWith (+) (xs ++ repeat 0) (ys ++ repeat 0))

-- 3ª solución

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

siembra3 :: [Int] -> [Int]

siembra3 [] = []

siembra3 xs = aux xs 0 (repeat 0) where

aux [] _ ys = cosecha ys

aux (x:xs) n ys = aux xs (n+1) (zipWith (+) brotes ys)

where brotes = replicate (n+1) 0 ++ replicate x 1 ++ repeat 0

-- (cosecha xs) es la lista formada por los ceros iniciales de xs y los

-- elementos siguientes hasta que vuelve a aparecer el 0. Por ejemplo,

-- cosecha [0,0,3,5,2,0,9] == [0,0,3,5,2]

-- cosecha ([0,0,3,5,2] ++ repeat 0) == [0,0,3,5,2]

cosecha :: [Int] -> [Int]

cosecha xs = ys ++ takeWhile (>0) zs

where (ys,zs) = span (==0) xs

-- 4ª solución

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

siembra4 :: [Int] -> [Int]

siembra4 [] = []

siembra4 xs = aux xs [] (repeat 0) where

aux [] ys zs = reverse ys ++ takeWhile (>0) zs

aux (x:xs) ys (z:zs) = aux xs (z:ys) (zipWith (+) brotes zs)

where brotes = replicate x 1 ++ repeat 0

-- Comparación de eficiencia

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

-- λ> sum $ siembra1 [1..2000]

-- 2001000

-- (9.44 secs, 1,894,065,928 bytes)

-- ghci> sum $ siembra2 [1..2000]

-- 2001000

-- (5.92 secs, 936900576 bytes)

-- ghci> sum $ siembra3 [1..2000]

-- 2001000

-- (1.59 secs, 836847072 bytes)

-- ghci> sum $ siembra4 [1..2000]

-- 2001000

-- (1.68 secs, 570492392 bytes)

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

siembra :: [Int] -> [Int]

siembra = siembra2

-- Verificación

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

-- La propiedad es

prop_siembra :: [Int] -> Bool

prop_siembra xs =

sum (siembra1 ys) == sum ys

where ys = map (\x -> 1 + abs x) xs

-- La comprobación es

-- λ> quickCheck prop_siembra

-- +++ OK, passed 100 tests.

Ternas con suma acotada

PorJosé A. Alonso 20-noviembre-20151-mayo-2016

Definir la función

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

1	ternasAcotadas :: [Int] -> Int -> [(Int,Int,Int)]

tal que (ternasAcotadas xs n) es el conjunto de ternas de números naturales de xs cuya suma es menor que n. Por ejemplo,

   ternasAcotadas [5,1,5,4,7] 12      ==  [(1,4,5),(1,5,5)]
   ternasAcotadas [5,1,5,4,7] 11      ==  [(1,4,5)]
   ternasAcotadas [5,1,5,4,7] 10      ==  []
   ternasAcotadas [1..10^6] 8         ==  [(1,2,3),(1,2,4)]
   ternasAcotadas [10^6,10^6-1..1] 8  ==  [(1,2,3),(1,2,4)]

ternasAcotadas [5,1,5,4,7] 12 == [(1,4,5),(1,5,5)]

ternasAcotadas [5,1,5,4,7] 11 == [(1,4,5)]

ternasAcotadas [5,1,5,4,7] 10 == []

ternasAcotadas [1..10^6] 8 == [(1,2,3),(1,2,4)]

ternasAcotadas [10^6,10^6-1..1] 8 == [(1,2,3),(1,2,4)]

Soluciones

import Data.List (tails, sort, nub)

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

ternasAcotadas :: [Int] -> Int -> [(Int,Int,Int)]
ternasAcotadas xs n =
    nub [(x,y,z) | (x,y,z) <- ternas (sort xs)
                 , x+y+z < n]

-- (ternas xs) es la lista de ternas de elementos de xs. Por ejemplo,
--    λ> ternas [1..5]
--    [(1,2,3),(1,2,4),(1,2,5),(1,3,4),(1,3,5),(1,4,5),
--     (2,3,4),(2,3,5),(2,4,5),
--     (3,4,5)]
ternas :: [a] -> [(a,a,a)]
ternas xs = [(x,y,z) | (x:ys) <- tails xs
                     , (y:zs) <- tails ys
                     , z <- zs]

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

ternasAcotadas2 :: [Int] -> Int -> [(Int,Int,Int)]
ternasAcotadas2 xs n = nub (aux (sort xs))
    where aux xs = [(x,y,z) | (x:ys) <- tails (takeWhile (< n) xs)
                            , (y:zs) <- tails (takeWhile (< (n-x)) ys)
                            , z <- takeWhile (< (n-x-y)) zs]

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

--    λ> ternasAcotadas [1..1000] 10
--    [(1,2,3),(1,2,4),(1,2,5),(1,2,6),(1,3,4),(1,3,5),(2,3,4)]
--    (336.06 secs, 50,595,444,208 bytes)
--    λ> ternasAcotadas2 [1..1000] 10
--    [(1,2,3),(1,2,4),(1,2,5),(1,2,6),(1,3,4),(1,3,5),(2,3,4)]
--    (0.00 secs, 0 bytes)

import Data.List (tails, sort, nub)

-- 1ª definición

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

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

ternasAcotadas xs n =

nub [(x,y,z) | (x,y,z) <- ternas (sort xs)

, x+y+z < n]

-- (ternas xs) es la lista de ternas de elementos de xs. Por ejemplo,

-- λ> ternas [1..5]

-- [(1,2,3),(1,2,4),(1,2,5),(1,3,4),(1,3,5),(1,4,5),

-- (2,3,4),(2,3,5),(2,4,5),

-- (3,4,5)]

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

ternas xs = [(x,y,z) | (x:ys) <- tails xs

, (y:zs) <- tails ys

, z <- zs]

-- 2ª definición

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

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

ternasAcotadas2 xs n = nub (aux (sort xs))

where aux xs = [(x,y,z) | (x:ys) <- tails (takeWhile (< n) xs)

, (y:zs) <- tails (takeWhile (< (n-x)) ys)

, z <- takeWhile (< (n-x-y)) zs]

-- Comparación de eficiencia

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

-- λ> ternasAcotadas [1..1000] 10

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

-- (336.06 secs, 50,595,444,208 bytes)

-- λ> ternasAcotadas2 [1..1000] 10

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

-- (0.00 secs, 0 bytes)

Distancia invierte y suma hasta capicúa

PorJosé A. Alonso 27-abril-20151-mayo-2016

Un número es capicúa si es igual leído de izquierda a derecha que de derecha a izquierda; por ejemplo, el 4884.

El transformado «invierte y suma» de un número x es la suma de x y su número invertido; es decir, el número resultante de la inversión del orden en el que aparecen sus dígitos. Por ejemplo, el transformado de 124 es 124 + 421 = 545.

Se aplica la transformación «invierte y suma» hasta obtener un capicúa. Por ejemplo, partiendo del número 87, el proceso es

     87 +   78 =  165 
    165 +  561 =  726 
    726 +  627 = 1353 
   1353 + 3531 = 4884

87 + 78 = 165

165 + 561 = 726

726 + 627 = 1353

1353 + 3531 = 4884

El número de pasos de dicho proceso es la distancia capicúa del número; por ejemplo, la distancia capicúa de 87 es 4.

Definir la función

   distanciaIS :: Integer -> Integer

1	distanciaIS :: Integer -> Integer

tal que (distanciaIS x) es la distancia capicúa de x. Por ejemplo,

   distanciaIS 11                   ==    0
   distanciaIS 10                   ==    1
   distanciaIS 19                   ==    2
   distanciaIS 59                   ==    3
   distanciaIS 69                   ==    4
   distanciaIS 166                  ==    5
   distanciaIS 79                   ==    6
   distanciaIS 89                   ==   24
   distanciaIS 10911                ==   55
   distanciaIS 1000000079994144385  ==  259

distanciaIS 11 == 0

distanciaIS 10 == 1

distanciaIS 19 == 2

distanciaIS 59 == 3

distanciaIS 69 == 4

distanciaIS 166 == 5

distanciaIS 79 == 6

distanciaIS 89 == 24

distanciaIS 10911 == 55

distanciaIS 1000000079994144385 == 259

Soluciones

import Data.List (genericLength)

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

distanciaIS1 :: Integer -> Integer
distanciaIS1 = genericLength . cadena

-- (cadena x) es la lista de transformados de x que no son capicúas. Por
-- ejemplo, 
--    cadena 87  ==  [87,165,726,1353]
cadena :: Integer -> [Integer]
cadena x | esCapicua x = []
         | otherwise   = x : cadena (transformadoIS x)

-- (esCapicua x) se verifica si x es capicúa. Por ejemplo,
--    esCapicua 42524  ==  True
--    esCapicua 42542  ==  False
esCapicua :: Integer -> Bool
esCapicua x = show x == reverse (show x)

-- (transformadoIS x) es el número obtenido sumándole a x el número con los
-- mismos dígitos que x pero en orden inverso. Por ejemplo,
--    transformadoIS 1325  ==  6556
--    transformadoIS 1375  ==  7106
transformadoIS :: Integer -> Integer
transformadoIS x = x + read (reverse (show x))

-- 2ª solución (por recursión con contador)
distanciaIS2 :: Integer -> Integer
distanciaIS2 x = aux x 0
    where aux x n | esCapicua x = n
                  | otherwise   = aux (transformadoIS x) (n+1)

-- 3ª solución (con iterate)
distanciaIS3 :: Integer -> Integer
distanciaIS3 =
    genericLength . takeWhile (not . esCapicua) . iterate transformadoIS

import Data.List (genericLength)

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

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

distanciaIS1 :: Integer -> Integer

distanciaIS1 = genericLength . cadena

-- (cadena x) es la lista de transformados de x que no son capicúas. Por

-- ejemplo,

-- cadena 87 == [87,165,726,1353]

cadena :: Integer -> [Integer]

cadena x | esCapicua x = []

| otherwise = x : cadena (transformadoIS x)

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

-- esCapicua 42524 == True

-- esCapicua 42542 == False

esCapicua :: Integer -> Bool

esCapicua x = show x == reverse (show x)

-- (transformadoIS x) es el número obtenido sumándole a x el número con los

-- mismos dígitos que x pero en orden inverso. Por ejemplo,

-- transformadoIS 1325 == 6556

-- transformadoIS 1375 == 7106

transformadoIS :: Integer -> Integer

transformadoIS x = x + read (reverse (show x))

-- 2ª solución (por recursión con contador)

distanciaIS2 :: Integer -> Integer

distanciaIS2 x = aux x 0

where aux x n | esCapicua x = n

| otherwise = aux (transformadoIS x) (n+1)

-- 3ª solución (con iterate)

distanciaIS3 :: Integer -> Integer

distanciaIS3 =

genericLength . takeWhile (not . esCapicua) . iterate transformadoIS

Agrupamiento de consecutivos iguales

PorJosé A. Alonso 30-marzo-20151-mayo-2016

Definir las funciones

   agrupa  :: Eq a => [a] -> [(a,Int)]
   expande :: [(a,Int)] -> [a]

1 2	agrupa :: Eq a => [a] -> [(a,Int)] expande :: [(a,Int)] -> [a]

tales que

(agrupa xs) es la lista obtenida agrupando las ocurrencias consecutivas de elementos de xs junto con el número de dichas ocurrencias. Por ejemplo:

     agrupa "aaabzzaa" == [('a',3),('b',1),('z',2),('a',2)]

1	agrupa "aaabzzaa" == [('a',3),('b',1),('z',2),('a',2)]

(expande xs) es la lista expandida correspondiente a ps (es decir, es la lista xs tal que la comprimida de xs es ps. Por ejemplo,

     expande [('a',2),('b',3),('a',1)] == "aabbba"

1	expande [('a',2),('b',3),('a',1)] == "aabbba"

Comprobar con QuickCheck que dada una lista de enteros, si se la agrupa y después se expande se obtiene la lista inicial.

Soluciones

import Data.List (group)
import Test.QuickCheck

-- Definiciones de agrupa
-- ======================

-- 1ª definición (por recursión)
agrupa :: Eq a => [a] -> [(a,Int)]
agrupa xs = aux xs 1
    where aux (x:y:zs) n | x == y    = aux (y:zs) (n+1)
                         | otherwise = (x,n) : aux (y:zs) 1
          aux [x]      n             = [(x,n)]
          aux []       _             = []

-- 2ª definición (por recursión usando takeWhile):
agrupa2 :: Eq a => [a] -> [(a,Int)]
agrupa2 [] = []
agrupa2 (x:xs) = 
    (x,1 + length (takeWhile (==x) xs)) : agrupa2 (dropWhile (==x) xs)

-- 3ª definición (por comprensión usando group):
agrupa3 :: Eq a => [a] -> [(a,Int)]
agrupa3 xs = [(head ys,length ys) | ys <- group xs]

-- 4ª definición (usando map y group):
agrupa4 :: Eq a => [a] -> [(a,Int)]
agrupa4 = map (\xs -> (head xs, length xs)) . group

-- Definiciones de expande
-- =======================

-- 1ª definición (por comprensión)
expande :: [(a,Int)] -> [a]
expande ps = concat [replicate k x | (x,k) <- ps]

-- 2ª definición (por concatMap)
expande2 :: [(a,Int)] -> [a]
expande2 = concatMap (\(x,k) -> replicate k x) 

-- 3ª definición (por recursión)
expande3 :: [(a,Int)] -> [a]
expande3 [] = []
expande3 ((x,n):ps) = replicate n x ++ expande3 ps

-- Comprobación
-- ============

-- La propiedad es
prop_expande_agrupa :: [Int] -> Bool 
prop_expande_agrupa xs = expande (agrupa xs) == xs

-- La comprobación es
--    ghci> quickCheck prop_expande_agrupa
--    +++ OK, passed 100 tests.

import Data.List (group)

import Test.QuickCheck

-- Definiciones de agrupa

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

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

agrupa :: Eq a => [a] -> [(a,Int)]

agrupa xs = aux xs 1

where aux (x:y:zs) n | x == y = aux (y:zs) (n+1)

| otherwise = (x,n) : aux (y:zs) 1

aux [x] n = [(x,n)]

aux [] _ = []

-- 2ª definición (por recursión usando takeWhile):

agrupa2 :: Eq a => [a] -> [(a,Int)]

agrupa2 [] = []

agrupa2 (x:xs) =

(x,1 + length (takeWhile (==x) xs)) : agrupa2 (dropWhile (==x) xs)

-- 3ª definición (por comprensión usando group):

agrupa3 :: Eq a => [a] -> [(a,Int)]

agrupa3 xs = [(head ys,length ys) | ys <- group xs]

-- 4ª definición (usando map y group):

agrupa4 :: Eq a => [a] -> [(a,Int)]

agrupa4 = map (\xs -> (head xs, length xs)) . group

-- Definiciones de expande

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

-- 1ª definición (por comprensión)

expande :: [(a,Int)] -> [a]

expande ps = concat [replicate k x | (x,k) <- ps]

-- 2ª definición (por concatMap)

expande2 :: [(a,Int)] -> [a]

expande2 = concatMap (\(x,k) -> replicate k x)

-- 3ª definición (por recursión)

expande3 :: [(a,Int)] -> [a]

expande3 [] = []

expande3 ((x,n):ps) = replicate n x ++ expande3 ps

-- Comprobación

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

-- La propiedad es

prop_expande_agrupa :: [Int] -> Bool

prop_expande_agrupa xs = expande (agrupa xs) == xs

-- La comprobación es

-- ghci> quickCheck prop_expande_agrupa

-- +++ OK, passed 100 tests.

Sucesión de números parientes

PorJosé A. Alonso 17-marzo-20151-mayo-2016

Se dice que dos números naturales son parientes sitienen exactamente un factor primo en común, independientemente de su multiplicidad. Por ejemplo,

Los números 12 (2²·3) y 40 (2³·5) son parientes, pues tienen al 2 como único factor primo en común.
Los números 49 (7²) y 63 (3²·7) son parientes, pues tienen al 7 como único factor primo en común.
Los números 12 (2²·3) y 30 (2·3·5) no son parientes, pues tienen dos factores primos en común.
Los números 49 (7²) y 25 (5²) no son parientes, pues no tienen factores primos en común.

Se dice que una lista de números naturales es una secuencia de parientes si cada par de números consecutivos son parientes. Por ejemplo,

La lista [12,40,35,28] es una secuencia de parientes.
La lista [12,30,21,49] no es una secuencia de parientes.

Definir la función

   secuenciaParientes :: [Integer] -> Bool

1	secuenciaParientes :: [Integer] -> Bool

tal que (secuenciaParientes xs) se verifica si xs es una secuencia de parientes. Por ejemplo,

   secuenciaParientes [12,40,35,28]           ==  True
   secuenciaParientes [12,30,21,49]           ==  False
   secuenciaParientes [2^n | n <- [1..2000]]  ==  True

secuenciaParientes [12,40,35,28] == True

secuenciaParientes [12,30,21,49] == False

secuenciaParientes [2^n | n <- [1..2000]] == True

Soluciones

import Data.List (intersect, nub)
import Data.Numbers.Primes (primes, primeFactors)

-- (parientes x y) se verifica si x e y son parientes. Por ejemplo,
--    parientes 12 40  ==  True
--    parientes 49 63  ==  True
--    parientes 12 30  ==  False
--    parientes 49 25  ==  False

-- 1ª definición (con gcd)
parientes1 :: Integer -> Integer -> Bool
parientes1 x y =
    length [p | p <- takeWhile (<= d) primes, d `mod` p == 0] == 1 
    where d = gcd x y

-- 2ª definición (con primeFactors)
parientes2 :: Integer -> Integer -> Bool
parientes2 0 0 = False
parientes2 x y = 
    length (nub (primeFactors x `intersect` primeFactors y)) == 1

-- Comparación de eficiencia
--    ghci> parientes1 (2^25) (2^25)
--    True
--    (34.34 secs, 15974866184 bytes)
--    ghci> parientes2 (2^25) (2^25)
--    True
--    (0.01 secs, 3093024 bytes)

-- Usaremos la 2ª definición
parientes :: Integer -> Integer -> Bool
parientes = parientes2

-- Definiciones de secuenciaParientes 
-- ==================================

-- 1ª definición (por recursión)
secuenciaParientes :: [Integer] -> Bool
secuenciaParientes []         = True
secuenciaParientes [x]        = True
secuenciaParientes (x1:x2:xs) =
    parientes x1 x2 && secuenciaParientes (x2:xs)

-- 2ª definición (por recursión con 2 ecuaciones)
secuenciaParientes2 :: [Integer] -> Bool
secuenciaParientes2 (x1:x2:xs) =
    parientes x1 x2 && secuenciaParientes2 (x2:xs)
secuenciaParientes2 _         = True

-- 3ª definición (sin recursión):
secuenciaParientes3 :: [Integer] -> Bool
secuenciaParientes3 xs = all (\(x,y) -> parientes x y) (zip xs (tail xs)) 

-- 4ª definición
secuenciaParientes4 :: [Integer] -> Bool
secuenciaParientes4 xs = all (uncurry parientes) (zip xs (tail xs))

import Data.List (intersect, nub)

import Data.Numbers.Primes (primes, primeFactors)

-- (parientes x y) se verifica si x e y son parientes. Por ejemplo,

-- parientes 12 40 == True

-- parientes 49 63 == True

-- parientes 12 30 == False

-- parientes 49 25 == False

-- 1ª definición (con gcd)

parientes1 :: Integer -> Integer -> Bool

parientes1 x y =

length [p | p <- takeWhile (<= d) primes, d `mod` p == 0] == 1

where d = gcd x y

-- 2ª definición (con primeFactors)

parientes2 :: Integer -> Integer -> Bool

parientes2 0 0 = False

parientes2 x y =

length (nub (primeFactors x `intersect` primeFactors y)) == 1

-- Comparación de eficiencia

-- ghci> parientes1 (2^25) (2^25)

-- True

-- (34.34 secs, 15974866184 bytes)

-- ghci> parientes2 (2^25) (2^25)

-- True

-- (0.01 secs, 3093024 bytes)

-- Usaremos la 2ª definición

parientes :: Integer -> Integer -> Bool

parientes = parientes2

-- Definiciones de secuenciaParientes

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

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

secuenciaParientes :: [Integer] -> Bool

secuenciaParientes [] = True

secuenciaParientes [x] = True

secuenciaParientes (x1:x2:xs) =

parientes x1 x2 && secuenciaParientes (x2:xs)

-- 2ª definición (por recursión con 2 ecuaciones)

secuenciaParientes2 :: [Integer] -> Bool

secuenciaParientes2 (x1:x2:xs) =

parientes x1 x2 && secuenciaParientes2 (x2:xs)

secuenciaParientes2 _ = True

-- 3ª definición (sin recursión):

secuenciaParientes3 :: [Integer] -> Bool

secuenciaParientes3 xs = all (\(x,y) -> parientes x y) (zip xs (tail xs))

-- 4ª definición

secuenciaParientes4 :: [Integer] -> Bool

secuenciaParientes4 xs = all (uncurry parientes) (zip xs (tail xs))

Números como sumas de primos consecutivos

PorJosé A. Alonso 11-marzo-201525-abril-2021

   41 =  2 +  3 +  5 + 7 + 11 + 13
   41 = 11 + 13 + 17

1 2	41 = 2 + 3 + 5 + 7 + 11 + 13 41 = 11 + 13 + 17

el 240 se puede escribir de tres formas

   240 =  17 +  19 + 23 + 29 + 31 + 37 + 41 + 43
   240 =  53 +  59 + 61 + 67
   240 = 113 + 127

240 = 17 + 19 + 23 + 29 + 31 + 37 + 41 + 43

240 = 53 + 59 + 61 + 67

240 = 113 + 127

y el 311 se puede escribir de 4 formas

   311 =  11 +  13 +  17 + 19 + 23 + 29 + 31 + 37 + 41 + 43 + 47
   311 =  31 +  37 +  41 + 43 + 47 + 53 + 59
   311 =  53 +  59 +  61 + 67 + 71
   311 = 101 + 103 + 107

311 = 11 + 13 + 17 + 19 + 23 + 29 + 31 + 37 + 41 + 43 + 47

311 = 31 + 37 + 41 + 43 + 47 + 53 + 59

311 = 53 + 59 + 61 + 67 + 71

311 = 101 + 103 + 107

Definir la función

   sumas :: Integer -> [[Integer]]

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

tal que (sumas x) es la lista de las formas de escribir x como suma de dos o más números primos consecutivos. Por ejemplo,

   ghci> sumas 41
   [[2,3,5,7,11,13],[11,13,17]]
   ghci> sumas 240
   [[17,19,23,29,31,37,41,43],[53,59,61,67],[113,127]]
   ghci> sumas 311
   [[11,13,17,19,23,29,31,37,41,43,47],[31,37,41,43,47,53,59],
    [53,59,61,67,71],[101,103,107]]
   ghci> maximum [length (sumas n) | n <- [1..600]]
   4

ghci> sumas 41

[[2,3,5,7,11,13],[11,13,17]]

ghci> sumas 240

[[17,19,23,29,31,37,41,43],[53,59,61,67],[113,127]]

ghci> sumas 311

[[11,13,17,19,23,29,31,37,41,43,47],[31,37,41,43,47,53,59],

[53,59,61,67,71],[101,103,107]]

ghci> maximum [length (sumas n) | n <- [1..600]]

Soluciones

import Data.Numbers.Primes (primes)
import Data.List (span)

sumas :: Integer -> [[Integer]]
sumas x = [ys | n <- takeWhile (< x) primes, 
                let ys = sumaDesde x n,
                not (null ys)]

-- (sumaDesde x n) es la lista de al menos dos números primos
-- consecutivos a partir del número primo n cuya suma es x, si existen y
-- la lista vacía en caso contrario. Por ejemplo,
--    sumaDesde 15 3  ==  [3,5,7]
--    sumaDesde  7 3  ==  []
sumaDesde :: Integer -> Integer -> [Integer]
sumaDesde x n | x == y    = take (1 + length us) ys
              | otherwise = []
    where ys       = dropWhile (<n) primes
          (us,y:_) = span (<x) (scanl1 (+) ys)

import Data.Numbers.Primes (primes)

import Data.List (span)

sumas :: Integer -> [[Integer]]

sumas x = [ys | n <- takeWhile (< x) primes,

let ys = sumaDesde x n,

not (null ys)]

-- (sumaDesde x n) es la lista de al menos dos números primos

-- consecutivos a partir del número primo n cuya suma es x, si existen y

-- la lista vacía en caso contrario. Por ejemplo,

-- sumaDesde 15 3 == [3,5,7]

-- sumaDesde 7 3 == []

sumaDesde :: Integer -> Integer -> [Integer]

sumaDesde x n | x == y = take (1 + length us) ys

| otherwise = []

where ys = dropWhile (<n) primes

(us,y:_) = span (<x) (scanl1 (+) ys)

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Referencias

Soluciones

Referencias

Soluciones

Referencias

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones en Maxima

Soluciones

Solución en Maxima

Soluciones

Referencias

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Referencias

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Entradas recientes

Buscar

Correo electrónico