Menu Close

Cadena descendiente de subnúmeros

José A. Alonso,

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

Avanzado
, , , , , , , ,

2 soluciones de “Cadena descendiente de subnúmeros”

  1. Responder
    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. Responder
    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.