Поменять местами два элемента в списке по его индексы
есть ли способ поменять местами два элемента в списке, если единственное, что я знаю об элементах-это положение, при котором они встречаются в списке.
чтобы быть более конкретным, я ищу что-то вроде этого:
swapElementsAt :: Int -> Int -> [Int] -> [Int]
это будет вести себя так:
> swapElementsAt 1 3 [5,4,3,2,1] -- swap the first and third elements
[3,4,5,2,1]
Я думал, что встроенная функция для этого может существовать в Haskell, но я не смог ее найти.
8 ответов
Haskell не имеет такой функции, главным образом потому, что она немного нефункциональна. Что вы на самом деле пытаетесь достичь?
Вы можете реализовать свою собственную версию (возможно, есть более идиоматический способ написать это). Обратите внимание, что я предполагаю, что i < j, но было бы тривиально расширить функцию, чтобы правильно обрабатывать другие случаи:
swapElementsAt :: Int -> Int -> [a] -> [a]
swapElementsAt i j xs = let elemI = xs !! i
elemJ = xs !! j
left = take i xs
middle = take (j - i - 1) (drop (i + 1) xs)
right = drop (j + 1) xs
in left ++ [elemJ] ++ middle ++ [elemI] ++ right
предупреждение: дифференциальное исчисление. я не намерен этот ответ всерьез, так как это скорее щелкание кувалды. Но это кувалда, которую я держу под рукой, так почему бы не заняться спортом? Помимо того, что это, вероятно, гораздо больше, чем спрашивающий хотел знать, за что я извиняюсь. Это попытка выкопать более глубокую структуру за разумными ответами, которые уже были предложены.
класс дифференцируемых функторов предлагает, по крайней мере, следующие фрагменты.
class (Functor f, Functor (D f)) => Diff (f :: * -> *) where
type D f :: * -> *
up :: (I :*: D f) :-> f
down :: f :-> (f :.: (I :*: D f))
полагаю, мне лучше распаковать некоторые из этих определений. Это базовый комплект для объединения функторов. Эта штука!--23-->
type (f :-> g) = forall a. f a -> g a
сокращает типы полиморфных функций для операций с контейнерами.
здесь константа, идентичность, состав, сумма и продукт для контейнеров.
newtype K a x = K a deriving (Functor, Foldable, Traversable, Show)
newtype I x = I x deriving (Functor, Foldable, Traversable, Show)
newtype (f :.: g) x = C {unC :: f (g x)} deriving (Functor, Foldable, Traversable, Show)
data (f :+: g) x = L (f x) | R (g x) deriving (Functor, Foldable, Traversable, Show)
data (f :*: g) x = f x :*: g x deriving (Functor, Foldable, Traversable, Show)
D вычисляет производную функтора по обычным правилам исчисления. Он говорит нам, как представлять a контекст с одним отверстием для элемента. Давайте еще раз перечтем типы этих операций.
up :: (I :*: D f) :-> f
говорит, что мы можем сделать целую f из пары один элемент и контекст для этого элемента в f. Это "вверх", потому что мы движемся вверх по иерархической структуре, фокусируясь на целом, а не на одном элементе.
down :: f :-> (f :.: (I :*: D f))
между тем, мы можем украсить каждый элемент в дифференцируемых функтор структура с его контекст, вычисляя все способы "спуститься" к одному элементу в частности.
я оставлю Diff экземпляры для основных компонентов до конца этого ответа. Для списков, мы получаем
instance Diff [] where
type D [] = [] :*: []
up (I x :*: (xs :*: ys)) = xs ++ x : ys
down [] = C []
down (x : xs) = C ((I x :*: ([] :*: xs)) :
fmap (id *:* ((x :) *:* id)) (unC (down xs)))
здесь
(*:*) :: (f a -> f' a) -> (g a -> g' a) -> (f :*: g) a -> (f' :*: g') a
(ff' *:* gg') (f :*: g) = ff' f :*: gg' g
так, например,
> unC (down [0,1,2])
[I 0 :*: ([] :*: [1,2]),I 1 :*: ([0] :*: [2]),I 2 :*: ([0,1] :*: [])]
выбирает каждый элемент в контексте по очереди.
если f тоже Foldable, получаем обобщенное !! оператор...
getN :: (Diff f, Foldable f) => f x -> Int -> (I :*: D f) x
getN f n = foldMap (: []) (unC (down f)) !! n
...с дополнительным бонусом, который мы получаем контекст элемента, а также сам элемент.
> getN "abcd" 2
I 'c' :*: ("ab" :*: "d")
> getN ((I "a" :*: I "b") :*: (I "c" :*: I "d")) 2
I "c" :*: R ((I "a" :*: I "b") :*: L (K () :*: I "d"))
если мы хотим, чтобы функтор предложить замену два элементы, он должен быть дважды дифференцируемым, и его производная должна быть также складываемой. Здесь идет.
swapN :: (Diff f, Diff (D f), Foldable f, Foldable (D f)) =>
Int -> Int -> f x -> f x
swapN i j f = case compare i j of
{ LT -> go i j ; EQ -> f ; GT -> go j i } where
go i j = up (I y :*: up (I x :*: f'')) where
I x :*: f' = getN f i -- grab the left thing
I y :*: f'' = getN f' (j - 1) -- grab the right thing
теперь легко захватить два элемента и подключить их обратно другим способом. Если мы нумеруем позиции, нам просто нужно быть внимательно следите за тем, как удаление элементов изменяет нумерацию позиций.
> swapN 1 3 "abcde"
"adcbe"
> swapN 1 2 ((I "a" :*: I "b") :*: (I "c" :*: I "d"))
(I "a" :*: I "c") :*: (I "b" :*: I "d")
как всегда, вам не придется копать слишком далеко ниже смешной операции редактирования, чтобы найти какую-то дифференциальную структуру на работе.
для полноты. вот другие примеры, связанные с вышеизложенным.
instance Diff (K a) where -- constants have zero derivative
type D (K a) = K Void
up (_ :*: K z) = absurd z
down (K a) = C (K a)
instance Diff I where -- identity has unit derivative
type D I = K ()
up (I x :*: K ()) = I x
down (I x) = C (I (I x :*: K ()))
instance (Diff f, Diff g) => Diff (f :+: g) where -- commute with +
type D (f :+: g) = D f :+: D g
up (I x :*: L f') = L (up (I x :*: f'))
up (I x :*: R g') = R (up (I x :*: g'))
down (L f) = C (L (fmap (id *:* L) (unC (down f))))
down (R g) = C (R (fmap (id *:* R) (unC (down g))))
instance (Diff f, Diff g) => Diff (f :*: g) where -- product rule
type D (f :*: g) = (D f :*: g) :+: (f :*: D g)
up (I x :*: (L (f' :*: g))) = up (I x :*: f') :*: g
up (I x :*: (R (f :*: g'))) = f :*: up (I x :*: g')
down (f :*: g) = C (fmap (id *:* (L . (:*: g))) (unC (down f))
:*: fmap (id *:* (R . (f :*:))) (unC (down g)))
instance (Diff f, Diff g) => Diff (f :.: g) where -- chain rule
type D (f :.: g) = (D f :.: g) :*: D g
up (I x :*: (C f'g :*: g')) = C (up (I (up (I x :*: g')) :*: f'g))
down (C fg) = C (C (fmap inner (unC (down fg)))) where
inner (I g :*: f'g) = fmap wrap (unC (down g)) where
wrap (I x :*: g') = I x :*: (C f'g :*: g')
вот как я решил это:
swapElementsAt :: Int -> Int -> [a] -> [a]
swapElementsAt a b list = list1 ++ [list !! b] ++ list2 ++ [list !! a] ++ list3
where list1 = take a list;
list2 = drop (succ a) (take b list);
list3 = drop (succ b) list
здесь я использовал соглашение, что позиция 0 является первой. Моя функция ожидает a
что мне нравится в моей программе есть строка take a list.
Edit: если вы хотите получить больше таких классных строк, посмотрите на этот код:
swapElementsAt :: Int -> Int -> [a] -> [a]
swapElementsAt a another list = list1 ++ [list !! another] ++ list2 ++ [list !! a] ++ list3
where list1 = take a list;
list2 = drop (succ a) (take another list);
list3 = drop (succ another) list
по сути, мы zip бесконечную последовательность натуральных чисел с исходным списком, чтобы включить информацию о порядке в первый элемент результирующих пар, а затем мы используем простую правую складку (катаморфизм), чтобы потреблять список справа и создавать новый список, но на этот раз с правильными элементами поменялись местами. Мы, наконец, извлекаем все вторые элементы, отбрасывание первого элемента, содержащего порядок.
индексирование в этом случае основано на нуле (соответствует типичным индексам Haskell), и указатели должны быть в диапазоне, или вы получите исключение (это можно легко предотвратить, если вы измените результирующий тип на Возможно [a]).
swapTwo :: Int -> Int -> [a] -> [a]
swapTwo f s xs = map snd . foldr (\x a ->
if fst x == f then ys !! s : a
else if fst x == s then ys !! f : a
else x : a) [] $ ys
where ys = zip [0..] xs
и один лайнер, делая своп всего за один проход (объединяя функциональность foldr и карты в zipWith):
swapTwo' f s xs = zipWith (\x y ->
if x == f then xs !! s
else if x == s then xs !! f
else y) [0..] xs
первый заказ один проход обмен
swap 1 j l = let (jth,ith:l') = swapHelp j l ith in jth:l'
swap j 1 l = swap 1 j l
swap i j (h:t) = h : swap (i-1) (j-1) t
swapHelp 1 (h:t) x = (h,x:t)
swapHelp n (h:t) x = (y,h:t') where
(y, t') = swapHelp (n-1) t x
- теперь условие в соответствии с оригинальным вопросом, т. е. расслабленным до 1 на обмен i j l
- сильно опирается на идею @dfeuer, чтобы уменьшить проблему до замены 1-го элемента списка другим из заданной позиции
Это странная вещь, но это должно работать, помимо ошибок off-by-one, которые вам придется исправить, так как я пишу это на своем телефоне. Эта версия позволяет избежать повторения одних и тех же сегментов списка больше раз, чем это необходимо.
swap' :: Int -> Int -> [a] -> [a]
swap' first second lst = beginning ++ [y] ++ middle ++ [x] ++ end
where
(beginning, (x : r)) = splitAt first lst
(middle, (y : end)) = splitAt (second - first - 1) r
swap x y | x == y = id
| otherwise = swap' (min x y) (max x y)
существует также рекурсивное решение:
setElementAt :: a -> Int -> [a] -> [a]
setElementAt a 0 (_:tail) = a:tail
setElementAt a pos (b:tail) = b:(setElementAt a (pred pos) tail)
swapElementsAt :: Int -> Int -> [a] -> [a]
swapElementsAt 0 b list@(c:tail) = (list !! b):(setElementAt c (pred b) tail)
swapElementsAt a b (c:tail) = c:(swapElementsAt (pred a) (pred b) tail)
Мне очень нравится решение @dfeuer. Однако есть еще место для оптимизации путем обезлесения:
swap' :: Int -> Int -> [a] -> [a]
swap' first second lst = beginning $ [y] ++ (middle $ [x] ++ end)
where
(beginning, (x : r)) = swapHelp first lst
(middle, (y : end)) = swapHelp (second - first - 1) r
swapHelp :: Int -> [a] -> ([a] -> [a],[a])
swapHelp 0 l = ( id , l)
swapHelp n (h:t) = ((h:).f , r) where
( f , r) = swapHelp (n-1) t