Racket Scheme Deleting elemts of list in range - list

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.

Related

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 listing sucessive averages in reverse

I am trying to list sucessive averages of elements in a list in reverse, for example in a list of (1 2 3) i try to get (3+2+1/3 2+1/2 1) here is an example of a list i tried my code on.
(list 2 3 4 5 6)
For some reason the values returned are " (4 7/2 4 7/2 4)". This is the code
(define (sucessive-avg lst)
(if (=(length lst) 1)
lst
(cons(avg(reverse lst)) (sucessive-avg(cdr(reverse lst))))))
The problem does not come from my avg so i dont know what is wrong with it
How many times will you call reverse? Try to do a step-by-step execution of your code to understand what is going on.
You could write a function which collect averages for the successives CDRs of a list, and call it with a reversed list:
(define (successive-averages lst)
(if (null? lst)
lst
(cons (avg lst)
(successive-averages (rest lst))))
(successive-averages (reverse (list 2 3 4 5 6)))
#coredump's answer is a pretty good start but it doesn't use proper tail recursion and it looks like it's averaging the wrong parts of the list
for example in a list of (1 2 3) i try to get (3+2+1/3 2+1/2 1)
For a list of '(2 3 4 5 6) my answer will give you
'((avg '(2 3 4 5 6))
(avg '(2 3 4 5))
(avg '(2 3 4))
(avg '(2 3))
(avg '(2)))
This seems to match your description more accurately.
Here's the code
(define (avg lst)
(/ (foldl + 0 lst)
(length lst)))
(define (successive-avg lst)
(define (iter res lst)
(if (empty? lst)
(reverse res)
(iter (cons (avg lst) res) (rest lst))))
(iter '() (reverse lst)))
(print (successive-avg '(2 3 4 5 6)))
Output
'(4 3 1/2 3 2 1/2 2)
You don't actually need to recall reverse or average at all. The reason you don't need average is that you can keep a running sum (in my code via a lambda chain) and an explicit count. And sense you want the result of the deepest recursion first, consing running average onto an acumulator as you recure gives you the right final order.
(define (successiveAvg Lst)
(cond ((null? Lst)
(error "succesiveAvg requires a non-empty list"))
((fold (lambda (acc x)
(if acc (number? x) #f))
#t
Lst)
(error "succesiveAvg requires a list of numbers" Lst))
(else
(let ((inc (lambda (x)
(+ 1 x)))
(f (lambda (x)
(lambda (y) (+ x y)))))
(let loop ((acc '())
(c (lambda (x) x))
(L lst)
(i 1))
(if (null? L)
acc
(loop (cons (/ (c (car L)) i)
acc)
(f (c (car L)))
(cdr L)
(inc i))))))))
(successiveavg '(2 3 4 5 6))
;Value 3: (4 7/2 3 5/2 2)

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)

Bubble Sorting in Scheme

I am writing a recursive code to Bubble Sort (smallest to largest by swapping)
I have a code to do the bubble sort just once
(define (bubble-up L)
(if (null? (cdr L))
L
(if (< (car L) (cadr L))
(cons (car L) (bubble-up (cdr L)))
(cons (cadr L) (bubble-up (cons (car L) (cddr L))))
)
)
if i put a list into this code, it returns the list with the largest number at the end
EX.. (bubble-up ' (8 9 4 2 6 7)) -> ' (8 4 2 6 7 9)
Now i am trying to write a code to do the (bubble-up L) N times (the number of integers in list)
I have this code:
(define (bubble-sort-aux N L)
(cond ((= N 1) (bubble-up L))
(else (bubble-sort-aux (- N 1) L)
(bubble-up L))))
(bubble-sort-aux 6 (list 8 9 4 2 6 7)) -> ' (8 4 2 6 7 9)
But the recursion doesn't seem to happen because it only sorts once!
Any suggestions would be welcome, i'm just stumped!
Try this:
(define (bubble-sort-aux N L)
(cond ((= N 1) (bubble-up L))
(else (bubble-sort-aux (- N 1) (bubble-up L)))))
If you keep "bubbling-up" the list N times it'll be sorted at the end. The problem with your code is that you weren't using the result of bubble-up for anything - but if we pass the value returned by bubble-up to the next call of the function, it'll eventually be sorted. Now the procedure works as expected:
(bubble-sort-aux 6 (list 8 9 4 2 6 7))
=> '(2 4 6 7 8 9)
My implementation:
(define (bubble-swap ls)
(if (null? (cdr ls))
ls
(if (> (car ls) (cadr ls))
(cons (cadr ls) (bubble-swap (cons (car ls) (cddr ls))))
(cons (car ls) (bubble-swap (cdr ls))))))
(define (len ls)
(if (null? ls)
0
(+ 1 (len (cdr ls)))))
(define (bubblesort_ ls n)
(if (= n 1)
ls
(bubblesort_ (bubble-swap ls) (- n 1))))
(define (bubblesort ls) (bubblesort_ ls (len ls)))
I implemented a custom len function but you can use standard length function, if available.