I am encountering a issue that I need to add up the second number of each list. For example, suppose I have a list of lists like below,
(list (list -4
(list (list -1 4) (list 1 7)))
(list 1 (list (list -2 5) (list 3 3)))
(list 3 12))
Then my job is to add up 4 + 7 + 5 + 3 + 12 = 31. However, the list can have multiple sub lists. But the second item inside a list can either be a number or a list. If it is a list, then we need to dig deeper into this list until we get a number.
Thanks!
Solution
(define (atom? x)
(and (not (null? x))
(not (pair? x))))
(define (my-and x y)
(and x y))
(define (every? l)
(foldr my-and #t l))
(define (flat-list? l)
(cond ((null? l) #t)
((every? (map atom? l)) #t)
(else #f)))
(define (add-only-seconds l)
(define (l-sec-add l acc)
(cond ((null? l) acc)
((atom? l) acc)
((flat-list? l) (+ (second l) acc))
((list? l) (apply + acc (map (lambda (x) (l-sec-add x 0)) l)))))
(l-sec-add l 0))
Example test
(define example-list (list (list -4
(list (list -1 4) (list 1 7)))
(list 1 (list (list -2 5) (list 3 3)))
(list 3 12)))
(add-only-seconds example-list) ;; 31
I used common-lisp-typical functions atom? and every?.
Since and cannot be used in foldr, I defined my-add to make add a function which can be used infoldr`.
Related
This seems straightforward, but I can't seem to find a solution. I want to replace an item within a list of a list with something, but if that item appears multiple times then you randomly replace one of them, but not both. I want to do this in ISL+.
I created the function flatten which appends all sublists :
(check-expect (flatten '((a b) (c) (d e f g) (h i j)))
(list 'a 'b 'c 'd 'e 'f 'g 'h 'i 'j))
(define (flatten lol)
(foldr append empty lol))
I also made rewrite, which replaces the value at index n with whatever you choose
(check-expect (rewrite '(x x x - x x x x) 3 'x)
(list 'x 'x 'x 'x 'x 'x 'x 'x))
(define (rewrite ls n val)
(cond
[(empty? ls) (error "error")]
[(= n 0) (cons val (rest ls))]
[else (cons (first ls) (rewrite (rest ls) (sub1 n) val))]))
The problem is I don't know how to apply this to a list of list and I also don't know how to randomly replace one of items if it occurs more than once. This is what I have for the final product, but it's probably not the way to go:
(define (fullreplace b)
(local [
;makes a list of nested lists of each index the element occurs
;problem is that it makes a list of nested lists so I can't use flatten either
(define (position ls ele n)
(cond [(empty? ls) 0]
[(equal? ele (first ls)) (list n (position (rest ls) ele (add1 n))) ]
[else (position (rest ls) ele (+ 1 n))]))]
;lol-full? checks if the item occurs in the list of lists at all
(if (lol-full? b) b (rewrite (flatten b)
(position (flatten b) '- 0)
"item replaced"))))
;just used for testing
(define lol2 (list
(list 2 2 2 2)
(list 4 '- 4 '-)
(list '- 8 8 8)
(list 16 '- '- 16)))
(fullreplace lol2) may return this or where any of the other '- are located:
(list
(list 2 2 2 2)
(list 4 '- 4 2)
(list '- 8 8 8)
(list 16 '- '- 16))
I've been working on this awhile so any new insight would go a long way. Thank you
The "random" part is what makes this problem pathological. If you could just replace the first occurrence, it would be easy. But to replace a random occurence, you must first know how many occurrences there are. So before you go replacing stuff, you have to go a-counting:
(define (count/recursive val tree)
(cond ((equal? val tree)
1)
(else (foldl (λ (next-value total)
(cond ((equal? val next-value)
(add1 total))
((list? next-value)
(+ total (count/recursive val next-value)))
(else total))) 0 tree))))
Then you need a function that can replace the nth occurrence of a value:
(define (replace/recursive val replace-with n tree)
(cond ((equal? val tree)
replace-with)
(else
(cdr
(foldl (λ (next-value total/output-tree)
(local ((define total (car total/output-tree))
(define output-tree (cdr total/output-tree)))
(cond ((equal? next-value val)
(cons (add1 total)
(cons (if (= total n) replace-with next-value) output-tree)))
((list? next-value)
(cons (+ total (count/recursive val next-value))
(cons (replace/recursive val replace-with (- n total) next-value)
output-tree)))
(else (cons total (cons next-value output-tree)))))) (cons 0 empty) tree)))))
Finally, you use random to pick the instance you will replace, using count/recursive to limit how high of a number random picks:
(define original '((x x (x y x) a b (((c x z x) x) y x x))))
(replace/recursive 'x '- (random (count/recursive 'x original)) original)
How to replace all occurences of a value with another value:
(define (replace-all needle new-value haystack)
(cond ((equal? needle haystack) new-value)
((pair? haystack)
(cons (replace-all needle new-value (car haystack))
(replace-all needle new-value (cdr haystack))))
(else haystack)))
The only thing to change is to check if the first part constituted a change. If it did you don't do the replace on the other half. Use equal? to compare structure.
It's not random. It will replace the first occurence it finds either by doing car before cdr or cdr before car.
I'm completely new to scheme and I'm having trouble trying to add 2 lists of different sizes. I was wondering how do I add 2 lists of different sizes together correctly. In my code I compared the values and append '(0) to the shorter list so that they can get equal sizes, but even after doing that I can not use map to add the 2 lists. I get an error code after running the program. The results I should be getting is '(2 4 5 4). Could anyone help me out? Thanks.
#lang racket
(define (add lst1 lst2)
(cond [(< (length lst1) (length lst2)) (cons (append lst1 '(0)))]
[else lst1])
(cond
((and (null? lst1)(null? lst2)) null)
(else
(map + lst1 lst2))))
;;Result should be '(2 4 6 4)
(add '(1 2 3) '(1 2 3 4))
ERROR:
cons: arity mismatch;
the expected number of arguments does not match the given number
expected: 2
given: 1
arguments...:
'(1 2 3 0)
The problem with your code is that there are two cond expressions one after the other - both will execute, but only the result of the second one will be returned - in other words, the code is not doing what you think it's doing. Now, to solve this problem it'll be easier if we split the solution in two parts (in general, that's a good strategy!). Try this:
(define (fill-zeroes lst n)
(append lst (make-list (abs n) 0)))
(define (add lst1 lst2)
(let ((diff (- (length lst1) (length lst2))))
(cond [(< diff 0)
(map + (fill-zeroes lst1 diff) lst2)]
[(> diff 0)
(map + lst1 (fill-zeroes lst2 diff))]
[else (map + lst1 lst2)])))
Explanation:
The fill-zeroes procedure takes care of filling the tail of a list with a given number of zeroes
The add procedure is in charge of determining which list needs to be filled, and when both lists have the right size performs the actual addition
It works as expected for any combination of list lengths:
(add '(1 2 3 4) '(1 2 3))
=> '(2 4 6 4)
(add '(1 2 3) '(1 2 3 4))
=> '(2 4 6 4)
(add '(1 2 3 0) '(1 2 3 4))
=> '(2 4 6 4)
Similar to Oscar's, slighty shorter:
(define (fill0 lst len)
(append lst (make-list (- len (length lst)) 0)))
(define (add lst1 lst2)
(let ((maxlen (max (length lst1) (length lst2))))
(map + (fill0 lst1 maxlen) (fill0 lst2 maxlen))))
or, for fun, the other way round:
(define (add lst1 lst2)
(let ((minlen (min (length lst1) (length lst2))))
(append
(map + (take lst1 minlen) (take lst2 minlen))
(drop lst1 minlen)
(drop lst2 minlen))))
There's no need to pre-compute the lengths of the lists and add zeroes to the end of one or the other of the lists. Here we solve the problem with a simple recursion:
(define (add xs ys)
(cond ((and (pair? xs) (pair? ys))
(cons (+ (car xs) (car ys)) (add (cdr xs) (cdr ys))))
((pair? xs) (cons (car xs) (add (cdr xs) ys)))
((pair? ys) (cons (car ys) (add xs (cdr ys))))
(else '())))
That works for all of Oscar's tests:
> (add '(1 2 3 4) '(1 2 3))
(2 4 6 4)
> (add '(1 2 3) '(1 2 3 4))
(2 4 6 4)
> (add '(1 2 3 0) '(1 2 3 4))
(2 4 6 4)
If you like, you can write that using a named-let and get the same results:
(define (add xs ys)
(let loop ((xs xs) (ys ys) (zs '()))
(cond ((and (pair? xs) (pair? ys))
(loop (cdr xs) (cdr ys) (cons (+ (car xs) (car ys)) zs)))
((pair? xs) (loop (cdr xs) ys (cons (car xs) zs)))
((pair? ys) (loop xs (cdr ys) (cons (car ys) zs)))
(else (reverse zs)))))
Have fun!
A yet simpler version.
(define (add x y)
(cond ((and (pair? x) (pair? y))
(cons (+ (car x) (car y))
(add (cdr x) (cdr y))))
((pair? x) x)
(else y)))
how to implement this function
if get two list (a b c), (d e)
and return list (a+d b+d c+d a+e b+e c+e)
list element is all integer and result list's element order is free
I tried this like
(define (addlist L1 L2)
(define l1 (length L1))
(define l2 (length L2))
(let ((result '()))
(for ((i (in-range l1)))
(for ((j (in-range l2)))
(append result (list (+ (list-ref L1 i) (list-ref L2 j))))))))
but it return error because result is '()
I don't know how to solve this problem please help me
A data-transformational approach:
(a b c ...) (x y ...)
1. ==> ( ((a x) (b x) (c x) ...) ((a y) (b y) (c y) ...) ...)
2. ==> ( (a x) (b x) (c x) ... (a y) (b y) (c y) ... ...)
3. ==> ( (a+x) (b+x) ... )
(define (addlist L1 L2)
(map (lambda (r) (apply + r)) ; 3. sum the pairs up
(reduce append '() ; 2. concatenate the lists
(map (lambda (e2) ; 1. pair-up the elements
(map (lambda (e1)
(list e1 e2)) ; combine two elements with `list`
L1))
L2))))
testing (in MIT-Scheme):
(addlist '(1 2 3) '(10 20))
;Value 23: (11 12 13 21 22 23)
Can you simplify this so there's no separate step #3?
We can further separate out the different bits and pieces in play here, as
(define (bind L f) (join (map f L)))
(define (join L) (reduce append '() L))
(define yield list)
then,
(bind '(1 2 3) (lambda (x) (bind '(10 20) (lambda (y) (yield (+ x y))))))
;Value 13: (11 21 12 22 13 23)
(bind '(10 20) (lambda (x) (bind '(1 2 3) (lambda (y) (yield (+ x y))))))
;Value 14: (11 12 13 21 22 23)
Here you go:
(define (addlist L1 L2)
(for*/list ((i (in-list L1)) (j (in-list L2)))
(+ i j)))
> (addlist '(1 2 3) '(10 20))
'(11 21 12 22 13 23)
The trick is to use for/list (or for*/list in case of nested fors) , which will automatically do the append for you. Also, note that you can just iterate over the lists, no need to work with indexes.
To get the result "the other way round", invert L1 and L2:
(define (addlist L1 L2)
(for*/list ((i (in-list L2)) (j (in-list L1)))
(+ i j)))
> (addlist '(1 2 3) '(10 20))
'(11 12 13 21 22 23)
In scheme, it's not recommended using function like set! or append!.
because it cause data changed or Variable, not as Funcitonal Programming Style.
should like this:
(define (add-one-list val lst)
(if (null? lst) '()
(cons (list val (car lst)) (add-one-list val (cdr lst)))))
(define (add-list lst0 lst1)
(if (null? lst0) '()
(append (add-one-list (car lst0) lst1)
(add-list (cdr lst0) lst1))))
first understanding function add-one-list, it recursively call itself, and every time build val and fist element of lst to a list, and CONS/accumulate it as final answer.
add-list function just like add-one-list.
(define (addlist L1 L2)
(flatmap (lambda (x) (map (lambda (y) (+ x y)) L1)) L2))
(define (flatmap f L)
(if (null? L)
'()
(append (f (car L)) (flatmap f (cdr L)))))
1 ]=> (addlist '(1 2 3) '(10 20))
;Value 2: (11 12 13 21 22 23)
Going with Will and Procras on this one. If you're going to use scheme, might as well use idiomatic scheme.
Using for to build a list is a bit weird to me. (list comprehensions would fit better) For is usually used to induce sequential side effects. That and RSR5 does not define a for/list or for*/list.
Flatmap is a fairly common functional paradigm where you use append instead of cons to build a list to avoid nested and empty sublists
It doesn't work because functions like append don't mutate the containers. You could fix your problem with a mutating function like append!. Usually functions that mutate have a ! in their name like set! etc.
But it's possible to achieve that without doing mutation. You'd have to change your algorithm to send the result to your next iteration. Like this:
(let loop ((result '()))
(loop (append result '(1)))
As you can see, when loop will get called, result will be:
'()
'(1)
'(1 1)
'(1 1 1)
....
Following this logic you should be able to change your algorithm to use this method instead of for loop. You'll have to pass some more parameters to know when you have to exit and return result.
I'll try to add a more complete answer later today.
Here's an implementation of append! I just wrote:
(define (append! lst1 lst2)
(if (null? (cdr lst1))
(set-cdr! lst1 lst2)
(append! (cdr lst1) lst2)))
I'm trying to reverse a list, here's my code:
(define (reverse list)
(if (null? list)
list
(list (reverse (cdr list)) (car list))))
so if i enter (reverse '(1 2 3 4)), I want it to come out as (4 3 2 1), but right now it's not giving me that. What am I doing wrong and how can I fix it?
The natural way to recur over a list is not the best way to solve this problem. Using append, as suggested in the accepted answer pointed by #lancery, is not a good idea either - and anyway if you're learning your way in Scheme it's best if you try to implement the solution yourself, I'll show you what to do, but first a tip - don't use list as a parameter name, that's a built-in procedure and you'd be overwriting it. Use other name, say, lst.
It's simpler to reverse a list by means of a helper procedure that accumulates the result of consing each element at the head of the result, this will have the effect of reversing the list - incidentally, the helper procedure is tail-recursive. Here's the general idea, fill-in the blanks:
(define (reverse lst)
(<???> lst '())) ; call the helper procedure
(define (reverse-aux lst acc)
(if <???> ; if the list is empty
<???> ; return the accumulator
(reverse-aux <???> ; advance the recursion over the list
(cons <???> <???>)))) ; cons current element with accumulator
Of course, in real-life you wouldn't implement reverse from scratch, there's a built-in procedure for that.
Here is a recursive procedure that describes an iterative process (tail recursive) of reversing a list in Scheme
(define (reverse lst)
(define (go lst tail)
(if (null? lst) tail
(go (cdr lst) (cons (car lst) tail))))
(go lst ())))
Using substitution model for (reverse (list 1 2 3 4))
;; (reverse (list 1 2 3 4))
;; (go (list 1 2 3 4) ())
;; (go (list 2 3 4) (list 1))
;; (go (list 3 4) (list 2 1))
;; (go (list 4) (list 3 2 1))
;; (go () (list 4 3 2 1))
;; (list 4 3 2 1)
Here is a recursive procedure that describes a recursive process (not tail recursive) of reversing a list in Scheme
(define (reverse2 lst)
(if (null? lst) ()
(append (reverse2 (cdr lst)) (list (car lst)))))
(define (append l1 l2)
(if (null? l1) l2
(cons (car l1) (append (cdr l1) l2))))
Using substitution model for (reverse2 (list 1 2 3 4))
;; (reverse2 (list 1 2 3 4))
;; (append (reverse2 (list 2 3 4)) (list 1))
;; (append (append (reverse2 (list 3 4)) (list 2)) (list 1))
;; (append (append (append (reverse2 (list 4)) (list 3)) (list 2)) (list 1))
;; (append (append (append (append (reverse2 ()) (list 4)) (list 3)) (list 2)) (list 1))
;; (append (append (append (append () (list 4)) (list 3)) (list 2)) (list 1))
;; (append (append (append (list 4) (list 3)) (list 2)) (list 1))
;; (append (append (list 4 3) (list 2)) (list 1))
;; (append (list 4 3 2) (list 1))
;; (list 4 3 2 1)
Tail recursive approach using a named let:
(define (reverse lst)
(let loop ([lst lst] [lst-reversed '()])
(if (empty? lst)
lst-reversed
(loop (rest lst) (cons (first lst) lst-reversed)))))
This is basically the same approach as having a helper function with an accumulator argument as in Oscar's answer, where the loop binding after let makes the let into an inner function you can call.
Here's a solution using build-list procedure:
(define reverse
(lambda (l)
(let ((len (length l)))
(build-list len
(lambda (i)
(list-ref l (- len i 1)))))))
This one works but it is not a tail recursive procedure:
(define (rev lst)
(if (null? lst)
'()
(append (rev (cdr lst)) (car lst))))
Tail recursive solution:
(define (reverse oldlist)
(define (t-reverse oldlist newlist)
(if (null? oldlist)
newlist
(t-reverse (cdr oldlist) (cons (car oldlist) newest))))
(t-reverse oldlist '()))
Just left fold the list using cons:
(define (reverse list) (foldl cons null list))
This is also efficient because foldl is tail recursive and there is no need for append. This can also be done point-free (using curry from racket):
(define reverse (curry foldl cons null))
(define reverse?
(lambda (l)
(define reverse-aux?
(lambda (l col)
(cond
((null? l) (col ))
(else
(reverse-aux? (cdr l)
(lambda ()
(cons (car l) (col))))))))
(reverse-aux? l (lambda () (quote ())))))
(reverse? '(1 2 3 4) )
One more answer similar to Oscar's. I have just started learning scheme, so excuse me in case you find issues :).
There's actually no need for appending or filling the body with a bunch of lambdas.
(define (reverse items)
(if (null? items)
'()
(cons (reverse (cdr items)) (car items))))
I think it would be better to use append instead of cons
(define (myrev l)
(if (null? l)
'()
(append (myrev (cdr l)) (list (car l)))
)
)
this another version with tail recursion
(define (myrev2 l)
(define (loop l acc)
(if (null? l)
acc
(loop (cdr l) (append (list (car l)) acc ))
)
)
(loop l '())
)
I don't fully understand what the append-map command does in racket, nor do I understand how to use it and I'm having a pretty hard time finding some decently understandable documentation online for it. Could someone possibly demonstrate what exactly the command does and how it works?
The append-map procedure is useful for creating a single list out of a list of sublists after applying a procedure to each sublist. In other words, this code:
(append-map proc lst)
... Is semantically equivalent to this:
(apply append (map proc lst))
... Or this:
(append* (map proc lst))
The applying-append-to-a-list-of-sublists idiom is sometimes known as flattening a list of sublists. Let's look at some examples, this one is right here in the documentation:
(append-map vector->list '(#(1) #(2 3) #(4)))
'(1 2 3 4)
For a more interesting example, take a look at this code from Rosetta Code for finding all permutations of a list:
(define (insert l n e)
(if (= 0 n)
(cons e l)
(cons (car l)
(insert (cdr l) (- n 1) e))))
(define (seq start end)
(if (= start end)
(list end)
(cons start (seq (+ start 1) end))))
(define (permute l)
(if (null? l)
'(())
(apply append (map (lambda (p)
(map (lambda (n)
(insert p n (car l)))
(seq 0 (length p))))
(permute (cdr l))))))
The last procedure can be expressed more concisely by using append-map:
(define (permute l)
(if (null? l)
'(())
(append-map (lambda (p)
(map (lambda (n)
(insert p n (car l)))
(seq 0 (length p))))
(permute (cdr l)))))
Either way, the result is as expected:
(permute '(1 2 3))
=> '((1 2 3) (2 1 3) (2 3 1) (1 3 2) (3 1 2) (3 2 1))
In Common Lisp, the function is named "mapcan" and it is sometimes used to combine filtering with mapping:
* (mapcan (lambda (n) (if (oddp n) (list (* n n)) '()))
'(0 1 2 3 4 5 6 7))
(1 9 25 49)
In Racket that would be:
> (append-map (lambda (n) (if (odd? n) (list (* n n)) '()))
(range 8))
'(1 9 25 49)
But it's better to do it this way:
> (filter-map (lambda (n) (and (odd? n) (* n n))) (range 8))
'(1 9 25 49)