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 '())
'()
Related
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 '())))
Im trying to write a small program that will take a list as an input and the first function is supposed to remove values that are greater than 4 and the other one is supposed to remove values that are lower than 4 in the check-expects. I figure this is a simple solution but I cant seem to figure it out as Im still new to lists and data structures. Any help would be appreciated, here is the code:
(define (removehigher lon n)
(cond [(> n lon)(remove (lon))]
[(< n lon) true]))
(define (removelower lon n)
(cond [(> n lon) true]
[(< n lon) (remove(lon))]))
(check-expect(removehigher(list 0 1 2 3 4 5 6)4)(list 0 1 2 3))
(check-expect(removelower(list 0 1 2 5 6 7) 3)(list 5 6 7))
There is a function called filter which would do this.
(define (my-filter pred lst (acc '()))
(cond [(null? lst) (reverse acc)]
[(pred (car lst)) (my-filter pred (cdr lst) (cons (car lst) acc))]
[else (my-filter pred (cdr lst) acc)]))
It is actually an in-built function filter. I use my- as prefix to not to overwrite this in-built function.
Once you have the function filter (or my-filter), you can write your desired functions easily - it is then about to define the predicate function (pred) correctly for each of the cases:
(define (remove-higher lst n)
(filter (lambda (x) (<= x n)) lst))
(define (remove-lower lst n)
(filter (lambda (x) (<= n x)) lst))
Alternatively, one could also use append-map:
(define (remove-higher lst n)
(append-map (lambda (x) (if (<= x n) (list x) '())) lst))
(define (remove-lower lst n)
(append-map (lambda (x) (if (<= n x) (list x) '())) lst))
Or define filter using append-map:
(define (my-filter pred lst)
(append-map (lambda (x) (if (pred x) (list x) '())) lst))
append-map in turn can be defined:
(define (my-append-map func lst)
(apply append (map func lst)))
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 know this question has been asked before, and my solution is the same as many of the answers but I have a special test case that won't work correctly with the common solution to this problem.
The solution that I have found for the zip problem like many others is
(define (zip l1 l2)(map list l1 l2))
. . .which works great with given arguments such as
(zip '(a b c) '(1 2 3)) => ((a 1) (b 2) (c 3))
but I also want the zip function to work for cases where my arguments do not match length like
(zip '(a b c) '(1)) => ((a 1) (b ()) (c ()))
I have not found a solution to this problem and not really sure how to approach it where each list can be any length.
First, a simple iterative version that works for 2 lists only:
(define (zip lst1 lst2 (placeholder '()))
(define (my-car lst)
(if (empty? lst) placeholder (car lst)))
(define (my-cdr lst)
(if (empty? lst) lst (cdr lst)))
(let loop ((lst1 lst1) (lst2 lst2) (res '()))
(if (and (empty? lst1) (empty? lst2))
(reverse res)
(loop (my-cdr lst1) (my-cdr lst2)
(cons (list (my-car lst1) (my-car lst2)) res)))))
such as
(zip '(a b c) '(1 2 3))
=> '((a 1) (b 2) (c 3))
(zip '(a b c) '(1))
=> '((a 1) (b ()) (c ()))
From this, you can generalise to n lists, but to avoid keyword parameters you have to put the placeholder parameter first:
(define (zip placeholder . lsts)
(define (my-car lst)
(if (empty? lst) placeholder (car lst)))
(define (my-cdr lst)
(if (empty? lst) lst (cdr lst)))
(let loop ((lsts lsts) (res '()))
(if (andmap empty? lsts)
(reverse res)
(loop (map my-cdr lsts)
(cons (apply list (map my-car lsts)) res)))))
such as
(zip '() '(a b c) '(1 2 3))
==> '((a 1) (b 2) (c 3))
(zip '() '(a b c) '(1))
==> '((a 1) (b ()) (c ()))
(zip '() '(a b c) '(1) '(x y))
=> '((a 1 x) (b () y) (c () ()))
I believe that andmap is the only Racket-specific function here, which probably has some Scheme or SRFI equivalent depending on your implementation.
EDIT
Since the solution is based on creating lists of equal length, instead of duplicating the zip algorithm, you can also first add the placeholders to the lists before doing the classic map-list stuff:
(define (zip placeholder . lsts)
(let* ((max-len (apply max (map length lsts))) ; the length of the longest lists
(equal-length-lists ; adjusts all lists to the same length,
(map ; filling with placeholder
(lambda (lst) (append lst (make-list (- max-len (length lst)) placeholder)))
lsts)))
(apply map list equal-length-lists))) ; classical zip
It's not semantically correct to have (zip '(a b c) '(1)) => ((a 1) (b ()) (c ())) (unless you're specifically using () as a placeholder value); it's more sensible to have ((a 1) (b) (c)). Here's an implementation that achieves that:
(define (zip-with-uneven . lists)
(define (advance lst)
(if (null? lst)
lst
(cdr lst)))
(define (firsts lists)
(let loop ((lists lists)
(result '()))
(cond ((null? lists) (reverse result))
((null? (car lists)) (loop (cdr lists) result))
(else (loop (cdr lists) (cons (caar lists) result))))))
(let loop ((lists lists)
(results '()))
(if (andmap null? lists)
(reverse results)
(loop (map advance lists)
(cons (firsts lists) results)))))
andmap is from Racket. If you're not using Racket, you can use every from SRFI 1 instead.
If you really want to use a placeholder, here's a (Racket-specific) version that supports placeholders. The default placeholder is (void), which I presume is never a valid value you'd want to put in your result list.
(define (zip-with-uneven #:placeholder (ph (void)) . lists)
(define (advance lst)
(if (null? lst)
lst
(cdr lst)))
(define (cons-with-placeholder a d)
(if (void? a)
d
(cons a d)))
(define (firsts lists)
(let loop ((lists lists)
(result '()))
(cond ((null? lists) (reverse result))
((null? (car lists))
(loop (cdr lists) (cons-with-placeholder ph result)))
(else (loop (cdr lists) (cons (caar lists) result))))))
(let loop ((lists lists)
(results '()))
(if (andmap null? lists)
(reverse results)
(loop (map advance lists)
(cons (firsts lists) results)))))
I am trying to write a code using SCHEME that takes two arguments, for example '(2 1 3) & '(a b c) and gives a list '(b a c). My code is not working either recursive or iterative. Any help!!
(define project
(lambda (list1 list2 list3 n b index)
(define n (length(list1)))
(let ((i n))
(for-each (i)
(cond
((null? list1) (display "empty"))
(else
(define n (car list1))
(define index (- n 1))
(define b (list-ref list2 index))
(define list3 (cons list3 b))
(define list1 (cdr list1))
list3 ))))))
(define (rearrange order l)
(cond ((number? order) (rearrange (list order) l))
((list? order) (map (lambda (num) (list-ref l (- num 1))) order))
(else 'bad-order)))
If you need order to be 'complex' (like '(1 (2 3) 4)) then use this:
(define (listify thing)
(cond ((null? thing) '())
((pair? thing) (apply append (map listify thing)))
(else (list thing))))
> (listify 10)
(10)
> (listify '(1 (2 3) 4))
(1 2 3 4)
>
and then
(define (rearrange order l)
(map (lambda (num) (list-ref l (- num 1)))
(listify order)))
Here's a version that handles arbitrarily-nested lists: first, a nested-map that is like map but handles nested lists:
(define (nested-map func tree)
(if (list? tree)
(map (lambda (x)
(nested-map func x))
tree)
(func tree)))
Then, we create a mapper to use with it (using list-ref if the list is shorter than 16 elements, otherwise copying to a vector first for better scalability):
(define (rearrange indices lst)
(define mapper (if (< (length lst) 16)
(lambda (i)
(list-ref lst (- i 1)))
(let ((vec (list->vector lst)))
(lambda (i)
(vector-ref vec (- i 1))))))
(nested-map mapper indices))
Notice how, after the mapper is defined, the function is simply a single call to nested-map. Easy! :-D
First that came to mind:
(define (rearrange order symbols)
(define (element i list)
(if (= i 1)
(car list)
(element (- i 1) (cdr list))))
(define (iter order output)
(if (null? order)
output
(iter (cdr order)
(append output (list (element (car order) symbols))))))
(iter order '()))
Better solution:
(define (rearrange order symbols)
(define (nth-element i list)
(if (= i 1)
(car list)
(nth-element (- i 1) (cdr list))))
(map (lambda (x) (nth-element x symbols)) order))
Here's a simple version for un-nested lists:
(define (arrange idx lst)
(map (lambda (i) (list-ref lst i)) idx))
(arrange '(1 0 2) '(a b c))
=> '(b a c)
If you need to use nested lists, flatten comes in handy:
(define (arrange idx lst)
(map (lambda (i) (list-ref lst i)) (flatten idx)))
(arrange '(1 (0 2)) '(a b c))
=> '(b a c)
Note that I use 0-based indexes, as is the custom in Scheme.