Menu Close

Múltiplos persistentes de siete

El enunciado del problema 1 de la Fase Local de la Olimpiada Matemática Española del 2021 es

Determinar todos los números de cuatro cifras tales que al insertar un dígito 0 en cualquier posición se obtiene un múltiplo de 7.

Un número n se dice que es un múltiplo persistente de 7 si al insertar el dígito 0 en cualquier posición de n se obtiene un múltiplo de 7.

Definir las funciones

   esMultiploPersistente :: Integer -> Bool
   multiplosPersistentes :: Int -> [Integer]

tales que

  • (esMultiploPersistente n) se verifica si n es un múltiplo persistente de n. Por ejemplo,
     esMultiploPersistente 7007  ==  True
     esMultiploPersistente 7107  ==  False
  • (multiplosPersistentes k) es la lista de los números con k dígitos que son múltiplos persistentes de 7. Por ejemplo,
     take 2 (multiplosPersistentes 4)   ==  [7000,7007]
     length (multiplosPersistentes 20)  ==  524288

Usando la función multiplosPersistentes, calcular la respuesta al problema de la Olimpiada.

Soluciones

import Data.List (sort)
 
-- 1ª definición de esMultiploPersistente
-- ======================================
 
esMultiploPersistente :: Integer -> Bool
esMultiploPersistente n =
  and [x `mod` 7 == 0 | x <- insertados n]
 
-- (insertados n) es la lista de los números obtenidos insertando un 0
-- en cualquier posición de n. Por ejemplo,
--    insertados 3264  ==  [3264,30264,32064,32604,32640]
insertados :: Integer -> [Integer]
insertados n =
  [read (xs ++ "0" ++ ys) | k <- [0..length ns],
                            let (xs,ys) = splitAt k ns]
  where ns = show n
 
-- 1ª definición de multiplosPersistentes
-- ======================================
 
multiplosPersistentes :: Int -> [Integer]
multiplosPersistentes n =
  filter esMultiploPersistente [10^(n-1)..10^n-1]
 
-- 2ª definición de multiplosPersistentes
-- ======================================
 
multiplosPersistentes2 :: Int -> [Integer]
multiplosPersistentes2 n =
  filter esMultiploPersistente [7*10^(n-1),7*10^(n-1)+7..7*((10^n-1) `div` 9)]
 
-- 3ª definición de esMultiploPersistente
-- ======================================
 
-- Observando los cálculos
--    multiplosPersistentes2 1  ==  [7]
--    multiplosPersistentes2 2  ==  [70,77]
--    multiplosPersistentes2 3  ==  [700,707,770,777]
--    multiplosPersistentes2 4  ==  [7000,7007,7070,7077,7700,7707,7770,7777]
 
esMultiploPersistente2 :: Integer -> Bool
esMultiploPersistente2 n =
  all (`elem` "07") (show n)
 
-- 3ª definición de multiplosPersistentes
-- ======================================
 
multiplosPersistentes3 :: Int -> [Integer]
multiplosPersistentes3 n =
  filter esMultiploPersistente2 [7*10^(n-1),7*10^(n-1)+7..7*((10^n-1) `div` 9)]
 
-- 4ª definición de multiplosPersistentes
-- ======================================
 
multiplosPersistentes4 :: Int -> [Integer]
multiplosPersistentes4 k =
  sort [read (reverse cs) | cs <- aux k]
  where aux 1 = ["7"]
        aux n = map ('0':) xs ++ map ('7':) xs
          where xs = aux (n-1)
 
-- Comprobación de equivalencia
-- ============================
 
-- La propiedad es
prop_multiplosPresistentes :: Int -> Bool
prop_multiplosPresistentes n =
  all (== (multiplosPersistentes n))
      [multiplosPersistentes2 n,
       multiplosPersistentes3 n,
       multiplosPersistentes4 n]
 
-- La comprobación es
--    λ> all prop_multiplosPresistentes [1..6]
--    True
 
-- Comparación de eficiencia
-- =========================
 
-- La comparación es
--    λ> length (multiplosPersistentes 6)
--    32
--    (3.35 secs, 7,378,373,000 bytes)
--    λ> length (multiplosPersistentes2 6)
--    32
--    (0.12 secs, 171,735,992 bytes)
--    λ> length (multiplosPersistentes3 6)
--    32
--    (0.03 secs, 9,290,744 bytes)
--    λ> length (multiplosPersistentes4 6)
--    32
--    (0.01 secs, 294,584 bytes)
--
--    λ> length (multiplosPersistentes2 8)
--    128
--    (7.76 secs, 18,659,185,520 bytes)
--    λ> length (multiplosPersistentes3 8)
--    128
--    (0.73 secs, 1,007,383,168 bytes)
--    λ> length (multiplosPersistentes4 8)
--    128
--    (0.01 secs, 960,808 bytes)
--
--    λ> length (multiplosPersistentes3 9)
--    256
--    (6.82 secs, 10,517,232,576 bytes)
--    λ> length (multiplosPersistentes4 9)
--    256
--    (0.01 secs, 1,912,136 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>

3 soluciones de “Múltiplos persistentes de siete

  1. Joaquín Infante Rodríguez
    import Data.List
    import Test.QuickCheck
     
    --Vemos primero unas definiciones de las funciones poco eficientes para
    --intentar buscar algún patrón.
     
    --La función auxiliar digitos devuelve los dígitos de un número:
    --  λ> digitos 233 == [2,3,3] (0.00 secs, 72,600 bytes)
    digitos :: Integer -> [Integer]
    digitos n = [read [x] | x<-show n]
     
    --La función listaNumero toma una lista y devuelve el número correspondiente a esos
    --dígitos:
    --  λ> listaNumero [3,2,2] == 322 (0.00 secs, 60,992 bytes)
    listaNumero :: [Integer] -> Integer
    listaNumero [] = 0
    listaNumero (x:xs) = x*10^(genericLength (x:xs)-1) + listaNumero xs
     
    --La función insertaCero toma un número n y devuelve una lista de enteros
    --resultantes de insertar en n el dígito cero en todas sus posiciones (Nota:
    --cuando el cero se inserta en la primera posición no devuelve 01889, sino que
    --devuelve el 1889):
    --  λ> insertaCero 1889 == [1889,10889,18089,18809,18890] (0.00 secs, 102,336 bytes)
    insertaCero :: Integer -> [Integer]
    insertaCero n = [read ((take k xs) ++ "0" ++ (drop k xs)) | k<-[0..length xs]]
                  where xs = show n
     
    --Llegamos a la definición (poco eficiente, por eso la nombramos con ') de
    --esMultiploPersistente', tal que esta toma un entero n y tiene que verificar
    --que en la lista resultante de insertaCero n todos son múltiplos de 7:
    --  λ> esMultiploPersistente' 7007 == True (0.02 secs, 88,080 bytes)
    --  λ> esMultiploPersistente' 7107 == False (0.02 secs, 65,584 bytes)
    esMultiploPersistente' :: Integer -> Bool
    esMultiploPersistente' n = and [rem (xs!!k) 7 == 0 | k<-[0..(genericLength xs -1)]]
                              where xs = insertaCero n
     
    --Por último vemos la función multiplosPersistentes' tal que esta recorre todos los
    --números de k cifras y devuelve los que sean múltiplos persistentes:
    --  λ> multiplosPersistentes' 4 == [7000,7007,7070,7077,7700,7707,7770,7777] (0.08 secs, 79,705,416 bytes)
     
    --  λ> multiplosPersistentes' 5 == [70000,70007,70070,70077,70700,70707,70770,70777,
    --                                  77000,77007,77070,77077,77700,77707,77770,77777]
    --                                 (0.67 secs, 854,845,440 bytes)
     
    multiplosPersistentes' :: Int -> [Integer]
    multiplosPersistentes' k = [n | n<-[(10^(k-1))..(10^k-1)], esMultiploPersistente' n]
     
     
    -- Analizamos los casos hasta los que la eficiencia ha permitido calcular.
    -- Vemos que un número es múltiplo persistente de 7, si el conjunto de todas
    -- sus cifras está compuesto por 7 o bien, por 0 (y un 7 como mínimo, pues el
    -- número 00000...0 == 0 no es válido).
     
    --Sea por tanto la función esMultiploPersistente, tal que dado un número n se
    --verifica si tras eliminar las repeticiones de sus dígitos nos queda la lista
    --[7] o [0,7] (ordenada):
    --  λ> esMultiploPersistente 7007 == True  (0.00 secs, 73,192 bytes)
    --  λ> esMultiploPersistente 7107 == False (0.00 secs, 77,072 bytes)
    esMultiploPersistente :: Integer -> Bool
    esMultiploPersistente n = xs == [7] || xs == [0,7]
                       where xs = sort (nub (digitos n))
     
    --La parte más bonita del problema es definir la función
    --multiplosPersistentes.
     
    --La función aux es la constructora de las variaciones con repetición de los
    --elementos 0 y 7 tomados de k en k.
    --  λ> aux 3 == [[0,0,0],[0,0,7],[0,7,0],[0,7,7],[7,0,0],[7,0,7],[7,7,0],[7,7,7]]
    --              (0.00 secs, 112,256 bytes)
    aux :: Integer -> [[Integer]]
    aux 0 = [[]]
    aux k = [x:ys | x <- xs, ys <- aux (k-1)]
                              where xs = [0,7]
     
    --Vemos que un número será persistente si y
    --solamente si empieza por 7 y las restantes cifras son resultado de una
    --variación con repetición de los elementos 0 y 7, tomados de (k-1) en (k-1).
    --  λ> take 2 (multiplosPersistentes 4) == [7000,7007]
    --     (0.00 secs, 73,768 bytes)
    --  λ> length (multiplosPersistentes 20) == 524288
    --     (1.34 secs, 1,635,835,192 bytes)
    multiplosPersistentes :: Integer -> [Integer]
    multiplosPersistentes k = map (listaNumero) (map (7:) ((aux (k-1))))
     
    --Vemos la equivalencia de esMultiploPersistente n == esMultiploPersistente' n
    prop1 :: Integer -> Property
    prop1 n = n>0 ==> esMultiploPersistente n == esMultiploPersistente' n
     
    --  λ> quickCheck prop1
    --  +++ OK, passed 100 tests.
    --  (0.01 secs, 2,917,016 bytes)
     
    --Como los múltiplos persistentes son variaciones con repetición de (k-1) en
    --(k-1) elementos (con el 7 como primera cifra), el cardinal del conjunto
    --multiplosPersistentes k tendrá que ser 2^(k-1), pues la fórmula del cardinal
    --de las variaciones con repetición de n elementos tomados de k en k es 2^n.
    --(Nota: Acotamos el número 20 para que haskell pueda calcular la propiedad)
    prop2 :: Integer -> Property
    prop2 k = k>0 && k<20 ==> length (multiplosPersistentes k) == 2^(k-1)
     
    --  λ> quickCheck prop2
    --  +++ OK, passed 100 tests.
    --  (6.08 secs, 7,224,663,904 bytes)
  2. j0sejuan
    {-
     
      Nos dicen que para cualquier múltiplo de 7
     
        a 10^k + b = 7 k
     
      si le ponemos un cero en la posición `k` debe
      seguir siendo múltiplo de 7, es decir
     
        a 10^(k + 1) + b = 7 w
     
      Debe cumplirse por tanto que (restando)
     
        10 a = 7 (k - w)
     
      Lo que nos lleva al principio, es decir, debe ser
     
        10 a = 7 z
     
      Pero entonces `a`, que es la terminación de `n` debe
      ser múltiplo de 7, es decir, el dígito más significativo
      de `n` debe ser 7.
     
      Repetimos a ver
     
        7 10^m + a 10^k + b = 7 k
     
      Volvemos a poner un cero en k
     
        7 10^(m + 1) + a 10^k + 1) + b = 7 w
     
      Y restando tenemos
     
        10 (7 + a) = 7 (k - w)
     
      Es decir, 7 + a debe ser múltiplo de 7 lo cual sólo es
      posible otra vez si `a` lo es, luego de nuevo el dígito
      más significativo de `a` debe ser 7 o 0.
     
      Repitiendo el proceso vemos que los números buscados
      son persistentes sii están formados por los dígitos 7 y 0.
     
    -}
    esMultiploPersistente :: Integer -> Bool
    esMultiploPersistente = (0 ==) . length . filter (not . (`elem` "07")) . show
     
    todosPersistentes :: [Integer]
    todosPersistentes = 0: rec [0] 7
      where rec xs p = let ys = map (p+) xs
                       in  ys ++ rec (xs ++ ys) (10 * p)
     
    multiplosPersistentes :: Int -> [Integer]
    multiplosPersistentes m = let p = 10^(m - 1) * 7
                              in  map (p+) $ takeWhile (<p) todosPersistentes
  3. Alejandro García Alcaide
    import Data.List (nub)
    -- La funcion digitos pasa un numero a una lista, formada por sus digitos. Por
    -- ejemplo:
    -- digitos 7007 == [7,0,0,7]
    digitos :: Integer -> [Integer]
    digitos n = [read [x] :: Integer | x <- show n]
     
    -- Por otro lado, tenemos leeDigito, inversa de la anterior, que devuelve a
    -- partir de una lista un número. Por ejemplo:
    -- leeDigito [7,0,0,7] == 7007
    leeDigito :: [Integer] -> Integer
    leeDigito []     = 0
    leeDigito (x:xs) = x * 10^(length xs) + leeDigito xs 
     
    -- Avanzando con la definicion, llegamos a insertaCeros que añade un cero en la
    -- lista que representara al numero en una posicion n.
    insertaCeros :: [Integer] -> Int -> [Integer]
    insertaCeros []     _ = [0]
    insertaCeros (x:xs) n | n == 0 = (0:x:xs)
                          | n == 1 = (x:0:xs)
                          | otherwise = x : insertaCeros xs (n-1)
    -- Por ultimo, con combinacionesIns obtenemos todos los posibles numeros que se
    -- obtienen al insertar un cero en el numero. Veamos un ejemplo:
    -- combinacionesIns 7007 == [7007,70007,70070]
     
    combinacionesIns n = nub [leeDigito $ insertaCeros xs p | p <- [0..s]]
     where xs = digitos n
           s  = length xs
    -- Dado que es posible que haya dos numeros iguales al añadir el cero,
    -- eliminamos estas repeticiones.
    -- Definimo, finalmente, esMultiplo.
    esMultiplo :: Integer -> Integer -> Bool
    esMultiplo x y = mod x y == 0
     
    esMultiploPersistente :: Integer -> Bool
    esMultiploPersistente n =  and [mod x 7 == 0 | x <- combinacionesIns n]
     
     
     
    multiplosPersistentes :: Int -> [Integer]
    multiplosPersistentes n = filter (esMultiploPersistente) [1*10^(n-1)..]

Leave a Reply

Este sitio usa Akismet para reducir el spam. Aprende cómo se procesan los datos de tus comentarios.