Let's say we have a list like the following:
("These" "Are "Some" "Words"), let us call it listy
How to call a function on each of those items of the list?
Perhaps call a function like:
(defun messager (somelist)
(interactive)
(message somelist)
)
Running the function:
(messager listy)
I would expect in the buffer to see seperate lines for each item of the list.
The part that is not working though, is to loop or something over the items from the list.
Use
(mapc 'messager listy)
or
(dolist (item listy)
(messager item))
Now, I'm going for self-advertising once again :P But in hopes that I will communicate some useful info on the way:
;; Here is what `dolist' expands to:
(dolist (item listy)
(messager item))
(identity
(catch (quote --cl-block-nil--)
(let ((--dolist-tail-- listy) item)
(while --dolist-tail--
(setq item (car --dolist-tail--))
(messager item)
(setq --dolist-tail-- (cdr --dolist-tail--))))))
;; And here is what `i-iterate' expands to:
(++ (for item in listy)
(messager item))
(let* ((--0 listy) item)
(while --0
(setq item (car --0) --0 (cdr --0))
(messager item)))
Some commentary: dolist will create a (catch ...) block whether there or not there is a conditional exit, while i-iterate will try to do that only if such conditional exit was identified. Generally, executing code inside (catch ...) form is a little slower.
Also, dolist will wrap the code into a special "block" (which is basically just the call to identity function. This is, too, a sort of cruft, that is a default, but not always needed.
Now, to your other question about alist, you could use loop macro like so:
(loop for (key . value) in '((a . b) (c . d)) do
(message "key: %s -> value: %s" key value))
;; Which expands to:
(identity
(catch (quote --cl-block-nil--)
(let* ((--cl-var-- (quote ((a . b) (c . d)))) (value nil) (key nil))
(while (consp --cl-var--)
(setq value (car --cl-var--)
key (car (prog1 value (setq value (cdr value)))))
(message "key: %s -> value: %s" key value)
(setq --cl-var-- (cdr --cl-var--))) nil)))
;; Compared to i-iterate
(++ (for (key . value) in '((a . b) (c . d)))
(message "key: %s -> value: %s" key value))
;; Which expands to:
(let* ((--0 (quote ((a . b) (c . d)))) value key)
(while --0
(setq key (caar --0) value (cdar --0) --0 (cdr --0))
(message "key: %s -> value: %s" key value)))
Where, in this particular case using pop was not justified. Likewise the use of (catch ...) block (since there wasn't a conditional exit).
Oh, and the link to the library: http://code.google.com/p/i-iterate/ :)
The benefits and downsides of using mapc for this purpose: The high-order functions combine well with already existing functions. So, if you already had one you wanted to apply to every element - that would be, probably, the best way to solve your problem. However, if you are going to create a function only to use it with a high-order function - then it rarely pays off, as you will create a "redundant" instance, which you could've otherwise avoided. It is not always the case, and some times, especially when used with macros, this can be a powerful tool, but as is your case, the iteration seems to be better suited.
Related
As a beginner, I am struggling with lips, in my program I have a list like :
(((NIL (B) (C) (B)) (A)) (E) (G))
But what I want to construct is n-dimensional list (3-dim in this case):
((B C B)(A)(E G))
I have tried flattening the list but it does not seem to be correct. I will appreciate any help.
As you have not really given the specification of what your program is meant to do, here is something that turns the structure you have into the one you want, on the assumption that something else is giving you this structure.
Your structure is a cons, the car of which is either null, if there's no more structure, or a structure. The cdr of the structure list of single-element lists and we want those elements.
I've called the structure a BLOB-TREE and each CDR is a BLOB.
(defun blob-to-list (blob)
;; a blob is a list of single-element lists, and we want the elements
(mapcar (lambda (e)
(assert (and (listp e) (null (rest e))))
(first e))
blob))
(defun blob-tree-to-list (blobs)
;; BLOB-TREE is some horrible tree: what we need to do is split it into
;; its car & cdr, and then convert the cdr to a list with
;; blob-to-list, then recurse on the car, until we get a null car.
(labels ((extract-blobs (remains accum)
(etypecase remains
(null accum)
(cons
(extract-blobs (car remains) (cons (blob-to-list (cdr remains))
accum))))))
(extract-blobs blobs '())))
And now
> (blob-tree-to-list '(((NIL (B) (C) (B)) (A)) (E) (G)))
((b c b) (a) (e g))
I rather doubt that this is actually what you want to do.
As a check, I wrote a function which takes a list in the form you want and converts it into a blob-tree. You can use this to check that things round-trip properly.
(defun list-to-blob-tree (l)
(labels ((list-to-blob (es)
(mapcar #'list es))
(build-blob-tree (tail accum)
(if (null tail)
accum
(build-blob-tree (rest tail)
(cons accum (list-to-blob (first tail)))))))
(build-blob-tree l '())))
If you really want to deal with things like this (which, in real life, you sometimes have to), a good approach is to write a bunch of accessor functions which let you abstract away the shonky data structures you've been given.
In this case we can write functions to deal with blobs:
;;; Blobs are lists are lists where each element is wrapped in a
;;; single-element list
(defun blob->element-list (blob)
;; a blob is a list of single-element lists, and we want the elements
(mapcar (lambda (e)
(assert (and (listp e) (null (rest e))))
(first e))
blob))
(defun element-list->blob (list)
;; turn a list into a blob
(mapcar #'list list))
And another set of functions to deal with blob trees, which (it turns out) are just lists built with their cars & cdrs swapped:
;;; Blob trees are lists, built backwards
;;;
(deftype blob-tree ()
'(or cons null))
(defconstant null-blob-tree nil)
(defun blob-tree-car (blob-tree)
(cdr blob-tree))
(defun blob-tree-cdr (blob-tree)
(car blob-tree))
(defun blob-tree-cons (car cdr)
(cons cdr car))
(defun blob-tree-null-p (blob-tree)
(null blob-tree))
In both cases I've only written the functions I need: there are readers but no writers for instance.
And now we can write the functions we need in terms of these abstractions:
(defun blob-tree->element-list (blob-tree)
(labels ((extract-blobs (tree accum)
(assert (typep tree 'blob-tree))
(if (blob-tree-null-p tree)
accum
(extract-blobs (blob-tree-cdr tree)
(cons (blob->element-list (blob-tree-car tree))
accum)))))
(extract-blobs blob-tree '())))
(defun element-list->blob-tree (el)
(labels ((build-blob-tree (elt accum)
(if (null elt)
accum
(build-blob-tree (rest elt)
(blob-tree-cons
(element-list->blob (first elt))
accum)))))
(build-blob-tree el null-blob-tree)))
This means that if the representation changes these two mildly hairy functions don't.
This works for me:
(defun peculiar-transform (input-list)
(destructuring-bind (((ignore (xb) (xc) (xb)) (xa)) (xe) (xg)) input-list
`((,xb ,xc ,xb) (,xa) (,xe ,xg))))
Test:
[1]> (peculiar-transform '(((NIL (B) (C) (B)) (A)) (E) (G)))
((B C B) (A) (E G))
[2]> (peculiar-transform '(((NIL (2) (3) (2)) (1)) (5) (7)))
((2 3 2) (1) (5 7))
I've renamed your variables to XA, XB, ... just to reduce confusion when we use the A, B, ... occur in the input test case.
Here we are taking advantage destructuring-bind to use your input pattern directly (just with the variables renamed) as the specification for how to extract the elements, and then we use the backquote syntax to produce a template that has the required output shape, with the extracted pieces inserted into the right places.
I've a problem about keeping a list in the memory without using set!
I have an initial empty list defined,
(define database (list))
then I have this procedure which checks if the password is correct and adds the pair to the list.
(define (set-pass l)
(if (pair? l)
(if (check-pass (second (last l)))
(add-to-list l)
"password does not meet policy requirements"
)
"invalid input"
)
)
And a add-to-list procedure:
(define (add-to-list l)
;(append database l)
;implement this.
)
Problem is, I have to call this procedure multiple times:
(set-pass '('john '(X p c F z C b Y h 1 2 3 4 : :)))
(set-pass '('john '(X p c F z C b Y : 1 2 3 4 : :)))
(set-pass '('john '(X p c F z C b : : 1 2 3 4 : :)))
I implemented the procedure add-to-list like I'm calling set-pass once (with append as shown above), but I couldn't find a way to implement if I call it multiple times. I tried a few things mentioned here, here and here. But I couldn't achieve what I wanted. So how can I do this?
It's possible to do this functionally by having the database as a variable:
(let loop ((input (read-line)) (database '()))
(display (format "inserting ~a\n" input))
(loop (read-line)
(cons input database)))
The other features (removing etc) work the same way you as recur with the altered structure according the operation.
You can also update a list with set-cdr!. While set! mutates what a symbol points to, set-cdr! mutates the cdr of a pair. Since it needs to be a pair you need to have the first element be some dummy data:
(define database (list "head"))
(define (add element)
(let ((tmp (cdr database)))
(set-cdr! database (cons element tmp))))
(define (delete element)
(let loop ((prev database) (cur (cdr database)))
(cond ((null? cur) #f)
((equal? (car cur) element)
(set-cdr! prev (cdr cur)))
(else (loop cur (cdr cur))))))
(define (get)
(cdr database))
(add 1)
(add 2)
(add 3)
(get) ; ==> (3 2 1)
(delete 2)
(get) ; ==> (3 1)
The second you allow mutation the cat is out of the bag and all mutation is available. Eg. you can make a mutable object with closures if set! is provided and you can get mutable bindings with boxes if set-car!/set-cdr! is provided.
I have been trying to transform a linear list into a set but with no avail. Everytime I run this, I get some weird compilation errors like "badly formed lambda" which points to the way I use append. Here is my code:
(defun mem(e l)
(cond
((null l) nil)
((equal e (car l)) t)
((listp (car l)) (mem e (car l)))
(t(mem e (cdr l)))
)
)
(defun st(l k)
(cond
((null l) nil)
(( mem '(car l) 'k) (st (cdr l) k))
((listp (car l)) (st (car l) k))
( t (st (cdr l) (append((car l) k)) ))
(t(mem e (cdr l)))
)
)
EDIT: frankly I just want to remove the duplicates from list l
Prefer Standard Library Functions
EDIT: frankly I just want to remove the duplicates from list l
Common Lisp has a remove-duplicates function. The documentation inclues examples:
Examples:
(remove-duplicates "aBcDAbCd" :test #'char-equal :from-end t) => "aBcD"
(remove-duplicates '(a b c b d d e)) => (A C B D E)
(remove-duplicates '(a b c b d d e) :from-end t) => (A B C D E)
(remove-duplicates '((foo #\a) (bar #\%) (baz #\A))
:test #'char-equal :key #'cadr) => ((BAR #\%) (BAZ #\A))
(remove-duplicates '((foo #\a) (bar #\%) (baz #\A))
:test #'char-equal :key #'cadr :from-end t) => ((FOO #\a) (BAR #\%))
Are you trying to flatten the list too?
From your code for mem, where you do:
((listp (car l)) (mem e (car l)))
it looks like you want your member function to also recurse into sublists. That's a bit questionable, even when working with sets, since sets can traditionally include other sets. E.g., {{3},{4},5} is a set containing 5, the set {3}, and the set {4}. It's not the same as the set {3,4,5}. Your st function also looks like it's trying to recurse into lists, which makes it seem like you want to flatten you lists, too. Again, that's a bit questionable, but if you want to do that, then your conversion to a set would be easier as a "flatten, then remove duplicates" process:
(defun flatten (list)
"Returns a fresh list containing the leaf elements of LIST."
(if (listp list)
(mapcan 'flatten list)
(list list)))
;; CL-USER> (flatten '(1 2 (3 4) 5 ((6))))
;; (1 2 3 4 5 6)
(defun to-set (list)
"Returns a set based on the elements of LIST. The result
is a flat list containing the leaf elements of LIST, but
with any duplicate elements removed."
(delete-duplicates (flatten list)))
;; CL-USER> (to-set '(1 3 (3 4) ((4) 5)))
;; (1 3 4 5)
Notes
I get some weird compilation errors like "badly formed lambda" which points to the way I use append.
Yes, you're trying to call append like: (append((car l) k)). That's actually not a problem for append. Remember, the syntax for a function call in Lisp is (function argument…). That means that you've got:
(append ((car l) k))
<function> <argument1>
But your argument1 is also a function call:
((car l) k )
<function> <argument1>
In Common Lisp, you can't use (car l) as a function. The only thing that can appear for a function is a symbol (e.g., car, append) or a lambda expression (e.g., (lambda (x) (+ x 1)).
You want to call (append (car l) k) instead.
First, CL does not have a set data type.
Lists, however, can be used as sets, you do not need to write any special code for that.
Second, I don't understand what your st function is supposed to do, but I bet that in the second cond clause you should not quote (car l) and k. You should use meaningful names for your functions and avoid abbreviations. As per your explanation in the comment, you should use pushnew instead.
Third, your mem function is quite weird, I am pretty sure you do not mean what you wrote: e is searched along a path in the tree l, not in the list l. As per your explanation in the comment, you should check both car and cdr:
(defun tree-member (tree element &key (test #'eql))
(if (consp tree)
(or (tree-member (car tree) element :test test)
(tree-member (cdr tree) element :test test))
(funcall test element tree)))
I want to write a recursive function that checks the list and either returns true if the list is in ascending order or NIL otherwise. If the list is empty it is still true. I am completely new to Lisp, so its still very confusing.
(defun sorted (x)
(if (null x)
T
(if (<= car x (car (cdr x)))
(sorted (cdr x))
nil)))
The recursive version:
(defun sorted (list)
(or (endp list)
(endp (cdr list))
(and (<= (first list) (second list))
(sorted (cdr list)))))
The more idiomatic loop-based predicate accepting a :test argument:
(defun sortedp (list &key (test #'<=))
(loop for (a b) on list
while b
always (funcall test a b)))
The version accepting a :key; we only call the key function once per visited element:
(defun sortedp (list &key (test #'<=) (key #'identity))
(loop for x in list
for old = nil then new
for new = (funcall key x)
for holdp = T then (funcall test old new)
always holdp))
Some tests:
(loop for k in '(()
((1))
((1) (2))
((2) (1))
((1) (2) (3))
((3) (2) (1)))
collect (sortedp k :test #'> :key #'car))
=> (T T NIL T NIL T)
This one also works with other kinds of sequences:
(defun sortedp (sequence &key (test #'<=) (key #'identity))
(reduce (lambda (old x &aux (new (funcall key x)))
(if (or (eq old t)
(funcall test old new))
new
(return-from sortedp nil)))
sequence
:initial-value t))
The above test gives:
(T 1 NIL 1 NIL 1)
... which is a correct result thanks to generalized booleans.
If you are doing your homework (seems so), then the above answers are fine. If you are just learning Lisp, and don't have constraints about recursivity, then the following might give you a glimpse about the power of Lisp:
(defun sorted (l)
(or (null l) (apply #'< l)))
The first problem with your solution is the base case You need to stop not at the end of the list, but when looking at the last to elements, as you need to elements to do the comparison. Also the parens are missing in the call to (car x)
(defun sorted (list)
(if (endp (cddr list))
(<= (car list) (cadr list))
(and (<= (car list) (cadr list))
(sorted (cdr list)))))
Bare in mind that recursive solutions are discouraged in CL
I previously asked a question concerning message passing Abstraction here: MIT Scheme Message Passing Abstraction
The question asked that I:
Write a mailman object factory (make-mailman) that takes in no parameters and returns
a message-passing object that responds to the following messages:
'add-to-route: return a procedure that takes in an arbitrary number of mailbox objects
and adds them to the mailman object's “route”
'collect-letters: return a procedure that takes in an arbitrary number of letter
objects and collects them for future distribution
'distribute: add each of the collected letters to the mailbox on the mailman's route
whose address matches the letter's destination and return a list of any letters whose
destinations did not match any mailboxes on the route (Note: After each passing of
'distribute the mailman object should have no collected letters.)
I had already written 2 procedures earlier as part of this assignment to make a mailbox and make a letter:
(define (make-letter destination message)
(define (dispatch x)
(cond ((eq? x 'get-destination) destination)
((eq? x 'get-message) message)
(else "Invalid option.")))
dispatch)
(define (make-mailbox address)
(let ((T '()))
(define (post letter)
(assoc letter T))
(define (previous-post post)
(if (null? (cdr post)) post (cdr (previous-post post))))
(define (letter-in-mailbox? letter)
(if (member (post letter) T) #t #f))
(define (add-post letter)
(begin (set! T (cons letter T)) 'done))
(define (get-previous-post post)
(if (letter-in-mailbox? post)
(previous-post post)
#f))
(define (dispatch y)
(cond ((eq? y 'add-letter) add-post)
((eq? y 'get-latest-message) (get-previous-post T))
((eq? y 'get-address) address)
(else "Invalid option.")))
dispatch))
After being given a very good explanation on what my current answer was doing wrong and making many necessary changes to my code, I was told that any problems I have in that code would be better off asked in this question. Therefore, here is the code that builds off my previous question:
(define (make-mailman)
(let ((self (list '(ROUTE) '(MAILBAG))))
(define (add-to-route . mailboxes)
(let ((route (assoc 'ROUTE self)))
(set-cdr! route (append mailboxes (cdr route)))
'DONE))
(define (collect-letters . letters)
(let ((mailbag (assoc 'MAILBAG self)))
(set-cdr! mailbag (append letters (cdr mailbag)))
'DONE))
(define (distribute-the-letters)
(let* ((mailbag (assoc 'MAILBAG self))
(mailboxes (cdr (assoc 'ROUTE self)))
(letters (cdr mailbag)))
(if (null? letters)
()
(let loop ((letter (car letters))
(letters (cdr letters))
(not-delivered ()))
(let* ((address (letter 'get-address))
(mbx (find-mailbox address mailboxes)))
(if (equal? address letter)
((mbx 'add-post) letter)
((mbx 'add-post) not-delivered))
(if (null? letters)
(begin (set-cdr! mailbag '()) not-delivered)
(loop (car letters) (cdr letters) not-delivered)))))))
(define (dispatch z)
(cond ((eq? z 'add-to-route) add-to-route)
((eq? z 'collect-letters) collect-letters)
((eq? z 'distribute) distribute-the-letters)
(else "Invalid option")))
dispatch))
Essentially, I'm running into a different error now that instead returns that the distribute-the-letters procedure is being passed as an argument to length, which is not a list. I do not know why this error is being returned, since I would think that I am passing in the lists as they are needed. Would anyone be able to shed some light on what's going on? Any help will be appreciated.
UPDATE: Using this procedure in my make-mailman code now:
(define (find-mailbox address mailbox)
(if (not (element? address self))
#f
(if (element? mailbox self)
mailbox
#f)))
Your error is here:
(define (distribute-the-letters)
(let* ((mailbag (assoc 'MAILBAG self))
(mailboxes (cdr (assoc 'ROUTE self)))
(letters (cdr mailbag)))
(if (null? letters)
()
(let loop ((letter (car letters))
(letters (cdr letters))
(not-delivered ()))
(let* ((address (letter 'get-address))
(mbx (find-mailbox address mailboxes))) ;; has to be impl'd
;; (if (equal? address letter) ;; this makes
;; ((mbx 'add-post) letter) ;; no
;; ((mbx 'add-post) not-delivered)) ;; sense
;; here you're supposed to put the letter into the matching mailbox
;; or else - into the not-delivered list
(if mbox ;; NB! find-mailbox should accommodate this
((mbox 'put-letter) letter) ;; NB! "mailbox" should accom'te this
(set! not-delivered ;; else, it wasn't delivered
(cons letter not-delivered)))
(if (null? letters)
(begin
(set-cdr! mailbag '()) ;; the mailbag is now empty
not-delivered) ;; the final return
(loop (car letters)
(cdr letters)
not-delivered)))))))
find-mailbox still has to be implemented here. It should search for the matching mailbox, and return #f in case it is not found, or return the mailbox object itself if it was found. The "mailbox" objects must be able to respond to 'put-letter messages and have "addresses". The "letter" objects must also have "addresses" (which we retrieve with the call (letter 'get-address), and for mailbox we'd call (mbox 'get-address)), and these addresses must be so that we can compare them for equality.
That means that letters and mailboxes should be objects defined through the same kind of procedure as here the mailman is defined, with internal procedures, and the dispatch procedure exported as the object itself.
This all needs to be further implemented, or perhaps you have them already as part of some previous assignment?
now that you've provided your additional definitions, let's see.
make-letter seems OK. A letter supports two messages: 'get-destination and get-message.
make-mailbox has issues.
(define (make-mailbox address)
(let ((T '()))
(define (post letter)
(assoc letter T)) ;; why assoc? you add it with plain CONS
(define (previous-post post)
(if (null? (cdr post)) ;; post == T (11)
post
(cdr (previous-post post) ;; did you mean (prev-p (cdr post)) ? (12)
)))
(define (letter-in-mailbox? letter) ;; letter == T ??????? (3)
(if (member (post letter) T) #t #f))
(define (add-post letter)
(begin (set! T (cons letter T)) 'done)) ;; added with plain CONS
(define (get-previous-post post)
(if (letter-in-mailbox? post) ;; post == T (2)
(previous-post post) ;; post == T (10)
#f))
(define (dispatch y)
(cond ((eq? y 'add-letter) add-post)
((eq? y 'get-latest-message)
(get-previous-post T)) ;; called w/ T (1)
((eq? y 'get-address) address)
(else "Invalid option.")))
dispatch))
you add letters with add-post, and it calls (set! T (cons letter T)). So it adds each letter into the T list as-is. No need to use assoc to retrieve it later, it's just an element in a list. Just call (member letter T) to find out whether it's in. post has no function to perform, it should be (define (post letter) letter).
(if (member letter T) #t #f) is functionally the same as just (member letter T). In Scheme, any non-false value is like a #t.
Your previous-post (if fixed w/ (12) ) returns the last cdr cell of its argument list. If it holds letters (a b c d), (previous-post T) returns (d). Didn't you mean it to be a ? The message it handles is called 'get-latest-message after all. Whatever you just added with cons into list ls, can be gotten back with one simple call to ... (what?).
And why is it called get-latest-message? Does it return a letter, or the message within that letter? (and here the word message is used in two completely unrelated senses in one program; better call letter's contents, maybe, letter-contents ??
Lastly, we call (find-mailbox address mailboxes) in the main program, but you define (define (find-mailbox address mailbox) .... It should compare (equal? address (mailbox 'get-address)). self isn't needed, so this utility function can be put into global scope.
And it must enumerate through those mailboxes:
(define (find-mailbox address mailboxes)
(if (not (null? mailboxes))
(if (equal? address ((car mailboxes) 'get-address))
(car ..... )
(find-mailbox address .... ))))