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.
Related
I am trying to make deep-reverse function in lisp. For example:
(a (b c d) e) -> (e (d c b) a)
Here is my code.
(defun deeprev (l)
(cond ((null l) nil)
((list (car l)) (append (deeprev (cdr l)) (deeprev (car l))))
(t (append (deeprev (cdr l))(car l)))
)
)
Whenever I compile and load, I have an error:
Error: Attempt to take the car of E which is not listp
The easiest option would be to just REVERSE the current list, and use MAPCAR to reverse all sublist with the same function.
(defun tree-reverse (tree)
"Deep reverse TREE if it's a list. If it's an atom, return as is."
(if (listp tree)
(mapcar #'tree-reverse
(reverse tree))
tree))
(tree-reverse '(a (b c d) e)) ;=> (E (D C B) A)
In your function, you assume that if the l input variable is not nil, then it is necessarily a cons-cell, because you unconditionally takes (car l) inside the (list ...) function. That's why you have an error. There are many other things that are not nil which could be bound to l at this point, like numbers or symbols.
By the way, (list ...) just builds a list, you would need to use listp instead. Since you ruled out the nil case and a list is defined as either nil or a cons, you could have used also consp.
I would like to ask you for help with the following:
When I apply a procedure number-of-elements on the list, I need to get a list of pairs, where on the first place in the pair is the element and on the second place (after the dot) there is a number of elements occurred in the list.
For example, when typing this:
(number-of-elements '((a b c) a (b c) c (a b b)))
I got this:
((a . 3) (b . 4) (c . 3))
So far I have a code working on regular list (a b a d).
(define number-of-elements
(lambda (lst)
(define exclude
(lambda (sznm key)
(foldr (lambda (ass result)
(if (equal? (car ass) key)
result
(cons ass result)))
'()
sznm)))
(foldr (lambda (key bag)
(cond ((assoc key bag)
=> (lambda (old)
(let ((new (cons key (+ (cdr old) 1))))
(cons new (exclude bag key)))))
(else (let ((new (cons key 1)))
(cons new bag)))))
'()
lst)))
But if I use it on:
(number-of-elements '((a b c) a (b c) c (a b b)))
I got this:
(((a b c) . 1) (a . 1) ((b c) . 1) (c . 1) ((a b b) . 1))
I know I need to use a deep recursion, but I do not know, how to implement it into the code I actually have.
You already did most of the work counting the elements - but see the different implementations of bagify for a simpler implementation. One straightforward solution for dealing with nested sublists would be to flatten the input list before counting the elements:
(number-of-elements
(flatten
'((a b c) a (b c) c (a b b))))
=> '((a . 3) (b . 4) (c . 3))
If your interpreter doesn't define flatten, it's easy to implement:
(define (flatten lst)
(if (not (list? lst))
(list lst)
(apply append (map flatten lst))))
This is the idiomatic way to think about solutions in Scheme: decompose the problem in parts, then use built-in procedures to solve each subpart, and finally combine them.
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)))
;; ...
))
Structure Definition:
(define-struct movie (title genre stars))
;; title is a nonempty string
;; genre is a nonempty string
;; stars us a list of nonempty strings
I am trying to write a scheme function that consumes a list of movies and produces the genre that occurs most often.
So far, I have the following:
(define (popular-gnere movies)
(local
[(define acc movies genre)
(cond
[(empty? movies) genre]
[(equal? genre (movie-genre (first movies)))
(acc (rest movies genre)))
I'm stuck as to how I can keep count of how many times a specific genre has appeared in a given list of movies.
I understand that accumulated recursion in this case would be most efficient but am having trouble completing my accumulator.
Why don't you fix your parentheses problem and indent the code properly. Press CRTL+i. Where the identation is wrong you probably have missing parentheses. Press Run to evaluate and you'd get proper error messages. When you have something that doesn't produce errors, update this question.
The answer your question you add more parameters to your local procedures than the global. That way you hae a parameter that can hold a count that you increase when you find the search element in the current element.eg.
(define (length lst)
(define (length-aux lst cnt)
(if (null? lst)
cnt
(length-aux (cdr lst) (add1 cnt))))
(length-aux lst 0))
Or better with named let
(define (length lst)
(let length-aux ((lst lst) (cnt 0))
(if (null? lst)
cnt
(length-aux (cdr lst) (add1 cnt)))))
EDIT
I recommend having at least 4 helper procedures that takes each their part of a problem. (Less if you make use racket's own remove, count, and argmax). Note that there are probably many other ways to solve this but this is how I would have solved it without a hash table.
Since you are only interested in genre the first thing to imagine is that you can do (map movie-genre lst) so that you get a list of genres to work with in your main helper.
In your main helper you can build up a list of cons having genre and count. To do that you use a helper count that (count 'c '(a b c d c c a) 0) ==> 3 and you just take the first genre and count the list for those as the first accumulated value, then process the result of (remove 'c '(a b c d c c a) '()) ==> (a d b a) on the rest of the list.
When processing is done you have in your accumulator ((a . 4) (b . 6) ...) and you need a helper (max-genre 'a 4 '((b . 6) (c . 20) (d . 10))) ; ==> c
The main helper would look something like this:
(define (aux lst acc)
(if (null? lst)
(max-genre (caar acc) (cdar acc) (cdr acc))
(aux (remove (car lst) lst '())
(cons (cons (car lst) (count (car lst) lst 0)) acc))))
Now you could do it a lot simpler with a hash table in one pass. You'd still have to have max-genre/argmax after reading all elements once.
First you need to settle on a key-value datatype. You could use association lists, but hash tables are a more efficient choice.
Let's start with a short list:
(define-struct movie (title genre stars))
(define films
(list
(make-movie "Godfater" "Crime" '("Marlon Brando" "Al Pacino"))
(make-movie "Rambo" "Thriller" '("Sylvester Stallone"))
(make-movie "Silence of the Lambs" "Crime" '("Jodie Foster" "Anthony Hopkins"))))
and create an empty hash table
(define h (make-hash))
Now we process every film, updating the hash table as we go:
> (for-each (lambda (e) (hash-update! h e add1 0)) (map movie-genre films))
> h
'#hash(("Thriller" . 1) ("Crime" . 2))
Now we need to find the highest count:
> (hash-values h)
'(1 2)
> (define most (foldl (lambda (e r) (if (> e r) e r)) 0 (hash-values h)))
> most
2
So 2 is our highest count. Now we create a list of all genres with count 2:
> (hash->list h)
'(("Thriller" . 1) ("Crime" . 2))
> (foldl
(lambda (e r) (if (= (cdr e) most) (cons (car e) r) r))
null
(hash->list h))
'("Crime")
Putting it all together:
(define (count-by-genre lst)
(define h (make-hash))
(for-each (lambda (e) (hash-update! h e add1 0)) (map movie-genre lst))
(define most (foldl (lambda (e r) (if (> e r) e r)) 0 (hash-values h)))
(foldl
(lambda (e r) (if (= (cdr e) most) (cons (car e) r) r))
null
(hash->list h)))
But this is quite inefficient, for several reasons:
after updating the hash table, we have to re-iterate over it, create a list and then apply foldl just to find the highest value, whereas we could have just kept note of it while updating the hash table
then again we create a full list (hash->list) and a final result list using foldl.
Lots of consing and stuff. An alternative, more efficient version using Racket-specific for constructs, could be:
(define (count-by-genre lst)
(define h (make-hash))
(define most
(for/fold ((highest 0)) ((e (in-list (map movie-genre lst))))
(define new (add1 (hash-ref h e 0)))
(hash-set! h e new)
(max highest new)))
(for/fold ((res null)) (((k v) (in-hash h)))
(if (= v most) (cons k res) res)))
I need to find all nodes that are children of selected node. Graph is created like this:
(setq graf1 '((A(B C)) (B(D E)) (C (F G )) (D (H)) (E(I)) (F(J)) (G(J)) (H()) (I(J)) (J())))
So, all children from node B are (on first level) D,E, on 2nd H,I, third J.
Here's the code for finding first level children, but as i'm begineer in lisp i cant make it work for other ones.
(defun sledG (cvor graf obradjeni)
(cond ((null graf) '())
((equal (caar graf) cvor)
(dodaj (cadar graf) obradjeni))
(t(sledG cvor (cdr graf) obradjeni)))
(defun dodaj (potomci obradjeni)
(cond ((null potomci) '())
((member (car potomci) obradjeni)
(dodaj (cdr potomci) obradjeni )
(t(cons (car potomci)
(dodaj (cdr potomci) obradjeni) ))))
(setq graf1 '((A(B C)) (B(D E)) (C (F G )) (D (H)) (E(I)) (F(J)) (G(J)) (H()) (I(J)) (J())))
Using alexandria package:
(defvar *graf*
'((a (b c)) (b (d e)) (c (f g)) (d (h)) (e (i)) (f (j)) (g (j)) (h nil) (i (j)) (j nil)))
(defun descendants (tree label)
(let ((generation
(mapcan #'cadr
(remove-if-not
(alexandria:compose (alexandria:curry #'eql label) #'car)
tree))))
(append generation (mapcan (alexandria:curry #'descendants tree) generation))))
;; (D E H I J)
I believe, this is what you wanted to do. This will work for acyclic graphs, but it will recur "forever", if you have a cycle in it. If you wanted to add depth counter, you could add it as one more argument to descendants or in the last mapcan transform the resulting list by inserting the depth counter.
With depth included:
(defun descendants (tree label)
(labels ((%descendants (depth label)
(let ((generation
(mapcan #'cadr
(remove-if-not
(alexandria:compose
(alexandria:curry #'eql label) #'car)
tree))))
(append (mapcar (alexandria:compose
#'nreverse
(alexandria:curry #'list depth))
generation)
(mapcan (alexandria:curry #'%descendants (1+ depth))
generation)))))
(%descendants 0 label)))
;; ((D 0) (E 0) (H 1) (I 1) (J 2))
As I read it, the graph is a directed graph. So to find the children (directed edges) of the graph (in the example),
(defun children (node graph) (second (assoc node graph)))
then
(children 'b graf1) ; with graf1 from the OP
returns (D E). All you have to do then is to loop over the children, something like (very quick and dirty)
(defun all-children (node graph)
(let ((c (children node graph)))
(if (null c) nil
(union c (loop for x in c appending (all-children x graph))))))
This returns (J I H D E) as children of B.