Is there any way to swap two elements in a list if the only thing I know about the elements is the position at which they occur in the list.
To be more specific, I am looking for something like this:
swapElementsAt :: Int -> Int -> [Int] -> [Int]
that would behave like that:
> swapElementsAt 1 3 [5,4,3,2,1] -- swap the first and third elements
[3,4,5,2,1]
I thought that a built-in function for this might exists in Haskell but I wasn't able to find it.
Warning: differential calculus. I don't intend this answer entirely seriously, as it's rather a sledgehammer nutcracking. But it's a sledgehammer I keep handy, so why not have some sport? Apart from the fact that it's probably rather more than the questioner wanted to know, for which I apologize. It's an attempt to dig out the deeper structure behind the sensible answers which have already been suggested.
The class of differentiable functors offers at least the following bits and pieces.
class (Functor f, Functor (D f)) => Diff (f :: * -> *) where
type D f :: * -> *
up :: (I :*: D f) :-> f
down :: f :-> (f :.: (I :*: D f))
I suppose I'd better unpack some of those definitions. They're basic kit for combining functors. This thing
type (f :-> g) = forall a. f a -> g a
abbreviates polymorphic function types for operations on containers.
Here are constant, identity, composition, sum and product for containers.
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 computes the derivative of a functor by the usual rules of calculus. It tells us how to represent a one-hole context for an element. Let's read the types of those operations again.
up :: (I :*: D f) :-> f
says we can make a whole f from the pair of one element and a context for that element in an f. It's "up", because we're navigating upward in a hierarchical structure, focusing on the whole rather than one element.
down :: f :-> (f :.: (I :*: D f))
Meanwhile, we can decorate every element in a differentiable functor structure with its context, computing all the ways to go "down" to one element in particular.
I'll leave the Diff instances for the basic components to the end of this answer. For lists we get
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)))
where
(*:*) :: (f a -> f' a) -> (g a -> g' a) -> (f :*: g) a -> (f' :*: g') a
(ff' *:* gg') (f :*: g) = ff' f :*: gg' g
So, for example,
> unC (down [0,1,2])
[I 0 :*: ([] :*: [1,2]),I 1 :*: ([0] :*: [2]),I 2 :*: ([0,1] :*: [])]
picks out each element-in-context in turn.
If f is also Foldable, we get a generalized !! operator...
getN :: (Diff f, Foldable f) => f x -> Int -> (I :*: D f) x
getN f n = foldMap (: []) (unC (down f)) !! n
...with the added bonus that we get the element's context as well as the element itself.
> 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"))
If we want a functor to offer swapping of two elements, it had better be twice differentiable, and its derivative had better be foldable too. Here goes.
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
It's now easy to grab two elements out and plug them back in the other way around. If we're numbering the positions, we just need to be careful about the way removing elements renumbers the positions.
> swapN 1 3 "abcde"
"adcbe"
> swapN 1 2 ((I "a" :*: I "b") :*: (I "c" :*: I "d"))
(I "a" :*: I "c") :*: (I "b" :*: I "d")
As ever, you don't have do dig down too far below a funny editing operation to find some differential structure at work.
For completeness. Here are the other instances involved in the above.
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')
Haskell doesn't have such a function, mainly because it is a little bit un-functional. What are you actually trying to achieve?
You can implement your own version of it (maybe there is a more idiomatic way to write this). Note that I assume that i < j, but it would be trivial to extend the function to correctly handle the other cases:
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
There are several working answers here, but I thought that a more idiomatic haskell example would be useful.
In essence, we zip an infinite sequence of natural numbers with the original list to include ordering information in the first element of the resulting pairs, and then we use a simple right fold (catamorphism) to consume the list from the right and create a new list, but this time with the correct elements swapped. We finally extract all the second elements, discarding the first element containing the ordering.
The indexing in this case is zero-based (congruent with Haskell's typical indexes) and the pointers must be in range or you'll get an exception (this can be easily prevented if you change the resulting type to 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
And a single liner, doing the swap in just one pass (combining the functionality of the foldr and map into a 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
That's how I solved it:
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
Here I used the convention that position 0 is the first. My function expects a<=b.
What I like most in my program is the line take a list.
Edit: If you want to get more such cool lines, look at this code:
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
first-order one-pass swapping
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
now with precondition in compliance with original question, i.e. relaxed to 1 <= i,j <= length l for swap i j l
draws heavily on an idea by #dfeuer to reduce the problem to swapping the 1st element of a list with another from a given position
This is a strange thing to do, but this should work, aside from the off-by-one errors you'll have to fix since I'm writing this on my phone. This version avoids going over the same segments of the list any more times than necessary.
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)
There is also a recursive solution:
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)
I really like #dfeuer 's solution. However there's still room for optimization by way of deforestation:
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
For positional swapping, using a more complex fold function I have changed the value of the smalest (min) index with the value of the greates (xs!!(y-ii)) and then keep the value for the greatest index in the temp, until find it, the index(max).
I used min and max to make sure I encounter in proper order the indices otherwise I would have to put more checks and conditions in the folds function.
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
Results
> 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]
Efficiency aside, we can do a fully recursive definition with only pattern matching.
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))
I remember in the past writing a Python program that did this same thing. I remember thinking the algorithm as clever, but now trying to implement it from memory in Clojure I'm having some issues.
I'm pretty new to Clojure, so I know that I'm probably not doing this in the best way.
Below I'm using the word 'herps' as a test and it should return a list of all possible combinations of the word. I'm finally getting the combinations right, but they're nested and I'd like a flat list of the words. I think it's because for returns a lazy seq, but I'm not sure how to get around it.
(ns combos.core
(:gen-class))
(use '[clojure.string :only [join]])
(defn rmletter [in letter]
(join (remove #(= letter %) in)))
(defn combo [total in]
(if (= (count in) 1)
(concat total (list in))
(for [item in]
(do
(if (= (count in) 5) (print "top: "))
(combo (concat total (list item)) (rmletter in item)))
)))
(defn -main
"I don't do a whole lot ... yet."
[& args]
;; work around dangerous default behaviour in Clojure
(alter-var-root #'*read-eval* (constantly false))
(doseq [item (combo nil "herps")] (print "item:")(println item))
(println "Hello, World!"))
And here's the output:
top: item:((((h e r p s) (h e r s p)) ((h e p r s) (h e p s r)) ((h e s r p) (h
e s p r))) (((h r e p s) (h r e s p)) ((h r p e s) (h r p s e)) ((h r s e p) (h
r s p e))) (((h p e r s) (h p e s r)) ((h p r e s) (h p r s e)) ((h p s e r) (h
p s r e))) (((h s e r p) (h s e p r)) ((h s r e p) (h s r p e)) ((h s p e r) (h
s p r e))))
top: item:((((e h r p s) (e h r s p)) ((e h p r s) (e h p s r)) ((e h s r p) (e
h s p r))) (((e r h p s) (e r h s p)) ((e r p h s) (e r p s h)) ((e r s h p) (e
r s p h))) (((e p h r s) (e p h s r)) ((e p r h s) (e p r s h)) ((e p s h r) (e
p s r h))) (((e s h r p) (e s h p r)) ((e s r h p) (e s r p h)) ((e s p h r) (e
s p r h))))
top: item:((((r h e p s) (r h e s p)) ((r h p e s) (r h p s e)) ((r h s e p) (r
h s p e))) (((r e h p s) (r e h s p)) ((r e p h s) (r e p s h)) ((r e s h p) (r
e s p h))) (((r p h e s) (r p h s e)) ((r p e h s) (r p e s h)) ((r p s h e) (r
p s e h))) (((r s h e p) (r s h p e)) ((r s e h p) (r s e p h)) ((r s p h e) (r
s p e h))))
top: item:((((p h e r s) (p h e s r)) ((p h r e s) (p h r s e)) ((p h s e r) (p
h s r e))) (((p e h r s) (p e h s r)) ((p e r h s) (p e r s h)) ((p e s h r) (p
e s r h))) (((p r h e s) (p r h s e)) ((p r e h s) (p r e s h)) ((p r s h e) (p
r s e h))) (((p s h e r) (p s h r e)) ((p s e h r) (p s e r h)) ((p s r h e) (p
s r e h))))
top: item:((((s h e r p) (s h e p r)) ((s h r e p) (s h r p e)) ((s h p e r) (s
h p r e))) (((s e h r p) (s e h p r)) ((s e r h p) (s e r p h)) ((s e p h r) (s
e p r h))) (((s r h e p) (s r h p e)) ((s r e h p) (s r e p h)) ((s r p h e) (s
r p e h))) (((s p h e r) (s p h r e)) ((s p e h r) (s p e r h)) ((s p r h e) (s
p r e h))))
Hello, World!
I suspect you need to work an apply concat into your answer somewhere.
A full answer to generating permutations properly is not straitforward, use clojure.math.combinatorics if it meets your needs. It's worth describing a brief algorithm though:
(defn perms [v]
(cond (= 1 (count v)) v ; one permutation is it's self
(= 2 (count v)) [[(second v) (first v)] ; two items is [[ab][b a]]
[(first v) (second v)]]
:default
(apply concat
(for [i (range (count v))] ; take the first item
(->> (assoc v i (v 0)) ; add it in each position
(#(subvec % 1)) ; find the permutations of
perms ; the rest of each of them
(mapv #(conj % (nth v i)))))))) ; then stick the
; one that was assoced back
; onto the start of each of them
There are much better ways to calulate this, this simple recursive method just strikes me as a fairly clojure way of going about the problem. One of the important points is the assoc call with works because it's persistent and does not clobber the version used by each of the other recursive branches.
hello.exp> (pprint (perms (vec "1234")))
([\4 \3 \2 \1]
[\3 \4 \2 \1]
[\4 \2 \3 \1]
[\2 \4 \3 \1]
[\2 \3 \4 \1]
[\3 \2 \4 \1]
[\4 \3 \1 \2]
[\3 \4 \1 \2]
[\4 \1 \3 \2]
[\1 \4 \3 \2]
[\1 \3 \4 \2]
[\3 \1 \4 \2]
[\4 \1 \2 \3]
[\1 \4 \2 \3]
[\4 \2 \1 \3]
[\2 \4 \1 \3]
[\2 \1 \4 \3]
[\1 \2 \4 \3]
[\1 \3 \2 \4]
[\3 \1 \2 \4]
[\1 \2 \3 \4]
[\2 \1 \3 \4]
[\2 \3 \1 \4]
[\3 \2 \1 \4])
nil
hello.exp> (count (perms (vec "hello")))
120
In practice use the lazy perm form the combinatorics library to avoid blowing the stack as this version will do.
I love these little puzzles, and can't help but golf a bit:
(defn perms1 [xs]
(if-not (next xs)
[xs]
(->> [[] xs]
(iterate (fn [[a [x & b]]] ;; seq of all splits of xs
[(conj a x) b]))
(take-while second)
(mapcat (fn [[a [x & b]]]
(map #(cons x %) ;; cons split point onto each comb of the rest
(perms1 (concat a b))))))))
Note perms1 handles duplicate items in the input collection by generating duplicate combinations in the output sequence. If we're sure of no dups in the input, we can tighten up the code a bit by using a set to hold the remaining items in the collection:
(defn perms2 [xs]
(if-not (next xs)
[xs]
(mapcat (fn [x]
(map cons
(repeat x)
(perms2 (disj (set xs) x))))
xs)))
The nested seqs in your original solution are because your combo always returns a seq, and for always returns a seq of what its body returns, so you end up with seqs of seqs, nested to the depth of your recursion. Note how my solutions use mapcat instead of for to avoid this problem. Calling (apply concat ...) on the results of for would be another way to flatten the results.
Here's my solution.
(defn but-nth [s i]
[(get s i) (into [] (concat (take i s) (take-last (dec (- (count s) i)) s)))])
(defn combs [sofar r]
(if (empty? r)
sofar
(for [[c z] (map (partial but-nth r) (range (count r)))]
(combs (conj sofar c) z))))
(defn r-combs [s]
(map (fn [x] (apply str x)) (partition (count s) (flatten (combs [] (vec s))))))
(r-combs "herps")
I have a list of functions, a list of elements, and I'd like to apply all the functions on all the elements then append all the resulting lists together. I did it as follow
(defun apply-functions(funcs elements)
(if (null funcs)
nil
(append (mapcar #'(lambda (x) (funcall (car funcs) x)) elements) (apply-functions (rest funcs) elements))))
It works as intended, but I don't like it. Is there a cleaner, more concise way of doing it?. I am new to lisp, and still getting used to the lispish style of doing things.
I don't know if you like loop macro (and I don't want to spoil anyone), but try this:
(defun apply-functions (fs es)
(loop for f in fs appending (mapcar f es)))
This is the same idea as yours, just shorter:
(defun apply-functions (functions elements)
(mapcan #'(lambda (x) (mapcar x elements)) functions))
I would define a function, call-each that returns a new function,
returning the list of calling each function on it's argument:
(defun call-each (fns)
(lambda (arg)
(mapcar (lambda (fn)
(funcall fn arg))
fns)))
(funcall (call-each (list #'third #'second #'first)) '(a b c))
;=> (C B A)
cl has the function mapcan which is basically nconc + mapcar :
(mapcan #'reverse '((a b c)
(e f g)
(h i j)))
;=> (C B A G F E J I H)
(mapcan (call-each (list #'identity #'1+)) '(1 3 5 7 9))
;=> (1 2 3 4 5 6 7 8 9 10)
unfortunately, nconc, which mapcan uses, is destructive:
(let ((data '((a b c)
(d e f)
(g h i))))
;;here be dragons
(list (mapcan #'identity data)
data))
;=> ((A B C D E F G H I) ((A B C D E F G H I) (D E F G H I) (G H I)))
alexandria to the rescue:
(let ((data '((a b c)
(d e f)
(g h i))))
;;safe version
(list (alexandria:mappend #'identity data)
data))
;=> ((A B C D E F G H I) ((A B C) (D E F) (G H I)))
note that using mapcan is more efficient, but unless you know exactly where
your data is coming from, and who owns it, mappend is the way to go.
so you could write:
(defun apply-functions (fs es)
(when fs
(alexandria:mappend (call-each fs) es))
(apply-functions (list #'identity #'1+) '(1 3 5 7 9))
;=> (1 2 3 4 5 6 7 8 9 10)