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).
Related
Does using nested maps automatically create another level of nesting? Here is a basic example that I used:
; One level
(map (lambda (x1)
"Hi")
'(1))
; Two levels
(map (lambda (x1)
(map (lambda (x2)
"Hi")
'(1)))
'(1))
; Three levels
(map (lambda (x1)
(map (lambda (x2)
(map (lambda (x3)
"Hi")
'(1)))
'(1)))
'(1))
; Four levels
(map (lambda (x1)
(map (lambda (x2)
(map (lambda (x3)
(map (lambda (x4)
"Hi")
'(1)))
'(1)))
'(1)))
'(1))
("Hi")
(("Hi"))
((("Hi")))
(((("Hi"))))
Or, are there any counterexamples where adding another map will not produce additional nesting? I'm having trouble 'getting' how map adds another level. For example, for the first level:
(map (lambda (x1)
"Hi")
'(1))
I understand that there is one element in the list, and 'for each element' in the list -- we will return the element "Hi"at that position in the list, so for the first level we get ("Hi").
But then how, for example, from the list ("Hi") do we get a nested list at the second level? I know I've asked a lot of questions related to map and nesting, but hopefully if I can just understand the going from 1 level to 2 I can figure out the rest...
map collects the return values of all the function calls, and wraps them in another list.
If the function returns a list, you'll get a list of lists.
So if you have nested maps, you always get nested lists as the final result. And each level of mapping adds another level of nesting.
Note that this is only true if you're actually returning the value of map at each level. You could do other things with it, e.g.
;; Two levels
(map (lambda (x1)
(length (map (lambda (x2)
"Hi")
'(1))))
'(1))
This will return (1)
one-to-one
Your examples include (map (lambda (x) x) ...)
(map (lambda (ignore-me)
(map (lambda (x) x) ; <- no-op
'(1 2 3)))
'(1))
((1 2 3))
It's "hard to see" because the inner map is essentially a no-op. map creates a 1:1 relationship between the input and the output, with no opinions about what the mapping procedure does. If the mapping procedure returns a single element, a list, or a very nested list, it doesn't matter -
(map (lambda (ignore-me)
'(1 2 3))
'(foo))
((1 2 3))
(map (lambda (_)
'(((((really nested))))))
'(1 2 3))
((((((really nested)))))
(((((really nested)))))
(((((really nested))))))
Or with some ascii visualization -
(define (fn x) (+ x x))
(map fn '(1 2 3))
; \ \ \
; \ \ (fn 3)
; \ \ \
; \ (fn 2) \
; \ \ \
; (fn 1) \ \
; \ \ \
; output: '(2 4 6)
Should you choose to map inside of the mapping procedure to another map call -
(map (lambda (...)
(map ...)) ; <- nested map
...)
The same rules apply. Each map output has a 1:1 relationship with its input list. We can imagine map's type for more insight -
map : ('a -> 'b, 'a list) -> 'b list
-------- ------- -------
\ \ \_ returns a list of type 'b
\ \
\ \__ input list of type 'a
\
\__ mapping procedure, maps
one element of type 'a
to one element of type 'b
implementing map
As a learning exercise, it's useful to implement map to gain an intimate understanding of how it works -
(define (map fn lst)
(if (null? lst)
'()
(cons (fn (car lst))
(map fn (cdr lst)))))
(map (lambda (x)
(list x x x x x))
'(1 2 3))
((1 1 1 1 1)
(2 2 2 2 2)
(3 3 3 3 3))
As you can see, map does not have an opinion on the type of elements in lst or what the return value of fn is. map plainly passes the car of the list to fn and cons'es it onto the recursive result of the cdr of the list.
append-map
Another relevant procedure we should look at is append-map -
append-map : ('a -> 'b list, 'a list) -> 'b list
------------- ------- -------
\ \ \_ returns a list of type 'b
\ \_ input list of type 'a
\
\_ mapping function, maps
one element of type 'a
to a LIST of elements of type 'b
The only difference here is the mapping procedure is expected to return a list of elements, not just a single element. In this way, append-map creates a 1:many relationship between in the input list and the output list.
(append-map (lambda (x)
(list x x x x x))
'(1 2 3))
(1 1 1 1 1 2 2 2 2 2 3 3 3 3 3)
This characteristic of append-map is why it is sometimes called flatmap, as it "flattens" a level of nesting -
(append-map (lambda (x)
(map (lambda (y)
(list x y))
'(spade heart club diamond)))
'(J Q K A))
((J spade)
(J heart)
(J club)
(J diamond)
(Q spade)
(Q heart)
(Q club)
(Q diamond)
(K spade)
(K heart)
(K club)
(K diamond)
(A spade)
(A heart)
(A club)
(A diamond))
Follow-up exercises for the reader:
What would the output be if we traded append-map for map in the example above?
Define map in another way or two. Verify the correct behaviour
Define append-map in terms of map. Define it again without using map.
loose typing
Scheme is an untyped language and thus a list's contents are not required to be homogenous. Still, it's useful to think about map and append-map in this way as the type helps communicate how the function will behave. Here are more accurate type definitions provided by Racket -
(map proc lst ...+) → list?
proc : procedure?
lst : list?
(append-map proc lst ...+) → list?
proc : procedure?
lst : list?
These are much looser and do reflect the loose programs you can actually write. For example -
(append-map (lambda (x)
(list 'a-symbol "hello" 'float (* x 1.5) 'bool (> x 1)))
'(1 2 3))
(a-symbol "hello" float 1.5 bool #f a-symbol "hello" float 3.0 bool #t a-symbol "hello" float 4.5 bool #t)
variadic map and append-map
Do you see those ...+ in the types above? For the sake of simplicity, I've been hiding an important detail up until this point. The variadic interface of map means that it can accept 1 or more input lists -
(map (lambda (x y z)
(list x y z))
'(1 2 3)
'(4 5 6)
'(7 8 9))
((1 4 7) (2 5 8) (3 6 9))
(append-map (lambda (x y z)
(list x y z))
'(1 2 3)
'(4 5 6)
'(7 8 9))
(1 4 7 2 5 8 3 6 9)
Follow-up exercises for the reader:
Define variadic map
Define variadic append-map
a touch of lambda calculus
You are aware of lambda calculus. Did you know (lambda (x y z) (list x y z) is the same as list? This is known as Eta reduction -
(map list '(1 2 3) '(4 5 6) '(7 8 9))
((1 4 7) (2 5 8) (3 6 9))
(append-map list '(1 2 3) '(4 5 6) '(7 8 9))
(1 4 7 2 5 8 3 6 9)
delimited continuations
Remember when we talked about delimited continuations and operators shift and reset? After learning about append-map, let's see amb, the ambiguous choice operator -
(define (amb . lst)
(shift k (append-map k lst)))
We can use amb like this -
(reset (list (amb 'J 'Q 'K 'A) (amb '♡ '♢ '♤ '♧)))
(J ♡ J ♢ J ♤ J ♧ Q ♡ Q ♢ Q ♤ Q ♧ K ♡ K ♢ K ♤ K ♧ A ♡ A ♢ A ♤ A ♧)
(reset (list (list (amb 'J 'Q 'K 'A) (amb '♡ '♢ '♤ '♧))))
((J ♡) (J ♢) (J ♤) (J ♧) (Q ♡) (Q ♢) (Q ♤) (Q ♧) (K ♡) (K ♢) (K ♤) (K ♧) (A ♡) (A ♢) (A ♤) (A ♧))
In a more useful example, we use the pythagorean theorem to find-right-triangles -
(define (pythag a b c)
(= (+ (* a a) (* b b)) (* c c))) ; a² + b² = c²
(define (find-right-triangles . side-lengths)
(filter ((curry apply) pythag)
(reset (list
(list (apply amb side-lengths)
(apply amb side-lengths)
(apply amb side-lengths))))))
(find-right-triangles 1 2 3 4 5 6 7 8 9 10 11 12)
((3 4 5) (4 3 5) (6 8 10) (8 6 10))
Delimited continuations effectively turn your program inside-out, allowing you to focus on declarative structure -
(define (bit)
(amb #\0 #\1))
(define (4-bit)
(reset (list (string (bit) (bit) (bit) (bit)))))
(4-bit)
("0000" "0001" "0010" "0011" "0100" "0101" "0110" "0111" "1000" "1001" "1010" "1011" "1100" "1101" "1110" "1111")
amb can be used anywhere in any expression to evaluate the expression once per supplied value. This limitless use can yield extraordinary results -
(reset
(list
(if (> 5 (amb 6 3))
(string-append "you have "
(amb "dark" "long" "flowing")
" "
(amb "hair" "sentences"))
(string-append "please do not "
(amb "steal" "hurt")
" "
(amb "any" "other")
" "
(amb "people" "animals")))))
("please do not steal any people"
"please do not steal any animals"
"please do not steal other people"
"please do not steal other animals"
"please do not hurt any people"
"please do not hurt any animals"
"please do not hurt other people"
"please do not hurt other animals"
"you have dark hair"
"you have dark sentences"
"you have long hair"
"you have long sentences"
"you have flowing hair"
"you have flowing sentences")
The map will return a list for each element in that list. Let us go through a multi-map example where we can show how nesting comes into play.
First, let's do a single map on a sequence of numbers and "do nothing" to them. That is, just return the element from the input:
(map (lambda (x) x)
'(1 2 3))
; (1 2 3)
At this point, it may be easy to think that another level of nesting should not occur if we add on another map since here we have not 'nested' the input list. It has simply 'stayed' at (1 2 3).
But if we add an outer level, we can see how this may occur:
(map (lambda (ignore-me)
(map (lambda (x) x)
'(1 2 3)))
'(1))
; (( 1 2 3 ))
With just one 'outer-element' it's hard to see this, but instead, let's add 5 outer elements and make it much easier to spot:
(map (lambda (ignore-me)
(map (lambda (x) x)
'(1 2 3)))
'(5 5 5 5 5))
;(
; (1 2 3)
; (1 2 3)
; (1 2 3)
; (1 2 3)
; (1 2 3)
;)
Here we can see for each outer element -- and there are five of them -- we are returning the "inner-result" -- which is (1 2 3) in the above case. If we did the same thing again, this time producing two additional outer loops, we can see a similar result occurring:
(map (lambda (ignore-me1)
(map (lambda (ignore-me2)
(map (lambda (x) x)
'(1 2 3)))
'(5 5 5 5 5)))
'(2 2))
; (
; ((1 2 3) (1 2 3) (1 2 3) (1 2 3) (1 2 3))
; ((1 2 3) (1 2 3) (1 2 3) (1 2 3) (1 2 3))
; )
I've asked a few questions here about Scheme/SICP, and quite frequently the answers involve using the apply procedure, which I haven't seen in SICP, and in the book's Index, it only lists it one time, and it turns out to be a footnote.
Some examples of usage are basically every answer to this question: Going from Curry-0, 1, 2, to ...n.
I am interested in how apply works, and I wonder if some examples are available. How could the apply procedure be re-written into another function, such as rewriting map like this?
#lang sicp
(define (map func sequence)
(if (null? sequence) nil
(cons (func (car sequence)) (map func (cdr sequence)))))
It seems maybe it just does a function call with the first argument? Something like:
(apply list '(1 2 3 4 5)) ; --> (list 1 2 3 4 5)
(apply + '(1 2 3)) ; --> (+ 1 2 3)
So maybe something similar to this in Python?
>>> args=[1,2,3]
>>> func='max'
>>> getattr(__builtins__, func)(*args)
3
apply is used when you want to call a function with a dynamic number of arguments.
Your map function only allows you to call functions that take exactly one argument. You can use apply to map functions with different numbers of arguments, using a variable number of lists.
(define (map func . sequences)
(if (null? (car sequences))
'()
(cons (apply func (map car sequences))
(apply map func (map cdr sequences)))))
(map + '(1 2 3) '(4 5 6))
;; Output: (5 7 9)
You asked to see how apply could be coded, not how it can be used.
It can be coded as
#lang sicp
; (define (appl f xs) ; #lang racket
; (eval
; (cons f (map (lambda (x) (list 'quote x)) xs))))
(define (appl f xs) ; #lang r5rs, sicp
(eval
(cons f (map (lambda (x) (list 'quote x))
xs))
(null-environment 5)))
Trying it out in Racket under #lang sicp:
> (display (appl list '(1 2 3 4 5)))
(1 2 3 4 5)
> (display ( list 1 2 3 4 5 ))
(1 2 3 4 5)
> (appl + (list (+ 1 2) 3))
6
> ( + (+ 1 2) 3 )
6
> (display (appl map (cons list '((1 2 3) (10 20 30)))))
((1 10) (2 20) (3 30))
> (display ( map list '(1 2 3) '(10 20 30) ))
((1 10) (2 20) (3 30))
Here's the link to the docs about eval.
It requires an environment as the second argument, so we supply it with (null-environment 5) which just returns an empty environment, it looks like it. We don't actually need any environment here, as the evaluation of the arguments has already been done at that point.
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.
Deos anyone know, how I can make this funktion recursive by inserting the function somewhere? I am not allowed to use implemented functions for lists except append, make-pair(list) and reverse.
(: split-list ((list-of %a) -> (tuple-of (list-of %a) (list-of %a))))
(check-expect (split-list (list 1 2)) (make-tuple (list 1) (list 2)))
(check-expect (split-list (list 1 2 3 4)) (make-tuple (list 1 3) (list 2 4)))
(check-expect (split-list (list 1 2 3)) (make-tuple (list 1 3) (list 2)))
(check-expect (split-list (list 1 2 3 4 5)) (make-tuple (list 1 3 5) (list 2 4)))
(check-expect (split-list (list 1 2 3 4 5 6)) (make-tuple (list 1 3 5) (list 2 4 6)))
(define split-list
(lambda (x)
(match x
(empty empty)
((make-pair a empty) (make-tuple a empty))
((make-pair a (make-pair b empty)) (make-tuple (list a) (list b)))
((make-pair a (make-pair b c)) (make-tuple (list a (first c)) (list b (first(rest c))))))))
Code for make-tuple:
(define-record-procedures-parametric tuple tuple-of
make-tuple
tuple?
(first-tuple
rest-tuple))
Here's a way you can fix it using match and a named let, seen below as loop.
(define (split xs)
(let loop ((xs xs) ;; the list, initialized with our input
(l empty) ;; "left" accumulator, initialized with an empty list
(r empty)) ;; "right" accumulator, initialized with an empty list
(match xs
((list a b rest ...) ;; at least two elements
(loop rest
(cons a l)
(cons b r)))
((cons a empty) ;; one element
(loop empty
(cons a l)
r))
(else ;; zero elements
(list (reverse l)
(reverse r))))))
Above we use a loop to build up left and right lists then we use reverse to return the final answer. We can avoid having to reverse the answer if we build the answer in reverse order! The technique used here is called continuation passing style.
(define (split xs (then list))
(match xs
((list a b rest ...) ;; at least two elements
(split rest
(λ (l r)
(then (cons a l)
(cons b r)))))
((cons a empty) ;; only one element
(then (list a) empty))
(else ;; zero elements
(then empty empty))))
Both implementations perform to specification.
(split '())
;; => '(() ())
(split '(1))
;; => '((1) ())
(split '(1 2 3 4 5 6 7))
;; => '((1 3 5 7) (2 4 6))
Grouping the result in a list is an intuitive default, but it's probable that you plan to do something with the separate parts anyway
(define my-list '(1 2 3 4 5 6 7))
(let* ((result (split my-list)) ;; split the list into parts
(l (car result)) ;; get the "left" part
(r (cadr result))) ;; get the "right" part
(printf "odds: ~a, evens: ~a~n" l r))
;; odds: (1 3 5 7), evens: (2 4 6)
Above, continuation passing style gives us unique control over the returned result. The continuation is configurable at the call site, using a second parameter.
(split '(1 2 3 4 5 6 7) list) ;; same as default
;; '((1 3 5 7) (2 4 6))
(split '(1 2 3 4 5 6 7) cons)
;; '((1 3 5 7) 2 4 6)
(split '(1 2 3 4 5 6 7)
(λ (l r)
(printf "odds: ~a, evens: ~a~n" l r)))
;; odds: (1 3 5 7), evens: (2 4 6)
(split '(1 2 3 4 5 6 7)
(curry printf "odds: ~a, evens: ~a~n"))
;; odds: (1 3 5 7), evens: (2 4 6)
Oscar's answer using an auxiliary helper function or the first implementation in this post using loop are practical and idiomatic programs. Continuation passing style is a nice academic exercise, but I only demonstrated it here because it shows how to step around two complex tasks:
building up an output list without having to reverse it
returning multiple values
I don't have access to the definitions of make-pair and make-tuple that you're using. I can think of a recursive algorithm in terms of Scheme lists, it should be easy to adapt this to your requirements, just use make-tuple in place of list, make-pair in place of cons and make the necessary adjustments:
(define (split lst l1 l2)
(cond ((empty? lst) ; end of list with even number of elements
(list (reverse l1) (reverse l2))) ; return solution
((empty? (rest lst)) ; end of list with odd number of elements
(list (reverse (cons (first lst) l1)) (reverse l2))) ; return solution
(else ; advance two elements at a time, build two separate lists
(split (rest (rest lst)) (cons (first lst) l1) (cons (second lst) l2)))))
(define (split-list lst)
; call helper procedure with initial values
(split lst '() '()))
For example:
(split-list '(1 2))
=> '((1) (2))
(split-list '(1 2 3 4))
=> '((1 3) (2 4))
(split-list '(1 2 3))
=> '((1 3) (2))
(split-list '(1 2 3 4 5))
=> '((1 3 5) (2 4))
(split-list '(1 2 3 4 5 6))
=> '((1 3 5) (2 4 6))
split is kind of a de-interleave function. In many other languages, split names functions which create sublists/subsequences of a list/sequence which preserve the actual order. That is why I don't like to name this function split, because it changes the order of elements in some way.
Tail-call-rescursive solution
(define de-interleave (l (acc '(() ())))
(cond ((null? l) (map reverse acc)) ; reverse each inner list
((= (length l) 1)
(de-interleave '() (list (cons (first l) (first acc))
(second acc))))
(else
(de-interleave (cddr l) (list (cons (first l) (first acc))
(cons (second l) (second acc)))))))
You seem to be using the module deinprogramm/DMdA-vanilla.
The simplest way is to match the current state of the list and call it again with the rest:
(define split-list
(lambda (x)
(match x
;the result should always be a tuple
(empty (make-tuple empty empty))
((list a) (make-tuple (list a) empty))
((list a b) (make-tuple (list a) (list b)))
;call split-list with the remaining elements, then insert the first two elements to each list in the tuple
((make-pair a (make-pair b c))
((lambda (t)
(make-tuple (make-pair a (first-tuple t))
(make-pair b (rest-tuple t))))
(split-list c))))))
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"))