Non-decreasing list of lists in Scheme? - list

We need a Scheme function called nondecreaselist, which takes in a list of numbers and outputs a list of lists, which overall has the same numbers in the same order, but grouped into lists that are non-decreasing.
For example, if we have input (1 2 3 4 1 2 3 4 1 1 1 2 1 1 0 4 3 2 1), the output should be:
((1 2 3 4) (1 2 3 4) (1 1 1 2) (1 1) (0 4) (3) (2) (1))
How would you implement this? I know we have to use recursion.
My attempt so far:
(define (nondecreaselist s)
(cond ((null? s) '())
((cons (cons (car s)
((if (and (not (null? (cadr s)))
(not (> (car s) (cadr s))))
((cadr s))
('()))))
(nondecreaselist (cdr s))))))
However, this gives me the error:
(int) is not callable:

(define decrease-list
(lambda (l)
((lambda (s) (s s l cons))
(lambda (s l col)
;; limitcase1: ()
(if (null? l)
(col '() '())
;; limitcase2: (a1)
(if (null? (cdr l))
(col l '())
(let ((a1 (car l)) (a2 (cadr l)))
;; limitcase3: (a1 a2)
(if (null? (cddr l))
(if (>= a2 a1)
(col l '())
(col (list a1) (list (cdr l))))
;; most usual case: (a1 a2 ...)
(s s (cdr l)
(lambda (g l*)
(if (>= a2 a1)
(col (cons a1 g) l*)
(col (list a1) (cons g l*)))))))))))))
1 ]=> (decrease-list '(1 2 3 4 1 2 3 4 1 1 1 2 1 1 0 4 3 2 1))
;Value: ((1 2 3 4) (1 2 3 4) (1 1 1 2) (1 1) (0 4) (3) (2) (1))
I did not comment it, if you have questions you can ask but I think you can also study yourself the code I wrote for you now.
Note also that one can consider the limit cases () and (a1) out of the loop and check these cases only once:
(define decrease-list
(lambda (l)
;; limitcase1: ()
(if (null? l)
'()
;; limitcase2: (a1)
(if (null? (cdr l))
(list l)
((lambda (s) (s s l cons))
(lambda (s l col)
(let ((a1 (car l)) (a2 (cadr l)))
;; limitcase3: (a1 a2)
(if (null? (cddr l))
(if (>= a2 a1)
(col l '())
(col (list a1) (list (cdr l))))
;; most usual case: (a1 a2 ...)
(s s (cdr l)
(lambda (g l*)
(if (>= a2 a1)
(col (cons a1 g) l*)
(col (list a1) (cons g l*)))))))))))))

There are a few problems with the posted code. There is no test expression in the second cond clause; there are too many parentheses around the if and its clauses. Perhaps the most significant problem is that the code is attempting to build a non-decreasing list, which is to be consed to the result of (nondecreaselist (cdr s)), but when the non-decreasing sequence is more than one number long this starts again too soon in the input list by going all the way back to (cdr s).
Fixing Up OP Code
The logic can be cleaned up. OP code already is returning an empty list when input is an empty list. Instead of testing (null? (cadr s)) (when (cdr s) is '(), cadr won't work on s), one could test (null? (cdr s)) before code attempts a (cadr s). But it is even better to move this logic; when the input list contains one element, just return a list containing the input list: ((null? (cdr s)) (list s)).
Instead of (and (not (> ;... the logic can be made more clear by testing for > and executing the appropriate action. In this case, when (> (car s) (cadr s)) a new sublist should be started, and consed onto the list of sublists that is the result returned from nondecreaselist.
Otherwise, (car s) should be added to the first sublist in the result returned from nondecreaselist. To accomplish this, we need to construct the return list by consing s onto the first sublist, and then consing that new sublist back onto the cdr of the list of sublists that is the result returned from nondecreaselist.
Here is some revised code:
(define (nondecreaselist s)
(cond ((null? s) '())
((null? (cdr s)) (list s))
((> (car s) (cadr s))
(cons (list (car s))
(nondecreaselist (cdr s))))
(else
(let ((next (nondecreaselist (cdr s))))
(cons (cons (car s)
(car next))
(cdr next))))))
Using a Helper Function
Another approach would be to define a helper function that takes an input list and an accumulation list as arguments, returning a list of lists. The helper function would take numbers from the front of the input list and either add them to the accumulator, creating a non-decreasing list, or it would cons the accumulated non-decreasing list to the result from operating on the rest of the input.
If the input lst to the helper function ndl-helper is empty, then a list containing the accumulated non-decreasing list sublst should be returned. Note that sublst will need to be reversed before it is returned because of the way it is constructed, as described below.
If the accumulator sublst is empty, or if the next number in the input list is greater-than-or-equal-to the largest number in the sublst, then the next number should simply be added to the sublst. By consing the number onto the front of sublst, only the car of sublst needs to be checked, since this will always be the largest (or equal to the largest) value in sublst. But, since sublst is in reverse order, it will need to be reversed before adding it to the growing list of lists.
Otherwise, lst is not empty, and sublst is not empty, and the next number in the input list is less than the largest number in sublst. Thus, a new sublist needs to be started, so the old sublst is reversed and consed onto the result of the remaining computation done by calling the helper function on the remaining lst with an empty accumulator sublst:
(define (nondecreaselist-2 lst)
(define (ndl-helper lst sublst)
(cond ((null? lst) (list (reverse sublst)))
((or (null? sublst)
(>= (car lst) (car sublst)))
(ndl-helper (cdr lst) (cons (car lst) sublst)))
(else
(cons (reverse sublst) (ndl-helper lst '())))))
(ndl-helper lst '()))
Both functions work:
> (nondecreaselist '(1 2 3 4 1 2 3 4 1 1 1 2 1 1 0 4 3 2 1))
((1 2 3 4) (1 2 3 4) (1 1 1 2) (1 1) (0 4) (3) (2) (1))
> (nondecreaselist-2 '(1 2 3 4 1 2 3 4 1 1 1 2 1 1 0 4 3 2 1))
((1 2 3 4) (1 2 3 4) (1 1 1 2) (1 1) (0 4) (3) (2) (1))

Related

Racket Scheme Deleting elemts of list in range

How can I delete the values of list in range(a, b)? I tried with:
#lang racket
(define (remove L i n)
(cond ((null? L)
empty)
((> i 0)
(cons (car L) (remove (cdr L) (sub1 i) n)))
((> n 0)
(remove (cdr L) i (sub1 n)))
(else
L)))
But the result is:
(remove '(1 2 3 4 5) 2 4)
'(1 2)
(remove '(1 2 3 4 5 6 7 8 9) 2 5)
'(1 2 8 9)
I would like to have:
(remove '(1 2 3 4 5) 2 4)
'(1 5)
I think this will be easier to implement if you keep another parameter with the current index:
(define (remove L index start end)
(cond ((null? L)
empty)
((and (>= index start) (<= index end))
(remove (cdr L) (add1 index) start end))
(else
(cons (car L) (remove (cdr L) (add1 index) start end)))))
If you don't want to add one extra parameter, we can always use a named let:
(define (remove L start end)
(let loop ((lst L) (index 1))
(cond ((null? lst)
empty)
((and (>= index start) (<= index end))
(loop (cdr lst) (add1 index)))
(else
(cons (car lst) (loop (cdr lst) (add1 index)))))))
Either way, it works as expected:
(remove '(1 2 3 4 5) 2 4)
=> '(1 5)
(remove '(1 2 3 4 5 6 7 8 9) 2 5)
=> '(1 6 7 8 9)
There are two bugs:
You're using one-based indexing, so the first condition should be (> i 1);
Since the list shrinks in the first recursive clause, you need (sub1 n) there, too.
Passing n makes it count how many elements to remove rather than the index of where to stop.

Common lisp identity-groups

I am a lisp beginner and i wrote a function to group equal adjacent items in a list. I would be grateful if Lisp experts could give me some advice about a better lispy writing of this function. Thanks in advance!
(defun identity-groups (lst)
(labels ((travel (tail group groups)
(cond ((endp tail) (cons group groups))
((equal (car tail) (car (last group)))
(travel (cdr tail) (cons (car tail) group) groups))
(t (travel (cdr tail) (list (car tail)) (cons group groups))))))
(reverse (travel (cdr lst) (list (car lst)) nil))))
(identity-groups '(1 3 5 4 4 4 4 5 1 2 2 2 1 2 3 3 3 3 3 4 5 6 7))
;; => ((1) (3) (5) (4 4 4 4) (5) (1) (2 2 2) (1) (2) (3 3 3 3 3) (4) (5) (6) (7))
Looks pretty good!
(equal (car tail) (car (last group))) seems equivalent to (equal (car tail) (car group))
To keep the elements in the original order, reverse the items of every group.
As you build the resulting list groups yourself, it's safe and more efficient to use nreverse instead of reverse.
There is no name clash when using list as parameter, instead of lst, as variables and functions live in different namespaces ("Lisp-2").
It's considered good style to give utility functions like this &key test key arguments so callers can decide on when list elements are considered equal (see e.g. Common lisp :KEY parameter use), to join the club of general functions like member, find and sort.
And a documentation string! :)
Updated version:
(defun identity-groups (list &key (test #'eql) (key #'identity))
"Collect adjacent items in LIST that are the same. Returns a list of lists."
(labels ((travel (tail group groups)
(cond ((endp tail) (mapcar #'nreverse (cons group groups)))
((funcall test
(funcall key (car tail))
(funcall key (car group)))
(travel (cdr tail) (cons (car tail) group) groups))
(t (travel (cdr tail) (list (car tail)) (cons group groups))))))
(nreverse (travel (cdr list) (list (car list)) nil))))
Tests:
(identity-groups '(1 2 2 2 3 3 3 4 3 2 2 1))
-> ((1) (2 2 2) (3 3 3) (4) (3) (2 2) (1))
;; Collect numbers in groups of even and odd:
(identity-groups '(1 3 4 6 8 9 11 13 14 15) :key #'oddp)
-> ((1 3) (4 6 8) (9 11 13) (14) (15))
;; Collect items that are EQ:
(identity-groups (list 1 1 2 2 (list "A") (list "A")) :test 'eq)
-> ((1 1) (2 2) (("A")) (("A")))
The desired function fits the pattern which consists in building a value G1 from a known subresult G0 and a new value, and can be implemented using REDUCE.
The first parameter of the anonymous reducing function is the accumulator, here a list of groups. The second parameter is the new value.
(reduce (lambda (groups value)
(let ((most-recent-group (first groups)))
(if (equal (first most-recent-group) value)
(list* (cons value most-recent-group) (rest groups))
(list* (list value) groups))))
'(1 3 5 4 4 4 4 5 1 2 2 2 1 2 3 3 3 3 3 4 5 6 7)
:initial-value ())
The result is:
((7) (6) (5) (4) (3 3 3 3 3) (2) (1) (2 2 2) (1) (5) (4 4 4 4) (5) (3) (1))
One problem in your code is the call to last to access the last group, which makes the code traverse lists again and again. Generally you should avoid treating lists as arrays, but use them as stacks (only manipualte the top elment).
If you need to reverse elements, you can use do it at the end of each group (order among equivalent values), or at the end of the whole function (order among groups).
A 'classical' recursive solution
(defun identity-groups (l &key (test #'eql))
(labels ((group (l last-group acc)
(cond ((null l) (cons last-group acc))
((and last-group (funcall test (car l) (car last-group)))
(group (cdr l) (cons (car l) last-group) acc))
(t
(group (cdr l) (list (car l)) (cons last-group acc))))))
(cdr (reverse (group l '() '())))))
Older version (requires an initial-value not equal to first list element)
So the version above got rid of this key argument.
(defun identity-groups (l &key (test #'eql) (initial-value '(0)))
(labels ((group (l last-group acc)
(cond ((null l) (cons last-group acc))
((funcall test (car l) (car last-group))
(group (cdr l) (cons (car l) last-group) acc))
(t
(group (cdr l) (list (car l)) (cons last-group acc))))))
(cdr (reverse (group l initial-value '())))))
Imperative-style looping construct
Tried for fun also a looping construct with do.
(defun group-identicals (l &key (test #'eql))
(let ((lx) (tmp) (res)) ;; initiate variables
(dolist (x l (reverse (cons tmp res))) ;; var list return/result-value
(cond ((or (null lx) (funcall test x lx)) ;; if first round or
(push x tmp) ;; if last x (lx) equal to current `x`,
(setf lx x)) ;; collect it in tmp and set lx to x
(t (push tmp res) ;; if x not equal to lastx, push tmp to result
(setf tmp (list x)) ;; and begin new tmp list with x
(setf lx x)))))) ;; and set last x value to current x
(cdr (reverse (group l initial-value '())))))
;; cdr removes initial last-group value
;; test:
(group-identicals '(1 2 3 3 4 4 4 4 5 5 6 3 3 3 3))
;; ((1) (2) (3 3) (4 4 4 4) (5 5) (6) (3 3 3 3))
(group-identicals '("a" "b" "b" "c" "d" "d" "d" "e") :test #'string=)
;; (("a") ("b" "b") ("c") ("d" "d" "d") ("e"))

delete every nth item in scheme

Trying to delete every nth item in scheme recursively
(define x '(1 2 3 4 5 6 7 8 15 10))
(define ndelete
(lambda (alist nth) ;#params (list to delete items from) (nth intervals to delete items)
(cond [(null? alist) alist] ;if null, return empty list
[(if (= nth 1) (ndelete (cdr alist) nth))]
[else (list (car alist) (ndelete (cdr alist) (- nth 1)))]
)))
when i call:
> (ndelete x 5)
the output should be:
(1 2 3 4 6 7 8 15)
but i get blank output:
> (ndelete x 5)
>
At the (= nth 1) condition, you skipped the element but did not reset the nth back up to 5 (or whatever the initial value was). That means it stayed at 1 and skipped every element afterwards.
To solve this, you will need an inner function that keeps a counter, while still letting you hold on to the initial n. Here's my solution (I chose to count up to n rather than down from n):
(define (ndelete lst n)
(let recur ((i 1)
(rest lst))
(cond ((null? rest) '())
((= i n) (recur 1 (cdr rest)))
(else (cons (car rest) (recur (+ i 1) (cdr rest)))))))

Scheme - Splitting a list into two equal lists

Problem:
Write a function (split l) that takes a list and partitions it into two equal-sized (within one) lists, and returns a pair whose car is the first list and whose cdr is the second list.
My code:
(define split list)
(let ((half (/ (length list) 2)
(cons (car half list)
(cdr half list))))
Here's another possible implementation using the tortoise and hare algorithm:
(define (split lst)
(let loop ((tortoise lst) (hare lst) (acc '()))
(if (or (null? hare) (null? (cdr hare)))
(cons (reverse acc) tortoise)
(loop (cdr tortoise)
(cddr hare)
(cons (car tortoise) acc)))))
The above solution has the advantage of traversing the list only once, notice that we don't need to know the length of the list to make the split. It's called "tortoise and hare" because we keep two pointers over the list: one advances slowly, one element at a time (the "tortoise") and the other goes faster, two elements at a time (the "hare"). The algorithm stops when the hare reaches the end of the input list.
Alternatively, we can implement a more idiomatic (albeit slower) solution using built-in procedures. Assuming that the take and drop procedures are available in your interpreter (if not, import them from SRFI-1), this is closer to what you had in mind:
(define (split lst)
(let ((half (quotient (length lst) 2)))
(cons (take lst half)
(drop lst half))))
Either way, it works as expected:
(split '(1 2 3 4))
=> ((1 2) 3 4)
(split '(1 2 3 4 5))
=> ((1 2) 3 4 5)
Try:
(define (splitAt n lst)
(let loop ((acc '()) (n n) (lst lst))
(if (or (= n 0) (null? lst)) (cons (reverse acc) lst)
(loop (cons (car lst) acc) (- n 1) (cdr lst)))))
(define (split lst) (splitAt (quotient (length lst) 2) lst))
It works as follows:
(split '(1 2 3 4)) => ((1 2) 3 4)
(split '(1 2 3 4 5)) => ((1 2) 3 4 5)
Hope this helps.

Scheme function that deletes member from list and sublists

First off, if anyone can find a question where this has already been answered, let me know. All I can find are functions that remove duplicates.
Anyhow, I am trying to write a scheme function (delete V L) that takes a value and a list as arguments, and removes that value from the list and all its sublists. For example, given the following input:
> (deep-delete 3 '(1 2 3 (4 3) 5 (6 (3 7)) 8))
It would yield:
(1 2 (4) 5 (6 (7)) 8)
So far, this is what I have written, but I know that the if statement (which is to check to see if the element is a sub-list, which implies it too must be operated on) must be placed incorrectly. Also, I cannot wrap my brain around where I should be using cons and where I shouldn't, because I'm still confused about tracking the return values of the recursion. Can someone please take a look and explain what I'm doing wrong?
(define (delete V L)
(if (list? (car L)) (cons (delete V (car L) (cdr L)))
(cond
((null? L) L)
((equal? V (car L)) (delete V (cdr L)))
(else (cons (car L) (delete V (cdr L))))))))
I have a few comments on your code:
First, in your if statement you use (car L) without checking if L is empty.
Also, in line 2 of your code, you do: (delete V (car L) (cdr L)),
but cons takes two arguments, not three. And you forgot to recursively call delete on the cdr.
You wanted:
(cons (delete V (car L)) (delete V (cdr L)))
Why not use a single cond? Since there are several cases, using cond will make the recursive structure of your algorithm more apparent, and errors easier to catch.
See below.
(define (del V L)
(cond ((null? L) L)
((list? (car L))
(cons (del V (car L)) (del V (cdr L))))
((equal? V (car L)) (del V (cdr L)))
(else (cons (car L) (del V (cdr L))))))
This will recursively delete V from L.
(del 3 '(1 2 3 (4 3) 5 (6 (3 7)) 8))
==> (1 2 (4) 5 (6 (7)) 8)
This is quite easy to achieve with folding; here's an example in Racket using foldr:
(define (deep-delete elt lst (test equal?))
(foldr (lambda (e r)
(if (list? e)
(cons (deep-delete elt e test) r)
(if (test elt e) r (cons e r))))
null
lst))
testing
> (deep-delete 3 '(1 2 3 (4 3) 5 (6 (3 7)) 8))
'(1 2 (4) 5 (6 (7)) 8)
This removes subtrees from a tree (including atomic ones):
(define (remove-element needle haystack)
(let rec ((haystack haystack))
(cond
((equal? needle haystack) '())
((not (pair? haystack)) haystack)
((equal? needle (car haystack)) (rec (cdr haystack)))
((equal? needle (cdr haystack)) (cons (rec (car haystack)) '()))
(else (cons (rec (car haystack))
(rec (cdr haystack)))))))
(remove-element 'atom 'atom) ; => ()
(remove-element '(1 2 3) '((1 2 3) 1 2 3)) ; => ()
(remove-element '(1 2 3) '((1 2 3) 4 5 6)) ; => (4 5 6)
(remove-element '(1 2 3) '(3 2 1 2 3)) ; ==> (3 2)
(remove-element '3 '((1 2 3) 1 2 3)) ; ==> ((1 2) 1 2)
(remove-element '(1 2 3) '(1 2 3 4)) ; ==> (1 2 3 4)