Reverse Interleave

Today's example is a reverse interleave - - that is, instead of taking two or more sequences and blending them together, we take one sequence and split it down into two or more by adding elements from the original sequence to the new sequences in rotation.

For example we want the function f that does this:-

(f '(1 2 3 4 5 6) 2) => ((1 3 5) (2 4 6)) ; split into two
(f '(1 2 3 4 5 6) 3) => ((1 4) (2 5) (3 6)) ; split into three

OK, so I expect I will want code to get every nth element from a sequence - every 2nd, every 3rd one etc. The built-in function partition-all splits a sequence into sequences of a nominated length: so all I want from this is the first element of every sub-sequence.  I map first onto the sequence of sequences returned by partition-all:-

user=> (def t '(1 2 3 4 5 6))
#'user/t
user=> t
(1 2 3 4 5 6)
user=> (partition-all 2 t)
((1 2) (3 4) (5 6))
user=> (partition-all 3 t)
((1 2 3) (4 5 6))
user=> (map first (partition-all 2 t))
(1 3 5)
user=> (map first (partition-all 3 t))
(1 4)

Then moving on I will want to get every nth element but not starting at the beginning, starting at some i-th element in.  So I have to drop some elements before the rest of the function gets it - something like this:-

defn every-nth-from-i
  "return every nth item from sequence s starting from element i (counting from zero)"
  [n s i]
  (map first (partition-all n (drop i s))))

user=> (every-nth-from-i 3 t 0)
(1 4)
user=> (every-nth-from-i 3 t 1)
(2 5)
user=> (every-nth-from-i 3 t 2)
(3 6)

Now the result I want is a sequence of all the sequences generated by this code, for each value of i up to the length of the sub-sequences I want to generate. Well, one less.  That's ok, given n I want to map the numbers in (range n) to the every-nth code.

(def reverse-interleave
  (fn [n s]
    (map
      (fn [i] (map first (partition-all n (drop i s))))
      (range 0 n))))

I don't need to explicitly pass n and s to the internal function because it executes in the environment where they are already available.

Does this work?

user=> (reverse-interleave 2 t)
((1 3 5) (2 4 6))
user=> (reverse-interleave 3 t)
((1 4) (2 5) (3 6))

Actually that turned out simpler than I expected.

Rotate Sequence

Today, for exercise No. 44 Rotate Sequence we write code to rotate a sequence in either direction - determined by the sign of the first parameter.

To rotate the first element of a list to the end we make a list of the first element and concatenate the rest of the list onto it, like this:

#(concat (rest %) (list (first %)))

For example:

user=> (#(concat (rest %) (list (first %))) '(1 2 3 4 5))
(2 3 4 5 1)

To rotate the other way we could use last to get the end element and butlast to get the others and then swap these around in the same way:

user=> (#(concat (list (last %)) (butlast %)) '(1 2 3 4 5))
(5 1 2 3 4)

This just moves one element - to move more I can make the function recursive.  As the function is recursive anyway I can implement the reverse rotation for negative counts by reversing the original list, rotating it forwards, then reversing the result.  The call to the negative version only happens once - the forward rotation call that does the work is still tail recursive.

You can make an anonymous function recursive by adding a label (in this case this) between the keyword fn and the parameter list. The base case is when the number of rotations left to do is zero: then of course we just return the list. On that basis then we get this:-

(def my-rotate
  (fn this [n xs]
    (if (= 0 n)
        xs
        (if (> n 0) ; n is +ve
          (this (dec n) (concat (rest xs) (list (first xs))))
          (reverse (this (- 0 n) (reverse xs)))))))

How does this look?

user=> (my-rotate 2 [1 2 3 4 5])
(3 4 5 1 2)
user=> (my-rotate -2 [1 2 3 4 5])
(4 5 1 2 3)
user=> (my-rotate 6 [1 2 3 4 5])
(2 3 4 5 1)
user=> (my-rotate 1 '(:a :b :c))
(:b :c :a)
user=> (my-rotate -4 '(:a :b :c))
(:c :a :b)

Flipping Out Continued

And to test the flip-out function I needed a function that takes three parameters where the order matters.  So I added this:

(defn drop-take
  "Drop i elements from the sequence s and then take j of what's left"
  [i j s]
  (take j (drop i s)))

Then to test:

user=> (drop-take 10 5 (range))
(10 11 12 13 14)

user=> ((flip-out drop-take) 5 10 (range))
IllegalArgumentException Don't know how to create ISeq from: java.lang.Long  clojure.lang.RT.seqFrom (RT.java:494)

Ha - pay attention - arguments in the reverse order, remember?

user=> ((flip-out drop-take) (range) 5 10)
(10 11 12 13 14)

That's more like it.

I'm puzzled that I had to rebuild the parameter list by writing

([x y & more] (apply f (reverse (cons x (cons y more)))))

I thought this might work:

([x y & more :as s] (apply f (reverse (s)))

But no, more research required...

Flipping Out

The next exercise is No. 46, Flipping Out: to write a higher-order function that flips the order of the arguments of an input function.  the lesson today is how to define a function when you do not know how many arguments it will be passed when it is called.

So I am writing a function flip-out that takes a function f as argument and returns a new function...

(def flip-out
  (fn [f]...
 
What does is new function supposed to do when I call it?  If there are no arguments, it returns whatever the starting function would have returned:

     ([] (f))
    
No, it doesn't return the function we started with , which would be:

    ([] f)
   
...it calls said function and returns the result:

     ([] (f))
    
If the new function is called with one argument x then call the function with that argument:

      ([x] (f x))
     
If it is called with two arguments x and y then call the function with these arguments but in the other order as per the spec:

      ([x y] (f y x))
     
And finally if there are more than two argument our parameter list looks like this: the first argument x, the second argument y, and then a sequence of the remaining arguments conventionally labelled more:

    [x y & more]
   
So we rebuild the argument list and reverse it:

 (reverse (cons x (cons y more)))

...and apply our original function to the result. There is a higher-order function that does this, coincidentally called apply.  For example:

user=> (+ 1 2 3 4)
10
user=> (apply + '(1 2 3 4)) ; same thing
10

So we use apply thus:

    (apply f (reverse (cons x (cons y more))))
   
So the whole function looks like this:

(def flip-out
  (fn [f]
    (fn
        ([] (f))
        ([x] (f x))
        ([x y] (f y x))
        ([x y & more] (apply f (reverse (cons x (cons y more))))))))

This defines the result as a function for testing.  To stick this into the 4Clojure page we need just the bit inside the definition.

Alert

If you unexpectedly find yourself ahead of schedule on a large project, take another good look at the spec.  Maybe you forgot something important early on - -

Drop every nth item - corrected

A keen eyed Clojurian has spotted that my revised function for dropping every nth item from a sequence has a bug.  It was this function:-

(defn drop-nth [n s]
  (flatten (map drop-last (partition-all n s))))

My mistake was that by using partition-all to break up the original sequence I get a final sub-sequence that will generally have less than n elements.  Therefore when I drop-last I lose one element I wanted to keep.  For example all these sequences should include the final element 13:-

user=> (def s [1 2 3 4 5 6 7 8 9 10 11 12 13])
#'user/s
user=> s
[1 2 3 4 5 6 7 8 9 10 11 12 13]
user=> (drop-nth 3 s)
(1 2 4 5 7 8 10 11)
user=> (drop-nth 4 s)
(1 2 3 5 6 7 9 10 11)
user=> (drop-nth 5 s)
(1 2 3 4 6 7 8 9 11 12)

So really instead of dropping the last element on the assumption that there are n altogether I need to take n-1 elements.  So the function now looks like this:-

(defn drop-nth [n s]
  (flatten (map #(take (- n 1) %) (partition-all n s))))

user=> (drop-nth 3 s)
(1 2 4 5 7 8 10 11 13)
user=> (drop-nth 4 s)
(1 2 3 5 6 7 9 10 11 13)
user=> (drop-nth 5 s)
(1 2 3 4 6 7 8 9 11 12 13)

That's more like it.

Anagram Finder

Picking a problem at random today, I find http://www.4clojure.com/problem/77 the objective is to take a list of words and return a set of sets of words where each set of words contains two or more words from the original list that are anagrams of each other.

For example starting from this list

user=> (def s ["meat" "mat" "team" "mate" "eat"])
#'user/s
user=> s
["meat" "mat" "team" "mate" "eat"]

We want to get this:-

#{#{"mate" "meat" "team"}}

Now, strings in Clojure are sequences and therefore they can be sorted.  If two words are anagrams then when you sort them they return the same list of letters.  So the quick test is #(= (sort %1) (sort %2))

user=> (#(= (sort %1) (sort %2)) "meat" "team")
true
user=> (#(= (sort %1) (sort %2)) "meat" "vale")
false

To rearrange our source list we call upon the built-in list function group-by, which gathers together items from a list that return the same value to a given function.  For our purposes this function required is just sort, because we want to group together words with the same letters:-

user=> (group-by sort s)
{(\a \e \m \t) ["meat" "team" "mate"], (\a \m \t) ["mat"], (\a \e \t) ["eat"]}

Well, here we get back a complete map.  We don't need the keys to the map - that is to say the actual list of letters that each word contains - we just want the values, the lists of matching words: the map function vals does this:-

user=> (vals (group-by sort s))
(["meat" "team" "mate"] ["mat"] ["eat"])

But I do not want to see ["mat"] nor ["eat"] in the output because we are asked for sets only where there are two or more anagrams.  So I am going to filter these out, and the required predicate - well, seq will eliminate empty lists, and I can combine this with rest to eliminate lists with only one element - so my predicate is going to be (comp seq rest):-

user=> (filter (comp seq rest) (vals (group-by sort s)))
(["meat" "team" "mate"])

The requirements ask for a set of sets, so I will map the set creator function set into my returned sequence and apply it to the whole list, so:-

user=> (set (map set (filter (comp seq rest) (vals (group-by sort s)))))
#{#{"mate" "meat" "team"}}

So the function than answers the problem is

#(set (map set (filter (comp seq rest) (vals (group-by sort %)))))

Hmm. The disturbing thing about that code is that because it is just a sequence of faceless off-the-shelf built in functions it offers no clue as to what it does. You could be tempted to rewrite to use some local functions with descriptive names - not to change the function but to make the code less Sphinxlike.  Maybe

(defn anagram-set [word-list]
  (let
    [anagram sort,
    two-or-more (comp seq rest)]
    (set (map set (filter two-or-more (vals (group-by anagram word-list)))))))
     
Or something.  I don't know.