cons* in scheme - how to implement - scheme

I tried to implement the cons* (https://scheme.com/tspl4/objects.html#./objects:s44).
Examples:
(cons* '()) -> ()
(cons* '(a b)) -> (a b)
(cons* 'a 'b 'c) -> (a b . c)
(cons* 'a 'b '(c d)) -> (a b c d)
this is what I did do far but I don't know how to replace the ?? to make the third example (the dot notion) work
(define cons*
(lambda x
(if
(null? x)
x
(if (list? (car (reverse x)))
(fold-right cons (car (reverse x)) (reverse (cdr (reverse x))))
???
)
)
)
)

Here's a lo-fi way using lambda -
(define cons*
(lambda l
(cond ((null? l) null)
((null? (cdr l)) (car l))
(else (cons (car l) (apply cons* (cdr l)))))))
Here's a way you can do it using match (Racket)
(define (cons* . l)
(match l
((list) null) ; empty list
((list a) a) ; singleton list
((list a b ...) (cons a (apply cons* b))))) ; two or elements
Often times patterns and order can be rearranged and still produce correct programs. It all depends on how you're thinking about the problem -
(define (cons* . l)
(match l
((list a) a) ; one element
((list a b) (cons a b)) ; two elements
((list a b ...) (cons a (apply cons* b))))) ; more
Or sugar it up with define/match -
(define/match (cons* . l)
[((list)) null]
[((list a)) a]
[((list a b ...)) (cons a (apply cons* b))])
All four variants produce the expected output -
(cons* '())
(cons* '(a b))
(cons* 'a 'b 'c)
(cons* 'a 'b '(c d))
'()
'(a b)
'(a b . c)
'(a b c d)

Personally, I'd use a macro instead of a function to transform a cons* into a series of cons calls:
(define-syntax cons*
(syntax-rules ()
((_ arg) arg)
((_ arg1 rest ...) (cons arg1 (cons* rest ...)))))
(define (writeln x)
(write x)
(newline))
(writeln (cons* '())) ;; -> '()
(writeln (cons* '(a b))) ;; -> '(a b)
(writeln (cons* 'a 'b 'c)) ;; -> (cons 'a (cons 'b 'c)) -> '(a b . c)
(writeln (cons* 'a 'b '(c d))) ;; -> (cons 'a (cons 'b '(c d))) -> '(a b c d)

A Simple Procedure
I think that you are making this more complicated than it needs to be. It seems best not to use lambda x here, since that would allow calls like (cons*) with no arguments. Instead, I would use (x . xs), and I would even just use the define syntax:
(define (cons* x . xs)
(if (null? xs)
x
(cons x (apply cons*
(car xs)
(cdr xs)))))
If there is only one argument to cons*, then xs is empty, i.e., (null? xs) is true, and that single argument x should be returned. Otherwise you should cons the first argument to the result of calling cons* again, with the first element of xs as the first argument, followed by the remaining arguments from xs. The trick here is that (cdr xs) returns a list, which will itself be put into a list thanks to the (x . xs) syntax. This is the reason for using apply, which will apply cons* to the arguments in the list.
This works for all of the test cases:
> (cons* '())
()
> (cons* '(a b))
(a b)
> (cons* 'a 'b 'c)
(a b . c)
> (cons* 'a 'b '(c d))
(a b c d)
Using Mutation
Taking a closer look at what a proper list really is suggests another approach to solving the problem. Consider a list like (a b c d). This is really a chain of cons cells that look like this:
(a . (b . (c . (d . ()))))
We would like to transform this list to an improper, or dotted, list:
(a . (b . (c . (d . ())))) --> (a . (b . (c . d)))
This transformed list is equivalent to (abc.d), which is what we would like the call to (cons* 'a 'b 'c 'd) to return.
We could mutate the proper list to an improper list by setting the cdr of the next-to-last pair to the car of the last pair; that is, by setting the cdr of (c . (d .()) to d. We can use the list-tail procedure to get at the next-to-last pair, list-ref to get at the car of the last pair, and set-cdr! to set the cdr of the next-to-last pair to the new value. After this, the list is no longer terminated by an empty list (unless the car of the final pair is itself an empty list!).
Here is a procedure proper->improper! that mutates a proper list to an improper list. Note that the input must be a proper list to avoid an error. If the input list contains only a single element, then that element is simply returned and no mutation takes place.
(define (proper->improper! xs)
(cond ((null? (cdr xs))
(car xs))
(else
(set-cdr! (list-tail xs (- (length xs) 2))
(list-ref xs (- (length xs) 1)))
xs)))
Now cons* can be defined simply in terms of proper->improper!:
(define (cons* . xs)
(proper->improper! xs))
Here, the arguments to cons* are packed up into a fresh list and passed to proper->improper! which effectively removes the terminal empty list from its input, returning a chain of pairs whose last cdr is the last argument to cons*; or if only one argument is provided, that argument is returned. This works just like the other solution:
> (cons* '())
()
> (cons* 'a)
a
> (cons* 'a 'b 'c 'd)
(a b c . d)
> (cons* 'a 'b '(c d))
(a b c d)
Real Life
In real life, at least in Chez Scheme, cons* is not implemented like any of these solutions, or even in Scheme at all. Instead Chez opted to make cons* a primitive procedure, implemented in C (I believe).

Related

reverse a general list using scheme

I am trying to reverse a general list using Scheme. How can I reverse a complex list?
I can make a single list like (A B C D) works using my function, but for some complex list inside another list like (F ((E D) C B) A), the result is just (A ((E D) C B) F). How can I improve it?
(define (reverse lst)
(if (null? lst)
lst
(append (reverse (cdr lst)) (list (car lst)))))
Any comments will be much appreciated!
Here is another way that uses a default parameter (r null) instead of the expensive append operation -
(define (reverse-rec a (r null))
(if (null? a)
r
(reverse-rec (cdr a)
(cons (if (list? (car a))
(reverse-rec (car a))
(car a))
r))))
(reverse-rec '(F ((E D) C B) A))
; '(A (B C (D E)) F)
Using a higher-order procedure foldl allows us to encode the same thing without the extra parameter -
(define (reverse-rec a)
(foldl (lambda (x r)
(cons (if (list? x) (reverse-rec x) x)
r))
null
a))
(reverse-rec '(F ((E D) C B) A))
; '(A (B C (D E)) F)
There are several ways of obtaining the expected result. One is to call reverse recursively also on the car of the list that we are reversing, of course taking care of the cases in which we must terminate the recursion:
(define (reverse x)
(cond ((null? x) '())
((not (list? x)) x)
(else (append (reverse (cdr x)) (list (reverse (car x)))))))
(reverse '(F ((E D) C B) A))
'(A (B C (D E)) F)
(A ((E D) C B) F) is the correct result, if your goal is to reverse the input list. There were three elements in the input list, and now the same three elements are present, in reverse order. Since it is correct, I don't suggest you improve its behavior!
If you have some other goal in mind, some sort of deep reversal, you would do well to specify more clearly what result you want, and perhaps a solution will be easier to find then.

Trying to replace all instances of an element in a list with a new element [Racket]

As the title said, I'm trying to write a function that takes a list, a variable, and an element, then replaces all instances of the variable in the list with that element.
For example:
(substitute '(C or (D or D)) 'D #f) would return
'(C or (#f or #f))
Right now what I've got is:
(define (substitute lst rep new)
(cond ((or (null? lst))
lst)
((eq? (car lst) rep)
(cons new (substitute (cdr lst) rep new)))
(else
(cons (car lst) (substitute (cdr lst) rep new)))))
Which doesn't check nested lists like my example, though it works fine when they aren't a part of the input.
And I'm having trouble with where to place recursion in order to do so - or would it be easier to flatten it all and then rebuild it after everything's been replaced in some way?
Here's another solution using pattern matching via match -
(define (sub l rep new)
(match l
((list (list a ...) b ...) ; nested list
(cons (sub a rep new)
(sub b rep new)))
((list a b ...) ; flat list
(cons (if (eq? a rep) new a)
(sub b rep new)))
(_ ; otherwise
null)))
It works like this -
(sub '(a b c a b c a b c) 'a 'z)
;; '(z b c z b c z b c)
(sub '(a b c (a b c (a b c))) 'a 'z)
;; '(z b c (z b c (z b c)))
(sub '() 'a 'z)
; '()
At first sight, your question looks similar to How to replace an item by another in a list in DrScheme when given paramters are two items and a list?. From my understanding, your question is slightly different because you also want to replace occurrences within nested lists.
In order to deal with nested lists, you must add a clause to check for the existence of a nested list, and replace all occurrences in that nested list by recursing down the nested list:
(define (subst l rep new)
(cond ((null? l)
'())
((list? (car l)) ; Check if it is a nested list.
(cons (subst (car l) rep new) ; Replace occurrences in the nested list.
(subst (cdr l) rep new))) ; Replace occurrences in the rest of the list.
((eq? (car l) rep)
(cons new
(subst (cdr l) rep new)))
(else
(cons (car l)
(subst (cdr l) rep new)))))
Example use (borrowed from the answer given by user633183):
(subst '(a b c a b c a b c) 'a 'z)
;; '(z b c z b c z b c)
(subst '(a b c (a b c (a b c))) 'a 'z)
;; '(z b c (z b c (z b c)))
(subst '() 'a 'z)
; '()
This can be done using map and recursion:
(define (subst lst rep new)
(map (lambda (x)
(if (list? x)
(subst x rep new)
(if (eq? rep x) new x))) lst))
the output:
(subst '(a b c (a b c (a b c))) 'a 'z)
; '(z b c (z b c (z b c)))

Scheme procedure to substitute the element in a pair

I'm trying to write a procedure: when a pair starts with a, it would return b; when a pair starts with b, it would return c; and when a pair starts with c, it would return a.
(define e '((a b) (b c) (c a)))
(define (make-encoder e)
(cond ((eq? 'a (car (assq 'a e)))
(cadr (assq 'a e)))
((eq? 'b (car (assq 'b e)))
(cadr (assq 'b e)))
((eq? 'c (car (assq 'c e)))
(cadr (assq 'c e)))))
What is returned is only 'b', so I'm wondering where my brackets are wrong in cutting off the remaining code? I have played around for so long and wondering if that's my problem, or if it something else.
I don't think it's an issue of wrong parens; I can't really see a way to tweak your code to get the desired behavior. Here's how I would do it:
(define (make-encoder assoc-list)
(lambda (lst)
(define (-> elem)
(cadr (assq elem assoc-list)))
(map -> lst)))
As you can see, when you call this procedure with an association list such as e, it will return a new function that takes a list and maps -> over it, where -> looks up the element in the association list and returns result. Hence:
> ((make-encoder e) '(a b a c a b))
'(b c b a b c)
You have looking up the value of a key in a association list with (cadr (assq k a)) but what you are missing is how to apply that to every item in a list. That is where map comes in. So:
> (map (lambda (v) (cadr (assq v '((a b) (b c) (c a))))) '(a b a c a b))
'(b c b a b c)
This can be turned into a function by placing it within lambdas or a definition and replacing the values with bound names.

Transforming this into an expression

Hi guys i'm wanted to know if i have the correct expression for this picture, if not why please
(a((f(b c))(g h))e)
You're close, but not quite right. It'll be more clear if we build the list structure explicitly using cons; this is more like it:
(cons 'a
(cons (cons (cons 'f
(cons 'b 'c))
(cons 'g
(cons 'h '())))
(cons 'e '())))
=> '(a ((f b . c) g h) e)
Notice that in this part: (f b . c) we have an improper list, because the sublist doesn't end in null.
You answer is incorrect as it doesn't properly express the improper list (f b . c). Also the parentheses around g h are an error.
With dotted pairs the full expression would be:
'(a ((f b . c) g h) e)
Note that '(f b . c) is not the same as '(f (b c)).
See that '(f (b c)) is:
(cons 'f (cons (cons 'b (cons 'c '())) '()))
Rather than what '(f b . c) is:
(cons 'f (cons (cons 'b 'c) '()))
Note the improper list.

Help explaining how `cons` in Scheme work?

This is the function that removes the last element of the list.
(define (remove-last ll)
(if (null? (cdr ll))
'()
(cons (car ll) (remove-last (cdr ll)))))
So from my understanding if we cons a list (eg. a b c with an empty list, i.e. '(), we should get
a b c. However, testing in interaction windows (DrScheme), the result was:
If (cons '() '(a b c))
(() a b c)
If (cons '(a b c) '())
((a b c))
I'm like what the heck :(!
Then I came back to my problem, remove all elements which have adjacent duplicate. For example,
(a b a a c c) would be (a b).
(define (remove-dup lst)
(cond ((null? lst) '())
((null? (cdr lst)) (car lst))
((equal? (car lst) (car (cdr lst))) (remove-dup (cdr (cdr lst))))
(else (cons (car lst) (car (cdr lst))))
)
)
It was not correct, however I realize the answer have a . between a b. How could this happen?
`(a . b)`
There was only one call to cons in my code above, I couldn't see which part could generate this .. Any idea?
Thanks,
cons build pairs, not lists. Lisp interpreters uses a 'dot' to visually separate the elements in the pair. So (cons 1 2) will print (1 . 2). car and cdr respectively return the first and second elements of a pair. Lists are built on top of pairs. If the cdr of a pair points to another pair, that sequence is treated as a list. The cdr of the last pair will point to a special object called null (represented by '()) and this tells the interpreter that it has reached the end of the list. For example, the list '(a b c) is constructed by evaluating the following expression:
> (cons 'a (cons 'b (cons 'c '())))
(a b c)
The list procedure provides a shortcut for creating lists:
> (list 'a 'b 'c)
(a b c)
The expression (cons '(a b c) '()) creates a pair whose first element is a list.
Your remove-dup procedure is creating a pair at the else clause. Instead, it should create a list by recursively calling remove-dup and putting the result as the second element of the pair. I have cleaned up the procedure a bit:
(define (remove-dup lst)
(if (>= (length lst) 2)
(if (eq? (car lst) (cadr lst))
(cons (car lst) (remove-dup (cddr lst)))
(cons (car lst) (remove-dup (cdr lst))))
lst))
Tests:
> (remove-dup '(a b c))
(a b c)
> (remove-dup '(a a b c))
(a b c)
> (remove-dup '(a a b b c c))
(a b c)
Also see section 2.2 (Hierarchical Data and the Closure Property) in SICP.
For completeness, here is a version of remove-dup that removes all identical adjacent elements:
(define (remove-dup lst)
(if (>= (length lst) 2)
(let loop ((f (car lst)) (r (cdr lst)))
(cond ((and (not (null? r))(eq? f (car r)))
(loop f (cdr r)))
(else
(cons (car lst) (remove-dup r)))))
lst))
Here in pseudocode:
class Pair {
Object left,
Object right}.
function cons(Object left, Object right) {return new Pair(left, right)};
So,
1. cons('A,'B) => Pair('A,'B)
2. cons('A,NIL) => Pair('A,NIL)
3. cons(NIL,'A) => Pair(NIL,'A)
4. cons('A,cons('B,NIL)) => Pair('A, Pair('B,NIL))
5. cons(cons('A 'B),NIL)) => Pair(Pair('A,'B),NIL)
Let's see lefts and rights in all cases:
1. 'A and 'B are atoms, and whole Pair is not a list, so (const 'a 'b) gives (a . b) in scheme
2. NIL is an empty list and 'A is an atom, (cons 'a '()) gives list (a)
3. NIL and 'A as above, but as left is list(!), (cons '() 'a) gives pair (() . a)
4. Easy case, we have proper list here (a b).
5. Proper list, head is pair (a . b), tail is empty.
Hope, you got the idea.
Regarding your function. You working on LIST but construct PAIRS.
Lists are pairs (of pairs), but not all pairs are lists! To be list pair have to have NIL as tail.
(a b) pair & list
(a . b) pair not list
Despite cons, your function has errors, it just don't work on '(a b a a c c d). As this is not related to your question, I will not post fix for this here.

Resources