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áximos locales y sus posiciones

Los máximos locales de [7,2,3,4,4,4,0,1,1,0,1,4,9] son el 4 (que se encuentra en la posición 3 (empezando a contar en 0)) y el 1 que se encuentra en la posición 7. En cada meseta, por ejemplo la formada por los tres 4 en las posiciones 3, 4 y 5, sólo se considera el primer elemento (en este caso, el de la posición 3) y se compara con el primero después de la meseta (en este caso, el 0 de la posición 6).

Los extremos de la lista no se consideran máximos locales. Por ejmplo, la listas [1,2,2,2,3] y [1,2,2,2,2] no tienen máximos locales.

Definir la función

   maximosLocales :: Ord a => [a] -> [(a,Int)]

tal que (maximosLocales xs) es la lista de los máximos locales de xs junto con sus posiciones. Por ejemplo,

   maximosLocales [7,2,3,4,4,4,0,1,1,0,1,4,9]  ==  [(4,3),(1,7)]
   maximosLocales [1,2,2,2,3]  ==  []
   maximosLocales [1,2,2,2,2]  ==  []

Soluciones

import Data.List (groupBy)
import Data.Function (on)
 
-- 1ª solución
-- ===========
 
maximosLocales1 :: Ord a => [a] -> [(a,Int)]
maximosLocales1 = aux . enumeradosSinMesetas
 where
   aux (x:y:z:xs) | y > x && y > z = y : aux (z:xs)
                  | otherwise      = aux (y:z:xs)
   aux _                           = []
 
-- (enumeradosSinMesetas xs) es la lista xs con los elementos enumerados
-- y eliminando las mesetas (es decir,la sucesión de elementos
-- iguales). Por ejemplo,
--    λ> enumeradosSinMesetas [7,7,2,2,7,4,4,4,2]
--    [(7,0),(2,2),(7,4),(4,5),(2,8)]
enumeradosSinMesetas :: Eq a => [a] -> [(a,Int)]
enumeradosSinMesetas xs = aux (zip xs [0..])
  where aux [] = []
        aux ((x,n):ps) = (x,n) : aux (dropWhile (\(y,_) -> y == x) ps)
 
-- Se puede definir sin recursión:
enumeradosSinMesetas2 :: Eq a => [a] -> [(a,Int)]
enumeradosSinMesetas2 xs =
  map head (groupBy (on (==) fst) (zip xs [0..]))
 
-- 2ª solución
-- ===========
 
maximosLocales2 :: Ord a => [a] -> [(a,Int)]
maximosLocales2 xs =
  [y | (x,y,z) <- zip3 ps (tail ps) (drop 2 ps), x < y && y > z]
  where ps = enumeradosSinMesetas 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>