Related to this question: Pair combinations in scheme, I'm trying to write a function that creates possible sequences of a list. I'm also trying to annotate it to myself with some lets, rather than putting everything in maps. Here is what I have so far:
(define (remove-from-list elem L)
(filter (lambda (x) (not (= x elem))) L))
(define (prepend-element-to-list-of-lists elem L)
(map (lambda (x) (append (list elem) x)) L))
(define (perm L)
; returns a list of lists, so base case will be '(()) rather than '()
(if (null? L) '(())
; we will take out the first element, this is our "prepend-item"
(let ((prepend-element (car L))
(list-minus-self (remove-from-list (car L) L)))
; prepend-to-list-of-lists
(let ((other-lists-minus-self (perm list-minus-self)))
(prepend-element-to-list-of-lists prepend-element other-lists-minus-self)
))))
(perm3 '(1 2 3))
((1 2 3)) ; seems to be stopping before doing the recursive cases/iterations.
What I'm trying to do here is to take out the first element of a list, and prepend that to all list-of-lists that would be created by the procedure without that element. For example, for [1,2,3] the first case would be:
Take out 1 --> prepended to combinations from [2,3], and so eventually it comes to [1,2,3] and [1,3,2].
However, I was seeing if I can do this without map and just calling itself. Is there a way to do that, or is map the only way to do the above for 1, then 2, then 3, ...
And related to this, for the "working normal case", why does the following keep nesting parentheticals?
(define (perm L)
(if (null? L) '(())
; (apply append <-- why is this part required?
(map (lambda (elem)
(map (lambda (other_list) (cons elem other_list))
(perm (remove-from-list elem L))))
L)))
; )
That is, without doing an (apply append) outside the map, I get the "correct" answer, but with tons of nested parens: (((1 (2 (3))) (1 (3 (2)))) ((2 (1 (3))) (2 (3 (1)))) ((3 (1 (2))) (3 (2 (1))))). I suppose if someone could just show an example of a more basic setup where a map 'telescopes' without the big function that might be helpful.
Regarding "where do parens come from", it's about types: the function being mapped turns "element" into a "list of elements", so if you map it over a list of elements, you turn each element in the list into a list of elements: ....
[ 1, 2, 3, ] -->
[ [ 1a, 1b ], [2a], [] ]
, say, (in general; not with those functions in question). And since there's recursion there, we then have something like
[ [ [1a1], [] ], [[]], [] ]
, and so on.
So map foo is listof elts -> listof (listof elts):
`foo` is: elt -> (listof elts)
-------------------------------------------------------
`map foo` is: listof elts -> listof (listof elts)
But if we apply append after the map on each step, we've leveled it into the listof elts -> listof elts,
`map foo`: listof elts -> listof (listof elts)
`apply append`: listof (listof elts) -> listof elts
----------------------------------------------------------------------
`flatmap foo`: listof elts -> listof elts
and so no new parens are popping up -- since they are leveled at each step when they appear, so they don't accumulate like that; the level of nestedness stays the same.
That's what apply append does: it removes the inner parens:
(apply append [ [x, ...], [y, ...], [z, ...] ] ) ==
( append [x, ...] [y, ...] [z, ...] ) ==
[ x, ..., y, ..., z, ... ]
So, as an example,
> (define (func x) (if (= 0 (remainder x 3)) '()
(if (= 0 (remainder x 2)) (list (+ x 1))
(list (+ x 1) (+ x 2)))))
> (display (map func (list 1 2 3 4)))
((2 3) (3) () (5))
> (display (map (lambda (xs) (map func xs)) (map func (list 1 2 3 4))))
(((3) ()) (()) () ((6 7)))
> (display (flatmap func (list 1 2 3 4)))
(2 3 3 5)
> (display (flatmap func (flatmap func (list 1 2 3 4))))
(3 6 7)
Now that the types fit, the flatmap funcs compose nicely, unlike without the flattening. Same happens during recursion in that function. The deeper levels of recursion work on the deeper levels of the result list. And without the flattening this creates more nestedness.
Related
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.
I started to learn Racket and I don't know how to check if a list is found in another list. Something like (member x (list 1 2 3 x 4 5)), but I want that "x" to be a a sequence of numbers.
I know how to implement recursive, but I would like to know if it exists a more direct operator.
For example I want to know if (list 3 4 5) is found in (list 1 2 3 4 5 6 )
I would take a look at this Racket Object interface and the (is-a? v type) -> boolean seems to be what you are looking for?, simply use it while looping to catch any results that are of a given type and do whatever with them
you may also want to look into (subclass? c cls) -> boolean from the same link, if you want to catch all List types in one go
should there be a possiblity of having a list inside a list, that was already inside a list(1,2,(3,4,(5,6))) i'm afraid that recursion is probally the best solution though, since given there is a possibility of an infinit amount of loops, it is just better to run the recursion on a list everytime you locate a new list in the original list, that way any given number of subList will still be processed
You want to search for succeeding elements in a list:
(define (subseq needle haystack)
(let loop ((index 0)
(cur-needle needle)
(haystack haystack))
(cond ((null? cur-needle) index)
((null? haystack) #f)
((and (equal? (car cur-needle) (car haystack))
(loop index (cdr cur-needle) (cdr haystack)))) ; NB no consequence
(else (loop (add1 index) needle (cdr haystack))))))
This evaluates to the index where the elements of needle is first found in the haystack or #f if it isn't.
You can use regexp-match to check if pattern is a substring of another string by converting both lists of numbers to strings, and comparing them, as such:
(define (member? x lst)
(define (f lst)
(foldr string-append "" (map number->string lst)))
(if (regexp-match (f x) (f lst)) #t #f))
f converts lst (a list of numbers) to a string. regexp-match checks if (f x) is a pattern that appears in (f lst).
For example,
> (member? (list 3 4 5) (list 1 2 3 4 5 6 7))
#t
One can also use some string functions to join the lists and compare them (recursion is needed):
(define (list-in-list l L)
(define (fn ll)
(string-join (map number->string ll))) ; Function to create a string out of list of numbers;
(define ss (fn l)) ; Convert smaller list to string;
(let loop ((L L)) ; Set up recursion and initial value;
(cond
[(empty? L) #f] ; If end of list reached, pattern is not present;
[(string-prefix? (fn L) ss) #t] ; Compare if initial part of main list is same as test list;
[else (loop (rest L))]))) ; If not, loop with first item of list removed;
Testing:
(list-in-list (list 3 4 5) (list 1 2 3 4 5 6 ))
Output:
#t
straight from the Racket documentation:
(member v lst [is-equal?]) → (or/c list? #f)
v : any/c
lst : list?
is-equal? : (any/c any/c -> any/c) = equal?
Locates the first element of lst that is equal? to v. If such an element exists, the tail of lst starting with that element is returned. Otherwise, the result is #f.
Or in your case:
(member '(3 4 5) (list 1 2 3 4 5 6 7))
where x is '(3 4 5) or (list 3 4 5) or (cons 3 4 5)
it will return '(3 4 5 6 7) if x ( searched list '(3 4 5) ) was found in the list or false (#f) if it was not found
or you can use assoc to check if your x is met in one of many lists, or :
(assoc x (list (list 1 2) (list 3 4) (list x 6)))
will return :
'(x 6)
There are also lambda constructions but I will not go in depth since I am not very familiar with Racket yet. Hope this helps :)
EDIT: if member gives you different results than what you expect try using memq instead
The problem is when lists have a different length, any idea of how to do it?
I have to use functions like map or something like that
This is the code I wrote so far, it works with lists of the same length but it also needs to work with lists of different lengths. Thank you.
(define (interleave list1 list2)
(flatten [map (lambda (x y) (cons x (cons y null))) list1 list2]))
if lists have different length this is what I get:
map: all lists must have same size; arguments were: # '(1 2 3 4 5) '(a b c)
I'm trying to get (1 a 2 b 3 c 4 5)
#lang racket
(define (weave xs ys)
(match (list xs ys)
[(list (cons x xs) (cons y ys)) (cons x (cons y (weave xs ys)))]
[(list '() ys) ys]
[(list xs '()) xs]))
I'm assuming your desired behavior is that the lists are interleaved for as long as this is possible, and then whatever is left over from the nonempty list is appended to the end. In that case one possible implementation is
(define (interleave a b)
(if (null? a)
b
(cons (car a)
(interleave b (cdr a)))))
I think this is probably the simplest possible way to write what you're looking for.
Neither map nor fold-right would work because they either signal an error when one list is smaller than the other or they tend to stop at the shortest list. eg. SRFI-1's map (interleave '(1 2 3 4) (circular-list 9 8)) ; ==> (1 9 2 8 3 9 4 8). For a different behavior you need to roll your own.
A solution using simple list manipulation functions might be:
(define (interleave list1 list2)
(cond ((empty? list1) list2)
((empty? list2) list1)
(else
(append
(list (car list1) (car list2))
(interleave (cdr list1) (cdr list2))))))
Testing...
> (interleave '(1 2 3 4 5) '(a b c))
(1 a 2 b 3 c 4 5)
> (interleave '(1 2 3 4 5) '())
(1 2 3 4 5)
> (interleave '() '(a b c))
(a b c)
>
I think it is fairly self-documenting.
"There ain't nothin' you can't not do with fold-right and some of them con-tin-uations thingies", said a cowboy to another, spittin' into the campfire and puffin' on his cigar in the evening, sippin' his black coffee from his rugged banged up tin mug. "Yessa, nothin' in the whole darn world."
(define (interleave xs ys)
;; interleave xs ys = foldr g n xs ys
;; where
;; g x r (y:ys) = x : y : r ys
;; g x r [] = x : r []
;; n ys = ys
((foldr
(lambda (x r)
(lambda (ys)
(cond ((null? ys) (cons x (r '())))
(else (apply (lambda (y . ys)
(cons x (cons y (r ys))))
ys)))))
(lambda (ys) ys)
xs)
ys))
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"))
I notice that almost all scheme functions can only return one list as output.
In the following, I would like to return multiple values of all the adjacent nodes of neighbors.
(define (neighbors l w)
(if (and (= 1 l) (= 1 w))
(list (and (l (+ 1 w))) (and (+ 1 l) w)))) ; how to output 2 or more values?
In this case I'm first testing if the node is at corner, if so, return 2 values of the coordinates where (l and w+1), (l+1 and w) basically if I'm at (1,1) return me (1,2) and (2,1)
Same applies when the node has only 1 neighbor near the edge, in this case I will have 3 values.
When no edge is nearby I will have 4 return values.
I tried to use cons, append, list, display, write none of them seems working with additional values. I need this as a sub-function of this question. How should I implement it so I could pass on the return value and use it recursively to return me all the adjacent nodes?
Edit: I found the answer: use the keyword "values" to return multiple values. Example:
(define (store l w)
(values (write l)
(write w)
(newline)
(list (+ 1 w) l)
(list w (+ 1 l))))
values, continuation passing style, and list are at least three ways of returning multiple values:
(import (rnrs))
; let-values + values
(define (foo1)
(values 1 2 3))
(let-values (((a b c) (foo1)))
(display (list a b c))
(newline))
; cps
(define (foo2 k)
(k 1 2 3))
(foo2 (lambda (a b c)
(display (list a b c))
(newline)))
; list
(define (foo3)
(list 1 2 3))
(let ((result (foo3)))
(display result)
(newline))
The Guile implementation of Scheme has a receive syntax, which it says is "much more convenient" than values. I haven't used it yet, however, but this may be useful:
http://www.gnu.org/software/guile/manual/html_node/Multiple-Values.html
You can return a pair of values in a cons cell:
(define (foo)
(cons 'a 5))
(let* ((r (foo))
(x (car r))
(y (cdr r)))
(display x) (display y) (newline))
You can generalise this to return multiple values in a list, too.