racket: add a number to each element of nested list - recursion

I'm trying to write this function recursively. Please let me know if there's a library function for this in Racket documentation. Trying to add a number to every atomic element of a nested list. I'm guaranteed the list is only 2-deep
(define (add_to_all x li) (cond
((number? li) (+ li x))
((and (=(len li)1) (number?(car li))) (list (add_to_all x (car li))))
((=(len li)1) (add_to_all x (car li)))
(else (list (add_to_all x (car li)) `(,#(add_to_all x (cdr li)))))))
Example usage:
(define list_of_lists `((1 2 3)(4 5 6)))
(add_to_all 1 list_of_lists)
Bug: I'm getting too many nested lists at the end of my return value:
'((2 (3 (4))) (5 (6 (7))))
where it should be
'((2 3 4) (5 6 7))
I think the problem is in the last else condition block, but I'm not sure how to "unnest" that trailing part to get what I want

Whether the list is 2-deep or N-deep, it doesn't really matter, the algorithm can be the same.
(define (add-to-all x xs)
(cond ((null? xs)
null)
((list? (car xs))
(cons (add-to-all x (car xs))
(add-to-all x (cdr xs))))
(else
(cons (+ x (car xs))
(add-to-all x (cdr xs))))))
(add-to-all 10 '((1 2) (3 4) (5 (6 (7 8 9)))))
;; '((11 12) (13 14) (15 (16 (17 18 19))))
The procedure can be generalized to allow any operation to be performed on all atoms of a nested list
(define (map* f xs)
(cond ((null? xs)
null)
((list? (car xs))
(cons (map* f (car xs))
(map* f (cdr xs))))
(else
(cons (f (car xs))
(map* f (cdr xs))))))
(define (add-to-all x xs)
(map* (curry + x) xs))
(add-to-all 10 '((1 2) (3 4) (5 (6 (7 8 9)))))
;; '((11 12) (13 14) (15 (16 (17 18 19))))

There's a simpler way than recursion:
(define (add x li)
(for/list ([e li]) (+ x e)))
(define (add_to_all x li)
(map (lambda(sublist)(add x sublist))
li))
Usage:
(add_to_all 1 '((1 2 3)(4 5 6)))
If someone knows a library function for this operation, please answer as well

I think this problem can be generalized to "How do I map over nested lists?".
I am working off the assumption the procedure should also add numbers to top level elements, e.g.: (add-to-all 1 '(1 2 (3 4) 5)) yields '(2 3 (4 5) 6).
Here is a recursive solution based on the question:
(define (add-to-all x li)
(cond
[(number? li) (+ li x)]
[(list? li) (map (curry add-to-all x) li)]
[else li]))
A more generalized solution:
(define (map* proc ls)
(for/list ([elem ls])
(if (list? elem)
(map* proc elem)
(proc elem))))
(define (add-to-all x li)
(define (proc e)
(if (number? e)
(+ x e)
e))
(map* proc li))
I didn't see a procedure like map* in the standard Racket library, but I only looked for several minutes :).

Related

Return the longest sequence of consecutive numbers from list in lisp

I am a lisp newbie.
I'm trying to create a function in lisp that receives an unsorted list and the function has to sort de list and return a list with the longest sequence of numbers.
Example: (2 1 8 9 3 11 10 20 12 21)(1 2 3 8 9 10 11 12 20 21) -> return (8 9 10 11 12)
I don't want to use the sort function and I have created 2 functions (With some help) to sort, but now I have no idea how I could find and return the longest sequence of numbers.
I could go through the list but, how I can store the numbers and check if a list of consecutive numbers is longer than another?
This are my functions to sort
(defun sortOne (list)
(let ((ca1 (car list)) (cd1 (cdr list)))
(if (null cd1)
list
(let ((cd (sortOne cd1))) ; cd = sorted tail
(let ((ca2 (car cd)) (cd2 (cdr cd)))
(if (<= ca1 ca2)
(cons ca1 cd)
(cons ca2 (cons ca1 cd2))))))))
(defun sortAll (list)
(if (null list)
nil
(let ((s (sortOne list)))
(cons (car s) (sortAll (cdr s))))))
Hope someone can help me.
¡Thanks!
Tonight I managed to do it, but surely it is not the best solution, I would like to know how to use a lambda function or recursion to do it better.
(defun listilla (lista)
(setq lista (sort lista #'<))
(setq lista1 (list (car lista)))
(setq lista2 '())
(loop for i from 0 to (- (length lista) 2) do
(cond ((= (nth i lista) (- (nth (+ i 1) lista) 1))
(push (nth (+ i 1) lista) (cdr (last lista1))))
(t (push lista1 lista2)
(setq lista1 (list (nth (+ i 1) lista)))
)
)
)
(push lista1 lista2)
(setq masLargo (car lista2))
(loop for i from 1 to (- (length lista2) 2) do
(if (< (length (nth i lista2)) (length (nth (+ i 1) lista2)))
(setq masLargo (nth (+ i 1) lista2))
)
)
masLargo
)
(print (listilla '(23 15 6 5 78 4 77)))
(defun group-consecutives (l &optional (acc '()))
(cond ((null l) (nreverse acc))
((and acc (= 1 (- (car l) (caar acc)))) (consecutives (cdr l) (cons (cons (car l) (car acc)) (cdr acc))))
(t (consecutives (cdr l) (cons (list (car l)) (when acc (cons (nreverse (car acc)) (cdr acc))))))))
(defun longest-consecutive (l)
(car (sort (consecutives (sort l #'<)) #'> :key #'length)))
(longest-consecutive '(2 1 8 9 3 11 10 20 12 21))
;;=> (8 9 10 11 12)
Probably the second function is easier to understand like this:
(defun sort-increasing (l)
(sort l #'<))
(defun sort-groups-by-length (groups)
(sort groups #'> #'length))
(defun longest-consecutive (l)
(car (sort-groups-by-length (group-consecutives (sort-increasing l))))))))

How to build a rolling window procedure using racket/scheme?

When written this way the error says: 4 parts after if:
(define (rolling-window l size)
(if (< (length l) size) l
(take l size) (rolling-window (cdr l) size)))
and when there's another paranthesis to make it 3 parts:
(define (rolling-window l size)
(if (< (length l) size) l
((take l size) (rolling-window (cdr l) size))))
then it says: application: not a procedure;
How to write more than one expression in if's else in racket/scheme?
Well that's not really the question. The question is "How to build a rolling window procedure using racket?". Anyway, it looks like you're probably coming from another programming language. Processing linked lists can be a little tricky at first. But remember, to compute the length of a list, you have to iterate through the entire list. So using length is a bit of an anti-pattern here.
Instead, I would recommend you create an auxiliary procedure inside your rolling-window procedure which builds up the window as you iterate thru the list. This way you don't have to waste iterations counting elements of a list.
Then if your aux procedure ever returns and empty window, you know you're done computing the windows for the given input list.
(define (rolling-window n xs)
(define (aux n xs)
(let aux-loop ([n n] [xs xs] [k identity])
(cond [(= n 0) (k empty)] ;; done building sublist, return sublist
[(empty? xs) empty] ;; reached end of xs before n = 0, return empty window
[else (aux-loop (sub1 n) (cdr xs) (λ (rest) (k (cons (car xs) rest))))]))) ;; continue building sublist
(let loop ([xs xs] [window (aux n xs)] [k identity])
(cond ([empty? window] (k empty)) ;; empty window, done
([empty? xs] (k empty)) ;; empty input list, done
(else (loop (cdr xs) (aux n (cdr xs)) (λ (rest) (k (cons window rest)))))))) ;; continue building sublists
(rolling-window 3 '(1 2 3 4 5 6))
;; => '((1 2 3) (2 3 4) (3 4 5) (4 5 6))
It works for empty windows
(rolling-window 0 '(1 2 3 4 5 6))
;; => '()
And empty lists too
(rolling-window 3 '())
;; => '()
Here is an alternative:
#lang racket
(define (rolling-window n xs)
(define v (list->vector xs))
(define m (vector-length v))
(for/list ([i (max 0 (- m n -1))])
(vector->list (vector-copy v i (+ i n)))))
(rolling-window 3 '(a b c d e f g))
(rolling-window 3 '())
(rolling-window 0 '(a b c))
Output:
'((a b c) (b c d) (c d e) (d e f) (e f g))
'()
'(() () () ()) ; lack of spec makes this ok !
Following modification of OP's function works. It includes an outlist for which the initial default is empty list. Sublists are added to this outlist till (length l) is less than size.
(define (rolling-window l size (ol '()))
(if (< (length l) size) (reverse ol)
(rolling-window (cdr l) size (cons (take l size) ol))))
Testing:
(rolling-window '(1 2 3 4 5 6) 2)
(rolling-window '(1 2 3 4 5 6) 3)
(rolling-window '(1 2 3 4 5 6) 4)
Output:
'((1 2) (2 3) (3 4) (4 5) (5 6))
'((1 2 3) (2 3 4) (3 4 5) (4 5 6))
'((1 2 3 4) (2 3 4 5) (3 4 5 6))
Any improvements on this one?
(define (rolling-window l size)
(cond ((eq? l '()) '())
((< (length l) size) '())
((cons (take l size) (rolling-window (cdr l) size)))))

recursively count sublists beginning with a number

I am trying to write code in Lisp counting sublists beginning with number, recursively. I ve trying to use numberp but my code, when arrived to an atom, doesn't count the rest of the list.
With my code here,
(defun nombres (liste)
(cond
((atom liste) 0)((atom (car liste)) 0)
((and (numberp (caar liste)) (+ (nombres (cdr liste)) 1)))
(t (nombres (cdr liste))) ) )
I can get a count of sublists but when arrived to an atom , it doesn't count the rest.
[67]> (nombres '((a b d) (5 g) (7 m)))
2
[68]> (nombres '((a b d) (5 g) g (7 m)))
1
When I test the sublist with (listp (car list), it gives me nil.
[69]> (defun nombres (liste)
(cond
((atom liste) 0)((atom (car liste)) 0)
((listp (car liste))(and (numberp (caar liste)) (+ (nombres (cdr liste)) 1))) (t (nombres (cdr liste))) ) )
NOMBRES
[70]> (nombres '((a b d) (5 g) g (7 m) m))
NIL
I want to get something like :
(nombres '((a b d) a (5 g) (b) (7 m) j (8 h l g)))
3
Thanks for your help
You need to think about the cases you need to handle.
The end of the list => return the result
A sublist that has a number in front => add one to the result
Anything else => continue to the next element
These will quite easily translate to a COND:
(cond ((endp list) ...) ; 1
((and (listp (car list)) ; 2
(numberp (caar list)))
...)
(t ...) ; 3
Using an accumulator as an optional parameter, the counting is easy to fill in:
(defun count-sublists (list &optional (acc 0))
(cond ((endp list) acc)
((and (listp (car list))
(numberp (caar list)))
(count-sublists (cdr list) (1+ acc)))
(t (count-sublists (cdr list) acc))))
(count-sublists '((a b d) a (5 g) (b) (7 m) j (8 h l g)))
;=> 3
The standard Common Lisp function count-if is easier to use:
CL-USER > (count-if (lambda (item)
(and (consp item)
(numberp (first item))))
'((a b d) a (5 g) (b) (7 m) j (8 h l g)))
3

Finding the position of a number in a list

Hey guys, I have a homework question that's been frustrating me to no end! I'm supposed to create index-of-least that will take a non-empty list and return the index of the smallest number in the list. The index of the (car ls) = 0, index of the (car (cdr ls)) = 1, and so on.
A helper needs to be created that will keep track of the current-position, least-position, least-value, and list. So far, I have this program (that doesn't load) that shows the basic algorithm.. But I'm having a hard time keeping track of everything and putting it into chez scheme code.
(define index-helper
(lambda (ls current-position least-position least-value)
(if (> (car ls) least-value)
(add1 (car ls (cdr ls (add1 current-position))))
(car ls (cdr ls (add1 current-position))))))
;trace
;ls: (4231) c-pos: 0 least-value: 5 least-pos: 0
;ls: (231) c-pos: 1 least-value: 4 least-pos: 1
;ls: (31) c-pos 2 least-value: 2 least-pos: 2
;ls: 1 c-pos: 3 l-v: 2 l-pos: 2
;ls '() c-pos: 4 l-v: 1 l-pos: 4
;*least-position = current-position
I already googled this and found similar questions in python, but I don't understand the code because I'm new to programming. :P
If anyone can give me a hint, I'd really appreciate it!
You want two functions. The first function find the least element x. The second function finds the index of the element x in the list.
Something like:
(define (find-least xs)
(foldl (lambda (e acc) (min e acc)) (car xs) xs))
(define (elem-index x xs)
(define (elem-index-find x xs ind)
(cond
((empty? xs) ind)
((eq? x (car xs))
ind)
(else (elem-index-find x (cdr xs) (+ ind 1)))))
(if (empty? xs)
(error "empty list")
(elem-index-find x xs 0)))
(define (index-of-least xs)
(let ((least (find-least xs)))
(elem-index least xs)))
Test:
> (index-of-least (list 5 8 4 9 1 3 7 2))
4
Or, in one pass:
(define (index-of-least-1-pass xs)
(define (index-do least ind-least ind xs)
(cond
((empty? xs) ind-least)
((< (car xs) least)
(index-do (car xs) (+ ind 1) (+ ind 1) (cdr xs)))
(else
(index-do least ind-least (+ ind 1) (cdr xs)))))
(index-do (car xs) 0 0 (cdr xs)))
Test:
> (index-of-least-1-pass (list 5 8 4 9 1 3 7 2))
4
In index-do helper function first you check if the intermediate list is empty; this is a base case, when we have got just one element int the list, and return its index.
Next condition checks if the next element of the intermediate list is greater than the current least value, and if so, we call helper with the new value of least and its index.
The last condition is selected, when the next element is not greater than the least, and it calls the helper function with the same values of least and ind-least, and the intermediate list with head element removed until there are no elements in the list, and we approached the base case, when there are no elements in the list.
A good example for named let:
(define (index-of-least xs)
(let loop ((i 0) (p 0) (x (car xs)) (xs (cdr xs)))
(cond ((null? xs) p)
((< (car xs) x) (loop (+ i 1) (+ i 1) (car xs) (cdr xs)))
(else (loop (+ i 1) p x (cdr xs))))))
(index-of-least (list 5 8 4 9 1 3 7 2)) => 4

How do you properly compute pairwise differences in Scheme?

Given a list of numbers, say, (1 3 6 10 0), how do you compute differences (xi - xi-1), provided that you have x-1 = 0 ?
(the result in this example should be (1 2 3 4 -10))
I've found this solution to be correct:
(define (pairwise-2 f init l)
(first
(foldl
(λ (x acc-data)
(let ([result-list (first acc-data)]
[prev-x (second acc-data)])
(list
(append result-list (list(f x prev-x)))
x)))
(list empty 0)
l)))
(pairwise-2 - 0 '(1 3 6 10 0))
;; => (1 2 3 4 -10)
However, I think there should be more elegant though no less flexible solution. It's just ugly.
I'm new to functional programming and would like to hear any suggestions on the code.
Thanks.
map takes multiple arguments. So I would just do
(define (butlast l)
(reverse (cdr (reverse l))))
(let ((l '(0 1 3 6 10)))
(map - l (cons 0 (butlast l)))
If you want to wrap it up in a function, say
(define (pairwise-call f init l)
(map f l (cons init (butlast l))))
This is of course not the Little Schemer Way, but the way that avoids writing recursion yourself. Choose the way you like the best.
I haven't done scheme in dog's years, but this strikes me as a typical little lisper type problem.
I started with a base definition (please ignore misplacement of parens - I don't have a Scheme interpreter handy:
(define pairwise-diff
(lambda (list)
(cond
((null? list) '())
((atom? list) list)
(t (pairwise-helper 0 list)))))
This handles the crap cases of null and atom and then delegates the meat case to a helper:
(define pairwise-helper
(lambda (n list)
(cond
((null? list) '())
(t
(let ([one (car list)])
(cons (- one n) (pairwise-helper one (cdr list))))
))))
You could rewrite this using "if", but I'm hardwired to use cond.
There are two cases here: null list - which is easy and everything else.
For everything else, I grab the head of the list and cons this diff onto the recursive case. I don't think it gets much simpler.
After refining and adapting to PLT Scheme plinth's code, I think nearly-perfect solution would be:
(define (pairwise-apply f l0 l)
(if (empty? l)
'()
(let ([l1 (first l)])
(cons (f l1 l0) (pairwise-apply f l1 (rest l))))))
Haskell tells me to use zip ;)
(define (zip-with f xs ys)
(cond ((or (null? xs) (null? ys)) null)
(else (cons (f (car xs) (car ys))
(zip-with f (cdr xs) (cdr ys))))))
(define (pairwise-diff lst) (zip-with - (cdr lst) lst))
(pairwise-diff (list 1 3 6 10 0))
; gives (2 3 4 -10)
Doesn't map finish as soon as the shortest argument list is exhausted, anyway?
(define (pairwise-call fun init-element lst)
(map fun lst (cons init-element lst)))
edit: jleedev informs me that this is not the case in at least one Scheme implementation. This is a bit annoying, since there is no O(1) operation to chop off the end of a list.
Perhaps we can use reduce:
(define (pairwise-call fun init-element lst)
(reverse (cdr (reduce (lambda (a b)
(append (list b (- b (car a))) (cdr a)))
(cons (list init-element) lst)))))
(Disclaimer: quick hack, untested)
This is the simplest way:
(define (solution ls)
(let loop ((ls (cons 0 ls)))
(let ((x (cadr ls)) (x_1 (car ls)))
(if (null? (cddr ls)) (list (- x x_1))
(cons (- x x_1) (loop (cdr ls)))))))
(display (equal? (solution '(1)) '(1))) (newline)
(display (equal? (solution '(1 5)) '(1 4))) (newline)
(display (equal? (solution '(1 3 6 10 0)) '(1 2 3 4 -10))) (newline)
Write out the code expansion for each of the example to see how it works.
If you are interested in getting started with FP, be sure to check out How To Design Program. Sure it is written for people brand new to programming, but it has tons of good FP idioms within.
(define (f l res cur)
(if (null? l)
res
(let ((next (car l)))
(f (cdr l) (cons (- next cur) res) next))))
(define (do-work l)
(reverse (f l '() 0)))
(do-work '(1 3 6 10 0))
==> (1 2 3 4 -10)

Resources