Menu Close

Cadena descendiente de subnúmeros

Una particularidad del 2019 es que se puede escribir como una cadena de dos subnúmeros consecutivos (el 20 y el 19).

Definir la función

   cadena :: Integer -> [Integer]

tal que (cadena n) es la cadena de subnúmeros consecutivos de n cuya unión es n; es decir, es la lista de números [x,x-1,…x-k] tal que su concatenación es n. Por ejemplo,

   cadena 2019         == [20,19]
   cadena 2018         == [2018]
   cadena 1009         == [1009]
   cadena 110109       == [110,109]
   cadena 201200199198 == [201,200,199,198] 
   cadena 3246         == [3246]            
   cadena 87654        == [8,7,6,5,4]       
   cadena 123456       == [123456]          
   cadena 1009998      == [100,99,98]       
   cadena 100908       == [100908]          
   cadena 1110987      == [11,10,9,8,7]     
   cadena 210          == [2,1,0]           
   cadena 1            == [1]               
   cadena 0            == [0]               
   cadena 312          == [312]             
   cadena 191          == [191]
   length (cadena (read (concatMap show [2019,2018..0])))  ==  2020

Nota: Los subnúmeros no pueden empezar por cero. Por ejemplo, [10,09] no es una cadena de 1009 como se observa en el tercer ejemplo.

Soluciones

import Test.QuickCheck
import Data.List (inits)
 
-- 1ª solución
-- ===========
 
cadena :: Integer -> [Integer]
cadena = head . cadenasL . digitos
 
-- (digitos n) es la lista de los dígitos de n. Por ejemplo, 
--    digitos 325  ==  [3,2,5]
digitos :: Integer -> [Integer]
digitos n = [read [c] | c <- show n]
 
-- (cadenasL xs) son las cadenas descendientes del número cuyos dígitos
-- son xs. Por ejemplo,
--    cadenasL [2,0,1,9]      == [[20,19],[2019]]
--    cadenasL [1,0,0,9]      == [[1009]]
--    cadenasL [1,1,0,1,0,9]  == [[110,109],[110109]]
cadenasL :: [Integer] -> [[Integer]] 
cadenasL []       = []
cadenasL [x]      = [[x]]
cadenasL [1,0]    = [[1,0],[10]]
cadenasL (x:0:zs) = cadenasL (10*x:zs) 
cadenasL (x:y:zs) =
     [x:a:as | (a:as) <- cadenasL (y:zs), a == x-1]
  ++ cadenasL (10*x+y:zs)
 
-- 2ª solución
-- ===========
 
cadena2 :: Integer -> [Integer]
cadena2 n = (head . concatMap aux . iniciales) n 
  where aux x = [[x,x-1..x-k] | k <- [0..x]
                              , concatMap show [x,x-1..x-k] == ds]
        ds    = show n
 
-- (iniciales n) es la lista de los subnúmeros iniciales de n. Por
-- ejemplo, 
--    iniciales 2019  ==  [2,20,201,2019]
iniciales :: Integer -> [Integer]
iniciales = map read . tail . inits . show
 
-- Equivalencia
-- ============
 
-- La propiedad es
prop_cadena :: (Positive Integer) -> Bool
prop_cadena (Positive n) =
  cadena n == cadena2 n 
 
-- La comprobación es
--    λ> quickCheck prop_cadena
--    +++ OK, passed 100 tests.
 
-- Comparación de eficiencia
-- =========================
 
--    λ> length (cadena (read (concatMap show [15,14..0])))
--    16
--    (3.28 secs, 452,846,008 bytes)
--    λ> length (cadena2 (read (concatMap show [15,14..0])))
--    16
--    (0.03 secs, 176,360 bytes)

Pensamiento

La inseguridad, la incertidumbre, la desconfianza, son acaso nuestras únicas verdades. Hay que aferrarse a ellas.

Antonio Machado

2 soluciones de “Cadena descendiente de subnúmeros

  1. javmarcha1
    import Data.List
     
    -- 1º DEFINICIÓN
     
    cadena :: Integer ->  [Integer]
    cadena n = head [xs | xs <- candidatos n, joiner xs == n]
     
    joiner :: [Integer] -> Integer
    joiner (x:xs) = read (concat (map show (x:xs)))
     
    candidatos :: Integer -> [[Integer]]
    candidatos n =
      [xs | xs <- tail (subsequences (todos n)),
            (head xs - last xs) < genericLength xs]
      ++ [[n]]
     
    todos :: Integer -> [Integer]
    todos n = reverse (sort (repetidos n ++ añadir n))
     
    añadir :: Integer -> [Integer]
    añadir n = [x+1 | x <- repetidos n , x+1 `notElem` repetidos n]
     
    repetidos :: Integer -> [Integer]
    repetidos n = [x | x <- subsecuenciasnumeros n , elem x (repetidosx2 n)]
     
    repetidosx2 :: Integer -> [Integer]
    repetidosx2 n = [x | x <- ambos n, aparece x (ambos n) > 1]
     
    aparece :: Eq a => a -> [a] -> Int
    aparece _ [] = 0
    aparece x (y:ys) | x == y    = 1 + aparece x ys
                     | otherwise = aparece x ys
     
    ambos :: Integer -> [Integer]
    ambos n = subsecuenciasnumeros n ++ anteriores n
     
    anteriores :: Integer -> [Integer]
    anteriores n = [x - 1 | x <- subsecuenciasnumeros n]
     
    subsecuenciasnumeros :: Integer -> [Integer]
    subsecuenciasnumeros n = [aInteger xs | xs <- subsecuencias n]
     
    subsecuencias :: Integer -> [String]
    subsecuencias n = tail (subsequences (show n))
     
    aInteger :: String -> Integer
    aInteger = read 
     
    -- 2º DEFINICIÓN (MÁS EFICIENTE)
     
    cadena2 :: Integer -> [Integer]
    cadena2 n =
      head ([xs | xs <- agrupafinal n, joiner xs == n] ++ [[n]])
     
    agrupafinal :: Integer -> [[Integer]]
    agrupafinal n =
      concat [agrupaR x (listafinal n) | x <- [1..length (show n)]]
     
    listafinal :: Integer -> [Integer]
    listafinal n =
      reverse (sort (nub [ x | x <- agrupa n ,
                               elem (x-1) (agrupa n) || elem (x+1) (agrupa n)]))
     
    agrupa :: Integer -> [Integer]
    agrupa x = [joiner ys | ys <- agrupalist x]
     
    agrupalist :: Integer -> [[Integer]]
    agrupalist x = agrupalist2 [1..length (show x)] x
     
    agrupalist2 :: [Int] -> Integer -> [[Integer]]
    agrupalist2 [] _     = []
    agrupalist2 (x:xs) n = agrupaR x (digitos n) ++ agrupalist2 xs n
     
    digitos :: Integer -> [Integer]
    digitos n = [read [x] | x <- show n]
     
    agrupaR :: Int -> [a] -> [[a]]
    agrupaR _ []                 = []
    agrupaR n xs | n > length xs = []
    agrupaR n xs                 = take n xs : agrupaR n (drop 1 xs) 
     
    -- EFICIENCIA:
    --    λ> cadena 87654
    --    [8,7,6,5,4]
    --    (14.66 secs, 13,787,994,104 bytes)
    --    λ> cadena2 87654
    --    [8,7,6,5,4]
    --    (0.02 secs, 21,007,112 bytes)
  2. adogargon
    cadena :: Integer -> [Integer]
    cadena x = cadenaAux (digitos x)
     
    digitos :: Integer -> [Integer]
    digitos x = [read [y] | y <- show x]
     
    cadenaAux :: [Integer] -> [Integer]
    cadenaAux []  = []
    cadenaAux [x] = [x]
    cadenaAux (x:y:xs)
      | prop (x:y:xs) = x:y:xs
      | otherwise     = head [zs | (zs, p) <- zip (divide (x:y:xs))
                                                  (map prop (divide (x:y:xs)))
                                 , p && concatMap digitos zs == (x:y:xs)]
     
    prop :: [Integer] -> Bool
    prop [x] = True
    prop []  = True
    prop (x:y:xs) | siguiente x y = prop (y:xs)
                  | otherwise     = False
     
    siguiente :: Integer  -> Integer  -> Bool
    siguiente x y = x-1 == y
     
    lee :: [Integer]  -> Integer
    lee []     = 0
    lee (x:xs) = x * 10 ^ length xs + lee xs
     
    divide ::[Integer] -> [[Integer]]
    divide []  = [[]]
    divide [x] = [[x]]
    divide (x:y:xs) = [lee [x,y] : ys | ys <- divide xs]
                      ++ [x:y:xs]
                      ++ divide (lee [x,y] : xs)

Escribe tu solución

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