I am new to Scheme and today I came across the following problem that I couldn't solve. I have the following representation for the nodes of a tree representing a file system:
(directory_name content) for directories
file_name for files
(directory_name null) for an empty directory
For example, ("etc/" (("network/" ("interfaces")))) is the tree for path etc/network/interfaces.
What I have to do is to write a function that takes as arguments this kind of tree and a directory/file name and returns the path to it, if there is one. If the directory/file doesn't exist, it returns #f.
For example:
(define tree '("/"
(("etc/" ("network/" ("interfaces")))
("root/" null))))
Supposing the function's name is get-path, by running (get-path tree "interfaces") it will output "/etc/network/interfaces".
All I want is an idea, if you can give me one, I will be grateful.
Here is an answer for you. I used symbols not strings for directory/files and slightly changed the tree format.
(define tree '(root (etc (passwd) (profile)) (usr (bin) (lib))))
(define (get-path tree name)
(define (reverse-if l) (and l (reverse l)))
(reverse-if
(let descending ((tree tree) (path '()))
(and (not (null? tree))
(let ((root (car tree))
(subs (cdr tree)))
(if (eq? root name)
(cons root path)
(let looking ((subs subs))
(and (not (null? subs))
(or (descending (car subs) (cons root path))
(looking (cdr subs)))))))))))
With some results:
> (get-path tree 'etc)
(root etc)
> (get-path tree 'bin)
(root usr bin)
> (get-path tree 'profile)
(root etc profile)
> (get-path tree 'foo)
#f
>
Related
Let a NODE be a function with a STORE in its closure. All leafs of the graph have a STORE that is a single value (either a constant or a variable) and all internal nodes have a STORE that is a list containing:
A symbol representing a function ('+ '* 'cos 'sin etc)
A list of one or more NODES representing the children of this NODE.
A simplification function (which is irrelevant for my question).
Assume [[(NODE f)]] = [[(f STORE)]] if f is a procedure and STORE is the STORE in NODE'S closure.
I am trying to find a way to traverse this tree and print an expression that can be evaluated with (eval). I have come close but I just cannot get it to work.
Here is my code:
(define repr
(lambda(store)
(if (is_leaf? store)
store
(list (car store)
(repr_helper (cadr store) repr)))))
(define repr_helper
(lambda(f_list arg)
(cond ((null? f_list) '())
(else (cons ((car f_list) arg) (repr_helper (cdr f_list) arg))))))
Simple exemple: Assume a tree with a single addition of 4 arguments (creates a + node with 4 children all of which are leaves).
((Add 10 'x 'y 'z) repr)
Output: '(+ (10 x y z)).
Expected output: '(+ 10 x y z)
As you can see the problem comes from the extra parenthesis inside the expression. You can imagine this is even worse for more complex examples. I understand where I create the list and why the parenthesis is there, but I can't seem to find a way to remove it, print the values correctly.
Try modifying the part that builds the list, like this:
(define repr
(lambda (store)
(if (is_leaf? store)
store
(cons (car store)
(repr_helper (cadr store) repr)))))
We just need to add a new item at the head of the list returned by repr_helper, a call to cons will do the trick.
I have a structure:
(defstruct spider omegas values continuation)
and I have functions that take in this structure and return a mutated version of it:
(defun dec (s)
(make-spider
:omegas (spider-omegas s)
:values (cons (- (car (spider-values s)) 1) (cdr (spider-values s)))
:continuation (cdr (spider-continuation s))))
And I have a hunch that this is creating new instances of spider in memory that don't need to be there (google has been no help). I care that what I'm returning is its own block of memory but I don't care about the spider that is the argument s by the time I'm done with the function. Is there a smoother way to return structures like this?
If you just want to mutate the argument structure object:
(defun dec (s)
(decf (first (spider-values s))) ; mutates the list of values
(pop (spider-continuation s))
s)
I'm trying to write a delete! function that mutates a list and removes from it a specified value. This is the code I have so far.
(define (extend! l . xs)
(if (null? (cdr l))
(set-cdr! l xs)
(apply extend! (cdr l) xs)))
(define (delete! lis y)
(define returnLis '())
(for-each (lambda(x) (if(not(eq? x y))
(extend! returnLis x))) lis)
returnLis)
The problem I am having is that I am trying to add to an empty list which can't be done in Scheme.
Desired outcome:
(delete! '(1 2 3 4 5) 3)
=> (1 2 4 5)
Your extend function use actually would make a copy of each element in a fresh pair, but since the initial value is '() it cannot be set-cdr!. The whole point of mutating something is that old variables will continue point to the changed data and making a copy won't do that.
You need to see the pairs. You want to remove 3
[1,-]->[2,-]->[3,-]->[4,-]->[5,-]->()
So When you have found 3, you need to change the cdr of the pair that holds 2 and pint it the pair that holds 3s cdr like this:
[1,-]->[2,-]->[4,-]->[5,-]->()
Something like this then:
(define (delete lst e)
(if (and (not (null? lst)) (not (null? (cdr lst))))
(if (equal? (cadr lst) e)
(set-cdr! lst (cddr lst))
(delete (cdr lst) e))
'undefined))
(define test (list 1 2 3 4 5))
(delete lst 3)
lst ; ==> (1 2 4 5)
Notice I'm using list since a quoted literal cannot be used here since you are not allowed to change constant data like '(1 2 3 4 5). The result will be undefined or it will signal an error.
It won't work if the element in question is the first. It's because the variable points to the first pair and this only changes the pointers in pairs, not bindings. One could just switch the two first and delete the second, but in the event you have a one element list you are still stuck. Scheme implementations of mutable queues usually have a head consisting of a dummy element not considered part of the list to delete the first element.
All you need is a head-sentinel technique:
(define (delete! lis y)
(define returnLis (list 1))
(for-each (lambda(x) (if(not(eq? x y))
(extend! returnLis x))) lis)
(cdr returnLis))
Well, not all... because as it is, this is a quadratic algorithm. It re-searches the returnLis from top anew while adding each new element with extend!. Better just maintain the last cdr cell and update it:
(define (delete! lis y)
(define returnLis (list 1))
(define last-cell returnLis)
(for-each (lambda(x) (cond ((not(eq? x y))
; (extend! last-cell x)
(set-cdr! last-cell (list x))
(set! last-cell (cdr last-cell)))))
lis)
(cdr returnLis))
But, as #Sylwester points out, with this approach you shouldn't use an exclamation mark in the name, as this will return a freshly built list instead of mutating the argument's structure.
I am wondering how the substitution model can be used to show certain things about infinite streams. For example, say you have a stream that puts n in the nth spot and so on inductively. I define it below:
(define all-ints
(lambda ((n <integer>))
(stream-cons n (all-ints (+ 1 n)))))
(define integers (all-ints 1))
It is pretty clear that this does what it is supposed to, but how would someone go about proving it? I decided to use induction. Specifically, induction on k where
(last (stream-to-list integers k))
provides the last value of the first k values of the stream provided, in this case integers. I define stream-to-list below:
(define stream-to-list
(lambda ((s <stream>) (n <integer>))
(cond ((or (zero? n) (stream-empty? s)) '())
(else (cons (stream-first s)
(stream-to-list (stream-rest s) (- n 1)))))))
What I'd like to prove, specifically, is the property that k = (last (stream-to-list integers k)) for all k > 1.
Getting the base case is fairly easy and I can do that, but how would I go about showing the "inductive case" as thoroughly as possible? Since computing the item in the k+1th spot requires that the previous k items also be computed, I don't know how this could be shown. Could someone give me some hints?
In particular, if someone could explain how, exactly, streams are interpreted using the substitution model, I'd really appreciate it. I know they have to be different from the other constructs a regular student would have learned before streams, because they delay computation and I feel like that means they can't be evaluated completely. In turn this would man, I think, the substitution model's apply eval apply etc pattern would not be followed.
stream-cons is a special form. It equalent to wrapping both arguments in lambdas, making them thunks. like this:
(stream-cons n (all-ints (+ 1 n))) ; ==>
(cons (lambda () n) (lambda () (all-ints (+ n 1))))
These procedures are made with the lexical scopes so here n is the initial value while when forcing the tail would call all-ints again in a new lexical scope giving a new n that is then captured in the the next stream-cons. The procedures steam-first and stream-rest are something like this:
(define (stream-first s)
(if (null? (car s))
'()
((car s))))
(define (stream-rest s)
(if (null? (cdr s))
'()
((cdr s))))
Now all of this are half truths. The fact is they are not functional since they mutates (memoize) the value so the same value is not computed twice, but this is not a problem for the substitution model since side effects are off limits anyway. To get a feel for how it's really done see the SICP wizards in action. Notice that the original streams only delayed the tail while modern stream libraries delay both head and tail.
Let's say I have two lisp lists that are the same but in different sequence: '(A B C) and '(C B A).
How can I check if they are the same (in the sense that the elements are the same)?
CL-USER> (equal '(a b c) '(c b a))
NIL
Like this:
(not (set-exclusive-or '(a b c) '(c b a)))
which returns T if the two sets are equal, NIL otherwise.
[Edit] If they are not truly sets then you could use this:
(not (set-exclusive-or
(remove-duplicates '(a b c))
(remove-duplicates '(c b a))))
If the lists are not sets and repeated items are important, one could use a function like this:
(defun same-elements-p (a b)
(loop (when (and (null a) (null b))
(return t))
(when (or (null a) (null b))
(return nil))
(setf b (remove (pop a) b :count 1))))
If both lists are empty, they are the same. We remove all items of one list from the other and see what happens. Note the :count 1 argument to REMOVE. It makes sure than only one item is removed.
We can define the functions perm-equal and perm-equalp which are similar to EQUAL and EQUALP except that if the arguments are lists, then their permutation doesn't matter. The list (1 1 2 3) is perm-equal to (2 1 3 1), but not to (2 3 1).
The implementation works by normalizing values into a canonical permutation by sorting. This brings up the ugly spectre of requiring an inequality comparison. However, we can hide that by providing a predefined one which works for numbers, symbols and strings. (Why doesn't the sort function do something like this, the way eql is defaulted as the :key parameter?)
(defun less (a b)
(if (realp a)
(< a b)
(string< a b)))
(defun lessp (a b)
(if (realp a)
(< a b)
(string-lessp a b)))
(defun perm-equal (a b &optional (pred #'less))
(if (or (atom a) (atom b))
(equal a b)
(let ((as (sort (copy-list a) pred))
(bs (sort (copy-list b) pred)))
(equal as bs))))
(defun perm-equalp (a b &optional (pred #'lessp))
(if (or (atom a) (atom b))
(equalp a b)
(let ((as (sort (copy-list a) pred))
(bs (sort (copy-list b) pred)))
(equalp as bs))))
Notes:
Doesn't handle improper lists: it just tries to sort them and it's game over.
Even though equalp compares vectors, perm-equalp doesn't extend its permutation-squashing logic over vectors.
realp is used to test for numbers because complex numbers satisfy numberp, yet cannot be compared with <.
The trivial answer for non-sets is to sort both lists. CL's default sort is destructive, so you'll need copies if you want to keep them afterwards.
(defun sorted (a-list predicate)
(sort (copy-list a-list) predicate))
(defun same-list-p (list-a list-b predicate)
(equalp (sorted list-a predicate) (sorted list-b predicate)))
It doesn't have the best performance, but is simple and functional.
This looks to me like an O(n) variant:
(defun equal-elementwise (a b &key (test #'eq))
(loop with hash = (make-hash-table :test test)
for i on a for j on b do
(let ((i (car i)) (j (car j)))
(unless (funcall test i j)
(setf (gethash i hash) (1+ (gethash i hash 0))
(gethash j hash) (1- (gethash j hash 0)))))
finally (return
(unless (or (cdr i) (cdr j))
(loop for value being the hash-value of hash do
(unless (zerop value) (return))
finally (return t))))))
However, this won't be efficient on short lists.