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)))
Related
I'm finishing up a Scheme assignment and I'm having some trouble with the recursive cases for two functions.
The first function is a running-sums function which takes in a list and returns a list of the running sums i.e (summer '(1 2 3)) ---> (1 3 6) Now I believe I'm very close but can't quite figure out how to fix my case. Currently I have
(define (summer L)
(cond ((null? L) '())
((null? (cdr L)) '())
(else (cons (car L) (+ (car L) (cadr L))))))
I know I need to recursively call summer, but I'm confused on how to put the recursive call in there.
Secondly, I'm writing a function which counts the occurrences of an element in a list. This function works fine through using a helper function but it creates duplicate pairs.
(define (counts L)
(cond ((null? L) '())
(else (cons (cons (car L) (countEle L (car L))) (counts (cdr L))))))
(define (countEle L x)
(if (null? L) 0
(if (eq? x (car L)) (+ 1 (countEle (cdr L) x)) (countEle (cdr L) x))))
The expected output is:
(counts '(a b c c b b)) --> '((a 1) (b 3) ( c 2))
But it's currently returning '((a . 1) (b . 3) (c . 2) (c . 1) (b . 2) (b . 1)). So it's close; I'm just not sure how to handle checking if I've already counted the element.
Any help is appreciated, thank you!
To have a running sum, you need in some way to keep track of the last sum. So some procedure should have two arguments: the rest of the list to sum (which may be the whole list) and the sum so far.
(define (running-sum L)
(define (rs l s)
...)
(rs L 0))
For the second procedure you want to do something like
(define (count-elems L)
(define (remove-elem e L) ...)
(define (count-single e L) ...)
(if (null? L)
'()
(let ((this-element (car L)))
(cons (list this-element (count-single this-element L))
(count-elems (remove-elem this-element (cdr L)))))))
Be sure to remove the elements you've counted before continuing! I think you can fill in the rest.
To your first problem:
The mistake in your procedure is, that there is no recursive call of "summer". Have a look at the last line.
(else (cons (car L) (+ (car L) (cadr L))))))
Here is the complete solution:
(define (summer LL)
(define (loop sum LL)
(if (null? LL)
'()
(cons (+ sum (car LL)) (loop (+ sum (car ll)) (cdr LL)))))
(loop 0 LL))
I have a requirement to return the last negative number in a list, using a recursive procedure. Right now I have a recursive procedure that returns all negative numbers in the list.
(define returnLastNeg
(lambda (lst)
(if (null? lst)
'()
(if (positive? (car lst))
(returnLastNeg (cdr lst))
(cons (car lst) (returnLastNeg (cdr lst)))))))
calling it with (returnLastNeg'(1 -2 -3 4 -5 6)) returns
Output:
'(-2 -3 -5)
I need it to only return -5 though. I tried to modify my procedure to check to see if the last element in the list is positive. If it is, I want to remove the last element and then call the procedure again. But when I do that I get an error (below)
Modified procedure:
(define returnLastNeg-modified
(lambda (lst)
(if (null? lst)
'()
(if (positive? (last lst))
(remove (last lst) (lst))
(cons (car lst) (returnLastNeg-modified (cdr lst)))))))
ERROR:
application: not a procedure;
expected a procedure that can be applied to arguments
given: '(1 -2 -3 4 -5 6)
arguments...: [none]
>
A simpler approach would be with a helper procedure (called "sub") in this example:
(define returnLastNeg
(lambda (lst)
(define sub
(lambda (lst last-neg)
(if (null? lst)
last-neg
(let ((c (car lst)))
(sub (cdr lst)
(if (negative? c) c last-neg))))))
(sub lst null)))
EDIT
Knowing that
(define <procedureName> (lambda (<params>) ... )
is the same as
(define (<procedureName> <params>) ... )
and reformatting a little, this becomes:
(define (returnLastNeg lst)
(define (sub lst last-neg)
(if (null? lst)
last-neg
(let ((c (car lst)))
(sub (cdr lst) (if (negative? c) c last-neg)))))
(sub lst null))
I hope it's clearer
last-neg gets set to null by the very last expression
the recursive call to sub has 2 parameters (split on 2 lines in the initial version, but newlines don't matter).
This is the same as the even shorter version
(define (returnLastNeg lst)
(let sub ((lst lst) (last-neg null))
(if (null? lst)
last-neg
(let ((c (car lst)))
(sub (cdr lst) (if (negative? c) c last-neg))))))
using a so-called "named let".
I am trying to reverse a list in Scheme using DrRacket.
Code:
(define rev
(lambda(l)
(if (null? l)
'()
(append (rev (cdr l)) (list (car l))))))
If I input (rev '(a((b)(c d)(((e)))))), the output is (((b) (c d) (((e)))) a).
I want it to be (((((e)))(d c)(b))a). I looked here: How to Reverse a List? but I get an even worse output. What am I doing wrong? Any help would be appreciated!
This is trickier than it looks, you're trying to do a "deep reverse" on a list of lists, not only the elements are reversed, but also the structure … here, try this:
(define (rev l)
(let loop ((lst l)
(acc '()))
(cond ((null? lst) acc)
((not (pair? lst)) lst)
(else (loop (cdr lst)
(cons (rev (car lst))
acc))))))
It works as expected:
(rev '(a ((b) (c d) (((e))))))
=> '(((((e))) (d c) (b)) a)
This code will do it:
(define (rev-list lst)
(if (null? lst)
null
(if (list? lst)
(append (rev-list (cdr lst)
(list (rev-list (car lst))))
lst)))
And the result is:
>>> (display (rev-list '((1 7) 5 (2 4 (5 9))) ))
(((9 5) 4 2) 5 (7 1))
The idea is simple: Return the arg if it's not a list, return rev-list(arg) otherwise.
"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))
how to design a function content which
inputs a single list of atoms lat and which returns
the content of lat.Thus the content of '(a b c a b c d d) is '(a b c d).
The procedure content below should get you what you need.
(define (work x y)
(if (null? (cdr x))
(if (in? (car x) y)
y
(cons (car x) y))
(if (in? (car x) y)
(work (cdr x) y)
(work (cdr x) (cons (car x) y)))))
(define (in? x y)
(if (null? y)
#f
(if (equal? x (car y))
#t
(in? x (cdr y)))))
(define (content x) (work x (list)))
The procedure content accepts a list as a parameter. It sends the list to another procedure called work. This procedure processes the list and adds the items in the list to a new list (if they are not already in the new list). The work procedure makes use of yet another procedure called in, which checks to see if an item is a member of a list.
My solution essentially divides your problem into two sub-problems and makes use of procedures which operate at a lower level of abstraction than your original problem.
Hope that helps.
It is PLT Scheme solution:
(define (is_exists list element)
(cond
[(empty? list) false]
[else
(cond
[(= (first list) element) true]
[else (is_exists (rest list) element)])]))
(define (unique list target)
(cond
[(empty? list) target]
[else
(cond
[(is_exists target (first list)) (unique (rest list) target)]
[else (unique (rest list) (cons (first list) target))])]))
(define (create_unique list)
(unique list empty))
Check it:
> (define my_list (cons '1 (cons '2 (cons '3 (cons '2 (cons '1 empty))))))
> my_list
(list 1 2 3 2 1)
> (create_unique my_list)
(list 3 2 1)
How about little schemer style,
(define (rember-all a lat)
(cond
((null? lat) '())
((eq? a (car lat)) (rember-all a (cdr lat)))
(else (cons (car lat) (rember-all a (cdr lat))))))
(define (content lat)
(cond
((null? lat) '())
(else (cons (car lat)
(content (rember-all (car lat) (cdr lat)))))))
Start from a procedure that simply creates a copy of the passed-in list (very easy to do):
(define (unique-elements seq)
(define (loop ans rest)
(cond ((null? rest) ans)
(else
(loop (cons (car rest) ans)
(cdr rest)))))
(loop '() seq))
To ensure that the output list's elements are unique, we should skip the CONS if the head of REST is already a member of ANS. So we add another condition to do just that:
;;; Create list containing elements of SEQ, discarding duplicates.
(define (unique-elements seq)
(define (loop ans rest)
(cond ((null? rest) ans)
((member (car rest) ans) ; *new*
(loop ans (cdr rest))) ; *new*
(else
(loop (cons (car rest) ans)
(cdr rest)))))
(loop '() seq))
The following function takes in a list and returns a new list with only the unique inputs of it's argument using recursion:
(defun uniq (list)
(labels ((next (lst new)
(if (null lst)
new
(if (member (car lst) new)
(next (cdr lst) new)
(next (cdr lst) (cons (car lst) new))))))
(next list ())))
As was mentioned in the comments, common lisp already has this function:
(defun uniq (list)
(remove-duplicates list))
(define (remove-duplicates aloc)
(cond
((empty? aloc) '())
(else (cons (first aloc)
(remove-duplicates
(filter (lambda (x)
(cond
((eq? x (first aloc)) #f)
(else #t)))
(rest aloc)))))))