I'm completely new to scheme and I'm having trouble trying to add 2 lists of different sizes. I was wondering how do I add 2 lists of different sizes together correctly. In my code I compared the values and append '(0) to the shorter list so that they can get equal sizes, but even after doing that I can not use map to add the 2 lists. I get an error code after running the program. The results I should be getting is '(2 4 5 4). Could anyone help me out? Thanks.
#lang racket
(define (add lst1 lst2)
(cond [(< (length lst1) (length lst2)) (cons (append lst1 '(0)))]
[else lst1])
(cond
((and (null? lst1)(null? lst2)) null)
(else
(map + lst1 lst2))))
;;Result should be '(2 4 6 4)
(add '(1 2 3) '(1 2 3 4))
ERROR:
cons: arity mismatch;
the expected number of arguments does not match the given number
expected: 2
given: 1
arguments...:
'(1 2 3 0)
The problem with your code is that there are two cond expressions one after the other - both will execute, but only the result of the second one will be returned - in other words, the code is not doing what you think it's doing. Now, to solve this problem it'll be easier if we split the solution in two parts (in general, that's a good strategy!). Try this:
(define (fill-zeroes lst n)
(append lst (make-list (abs n) 0)))
(define (add lst1 lst2)
(let ((diff (- (length lst1) (length lst2))))
(cond [(< diff 0)
(map + (fill-zeroes lst1 diff) lst2)]
[(> diff 0)
(map + lst1 (fill-zeroes lst2 diff))]
[else (map + lst1 lst2)])))
Explanation:
The fill-zeroes procedure takes care of filling the tail of a list with a given number of zeroes
The add procedure is in charge of determining which list needs to be filled, and when both lists have the right size performs the actual addition
It works as expected for any combination of list lengths:
(add '(1 2 3 4) '(1 2 3))
=> '(2 4 6 4)
(add '(1 2 3) '(1 2 3 4))
=> '(2 4 6 4)
(add '(1 2 3 0) '(1 2 3 4))
=> '(2 4 6 4)
Similar to Oscar's, slighty shorter:
(define (fill0 lst len)
(append lst (make-list (- len (length lst)) 0)))
(define (add lst1 lst2)
(let ((maxlen (max (length lst1) (length lst2))))
(map + (fill0 lst1 maxlen) (fill0 lst2 maxlen))))
or, for fun, the other way round:
(define (add lst1 lst2)
(let ((minlen (min (length lst1) (length lst2))))
(append
(map + (take lst1 minlen) (take lst2 minlen))
(drop lst1 minlen)
(drop lst2 minlen))))
There's no need to pre-compute the lengths of the lists and add zeroes to the end of one or the other of the lists. Here we solve the problem with a simple recursion:
(define (add xs ys)
(cond ((and (pair? xs) (pair? ys))
(cons (+ (car xs) (car ys)) (add (cdr xs) (cdr ys))))
((pair? xs) (cons (car xs) (add (cdr xs) ys)))
((pair? ys) (cons (car ys) (add xs (cdr ys))))
(else '())))
That works for all of Oscar's tests:
> (add '(1 2 3 4) '(1 2 3))
(2 4 6 4)
> (add '(1 2 3) '(1 2 3 4))
(2 4 6 4)
> (add '(1 2 3 0) '(1 2 3 4))
(2 4 6 4)
If you like, you can write that using a named-let and get the same results:
(define (add xs ys)
(let loop ((xs xs) (ys ys) (zs '()))
(cond ((and (pair? xs) (pair? ys))
(loop (cdr xs) (cdr ys) (cons (+ (car xs) (car ys)) zs)))
((pair? xs) (loop (cdr xs) ys (cons (car xs) zs)))
((pair? ys) (loop xs (cdr ys) (cons (car ys) zs)))
(else (reverse zs)))))
Have fun!
A yet simpler version.
(define (add x y)
(cond ((and (pair? x) (pair? y))
(cons (+ (car x) (car y))
(add (cdr x) (cdr y))))
((pair? x) x)
(else y)))
Related
I am encountering a issue that I need to add up the second number of each list. For example, suppose I have a list of lists like below,
(list (list -4
(list (list -1 4) (list 1 7)))
(list 1 (list (list -2 5) (list 3 3)))
(list 3 12))
Then my job is to add up 4 + 7 + 5 + 3 + 12 = 31. However, the list can have multiple sub lists. But the second item inside a list can either be a number or a list. If it is a list, then we need to dig deeper into this list until we get a number.
Thanks!
Solution
(define (atom? x)
(and (not (null? x))
(not (pair? x))))
(define (my-and x y)
(and x y))
(define (every? l)
(foldr my-and #t l))
(define (flat-list? l)
(cond ((null? l) #t)
((every? (map atom? l)) #t)
(else #f)))
(define (add-only-seconds l)
(define (l-sec-add l acc)
(cond ((null? l) acc)
((atom? l) acc)
((flat-list? l) (+ (second l) acc))
((list? l) (apply + acc (map (lambda (x) (l-sec-add x 0)) l)))))
(l-sec-add l 0))
Example test
(define example-list (list (list -4
(list (list -1 4) (list 1 7)))
(list 1 (list (list -2 5) (list 3 3)))
(list 3 12)))
(add-only-seconds example-list) ;; 31
I used common-lisp-typical functions atom? and every?.
Since and cannot be used in foldr, I defined my-add to make add a function which can be used infoldr`.
I'm working on sorting a list of lists by their first element for example
(sort (list '(2 1 6 7) '(4 3 1 2 4 5) '(1 1))))
expected output => ('(1 1) '(2 1 6 7) '(4 3 1 2 4 5))
The algorithm I used is bubble sort. And I modified it to deal with lists. However, the code doesn't compile. The error is
mcar: contract violation
expected: mpair?
given: 4
Can someone correct my code and explain it. Thank you
(define (bubble L)
(if (null? (cdr L))
L
(if (< (car (car L)) (car (cadr L)))
(list (car L)
(bubble (car (cdr L))))
(list (cadr L)
(bubble (cons (car (car L)) (car (cddr L))))))))
(define (bubble-sort N L)
(cond ((= N 1) (bubble L))
(else
(bubble-sort (- N 1) (bubble L)))))
(define (bubble-set-up L)
(bubble-sort (length L) L))
(define t3 (list '(2 1 6 7) '(4 3 1 2 4 5) '(1 2 3) '(1 1)))
(bubble-set-up t3)
How about (sort (lambda (x y)(< (car x)(car y))) <YOUR_LIST>)?
I have fixed a few mistakes. There is at least one mistake left.
Consider the case where L only contains one element.
#lang r5rs
(define (bubble L)
(if (null? (cdr L))
L
(if (< (car (car L)) (car (cadr L)))
(cons (car L)
(bubble (cdr L)))
(cons (cadr L)
(bubble (cons (car L) (cddr L)))))))
(define (bubble-sort N L)
(cond ((= N 1) (bubble L))
(else
(bubble-sort (- N 1) (bubble L)))))
(define (bubble-set-up L)
(bubble-sort (length L) L))
(define t3 (list '(2 1 6 7) '(4 3 1 2 4 5) '(1 2 3) '(1 1)))
(display (bubble-set-up t3))
(newline)
I am trying to solve the exercise 2.20 from SICP book. The exercise -
Write a procedure same-parity that takes one or more integers and returns a list of
all the arguments that have the same even-odd parity as the first argument. For example,
(same-parity 1 2 3 4 5 6 7)
(1 3 5 7)
(same-parity 2 3 4 5 6 7)
(2 4 6)
My code -
(define same-parity (lambda (int . l)
(define iter-even (lambda (l2 rl)
(cons ((null? l2) rl)
((even? (car l2))
(iter-even (cdr l2) (append rl (car l2))))
(else (iter-even (cdr l2) rl)))))
(define iter-odd (lambda (l2 rl)
(cons ((null? l2) rl)
((odd? (car l2))
(iter-odd (cdr l2) (append rl (car l2))))
(else (iter-odd (cdr l2) rl)))))
(if (even? int) (iter-even l (list int))
(iter-odd l (list int)))))
For some reason I am getting an error saying "The object (), passed as the first argument to cdr, is not the correct type". I tried to solve this for more than two hours, but I cant find any reason why it fails like that. Thanks for hlep.
Try this:
(define same-parity
(lambda (int . l)
(define iter-even
(lambda (l2 rl)
(cond ((null? l2) rl)
((even? (car l2))
(iter-even (cdr l2) (append rl (list (car l2)))))
(else (iter-even (cdr l2) rl)))))
(define iter-odd
(lambda (l2 rl)
(cond ((null? l2) rl)
((odd? (car l2))
(iter-odd (cdr l2) (append rl (list (car l2)))))
(else (iter-odd (cdr l2) rl)))))
(if (even? int)
(iter-even l (list int))
(iter-odd l (list int)))))
Explanation:
You are using cons instead of cond for the different conditions
in the part where append is called, the second argument must be a proper list (meaning: null-terminated) - but it is a cons-pair in your code. This was causing the error, the solution is to simply put the second element inside a list before appending it.
I must say, using append to build an output list is frowned upon. You should try to write the recursion in such a way that cons is used for creating the new list, this is more efficient, too.
Some final words - as you're about to discover in the next section of SICP, this problem is a perfect fit for using filter - a more idiomatic solution would be:
(define (same-parity head . tail)
(if (even? head)
(filter even? (cons head tail))
(filter odd? (cons head tail))))
First, I check the first element in the list. If it is even, I call the procedure that forms a list out of only the even elements. Else, I call the procedure that forms a list out of odd elements.
Here's my code
(define (parity-helper-even B)(cond
((= 1 (length B)) (cond
((even? (car B)) B)
(else '())
))
(else (cond
((even? (car B)) (append (list (car B)) (parity-helper-even (cdr B))))
(else (parity-helper-even(cdr B)))
))))
(define (parity-helper-odd B)(cond
((= 1 (length B)) (cond
((odd? (car B)) B)
(else '())
))
(else (cond
((odd? (car B)) (append (list (car B)) (parity-helper-odd (cdr B))))
(else (parity-helper-odd (cdr B)))
))))
(define (same-parity first . L) (cond
((even? first) (parity-helper-even (append (list first) L)))
(else (parity-helper-odd (append (list first) L)))))
(same-parity 1 2 3 4 5 6 7)
;Output (1 3 5 7)
While you are traversing the list, you might as well just split it into even and odd parities. As the last step, choose the one you want.
(define (parities args)
(let looking ((args args) (even '()) (odd '()))
(if (null? args)
(values even odd)
(let ((head (car args)))
(if (even? head)
(looking (cdr args) (cons head even) odd)
(looking (cdr args) even (cons head odd)))))))
(define (same-parity head . rest)
(let-values ((even odd) (parities (cons head rest)))
(if (even? head)
even
odd)))
Except for homework assignments, if you are going to look for one then you are likely to need the other. Said another way, you'd find yourself using parities more frequently in practice.
You could simply filter elements by parity of first element:
(define (same-parity x . y)
(define (iter z filter-by)
(cond ((null? z) z)
((filter-by (car z))
(cons (car z) (iter (cdr z) filter-by)))
(else (iter (cdr z) filter-by))))
(iter (cons x y) (if (even? x) even? odd?)))
And try:
(same-parity 1 2 3 4 5 6 7)
(same-parity 2 3 4 5 6 7)
In lisp/scheme, is there any form using set product as function input? map form uses n length-equal lists for a function which needs n arguments. Sometimes, we need the arguments to come from the product of a group of sets. For example:
(pmap (λ (d p) foo)
A B)
Here, list A may have different length with B, and pmap feeds each element of the product of A and B to the lambda expression.
Form for* of scheme/racket can do this job:
(for* ([x '(0 2 4)]
[y '(1 3 5)])
((λ (d p)
(printf "(~a, ~a)\n" d p))
x y))
Output:
(0, 1)
(0, 3)
(0, 5)
(2, 1)
(2, 3)
(2, 5)
(4, 1)
(4, 3)
(4, 5)
I want to know whether there exists other means similar to map or fold to do this in scheme.
As far as I know such a thing is not present in the standard. It is however not a problem to write one.
For an overview over useful list functions, I can recommend srfi1, which gives you quite a few useful operations besides map and fold.
http://srfi.schemers.org/srfi-1/srfi-1.html
I wrote the following implementation of pmap. It works using only cons, car, cdr, null?, apply, map and reverse and supports any number of arguments like map does.
(define (pmap f . xs)
(define (carry a xs ys then)
(if (and (not (null? ys)) (null? (car ys)))
'()
(if (null? xs)
(then (reverse a))
(if (null? (car xs))
(if (null? (cdr xs))
'()
(carry (cons (car ys) a) (cons (cdr (car (cdr xs))) (cdr (cdr xs))) (cdr ys) then))
(carry (cons (car xs) a) (cdr xs) (cdr ys) then)))))
(define (pmap-helper f xs ys)
(carry '() xs ys
(lambda (xs)
(cons (apply f (map car xs))
(pmap-helper f (cons (cdr (car xs)) (cdr xs)) ys)))))
(pmap-helper f xs xs))
(display (pmap list '(0 2 4) '(1 3 5))) (newline)
;((0 1) (2 1) (4 1) (0 3) (2 3) (4 3) (0 5) (2 5) (4 5))
The only difference is that the earlier lists are iterated over faster than later ones where as your example is the reverse. This pmap can be modified to do that:
(define (pmap f . xs)
(define (carry a xs ys then)
(if (and (not (null? ys)) (null? (car ys)))
'()
(if (null? xs)
(then (reverse a))
(if (null? (car xs))
(if (null? (cdr xs))
'()
(carry (cons (car ys) a) (cons (cdr (car (cdr xs))) (cdr (cdr xs))) (cdr ys) then))
(carry (cons (car xs) a) (cdr xs) (cdr ys) then)))))
(define (pmap-helper f xs ys)
(carry '() xs ys
(lambda (xs)
(cons (apply f (reverse (map car xs)))
(pmap-helper f (cons (cdr (car xs)) (cdr xs)) ys)))))
(let ((xs (reverse xs)))
(pmap-helper f xs xs)))
(display (pmap list '(0 2 4) '(1 3 5))) (newline)
; ((0 1) (0 3) (0 5) (2 1) (2 3) (2 5) (4 1) (4 3) (4 5))
In an application I'm working on in Racket I need to take a list of numbers and partition the list into sub-lists of consecutive numbers:
(In the actual application, I'll actually be partitioning pairs consisting of a number and some data, but the principle is the same.)
i.e. if my procedure is called chunkify then:
(chunkify '(1 2 3 5 6 7 9 10 11)) -> '((1 2 3) (5 6 7) (9 10 11))
(chunkify '(1 2 3)) -> '((1 2 3))
(chunkify '(1 3 4 5 7 9 10 11 13)) -> '((1) (3 4 5) (7) (9 10 11) (13))
(chunkify '(1)) -> '((1))
(chunkify '()) -> '(())
etc.
I've come up with the following in Racket:
#lang racket
(define (chunkify lst)
(call-with-values
(lambda ()
(for/fold ([chunk '()] [tail '()]) ([cell (reverse lst)])
(cond
[(empty? chunk) (values (cons cell chunk) tail)]
[(equal? (add1 cell) (first chunk)) (values (cons cell chunk) tail)]
[else (values (list cell) (cons chunk tail))])))
cons))
This works just fine, but I'm wondering given the expressiveness of Racket if there isn't a more straightforward simpler way of doing this, some way to get rid of the "call-with-values" and the need to reverse the list in the procedure etc., perhaps some way comepletely different.
My first attempt was based very loosely on a pattern with a collector in "The Little Schemer" and that was even less straightforward than the above:
(define (chunkify-list lst)
(define (lambda-to-chunkify-list chunk) (list chunk))
(let chunkify1 ([list-of-chunks '()]
[lst lst]
[collector lambda-to-chunkify-list])
(cond
[(empty? (rest lst)) (append list-of-chunks (collector (list (first lst))))]
[(equal? (add1 (first lst)) (second lst))
(chunkify1 list-of-chunks (rest lst)
(lambda (chunk) (collector (cons (first lst) chunk))))]
[else
(chunkify1 (append list-of-chunks
(collector (list (first lst)))) (rest lst) list)])))
What I'm looking for is something simple, concise and straightforward.
Here's how I'd do it:
;; chunkify : (listof number) -> (listof (non-empty-listof number))
;; Split list into maximal contiguous segments.
(define (chunkify lst)
(cond [(null? lst) null]
[else (chunkify/chunk (cdr lst) (list (car lst)))]))
;; chunkify/chunk : (listof number) (non-empty-listof number)
;; -> (listof (non-empty-listof number)
;; Continues chunkifying a list, given a partial chunk.
;; rchunk is the prefix of the current chunk seen so far, reversed
(define (chunkify/chunk lst rchunk)
(cond [(and (pair? lst)
(= (car lst) (add1 (car rchunk))))
(chunkify/chunk (cdr lst)
(cons (car lst) rchunk))]
[else (cons (reverse rchunk) (chunkify lst))]))
It disagrees with your final test case, though:
(chunkify '()) -> '() ;; not '(()), as you have
I consider my answer more natural; if you really want the answer to be '(()), then I'd rename chunkify and write a wrapper that handles the empty case specially.
If you prefer to avoid the mutual recursion, you could make the auxiliary function return the leftover list as a second value instead of calling chunkify on it, like so:
;; chunkify : (listof number) -> (listof (non-empty-listof number))
;; Split list into maximal contiguous segments.
(define (chunkify lst)
(cond [(null? lst) null]
[else
(let-values ([(chunk tail) (get-chunk (cdr lst) (list (car lst)))])
(cons chunk (chunkify tail)))]))
;; get-chunk : (listof number) (non-empty-listof number)
;; -> (values (non-empty-listof number) (listof number))
;; Consumes a single chunk, returns chunk and unused tail.
;; rchunk is the prefix of the current chunk seen so far, reversed
(define (get-chunk lst rchunk)
(cond [(and (pair? lst)
(= (car lst) (add1 (car rchunk))))
(get-chunk (cdr lst)
(cons (car lst) rchunk))]
[else (values (reverse rchunk) lst)]))
I can think of a simple, straightforward solution using a single procedure with only primitive list operations and tail recursion (no values, let-values, call-with-values) - and it's pretty efficient. It works with all of your test cases, at the cost of adding a couple of if expressions during initialization for handling the empty list case. It's up to you to decide if this is concise:
(define (chunkify lst)
(let ((lst (reverse lst))) ; it's easier if we reverse the input list first
(let loop ((lst (if (null? lst) '() (cdr lst))) ; list to chunkify
(cur (if (null? lst) '() (list (car lst)))) ; current sub-list
(acc '())) ; accumulated answer
(cond ((null? lst) ; is the input list empty?
(cons cur acc))
((= (add1 (car lst)) (car cur)) ; is this a consecutive number?
(loop (cdr lst) (cons (car lst) cur) acc))
(else ; time to create a new sub-list
(loop (cdr lst) (list (car lst)) (cons cur acc)))))))
Yet another way to do it.
#lang racket
(define (split-between pred xs)
(let loop ([xs xs]
[ys '()]
[xss '()])
(match xs
[(list) (reverse (cons (reverse ys) xss))]
[(list x) (reverse (cons (reverse (cons x ys)) xss))]
[(list x1 x2 more ...) (if (pred x1 x2)
(loop more (list x2) (cons (reverse (cons x1 ys)) xss))
(loop (cons x2 more) (cons x1 ys) xss))])))
(define (consecutive? x y)
(= (+ x 1) y))
(define (group-consecutives xs)
(split-between (λ (x y) (not (consecutive? x y)))
xs))
(group-consecutives '(1 2 3 5 6 7 9 10 11))
(group-consecutives '(1 2 3))
(group-consecutives '(1 3 4 5 7 9 10 11 13))
(group-consecutives '(1))
(group-consecutives '())
I want to play.
At the core this isn't really anything that's much different from what's
been offered but it does put it in terms of the for/fold loop. I've
grown to like the for loops as I think they make for much
more "viewable" (not necessarily readable) code. However, (IMO --
oops) during the early stages of getting comfortable with
racket/scheme I think it's best to stick to recursive expressions.
(define (chunkify lst)
(define-syntax-rule (consecutive? n chunk)
(= (add1 (car chunk)) n))
(if (null? lst)
'special-case:no-chunks
(reverse
(map reverse
(for/fold ([store `((,(car lst)))])
([n (cdr lst)])
(let*([chunk (car store)])
(cond
[(consecutive? n chunk)
(cons (cons n chunk) (cdr store))]
[else
(cons (list n) (cons chunk (cdr store)))])))))))
(for-each
(ƛ (lst)
(printf "input : ~s~n" lst)
(printf "output : ~s~n~n" (chunkify lst)))
'((1 2 3 5 6 7 9 10 11)
(1 2 3)
(1 3 4 5 7 9 10 11 13)
(1)
()))
Here's my version:
(define (chunkify lst)
(let loop ([lst lst] [last #f] [resint '()] [resall '()])
(if (empty? lst)
(append resall (list (reverse resint)))
(begin
(let ([ca (car lst)] [cd (cdr lst)])
(if (or (not last) (= last (sub1 ca)))
(loop cd ca (cons ca resint) resall)
(loop cd ca (list ca) (append resall (list (reverse resint))))))))))
It also works for the last test case.