Menu Close

Día: 20 abril, 2021

Cuadriseguidos y números encadenados

El enunciado del primer problema de este mes de la RSME es el siguiente:

Un entero positivo de dos o más cifras se denomina cuadriseguido si cada par de dígitos consecutivos que tenga es un cuadrado perfecto. Por ejemplo,

  • 364 es cuadriseguido, pues 36 = 6^2 y 64 = 8^2
  • 3642 no lo es porque 42 no es un cuadrado perfecto.

Obtén todos los números cuadriseguidos posibles.

El concepto de cuadriseguido se puede generalizar como sigue: Un entero positivo n de dos o más cifras se denomina encadenado respecto de una lista de números de dos dígitos xs si cada par de dígitos consecutivos que tenga es un elemento distinto de xs. Por ejemplo,

  • 364 es encadenado respecto de xs = [36,64,15], porque 36 y 64 pertenecen a xs
  • 3642 no es encadenado respecto de xs = [36,64,15], porque 42 no pertenece a xs

Definir la función

   encadenados :: [Integer] -> [Integer]

tal que (encadenados xs) es la lista de los números encadenados respecto de xs. Por ejemplo,

   λ> encadenados [12,23,31]
   [12,23,31,123,231,312,1231,2312,3123]
   λ> encadenados [12,22,31]
   [12,22,31,122,312,3122]
   λ> take 14 (encadenados [n^2 | n <- [4..9]])
   [16,25,36,49,64,81,164,364,649,816,1649,3649,8164,81649]
   λ> length (encadenados [10..42])
   911208

Calcular todos los números cuadriseguidos posibles usando la función encadenados.

Soluciones

import Data.List (delete, sort)
import Data.Tree (Tree (Node), drawTree)
import Test.QuickCheck (Gen, choose, sublistOf, quickCheck)
 
-- 1ª solución
-- ===========
 
encadenados :: [Integer] -> [Integer]
encadenados xs =
  filter (esEncadenado xs) [10..10^(2 * length xs) - 1]
 
-- (esEncadenado xs n) se verifica si n es un número encadenado respecto
-- de xs. Por ejemplo,
--    esEncadenado [36,64,15] 364   ==  True
--    esEncadenado [36,64,15] 3642  ==  False
--    esEncadenado [36,63] 3636     ==  False
esEncadenado :: [Integer] -> Integer -> Bool
esEncadenado xs n =
  dosConsecutivos n `contenido` xs
 
-- (dosConsecutivos n) es la lista de los números formados por dos
-- dígitos consecutivos de xs. Por ejemplo,
--    dosConsecutivos 81649  ==  [81,16,64,49]
dosConsecutivos :: Integer -> [Integer]
dosConsecutivos n =
  map read [[x,y] | (x,y) <- zip xs (tail xs)]
  where xs = show n
 
-- Otra definición alternativa
dosConsecutivos2 :: Integer -> [Integer]
dosConsecutivos2 = reverse . aux
  where aux n
          | n < 10    = []
          | otherwise = n `mod` 100 : aux (n `div` 10)
 
-- (contenido xs ys) se verifica si xs está contenido en ys. Por
-- ejemplo,
--    contenido [2,5] [3,5,2]  ==  True
--    contenido [2,5,5] [3,5,2]  ==  False
contenido :: [Integer] -> [Integer] -> Bool
contenido [] _      = True
contenido (x:xs) ys = x `elem` ys && xs `contenido` (delete x ys)
 
-- 2ª solución
-- ===========
 
encadenados2 :: [Integer] -> [Integer]
encadenados2 xs =
  sort (map (digitosAnumero . cadenaReducida) (tail (nodos (arbolCadenas ps))))
  where ps = map (`divMod` 10) xs
 
-- (arbolCadenas ps) es el árbol de las cadenas formadas con los
-- elementos de ps. Por ejemplo,
--    λ> putStrLn (drawTree (fmap show (arbolCadenas [(1,2),(2,3),(3,1)])))
--    []
--    |
--    +- [(1,2)]
--    |  |
--    |  `- [(3,1),(1,2)]
--    |     |
--    |     `- [(2,3),(3,1),(1,2)]
--    |
--    +- [(2,3)]
--    |  |
--    |  `- [(1,2),(2,3)]
--    |     |
--    |     `- [(3,1),(1,2),(2,3)]
--    |
--    `- [(3,1)]
--       |
--       `- [(2,3),(3,1)]
--          |
--          `- [(1,2),(2,3),(3,1)]
arbolCadenas :: Eq a => [(a,a)] -> Tree [(a,a)]
arbolCadenas ps = aux []
  where
    aux xs = Node xs (map aux (extensiones xs))
    extensiones [] =
      [[p] | p <- ps]
    extensiones ((x,y):rs) =
      [(a,b):(x,y):rs | (a,b) <- ps,
                        b == x,
                        (a,b) `notElem` ((x,y):rs)]
 
-- (nodos a) es la lista de los nodos del árbol a. Por ejemplo,
--    λ> nodos (arbolCadenas [(1,6),(6,4),(8,1)])
--    [[],[(1,6)],[(8,1),(1,6)],[(6,4)],[(1,6),(6,4)],[(8,1),(1,6),(6,4)],[(8,1)]]
nodos :: Tree [(a,a)] -> [[(a,a)]]
nodos (Node x ys) =
  x : concatMap nodos ys
 
-- (cadenaReducida ps) es la lista de los elementos la cadena ps donde
-- los enlaces solo se escriben una vez. Por ejemplo,
--    cadenaReducida [(8,1),(1,6),(6,4),(4,9)]  ==  [8,1,6,4,9]
cadenaReducida :: [(a,a)] -> [a]
cadenaReducida [] = []
cadenaReducida ((x,y):ps) = x : y : map snd ps
 
-- (digitosAnumero xs) es el número cuya lista de dígitos es xs. Por
-- ejemplo,
--    digitosAnumero [8,1,6,4,9]  ==  81649
digitosAnumero :: [Integer] -> Integer
digitosAnumero xs =
  read (concatMap show xs)
 
-- 3ª solución
-- ===========
 
encadenados3 :: [Integer] -> [Integer]
encadenados3 xs =
  sort (map read (aux [(p,delete p ps) | p <- ps]))
  where
    ps = map show xs
    aux [] = []
    aux ((as,qs):yss)
      | null zss  = as : aux yss
      | otherwise = as : aux (zss ++ yss)
      where zss = extensiones (as,qs)
    extensiones (x:xs,cs) =
      [(a:x:xs,delete [a,b] cs) | [a,b] <- cs, b == x]
 
-- Cálculo de cuadriseguidos
-- =========================
 
-- El cálculo es
--    λ> encadenados2 [n^2 | n <- [4..9]]
--    [16,25,36,49,64,81,164,364,649,816,1649,3649,8164,81649]
 
-- Comprobación de equivalencia
-- ============================
 
-- La propiedad es
prop_encadenados :: Gen Bool
prop_encadenados = do
  n <- choose (2,9)
  xs <- sublistOf [10..99]
  let ys = take n xs
      as = encadenados3 ys
      m  = length as
  return (take m (encadenados ys) == as &&
          encadenados2 ys == as)
 
-- La comprobación es
--    λ> quickCheck prop_encadenados
--    +++ OK, passed 100 tests.
 
-- Comparación de eficiencia
-- =========================
 
-- La comparación es
--    λ> encadenados [12,24,41]
--    [12,24,41,124,241,412,1241,2412,4124]
--    (2.23 secs, 5,189,736,248 bytes)
--    λ> encadenados2 [12,24,41]
--    [12,24,41,124,241,412,1241,2412,4124]
--    (0.00 secs, 188,496 bytes)
--    λ> encadenados3 [12,24,41]
--    [12,24,41,124,241,412,1241,2412,4124]
--    (0.01 secs, 176,376 bytes)
--
--    λ> length (encadenados2 [10..42])
--    911208
--    (13.59 secs, 14,104,867,760 bytes)
--    λ> length (encadenados3 [10..42])
--    911208
--    (10.62 secs, 10,164,004,808 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>