Блог

Я изучаю код в данных.Модуль списка и я не могу точно понять эту реализацию перестановок:

 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)
  

Может кто-нибудь подробно объяснить, как эти вложенные функции соединяются / работают друг с другом?

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

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

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

Теперь рассмотрим 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 себе.

Теперь перейдем к реализации.

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

1. Selection style: keep picking elements from the list until there are none left

    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. Insertion style: insert or interleave each element in all possible places

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

Note that neither of these is maximally lazy. The first case, the first thing this function does is pick the first element from the entire list, which is not lazy at all. In the second case we need the permutations of the tail before we can make any permutation.

To start, note that interleave can be made more lazy. The first element of interleave yss list is [x] if yss=[] or (x:y:ys) if yss=y:ys . But both of these are the same as x:yss , so we can write

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

Реализация в данных.Список продолжает эту идею, но использует еще несколько приемов.

Возможно, проще всего перейти к обсуждению списка рассылки. Мы начнем с версии Дэвида Бенбенника, которая совпадает с той, которую я написал выше (без ленивого чередования). Мы уже знаем, что первым элементом 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 для передачи хвоста в качестве параметра. Выход — избавиться от map. Если мы передадим параметр 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
  

О, только первые 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 ys@(y:ys') = (t:ys) : map (y:) (interleave t ys') 
  

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

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

Первый шаг — избавиться от init and 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 ys@(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
  

Now we make newPerms a function of xxs and this accumulating parameter, instead of tails xxs and 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))
  

inlining newPerms into newPerms' then gives

 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 to 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 по сути такой же, как «Алгоритм P» Кнута. Насколько известно Кнуту, этот алгоритм был впервые опубликован английскими церковными звонарями в 1600-х годах.

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

Чтобы объяснить, как это выглядит, [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 между ними, и изначально он пуст.

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

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

 foldr interleave <thunk> (permutations is)
  

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

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

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

 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 s после нашей цели 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 и обсуждал его в течение нескольких часов)