Consider a graph such as this one, composed of nodes and neighbors:
(defparameter *graph* '((A (B C D))
(B (A C E))
(C (A B D E))
(D (A C E))
(E (B C D))))
...and a set of labels for each node:
(defparameter *values* '((A 1)
(B 2)
(C 3)
(D 2)
(E 1)))
I'm trying to write a function that evaluates a graph in that format and determines whether or not adjacent nodes have the same label. If I were writing this in C++ or Java my logic for an iterative version of the function might look something like this:
(defun evaluate-label (graph values)
;; for every node in graph
;; for every adjoining node
;; if (node.value == adjoiningNode.value)
;; return false
;; return true
)
...but I'm not sure what sort of logic would be more appropriate for Lisp, let alone how to go about coding it up.
So, two questions:
What would a "Lispy" bit of pseudocode for this function look like?
What specific syntactical features would you put in the function? Let's assume there's a cond. Is every useful for this problem? Can we easily do this without resorting to lambda expressions?
Thanks in advance for any feedback!
One important aspect of good programming, regardless of the language, is good abstraction. At times, that can be a matter of taste, but here's an example that tries to apply some abstraction to this problem. Once you have your graph and your values, you can define a node-value function that returns the value of a node. Then you can phrase your question as
Is there some node the graph that has the same node value as one of its neighbors?
This isn't too hard to write with some:
(defun adjacent-values-p (graph values)
(flet ((node-value (node)
(cadr (assoc node values))))
(some #'(lambda (node-descriptor)
(destructuring-bind (node neighbors)
node-descriptor
(find (node-value node) neighbors
:key #'node-value)))
graph)))
(adjacent-values-p '((a (b c)))
'((a 1) (b 2) (c 1)))
;=> C
(adjacent-values-p '((a (b c)))
'((a 1) (b 2) (c 3)))
;=> NIL
That said, even though that might be more Lisp-y in some senses, it might make just as much sense to write it using explicit iteration with dolist:
(defun adjacent-values-p (graph values)
(flet ((node-value (node)
(cadr (assoc node values))))
(dolist (node-descriptor graph)
(destructuring-bind (node neighbors) node-descriptor
(when (member (node-value node) neighbors :key #'node-value)
(return t))))))
This can be even better with loop, which supports some destructuring:
(defun adjacent-values-p (graph values)
(flet ((node-value (node)
(cadr (assoc node values))))
(loop for (node neighbors) in graph
thereis (find (node-value node) neighbors :key #'node-value))))
All of these versions could benefit from storing values in, e.g,. a hashtable for quicker retrieval. Whether this makes sense to do here or not depends on your needs, application domain, etc. Otherwise you'll be retrieving edge labels O(2×|E|), doing a O(|V|) traversal each time. For instance:
(let ((table (make-hash-table)))
(flet ((node-value (node)
(multiple-value-bind (value presentp)
(gethash node table)
(if presentp value
(setf (gethash node table)
(cadr (assoc node values)))))))
;; ...
))
That caches "on-demand" by not looking up a node value until it's needed. However, since every node value should be needed (assuming that that the list of values provided doesn't contain any extra nodes), it's probably better to just populate the table at the beginning. Then you don't have to do any checks later on, and you only have to traverse the values list once. Thus:
(defun adjacent-values-p (graph values &aux (table (make-hash-table)))
(loop for (node value) in values
doing (setf (gethash node table) value))
(flet ((node-value (node)
(gethash node table)))
;; ...
))
Related
Working on CLISP in Sublime Text.
Exp. in CLISP : less than 1 year
It's already for a while that I'm trying to solve this exercice... without success... as you might guess.
In fact I have to create a function which will modify the list and keeps only sublists which are equals or greater than the given number (watch below)
The list on which I have to work :
(setq liste '((a b) c (d) (e f) (e g x) f))
I'm supposed to find this as result :
(lenght 2 liste) => ((a b) (e f) (e g x))
liste => ((a b) (e f) (e g x))
Here my code :
(defun lenght(number liste)
(cond
((atom liste) nil)
((listp (car liste))
(rplacd liste (lenght number (cdr liste))) )
((<= (lenght number (car liste)) number)
(I don't know what to write) )
((lenght number (cdr liste))) ) )
It will be very kind if you could give me only some clue so as to let me find the good result.
Thanks guys.
Modifying the list does not make much sense, because it gets hairy at the head of the list to retain the original reference. Return a new list.
This is a filtering operation. The usual operator in Common Lisp for that is remove-if-not (or remove-if, or remove, depending on the condition). It takes a predicate that should return whether the element should be kept. In this case, it seems to be (lambda (element) (and (listp element) (>= (length element) minlength))).
(defun filter-by-min-length (minlength list)
(remove-if-not (lambda (element)
(and (listp element)
(>= (length element) minlength)))
list))
In many cases, when the condition is known at compile time, loop produces faster compiled code:
(defun filter-by-min-length (minlength list)
(loop :for element :in list
:when (and (listp element)
(>= (length element) minlength))
:collect element))
This returns a new list that fulfills the condition. You'd call it like (let ((minlength-list (filter-by-min-length 2 raw-list))) …).
Many basic courses insist on recursively using primitive operations on cons cells for teaching purposes at first.
The first attempt usually disregards the possible stack exhaustion. At each step, you first look whether you're at the end (then return nil), whether the first element should be discarded (then return the result of recursing on the rest), or if it should be kept (then cons it to the recursion result).
If tail call optimization is available, you can refactor this to use an accumulator. At each step, instead of first recursing and then consing, you cons a kept value onto the accumulator and pass it to the recursion. At the end, you do not return nil, but reverse the accumulator and return that.
Well, I have found the answer that I was looking for, after scratching my head until blood...
Seriously, here is the solution which is working (and thanks for the correction about length which helped me to find the solution ^^) :
(defun filter-by-min-length (min-length liste)
(cond
((atom liste) nil)
((and (listp (car liste))(>= (length (car liste)) min-length))
(rplacd liste (filter-by-min-length min-length (cdr liste))) )
((filter-by-min-length min-length (cdr liste))) ) )
A non-modifying version
(defun filter-by-min-length (min-length le)
(cond ((atom le) nil)
((and (listp (car le)) (>= (length (car le)) min-length))
(cons (car le) (filter-by-min-length min-length (cdr le))))
(t (filter-by-min-length min-length (cdr le)))))
Test:
(defparameter *liste* '((a b) c (d) (e f) (e g x) f))
(filter-by-min-length 2 *liste*)
;; ((A B) (E F) (E G X))
*liste*
;; ((A B) C (D) (E F) (E G X) F) ; -> *liste* not modified
For building good habits, I would recommend to use defparameter instead of setq, since the behaviour of setq might not always be defined (see here). In the link, it is said:
use defvar, defparameter, or let to introduce new variables. Use setf
and setq to mutate existing variables. Using them to introduce new
variables is undefined behaviour
I wish to replace the first occurrence of a symbol within pairs. For example:
take
(define n '((a . b) . (a . d)))
and i define a method context to replace the first instance (left most) of X with '()
replacing a should give me:
((() . b) a . d)
however i am stuck as my method replaces ALL instances and i am not sure how to add a check for this.
my code is as follows:
(define (context s sym)
(cond ((null? s) #f)
((atom? s)
(if (equal? s sym) '() s ))
(else (cons (context (car s) sym)
(context (cdr s) sym)))))
which gives : ((() . b) () . d)
any help? Thank you
The quickest way is to use a flag indicating whether the replacement has already been done, something along the lines of:
(define (context sxp sym)
(define done #f)
(let loop ((sxp sxp))
(cond (done sxp)
((pair? sxp) (cons (loop (car sxp)) (loop (cdr sxp))))
((eq? sym sxp) (set! done #t) '())
(else sxp))))
It's not very elegant to use set!, but the alternative would be to have the procedure return 2 values, and the resulting let-values code would be even worse in terms of readability IMO.
Also note that I didn't use atom? because it's not defined in standard Scheme; the usual way is to successively test null? then pair?, and handle the atom case in the else clause.
This is a bit more general (you can replace things other than symbols, and you can customize the test, and you can specify any particular number of instances to replace, not just one), and may be a little bit more complicated at first glance than what you're looking for, but here's a solution that works by internally using a continuation-passing style helper function. The main function, subst-n takes a new element, and old element, a tree, a test, and a count. It replaces the first count occurrences of new (as compared with test) with old (or all, if count is not a non-negative integer).
(define (subst-n new old tree test count)
(let substs ((tree tree)
(count count)
(k (lambda (tree count) tree)))
(cond
;; If count is a number and zero, we've replaced enough
;; and can just "return" this tree unchanged.
((and (number? count) (zero? count))
(k tree count))
;; If the tree is the old element, then "return" the new
;; element, with a decremented count (if count is a number).
((test old tree)
(k new (if (number? count) (- count 1) count)))
;; If tree is a pair, then recurse on the left side,
;; with a continuation that will recurse on the right
;; side, and then put the sides together.
((pair? tree)
(substs (car tree) count
(lambda (left count)
(substs (cdr tree) count
(lambda (right count)
(k (cons left right) count))))))
;; Otherwise, there's nothing to do but return this
;; tree with the unchanged count.
(else
(k tree count)))))
> (display (subst-n '() 'a '((a . b) . (a . d)) eq? 1))
((() . b) a . d)
> (display (subst-n '() 'a '((a . b) . (a . d)) eq? 2))
((() . b) () . d)
I'm doing some homework in Lisp, using clisp to test, and I'm loading this code and running in in clisp
(defun myreverse (thelist)
(reverse thelist)
(print thelist)
(if (equal thelist nil)
nil
(if (consp (first thelist))
(cons (myreverse (reverse (first thelist)))
(myreverse (reverse (rest thelist))))
(cons (first thelist) (myreverse (rest thelist))))))
I'm kind of new to Lisp, but this code isn't reversing thelist at all, my output is:
[18]> (myreverse '(a (b c) d))
(A (B C) D)
((B C) D)
(C B)
(B)
NIL
(D)
NIL
(A (C B) D)
The first line of my code says (reverse thelist), why isn't it reversing for the first print statement? Am I missing something?
I believe (reverse) is without side-effects, thus it doesn't reverse the original list, but returns a new, reversed one. This is not so natural in Common Lisp, but expected in Scheme. Nevertheless, here is the doc http://www.lispworks.com/documentation/HyperSpec/Body/f_revers.htm#reverse
What I think you want is (nreverse).
I have an implementation of BFS I got elsewhere and modified slightly, but I am having problems with its input.
It takes a graph, and will take it as '((a b c) (b c) (c d))
But my input I am giving it is a weighted graph... I know it's not useful for the BFS, but I use the weights farther down the line later. This input looks like
'(
(a (b 3) (c 1))
(b (a 3) (d 1))
(c (a 1) (d2) (e 2))
)
And so on.
My code:
(defun shortest-path (start end net)
(BFS end (list (list start)) net))
(defun BFS (end queue net)
(if (null queue)
nil
(expand-queue end (car queue) (cdr queue) net)))
(defun expand-queue (end path queue net)
(let ((node (car path)))
(if (eql node end)
(reverse path)
(BFS end
(append queue
(new-paths path node net))
net))))
(defun new-paths (path node net)
(mapcar #'(lambda (n)
(cons n path))
(cdr (assoc node net))))
I'm just not sure where I need to most likely modify it to accept the new style list, or make a help function to format it correctly?
You need to specify what the list that represents your graph means. Currently you have only given an example list.
When the graph has a syntax like:
graph = (node*)
node = (name nextnodename*)
name = SYMBOL
nextnodename = SYMBOL
Then a transformation function might be:
(defun convert-graph (graph)
(mapcar (lambda (node)
(destructuring-bind (name . nodes) node
(cons name (mapcar #'first nodes))))
graph))
or if you might need other extraction functions:
(defun convert-graph (graph &key (key #'first))
(mapcar (lambda (node)
(destructuring-bind (name . nodes) node
(cons name (mapcar key nodes))))
graph))
Example:
(convert-graph '((a (b 3) (c 1))
(b (a 3) (d 1))
(c (a 1) (d 2) (e 2)))
:key #'first)
((A B C) (B A D) (C A D E))
Now you might need to remove duplicate links. But this depends on the syntax and semantics of your graph description.
Given 2 lists, how can you produce an output of a 3rd list which has its elements as an interleaved set of L1 and L2? If they are uneven length, nil should be inserted for holes. On a second note, how can I reverse a list? I am super new to LISP and simply modifying existing code... I'd really love to have a good explanation, not just code.
First, I guess you use Common Lisp, as it is the one most used in Lisp courses. So, my examples will be in CL. If you use Scheme, you will get almost the same code. If modern Clojure, it will need some changes, through an idea will be the same.
Interleave
To interleave 2 lists you must go through both of them, collecting elements by turns. You can use loop statement or recursion for this. I'll use recursion since it has more functional style and may be used in any lisp, not only CL. Also note, that there's a feature called tail recursion, which lets you write recursive function that will be compiled to a loop.
So, base skeleton for our function will be:
(defun interleave (l1 l2)
??????
(interleave ?????))
To collect items in recursive functions you will need to return them from each call and then cons together (for a tail recursion you must have one more parameter, which will accumulate values). So, the end of the function will be (cons current-value (interleave ????)).
Also you must alternate lists to take elements from with each other. You may have additional parameter, but you also may just swap them in a recursive call. So, code becomes:
(defun interleave (l1 l2)
?????
(cons current-value (interleave l2 l1)))
Any recursion must stop somewhere. In this case, it must stop when both lists are empty (nil).
This is one condition (let give it number 1), and there are some more conditions:
2. if the list to take from is empty, and the other one is not, we must take nil instead.
3. if both lists are not empty, take first element as a current-value and proceed with it's tail.
There's only one more condition that 2 lists can be in: list to take from is not empty, and the second one is. But in fact we don't care about this and may go forward with a rule number 3.
So, the code (and this is the final one):
(defun interleave (l1 l2)
(cond ((and (eql l1 nil) (eql l2 nil)) nil) ;; rule #1
((eql l1 nil) (cons nil (interleave l2 l1))) ;; rule #2, current value is nil
(true (cons (first l1) (interleave l2 (rest l1)))))) ;; rule #3 in all other cases
Reverse
I'll show two implementations of this function: one with cond and another with built-in reduce function which is extremely useful in practice.
First approach for cond version is to go through the all list with a recursive calls and then go back, collecting elements:
(defun reverse-1-1 (li)
(if (eql li nil)
nil
(append (reverse-1-1 (rest li))
(list (first li)))))
But this is extremely inefficient, since append is O(n), and you must pass n elements, so the final complexity is O(n^2).
To reduce it you may use one more argument to the function (and make it tail recursive, if compiler lets you):
(defun reverse-1-2 (li)
(reverse-aux li nil))
(defun reverse-aux (li accumulator)
(if (eql li nil)
accumulator
(reverse-aux (rest li) (cons (first li) accumulator))))
That's you use one more parameter to collect your elements in while passing through the list, and then just return this accumulator.
There's one more interesting option. Lisp has extremely powerful function reduce (in other functional languages it is sometimes called fold, foldr, foldl or something like that). You may find description for it here, and I'll just show an example:
(defun reverse-2 (li)
(reduce #'cons li :from-end t :initial-value nil))
:from-end tells function to go through the the list from the end, and :initial-value tells to use as the very first reduced argument nil.
Note: in some implementations reduce with option :from-end true may first reverse list by itself, so if you need to create it from scratch or use the most efficient version, use reverse-1-2 instead.
In Common Lisp:
(defun merge-lists (lst1 lst2)
(let ((m (max (length lst1) (length lst2))))
(flatten (mapcar (lambda (a b) (list a b))
(append-nulls lst1 m)
(append-nulls lst2 m)))))
Examples:
(merge-lists '(1 2 3 4) '(5 6 7 8)) ;; => (1 5 2 6 3 7 4 8)
(merge-lists '(1 2 3 4) '(5 6 7)) ;; => (1 5 2 6 3 7 4 NULL)
(merge-lists '(1 2) '(5 6 7 8)) ;; => (1 5 2 6 NULL 7 NULL 8)
The helper functions flatten and append-nulls:
(defun flatten (tree)
(let ((result '()))
(labels ((scan (item)
(if (listp item)
(map nil #'scan item)
(push item result))))
(scan tree))
(nreverse result)))
(defun append-nulls (lst n)
(if (< (length lst) n)
(dotimes (i (- n (length lst)))
(setq lst (append lst (list 'null)))))
lst)
The answer above:
(defun interleave (l1 l2)
(cond ((and (eql l1 nil) (eql l2 nil)) nil) ;; rule #1
((eql l1 nil) (cons nil (interleave l2 l1))) ;; rule #2, current value is nil
(true (cons (first l1) (interleave l2 (rest l1)))))) ;; rule #3 in all other cases
If one of your lists is longer than the other, you will get something like (1 2 3 4 nil 5).
Replace:
((eql l1 nil) (cons nil (interleave l2 l1)))
with:
((null l1) l2)
:P
An example of a more idiomatic solution in Common Lisp:
(defun interleave (a b)
(flet ((nil-pad (list on-list)
(append list (make-list (max 0 (- (length on-list) (length list)))))))
(loop for x in (nil-pad a b)
for y in (nil-pad b a)
append (list x y))))