takeWhile

Orden de divisibilidad

PorJosé A. Alonso 9-marzo-201525-abril-2021

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

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

7 es divisible por 1

74 es divisible por 2

741 es divisible por 3

7415 no es divisible por 4

Definir la función

   ordenDeDivisibilidad :: Integer -> Int

1	ordenDeDivisibilidad :: Integer -> Int

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

   ordenDeDivisibilidad 74156                      ==  3
   ordenDeDivisibilidad 3608528850368400786036725  ==  25

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

Soluciones

import Data.List (inits)

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

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

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

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

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

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

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

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

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

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

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

import Data.List (inits)

-- 1ª definición de ordenDeDivisibilidad

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

ordenDeDivisibilidad :: Integer -> Int

ordenDeDivisibilidad n =

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

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

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

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

sucDigitos :: Integer -> [Integer]

sucDigitos n =

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

where k = length (show n)

-- 2ª definición de sucDigitos

sucDigitos2 :: Integer -> [Integer]

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

where aux [] = []

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

-- 3ª definición de sucDigitos

sucDigitos3 :: Integer -> [Integer]

sucDigitos3 n =

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

where ds = show n

-- 4ª definición de sucDigitos

sucDigitos4 :: Integer -> [Integer]

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

-- 5ª definición de sucDigitos

sucDigitos5 :: Integer -> [Integer]

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

-- 6ª definición de sucDigitos

sucDigitos6 :: Integer -> [Integer]

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

-- Eficiencia de las definiciones de sucDigitos

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

-- 5001

-- (0.01 secs, 1550688 bytes)

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

-- 5001

-- (1.25 secs, 729411872 bytes)

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

-- 5001

-- (0.02 secs, 2265120 bytes)

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

-- 5001

-- (1.10 secs, 728366872 bytes)

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

-- 5001

-- (1.12 secs, 728393864 bytes)

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

-- 5001

-- (1.20 secs, 728403052 bytes)

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

-- 3000001

-- (2.73 secs, 820042696 bytes)

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

-- 3000001

-- (3.69 secs, 820043688 bytes)

-- 2ª definición de ordenDeDivisibilidad

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

ordenDeDivisibilidad :: Integer -> Int

ordenDeDivisibilidad x =

length $ takeWhile (==0) $ zipWith (mod . read) (tail $ inits $ show x) [1..]

Segmentos de longitud dada

PorJosé A. Alonso 10-febrero-20151-mayo-2016

Definir la función

   segmentos :: Int -> [a] -> [[a]]

1	segmentos :: Int -> [a] -> [[a]]

tal que (segmentos n xs) es la lista de los segmentos de longitud n de la lista xs. Por ejemplo,

   segmentos 3 [1..5]  ==  [[1,2,3],[2,3,4],[3,4,5]]

1	segmentos 3 [1..5] == [[1,2,3],[2,3,4],[3,4,5]]

Soluciones

import Data.List (tails)

-- 1ª definición (por recursión)
segmentos1 :: Int -> [a] -> [[a]]
segmentos1 n xs 
    | length xs < n = []
    | otherwise     = take n xs : segmentos1 n (tail xs)
                  
-- 2ª definición (con tails):
segmentos2 :: Int -> [a] -> [[a]]
segmentos2 n xs = 
    takeWhile (\ys -> length ys == n) (map (take n) (tails xs))

-- 3ª definición:
segmentos3 :: Int -> [a] -> [[a]]
segmentos3 n xs = 
    take (length xs - n + 1) (map (take n) (tails xs))

--    ghci> length (segmentos1 3 [1..30000])
--    29998
--    (2.99 secs, 13998816 bytes)
--    
--    ghci> length (segmentos2 3 [1..30000])
--    29998
--    (0.05 secs, 16941304 bytes)
--    
--    ghci> length (segmentos3 3 [1..30000])
--    29998
--    (0.04 secs, 10375520 bytes)
--    
--    ghci> length (segmentos2 3 [1..1000000])
--    999998
--    (0.70 secs, 498098336 bytes)
--    
--    ghci> length (segmentos3 3 [1..1000000])
--    999998
--    (0.24 secs, 273979304 bytes)

import Data.List (tails)

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

segmentos1 :: Int -> [a] -> [[a]]

segmentos1 n xs

| length xs < n = []

| otherwise = take n xs : segmentos1 n (tail xs)

-- 2ª definición (con tails):

segmentos2 :: Int -> [a] -> [[a]]

segmentos2 n xs =

takeWhile (\ys -> length ys == n) (map (take n) (tails xs))

-- 3ª definición:

segmentos3 :: Int -> [a] -> [[a]]

segmentos3 n xs =

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

-- ghci> length (segmentos1 3 [1..30000])

-- 29998

-- (2.99 secs, 13998816 bytes)

-- ghci> length (segmentos2 3 [1..30000])

-- 29998

-- (0.05 secs, 16941304 bytes)

-- ghci> length (segmentos3 3 [1..30000])

-- 29998

-- (0.04 secs, 10375520 bytes)

-- ghci> length (segmentos2 3 [1..1000000])

-- 999998

-- (0.70 secs, 498098336 bytes)

-- ghci> length (segmentos3 3 [1..1000000])

-- 999998

-- (0.24 secs, 273979304 bytes)

Posición del primer falso en un vector

PorJosé A. Alonso 29-enero-201526-marzo-2022

Excercitium

Definir la función

   posicion :: Array Int Bool -> Maybe Int

1	posicion :: Array Int Bool -> Maybe Int

tal que (posicion v) es la menor posición del vector de booleanos v cuyo valor es falso y es Nothing si todos los valores son verdaderos. Por ejemplo,

   posicion (listArray (0,4) [True,True,False,True,False]) == Just 2
   posicion (listArray (0,4) [i <= 2 | i <- [0..4]])       == Just 3
   posicion (listArray (0,4) [i <= 7 | i <- [0..4]])       == Nothing

posicion (listArray (0,4) [True,True,False,True,False]) == Just 2

posicion (listArray (0,4) [i <= 2 | i <- [0..4]]) == Just 3

posicion (listArray (0,4) [i <= 7 | i <- [0..4]]) == Nothing

Soluciones

import Data.Array 

-- 1ª definición:
posicion :: Array Int Bool -> Maybe Int
posicion v | p > n     = Nothing
           | otherwise = Just p
    where p = (length . takeWhile id . elems) v
          (_,n) = bounds v 

-- 2ª posición:
posicion2 :: Array Int Bool -> Maybe Int
posicion2 v | null xs   = Nothing
            | otherwise = Just (head xs)
    where xs = [i | i <- indices v, v!i]

import Data.Array

-- 1ª definición:

posicion :: Array Int Bool -> Maybe Int

posicion v | p > n = Nothing

| otherwise = Just p

where p = (length . takeWhile id . elems) v

(_,n) = bounds v

-- 2ª posición:

posicion2 :: Array Int Bool -> Maybe Int

posicion2 v | null xs = Nothing

| otherwise = Just (head xs)

where xs = [i | i <- indices v, v!i]

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

Enumeración de los pares de números naturales

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

Los pares de los números naturales se pueden ordenar por la suma de sus componentes y entre los pares con la misma suma elegir antes al que tiene mayos su primera componente.

Definir la función

   pares :: [(Int,Int)]

1	pares :: [(Int,Int)]

tal que pares es la lista de los pares de números naturales con el orden anterior. por ejemplo,

   ghci> take 10 pares
   [(0,0),(1,0),(0,1),(2,0),(1,1),(0,2),(3,0),(2,1),(1,2),(0,3)]

1 2	ghci> take 10 pares [(0,0),(1,0),(0,1),(2,0),(1,1),(0,2),(3,0),(2,1),(1,2),(0,3)]

Usando la definición de pares, definir la función

   posicion :: (Int,Int) -> Int

1	posicion :: (Int,Int) -> Int

tal que (posicion p) es la posición del par p en la lista pares. Por ejemplo,

   posicion (0,0)  ==  0
   posicion (2,0)  ==  3

1 2	posicion (0,0) == 0 posicion (2,0) == 3

Finalmente, comprobar con QuickCheck que para cualquier par (x,y) de números naturales, la (posicion (x,y)) es igual a (y + (x+y+1)*(x+y) div 2).

Nota. En la comprobación usar

   quickCheckWith (stdArgs {maxSize=7}) prop_posicion

1	quickCheckWith (stdArgs {maxSize=7}) prop_posicion

Soluciones

import Test.QuickCheck

pares :: [(Int,Int)]
pares = [(n-y,y) | n <- [0..], y <- [0..n]] 

posicion :: (Int,Int) -> Int
posicion p = length (takeWhile (/=p) pares)

-- La propiedad es
prop_posicion :: (Int,Int) -> Property
prop_posicion (x,y) =
    x >= 0 && y >= 0 ==> 
    posicion (x,y) == y + (x+y+1)*(x+y) `div` 2

-- La comprobación es
--    ghci> quickCheckWith (stdArgs {maxSize=7}) prop_posicion
--    +++ OK, passed 100 tests.

import Test.QuickCheck

pares :: [(Int,Int)]

pares = [(n-y,y) | n <- [0..], y <- [0..n]]

posicion :: (Int,Int) -> Int

posicion p = length (takeWhile (/=p) pares)

-- La propiedad es

prop_posicion :: (Int,Int) -> Property

prop_posicion (x,y) =

x >= 0 && y >= 0 ==>

posicion (x,y) == y + (x+y+1)*(x+y) `div` 2

-- La comprobación es

-- ghci> quickCheckWith (stdArgs {maxSize=7}) prop_posicion

-- +++ OK, passed 100 tests.

2015, suma de dígitos y número de divisores

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

Una propiedad del 2015 es que la suma de sus dígitos coincide con el número de sus divisores; en efecto, la suma de sus dígitos es 2+0+1+5=8 y tiene 8 divisores (1, 5, 13, 31, 65, 155, 403 y 2015).

Definir la sucesión

   especiales :: [Int]

1	especiales :: [Int]

formada por los números n tales que la suma de los dígitos de n coincide con el número de divisores de n. Por ejemplo,

   take 12 especiales == [1,2,11,22,36,84,101,152,156,170,202,208]

1	take 12 especiales == [1,2,11,22,36,84,101,152,156,170,202,208]

Usar la sucesión para responder las siguientes cuestiones

¿Cuántos años hasta el 2015 inclusive han cumplido la propiedad?
¿Cuál fue el anterior al 2015 que cumplió la propiedad?
¿Cuál será el siguiente al 2015 que cumplirá la propiedad?

Nota: La sucesión especiales es la misma que la A057531 de la OEIS (On-Line Encyclopedia of Integer Sequences).

Soluciones

especiales :: [Int]
especiales = [n | n <- [1..], especial n]

especial :: Int -> Bool
especial n = sum (digitos n) == length (divisores n)

digitos :: Int -> [Int]
digitos n = [read [d] | d <- show n]

divisores :: Int -> [Int]
divisores n = [x | x <- [1..n], n `mod` x == 0]

-- El cálculo de número de años hasta el 2015 inclusive que han cumplido
-- la propiedad es
--    ghci> length (takeWhile (<=2015) especiales)
--    59

-- El cálculo del anterior al 2015 que cumplió la propiedad es
--    ghci> last (takeWhile (<2015) especiales)
--    2006

-- El cálculo del siguiente al 2015 que cumplirá la propiedad es 
--    ghci> head (dropWhile (<=2015) especiales)
--    2101

especiales :: [Int]

especiales = [n | n <- [1..], especial n]

especial :: Int -> Bool

especial n = sum (digitos n) == length (divisores n)

digitos :: Int -> [Int]

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

divisores :: Int -> [Int]

divisores n = [x | x <- [1..n], n `mod` x == 0]

-- El cálculo de número de años hasta el 2015 inclusive que han cumplido

-- la propiedad es

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

-- 59

-- El cálculo del anterior al 2015 que cumplió la propiedad es

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

-- 2006

-- El cálculo del siguiente al 2015 que cumplirá la propiedad es

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

-- 2101

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]

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!

Extensión de un fichero

PorJosé A. Alonso 10-noviembre-20141-mayo-2016

Enunciado

-- La extensión de un fichero es la palabra a continuación del último
-- punto en el nombre del fichero. Por ejemplo, la extensión de
-- "documento.txt" es "txt" 
-- 
-- Definir la función
--    extension :: String -> String
-- tal que (extension cs) es la extensión del fichero cs. Por ejemplo,
--    extension "ejercicio.hs"       ==  "hs"
--    extension "documento.txt"      ==  "txt"
--    extension "documento.txt.pdf"  ==  "pdf"
--    extension "resumen"            ==  ""

-- La extensión de un fichero es la palabra a continuación del último

-- punto en el nombre del fichero. Por ejemplo, la extensión de

-- "documento.txt" es "txt"

-- Definir la función

-- extension :: String -> String

-- tal que (extension cs) es la extensión del fichero cs. Por ejemplo,

-- extension "ejercicio.hs" == "hs"

-- extension "documento.txt" == "txt"

-- extension "documento.txt.pdf" == "pdf"

-- extension "resumen" == ""

Soluciones

-- 1ª definición (por recursión):
extension1 :: String -> String
extension1 cs | elem '.' cs = reverse (aux (reverse cs))
              | otherwise   = ""
    where aux []       = []
          aux ('.':cs) = []
          aux (c:cs)   = c : aux cs

-- 2ª definición (con takeWhile):
extension2 :: String -> String
extension2 cs
    | notElem '.' cs = ""
    | otherwise      = reverse (takeWhile (/= '.') (reverse cs))

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

extension1 :: String -> String

extension1 cs | elem '.' cs = reverse (aux (reverse cs))

| otherwise = ""

where aux [] = []

aux ('.':cs) = []

aux (c:cs) = c : aux cs

-- 2ª definición (con takeWhile):

extension2 :: String -> String

extension2 cs

| notElem '.' cs = ""

| otherwise = reverse (takeWhile (/= '.') (reverse cs))

Mayor sucesión del problema 3n+1

PorJosé A. Alonso 20-junio-20141-mayo-2016

Enunciado

-- La sucesión 3n+1 generada por un número entero positivo x es la
-- sucesión generada por el siguiente algoritmo: Se empieza con el
-- número x. Si x es par, se divide entre 2. Si x es impar, se
-- multiplica por 3 y se le suma 1. El  proceso se repite con el número
-- obtenido hasta que se alcanza el valor 1. Por ejemplo, la sucesión de
-- números generadas cuando se empieza en 22 es
--    22 11 34 17 52 26 13 40 20 10 5 16 8 4 2 1
-- Se ha conjeturado (aunque no demostrado) que este algoritmo siempre
-- alcanza el 1 empezando en cualquier entero positivo.
-- 
-- Definir la función
--    mayorLongitud :: Integer -> Integer -> Integer
-- tal que (mayorLongitud i j) es el máximo de las longitudes de las
-- sucesiones 3n+1 para todos los números comprendidos entre i y j,
-- ambos inclusives. Por ejemplo,
--    mayorLongitud   1   10  ==  20
--    mayorLongitud 100  200  ==  125
--    mayorLongitud 201  210  ==  89
--    mayorLongitud 900 1000  ==  174

-- La sucesión 3n+1 generada por un número entero positivo x es la

-- sucesión generada por el siguiente algoritmo: Se empieza con el

-- número x. Si x es par, se divide entre 2. Si x es impar, se

-- multiplica por 3 y se le suma 1. El proceso se repite con el número

-- obtenido hasta que se alcanza el valor 1. Por ejemplo, la sucesión de

-- números generadas cuando se empieza en 22 es

-- 22 11 34 17 52 26 13 40 20 10 5 16 8 4 2 1

-- Se ha conjeturado (aunque no demostrado) que este algoritmo siempre

-- alcanza el 1 empezando en cualquier entero positivo.

-- Definir la función

-- mayorLongitud :: Integer -> Integer -> Integer

-- tal que (mayorLongitud i j) es el máximo de las longitudes de las

-- sucesiones 3n+1 para todos los números comprendidos entre i y j,

-- ambos inclusives. Por ejemplo,

-- mayorLongitud 1 10 == 20

-- mayorLongitud 100 200 == 125

-- mayorLongitud 201 210 == 89

-- mayorLongitud 900 1000 == 174

Soluciones

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

mayorLongitud1 :: Int -> Int -> Int
mayorLongitud1 i j = maximum [length (sucesion k) | k <- [i..j]]

-- (sucesion n) es la sucesión 3n+1 generada por n. Por ejemplo, 
--    sucesion 22  ==  [22,11,34,17,52,26,13,40,20,10,5,16,8,4,2,1]
sucesion :: Int -> [Int]
sucesion 1 = [1]
sucesion n | even n    = n : sucesion (n `div` 2)
           | otherwise = n : sucesion (3*n+1)

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

mayorLongitud2 :: Int -> Int -> Int
mayorLongitud2 i j = maximum [longitud k | k <- [i..j]]

-- (longitud n) es la longitud de la sucesión 3n+1 generada por n. Por
-- ejemplo, 
--    longitud 22  ==  16
longitud :: Int -> Int
longitud 1 = 1
longitud n | even n    = 1 + longitud (n `div` 2)
           | otherwise = 1 + longitud (3*n+1)

-- 3ª solución (con iterate)
-- =========================

mayorLongitud3 :: Int -> Int -> Int
mayorLongitud3 i j = maximum [length (sucesion2 k) | k <- [i..j]]

-- (sucesion2 n) es la sucesión 3n+1 generada por n. Por ejemplo, 
--    sucesion2 22  ==  [22,11,34,17,52,26,13,40,20,10,5,16,8,4,2,1]
sucesion2 :: Int -> [Int]
sucesion2 n = takeWhile (/=1) (iterate f n) ++ [1]
    where f x | even x    = x `div` 2
              | otherwise = 3*x+1

-- 1ª solución

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

mayorLongitud1 :: Int -> Int -> Int

mayorLongitud1 i j = maximum [length (sucesion k) | k <- [i..j]]

-- (sucesion n) es la sucesión 3n+1 generada por n. Por ejemplo,

-- sucesion 22 == [22,11,34,17,52,26,13,40,20,10,5,16,8,4,2,1]

sucesion :: Int -> [Int]

sucesion 1 = [1]

sucesion n | even n = n : sucesion (n `div` 2)

| otherwise = n : sucesion (3*n+1)

-- 2ª solución

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

mayorLongitud2 :: Int -> Int -> Int

mayorLongitud2 i j = maximum [longitud k | k <- [i..j]]

-- (longitud n) es la longitud de la sucesión 3n+1 generada por n. Por

-- ejemplo,

-- longitud 22 == 16

longitud :: Int -> Int

longitud 1 = 1

longitud n | even n = 1 + longitud (n `div` 2)

| otherwise = 1 + longitud (3*n+1)

-- 3ª solución (con iterate)

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

mayorLongitud3 :: Int -> Int -> Int

mayorLongitud3 i j = maximum [length (sucesion2 k) | k <- [i..j]]

-- (sucesion2 n) es la sucesión 3n+1 generada por n. Por ejemplo,

-- sucesion2 22 == [22,11,34,17,52,26,13,40,20,10,5,16,8,4,2,1]

sucesion2 :: Int -> [Int]

sucesion2 n = takeWhile (/=1) (iterate f n) ++ [1]

where f x | even x = x `div` 2

| otherwise = 3*x+1

Referencia

El ejercicio está basado en The 3n + 1 problem de UVa Online Judge.

Órbita prima

PorJosé A. Alonso 13-junio-20141-mayo-2016

Enunciado

-- La órbita prima de un número n es la sucesión construida de la
-- siguiente forma: 
--    * si n es compuesto su órbita no tiene elementos 
--    * si n es primo, entonces n está en su órbita; además, sumamos n y
--      sus dígitos, si el resultado es un número primo repetimos el
--      proceso hasta obtener un número compuesto. 
-- Por ejemplo, con el 11 podemos repetir el proceso dos veces
--    13 = 11+1+1
--    17 = 13+1+3
-- Así, la órbita prima de 11 es 11, 13, 17. 
-- 
-- Definir la función
--    orbita :: Integer -> [Integer]
-- tal que (orbita n) es la órbita prima de n. Por ejemplo,
--    orbita 11 == [11,13,17]
--    orbita 59 == [59,73,83]
-- Calcular el menor número cuya órbita prima tiene más de 3 elementos.

-- La órbita prima de un número n es la sucesión construida de la

-- siguiente forma:

-- * si n es compuesto su órbita no tiene elementos

-- * si n es primo, entonces n está en su órbita; además, sumamos n y

-- sus dígitos, si el resultado es un número primo repetimos el

-- proceso hasta obtener un número compuesto.

-- Por ejemplo, con el 11 podemos repetir el proceso dos veces

-- 13 = 11+1+1

-- 17 = 13+1+3

-- Así, la órbita prima de 11 es 11, 13, 17.

-- Definir la función

-- orbita :: Integer -> [Integer]

-- tal que (orbita n) es la órbita prima de n. Por ejemplo,

-- orbita 11 == [11,13,17]

-- orbita 59 == [59,73,83]

-- Calcular el menor número cuya órbita prima tiene más de 3 elementos.

Soluciones

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

orbita1 :: Integer -> [Integer]
orbita1 n | not (esPrimo n) = []
          | otherwise       = n : orbita1 (n + sum (cifras n))

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

cifras :: Integer -> [Integer]
cifras n = [read [x]| x <- show n]

-- El cálculo es
--    ghci> head [x | x <- [1,3..], length (orbita x) > 3]
--    277
-- 
--    ghci> orbita 277
--    [277,293,307,317]

-- 2ª definición (con iterate)
-- ===========================

orbita2 :: Integer -> [Integer]
orbita2 n = takeWhile esPrimo (iterate f n)
    where f x = x + sum (cifras x)

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

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

orbita1 :: Integer -> [Integer]

orbita1 n | not (esPrimo n) = []

| otherwise = n : orbita1 (n + sum (cifras n))

esPrimo :: Integer -> Bool

esPrimo n = [x | x <- [1..n], n `rem` x == 0] == [1,n]

cifras :: Integer -> [Integer]

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

-- El cálculo es

-- ghci> head [x | x <- [1,3..], length (orbita x) > 3]

-- 277

-- ghci> orbita 277

-- [277,293,307,317]

-- 2ª definición (con iterate)

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

orbita2 :: Integer -> [Integer]

orbita2 n = takeWhile esPrimo (iterate f n)

where f x = x + sum (cifras x)

Orden de divisibilidad

Soluciones

Segmentos de longitud dada

Soluciones

Posición del primer falso en un vector

Excercitium

Soluciones

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

Soluciones

Enumeración de los pares de números naturales

Soluciones

2015, suma de dígitos y número de divisores

Soluciones

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

Soluciones

Extensión de un fichero

Enunciado

Soluciones

Mayor sucesión del problema 3n+1

Enunciado

Soluciones

Referencia

Órbita prima

Enunciado

Soluciones

Entradas recientes

Buscar

Correo electrónico