I'm trying to find a way to assign a list to a local variable, and then add that list to a symbol to make a new list, an improper list. Example below is to illustrate this:
Input: '?e1 ((?e1 ?e0) (?e1 ?ex) (?e1 ?ey) (?e1 ?e2))
Expected output: (?e1 (?e0 ?ex ?ey ?e2))
The idea is that compare (car graph) in all nested list with ?e1, add them together to form a list, assign the list to a variable, finally (list '?e1 (new list))
But actually the recursion make my code fail .....
I have try to write a program, but the output from this is quite ridiculous:
(define agrv '((?e1 ?e0) (?e1 ?ex) (?e1 ?ey) (?e1 ?e2)))
(define successor
(lambda (node graph)
(if (equal? node (car graph))
(cdr graph)
'())))
(define (find-dst node graph)
(if (null? graph)
'()
(let ((custom-list (append (list (successor node (car graph))) (find-dst node (cdr graph)))))
(list node custom-list))))
(find-dst '?e1 agrv)
output is: '(?e1 ((?e0) ?e1 ((?ex) ?e1 ((?ey) ?e1 ((?e2))))))
Can someone please explain where I get wrong??? Thank you very much!!
You might want to get more acquainted with the fundamental Scheme procedures, since your procedure could simply be expressed as follows:
(define (find-dst node graph)
(cons node
(list
(map cadr
(filter (lambda (e) (eq? node (car e))) graph)))))
I would rewrite your example as follows:
(define (find-dst node graph)
(define (sub graph)
(if (null? graph)
null
(let ((e (car graph)))
(if (eq? node (car e))
(cons (cadr e) (sub (cdr graph)))
(sub (cdr graph))))))
(cons node (list (sub graph))))
(find-dst '?e1 '((?e1 ?e0) (?e1 ?ex) (?e1 ?ey) (?e1 ?e2)))
=> '(?e1 (?e0 ?ex ?ey ?e2))
EDIT
Regarding the additional question in your comment, if I understood it correctly, you could do something which is close:
(define (find-dst2 node graph)
(let ((r (find-dst node graph)))
(cons node
(map (lambda (e) (find-dst e graph)) (cadr r)))))
(find-dst2 '?e1 '((?e1 ?e0) (?e0 ?ex) (?e0 ?ey) (?e1 ?e2)))
=> '(?e1 (?e0 (?ex ?ey)) (?e2 ()))
Related
I have tried many times but I still stuck in this problem, here is my input:
(define *graph*
'((a . 2) (b . 2) (c . 1) (e . 1) (f . 1)))
and I want the output to be like this: ((2 a b) (1 c e f))
Here is my code:
(define group-by-degree
(lambda (out-degree)
(if (null? (car (cdr out-degree)))
'done
(if (equal? (cdr (car out-degree)) (cdr (car (cdr out-degree))))
(list (cdr (car out-degree)) (append (car (car out-degree))))
(group-by-degree (cdr out-degree))))))
Can you please show me what I have done wrong cos the output of my code is (2 a). Then I think the idea of my code is correct.
Please help!!!
A very nice and elegant way to solve this problem, would be to use hash tables to keep track of the pairs found in the list. In this way we only need a single pass over the input list:
(define (group-by-degree lst)
(hash->list
(foldl (lambda (key ht)
(hash-update
ht
(cdr key)
(lambda (x) (cons (car key) x))
'()))
'#hash()
lst)))
The result will appear in a different order than the one shown in the question, but nevertheless it's correct:
(group-by-degree *graph*)
=> '((1 f e c) (2 b a))
If the order in the output list is a problem try this instead, it's less efficient than the previous answer, but the output will be identical to the one in the question:
(define (group-by-degree lst)
(reverse
(hash->list
(foldr (lambda (key ht)
(hash-update
ht
(cdr key)
(lambda (x) (cons (car key) x))
'()))
'#hash()
lst))))
(group-by-degree *graph*)
=> '((2 a b) (1 c e f))
I don't know why the lambda is necessary; you can directly define a function with (define (function arg1 arg2 ...) ...)
That aside, however, to put it briefly, the problen is that the cars and cdrs are messed up. I couldn't find a way to tweak your solution to work, but here is a working implementation:
; appends first element of pair into a sublist whose first element
; matches the second of the pair
(define (my-append new lst) ; new is a pair
(if (null? lst)
(list (list (cdr new) (car new)))
(if (equal? (car (car lst)) (cdr new))
(list (append (car lst) (list (car new))))
(append (list (car lst)) (my-append new (cdr lst)))
)
)
)
; parses through a list of pairs and appends them into the list
; according to my-append
(define (my-combine ind)
(if (null? ind)
'()
(my-append (car ind) (my-combine (cdr ind))))
)
; just a wrapper for my-combine, which evaluates the list backwards
; this sets the order right
(define (group-by-degree out-degree)
(my-combine (reverse out-degree)))
I am trying to remove a given symbol from a list.
Here is the code i wrote:
(define member?
(lambda (in-sym in-seq)
(if (and (symbol? in-sym) (sequence? in-seq))
(if (null? in-seq)
'()
(append
(if (equal? in-sym (car in-seq)) '() (list (car in-seq)))
(member? in-sym (cdr in-seq)))))))
It turns out that i remove all occurences of the given symbol although i want to remove only the first occurence. Can somebody help me with this?
You can use a built-in procedure for this, check if your interpreter provides remove:
(remove 'b '(a b b c b))
=> '(a b c b)
Now, if you intend to implement the functionality yourself, I advice you to split the problem in two parts: one procedure that checks if the procedure can be executed (if inSymbol is a symbol and inSeq is a sequence), and the other, remove-member that performs the actual removal of data:
(define member?
(lambda (inSym inSeq)
(if (and (symbol? inSym) (sequence? inSeq)) ; can remove?
(remove-member inSym inSeq) ; then remove!
'can-not-remove))) ; otherwise, present an error message
(define remove-member
(lambda (inSym inSeq)
(cond ((null? inSeq)
'())
((equal? (car inSeq) inSym)
(cdr inSeq))
(else
(cons (car inSeq)
(remove-member inSym (cdr inSeq)))))))
Your problem is that you append to ( member? inSym ( cdr inSeq)) whether you found the symbol or not. What you want to do is this:
(define member?
(lambda (inSym inSeq)
(if (and (symbol? inSym) (sequence? inSeq))
(if (null? inSeq) '()
(if (equal? inSym (car inSeq)) (cdr inSeq)
(append (list (car inSec)) (member? inSym (cdr inSeq)))
)
)
)
)
)
I.e. if you found the symbol, just return (cdr inSeq) instead because you are done.
"define a procedure 'reduce-per-key' which a procedure reducef and a list of associations in which each key is paired with a list. The output is a list of the same structure except that each key is now associated with the result of applying reducef to its associated list"
I've already written 'map-per-key' and 'group-by-key' :
(define (map-per-key mapf lls)
(cond
[(null? lls) '()]
[else (append (mapf (car lls))(map-per-key mapf (cdr lls)))]))
(define (addval kv lls)
(cond
[(null? lls) (list (list (car kv)(cdr kv)))]
[(eq? (caar lls) (car kv))
(cons (list (car kv) (cons (cadr kv) (cadar lls)))(cdr lls))]
[else (cons (car lls)(addval kv (cdr lls)))]))
(define (group-by-key lls)
(cond
[(null? lls) '()]
[else (addval (car lls) (group-by-key (cdr lls)))]))
how would I write the next step, 'reduce-per-key' ? I'm also having trouble determining if it calls for two arguments or three.
so far, I've come up with:
(define (reduce-per-key reducef lls)
(let loop ((val (car lls))
(lls (cdr lls)))
(if (null? lls) val
(loop (reducef val (car lls)) (cdr lls)))))
however, with a test case such as:
(reduce-per-key
(lambda (kv) (list (car kv) (length (cadr kv))))
(group-by-key
(map-per-key (lambda (kv) (list kv kv kv)) xs)))
I receive an incorrect argument count, but when I try to write it with three arguments, I also receive this error. Anyone know what I'm doing wrong?
Your solution is a lot more complicated than it needs to be, and has several errors. In fact, the correct answer is simple enough to make unnecessary the definition of new helper procedures. Try working on this skeleton of a solution, just fill-in the blanks:
(define (reduce-per-key reducef lls)
(if (null? lls) ; If the association list is empty, we're done
<???> ; and we can return the empty list.
(cons (cons <???> ; Otherwise, build a new association with the same key
<???>) ; and the result of mapping `reducef` on the key's value
(reduce-per-key <???> <???>)))) ; pass reducef, advance the recursion
Remember that there's a built-in procedure for mapping a function over a list. Test it like this:
(reduce-per-key (lambda (x) (* x x))
'((x 1 2) (y 3) (z 4 5 6)))
> '((x 1 4) (y 9) (z 16 25 36))
Notice that each association is composed of a key (the car part) and a list as its value (the cdr part). For example:
(define an-association '(x 3 6 9))
(car an-association)
> 'x ; the key
(cdr an-association)
> '(3 6 9) ; the value, it's a list
As a final thought, the name reduce-per-key is a bit misleading, map-per-key would be a lot more appropriate as this procedure can be easily expressed using map ... but that's left as an exercise for the reader.
UPDATE:
Now that you've found a solution, I can suggest a more concise alternative using map:
(define (reduce-per-key reducef lls)
(map (lambda (e) (cons (car e) (map reducef (cdr e))))
lls))
So I have a function that replaces an element of a list with the corespondent element in a list o pairs for example if i have this : (i have a list) and ((have not) (list queue)) it will return (i not a queue)
(define replacecoresp
(lambda (ls a-list)
(map (lambda (x)
(let ((lookup (assq x a-list)))
(if lookup
(cadr lookup)
x)))
ls)))
unfortunately it doesn't work for a list of lists of lists etc what I want is to do this :
if I have a list (i have ( a list) of (list ( list and list ))) and ((list queue) (have not)) the result should be (I not (a queue) of (queue (queue and queue))) I hope you got the idea :) thanks a lot!
Try this:
(define (replacecoresp ls a-list)
(cond ((null? ls) '())
((not (list? ls))
(cond ((assq ls a-list) => cadr)
(else ls)))
(else (cons (replacecoresp (car ls) a-list)
(replacecoresp (cdr ls) a-list)))))
It works as expected:
(replacecoresp '(I have (a list) of (list (list and list)))
'((list queue) (have not)))
> (I not (a queue) of (queue (queue and queue)))
Explanation: When traversing a list of lists (say, ls) you need to consider three cases:
ls is empty, return the empty list
ls is an atom not a list, process the element
ls is a list, invoke the recursion on both the car and the cdr
of the list and combine the results
In the particular case of your question, cons is used in the third step for combining the solution; and the second case is the part where we check to see if the current symbol is in the association list, replacing it if it was found or leaving the symbol untouched if not. I used a shortcut for writing less code in this step, but you can replace the inner cond with this snippet of code if it's clearer:
(let ((lookup (assq ls a-list)))
(if lookup
(cadr lookup)
ls))
Another way to express the solution is to use a map on the list like this:
(define(replacecoresp ls a-list)
(if (not (list? ls))
(cond ((assq ls a-list) => cadr)
(else ls))
(map (lambda (l) (replacecoresp l a-list)) ls)))
Just trying to get back into the swing of scheme again, because everyone loves recursion.. (mhhmnmm.)
anyways trying to return #t or #f to determine whether all elements in a list are unique.
Comparing 1st element and 2nd element no problem. It's recursively continuing..
(define (unique ls)
(if (null? ls) #t
(equal? (car ls)(car(cdr ls)))))
I'll write a different, simpler function that demonstrates looping. Hopefully between that and what you have, you'll get there. :-)
(define (member x lst)
(cond ((null? lst) #f)
((equal? x (car lst)) lst)
(else (member x (cdr lst)))))
Another example:
(define (assoc x alist)
(cond ((null? alist) #f)
((equal? x (caar alist)) (car alist))
(else (assoc x (cdr alist)))))
Well your (equal?) invocation is incomplete. If the head and head-of-the-tail are equal, then the value of "unique" is false. If they're not equal, then you'd return the value of unique as applied to the tail (cdr) of the list.
(It's implicit in your proto-implementation that you're checking a pre-sorted list. If not, then that's another step to take.)
(use srfi-1)
(define (unique? ls) (eq? (length ls) (length (delete-duplicates ls))))