I have seen the following code:
#lang r5rs
(define ma-liste-1 (list 2 3 4 5))
(define ma-liste-2 (list 6 7 8 9))
(define (cons! e L)
(set-cdr! L (cons (car L) (cdr L)))
(set-car! L e))
(cons! 1 ma-liste-1)
ma-liste-1 ; (list 1 2 3 4 5)
I just do not understand why the following code does not work:
#lang r5rs
(define ma-liste-1 (list 2 3 4 5))
(define ma-liste-2 (list 6 7 8 9))
(define (cons! e L)
(set-cdr! L L)
(set-car! L e))
(cons! 1 ma-liste-1)
ma-liste-1 ; #0=(mcons 1 #0#)
Could anyone help?
(set-cdr! L L)
produces a cons cell whose cdr references itself circularly, in ASCII art
.-> ( CAR . CDR )
/ /
\___________/
while (set-cdr! L (cons (car L) (cdr L))) first reconstructs the cdr so that there's no circular reference.
You are forced to make a copy, else as you can see, you end up mutating an existing list, and end up making it a circular list (that notation is used for such shared structures).
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 have a question on a homework assignment that is as follows:
I have the first part (double-list-elements) complete
(define (double-list-elements s)
(if (null? s)
'()
(cons (* 2 (car s))
(double-list-elements (cdr s)))))
but I honestly have absolutely no idea how to proceed with double-list-elements-one. Any pointers would be greatly appreciated.
Close But No Cigar:
(define (double-list-elements s)
(if (null? s)
'()
(cons (* 2 (car s))
(double-list-elements (cdr s)))))
(define (custom-map proc lst)
(if (null? lst)
'()
(cons (proc lst)
(custom-map proc (cdr lst)))))
(define (double-list-elements-one func s)
(custom-map double-list-elements s))
(double-list-elements-one double-list-elements '(1 2 3 4 5 6))
Output = (list (list 2 4 6 8 10 12) (list 4 6 8 10 12) (list 6 8 10 12) (list 8 10 12) (list 10 12) (list 12))
I need to pass double-list-elements to double-list-elements-one as a parameter as well as the list.
You just have to write your own map, it's very very similar to what you already have, simply pass the part that changes as a procedure parameter, and invoke it on the right place:
(define (mymap proc lst)
(if (null? lst)
'()
(cons <invoke proc on current element>
(mymap proc (cdr lst)))))
(define (double-list-elements-one s)
(mymap <pass a proper lambda> s))
(double-list-elements-one '(1 2 3 4 5))
=> '(2 4 6 8 10)
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 saw a code on a book about how to create a map function in Scheme, the code is the following:
(define map (lambda (f L)
(if null? L '()
(cons (f (car L)) (map f (cdr L))))))
(define square (lambda (x)
(* x x)))
(define square-list (lambda (L)
(map square L)))
Supposedly I can call it with:
(map square-list '(1 2 3 4))
but it is throwing me the following error:
SchemeError: too many operands in form: (null? L (quote ()) (cons (f (car L)) (map f (cdr L))))
Current Eval Stack:
-------------------------
0: (map square-list (quote (1 2 3 4)))
How should I call this function?
You have two errors. First, you forgot to surround the null? check with parentheses (and notice a better way to indent your code):
(define map
(lambda (f L)
(if (null? L)
'()
(cons (f (car L))
(map f (cdr L))))))
Second, you're expected to call the procedure like this:
(square-list '(1 2 3 4 5))
=> '(1 4 9 16 25)
You're missing parens around null? L, i.e. your condition should probably look like
(if (null? L) '()
(cons ...))
I want to show the last appearance of an element from a given list. For example: For the list '(1 1 2 1 3 3 4 3 5 6), the result will be '(2 1 4 3 5 6)
This is the code I have:
(define (func L res)
(if (not (null? L))
(foldl (lambda (e)
(if (not (member e (cdr L)))
(cons e (remove-duplicates-right (cdr L)))
(remove-duplicates-right (cdr L))))
res L)
res))
(define (show-last-app L)
(func L '()))
The next error occurs: "foldl: given procedure does not accept 2 arguments"
This is how I solved it only with recursion but I want to use only foldl or filter and don't use functions with side effects:
(define (show-last-app L)
(cond
((null? L)
'())
((not (member (car L) (cdr L)))
(append (list (car L)) (show-last-app (cdr L))))
(else (show-last-app (cdr L)))))
I think you misunderstand how folds work in Scheme. This is closer to what you were aiming for:
(define (show-last-app L)
(foldr (lambda (e acc)
(if (not (member e acc))
(cons e acc)
acc))
'()
L))
If you really, really have to use foldl:
(define (show-last-app L)
(foldl (lambda (e acc)
(if (not (member e acc))
(cons e acc)
acc))
'()
(reverse L)))
Either way, it works as expected:
(show-last-app '(1 2 4 1 5 3 1 6 2))
=> (4 5 3 1 6 2)