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)