Given an s-expression '((a . b) . (c . d)) and a list '(e f g h), how can I traverse the s-expression create an s-expression with the same shape, but with elements taken from the list? E.g., for the s-expression and list above, the result would be '((e . f) g . h)?
Traversing a tree of pairs in left to right order isn't particularly difficult, as car and cdr let you get to both sides, and cons can put things back together. The tricky part in a problem like this is that to "replace" elements in the right hand side of a tree, you need to know how many of the available inputs you used when processing the left hand side of the tree. So, here's a procedure reshape that takes a template (a tree with the shape that you want) and a list of elements to use in the new tree. It returns as multiple values the new tree and any remaining elements from the list. This means that in the recursive calls for a pair, you can easily obtain both the new left and right subtrees, along with the remaining elements.
(define (reshape template list)
;; Creates a tree shaped like TEMPLATE, but with
;; elements taken from LIST. Returns two values:
;; the new tree, and a list of any remaining
;; elements from LIST.
(if (not (pair? template))
(values (first list) (rest list))
(let-values (((left list) (reshape (car template) list)))
(let-values (((right list) (reshape (cdr template) list)))
(values (cons left right) list)))))
(reshape '((a . b) . (c . d)) '(e f g h))
;=> ((e . f) g . h)
;=> ()
(reshape '((a . b) . (c . d)) '(e f g h i j k))
;=> ((e . f) g . h)
;=> (i j k) ; leftovers
I'll assume that you want to create a new s-expression with the same shape of the s-expression given as the first parameter, but with the elements of the list from the second parameter.
If that's right, here's one possible solution using a list to save the point where we are in the replacement list and Racket's begin0 to keep the list updated (if that's not available in you interpreter use a let, as suggested by Chris and Joshua in the comments):
(define (transform sexp lst)
(let loop ((sexp sexp)) ; the s-expression list to be traversed
(cond ((null? sexp) '()) ; if it's empty, we're finished
((not (pair? sexp)) ; if it's an atom
(begin0 ; then (alternatively: use a `let`)
(car lst) ; return first element in replacements list
(set! lst (cdr lst)))) ; and update replacements to next element
(else ; otherwise advance recursion
(cons (loop (car sexp)) ; over both the `car` part of input
(loop (cdr sexp))))))) ; and the `cdr` part
For example:
(transform '((a . b) . (c . d)) '(e f g h))
=> '((e . f) g . h)
(transform '((a . b) (c d (x y) . z) . t) '(e f g h i j k m))
=> '((e . f) (g h (i j) . k) . m)
The solution is similar to my previous answer:
(define (transform sxp lst)
(let loop ((sxp sxp))
(cond ((null? sxp) sxp)
((pair? sxp) (cons (loop (car sxp)) (loop (cdr sxp))))
(else (begin0 (car lst) (set! lst (cdr lst)))))))
then
> (transform '((a . b) . (c . d)) '(e f g h))
'((e . f) g . h)
Related
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).
I'm trying to make a code with Scheme language.I want to input a list and return the string representation of the list where the first element is repeated one time, the second element repeats two times and third element repeats three times like
input is => (c d g)
output is => (c d d g g g)
I wrote a code with duplicating all elements. I should use loop for making repeat all elements from first one to last one with 1 to n times.(n is size of list). But I do not know how.
(define repeat
(lambda (d)
(cond [(null? d) '()]
[(not (pair? (car d)))
(cons (car d)
(cons (car d)
(repeat (cdr d))))]
[else (cons (repeat (car d))
(repeat (cdr d)))])))
(repeat '(a b c d e)) => aa bb cc dd ee
(define size
(lambda (n)
(if (null? n)
0
(+ 1 (size (cdr n))))))
(size '(A B C D)) => 4
You will need to make a few different functions for this.
repeat (as you described) acts like this (repeat '(c d g)) ;=> (c d d g g g)
The best way to implement that is using a helper (repeat-aux n lst) which repeats the first element n times, the second element n+1 times and so on.
Given that you can define:
(define (repeat lst) (repeat-aux 1 lst))
To implement repeat-aux you can use a recursion pattern like this
(define (repeat-aux n lst)
(if (null? lst)
'()
... (repeat-aux (+ n 1) (cdr lst) ...))
I'm just giving a sketch or outline of the function, not the whole thing. So that you can work on it yourself.
To implement repeat-aux I would also recommend making a helping function (replicate n elt tail) which works like this:
(replicate 3 'o '(u v w)) ;=> (o o o u v w)
I hope the idea of breaking it down into simple helper function makes it easier. Have a go and feel free to ask if you get stuck.
Given a list of lists as an input, I want to execute a procedure such that the final result would be:
(define (thing . lists) ; list of lists (l1 l2 ... lN)
;returns ...f(f(f(l1 l2) l3) lN)...
)
So for example:
(thing '(a b) '(c d) '(e f))
...would result in f(f((a b) (c d)) (e f))
I am fighting with folding, lambda, apply and map, but I can't figure out right way.
Assuming that the input has at least two lists and that f was previously defined:
(define (thing . lists)
(foldr (lambda (lst acc)
(f acc lst))
(f (car lists) (cadr lists))
(cddr lists)))
For example:
(define f append)
(thing '(a b) '(c d) '(e f))
=> '(a b c d e f)
I got a tree:
(A . ((C . ((D . nil)(E . nil)))
(B . ((F . nil)(G . nil)))))
I want to transform this tree into:
((A C D) (A C E) (A B F) (A B G))
I already implemented this function for doing so:
(defun tree->paths (tree &optional buff)
(labels ((recurse (follow-ups extended-list)
(if follow-ups
(append (list (tree->paths (car follow-ups) extended-list))
(recurse (cdr follow-ups) extended-list))
nil)))
(rstyu:aif (cdr tree)
(recurse it (append buff (list (car tree))))
(append buff (list (car tree))))))
But applying it results in:
(tree->paths '(A . ((C . ((D . nil) (E . nil)))
(B . ((F . nil) (G . nil))))))
=>
(((A C D) (A C E)) ((A B F) (A B G)))
I must be missing some kind of append/merge within the recursion but I am not seeing it.
You must remove the list in (append (list (tree->paths
The tree->paths returns a list of paths; so does recurse. So, they may be appended without wrapping in a list call.
Here, I've tried to rewrite it so that it would work linearly (because your original function would exhaust stack space). However, while doing so, I've discovered something, which you might consider in general re' your original idea:
(defun tree-to-paths (tree)
(loop with node = tree
with trackback = nil
with result = nil
with head = nil
with head-trackback = nil
while (or node trackback) do
(cond
((null node)
(setf node (car trackback)
trackback (cdr trackback)
result (cons head result)
head (car head-trackback)
head-trackback (cdr head-trackback)))
((consp (car node))
(setf trackback (cons (cdr node) trackback)
head-trackback (cons head head-trackback)
head (copy-list head)
node (car node)))
(t (setf head (cons (car node) head)
node (cdr node))))
finally (return (nreverse (mapcar #'nreverse result)))))
In your example data the result you want to receive seems intuitively correct, but you can think of it also as if there were more paths, such as for example:
A -> C -> NIL - From looking at your data, this result seems redundant, but in general, you may want to have these results too / it would be hard to filter them all out in general.
I started over and chose the reverse approach by going leaf to root instead of root to leaf as I tried in the question:
(defun tree->paths2 (tree)
(labels ((recurse (follow-ups)
(if follow-ups
(append (tree->paths2 (car follow-ups))
(recurse (cdr follow-ups)))
nil)))
(rstyu:aif (cdr tree)
(mapcar #'(lambda(arg)
(cons (car tree) arg))
(recurse it))
(list tree))))
(tree->paths2 '(A . ((C . ((D . nil) (E . nil)))
(B . ((F . nil) (G . nil))))))
=>
((A C D) (A C E) (A B F) (A B G))
But if there is a way to fix my first approach I'd prefer to accept such fix as an answer.
I have a nested list structure of arbitrary length, with a depth of three. The first level has arbitrary length, as does the second level, but the third level is guaranteed to have a uniform length across the whole thing. An example of said structure would be '(((A B) (C D)) ((E F) (G H)) ((I J))).
I'm trying to write a function that would apply another function across the different levels of the structure (sorry, I don't really know how to phrase that). An example of the function mapping across the example structure would be in this order:
f A C = AC, f B D = BD, f E G = EG, f F H = FH, f I = I, f J = J,
yielding
'((AC BD) (EG FH) (I J))
but imagining that the third level of the list contains many more elements (say, around 32,000 in the final version).
Essentially, what I'm trying to do would be expressed in Haskell as something like f . transpose. I know I need something like (map car (map flatten (car ...))) to get the first part of the first section, but after that, I'm really lost with the logic here. I'm sorry if this is a really convoluted, poorly explained question. I'm just really lost.
How would I go about applying the function across the structure in this manner?
(define l '(((A B)
(C D))
((E F)
(G H))
((I J)))
)
(define zip (lambda lists (apply map list lists)))
(define (f values) (list 'f values))
(map (lambda (v) (map (lambda values (apply f values)) (apply zip v))) l)
prints
(((f (a c)) (f (b d))) ((f (e g)) (f (f h))) ((f (i)) (f (j))))
It would be much easier to define your f as a function that takes in a list of values. If not, then the last form is easy to add apply to, but it doesn't make it better. (Using a rest argument means that the language will have to create these lists anyway.)
#lang racket
(define data '(((A B) (C D)) ((E F) (G H)) ((I J))))
(define (f xs) (string->symbol (string-append* (map symbol->string xs))))
(map (λ (pairs)
(list (f (map first pairs))
(f (map second pairs))))
data)
(map (λ (pairs) (map f (apply map list pairs)))
data)
(for/list ([pairs (in-list data)])
(for/list ([xs (in-list (apply map list pairs))])
(f xs)))