I have following task:
Define a function replace-element that searches a given list for a given element x and replaces each element x with a given element y.
I am a super beginner and have no idea how to do this.
Maybe there is someone who can help me. Thanks a lot!!
For example:
(replace-element ‘a ‘b ‘(a b c a b c))
(B B C B B C)
Here is a way of doing this which, again, you probably cannot submit as homework, but it shows you an approach.
First of all, tconc and friends to accumulate lists:
(defun empty-tconc ()
;; make an empty accumulator for TCONC
(cons nil nil))
(defun tconc (v into)
;; destructively add V to the end of the accumulator INTO, return
;; INTO
(if (null (car into))
(setf (car into) (list v)
(cdr into) (car into))
(setf (cdr (cdr into)) (list v)
(cdr into) (cdr (cdr into))))
into)
(defun tconc-value (into)
;; Retrieve the value of an accumulator
(car into))
Next the answer:
(defun replace-element (x y l)
(replace-element-loop x y l (empty-tconc)))
(defun replace-element-loop (x y l accumulator)
(if (null l)
(tconc-value accumulator)
(replace-element-loop
x y (rest l)
(tconc (if (eql (first l) x) y (first l)) accumulator))))
Or you do the tail call recursion in one function using optional arguments or key arguments:
(defun replace-element (element replacer l &key (acc '()) (test #'eql))
(cond ((null l) (nreverse acc))
((funcall test (car l) element) (replace-element element replacer (cdr l) :acc (cons replacer acc) :test test))
(t (replace-element element replacer (cdr l) :acc (cons (car l) acc) :test test))))
It is also possible to use reduce for this:
(defun replace-element (element replacer l &key (test #'eql))
(nreverse
(reduce (lambda (res el)
(if (funcall test el element)
(cons replacer res)
(cons el res)))
l
:initial-value '())))
Related
I've just started to learn Racket.
I have this code:
#lang racket
(define l1 '(1 2 3 4))
(car l1)
(cdr l1)
(car l1) returns 1.
(cdr l1) returns '(2 3 4)
Is there a function that returns '(1 2 3)?
I've tried this:
#lang racket
(define l1 '(1 2 3 4))
(map
(lambda (l i)
(if (not (= i (sub1 (length l1)))) l '()))
l1 (range 0 (length l1)))
But, it returns: '(1 2 3 ())
And I have also tried:
#lang racket
(define l1 '(1 2 3 4))
(map
(lambda (l i)
(cond ((not (= i (sub1 (length l1)))) l )))
l1 (range 0 (length l1)))
But, it returns: '(1 2 3 #<void>)
The map function always returns a list the same length as its input. You want an output list that is shorter than its input. The function you are looking for is traditionally called but-last:
(define (but-last xs) (reverse (cdr (reverse xs))))
What about something like this ?
(define (myCdr l)
(if (not (pair? (cdr l)))
'()
(cons (car l) (myCdr (cdr l)))
)
)
length is generally an anti-pattern in Scheme because the entire list needs to be read in order to get the result. W. Ness remarks that map does not alter the structure of the list, and the behavior of filter is based on the list's values, neither of which suit your needs.
Instead of making potentially expensive computations first or awkwardly applying the library functions, you can compute the init of a list using direct recursion -
(define (init l)
(cond ((null? l)
(error 'init "cannot get init of empty list"))
((null? (cdr l))
null)
(else
(cons (car l)
(init (cdr l))))))
(init '(a b c d e)) ;; '(a b c d)
(init '(a)) ;; '(a)
(init '()) ;; init: cannot get init of empty list
Or a tail-recursive form that only uses one reverse -
(define (init l)
(let loop ((acc null)
(l l))
(cond ((null? l)
(error 'init "cannot get init of empty list"))
((null? (cdr l))
(reverse acc))
(else
(loop (cons (car l) acc)
(cdr l))))))
(init '(a b c d e)) ;; '(a b c d)
(init '(a)) ;; '(a)
(init '()) ;; init: cannot get init of empty list
And lastly a tail-recursive form that does not use length or reverse. For more intuition on how this works, see "How do collector functions work in Scheme?" -
(define (init l (return identity))
(cond ((null? l)
(error 'init "cannot get init of empty list"))
((null? (cdr l))
(return null))
(else
(init (cdr l)
(lambda (r)
(return (cons (car l) r)))))))
(init '(a b c d e)) ;; '(a b c d)
(init '(a)) ;; '(a)
(init '()) ;; init: cannot get init of empty list
Here's one more, via zipping:
#lang racket
(require srfi/1)
(define (but-last-zip xs)
(if (null xs)
xs ; or error, you choose
(map (lambda (x y) x)
xs
(cdr xs))))
Here's another, emulating filtering via lists with appending, where empty lists disappear by themselves:
(define (but-last-app xs)
(if (null? xs)
xs
(let ((n (length xs)))
(apply append ; the magic
(map (lambda (x i)
(if (= i (- n 1)) '() (list x)))
xs
(range n))))))
Or we could use the decorate--filter--undecorate directly, it's even more code!
(define (but-last-fil xs)
(if (null? xs)
xs
(let ((n (length xs)))
(map car
(filter (lambda (x) (not (null? x)))
(map (lambda (x i)
(if (= i (- n 1)) '() (list x)))
xs
(range n)))))))
Here's yet another alternative, assuming that the list is non-empty. It's efficient (it performs a single pass over the list), and it doesn't get any simpler than this!
(define (delete-last lst)
(drop-right lst 1))
(delete-last '(1 2 3 4))
=> '(1 2 3)
Here is an equivalent of Will Ness's beautiful but-last-zip which does not rely on srfi/1 in Racket: without srfi/1 Racket's map insists that all its arguments are the same length (as does the R5RS version in fact) but it is common in other Lisps to have the function terminate at the end of the shortest list.
This function uses Racket's for/list and also wires in the assumption that the result for the empty list is the empty list.
#lang racket
(define (but-last-zip xs)
(for/list ([x xs] [y (if (null? xs) xs (rest xs))])
x))
I think Will's version is purer: mapping functions over things is a very Lisp thing to do I think, while for/list feels less Lispy to me. This version's only advantage is that it does not require a module.
My own solution using recursion:
#lang racket
(define but-last
(lambda (l)
(cond ((null? (cdr l)) '())
(else (cons (car l) (but-last (cdr l)))))))
And another solution using filter-not and map:
#lang racket
(define l1 '(1 2 3 4))
(filter-not empty? (map
(lambda (l i)
(if (not (= i (sub1 (length l1)))) l empty))
l1 (range 0 (length l1))))
I was reading the book On Lisp by Paul Graham. In Chapter 4, Utility Functions, he gives examples of small functions that operate on lists, which would be helpful while writing a larger program.
One of them is flatten. Given a nested list at any arbitrary level as argument, flatten will remove all the nested elements and put them on the top level.
Below is my attempt at implementing flatten:
(defun flatten (lst)
(labels ((rflatten (lst1 acc)
(dolist (el lst1)
(if (listp el)
(rflatten el acc)
(push el acc)))
acc))
(reverse (rflatten lst nil))))
But the above function does not flatten lists properly.
; returns (1) instead of (1 2)
(print (flatten '(1 (2))))
(1)
Calling the function with (1 (2)) returns (1) instead of (1 2).
I cannot find what's wrong with my implementation of flatten. Is it the way I am using
labels? Or is it the the way I am using the dolist macro? The dolist macro always returns nil. But that should not matter as I am using an accumulator acc to store the flattened list.
push changes the symbol binding in scope. Thus the recursion (rflatten el acc) has it's own acc which is the result there but you don't do anything with the returned result and it doesn't alter the callee acc.
Perhaps a (setf acc (rflatten el acc)) would fix that:
(defun flatten (lst)
(labels ((rflatten (lst1 acc)
(dolist (el lst1)
(if (listp el)
(setf acc (rflatten el acc))
(push el acc)))
acc))
(reverse (rflatten lst nil))))
You're actually very close. As Sylwester mentions, the issue is that (push el acc) only modifies the local binding of el (of which there's a new one for each call to rflatten. As Rainer mentions, it's not really an accumulator in the traditional sense, so I'm going not going to call it acc, but result. Since you're already defining a local function, there's no reason not to define result in a wider scope:
(defun flatten (lst)
(let ((result '()))
(labels ((rflatten (lst1)
(dolist (el lst1)
(if (listp el)
(rflatten el)
(push el result)))))
(rflatten lst)
(nreverse result))))
There are actually a few ways to clean this up, too. The first is a matter of style and taste, but I'd use an &aux variable to bind result, so
(defun flatten (lst &aux (result '()))
...)
The next is that dolist can take a third argument, a form to evaluate as for the return value. This is often used in a "push to create a list, then reverse for the return value" idiom, e.g.,
(let ((result '()))
(dolist (x list (nreverse result))
...
(push ... result)))
You don't want to reverse after every dolist, but you can still return result from the dolist, and thus from rflatten. Then you can simply call nreverse with the result of rflatten:
(defun flatten (lst &aux (result '()))
(labels ((rflatten (lst1)
(dolist (el lst1 result)
(if (listp el)
(rflatten el)
(push el result)))))
(nreverse (rflatten lst))))
A non-recursive code which builds the result by conses, following comments and starting from a code by user:Sylwester:
(defun flatten (lst &optional back acc)
(loop
(cond
((consp lst) (psetq lst (cdr lst) ; parallel assignment
back (cons (car lst) back)))
(back
(if (consp (car back))
(psetq lst (cdar back)
back (cons (caar back) (cdr back)))
(psetq acc (if (car back) (cons (car back) acc) acc)
back (cdr back))))
(t
(return acc))))) ; the result
It's not pretty, but it seems to work. Parallel assignment PSETQ is used to simulate tail-recursive call frame update without worrying about precise sequencing.
Implements the same process as the one encoded nicely by
(defun flatten2 (l z)
(cond
((endp l) z)
((listp (car l)) (flatten2 (car l) (flatten2 (cdr l) z)))
((atom (car l)) (cons (car l) (flatten2 (cdr l) z)))))
(defun flatten (l)
(flatten2 l nil))
with implicit stack operations explicated as list structure manipulations among the variables.
I discovered a solution which does not use helper functions or variable assignment, and constructs the list in a forward manner, which I think is easier to understand.
(defun flatten (lst &aux (re '()))
(cond
((null lst) '())
((listp (car lst))
(append (flatten (car lst))
(append (flatten (cdr lst))
re)))
(t (cons (car lst)
(append (flatten (cdr lst)) re)))))
And we can easily adapt it to control the depth of the flattening!
(defun flatten* (lst depth &aux (re '()))
(cond
((null lst) '())
((listp (car lst))
(append (cond
((= 0 depth) ; flatten none
(list (car lst)))
((< 0 depth) ; flatten down
(flatten* (car lst) (- depth 1)))
((= -1 depth) ; flatten all
(flatten* (car lst) depth))
((< depth -1) ; flatten up
(list (flatten* (car lst) (+ depth 1)))))
(append (flatten* (cdr lst) depth)
re)))
(t (cons (car lst)
(append (flatten* (cdr lst) depth) re)))))
I'm new to Scheme and I'm trying to write a procedure which combines n list into a list of n-tuples. If the lists are of different size, the tuples should contain the empty list () when the corresponding list ran out of elements.
My current implementation is the following:
(define (comb list1 list2)
(cond [(empty? list1) empty]
[(empty? list2) empty]
[else (cons (list (first list1) (first list2))
(comb (rest list1) (rest list2)))]))
However, this program doesn't produce another tuple when there are no more items in the list to combine. For instance, (comb '(1 2 3 ) '(3 4)) produces only ((1 3) (2 4))
How do I solve it?
This is a bit tricky, and I believe it's not an appropriate exercise for someone who is just learning the basics of the language. Anyway, here's my proposed solution, in terms of higher-order procedures:
; helper procedure for filling a list with arbitrary values at the end
(define (fill lst val num)
(append lst
(build-list num (const val))))
; helper procedure for transposing a list of lists
(define (transpose lsts)
(apply map list lsts))
; main procedure
(define (list-tuples lsts)
(let* ((lengths (map length lsts)) ; obtain the length of each sublist
(max-length (apply max lengths))) ; find out the maximum length
(transpose ; build new sublists element-wise
(map (lambda (lst len) ; build sublists of the right length
(fill lst '() (- max-length len))) ; fill sublists with '()
lsts
lengths))))
The trick was to find the maximum length of the lists and then build new lists with that length, filling them with '() at the end. After that, it's a simple matter of building the answer by taking one element from each sublist. It works as expected:
(list-tuples '((m n o) (1) (x y)))
=> '((m 1 x) (n () y) (o () ()))
You need to specifically deal with the situation where one of the lists is empty. The following does what I think you want with two lists.
(define (comb l1 l2)
(cond
((empty? l1)
(cond
((empty? l2) '())
(else (cons (list '() (car l2)) (comb l1 (cdr l2))))))
(else
(cond
((empty? l2) (cons (list (car l1) '()) (comb (cdr l1) l2)))
(else (cons (list (car l1) (car l2)) (comb (cdr l1) (cdr l2))))))))
Let's split the problem into 2 parts.
First let's assume a procedure that will take a list, and return the following results:
a list containing the first items of each sublist
a list containing the remainder of each sublist
the number of non-empty lists encountered
An example implementation could be:
(define (split-tuples lst)
(let loop ((lst lst) (fst null) (rst null) (cnt 0))
(if (null? lst)
(values (reverse fst) (reverse rst) cnt)
(let ((c (car lst)))
(if (null? c)
(loop (cdr lst) (cons c fst) (cons c rst) cnt)
(loop (cdr lst) (cons (car c) fst) (cons (cdr c) rst) (add1 cnt)))))))
Testing:
> (split-tuples '((m n o) (1) (x y)))
'(m 1 x)
'((n o) () (y))
3
> (split-tuples '((n o) () (y)))
'(n () y)
'((o) () ())
2
> (split-tuples '((o) () ()))
'(o () ())
'(() () ())
1
> (split-tuples '(() () ()))
'(() () ())
'(() () ())
0
Now using this procedure we create the main procedure that will just loop until all sublists are empty:
(define (list-tuples lst)
(let loop ((lst lst) (res null))
(let-values (((fst rst cnt) (split-tuples lst)))
(if (zero? cnt)
(reverse res)
(loop rst (cons fst res))))))
Testing:
> (list-tuples '((m n o) (1) (x y)))
'((m 1 x) (n () y) (o () ()))
> (list-tuples '())
'()
This program takes a list where elements are repeated, e.g L = (a a a b b b c c c d), and output a list of items and number of repetition e.g ((a 3)(b 3)(c 3) d)
(define counter 0)
(define (compress liste)
(if (or (null? liste) (null? (cdr liste)))
liste
(let ((compressed-cdr (compress (cdr liste))))
(if (equal? (car liste) (car compressed-cdr))
((+ counter 1) compressed-cdr)
((cons (car liste) counter) (= counter 0) (compressed-cdr))))
))
However, I get this error:
Error: application: not a procedure; expected a procedure that can be applied to arguments
given: 1 arguments ...
The error is at the true predicate of the second if condition.
Building the result list in a top-down manner, with the "head-sentinel trick", for simplicity:
(define (rle lst)
(if (null? lst)
'()
(let ((res (list 1))) ; head sentinel
(let loop ((p res) ; result's last cons cell
(elt (car lst))
(cnt 1)
(lst (cdr lst)))
(if (and (not (null? lst))
(equal? elt (car lst)))
(loop p elt (+ cnt 1) (cdr lst))
(begin
(set-cdr! p (list (if (= 1 cnt) elt (list elt cnt))))
(if (null? lst)
(cdr res) ; skip the head in result, on return
(loop (cdr p) (car lst) 1 (cdr lst)))))))))
As #uselpa explained, this is called run-length encoding; for the uniformity of the result I'd suggest using (x 1) representation for non-repeating elements.
And the error "Error: application: not a procedure; expected a procedure", as others have said, means that the system expected to find a procedure but found something else, so can't apply it. Scheme expects to find a procedure as the first form in a list: (proc args ...), and tries to apply it to the arguments. But in your code it is not a procedure, but some other type of data.
If your Scheme has left fold, or reduce, you can run through it twice - first collecting the uniform results, and then applying your special format while reversing (left fold's results are usually built in reversed order):
(define (fold f init lst) ; if fold is not defined,
(reduce f init (cons init lst))) ; define it in terms of reduce
(define (rle lst)
(fold (lambda (x acc) ; NB! MIT-Scheme: (acc x)
(if (= 1 (cadr x)) (cons (car x) acc) (cons x acc)))
'()
(fold (lambda (x acc) ; NB! MIT-Scheme: (acc x)
(if (or (null? acc) (not (equal? (caar acc) x)))
(cons (list x 1) acc)
(cons (list x (+ (cadar acc) 1)) (cdr acc))))
'()
lst)))
As the error message says, the problem is located "at the true predicate of the second if condition":
((+ counter 1) compressed-cdr)
In this case, (+ counter 1) should evaluate to a procedure but it evaluates to a number. I think the problem is that you don't know how to increment the counter.
Your false predicate has the same problem:
((cons (car liste) counter) (= counter 0) (compressed-cdr))))))
where (cons (car liste) counter) yields a list and not a procedure.
I don't think we could really work with this code. I suggest looking at R Sahu's answer, which is close. Alternatively, I can show you a tail-recursive version which you could also have a look at. BTW, this is called run-length encoding, hence I've called my procedure rle:
(define (rle lst)
(define (newres prv cnt res)
(case cnt
((0) res)
((1) (cons prv res))
(else (cons (list prv cnt) res))))
(let loop ((lst lst) (prv null) (cnt 0) (res null))
(if (null? lst)
(if (zero? cnt)
(reverse res)
(loop null null 0 (newres prv cnt res)))
(let ((c (car lst)))
(if (eq? c prv)
(loop (cdr lst) prv (add1 cnt) res)
(loop (cdr lst) c 1 (newres prv cnt res)))))))
It was hard for me to figure out where the problem is in your code. I tried the following that seems to work.
(define (compress liste)
(define (helper in prev out)
(if (null? in)
(list (list (car out) (length out)))
(if (equal? prev (car in))
(helper (cdr in) prev (append out (list (car in))))
(cons (list (car out) (length out)) (compress in)))))
(if (null? liste)
'()
(helper (cdr liste) (car liste) (list (car liste))))
)
It uses helper to gather the output for matching items. When it finds a mismatch, it calls the main function to process the rest of the list. helper simply prepends its results to the results obtained from the main function.
A slightly improved version:
(define (compress liste)
(define (helper in prev out)
(if (null? in)
(list (list prev out))
(if (equal? prev (car in))
(helper (cdr in) prev (+ 1 out))
(cons (list prev out) (compress in)))))
(if (null? liste)
'()
(helper (cdr liste) (car liste) 1))
)
Here's tail-recursive version:
(define (compress liste)
(define (helper-1 in out)
(if (null? in)
'()
(helper-2 (cdr in) (car in) 1 out)))
(define (helper-2 in prev count out)
(if (null? in)
(append out (list (list prev count)))
(if (equal? prev (car in))
(helper-2 (cdr in) prev (+ 1 count) out)
(helper-1 in (append out (list (list prev count)))))))
(helper-1 liste '()))
I'm trying to add a given variable x to a list L. Both of which are parameters of the function ADDV. The code I have so far is as follows:
(defun addV(L x)
(cond
((eq L nil) nil)
((eq (cdr L) nil) (list(+(car L) x)))
(+ x (first(last L)))
(butlast L)
(append L x) ) )
With the parameters
L = '(1 2 3 4)
x = 2
When the statement: (+ x (first(last L)))) is evaluated, it's value is 4. The final goal should be
L = '(1 2 3 6)
I'm not sure what I'm doing wrong. Any help would be greatly appreciated. Thanks.
Your code is badly formatted. Re-indenting, we get
(defun addV(L x)
(cond
((eq L nil)
nil)
((eq (cdr L) nil)
(list (+ (car L) x)))
(+
x
(first (last L)))
(butlast
L)
(append
L
x) ) )
do you see the problem now?
Since (not +) is NIL, the corresponding clause in the COND form is entered. Its body's forms (x and (first (last L))) are evaluated for effects, of which there are none. Then the last form's value is returned.
What you evidently wanted it to be, is
(defun addV (L x)
(cond
((eq L nil)
nil)
((eq (cdr L) nil)
(list (+ (car L) x)))
(T
(append
(butlast L)
(list (+ x (first (last L))))))))
Coincidentally, the 2nd clause it completely unnecessary and may just be omitted, making it
(defun addV (L x)
(if (not (null L))
(append (butlast L)
(list (+ x (first (last L)))))))
If you can do this destructively, then you can use incf and last:
(defun increment-last (list x)
(prog1 list ; return the list
(incf (first (last list)) x)))
If you do need to make a new list, you'll have to walk to the end of the list to get to the last element. While you're doing that, you could keep track of the elements you've already seen (in reverse order) and efficiently use that reverse order list to construct the new list for you using nreconc:
(defun plus-last (list x)
(do ((list list (rest list))
(rhead '() (list* (first list) rhead)))
((endp (rest list))
(nreconc rhead (list (+ x (first list)))))))
CL-USER> (plus-last '(1 2 3 4) 2)
(1 2 3 6)
If you're not so comfortable with do syntax, you could use a tail recursive function, too (which some Common Lisp implementations can optimize into a loop):
(defun plus-last (list x)
(labels ((pl (list rhead)
(if (endp (rest list))
(nreconc rhead (list (+ x (first list))))
(pl (rest list)
(list* (first list) rhead)))))
(pl list '())))
You could also use loop, and express the logic pretty clearly:
(defun plus-last (list x)
(loop for (a . b) on list
if (null b) collect (+ a x)
else collect a))
This could also be done with maplist:
(defun plus-last (list x)
(maplist (lambda (list)
(if (endp (rest list))
(+ x (first list))
(first list)))
list))