I need to make a recursive function that takes an object and a vector and returns a list of all the objects that preceded my object parameter.
I did it using iteration like this:
(define (precedes obj vec)
(do ((i 1 (+ i 1))
(list '() (if (eqv? obj (vector-ref vec i))
(cons(vector-ref vec (- i 1)) list)
list)))
((= i (vector-length vec)) list))
)
but I'm having a lot of trouble trying to figure out how to do the same thing using recursion. I'm confused how I can keep incrementing through the vector as I recursively call. So far, all I have is this:
(define (precedes2 obj vec)
(define list '())
(if (eqv? obj (vector-ref vec i))
(cons(vector-ref vec(- i 1)) list)
list)))
I figured I would use the same logic I used before in terms of the if statement, but I'm not sure how to now call the same function with the updated vector. Any help would be great.
You're in the interesting position of moving from an iterative implementation to a recursive one; usually people go in the other direction. Fortunately, moving from a do-loop to recursion is pretty easy. In general, a do loop can be rewritten as follows:
(do ((i i-init i-step)
(j j-init j-step)
...)
(test result)
body)
becomes
(define f (i j ...)
(cond
(test result)
(else body (f i-step j-step ...))))
(f i-init j-init ...)
That translation is usually written using a named let, though:
(let f ((i i-init)
(j j-init)
...)
(cond
(test result)
(else body (f i-step j-step ...))))
So (and I haven't tested the code) your original function
(define (precedes obj vec)
(do ((i 1 (+ i 1))
(list '() (if (eqv? obj (vector-ref vec i))
(cons(vector-ref vec (- i 1)) list)
list)))
((= i (vector-length vec)) list))
)
would turn into
(define (precedes obj vec)
(let loop ((i 1)
(list '()))
(cond
((= i (vector-length vec)) list)
(else (loop (+ i 1)
(if (eqv? obj (vector-ref vec i))
(cons (vector-ref vec (- i 1)) list)
list))))))
Related
How do I implement a program in Scheme taking the elements of a given list and returning a new list where the elements are random gatherings of the previous list? I would like it to work for any length. For example:
Input: '(a e i o u), output: '((a e) (i o) (u)) for length 2.
My attempts (making use of for/list) are being clumsy and based on recursion. I have divided the tasks as suggested by Óscar:
Select n elements randomly from a list l:
(define (pick-n-random l n)
(take (shuffle l) n))
Remove a list l2 from a list l1:
(define (cut l1 l2)
(cond ((null? l1)
'())
((not (member (car l1) l2))
(cons (car l1) (cut (cdr l1) l2)))
(else
(cut (cdr l1) l2))))
Then, and that is my problem: how do I recurse over this process to get the intended program? Should I use for/list to paste all sublists got by this process 1. and 2.?
It's easier if we split the problem into chunks. First, let's write a couple of procedures that will allow us to take or drop n elements from a list, with appropriate results if there are not enough elements left in the list (if not for this, we could have used the built-in take and drop):
(define (take-up-to lst n)
(if (or (<= n 0) (null? lst))
'()
(cons (car lst) (take-up-to (cdr lst) (sub1 n)))))
(define (drop-up-to lst n)
(if (or (<= n 0) (null? lst))
lst
(drop-up-to (cdr lst) (sub1 n))))
With the above two procedures in place, it's easy to create another procedure to group the elements in a list into n-sized sublists:
(define (group lst n)
(if (null? lst)
'()
(cons (take-up-to lst n)
(group (drop-up-to lst n) n))))
Finally, we combine our grouping procedure with shuffle, which randomizes the contents of the list:
(define (random-groups lst n)
(group (shuffle lst) n))
It works as expected:
(random-groups '(a e i o u) 2)
=> '((e a) (u i) (o))
How would I write a vector-to-list function without using the built in (vector->list) function. Specifically I am looking to learn how to access values within vectors as I have not previously worked with them.
Is there a more straightforward implementation than this:
(define (vector-to-list vec)
(define (helper k lst)
(if (= k (vector-length vec))
lst
(helper (+ k 1) (cons (vector-ref vec k) lst))))
(reverse (helper 0 '())))
(vector-to-list #(1 2 3 4))
?
No, that is a sound implementation. One could write it a bit more idiomatically using 'named-let' as:
(define (vector-to-list vec)
(let ((len (vector-length vec)))
(let looping ((k 0) (lst '())
(if (= k len)
(reverse lst)
(looping (+ k 1)
(cons (vector-ref vec k) lst)))))
You could avoid the use of reverse by constructing the list from back to front:
(define (vector-to-list vec)
(let looping ((k (- (vector-length vec) 1)) (lst '())
(if (< k 0)
lst
(looping (- k 1)
(cons (vector-ref vec k) lst)))))
I am trying to implement a mergesort algorithm in Scheme using vectors. I am aware of other sorting methods that I could use, but I would like to finish my code on this. What I have so far is as follows.
(define (split v)
(define (helper k v1 v2)
(let ((m (floor (/ (vector-length v) 2))))
(if (>= k m)
(if (= k (vector-length v))
(cons v1 v2)
(helper (+ k 1) v1 (vector-append v2 (vector (vector-ref v k)))))
(helper (+ k 1) (vector-append v1 (vector (vector-ref v k))) v2))))
(helper 0 #() #()))
(define (merge v1 v2)
(if (< (vector-ref v1 0) (vector-ref v2 0))
(vector-append v1 v2)
(vector-append v2 v1)))
(define (mergesort v)
(if (<= (vector-length v) 1)
v
(merge (mergesort (car (split v))) (mergesort (cdr (split v))))))
I am very close to my answer, but I am missing something. Any help here?
The main stumbling block for your implementation is that your merge function didn't correctly implement the merge algorithm. In the merge algorithm:
You have two pointers, which initially point to the start of the left-hand and right-hand lists.
If both pointers are at the end of their respective lists, you're done.
If either pointer is at the end of its respective list, output the remaining elements of the other list. Done.
At this point, both pointers point to an element. If the right-hand element is less than the left-hand element, output the right-hand element, and advance the right pointer. Otherwise, output the left-hand element, and advance the left pointer. Go to step 2.
My merge-into! function below implements such an approach.
Aside from that, the other main biggie is that your split function is trying to build vectors piecemeal, and sadly, that is a slow process: it has to copy all the elements into a new vector each time. It's not like cons! With vectors, don't be hesitant to use vector-set!; any immutable update of vectors is going to be slow and inefficient, so just bite the bullet and make it mutable. :-)
For reference, I wrote a new implementation from scratch (in Racket):
(define (split-halves vec)
(vector-split-at vec (quotient (vector-length vec) 2)))
(define (merge lhs rhs)
(define result (make-vector (+ (vector-length lhs)
(vector-length rhs))))
(merge-into! result lhs rhs))
(define (merge-into! result lhs rhs)
(let loop ((i 0) (j 0) (k 0))
(define (take-left)
(vector-set! result k (vector-ref lhs i))
(loop (add1 i) j (add1 k)))
(define (take-right)
(vector-set! result k (vector-ref rhs j))
(loop i (add1 j) (add1 k)))
(cond ((= k (vector-length result)) result)
((= i (vector-length lhs))
(take-right))
((= j (vector-length rhs))
(take-left))
((< (vector-ref rhs j) (vector-ref lhs i))
(take-right))
(else
(take-left)))))
(define (mergesort vec)
(case (vector-length vec)
((0 1) vec)
(else (let-values (((lhs rhs) (split-halves vec)))
(merge (mergesort lhs) (mergesort rhs))))))
The merge-into! function allows a mutating version of mergesort to be easily written:
(define (mergesort! vec)
(case (vector-length vec)
((0 1) vec)
(else (let-values (((lhs rhs) (split-halves vec)))
(mergesort! lhs)
(mergesort! rhs)
(merge-into! vec lhs rhs)))))
If you don't use Racket, you may need these following additional definitions (which require SRFI 43; see bottom of post if you don't have that):
(define (vector-split-at vec pos)
(values (vector-copy vec 0 pos)
(vector-copy vec pos (vector-length vec))))
(define (add1 x)
(+ x 1))
let-values is defined in SRFI 11. If you don't have that, here's a version of mergesort that uses call-with-values:
(define (mergesort vec)
(case (vector-length vec)
((0 1) vec)
(else (call-with-values (lambda () (split-halves vec))
(lambda (lhs rhs)
(merge (mergesort lhs) (mergesort rhs)))))))
vector-copy is defined in SRFI 43. If you don't have that, here's a simplified version of that:
(define (vector-copy vec start end)
(define result (make-vector (- end start)))
(do ((i start (+ i 1))
(j 0 (+ j 1)))
((>= i end) result)
(vector-set! result j (vector-ref vec i))))
I'm starting scheme for Gimp script-fu and I don't find a simple way to remove item from a vector.
My only solution is to:
Convert vector to list
Remove item from the list (http://stackoverflow.com/questions/1905222/how-to-delete-an-element-from-a-list-in-scheme)
Convert list to vector
Is it a simplier way?
Here is my code:
(set! myvector (list->vector (delete item (vector->list myvector))))
(define delete
(lambda (item list)
(cond
((equal? item (car list)) (cdr list))
(else (cons (car list) (delete item (cdr list)))))))
That's the way: you need to create a new vector without the element that needs to be removed, copying all the others. But in your code, you're missing the case where the element is not present in the vector, also you don't need to create an intermediate list, go from vector to vector directly. I wrote this with Racket using standard Scheme, it should be easy enough to adapt for script-fu:
(define (vector-delete vec elt)
(let ((new-vec (if (> (vector-length vec) 0)
(make-vector (- (vector-length vec) 1))
(vector))))
(define (loop i j)
(cond ((= i (vector-length vec))
new-vec)
((equal? (vector-ref vec i) elt)
(loop (+ i 1) j))
((< j (vector-length new-vec))
(vector-set! new-vec j (vector-ref vec i))
(loop (+ i 1) (+ j 1)))
(else vec)))
(loop 0 0)))
Use it like this:
(define myvector #(1 2 3))
(set! myvector (vector-delete myvector 3))
myvector
=> '#(1 2)
Or by a more intuitive way :
(define (vector-delete v i)
(vector-append (vector-take v i) (vector-drop v (+ i 1))))
I am learning Lisp. I have implemented a Common Lisp function that merges two strings that are ordered alphabetically, using recursion. Here is my code, but there is something wrong with it and I didn't figure it out.
(defun merge (F L)
(if (null F)
(if (null L)
F ; return f
( L )) ; else return L
;else if
(if (null L)
F) ; return F
;else if
(if (string< (substring F 0 1) (substring L 0 1)
(concat 'string (substring F 0 1)
(merge (substring F 1 (length F)) L)))
(
(concat 'string (substring L 0 1)
(merge F (substring L 1 (length L)) ))
))))
Edit :
I simply want to merge two strings such as the
inputs are string a = adf and string b = beg
and the result or output should be abdefg.
Thanks in advance.
Using string< is an overkill, char< should be used instead, as shown by Kaz. Recalculating length at each step would make this algorithm quadratic, so should be avoided. Using sort to "fake it" makes it O(n log n) instead of O(n). Using concatenate 'string all the time probably incurs extra costs of unneeded traversals too.
Here's a natural recursive solution:
(defun str-merge (F L)
(labels ((g (a b)
(cond
((null a) b)
((null b) a)
((char< (car b) (car a))
(cons (car b) (g a (cdr b))))
(t (cons (car a) (g (cdr a) b))))))
(coerce (g (coerce F 'list) (coerce L 'list))
'string)))
But, Common Lisp does not have a tail call optimization guarantee, let alone tail recursion modulo cons optimization guarantee (even if the latter was described as early as 1974, using "Lisp 1.6's rplaca and rplacd field assignment operators"). So we must hand-code this as a top-down output list building loop:
(defun str-merge (F L &aux (s (list nil)) ) ; head sentinel
(do ((p s (cdr p))
(a (coerce F 'list) (if q a (cdr a)))
(b (coerce L 'list) (if q (cdr b) b ))
(q nil))
((or (null a) (null b))
(if a (rplacd p a) (rplacd p b))
(coerce (cdr s) 'string)) ; FTW!
(setq q (char< (car b) (car a))) ; the test result
(if q
(rplacd p (list (car b)))
(rplacd p (list (car a))))))
Judging by your comments, it looks like you're trying to use if with a series of conditions (like a series of else ifs in some other languages). For that, you probably want cond.
I replaced that if with cond and cleaned up some other errors, and it worked.
(defun empty (s) (= (length s) 0))
(defun my-merge (F L)
(cond
((empty F)
(if (empty L)
F
L))
((empty L)
F)
(t
(if (string< (subseq F 0 1) (subseq L 0 1))
(concatenate 'string (subseq F 0 1) (my-merge (subseq F 1 (length F)) L))
(concatenate 'string (subseq L 0 1) (my-merge F (subseq L 1 (length L))))))))
Your test case came out as you wanted it to:
* (my-merge "adf" "beg")
"abdefg"
There were quite a few good answers, so why would I add one more? Well, the below is probably more efficient then the other answers here.
(defun merge-strings (a b)
(let* ((lena (length a))
(lenb (length b))
(len (+ lena lenb))
(s (make-string len)))
(labels
((safe-char< (x y)
(if (and x y) (char< x y)
(not (null x))))
(choose-next (x y)
(let ((ax (when (< x lena) (aref a x)))
(by (when (< y lenb) (aref b y)))
(xy (+ x y)))
(cond
((= xy len) s)
((safe-char< ax by)
(setf (aref s xy) ax)
(choose-next (1+ x) y))
(t
(setf (aref s xy) by)
(choose-next x (1+ y)))))))
(choose-next 0 0))))
(merge-strings "adf" "beg")
It is more efficient specifically in the sense of memory allocations - it only allocates enough memory to write the result string, never coerces anything (from list to string or from array to string etc.) It may not look very pretty, but this is because it is trying to do every calculation only once.
This is, of course, not the most efficient way to write this function, but programming absolutely w/o efficiency in mind is not going to get you far.
A recursive way to do it (fixed according to comment- other solutions can get an IF form as well).
(defun merge-strings (a b)
(concatenate 'string
(merge-strings-under a b)))
(defun merge-strings-under (a b)
(when (and
(= (length a)
(length b))
(> (length a) 0))
(append (if (string< (aref a 0) (aref b 0))
(list (aref a 0) (aref b 0))
(list (aref b 0) (aref a 0)))
(merge-strings-under (subseq a 1)
(subseq b 1)))))
Here's a iterative way to do it.
(concatenate 'string
(loop for i across "adf" for j across "beg" nconc (list i j)))
Note that these rely on building the string into a list of characters, then vectorizing it ( a string is a vector of characters).
You can also write a more C-esque approach...
(defun merge-strings-vector (a b)
(let ((retstr (make-array (list (+
(length a)
(length b)))
:element-type 'character)))
(labels ((merge-str (a b i)
(when (and
(= (length a)
(length b))
(/= i (length a)))
(setf (aref retstr (* 2 i)) (aref a i))
(setf (aref retstr (1+ (* 2 i))) (aref b i))
(merge-str a b (1+ i)))))
(merge-str a b 0)
retstr)))
Note that this one - unlike the other 2 - has side effects within the function. It also, imo, is more difficult to understand.
All 3 take varying numbers of cycles to execute on SBCL 56; each seems to take between 6K and 11K on most of my trials. I'm not sure why.