Все вращения списка в Haskell [дубликат]

этот вопрос уже есть ответ здесь:

у меня есть функция для поворота списка:

rotate :: [a] -> [a]
rotate [] = []
rotate (x:xs) = xs ++ [x]

теперь я хочу функцию, которая дает список со всеми возможными вращениями конечного списка:

rotateAll :: [a] -> [[a]]

на императивном языке я бы сделал что-то вроде (в псевдокоде)

for i = 1 to length of list
  append list to rotateList
  list = rotate(list)

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

дополнительные мысли:

чтобы решить эту проблему, мне нужно решить две проблемы. Сначала мне нужно несколько раз повернуть список и собрать каждый результат в список. Поэтому первое решение должно сделать что-то вроде

rotateAll xs = [xs (rotate xs) (rotate (rotate xs)) (rotate (rotate (rotate xs))) ...]

конечно, я не знаю, сколько раз это делать. Я был бы доволен сделать это бесконечно, а затем использовать take (length xs) чтобы получить конечное количество списков, которые я желаю. Это фактически демонстрирует вторую проблему: определение того, когда остановиться. Я не знаю, использует ли take Это самый эффективный или элегантный способ решить проблему, но это пришло на ум, когда я печатал это и должен работать.

дополнение: Теперь, когда я нашел два решения самостоятельно или с подсказками. Я с радостью приветствую любого другие решения, которые быстрее или используют разные подходы. Спасибо!

11 ответов


помимо итерации, вы можете написать функцию, которая генерирует список из n вращений. Случай n=0 просто обернет входные данные в список, а случай n=m+1 добавит входные данные к результату случая m. Хотя использование стандартных функций обычно предпочтительнее, иногда написание собственных решений полезно.


используйте предопределенные функции в Data.List! Вы можете получить список всех вращений, используя четыре вызова функций, без рекурсии и без


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

rotations xs = map (takeSame xs) $ takeSame xs (tails (xs ++ xs)) where
    takeSame [] _ = [] 
    takeSame (_:xs) (y:ys) = y:takeSame xs ys

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


вы также можете рассмотреть этот сайт как определить функцию вращения это ответ на тот же вопрос.

редактировать из-за комментария: реализации, основанные на rotate а также на основе inits и tails должно быть квадратичным по длине списка. Однако, исходя из inits и tails должно быть менее эффективным, потому что он выполняет несколько квадратичных обходов. Хотя отметим, что эти заявления только если вы полностью оценить результат. Кроме того, компилятор может улучшить код, поэтому вы должны относиться к этим операторам с осторожностью.


rotations (x:xs) = (xs++[x]):(rotations (xs++[x]) ) 

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

take (length xs) (rotations xs)

Я придумал два решения. Сначала это ручной работы, который пришел ко мне после того, как я разместил свой вопрос:

rotateAll :: [a] -> [[a]]
rotateAll xs = rotateAll' xs (length xs)
    where rotateAll' xs 1 = [xs]
          rotateAll' xs n = xs : rotateAll' (rotate xs) (n - 1)

другой использует предложение @Tilo:

rotateAll :: [a] -> [[a]]
rotateAll xs = take (length xs) (iterate rotate xs)

вы также можете генерировать их рекурсивно. Генерация всех вращений пустого или одиночного списка элементов тривиальна, а генерация вращений x:xs Это вопрос вставке x в правильное положение всех поворотов xs.

вы можете сделать это, создав индексы для вставки в (просто список [1, 2,...] предполагая, что предыдущие вращения находятся в этом порядке) и использовать zipWith вставить x в правильной должностное положение.

вы можете split вращения вокруг позиции с использованием комбинации inits и tails и использовать zipWith чтобы склеить их обратно.


добавление: теперь, когда я нашел два решения самостоятельно или с подсказками. Я с радостью приветствую любые другие решения, которые быстрее или использовать различных методов. Спасибо!

так как никто другой не указал на использование cycle Я думал, что добавлю это решение для конечных списков:

rotations x = let n = length x in map (take n) $ take n (tails (cycle x))

для бесконечного списка x повороты просто tails x.

оценка cycle x O (n) время и пространство, каждый элемент tails is O (1), and take n есть O (n) время и пространство, но два take n вложены, поэтому оценка всего результата-O (n^2) Время и пространство.

если он собирает каждый оборот, прежде чем лениво генерировать следующий, то пространство теоретически O (n).

если вы умны о том, сколько вы потребляете, то вы не нужны map (take n) и может просто ходить cycle x или take n (tails (cycle x)) и сохранить пробел O (n).


возможно, вы можете использовать Data.List

import Data.List
rotate x=[take (length x) $ drop i $ cycle x | i<-[0..length x-1]]

С нуля:

data [] a = [] | a : [a]

end :: a -> [a] -> [a]
end y []       = y : []
end y (x : xs) = x : y `end` xs

-- such that `end x xs  =  xs ++ [x]`

rotating :: [a] -> [[a]]
rotating [] = []
rotating xs = rots xs
   where
      rots xs@(x : xs') = xs : rots (x `end` xs')

-- An infinite list of rotations

rotations :: [a] -> [[a]]
rotations xs = rots xs (rotating xs)
   where
      rots []       _        = []
      rots (_ : xs) (r : rs) = r : rots xs rs

-- All unique rotations, `forall xs.` equivalent to `take
-- (length xs) (rotating xs)`

или:

{-# LANGUAGE BangPatters #-}

rotate :: [a] -> [a]
rotate []       = []
rotate (x : xs) = x `end` xs
   where
      end y []       = y : []
      end y (x : xs) = x : end y xs

iterate :: Int -> (a -> a) -> a -> [a]
iterate 0 _ _ = []
iterate n f x = case f x of
                   x' -> x' : iterate (n - 1) f x'

length :: [a] -> Int
length xs = len 0 xs
   where
      len !n []       = n
      len !n (_ : xs) = len (n + 1) xs

rotations :: [a] -> [[a]]
rotations xs = iterate (length xs) rotate xs

-- Starting with single rotation

или, интегрированы:

rotations :: [a] -> [[a]]
rotations [] = [[]]
rotations xs = rots xs xs
   where
      rots []       _            = []
      rots (_ : xc) xs@(x : xs') = xs : rots xc (x `end` xs')

      end y []       = y : []
      end y (x : xs) = x : end y xs

я использовал следующие rotations функция в качестве помощника для my алгоритм перестановок. Кажется, он самый быстрый среди всех здесь.

rotations :: [a] -> [[a]]
rotations xs = take (length xs) (iterate (\(y:ys) -> ys ++ [y]) xs)