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
Related
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 :).
i have a function in scheme, this function calls another function many times, and every time this function appends return value of another function to result value.
but finally i want to get a result such that '(a b c), however i get a result such that '((a) (b) (c)) how can i fix this problem? i have searched but i couldn't find good solution.
my little code like that not all of them.
(append res (func x))
(append res (func y))
(append res (func z))
my code like this
(define (check a )
'(1)
)
(define bos '())
(define (func a)
(let loop1([a a] [res '()])
(cond
[(eq? a '()) res]
[else (let ([ x (check (car a))])
(loop1 (cdr a) (append res (list x)))
)]
)
))
Try this:
(define (func a)
(let loop1 ([a a] [res '()])
(cond
[(eq? a '()) res]
[else
(let ([ x (check (car a))])
(loop1 (cdr a) (append res x)))])))
Notice that the only change I made (besides improving the formatting) was substituting (list x) with x. That will do the trick! Alternatively, but less portable - you can use append* instead of append:
(append* res (list x))
As a side comment, you should use (null? a) for testing if the list is empty. Now if we test the procedure using the sample code in the question, we'll get:
(func '(a b c))
=> '(1 1 1)
It seems that instead of
(loop1 (cdr a) (cdr b) c (append res (list x)))
you want
(loop1 (cdr a) (cdr b) c (append res x))
Basically the trick is to use cons instead of list. Imagine (list 1 2 3 4) which is the same as (cons 1 (cons 2 (cons 3 (cons 4 '())))). Do you see how each part is (cons this-iteration-element (recurse-further)) like this:
(define (make-list n)
(if (zero? n)
'()
(cons n (make-list (sub1 n)))))
(make-list 10) ; ==> (10 9 8 7 6 5 4 3 2 1)
Usually when you can choose direction you can always make it tail recursive with an accumulator:
(define (make-list n)
(let loop ((x 1) (acc '()))
(if (> x n)
acc
(loop (add1 x) (cons x acc))))) ; build up in reverse!
(make-list 10) ; ==> (10 9 8 7 6 5 4 3 2 1)
Now this is a generic answer. Applied to your working code:
(define (func a)
(let loop1 ([a a] [res '()])
(cond
[(eq? a '()) (reverse res)]
[else
(let ([x (check (car a))])
(loop1 (cdr a) (cons (car x) res)))])))
(func '(a b c)) ; ==> (1 1 1)
append replaces the cons so why not put the car og your result to the rest of the list. Since you want the result in order I reverse the result in the base case. (can't really tell from the result, but I guessed since you ise append)
I was doing a problem from the HTDP book where you have to create a function that finds all the permutations for the list. The book gives the main function, and the question asks for you to create the helper function that would insert an element everywhere in the list. The helper function, called insert_everywhere, is only given 2 parameters.
No matter how hard I try, I can't seem to create this function using only two parameters.
This is my code:
(define (insert_everywhere elt lst)
(cond
[(empty? lst) empty]
[else (append (cons elt lst)
(cons (first lst) (insert_everywhere elt (rest lst))))]))
My desired output for (insert_everywhere 'a (list 1 2 3)) is (list 'a 1 2 3 1 'a 2 3 1 2 'a 3 1 2 3 'a), but instead my list keeps terminating.
I've been able to create this function using a 3rd parameter "position" where I do recursion on that parameter, but that botches my main function. Is there anyway to create this helper function with only two parameters? Thanks!
Have you tried:
(define (insert x index xs)
(cond ((= index 0) (cons x xs))
(else (cons (car xs) (insert x (- index 1) (cdr xs))))))
(define (range from to)
(cond ((> from to) empty)
(else (cons from (range (+ from 1) to)))))
(define (insert-everywhere x xs)
(fold-right (lambda (index ys) (append (insert x index xs) ys))
empty (range 0 (length xs))))
The insert function allows you to insert values anywhere within a list:
(insert 'a 0 '(1 2 3)) => (a 1 2 3)
(insert 'a 1 '(1 2 3)) => (1 a 2 3)
(insert 'a 2 '(1 2 3)) => (1 2 a 3)
(insert 'a 3 '(1 2 3)) => (1 2 3 a)
The range function allows you to create Haskell-style list ranges:
(range 0 3) => (0 1 2 3)
The insert-everywhere function makes use of insert and range. It's pretty easy to understand how it works. If your implementation of scheme doesn't have the fold-right function (e.g. mzscheme) then you can define it as follows:
(define (fold-right f acc xs)
(cond ((empty? xs) acc)
(else (f (car xs) (fold-right f acc (cdr xs))))))
As the name implies the fold-right function folds a list from the right.
You can do this by simply having 2 lists (head and tail) and sliding elements from one to the other:
(define (insert-everywhere elt lst)
(let loop ((head null) (tail lst)) ; initialize head (empty), tail (lst)
(append (append head (cons elt tail)) ; insert elt between head and tail
(if (null? tail)
null ; done
(loop (append head (list (car tail))) (cdr tail)))))) ; slide
(insert-everywhere 'a (list 1 2 3))
=> '(a 1 2 3 1 a 2 3 1 2 a 3 1 2 3 a)
In Racket, you could also express it in a quite concise way as follows:
(define (insert-everywhere elt lst)
(for/fold ((res null)) ((i (in-range (add1 (length lst)))))
(append res (take lst i) (cons elt (drop lst i)))))
This has a lot in common with my answer to Insert-everywhere procedure. There's a procedure that seems a bit odd until you need it, and then it's incredibly useful, called revappend. (append '(a b ...) '(x y ...)) returns a list (a b ... x y ...), with the elements of (a b ...). Since it's so easy to collect lists in reverse order while traversing a list recursively, it's useful sometimes to have revappend, which reverses the first argument, so that (revappend '(a b ... m n) '(x y ...)) returns (n m ... b a x y ...). revappend is easy to implement efficiently:
(define (revappend list tail)
(if (null? list)
tail
(revappend (rest list)
(list* (first list) tail))))
Now, a direct version of this insert-everywhere is straightforward. This version isn't tail recursive, but it's pretty simple, and doesn't do any unnecessary list copying. The idea is that we walk down the lst to end up with the following rhead and tail:
rhead tail (revappend rhead (list* item (append tail ...)))
------- ------- ------------------------------------------------
() (1 2 3) (r 1 2 3 ...)
(1) (2 3) (1 r 2 3 ...)
(2 1) (3) (1 2 r 3 ...)
(3 2 1) () (1 2 3 r ...)
If you put the recursive call in the place of the ..., then you get the result that you want:
(define (insert-everywhere item lst)
(let ie ((rhead '())
(tail lst))
(if (null? tail)
(revappend rhead (list item))
(revappend rhead
(list* item
(append tail
(ie (list* (first tail) rhead)
(rest tail))))))))
> (insert-everywhere 'a '(1 2 3))
'(a 1 2 3 1 a 2 3 1 2 a 3 1 2 3 a)
Now, this isn't tail recursive. If you want a tail recursive (and thus iterative) version, you'll have to construct your result in a slightly backwards way, and then reverse everything at the end. You can do this, but it does mean one extra copy of the list (unless you destructively reverse it).
(define (insert-everywhere item lst)
(let ie ((rhead '())
(tail lst)
(result '()))
(if (null? tail)
(reverse (list* item (append rhead result)))
(ie (list* (first tail) rhead)
(rest tail)
(revappend tail
(list* item
(append rhead
result)))))))
> (insert-everywhere 'a '(1 2 3))
'(a 1 2 3 1 a 2 3 1 2 a 3 1 2 3 a)
How about creating a helper function to the helper function?
(define (insert_everywhere elt lst)
(define (insert_everywhere_aux elt lst)
(cons (cons elt lst)
(if (empty? lst)
empty
(map (lambda (x) (cons (first lst) x))
(insert_everywhere_aux elt (rest lst))))))
(apply append (insert_everywhere_aux elt lst)))
We need our sublists kept separate, so that each one can be prefixed separately. If we'd append all prematurely, we'd lose the boundaries. So we append only once, in the very end:
insert a (list 1 2 3) = ; step-by-step illustration:
((a)) ; the base case;
((a/ 3)/ (3/ a)) ; '/' signifies the consing
((a/ 2 3)/ (2/ a 3) (2/ 3 a))
((a/ 1 2 3)/ (1/ a 2 3) (1/ 2 a 3) (1/ 2 3 a))
( a 1 2 3 1 a 2 3 1 2 a 3 1 2 3 a ) ; the result
Testing:
(insert_everywhere 'a (list 1 2 3))
;Value 19: (a 1 2 3 1 a 2 3 1 2 a 3 1 2 3 a)
By the way this internal function is tail recursive modulo cons, more or less, as also seen in the illustration. This suggests it should be possible to convert it into an iterative form. Joshua Taylor shows another way, using revappend. Reversing the list upfront simplifies the flow in his solution (which now corresponds to building directly the result row in the illustration, from right to left, instead of "by columns" in my version):
(define (insert_everywhere elt lst)
(let g ((rev (reverse lst))
(q '())
(res '()))
(if (null? rev)
(cons elt (append q res))
(g (cdr rev)
(cons (car rev) q)
(revappend rev (cons elt (append q res)))))))
I am trying to create a scheme recursive function deep_count that counts the sum of the numbers even if it's nested in sub lists.
(define deep_count
(lambda (xs)
(cond
((empty? xs) 0)
((list? (first xs)) (+
(deep_count (first xs))
(deep_count (rest xs))))
(else (+ 1 (deep_count (rest xs)))))))
(deep_count '(1 2 3 (4 5 6) ((7 8 9) 10 (11 (12 13)))))
But I am getting 13 instead of 91.
Whats wrong here?
EDIT: never mind, I know why.
There's a small mistake at the end. Change this:
(+ 1 (deep_count (rest xs)))
... For this, and you're all set:
(+ (first xs) (deep_count (rest xs)))
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)