通过索引交换列表中的两个元素

Question

如果我对元素的唯一了解是它们出现在列表中的 position，那么有什么方法可以交换列表中的两个元素。

更具体地说，我正在寻找这样的东西：

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 中可能存在一个内置的 function ，但我找不到它。

Answer 1

警告：微积分。 我不打算完全认真地回答这个问题，因为它是大锤胡说八道。 但这是我随身携带的大锤，所以为什么不进行一些运动呢？ 除了这可能比提问者想知道的更多，对此我深表歉意。 它试图挖掘已经提出的合理答案背后的更深层次结构。

可微函子类至少提供以下点点滴滴。

class (Functor f, Functor (D f)) => Diff (f :: * -> *) where
  type D f :: * -> *
  up   :: (I :*: D f) :-> f
  down :: f :-> (f :.: (I :*: D f))

我想我最好解开其中的一些定义。 它们是组合函子的基本套件。 这东西

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通过通常的微积分规则计算函子的导数。 它告诉我们如何表示一个元素的单孔上下文。 让我们再次阅读这些操作的类型。

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

Answer 2

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

Answer 3

这里有几个有效的答案，但我认为一个更惯用的 haskell 示例会很有用。

本质上，我们用原始列表压缩一个无限的自然数序列，以在结果对的第一个元素中包含排序信息，然后我们使用简单的右折叠（catamorphism）从右边消耗列表并创建一个新的列表，但这次交换了正确的元素。 我们最终提取所有第二个元素，丢弃包含排序的第一个元素。

在这种情况下，索引是从零开始的（与 Haskell 的典型索引一致），并且指针必须在范围内，否则会出现异常（如果将结果类型更改为 Maybe [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 和 map 的功能组合到一个 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

Answer 4

我就是这样解决的：

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<=b。

在我的程序中我最喜欢的是 line take a list 。

编辑：如果您想获得更多这样的酷行，请查看以下代码：

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

Answer 5

这是一件很奇怪的事情，但这应该可以工作，除了因为我是在手机上写的，所以你必须解决一个个错误。 此版本避免了不必要地多次遍历列表的相同部分。

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)

Answer 6

一阶单程交换

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 <= length l以进行交换 ijl
• 大量借鉴@dfeuer 的想法，将问题减少到将列表的第一个元素与给定位置的另一个元素交换

Answer 7

还有一个递归解决方案：

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)

Answer 8

我真的很喜欢 @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

Answer 9

对于位置交换，使用更复杂的折叠函数，我将最小 ( min ) 索引的值更改为最大值(xs!!(y-ii))的值，然后将最大索引的值保留在 temp ，直到找到它，索引（ max ）。

我使用min和max来确保我以正确的顺序遇到索引，否则我将不得不在folds函数中放置更多的检查和条件。

folds _ _ _ _ [] = []
folds i z y tmp (x:xs)
    | i == z = (xs!!(y-ii)):folds ii z y x xs
    | i == y = tmp:folds ii z y 0 xs
    | otherwise = x:folds ii z y tmp xs
    where 
        ii = i+1

swapElementsAt x y xs = folds 0 a b 0 xs
    where
        a = min x y
        b = max x y

结果

> swapElementsAt 0 1 [1,1,1,3,4,9]
[1,1,1,3,4,9]
> swapElementsAt 0 5 [1,1,1,3,4,9]
[9,1,1,3,4,1]
> swapElementsAt 3 1 [1,1,1,3,4,5]
[1,3,1,1,4,5]
> swapElementsAt 1 3 [1,1,1,3,4,5]
[1,3,1,1,4,5]
> swapElementsAt 5 4 [1,1,1,3,4,5]
[1,1,1,3,5,4]

Answer 10

抛开效率不谈，我们可以只用模式匹配来做一个完全递归的定义。

swapListElem :: [a] -> Int -> Int -> [a]
-- Get nice arguments
swapListElem xs i j
  | (i>= length xs) || (j>=length xs) = error "Index out of range"
  | i==j = xs
  | i>j  = swapListElem xs j i
-- Base case
swapListElem (x:y:xs) 0 1 = (y:x:xs)
-- Base-ish case: If i=0, use i'=1 as a placeholder for j-th element
swapListElem (x:xs) 0 j = swapListElem (swapListElem (x:(swapListElem xs 0 (j-1))) 0 1) 1 j
-- Non-base case: i>0
swapListElem (x:xs) i j = x:(swapListElem xs (i-1) (j-1))