head

Cadena de primos

PorJosé A. Alonso 23-enero-201730-enero-2017

La lista de los primeros números primos es

   [2,3,5,7,11,13,17,19,23,29,31,37,41,43,47,53,59,61,67,71]

1	[2,3,5,7,11,13,17,19,23,29,31,37,41,43,47,53,59,61,67,71]

Los primeros elementos de la cadena obtenida concatenado los números primos es

   "23571113171923293137414347535961677173798389971011"

1	"23571113171923293137414347535961677173798389971011"

Definir la función

   primoEnPosicion :: Int -> Integer

1	primoEnPosicion :: Int -> Integer

tal que (primoEnPosicion n) es el número primo que tiene algún dígito en la posición n de la cadena obtenida concatenado los números primos. Por ejemplo,

   primoEnPosicion 0       ==  2
   primoEnPosicion 1       ==  3
   primoEnPosicion 4       ==  11
   primoEnPosicion 5       ==  11
   primoEnPosicion 6       ==  13
   primoEnPosicion 1022    ==  2011
   primoEnPosicion 1023    ==  2017
   primoEnPosicion 1026    ==  2017
   primoEnPosicion 1027    ==  2027
   primoEnPosicion (10^7)  ==  21242357

primoEnPosicion 0 == 2

primoEnPosicion 1 == 3

primoEnPosicion 4 == 11

primoEnPosicion 5 == 11

primoEnPosicion 6 == 13

primoEnPosicion 1022 == 2011

primoEnPosicion 1023 == 2017

primoEnPosicion 1026 == 2017

primoEnPosicion 1027 == 2027

primoEnPosicion (10^7) == 21242357

Soluciones

import Data.Numbers.Primes
import Test.QuickCheck

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

primoEnPosicion :: Int -> Integer
primoEnPosicion = aux primes
  where aux (x:xs) n | m > n     = x
                     | otherwise = aux xs (n-m)
          where m = length (show x)


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

primoEnPosicion2 :: Int -> Integer
primoEnPosicion2 n = p
  where (p,_) = head $ dropWhile (\(x,k) -> k < n) primosYfinales

-- primosYfinales es la sucesión de los pares de los números primos y
-- las posiciones de sus dígitos finales en la sucesión de la
-- concatenación de primos. Por ejemplo, 
--    λ> take 10 primosYfinales
--    [(2,0),(3,1),(5,2),(7,3),(11,5),(13,7),(17,9),(19,11),(23,13),(29,15)]
primosYfinales :: [(Integer, Int)]
primosYfinales = scanl f (2,0) (tail primes)
  where f (p,k) q = (q, k + length (show q))

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

-- La propiedad es
prop_equivalencia (Positive n) =
  primoEnPosicion n == primoEnPosicion2 n

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

import Data.Numbers.Primes

import Test.QuickCheck

-- 1ª definición

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

primoEnPosicion :: Int -> Integer

primoEnPosicion = aux primes

where aux (x:xs) n | m > n = x

| otherwise = aux xs (n-m)

where m = length (show x)

-- 2ª definición

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

primoEnPosicion2 :: Int -> Integer

primoEnPosicion2 n = p

where (p,_) = head $ dropWhile (\(x,k) -> k < n) primosYfinales

-- primosYfinales es la sucesión de los pares de los números primos y

-- las posiciones de sus dígitos finales en la sucesión de la

-- concatenación de primos. Por ejemplo,

-- λ> take 10 primosYfinales

-- [(2,0),(3,1),(5,2),(7,3),(11,5),(13,7),(17,9),(19,11),(23,13),(29,15)]

primosYfinales :: [(Integer, Int)]

primosYfinales = scanl f (2,0) (tail primes)

where f (p,k) q = (q, k + length (show q))

-- Comprobación de equivalencia

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

-- La propiedad es

prop_equivalencia (Positive n) =

primoEnPosicion n == primoEnPosicion2 n

-- La comprobación es

-- λ> quickCheck prop_equivalencia

-- +++ OK, passed 100 tests.

Notación polaca inversa

PorJosé A. Alonso 20-enero-201727-enero-2017

La notación polaca inversa (en inglés, Reverse Polish Notation, o RPN), es una forma alternativa de escribir expresiones matemáticas. Por ejemplo, la expresión "20 - (4 + 3) * 2" en RPN es "20 4 3 + 2 * -".

Para evaluar una expresión en RPN, usamos una lista auxiliar (inicialmente vacía) y recorremos la expresión de izquierda a derecha. Cada vez que encontramos un número, lo añadimos a la lista auxiliar. Cuando encontramos un operador, retiramos los dos números que hay al principio de la pila, utilizamos el operador con ellos y los quitamos de la lista y le añadimos el resultado. Cuando alcancemos el final de la expresión, debemos tener un solo número en la lista auxiliar si la expresión estaba bien formada, y éste representa el resultado de la expresión. Por ejemplo, la evaluación de RPN "20 4 3 + 2 * -" es la siguiente

   ""                 []
   "20"               [20]
   "20 4"             [4, 20]
   "20 4 3"           [3, 4, 20]
   "20 4 3 +"         [7, 20]
   "20 4 3 + 2"       [2, 7, 20]
   "20 4 3 + 2 *"     [14, 20]
   "20 4 3 + 2 * -"   [6]

"" []

"20" [20]

"20 4" [4, 20]

"20 4 3" [3, 4, 20]

"20 4 3 +" [7, 20]

"20 4 3 + 2" [2, 7, 20]

"20 4 3 + 2 *" [14, 20]

"20 4 3 + 2 * -" [6]

Definir la función

   valor :: String -> Float

1	valor :: String -> Float

tal que (valor cs) es el valor de la expresión RPN cs. Por ejemplo,

   valor "4"               ==  4.0
   valor "4 3 +"           ==  7.0
   valor "4 3 + 2 *"       ==  14.0
   valor "20 4 3 + 2 * -"  ==  6.0
   valor "3 7 + 2 /"       ==  5.0

valor "4" == 4.0

valor "4 3 +" == 7.0

valor "4 3 + 2 *" == 14.0

valor "20 4 3 + 2 * -" == 6.0

valor "3 7 + 2 /" == 5.0

Soluciones

valor :: String -> Float
valor = head . foldl aux [] . words
  where aux (x:y:ys) "+" = (x + y) : ys
        aux (x:y:ys) "-" = (y - x) : ys
        aux (x:y:ys) "*" = (x * y) : ys
        aux (x:y:ys) "/" = (y / x) : ys
        aux xs cs        = read cs : xs

valor :: String -> Float

valor = head . foldl aux [] . words

where aux (x:y:ys) "+" = (x + y) : ys

aux (x:y:ys) "-" = (y - x) : ys

aux (x:y:ys) "*" = (x * y) : ys

aux (x:y:ys) "/" = (y / x) : ys

aux xs cs = read cs : xs

Día de la semana

PorJosé A. Alonso 21-diciembre-201628-diciembre-2016

Definir la función

   dia :: Int -> Int -> Int -> String

1	dia :: Int -> Int -> Int -> String

tal que (dia d m a) es el día de la semana correspondiente al día d del mes m del año a. Por ejemplo,

   dia 21 12 2016  ==  "Miercoles"
   dia 14  4 1936  ==  "Martes"

1 2	dia 21 12 2016 == "Miercoles" dia 14 4 1936 == "Martes"

Nota: Este ejercicio ha sido propuesto por Miguel Ibáñez.

Soluciones

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

-- Comentario: usar que el 1-1-2007 cayó en lunes

dSem :: [(String,Int)]
dSem = [("Lunes",0),("Martes",1),("Miercoles",2),("Jueves",3),
        ("Viernes",4),("Sabado",5),("Domingo",6)]

dMes :: [(Int,Int)]
dMes = [(1,31),(2,28),(3,31),( 4,30),( 5,31),( 6,30),
        (7,31),(8,31),(9,30),(10,31),(11,30),(12,31)]

busca :: a -> [(a1,a2)] -> (a -> a1 -> Bool) -> [(a1,a2)]
busca x xs p  =  [(x',y) | (x',y) <- xs, p x x']

diaAno :: (Int,Int,Int) -> Int
diaAno (d,m,a)  =  d + sum [y | (x,y) <- busca m dMes (>)]

dia :: Int -> Int -> Int -> String
dia d m a = head [fst (x,y') | (x,y') <- dSem, n == y']
  where  n = mod ((diaAno (d,m,a) + (a - 2007)*365) + x) 7
         x | d <= 29 && m <= 2  =  div (a - 2007) 4 - 1
           | otherwise          =  div (a - 2007) 4


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

-- Usando la congruencia de Zeller http://bit.ly/2gYxHym

dia2 :: Int -> Int -> Int -> String
dia2 d m a = diasSemana !! h
  where m1 = if   (m < 3)
             then m + 12
             else m

        a1 = if   (m1 > 12)
             then a - 1
             else a

        k  = a1 `mod` 100
        j  = a1 `div` 100

        h  = ( d
             + ((13 * (m1 + 1)) `div` 5)
             + k
             + (k `div` 4)
             + (j `div` 4)
             - (2 * j)
             ) `mod` 7

diasSemana :: [String]
diasSemana = [ "Sabado" 
             , "Domingo"
             , "Lunes" 
             , "Martes"
             , "Miercoles"
             , "Jueves"
             , "Viernes"]

-- 1ª solución

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

-- Comentario: usar que el 1-1-2007 cayó en lunes

dSem :: [(String,Int)]

dSem = [("Lunes",0),("Martes",1),("Miercoles",2),("Jueves",3),

("Viernes",4),("Sabado",5),("Domingo",6)]

dMes :: [(Int,Int)]

dMes = [(1,31),(2,28),(3,31),( 4,30),( 5,31),( 6,30),

(7,31),(8,31),(9,30),(10,31),(11,30),(12,31)]

busca :: a -> [(a1,a2)] -> (a -> a1 -> Bool) -> [(a1,a2)]

busca x xs p = [(x',y) | (x',y) <- xs, p x x']

diaAno :: (Int,Int,Int) -> Int

diaAno (d,m,a) = d + sum [y | (x,y) <- busca m dMes (>)]

dia :: Int -> Int -> Int -> String

dia d m a = head [fst (x,y') | (x,y') <- dSem, n == y']

where n = mod ((diaAno (d,m,a) + (a - 2007)*365) + x) 7

x | d <= 29 && m <= 2 = div (a - 2007) 4 - 1

| otherwise = div (a - 2007) 4

-- 2ª solución

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

-- Usando la congruencia de Zeller http://bit.ly/2gYxHym

dia2 :: Int -> Int -> Int -> String

dia2 d m a = diasSemana !! h

where m1 = if (m < 3)

then m + 12

else m

a1 = if (m1 > 12)

then a - 1

else a

k = a1 `mod` 100

j = a1 `div` 100

h = ( d

+ ((13 * (m1 + 1)) `div` 5)

+ k

+ (k `div` 4)

+ (j `div` 4)

- (2 * j)

) `mod` 7

diasSemana :: [String]

diasSemana = [ "Sabado"

, "Domingo"

, "Lunes"

, "Martes"

, "Miercoles"

, "Jueves"

, "Viernes"]

Listas engarzadas

PorJosé A. Alonso 5-diciembre-201612-diciembre-2016

Una lista de listas es engarzada si el último elemento de cada lista coincide con el primero de la siguiente.

Definir la función

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

1	engarzada :: Eq a => [[a]] -> Bool

tal que (engarzada xss) se verifica si xss es una lista engarzada. Por ejemplo,

   engarzada [[1,2,3], [3,5], [5,9,0]] == True
   engarzada [[1,4,5], [5,0], [1,0]]   == False
   engarzada [[1,4,5], [], [1,0]]      == False
   engarzada [[2]]                     == True

engarzada [[1,2,3], [3,5], [5,9,0]] == True

engarzada [[1,4,5], [5,0], [1,0]] == False

engarzada [[1,4,5], [], [1,0]] == False

engarzada [[2]] == True

Soluciones

-- 1ª solución:
engarzada :: Eq a => [[a]] -> Bool
engarzada (xs:ys:xss) =
     not (null xs) && not (null ys) && last xs == head ys
  && engarzada (ys:xss)
engarzada _ = True

-- 2ª solución:
engarzada2 :: Eq a => [[a]] -> Bool
engarzada2 (xs:ys:xss) =
  and [ not (null xs)
      , not (null ys)
      , last xs == head ys
      , engarzada2 (ys:xss) ]
engarzada2 _ = True

-- 3ª solución:
engarzada3 :: Eq a => [[a]] -> Bool
engarzada3 xss =
  and [ not (null xs) && not (null ys) && last xs == head ys
      | (xs,ys) <- zip xss (tail xss)]

-- 4ª solución:
engarzada4 :: Eq a => [[a]] -> Bool
engarzada4 xss =
  all engarzados (zip xss (tail xss))
  where engarzados (xs,ys) =
          not (null xs) && not (null ys) && last xs == head ys

-- 5ª solución:
engarzada5 :: Eq a => [[a]] -> Bool
engarzada5 xss =
  all engarzados (zip xss (tail xss))
  where engarzados ([],_)   = False
        engarzados (_,[])   = False
        engarzados (xs,y:_) = last xs == y

-- 6ª solución:
engarzada6 :: Eq a => [[a]] -> Bool
engarzada6 xss =
  and (zipWith engarzados xss (tail xss))
  where engarzados [] _     = False
        engarzados _  []    = False
        engarzados xs (y:_) = last xs == y

-- 1ª solución:

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

engarzada (xs:ys:xss) =

not (null xs) && not (null ys) && last xs == head ys

&& engarzada (ys:xss)

engarzada _ = True

-- 2ª solución:

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

engarzada2 (xs:ys:xss) =

and [ not (null xs)

, not (null ys)

, last xs == head ys

, engarzada2 (ys:xss) ]

engarzada2 _ = True

-- 3ª solución:

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

engarzada3 xss =

and [ not (null xs) && not (null ys) && last xs == head ys

| (xs,ys) <- zip xss (tail xss)]

-- 4ª solución:

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

engarzada4 xss =

all engarzados (zip xss (tail xss))

where engarzados (xs,ys) =

not (null xs) && not (null ys) && last xs == head ys

-- 5ª solución:

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

engarzada5 xss =

all engarzados (zip xss (tail xss))

where engarzados ([],_) = False

engarzados (_,[]) = False

engarzados (xs,y:_) = last xs == y

-- 6ª solución:

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

engarzada6 xss =

and (zipWith engarzados xss (tail xss))

where engarzados [] _ = False

engarzados _ [] = False

engarzados xs (y:_) = last xs == y

Mínimo número de operaciones para transformar un número en otro

PorJosé A. Alonso 25-noviembre-201625-marzo-2022

Se considera el siguiente par de operaciones sobre los números:

multiplicar por dos
restar uno.

Dados dos números x e y se desea calcular el menor número de operaciones para transformar x en y. Por ejemplo, el menor número de operaciones para transformar el 4 en 7 es 2:

   4 ------> 8 ------> 7
      (x2)      (-1)

1 2	4 ------> 8 ------> 7 (x2) (-1)

y el menor número de operaciones para transformar 2 en 5 es 4

   2 ------> 4 ------> 3 ------> 6 ------> 5
      (x2)      (-1)      (x2)      (-1)

1 2	2 ------> 4 ------> 3 ------> 6 ------> 5 (x2) (-1) (x2) (-1)

Definir las siguientes funciones

   arbolOp :: Int -> Int -> Arbol
   minNOp  :: Int -> Int -> Int

1 2	arbolOp :: Int -> Int -> Arbol minNOp :: Int -> Int -> Int

tales que

(arbolOp x n) es el árbol de profundidad n obtenido aplicándole a x las dos operaciones. Por ejemplo,

    λ> arbolOp 4 1
    N 4 (H 8) (H 3)
    λ> arbolOp 4 2
    N 4 (N 8 (H 16) (H 7))
        (N 3 (H 6) (H 2))
    λ> arbolOp 2 3
    N 2 (N 4
           (N 8 (H 16) (H 7))
           (N 3 (H 6) (H 2)))
        (N 1
           (N 2 (H 4) (H 1))
           (H 0))
    λ> arbolOp 2 4
    N 2 (N 4 (N 8
                (N 16 (H 32) (H 15))
                (N 7 (H 14) (H 6)))
             (N 3
                (N 6 (H 12) (H 5))
                (N 2 (H 4) (H 1))))
        (N 1 (N 2
                (N 4 (H 8) (H 3))
                (N 1 (H 2) (H 0)))
             (H 0))

λ> arbolOp 4 1

N 4 (H 8) (H 3)

λ> arbolOp 4 2

N 4 (N 8 (H 16) (H 7))

(N 3 (H 6) (H 2))

λ> arbolOp 2 3

N 2 (N 4

(N 8 (H 16) (H 7))

(N 3 (H 6) (H 2)))

(N 1

(N 2 (H 4) (H 1))

(H 0))

λ> arbolOp 2 4

N 2 (N 4 (N 8

(N 16 (H 32) (H 15))

(N 7 (H 14) (H 6)))

(N 3

(N 6 (H 12) (H 5))

(N 2 (H 4) (H 1))))

(N 1 (N 2

(N 4 (H 8) (H 3))

(N 1 (H 2) (H 0)))

(H 0))

(minNOp x y) es el menor número de operaciones necesarias para transformar x en y. Por ejemplo,

     minNOp 4 7  ==  2
     minNOp 2 5  ==  4

1 2	minNOp 4 7 == 2 minNOp 2 5 == 4

Soluciones

data Arbol = H Int
           | N Int Arbol Arbol
           deriving Show

arbolOp :: Int -> Int -> Arbol
arbolOp 0 _ = H 0
arbolOp x 0 = H x
arbolOp x n = N x (arbolOp (2 * x) (n - 1)) (arbolOp (x - 1) (n - 1))

ocurre :: Int -> Arbol -> Bool
ocurre x (H y)     = x == y
ocurre x (N y i d) = x == y || ocurre x i || ocurre x d

minNOp :: Int -> Int -> Int
minNOp x y =
  head [n | n <- [0..]
          , ocurre y (arbolOp x n)]

data Arbol = H Int

| N Int Arbol Arbol

deriving Show

arbolOp :: Int -> Int -> Arbol

arbolOp 0 _ = H 0

arbolOp x 0 = H x

arbolOp x n = N x (arbolOp (2 * x) (n - 1)) (arbolOp (x - 1) (n - 1))

ocurre :: Int -> Arbol -> Bool

ocurre x (H y) = x == y

ocurre x (N y i d) = x == y || ocurre x i || ocurre x d

minNOp :: Int -> Int -> Int

minNOp x y =

head [n | n <- [0..]

, ocurre y (arbolOp x n)]

Referencias

Basado en el artículo Minimum number of operation required to
convert number x into y de Vipin Khushu en
GeeksforGeeks.

Números consecutivos compuestos

PorJosé A. Alonso 22-noviembre-201629-noviembre-2016

Una serie compuesta de longitud n es una lista de n números consecutivos que son todos compuestos. Por ejemplo, [8,9,10] y [24,25,26] son dos series compuestas de longitud 3.

Cada serie compuesta se puede representar por el par formado por su primer y último elemento. Por ejemplo, las dos series anteriores se pueden representar pos (8,10) y (24,26) respectivamente.

Definir la función

   menorSerieCompuesta :: Integer -> (Integer,Integer)

1	menorSerieCompuesta :: Integer -> (Integer,Integer)

tal que (menorSerieCompuesta n) es la menor serie compuesta (es decir, la que tiene menores elementos) de longitud 3. Por ejemplo,

   menorSerieCompuesta 3    ==  (8,10)
   menorSerieCompuesta 4    ==  (24,27)
   menorSerieCompuesta 5    ==  (24,28)
   menorSerieCompuesta 150  ==  (4652354,4652503)

menorSerieCompuesta 3 == (8,10)

menorSerieCompuesta 4 == (24,27)

menorSerieCompuesta 5 == (24,28)

menorSerieCompuesta 150 == (4652354,4652503)

Comprobar con QuickCheck que para n > 1, el primer elemento de (menorSerieCompuesta n) es igual al primero de (menorSerieCompuesta (n-1)) o al primero de (menorSerieCompuesta (n+1)).

Soluciones

import Data.Numbers.Primes
import Test.QuickCheck

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

menorSerieCompuesta1 :: Integer -> (Integer,Integer)
menorSerieCompuesta1 n = (x,x+n-1)
  where x = head [y | y <- [1..]
                    , esCompuesta [y..y+n-1]]

esCompuesta :: [Integer] -> Bool
esCompuesta xs =  all (not . isPrime) xs

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

menorSerieCompuesta2 :: Integer -> (Integer,Integer)
menorSerieCompuesta2 n = (x+1,x+n)
  where (x,y) = head [(p,q) | (p,q) <- zip primes (tail primes)
                            , q - p >= n + 1]

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

--    λ> menorSerieCompuesta1 75
--    (155922,155996)
--    (12.16 secs, 30,378,380,552 bytes)
--    λ> menorSerieCompuesta2 75
--    (155922,155996)
--    (0.07 secs, 89,813,752 bytes)


-- Comprobación de la propiedad
-- ============================

-- La propiedad es
prop_menorSerieCompuesta :: Integer -> Property
prop_menorSerieCompuesta n =
  n > 1 ==> x == y || y == z
  where [x,y,z] = map (fst . menorSerieCompuesta2) [n-1,n,n+1]

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

import Data.Numbers.Primes

import Test.QuickCheck

-- 1ª definición

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

menorSerieCompuesta1 :: Integer -> (Integer,Integer)

menorSerieCompuesta1 n = (x,x+n-1)

where x = head [y | y <- [1..]

, esCompuesta [y..y+n-1]]

esCompuesta :: [Integer] -> Bool

esCompuesta xs = all (not . isPrime) xs

-- 2ª definición

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

menorSerieCompuesta2 :: Integer -> (Integer,Integer)

menorSerieCompuesta2 n = (x+1,x+n)

where (x,y) = head [(p,q) | (p,q) <- zip primes (tail primes)

, q - p >= n + 1]

-- Comparación de eficiencia

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

-- λ> menorSerieCompuesta1 75

-- (155922,155996)

-- (12.16 secs, 30,378,380,552 bytes)

-- λ> menorSerieCompuesta2 75

-- (155922,155996)

-- (0.07 secs, 89,813,752 bytes)

-- Comprobación de la propiedad

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

-- La propiedad es

prop_menorSerieCompuesta :: Integer -> Property

prop_menorSerieCompuesta n =

n > 1 ==> x == y || y == z

where [x,y,z] = map (fst . menorSerieCompuesta2) [n-1,n,n+1]

-- La comprobación es

-- λ> quickCheck prop_menorSerieCompuesta

-- +++ OK, passed 100 tests.

Referencias

Sucesión A030296 de la OEIS.

Máximo producto en la partición de un número

PorJosé A. Alonso 16-noviembre-201623-noviembre-2016

El artículo de esta semana de Antonio Roldán en su blog Números y hoja de cálculo es Máximo producto en la partición de un número (1)

Una partición de un entero positivo n es una forma de descomponer n como suma de enteros positivos. Dos sumas se considerarán iguales si solo difieren en el orden de los sumandos. Por ejemplo, las 11 particiones de 6 (con sus correspondientes productos) son

   6 = 6                      |  6                     = 6
   6 = 5 + 1                  |  5 x 1                 = 5
   6 = 4 + 2                  |  4 x 2                 = 8
   6 = 4 + 1 + 1              |  4 x 1 x 1             = 4
   6 = 3 + 3                  |  3 x 3                 = 9
   6 = 3 + 2 + 1              |  3 x 2 x 1             = 6
   6 = 3 + 1 + 1 + 1          |  3 x 1 x 1 x 1         = 3
   6 = 2 + 2 + 2              |  2 x 2 x 2             = 8
   6 = 2 + 2 + 1 + 1          |  2 x 2 x 1 x 1         = 4
   6 = 2 + 1 + 1 + 1 + 1      |  2 x 1 x 1 x 1 x 1     = 2
   6 = 1 + 1 + 1 + 1 + 1 + 1  |  1 x 1 x 1 x 1 x 1 x 1 = 1

6 = 6 | 6 = 6

6 = 5 + 1 | 5 x 1 = 5

6 = 4 + 2 | 4 x 2 = 8

6 = 4 + 1 + 1 | 4 x 1 x 1 = 4

6 = 3 + 3 | 3 x 3 = 9

6 = 3 + 2 + 1 | 3 x 2 x 1 = 6

6 = 3 + 1 + 1 + 1 | 3 x 1 x 1 x 1 = 3

6 = 2 + 2 + 2 | 2 x 2 x 2 = 8

6 = 2 + 2 + 1 + 1 | 2 x 2 x 1 x 1 = 4

6 = 2 + 1 + 1 + 1 + 1 | 2 x 1 x 1 x 1 x 1 = 2

6 = 1 + 1 + 1 + 1 + 1 + 1 | 1 x 1 x 1 x 1 x 1 x 1 = 1

Se observa que el máximo producto de las particiones de 6 es 9.

Definir la función

   maximoProductoParticiones :: Int -> Int

1	maximoProductoParticiones :: Int -> Int

tal que (maximoProductoParticiones n) es el máximo de los productos de las particiones de n. Por ejemplo,

   maximoProductoParticiones 4     ==  4
   maximoProductoParticiones 5     ==  6
   maximoProductoParticiones 6     ==  9
   maximoProductoParticiones 7     ==  12
   maximoProductoParticiones 8     ==  18
   maximoProductoParticiones 9     ==  27
   maximoProductoParticiones 50    ==  86093442
   maximoProductoParticiones 100   ==  7412080755407364
   maximoProductoParticiones 200   ==  61806308765265224723841283607058
   length (show (maximoProductoParticiones (10^7)))  ==  1590405

maximoProductoParticiones 4 == 4

maximoProductoParticiones 5 == 6

maximoProductoParticiones 6 == 9

maximoProductoParticiones 7 == 12

maximoProductoParticiones 8 == 18

maximoProductoParticiones 9 == 27

maximoProductoParticiones 50 == 86093442

maximoProductoParticiones 100 == 7412080755407364

maximoProductoParticiones 200 == 61806308765265224723841283607058

length (show (maximoProductoParticiones (10^7))) == 1590405

Comprobar con QuickChek que los únicos posibles factores de (maximoProductoParticiones n) son 2 y 3.

Soluciones

import Data.List (genericIndex, sort)
import Data.Numbers.Primes (primeFactors)
import Test.QuickCheck

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

maximoProductoParticiones1 :: Integer -> Integer
maximoProductoParticiones1 n =
  maximum [product xs | xs <- particiones1 n]

-- (particiones1 n) es la lista de las particiones de n. Por ejemplo,  
--    λ> particiones1 4
--    [[4],[3,1],[2,2],[2,1,1],[1,1,1,1]]
--    λ> particiones1 5
--    [[5],[4,1],[3,2],[3,1,1],[2,2,1],[2,1,1,1],[1,1,1,1,1]]
particiones1 :: Integer -> [[Integer]]
particiones1 0 = [[]]
particiones1 n = [x:y | x <- [n,n-1..1]
                      , y <- particiones1 (n-x) 
                      , [x] >= take 1 y]
 
-- 2ª definición
-- =============

maximoProductoParticiones2 :: Integer -> Integer
maximoProductoParticiones2 n =
  maximum [product xs | xs <- particiones2 n]

-- (particiones2 n) es la lista de las particiones de n. Por ejemplo,  
--    λ> particiones2 4
--    [[4],[3,1],[2,2],[2,1,1],[1,1,1,1]]
--    λ> particiones2 5
--    [[5],[4,1],[3,2],[3,1,1],[2,2,1],[2,1,1,1],[1,1,1,1,1]]
particiones2 :: Integer -> [[Integer]]
particiones2 n = aux `genericIndex` n
  where aux = [] : map particiones [1..]
          where particiones n = [n] : [x:p | x <- [n,n-1..1]
                                           , p <- aux `genericIndex` (n-x) 
                                           , x >= head p]

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

maximoProductoParticiones3 :: Integer -> Integer
maximoProductoParticiones3 0 = 1
maximoProductoParticiones3 n =
  maximum [(n-i) * maximoProductoParticiones3 i | i <- [0..n-1]]

-- 4ª definición
-- =============

maximoProductoParticiones4 :: Integer -> Integer
maximoProductoParticiones4 n =
  maximosProductosParticiones `genericIndex` n

maximosProductosParticiones :: [Integer]
maximosProductosParticiones = 1 : f [1]
  where f xs = y : f (y:xs)
          where y = maximum (zipWith (*) [1..] xs)

-- 5ª definición
-- =============

maximoProductoParticiones5 :: Integer -> Integer
maximoProductoParticiones5 1 = 1
maximoProductoParticiones5 n
  | r == 0 = 3^q
  | r == 1 = 4 * 3^(q-1)
  | r == 2 = 2 * 3 ^q
  where (q,r) = quotRem n 3
        
-- Comparación de eficiencia                                        
-- =========================

-- La comparación es
--    λ> maximoProductoParticiones1 20
--    1458
--    (5.42 secs, 832,283,184 bytes)
--    λ> maximoProductoParticiones2 20
--    1458
--    (0.02 secs, 0 bytes)
--    λ> maximoProductoParticiones3 20
--    1458
--    (3.18 secs, 524,500,000 bytes)
--    λ> maximoProductoParticiones4 20
--    1458
--    (0.00 secs, 0 bytes)
--    
--    λ> maximoProductoParticiones2 50
--    86093442
--    (9.18 secs, 980,524,320 bytes)
--    λ> maximoProductoParticiones4 50
--    86093442
--    (0.01 secs, 1,381,192 bytes)
--    λ> maximoProductoParticiones5 50
--    86093442
--    (0.00 secs, 0 bytes)
--    
--    λ> length (show (maximoProductoParticiones4 2000))
--    319
--    (2.93 secs, 638,270,872 bytes)
--    λ> length (show (maximoProductoParticiones5 2000))
--    319
--    (0.01 secs, 0 bytes)

-- Comprobación
-- ============

-- La propiedad es
prop_factores :: Integer -> Property
prop_factores n =
  n > 0 ==> primeFactors (maximoProductoParticiones5 n) `contenido` [2,3]

contenido :: Eq a => [a] -> [a] -> Bool
contenido xs ys = all (`elem` ys) xs

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

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

import Data.List (genericIndex, sort)

import Data.Numbers.Primes (primeFactors)

import Test.QuickCheck

-- 1ª definición

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

maximoProductoParticiones1 :: Integer -> Integer

maximoProductoParticiones1 n =

maximum [product xs | xs <- particiones1 n]

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

-- λ> particiones1 4

-- [[4],[3,1],[2,2],[2,1,1],[1,1,1,1]]

-- λ> particiones1 5

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

particiones1 :: Integer -> [[Integer]]

particiones1 0 = [[]]

particiones1 n = [x:y | x <- [n,n-1..1]

, y <- particiones1 (n-x)

, [x] >= take 1 y]

-- 2ª definición

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

maximoProductoParticiones2 :: Integer -> Integer

maximoProductoParticiones2 n =

maximum [product xs | xs <- particiones2 n]

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

-- λ> particiones2 4

-- [[4],[3,1],[2,2],[2,1,1],[1,1,1,1]]

-- λ> particiones2 5

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

particiones2 :: Integer -> [[Integer]]

particiones2 n = aux `genericIndex` n

where aux = [] : map particiones [1..]

where particiones n = [n] : [x:p | x <- [n,n-1..1]

, p <- aux `genericIndex` (n-x)

, x >= head p]

-- 3ª definición

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

maximoProductoParticiones3 :: Integer -> Integer

maximoProductoParticiones3 0 = 1

maximoProductoParticiones3 n =

maximum [(n-i) * maximoProductoParticiones3 i | i <- [0..n-1]]

-- 4ª definición

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

maximoProductoParticiones4 :: Integer -> Integer

maximoProductoParticiones4 n =

maximosProductosParticiones `genericIndex` n

maximosProductosParticiones :: [Integer]

maximosProductosParticiones = 1 : f [1]

where f xs = y : f (y:xs)

where y = maximum (zipWith (*) [1..] xs)

-- 5ª definición

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

maximoProductoParticiones5 :: Integer -> Integer

maximoProductoParticiones5 1 = 1

maximoProductoParticiones5 n

| r == 0 = 3^q

| r == 1 = 4 * 3^(q-1)

| r == 2 = 2 * 3 ^q

where (q,r) = quotRem n 3

-- Comparación de eficiencia

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

-- La comparación es

-- λ> maximoProductoParticiones1 20

-- 1458

-- (5.42 secs, 832,283,184 bytes)

-- λ> maximoProductoParticiones2 20

-- 1458

-- (0.02 secs, 0 bytes)

-- λ> maximoProductoParticiones3 20

-- 1458

-- (3.18 secs, 524,500,000 bytes)

-- λ> maximoProductoParticiones4 20

-- 1458

-- (0.00 secs, 0 bytes)

-- λ> maximoProductoParticiones2 50

-- 86093442

-- (9.18 secs, 980,524,320 bytes)

-- λ> maximoProductoParticiones4 50

-- 86093442

-- (0.01 secs, 1,381,192 bytes)

-- λ> maximoProductoParticiones5 50

-- 86093442

-- (0.00 secs, 0 bytes)

-- λ> length (show (maximoProductoParticiones4 2000))

-- 319

-- (2.93 secs, 638,270,872 bytes)

-- λ> length (show (maximoProductoParticiones5 2000))

-- 319

-- (0.01 secs, 0 bytes)

-- Comprobación

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

-- La propiedad es

prop_factores :: Integer -> Property

prop_factores n =

n > 0 ==> primeFactors (maximoProductoParticiones5 n) `contenido` [2,3]

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

contenido xs ys = all (`elem` ys) xs

-- La comprobación es

-- λ> quickCheck prop_factores

-- +++ OK, passed 100 tests.

Referencia

Máximo producto en la partición de un número (1) de Antonio Roldán en el blog Números y hoja de cálculo.
Sucesión A000792 de la OEIS.

Persistencia multiplicativa de un número

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

La persistencia multiplicativa de un número es la cantidad de pasos requeridos para reducirlo a una cifra multiplicando sus dígitos. Por ejemplo, la persistencia de 39 es 3 porque 3×9 = 27, 2×7 = 14 y 1×4 = 4.

Definir las funciones

   persistencia     :: Integer -> Integer
   menorPersistente :: Integer -> Integer

1 2	persistencia :: Integer -> Integer menorPersistente :: Integer -> Integer

tales que

(persistencia x) es la persistencia de x. Por ejemplo,

     persistencia 39                             ==   3
     persistencia 2677889                        ==   8
     persistencia 26888999                       ==   9
     persistencia 3778888999                     ==  10
     persistencia 277777788888899                ==  11
     persistencia 77777733332222222222222222222  ==  11

persistencia 39 == 3

persistencia 2677889 == 8

persistencia 26888999 == 9

persistencia 3778888999 == 10

persistencia 277777788888899 == 11

persistencia 77777733332222222222222222222 == 11

(menorPersistente n) es el menor número con persistencia n. Por ejemplo,

     menorPersistente 0  ==  1
     menorPersistente 1  ==  10
     menorPersistente 2  ==  25
     menorPersistente 3  ==  39
     menorPersistente 4  ==  77
     menorPersistente 5  ==  679
     menorPersistente 6  ==  6788
     menorPersistente 7  ==  68889

menorPersistente 0 == 1

menorPersistente 1 == 10

menorPersistente 2 == 25

menorPersistente 3 == 39

menorPersistente 4 == 77

menorPersistente 5 == 679

menorPersistente 6 == 6788

menorPersistente 7 == 68889

Comprobar con QuickCheck si todos los números menores que 10^233 tienen una persistencia multiplicativa menor o igual que 11.

Nota: Este ejercicio ha sido propuesto por Marcos Giráldez.

Soluciones

import Test.QuickCheck

persistencia :: Integer -> Integer
persistencia x
  | x < 10    = 0
  | otherwise = 1 + persistencia (productoDigitos x)

productoDigitos :: Integer -> Integer
productoDigitos x 
  | x < 10    = x
  | otherwise = r * productoDigitos y
  where (y,r) = quotRem x 10

menorPersistente :: Integer -> Integer
menorPersistente n =
  head [x | x <- [1..]
          , persistencia x == n]

-- La propiedad es
prop_persistencia :: Integer -> Property
prop_persistencia x =
  x <= y ==> persistencia x <= 11
  where y = 10^233

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

import Test.QuickCheck

persistencia :: Integer -> Integer

persistencia x

| x < 10 = 0

| otherwise = 1 + persistencia (productoDigitos x)

productoDigitos :: Integer -> Integer

productoDigitos x

| x < 10 = x

| otherwise = r * productoDigitos y

where (y,r) = quotRem x 10

menorPersistente :: Integer -> Integer

menorPersistente n =

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

, persistencia x == n]

-- La propiedad es

prop_persistencia :: Integer -> Property

prop_persistencia x =

x <= y ==> persistencia x <= 11

where y = 10^233

-- La comprobación es

-- λ> quickCheck prop_persistencia

-- +++ OK, passed 100 tests.

Referencias

Persistencia multiplicativa y el número 77777733332222222222222222222 por M. Macho
Multiplicative persistence por Eric W. Weisstein en MathWorld.
Sucesión A003001 de la OEIS.

Números perfectos y cojonudos

PorJosé A. Alonso 11-noviembre-201618-noviembre-2016

Un número perfecto es un número entero positivo que es igual a la suma de sus divisores propios. Por ejemplo, el 28 es perfecto porque sus divisores propios son 1, 2, 4, 7 y 14 y 1+2+4+7+14 = 28.

Un entero positivo x es un número cojonudo si existe un n tal que n > 0, x = 2^n·(2^(n+1)-1) y 2^(n+1)-1 es primo. Por ejemplo, el 28 es cojonudo ya que para n = 2 se verifica que 2 > 0, 28 = 2^2·(2^3-1) y 2^3-1 = 7 es primo.

Definir la funciones

   esPerfecto                      :: Integer -> Bool
   esCojonudo                      :: Integer -> Bool
   equivalencia_CojonudosPerfectos :: Integer -> Bool

esPerfecto :: Integer -> Bool

esCojonudo :: Integer -> Bool

equivalencia_CojonudosPerfectos :: Integer -> Bool

tales que

(esPerfecto x) se verifica si x es perfecto. Por ejemplo,

     esPerfecto 28  ==  True
     esPerfecto 30  ==  False

1 2	esPerfecto 28 == True esPerfecto 30 == False

(esCojonudo x) se verifica si x es cojonudo. Por ejemplo,

     esCojonudo 28                   ==  True
     esCojonudo 30                   ==  False
     esCojonudo 2305843008139952128  ==  True

esCojonudo 28 == True

esCojonudo 30 == False

esCojonudo 2305843008139952128 == True

(equivalenciaCojonudosPerfectos n) se verifica si para todos los números x menores o iguales que n se tiene que x es perfecto si, y sólo si, x es cojonudo. Por ejemplo,

     equivalenciaCojonudosPerfectos 3000  ==  True

1	equivalenciaCojonudosPerfectos 3000 == True

Soluciones

import Data.Numbers.Primes
import Data.List

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

esPerfecto1 :: Integer -> Bool
esPerfecto1 x =
  sum (divisoresPropios1 x) == x

divisoresPropios1 :: Integer -> [Integer]
divisoresPropios1 x =
  [y | y <- [1..x-1]
     , x `mod` y == 0]

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

esPerfecto2 :: Integer -> Bool
esPerfecto2 n = sum (divisoresPropios2 n) == n
 
divisoresPropios2 :: Integer -> [Integer]
divisoresPropios2 n =
  (delete n . nub . map product . subsequences) (primeFactors n)

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

--    λ> esPerfecto1 33550336
--    True
--    (48.70 secs, 6,976,432,536 bytes)
--    λ> esPerfecto2 33550336
--    True
--    (0.01 secs, 0 bytes)
--    
--    λ> [x | x <- [1..10^4], esPerfecto1 x]
--    [6,28,496,8128]
--    (72.88 secs, 10,411,693,760 bytes)
--    λ> [x | x <- [1..10^4], esPerfecto2 x]
--    [6,28,496,8128]
--    (0.69 secs, 311,388,248 bytes)

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

esCojonudo1 :: Integer -> Bool
esCojonudo1 x = pertenece x cojonudos

cojonudos :: [Integer]
cojonudos =
  [2^n*p | n <- [1..]
         , let p = 2^(n+1) - 1
         , isPrime p]

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

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

esCojonudo2 :: Integer -> Bool
esCojonudo2 n | length p /= 1  = False
              | otherwise      = head p == 2 * product d -1
    where (d,p) = partition (==2) (primeFactors n)

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

--    λ> length [x | x <- [1..10^5], esCojonudo1 x]
--    4
--    (0.37 secs, 23,492,384 bytes)
--    λ> length [x | x <- [1..10^5], esCojonudo2 x]
--    4
--    (7.46 secs, 4,245,266,408 bytes)

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

equivalencia_CojonudosPerfectos :: Integer -> Bool
equivalencia_CojonudosPerfectos n =
  and [esCojonudo1 x == esPerfecto2 x | x <- [1..n]]

import Data.Numbers.Primes

import Data.List

-- 1ª definición de esPerfecto

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

esPerfecto1 :: Integer -> Bool

esPerfecto1 x =

sum (divisoresPropios1 x) == x

divisoresPropios1 :: Integer -> [Integer]

divisoresPropios1 x =

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

, x `mod` y == 0]

-- 2ª definición de esPerfecto

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

esPerfecto2 :: Integer -> Bool

esPerfecto2 n = sum (divisoresPropios2 n) == n

divisoresPropios2 :: Integer -> [Integer]

divisoresPropios2 n =

(delete n . nub . map product . subsequences) (primeFactors n)

-- Comparación de eficiencia

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

-- λ> esPerfecto1 33550336

-- True

-- (48.70 secs, 6,976,432,536 bytes)

-- λ> esPerfecto2 33550336

-- True

-- (0.01 secs, 0 bytes)

-- λ> [x | x <- [1..10^4], esPerfecto1 x]

-- [6,28,496,8128]

-- (72.88 secs, 10,411,693,760 bytes)

-- λ> [x | x <- [1..10^4], esPerfecto2 x]

-- [6,28,496,8128]

-- (0.69 secs, 311,388,248 bytes)

-- 1ª definición de esCojonudo

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

esCojonudo1 :: Integer -> Bool

esCojonudo1 x = pertenece x cojonudos

cojonudos :: [Integer]

cojonudos =

[2^n*p | n <- [1..]

, let p = 2^(n+1) - 1

, isPrime p]

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

pertenece x ys =

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

-- 2ª definición de esCojonudo

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

esCojonudo2 :: Integer -> Bool

esCojonudo2 n | length p /= 1 = False

| otherwise = head p == 2 * product d -1

where (d,p) = partition (==2) (primeFactors n)

-- Comparación de eficiencia

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

-- λ> length [x | x <- [1..10^5], esCojonudo1 x]

-- 4

-- (0.37 secs, 23,492,384 bytes)

-- λ> length [x | x <- [1..10^5], esCojonudo2 x]

-- 4

-- (7.46 secs, 4,245,266,408 bytes)

-- Comprobación de equivalencia

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

equivalencia_CojonudosPerfectos :: Integer -> Bool

equivalencia_CojonudosPerfectos n =

and [esCojonudo1 x == esPerfecto2 x | x <- [1..n]]

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

Cadena de primos

Soluciones

Notación polaca inversa

Soluciones

Día de la semana

Soluciones

Listas engarzadas

Soluciones

Mínimo número de operaciones para transformar un número en otro

Soluciones

Referencias

Números consecutivos compuestos

Soluciones

Referencias

Máximo producto en la partición de un número

Soluciones

Referencia

Persistencia multiplicativa de un número

Soluciones

Referencias

Números perfectos y cojonudos

Soluciones

Primo anterior

Soluciones

Entradas recientes

Buscar

Correo electrónico