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 final 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
Ejercicio

3 soluciones de “Sucesiones de listas de números

  1. enrnarbej
    import Data.List 
     
    -- En primer lugar vemos que el proceso siempre termina al ser el máximo fijo y ya que cada vez que aplicamos
    -- una operación aumentamos la suma total.
     
    -- Aplicamos busqueda en espacios de estados
     
    type Estado = (Int,[Int])
     
    soluciones :: [Int] -> [Estado]
    soluciones xs = sol [] [(0,xs)] 
     
    sol :: [Estado] -> [Estado] -> [Estado]
    sol ys [] = ys
    sol ys ((n,xs):zs) | esFinal xs = sol ((n,xs):ys) zs
                       | otherwise  = sol ys ([(n+1,x) |x <- aplica xs] ++ zs)
     
    esFinal :: [Int] -> Bool          
    esFinal xs = sort xs == xs
     
    aplica :: [Int] -> [[Int]]
    aplica (x:y:xs) | x > y = ((x-1):x:xs):((y+1):x:xs): map (x:) (aplica (y:xs))
                    | otherwise = map (x:) (aplica (y:xs))
    aplica _ = []
     
    finales :: [Int] -> [[Int]]
    finales = nub . map snd . soluciones
     
    finalesMaximales :: [Int] -> (Int,[[Int]])
    finalesMaximales xs = (n,(nub . map snd . filter ((n==) . fst)) s)
                     where
                      s = soluciones xs
                      n = (maximum . map fst) s
  2. albcercid
     
    import Data.List as D
    import Data.Set as S
     
     
    type Estado = (Int,[Int])
     
     
    siguientes xs = aux xs []
        where aux [x] _ = []
              aux (x:y:ys) zs | x > y = t1:t2:aux (y:ys) (x:zs)
                              | otherwise = aux (y:ys) (x:zs)
                          where t1 = reverse zs ++ (y+1):x:ys
                                t2 = reverse zs ++ (x-1):x:ys
    esFinal xs = all ((a,b) -> a <= b) (zip xs (tail xs))
     
    soluciones :: [Int] -> [Estado]
    soluciones xs = fin [(0,xs)]
      where fin [] = []
            fin ((a,ys):zs) | esFinal ys = (a,ys):fin zs
                            | otherwise =
                              fin (zip (repeat (a+1)) (siguientes ys) ++ zs)
     
     
    finales :: [Int] -> [[Int]]
    finales xs = aux (fromList [xs]) (fromList [])
        where aux t x | S.null t = toList x
                      | esFinal c = aux t2 (S.insert c x)
                      | otherwise = aux (S.union t2 (fromList (siguientes c))) x
                        where (c,t2) = deleteFindMin t
     
     
    finalesMaximales :: [Int] -> (Int,[[Int]])
    finalesMaximales xs = (a, nub $ D.map snd $ D.filter ((x,y) -> x == a) f)
              where a = maximum $ D.map fst $ f
                    f = soluciones xs
  3. Cescarde
    import Data.List
    type Estado = (Int,[Int])
     
    soluciones :: [Int] -> [Estado]
    soluciones = nub.auxi 0
               where auxi n xs | esFinal xs = [(n,xs)]
                               | otherwise = concat [auxi (n+1) x | x <- trans xs]
     
    esFinal :: [Int] -> Bool
    esFinal xs = sort xs == xs
     
    trans :: [Int] -> [[Int]]
    trans (x:y:xs) | x>y = ((x-1):x:xs) : ((y+1):x:xs) : map (x:) (trans (y:xs))
                   | otherwise = map (x:) (trans (y:xs))
    trans _ = []
     
    finales :: [Int] -> [[Int]]
    finales xs = nub $ filter (esFinal) (map snd (soluciones xs))
     
    finalesMaximales :: [Int] -> (Int,[[Int]])
    finalesMaximales xs = auxNew [] (fst $ last ys) ys
                     where ys = soluciones xs
                           auxNew hs a [] = (a,sort hs)
                           auxNew hs a ((b,xs):zs) | a==b = auxNew (xs:hs) a zs
                                                   | otherwise = auxNew hs a zs

Escribe tu solución

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