Генерация всех перестановок списка, включая различные размеры и повторяющиеся элементы

Question

Я хотел создать функцию genAllSize ::[a] -> [[a]], которая получает список l и генерирует все списки, отсортированные по размеру, которые можно построить с элементами списка l; т.е.

> genAllSize [2,4,8] 
[[],[2],[4],[8],[2,2],[4,2],[8,2],[2,4],[4,4],[8,4],[2,8],[4,8],[8,8],[2,2,2],[4,2,2],[8,2,2], ...

Как бы вы это сделали? Я пришел к решению с использованием перестановок из Data.List, но я не хочу его использовать.

Answer 1

Простой и высокоэффективный вариант:

genAllSize [] = [[]]
genAllSize [a] = iterate (a:) []
genAllSize xs =
  [] : [x:q|q<-genAllSize xs,x<-xs]

(Спасибо Уиллу Нессу за небольшое, но очень приятное упрощение.)

Это решение использует тот факт, что действительный список решений либо пуст, либо элемент списка аргументов ограничен более коротким допустимым списком решений. В отличие от решения Даниэля Вагнера, оно не прибегает к счету. Мои тесты показывают, что он работает очень хорошо в типичных условиях.

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

Но что за дело с этим вызовом genAllSizes с тем же аргументом? Не лучше ли сохранить результат для увеличения общего доступа?

genAllSize [] = [[]]
genAllSize xs = p
  where
    p = [] : [x:q|q<-p,x<-xs]

Действительно, на теоретической машине с неограниченной постоянной памятью это оптимально: для обхода списка требуется наихудшее O (1) время для каждого минуса. На практике будет хорошей идеей, если будет реализовано и сохранено очень много записей. В противном случае возникает проблема: большинство записей в списке будут сохраняться бесконечно, что резко увеличивает резидентность памяти и объем работы, которую должен выполнять сборщик мусора. Вышеприведенная версия не выделенного жирным шрифтом по-прежнему предлагает амортизированное O (1) время за минусы, но для этого требуется очень мало памяти (логарифмическая, а не линейная).

Примеры

genAllSize "ab" =
 ["","a","b","aa","ba"
 ,"ab","bb","aaa","baa"
 ,"aba","bba","aab","bab"
 ,"abb","bbb","aaaa",...]

genAllSize "abc" =
  ["","a","b","c","aa","ba"
  ,"ca","ab","bb","cb","ac"
  ,"bc","cc","aaa","baa"
  ,"caa","aba","bba","cba"
  ,"aca",...]

Явная опция

Вы также можете использовать два аккумулятора:

genAllSize [] = [[]]
genAllSize [a] = iterate (a:) []
genAllSize (x:xs) = go ([], []) where
  go (curr, remain) = curr : go (step curr remain)
  step [] [] = ([x], [xs])
  step (_:ls) ((r:rs):rss) =
    (r:ls, rs:rss)
  step (_:ls) ([] : rs) =
    (x : ls', xs : rs')
    where
      !(ls', rs') = step ls rs

Эта версия отслеживает текущее «слово», а также оставшиеся доступные «буквы» в каждой позиции. Производительность кажется сопоставимой в целом, но немного лучше в отношении резидентности памяти. Это также намного сложнее понять!

Answer 2

Другие ответы кажутся довольно сложными. Я бы сделал это так:

> [0..] >>= flip replicateM "abc"
["","a","b","c","aa","ab","ac","ba","bb","bc","ca","cb","cc","aaa","aab",...

Answer 3

Хмм, думаю, тебе нужен ленивый бесконечный список циклических подпоследовательностей. Один наивный способ может быть похож на

Prelude> take 100 $ nub . subsequences . cycle $ [2,4,8]
[[],[2],[4],[2,4],[8],[2,8],[4,8],[2,4,8],[2,2],[4,2],[2,4,2],[8,2],[2,8,2],[4,8,2],[2,4,8,2],[4,4],[2,4,4],[8,4],[2,8,4],[4,8,4],[2,4,8,4],[2,2,4],[4,2,4],[2,4,2,4],[8,2,4],[2,8,2,4],[4,8,2,4],[2,4,8,2,4],[8,8],[2,8,8],[4,8,8],[2,4,8,8],[2,2,8],[4,2,8],[2,4,2,8],[8,2,8],[2,8,2,8],[4,8,2,8],[2,4,8,2,8],[4,4,8],[2,4,4,8],[8,4,8],[2,8,4,8],[4,8,4,8],[2,4,8,4,8],[2,2,4,8],[4,2,4,8],[2,4,2,4,8],[8,2,4,8],[2,8,2,4,8],[4,8,2,4,8],[2,4,8,2,4,8],[2,2,2],[4,2,2],[2,4,2,2],[8,2,2],[2,8,2,2],[4,8,2,2],[2,4,8,2,2],[4,4,2],[2,4,4,2],[8,4,2],[2,8,4,2],[4,8,4,2],[2,4,8,4,2],[2,2,4,2],[4,2,4,2],[2,4,2,4,2],[8,2,4,2],[2,8,2,4,2],[4,8,2,4,2],[2,4,8,2,4,2]]

Answer 4

Это создает элементы в другом порядке в пределах каждой длины, чем ваш пример, но это соответствует определению текста вашего вопроса. Изменить заказ очень просто - вы должны заменить <*> немного другим оператором вашего собственного производства.

import Control.Applicative
import Control.Monad

rinvjoin :: Applicative both => both a -> both (both a)
rinvjoin = fmap pure

extendBranches options branches = (<|>) <$> options <*> branches
singletonBranchExtensions = rinvjoin

genAllSize [] = []
genAllSize xs = join <$> iterate (extendBranches extensions) $ initialBranches
  where extensions = singletonBranchExtensions xs
        initialBranches = pure empty

Answer 5

• Учитывая список ввода xs, выберите префикс этого недетерминированным способом
• Для каждого элемента префикса замените его на любой элемент xs недетерминированным способом

Результат:

> xs = [2,4,8]
> inits xs >>= mapM (const xs)
[[],[2],[4],[8],[2,2],[2,4],[2,8],[4,2],[4,4],[4,8],[8,2],[8,4],
[8,8],[2,2,2],[2,2,4],[2,2,8],[2,4,2],[2,4,4],[2,4,8],[2,8,2],
[2,8,4],[2,8,8],[4,2,2],[4,2,4],[4,2,8],[4,4,2],[4,4,4],[4,4,8],
[4,8,2],[4,8,4],[4,8,8],[8,2,2],[8,2,4],[8,2,8],[8,4,2],[8,4,4],
[8,4,8],[8,8,2],[8,8,4],[8,8,8]]