Menu Close

Sucesiones de listas de números

En la Olimpiada Internacional de Matemáticas del 2012 se propuso el siguiente problema:

Varios enteros positivos se escriben en una lista. Iterativamente, Alicia elige dos números adyacentes x e y tales que x > y y x está a la izquierda de y y reemplaza el par (x,y) por (y+1,x) o (x-1,x). Demostrar que sólo puede aplicar un número finito de dichas iteraciones.

Por ejemplo, las transformadas de la lista [1,3,2] son [1,2,3] y [1,3,3] y las dos obtenidas son finales (es decir, no se les puede aplicar ninguna transformación).

Definir las funciones

   soluciones       :: [Int] -> [Estado]
   finales          :: [Int] -> [[Int]]
   finalesMaximales :: [Int] -> (Int,[[Int]])

tales que

  • (soluciones xs) es la lista de pares (n,ys) tales que ys es una lista obtenida aplicándole n transformaciones a xs. Por ejemplo,
     λ> soluciones [1,3,2]
     [(1,[1,3,3]),(1,[1,2,3])]
     λ> sort (nub (soluciones [3,3,2]))
     [(1,[3,3,3]),(2,[2,3,3]),(2,[3,3,3])]
     λ> sort (nub (soluciones [3,2,1]))
     [(2,[2,2,3]),(3,[2,2,3]),(3,[2,3,3]),(3,[3,3,3]),(4,[2,3,3]),(4,[3,3,3])]
  • (finales xs) son las listas obtenidas transformando xs y a las que no se les puede aplicar más transformaciones. Por ejemplo,
     finales [1,2,3]               ==  [[1,2,3]]
     finales [1,3,2]               ==  [[1,2,3],[1,3,3]]
     finales [3,2,1]               ==  [[2,2,3],[2,3,3],[3,3,3]]
     finales [1,3,2,4]             ==  [[1,2,3,4],[1,3,3,4]]
     finales [1,3,2,3]             ==  [[1,2,3,3],[1,3,3,3]]
     length (finales [9,6,0,7,2])  ==  19
     length (finales [80,60..0])   ==  420
  • (finalesMaximales xs) es el par (n,yss) tal que la longitud de las cadenas más largas de transformaciones a partir de xs e yss es la lista de los estados finales a partir de xs con n transformaciones. Por ejemplo,
     finalesMaximales [9,5,7]   ==  (2,[[6,8,9],[8,8,9]])
     finalesMaximales [3,2,1]   ==  (4,[[2,3,3],[3,3,3]])
     finalesMaximales [3,2..0]  ==  (10,[[2,3,3,3],[3,3,3,3]])
     finalesMaximales [4,3..0]  ==  (20,[[3,4,4,4,4],[4,4,4,4,4]])

Soluciones

import Data.List (nub, sort)
import I1M.BusquedaEnEspaciosDeEstados (buscaEE)
 
type Estado = (Int,[Int])
 
inicial :: [Int] -> Estado
inicial xs = (0,xs)
 
esFinal :: Estado -> Bool
esFinal e = null (sucesores e)
 
--    λ> sucesores [9,6,0,7,2]
--    [[7,9,0,7,2],[8,9,0,7,2],[9,1,6,7,2],[9,5,6,7,2],[9,6,0,3,7],[9,6,0,6,7]]
sucesores :: Estado -> [Estado]
sucesores (_,[])  = []
sucesores (_,[_]) = []
sucesores (n,x:y:xs) | x > y     = [(n+1,y+1:x:xs), (n+1,x-1:x:xs)] ++ yss
                     | otherwise = yss
    where yss = [(m,x:ys) | (m,ys) <- sucesores (n,y:xs)]
 
 
soluciones :: [Int] -> [Estado]
soluciones xs =
    buscaEE sucesores esFinal (inicial xs)
 
finales :: [Int] -> [[Int]]
finales xs =
    sort (nub (map snd (soluciones xs)))
 
finalesMaximales :: [Int] -> (Int,[[Int]])
finalesMaximales xs =
    (m, [xs | (n,xs) <- es, n == m])
    where es    = sort (nub (soluciones xs))
          (m,_) = maximum es
Avanzado

5 soluciones de “Sucesiones de listas de números

  1. fracruzam

    Si a alguien se le ocurre como evitar repeticiones…

    import Data.List
     
    soluciones :: [Int] -> [(Int,[Int])]
    soluciones xs = nub $ busca [(0,xs)]
      where busca :: [(Int,[Int])] -> [(Int,[Int])]
            busca ((n,xs):ys)
              | esFinal xs = (n,xs): busca ys
              | otherwise  = busca (ys ++ zs)
              where zs = [(n+1,ws) | ws <- alicia xs]
            busca   _      = []
            esFinal :: [Int] -> Bool
            esFinal (x:ys@(y:_)) = x <= y && esFinal ys
            esFinal  _           = True
            alicia :: [Int] -> [[Int]]
            alicia (x:ys@(y:xs)) 
              | x > y     = (y+1:x:xs):(x-1:x:xs):(map (x:) $ alicia ys)
              | otherwise = map (x:) $ alicia ys
            alicia  _     = []
     
    finales :: [Int] -> [[Int]]
    finales xs = nub $ busca' [xs]
      where busca' :: [[Int]] -> [[Int]]
            busca' (xs:yss)
              | esFinal xs = xs: busca' yss
              | otherwise  = busca' (yss ++ (filter (`notElem` yss) $ alicia xs))
            busca'  _      = []
            esFinal :: [Int] -> Bool
            esFinal (x:ys@(y:_)) = x <= y && esFinal ys
            esFinal  _           = True
            alicia :: [Int] -> [[Int]]
            alicia (x:ys@(y:xs)) 
              | x > y     = (y+1:x:xs):(x-1:x:xs):(map (x:) $ alicia ys)
              | otherwise = map (x:) $ alicia ys
            alicia  _     = []
     
     
    finalesMaximales :: [Int] -> (Int,[[Int]])
    finalesMaximales xs = (n,map snd $ takeWhile ((m,_) -> n == m) ys)
      where ys@((n,_):_) = reverse (soluciones xs)
    • fracruzam

      Añadiendo una guarda para alicia (gracias a Manu Pena por la idea)

       alicia :: [Int] -> [[Int]]
       alicia (x:ys@(y:xs)) 
           | x - 1 == y + 1 = (y+1:x:xs): (map (x:) $ alicia ys)
           | x > y          = (y+1:x:xs):(x-1:x:xs):(map (x:) $ alicia ys)
           | otherwise      = map (x:) $ alicia ys

      Y filtrando repeticiones en busca

      zs = [par | ws <- alicia xs, let par = (n+1,ws), par `notElem` ys]

      Se consigue bajar bastante el número de repeticiones.

  2. josejuan
    {-# LANGUAGE TupleSections #-}
    {-
     
      Sea xs la lista de elementos.
      Sea T(xs) una transformación sobre cualquier par.
      Sea S(xs) el supremo.
      Sea M(xs) la suma de sus elementos.
     
      Entonces, S es invariante frente a T
     
        S(xs) = S(T(xs))
     
      La sucesión
     
        M(xs), M(T(xs)), M(T(T(xs))), ...
     
      es monótona no decreciente y el nº de elementos iguales
      en dicha sucesión es finita (es decir, debe crecer en
      algún momento), pues, si no crece, es porque se ha
      aplicado la transformación
     
          ... X, Y ... ==>  ... X-1, X ...
     
      siendo Y=X-1 (en otro caso habría crecido), pero esta
      transformación sólo puede realizarse un máximo (contiguo)
      de veces igual a la longitud de xs cuando es
     
            X, X, X, ..., X, X, X-1
     
      Dado que la sucesión indicada siempre crece (para algún
      número de transformaciones) y el valor de M(xs) está acotada
      superiormente por
     
          S(xs) * Tamaño(xs)
     
      Se concluye que sólo pueden aplicarse T un nº finito de veces.
     
    -}
    import Control.Arrow
    import Control.Monad
    import Control.Monad.Trans.Writer
    import qualified Data.Set as S
    import Data.Function
    import Data.List
     
    -- Aplica cierta transformación o, si no hay pares, sobre la lista
    sobrePares :: ([Int] ->a) ->([[Int]] ->a) ->[Int] ->a
    sobrePares g f xs = case _T xs of { [] ->g xs; ps ->f ps }
      where _T ks = nub $ do  (xs,(x:y:ys)) <-init $ init $ zip (inits ks) (tails ks)
                              guard (x > y)
                              [xs ++ [x-1, x] ++ ys, xs ++ [y+1, x] ++ ys]
     
    soluciones :: [Int] ->[(Int, [Int])]
    soluciones = nub . sobrePares (return . (0,)) (concatMap (map (first (+1)) . soluciones))
     
    finales :: [Int] ->[[Int]]
    finales = S.toList . execWriter . f where f = sobrePares (tell . S.singleton) (mapM_ f)
     
    finalesMaximales :: [Int] ->(Int, [[Int]])
    finalesMaximales = (r@((n,_):_) ->(n, map snd r))
                     . head
                     . groupBy ((==) `on` fst)
                     . reverse
                     . soluciones
    • josejuan

      Una versión mucho más eficiente de finalesMaximales es recorrer el árbol de expansión en anchura (y no todo el árbol usando soluciones).

      -- En lugar de usar `soluciones` (que recorre todo el árbol de expansión)
      -- podemos recorrer dicho árbol en anchura para unificar las ramas comunes
      -- (dejando el prefijo con mayor longitud)
      finalesMaximales xs = f 0 [xs]
        where f n xss = case nub (concatMap (sobrePares (const []) id) xss) of
                          [](n, xss)
                          xss' → f (n+1) xss'
       
      {-
       
        > finalesMaximales [5,4..0]
        (35,[[4,5,5,5,5,5],[5,5,5,5,5,5]])
        (0.74 secs, 98,071,936 bytes)
       
      -}
  3. manpende

    Por el tipo de búsqueda, es bastante ineficiente cuando el proceso se ramifica en exceso, pero no se me ocurre otro modo de definirla haciendo uso de la librería de espacios de estado. También adolece de repeticiones innecesarias.
    Gracias a fracruzam por la ayuda.

    import BusquedaEnEspaciosDeEstados
    import Data.List
     
    type Estado = (Int,[Int])
    data NodoAlicia = Nodo [[Int]]
                    deriving (Eq,Ord,Show)
     
    soluciones :: [Int] -> [Estado]
    soluciones xs = nodosAEstado $ buscaEE sucesoresN esFinalN (Nodo [xs])
     
    finales :: [Int] -> [[Int]]
    finales xs =  nub $ nodosALista $ buscaEE sucesoresN esFinalN (Nodo [xs])
     
    finalesMaximales :: [Int] -> (Int,[[Int]])
    finalesMaximales xs = (n,nub[x | (m,x) <- s, m == n])
        where n = maximum $ map fst s
              s = soluciones xs
     
    sucesores :: [Int] -> [[Int]] 
    sucesores [] = []
    sucesores xs | esFinal xs = [xs]
                 | otherwise = modifica xs                   
                 where modifica :: [Int] -> [[Int]]
                       modifica [] = []
                       modifica [x] = [[x]]
                       modifica (x:b@(y:xs)) 
                           | x-1 == y+1 = [x-1:x:xs] ++ map (x:) (modifica b)
                           | x > y = [x-1:x:xs] ++ [y+1:x:xs] ++ 
                                     map (x:) (modifica b) 
                           | otherwise = map (x:) (modifica b)
     
    sucesoresN :: NodoAlicia -> [NodoAlicia]
    sucesoresN (Nodo y) = [Nodo (x:y) | x <- sucesores (head y),notElem x y] 
     
    esFinal :: [Int] -> Bool
    esFinal (x:b@(y:xs)) | x > y = False
                         | otherwise = esFinal b
    esFinal _ = True
     
    esFinalN :: NodoAlicia -> Bool
    esFinalN (Nodo xs) = esFinal (head xs)
     
    nodosALista :: [NodoAlicia] -> [[Int]]
    nodosALista [] = []
    nodosALista ((Nodo x):xs) = head x : nodosALista xs
     
    nodosAEstado :: [NodoAlicia] -> [Estado]
    nodosAEstado [] = []
    nodosAEstado ((Nodo x):xs) = (length x-1,head x) : nodosAEstado xs

Escribe tu solución

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