Menu Close

Categoría: Medio

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

José A. Alonso---5 Comentarios

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>
Seguir leyendo →

Máximo de las rotaciones

José A. Alonso---4 Comentarios

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>
Seguir leyendo →

Particiones por un elemento

José A. Alonso---4 Comentarios

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>
Seguir leyendo →

Sumas de potencias que son cuadrados perfectos

José A. Alonso---4 Comentarios

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>
Seguir leyendo →

Máximos locales y sus posiciones

José A. Alonso---1 Comentario

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>
Seguir leyendo →