how to write a reduce-per-key function in scheme? - dictionary

"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))

Related

Recursion on list of pairs in Scheme

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)))

Lisp Recursion Issue With Stack

I have just hit another bump in the road along my journey with Scheme. It's probably safe to say my table has had enough of me banging my head into it... I have written a function to find the min and max number within a list for class homework. The logic is sound (i think so...) and everything works fine, however, only the value of the first function call is returned from the (define (iterator aList minNum maxNum)). What I am noticing with the debugger is that after every recursion / function call I see (using DrRacket) that function call being pushed to the stack. Once the recursion happens for the last time and the code jumps down to the return of (list minNum maxNum) it doesn't return what it should, as I can see the values are correct, instead I see the function calls coming off the stack one by one until it gets to the very first one. Thus the initial values which would be the first two values form the list are returned instead. I know the stack is FIFO, however, I am not even trying to push anything to the stack. In theory I just want to call the function again and keep passing values back up... Any guidance on this would be much appreciated.
(define (findMinMax aList)
(define (iterator aList minNum maxNum)
(when(not(null? aList))
(cond
((> minNum (car aList))
(set! minNum (car aList)))
((< maxNum (car aList))
(set! maxNum (car aList))))
(iterator (cdr aList) minNum maxNum))
(list minNum maxNum))
(cond ; setting the first two atoms in a list appropriately to the min and max variables.
((< (car aList) (car(cdr aList)))
(iterator (cdr (cdr aList)) (car aList) (car(cdr aList))))
((> (car aList) (car(cdr aList)))
(iterator (cdr (cdr aList)) (car(cdr aList)) (car aList)))
(else
(iterator (cdr (cdr aList)) (car aList) (car(cdr aList))))))
Your sophistication with Scheme is already much better than most on SO! There is a very useful Scheme syntactic keyword 'named-let' that makes it easy to define internal, recursive function definitions. Here is an example to take you to the next level:
(define (findMinMax list)
(assert (not (null? list)))
(let finding ((list (cdr list))
(lMin (car list))
(lMax (car list)))
(if (null? list)
(values lMin lMax)
(finding (cdr list)
(min lMin (car list))
(max lMax (car list))))))
Note also that I've used the values syntactic form to return two values. And, I used builtin functions min and max. Also, the use of finding is tail-recursive meaning that the Scheme compiler converts this recursive call into an iterative call and thus no stack frame is required.
You need to rewrite the code not to use either set! or when since it's holding you back on learning Scheme. You have to think differently when writing in a Lisp dialect than an Algol dialect so try just making the change in the recursion rather than using set! and use 3 way if and just one expression in the body of a procedure.
(define (my-length lst)
(define (length-aux lst n)
(if (null? lst)
n ; base case, return the length
(length-aux (cdr lst) (+ n 1)))) ; instead of set! we put the new value as argument
(length-aux lst 0)) ; one expression that calls the auxiliary procedure to do the calculations
Your internal procedure can be made just as simple:
(define (iterator aList minNum maxNum)
(if (null? <???>)
(list minNum maxNum)
(iterator <???>
(min <???> <???>)
(max <???> <???>))))
Or maybe with if instead of min/max
(define (iterator aList minNum maxNum)
(if (null? <???>)
(list minNum maxNum)
(let ((n (car aList))) ; use n to compare with minNum/maxNum
(iterator <???>
(if <???> <???> <???>)
(if <???> <???> <???>))))
You have some misleading indentation. Indentation step of 1 is really not advisable. 2 is OK but 4 is better while you're learning Scheme.
You actually just need to make some minimal changes, syntax-wise. Instead of
(define (findMinMax aList)
(define (iterator aList minNum maxNum)
(when (not (null? aList))
(cond
((> minNum (car aList)) ; change the local
(set! minNum (car aList))) ; variable's value
((< maxNum (car aList))
(set! maxNum (car aList))))
(iterator (cdr aList) minNum maxNum)) ; pass new values on, but
; ignore recursive result, and
(list minNum maxNum)) ; return the current values instead!
you need:
(define (findMinMax aList)
(define (iterator aList minNum maxNum)
(if (not (null? aList))
(begin
(cond
((> minNum (car aList))
(set! minNum (car aList)))
((< maxNum (car aList))
(set! maxNum (car aList))))
(iterator (cdr aList) minNum maxNum)) ; return recursive result!
(list minNum maxNum))) ; ELSE - base case
the initial call is just:
(iterator (cdr aList) (car aList) (car aList)))
Yes stay away from set! or you won't learn the ropes of the functional aspect of scheme. You can use it if something is otherwise very messy but it's rare that that's the case.
A lot of answers here are expressed in terms of recursion, but often simpler to understand are higher order functions
Both the built-in min and max are defined in some implementations in terms of fold.
(define (min first . L) (fold (lambda (x y) (if (< x y) x y)) first L))
(define (max first . L) (fold (lambda (x y) (if (> x y) x y)) first L))
(define (MinMax first . L)
(define (internal y x)
(let ((min (car x))
(max (cdr x)))
(cons (if (< min y) min y)
(if (> max y) max y))))
(fold internal (cons first first) L))
Notice how much cleaner the code is when you can fit what your doing to a higher order function. Two lines to define the ADT, Two lines to tell fold how to carry along the local state, and one line for the actual procedure.
;;Sample Call
> (minmax 0 9 3 4 7 6 -2)
;Value 4: (-2 . 9)

How to remove a given symbol from a list?

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.

Scheme sum of list

First off, this is homework, but I am simply looking for a hint or pseudocode on how to do this.
I need to sum all the items in the list, using recursion. However, it needs to return the empty set if it encounters something in the list that is not a number. Here is my attempt:
(DEFINE sum-list
(LAMBDA (lst)
(IF (OR (NULL? lst) (NOT (NUMBER? (CAR lst))))
'()
(+
(CAR lst)
(sum-list (CDR lst))
)
)
)
)
This fails because it can't add the empty set to something else. Normally I would just return 0 if its not a number and keep processing the list.
I suggest you use and return an accumulator for storing the sum; if you find a non-number while traversing the list you can return the empty list immediately, otherwise the recursion continues until the list is exhausted.
Something along these lines (fill in the blanks!):
(define sum-list
(lambda (lst acc)
(cond ((null? lst) ???)
((not (number? (car lst))) ???)
(else (sum-list (cdr lst) ???)))))
(sum-list '(1 2 3 4 5) 0)
> 15
(sum-list '(1 2 x 4 5) 0)
> ()
I'd go for this:
(define (mysum lst)
(let loop ((lst lst) (accum 0))
(cond
((empty? lst) accum)
((not (number? (car lst))) '())
(else (loop (cdr lst) (+ accum (car lst)))))))
Your issue is that you need to use cond, not if - there are three possible branches that you need to consider. The first is if you run into a non-number, the second is when you run into the end of the list, and the third is when you need to recurse to the next element of the list. The first issue is that you are combining the non-number case and the empty-list case, which need to return different values. The recursive case is mostly correct, but you will have to check the return value, since the recursive call can return an empty list.
Because I'm not smart enough to figure out how to do this in one function, let's be painfully explicit:
#lang racket
; This checks the entire list for numericness
(define is-numeric-list?
(lambda (lst)
(cond
((null? lst) true)
((not (number? (car lst))) false)
(else (is-numeric-list? (cdr lst))))))
; This naively sums the list, and will fail if there are problems
(define sum-list-naive
(lambda (lst)
(cond
((null? lst) 0)
(else (+ (car lst) (sum-list-naive (cdr lst)))))))
; This is a smarter sum-list that first checks numericness, and then
; calls the naive version. Note that this is inefficient, because the
; entire list is traversed twice: once for the check, and a second time
; for the sum. Oscar's accumulator version is better!
(define sum-list
(lambda (lst)
(cond
((is-numeric-list? lst) (sum-list-naive lst))
(else '()))))
(is-numeric-list? '(1 2 3 4 5))
(is-numeric-list? '(1 2 x 4 5))
(sum-list '(1 2 3 4 5))
(sum-list '(1 2 x 4 5))
Output:
Welcome to DrRacket, version 5.2 [3m].
Language: racket; memory limit: 128 MB.
#t
#f
15
'()
>
I suspect your homework is expecting something more academic though.
Try making a "is-any-nonnumeric" function (using recursion); then you just (or (is-any-numeric list) (sum list)) tomfoolery.

Scheme Recursively going through a List

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))))

Resources