¿Qué hace exactamente esta lista la implementación de las permutaciones en Haskell?

permutation

Question

Estoy estudiando el código en el módulo Data.List y no puedo entender bien esta implementación de permutaciones:

permutations            :: [a] -> [[a]]
permutations xs0        =  xs0 : perms xs0 []
  where
    perms []     _  = []
    perms (t:ts) is = foldr interleave (perms ts (t:is)) (permutations is)
      where interleave    xs     r = let (_,zs) = interleave'' id xs r in zs
            interleave'' _ []     r = (ts, r)
            interleave'' f (y:ys) r = let (us,zs) = interleave'' (f . (y:)) ys r
                                     in  (y:us, f (t:y:us) : zs)

¿Alguien puede explicar en detalle cómo se conectan / trabajan estas funciones anidadas?

Answer 1

El algoritmo básico se basa en la idea de tomar un elemento de la lista a la vez, encontrar cada permutación de elementos, incluido el nuevo, y luego repetir.

Para explicar cómo se ve esto, [1 ..] significará una lista de una arriba, donde aún no se han examinado los valores (ni siquiera el primero). Es el parámetro de la función. La lista resultante es algo así como:

[[1..]] ++
[[2,1,3..]] ++
[[3,2,1,4..], [2,3,1,4..]] ++ [[3,1,2,4..], [1,3,2,4..]]
[[4,3,2,1,5..], etc

El agrupamiento anterior refleja la idea central del algoritmo ... cada fila representa un nuevo elemento tomado de la lista de entrada, y se agrega al conjunto de elementos que se permutan. Además, es recursivo ... en cada nueva fila, toma todas las permutaciones existentes, y coloca el elemento en cada lugar que todavía no ha sido (todos los lugares excepto el último). Entonces, en la tercera fila, tenemos las dos permutaciones [2,1] y [1,2], y luego tenemos lugar 3 en ambos espacios disponibles, entonces [[3,2,1], [2,3, 1]] y [[3,1,2], [1,3,2]], respectivamente, y luego anexar lo que sea la parte no observada.

Con suerte, esto al menos aclara un poco el algoritmo. Sin embargo, hay algunas optimizaciones y detalles de implementación para explicar.

(Nota al margen: hay dos optimizaciones centrales de rendimiento que se utilizan: en primer lugar, si desea agregar previamente varios elementos a múltiples listas, la lista del map (x:y:z:) list es mucho más rápida que la coincidencia condicional o de patrones, porque no tiene ramificación, solo un salto calculado. Segundo, y este se usa mucho, es barato (y práctico) construir listas desde atrás hacia adelante, al preceder repetidamente los ítems, esto se usa en algunos lugares .

Lo primero que hace la función es establecer un caso de dos bases: primero, cada lista tiene al menos una permutación: ella misma. Esto puede ser devuelto sin evaluación alguna. Esto podría considerarse como el caso de "tomar 0".

El bucle externo es la parte que se parece a lo siguiente:

perms (t:ts) is = <prepend_stuff_to> (perms ts (t:is))

ts es la parte "intacta" de la lista, que aún no estamos en proceso de permutación y que aún no hemos examinado, y que inicialmente es toda la secuencia de entrada.

t es el nuevo ítem que quedaremos entre las permutaciones.

is la lista de elementos que permutarán, y luego colocar t en medio, e inicialmente está vacía.

Cada vez que calculamos una de las filas anteriores, alcanzamos el final de los elementos que hemos agregado al thunk que contiene (perms ts (t: is)) y se repetirá.

El segundo bucle es un foldr. Para cada permutación de is (el material antes del elemento actual en la lista original), interleave el elemento en esa lista, y lo antepone al thunk.

foldr interleave <thunk> (permutations is)

El tercer ciclo es uno de los más complejos. Sabemos que precede cada intercalación posible de nuestro elemento objetivo t en una permutación, seguida de la cola no observada en la secuencia de resultados. Hace esto con una llamada recursiva, donde pliega la permutación en una pila de funciones mientras recursivamente, y luego, a medida que regresa, ejecuta lo que equivale a dos pequeñas máquinas de estado para generar los resultados.

interleave [<thunk>] [1,2,3] un ejemplo: interleave [<thunk>] [1,2,3] donde t = 4 y is = [5..]

Primero, como intercalar ''se llama de manera recursiva, construye y s y f s en la pila, así:

y = 1, f = id
y = 2, f = (id . (1:))
y = 3, f = ((id . (1:)) . (2:))
(the functions are conceptually the same as ([]++), ([1]++), and ([1,2]++) respectively)

Luego, cuando volvemos a subir, volvemos y evaluamos una tupla que contiene dos valores, (us, zs) .

us es la lista a la que anteponemos el ys después de nuestro objetivo t .

zs es el acumulador de resultados, donde cada vez que recibimos una nueva permutación, la anteponemos a las listas de resultados.

Por lo tanto, para finalizar el ejemplo, f (t:y:us) se evalúa y se devuelve como resultado para cada nivel de la pila anterior.

([1,2]++) (4:3:[5..]) === [1,2,4,3,5..]
([1]++) (4:2[3,5..])  === [1,4,2,3,5..]
([]++) (4:1[2,3,5..]) === [4,1,2,3,5..]

Con suerte, eso ayuda, o al menos complementa el material haskell.1045720.n5.nabble.com/… .

(Gracias a dfeuer por mencionar esto en el IRC y discutirlo durante unas horas)

Answer 2

Perdón por la respuesta tardía, tomó un poco más escribir lo esperado.

Entonces, antes que nada para maximizar la pereza en una función de lista como esta, hay dos objetivos:

• Produzca tantas respuestas como sea posible antes de inspeccionar el siguiente elemento de la lista de entrada
• Las respuestas en sí deben ser flojas, por lo que lo mismo debe ser válido.

Ahora considere la función de permutation . Aquí la pereza máxima significa:

• ¡Deberíamos determinar que hay al menos n! permutaciones después de inspeccionar solo n elementos de entrada
• Para cada uno de estos n! permutaciones, los primeros n elementos deberían depender solo de los primeros n elementos de la entrada.

La primera condición podría formalizarse como

length (take (factorial n) $ permutations ([1..n] ++ undefined))) `seq` () == ()

David Benbennick formalizó la segunda condición como

map (take n) (take (factorial n) $ permutations [1..]) == permutations [1..n] 

Combinados, tenemos

map (take n) (take (factorial n) $ permutations ([1..n] ++ undefined)) == permutations [1..n] 

Comencemos con algunos casos simples. Primera permutation [1..] . Debemos tener

permutations [1..] = [1,???] : ???

Y con dos elementos debemos tener

permutations [1..] = [1,2,???] : [2,1,???] : ???

Tenga en cuenta que no hay ninguna opción sobre el orden de los dos primeros elementos, no podemos poner [2,1,...] primero, ya que ya hemos decidido que la primera permutación debe comenzar con 1 . Ya debería estar claro que el primer elemento de las permutations xs debe ser igual a xs .

Ahora a la implementación.

En primer lugar, hay dos formas diferentes de hacer todas las permutaciones de una lista:

1. Estilo de selección: sigue seleccionando elementos de la lista hasta que no queden más

   permutations []  = [[]]
   permutations xxs = [(y:ys) | (y,xs) <- picks xxs, ys <- permutations xs]
     where
       picks (x:xs) = (x,xs) : [(y,x:ys) | (y,ys) <- picks xs]

2. Estilo de inserción: inserte o intercale cada elemento en todos los lugares posibles

   permutations []     = [[]]
   permutations (x:xs) = [y | p <- permutations xs, y <- interleave p]
     where
       interleave []     = [[x]]
       interleave (y:ys) = (x:y:ys) : map (y:) (interleave ys)

Tenga en cuenta que ninguno de estos es máximamente vago. El primer caso, lo primero que hace esta función es elegir el primer elemento de la lista completa, que no es perezoso en absoluto. En el segundo caso, necesitamos las permutaciones de la cola antes de poder realizar cualquier permutación.

Para empezar, tenga en cuenta que la interleave puede hacerse más vago. El primer elemento de la lista de interleave yss es [x] si yss=[] o (x:y:ys) si yss=y:ys . Pero ambos son lo mismo que x:yss , entonces podemos escribir

interleave yss = (x:yss) : interleave'' yss
interleave'' [] = []
interleave'' (y:ys) = map (y:) (interleave ys)

La implementación en Data.List continúa con esta idea, pero usa algunos trucos más.

Quizás sea más fácil pasar por la haskell.1045720.n5.nabble.com/… . Comenzamos con la versión de David Benbennick, que es la misma que la que escribí arriba (sin la intercalación perezosa). Ya sabemos que el primer elemento de permutations xs debe ser xs . Entonces, pongamos eso

permutations xxs     = xxs : permutations'' xxs
permutations'' []     = []
permutations'' (x:xs) = tail $ concatMap interleave $ permutations xs
  where interleave = ..

La llamada a la tail por supuesto, no es muy agradable. Pero si ponemos en línea las definiciones de permutations e interleave obtenemos

permutations'' (x:xs)
  = tail $ concatMap interleave $ permutations xs
  = tail $ interleave xs ++ concatMap interleave (permutations'' xs)
  = tail $ (x:xs) : interleave'' xs ++ concatMap interleave (permutations'' xs)
  = interleave'' xs ++ concatMap interleave (permutations'' xs)

Ahora tenemos

permutations xxs     = xxs : permutations'' xxs
permutations'' []     = []
permutations'' (x:xs) = interleave'' xs ++ concatMap interleave (permutations'' xs)
  where
   interleave yss = (x:yss) : interleave'' yss
   interleave'' [] = []
   interleave'' (y:ys) = map (y:) (interleave ys)

El siguiente paso es la optimización. Un objetivo importante sería eliminar las llamadas (++) en intercalado. Esto no es tan fácil, debido a la última línea, map (y:) (interleave ys) . No podemos usar inmediatamente el truco foldr / ShowS de pasar la cola como parámetro. La salida es deshacerse del mapa. Si pasamos un parámetro f como la función que debe mapearse sobre el resultado al final, obtenemos

permutations'' (x:xs) = interleave'' id xs ++ concatMap (interleave id) (permutations'' xs)
  where
   interleave f yss = f (x:yss) : interleave'' f yss
   interleave'' f [] = []
   interleave'' f (y:ys) = interleave (f . (y:)) ys

Ahora podemos pasar la cola

permutations'' (x:xs) = interleave'' id xs $ foldr (interleave id) [] (permutations'' xs)
  where
   interleave  f yss    r = f (x:yss) : interleave'' f yss r
   interleave'' f []     r = r
   interleave'' f (y:ys) r = interleave (f . (y:)) ys r

Esto empieza a parecerse al de Data.List, pero todavía no es el mismo. En particular, no es tan flojo como podría ser. Probémoslo:

*Main> let n = 4
*Main> map (take n) (take (factorial n) $ permutations ([1..n] ++ undefined))
[[1,2,3,4],[2,1,3,4],[2,3,1,4],[2,3,4,1]*** Exception: Prelude.undefined

Oh, oh, solo los primeros n elementos son correctos, no el primer factorial n . La razón es que todavía intentamos colocar el primer elemento (el 1 en el ejemplo anterior) en todas las ubicaciones posibles antes de intentar cualquier otra cosa.

Yitzchak Gale encontró una solución. Se consideraron todas las formas de dividir la entrada en una parte inicial, un elemento intermedio y una cola:

[1..n] == []    ++ 1 : [2..n]
       == [1]   ++ 2 : [3..n]
       == [1,2] ++ 3 : [4..n]

Si no ha visto el truco para generar estos antes, puede hacerlo con zip (inits xs) (tails xs) . Ahora las permutaciones de [1..n] serán

• [] ++ 1 : [2..n] aka. [1..n] , o
• 2 insertado (intercalado) en algún lugar en una permutación de [1] , seguido de [3..n] . Pero no 2 insertadas al final de [1] , ya que ya hemos obtenido ese resultado en el punto anterior.
• 3 intercalado en una permutación de [1,2] (no al final), seguido de [4..n] .
• etc.

Puedes ver que esto es holgazán al máximo, ya que incluso antes de considerar hacer algo con 3 , hemos dado todas las permutaciones que comienzan con alguna permutación de [1,2] . El código que Itzjak dio fue

permutations xs = xs : concat (zipWith newPerms (init $ tail $ tails xs)
                                                (init $ tail $ inits xs))
  where
    newPerms (t:ts) = map (++ts) . concatMap (interleave t) . permutations3
    interleave t [y]        = [[t, y]]
    interleave t ys@(y:ys'') = (t:ys) : map (y:) (interleave t ys'') 

Tenga en cuenta la llamada recursiva a permutations3 , que puede ser una variante que no tiene que ser máximamente vago.

Como puede ver, esto está un poco menos optimizado que lo que teníamos antes. Pero podemos aplicar algunos de los mismos trucos.

El primer paso es deshacerse de init y tail . Veamos qué zip (init $ tail $ tails xs) (init $ tail $ inits xs) realidad es

*Main> let xs = [1..5] in zip (init $ tail $ tails xs) (init $ tail $ inits xs)
[([2,3,4,5],[1]),([3,4,5],[1,2]),([4,5],[1,2,3]),([5],[1,2,3,4])]

El init elimina la combinación ([],[1..n]) , mientras que la tail se deshace de la combinación ([1..n],[]) . No queremos lo primero, porque eso no coincidiría con el patrón en los newPerms . El último fallaría interleave . Ambos son fáciles de solucionar: simplemente agregue un caso para los newPerms [] y para interleave t [] .

permutations xs = xs : concat (zipWith newPerms (tails xs) (inits xs))
  where
    newPerms [] is = []
    newPerms (t:ts) is = map (++ts) (concatMap (interleave t) (permutations is))
    interleave t []         = []
    interleave t ys@(y:ys'') = (t:ys) : map (y:) (interleave t ys'') 

Ahora podemos intentar alinear tails e inits . Su definición es

tails xxs = xxs : case xxs of
  []     -> []
  (_:xs) -> tails xs

inits xxs = [] : case xxs of
  []     -> []
  (x:xs) -> map (x:) (inits xs)

El problema es que inits no es recursivo de cola. Pero dado que vamos a tomar una permutación de los inits de todos modos, no nos importa el orden de los elementos. Entonces podemos usar un parámetro de acumulación

inits'' = inits'''' []
  where
  inits'''' is xxs = is : case xxs of
    []     -> []
    (x:xs) -> inits'''' (x:is) xs

Ahora hacemos newPerms una función de xxs y este parámetro de acumulación, en lugar de tails xxs e inits xxs .

permutations xs = xs : concat (newPerms'' xs [])
  where
    newPerms'' xxs is =
      newPerms xxs is :
      case xxs of
        []     -> []
        (x:xs) -> newPerms'' xs (x:is)
    newPerms [] is = []
    newPerms (t:ts) is = map (++ts) (concatMap (interleave t) (permutations3 is))

al newPerms newPerms'' newPerms en los newPerms'' se da

permutations xs = xs : concat (newPerms'' xs [])
  where
    newPerms'' []     is = [] : []
    newPerms'' (t:ts) is =
      map (++ts) (concatMap (interleave t) (permutations is)) :
      newPerms'' ts (t:is)

enlineando y desplegando concat , y moviendo el map (++ts) final map (++ts) en interleave ,

permutations xs = xs : newPerms'' xs []
  where
    newPerms'' []     is = []
    newPerms'' (t:ts) is =
        concatMap interleave (permutations is) ++
        newPerms'' ts (t:is)
      where
      interleave []     = []
      interleave (y:ys) = (t:y:ys++ts) : map (y:) (interleave ys) 

Entonces, finalmente, podemos volver a aplicar el truco de foldr para deshacernos de (++) :

permutations xs = xs : newPerms'' xs []
  where
    newPerms'' []     is = []
    newPerms'' (t:ts) is =
        foldr (interleave id) (newPerms'' ts (t:is)) (permutations is)
      where
      interleave f []     r = r
      interleave f (y:ys) r = f (t:y:ys++ts) : interleave (f . (y:)) ys r

Espera, dije, deshacete del (++) . Nos deshicimos de uno de ellos, pero no el de interleave . Para eso, podemos ver que siempre estamos concatenando alguna cola de yys a ts . Entonces, podemos desplegar el cálculo (ys++ts) junto con la recursión de interleave , y hacer que la función interleave'' f ys r devuelva la tupla (ys++ts, interleave f ys r) . Esto da

permutations xs = xs : newPerms'' xs []
  where
    newPerms'' []     is = []
    newPerms'' (t:ts) is =
        foldr interleave (newPerms'' ts (t:is)) (permutations is)
      where
      interleave ys r = let (_,zs) = interleave'' id ys r in zs
      interleave'' f []     r = (ts,r)
      interleave'' f (y:ys) r = 
        let (us,zs) = interleave'' (f . (y:)) ys r
        in  (y:us, f (t:y:us) : zs)

Y ahí lo tiene, Data.List.permutations en toda su gloria optimizada máximamente floja.

Gran reseña de Twan! Yo (@Yitz) solo agregaré algunas referencias:

• El hilo de correo electrónico original donde Twan desarrolló este algoritmo, vinculado anteriormente por Twan, es una lectura fascinante.

• Knuth clasifica todos los algoritmos posibles que satisfacen estos criterios en el Vol. 4 Fasc. 2 segundos. 7.2.1.2.

• Las permutations3 de Twan son esencialmente las mismas que las del "Algoritmo P" de Knuth. Por lo que Knuth sabe, ese algoritmo fue publicado por primera vez por campanarios de la iglesia inglesa en el 1600.