Scheme - Return a list of pairs from 2 given lists - scheme

I'm working on this procedure which is supposed to return a list of pairs from 2 given lists. So for example (pairs '(1 2 3) '(a b c)) should return '((1.a) (2.b) (3.c)).
This is my logic so far. I would take the first element of each list and recursively call the procedure again with cdr as the new arguments. My result is returning a list such as this: (1 a 2 b 3 c)
Where is my logic going wrong? I know there is a list missing somewhere, but I'm not an expert at Scheme.
Any suggestions?
(define pairs
(lambda (x y)
(if (or (null? x) (null? y))
'()
(cons (car x)
(cons (car y)
(pairs (cdr x)(cdr y)))))))
(pairs '(1 2 3) '(a b c))

Notice that you produce a value that prints as (1 . 3) by evaluating (cons 1 3). However in your program you are doing (cons 1 (cons 3 ...)) which will prepend 1 and 3 to the following list.
In other words: Instead of (cons (car x) (cons (car y) (pairs ...))
use (cons (cons (car x) (car y) (pairs ...)).

Using map simplifies it a lot:
(define (pairs x y)
(map (λ (i j) (list i j)) x y))
Testing:
(pairs '(1 2 3) '(a b c))
Output:
'((1 a) (2 b) (3 c))

The result you're looking for should look like this:
((1 a) (2 b) (3 c))
In reality this structure is similar to this:
(cons
(cons 1 a)
(cons
(cons 2 b)
(cons
(cons 3 c)
'()
)
)
)
So what you're looking for is to append pairs to a list instead of adding all items to the list like you do. Simply your result looks like this:
(1 (2 (pairs ...)))
Your code should look like this:
(define pairs
(lambda (x y)
(if (or (null? x) (null? y))
'()
(cons
(cons (car x) (car y))
(pairs (cdr x) (cdr y))))))
This code might work, but it isn't perfect. We could make the code pass the list we create as a third parameter to make the function tail recursive.
You'd have something like this:
(define pairs
(lambda (x y)
(let next ((x x) (y y) (lst '()))
(if (or (null? x) (null? y))
(reverse lst)
(next (cdr x)
(cdr y)
(cons
(cons (car x) (car y))
lst))))))
As you can see, here since we're adding next element at the beginning of the list, we have to reverse the lst at the end. The difference here is that every time next is called, there is no need to keep each state of x and y in memory. When the named let will return, it won't be necessary to pop all the values back to where it called. It will simply return the reversed list.
That said, instead of using reverse we could simply return lst and use (append lst (cons (car x) (car y))) which would append the pair at the end of the list... Since lists are linked lists... in order to append something at the end of the list, scheme has to walk over all list items... which migth not be good with big list. So the solution is to add everything and at the end reorder the list as you wish. The reverse operation would happen only once.

Related

Scheme - returning first n-elements of an array

I'm trying to write a function in Scheme that returns the first n elements in a list. I'm want to do that without loops, just with this basic structure below.
What I've tried is:
(define n-first
(lambda (lst n)
(if (or(empty? lst) (= n 0))
(list)
(append (car lst) (n-first (cdr lst) (- n 1))))))
But I'm getting an error:
append: contract violation
expected: list?
given: 'in
I've tried to debug it and it looks that the tail of the recursion crashes it, meaning, just after returning the empty list the program crashes.
When replacing "append" operator with "list" I get:
Input: (n-first '(the cat in the hat) 3)
Output:
'(the (cat (in ())))
But I want to get an appended list.
A list that looks like (1 2 3) i constructed like (1 . (2 . (3 . ()))) or if you're more familiar with cons (cons 1 (cons 2 (cons 3 '()))). Thus (list 1 2 3)) does exactly that under the hood. This is crucial information in order to be good at procedures that works on them. Notice that the first cons cannot be applied before the (cons 2 (cons 3 '())) is finished so a list is always created from end to beginning. Also a list is iterated from beginning to end.
So you want:
(define lst '(1 2 3 4 5))
(n-first lst 0) ; == '()
(n-first lst 1) ; == (cons (car lst) (n-first (- 1 1) (cdr lst)))
(n-first lst 2) ; == (cons (car lst) (n-first (- 2 1) (cdr lst)))
append works like this:
(define (append lst1 lst2)
(if (null? lst1)
lst2
(cons (car lst1)
(append (cdr lst1) lst2))))
append is O(n) time complexity so if you use that each iteration of n parts of a list then you get O(n^2). For small lists you won't notice it but even a medium sized lists of a hundred thousand elements you'll notice append uses about 50 times longer to complete than the cons one and for large lists you don't want to wait for the result since it grows exponentially.
try so
(define first-n
(lambda (l)
(lambda (n)
((lambda (s)
(s s l n (lambda (x) x)))
(lambda (s l n k)
(if (or (zero? n)
(null? l))
(k '())
(s s (cdr l) (- n 1)
(lambda (rest)
(k (cons (car l) rest))))))))))
(display ((first-n '(a b c d e f)) 4))
(display ((first-n '(a b)) 4))
In scheme you must compute mentally the types of each expression, as it does not have a type checker/ type inference included.

Rewrite an item in a list of list

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.

How to do square in RACKET

Here is my code:
(define (squares 1st)
(let loop([1st 1st] [acc 0])
(if (null? 1st)
acc
(loop (rest 1st) (* (first 1st) (first 1st) acc)))))
My test is:
(test (sum-squares '(1 2 3)) => 14 )
and it's failed.
The function input is a list of number [1 2 3] for example, and I need to square each number and sum them all together, output - number.
The test will return #t, if the correct answer was typed in.
This is rather similar to your previous question, but with a twist: here we add, instead of multiplying. And each element gets squared before adding it:
(define (sum-squares lst)
(if (empty? lst)
0
(+ (* (first lst) (first lst))
(sum-squares (rest lst)))))
As before, the procedure can also be written using tail recursion:
(define (sum-squares lst)
(let loop ([lst lst] [acc 0])
(if (empty? lst)
acc
(loop (rest lst) (+ (* (first lst) (first lst)) acc)))))
You must realize that both solutions share the same structure, what changes is:
We use + to combine the answers, instead of *
We square the current element (first lst) before adding it
The base case for adding a list is 0 (it was 1 for multiplication)
As a final comment, in a real application you shouldn't use explicit recursion, instead we would use higher-order procedures for composing our solution:
(define (square x)
(* x x))
(define (sum-squares lst)
(apply + (map square lst)))
Or even shorter, as a one-liner (but it's useful to have a square procedure around, so I prefer the previous solution):
(define (sum-squares lst)
(apply + (map (lambda (x) (* x x)) lst)))
Of course, any of the above solutions works as expected:
(sum-squares '())
=> 0
(sum-squares '(1 2 3))
=> 14
A more functional way would be to combine simple functions (sum and square) with high-order functions (map):
(define (square x) (* x x))
(define (sum lst) (foldl + 0 lst))
(define (sum-squares lst)
(sum (map square lst)))
I like Benesh's answer, just modifying it slightly so you don't have to traverse the list twice. (One fold vs a map and fold)
(define (square x) (* x x))
(define (square-y-and-addto-x x y) (+ x (square y)))
(define (sum-squares lst) (foldl square-y-and-addto-x 0 lst))
Or you can just define map-reduce
(define (map-reduce map-f reduce-f nil-value lst)
(if (null? lst)
nil-value
(map-reduce map-f reduce-f (reduce-f nil-value (map-f (car lst))))))
(define (sum-squares lst) (map-reduce square + 0 lst))
racket#> (define (f xs) (foldl (lambda (x b) (+ (* x x) b)) 0 xs))
racket#> (f '(1 2 3))
14
Without the use of loops or lamdas, cond can be used to solve this problem as follows ( printf is added just to make my exercises distinct. This is an exercise from SICP : exercise 1.3):
;; Takes three numbers and returns the sum of squares of two larger number
;; a,b,c -> int
;; returns -> int
(define (sum_sqr_two_large a b c)
(cond
((and (< a b) (< a c)) (sum-of-squares b c))
((and (< b c) (< b a)) (sum-of-squares a c))
((and (< c a) (< c b)) (sum-of-squares a b))
)
)
;; Sum of squares of numbers given
;; a,b -> int
;; returns -> int
(define (sum-of-squares a b)
(printf "ex. 1.3: ~a \n" (+ (square a)(square b)))
)
;; square of any integer
;; a -> int
;; returns -> int
(define (square a)
(* a a)
)
;; Sample invocation
(sum_sqr_two_large 1 2 6)

how to delete third element in a list using scheme

This is what I want:
(delete-third1 '(3 7 5)) ==> (3 7)
(delete-third1 '(a b c d)) ==> (a b d)
so I did something like:
(define (delete-third1 LS ) (list(cdr LS)))
which returns
(delete-third1 '(3 7 5))
((7 5))
when it should be (3 7). What am I doing wrong?
Think about what cdr is doing. cdr says that "given a list, chop off the first value and return the rest of the list". So it's removing only the first value, then returning you the rest of that list (which is exactly what you are seeing). Since it returns a list, you don't need a list (cdr LS) there either.
What you want is something like this:
(define (delete-n l n)
(if (= n 0)
(cdr l)
(append (list (car l)) (delete-n (cdr l) (- n 1)))))
(define (delete-third l)
(delete-n l 2))
So how does this work? delete-n will delete the nth element of a list by keeping a running count of what element we are up to. If we're not up to the nth element, then add that element to the list. If we are, then skip that element and add the rest of the elements to our list.
Then we simply define delete-third as delete-n where it removes the 3rd element (which is element 2 when we start counting at 0).
The simplest way would be: cons the first element, the second element and the rest of the list starting from the fourth position. Because this looks like homework I'll only give you the general idea, so you can fill-in the blanks:
(define (delete-third1 lst)
(cons <???> ; first element of the list
(cons <???> ; second element of the list
<???>))) ; rest of the list starting from the fourth element
The above assumes that the list has at least three elements. If that's not always the case, validate first the size of the list and return an appropriate value for that case.
A couple more of hints: in Racket there's a direct procedure for accessing the first element of a list. And another for accessing the second element. Finally, you can always use a sequence of cdrs to reach the rest of the rest of the ... list (but even that can be written more compactly)
From a practical standpoint, and if this weren't a homework, you could implement this functionality easily in terms of other existing procedures, and even make it general enough to remove elements at any given position. For example, for removing the third element (and again assuming there are enough elements in the list):
(append (take lst 2) (drop lst 3))
Or as a general procedure for removing an element from a given 0-based index:
(define (remove-ref lst idx)
(append (take lst idx) (drop lst (add1 idx))))
Here's how we would remove the third element:
(remove-ref '(3 7 5) 2)
=> '(3 7)
This works:
(define (delete-third! l)
(unless (or (null? l)
(null? (cdr l))
(null? (cddr l)))
(set-cdr! (cdr l) (cdddr l)))
l)
if you want a version that does not modify the list:
(define (delete-third l)
(if (not (or (null? l)
(null? (cdr l))
(null? (cddr l))))
(cons (car l) (cons (cadr l) (cdddr l)))
l))
and if you want to do it for any nth element:
(define (list-take list k)
(assert (not (negative? k)))
(let taking ((l list) (n k) (r '()))
(if (or (zero? n) (null? l))
(reverse r)
(taking (cdr l) (- n 1) (cons (car l) r)))))
(define (delete-nth l n)
(assert (positive? n))
(append (list-take l (- n 1))
(if (> n (length l))
'()
(list-tail l n))))
(define (nth-deleter n)
(lambda (l) (delete-nth l n)))
(define delete-3rd (nth-deleter 3))

Scheme looping through list

I am trying to write some code that will loop through a list and add like terms. I'm trying to cons the cdr of the input list to a null list and then just compare the car of the list to the car of the new list and traverse down the list but my code just isn't working. What am I doing wrong here?
(define loop-add
(lambda (l temp outputList)
(if (or (equal? (cdr l) '()) (equal? (pair? (car l)) #f))
outputList
(if (equal? l '())
outputList
(let ((temp (cdr l)))
(if (equal? temp '())
(loop-add (cdr l) outputList)
(if (equal? (cdr (car l)) (cdr (car temp)))
(loop-add l (cdr temp) (cons (append (cdr (car l)) (cdr (car (cdr l)))) outputList))
(loop-add l temp outputList))))))))
but the problem now is at the end line its just going to be an infinite loop. I need a way to recur with the input list but with temp being the cdr of the previous temp list.
Start by writing a procedure that can transform your input list into a new list of the unique terms in the original list, so
(get-unique-terms '((2 1) (3 4) (5 3) (2 4)))
(1 4 3) ; or something like that
Call this new list TERMS. Now for each element in TERMS you can search the original list for matching elements, and get a sum of the coefficients:
(define (collect-like-terms l)
(let ((terms (get-unique-terms l)))
;; For each element of TERMS,
;; Find all elements of L which have a matching term,
;; Sum the coefficients of those elements,
;; Make a record of the sum and the term a la L.
;; Collect the results into a list and return.
Here's a simple solution in Racket:
(define (loop-add l)
(define table
(for/fold ([h (hash)]) ([i l])
(dict-update h (cadr i) (lambda (v) (+ v (car i))) 0)))
(dict-map table (lambda (key val) (list val key))))
(loop-add '((2 1) (3 4) (5 3) (2 4)))

Resources