Menu Close

Categoría: Medio

Números ordenados con cuadrados ordenados

Un número es ordenado si cada uno de sus dígitos es menor o igual el siguiente dígito. Por ejemplo, 116 es un número creciente y su cuadrado es 13456, que también es ordenado. En cambio, 115 es ordenado pero su cuadrado es 13225 que no es ordenado.

Definir la lista

   numerosOrdenadosConCuadradosOrdenados :: [Integer]

cuyos elementos son los números ordenados cuyos cuadrados también lo son. Por ejemplo,

   λ> take 20 numerosOrdenadosConCuadradosOrdenados
   [0,1,2,3,4,5,6,7,12,13,15,16,17,34,35,37,38,67,116,117]
   λ> length (show (numerosOrdenadosConCuadradosOrdenados !! (10^6)))
   1411
   λ> length (show (numerosOrdenadosConCuadradosOrdenados !! (5*10^6)))
   3159

Soluciones

import Data.List
 
-- 1ª solución
-- ===========
 
numerosOrdenadosConCuadradosOrdenados :: [Integer]
numerosOrdenadosConCuadradosOrdenados =
  filter numeroOrdenadoConCuadradoOrdenado [0..]
 
-- (numeroOrdenadoConCuadradoOrdenado n) se verifica si n es un número
-- ordenado cuyo cuadrado también lo es. Por ejemplo,
--    numeroOrdenadoConCuadradoOrdenado 116  ==  True
--    numeroOrdenadoConCuadradoOrdenado 115  ==  False
numeroOrdenadoConCuadradoOrdenado :: Integer -> Bool
numeroOrdenadoConCuadradoOrdenado n =
  ordenado n && ordenado (n^2)
 
-- (ordenado n) se verifica si n es un número ordenado. Por ejemplo,
--    ordenado 115  ==  True
--    ordenado 151  ==  False
ordenado :: Integer -> Bool
ordenado n =
  and [x <= y | (x,y) <- zip xs (tail xs)]
  where xs = show n
 
-- 2ª solución
-- ===========
 
-- Se basa en la observación de los sisuientes cálculos con la primera
-- solución
--    λ> take 30 numerosOrdenadosConCuadradosOrdenados
--    [0,1,2,3,4,5,6,7,12,13,15,16,17,34,35,37,38,67,116,117,
--     167,334,335,337,367,667,1667,3334,3335,3337]
--    λ> take 21 (dropWhile (<= 117) numerosOrdenadosConCuadradosOrdenados)
--    [167,334,335,337,367,667,
--     1667,3334,3335,3337,3367,3667,6667,
--     16667,33334,33335,33337,33367,33667,36667,66667]
--
-- Se observa que a partir del 167 todos los elementos son de 4 tipos
-- como se ve en la siguente tabla
--    |-------+--------+--------+--------+--------|
--    |       | Tipo A | Tipo B | Tipo C | Tipo D |
--    |-------+--------+--------+--------+--------|
--    |   167 | 16¹7   |        |        |        |
--    |   334 |        | 3²4    |        |        |
--    |   335 |        |        | 3²5    |        |
--    |   337 |        |        |        | 3²6⁰7  |
--    |   367 |        |        |        | 3¹6¹7  |
--    |   667 |        |        |        | 3⁰6²7  |
--    |  1667 | 16²7   |        |        |        |
--    |  3334 |        | 3³4    |        |        |
--    |  3335 |        |        | 3³5    |        |
--    |  3337 |        |        |        | 3³6⁰7  |
--    |  3367 |        |        |        | 3²6¹7  |
--    |  3667 |        |        |        | 3¹6²7  |
--    |  6667 |        |        |        | 3⁰6³7  |
--    | 16667 | 16³7   |        |        |        |
--    | 33334 |        | 3⁴4    |        |        |
--    | 33335 |        |        | 3⁴5    |        |
--    | 33337 |        |        |        | 3⁴6⁰7  |
--    | 33367 |        |        |        | 3³6¹7  |
--    | 33667 |        |        |        | 3²6²7  |
--    | 36667 |        |        |        | 3¹6³7  |
--    | 66667 |        |        |        | 3⁰6⁴7  |
--    |-------+--------+--------+--------+--------|
-- donde el exponente en cad dígito indica el número de repeticiones de
-- dicho dígito.
 
numerosOrdenadosConCuadradosOrdenados2 :: [Integer]
numerosOrdenadosConCuadradosOrdenados2 =
  [0,1,2,3,4,5,6,7,12,13,15,16,17,34,35,37,38,67,116,117] ++
  map read (concat [['1' : replicate n '6' ++ "7",
                     replicate (n+1) '3' ++ "4",
                     replicate (n+1) '3' ++ "5"] ++
                    [replicate a '3' ++ replicate b '6' ++ "7"
                    | b <- [0..n+1], let a = (n+1) - b]
                   | n <- [1..]])
 
-- Comparación de eficiencia
-- =========================
 
-- La comparación es
--    λ> numerosOrdenadosConCuadradosOrdenados !! 50
--    1666667
--    (2.35 secs, 2,173,983,096 bytes)
--    λ> numerosOrdenadosConCuadradosOrdenados2 !! 50
--    1666667
--    (0.01 secs, 125,296 bytes)
 
-- Comprobación de equivalencia
-- ============================
 
-- La comprobación es
--    λ> take 50 numerosOrdenadosConCuadradosOrdenados == take 50 numerosOrdenadosConCuadradosOrdenados2
--    True

Nuevas soluciones

  • En los comentarios se pueden escribir nuevas soluciones.
  • El código se debe escribir entre una línea con <pre lang="haskell"> y otra con </pre>

Cálculo de pi mediante la fórmula de Brouncker

El mes de marzo es el mes de pi, ya que el 14 de marzo (3/14) es el día de pi. Con ese motivo, el pasado 3 de marzo se publicó en Twitter un mensaje con la fórmula de Brouncker para el cálculo de pi

La primeras aproximaciones son

     a(1) = 4                                  =  4
     a(2) = 4/(1+1^2)                          =  2.0
     a(3) = 4/(1+1^2/(2+3^2))                  =  3.666666666666667
     a(4) = 4/(1+1^2/(2+3^2/(2+5^2)))          =  2.8
     a(5) = 4/(1+1^2/(2+3^2/(2+5^2/(2+7^2))))  =  3.395238095238095

Definir las funciones

   aproximacionPi :: Int -> Double
   grafica        :: [Int] -> IO ()

tales que

  • (aproximacionPi n) es la n-ésima aproximación de pi con la fórmula de Brouncker. Por ejemplo,
     aproximacionPi 1      ==  4.0
     aproximacionPi 2      ==  2.0
     aproximacionPi 3      ==  3.666666666666667
     aproximacionPi 4      ==  2.8
     aproximacionPi 5      ==  3.395238095238095
     aproximacionPi 10     ==  3.0301437124966535
     aproximacionPi 1000   ==  3.1405916523380406
     aproximacionPi 1001   ==  3.142592653839793
     aproximacionPi 10000  ==  3.141492643588543
     aproximacionPi 10001  ==  3.1416926535900433
     pi                    ==  3.141592653589793
  • (grafica xs) dibuja la gráfica de las k-ésimas aproximaciones de pi para k en xs. Por ejemplo, (grafica [10..100]) dibuja

Soluciones

import Graphics.Gnuplot.Simple (Attribute (Key, PNG), plotList)
 
-- 1ª solución
-- ===========
 
aproximacionPi :: Int -> Double
aproximacionPi 1 = 4
aproximacionPi n = 4/(1 + 1/(aux 1 3))
  where aux a b | a == n-1  = 1
                | otherwise = 2 + (b^2)/(aux (a+1) (b+2))
 
-- El cálculo es
--    aproximacionPi 2
--      = 4/(1 + 1/(aux 1 3))
--      = 4/(1 + 1/1)
--      = 2.0
--
--    aproximacionPi 3
--      = 4/(1 + 1/(aux 1 3))
--      = 4/(1 + 1/(2 + 3^2/(aux 2 5))
--      = 4/(1 + 1/(2 + 3^2/1))
--      = 3.666666666666667
--
--    aproximacionPi 4
--      = 4/(1 + 1/(aux 1 3))
--      = 4/(1 + 1/(2 + 3^2/(aux 2 5))
--      = 4/(1 + 1/(2 + 3^2/(2 + 5^2/(aux 3 7))))
--      = 4/(1 + 1/(2 + 3^2/(2 + 5^2/1)))
--      = 2.8
 
-- 2ª solución
-- ===========
 
aproximacionPi2 :: Int -> Double
aproximacionPi2 n =
  aproximacionFC n fraccionPi
 
-- fraccionPi es la representación de la fracción continua de pi como un
-- par de listas infinitas.
fraccionPi :: [(Integer, Integer)]
fraccionPi = zip (0 : 1 : [2,2..]) (4 : map (^2) [1,3..])
 
-- (aproximacionFC n fc) es la n-ésima aproximación de la fracción
-- continua fc (como un par de listas).
aproximacionFC :: Int -> [(Integer, Integer)] -> Double
aproximacionFC n =
  foldr (\(a,b) z -> fromIntegral a + fromIntegral b / z) 1 . take n
 
-- Gráfica
-- =======
 
grafica :: [Int] -> IO ()
grafica xs =
  plotList [ Key Nothing
           -- , PNG "Calculo_de_pi_mediante_la_formula_de_Brouncker_1.png"
           ]
           [(k,aproximacionPi k) | k <- xs]

Nuevas soluciones

  • En los comentarios se pueden escribir nuevas soluciones.
  • El código se debe escribir entre una línea con <pre lang="haskell"> y otra con </pre>

Sucesión de Rowland

Definir las siguientes sucesiones

   sucesionA       :: [Integer]
   sucesionB       :: [Integer]
   sucesionRowland :: [Integer]

tales que

  • el término n-ésimo de la sucesionA es a(n) definido por a(1) = 7 y a(n) = a(n-1) + mcd(n, a(n-1)), para n > 1. Por ejemplo,
     λ> take 20 sucesionA
     [7,8,9,10,15,18,19,20,21,22,33,36,37,38,39,40,41,42,43,44]
  • los términos de la sucesionB son las diferencias de los términos consecutivos de la sucesionA. Por ejemplo,
     λ> take 30 sucesionB
     [1,1,1,5,3,1,1,1,1,11,3,1,1,1,1,1,1,1,1,1,1,23,3,1,1,1,1,1,1,1]
  • los términos de la sucesionRowland son los términos de la sucesionB distintos de 1. Por ejemplo,\0
      λ> take 20 sucesionRowland
      [5,3,11,3,23,3,47,3,5,3,101,3,7,11,3,13,233,3,467,3]
      λ> sucesionRowland !! 92
      15567089

Comprobar con QuickCheck que los elementos de la sucesionRowland son números primos.

Nota: Eric S. Rowland demostró en A natural prime-generating recurrence que los elementos de la sucesionRowland son números primos.

Soluciones

import Data.Numbers.Primes (isPrime)
import Test.QuickCheck (Property, (==>), quickCheck)
 
sucesionA :: [Integer]
sucesionA =
   7 : zipWith (+) sucesionA (zipWith gcd sucesionA [2..])
 
sucesionB :: [Integer]
sucesionB = zipWith (-) (tail sucesionA) sucesionA
 
sucesionRowland :: [Integer]
sucesionRowland =  filter (> 1) sucesionB
 
-- La propiedad es
prop_sucesionRowland :: Int -> Property
prop_sucesionRowland n =
  n >= 0 ==> isPrime (sucesionRowland !! n)
 
-- La comprobación es
--    λ> quickCheck prop_sucesionRowland
--    +++ OK, passed 100 tests.

Nuevas soluciones

  • En los comentarios se pueden escribir nuevas soluciones.
  • El código se debe escribir entre una línea con <pre lang="haskell"> y otra con </pre>

Siguiente equidigital

Dos números son equidigitales si tienen el mismo multiconjunto de dígitos. Por ejemplo, 2021 y 2120 son equidigitales ya que ambos tiene a {0,1,2,2} como su multiconjunto de dígitos.

Definir la función

   siguienteEquidigital :: Integer -> Maybe Integer

tal que (siguienteEquidigital n) es precisamente el menor número equidigital con n que es mayor que n (es decir, (Just x) si x es dicho número o Nothing si no hay ningún número equidigital con n que sea mayor que n). Por ejemplo,

   siguienteEquidigital 12    ==  Just 21
   siguienteEquidigital 21    ==  Nothing
   siguienteEquidigital 513   ==  Just 531
   siguienteEquidigital 531   ==  Nothing
   siguienteEquidigital 2021  ==  Just 2102
   siguienteEquidigital 2102  ==  Just 2120
   siguienteEquidigital 2120  ==  Just 2201
   siguienteEquidigital 2201  ==  Just 2210
   siguienteEquidigital 2210  ==  Nothing
   fmap (`mod` 1000) (siguienteEquidigital (2^(10^5)))  ==  Just 637

Soluciones

import Data.List (sort)
import Data.Maybe (listToMaybe)
 
-- 1ª solución
-- ===========
 
siguienteEquidigital :: Integer -> Maybe Integer
siguienteEquidigital n
  | null xs = Nothing
  | otherwise = Just (head xs)
  where xs = equidigitalesMayores n
 
-- (equidigitalesMayores n) es la lista de los equidigitales mayores que
-- n. Por ejemplo,
--    equidigitalesMayores 2021  ==  [2102,2120,2201,2210]
--    equidigitalesMayores 2210  ==  []
equidigitalesMayores :: Integer -> [Integer]
equidigitalesMayores n =
  [x | x <- [n+1..mayorEquidigital n],
       sort (show x) == ds]
  where ds = sort (show n)
 
-- (mayorEquidigital n) es el mayor número equidigital con n. Por ejemplo,
--    mayorEquidigital 2021  ==  2210
--    mayorEquidigital 2210  ==  2210
mayorEquidigital :: Integer -> Integer
mayorEquidigital = read . reverse . sort . show
 
-- 2ª solución
-- ===========
 
siguienteEquidigital2 :: Integer -> Maybe Integer
siguienteEquidigital2 = listToMaybe . equidigitalesMayores

Nuevas soluciones

  • En los comentarios se pueden escribir nuevas soluciones.
  • El código se debe escribir entre una línea con <pre lang="haskell"> y otra con </pre>

Mínima diferencia de las sumas de las biparticiones de las N primeras potencias de dos

Se consideran las N primeras potencias de 2 (donde N es un número par). Por ejemplo, para N = 4, las potencias de 2 son 1, 2, 4 y 8. Las biparticiones de dichas potencias en dos conjuntos de igual tamaño son

   ([1,2],[4,8]), ([1,4],[2,8]), ([1,8],[2,4])

Las sumas de los elementos de las biparticiones son

   (3,12), (5,10), (9,6)

Los valores absolutos de las diferencias de dichas sumas son

   9, 5, 3

El mínimo de dichas diferencias es 3.

Definir la función

  minimaDiferencia :: Integer -> Integer

tal que (minimaDiferencia n) es la mínima diferencia de las sumas las biparticiones de las n (donde n es un número par) primeras potencias de dos conjuntos con igual número de elementos. Por ejemplo,

   minimaDiferencia 4  ==  3
   minimaDiferencia 6  ==  7
   minimaDiferencia (10^9) `mod` (10^9)  ==  787109375

Soluciones

import Test.QuickCheck
import Data.List ((\\))
 
-- 1ª solución
-- ===========
 
minimaDiferencia :: Integer -> Integer
minimaDiferencia n =
  minimum [abs (sum xs - sum ys) | (xs,ys) <- particiones n]
 
-- (particiones n) es la lista de las particiones de las n (donde n es
-- un número par) de las n primeras potencias de 2 en dos conjuntos de
-- igual tamaño. Por ejemplo,
--   λ> particiones 4
--   [([1,2],[4,8]),([1,4],[2,8]),([1,8],[2,4]),
--    ([2,4],[1,8]),([2,8],[1,4]),([4,8],[1,2])]
particiones :: Integer -> [([Integer],[Integer])]
particiones n =
  [(as,xs \\ as) | as <- kSubconjuntos xs (n `div` 2)]
  where xs = [2^k | k <- [0..n-1]]
 
-- (kSubconjuntos xs k) es la lista de los subconjuntos de xs con k
-- elementos. Por ejemplo,
--    λ> kSubconjuntos "bcde" 2
--    ["bc","bd","be","cd","ce","de"]
--    λ> kSubconjuntos "bcde" 3
--    ["bcd","bce","bde","cde"]
--    λ> kSubconjuntos "abcde" 3
--    ["abc","abd","abe","acd","ace","ade","bcd","bce","bde","cde"]
kSubconjuntos :: [a] -> Integer -> [[a]]
kSubconjuntos _ 0      = [[]]
kSubconjuntos [] _     = []
kSubconjuntos (x:xs) k =
  [x:ys | ys <- kSubconjuntos xs (k-1)] ++ kSubconjuntos xs k
 
-- 2ª solución
-- ===========
 
-- Nota: La suma de las primeras (n-1) potencias de 2 es
--    sum [2^i | i <- [0..n-2]] = 2^(n-1) - 1
-- que es menor que la n-ésima potencia de 2 (es decir, 2^(n-1) porque
-- se empieza a contar en 0). Por tanto, para que la diferencia de las
-- suma sea mínima hay que agrupar la última (2^(n-1) con las menores
-- (es decir, desde 0 hasta n/2-2).
 
minimaDiferencia2 :: Integer -> Integer
minimaDiferencia2 n =
  2^(n-1) + sum [2^i | i <- [0..n `div` 2 - 2]] -
  sum [2^i | i <- [n `div` 2 - 1.. n-2]]
 
-- 3ª solución
-- ===========
 
-- Nota: Sea m = n/2 - 2. Entonces la suma de la mayor con las menores
-- es
--    s1 = 2^(n-1) + sum [2^i | i <- [0..m]]
--       = 2^(n-1) + (2^(m+1)-1)
-- y, puesto que la suma de las n primeras potencias es 2^n-1, la suma
-- de las restantes es
--    s2 = (2^n-1) - s1
 
minimaDiferencia3 :: Integer -> Integer
minimaDiferencia3 n = s1 - s2
  where m = n `div` 2 - 2
        s1 = 2^(n-1) + (2^(m+1)-1)
        s2 = (2^n-1) - s1
 
-- 4ª solución
-- ===========
 
-- Nota: Con la notación de la solución anterior, la mínima diferencia es
--    s1 - s2
--    = s1 - ((2^n-1) - s1)
--    = 2*s1 - (2^n-1)
--    = 2*(2^(n-1) + (2^(m+1)-1)) - (2^n-1)
--    = 2^n + 2^(m+2) - 2 - 2^n + 1
--    = 2^(m+2) - 1
 
minimaDiferencia4 :: Integer -> Integer
minimaDiferencia4 n = 2^(m+2) - 1
  where m = n `div` 2 - 2
 
-- Comparación de eficiencia
-- =========================
 
-- La comparación es
--    λ> minimaDiferencia 22
--    2047
--    (7.75 secs, 6,597,330,816 bytes)
--    λ> minimaDiferencia2 22
--    2047
--    (0.00 secs, 126,344 bytes)
--    λ> minimaDiferencia3 22
--    2047
--    (0.01 secs, 107,192 bytes)
--    λ> minimaDiferencia4 22
--    2047
--    (0.01 secs, 102,544 bytes)
--
--    λ> minimaDiferencia2 (10^5) `mod` (10^50)
--    9602443968201967760613102289456131085235835109375
--    (8.18 secs, 2,915,200,064 bytes)
--    λ> minimaDiferencia3 (10^5) `mod` (10^50)
--    9602443968201967760613102289456131085235835109375
--    (0.01 secs, 293,640 bytes)
--    λ> minimaDiferencia4 (10^5) `mod` (10^50)
--    9602443968201967760613102289456131085235835109375
--    (0.03 secs, 167,176 bytes)
--
--    λ> minimaDiferencia3 (10^8) `mod` (10^50)
--    30521751870548886367615394702753936894129787109375
--    (2.08 secs, 149,075,824 bytes)
--    λ> minimaDiferencia4 (10^8) `mod` (10^50)
--    30521751870548886367615394702753936894129787109375
--    (0.41 secs, 24,929,696 bytes)
 
-- Comprobación de equivalencia
-- ============================
 
-- Como la primera sólo calcula hasta 22, se compara la primera con la
-- cuarta para dichos valores.
prop_equivalencia1 :: Bool
prop_equivalencia1 =
  and [minimaDiferencia n == minimaDiferencia4 n | n <- [0,2..22]]
 
-- La comprobación es
--    λ> prop_equivalencia1
--    True
 
-- La propiedad de la equivalencia de las definiciones 2, 3 y 4 es
prop_equivalencia :: Integer -> Bool
prop_equivalencia n =
  all (== (minimaDiferencia2 n'))
      [minimaDiferencia3 n',
       minimaDiferencia4 n']
  where n' = 2 + abs n
 
-- La comprobación es
--    λ> quickCheck prop_equivalencia
--    +++ OK, passed 100 tests.

Nuevas soluciones

  • En los comentarios se pueden escribir nuevas soluciones.
  • El código se debe escribir entre una línea con <pre lang="haskell"> y otra con </pre>

Índice del menor elemento a eliminar para que la suma sea divisible por K

Definir la función

   indice :: [Int] -> Int -> Maybe Int

tal que (indice xs k) es el índice del menor elemento a eliminar de la lista de enteros positivos xs para que la suma de los restantes sea divisible por k o Nothing, si no existe dicho elemento. Por ejemplo,

   indice [1,8,4,1] 2         ==  Just 2
   indice [4,6,7,5,7] 11      ==  Just 2
   indice [4,6,7,5,7] 12      ==  Just 3
   indice [4,6,7,5,7] 13      ==  Nothing
   indice [1..10^7] 7         ==  Just 5
   indice [10^7,10^7-1..1] 7  ==  Just 9999994

Soluciones

import Test.QuickCheck
import Data.List (sort)
import Data.Maybe (listToMaybe)
 
-- 1ª solución
-- ===========
 
indice :: [Int] -> Int -> Maybe Int
indice xs k
  | null ys   = Nothing
  | otherwise = Just (head ys)
  where ys = [i | (_,i,zs) <- sort (eliminaciones xs),
                  sum zs `mod` k == 0]
 
-- (eliminaciones xs) es la lista de ternas (x,i,zs) tales que x es un
-- elemento de xs, i es la posición de x en xs y zs es la lista de los
-- restantes elementos de xs. Por ejemplo,
--    λ> eliminaciones [5,7,6,5]
--    [(5,0,[7,6,5]),(7,1,[5,6,5]),(6,2,[5,7,5]),(5,3,[5,7,6])]
eliminaciones :: [a] -> [(a,Int,[a])]
eliminaciones xs = [(z,i,zs) | ((z,zs),i) <- zip (aux xs) [0..]]
  where aux []       = []
        aux [x]      = [(x,[])]
        aux (x:y:zs) = (x,y:zs) : [(v,x:vs) | (v,vs) <- aux (y:zs)]
 
-- 2ª solución
-- ===========
 
indice2 :: [Int] -> Int -> Maybe Int
indice2 xs k
  | null ys   = Nothing
  | otherwise = Just (head ys)
  where d = sum xs `mod` k
        ys = [i | (x,i) <- sort (zip xs [0..]),
                  x `mod` k == d]
 
-- 3ª solución
-- ===========
 
indice3 :: [Int] -> Int -> Maybe Int
indice3 xs k = listToMaybe ys
  where d = sum xs `mod` k
        ys = [i | (x,i) <- sort (zip xs [0..]),
                  x `mod` k == d]
 
-- Comprobación de la equivalencia
-- ===============================
 
-- La propiedad es
prop_equivalencia :: [Int] -> Int -> Bool
prop_equivalencia xs k =
  indice  xs' k' == indice2 xs' k' &&
  indice2 xs' k' == indice3 xs' k'
  where xs' = map ((+1) . abs) xs
        k'  = 1 + abs k
 
-- La comprobación es
--    λ> quickCheck prop_equivalencia
--    +++ OK, passed 100 tests.
 
-- Comparación de eficiencia
-- =========================
 
-- La comparación es
--    λ> indice [1..5000] 7
--    Just 2
--    (2.82 secs, 2,458,555,104 bytes)
--    λ> indice2 [1..5000] 7
--    Just 2
--    (0.01 secs, 1,991,232 bytes)
--    λ> indice3 [1..5000] 7
--    Just 2
--    (0.01 secs, 1,991,072 bytes)

Nuevas soluciones

  • En los comentarios se pueden escribir nuevas soluciones.
  • El código se debe escribir entre una línea con <pre lang="haskell"> y otra con </pre>

Máximo de las rotaciones

Las rotaciones del número 3252 son [3252, 2523, 5232, 2325] y el mayor de dichos números es 5232.

Definir la función

   maximoRotaciones :: Integer -> Integer

tal que (maximoRotaciones n) es el mayor número obtenido rotando los dígitos de n. Por ejemplo,

   maximoRotaciones 3252    ==  5232
   maximoRotaciones 913942  ==  942913
   maximoRotaciones (234 + 10^(10^6)) `div` (10^(10^6))  ==  4

Soluciones

import Data.List (inits, tails)
 
-- 1ª solución
-- ===========
 
maximoRotaciones :: Integer -> Integer
maximoRotaciones = maximum . rotacionesNumero
 
-- (rotacionesNumero n) es la lista de las rotaciones obtenidas desplazando
-- el primer dígito de n al final. Por ejemplo,
--    rotacionesNumero 325  ==  [325,253,532]
rotacionesNumero :: Integer -> [Integer]
rotacionesNumero = map read . rotaciones . show
 
-- (rotaciones xs) es la lista de las rotaciones obtenidas desplazando
-- el primer elemento xs al final. Por ejemplo,
--    rotaciones [2,3,5]  ==  [[2,3,5],[3,5,2],[5,2,3]]
rotaciones :: [a] -> [[a]]
rotaciones xs = take (length xs) (iterate rota xs)
 
-- (rota xs) es la lista añadiendo el primer elemento de xs al
-- final. Por ejemplo,
--    rota [3,2,5,7]  ==  [2,5,7,3]
rota :: [a] -> [a]
rota (x:xs) = xs ++ [x]
 
-- 2ª solución
-- ===========
 
maximoRotaciones2 :: Integer -> Integer
maximoRotaciones2 n =
  maximum (rotacionesDigito n (maximoDigito n))
 
-- (maximoDigito n) es el máximo de los dígitos de n. Por ejemplo,
--    maximoDigito 291394  ==  9
maximoDigito :: Integer -> Integer
maximoDigito n =
  read [maximum (show n)]
 
-- (rotacionesDigito n k) es la lista de las rotaciones de n cuyo primer
-- dígito es k. Por ejemplo,
--    rotacionesDigito 291394 9  ==  [913942,942913]
rotacionesDigito :: Integer -> Integer -> [Integer]
rotacionesDigito n k =
  [read (vs ++ us) | (us,vs) <- particiones (show n) (head (show k))]
 
-- (particiones xs y) es la lista de las particiones de xs en dos partes
-- tales que el primer elemento de la segunda parte es y. Por
-- ejemplo,
--    particiones [2,9,1,3,9,4] 9   == [([2],[9,1,3,9,4]),([2,9,1,3],[9,4])]
--    particiones [2,9,1,3,9,4] 3   == [([2,9,1],[3,9,4])]
--    particiones [2,9,1,3,9,4] 7   == []
--    particiones "Particiones" 'i' == [("Part","iciones"),("Partic","iones")]
particiones :: Eq a => [a] -> a -> [([a],[a])]
particiones xs y =
  [(prefijoSufijo xs zs,zs) | zs <- sufijos xs y]
 
-- (sufijos xs y) es la lista de los sufijos de xs que empiezan por
-- y. Por ejemplo,
--   λ> sufijos "particiones" 'i'
--   ["iciones","iones"]
sufijos :: Eq a => [a] -> a -> [[a]]
sufijos xs y = filter ((== y) . head) (init (tails xs))
 
-- (prefijoSufijo xs zs) es el prefijo de xs que junto con el sufijo zs
-- forma la lista xs. Por ejemplo,
--   λ> prefijoSufijo "particiones" "iciones"
--   "part"
prefijoSufijo :: [a] -> [a] -> [a]
prefijoSufijo xs zs = (inits xs) !! (length xs - length zs)
 
-- Comprobación de equivalencia
-- ============================
 
-- La propiedad es
prop_equivalencia :: Integer -> Property
prop_equivalencia n =
  n > 0 ==>
  maximoRotaciones n == maximoRotaciones2 n
 
-- La comprobación es
--    λ> quickCheck prop_equivalencia
--    +++ OK, passed 100 tests.
 
-- Comparación de eficiencia
-- =========================
 
-- La comparación es
--    λ> maximoRotaciones (product [1..2000]) `mod` (10^20)
--    64970515522882052348
--    (4.59 secs, 13,275,801,696 bytes)
--    λ> maximoRotaciones2 (product [1..2000]) `mod` (10^20)
--    64970515522882052348
--    (0.41 secs, 1,132,544,240 bytes)
--
--    λ> read (take 9 (show (maximoRotaciones (234 + 10^(10^4))))) :: Integer
--    410000000
--    (12.53 secs, 36,326,102,416 bytes)
--    λ> read (take 9 (show (maximoRotaciones2 (234 + 10^(10^4))))) :: Integer
--    410000000
--    (0.03 secs, 6,227,024 bytes)

Nuevas soluciones

  • En los comentarios se pueden escribir nuevas soluciones.
  • El código se debe escribir entre una línea con <pre lang="haskell"> y otra con </pre>

Particiones por un elemento

Definir la función

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

tal que (particiones xs y) es la lista de las particiones de xs en dos partes tales que el primer elemento de la segunda parte es y. Por ejemplo,

   particiones [2,9,1,3,9,4] 9   == [([2],[9,1,3,9,4]),([2,9,1,3],[9,4])]
   particiones [2,9,1,3,9,4] 3   == [([2,9,1],[3,9,4])]
   particiones [2,9,1,3,9,4] 7   == []
   particiones "Particiones" 'i' == [("Part","iciones"),("Partic","iones")]

Soluciones

import Data.List (tails, inits)
 
-- 1ª solución
-- ===========
 
particiones :: Eq a => [a] -> a -> [([a],[a])]
particiones [] _ = []
particiones xs y
  | null vs = []
  | otherwise = (us,vs) : [(us ++ y:us', vs')
                          | (us',vs') <- particiones (tail vs) y ]
  where (us,vs) = span (/=y) xs
 
-- 2ª solución
-- ===========
 
particiones2 :: Eq a => [a] -> a -> [([a],[a])]
particiones2 xs y =
  [(ys,z:zs) | (ys,z:zs) <- listaPares xs, z == y]
 
-- (listaPares xs) es la lista de los pares que resultan al dividir la
-- lista xs en dos partes. Por ejemplo,
--    λ> listaPares [2,9,1,3,9,4]
--    [([],[2,9,1,3,9,4]),([2],[9,1,3,9,4]),([2,9],[1,3,9,4]),([2,9,1],[3,9,4]),
--    ([2,9,1,3],[9,4]),([2,9,1,3,9],[4])]
listaPares :: [a] -> [([a],[a])]
listaPares xs = init (zip (inits xs) (tails xs))
 
-- 3ª solución
-- ===========
 
particiones3 :: Eq a => [a] -> a -> [([a],[a])]
particiones3 xs y =
  [(prefijoSufijo xs zs,zs) | zs <- sufijos xs y]
 
-- (sufijos xs y) es la lista de los sufijos de xs que empiezan por
-- y. Por ejemplo,
--   λ> sufijos "particiones" 'i'
--   ["iciones","iones"]
sufijos :: Eq a => [a] -> a -> [[a]]
sufijos xs y = filter ((== y) . head) (init (tails xs))
 
-- (prefijoSufijo xs zs) es el prefijo de xs que junto con el sufijo zs
-- forma la lista xs. Por ejemplo,
--   λ> prefijoSufijo "particiones" "iciones"
--   "part"
prefijoSufijo :: [a] -> [a] -> [a]
prefijoSufijo xs zs = (inits xs) !! (length xs - length zs)
 
-- Comprobación de la equivalencia
-- ===============================
 
-- La propiedad es
prop_equivalencia :: [Int] -> Int -> Bool
prop_equivalencia xs y =
  particiones xs y'  == particiones2 xs y' &&
  particiones2 xs y' == particiones3 xs y'
  where y' = y `mod` length xs
 
-- La comprobación es
--    λ> quickCheck prop_equivalencia
--    +++ OK, passed 100 tests.
 
-- Comparación de eficiencia
-- =========================
 
-- La comparación es
--    λ> length (particiones (take (10^5) (cycle [1..9])) 5)
--    11111
--    (9.10 secs, 13,375,324,416 bytes)
--    λ> length (particiones2 (take (10^5) (cycle [1..9])) 5)
--    11111
--    (0.08 secs, 44,107,672 bytes)
--    λ> length (particiones3 (take (10^5) (cycle [1..9])) 5)
--    11111
--    (0.07 secs, 21,524,936 bytes)
--
--    λ> length (particiones2 (take (10^7) (cycle [1..9])) 5)
--    1111111
--    (3.93 secs, 4,400,105,800 bytes)
--    λ> length (particiones3 (take (10^7) (cycle [1..9])) 5)
--    1111111
--    (1.88 secs, 2,142,328,800 bytes)

Nuevas soluciones

  • En los comentarios se pueden escribir nuevas soluciones.
  • El código se debe escribir entre una línea con <pre lang="haskell"> y otra con </pre>

Sumas de potencias que son cuadrados perfectos

El 2º problema de la ONEM (Olimpíada Nacional Escolar de Matemática) de Mayo del 2020 dice

Determinar si existen enteros positivos a, b y c, no necesariamente distintos, tales que a+b+c=2020 y 2^a + 2^b + 2^c es un cuadrado perfecto.

Definir la función

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

tales que (soluciones k n) es la lista de las ternas no decrecientes (a,b,c) tales que que a+b+c=n y k^a + k^b + k^c es un cuadrado perfecto. Por ejemplo,

   soluciones 2 19  ==  [(2,6,11),(2,7,10),(4,7,8),(5,5,9),(6,6,7)]
   soluciones 3 19  ==  []
   take 2 (soluciones 2 2020)  ==  [(2,674,1344),(4,674,1342)]

Soluciones

soluciones :: Integer -> Integer -> [(Integer,Integer,Integer)]
soluciones k n =
  [(a,b,c) | a <- [1..n `div` 3],
             b <- [a..n-a],
             let c = n-a-b,
             c >= b,
             esCuadradoPerfecto (k^a + k^b + k^c)]
 
-- (esCuadradoPerfecto x) se verifica si x es un cuadrado perfecto. Por
-- ejemplo,
--    esCuadradoPerfecto 16  ==  True
--    esCuadradoPerfecto 27  ==  False
esCuadradoPerfecto :: Integer -> Bool
esCuadradoPerfecto x =
  (raizEntera x)^2 == x
 
-- (raizEntera x) es el mayor entero cuyo cuadrado es menor o igual que
-- x. Por ejemplo,
--    raizEntera 16  ==  4
--    raizEntera 27  ==  5
raizEntera :: Integer -> Integer
raizEntera x = aux (1,x)
    where aux (a,b) | d == x    = c
                    | c == a    = c
                    | d < x     = aux (c,b)
                    | otherwise = aux (a,c)
              where c = (a+b) `div` 2
                    d = c^2

Nuevas soluciones

  • En los comentarios se pueden escribir nuevas soluciones.
  • El código se debe escribir entre una línea con <pre lang="haskell"> y otra con </pre>

Mínimo número de saltos para alcanzar el final

Dada una lista de enteros positivos, se interpreta cada elemento el máximo número de pasos que se puede avanzar desde dicho elemento. Por ejemplo, para la lista [1,3,5,8,9,2,6,7,6,8,9], desde sólo se puede avanzar un paso (hasta el 3), desde el 3 se puede avanzar 3 pasos (hasta el 5, 8 ó 9), y así sucesivamente. En dicha lista, el mínimo número de saltos que hay que dar para alcanzar el final es 3 (el recorrido es 1, 3, 8, 9).

Definir la función

   minimoSaltos :: [Int] -> Int

tal que (minimoSaltosxs) es el mínimo número de saltos que hay que dar en la lista xs para alcanzar el final. Por ejemplo,

   minimoSaltos [1,3,5,8,9,2,6,7,6,8,9]  ==  3
   minimoSaltos (replicate 10 1)         ==  9
   minimoSaltos [1..25]                  ==  5

Soluciones

import Data.List (tails)
 
minimoSaltos :: [Int] -> Int
minimoSaltos (x:y:xs) =
  1 + minimum [minimoSaltos ys | ys <- take x (tails (y:xs))]
minimoSaltos _ = 0

Nuevas soluciones

  • En los comentarios se pueden escribir nuevas soluciones.
  • El código se debe escribir entre una línea con <pre lang="haskell"> y otra con </pre>