dropWhile – Página 2

Por 3 o más 5

PorJosé A. Alonso 16-marzo-201720-enero-2019

El enunciado del problema Por 3 o más 5 de ¡Acepta el reto! es el siguiente

Cuenta la leyenda que un famoso matemático, tras aprender a sumar y multiplicar a la tierna edad de 3 años en apenas 5 días, se dio cuenta de que, empezando por 1, podía generar un montón de números sin más que multiplicar por 3 o sumar 5 a alguno de los que ya hubiera generado antes.

Por ejemplo, el 23 (edad a la que se casaría) lo obtuvo así: ((1 + 5) × 3) + 5
Por su parte el 77 (edad a la que tendría su primer bisnieto) lo consiguió: (((1 × 3 + 5) × 3) × 3) + 5

Por mucho que lo intentó, algunos números, sin embargo, resultaron ser imposibles de obtener, como por ejemplo el 5, el 7 o el 15.

Se dice que un número es generable si se puede escribir como una sucesión (quizá vacía) de multiplicaciones por 3 y sumas de 5 al número 1.

Definir las siguientes funciones

   generables     :: [Integer]
   generable      :: Integer -> Bool
   arbolGenerable :: Integer -> Tree Integer

generables :: [Integer]

generable :: Integer -> Bool

arbolGenerable :: Integer -> Tree Integer

tales que

generables es la sucesión de los números generables. Por ejemplo,

     λ> take 20 generables
     [1,3,6,8,9,11,13,14,16,18,19,21,23,24,26,27,28,29,31,32]
     λ> generables !! (10^6)
     1250008

λ> take 20 generables

[1,3,6,8,9,11,13,14,16,18,19,21,23,24,26,27,28,29,31,32]

λ> generables !! (10^6)

1250008

(generable x) se verifica si x es generable. Por ejemplo,

     generable 23       ==  True
     generable 77       ==  True
     generable 15       ==  False
     generable 1250008  ==  True
     generable 1250010  ==  False

generable 23 == True

generable 77 == True

generable 15 == False

generable 1250008 == True

generable 1250010 == False

(arbolGenerable x) es el árbol de los números generables menores o iguales a x. Por ejemplo,

     λ> putStrLn (drawTree (fmap show (arbolGenerable 11)))
     1
     |
     +- 3
     |  |
     |  +- 9
     |  |
     |  `- 8
     |
     `- 6
        |
        `- 11

λ> putStrLn (drawTree (fmap show (arbolGenerable 11)))

+- 3

| |

| +- 9

| |

| `- 8

`- 6

`- 11

Soluciones

import Graphics.Gnuplot.Simple

generables :: [Integer]
generables = 1 : mezcla [3 * x | x <- generables]
                        [5 + x | x <- generables]

-- (mezcla xs ys) es la lista ordenada obtenida mezclando las dos listas
-- ordenadas xs e ys, suponiendo que ambas son infinitas. 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
  | x == y    = x : mezcla xs ys
  | otherwise = y : mezcla us ys

generable :: Integer -> Bool
generable x =
  x == head (dropWhile (<x) generables)

-- 2ª definición
generable2 :: Integer -> Bool
generable2 1 = True
generable2 x =    (x `mod` 3 == 0 && generable2 (x `div` 3))
               || (x > 5 && generable2 (x - 5))

generables2 :: [Integer] 
generables2 = filter generable2 [1..]

arbolGenerable :: Integer -> Tree Integer
arbolGenerable n = aux 1
  where aux x
          | 3*x <= n && 5+x <= n = Node x [aux (3*x), aux (5+x)] 
          | 3*x <= n             = Node x [aux (3*x)]
          | 5+x <= n             = Node x [aux (5+x)]
          | otherwise            = Node x [] 

-- 3ª definición
generable3 :: Integer -> Bool
generable3 x =
  x `elem` arbolGenerable x

import Graphics.Gnuplot.Simple

generables :: [Integer]

generables = 1 : mezcla [3 * x | x <- generables]

[5 + x | x <- generables]

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

-- ordenadas xs e ys, suponiendo que ambas son infinitas. 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

| x == y = x : mezcla xs ys

| otherwise = y : mezcla us ys

generable :: Integer -> Bool

generable x =

x == head (dropWhile (<x) generables)

-- 2ª definición

generable2 :: Integer -> Bool

generable2 1 = True

generable2 x = (x `mod` 3 == 0 && generable2 (x `div` 3))

|| (x > 5 && generable2 (x - 5))

generables2 :: [Integer]

generables2 = filter generable2 [1..]

arbolGenerable :: Integer -> Tree Integer

arbolGenerable n = aux 1

where aux x

| 3*x <= n && 5+x <= n = Node x [aux (3*x), aux (5+x)]

| 3*x <= n = Node x [aux (3*x)]

| 5+x <= n = Node x [aux (5+x)]

| otherwise = Node x []

-- 3ª definición

generable3 :: Integer -> Bool

generable3 x =

x `elem` arbolGenerable x

Números cubifinitos

PorJosé A. Alonso 15-marzo-201721-enero-2020

El enunciado del problema Números cubifinitos de ¡Acepta el reto! es el siguiente

Se dice que un número es cubifinito cuando al elevar todos sus dígitos al cubo y sumarlos el resultado o bien es 1 o bien es un número cubifinito.

Por ejemplo, el número 1243 es cubifinito, pues al elevar todos sus dígitos al cubo obtenemos 100 que es cubifinito.

Por su parte, el 513 no es cubifinito, pues al elevar al cubo sus dígitos conseguimos el 153 que nunca podrá ser cubifinito, pues la suma de los cubos de sus dígitos vuelve a dar 153.

Definir las funciones

   esCubifinito :: Int -> Bool
   grafica :: Int -> IO ()

1 2	esCubifinito :: Int -> Bool grafica :: Int -> IO ()

tales que

(esCubifinito n) se verifica si n es un número cubifinito. Por ejemplo,

     esCubifinito 1      ==  True
     esCubifinito 10     ==  True
     esCubifinito 1243   ==  True
     esCubifinito 87418  ==  True
     esCubifinito 513    ==  False

esCubifinito 1 == True

esCubifinito 10 == True

esCubifinito 1243 == True

esCubifinito 87418 == True

esCubifinito 513 == False

(grafica n) dibuja la gráfica de la sucesión de los primeros n números cubifinitos. Por ejemplo, al evaluar (grafica 50) se dibuja

Soluciones

import Graphics.Gnuplot.Simple

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

esCubifinito :: Int -> Bool
esCubifinito n = aux [n]
  where aux (n:ns) | n == 1      = True
                   | n `elem` ns = False
                   | otherwise   = aux (sumaCubosDigitos n : n : ns)

-- (sumaCubosDigitos b) es la suma de los cubos de los dígitos de n. Por
-- ejemplo, 
--    sumaCubosDigitos 513  ==  153
sumaCubosDigitos :: Int -> Int
sumaCubosDigitos = sum . map (^3) . digitos

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

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

esCubifinito2 :: Int -> Bool
esCubifinito2 n = primerRepetido (orbita n) == 1

-- (orbita n) es la lista cuyo primer elemento es n y los siguientes se
-- obtienen sumando los cubos de los digitos del elemento anterior. Por
-- ejemplo,  
--    take 9 (orbita 2)  ==  [2,8,512,134,92,737,713,371,371]
orbita :: Int -> [Int]
orbita n = iterate sumaCubosDigitos n

-- (primerRepetido xs) es el primer elemento repetido de la lista
--  xs. Por ejemplo, 
--    primerRepetido [3,7,5,7,2]  ==  7
primerRepetido :: Eq a => [a] -> a
primerRepetido xs = aux xs []
  where
    aux (x:xs') ys | x `elem` ys = x
                   | otherwise   = aux xs' (x:ys) 

grafica :: Int -> IO ()
grafica n = 
    plotList [Key Nothing, PNG "Numeros_cubifinitos.png"]
             (zip [1..n] [x | x <- [1..], esCubifinito x])

import Graphics.Gnuplot.Simple

-- 1ª solución

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

esCubifinito :: Int -> Bool

esCubifinito n = aux [n]

where aux (n:ns) | n == 1 = True

| n `elem` ns = False

| otherwise = aux (sumaCubosDigitos n : n : ns)

-- (sumaCubosDigitos b) es la suma de los cubos de los dígitos de n. Por

-- ejemplo,

-- sumaCubosDigitos 513 == 153

sumaCubosDigitos :: Int -> Int

sumaCubosDigitos = sum . map (^3) . digitos

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

-- digitos 513 == [5,1,3]

digitos :: Int -> [Int]

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

-- 2ª solución

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

esCubifinito2 :: Int -> Bool

esCubifinito2 n = primerRepetido (orbita n) == 1

-- (orbita n) es la lista cuyo primer elemento es n y los siguientes se

-- obtienen sumando los cubos de los digitos del elemento anterior. Por

-- ejemplo,

-- take 9 (orbita 2) == [2,8,512,134,92,737,713,371,371]

orbita :: Int -> [Int]

orbita n = iterate sumaCubosDigitos n

-- (primerRepetido xs) es el primer elemento repetido de la lista

-- xs. Por ejemplo,

-- primerRepetido [3,7,5,7,2] == 7

primerRepetido :: Eq a => [a] -> a

primerRepetido xs = aux xs []

where

aux (x:xs') ys | x `elem` ys = x

| otherwise = aux xs' (x:ys)

grafica :: Int -> IO ()

grafica n =

plotList [Key Nothing, PNG "Numeros_cubifinitos.png"]

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

Generadores de números de Gabonacci

PorJosé A. Alonso 9-marzo-201720-marzo-2017

Los números de Gabonacci generados por (a,b) son los elementos de la sucesión de Gabonacci definida por

   G(0) = a
   G(1) = b
   G(n) = G(n-2) + G(n-1), si n > 1

G(0) = a

G(1) = b

G(n) = G(n-2) + G(n-1), si n > 1

Por ejemplo, la sucesión de Gabonacci generada por (2,5) es 2, 5, 7, 12, 19, 31, 50, 81, 131, 212, …

Un número pertenece a distintas sucesiones de Gabonacci. Por ejemplo, el 9 pertenece a las sucesiones de Gabonacci generados por (3,3), (1,4) y (4,5).

El menor generador de Gabonacci de un número x es el par (a,b), con 1 ≤ a ≤ b, tal que (a,b) es un generador de Gabonacci de x y no existe ningún generador de Gabonacci de x (a’,b’) tal que b’ < b ó b’ = b y a’ < a. Por ejemplo, el menor generador de Gabonacci de 9 es (3,3).

Definir la función

   menorGenerador :: Integer -> (Integer,Integer)

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

tal que (menorGenerador x) es el menor generador de Gabonacci de x. Por ejemplo,

   menorGenerador 9          ==  (3,3)
   menorGenerador 7          ==  (1,3)
   menorGenerador 5          ==  (1,1)
   menorGenerador 27         ==  (3,7)
   menorGenerador 57         ==  (4,9)
   menorGenerador 218        ==  (10,21)
   menorGenerador 1121       ==  (20,41)
   menorGenerador 89         ==  (1,1)
   menorGenerador 123        ==  (1,3)
   menorGenerador 1000       ==  (2,10)
   menorGenerador 842831057  ==  (2,7)
   menorGenerador 1573655    ==  (985,1971)

menorGenerador 9 == (3,3)

menorGenerador 7 == (1,3)

menorGenerador 5 == (1,1)

menorGenerador 27 == (3,7)

menorGenerador 57 == (4,9)

menorGenerador 218 == (10,21)

menorGenerador 1121 == (20,41)

menorGenerador 89 == (1,1)

menorGenerador 123 == (1,3)

menorGenerador 1000 == (2,10)

menorGenerador 842831057 == (2,7)

menorGenerador 1573655 == (985,1971)

Soluciones

menorGenerador :: Integer -> (Integer,Integer)
menorGenerador = head . generadores

generadores :: Integer -> [(Integer,Integer)]
generadores x = [(a,b) | b <- [1..x]
                       , a <- [1..b]
                       , pertenece x (gabonacci a b)]

gabonacci :: Integer -> Integer -> [Integer]
gabonacci a b = aux
  where aux = a : scanl (+) b aux

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

menorGenerador :: Integer -> (Integer,Integer)

menorGenerador = head . generadores

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

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

, a <- [1..b]

, pertenece x (gabonacci a b)]

gabonacci :: Integer -> Integer -> [Integer]

gabonacci a b = aux

where aux = a : scanl (+) b aux

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

pertenece x ys =

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

Números construibles como sumas de dos dados

PorJosé A. Alonso 3-marzo-201725-marzo-2022

Un número x es construible a partir de de los números enteros positivos a y b si se puede escribir como una suma cuyos sumandos son a o b. Por ejemplo, 7 y 9 son construibles a partir de 2 y 3 ya que 7 = 2+2+3 y 9 = 3+3+3.

Definir las funciones

   construibles  :: Integer -> Integer -> [Integer]
   esConstruible :: Integer -> Integer -> Integer -> Bool

1 2	construibles :: Integer -> Integer -> [Integer] esConstruible :: Integer -> Integer -> Integer -> Bool

tales que

(construibles a b) es la lista de los números construibles a partir de a y b. Por ejemplo,

     take 5 (construibles 2 9)  ==  [2,4,6,8,9]
     take 5 (construibles 6 4)  ==  [4,6,8,10,12]
     take 5 (construibles 9 7)  ==  [7,9,14,16,18]

take 5 (construibles 2 9) == [2,4,6,8,9]

take 5 (construibles 6 4) == [4,6,8,10,12]

take 5 (construibles 9 7) == [7,9,14,16,18]

(esConstruible a b x) se verifica si x es construible a partir de a y b. Por ejemplo,

     esConstruible 2 3 7   ==  True
     esConstruible 9 7 15  ==  False

1 2	esConstruible 2 3 7 == True esConstruible 9 7 15 == False

Soluciones

import Data.List (nub)

construibles :: Integer -> Integer -> [Integer]
construibles a b = tail aux
  where aux = 0 : mezcla [a + x | x <- aux]
                         [b + x | x <- aux]

mezcla :: [Integer] -> [Integer] -> [Integer]
mezcla p@(x:xs) q@(y:ys) | x < y     = x : mezcla xs q
                         | x > y     = y : mezcla p  ys  
                         | otherwise = x : mezcla xs ys
mezcla []       ys                   = ys
mezcla xs       []                   = xs
              
esConstruible :: Integer -> Integer -> Integer -> Bool
esConstruible a b x = x == y
  where (y:_) = dropWhile (<x) (construibles a b)

import Data.List (nub)

construibles :: Integer -> Integer -> [Integer]

construibles a b = tail aux

where aux = 0 : mezcla [a + x | x <- aux]

[b + x | x <- aux]

mezcla :: [Integer] -> [Integer] -> [Integer]

mezcla p@(x:xs) q@(y:ys) | x < y = x : mezcla xs q

| x > y = y : mezcla p ys

| otherwise = x : mezcla xs ys

mezcla [] ys = ys

mezcla xs [] = xs

esConstruible :: Integer -> Integer -> Integer -> Bool

esConstruible a b x = x == y

where (y:_) = dropWhile (<x) (construibles a b)

Sucesiones alícuotas

PorJosé A. Alonso 28-febrero-20177-marzo-2017

La sucesión alícuota de un número x es la sucesión cuyo primer término es x y cada otro término es la suma de los divisores propios del término anterior. Por ejemplo, la sucesión alícuota de 10 es [10,8,7,1,0,0,0] ya que

   la suma de los divisores propios de 10 es 5 + 2 + 1 = 8
   la suma de los divisores propios de  8 es 4 + 2 + 1 = 7
   la suma de los divisores propios de  7 es 1
   la suma de los divisores propios de  1 es 0

la suma de los divisores propios de 10 es 5 + 2 + 1 = 8

la suma de los divisores propios de 8 es 4 + 2 + 1 = 7

la suma de los divisores propios de 7 es 1

la suma de los divisores propios de 1 es 0

Definir la función

   sucAlicuota :: Integer -> [Integer]

1	sucAlicuota :: Integer -> [Integer]

tal que (sucAlicuota x) es la sucesión alícuota de x. Por ejemplo,

   take 6 (sucAlicuota 10)       ==  [10,8,7,1,0,0]
   take 6 (sucAlicuota 95)       ==  [95,25,6,6,6,6]
   take 6 (sucAlicuota 220)      ==  [220,284,220,284,220,284]
   sucAlicuota 1184 !! (1+10^7)  ==  1210
   sucAlicuota 276 !! 200        ==  2790456740340877466506

take 6 (sucAlicuota 10) == [10,8,7,1,0,0]

take 6 (sucAlicuota 95) == [95,25,6,6,6,6]

take 6 (sucAlicuota 220) == [220,284,220,284,220,284]

sucAlicuota 1184 !! (1+10^7) == 1210

sucAlicuota 276 !! 200 == 2790456740340877466506

Soluciones

import Math.NumberTheory.ArithmeticFunctions (sigma)

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

sucAlicuota :: Integer -> [Integer]
sucAlicuota x = x : sucAlicuota (sumaDivisoresPropios x)

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

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

sucAlicuota2 :: Integer -> [Integer]
sucAlicuota2 = iterate (sum . divisoresPropios)

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

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

sucAlicuota3 :: Integer -> [Integer]
sucAlicuota3 x = aux x []
  where aux y ys | y `elem` ys = us ++ cycle zs
                 | otherwise   = aux (sumaDivisoresPropios y) (y:ys)
          where us = reverse ys
                zs = dropWhile (/=y) us

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

sucAlicuota4 :: Integer -> [Integer]
sucAlicuota4 x = x : sucAlicuota4 (sumaDivisoresPropios4 x)

sumaDivisoresPropios4 :: Integer -> Integer
sumaDivisoresPropios4 x =
  sigma 1 x - x

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

--    λ> sucAlicuota 1184 !! (1+10^3)
--    1210
--    (2.02 secs, 261,081,688 bytes)
--    λ> sucAlicuota2 1184 !! (1+10^3)
--    1210
--    (2.02 secs, 245,485,568 bytes)
--    λ> sucAlicuota3 1184 !! (1+10^3)
--    1210
--    (0.02 secs, 0 bytes)
--    λ> sucAlicuota4 1184 !! (1+10^3)
--    1210
--    (0.05 secs, 0 bytes)

import Math.NumberTheory.ArithmeticFunctions (sigma)

-- 1ª definición

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

sucAlicuota :: Integer -> [Integer]

sucAlicuota x = x : sucAlicuota (sumaDivisoresPropios x)

sumaDivisoresPropios :: Integer -> Integer

sumaDivisoresPropios x =

sum [y | y <- [1..x-1], x `mod` y == 0]

-- 2ª definición

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

sucAlicuota2 :: Integer -> [Integer]

sucAlicuota2 = iterate (sum . divisoresPropios)

divisoresPropios :: Integer -> [Integer]

divisoresPropios x = [y | y <- [1..x-1], x `mod` y == 0]

-- 3ª definición

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

sucAlicuota3 :: Integer -> [Integer]

sucAlicuota3 x = aux x []

where aux y ys | y `elem` ys = us ++ cycle zs

| otherwise = aux (sumaDivisoresPropios y) (y:ys)

where us = reverse ys

zs = dropWhile (/=y) us

-- 4ª definición

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

sucAlicuota4 :: Integer -> [Integer]

sucAlicuota4 x = x : sucAlicuota4 (sumaDivisoresPropios4 x)

sumaDivisoresPropios4 :: Integer -> Integer

sumaDivisoresPropios4 x =

sigma 1 x - x

-- Comparación de eficiencia

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

-- λ> sucAlicuota 1184 !! (1+10^3)

-- 1210

-- (2.02 secs, 261,081,688 bytes)

-- λ> sucAlicuota2 1184 !! (1+10^3)

-- 1210

-- (2.02 secs, 245,485,568 bytes)

-- λ> sucAlicuota3 1184 !! (1+10^3)

-- 1210

-- (0.02 secs, 0 bytes)

-- λ> sucAlicuota4 1184 !! (1+10^3)

-- 1210

-- (0.05 secs, 0 bytes)

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.

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

Inversa del factorial

PorJosé A. Alonso 16-enero-201726-marzo-2022

Definir la función

   inversaFactorial :: Integer -> Maybe Integer

1	inversaFactorial :: Integer -> Maybe Integer

tal que (inversaFactorial x) es (Just n) si el factorial de n es x y es Nothing si no existe ningún número n tal que el factorial de n es x. Por ejemplo,

   inversaFactorial 24  ==  Just 4
   inversaFactorial 25  ==  Nothing

1 2	inversaFactorial 24 == Just 4 inversaFactorial 25 == Nothing

Soluciones

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

inversaFactorial :: Integer -> Maybe Integer
inversaFactorial 1 = Just 1
inversaFactorial x = aux 2 x
  where aux n 1 = Just (n-1)
        aux n y | y `mod` n == 0 = aux (n+1) (y `div` n)
                | otherwise      = Nothing

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

inversaFactorial2 :: Integer -> Maybe Integer
inversaFactorial2 x
  | y == x   = Just n
  |otherwise = Nothing  
  where ((n,y):_) = dropWhile (\(k,z) -> z < x) factorialesAnotados

-- factorialesAnotados es la lista de los factoriales anotados con sus
-- posiciones. Por ejemplo, 
--    take 5 factorialesAnotados  ==  [(0,1),(1,1),(2,2),(3,6),(4,24)]
factorialesAnotados :: [(Integer, Integer)]
factorialesAnotados = zip [0..] factoriales
    
-- factoriales es la lista de los factoriales. Por ejemplo,
--    take 5 factoriales  ==  [1,1,2,6,24]
factoriales :: [Integer]
factoriales =
  1 : scanl1 (*) [1..]

-- Comparación de eficiencia
--    λ> inversaFactorial (product [1..4*10^4])
--    Just 40000
--    (2.76 secs, 3,105,158,528 bytes)
--    λ> inversaFactorial2 (product [1..4*10^4])
--    Just 40000
--    (2.60 secs, 3,261,722,960 bytes)
--
--    λ> inversaFactorial (1 + product [1..4*10^4])
--    Nothing
--    (1.80 secs, 1,626,433,432 bytes)
--    λ> inversaFactorial2 (1 + product [1..4*10^4])
--    Nothing
--    (2.56 secs, 3,257,388,296 bytes)

-- 1ª definición

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

inversaFactorial :: Integer -> Maybe Integer

inversaFactorial 1 = Just 1

inversaFactorial x = aux 2 x

where aux n 1 = Just (n-1)

aux n y | y `mod` n == 0 = aux (n+1) (y `div` n)

| otherwise = Nothing

-- 2ª definición

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

inversaFactorial2 :: Integer -> Maybe Integer

inversaFactorial2 x

| y == x = Just n

|otherwise = Nothing

where ((n,y):_) = dropWhile (\(k,z) -> z < x) factorialesAnotados

-- factorialesAnotados es la lista de los factoriales anotados con sus

-- posiciones. Por ejemplo,

-- take 5 factorialesAnotados == [(0,1),(1,1),(2,2),(3,6),(4,24)]

factorialesAnotados :: [(Integer, Integer)]

factorialesAnotados = zip [0..] factoriales

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

-- take 5 factoriales == [1,1,2,6,24]

factoriales :: [Integer]

factoriales =

1 : scanl1 (*) [1..]

-- Comparación de eficiencia

-- λ> inversaFactorial (product [1..4*10^4])

-- Just 40000

-- (2.76 secs, 3,105,158,528 bytes)

-- λ> inversaFactorial2 (product [1..4*10^4])

-- Just 40000

-- (2.60 secs, 3,261,722,960 bytes)

-- λ> inversaFactorial (1 + product [1..4*10^4])

-- Nothing

-- (1.80 secs, 1,626,433,432 bytes)

-- λ> inversaFactorial2 (1 + product [1..4*10^4])

-- Nothing

-- (2.56 secs, 3,257,388,296 bytes)

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.

Sin ceros finales

PorJosé A. Alonso 6-diciembre-201613-diciembre-2016

Definir la función

   sinCerosFinales :: Int -> Int

1	sinCerosFinales :: Int -> Int

tal que (sinCerosFinales n) es el número obtenido eliminando los ceros finales de n. Por ejemplo,

   sinCerosFinales 104050     == 10405
   sinCerosFinales 960000     == 96
   sinCerosFinales 100050     == 10005
   sinCerosFinales (-10050)   == -1005
   sinCerosFinales 12         == 12
   sinCerosFinales 0          == 0

sinCerosFinales 104050 == 10405

sinCerosFinales 960000 == 96

sinCerosFinales 100050 == 10005

sinCerosFinales (-10050) == -1005

sinCerosFinales 12 == 12

sinCerosFinales 0 == 0

Comprobar con QuickCheck que, para cualquier número entero n,

   sinCerosFinales (sinCerosFinales n) == sinCerosFinales n

1	sinCerosFinales (sinCerosFinales n) == sinCerosFinales n

Soluciones

import Test.QuickCheck

-- 1ª solución
sinCerosFinales :: Int -> Int
sinCerosFinales 0 = 0
sinCerosFinales n
  | r /= 0    = n
  | otherwise = sinCerosFinales q  
  where (q,r) = quotRem n 10

-- 2ª solución
sinCerosFinales2 :: Int -> Int
sinCerosFinales2 0 = 0
sinCerosFinales2 n =
  read (reverse (dropWhile (=='0') (reverse (show n))))

-- 3ª solución
sinCerosFinales3 :: Int -> Int
sinCerosFinales3 0 = 0
sinCerosFinales3 n =
  (read . reverse . dropWhile (== '0') . reverse . show) n

-- 4ª solución
sinCerosFinales4 :: Int -> Int
sinCerosFinales4 0 = 0
sinCerosFinales4 n =
  read . reverse . dropWhile (== '0') . reverse . show $ n

-- La propiedad es
prop_sinCerosFinales :: Int -> Bool
prop_sinCerosFinales n =
  sinCerosFinales (sinCerosFinales n) == sinCerosFinales n

-- 5ª solución
sinCerosFinales5 :: Int -> Int
sinCerosFinales5 0 = 0
sinCerosFinales5 n = until (\x -> mod x 10 /= 0) (`div` 10) n

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

import Test.QuickCheck

-- 1ª solución

sinCerosFinales :: Int -> Int

sinCerosFinales 0 = 0

sinCerosFinales n

| r /= 0 = n

| otherwise = sinCerosFinales q

where (q,r) = quotRem n 10

-- 2ª solución

sinCerosFinales2 :: Int -> Int

sinCerosFinales2 0 = 0

sinCerosFinales2 n =

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

-- 3ª solución

sinCerosFinales3 :: Int -> Int

sinCerosFinales3 0 = 0

sinCerosFinales3 n =

(read . reverse . dropWhile (== '0') . reverse . show) n

-- 4ª solución

sinCerosFinales4 :: Int -> Int

sinCerosFinales4 0 = 0

sinCerosFinales4 n =

read . reverse . dropWhile (== '0') . reverse . show $ n

-- La propiedad es

prop_sinCerosFinales :: Int -> Bool

prop_sinCerosFinales n =

sinCerosFinales (sinCerosFinales n) == sinCerosFinales n

-- 5ª solución

sinCerosFinales5 :: Int -> Int

sinCerosFinales5 0 = 0

sinCerosFinales5 n = until (\x -> mod x 10 /= 0) (`div` 10) n

-- La comprobación es

-- λ> quickCheck prop_sinCerosFinales

-- +++ OK, passed 100 tests.

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.

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

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)

Índices de números de Fibonacci

PorJosé A. Alonso 2-marzo-201626-marzo-2022

Los primeros términos de la sucesión de Fibonacci son

   0, 1, 1, 2, 3, 5, 8, 13, 21, 34

1	0, 1, 1, 2, 3, 5, 8, 13, 21, 34

Se observa que el 6º término de la sucesión (comenzando a contar en 0) es el número 8.

Definir la función

   indiceFib :: Integer -> Maybe Integer

1	indiceFib :: Integer -> Maybe Integer

tal que (indiceFib x) es justo el número n si x es el n-ésimo términos de la sucesión de Fibonacci o Nothing en el caso de que x no pertenezca a la sucesión. Por ejemplo,

    indiceFib 8                                           == Just 6
    indiceFib 9                                           == Nothing
    indiceFib 21                                          == Just 8
    indiceFib 22                                          == Nothing
    indiceFib 280571172992510140037611932413038677189525  == Just 200
    indiceFib 123456789012345678901234567890123456789012  == Nothing

indiceFib 8 == Just 6

indiceFib 9 == Nothing

indiceFib 21 == Just 8

indiceFib 22 == Nothing

indiceFib 280571172992510140037611932413038677189525 == Just 200

indiceFib 123456789012345678901234567890123456789012 == Nothing

Soluciones

indiceFib :: Integer -> Maybe Integer
indiceFib x | y == x    = Just n
            | otherwise = Nothing
    where (y,n) = head (dropWhile (\(z,m) -> z < x) fibsNumerados)

-- fibs es la lista de los términos de la sucesión de Fibonacci. Por
-- ejemplo, 
--    take 10 fibs  ==  [0,1,1,2,3,5,8,13,21,34]
fibs :: [Integer]
fibs = 0 : 1 : [x+y | (x,y) <- zip fibs (tail fibs)]

-- fibsNumerados es la lista de los términos de la sucesión de Fibonacci
-- juntos con sus posiciones. Por ejemplo,
--    ghci> take 10 fibsNumerados
--    [(0,0),(1,1),(1,2),(2,3),(3,4),(5,5),(8,6),(13,7),(21,8),(34,9)]
fibsNumerados :: [(Integer,Integer)]
fibsNumerados = zip fibs [0..]

indiceFib :: Integer -> Maybe Integer

indiceFib x | y == x = Just n

| otherwise = Nothing

where (y,n) = head (dropWhile (\(z,m) -> z < x) fibsNumerados)

-- fibs es la lista de los términos de la sucesión de Fibonacci. Por

-- ejemplo,

-- take 10 fibs == [0,1,1,2,3,5,8,13,21,34]

fibs :: [Integer]

fibs = 0 : 1 : [x+y | (x,y) <- zip fibs (tail fibs)]

-- fibsNumerados es la lista de los términos de la sucesión de Fibonacci

-- juntos con sus posiciones. Por ejemplo,

-- ghci> take 10 fibsNumerados

-- [(0,0),(1,1),(1,2),(2,3),(3,4),(5,5),(8,6),(13,7),(21,8),(34,9)]

fibsNumerados :: [(Integer,Integer)]

fibsNumerados = zip fibs [0..]

En Maxima

indiceFib (n) := block([a:0,b:1,c:1,p:0],
  unless n <= a do
   (a : b,
    b : c,
    c : a + b,
    p : p + 1),
  if n = a
  then Just (p)
  else Nothing)$

indiceFib (n) := block([a:0,b:1,c:1,p:0],

unless n <= a do

(a : b,

b : c,

c : a + b,

p : p + 1),

if n = a

then Just (p)

else Nothing)$

Eliminación de espacios extremos

PorJosé A. Alonso 10-febrero-201617-febrero-2016

Definir la función

   sinEspaciosExtremos :: String -> String

1	sinEspaciosExtremos :: String -> String

tal que (sinEspaciosExtremos cs) es la cadena obtenida eliminando los espacios blancos de los extremos de la cadena cs. Por ejemplo,

   λ> sinEspaciosExtremos "   El lunes a las 12:30.     "
   "El lunes a las 12:30."

1 2	λ> sinEspaciosExtremos " El lunes a las 12:30. " "El lunes a las 12:30."

Soluciones

import Data.Char (isSpace)

sinEspaciosExtremos :: String -> String
sinEspaciosExtremos = f . f
    where f = reverse . dropWhile isSpace

import Data.Char (isSpace)

sinEspaciosExtremos :: String -> String

sinEspaciosExtremos = f . f

where f = reverse . dropWhile isSpace

Sumas digitales de primos consecutivos

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

Definir la función

   primosConsecutivosConSumasDigitalesPrimas :: Int -> [[Integer]]

1	primosConsecutivosConSumasDigitalesPrimas :: Int -> [[Integer]]

tal que (primosConsecutivosConSumasDigitalesPrimas k) es la sucesión de listas de k primos consecutivos tales que las sumas ordenadas de sus dígitos también son primos consecutivos. Por ejemplo,

   λ> take 5 (primosConsecutivosConSumasDigitalesPrimas 2)
   [[2,3],[3,5],[5,7],[41,43],[43,47]]
   λ> take 5 (primosConsecutivosConSumasDigitalesPrimas 3)
   [[2,3,5],[3,5,7],[41,43,47],[191,193,197],[193,197,199]]
   λ> take 4 (primosConsecutivosConSumasDigitalesPrimas 4)
   [[2,3,5,7],[3,5,7,11],[191,193,197,199],[821,823,827,829]]
   λ> primosConsecutivosConSumasDigitalesPrimas 4 !! 50
   [129197,129209,129221,129223]

λ> take 5 (primosConsecutivosConSumasDigitalesPrimas 2)

[[2,3],[3,5],[5,7],[41,43],[43,47]]

λ> take 5 (primosConsecutivosConSumasDigitalesPrimas 3)

[[2,3,5],[3,5,7],[41,43,47],[191,193,197],[193,197,199]]

λ> take 4 (primosConsecutivosConSumasDigitalesPrimas 4)

[[2,3,5,7],[3,5,7,11],[191,193,197,199],[821,823,827,829]]

λ> primosConsecutivosConSumasDigitalesPrimas 4 !! 50

[129197,129209,129221,129223]

Soluciones

import Data.Char (digitToInt)
import Data.List (isPrefixOf, sort, tails)
import Data.Numbers.Primes

primosConsecutivosConSumasDigitalesPrimas :: Int -> [[Integer]]
primosConsecutivosConSumasDigitalesPrimas k = 
    [xs | xs <- map (take k) (tails primes),
          primosConsecutivos (sort (map sumaDigital xs))]

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

-- (sumaDigital n) es la suma de los dígitos de n. Por ejemplo, 
--    sumaDigital 325  ==  10
sumaDigital :: Integer -> Integer
sumaDigital = sum . digitos

-- (primosConsecutivos xs) se verifica si xs es una lista de primos
-- consecutivos. Por ejemplo,
--    primosConsecutivos [5,7,11]  ==  True
--    primosConsecutivos [5,7,17]  ==  False
primosConsecutivos :: [Integer] -> Bool
primosConsecutivos (x:xs) =
    isPrefixOf (x:xs) (dropWhile (<x) primes)

import Data.Char (digitToInt)

import Data.List (isPrefixOf, sort, tails)

import Data.Numbers.Primes

primosConsecutivosConSumasDigitalesPrimas :: Int -> [[Integer]]

primosConsecutivosConSumasDigitalesPrimas k =

[xs | xs <- map (take k) (tails primes),

primosConsecutivos (sort (map sumaDigital xs))]

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

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

digitos :: Integer -> [Integer]

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

-- (sumaDigital n) es la suma de los dígitos de n. Por ejemplo,

-- sumaDigital 325 == 10

sumaDigital :: Integer -> Integer

sumaDigital = sum . digitos

-- (primosConsecutivos xs) se verifica si xs es una lista de primos

-- consecutivos. Por ejemplo,

-- primosConsecutivos [5,7,11] == True

-- primosConsecutivos [5,7,17] == False

primosConsecutivos :: [Integer] -> Bool

primosConsecutivos (x:xs) =

isPrefixOf (x:xs) (dropWhile (<x) primes)

Referencias

Basado en el artículo DigitSums of some consecutive primes del blog Fun With Num3ers.

Productos de N números consecutivos

PorJosé A. Alonso 17-noviembre-201526-marzo-2022

La semana pasada se planteó en Twitter el siguiente problema

Se observa que

      1x2x3x4 = 2x3x4 
      2x3x4x5 = 4x5x6

1 2	1x2x3x4 = 2x3x4 2x3x4x5 = 4x5x6

¿Existen ejemplos de otros productos de cuatro enteros consecutivos iguales a un producto de tres enteros consecutivos?

Definir la función

   esProductoDeNconsecutivos :: Integer -> Integer -> Maybe Integer

1	esProductoDeNconsecutivos :: Integer -> Integer -> Maybe Integer

tal que (esProductoDeNconsecutivos n x) es (Just m) si x es el producto de n enteros consecutivos a partir de m y es Nothing si x no es el producto de n enteros consecutivos. Por ejemplo,

   esProductoDeNconsecutivos 3   6  == Just 1
   esProductoDeNconsecutivos 4   6  == Nothing
   esProductoDeNconsecutivos 4  24  == Just 1
   esProductoDeNconsecutivos 3  24  == Just 2
   esProductoDeNconsecutivos 3 120  == Just 4
   esProductoDeNconsecutivos 4 120  == Just 2

esProductoDeNconsecutivos 3 6 == Just 1

esProductoDeNconsecutivos 4 6 == Nothing

esProductoDeNconsecutivos 4 24 == Just 1

esProductoDeNconsecutivos 3 24 == Just 2

esProductoDeNconsecutivos 3 120 == Just 4

esProductoDeNconsecutivos 4 120 == Just 2

Para ejemplos mayores,

   λ> esProductoDeNconsecutivos 3 (product [10^20..2+10^20])
   Just 100000000000000000000
   λ> esProductoDeNconsecutivos2 4 (product [10^20..2+10^20])
   Nothing
   λ> esProductoDeNconsecutivos2 4 (product [10^20..3+10^20])
   Just 100000000000000000000

λ> esProductoDeNconsecutivos 3 (product [10^20..2+10^20])

Just 100000000000000000000

λ> esProductoDeNconsecutivos2 4 (product [10^20..2+10^20])

Nothing

λ> esProductoDeNconsecutivos2 4 (product [10^20..3+10^20])

Just 100000000000000000000

Usando la función esProductoDeNconsecutivos resolver el problema.

Soluciones

import Data.Maybe

-- 1ª definición
esProductoDeNconsecutivos1 :: Integer -> Integer -> Maybe Integer
esProductoDeNconsecutivos1 n x 
    | null productos = Nothing
    | otherwise      = Just (head productos)
    where productos = [m | m <- [1..x-n], product [m..m+n-1] == x]

-- 2ª definición
esProductoDeNconsecutivos2 :: Integer -> Integer -> Maybe Integer
esProductoDeNconsecutivos2 n x = aux k
    where k = floor (fromIntegral x ** (1/(fromIntegral n))) - (n `div` 2)
          aux m | y == x    = Just m
                | y <  x    = aux (m+1)
                | otherwise = Nothing
                where y = product [m..m+n-1]

-- Comparación de eficiencia
--    λ> esProductoDeNconsecutivos1 3 (product [10^7..2+10^7])
--    Just 10000000
--    (12.37 secs, 5678433692 bytes)
--    λ> esProductoDeNconsecutivos2 3 (product [10^7..2+10^7])
--    Just 10000000
--    (0.00 secs, 1554932 bytes)

-- Solución del problema
-- =====================

soluciones :: [Integer]
soluciones = [x | x <- [121..]
                , isJust (esProductoDeNconsecutivos2 4 x)
                , isJust (esProductoDeNconsecutivos2 3 x)]

-- El cálculo es
--    λ> head soluciones
--    175560
--    λ> esProductoDeNconsecutivos2 4 175560
--    Just 19
--    λ> esProductoDeNconsecutivos2 3 175560
--    Just 55
--    λ> product [19,20,21,22] 
--    175560
--    λ> product [55,56,57]
--    175560
--    λ> product [19,20,21,22] == product [55,56,57]
--    True

-- Se puede definir una función para automatizar el proceso anterior:
soluciones2 :: [(Integer,[Integer],[Integer])]
soluciones2 = [(x,[a..a+3],[b..b+2]) 
               | x <- [121..]
               , let y = esProductoDeNconsecutivos2 4 x
               , isJust y
               , let z = esProductoDeNconsecutivos2 3 x
               , isJust z
               , let a = fromJust y
               , let b = fromJust z
               ]

-- El cálculo es 
--    λ> head soluciones2
--    (175560,[19,20,21,22],[55,56,57])

import Data.Maybe

-- 1ª definición

esProductoDeNconsecutivos1 :: Integer -> Integer -> Maybe Integer

esProductoDeNconsecutivos1 n x

| null productos = Nothing

| otherwise = Just (head productos)

where productos = [m | m <- [1..x-n], product [m..m+n-1] == x]

-- 2ª definición

esProductoDeNconsecutivos2 :: Integer -> Integer -> Maybe Integer

esProductoDeNconsecutivos2 n x = aux k

where k = floor (fromIntegral x ** (1/(fromIntegral n))) - (n `div` 2)

aux m | y == x = Just m

| y < x = aux (m+1)

| otherwise = Nothing

where y = product [m..m+n-1]

-- Comparación de eficiencia

-- λ> esProductoDeNconsecutivos1 3 (product [10^7..2+10^7])

-- Just 10000000

-- (12.37 secs, 5678433692 bytes)

-- λ> esProductoDeNconsecutivos2 3 (product [10^7..2+10^7])

-- Just 10000000

-- (0.00 secs, 1554932 bytes)

-- Solución del problema

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

soluciones :: [Integer]

soluciones = [x | x <- [121..]

, isJust (esProductoDeNconsecutivos2 4 x)

, isJust (esProductoDeNconsecutivos2 3 x)]

-- El cálculo es

-- λ> head soluciones

-- 175560

-- λ> esProductoDeNconsecutivos2 4 175560

-- Just 19

-- λ> esProductoDeNconsecutivos2 3 175560

-- Just 55

-- λ> product [19,20,21,22]

-- 175560

-- λ> product [55,56,57]

-- 175560

-- λ> product [19,20,21,22] == product [55,56,57]

-- True

-- Se puede definir una función para automatizar el proceso anterior:

soluciones2 :: [(Integer,[Integer],[Integer])]

soluciones2 = [(x,[a..a+3],[b..b+2])

| x <- [121..]

, let y = esProductoDeNconsecutivos2 4 x

, isJust y

, let z = esProductoDeNconsecutivos2 3 x

, isJust z

, let a = fromJust y

, let b = fromJust z

]

-- El cálculo es

-- λ> head soluciones2

-- (175560,[19,20,21,22],[55,56,57])

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.

Siguiente elemento en una lista

PorJosé A. Alonso 2-febrero-201526-marzo-2022

Definir la función

   siguiente :: Eq a => a -> [a] -> Maybe a

1	siguiente :: Eq a => a -> [a] -> Maybe a

tal que (siguiente x ys) es justo el elemento siguiente a la primera ocurrencia de x en ys o Nothing si x no pertenece a ys. Por ejemplo,

   siguiente 5 [3,5,2,5,7]                       ==  Just 2
   siguiente 9 [3,5,2,5,7]                       ==  Nothing
   siguiente 'd' "afdegdb"                       ==  Just 'e'
   siguiente "todo" ["En","todo","la","medida"]  ==  Just "la"
   siguiente "nada" ["En","todo","la","medida"]  ==  Nothing
   siguiente 999999 [1..1000000]                 ==  Just 1000000
   siguiente 1000000 [1..1000000]                ==  Nothing

siguiente 5 [3,5,2,5,7] == Just 2

siguiente 9 [3,5,2,5,7] == Nothing

siguiente 'd' "afdegdb" == Just 'e'

siguiente "todo" ["En","todo","la","medida"] == Just "la"

siguiente "nada" ["En","todo","la","medida"] == Nothing

siguiente 999999 [1..1000000] == Just 1000000

siguiente 1000000 [1..1000000] == Nothing

Soluciones

import Data.Maybe (listToMaybe) -- Para la 4ª solución

-- 1ª solución (por recursión):
siguiente1 :: Eq a => a -> [a] -> Maybe a
siguiente1 x (y1:y2:ys) | x == y1   = Just y2
                        | otherwise = siguiente1 x (y2:ys)
siguiente1 x _ = Nothing

-- 2ª solución (por comprensión):
siguiente2 :: Eq a => a -> [a] -> Maybe a
siguiente2 x ys 
    | null zs   = Nothing
    | otherwise = Just (snd (head zs))
    where zs = [(u,v) | (u,v) <- zip ys (tail ys), u == x]  

-- 3ª solución (con dropWhile)
siguiente3 :: Eq a => a -> [a] -> Maybe a
siguiente3 x = aux . drop 1 . dropWhile (/=x)
    where aux []    = Nothing
          aux (y:_) = Just y

-- 4ª solución (con dropWhile y listToMaybe):
siguiente4 :: Eq a => a -> [a] -> Maybe a
siguiente4 x = listToMaybe . drop 1 . dropWhile (/=x)

-- Nota: En la librería Data.Maybe está definida la función 
--    listToMaybe :: [a] -> Maybe a 
-- tal que (listToMaybe xs) es Nothing si la lista xs está vacía y es
-- justo el primer elemento, en caso contrario, Por ejemplo,
--    listToMaybe []       ==  Nothing
--    listToMaybe [3,2,5]  ==  Just 3

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

-- La comparación es
--    ghci> let n=10^6 in siguiente1 (n-1) [1..n]
--    Just 1000000
--    (1.34 secs, 277352616 bytes)
--    
--    ghci> let n=10^6 in siguiente2 (n-1) [1..n]
--    Just 1000000
--    (1.45 secs, 340836576 bytes)
--    
--    ghci> let n=10^6 in siguiente3 (n-1) [1..n]
--    Just 1000000
--    (0.26 secs, 84987544 bytes)
--    
--    ghci> let n=10^6 in siguiente4 (n-1) [1..n]
--    Just 1000000
--    (0.26 secs, 84987440 bytes)

import Data.Maybe (listToMaybe) -- Para la 4ª solución

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

siguiente1 :: Eq a => a -> [a] -> Maybe a

siguiente1 x (y1:y2:ys) | x == y1 = Just y2

| otherwise = siguiente1 x (y2:ys)

siguiente1 x _ = Nothing

-- 2ª solución (por comprensión):

siguiente2 :: Eq a => a -> [a] -> Maybe a

siguiente2 x ys

| null zs = Nothing

| otherwise = Just (snd (head zs))

where zs = [(u,v) | (u,v) <- zip ys (tail ys), u == x]

-- 3ª solución (con dropWhile)

siguiente3 :: Eq a => a -> [a] -> Maybe a

siguiente3 x = aux . drop 1 . dropWhile (/=x)

where aux [] = Nothing

aux (y:_) = Just y

-- 4ª solución (con dropWhile y listToMaybe):

siguiente4 :: Eq a => a -> [a] -> Maybe a

siguiente4 x = listToMaybe . drop 1 . dropWhile (/=x)

-- Nota: En la librería Data.Maybe está definida la función

-- listToMaybe :: [a] -> Maybe a

-- tal que (listToMaybe xs) es Nothing si la lista xs está vacía y es

-- justo el primer elemento, en caso contrario, Por ejemplo,

-- listToMaybe [] == Nothing

-- listToMaybe [3,2,5] == Just 3

-- Comparación de eficiencia

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

-- La comparación es

-- ghci> let n=10^6 in siguiente1 (n-1) [1..n]

-- Just 1000000

-- (1.34 secs, 277352616 bytes)

-- ghci> let n=10^6 in siguiente2 (n-1) [1..n]

-- Just 1000000

-- (1.45 secs, 340836576 bytes)

-- ghci> let n=10^6 in siguiente3 (n-1) [1..n]

-- Just 1000000

-- (0.26 secs, 84987544 bytes)

-- ghci> let n=10^6 in siguiente4 (n-1) [1..n]

-- Just 1000000

-- (0.26 secs, 84987440 bytes)

División según una propiedad

PorJosé A. Alonso 28-enero-20154-febrero-2015

Enunciado

Definir la función

   divideSegun :: (a -> Bool) -> [a] -> [[a]]

1	divideSegun :: (a -> Bool) -> [a] -> [[a]]

tal que (divideSegun p xs) es la lista de los segmentos de xs cuyos elementos no cumplen la propiedad p. Por ejemplo,

   divideSegun even [3,5,2,7,6,8,9,1]  ==  [[3,5],[7],[9,1]]
   divideSegun odd  [3,5,2,7,6,8,9,1]  ==  [[2],[6,8]]

1 2	divideSegun even [3,5,2,7,6,8,9,1] == [[3,5],[7],[9,1]] divideSegun odd [3,5,2,7,6,8,9,1] == [[2],[6,8]]

Comprobar con QuickCheck que, para cualquier lista xs de números enteros, la concatenación de los elementos de (divideSegun even xs) es la lista de los elementos de xs que no son pares.

Soluciones

import Test.QuickCheck

divideSegun :: (a -> Bool) -> [a] -> [[a]]
divideSegun p xs 
    | null ys   = []
    | otherwise = ys : divideSegun p zs
    where (ys,zs) = break p (dropWhile p xs)

-- La propiedad es
prop_divideSegun :: [Int] -> Bool
prop_divideSegun xs =
    concat (divideSegun even xs) == filter (not . even) xs

-- La comprobación es 
--    ghci> quickCheck prop_divideSegun
--    +++ OK, passed 100 tests.

import Test.QuickCheck

divideSegun :: (a -> Bool) -> [a] -> [[a]]

divideSegun p xs

| null ys = []

| otherwise = ys : divideSegun p zs

where (ys,zs) = break p (dropWhile p xs)

-- La propiedad es

prop_divideSegun :: [Int] -> Bool

prop_divideSegun xs =

concat (divideSegun even xs) == filter (not . even) xs

-- La comprobación es

-- ghci> quickCheck prop_divideSegun

-- +++ OK, passed 100 tests.

2015 y los números con factorización capicúa

PorJosé A. Alonso 1-enero-20151-mayo-2016

Un número tiene factorización capicúa si puede escribir como un producto de números primos tal que la concatenación de sus dígitos forma un número capicúa. Por ejemplo, el 2015 tiene factorización capicúa ya que 2015 = 13·5·31, los factores son primos y su concatenación es 13531 que es capicúa.

Definir la sucesión

   conFactorizacionesCapicuas :: [Int]

1	conFactorizacionesCapicuas :: [Int]

formada por los números que tienen factorización capicúa. Por ejemplo,

   ghci> take 20 conFactorizacionesCapicuas
   [1,2,3,4,5,7,8,9,11,12,16,18,20,25,27,28,32,36,39,44]

1 2	ghci> take 20 conFactorizacionesCapicuas [1,2,3,4,5,7,8,9,11,12,16,18,20,25,27,28,32,36,39,44]

Usando conFactorizacionesCapicuas escribir expresiones cuyos valores sean las respuestas a las siguientes preguntas y calcularlas

¿Qué lugar ocupa el 2015 en la sucesión?
¿Cuál fue el anterior año con factorización capicúa?
¿Cuál será el siguiente año con factorización capicúa?

Soluciones

import Data.List (permutations)

conFactorizacionesCapicuas :: [Int]
conFactorizacionesCapicuas =
    [n | n <- [1..], not (null (factorizacionesCapicua n))]

-- (factorizacionesCapicua n) es la lista de las factorizaciones
-- capicúas de n. Por ejemplo,
--    factorizacionesCapicua 2015  ==  [[13,5,31],[31,5,13]]
factorizacionesCapicua :: Int -> [[Int]]
factorizacionesCapicua n =
    [xs | xs <- permutations (factorizacion n),
          esCapicuaConcatenacion xs]

-- (factorizacion n) es la lista de todos los factores primos de n; es
-- decir, es una lista de números primos cuyo producto es n. Por ejemplo,
--    factorizacion 300  ==  [2,2,3,5,5]
factorizacion :: Int -> [Int]
factorizacion n | n == 1    = []
                | otherwise = x : factorizacion (div n x)
    where x = menorFactor n

-- (menorFactor n) es el menor factor primo de n. Por ejemplo,
--    menorFactor 15  ==  3
--    menorFactor 16  ==  2
--    menorFactor 17  == 17
menorFactor :: Int -> Int
menorFactor n = head [x | x <- [2..], rem n x == 0]

-- (esCapicuaConcatenacion xs) se verifica si la concatenación de los
-- números de xs es capicúa. Por ejemplo,
--    esCapicuaConcatenacion [13,5,31]   ==  True
--    esCapicuaConcatenacion [135,31]    ==  True
--    esCapicuaConcatenacion [135,21]    ==  False
esCapicuaConcatenacion :: [Int] -> Bool
esCapicuaConcatenacion xs = ys == reverse ys
    where ys = concat (map show xs)

-- El cálculo de la 1ª respuesta es
--    ghci> length (takeWhile (<= 2015) conFactorizacionesCapicuas)
--    265

-- El cálculo de la 2ª respuesta es
--    ghci> last (takeWhile (<2015) conFactorizacionesCapicuas)
--    2001

-- El cálculo de la 3ª respuesta es
--    ghci> head (dropWhile (<=2015) conFactorizacionesCapicuas)
--    2023

import Data.List (permutations)

conFactorizacionesCapicuas :: [Int]

conFactorizacionesCapicuas =

[n | n <- [1..], not (null (factorizacionesCapicua n))]

-- (factorizacionesCapicua n) es la lista de las factorizaciones

-- capicúas de n. Por ejemplo,

-- factorizacionesCapicua 2015 == [[13,5,31],[31,5,13]]

factorizacionesCapicua :: Int -> [[Int]]

factorizacionesCapicua n =

[xs | xs <- permutations (factorizacion n),

esCapicuaConcatenacion xs]

-- (factorizacion n) es la lista de todos los factores primos de n; es

-- decir, es una lista de números primos cuyo producto es n. Por ejemplo,

-- factorizacion 300 == [2,2,3,5,5]

factorizacion :: Int -> [Int]

factorizacion n | n == 1 = []

| otherwise = x : factorizacion (div n x)

where x = menorFactor n

-- (menorFactor n) es el menor factor primo de n. Por ejemplo,

-- menorFactor 15 == 3

-- menorFactor 16 == 2

-- menorFactor 17 == 17

menorFactor :: Int -> Int

menorFactor n = head [x | x <- [2..], rem n x == 0]

-- (esCapicuaConcatenacion xs) se verifica si la concatenación de los

-- números de xs es capicúa. Por ejemplo,

-- esCapicuaConcatenacion [13,5,31] == True

-- esCapicuaConcatenacion [135,31] == True

-- esCapicuaConcatenacion [135,21] == False

esCapicuaConcatenacion :: [Int] -> Bool

esCapicuaConcatenacion xs = ys == reverse ys

where ys = concat (map show xs)

-- El cálculo de la 1ª respuesta es

-- ghci> length (takeWhile (<= 2015) conFactorizacionesCapicuas)

-- 265

-- El cálculo de la 2ª respuesta es

-- ghci> last (takeWhile (<2015) conFactorizacionesCapicuas)

-- 2001

-- El cálculo de la 3ª respuesta es

-- ghci> head (dropWhile (<=2015) conFactorizacionesCapicuas)

-- 2023

2015 como raíz cuadrada de la suma de tres cubos

PorJosé A. Alonso 19-diciembre-20141-mayo-2016

Todos los años, en las proximidades del final de año suelen aparecer cuestiones con propiedades del número del nuevo año. Una sobre el 2015 es la publicada el martes en la entrada 2015 como raíz de la suma de tres cubos del blog Números y algo más en la que se pide calcular tres números tales que 2015 sea igual a la raíz cuadrada de la suma de dichos tres números.

A partir de dicha entrada, se propone el siguiente problema: Definir la sucesión

   raicesCuadradasDeSumasDe3Cubos :: [Integer]

1	raicesCuadradasDeSumasDe3Cubos :: [Integer]

cuyos elementos son los números que se pueden escribir como raíces cuadradas de sumas de tres cubos. Por ejemplo,

   take 9 raicesCuadradasDeSumasDe3Cubos = [6,9,15,27,48,72,53,59,78]

1	take 9 raicesCuadradasDeSumasDe3Cubos = [6,9,15,27,48,72,53,59,78]

El 6 está en la sucesión porque 1³+2³+3³ = 36 y la raíz cuadrada de36 es 6 y el 9 está porque 3³+3³+3³ = 81 y la raíz cuadrada de 81 es 9. Algunos números tienen varias descomposiones como raíz cuadrada de suma de tres cubos; por ejemplo, el 71 se puede escribir como la raíz cuadrada de la suma de los cubos de 6, 9 y 16 y también como la de 4, 4, y 17.

A partir de la sucesión se plantean las siguientes cuestiones:

¿Qué lugar ocupa el 2015 en la sucesión?
¿Cuál será el próximo año que se podrá escribir como la raíz cuadrada de suma de tres cubos?
¿Cuáles son las descomposiciones de 2015 como raíz cuadrada de suma de tres cubos?
¿Cuáles son los años hasta el 2015 que se pueden escribir como raíz cuadrada de suma de tres cubos de más formas distintas?

Soluciones

import Data.List (sort)

raicesCuadradasDeSumasDe3Cubos :: [Integer]
raicesCuadradasDeSumasDe3Cubos =
    [n | n <- [1..], not (null (descomposiciones n))]

-- (descomposiciones n) es la lista de ternas de números tales que n es la
-- raíz cuadrada de la suma de los cubos de los tres números de la
-- terna. Por ejemplo,
--    descomposiciones  6  ==  [(1,2,3)]
--    descomposiciones  9  ==  [(3,3,3)]
--    descomposiciones 71  ==  [(6,9,16),(4,4,17)]
descomposiciones :: Integer -> [(Integer,Integer,Integer)]
descomposiciones n = 
    [(a,b,c) | c <- [1..floor ((fromIntegral (n*n))**(1/3))],
               b <- [1..c],
               let d = n^2 - c^3 - b^3,
               d > 0,
               let a = round ((fromIntegral d)**(1/3)),
               a <= b,
               a^3 == d]    

-- El cálculo de la posición de 2015 es
--    ghci> length (takeWhile (<=2015) raicesCuadradasDeSumasDe3Cubos)
--    343

-- El cálculo del próximo año expresable como la raízcuadrada de la suma
-- de tres cubos es
--    ghci> head (dropWhile (<=2015) raicesCuadradasDeSumasDe3Cubos)
--    2022

-- (masDescomponibles xs) es la lista de elementos de xs que se pueden
-- escribir de más formas como raíz cuadrada de suma de tres cubos.
masDescomponibles :: [Integer] -> [Integer]
masDescomponibles xs =
    [y | (x,y) <- takeWhile (\p -> fst p == u) zs]
    where zs = reverse (sort [(length (descomposiciones x),x) | x <- xs])
          u  = fst (head zs)

-- El cálculo de los años hasta el 2015 con mayor número de
-- descomposiciones es
--    ghci> masDescomponibles (takeWhile (<=2015) raicesCuadradasDeSumasDe3Cubos)
--    [1728]

import Data.List (sort)

raicesCuadradasDeSumasDe3Cubos :: [Integer]

raicesCuadradasDeSumasDe3Cubos =

[n | n <- [1..], not (null (descomposiciones n))]

-- (descomposiciones n) es la lista de ternas de números tales que n es la

-- raíz cuadrada de la suma de los cubos de los tres números de la

-- terna. Por ejemplo,

-- descomposiciones 6 == [(1,2,3)]

-- descomposiciones 9 == [(3,3,3)]

-- descomposiciones 71 == [(6,9,16),(4,4,17)]

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

descomposiciones n =

[(a,b,c) | c <- [1..floor ((fromIntegral (n*n))**(1/3))],

b <- [1..c],

let d = n^2 - c^3 - b^3,

d > 0,

let a = round ((fromIntegral d)**(1/3)),

a <= b,

a^3 == d]

-- El cálculo de la posición de 2015 es

-- ghci> length (takeWhile (<=2015) raicesCuadradasDeSumasDe3Cubos)

-- 343

-- El cálculo del próximo año expresable como la raízcuadrada de la suma

-- de tres cubos es

-- ghci> head (dropWhile (<=2015) raicesCuadradasDeSumasDe3Cubos)

-- 2022

-- (masDescomponibles xs) es la lista de elementos de xs que se pueden

-- escribir de más formas como raíz cuadrada de suma de tres cubos.

masDescomponibles :: [Integer] -> [Integer]

masDescomponibles xs =

[y | (x,y) <- takeWhile (\p -> fst p == u) zs]

where zs = reverse (sort [(length (descomposiciones x),x) | x <- xs])

u = fst (head zs)

-- El cálculo de los años hasta el 2015 con mayor número de

-- descomposiciones es

-- ghci> masDescomponibles (takeWhile (<=2015) raicesCuadradasDeSumasDe3Cubos)

-- [1728]

Elementos adicionales

PorJosé A. Alonso 17-diciembre-201427-diciembre-2014

Enunciado

-- Definir la función
--    adicionales :: Ord a => Int -> [a] -> [a] -> [a]
-- tal que (adicionales n xs ys) es la lista de los n elementos de xs
-- que no pertenecen a ys (se supone que las listas xs e ys están
-- ordenadas y que pueden ser infinitas). Por ejemplo, 
--    adicionales 0 [1,3]   [1,3]                  ==  []
--    adicionales 1 [1,3]   [1]                    ==  [3]
--    adicionales 2 [1,3,5] [1]                    ==  [3,5]
--    adicionales 2 [1,3,5,7,9] [1,5,7]            ==  [3,9]
--    adicionales 2 ([1,3,5]++[7..]) ([1]++[7..])  ==  [3,5]

-- Definir la función

-- adicionales :: Ord a => Int -> [a] -> [a] -> [a]

-- tal que (adicionales n xs ys) es la lista de los n elementos de xs

-- que no pertenecen a ys (se supone que las listas xs e ys están

-- ordenadas y que pueden ser infinitas). Por ejemplo,

-- adicionales 0 [1,3] [1,3] == []

-- adicionales 1 [1,3] [1] == [3]

-- adicionales 2 [1,3,5] [1] == [3,5]

-- adicionales 2 [1,3,5,7,9] [1,5,7] == [3,9]

-- adicionales 2 ([1,3,5]++[7..]) ([1]++[7..]) == [3,5]

Soluciones

-- 1ª definición (por recursión)
adicionales1 :: Ord a => Int -> [a] -> [a] -> [a]
adicionales1 0 _  _  = []
adicionales1 _ xs [] = xs
adicionales1 n (x:xs) (y:ys) 
    | x <  y    = x : adicionales1 (n-1) xs (y:ys)
    | x == y    = adicionales1 n xs ys
    | otherwise = adicionales1 n (x:xs) ys

-- 2ª definición (por comprensión):
adicionales2 :: Ord a => Int -> [a] -> [a] -> [a]
adicionales2 n xs ys =
    take n [x | x <- xs, x `noPertenece` ys]

-- (noPertenece x ys) se verifica si x no pertenece a la lista ordenada 
-- (posiblemente infinita ys). Por ejemplo.
--    noPertenece 2 [3,5]    ==  True
--    noPertenece 4 [3,5]    ==  True
--    noPertenece 7 [3,5]    ==  True
--    noPertenece 4 [3,5..]  ==  True
noPertenece :: Ord a => a -> [a] -> Bool
noPertenece x ys = null zs || head zs /= x
    where zs = dropWhile (<x) ys

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

adicionales1 :: Ord a => Int -> [a] -> [a] -> [a]

adicionales1 0 _ _ = []

adicionales1 _ xs [] = xs

adicionales1 n (x:xs) (y:ys)

| x < y = x : adicionales1 (n-1) xs (y:ys)

| x == y = adicionales1 n xs ys

| otherwise = adicionales1 n (x:xs) ys

-- 2ª definición (por comprensión):

adicionales2 :: Ord a => Int -> [a] -> [a] -> [a]

adicionales2 n xs ys =

take n [x | x <- xs, x `noPertenece` ys]

-- (noPertenece x ys) se verifica si x no pertenece a la lista ordenada

-- (posiblemente infinita ys). Por ejemplo.

-- noPertenece 2 [3,5] == True

-- noPertenece 4 [3,5] == True

-- noPertenece 7 [3,5] == True

-- noPertenece 4 [3,5..] == True

noPertenece :: Ord a => a -> [a] -> Bool

noPertenece x ys = null zs || head zs /= x

where zs = dropWhile (<x) ys

Números que sumados a su siguiente primo dan primos

PorJosé A. Alonso 11-diciembre-201425-marzo-2022

Introducción

La Enciclopedia electrónica de sucesiones de enteros (OEIS por sus siglas en inglés, de On-Line Encyclopedia of Integer Sequences) es una base de datos que registra sucesiones de números enteros. Está disponible libremente en Internet, en la dirección http://oeis.org.

La semana pasada Antonio Roldán añadió una nueva sucesión a la OEIS, la A249624 que sirve de base para el problema de hoy.

Enunciado

-- Definir la sucesión
--     a249624 :: [Integer]
-- tal que sus elementos son los números x tales que la suma de x y el
-- primo que le sigue es un número primo. Por ejemplo, 
--    ghci> take 20 a249624
--    [0,1,2,6,8,14,18,20,24,30,34,36,38,48,50,54,64,68,78,80]
-- 
-- El número 8 está en la sucesión porque su siguiente primo es 11 y
-- 8+11=19 es primo. El 12 no está en la sucesión porque su siguiente
-- primo es 13 y 12+13=25 no es primo.

-- Definir la sucesión

-- a249624 :: [Integer]

-- tal que sus elementos son los números x tales que la suma de x y el

-- primo que le sigue es un número primo. Por ejemplo,

-- ghci> take 20 a249624

-- [0,1,2,6,8,14,18,20,24,30,34,36,38,48,50,54,64,68,78,80]

-- El número 8 está en la sucesión porque su siguiente primo es 11 y

-- 8+11=19 es primo. El 12 no está en la sucesión porque su siguiente

-- primo es 13 y 12+13=25 no es primo.

Soluciones

import Data.Numbers.Primes (primes, isPrime)
import Data.List (genericReplicate)

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

a249624 :: [Integer]
a249624 = 0: 1: [x | x <- [2,4..], primo (x + siguientePrimo x)]

primo :: Integer -> Bool
primo x = [y | y <- [1..x], x `rem` y == 0] == [1,x]

siguientePrimo :: Integer -> Integer
siguientePrimo x = head [y | y <- [x+1..], primo y]

-- 2ª definición (por recursión)
-- =============================

a249624b :: [Integer]
a249624b = 0 : 1 : 2: aux [2,4..] primos where
    aux (x:xs) (y:ys) 
        | y < x                = aux (x:xs) ys
        | (x+y) `pertenece` ys = x : aux xs (y:ys)
        | otherwise            = aux xs (y:ys)
    pertenece x ys = x == head (dropWhile (<x) ys)

primos :: [Integer]
primos = 2 : [x | x <- [3,5..], primo x]

-- 3ª definición (con la librería de primos)
-- =========================================

a249624c :: [Integer]
a249624c = 0: 1: [x | x <- [2,4..], isPrime (x + siguientePrimo3 x)]

siguientePrimo3 x = head [y | y <- [x+1..], isPrime y]

-- 4ª definición (por recursión con la librería de primos)
-- =======================================================

a249624d :: [Integer]
a249624d = 0 : 1 : 2: aux [2,4..] primes where
    aux (x:xs) (y:ys) 
        | y < x                = aux (x:xs) ys
        | (x+y) `pertenece` ys = x : aux xs (y:ys)
        | otherwise            = aux xs (y:ys)
    pertenece x ys = x == head (dropWhile (<x) ys)

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

a249624e :: [Integer]
a249624e = [a | q <- primes, 
                let p = siguientePrimo3 (q `div` 2),
                let a = q-p,
                siguientePrimo3 a == p]

-- 6ª definición
-- =============

a249624f :: [Integer]
a249624f = [x | (x,y) <- zip [0..] ps, isPrime (x+y)]
    where ps = 2:2:concat (zipWith f primes (tail primes))
          f p q = genericReplicate (q-p) q

-- 7ª definición
-- =============

a249624g :: [Integer]
a249624g = 0:1:(aux primes (tail primes) primes)
    where aux (x:xs) (y:ys) zs
              | null rs   = aux xs ys zs2
              | otherwise = [r-y | r <- rs] ++ (aux xs ys zs2)
              where a = x+y
                    b = 2*y-1
                    zs1 = takeWhile (<=b) zs
                    rs = [r | r <- [a..b], r `elem` zs1]
                    zs2 = dropWhile (<=b) zs

-- ---------------------------------------------------------------------
-- § Comparación de eficiencia                                        --
-- ---------------------------------------------------------------------

-- La comparación es
--    ghci> :set +s
--    
--    ghci> a249624 !! 700
--    5670
--    (12.72 secs, 1245938184 bytes)
--    
--    ghci> a249624b !! 700
--    5670
--    (8.01 secs, 764775268 bytes)
-- 
--    ghci> a249624c !! 700
--    5670
--    (0.22 secs, 108982640 bytes)
--    
--    ghci> a249624d !! 700
--    5670
--    (0.20 secs, 4707384 bytes)
--    
--    ghci> a249624e !! 700
--    5670
--    (0.17 secs, 77283064 bytes)
--    
--    ghci> a249624f !! 700
--    5670
--    (0.08 secs, 31684408 bytes)
--    
--    ghci> a249624g !! 700
--    5670
--    (0.03 secs, 4651576 bytes)

100

101

102

103

104

105

106

107

108

109

110

111

112

113

import Data.Numbers.Primes (primes, isPrime)

import Data.List (genericReplicate)

-- 1ª definición

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

a249624 :: [Integer]

a249624 = 0: 1: [x | x <- [2,4..], primo (x + siguientePrimo x)]

primo :: Integer -> Bool

primo x = [y | y <- [1..x], x `rem` y == 0] == [1,x]

siguientePrimo :: Integer -> Integer

siguientePrimo x = head [y | y <- [x+1..], primo y]

-- 2ª definición (por recursión)

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

a249624b :: [Integer]

a249624b = 0 : 1 : 2: aux [2,4..] primos where

aux (x:xs) (y:ys)

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

| (x+y) `pertenece` ys = x : aux xs (y:ys)

| otherwise = aux xs (y:ys)

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

primos :: [Integer]

primos = 2 : [x | x <- [3,5..], primo x]

-- 3ª definición (con la librería de primos)

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

a249624c :: [Integer]

a249624c = 0: 1: [x | x <- [2,4..], isPrime (x + siguientePrimo3 x)]

siguientePrimo3 x = head [y | y <- [x+1..], isPrime y]

-- 4ª definición (por recursión con la librería de primos)

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

a249624d :: [Integer]

a249624d = 0 : 1 : 2: aux [2,4..] primes where

aux (x:xs) (y:ys)

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

| (x+y) `pertenece` ys = x : aux xs (y:ys)

| otherwise = aux xs (y:ys)

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

-- 5ª definición

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

a249624e :: [Integer]

a249624e = [a | q <- primes,

let p = siguientePrimo3 (q `div` 2),

let a = q-p,

siguientePrimo3 a == p]

-- 6ª definición

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

a249624f :: [Integer]

a249624f = [x | (x,y) <- zip [0..] ps, isPrime (x+y)]

where ps = 2:2:concat (zipWith f primes (tail primes))

f p q = genericReplicate (q-p) q

-- 7ª definición

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

a249624g :: [Integer]

a249624g = 0:1:(aux primes (tail primes) primes)

where aux (x:xs) (y:ys) zs

| null rs = aux xs ys zs2

| otherwise = [r-y | r <- rs] ++ (aux xs ys zs2)

where a = x+y

b = 2*y-1

zs1 = takeWhile (<=b) zs

rs = [r | r <- [a..b], r `elem` zs1]

zs2 = dropWhile (<=b) zs

-- ---------------------------------------------------------------------

-- § Comparación de eficiencia --

-- ---------------------------------------------------------------------

-- La comparación es

-- ghci> :set +s

-- ghci> a249624 !! 700

-- 5670

-- (12.72 secs, 1245938184 bytes)

-- ghci> a249624b !! 700

-- 5670

-- (8.01 secs, 764775268 bytes)

-- ghci> a249624c !! 700

-- 5670

-- (0.22 secs, 108982640 bytes)

-- ghci> a249624d !! 700

-- 5670

-- (0.20 secs, 4707384 bytes)

-- ghci> a249624e !! 700

-- 5670

-- (0.17 secs, 77283064 bytes)

-- ghci> a249624f !! 700

-- 5670

-- (0.08 secs, 31684408 bytes)

-- ghci> a249624g !! 700

-- 5670

-- (0.03 secs, 4651576 bytes)

Llanuras de longitud dada

PorJosé A. Alonso 4-diciembre-20141-mayo-2016

Enunciado

-- Una llanura de longitud n de una lista xs es una sublista de xs
-- formada por n elementos iguales.
--
-- Definir la función
--    llanuras :: Eq a => Int -> [a] -> [[a]]
-- tal que (llanuras n xs) es la lista de las llanuras de xs que tienen
-- n elementos como mínimo. Por ejemplo,
--    llanuras 3 "aabbbcddddffxffxx"  ==  ["bbb","dddd"]

-- Una llanura de longitud n de una lista xs es una sublista de xs

-- formada por n elementos iguales.

-- Definir la función

-- llanuras :: Eq a => Int -> [a] -> [[a]]

-- tal que (llanuras n xs) es la lista de las llanuras de xs que tienen

-- n elementos como mínimo. Por ejemplo,

-- llanuras 3 "aabbbcddddffxffxx" == ["bbb","dddd"]

Soluciones

import Data.List (group)
import Test.QuickCheck

-- 1ª definición (por comprensión):
llanuras :: Eq a => Int -> [a] -> [[a]]
llanuras n xs = [ys | ys <- group xs, length ys >= n] 

-- 2ª definición (por recursión con takeWhile y dropWhile):
llanuras2 :: Eq a => Int -> [a] -> [[a]]
llanuras2 _ [] = []
llanuras2 n xs@(x:_) 
    | length ys >= n = ys : llanuras2 n (dropWhile (x==) xs) 
    | otherwise      = llanuras2 n (dropWhile (x==) xs) 
    where ys = takeWhile (x==) xs

-- 3ª definición (por recursión con span):
llanuras3 :: Eq a => Int -> [a] -> [[a]]
llanuras3 _ [] = []
llanuras3 n xs@(x:_) 
    | length ys >= n = ys : llanuras3 n zs
    | otherwise      = llanuras3 n zs
    where (ys,zs) = span (x==) xs

-- 4ª definición (por recursión con span):
llanuras4 :: Eq a => Int -> [a] -> [[a]]
llanuras4 n = aux where
    aux [] = []
    aux xs@(x:_) | length ys >= n = ys : llanuras4 n zs
                 | otherwise      = llanuras4 n zs
                 where (ys,zs) = span (x==) xs

-- ---------------------------------------------------------------------
-- § Verificación                                                     --
-- ---------------------------------------------------------------------

-- Las definiciones son equivalentes
prop_equivalencia :: Int -> [Int] -> Bool
prop_equivalencia n xs =
    llanuras2 n xs == ys &&
    llanuras3 n xs == ys
    where ys = llanuras n xs

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

import Data.List (group)

import Test.QuickCheck

-- 1ª definición (por comprensión):

llanuras :: Eq a => Int -> [a] -> [[a]]

llanuras n xs = [ys | ys <- group xs, length ys >= n]

-- 2ª definición (por recursión con takeWhile y dropWhile):

llanuras2 :: Eq a => Int -> [a] -> [[a]]

llanuras2 _ [] = []

llanuras2 n xs@(x:_)

| length ys >= n = ys : llanuras2 n (dropWhile (x==) xs)

| otherwise = llanuras2 n (dropWhile (x==) xs)

where ys = takeWhile (x==) xs

-- 3ª definición (por recursión con span):

llanuras3 :: Eq a => Int -> [a] -> [[a]]

llanuras3 _ [] = []

llanuras3 n xs@(x:_)

| length ys >= n = ys : llanuras3 n zs

| otherwise = llanuras3 n zs

where (ys,zs) = span (x==) xs

-- 4ª definición (por recursión con span):

llanuras4 :: Eq a => Int -> [a] -> [[a]]

llanuras4 n = aux where

aux [] = []

aux xs@(x:_) | length ys >= n = ys : llanuras4 n zs

| otherwise = llanuras4 n zs

where (ys,zs) = span (x==) xs

-- ---------------------------------------------------------------------

-- § Verificación --

-- ---------------------------------------------------------------------

-- Las definiciones son equivalentes

prop_equivalencia :: Int -> [Int] -> Bool

prop_equivalencia n xs =

llanuras2 n xs == ys &&

llanuras3 n xs == ys

where ys = llanuras n xs

-- La comprobación es

-- ghci> quickCheck prop_equivalencia

-- +++ OK, passed 100 tests.

Referencias

Esté ejercicio está basado en el problema Llanura de números iguales con longitud igual a n propuesto Solveet!

Último dígito no nulo del factorial

PorJosé A. Alonso 14-noviembre-201425-abril-2021

Enunciado

-- El factorial de 7 es
--    7! = 1 * 2 * 3 * 4 * 5 * 6 * 7 = 5040
-- por tanto, el último dígito no nulo del factorial de 7 es 4.
-- 
-- Definir la función
--    ultimoNoNuloFactorial :: Integer -> Integer
-- tal que (ultimoNoNuloFactorial n) es el último dígito no nulo del
-- factorial de n. Por ejemplo,
--    ultimoNoNuloFactorial  7  == 4
--    ultimoNoNuloFactorial 10  == 8
--    ultimoNoNuloFactorial 12  == 6
--    ultimoNoNuloFactorial 97  == 2
--    ultimoNoNuloFactorial  0  == 1
--
-- Comprobar con QuickCheck que si n es mayor que 4, entonces el último
-- dígito no nulo del factorial de n es par.

-- El factorial de 7 es

-- 7! = 1 * 2 * 3 * 4 * 5 * 6 * 7 = 5040

-- por tanto, el último dígito no nulo del factorial de 7 es 4.

-- Definir la función

-- ultimoNoNuloFactorial :: Integer -> Integer

-- tal que (ultimoNoNuloFactorial n) es el último dígito no nulo del

-- factorial de n. Por ejemplo,

-- ultimoNoNuloFactorial 7 == 4

-- ultimoNoNuloFactorial 10 == 8

-- ultimoNoNuloFactorial 12 == 6

-- ultimoNoNuloFactorial 97 == 2

-- ultimoNoNuloFactorial 0 == 1

-- Comprobar con QuickCheck que si n es mayor que 4, entonces el último

-- dígito no nulo del factorial de n es par.

Soluciones

import Test.QuickCheck

ultimoNoNuloFactorial :: Integer -> Integer
ultimoNoNuloFactorial n = ultimoNoNulo (factorial n)

-- (ultimoNoNulo n) es el último dígito no nulo de n. Por ejemplo,
--    ultimoNoNulo 5040  ==  4
ultimoNoNulo :: Integer -> Integer
ultimoNoNulo n | m /= 0    = m
               | otherwise = ultimoNoNulo (n `div` 10)
               where m = n `rem` 10

-- 2ª definición (por comprensión)
ultimoNoNulo2 :: Integer -> Integer
ultimoNoNulo2 n = read [head (dropWhile (=='0') (reverse (show n)))]

-- (factorial n) es el factorial de n. Por ejemplo,
--    factorial 7  ==  5040
factorial :: Integer -> Integer
factorial n = product [1..n]


-- La propiedad es
prop_ultimoNoNuloFactorial :: Integer -> Property
prop_ultimoNoNuloFactorial n = 
    n > 4 ==> even (ultimoNoNuloFactorial n)
                  
-- La comprobación es
--    ghci> quickCheck prop_ultimoNoNuloFactorial
--    +++ OK, passed 100 tests.

import Test.QuickCheck

ultimoNoNuloFactorial :: Integer -> Integer

ultimoNoNuloFactorial n = ultimoNoNulo (factorial n)

-- (ultimoNoNulo n) es el último dígito no nulo de n. Por ejemplo,

-- ultimoNoNulo 5040 == 4

ultimoNoNulo :: Integer -> Integer

ultimoNoNulo n | m /= 0 = m

| otherwise = ultimoNoNulo (n `div` 10)

where m = n `rem` 10

-- 2ª definición (por comprensión)

ultimoNoNulo2 :: Integer -> Integer

ultimoNoNulo2 n = read [head (dropWhile (=='0') (reverse (show n)))]

-- (factorial n) es el factorial de n. Por ejemplo,

-- factorial 7 == 5040

factorial :: Integer -> Integer

factorial n = product [1..n]

-- La propiedad es

prop_ultimoNoNuloFactorial :: Integer -> Property

prop_ultimoNoNuloFactorial n =

n > 4 ==> even (ultimoNoNuloFactorial n)

-- La comprobación es

-- ghci> quickCheck prop_ultimoNoNuloFactorial

-- +++ OK, passed 100 tests.

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Referencias

Soluciones

Soluciones

Soluciones

En Maxima

Soluciones

Soluciones

Referencias

Soluciones

Soluciones

Soluciones

Enunciado

Soluciones

Soluciones

Soluciones

Enunciado

Soluciones

Introducción

Enunciado

Soluciones

Enunciado

Soluciones

Enunciado

Soluciones

Referencias

Enunciado

Soluciones

Entradas recientes

Buscar

Correo electrónico