Using only the cons command in the Scheme Programming Language, how can one write nested lists such as
'(a b (x y (m)))?
Hint: the car of a cons cell can be a cons cell too.
More particularly, the list you have is written in long form as:
(a . (b . ((x . (y . ((m . ()) . ()))) . ())))
(define a "a")
(define b "b")
(define x "x")
(define y "y")
(define m "m")
(define example (cons a (cons b (cons (cons x (cons y (cons (cons m '()) '()))) '()))))
Resultaat:
example
'("a" "b" ("x" "y" ("m")))
Related
I am building a function is Lisp ta reverses the first and last element of a list. I get that a list has a car and a cdr hence why there is a dot in my output. Is there a way to remove the dot?
(defun my-butlast (list)
(loop for l on list
while (cdr l)
collect (car l)))
(defun f-l-swap(list)
(append (last list)(cdr (my-butlast list))(car list))
)
(write(f-l-swap '(A B C D E)))
OUTPUT:
(E B C D . A)
append expects arguments to be lists. In your case (car list) is an atom. You have to change it to list if you want to stick with append. Ie:
(defun f-l-swap (list)
(append (last list)
(cdr (my-butlast list))
(list (car list))))
A list is a chain of cons pairs. eg. (1 2 3) is the visualization of (1 . (2 . (3 . ()))). In the event the last cdr is not () you have what we call a dotted list since then there is no simplified visualization of the last part. It has to be printed with a dot.
You have (E . (B . (C . (D . A)))) and want to have (E . (B . (C . (D . (A . ()))))). Do you see the difference? (car list) is not a list but one elment and that is why you get a dotted list.
Here are more sensible implementations of append and butlast:
(defun my-append (a b)
(if (null a)
b
(cons (car a) (my-append (cdr a) b))))
That only supports 2 arguments, but the idea for more is that it continues until you have consed all the previous lists and only have one left, which verbatim becomes the tail. Here is how that might look:
(defun my-append2 (x &rest xs)
(labels ((helper (x xs)
(cond ((null xs) x)
((null x) (helper (car xs) (cdr xs)))
(t (cons (car x) (helper (cdr x) xs))))))
(helper x xs)))
Here is butlast
(defun my-butlast (xs)
(if (null (cdr xs))
'()
(cons (car xs) (my-butlast (cdr xs)))))
Now, one should really do it with higher order functions or loop, but then you get the facts hidden how lists work. The code above shows you have they work.
I am trying to find depth of each element in a list and simultaneously create a output where flattened output is written with their depth level , so far i came up with following logic -
(define nestingDepth
(lambda (lst1)
(cond ((null? lst1) 1)
((list? (car lst1))
(cons(+ 1(nestingDepth (car lst1)))) (nestingDepth (cdr lst1)))
((null? (cdr lst1)) (cons (1 (cdr lst1))) (nestingDepth (cdr lst1))))))
But this is not printing anything in output. Please update where i am going wrong.
Expected result will look like -
input - '(a (b) c)
output - (1 a 2 b 1 c)
As some other answers have mentioned, it's important to make sure that each case retursn something of the proper type. If the input is the empty list, then the output should be the empty list. If the input is a pair, then you need to handle the car and the cdr of the pair and connect them. If the input is neither the empty list nor a pair, then the result is a list of the depth and the input.
Now, it may be handy to build the result incrementally. You can build from the right to the left, and add each element and its depth using an approach like the following:
(define (depths tree)
(let depths ((tree tree)
(depth 0)
(results '()))
(cond
((null? tree) results)
((pair? tree) (depths (car tree)
(+ 1 depth)
(depths (cdr tree)
depth
results)))
(else (cons depth (cons tree results))))))
> (depths '(a ((b) c ((d))) e))
(1 a 3 b 2 c 4 d 1 e)
Here's one possible solution (I have changed the output format a little to make the solution easier to code). append-map is defined in SRFI 1.
(define (depths x)
(cond ((list? x)
(append-map (lambda (y)
(map (lambda (z)
(cons (car z) (+ (cdr z) 1)))
(depths y)))
x))
(else `((,x . 0)))))
(I write the code as a seasoned Schemer would write it, not as someone would write a homework assignment. If that's your situation, try to understand what my code does, then reformulate it into something homework-acceptable.)
All the previous solutions work well for proper (nested) lists, for those who work for improper lists I am not sure if they are correct.
For example, (depths '(a . b)) yields (1 a 0 b) for Joshua's, and (((a . b) . 0)) for Chris', but I'd say it should be (1 a 1 b).
I'd therefore go for
(define (depths sxp)
(let loop ((sxp sxp) (res null) (level (if (cons? sxp) 1 0)))
(cond
((null? sxp) res)
((pair? sxp) (let ((ca (car sxp)))
(loop ca
(loop (cdr sxp) res level)
(if (pair? ca) (add1 level) level))))
(else (cons level (cons sxp res))))))
and my test cases are:
(check-equal? (depths '(a . b)) '(1 a 1 b))
(check-equal? (depths 'a) '(0 a)) ; 0
(check-equal? (depths '(a)) '(1 a))
(check-equal? (depths '(a a)) '(1 a 1 a))
(check-equal? (depths '(a (b . c) d (e (f (g h . i) . j)))) '(1 a 2 b 2 c 1 d 2 e 3 f 4 g 4 h 4 i 3 j))
(check-equal? (depths '(a (b) c)) '(1 a 2 b 1 c))
(check-equal? (depths '(a ((b) c ((d))) e)) '(1 a 3 b 2 c 4 d 1 e))
(check-equal? (depths '(a (b (c (d e))) f g)) '(1 a 2 b 3 c 4 d 4 e 1 f 1 g))
The base case is wrong (you can't return 1 if you intend to output a list as a result), the way the recursion is being advanced doesn't build a list as output … a complete rewrite is needed; the following solution is portable and should work on any Scheme interpreter, making use only of basic procedures:
(define (nestingDepth lst)
(let depth ((lst lst) (n 1))
(cond ((null? lst) '())
((not (pair? (car lst)))
(cons n
(cons (car lst)
(depth (cdr lst) n))))
(else
(append (depth (car lst) (+ 1 n))
(depth (cdr lst) n))))))
The output is as expected:
(nestingDepth '(a (b (c (d e))) f g))
=> '(1 a 2 b 3 c 4 d 4 e 1 f 1 g)
the code "tsFunc" gets two lists as input and it will pairs each elements from two lists.
It works most of cases.
but then I find a bit strange behavior when I give 2 equal length of lists (e.g. '(1 2) '(3 4).... or '(a b c) '(1 2 3).... , it works strangely. first, here are code.
[problem 1]
(define (tsFunc lst1 lst2)
(define (helper ls1 ls2 rst)
(reverse (if (or (null? ls1) (null? ls2))
rst
(helper (cdr ls1) (cdr ls2)
(cons (cons (car ls1) (car ls2)) rst)))))
(helper lst1 lst2 '()))
the behavior like this:
1) correct behavior with uneven length of lists :
(tsFunc '(1 2 3) '(a b)) ====> output: ((1 . a) (2 . b))
2) strange behavior with even length of lists
: (tsFunc '(1 2 3) '(a b c)) ===> output (wrong): ((3 . c) (2 . b) (1 . a))
===> expected : ((1 . a) (2 . b) (3 . c))
when the two input lists are same length, what is happening?
do the tsFunc logic have different behavior between the input lists with same lengths vs. the input lists with different lengths?
(Note. as I know, the code needs to have "reverse" for the final result. so it is not because of "reverse" in the code)
[problem 2] with the result of tsFunc => tsFunc result: (1 . 2) (3 . 4) => try to implement product like this (1*2)+(3*4) = 14, so I have like this..
(define (func l1 l2)
(tsFunc (l1 l2) ;; line 2 - how to call tsFunc's result??
(foldl (lambda (acc pair) ;; line 3
(+ acc (* (car pair) (cdr pair)))) ;; line 4
'()
l1 l2))) ;; like this?? or ??
line 3 , 4 ok..that's the logic what to do, then, how to call tsFunc result to use it as input and.. two lists for the last line.. unclear..
The first problem is that you keep reversing the lists at each iteration, if you really need to reverse the output, do it just once at the end:
(define (tsFunc lst1 lst2)
(define (helper ls1 ls2 rst)
(if (or (null? ls1) (null? ls2))
(reverse rst)
(helper (cdr ls1) (cdr ls2)
(cons (cons (car ls1) (car ls2)) rst))))
(helper lst1 lst2 '()))
Now, for the second problem - the code doesn't even compile: you're not correctly calling the tsFunc procedure, and you're calling it in the wrong point. Also the initial value for the accumulator parameter is wrong - you can't use a list if you intend to return a number:
(define (func l1 l2)
(foldl (lambda (acc pair)
(+ acc (* (car pair) (cdr pair))))
0
(tsFunc l1 l2)))
Using the sample input in the question, here's how it would work:
(func '(1 3) '(2 4))
=> 14
In the above tsFunc takes '(1 3) and '(2 4) as inputs, transforming them into '((1 . 2) (3 . 4)) and then foldl preforms the operation (1*2)+(3*4) = 14, as expected.
Since you are allowed to use higher order functions, why not use just SRFI-1 List library fold?
#!r6rs
(import (rnrs base)
(only (srfi :1) fold)) ;; srfi-1 fold stop at the shortest list
(define (func lst1 lst2)
(fold (lambda (x y acc)
(+ acc (* x y)))
0
lst1
lst2))
(func '(1 3) '(2 4 8)) ; ==> 14
i've got a problem: I need to find if list equal to the second one, for example:
(set%eq? '(1 2 3) '(1 2 3)) ===> #t
(set%eq? '(1 2 3) '(2 3 4)) ===> #f
That examples are correct in my program, but this one is not:
(set%eq? (quote ((quote one) (quote two) (quote three))) (quote ((quote one) (quote two)
(quote three)))) ====> #f but i need #t
what's wrong?
this is my program:
(define (set-eq? xs ys)
(cond ((and (null? xs) (null? ys)) #t)
((null? ys) #f)
((eq? (car xs) (car ys)) (set-eq? (cdr xs) (cdr ys)))
((eq? (car xs) (car (reverse ys))) (set-eq? (cdr xs) (cdr (reverse ys))))
(else #f)))
There are a couple of mistakes in the posted code, and FYI, the procedure tests whether two lists are equal, it's not really testing for equality between two sets:
(define (set-eq? xs ys)
(cond ((and (null? xs) (null? ys)) #t)
((or (null? xs) (null? ys)) #f) ; missing case
((equal? (car xs) (car ys)) (set-eq? (cdr xs) (cdr ys))) ; use equal?
; deleted unnecessary case here. Anyway, why are you reversing the list?
(else #f)))
Now this will work:
(set-eq? '(1 2 3) '(1 2 3))
=> #t
(set-eq? '(1 2 3) '(2 3 4))
=> #f
(set-eq? (quote ((quote one) (quote two) (quote three)))
(quote ((quote one) (quote two) (quote three))))
=> #t
In fact, this will work, too:
(equal? '(1 2 3) '(1 2 3))
=> #t
(equal? '(1 2 3) '(2 3 4))
=> #f
(equal? (quote ((quote one) (quote two) (quote three)))
(quote ((quote one) (quote two) (quote three))))
=> #t
...But this won't work, the lists are clearly different:
(set-eq? '(1 2 3 4) '(4 1 2 3))
=> #f
If you intended to test for equality between two sets, you have to completely rethink the algorithm. Here's an idea: write asubset? procedure that tests if a list is a subset of another list (that is: if all the elements in one list are contained in the other list), and then test whether (and (subset? l1 l2) (subset? l2 l1)) is true, if that happens, then they're equal according to the set definition of equality.
Base on the comments from OP it's clear that these are set-eq?
(set-eq? '(a b c) '(c b a)) ; ==> #t
(set-eq? '(a b c) '(b c a)) ; ==> #t
(set-eq? '() '()) ; ==> #t
(set-eq? '(a b) '(a b c)) ; ==> #f
(set-eq? '(a b c) '(a c)) ; ==> #f
If the lists are without duplicates one could iterate the first list and try to find it in the second. If found we recurse with the two lists without the match.
#!r6rs
(import (rnrs)
(rnrs lists))
(define (set-eq? xs ys)
(if (null? xs)
(null? ys) ; #t if both sets are empty, otherwise #f
(let ((cur (car xs)))
(and (memq cur ys) ; first element is found
(set-eq? <??> (remq <??> <??>)))))) ; recurse without first in both lists
There are ways to get this faster. E.q. Hash the first list and iterate the second. If all matches and hashtable-size is the same as the number of iterations it's #t.
So, from the SICP we know that the cons car and cdr can be defined as a procedure:
(define (cons x y)
(lambda (m) (m x y)))
(define (car z)
(z (lambda (p q) p)))
(define (cdr z)
(z (lambda (p q) q)))
But the pre-defined procedure list, which takes the arguments to build a list, uses the original cons. That means, a list that list built, isn't a procedure as I want.
(car (list 1 2 3))
;The Object (1 2 3) is not applicable
So i write this:
(define (list . l)
(if (null? l)
'()
(cons (original-car l)
(list (original-cdr l)))))
I just wondering how to define the original-car and original-cdr. Are there some way to make a copy of a procedure in Scheme? Or there's some alternate way to solve this problem. thx
If you need to save a reference to the "original" procedures before redefining them, simply create an alias before defining the "new" procedures (I guess that's what you mean by "copying" them). Like this:
(define original-cons cons)
(define original-car car)
(define original-cdr cdr)
(define original-list list)
In this way, the old procedures can still be used, as long as we refer to them by their new names. In other words, the implementation of cons, car, cdr and list as procedures will look like this:
(define (my-cons x y)
(lambda (m) (m x y)))
(define (my-car z)
(z (lambda (p q) p)))
(define (my-cdr z)
(z (lambda (p q) q)))
(define (my-list . els)
(if (null? els)
'()
(my-cons
(original-car els)
(apply my-list (original-cdr els)))))
And sure enough, it works:
(define lst (my-list 1 2 3 4))
lst
=> #<procedure>
(my-car lst)
=> 1
(my-car (my-cdr lst))
=> 2
List in an implementation is defined as
(define (list . l) l)
However, this is using a lot of the underlying implementation. E.g. to work it uses the native cons. cons as defined in SICP is a thought experiment so you're implementation needs a little correction:
(define (my-cons x y)
(lambda (m) (m x y)))
(define (my-car z)
(z (lambda (p q) p)))
(define (my-cdr z)
(z (lambda (p q) q)))
(define (my-list . l)
(define (my-list-aux l)
(if (null? l)
'()
(my-cons (car l)
(my-list-aux (cdr l)))))
(my-list-aux l))
;; optional, update binding
(define car my-car)
(define cdr my-cdr)
(define list my-list)
my-cons my-car, my-cdr and my-list are as defined in your question. Only change is reference to correct procedure (with name not conflicting with Scheme)