Given two lists composed by several "objects" in the following format: (name id) how can I get the objects from the first list that do not match by name the second one?
Expected output:
(remove-duplicates-by-name
'((Oliver 1) (Charlie 2) (Oscar 20))
'((Oliver 2)(Charlie 3)))
((Oscar 20))
(remove-duplicates-by-name
'((Oliver 1))
'((Oliver 2)(Charlie 3)))
()
(remove-duplicates-by-name
'()
'((Oliver 2)(Charlie 3)))
()
Edit:
Output order matters. Example:
(remove-duplicates-by-name
'((Oliver 1) (Charlie 2) (Oscar 20) (Daniel 30))
'((Oliver 2)(Charlie 3)))
Correct output: ((Oscar 20)(Daniel 30))
Incorrect output: ((Daniel 30)(Oscar 20))
Here are two hacky solutions.
(defun remove-duplicates-by-name (l to-remove)
;; low performance with large to-remove lists but fine with short
;; ones
(loop for e in l
unless (assoc (car e) to-remove)
collect e))
(defun remove-duplicates-by-name (l to-remove)
;; high performance with large to-remove lists but consy and
;; probably slow with short ones
(loop with dups = (loop with dt = (make-hash-table)
for e in to-remove
do (setf (gethash (car e) dt) t)
finally (return dt))
for e in l
unless (gethash (car e) dups)
collect e))
Your examples have nothing to do with duplicates, but everything to do
with Lists as Sets.
E.g.:
(set-difference '((Oliver 1) (Charlie 2) (Oscar 20)) '((Oliver 2)(Charlie 3)) :key #'car)
==> ((Oscar 20))
(set-difference '((Oliver 1)) '((Oliver 2)(Charlie 3)) :key #'car)
==> ()
(set-difference '() '((Oliver 2)(Charlie 3)) :key #'car)
==> ()
Related
hey so im trying to make a function in lisp which takes in three parameters, a list of runners, a name and a medal type. The list of runners looks like the following:
((bolt ((gold 4)(silver 2)))
(farah ((gold 3)(silver 1)(bronze 1)))
(ottey ((bronze 3))))
I'm trying to update the type and number of medals each runner has e.g. if I wanted bolt to have 4 gold medals then I could use this function to update the list accordingly. I am very new to lisp and I am struggling to do this, I've tried looping through the list using dolist() but I'm struggling with the logic behind it. how would I go about doing this ?
(defun update (type name list)
(setf medal (get-runner(name *runner)) )
(if ((assoc ‘medal medals) != nil) ;
(setf count (assoc ‘medal medals)+1)
(new-list (assoc ‘medal medals) count)
So, first of all let's call these lists of ((key value) ...) mlists (for 'medal list' if you like): they are in fact association lists (alists), but association lists are normally of the form ((key . value) ...), so I wanted another name.
Let's write a general function update-mlist to update an mlist. It will:
stop if there is nothing left to do;
otherwise, if the first element of the mlist is the one it is looking for, call its updater function on the value of that element and return a new mlist;
otherwise return a new mlist with the existing first element, and the rest of the mlist updated.
Here it is:
(defun update-mlist (mlist key updater)
;; update an mlist, replacing the element with key KEY by calling
;; UPDATER on its value. An mlist is of the form ((key value) ...).
(cond
((null mlist)
;; no more to process: we're done
'())
((eql (first (first mlist)) key)
;; found it: call the updater on the value and return the new
;; mlist
(cons (list (first (first mlist))
(funcall updater (second (first mlist))))
(rest mlist)))
(t
;; didn't find it: search the rest
(cons (first mlist)
(update-mlist (rest mlist) key updater)))))
And we can try this:
> (update-mlist '((able 1) (baker 2) (charlie 2))
'charlie
(lambda (v)
(+ v 1)))
((able 1) (baker 2) (charlie 3))
OK.
So, now, let's stash the medal list in a variable so we can talk about it:
(defvar *medals* '((bolt ((gold 4)
(silver 2)))
(farah ((gold 3)
(silver 1)
(bronze 1)))
(ottey ((bronze 3)))))
What's interesting about *medals* is that its an mlist, of which the values of each element is an mlist. So the thing we're going to want to do is to use update-mlist where the updater function itself calls update-mlist to update the medal list. OK, well, we can write that:
(defun update-medals (medals person medal updater)
;; update the medal mlist for PERSON, calling UPDATER on the value
;; of the MEDAL medal
(update-mlist medals person
(lambda (medal-mlist)
(update-mlist medal-mlist
medal
updater))))
And that's it. Let's say that farah has just won a gold medal: we want to bump their gold count by 1:
> (update-medals *medals* 'farah 'gold
(lambda (count)
(+ count 1)))
((bolt ((gold 4) (silver 2)))
(farah ((gold 4) (silver 1) (bronze 1)))
(ottey ((bronze 3))))
But we have a little problem:
> (update-medals *medals* 'ottey 'gold
(lambda (count)
(+ count 1)))
((bolt ((gold 4) (silver 2)))
(farah ((gold 3) (silver 1) (bronze 1)))
(ottey ((bronze 3))))
Oh dear.
So, well, we can solve this: let's change update-mlist so that, if it ever gets to the end of the mlist, it provides a fallback:
(defun update-mlist (mlist key updater fallback)
;; update an mlist, replacing the element with key KEY by calling
;; UPDATER on its value. An mlist is of the form ((key value) ...).
;; If we reach the end of the list add an entry for KEY with FALLBACK
(cond
((null mlist)
;; no more to process: add the fallback
(list (list key fallback)))
((eql (first (first mlist)) key)
;; found it: call the updater on the value and return the new
;; mlist
(cons (list (first (first mlist))
(funcall updater (second (first mlist))))
(rest mlist)))
(t
;; didn't find it: search the rest
(cons (first mlist)
(update-mlist (rest mlist) key updater fallback)))))
And we can test this:
> (update-mlist '((able 1) (baker 2) (charlie 3))
'zebra
(lambda (v)
(+ v 1))
26)
((able 1) (baker 2) (charlie 3) (zebra 26))
And we need to change update-medals correspondingly:
(defun update-medals (medals person medal updater fallback)
;; update the medal mlist for PERSON, calling UPDATER on the value
;; of the MEDAL medal. If there is no entry add a fallback. If
;; there is no entry for the person add a fallback as well
(update-mlist medals person
(lambda (medal-mlist)
(update-mlist medal-mlist
medal
updater
fallback))
(list medal fallback)))
And this works:
> (update-medals *medals* 'ottey 'gold
(lambda (count)
(+ count 1))
1)
((bolt ((gold 4) (silver 2)))
(farah ((gold 3) (silver 1) (bronze 1)))
(ottey ((bronze 3) (gold 1))))
> (update-medals *medals* 'hercules 'gold
(lambda (count)
(+ count 100))
100)
((bolt ((gold 4) (silver 2)))
(farah ((gold 3) (silver 1) (bronze 1)))
(ottey ((bronze 3)))
(hercules (gold 100)))
OK, finally we can wrap this all in an award-medal function:
(defun award-medal (medals person medal &optional (number 1))
(update-medals medals person medal
(lambda (c)
(+ c number))
number))
And now
> (award-medal *medals* 'bolt 'gold)
((bolt ((gold 5) (silver 2)))
(farah ((gold 3) (silver 1) (bronze 1)))
(ottey ((bronze 3))))
> (award-medal *medals* 'ottey 'gold)
((bolt ((gold 4) (silver 2)))
(farah ((gold 3) (silver 1) (bronze 1)))
(ottey ((bronze 3) (gold 1))))
> (award-medal *medals* 'hercules 'diamond 10000)
((bolt ((gold 4) (silver 2)))
(farah ((gold 3) (silver 1) (bronze 1)))
(ottey ((bronze 3)))
(hercules (diamond 10000)))
Something you may have noticed is that each time I call one of these functions it is as if it's the first time: that's because they're functions they have arguments and return values, and the values they return are new structures: they don't destructively modify their arguments. This means both that they are much easier to reason about and understand, as they are what's called referentially transparent, and they can be composed easily and safely:
> (award-medal (award-medal *medals* 'bolt 'gold)
'ottey 'silver)
((bolt ((gold 5) (silver 2)))
(farah ((gold 3) (silver 1) (bronze 1)))
(ottey ((bronze 3) (silver 1))))
Well, we can writ a little function that does this, too:
(defun award-medals (medals award-mlist)
(if (null award-mlist)
medals
(award-medals (award-medal medals
(first (first award-mlist))
(second (first award-mlist)))
(rest award-mlist))))
And now
> (award-medals *medals*
'((bolt gold) (ottey silver) (farah bronze)))
((bolt ((gold 5) (silver 2)))
(farah ((gold 3) (silver 1) (bronze 2)))
(ottey ((bronze 3) (silver 1))))
Two final things:
what's 'wrong' with update-mlist (both versions). What happens if you have really a huge lot of people in your mlist?
could you write a version of award-medals which didn't really care about the whole medal-awarding thing, and which would just do this trick for any function whatsoever? Would that be useful?
(define (lst-double-helper lst acc)
(if (empty? list)
acc
(lst-double-helper (rest lst) (cons (* (first lst) 2) acc))))
(define (lst-double lst)
(lst-double-helper lst '()))
I feel I'm doing it in the right way. But this gives me an error
(lst-double '(1,2,3))
*: contract violation
expected: number?
given: ',2
argument position: 1st
other arguments...:
Why do it expect the second argument to be a number?
A couple of comments:
List elements are separated by spaces, not commas. That's the error being reported.
The base case of the recursion must refer to the parameter lst, not to list.
Your tail-recursive solution reverses the list, an extra reverse is needed at the end to restore the original order
With the above changes in place, it works as expected:
(define (lst-double-helper lst acc)
(if (empty? lst) ; parameter is called `lst`
acc
(lst-double-helper (rest lst) (cons (* (first lst) 2) acc))))
(define (lst-double lst)
(reverse ; required to restore original order
(lst-double-helper lst '())))
(lst-double '(1 2 3)) ; use spaces to separate elements
=> '(2 4 6)
Be aware that a tail-recursive solution that traverses an input list and conses its elements to build an output list, will necessarily reverse the order of the elements in the input list. This is ok, and it's normal to do a reverse at the end. Possible alternatives to avoid reversing the elements at the end would be to reverse the input list at the beginning or to write a non-tail-recusive solution.
One such way is by using continuation-passing style. Here we add a parameter named return which effectively encodes a return-like behavior with a lambda. double now takes two arguments: the list to double, xs, and the continuation of the result, return –
(define (double xs return)
(if (empty? xs)
(return empty)
(double (cdr xs)
(lambda (result)
(return (cons (* 2 (car xs))
result))))))
As an example, the result of double applied to a list of '(1 2 3) is sent to print
(double '(1 2 3) print)
;; '(2 4 6)
;; => #<void>
double evaluates to whatever the final continuation evaluates to; in this case, print evaluates to #<void>. We can use the identity function to effectively get the value out –
(double '(1 2 3) identity)
;; => '(2 4 6)
Racket allows you to easily specify default arguments, so we can modify double to use identity as the default continuation
(define (double xs (return identity))
;; ...
)
This style results in convenient programs that work in two call styles at simultaneously: continuation-passing style –
(double '(10 11 12) print)
;; '(20 22 24)
;; => #<void>
(double '(10 11 12) length)
;; => 3
(double '(10 11 12) car)
;; => 20
(double '(10 11 12) cdr)
;; => '(22 24)
... or in direct style, using the default identity continuation
(print (double '(10 11 12)))
;; '(20 22 24)
(length (double '(10 11 12)))
;; => 3
(car (double '(10 11 12)))
;; => 20
(cdr (double '(10 11 12)))
;; => '(22 24)
use map.
(map (lambda (a) (* a 2)) '(1 2 3))
For nested lists:
(define (atom? x)
(and (not (null? x))
(not (pair? x))))
(define (lst-double-helper lst acc)
(cond ((empty? lst) acc)
((atom? (car lst)) (lst-double-helper (rest lst) (cons (* (first lst) 2) acc)))
(else (lst-double-helper (rest lst) (cons (lst-double (first lst))
acc) ))))
(define (lst-double lst)
(reverse ; required to restore original order
(lst-double-helper lst '())))
but actually to make this function tail-recursive is a little bit meaningless,
because as #simmone mentioned, map would do it
(define (list-doubler lst)
(map (lambda (x) (* 2 x)) lst))
(list-doubler '(1 2 3))
;; '(2 4 6)
Greets,
Summary
having trouble passing '(+) or '(-) as data to a cond (non evaluated). On their own, they return (+) or (-) which, as an argument returns the identity element (0).
HELP!
Background.
For the non standard scheme in the code.
In this book;
sentences are flat lists and
words are sybmols and strings.
There are three higher order functions/procedures in simply.scm, part of the library to illustrate the topic, every, keep and accumulate;
(every function data) [do this function to every element of data]
(keep predicate? data) [keep the elements of data that pass predicate? test]
(accumulate function data) [collect all data into the form of function — combine with keep to remove invalid data]
eg (accumulate + (keep number? data)) [remove non numbers then add the remaining numbers together, zero if no numbers found]
Data Flow.
Exercise 8.11 is a gpa calculator procedure. By instruction, no lambda or recursion allowed (not yet taught if read sequentially).
The first implementation I tried takes multiple grades in a single sentence and outputs individual sentences, each with a single grade. It then passes this output to a helper procedure.
If the single grade output has a + or - it is separated, for example '(a+) into '(a) and '(+) and all output is then passed to a further helper procedure.
then a cond allocates scores
a 4
b 3
c 2
d 1
e 0
+ 0.33
- -0.33
This, only worked in my head (why don't computers work like minds?) When a grade like '(a+) or '(a-) is seperated, the '(a) is processed properly but the '(+) or '(-) evaluate to the identity element (0) and fail to add to the gpa.
Is there a way to make '(+) and '(-) passable as data instead of as an expression? Alternatively, can I convert them to some arbitrary data usable in the cond before they return (0)?
The current version, a lengthy cond for each grade, works, but is hideous. Makes the implementation feel like imperative instead of functional programming.
Code.
returns the wrong gpa (doesn't add 0.33 or -0.33):
also, input type check in (gpa-helper) failed spectacularly.
(define (gpa gradesset)
(/ (accumulate + (every gpa-helper gradesset)) (count gradesset)) )
(define (gpa-helper gradewrd)
(cond ((or (< (count gradewrd) 1) (> (count gradewrd) 2)) '(Please use valid grade input))
((= (count gradewrd) 1) (gpa-allocator (keep valid-grade? gradewrd)))
((= (count gradewrd) 2) (every gpa-helper (keep valid-grade? gradewrd)))
(else '(Please check that all grades entered are valid)) ) )
(define (gpa-allocator gradeletter+-)
(cond ((equal? gradeletter+- 'a) 4)
((equal? gradeletter+- 'b) 3)
((equal? gradeletter+- 'c) 2)
((equal? gradeletter+- 'd) 1)
((equal? gradeletter+- 'e) 0)
((equal? gradeletter+- +) .33)
((equal? gradeletter+- -) (- .33))
(else 0) ) )
(define (valid-grade? gradein)
(if (member? gradein '(+ - a+ a a- b+ b b- c+ c c- d+ d d- e)) #t #f) )
redone version that returns a sentence of the individual scores. The 0 returned by '(+) and '(-) is visible here. Implements successful input type checking but introduces new problems. (accumulate + ing the result for one)
(define (gpa gradesset)
(every gpa-cleaner gradesset) )
(define (gpa-cleaner gradewrd)
(cond ((or (< (count gradewrd) 1) (> (count gradewrd) 2)) 0)
(else (every gpa-accumulator gradewrd)) ) )
(define (gpa-accumulator gradewrd)
(/ (accumulate + (every gpa-helper gradewrd)) (count gradewrd)) )
(define (gpa-helper gradewrd)
(cond ((= (count gradewrd) 1) (gpa-allocator (keep valid-grade? gradewrd)))
((= (count gradewrd) 2) (every gpa-helper (keep valid-grade? gradewrd)))
(else '(Please check that all grades entered are valid)) ) )
(define (gpa-allocator gradeletter+-)
(cond ((equal? gradeletter+- 'a) 4)
((equal? gradeletter+- 'b) 3)
((equal? gradeletter+- 'c) 2)
((equal? gradeletter+- 'd) 1)
((equal? gradeletter+- 'e) 0)
((equal? gradeletter+- +) .33)
((equal? gradeletter+- -) (- .33))
(else 0) ) )
(define (valid-grade? gradein)
(if (member? gradein '(+ - a b c d e)) #t #f) )
Using SCM version 5e7 with Slib 3b3, the additional libraries supplied with Simply Scheme (link provided under background above — simply.scm, functions.scm, ttt.scm, match.scm, database.scm) and the library where I input my answers for every exercise loaded.
If you need to pass + or - as a symbol (not as a procedure), you have to quote it first:
'+
'-
For example:
((equal? gradeletter+- '+) .33)
((equal? gradeletter+- '-) -.33)
But from the context, I don't think the gpa-allocator procedure is correct. A grade can be a or a+, the conditions imply that + or - are actual grades, which is wrong.
Maybe you should represent grades as strings and check (using string-ref) the first character in the string to determine if it's #\a, #\b, #\c, #\d, #\e and (if the string's length is greater than 1) test if the second character in the string is either #\+ or #\-. Then you can determine the appropriate value of the grade by adding the two values. Alternatively, you could pass the grade as a symbol and convert it to string. This is what I mean:
(define (gpa-allocator gradeletter+-)
(let ((grade (symbol->string gradeletter+-)))
(+ (case (string-ref grade 0)
((#\a #\A) 4)
((#\b #\B) 3)
((#\c #\C) 2)
((#\d #\D) 1)
((#\e #\E) 0)
(else 0))
(if (> (string-length grade) 1)
(case (string-ref grade 1)
((#\+) 0.33)
((#\-) -0.33)
(else 0))
0))))
Don't forget to test it:
(gpa-allocator 'A)
=> 4.0
(gpa-allocator 'A+)
=> 4.33
(gpa-allocator 'A-)
=> 3.67
Oscar is right about what's wrong, but his solution uses functions not used within the simply scheme book.
Here;s my solution from when I went through that chapter in that book
(define (gpa l-grades);;letter grades
(/ (accumulate + (every grade-value-mapper l-grades))
(count l-grades)
) )
(define (grade-value-mapper l-grade)
(let ((grade (first l-grade))
(g-mod (lambda (x)
(cond ((equal? '+ (bf l-grade))
(+ 1/3 x))
((equal? '- (bf l-grade))
(- 1/3 x))
(else x)
)) ) )
(cond ((equal? (first grade) 'a) (g-mod 4))
((equal? (first grade) 'b) (g-mod 3))
((equal? (first grade) 'c) (g-mod 2))
((equal? (first grade) 'd) (g-mod 1))
(else 0)
) ) )
Not my best work but hope it helps. The gmod you could pull out into it's own define. You would call it like so
((gmod l-grade) 4)
Or pull out more abraction
((gmod l-grade) (letter-value (first l-grade)))
I don't think the (let ... (grade ...) ...) is really doing much good. what's passed to grade-value-mapper is a single grade.
You could add the input cleaner/checker into the function grade-value-mapper as the first cond clause.
I have a macro called compare-and-swap!:
(define-macro (compare-and-swap! l x y)
`(if (> (vector-ref ,l ,x) (vector-ref ,l ,y))
(vector-swap! ,l ,x ,y)))
It works, I'm testing it like this:
(define v (list->vector '(5 4 3 2 1)))
(print v)
(compare-and-swap! v 1 2)
(print v)
I have a function that returns a list of pairs that I can call compare-and-swap! on serially to sort the whole list:
(batcher 8) → ((0 1) (2 3) (0 2) (1 3) (1 2) (4 5) (6 7) (4 6) (5 7) (5 6) (0 4) (2 6) (2 4) (1 5) (3 7) (3 5) (1 2) (3 4) (5 6))
Now I wish to create a macro that generates a lambda that sorts an N element list by calling batcher and doing the compare-and-swap! for each pair.
For example,
(generate-sorter 8)
→
(lambda (l) (begin (compare-and-swap! l 0 1) (compare-and-swap! l 2 3) ...))
→
(lambda (l) (begin (if (> (vector-ref l 0) (vector-ref l 1)) (vector-swap! 0 1)) (if (> (vector-ref l 2) (vector-ref l 3)) (vector-swap! 2 3))) ... )
I made a function that generates the necessary code:
(define generate-sorter (lambda (len)
(list 'lambda '( li ) 'begin (map (lambda (pair) (list 'compare-and-swap! 'li (first pair) (second pair))) (batcher len)))
))
But I don't now how to make it into a macro.
You don't need a macro for this and, in particular, for the 'generate' part. I suspect that you were thinking macro because the result of generate-sorter can vary from call to call and you hoped to encode the result through macro expansion. An alternative is to capture the result in the lexical environment as such:
(define-syntax compare-and-swap!
(syntax-rules ()
((_ l x y)
(when (> (vector-ref l x) (vector-ref l y))
(vector-swap! l x y)))))
(define (generate-sorter n)
(let ((sorters (generate-sorter n)))
(lambda (l)
(for-each (lambda (sorter)
(compare-and-swap! l (car sorter) (card sorter)))
sorters))))
(define sorter-8 (generate-sorter 8))
(sorter-8 <l-thingy>)
-> <sorted-l-thingy>
I am not too proficient with functional style and I don't want to use any set functions, so I have a problem. I am really struggling whether I should do recursively or in a different manner.
I have a collection of pairs in a list, like so:
((4 2) (3 1) (3 2) (2 4) etc...)
In this pair '(4 2), the second element '2' tells me which other pairs it matches to, in this case '(3 2).
So, I add these two pairs together using their first element, in this case, it's '4' and '3'.
The new pair is now '(7 2). And so on for other pairs in the list too.
Finally, it should return:
((7 2) (3 1) (2 4))
I would care less about the order.
.
I already have a working function that add two different pairs. The only assumption with this function is that the pairs are matching.
Consequently, what I want to do is manipulated this list of pairs to return a list in these manners.
Examples:
take the list ((4 2) (3 1) (3 2) (2 4))
matching-pairs: '(4 2) and '(3 2)
and then return --> ((7 2) (3 1) (2 4))
take the list ((2 1) (3 2) (1 2) (5 1) (6 3))
matching-pairs: '(2 1) and '(5 1)
'(3 2) and '(1 2)
and then return --> ((7 1) (4 2) (6 3))
Thank you for your time and efforts.
Iterate over your list and store each pair's car into a list in an assoc that looks like this:
original: ((2 . 1) (3 . 2) (1 . 2) (5 . 1) (6 . 3))
new: ((1 . (2 5))
(2 . (3 1))
(3 . (6))
Then sum together all the cdrs and flip each pair to get this:
((7 . 1) (4 . 2) (6 . 3))
(defun get-pairs (alist index)
(cond
(alist
(if (= (nth 1 (car alist)) index)
(append (list (caar alist)) (get-pairs (cdr alist) index))
(get-pairs (cdr alist) index)))
((not alist)
'nil)))
(defun get-iterator (alist)
(labels
((f (alist res)
(cond
(alist
(if (member (nth 1 (car alist)) res)
(f (cdr alist) res)
(f (cdr alist) (append (cdar alist) res))))
((not alist)
res))))
(f alist 'nil)))
(defun get-value (alist)
(loop for i in (get-iterator alist)
collect (get-pairs alist i)))
(defun list-sum (alist)
(loop for i in (get-value alist)
collect (apply #'+ i)))
(defun match-value (alist)
(loop for i in (get-iterator alist)
for j in (list-sum alist)
collect (append (list j) (list i))))
(defparameter *my-list* '((2 1) (3 1) (4 2) (5 2) (8 1) (9 2) (1 3) (0 3)))
(print (match-value *my-list*))
Sorry for the messy code but that should do the trick if I understood the problem right.