I've been working on a vector multiply function in scheme and have found myself in rut. I dont want to use any looping and I dont want to use any scheme built in functions other than the ones I've already included. I've created a helper function called rotate and dotproduct. I can get the correct values if I do this in racket (vectormult '(1 2 -1) (rotate '((0 2 3) (1 2 0) (1 0 3)))). How can I rotate the initial parameter without re-rotating after every recursive call? NOTE: I dont want to introduce additional paramaters. If my logic/approach to this is all wrong please help me get on the right track.
Code
(define dotproduct
(lambda (l1 l2)
(if (or (null? l1) (null? l2))
0
(+ (* (car l1) (car l2)) (dotproduct (cdr l1) (cdr l2))))))
(define getFirsts
(lambda (l)
(cond
((null? l) `())
(else (cons (first* l) (getFirsts (cdr l)))))))
(define removeFirsts
(lambda (l)
(cond
((null? l) `())
((null? (car l)) `())
(else (cons (cdr (car l)) (removeFirsts (cdr l)))))))
(define rotate
(lambda (l)
(cond
((null? l) `())
((null? (first* l)) `())
(else (cons (getFirsts l) (rotate (removeFirsts l)))))))
(define vectormult
(lambda (l1 l2)
(cond
((null? l2) `())
(else (cons (dotproduct l1 (car l2)) (vectormult l1 (cdr l2)))))))
If I understand the question, you could rename your current vectormult to, say, rotatedvectormult (and change its recursive call accordingly), and then have vectormult just rotate the parameter before calling rotatedvectormult. This way, rotatedvectormult would know the parameter was already rotated, but vectormult could still take an unrotated vector.
I ended up ditching the rotate function in favor of adding 2 functions getFirsts and removeFirsts.
Code
(define getFirsts
(lambda (l)
(cond
((null? l) `())
(else (cons (first* l) (getFirsts (cdr l)))))))
(define removeFirsts
(lambda (l)
(cond
((null? l) `())
((null? (car l)) `())
(else (cons (cdr (car l)) (removeFirsts (cdr l)))))))
;(define rotate
; (lambda (l)
; (cond
; ((null? l) `())
; ((null? (first* l)) `())
; (else (cons (getFirsts l) (rotate (removeFirsts l)))))))
(define vectormult
(lambda (l1 l2)
(cond
((null? (first* l2)) `())
(else (cons (dotproduct l1 (getFirsts l2)) (vectormult l1 (removeFirsts l2)))))))
Related
last-non-zero takes a list of numbers and return the last cdr whose car is 0.
So, I can implement it using continuations, but how do I do this with natural recursion.
(define last-non-zero
(lambda (ls)
(let/cc return
(letrec
((lnz
(lambda (ls)
(cond
((null? ls) '())
((zero? (car ls)) ;; jump out when we get to last 0.
(return (lnz (cdr ls))))
(else
(cons (car ls) (lnz (cdr ls))))))))
(lnz ls)))))
Here's an obvious version which is not tail-recursive:
(define (last-non-zero l)
;; Return the last cdr of l which does not contain zero
;; or #f if there is none
(cond
((null? l)
#f)
((zero? (car l))
(let ((lnzc (last-non-zero (cdr l))))
;; This is (or lnzc (cdr l)) but that makes me feel bad
(if lnzc
lnzc
(cdr l))))
(else
(last-non-zero (cdr l)))))
Here is that version turned into a tail-recursive equivalent with also the zero test moved around a bit.
(define (last-non-zero l)
(let lnzl ([lt l]
[r #f])
(if (null? lt)
r
(lnzl (cdr lt) (if (zero? (car lt)) (cdr lt) r)))))
It's much clearer in this last version that the list is traversed exactly once.
Please indicate if I have correctly understood the problem:
#lang scheme
; returns cdr after last zero in lst
(define (last-non-zero lst)
; a helper function with 'saved' holding progress
(define (lnz-iter lst saved)
(if (null? lst)
saved
(if (zero? (car lst))
(lnz-iter (cdr lst) (cdr lst))
(lnz-iter (cdr lst) saved))))
(lnz-iter lst '()))
(last-non-zero '(1 2 3 0 7 9)) ; result (7 9)
Racket's takef-right can do it:
> (takef-right '(1 2 0 3 4 0 5 6 7) (lambda (n) (not (zero? n))))
'(5 6 7)
But assuming you have an assignment where you're supposed to write the logic yourself instead of just using a built in function, one easy if not very efficient approach is to reverse the list, build a new list out of everything up to the first zero, and return that. Something like:
(define (last-non-zero ls)
(let loop ([res '()]
[ls (reverse ls)])
(if (or (null? ls) (zero? (car ls)))
res
(loop (cons (car ls) res) (cdr ls)))))
Using your implementation where you return the argument in the event there are no zero you can just have a variable to keep the value you think has no zero values until you hit it and then update both:
(define (last-non-zero lst)
(let loop ((lst lst) (result lst))
(cond ((null? lst) result)
((zero? (car lst)) (loop (cdr lst) (cdr lst)))
(else (loop (cdr lst) result)))))
(last-non-zero '()) ; ==> ()
(last-non-zero '(2 3)) ; ==> (2 3)
(last-non-zero '(2 3 0)) ; ==> ()
(last-non-zero '(2 3 0 1 2)) ; ==> (1 2)
(define last-non-zero
(lambda (l)
((lambda (s) (s s l (lambda (x) x)))
(lambda (s l* ret)
(if (null? l*)
(ret '())
(let ((a (car l*))
(r (cdr l*)))
(if (zero? a)
(s s r (lambda (x) x))
(s s r
(lambda (r)
(ret (cons a r)))))))))))
Also possible, to use foldr:
(define (last-non-zero l)
(reverse (foldl (lambda (e res) (if (zero? e) '() (cons e res))) 0 l)))
Or use recursion:
(define (last-non-zero l (res '()))
(cond ((empty? l) res)
((zero? (car l)) (last-non-zero (cdr l) (cdr l)))
(else (last-non-zero (cdr l) res))))
I have a nested list (1 (4 (5) 3) 9 10) and I want to delete the lists of length 1 so the result would be (1 (4 3) 9 10).
This is what I have tried so far, which does not remove (5) and returns the original list.
(defun remove (l)
(cond
((null l) nil)
((and (listp (car l)) (= (length l) 1)) (remove (cdr l)))
((atom (car l)) (cons (car l) (remove (cdr l))))
(T (cons (remove (car l)) (remove (cdr l))))
))
Two things: first, remove is a predefined function in package CL, so I strongly advice to use a different name, let's say my-remove.
Second, you are testing the length of l instead of the sublist (car l), which is what you want to eliminate.
The correct form would be:
(defun my-remove (l)
(cond
((null l) nil)
((and (listp (car l)) (= (length (car l)) 1)) (my-remove (cdr l)))
((atom (car l)) (cons (car l) (my-remove (cdr l))))
(T (cons (my-remove (car l)) (my-remove (cdr l))))
))
Tail call recursive version. Plus: Without the test (atom (car l)) to be permissive for non-list and non-atom components in the list. (e.g. vectors or other objects as element of the list - they are treated like atoms.
(defun my-remove (l &optional (acc '()))
(cond ((null l) (nreverse acc))
((listp (car l)) (if (= 1 (length (car l))) ;; list objects
(my-remove (cdr l) acc) ;; - of length 1
(my-remove (cdr l) (cons (my-remove (car l)) acc)))) ;; - longer
(t (my-remove (cdr l) (cons (car l) acc))))) ;; non-list objects
Can someone show me the error in this code please?
I want to generalize the member function to support nested lists. I need to search thing inside the nested list and return the rest of the list when I found thing. I don't really understand whats wrong with the code below.
(define (memberk thing lis)
(cond
((null? lis) #f)
((list? (car lis))
(cons (memberk thing (car lis))
(memberk thing (cdr lis))))
(else
(if (equal? (car lis) thing)
lis
(memberk thing (cdr lis))))))
Expexted output: (memberk 3 '(1 4 (3 1) 2)) = '((3 1) 2)
Actual output from the code above: '((3 1) . #f)
So how I see this you would like the top level cons that has the key found somewhere in car. I'm thinking something like:
(define (memberk needle lst)
(define (found? haystack)
(or (equal? needle haystack)
(and (pair? haystack)
(or (found? (car haystack))
(found? (cdr haystack))))))
(let loop ((lst lst))
(cond ((null? lst) #f)
((found? (car lst)) lst)
(else (loop (cdr lst))))))
(memberk '(a) '(a b (b (a) c) c d)) ; ==> ((b (a) c) c d)
Something like this?
It is a bit unclear what you want - since there is only one test case.
(define (memberk thing lis)
(cond
[(null? lis)
#f]
[(and (cons? (car lis)) (memberk thing (car lis)))
=> (λ (found) (cons found (cdr lis)))]
[(equal? (car lis) thing)
lis]
[else
(memberk thing (cdr lis))]))
Create the function AllEqual?(L) which will be given a list of (at least 2) elements and will return #t if all of them are the same, otherwise #f
(define (allequal? l)
(if (< (length l) 2)
#t
(equal? (car l) (allequal? (cdr l)))))
(equal? (car l) (allequal? (cdr l)))
tests if (car l) is equal? to (allequal? ...). Since allequal? returns a boolean (#t or #f), you test if (car l) is #t or #f, which is not what you want.
You need to compare the first two elements, if available, and then recurse on the cdr of your list:
(define (allequal? l)
(if (< (length l) 2)
#t
(and (equal? (car l) (cadr l))
(allequal? (cdr l)))))
or, easier,
(define (allequal? l)
(or (< (length l) 2)
(and (equal? (car l) (cadr l))
(allequal? (cdr l)))))
or even
(define (allequal? l)
(or (null? l)
(null? (cdr l))
(and (equal? (car l) (cadr l))
(allequal? (cdr l)))))
how to design a function content which
inputs a single list of atoms lat and which returns
the content of lat.Thus the content of '(a b c a b c d d) is '(a b c d).
The procedure content below should get you what you need.
(define (work x y)
(if (null? (cdr x))
(if (in? (car x) y)
y
(cons (car x) y))
(if (in? (car x) y)
(work (cdr x) y)
(work (cdr x) (cons (car x) y)))))
(define (in? x y)
(if (null? y)
#f
(if (equal? x (car y))
#t
(in? x (cdr y)))))
(define (content x) (work x (list)))
The procedure content accepts a list as a parameter. It sends the list to another procedure called work. This procedure processes the list and adds the items in the list to a new list (if they are not already in the new list). The work procedure makes use of yet another procedure called in, which checks to see if an item is a member of a list.
My solution essentially divides your problem into two sub-problems and makes use of procedures which operate at a lower level of abstraction than your original problem.
Hope that helps.
It is PLT Scheme solution:
(define (is_exists list element)
(cond
[(empty? list) false]
[else
(cond
[(= (first list) element) true]
[else (is_exists (rest list) element)])]))
(define (unique list target)
(cond
[(empty? list) target]
[else
(cond
[(is_exists target (first list)) (unique (rest list) target)]
[else (unique (rest list) (cons (first list) target))])]))
(define (create_unique list)
(unique list empty))
Check it:
> (define my_list (cons '1 (cons '2 (cons '3 (cons '2 (cons '1 empty))))))
> my_list
(list 1 2 3 2 1)
> (create_unique my_list)
(list 3 2 1)
How about little schemer style,
(define (rember-all a lat)
(cond
((null? lat) '())
((eq? a (car lat)) (rember-all a (cdr lat)))
(else (cons (car lat) (rember-all a (cdr lat))))))
(define (content lat)
(cond
((null? lat) '())
(else (cons (car lat)
(content (rember-all (car lat) (cdr lat)))))))
Start from a procedure that simply creates a copy of the passed-in list (very easy to do):
(define (unique-elements seq)
(define (loop ans rest)
(cond ((null? rest) ans)
(else
(loop (cons (car rest) ans)
(cdr rest)))))
(loop '() seq))
To ensure that the output list's elements are unique, we should skip the CONS if the head of REST is already a member of ANS. So we add another condition to do just that:
;;; Create list containing elements of SEQ, discarding duplicates.
(define (unique-elements seq)
(define (loop ans rest)
(cond ((null? rest) ans)
((member (car rest) ans) ; *new*
(loop ans (cdr rest))) ; *new*
(else
(loop (cons (car rest) ans)
(cdr rest)))))
(loop '() seq))
The following function takes in a list and returns a new list with only the unique inputs of it's argument using recursion:
(defun uniq (list)
(labels ((next (lst new)
(if (null lst)
new
(if (member (car lst) new)
(next (cdr lst) new)
(next (cdr lst) (cons (car lst) new))))))
(next list ())))
As was mentioned in the comments, common lisp already has this function:
(defun uniq (list)
(remove-duplicates list))
(define (remove-duplicates aloc)
(cond
((empty? aloc) '())
(else (cons (first aloc)
(remove-duplicates
(filter (lambda (x)
(cond
((eq? x (first aloc)) #f)
(else #t)))
(rest aloc)))))))