I'm trying this in SBCL to flip the dotted pairs in the list:
(mapcar (lambda (x) (let ((num (random 2)))
(if (= num 0)
(psetf (cdr x) (car x) (car x) (cdr x))
x)))
'((B . 21) (O . 24) (P . 15) (R . 47) (K . 49)))
However I get this (ymmv):
(NIL (O . 24) NIL (R . 47) (K . 49))
which tells me psetf is not liking what I'm doing. As I understand, psetf is destructive and returns NIL. What am I not understanding here?
The behavior you observe is correct and expected:
psetf returns nil
and mapcar places the return value
into the return list, so when num is 0, you get there nil,
and when it is 1, you get the original cell.
Easily fixed:
(mapcar (lambda (x)
(when (zerop (random 2))
(psetf (cdr x) (car x) (car x) (cdr x)))
x)
'((B . 21) (O . 24) (P . 15) (R . 47) (K . 49)))
==> ((B . 21) (24 . O) (P . 15) (47 . R) (K . 49))
actually, CL has a macro rotatef
just for your case:
(mapcar (lambda (x)
(when (zerop (random 2))
(rotatef (cdr x) (car x)))
x)
'((B . 21) (O . 24) (P . 15) (R . 47) (K . 49)))
==> ((21 . B) (O . 24) (15 . P) (R . 47) (K . 49))
Finally, please note that modifying quoted data is a very bad idea:
(defparameter *alist-0* '((B . 21) (O . 24) (P . 15) (R . 47) (K . 49)))
(defparameter *alist-1*
(mapcar (lambda (x)
(when (zerop (random 2))
(rotatef (cdr x) (car x)))
x)
*alist-0*))
(eq *alist-0* *alist-1*)
==> nil
(equal *alist-0* *alist-1*)
==> t ; !!!
(every #'eq *alist-0* *alist-1*)
==> t
i.e., the cells are the same, but the lists are different.
It would probably be better to consistently copy all cells:
(defparameter *alist-2*
(mapcar (lambda (x)
(if (zerop (random 2))
(cons (cdr x) (car x))
(cons (car x) (cdr x))))
*alist-0*))
*alist-0*
==> ((B . 21) (O . 24) (P . 15) (R . 47) (K . 49))
*alist-2*
==> ((21 . B) (O . 24) (15 . P) (R . 47) (K . 49))
Often one might want to avoid modifying the cons cells. cons new ones.
CL-USER 76 > (mapcar (lambda (pair)
(if (= (random 2) 0)
(cons (cdr pair)
(car pair))
pair))
'((B . 21) (O . 24) (P . 15) (R . 47) (K . 49)))
((21 . B) (24 . O) (P . 15) (47 . R) (49 . K))
Related
I'm having trouble writing a function that returns a sublist of pairs that satisfy a condition.
Current code:
(define lst1 '((a . 8)(b . 3)(c . 1)(d . 9)(e . 4)))
(define (letter t)
(caar t))
(define (numb p)
(cdar p))
(define (satisfy? c? lst)
(cond
[(or (c? (letter lst)) (c? (numb lst))) #t]
[else #f]))
(define (find-sublist c? lst)
(cond
[(satisfy? c? lst) (cons (car lst) (find-sublist c?(cdr lst)))]
[else (find-sublist c? (cdr lst))]))
Console input:
(find-sublist (lambda(x) (> (numb x) 3)) lst1)
Wanted output:
'((a . 8)(d . 9)(e . 4))
My current input consists of contract violations of either cons or pair
car: contract violation
expected: pair?
given: '()
cdar: contract violation
expected: (cons/c pair? any/c)
given: 'a
There are a couple of issues with your code:
The letter and numb procedures operate on a list element, not on a list, so they should be just car and cdr.
You forgot the base case, what should happen when the list is empty?
Don't put () around lst, it's not a procedure.
And more importantly: your satisfy? procedure attempts to operate on the letter or on the number, but in the lambda you already extracted the number. The solution is just to get rid of this procedure (or alternatively, don't extract the number in the lambda, but then you'll have to test if the lambda's argument is a number before applying the condition.)
This should fix the issues:
(define (letter t)
(car t))
(define (numb p)
(cdr p))
(define (find-sublist c? lst)
(cond
[(null? lst) '()]
[(c? (car lst)) (cons (car lst) (find-sublist c? (cdr lst)))]
[else (find-sublist c? (cdr lst))]))
It works as expected:
(define lst1 '((a . 8) (b . 3) (c . 1) (d . 9) (e . 4)))
(find-sublist (lambda (x) (> (numb x) 3)) lst1)
=> '((a . 8) (d . 9) (e . 4))
FYI you reimplemented the built-in filter procedure. You should use existing procedures whenever possible ;)
(filter (lambda (x) (> (numb x) 3)) lst1)
=> '((a . 8) (d . 9) (e . 4))
This is what my wason-deck produces:
((15 . D) (35 . H) (3 . B) (19 . K) (L . 15) (A . 16) (T . 23) (R . 53)
(N . 13) (M . 7) (I . 52) (35 . Q) (S . 19) (Y . 29) (45 . G) (44 . W)
(11 . V) (J . 25) (21 . F) (39 . Z) (25 . X) (50 . E) (5 . P) (33 . C)
(O . 34))
this being a list of pairs representing a Wason deck. (See this, Example 6). In the deck there should be all the letters of the alphabet matched with even or odd numbers depending on whether a vowel or consonant respectively. I randomly shuffle and flip the cards as you can see. Then I (optionally) randomly pollute the deck by occasionally breaking the vowel:even, consonant:odd rule. Here's the code I've come up with:
(defun wason-deck (&optional (p 0))
"This `consolst` and `vowlist` building is unnecessary, but a good exercise"
(let* ((alphab '(a b c d e f g h i j k l m n o p q r s t u v w x y z))
(consonents '(b c d f g h j k l m n p q r s t v w x y z))
(consolst (remove 'NIL (mapcar (lambda (x) (find x consonents)) alphab)))
(vowlst (remove 'NIL (mapcar (lambda (x) (find x '(a e i o))) alphab)))
(wdeck '()))
(labels ((make-consodeck ()
(mapcar (lambda (x) (let ((num (random 54)))
(cons x (if (evenp num)
(1+ num)
num)))) consolst))
(make-voweldeck ()
(mapcar (lambda (x) (let ((num (random 54)))
(cons x (if (oddp num)
(1+ num)
num)))) vowlst))
(swap (slst el1 el2)
(let ((tmp (elt slst el1)))
(setf (elt slst el1) (elt slst el2))
(setf (elt slst el2) tmp)))
(shuffle (slst)
(loop for i in (reverse (range (length slst) :min 1))
do (let ((j (random (+ i 1))))
(swap slst i j)))
slst)
(flip (flst)
(mapcar (lambda (x) (let ((num (random 2)))
(if (zerop num)
(cons (cdr x) (car x))
x))) flst)))
(setf wdeck (flip (shuffle (append (make-consodeck) (make-voweldeck)))))
(if (zerop p) wdeck
(mapcar (lambda (x) (let ((num (random 6)))
(cond ((and (zerop num) (numberp (car x))) (cons (1+ (car x)) (cdr x)))
((and (zerop num) (numberp (cdr x))) (cons (car x) (1+ (cdr x))))
(t x)))) wdeck)))))
It works, but what I fear is not really knowing what I'm doing, i.e., I've misused labels as well as done a setf in the code. If some of the more senior people could tell me whether this is totally off in the wrong direction or not.
Addendum:
This is what I've got after the suggestions from below:
(defun wason-deck3 (&optional (p 0))
(let* ((consonents '(b c d f g h j k l m n p q r s t v w x y z))
(vowels '(a e i o u))
(conso-deck (mapcar (lambda (x)
(cons x (1+ (* 2 (random 27)))))
consonents))
(vowel-deck (mapcar (lambda (x)
(cons x (* 2 (random 27))))
vowels))
(wdeck '()))
(labels
((shuffle (slst)
(loop :for i :from (1- (length slst)) :downto 1
:do (rotatef (nth i slst)
(nth (random (1+ i)) slst)))
slst)
(flip (flst)
(mapcar (lambda (x) (let ((num (random 2)))
(if (zerop num)
(cons (cdr x) (car x))
x))) flst)))
(setf wdeck (flip (shuffle (append conso-deck vowel-deck)))))
(if (zerop p) wdeck
(mapcar (lambda (x) (let ((num (random 6)))
(cond ((and (zerop num) (numberp (car x))) (cons (1+ (car x)) (cdr x)))
((and (zerop num) (numberp (cdr x))) (cons (car x) (1+ (cdr x))))
(t x)))) wdeck))))
Please add any new suggestions.
Using labels is totally OK, and your code is not entirely unreasonable.
A few pointers:
I'd represent characters as characters: '(#\a #\b #\c …)
I'd take my list exercises elsewhere, or at least use set-difference.
When you create a function for just one call, you might as well just save the result:
(let ((consonant-deck (mapcar (lambda (c)
(cons c (1+ (* 2 (random 27)))))
consonants))
(vowel-deck (mapcar (lambda (c)
(cons c (* 2 (random 27))))
vowels)))
…)
For swapping, there is rotatef: (rotatef (nth i list) (nth j list)). Such things are rather expensive on lists, so I'd prefer to use a vector for this. Then it comes in handy that a string is just a vector of characters…
Loop can do counting for you, you don't need to create lists:
(loop :for i :from (1- (length list)) :downto 1
:do (rotatef (nth i list)
(nth (random (1+ i)) list)))
(Using keywords as loop keywords is optional, but indentation should be like this.)
If you put the labels around the let, you can immediately bind wdeck, so that you do not need to setf it afterwards.
You do not need this function for the exercise that you linked to.
I'm learning Scheme using racket. I made the following program but it gives a contract violation error.
expected: (exact-nonnegative-integer? . -> . any/c)
given: '()
The program finds a list of all numbers in an interval which are divisible by 3 or 5.
#lang racket
;;Global Definitions
(define upper-bound 10)
(define lower-bound 0)
;;set-bounds: Int, Int -> ()
(define (set-bounds m n)
(set! upper-bound (max m n))
(set! lower-bound (min m n)))
;;get-numbers: () -> (Int)
(define (get-numbers)
(build-list upper-bound '()))
;;make-list: Int, (Int) -> (Int)
(define (build-list x y)
(cond
[(= x lower-bound) y]
[(= (modulo x 5) 0) (build-list (sub1 x) (cons x y))]
[(= (modulo x 3) 0) (build-list (sub1 x) (cons x y))]
[else (build-list (sub1 x) y)]))
EDIT: I made the changes suggested by Oscar Lopez.
An alternative method can be with the use of for/list to create the list:
(define (build-list ub lst)
(for/list ((i (range lb ub))
#:when (or (= 0 (modulo i 3))
(= 0 (modulo i 5))))
i))
Usage:
(define lb 0)
(build-list 10 '())
Output:
'(0 3 5 6 9)
Edit:
Actually lst is not needed here:
(define (build-list ub)
(for/list ((i (range lb ub))
#:when (or (= 0 (modulo i 3))
(= 0 (modulo i 5))))
i))
So one can call:
(build-list 10)
Following is a modification of the recursion method (uses 'named let'):
(define (build-list2 ub)
(let loop ((x ub) (lst '()))
(cond
[(= x lb) lst]
[(= (modulo x 5) 0) (loop (sub1 x) (cons x lst))]
[(= (modulo x 3) 0) (loop (sub1 x) (cons x lst))]
[else (loop (sub1 x) lst)])))
Also, if you always have to call your function with an empty list '(), you can put this as default in your argument list:
(build-list x (y '()))
Then you can call with simplified command:
(build-list 10)
You should test first the condition where the recursion stops - namely, when x equals the lower-bound:
(define (build-list x y)
(cond
[(= x lower-bound) y]
[(= (modulo x 5) 0) (build-list (sub1 x) (cons x y))]
[(= (modulo x 3) 0) (build-list (sub1 x) (cons x y))]
[else (build-list (sub1 x) y)]))
I am trying to implement a Scheme procedure which takes a nested list of numbers that may not be well-formed and returns a nested list with the same content and structure, but which does not have any dots when displayed.
Examples:
scm> (reform '((1 . 2) 3))
((1 2) 3)
scm> (reform '(1 (2 3 . 4) . 3))
(1 (2 3 4) 3)
scm> (reform '(1 . ((2 3 . 4) . 3)))
(1 (2 3 4) 3)
My current solution:
(define (reform s)
(cond
((null? s) nil)
((number? s) s)
((null? (cdr s)) (car s))
(else (list (reform (car s)) (reform (cdr s))))
)
)
This solution does remove all the dots, but it doesn't maintain the form of the input. How can I rewrite my implementation so that it doesn't create extra lists which don't exist in the input?
Not sure why #soegaard has so many tests wether the list is a pair when the obvious would be to do the exception first:
(define (dot->proper xs)
(cond ((null? xs) '())
((not (pair? xs)) (list xs))
((pair? (car xs)) (cons (dot->proper (car xs)) (dot->proper (cdr xs))))
(else (cons (car xs) (dot->proper (cdr xs))))))
(dot->proper '((1 . 2) 3)) ; ==> ((1 2) 3)
(dot->proper '(1 (2 3 . 4) . 3)) ; ==> (1 (2 3 4) 3)
(dot->proper '(1 . ((2 3 . 4) . 3))) ; ==> (1 (2 3 4) 3)
This passes the tests.
(define (reform xs)
(cond
[(null? xs) xs]
[(and (pair? xs) (pair? (cdr xs)))
(cons (reform (car xs)) (reform (cdr xs)))]
[(and (pair? xs) (null? (cdr xs)))
(list (reform (car xs)))]
[(pair? xs)
(cons (reform (car xs)) (list (reform (cdr xs))))]
[else xs]))
(reform '((1 . 2) 3))
(reform '(1 (2 3 . 4) . 3))
(reform '(1 . ((2 3 . 4) . 3)))
I have an input which is of this form:
(((lady-in-water . 1.25)
(snake . 1.75)
(run . 2.25)
(just-my-luck . 1.5))
((lady-in-water . 0.8235294117647058)
(snake . 0.5882352941176471)
(just-my-luck . 0.8235294117647058))
((lady-in-water . 0.8888888888888888)
(snake . 1.5555555555555554)
(just-my-luck . 1.3333333333333333)))
(context: the word denotes a movie and the number denotes the weighted rating submitted by the user)
I need to add all the quantity and return a list which looks something like this
((lady-in-water 2.5)
(snake 2.5)
(run 2.25)
(just-myluck 2.6))
How do I traverse the list and all the quantities? I am really stumped. Please help me.
Thanks.
My approach is similar to huaiyuan's above, but I prefer using dolist to loop:
(defun parse-ratings (all-ratings)
(let ((hash (make-hash-table)))
(dolist (rating-list all-ratings)
(dolist (rating rating-list)
(incf (gethash (car rating) hash 0)
(cdr rating))))
(maphash (lambda (key value)
(format t "total for ~a: ~a~%" key value))
hash)))
which results in the following output:
CL-USER> (parse-ratings '(((lady-in-water . 1.25) (snake . 1.75)
(run . 2.25) (just-my-luck . 1.5))
((lady-in-water . 0.8235294117647058)
(snake . 0.5882352941176471)
(just-my-luck . 0.8235294117647058))
((lady-in-water . 0.8888888888888888)
(snake . 1.5555555555555554)
(just-my-luck . 1.3333333333333333))))
total for LADY-IN-WATER: 2.9624183
total for SNAKE: 3.893791
total for RUN: 2.25
total for JUST-MY-LUCK: 3.6568627
NIL
CL-USER>
To avoid the wrong impression that CL is superior in any way, here is a PLT Scheme solution using the hash table approach. I've added a sort of the results for extra credit.
(define (data->movies data)
(define t (make-hasheq))
(for* ([x (in-list data)] [x (in-list x)])
(hash-set! t (car x) (+ (cdr x) (hash-ref t (car x) 0))))
(sort (hash-map t cons) > #:key cdr))
You need to break the problem into two parts: first, transform the list into something like this:
'(((lady-in-water . 1.25) (lady-in-water . 0.82) (lady-in-water . 0.88))
((snake . 1.75) ...)
...)
I'll do that using transpose:
(define (transpose ls)
(if (null? (car ls))
'()
(cons (map car ls) (transpose (map cdr ls)))))
Then it's easy to reduce the transposed movie list to a single list of pairs:
(define (sum-movie movie)
(cons (caar movie) (apply + (map cdr movie))))
(define (sum-movies movies)
(map sum-movie (transpose movies)))
Note that transpose is unsafe: it will crash if you are missing a movie in one sub-list. Also, using transpose in the first place assumes that movies come in the same order each time.
In Common Lisp:
(defun marginalize (data)
(let ((table (make-hash-table)))
(loop for row in data do
(loop for (k . v) in row do
(incf (gethash k table 0.0) v)))
(loop for k being the hash-key of table using (hash-value v)
collect (cons k v))))