José A. Alonso

Sumas parciales de Juzuk

PorJosé A. Alonso 23-enero-201830-enero-2018

En 1939 Dov Juzuk extendió el método de Nicómaco del cálculo de los cubos. La extensión se basaba en los siguientes pasos:

se comienza con la lista de todos los enteros positivos

     [1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, ...

1	[1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, ...

se agrupan tomando el primer elemento, los dos siguientes, los tres
siguientes, etc.

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

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

se seleccionan los elementos en posiciones pares

     [[1],         [4, 5, 6],                [11, 12, 13, 14, 15], ...

1	[[1], [4, 5, 6], [11, 12, 13, 14, 15], ...

se suman los elementos de cada grupo

     [1,           15,                       65,                   ...

1	[1, 15, 65, ...

se calculan las sumas acumuladas

     [1,           16,                       81,                   ...

1	[1, 16, 81, ...

Las sumas obtenidas son las cuantas potencias de los números enteros positivos.

Definir las funciones

   listasParcialesJuzuk :: [a] -> [[a]]
   sumasParcialesJuzuk  :: [Integer] -> [Integer]

1 2	listasParcialesJuzuk :: [a] -> [[a]] sumasParcialesJuzuk :: [Integer] -> [Integer]

tal que

(listasParcialesJuzuk xs) es lalista de ls listas parciales de Juzuk; es decir, la selección de los elementos en posiciones pares de la agrupación de los elementos de xs tomando el primer elemento, los dos siguientes, los tres siguientes, etc. Por ejemplo,

     λ> take 4 (listasParcialesJuzuk [1..])
     [[1],[4,5,6],[11,12,13,14,15],[22,23,24,25,26,27,28]]
     λ> take 4 (listasParcialesJuzuk [1,3..])
     [[1],[7,9,11],[21,23,25,27,29],[43,45,47,49,51,53,55]]

λ> take 4 (listasParcialesJuzuk [1..])

[[1],[4,5,6],[11,12,13,14,15],[22,23,24,25,26,27,28]]

λ> take 4 (listasParcialesJuzuk [1,3..])

[[1],[7,9,11],[21,23,25,27,29],[43,45,47,49,51,53,55]]

(sumasParcialesJuzuk xs) es la lista de las sumas acumuladas de los elementos de las listas de Juzuk generadas por xs. Por ejemplo,

     take 4 (sumasParcialesJuzuk [1..])  ==  [1,16,81,256]
     take 4 (sumasParcialesJuzuk [1,3..])  ==  [1,28,153,496]

1 2	take 4 (sumasParcialesJuzuk [1..]) == [1,16,81,256] take 4 (sumasParcialesJuzuk [1,3..]) == [1,28,153,496]

Comprobar con QuickChek que, para todo entero positivo n,

el elemento de (sumasParcialesJuzuk [1..]) en la posición (n-1) es n^4.
el elemento de (sumasParcialesJuzuk [1,3..]) en la posición (n-1) es n^2*(2*n^2 - 1).
el elemento de (sumasParcialesJuzuk [1,5..]) en la posición (n-1) es 4*n^4-3*n^2.
el elemento de (sumasParcialesJuzuk [2,3..]) en la posición (n-1) es n^2*(n^2+1).

Soluciones

import Data.List (genericIndex)
import Test.QuickCheck

listasParcialesJuzuk :: [a] -> [[a]]
listasParcialesJuzuk = elementosEnPares . listasParciales

-- (listasParciales xs) es la agrupación de los elementos de xs obtenida
-- tomando el primer elemento, los dos siguientes, los tres siguientes,
-- etc. Por ejemplo, 
--    λ> take 5 (listasParciales [1..])
--    [[1],[2,3],[4,5,6],[7,8,9,10],[11,12,13,14,15]]
listasParciales :: [a] -> [[a]]
listasParciales = aux 1
  where aux n xs = ys : aux (n+1) zs  
          where (ys,zs) = splitAt n xs

-- (elementosEnPares xs) es la lista de los elementos de xs en
-- posiciones pares. Por ejemplo,
--    λ> elementosEnPares [[1],[2,3],[4,5,6],[7,8,9,10],[11,12,13,14,15]]
--    [[1],[4,5,6],[11,12,13,14,15]]
elementosEnPares :: [a] -> [a]
elementosEnPares []       = []
elementosEnPares [x]      = [x]
elementosEnPares (x:_:xs) = x : elementosEnPares xs

sumasParcialesJuzuk :: [Integer] -> [Integer]
sumasParcialesJuzuk xs =
  scanl1 (+) (map sum (listasParcialesJuzuk xs))

-- La primera propiedad es
prop_sumasParcialesJuzuk :: (Positive Integer) -> Bool
prop_sumasParcialesJuzuk (Positive n) =
  sumasParcialesJuzuk [1..] `genericIndex` (n-1) == n^4

-- Su comprobación es
--    λ> quickCheck prop_sumasParcialesJuzuk
--    +++ OK, passed 100 tests.

-- La segunda propiedad es
prop_sumasParcialesJuzuk2 :: (Positive Integer) -> Bool
prop_sumasParcialesJuzuk2 (Positive n) =
  sumasParcialesJuzuk [1,3..] `genericIndex` (n-1) == n^2*(2*n^2 - 1)

-- Su comprobación es
--    λ> quickCheck prop_sumasParcialesJuzuk2
--    +++ OK, passed 100 tests.

-- La tercera propiedad es
prop_sumasParcialesJuzuk3 :: (Positive Integer) -> Bool
prop_sumasParcialesJuzuk3 (Positive n) =
  sumasParcialesJuzuk [1,5..] `genericIndex` (n-1) == 4*n^4-3*n^2

-- Su comprobación es
--    λ> quickCheck prop_sumasParcialesJuzuk3
--    +++ OK, passed 100 tests.

-- La cuarta propiedad es
prop_sumasParcialesJuzuk4 :: (Positive Integer) -> Bool
prop_sumasParcialesJuzuk4 (Positive n) =
  sumasParcialesJuzuk [2,3..] `genericIndex` (n-1) == n^2*(n^2+1)
  
-- Su comprobación es
--    λ> quickCheck prop_sumasParcialesJuzuk4
--    +++ OK, passed 100 tests.

import Data.List (genericIndex)

import Test.QuickCheck

listasParcialesJuzuk :: [a] -> [[a]]

listasParcialesJuzuk = elementosEnPares . listasParciales

-- (listasParciales xs) es la agrupación de los elementos de xs obtenida

-- tomando el primer elemento, los dos siguientes, los tres siguientes,

-- etc. Por ejemplo,

-- λ> take 5 (listasParciales [1..])

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

listasParciales :: [a] -> [[a]]

listasParciales = aux 1

where aux n xs = ys : aux (n+1) zs

where (ys,zs) = splitAt n xs

-- (elementosEnPares xs) es la lista de los elementos de xs en

-- posiciones pares. Por ejemplo,

-- λ> elementosEnPares [[1],[2,3],[4,5,6],[7,8,9,10],[11,12,13,14,15]]

-- [[1],[4,5,6],[11,12,13,14,15]]

elementosEnPares :: [a] -> [a]

elementosEnPares [] = []

elementosEnPares [x] = [x]

elementosEnPares (x:_:xs) = x : elementosEnPares xs

sumasParcialesJuzuk :: [Integer] -> [Integer]

sumasParcialesJuzuk xs =

scanl1 (+) (map sum (listasParcialesJuzuk xs))

-- La primera propiedad es

prop_sumasParcialesJuzuk :: (Positive Integer) -> Bool

prop_sumasParcialesJuzuk (Positive n) =

sumasParcialesJuzuk [1..] `genericIndex` (n-1) == n^4

-- Su comprobación es

-- λ> quickCheck prop_sumasParcialesJuzuk

-- +++ OK, passed 100 tests.

-- La segunda propiedad es

prop_sumasParcialesJuzuk2 :: (Positive Integer) -> Bool

prop_sumasParcialesJuzuk2 (Positive n) =

sumasParcialesJuzuk [1,3..] `genericIndex` (n-1) == n^2*(2*n^2 - 1)

-- Su comprobación es

-- λ> quickCheck prop_sumasParcialesJuzuk2

-- +++ OK, passed 100 tests.

-- La tercera propiedad es

prop_sumasParcialesJuzuk3 :: (Positive Integer) -> Bool

prop_sumasParcialesJuzuk3 (Positive n) =

sumasParcialesJuzuk [1,5..] `genericIndex` (n-1) == 4*n^4-3*n^2

-- Su comprobación es

-- λ> quickCheck prop_sumasParcialesJuzuk3

-- +++ OK, passed 100 tests.

-- La cuarta propiedad es

prop_sumasParcialesJuzuk4 :: (Positive Integer) -> Bool

prop_sumasParcialesJuzuk4 (Positive n) =

sumasParcialesJuzuk [2,3..] `genericIndex` (n-1) == n^2*(n^2+1)

-- Su comprobación es

-- λ> quickCheck prop_sumasParcialesJuzuk4

-- +++ OK, passed 100 tests.

Complemento potencial

PorJosé A. Alonso 22-enero-201829-enero-2018

El complemento potencial de un número entero positivo x es el menor número y tal que el producto de x por y es un una potencia perfecta. Por ejemplo,

el complemento potencial de 12 es 3 ya que 12 y 24 no son potencias perfectas pero 36 sí lo es;
el complemento potencial de 54 es 4 ya que 54, 108 y 162 no son potencias perfectas pero 216 = 6^3 sí lo es.

Definir las funciones

   complemento                 :: Integer -> Integer
   graficaComplementoPotencial :: Integer -> IO ()

1 2	complemento :: Integer -> Integer graficaComplementoPotencial :: Integer -> IO ()

tales que

(complemento x) es el complemento potencial de x; por ejemplo,

     complemento 12     ==  3
     complemento 54     ==  4
     complemento 720    ==  5
     complemento 24000  ==  9
     complemento 2018   ==  2018

complemento 12 == 3

complemento 54 == 4

complemento 720 == 5

complemento 24000 == 9

complemento 2018 == 2018

(graficaComplementoPotencial n) dibuja la gráfica de los complementos potenciales de los n primeros números enteros positivos. Por ejemplo, (graficaComplementoPotencial 100) dibuja

y (graficaComplementoPotencial 500) dibuja

Comprobar con QuickCheck que (complemento x) es menor o igual que x.

Soluciones

import Data.Numbers.Primes     (primeFactors)
import Data.List               (genericLength, group)
import Graphics.Gnuplot.Simple (plotList, Attribute (Key, PNG, Title))
import Test.QuickCheck

complemento :: Integer -> Integer
complemento 1 = 1
complemento x =
  head [y | y <- [1..]
          , esPotenciaPerfecta (x*y)]
  
-- (esPotenciaPerfecta x) se verifica si x es una potencia perfecta. Por
-- ejemplo, 
--    esPotenciaPerfecta 36  ==  True
--    esPotenciaPerfecta 72  ==  False
esPotenciaPerfecta :: Integer -> Bool
esPotenciaPerfecta x = mcd (exponentes x) > 1

-- (exponentes x) es la lista de los exponentes de la factorización prima
-- de x. Por ejemplos,
--    exponentes 36  ==  [2,2]
--    exponentes 72  ==  [3,2]
exponentes :: Integer -> [Integer]
exponentes = map snd . factorizacion
  
-- (factorizacion n) es la factorizacion prima de n. Por ejemplo,
--    factorizacion 1400  ==  [(2,3),(5,2),(7,1)]
factorizacion :: Integer -> [(Integer,Integer)]
factorizacion n =
  [(x,genericLength xs) | xs@(x:_) <- group (primeFactors n)]

-- (mcd xs) es el máximo común divisor de la lista xs. Por ejemplo,
--    mcd [4,6,10]  ==  2
--    mcd [4,5,10]  ==  1
mcd :: [Integer] -> Integer
mcd = foldl1 gcd

-- La propiedad es
prop_complemento :: (Positive Integer) -> Bool
prop_complemento (Positive x) =
  complemento x <= x

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

graficaComplementoPotencial :: Integer -> IO ()
graficaComplementoPotencial n =
  plotList [Key Nothing
           , PNG ("Complemento_potencial_"  ++ show n ++ ".png")
           , Title ("(graficaComplementoPotencial " ++ show n ++ ")") 
           ]
           (map complemento [1..n])

import Data.Numbers.Primes (primeFactors)

import Data.List (genericLength, group)

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

import Test.QuickCheck

complemento :: Integer -> Integer

complemento 1 = 1

complemento x =

head [y | y <- [1..]

, esPotenciaPerfecta (x*y)]

-- (esPotenciaPerfecta x) se verifica si x es una potencia perfecta. Por

-- ejemplo,

-- esPotenciaPerfecta 36 == True

-- esPotenciaPerfecta 72 == False

esPotenciaPerfecta :: Integer -> Bool

esPotenciaPerfecta x = mcd (exponentes x) > 1

-- (exponentes x) es la lista de los exponentes de la factorización prima

-- de x. Por ejemplos,

-- exponentes 36 == [2,2]

-- exponentes 72 == [3,2]

exponentes :: Integer -> [Integer]

exponentes = map snd . factorizacion

-- (factorizacion n) es la factorizacion prima de n. Por ejemplo,

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

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

factorizacion n =

[(x,genericLength xs) | xs@(x:_) <- group (primeFactors n)]

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

-- mcd [4,6,10] == 2

-- mcd [4,5,10] == 1

mcd :: [Integer] -> Integer

mcd = foldl1 gcd

-- La propiedad es

prop_complemento :: (Positive Integer) -> Bool

prop_complemento (Positive x) =

complemento x <= x

-- La comprobación es

-- λ> quickCheck prop_complemento

-- +++ OK, passed 100 tests.

graficaComplementoPotencial :: Integer -> IO ()

graficaComplementoPotencial n =

plotList [Key Nothing

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

, Title ("(graficaComplementoPotencial " ++ show n ++ ")")

]

(map complemento [1..n])

Terna pitagórica a partir de un lado

PorJosé A. Alonso 19-enero-201819-febrero-2018

Una terna pitagórica con primer lado x es una terna (x,y,z) tal que x^2 + y^2 = z^2. Por ejemplo, las ternas pitagóricas con primer lado 16 son (16,12,20), (16,30,34) y (16,63,65).

Definir las funciones

   ternasPitagoricas      :: Integer -> [(Integer,Integer,Integer)]
   mayorTernaPitagorica   :: Integer -> (Integer,Integer,Integer)
   graficaMayorHipotenusa :: Integer -> IO ()

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

mayorTernaPitagorica :: Integer -> (Integer,Integer,Integer)

graficaMayorHipotenusa :: Integer -> IO ()

tales que

(ternasPitgoricas x) es la lista de las ternas pitagóricas con primer lado x. Por ejemplo,

     ternasPitagoricas 16 == [(16,12,20),(16,30,34),(16,63,65)]
     ternasPitagoricas 20 == [(20,15,25),(20,21,29),(20,48,52),(20,99,101)]
     ternasPitagoricas 25 == [(25,60,65),(25,312,313)]
     ternasPitagoricas 26 == [(26,168,170)]

ternasPitagoricas 16 == [(16,12,20),(16,30,34),(16,63,65)]

ternasPitagoricas 20 == [(20,15,25),(20,21,29),(20,48,52),(20,99,101)]

ternasPitagoricas 25 == [(25,60,65),(25,312,313)]

ternasPitagoricas 26 == [(26,168,170)]

(mayorTernaPitagorica x) es la mayor de las ternas pitagóricas con primer lado x. Por ejemplo,

     mayorTernaPitagorica 16     ==  (16,63,65)
     mayorTernaPitagorica 20     ==  (20,99,101)
     mayorTernaPitagorica 25     ==  (25,312,313)
     mayorTernaPitagorica 26     ==  (26,168,170)
     mayorTernaPitagorica 2018   ==  (2018,1018080,1018082)
     mayorTernaPitagorica 2019   ==  (2019,2038180,2038181)

mayorTernaPitagorica 16 == (16,63,65)

mayorTernaPitagorica 20 == (20,99,101)

mayorTernaPitagorica 25 == (25,312,313)

mayorTernaPitagorica 26 == (26,168,170)

mayorTernaPitagorica 2018 == (2018,1018080,1018082)

mayorTernaPitagorica 2019 == (2019,2038180,2038181)

(graficaMayorHipotenusa n) dibuja la gráfica de las sucesión de las mayores hipotenusas de las ternas pitagóricas con primer lado x, para x entre 3 y n. Por ejemplo, (graficaMayorHipotenusa 100) dibuja

Soluciones

import Graphics.Gnuplot.Simple

-- Definición de ternasPitagoricas
-- ===============================

ternasPitagoricas :: Integer -> [(Integer,Integer,Integer)]
ternasPitagoricas x =
  [(x,y,z) | y <- [1..(x^ 2 - 1) `div` 2 ]
           , z <- raizCuadrada (x^2 + y^2)]

-- La justificación de la cota es
--    x > 2
--    x^2 + y^2 >= (y+1)^2
--    x^2 + y^2 >= y^2 + 2*y + 1
--    y =< (x^ 2 - 1) `div` 2 

-- (raizCuadrada x) es la lista formada por la raíz cuadrada entera de
-- x, si existe y la lista vacía, en caso contrario. Por ejemplo, 
--    raizCuadrada 25  ==  [5]
--    raizCuadrada 26  ==  []
raizCuadrada :: Integer -> [Integer]
raizCuadrada x =
  [y | y <- [(round . sqrt . fromIntegral) x]
     , y^2 == x]


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

mayorTernaPitagorica :: Integer -> (Integer,Integer,Integer)
mayorTernaPitagorica =
  last . ternasPitagoricas

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

mayorTernaPitagorica2 :: Integer -> (Integer,Integer,Integer)
mayorTernaPitagorica2 x =
  head [(x,y,z) | y <- [k, k-1 .. 1]
                , z <- raizCuadrada (x^2 + y^2)]
  where k = (x^2 - 1) `div` 2

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

-- Se supone que x > 2. Se consideran dos casos:
-- 
-- Primer caso: Supongamos que x es par. Entonces x^2 > 4 y es divisible
-- por 4. Por tanto, existe un y tal que x^2 = 4*y + 4; luego,
--    x^2 + y^2 = 4*y + 4 + y^2
--              = (y + 2)^2
-- La terna es (x,y,y+2) donde y = (x^2 - 4) / 4.
--
-- Segundo caso: Supongamos que x es impar. Entonces x^2 es impar. Por
-- tanto, existe un y tal que x^2 = 2*y + 1; luego,
--    x^2 + y^2 = 2*y + 1 + y^2
--              = (y+1)^2
-- La terna es (x,y,y+1) donde y = (x^2 - 1) / 2.

mayorTernaPitagorica3 :: Integer -> (Integer,Integer,Integer)
mayorTernaPitagorica3 x
  | even x    = (x, y1, y1 + 2)
  | otherwise = (x, y2, y2 + 1)
    where y1 = (x^2 - 4) `div` 4
          y2 = (x^2 - 1) `div` 2 

-- Comparación de eficiencia
--    λ> mayorTernaPitagorica 1006
--    (1006,253008,253010)
--    (7.36 secs, 1,407,793,992 bytes)
--    λ> mayorTernaPitagorica2 1006
--    (1006,253008,253010)
--    (3.76 secs, 704,007,456 bytes)
--    λ> mayorTernaPitagorica3 1006
--    (1006,253008,253010)
--    (0.01 secs, 157,328 bytes)

graficaMayorHipotenusa :: Integer -> IO ()
graficaMayorHipotenusa n =
  plotList [ Key Nothing
           , PNG "Terna_pitagorica_a_partir_de_un_lado.png"
           ]
           [(x,z) | x <- [3..n]
                  , let (_,_,z) = mayorTernaPitagorica3 x]

import Graphics.Gnuplot.Simple

-- Definición de ternasPitagoricas

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

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

ternasPitagoricas x =

[(x,y,z) | y <- [1..(x^ 2 - 1) `div` 2 ]

, z <- raizCuadrada (x^2 + y^2)]

-- La justificación de la cota es

-- x > 2

-- x^2 + y^2 >= (y+1)^2

-- x^2 + y^2 >= y^2 + 2*y + 1

-- y =< (x^ 2 - 1) `div` 2

-- (raizCuadrada x) es la lista formada por la raíz cuadrada entera de

-- x, si existe y la lista vacía, en caso contrario. Por ejemplo,

-- raizCuadrada 25 == [5]

-- raizCuadrada 26 == []

raizCuadrada :: Integer -> [Integer]

raizCuadrada x =

[y | y <- [(round . sqrt . fromIntegral) x]

, y^2 == x]

-- 1ª definición de mayorTernaPitagorica

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

mayorTernaPitagorica :: Integer -> (Integer,Integer,Integer)

mayorTernaPitagorica =

last . ternasPitagoricas

-- 2ª definición de mayorTernaPitagorica

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

mayorTernaPitagorica2 :: Integer -> (Integer,Integer,Integer)

mayorTernaPitagorica2 x =

head [(x,y,z) | y <- [k, k-1 .. 1]

, z <- raizCuadrada (x^2 + y^2)]

where k = (x^2 - 1) `div` 2

-- 3ª definición de mayorTernaPitagorica

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

-- Se supone que x > 2. Se consideran dos casos:

-- Primer caso: Supongamos que x es par. Entonces x^2 > 4 y es divisible

-- por 4. Por tanto, existe un y tal que x^2 = 4*y + 4; luego,

-- x^2 + y^2 = 4*y + 4 + y^2

-- = (y + 2)^2

-- La terna es (x,y,y+2) donde y = (x^2 - 4) / 4.

-- Segundo caso: Supongamos que x es impar. Entonces x^2 es impar. Por

-- tanto, existe un y tal que x^2 = 2*y + 1; luego,

-- x^2 + y^2 = 2*y + 1 + y^2

-- = (y+1)^2

-- La terna es (x,y,y+1) donde y = (x^2 - 1) / 2.

mayorTernaPitagorica3 :: Integer -> (Integer,Integer,Integer)

mayorTernaPitagorica3 x

| even x = (x, y1, y1 + 2)

| otherwise = (x, y2, y2 + 1)

where y1 = (x^2 - 4) `div` 4

y2 = (x^2 - 1) `div` 2

-- Comparación de eficiencia

-- λ> mayorTernaPitagorica 1006

-- (1006,253008,253010)

-- (7.36 secs, 1,407,793,992 bytes)

-- λ> mayorTernaPitagorica2 1006

-- (1006,253008,253010)

-- (3.76 secs, 704,007,456 bytes)

-- λ> mayorTernaPitagorica3 1006

-- (1006,253008,253010)

-- (0.01 secs, 157,328 bytes)

graficaMayorHipotenusa :: Integer -> IO ()

graficaMayorHipotenusa n =

plotList [ Key Nothing

, PNG "Terna_pitagorica_a_partir_de_un_lado.png"

]

[(x,z) | x <- [3..n]

, let (_,_,z) = mayorTernaPitagorica3 x]

Escalada hasta un primo

PorJosé A. Alonso 18-enero-201819-febrero-2018

Este ejercicio está basado en el artículo La conjetura de la «escalada hasta un primo» publicado esta semana por Miguel Ángel Morales en su blog Gaussianos.

La conjetura de escalada hasta un primo trata, propuesta por John Horton Conway, es sencilla de plantear, pero primero vamos a ver qué es eso de escalar hasta un primo. Tomamos un número cualquiera y lo descomponemos en factores primos (colocados en orden ascendente). Si el número era primo, ya hemos acabado; si no era primo, construimos el número formado por los factores primos y los exponentes de los mismos colocados tal cual salen en la factorización. Con el número obtenido hacemos lo mismo que antes. La escalada finaliza cuando obtengamos un número primo. Por ejemplo, para obtener la escalada prima de 1400, como no es primo, se factoriza (obteniéndose 2^3 * 5^2 * 7) y se unen bases y exponentes (obteniéndose 23527). Con el 23527 se repite el proceso obteniéndose la factorización (7 * 3361) y su unión (73361). Como el 73361 es primo, termina la escalada. Por tanto, la escalada de 1400 es [1400,23527,73361].

La conjetura de Conway sobre «escalada hasta un primo» dice que todo número natural mayor o igual que 2 termina su escalada en un número primo.

Definir las funciones

   escaladaPrima                :: Integer -> [Integer]
   longitudEscaladaPrima        :: Integer -> Integer
   longitudEscaladaPrimaAcotada :: Integer -> Integer -> Integer
   graficaEscalada              :: Integer -> Integer -> IO ()

escaladaPrima :: Integer -> [Integer]

longitudEscaladaPrima :: Integer -> Integer

longitudEscaladaPrimaAcotada :: Integer -> Integer -> Integer

graficaEscalada :: Integer -> Integer -> IO ()

tales que

(escaladaPrima n) es la escalada prima de n. Por ejemplo,

     λ> escaladaPrima 1400
     [1400,23527,73361]
     λ> escaladaPrima 333
     [333,3237,31383,3211317,3217139151,39722974813]
     λ> take 10 (escaladaPrima 20)
     [20,225,3252,223271,297699,399233,715623,3263907,32347303,160720129]
     λ> take 3 (escaladaPrima 13532385396179)
     [13532385396179,13532385396179,13532385396179]
     λ> take 2 (escaladaPrima 45214884853168941713016664887087462487)
     [45214884853168941713016664887087462487,13532385396179]

λ> escaladaPrima 1400

[1400,23527,73361]

λ> escaladaPrima 333

[333,3237,31383,3211317,3217139151,39722974813]

λ> take 10 (escaladaPrima 20)

[20,225,3252,223271,297699,399233,715623,3263907,32347303,160720129]

λ> take 3 (escaladaPrima 13532385396179)

[13532385396179,13532385396179,13532385396179]

λ> take 2 (escaladaPrima 45214884853168941713016664887087462487)

[45214884853168941713016664887087462487,13532385396179]

(longitudEscaladaPrima n) es la longitud de la escalada prima de n. Por ejemplo,

     longitudEscaladaPrima 1400  ==  3
     longitudEscaladaPrima 333   ==  6

1 2	longitudEscaladaPrima 1400 == 3 longitudEscaladaPrima 333 == 6

(longitudEscaladaPrimaAcotada n k) es el mínimo entre la longitud de la escalada prima de n y k. Por ejemplo,

     longitudEscaladaPrimaAcotada 333 10  ==  6
     longitudEscaladaPrimaAcotada 333 4   ==  4
     longitudEscaladaPrimaAcotada 20 4    ==  4

longitudEscaladaPrimaAcotada 333 10 == 6

longitudEscaladaPrimaAcotada 333 4 == 4

longitudEscaladaPrimaAcotada 20 4 == 4

(graficaEscalada n k) dibuja la gráfica de (longitudEscaladaPrimaAcotada x k) para x entre 2 y n. Por ejemplo, (graficaEscalada 120 15) dibuja

Soluciones

import Data.List (genericLength, group)
import Data.Numbers.Primes
import Graphics.Gnuplot.Simple

-- Definición de escaladaPrima 
escaladaPrima :: Integer -> [Integer]
escaladaPrima n
  | isPrime n = [n]
  | otherwise = n : escaladaPrima (siguiente n)

-- (siguiente n) es el siguiente de n en la escalada hacia un primo. Por
-- ejemplo, 
--    siguiente 1400  ==  23527
siguiente :: Integer -> Integer
siguiente = paresAnumero . factorizacion

-- (factorizacion n) es la factorizacion prima de n. Por ejemplo,
--    factorizacion 1400  ==  [(2,3),(5,2),(7,1)]
factorizacion :: Integer -> [(Integer,Integer)]
factorizacion n =
  [(x,genericLength xs) | xs@(x:_) <- group (primeFactors n)]

-- (paAnumero p) es el número obtenido pegando las dos componentes de p
-- (si la segunda es mayor que 1) o sólo la primera componente, en caso
-- contrario. Por ejemplo, 
--    parAnumero (7,1)  ==  7
--    parAnumero (23,5)  ==  235
parAnumero :: (Integer,Integer) -> Integer
parAnumero (n,1) = n
parAnumero (n,k) = read (show n ++ show k)

-- (paresA numeros ps) es el número obtenido aplicando parAnumero a cada
-- uno de los pares de ps. Por ejemplo,
--    paresAnumero [(2,3),(5,2),(7,1)]  ==  23527
paresAnumero :: [(Integer,Integer)] -> Integer
paresAnumero = read . concatMap (show . parAnumero)

-- Definición de longitudEscaladaPrima
longitudEscaladaPrima :: Integer -> Integer
longitudEscaladaPrima n
  | isPrime n = 1
  | otherwise = 1 + longitudEscaladaPrima (siguiente n)

-- Definición de longitudEscaladaPrimaAcotada
longitudEscaladaPrimaAcotada :: Integer -> Integer -> Integer
longitudEscaladaPrimaAcotada _ 0 = 0
longitudEscaladaPrimaAcotada n k
  | isPrime n = 1
  | otherwise = 1 + longitudEscaladaPrimaAcotada (siguiente n) (k-1)

-- Definición de graficaEscalada 
graficaEscalada :: Integer -> Integer -> IO ()
graficaEscalada n k =
  plotList [ Key Nothing
           , PNG "Escalada_hasta_un_primo.png"
           , Title ("graficaEscalada " ++ show n ++ " " ++ show k)
           , XLabel "Numeros"
           , YLabel "Longitud de escalada"
           ]
           [(x,longitudEscaladaPrimaAcotada x k) | x <- [2..n]]

import Data.List (genericLength, group)

import Data.Numbers.Primes

import Graphics.Gnuplot.Simple

-- Definición de escaladaPrima

escaladaPrima :: Integer -> [Integer]

escaladaPrima n

| isPrime n = [n]

| otherwise = n : escaladaPrima (siguiente n)

-- (siguiente n) es el siguiente de n en la escalada hacia un primo. Por

-- ejemplo,

-- siguiente 1400 == 23527

siguiente :: Integer -> Integer

siguiente = paresAnumero . factorizacion

-- (factorizacion n) es la factorizacion prima de n. Por ejemplo,

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

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

factorizacion n =

[(x,genericLength xs) | xs@(x:_) <- group (primeFactors n)]

-- (paAnumero p) es el número obtenido pegando las dos componentes de p

-- (si la segunda es mayor que 1) o sólo la primera componente, en caso

-- contrario. Por ejemplo,

-- parAnumero (7,1) == 7

-- parAnumero (23,5) == 235

parAnumero :: (Integer,Integer) -> Integer

parAnumero (n,1) = n

parAnumero (n,k) = read (show n ++ show k)

-- (paresA numeros ps) es el número obtenido aplicando parAnumero a cada

-- uno de los pares de ps. Por ejemplo,

-- paresAnumero [(2,3),(5,2),(7,1)] == 23527

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

paresAnumero = read . concatMap (show . parAnumero)

-- Definición de longitudEscaladaPrima

longitudEscaladaPrima :: Integer -> Integer

longitudEscaladaPrima n

| isPrime n = 1

| otherwise = 1 + longitudEscaladaPrima (siguiente n)

-- Definición de longitudEscaladaPrimaAcotada

longitudEscaladaPrimaAcotada :: Integer -> Integer -> Integer

longitudEscaladaPrimaAcotada _ 0 = 0

longitudEscaladaPrimaAcotada n k

| isPrime n = 1

| otherwise = 1 + longitudEscaladaPrimaAcotada (siguiente n) (k-1)

-- Definición de graficaEscalada

graficaEscalada :: Integer -> Integer -> IO ()

graficaEscalada n k =

plotList [ Key Nothing

, PNG "Escalada_hasta_un_primo.png"

, Title ("graficaEscalada " ++ show n ++ " " ++ show k)

, XLabel "Numeros"

, YLabel "Longitud de escalada"

]

[(x,longitudEscaladaPrimaAcotada x k) | x <- [2..n]]

Números como diferencias de potencias

PorJosé A. Alonso 17-enero-201819-febrero-2018

El número 45 se puede escribir de tres formas como diferencia de los cuadrados de dos números naturales:

   45 =  7^2 -  2^2 
      =  9^2 -  6^2
      = 23^2 - 22^2

45 = 7^2 - 2^2

= 9^2 - 6^2

= 23^2 - 22^2

Definir la función

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

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

tal que (diferencias x n) es la lista de pares tales que la diferencia de sus potencias n-ésima es x. Por ejemplo,

   diferencias 45 2    ==  [(7,2),(9,6),(23,22)]
   diferencias 50 2    ==  []
   diferencias 19 3    ==  [(3,2)]
   diferencias 8 3     ==  [(2,0)]
   diferencias 15 4    ==  [(2,1)]
   diferencias 4035 2  ==  [(142,127),(406,401),(674,671),(2018,2017)]
   head (diferencias 1161480105172255454401 5)  ==  (123456,123455)

diferencias 45 2 == [(7,2),(9,6),(23,22)]

diferencias 50 2 == []

diferencias 19 3 == [(3,2)]

diferencias 8 3 == [(2,0)]

diferencias 15 4 == [(2,1)]

diferencias 4035 2 == [(142,127),(406,401),(674,671),(2018,2017)]

head (diferencias 1161480105172255454401 5) == (123456,123455)

Soluciones

-- 1ª definición
diferencias :: Integer -> Integer -> [(Integer,Integer)]
diferencias x n = [(a,b) | b <- [0..x]
                         , a <- [b..x]
                         , x == a^n - b^n]

-- 2ª definición
diferencias2 :: Integer -> Integer -> [(Integer,Integer)]
diferencias2 x n =
  [(a,b) | a <- [1..x]
         , a^n >= x
         , let b = round ((fromIntegral (a^n - x)) ** (1/fromIntegral n))
         , x == a^n - b^n]

-- 3ª definición
diferencias3 :: Integer -> Integer -> [(Integer,Integer)]
diferencias3 x n =
  [(a,b) | a <- [0..x]
         , a^n >= x
         , b <- raizEntera n (a^n - x)]

raizEntera :: Integer -> Integer -> [Integer]
raizEntera n x 
  | y^n == x  = [y]
  | otherwise = []
  where y = head [k | k <- [0..], k^n >= x] 

-- 4ª definición
diferencias4 :: Integer -> Integer -> [(Integer,Integer)]
diferencias4 x n =
  [(a,b) | a <- [0..x]
         , a^n >= x
         , b <- raizEntera n (a^n - x)]
  where potencias = [(k,k^n) | k <- [0..]]
        raizEntera n x 
          | yn == x   = [y]
          | otherwise = []
          where (y,yn) = head [(k,kn) | (k,kn) <- potencias, kn >= x]

-- Comparación de eficiencia
--    λ> head (diferencias 7351 3)
--    (50,49)
--    (2.16 secs, 533,868,368 bytes)
--    λ> head (diferencias2 7351 3)
--    (50,49)
--    (0.01 secs, 270,040 bytes)
--    λ> head (diferencias3 7351 3)
--    (50,49)
--    (0.01 secs, 1,021,720 bytes)
--    λ> head (diferencias4 7351 3)
--    (50,49)
--    (0.01 secs, 316,536 bytes)

-- 1ª definición

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

diferencias x n = [(a,b) | b <- [0..x]

, a <- [b..x]

, x == a^n - b^n]

-- 2ª definición

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

diferencias2 x n =

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

, a^n >= x

, let b = round ((fromIntegral (a^n - x)) ** (1/fromIntegral n))

, x == a^n - b^n]

-- 3ª definición

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

diferencias3 x n =

[(a,b) | a <- [0..x]

, a^n >= x

, b <- raizEntera n (a^n - x)]

raizEntera :: Integer -> Integer -> [Integer]

raizEntera n x

| y^n == x = [y]

| otherwise = []

where y = head [k | k <- [0..], k^n >= x]

-- 4ª definición

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

diferencias4 x n =

[(a,b) | a <- [0..x]

, a^n >= x

, b <- raizEntera n (a^n - x)]

where potencias = [(k,k^n) | k <- [0..]]

raizEntera n x

| yn == x = [y]

| otherwise = []

where (y,yn) = head [(k,kn) | (k,kn) <- potencias, kn >= x]

-- Comparación de eficiencia

-- λ> head (diferencias 7351 3)

-- (50,49)

-- (2.16 secs, 533,868,368 bytes)

-- λ> head (diferencias2 7351 3)

-- (50,49)

-- (0.01 secs, 270,040 bytes)

-- λ> head (diferencias3 7351 3)

-- (50,49)

-- (0.01 secs, 1,021,720 bytes)

-- λ> head (diferencias4 7351 3)

-- (50,49)

-- (0.01 secs, 316,536 bytes)

Fractal hexagonal

PorJosé A. Alonso 16-enero-201819-febrero-2018

Escribir, usando CodeWorld, un programa para dibujar el fractal hexagonal que se muestra en la siguiente animación

Las 4 primeras fases de la animación son

Fase 0:
Fase 1:
Fase 2:
Fase 3:

Nota: Este ejercicio ha sido propuesto por Agustín Martín Aguera.

Soluciones

import CodeWorld

main :: IO()
main = animationOf (hexagono . s)

hexagono :: Int -> Picture
hexagono 0 =
  colored red $ solidPolygon [(9,0),(4.5,c),(-4.5,c),(-9,0),(-4.5,-c),(4.5,-c)]
  where c = 9 * sin (pi / 3)
hexagono n =
  pictures (hex : take 6 (iterate (rotated (pi / 3)) (translated 6 0 hex)))
  where hex = scaled (1/3) (1/3) $ hexagono (n-1)

s :: Double -> Int
s t = mod (floor t) 5

import CodeWorld

main :: IO()

main = animationOf (hexagono . s)

hexagono :: Int -> Picture

hexagono 0 =

colored red $ solidPolygon [(9,0),(4.5,c),(-4.5,c),(-9,0),(-4.5,-c),(4.5,-c)]

where c = 9 * sin (pi / 3)

hexagono n =

pictures (hex : take 6 (iterate (rotated (pi / 3)) (translated 6 0 hex)))

where hex = scaled (1/3) (1/3) $ hexagono (n-1)

s :: Double -> Int

s t = mod (floor t) 5

Sumas parciales de Nicómaco

PorJosé A. Alonso 15-enero-201825-marzo-2022

Nicómaco de Gerasa vivió en Palestina entre los siglos I y II de nuestra era. Escribió Arithmetike eisagoge (Introducción a la aritmética) que es el primer trabajo en donde se trata la Aritmética de forma separada a la Geometría. En el tratado se encuentra la siguiente proposición: «si se escriben los números impares

   1, 3, 5, 7, 9, 11, 13, 15, 17, ...

1	1, 3, 5, 7, 9, 11, 13, 15, 17, ...

entonces el primero es el cubo de 1; la suma de los dos siguientes, el cubo de 2; la suma de los tres siguientes, el cubo de 3; y así sucesivamente.»

Definir las siguientes funciones

   listasParciales :: [a] -> [[a]]
   sumasParciales  :: [Int] -> [Int]

1 2	listasParciales :: [a] -> [[a]] sumasParciales :: [Int] -> [Int]

tales que

(listasParciales xs) es la lista obtenido agrupando los elementos de la lista infinita xs de forma que la primera tiene 0 elementos; la segunda, el primer elemento de xs; la tercera, los dos siguientes; y así sucesivamente. Por ejemplo,

     λ> take 7 (listasParciales [1..])
     [[],[1],[2,3],[4,5,6],[7,8,9,10],[11,12,13,14,15],[16,17,18,19,20,21]]
     λ> take 7 (listasParciales [1,3..])
     [[],[1],[3,5],[7,9,11],[13,15,17,19],[21,23,25,27,29],[31,33,35,37,39,41]]

λ> take 7 (listasParciales [1..])

[[],[1],[2,3],[4,5,6],[7,8,9,10],[11,12,13,14,15],[16,17,18,19,20,21]]

λ> take 7 (listasParciales [1,3..])

[[],[1],[3,5],[7,9,11],[13,15,17,19],[21,23,25,27,29],[31,33,35,37,39,41]]

(sumasParciales xs) es la lista de las sumas parciales de la lista infinita xs. Por ejemplo,

     λ> take 15 (sumasParciales [1..])
     [0,1,5,15,34,65,111,175,260,369,505,671,870,1105,1379]
     λ> take 15 (sumasParciales [1,3..])
     [0,1,8,27,64,125,216,343,512,729,1000,1331,1728,2197,2744]

λ> take 15 (sumasParciales [1..])

[0,1,5,15,34,65,111,175,260,369,505,671,870,1105,1379]

λ> take 15 (sumasParciales [1,3..])

[0,1,8,27,64,125,216,343,512,729,1000,1331,1728,2197,2744]

Comprobar con QuickChek la propiedad de Nicómaco; es decir, que para todo número natural n, el término n-ésimo de (sumasParciales [1,3..]) es el cubo de n.

Soluciones

import Test.QuickCheck

listasParciales :: [a] -> [[a]]
listasParciales = aux 0
  where aux n xs = ys : aux (n+1) zs  
          where (ys,zs) = splitAt n xs

sumasParciales :: [Int] -> [Int]
sumasParciales = map sum . listasParciales

prop_Nicomaco :: (Positive Int) -> Bool
prop_Nicomaco (Positive n) =
  sumasParciales [1,3..] !! n == n^3

import Test.QuickCheck

listasParciales :: [a] -> [[a]]

listasParciales = aux 0

where aux n xs = ys : aux (n+1) zs

where (ys,zs) = splitAt n xs

sumasParciales :: [Int] -> [Int]

sumasParciales = map sum . listasParciales

prop_Nicomaco :: (Positive Int) -> Bool

prop_Nicomaco (Positive n) =

sumasParciales [1,3..] !! n == n^3

Números malvados y odiosos

PorJosé A. Alonso 12-enero-201825-abril-2021

Un número malvado es un número natural cuya expresión en base 2 (binaria) contiene un número par de unos.

Un número odioso es un número natural cuya expresión en base 2 (binaria) contiene un número impar de unos.

Podemos representar los números malvados y odiosos mediante el siguiente tipo de dato

  data MalvadoOdioso = Malvado | Odioso deriving Show

1	data MalvadoOdioso = Malvado \| Odioso deriving Show

Definir la función

  malvadoOdioso :: Integer -> MalvadoOdioso

1	malvadoOdioso :: Integer -> MalvadoOdioso

tal que (malvadoOdioso n) devuelve el tipo de número que es n. Por ejemplo,

   λ> malvadoOdioso 11
   Odioso
   λ> malvadoOdioso 12
   Malvado
   λ> malvadoOdioso3 (10^20000000)
   Odioso
   λ> malvadoOdioso3 (1+10^20000000)
   Malvado

λ> malvadoOdioso 11

Odioso

λ> malvadoOdioso 12

Malvado

λ> malvadoOdioso3 (10^20000000)

Odioso

λ> malvadoOdioso3 (1+10^20000000)

Malvado

Nota: Este ejercicio ha sido propuesto por Ángel Ruiz Campos.

Soluciones

import Data.List (genericLength)
import Data.Bits (popCount)

data MalvadoOdioso = Malvado | Odioso
  deriving (Eq, Show)

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

malvadoOdioso :: Integer -> MalvadoOdioso
malvadoOdioso n | (even . numeroUnosBin) n = Malvado
                | otherwise                = Odioso

-- (numeroUnosBin n) es el número de unos de la representación binaria
-- del número decimal n. Por ejemplo,
--   numeroUnosBin 11  ==  3
--   numeroUnosBin 12  ==  2
numeroUnosBin :: Integer -> Integer
numeroUnosBin = genericLength . filter (/= 0) . intBin

-- (intBin n) es el número binario correspondiente al número decimal n.
-- Por ejemplo, 
--   intBin 11  ==  [1,1,0,1]
--   intBin 12  ==  [0,0,1,1]
intBin :: Integer -> [Integer]
intBin n | n < 2     = [n]
         | otherwise = n `mod` 2 : intBin (n `div` 2)

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

malvadoOdioso2 :: Integer -> MalvadoOdioso
malvadoOdioso2 n | (even . numeroIntBin) n = Malvado
                 | otherwise               = Odioso

-- (numeroIntBin n) es el número de unos que contiene la representación
-- binaria del número decimal n. Por ejemplo,
--   numeroIntBin 11  ==  3
--   numeroIntBin 12  ==  2
numeroIntBin :: Integer -> Integer
numeroIntBin n | n < 2     = n
               | otherwise = n `mod` 2 + numeroIntBin (n `div` 2)

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

malvadoOdioso3 :: Integer -> MalvadoOdioso
malvadoOdioso3 n | (even . popCount) n = Malvado
                 | otherwise           = Odioso

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

--   λ> malvadoOdioso (10^40000)
--   Odioso
--   (3.25 secs, 1,167,416,968 bytes)
--   λ> malvadoOdioso2 (10^40000)
--   Odioso
--   (4.03 secs, 1,164,863,744 bytes)
--   λ> malvadoOdioso3 (10^40000)
--   Odioso
--   (0.00 secs, 165,312 bytes)

import Data.List (genericLength)

import Data.Bits (popCount)

data MalvadoOdioso = Malvado | Odioso

deriving (Eq, Show)

-- 1ª solución

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

malvadoOdioso :: Integer -> MalvadoOdioso

malvadoOdioso n | (even . numeroUnosBin) n = Malvado

| otherwise = Odioso

-- (numeroUnosBin n) es el número de unos de la representación binaria

-- del número decimal n. Por ejemplo,

-- numeroUnosBin 11 == 3

-- numeroUnosBin 12 == 2

numeroUnosBin :: Integer -> Integer

numeroUnosBin = genericLength . filter (/= 0) . intBin

-- (intBin n) es el número binario correspondiente al número decimal n.

-- Por ejemplo,

-- intBin 11 == [1,1,0,1]

-- intBin 12 == [0,0,1,1]

intBin :: Integer -> [Integer]

intBin n | n < 2 = [n]

| otherwise = n `mod` 2 : intBin (n `div` 2)

-- 2ª solución

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

malvadoOdioso2 :: Integer -> MalvadoOdioso

malvadoOdioso2 n | (even . numeroIntBin) n = Malvado

| otherwise = Odioso

-- (numeroIntBin n) es el número de unos que contiene la representación

-- binaria del número decimal n. Por ejemplo,

-- numeroIntBin 11 == 3

-- numeroIntBin 12 == 2

numeroIntBin :: Integer -> Integer

numeroIntBin n | n < 2 = n

| otherwise = n `mod` 2 + numeroIntBin (n `div` 2)

-- 3ª solución

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

malvadoOdioso3 :: Integer -> MalvadoOdioso

malvadoOdioso3 n | (even . popCount) n = Malvado

| otherwise = Odioso

-- Comparación de eficiencia

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

-- λ> malvadoOdioso (10^40000)

-- Odioso

-- (3.25 secs, 1,167,416,968 bytes)

-- λ> malvadoOdioso2 (10^40000)

-- Odioso

-- (4.03 secs, 1,164,863,744 bytes)

-- λ> malvadoOdioso3 (10^40000)

-- Odioso

-- (0.00 secs, 165,312 bytes)

Ordenación por frecuencia

PorJosé A. Alonso 11-enero-201819-febrero-2018

Definir la función

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

1	ordPorFrecuencia :: Ord a => [a] -> [a]

tal que (ordPorFrecuencia xs) es la lista obtenidas ordenando los elementos de xs por su frecuencia, de los que aparecen más a los que aparecen menos, y los que aparecen el mismo número de veces se ordenan de manera creciente según su valor. Por ejemplo,

   ordPorFrecuencia "canalDePanama"      ==  "aaaaannmlecPD"
   ordPorFrecuencia "11012018"           ==  "11110082"
   ordPorFrecuencia [2,3,5,3,7,9,5,3,7]  ==  [3,3,3,7,7,5,5,9,2]

ordPorFrecuencia "canalDePanama" == "aaaaannmlecPD"

ordPorFrecuencia "11012018" == "11110082"

ordPorFrecuencia [2,3,5,3,7,9,5,3,7] == [3,3,3,7,7,5,5,9,2]

Soluciones

import Test.QuickCheck

import Data.List (group, sort, sortBy)
import Data.Function (on)

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

ordPorFrecuencia1 :: Ord a => [a] -> [a]
ordPorFrecuencia1 xs =
  concatMap snd (reverse (sort [(length xs,xs) | xs <- group (sort xs)]))

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

ordPorFrecuencia2 :: Ord a => [a] -> [a]
ordPorFrecuencia2 =
    concat . reverse . sortBy comparaPorLongitud . group . sort

comparaPorLongitud :: [a] -> [a] -> Ordering
comparaPorLongitud xs ys = compare (length xs) (length ys)

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

ordPorFrecuencia3 :: Ord a => [a] -> [a]
ordPorFrecuencia3 =
    concat . reverse . sortBy (compare `on` length). group . sort

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

--    λ> xs = show (2^2000000)
--    λ> last (ordPorFrecuencia1 xs)
--    '8'
--    (1.45 secs, 938,345,320 bytes)
--    λ> last (ordPorFrecuencia2 xs)
--    '8'
--    (1.33 secs, 900,239,200 bytes)
--    λ> last (ordPorFrecuencia3 xs)
--    '8'
--    (1.30 secs, 900,241,848 bytes)

import Test.QuickCheck

import Data.List (group, sort, sortBy)

import Data.Function (on)

-- 1ª solución

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

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

ordPorFrecuencia1 xs =

concatMap snd (reverse (sort [(length xs,xs) | xs <- group (sort xs)]))

-- 2ª solución

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

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

ordPorFrecuencia2 =

concat . reverse . sortBy comparaPorLongitud . group . sort

comparaPorLongitud :: [a] -> [a] -> Ordering

comparaPorLongitud xs ys = compare (length xs) (length ys)

-- 3ª solución

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

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

ordPorFrecuencia3 =

concat . reverse . sortBy (compare `on` length). group . sort

-- Comparación de eficiencia

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

-- λ> xs = show (2^2000000)

-- λ> last (ordPorFrecuencia1 xs)

-- '8'

-- (1.45 secs, 938,345,320 bytes)

-- λ> last (ordPorFrecuencia2 xs)

-- '8'

-- (1.33 secs, 900,239,200 bytes)

-- λ> last (ordPorFrecuencia3 xs)

-- '8'

-- (1.30 secs, 900,241,848 bytes)

Números somirp

PorJosé A. Alonso 10-enero-201819-febrero-2018

Un número omirp es un número primo que forma un primo distinto al invertir el orden de sus dígitos.

Definir las funciones

  esOmirp            :: Integer -> Bool
  omirps             :: [Integer]
  nOmirpsIntermedios :: Int -> Int

esOmirp :: Integer -> Bool

omirps :: [Integer]

nOmirpsIntermedios :: Int -> Int

tales que

(esOmirp n) se verifica si n es un número omirp. Por ejemplo,

     esOmirp 13      ==  True
     esOmirp 11      ==  False
     esOmirp 112207  ==  True

esOmirp 13 == True

esOmirp 11 == False

esOmirp 112207 == True

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

     take 15 omirps  ==  [13,17,31,37,71,73,79,97,107,113]
     omirps !! 2000  ==  112207

1 2	take 15 omirps == [13,17,31,37,71,73,79,97,107,113] omirps !! 2000 == 112207

(nOmirpsIntermedios n) es la cantidad de números omirps entre el n-ésimo número omirp y el obtenido al invertir el orden de sus dígitos. Por ejemplo,

     nOmirpsIntermedios 2000  ==  4750

1	nOmirpsIntermedios 2000 == 4750

Nota: Este ejercicio ha sido propuesto por Ángel Ruiz Campos.

Soluciones

import Data.Numbers.Primes (isPrime,primes)

esOmirp :: Integer -> Bool
esOmirp n = n /= rn && isPrime rn
  where rn = read . reverse . show $ n

omirps :: [Integer]
omirps = filter esOmirp primes

nOmirpsIntermedios :: Int -> Int
nOmirpsIntermedios n =
  length
  . filter esOmirp
  . takeWhile (< rx)
  . dropWhile (<= x) $ primes
  where x  = omirps !! n
        rx = read . reverse . show $ x

import Data.Numbers.Primes (isPrime,primes)

esOmirp :: Integer -> Bool

esOmirp n = n /= rn && isPrime rn

where rn = read . reverse . show $ n

omirps :: [Integer]

omirps = filter esOmirp primes

nOmirpsIntermedios :: Int -> Int

nOmirpsIntermedios n =

length

. filter esOmirp

. takeWhile (< rx)

. dropWhile (<= x) $ primes

where x = omirps !! n

rx = read . reverse . show $ x

Autor: José A. Alonso

Sumas parciales de Juzuk

Soluciones

Terna pitagórica a partir de un lado

Soluciones

Números como diferencias de potencias

Soluciones

Fractal hexagonal

Soluciones

Sumas parciales de Nicómaco

Soluciones

Números malvados y odiosos

Soluciones

Números somirp

Soluciones

Entradas recientes

Buscar

Correo electrónico