Scheme zip function with possible uneven lists - list

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)))))

Related

Return a list without the last element

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))))

How to remove duplicates from a list which might contain lists in Racket

The code I've written:
(define (make-list lst)
(cond [(null? lst) '()]
[(member (car lst) (cdr lst)) (make-list (cdr L))]
[else (cons (car lst) (duplicates (cdr lst)))]))
I want (make-list '(a (a b b (c b) 3) 5 5.0 (e s) (s e s))))) to return:
(a (a b (c b) 3) 5 (e s))
But my procedure returns
'((a b b (c b) 3) 5 5.0 (e s) (s e s))
So it doesn't really do anything besides removing the first element, it doesn't go into the nested lists. Any help would be appreciated
I'm assuming duplicates and L are forgotten rename mistakes. make-list isn't really a good name since it is a well known procedure in the list library of R7RS, originally from SRFI-1 List library. remove-duplicates might be a better fit?
(define (remove-duplicates lst)
(cond [(null? lst) '()]
[(member (car lst) (cdr lst))
(remove-duplicates (cdr lst))]
[else
(cons (car lst) (remove-duplicates (cdr lst)))]))
Now this does all the elements in the given list and it only concerns itself with the top level list. sub lists are compared too:
(remove-duplicates '(a (b c) (b c) a))
; ==> ((b c) a)
You need to instead of just making a list with the first element also check if the first element is a list and do remove-duplicates on both parts. Thus you need to do add a term like this:
(define (remove-duplicates lst)
(cond [(null? lst) '()]
[(member (car lst) (cdr lst))
(remove-duplicates (cdr lst))]
[(list? (car lst)) ; or pair?
(cons (remove-duplicates (car lst))
(remove-duplicates (cdr lst)))]
[else
(cons (car lst)
(remove-duplicates (cdr lst)))]))
(remove-duplicates '((a b b a) (a b b a)))
; ==> ((b a))

How to make pairs from a numeric list based on cardinality?

I have a list '(1 2 1 1 4 5) and want output list as '((1 3)(2 1)(4 1)(5 1)). I have written a small code but I am stuck with how to calculate the cardinality for each number and then put it as pair in list. Can anyone please look at my code and give some ideas?
(define set2bags
(lambda (randlist)
(cond ((null? randlist) '())
(else
(sort randlist)
(makepairs randlist)))))
(define makepairs
(lambda (inlist)
(let ((x 0)) ((newlist '()))
(cond ((zero? (car inlist)) '())
(else
(eq? (car inlist)(car (cdr inlist)))
(+ x 1)
(makepairs (cdr inlist))
(append newlist (cons (car inlist) x)))))))
Your current solution is incorrect - it doesn't even compile. Let's start again from scratch, using a named let for traversing the input list:
(define set2bags
(lambda (randlist)
(cond ((null? randlist) '())
(else (makepairs (sort randlist >))))))
(define makepairs
(lambda (inlist)
(let loop ((lst inlist)
(prv (car inlist))
(num 0)
(acc '()))
(cond ((null? lst)
(cons (list prv num) acc))
((= (car lst) prv)
(loop (cdr lst) prv (add1 num) acc))
(else
(loop (cdr lst) (car lst) 1 (cons (list prv num) acc)))))))
Now it works as expected:
(set2bags '(1 2 1 1 4 5))
=> '((1 3) (2 1) (4 1) (5 1))
The trick is keeping a counter for the cardinality (I called it num), and incrementing it as long as the same previous element (I named it prv) equals the current element. Whenever we find a different element, we add a new pair to the output list (called acc) and reset the previous element and the counter.
Your code is fairly hard to read without proper formating.
I notice a two branch cond, which is easier to read as an if.
In your else clause of set2bags, you call (sort randlist) but leave it as is. You actually want to use this in the next s-expression (makepairs (sort randlist))
So far a pretty good idea.
Now in makepairs you should have better abstraction, say let variables like-first and unlike-first. If the inlist is null, then the function should be the null list, else it's the pair with the car being the list of the car of like-first and the length of like-first and the cdr being the result of calling makepairs on the unlike-first list
(define (makepairs inlist)
(let ((like-first (filter (lambda (x) (equal? x (car inlist)) inlist))
(unlike-first (filter (lambda (x) (not (equal? x (car inlist))) inlist)))
(if (null? inlist)
'()
(cons (list (car inlist) (length like-first)) (makepairs unlike-first)))))
more effecient version
(define (makepairs inlist)
(if (null? inlist)
'()
(let loop ((firsts (list (car inlist)))
(but-firsts (cdr inlist)))
(if (or (null? but-firsts)
(not (equal? (car firsts) (car but-firsts))))
(cons (list (car firsts) (length firsts))
(makepairs but-firsts))
(loop (cons (car but-firsts) firsts) (cdr but-firsts))))))
]=> (makepairs (list 1 1 1 2 4 5))
;Value 17: ((1 3) (2 1) (4 1) (5 1))
If you have your own implementation of sort, say a mergesort you could write this right into the merge part for the best effeciency.
(define (set2bags lst)
(mergesort2bags lst <))
(define (mergesort2bags lst pred)
(let* ((halves (divide-evenly lst))
(first-half (car halves))
(other-half (cadr halves)))
(cond ((null? lst) '())
((null? (cdr lst)) (list (list (car lst) 1)))
(else
(merge-bags
(mergesort2bags first-half pred)
(mergesort2bags other-half pred)
pred)))))
(define (divide-evenly lst)
(let loop
((to-go lst)
(L1 '())
(l2 '()))
(if (null? to-go)
(list L1 L2)
(loop (cdr to-go) (cons (car to-go) L2) L1))))
(define (merge-bags L1 L2 pred)
(cond ((null? L1) L2)
((null? L2) L1)
((pred (caar L1) (caar L2))
(cons (car L1) (merge-bags (cdr L1) L2 pred)))
((equal? (caar L1) (caar L2))
(cons (list (caar L1) (+ (cadar L1) (cadar L2)))
(merge-bags (cdr L1) (cdr L2) pred)))
(else (cons (car L2) (merge-bags L1 (cdr L2) pred)))))
(mergesort2bags (list 1 2 1 1 4 5) <)
;Value 46: ((1 3) (2 1) (4 1) (5 1))
I'm thinking for very large datasets with a lot of repetition this method would pay off.

rearrange elements in a List using Scheme

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.

Scheme extract unique atoms from list

I'm trying to write a scheme function that will return the unique atoms found in the input list such that.
> (unique-atoms '(a (b) b ((c)) (a (b))))
(a c b)
> (unique-atoms '(a . a))
(a)
> (unique-atoms '())
()
I was thinking something like this as a start
(define (unique-atoms l)
(if (null? l)
'()
(eq? (car (l) unique-atoms(cdr (l))))))
but I don't know how to collect the atoms that are unique, and create a new list while checking everything recursively.
The following walks list, term by term. If the next value is a list itself, then a recursive call is made with (append next rest) - that is, as list is walked we are flattening sublists at the same time.
We use a (tail) recursive function, looking, to walk the list and to accumulate the rslt. We add to the result when next is not alreay in rslt.
(define (uniquely list)
(let looking ((rslt '()) (list list))
(if (null? list)
rslt
(let ((next (car list))
(rest (cdr list)))
(if (list? next)
(looking rslt (append next rest))
(looking (if (memq next rslt)
rslt
(cons next rslt))
rest))))))
> (uniquely '(a b (a b) ((((a))))))
(b a)
If you really want the code to work for 'improper lists' like '(a . a) then the predicates null? and list? probably need to change.
This problem has two parts:
You need to find a way to visit each element of the given form, recursing into sublists.
You need a way to collect the unique elements being visited.
Here's a solution to the first part:
(define (recursive-fold visitor initial x)
(let recur ((value initial)
(x x))
(cond ((null? x) value)
((pair? x) (recur (recur value (car x)) (cdr x)))
(else (visitor x value)))))
I leave it for you to implement the second part.
I found a half solution where the non unique items are removed, although this wont work for an atom b and a list with b such as '(b (b))
(define (uniqueAtoms l)
(cond ((null? l)
'())
((member (car l) (cdr l))
(uniqueAtoms (cdr l)))
(else
(cons (car l) (uniqueAtoms (cdr l))))))
The easiest way to solve this problem with all kinds of list structures is to divide it into two parts
1) flatten then list - this results in a proper list with no sublists
; if you use Racket, you can use the build-in flatten procedure
; otherwise this one should do
(define (flatten expr)
(let loop ((expr expr) (res '()))
(cond
((empty? expr) res)
((pair? expr) (append (flatten (car expr)) (flatten (cdr expr))))
(else (cons expr res)))))
2) find all unique members of this proper list
(define (unique-atoms lst)
(let loop ((lst (flatten lst)) (res '()))
(if (empty? lst)
(reverse res)
(let ((c (car lst)))
(loop (cdr lst) (if (member c res) res (cons c res)))))))
Tests:
; unit test - Racket specific
(module+ test
(require rackunit)
(check-equal? (unique-atoms '(a (b) b ((c)) (a (b)))) '(a b c))
(check-equal? (unique-atoms '(a (b) b ((c . q)) (a (b . d)))) '(a b c q d))
(check-equal? (unique-atoms '(a . a)) '(a))
(check-equal? (unique-atoms '(a b (a b) ((((a)))))) '(a b))
(check-equal? (unique-atoms '()) '()))