I want to generate in Lisp the list of all permutations of a set. This is what I tried:
(defun ins(e n l)
(cond
((equal n 1) (cons e l))
(T (cons (car l) (ins e (1- n) (cdr l))))
)
)
;; (print (ins '1 1 '(2 3)))
;; (print (ins '1 2 '(2 3)))
;; (print (ins '1 3 '(2 3)))
(defun insert(e n l)
(cond
((equal n 0) nil)
(T (cons (ins e n l) (insert e (1- n) l) ))
)
)
;; (print (insert '1 3 '(2 3)))
(defun inserare(e l)
(insert e (1+ (length l)) l)
)
;(print (inserare '1 '(2 3))) -> ((2 3 1) (2 1 3) (1 2 3))
And from here I just can't make the final permutations function. I tried something like this:
(defun perm(L)
(cond
((null L) nil)
(T (append (perm (cdr L)) (inserare (car L) L)))
)
)
But this is not the good approach
Here is one way.
First of all, if you have a list like (x . y) and you have the permutations of y you will need to create from them the permutations of (x . y). Well consider one of these permutations p, and let this be (p1 p2 ...). From this you will need to make a bunch of permutations including x: (x p1 p2 ...), (p1 x p2 ...), (p1 p2 x ...) ... (p1 p2 ... x).
So let's write a function to do this: a function which given some object and a list will 'thread' the object through the list creating a bunch of new lists with the object inserted at every point. For reasons that will become clear this function is going to take an extra argument which is the list of things to attach the new permutations to the front of. It's also going to use a little local function to do the real work.
Here it is:
(defun thread-element-through-list (e l onto)
(labels ((tetl-loop (erofeb after into)
(if (null after)
(cons (nreverse (cons e erofeb)) into)
(tetl-loop (cons (first after) erofeb)
(rest after)
(cons (revappend (cons e erofeb) after) into)))))
(tetl-loop '() l onto)))
I'm not going to explain the details of this function, but there are a couple of things worth knowing:
tetl-loop is thread-element-through-list-loop;
erofeb is before backwards, because the elements are in reverse order on it;
the nreverse is just a gratuitous hack because at that point erofeb is otherwise dead – there is effectively no mutation in this function.
And we can test it:
> (thread-element-through-list 1 '(2 3) '())
((2 3 1) (2 1 3) (1 2 3))
Now, OK, what we actually have is not just one permutation of y, we have a list of them. And we need to thread x through each of them, using `thread-element-through-list. So we need a function to do that.
(defun thread-element-through-lists (e ls onto)
(if (null ls)
onto
(thread-element-through-lists
e (rest ls)
(thread-element-through-list e (first ls) onto))))
This also has an argument which defines what it's adding its results to, and you can see how this onto list now gets passed around to build the list.
And we can test this
> (thread-element-through-lists '1 '((2 3) (3 2)) '())
((3 2 1) (3 1 2) (1 3 2) (2 3 1) (2 1 3) (1 2 3))
Look at that carefully. I gave thread-element-through-lists, 1, and a list which was the permutations of (2 3), and it has turned out for me the permutations of (1 2 3). So what you now need to do (which I am not going to do for you) is to write a function which:
knows the permutations of () (which is () and of a single-element list (which is a list containing that list)`;
uses thread-elements-through-lists together with a recursive call to itself to compute the permutations of any longer list.
Related
I am trying to combine a list of pairs in scheme to get all possible combinations. For example:
((1 2) (3 4) (5 6)) --> ((1 3 5) (1 3 6) (1 4 5) (1 4 6) (2 3 5) (2 3 6) (2 4 5) (2 4 6))
I've been able to solve it (I think) using a "take the first and prepend it to the cdr of the procedure" with the following:
(define (combine-pair-with-list-of-pairs P Lp)
(apply append
(map (lambda (num)
(map (lambda (pair)
(cons num pair)) Lp)) P)))
(define (comb-N Lp)
(if (null? Lp)
'(())
(combine-pair-with-list-of-pairs (car Lp) (comb-N (cdr Lp)))))
(comb-N '((1 2)(3 4)(5 6)))
; ((1 3 5) (1 3 6) (1 4 5) (1 4 6) (2 3 5) (2 3 6) (2 4 5) (2 4 6))
However, I've been having trouble figuring out how I can use a procedure that only takes two and having a wrapper around it to be able to define comb-N by calling that function. Here it is:
(define (combinations L1 L2)
(apply append
(map (lambda (L1_item)
(map (lambda (L2_item)
(list L1_item L2_item))
L2))
L1)))
(combinations '(1) '(1 2 3))
; ((1 1) (1 2) (1 3))
I suppose the difficulty with calling this function is it expects two lists, and the recursive call is expecting a list of lists as the second argument. How could I call this combinations function to define comb-N?
difficulty? recursion? where?
You can write combinations using delimited continuations. Here we represent an ambiguous computation by writing amb. The expression bounded by reset will run once for each argument supplied to amb -
(define (amb . lst)
(shift k (append-map k lst)))
(reset
(list (list (amb 'a 'b) (amb 1 2 3))))
((a 1) (a 2) (a 3) (b 1) (b 2) (b 3))
how it works
The expression is evaluated through the first amb where the continuation is captured to k -
k := (list (list ... (amb 1 2 3)))
Where applying k will supply its argument to the "hole" left by amb's call to shift, represented by ... above. We can effectively think of k in terms of a lambda -
k := (lambda (x) (list (list x (amb 1 2 3)))
amb returns an append-map expression -
(append-map k '(a b))
Where append-map will apply k to each element of the input list, '(a b), and append the results. This effectively translates to -
(append
(k 'a)
(k 'b))
Next expand the continuation, k, in place -
(append
(list (list 'a (amb 1 2 3))) ; <-
(list (list 'b (amb 1 2 3)))) ; <-
Continuing with the evaluation, we evaluate the next amb. The pattern is continued. amb's call to shift captures the current continuation to k, but this time the continuation has evolved a bit -
k := (list (list 'a ...))
Again, we can think of k in terms of lambda -
k := (lambda (x) (list (list 'a x)))
And amb returns an append-map expression -
(append
(append-map k '(1 2 3)) ; <-
(list (list 'b ...)))
We can continue working like this to resolve the entire computation. append-map applies k to each element of the input and appends the results, effectively translating to -
(append
(append (k 1) (k 2) (k 3)) ; <-
(list (list 'b ...)))
Expand the k in place -
(append
(append
(list (list 'a 1)) ; <-
(list (list 'a 2)) ; <-
(list (list 'a 3))) ; <-
(list (list 'b (amb 1 2 3))))
We can really start to see where this is going now. We can simplify the above expression to -
(append
'((a 1) (a 2) (a 3)) ; <-
(list (list 'b (amb 1 2 3))))
Evaluation now continues to the final amb expression. We will follow the pattern one more time. Here amb's call to shift captures the current continuation as k -
k := (list (list 'b ...))
In lambda terms, we think of k as -
k := (lambda (x) (list (list 'b x)))
amb returns an append-map expression -
(append
'((a 1) (a 2) (a 3))
(append-map k '(1 2 3))) ; <-
append-map applies k to each element and appends the results. This translates to -
(append
'((a 1) (a 2) (a 3))
(append (k 1) (k 2) (k 3))) ; <-
Expand k in place -
(append
'((a 1) (a 2) (a 3))
(append
(list (list 'b 1)) ; <-
(list (list 'b 2)) ; <-
(list (list 'b 3)))) ; <-
This simplifies to -
(append
'((a 1) (a 2) (a 3))
'((b 1) (b 2) (b 3))) ; <-
And finally we can compute the outermost append, producing the output -
((a 1) (a 2) (a 3) (b 1) (b 2) (b 3))
generalizing a procedure
Above we used fixed inputs, '(a b) and '(1 2 3). We could make a generic combinations procedure which applies amb to its input arguments -
(define (combinations a b)
(reset
(list (list (apply amb a) (apply amb b)))))
(combinations '(a b) '(1 2 3))
((a 1) (a 2) (a 3) (b 1) (b 2) (b 3))
Now we can easily expand this idea to accept any number of input lists. We write a variadic combinations procedure by taking a list of lists and map over it, applying amb to each -
(define (combinations . lsts)
(reset
(list (map (lambda (each) (apply amb each)) lsts))))
(combinations '(1 2) '(3 4) '(5 6))
((1 3 5) (1 3 6) (1 4 5) (1 4 6) (2 3 5) (2 3 6) (2 4 5) (2 4 6))
Any number of lists of any length can be used -
(combinations
'(common rare)
'(air ground)
'(electric ice bug)
'(monster))
((common air electric monster)
(common air ice monster)
(common air bug monster)
(common ground electric monster)
(common ground ice monster)
(common ground bug monster)
(rare air electric monster)
(rare air ice monster)
(rare air bug monster)
(rare ground electric monster)
(rare ground ice monster)
(rare ground bug monster))
related reading
In Scheme, we can use Olivier Danvy's original implementation of shift/reset. In Racket, they are supplied via racket/control
(define-syntax reset
(syntax-rules ()
((_ ?e) (reset-thunk (lambda () ?e)))))
(define-syntax shift
(syntax-rules ()
((_ ?k ?e) (call/ct (lambda (?k) ?e)))))
(define *meta-continuation*
(lambda (v)
(error "You forgot the top-level reset...")))
(define abort
(lambda (v)
(*meta-continuation* v)))
(define reset-thunk
(lambda (t)
(let ((mc *meta-continuation*))
(call-with-current-continuation
(lambda (k)
(begin
(set! *meta-continuation* (lambda (v)
(begin
(set! *meta-continuation* mc)
(k v))))
(abort (t))))))))
(define call/ct
(lambda (f)
(call-with-current-continuation
(lambda (k)
(abort (f (lambda (v)
(reset (k v)))))))))
For more insight on the use of append-map and amb, see this answer to your another one of your questions.
See also the Compoasable Continuations Tutorial on the Scheme Wiki.
remarks
I really struggled with functional style at first. I cut my teeth on imperative style and it took me some time to see recursion as the "natural" way of thinking to solve problems in a functional way. However I offer this post in hopes to provoke you to reach for even higher orders of thinking and reasoning. Recursion is the topic I write about most on this site but I'm here saying that sometimes even more creative, imaginative, declarative ways exist to express your programs.
First-class continuations can turn your program inside-out, allowing you to write a program which manipulates, consumes, and multiplies itself. It's a sophisticated level of control that's part of the Scheme spec but only fully supported in a few other languages. Like recursion, continuations are a tough nut to crack, but once you "see", you wish you would've learned them earlier.
As suggested in the comments you can use recursion, specifically, right fold:
(define (flatmap foo xs)
(apply append
(map foo xs)))
(define (flatmapOn xs foo)
(flatmap foo xs))
(define (mapOn xs foo)
(map foo xs))
(define (combs L1 L2) ; your "combinations", shorter name
(flatmapOn L1 (lambda (L1_item)
(mapOn L2 (lambda (L2_item) ; changed this:
(cons L1_item L2_item)))))) ; cons NB!
(display
(combs '(1 2)
(combs '(3 4)
(combs '(5 6) '( () )))))
; returns:
; ((1 3 5) (1 3 6) (1 4 5) (1 4 6) (2 3 5) (2 3 6) (2 4 5) (2 4 6))
So you see, the list that you used there wasn't quite right, I changed it back to cons (and thus it becomes fully the same as combine-pair-with-list-of-pairs). That way it becomes extensible: (list 3 (list 2 1)) isn't nice but (cons 3 (cons 2 (cons 1 '()))) is nicer.
With list it can't be used as you wished: such function receives lists of elements, and produces lists of lists of elements. This kind of output can't be used as the expected kind of input in another invocation of that function -- it would produce different kind of results. To build many by combining only two each time, that combination must produce the same kind of output as the two inputs. It's like +, with numbers. So either stay with the cons, or change the combination function completely.
As to my remark about right fold: that's the structure of the nested calls to combs in my example above. It can be used to define this function as
(define (sequence lists)
(foldr
(lambda (list r) ; r is the recursive result
(combs list r))
'(()) ; using `()` as the base
lists))
Yes, the proper name of this function is sequence (well, it's the one used in Haskell).
Say there is any given list in Scheme. This list is ‘(2 3 4)
I want to find all possible partitions of this list. This means a partition where a list is separated into two subsets such that every element of the list must be in one or the other subsets but not both, and no element can be left out of a split.
So, given the list ‘(2 3 4), I want to find all such possible partitions. These partitions would be the following: {2, 3} and {4}, {2, 4} and {3}, and the final possible partition being {3, 4} and {2}.
I want to be able to recursively find all partitions given a list in Scheme, but I have no ideas on how to do so. Code or psuedocode will help me if anyone can provide it for me!
I do believe I will have to use lambda for my recursive function.
I discuss several different types of partitions at my blog, though not this specific one. As an example, consider that an integer partition is the set of all sets of positive integers that sum to the given integer. For instance, the partitions of 4 is the set of sets ((1 1 1 1) (1 1 2) (1 3) (2 2) (4)).
The process is building the partitions is recursive. There is a single partition of 0, the empty set (). There is a single partition of 1, the set (1). There are two partitions of 2, the sets (1 1) and (2). There are three partitions of 3, the sets (1 1 1), (1 2) and (3). There are five partitions of 4, the sets (1 1 1 1), (1 1 2), (1 3), (2 2), and (4). There are seven partitions of 5, the sets (1 1 1 1 1), (1 1 1 2), (1 2 2), (1 1 3), (1 4), (2 3) and (5). And so on. In each case, the next-larger set of partitions is determined by adding each integer x less than or equal to the desired integer n to all the sets formed by the partition of n − x, eliminating any duplicates. Here's how I implement that:
Petite Chez Scheme Version 8.4
Copyright (c) 1985-2011 Cadence Research Systems
> (define (set-cons x xs)
(if (member x xs) xs
(cons x xs)))
> (define (parts n)
(if (zero? n) (list (list))
(let x-loop ((x 1) (xs (list)))
(if (= x n) (cons (list n) xs)
(let y-loop ((yss (parts (- n x))) (xs xs))
(if (null? yss) (x-loop (+ x 1) xs)
(y-loop (cdr yss)
(set-cons (sort < (cons x (car yss)))
xs))))))))
> (parts 6)
((6) (3 3) (2 2 2) (2 4) (1 1 4) (1 1 2 2) (1 1 1 1 2)
(1 1 1 1 1 1) (1 1 1 3) (1 2 3) (1 5))
I'm not going to solve your homework for you, but your solution will be similar to the one given above. You need to state your algorithm in recursive fashion, then write code to implement that algorithm. Your recursion is going to be something like this: For each item in the set, add the item to each partition of the remaining items of the set, eliminating duplicates.
That will get you started. If you have specific questions, come back here for additional help.
EDIT: Here is my solution. I'll let you figure out how it works.
(define range (case-lambda ; start, start+step, ..., start+step<stop
((stop) (range 0 stop (if (negative? stop) -1 1)))
((start stop) (range start stop (if (< start stop) 1 -1)))
((start stop step) (let ((le? (if (negative? step) >= <=)))
(let loop ((x start) (xs (list)))
(if (le? stop x) (reverse xs) (loop (+ x step) (cons x xs))))))
(else (error 'range "unrecognized arguments"))))
(define (sum xs) (apply + xs)) ; sum of elements of xs
(define digits (case-lambda ; list of base-b digits of n
((n) (digits n 10))
((n b) (do ((n n (quotient n b))
(ds (list) (cons (modulo n b) ds)))
((zero? n) ds)))))
(define (part k xs) ; k'th lexicographical left-partition of xs
(let loop ((ds (reverse (digits k 2))) (xs xs) (ys (list)))
(if (null? ds) (reverse ys)
(if (zero? (car ds))
(loop (cdr ds) (cdr xs) ys)
(loop (cdr ds) (cdr xs) (cons (car xs) ys))))))
(define (max-lcm xs) ; max lcm of part-sums of 2-partitions of xs
(let ((len (length xs)) (tot (sum xs)))
(apply max (map (lambda (s) (lcm s (- tot s)))
(map sum (map (lambda (k) (part k xs))
(range (expt 2 (- len 1)))))))))
(display (max-lcm '(2 3 4))) (newline) ; 20
(display (max-lcm '(2 3 4 6))) (newline) ; 56
You can find all 2-partitions of a list using the built-in combinations procedure. The idea is, for every element of a (len-k)-combination, there will be an element in the k-combination that complements it, producing a pair of lists whose union is the original list and intersection is the empty list.
For example:
(define (2-partitions lst)
(define (combine left right)
(map (lambda (x y) (list x y)) left right))
(let loop ((m (sub1 (length lst)))
(n 1))
(cond
((< m n) '())
((= m n)
(let* ((l (combinations lst m))
(half (/ (length l) 2)))
(combine (take l half)
(reverse (drop l half)))))
(else
(append
(combine (combinations lst m)
(reverse (combinations lst n)))
(loop (sub1 m) (add1 n)))))))
then you can build the partitions as:
(2-partitions '(2 3 4))
=> '(((2 3) (4))
((2 4) (3))
((3 4) (2)))
(2-partitions '(4 6 7 9))
=> '(((4 6 7) (9))
((4 6 9) (7))
((4 7 9) (6))
((6 7 9) (4))
((4 6) (7 9))
((4 7) (6 9))
((6 7) (4 9)))
Furthermore, you can find the max lcm of the partitions:
(define (max-lcm lst)
(define (local-lcm arg)
(lcm (apply + (car arg))
(apply + (cadr arg))))
(apply max (map local-lcm (2-partitions lst))))
For example:
(max-lcm '(2 3 4))
=> 20
(max-lcm '(4 6 7 9))
=> 165
To partition a list is straightforward recursive non-deterministic programming.
Given an element, we put it either into one bag, or the other.
The very first element will go into the first bag, without loss of generality.
The very last element must go into an empty bag only, if such is present at that time. Since we start by putting the first element into the first bag, it can only be the second:
(define (two-parts xs)
(if (or (null? xs) (null? (cdr xs)))
(list xs '())
(let go ((acc (list (list (car xs)) '())) ; the two bags
(xs (cdr xs)) ; the rest of list
(i (- (length xs) 1)) ; and its length
(z '()))
(if (= i 1) ; the last element in the list is reached:
(if (null? (cadr acc)) ; the 2nd bag is empty:
(cons (list (car acc) (list (car xs))) ; add only to the empty 2nd
z) ; otherwise,
(cons (list (cons (car xs) (car acc)) (cadr acc)) ; two solutions,
(cons (list (car acc) (cons (car xs) (cadr acc))) ; adding to
z))) ; either of the two bags;
(go (list (cons (car xs) (car acc)) (cadr acc)) ; all solutions after
(cdr xs) ; adding to the 1st bag
(- i 1) ; and then,
(go (list (car acc) (cons (car xs) (cadr acc))) ; all solutions
(cdr xs) ; after adding
(- i 1) ; to the 2nd instead
z))))))
And that's that!
In writing this I was helped by following this earlier related answer of mine.
Testing:
(two-parts (list 1 2 3))
; => '(((2 1) (3)) ((3 1) (2)) ((1) (3 2)))
(two-parts (list 1 2 3 4))
; => '(((3 2 1) (4))
; ((4 2 1) (3))
; ((2 1) (4 3))
; ((4 3 1) (2))
; ((3 1) (4 2))
; ((4 1) (3 2))
; ((1) (4 3 2)))
It is possible to reverse the parts before returning, or course; I wanted to keep the code short and clean, without the extraneous details.
edit: The code makes use of a technique by Richard Bird, of replacing (append (g A) (g B)) with (g' A (g' B z)) where (append (g A) y) = (g' A y) and the initial value for z is an empty list.
Another possibility is for the nested call to go to be put behind lambda (as the OP indeed suspected) and activated when the outer call to go finishes its job, making the whole function tail recursive, essentially in CPS style.
I wrote a function which finds all the subsets of a list already and it works. I'm trying to write a second function where I get all the subsets of N length, but it's not working very well.
This is my code:
(define (subset_length_n n lst)
(cond
[(empty? lst) empty]
[else (foldr (lambda (x y) (if (equal? (length y) n) (cons y x) x)) empty (powerset lst))]
))
where (powerset lst) gives a list of all the subsets.
Am I misunderstanding the purpose of foldr?
I was thinking that the program would go through each element of the list of subsets, compare the length to n, cons it onto the empty list if there the same, ignore it if it's not.
But (subset_length_n 2 (list 1 2 3)) gives me (list (list 1 2) 1 2 3) when I want (list (list 1 2) (list 1 3) (list 2 3))
Thanks in advance
When using foldr you don't have to test if the input list is empty, foldr takes care of that for you. And this seems like a job better suited for filter:
(define (subset_length_n n lst)
(filter (lambda (e) (= (length e) n))
(powerset lst)))
If you must, you can use foldr for this, but it's a rather contrived solution. You were very close to getting it right! in your code, just change the lambda's parameters, instead of (x y) write (y x). See how a nice indentation and appropriate parameter names go a long way toward writing correct solutions:
(define (subset_length_n n lst)
(foldr (lambda (e acc)
(if (= (length e) n)
(cons e acc)
acc))
empty
(powerset lst)))
Anyway, it works as expected:
(subset_length_n 4 '(1 2 3 4 5))
=> '((1 2 3 4) (1 2 3 5) (1 2 4 5) (1 3 4 5) (2 3 4 5))
I want to do
(filter-list-into-two-parts #'evenp '(1 2 3 4 5))
; => ((2 4) (1 3 5))
where a list is split into two sub-lists depending on whether a predicate evaluates to true. It is easy to define such a function:
(defun filter-list-into-two-parts (predicate list)
(list (remove-if-not predicate list) (remove-if predicate list)))
but I would like to know if there is a built-in function in Lisp that can do this, or perhaps a better way of writing this function?
I don't think there is a built-in and your version is sub-optimal because it traverses the list twice and calls the predicate on each list element twice.
(defun filter-list-into-two-parts (predicate list)
(loop for x in list
if (funcall predicate x) collect x into yes
else collect x into no
finally (return (values yes no))))
I return two values instead of the list thereof; this is more idiomatic (you will be using multiple-value-bind to extract yes and no from the multiple values returned, instead of using destructuring-bind to parse the list, it conses less and is faster, see also values function in Common Lisp).
A more general version would be
(defun split-list (key list &key (test 'eql))
(let ((ht (make-hash-table :test test)))
(dolist (x list ht)
(push x (gethash (funcall key x) ht '())))))
(split-list (lambda (x) (mod x 3)) (loop for i from 0 to 9 collect i))
==> #S(HASH-TABLE :TEST FASTHASH-EQL (2 . (8 5 2)) (1 . (7 4 1)) (0 . (9 6 3 0)))
Using REDUCE:
(reduce (lambda (a b)
(if (evenp a)
(push a (first b))
(push a (second b)))
b)
'(1 2 3 4 5)
:initial-value (list nil nil)
:from-end t)
In dash.el there is a function -separate that does exactly what you ask:
(-separate 'evenp '(1 2 3 4)) ; => '((2 4) (1 3))
You can ignore the rest of the post if you use -separate. I had to implement Haskell's partition function in Elisp. Elisp is similar1 in many respects to Common Lisp, so this answer will be useful for coders of both languages. My code was inspired by similar implementations for Python
(defun partition-push (p xs)
(let (trues falses) ; initialized to nil, nil = '()
(mapc (lambda (x) ; like mapcar but for side-effects only
(if (funcall p x)
(push x trues)
(push x falses)))
xs)
(list (reverse trues) (reverse falses))))
(defun partition-append (p xs)
(reduce (lambda (r x)
(if (funcall p x)
(list (append (car r) (list x))
(cadr r))
(list (car r)
(append (cadr r) (list x)))))
xs
:initial-value '(() ()) ; (list nil nil)
))
(defun partition-reduce-reverse (p xs)
(mapcar #'reverse ; reverse both lists
(reduce (lambda (r x)
(if (funcall p x)
(list (cons x (car r))
(cadr r))
(list (car r)
(cons x (cadr r)))))
xs
:initial-value '(() ())
)))
push is a destructive function that prepends an element to list. I didn't use Elisp's add-to-list, because it only adds the same element once. mapc is a map function2 that doesn't accumulate results. As Elisp, like Common Lisp, has separate namespaces for functions and variables3, you have to use funcall to call a function received as a parameter. reduce is a higher-order function4 that accepts :initial-value keyword, which allows for versatile usage. append concatenates variable amount of lists.
In the code partition-push is imperative Common Lisp that uses a widespread "push and reverse" idiom, you first generate lists by prepending to the list in O(1) and reversing in O(n). Appending once to a list would be O(n) due to lists implemented as cons cells, so appending n items would be O(n²). partition-append illustrates adding to the end. As I'm a functional programming fan, I wrote the no side-effects version with reduce in partition-reduce-reverse.
Emacs has a profiling tool. I run it against these 3 functions. The first element in a list returned is the total amount of seconds. As you can see, appending to list works extremely slow, while the functional variant is the quickest.
ELISP> (benchmark-run 100 (-separate #'evenp (number-sequence 0 1000)))
(0.043594004 0 0.0)
ELISP> (benchmark-run 100 (partition-push #'evenp (number-sequence 0 1000)))
(0.468053176 7 0.2956386049999793)
ELISP> (benchmark-run 100 (partition-append #'evenp (number-sequence 0 1000)))
(7.412973128 162 6.853687342999947)
ELISP> (benchmark-run 100 (partition-reduce-reverse #'evenp (number-sequence 0 1000)))
(0.217411618 3 0.12750035599998455)
References
Differences between Common Lisp and Emacs Lisp
Map higher-order function
Technical Issues of Separation in Function Cells and Value Cells
Fold higher-order function
I don't think that there is a partition function in the common lisp standard, but there are libraries that provide such an utility (with documentation and source).
CL-USER> (ql:quickload :arnesi)
CL-USER> (arnesi:partition '(1 2 3 4 5) 'evenp 'oddp)
((2 4) (1 3 5))
CL-USER> (arnesi:partition '(1 2 b "c") 'numberp 'symbolp 'stringp)
((1 2) (B) ("c"))
A k-ary necklace of length n is an ordered list of length n whose items are drawn from an alphabet of length k, which is the lexicographically first list in a sort of all lists sharing an ordering under rotation.
Example:
(1 2 3) and (1 3 2) are the necklaces of length 3 from the alphabet {1 2 3}.
More info:
http://en.wikipedia.org/wiki/Necklace_(combinatorics)
I'd like to generate these in Scheme (or a Lisp of your choice). I've found some papers...
Savage - A New Algorithm for Generating Necklaces
Sawada - Generating Bracelets in Constant Amortized Time
Sawada - Generating Necklaces with Forbidden Substrings
...but the code presented in them is opaque to me. Mainly because they don't seem to be passing in either the alphabet or the length (n) desired. The scheme procedure I'm looking for is of the form (necklaces n '(a b c...)).
I can generate these easy enough by first generating k^n lists and then filtering out the rotations. But it's terribly memory-inefficient...
Thanks!
The FKM algorithm for generating necklaces. PLT Scheme. Not so hot on the performance. It'll take anything as an alphabet and maps the internal numbers onto whatever you provided. Seems to be correct; no guarantees. I was lazy when translating the loops, so you get this weird mix of for loops and escape continuations.
(require srfi/43)
(define (gennecklaces n alphabet)
(let* ([necklaces '()]
[alphavec (list->vector alphabet)]
[convert-necklace
(lambda (vec)
(map (lambda (x) (vector-ref alphavec x)) (cdr (vector->list vec))))]
[helper
(lambda (n k)
(let ([a (make-vector (+ n 1) 0)]
[i n])
(set! necklaces (cons (convert-necklace a) necklaces))
(let/ec done
(for ([X (in-naturals)])
(vector-set! a i (add1 (vector-ref a i)))
(for ([j (in-range 1 (add1 (- n i)))])
(vector-set! a (+ j i)
(vector-ref a j)))
(when (= 0 (modulo n i))
(set! necklaces (cons (convert-necklace a) necklaces)))
(set! i n)
(let/ec done
(for ([X (in-naturals)])
(unless (= (vector-ref a i)
(- k 1))
(done))
(set! i (- i 1))))
(when (= i 0)
(done))))))])
(helper n (length alphabet))
necklaces))
I would do a two step process. First, find each combination of n elements from the alphabet. Then, for each combination, pick the lowest value, and generate all permutations of the remaining items.
Edit: Here is some code. It assumes that the input list is already sorted and that it contains no duplicates.
(define (choose n l)
(let ((len (length l)))
(cond ((= n 0) '(()))
((> n len) '())
((= n len) (list l))
(else (append (map (lambda (x) (cons (car l) x))
(choose (- n 1) (cdr l)))
(choose n (cdr l)))))))
(define (filter pred l)
(cond ((null? l) '())
((pred (car l)) (cons (car l) (filter pred (cdr l))))
(else (filter pred (cdr l)))))
(define (permute l)
(cond ((null? l) '(()))
(else (apply append
(map (lambda (x)
(let ((rest (filter (lambda (y) (not (= x y))) l)))
(map (lambda (subperm) (cons x subperm))
(permute rest))))
l)))))
(define (necklaces n l)
(apply
append
(map
(lambda (combination)
(map (lambda (permutation)
(cons (car combination) permutation))
(permute (cdr combination))))
(choose n l))))
(display (choose 1 '(1 2 3 4 5))) (newline)
(display (choose 2 '(1 2 3 4 5))) (newline)
(display (permute '(1 2))) (newline)
(display (permute '(1 2 3))) (newline)
(display (necklaces 3 '(1 2 3 4))) (newline)
(display (necklaces 2 '(1 2 3 4))) (newline)
Example: (1 2 3) and (1 3 2) are the necklaces of length 3 from the alphabet {1 2 3}.
You forgot (1 1 1) (1 1 2) (1 1 3) (1 2 2) (1 3 3) (2 2 2) (2 2 3) (2 3 3) (3 3 3). Necklaces can contain duplicates.
If you were only looking for necklaces of length N, drawn from an alphabet of size N, that contain no duplicates, then it's pretty easy: there will be (N-1)! necklaces, and each necklace will be of the form (1 :: perm) where perm is any permutation of {2 .. N}. For example, the necklaces of {1 .. 4} would be (1 2 3 4) (1 2 4 3) (1 3 2 4) (1 3 4 2) (1 4 2 3) (1 4 3 2). Extending this method to deal with no-duplicates necklaces of length K < N is left as an exercise for the reader.
But if you want to find real necklaces, which may contain duplicate elements, then it's not so simple.
As a first idea, you can do the obvious, but inefficient: step through all combinations and check if they are a necklace, i.e. if they are the lexically smallest rotation of the elements (formal definition on p 5 in above paper). This would be like the way you proposed, but you would throw away all non-necklaces as soon as they are generated.
Other than that, I think that you will have to understand this article (http://citeseer.ist.psu.edu/old/wang90new.html):
T. Wang and C. Savage, "A new algorithm for generating necklaces," Report
TR-90-20, Department of Computer Science, North Carolina State University
(1990).
It is not too hard, you can break it down by implementing the tau and sigma functions as described and then applying them in the order outlined in the article.