Что делает реализация перестановок этого списка в Haskell?

Ответ 1

Извините за поздний ответ, потребовалось немного больше времени, чтобы записать, чем ожидалось.

Итак, прежде всего, чтобы максимизировать ленивость в такой функции списка, есть две цели:

• Произведите как можно больше ответов, прежде чем проверять следующий элемент списка ввода
• Ответы сами должны быть ленивыми, и поэтому там должно быть выполнено.

Теперь рассмотрим функцию permutation. Здесь максимальная ленивость означает:

• Мы должны определить, что есть по крайней мере n! перестановки после проверки только n элементов ввода
• Для каждой из этих перестановок n! первые элементы n должны зависеть только от первых элементов n ввода.

Первое условие может быть формализовано как

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

Дэвид Бенбеник формализовал второе условие как

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

В сочетании, мы имеем

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

Начнем с некоторых простых случаев. Сначала permutation [1..]. Мы должны иметь

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

И с двумя элементами мы должны иметь

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

Обратите внимание, что выбора порядка первых двух элементов нет, мы не можем сначала поставить [2,1,...], так как мы уже решили, что первая перестановка должна начинаться с 1. Теперь должно быть ясно, что первый элемент permutations xs должен быть равен самому xs.

Теперь о реализации.

Прежде всего, есть два разных способа сделать все перестановки списка:

• Стиль выделения: сохраняйте элементы выбора из списка, пока не осталось ни одного

  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]
  

• Стиль вставки: вставлять или перемежать каждый элемент во всех возможных местах

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

Обратите внимание, что ни один из них не является максимально ленивым. Первый случай, первое, что делает эта функция, - это выбрать первый элемент из всего списка, который вообще не ленится. Во втором случае нам нужны перестановки хвоста, прежде чем мы сможем сделать любую перестановку.

Чтобы начать, обратите внимание, что interleave можно сделать более ленивым. Первым элементом списка interleave yss является [x], если yss=[] или (x:y:ys), если yss=y:ys. Но оба они такие же, как x:yss, поэтому мы можем написать

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

Реализация в Data.List продолжается по этой идее, но использует еще несколько трюков.

Возможно, проще всего пройти обсуждение рассылки > . Мы начинаем с версии Дэвида Бенбенника, которая совпадает с той, которую я написал выше (без ленивого чередования). Мы уже знаем, что первый элюмент permutations xs должен быть xs сам. Итак, допустим, что в

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

Вызов tail, конечно, не очень приятный. Но если мы введем определения permutations и interleave, получим

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)

Теперь мы имеем

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)

Следующий шаг - оптимизация. Важной целью было бы устранить (++) вызовы в чередовании. Это не так просто, из-за последней строки, map (y:) (interleave ys). Мы не можем сразу использовать трюк foldr/ShowS для передачи хвоста в качестве параметра. Выход - это избавиться от карты. Если мы передадим параметр f как функцию, которая должна быть отображена по результату в конце, мы получим

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

Теперь мы можем пройти в хвост,

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

Это начинает выглядеть так, как в Data.List, но это еще не одно. В частности, это не так лениво, как могло бы быть. Попробуйте:

*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, только первые n элементы верны, а не первые factorial n. Причина в том, что мы по-прежнему пытаемся разместить первый элемент (1 в приведенном выше примере) во всех возможных местах, прежде чем пытаться что-либо еще.

Ицхак Гейл придумал решение. Рассматриваются все способы разбиения ввода на начальную часть, средний элемент и хвост:

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

Если вы еще не видели трюк для их создания до этого, вы можете сделать это с помощью zip (inits xs) (tails xs). Теперь перестановки [1..n] будут

• [] ++ 1 : [2..n] ака. [1..n] или
• 2 вставлен (перемежается) где-то в перестановку [1], а затем [3..n]. Но не 2 вставлен в конце [1], так как мы уже отправили этот результат в предыдущую маркерную точку.
• 3 чередуется с перестановкой [1,2] (не в конце), а затем [4..n].
• и др.

Вы можете видеть, что это максимально лениво, поскольку, прежде чем мы даже рассмотрим возможность сделать что-то с 3, мы дали все перестановки, которые начинаются с некоторой перестановки [1,2]. Код, который дал Ицхак, был

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') 

Обратите внимание на рекурсивный вызов permutations3, который может быть вариантом, который не должен быть максимально ленивым.

Как вы можете видеть, это немного менее оптимизировано, чем то, что мы имели раньше. Но мы можем применить некоторые из трюков.

Первый шаг - избавиться от init и tail. Посмотрим, что на самом деле zip (init $ tail $ tails xs) (init $ tail $ inits xs)

*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])]

init избавляется от комбинации ([],[1..n]), а tail избавляется от комбинации ([1..n],[]). Мы не хотим первого, потому что это не приведет к совпадению шаблона в newPerms. Последний не смог бы interleave. Оба легко исправить: просто добавьте футляр для newPerms [] и для 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') 

Теперь мы можем попробовать встроить tails и inits. Их определение

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

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

Проблема заключается в том, что inits не является хвостовым рекурсивным. Но так как в любом случае мы собираемся переставить элементы, мы не заботимся о порядке элементов. Таким образом, мы можем использовать накопительный параметр,

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

Теперь мы делаем newPerms функцию xxs и этот скопирующий параметр вместо tails xxs и 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))

вставка newPerms в newPerms', то дает

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

вставка и разворачивание concat и перемещение окончательного map (++ts) в 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) 

Затем, наконец, мы можем повторно применить трюк foldr, чтобы избавиться от (++):

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

Подождите, я сказал, избавиться от (++). Мы избавились от одного из них, но не одного из interleave. Для этого мы видим, что мы всегда конкатенируем некоторый хвост от yys до ts. Итак, мы можем развернуть вычисление (ys++ts) вместе с рекурсией interleave и иметь функцию interleave' f ys r вернуть кортеж (ys++ts, interleave f ys r). Это дает

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)

И у вас это есть, Data.List.permutations во всей своей максимально ленивой оптимизированной славе.

Отличная рецензия от Twan! я (@Yitz) просто добавит несколько ссылок:

• Оригинальная электронная почта, в которой Twan разработал этот алгоритм, связанный выше Twan, - увлекательное чтение.

• Кнут классифицирует все возможные алгоритмы, удовлетворяющие этим критериям в Vol. 4 Fasc. 2 сек. 7.2.1.2.

• Twan permutations3 по существу тот же, что и Knuth "Алгоритм P". Насколько известно Кнуту, этот алгоритм был впервые опубликован английскими церковными звонками в 1600-х годах.

Ответ 2

Основной алгоритм основан на идее одновременного ввода одного элемента из списка, нахождения каждой перестановки элементов, в том числе новой, и повторения.

Чтобы объяснить, как это выглядит, [1..] будет означать список из одного вверх, где еще не были проверены никакие значения (даже не первые). Это параметр функции. В результате список выглядит примерно так:

[[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

Кластеризация выше отражает основную идею алгоритма... каждая строка представляет новый элемент, взятый из входного списка, и добавляется к набору элементов, которые переставляются. Кроме того, он рекурсивный... в каждой новой строке, он принимает все существующие перестановки и помещает элемент в каждое место, где он еще не был (все остальные места, кроме последнего). Итак, в третьей строке мы имеем две перестановки [2,1] и [1,2], а затем мы получаем 3 в обоих доступных слотах, поэтому [[3,2,1], [2,3, 1]] и [[3,1,2], [1,3,2]], а затем добавить любую незаметную часть.

Надеюсь, это, по крайней мере, немного разъяснит алгоритм. Однако для объяснения есть некоторые сведения об оптимизации и реализации.

(Боковое примечание. Используются две центральные оптимизации производительности: во-первых, если вы хотите многократно добавлять некоторые элементы к нескольким спискам, map (x:y:z:) list выполняется намного быстрее, чем соответствие некоторого условного или шаблонного соответствия, поскольку оно не ветвь, только вычисленный прыжок. Во-вторых, и этот используется много, дешево (и удобно) создавать списки со спины к фронту, многократно добавляя элементы, это используется в нескольких местах.

Первое, что делает функция, это установить два базиса: во-первых, каждый список имеет одну перестановку как минимум: сам. Это может быть возвращено без какой-либо оценки. Это можно рассматривать как случай "взять 0".

Внешний цикл - это часть, которая выглядит следующим образом:

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

ts является "нетронутой" частью списка, которую мы еще не переставляем и еще не изучили, и изначально представляет собой всю входную последовательность.

t - это новый элемент, который мы будем придерживаться между перестановками.

is - список элементов, которые мы будем переставлять, а затем поместите t между ними и изначально пуст.

Каждый раз, когда мы вычисляем одну из приведенных выше строк, мы достигаем конца пунктов, которые мы добавили к thunk, содержащему (perms ts (t: is)) и будет рекурсивно.

Второй цикл in - это foldr. Он для каждой перестановки is (материал перед текущим элементом в исходном списке), он interleave элемент в этот список и добавляет его в thunk.

foldr interleave <thunk> (permutations is)

Третий цикл является одним из самых сложных. Мы знаем, что он добавляет к каждому возможному вкраплению нашего целевого элемента t в перестановку, за которым следует ненаблюдаемый хвост в последовательности результатов. Он делает это с помощью рекурсивного вызова, где он сбрасывает перестановку в стек функций, когда он рекурсирует, а затем, когда он возвращается, он выполняет то, что составляет две маленькие государственные машины для построения результатов.

Давайте рассмотрим пример: interleave [<thunk>] [1,2,3] где t = 4 и is = [5..]

Во-первых, поскольку interleave 'вызывается рекурсивно, он создает y и f в стеке, например:

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)

Затем, когда мы возвращаемся назад, мы возвращаем и вычисляем кортеж, содержащий два значения, (us, zs).

us - это список, к которому мы добавляем y после нашей цели t.

zs - это накопитель результата, где каждый раз, когда мы получаем новую перестановку, мы добавляем его в списки результатов.

Таким образом, чтобы закончить пример, f (t:y:us) получает оценку и возвращается как результат для каждого уровня стека выше.

([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..]

Надеюсь, это поможет или, по крайней мере, добавит материал связанный в комментарии автора выше.

(Спасибо dfeuer за то, что он поднял это на IRC и обсудил его в течение нескольких часов)