No busques más por otras páginas porque has llegado al espacio indicado, poseemos la respuesta que necesitas sin complicarte.
Solución:
Perdón por la respuesta tardía, tomó un poco más de tiempo escribir de lo esperado.
Entonces, en primer lugar, 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í mismas deben ser perezosas, por lo que deben ser válidas las mismas.
Ahora considere el permutation función. Aquí la pereza máxima significa:
- Debemos determinar que hay al menos
n!permutaciones después de inspeccionar solonelementos de entrada - Para cada uno de estos
n!permutaciones, la primeranelementos deben depender solo de la primeranelementos 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. Primero 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 elección sobre el orden de los dos primeros elementos, no podemos poner [2,1,...] primero, dado que ya decidimos que la primera permutación debe comenzar con 1. Debería estar claro a estas alturas que el primer elemento de permutations xs debe ser igual a xs sí mismo.
Ahora pasemos a la implementación.
En primer lugar, hay dos formas diferentes de realizar todas las permutaciones de una lista:
-
Estilo de selección: siga eligiendo elementos de la lista hasta que no quede ninguno
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] -
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 el máximo de vago. En el primer caso, lo primero que hace esta función es elegir el primer elemento de la lista completa, lo que no es nada flojo. En el segundo caso, necesitamos las permutaciones de la cola antes de poder realizar cualquier permutación.
Para empezar, tenga en cuenta que interleave se puede hacer más perezoso. El primer elemento de interleave yss la lista es [x] si yss=[] o (x:y:ys) si yss=y:ys. Pero ambos son iguales a x:yss, para que podamos 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 discusión de la lista de correo. Comenzamos con la versión de David Benbennick, que es la misma que escribí anteriormente (sin el intercalado perezoso). Ya sabemos que el primer elemento de permutations xs debiera ser xs sí mismo. Entonces, pongamos eso en
permutations xxs = xxs : permutations' xxs
permutations' [] = []
permutations' (x:xs) = tail $ concatMap interleave $ permutations xs
where interleave = ..
La llamada a tail Por supuesto, no es muy agradable. Pero si alineamos las definiciones de permutations y 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 intercalación. Esto no es tan fácil, debido a la última línea, map (y:) (interleave ys). No podemos usar inmediatamente el truco de 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 tiene que ser mapeada 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 por 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 comienza a parecerse al de Data.List, pero todavía no es el mismo. En particular, no es tan vago 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
Uh oh, solo el primero n los elementos son correctos, no los primeros 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 generarlos antes, puede hacerlo con zip (inits xs) (tails xs). Ahora las permutaciones de [1..n] estarán
[] ++ 1 : [2..n]alias.[1..n], o2insertado (intercalado) en algún lugar en una permutación de[1], seguido por[3..n]. Pero no2insertado al final de[1], ya que vamos a ese resultado en el punto anterior.3intercalado en una permutación de[1,2](no al final), seguido de[4..n].- etc.
Puede ver que esto es sumamente perezoso, ya que incluso antes de que consideremos hacer algo con 3, hemos dado todas las permutaciones que comienzan con alguna permutación de [1,2]. El código que dio Itzjak 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 [email protected](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 por qué ser muy vaga.
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 que zip (init $ tail $ tails xs) (init $ tail $ inits xs) en 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])]
los init se deshace de la combinación ([],[1..n]), mientras que la tail se deshace de la combinación ([1..n],[]). No queremos lo primero, porque eso haría fallar el patrón de coincidencia en newPerms. Este último fallaría interleave. Ambos son fáciles de arreglar: solo agregue un estuche para 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 [email protected](y:ys') = (t:ys) : map (y:) (interleave t ys')
Ahora podemos intentar alinear tails y inits. Su definicion es
tails xxs = xxs : case xxs of
[] -> []
(_:xs) -> tails xs
inits xxs = [] : case xxs of
[] -> []
(x:xs) -> map (x:) (inits xs)
El problema es ese inits no es la cola recursiva. Pero como 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 acumulativo,
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 acumulativo, en lugar de tails xxs y 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))
alineando newPerms dentro newPerms' luego 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)
alineando y desplegando concat, y moviendo la final map (++ts) dentro 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 foldr truco para deshacerse de la (++):
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 que te deshagas de la (++). Nos deshicimos de uno de ellos, pero no del de interleave. Por eso, podemos ver que siempre estamos concatenando alguna cola de yys para ts. Entonces, podemos desplegar el cálculo (ys++ts) junto con la recursividad de interleavey tener la función interleave' f ys r devolver 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 tienes, Data.List.permutations en todo su esplendor optimizado máximamente perezoso.
¡Gran artículo 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.
-
De Twan
permutations3es esencialmente el mismo que el "Algoritmo P" de Knuth. Por lo que sabe Knuth, ese algoritmo fue publicado por primera vez por los campaneros de iglesias inglesas en el siglo XVII.
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 uno en adelante, donde aún no se han examinado valores (ni siquiera el primero). Es el parámetro de la función. La lista resultante es algo 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 agregado al conjunto de elementos que se están permutando. Además, es recursivo ... en cada nueva fila, toma todas las permutaciones existentes y coloca el elemento en cada lugar en el que aún no ha estado (todos los lugares excepto el último). Entonces, en la tercera fila, tenemos las dos permutaciones [2,1] y [1,2], y luego ocupamos el lugar 3 en ambos espacios disponibles, por lo que [[3,2,1], [2,3,1]]y [[3,1,2], [1,3,2]]respectivamente, y luego agregue la parte no observada.
Con suerte, esto al menos aclara un poco el algoritmo. Sin embargo, hay algunas optimizaciones y detalles de implementación que explicar.
(Nota al margen: hay dos optimizaciones de rendimiento centrales que se utilizan: primero, si desea anteponer repetidamente algunos elementos a varias listas, map (x:y:z:) list es mucho más rápido que coincidir con alguna coincidencia condicional o de patrones, porque no tiene rama, solo un salto calculado. En segundo lugar, y este se usa mucho, es barato (y práctico) crear listas de atrás hacia adelante, añadiendo elementos repetidamente; esto se usa en algunos lugares.
Lo primero que hace la función es establecer dos casos básicos: primero, cada lista tiene al menos una permutación: ella misma. Esto se puede devolver sin evaluación alguna. Esto podría considerarse como el caso de "tomar 0".
El bucle exterior es la parte que se parece a lo siguiente:
perms (t:ts) is = (perms ts (t:is))
ts es la parte "intacta" de la lista, que todavía no estamos permutando y ni siquiera hemos examinado todavía, y es inicialmente la secuencia de entrada completa.
t es el nuevo elemento que colocaremos entre las permutaciones.
is es la lista de elementos que permutaremos y luego colocaremos t en el medio, e inicialmente está vacío.
Cada vez que calculamos una de las filas anteriores, llegamos al final de los elementos que hemos antepuesto al procesador que contiene (perms ts (t: is)) y se repetirá.
El segundo bucle es un pliegue. Es por cada permutación de is (las cosas antes del elemento actual en la lista original), interleaves el elemento en esa lista y lo antepone al procesador.
foldr interleave (permutations is)
El tercer ciclo es uno de los más complejos. Sabemos que antepone cada posible intercalación de nuestro elemento de destino t en una permutación, seguida de la cola no observada en la secuencia de resultados. Hace esto con una llamada recursiva, donde dobla la permutación en una pila de funciones a medida que se repite, y luego, cuando regresa, ejecuta lo que equivale a dos pequeñas máquinas de estado para generar los resultados.
Veamos un ejemplo: interleave [ dónde t = 4 y is = [5..]
Primero, como intercalar 'se llama recursivamente, se acumula yarena fs 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, a medida que regresamos, regresamos 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 obtenemos una nueva permutación, la anteponemos a las listas de resultados.
Así, para terminar el ejemplo, f (t:y:us) se evalúa y 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 en complementa al menos el material vinculado en el comentario del autor anterior.
(Gracias a dfeuer por traer esto a colación en IRC y discutirlo durante unas horas)
Si para ti ha sido de provecho este post, agradeceríamos que lo compartas con otros juniors de esta manera nos ayudas a dar difusión a esta información.