I want to write an insertion sort and a merge sort in clisp. The input will be a flat list of numbers. How would one write these 2 sorts recursively (preferably without using lambdas)? For the insertion sort I was thinking of making a function that takes the list and an integer (which is meant to be the current index of the element of interest) as arguments, and using setf and nth to manipulate the list. I know there's also supposed to be another recursive function inside that one, but like... I just get confused with so many functions and variables to store and stuff.
For merge sort I have absolutely no idea.
Merge sort is naturally recursive (as is any divide and conquer problem)
http://en.literateprograms.org/Merge_sort_(Lisp)
The insertion sort implementation they have cited is sort of anti-functional
http://en.literateprograms.org/Insertion_sort_(Lisp)
But loops can easily be turned into tail recursion instead.
I see it's an old question but I was also courious how to write an recursive implementation of Mergesort in Common Lisp style so I wrote it this way :
(defun mergesort (lo hi)
(let ((mid 0)
(items 0))
;; initializations
(setq items (- hi lo))
(multiple-value-bind (intreg rest)
(floor (/ (+ hi (1+ lo)) 2))
(setq mid intreg))
;; recursive call if more than 1 item
(cond ((> items 1)
(mergesort lo mid)
(mergesort mid hi)))
;; merge step
(let ((temp (sort-range *unsorted-list* lo mid hi)))
(do ((x lo (1+ x))
(tx 0 (1+ tx)))
((= x hi))
(setf (nth x *unsorted-list*) (nth tx temp))))
))
;; collect and sort range between low and high
(defun sort-range (LIST lo mid hi)
(labels ((collect-range (i1 i2)
(if (and (< i1 mid) (< i2 hi))
(let ((lv (nth i1 LIST))
(rv (nth i2 LIST)))
(if(and (< lv rv) (< i1 mid))
(cons lv (collect-range (1+ i1) i2))
(if(<= i2 hi)
(cons rv (collect-range i1 (1+ i2))))
))
(if (< i1 mid)
(cons (nth i1 LIST) (collect-range (1+ i1) i2))
(if(< i2 hi)
(cons (nth i2 LIST) (collect-range i1 (1+ i2)))))
)))
(collect-range lo mid)))
Any suggestions are welcomed !
Related
This is a problem I come up against all the time. I have a function that
does something useful, but I want a version that does something slightly
different as well.
For example, a substring search that finds all of the
positions where some substring occurs in another, longer piece of text.
Then I discover a use case that only requires finding the first instance
of the substring, or the last, or the n'th. Is there an idiomatic way to
factor out the different behaviors from the larger body of common code?
For example, here are two substring search functions. One returns the
first match. The other returns all matches. (Please ignore the fact that
this is a poor way to do a substring search.)
;; Return the index of the first matching instance of `pattern` in
;; `s`. Returns #f if there is no match.
(define (naive-string-find-first pattern s)
(let* ((p-len (string-length pattern))
(limit (- (string-length s) p-len)))
(let outer ((i 0))
(if (<= i limit)
(let inner ((j i)
(k 0))
(if (< k p-len)
(if (char=? (string-ref s j) (string-ref pattern k))
(inner (+ j 1) (+ k 1))
(outer (+ i 1)))
i))
#f))))
;; Return a list of all positions in `s` where `pattern` occurs.
;; Returns '() if there is no match.
(define (naive-string-find-all pattern s)
(let* ((p-len (string-length pattern))
(limit (- (string-length s) p-len)))
(let outer ((i 0))
(if (<= i limit)
(let inner ((j i)
(k 0))
(if (< k p-len)
(if (char=? (string-ref s j) (string-ref pattern k))
(inner (+ j 1) (+ k 1))
(outer (+ i 1)))
(cons i (outer (+ i 1)))))
'()))))
As you can see, they are almost identical, differing only in the last
two lines. Specifically, one of those lines handles proceeding from a match.
The other handles proceeding from a failure to match anything.
What I would like to be able to do is something like:
(define (naive-string-find-common pattern s match-func fail-func)
(let* ((p-len (string-length pattern))
(limit (- (string-length s) p-len)))
(let outer ((i 0))
(if (<= i limit)
(let inner ((j i)
(k 0))
(if (< k p-len)
(if (char=? (string-ref s j) (string-ref pattern k))
(inner (+ j 1) (+ k 1))
(outer (+ i 1)))
(match-func i)))
(fail-func i)))))
(define (naive-string-find-first-common pattern s)
(let ((match-f (lambda (x) x))
(fail-f (lambda (x) #f)))
(naive-string-find-common pattern s match-f fail-f)))
(define (naive-string-find-all-common pattern s)
(let ((match-f (lambda (x) (cons x (outer (+ x 1))))) ;; <-- Fails, of course.
(fail-f (lambda (x) #f)))
(naive-string-find-common pattern s match-f fail-f)))
Handling of the "find-first" behavior works. The "find-all" version
fails because the specialization procedure has no knowledge of the
named let outer.
Is there an idiomatic way to factor out the needed functionality in
cases like this?
As #soegaard says, wrapper functions that add a "flag" argument are idiomatic and clear.
The "What I would like to do" code could be repaired, for example (in Racket to use check-expect:
#lang r6rs
(import (rnrs) (test-engine racket-tests))
(define (naive-string-find-common pattern s match-func fail-func)
(let* ((p-len (string-length pattern))
(limit (- (string-length s) p-len)))
(let outer ((i 0))
(if (<= i limit)
(let inner ((j i)
(k 0))
(if (< k p-len)
(if (char=? (string-ref s j) (string-ref pattern k))
(inner (+ j 1) (+ k 1))
(outer (+ i 1)))
(match-func i (lambda () (outer (+ i 1))) )))
(fail-func i)))))
(define (naive-string-find-first-common pattern s)
(let ((match-f (lambda (x k) x))
(fail-f (lambda (x) #f)))
(naive-string-find-common pattern s match-f fail-f)))
(define (naive-string-find-all-common pattern s)
(let ((match-f (lambda (x k) (cons x (k))))
(fail-f (lambda (x) '())))
(naive-string-find-common pattern s match-f fail-f)))
(check-expect (naive-string-find-first-common "ab" "abab") 0 )
(check-expect (naive-string-find-first-common "ab" "a-b-") #f )
(check-expect (naive-string-find-all-common "ab" "abab") '(0 2) )
(check-expect (naive-string-find-all-common "ab" "a-b-") '() )
(test)
Is there an idiomatic way to factor out the needed functionality in cases like this?
The way you have done is idiomatic.
If two functions f and g do almost the same work, then make a funktion h that can do both. Make h take an extra argument, that indicates whether it should behave as f or g (here a flag that indicates whether to continue after the first needle is found). Finally define "wrappers" f and g that simply calls h with the appropriate flag(s).
Hi I am trying to implement a program in scheme shifting a list k times to the left.
For example:
(shift-k-left ’(1 2 3) 2)
’(3 1 2)
I have managed to implement a code that do shift left once here:
(define shift-left
(lambda (ls)
(if (null? ls)
'()
(append (cdr ls)
(cons (car ls)
'())))))
I want to use shift left as a function on shift-k-left.
Here is a solution using circular-list from srfi/1.
(require srfi/1)
(define (shift xs k)
(define n (length xs))
(take (drop (apply circular-list xs) k) n))
Using your shift-left to shift k times:
If k is 0: do nothing
If k is not 0: shift k-1 times, and then shift-left the result.
That is,
(define (shift-left-k ls k)
(if (= k 0)
ls
(shift-left (shift-left-k ls (- k 1)))))
You may want to adjust to do something sensible for negative k.
The idea is to count down n while consing the cars of r to p and the cdrs to r then the base case becomes append r to the reverse of p. If we run into a null? r we reverse p and continue this wraps the rotation:
(define (shift-k-left l n)
; assume that n >= 0
(let loop ((n n) (p '()) (r l))
(if (= n 0)
(append r (reverse p))
(if (null? r)
(loop n '() (reverse p))
(loop (- n 1) (cons (car r) p) (cdr r))))))
Here is something similar:
(define (addn value n)
(let loop ((value value) (n n))
(if (zero? n)
value
(loop (add1 value) (- n 1)))))
(addn 5 3)
; ==> 8
Now you could make an abstraction:
(define (repeat proc)
(lambda (v n)
...))
(define addn (repeat add1))
(addn 5 3)
; ==> 8
(define shift-k-left (repeat shift-left))
(shift-k-left ’(1 2 3) 2)
; ==> (3 1 2)
Needless to say repeat looks a lot like add1 does.
NB: The naming is off. Your implementation is more "rotate" than "shift".
shift-left is actually more like cdr than your implemenation.
I have been trying to implement a for loop inside a recursive function using a for loop. Using the already implemented "for" in racket is not permitted. Is there a way to implement such a case?
Note : I am using an Intermediate Student Language for the same.
First off for in #lang racket is purely for side effects. Usually you would want the other variants like for/map and for/fold that ends up producing a value.
Racket is a descendant of Scheme and all looping in it is just syntactic sugar for a recursive function being applied. As an example the do loop:
(do ((vec (make-vector 5))
(i 0 (+ i 1)))
((= i 5) vec)
(vector-set! vec i i))
; ==> #(0 1 2 3 4)
In reality the language doesn't have do as a primitive. Instead the implementation usually have a macro that makes it into this (or something similar):
(let loop ((vec (make-vector 5)) (i 0))
(if (= i 5)
vec
(begin
(vector-set! vec i i)
(loop vec (+ i 1)))))
This is of course just sugar for this:
((letrec ((loop (lambda (vec i)
(if (= i 5)
vec
(begin
(vector-set! vec i i)
(loop vec (+ i 1)))))))
loop)
(make-vector 5) (i 0))
And of course letrec is also sugar... It goes down to just using lambda at some level.
Here is an example. The function squares produces a list of the first n square numbers. To produce that list, it loops over the number 0, ..., n-1 using an index i.
(define (squares n)
(define (loop i)
(if (= i n)
'()
(cons (* i i) (loop (+ i 1)))))
(loop 0))
(squares 10)
I'm trying to implement Bubble Sort in Common Lisp, and I'm having a tough time getting my bearings.[See Below] is what I've got so far, which follows the algorithm as far as I can tell, but I'm getting the error " Undefined function SORTED called with arguments ()." when I run it. I can't seem to find what's the cause of that.
(defun bubble (lis)
(let ((sorted nil) (j 0))
(do () ((not sorted))
(progn
(setf sorted t)
(do (i j (+ i 1))
(if (< (nth i lis) (nth (+ i 1) lis))
(progn
(swap1 (lis (nth i lis) (nth (+ i 1) lis)))
(setf sorted nil)
)
)
)
)
)
)
)
Each call to NTH needs to iterate over the list. If you treat a list like a vector, you probably should use vectors instead. And in the case you don't really care about being efficient, you might still want to use ELT instead of NTH, since ELT works on any kind of sequence. That way, you can pass either vectors or lists and at least one of them will work reasonably well (as far as bubble sort can be efficient).
You might end up having something like the one from Rosetta Code.
By the way, Rosetta Code has an example of an iterative Bubble sort for lists, so I won't copy it. Instead, here below is a recursive version that I adapted from a Prolog one (by Roman Barták). As such it is not necessarily better, but it uses multiple values, ETYPECASE, DESTRUCTURING-BIND, ... features that are apparently not usually taught.
(defun bubble-sort (list)
(labels
((bsort (list acc)
(etypecase list
(null acc)
(cons (destructuring-bind (head . tail) list
(multiple-value-bind (new-tail max)
(bubble head tail)
(bsort new-tail
(cons max acc)))))))
(bubble (x list)
(etypecase list
(null (values nil x))
(cons (destructuring-bind (y . tail) list
(multiple-value-bind (new-tail max)
(bubble (max x y) tail)
(values (cons (min x y) new-tail)
max)))))))
(bsort list nil)))
There are quite a few things we can do to improve this code.
And something you can do to improve your question. If you ask again please provide the test cases and the specific issue.
Indenting
Lisp has relatively little syntax, but we use indenting to help highlight the structure of the code. Most Lisp aware editors help manage that. The most obvious departure from the conventional indenting approach is closing parentheses on following lines. I've Indented the mergelist function to show a more readable function body - well, at least to me.
(defun bubble (lis)
(let ((sorted nil) (j 0))
(do () ((not sorted))
(progn
(setf sorted t)
(do (i j (+ i 1))
(if (< (nth i lis) (nth (+ i 1) lis))
(progn
(swap1 (lis (nth i lis) (nth (+ i 1) lis)))
(setf sorted nil))))))))
Loop vs DO
DO has a long pedigree in lisp, but to be honest, I always make mistakes with DO, so don't use it very often. I can never remember where to return form goes, the increment. I tend to use LOOP
But first off, we don't need to use progn. Most looping constructs have an implicit progn for the code they are iterating so
(defun bubble-1 (lis)
(let ((sorted nil) (j 0))
(do () ((not sorted))
(setf sorted t)
(do (i j (+ i 1))
(if (< (nth i lis) (nth (+ i 1) lis))
(swap1 (lis (nth i lis) (nth (+ i 1) lis)))
(setf sorted nil))))))
Slightly nicer. Looking at your code there is the call to swap1, which must be a defun supplied somewhere. THis line also has a syntax problem as 'lis' appears as a function call.
Lets try to evaluate the function and see what happens
; in: DEFUN BUBBLE-1
; (LET ((SORTED NIL) (J 0))
; (DO ()
; ((NOT SORTED))
; (SETF SORTED T)
; (DO (I
; J
; (+ I 1))
; (IF (< # #) (SWAP1 #) (SETF #)))))
;
; caught STYLE-WARNING:
; The variable J is defined but never used.
; in: DEFUN BUBBLE-1
; (DO (I
; J
; (+ I 1))
; (IF
; (< (NTH I LIS) (NTH (+ I 1) LIS))
; (SWAP1 (LIS (NTH I LIS) (NTH # LIS)))
; (SETF SORTED NIL)))
; --> BLOCK
; ==>
; (LET (I J (+ I))
; (TAGBODY
; (GO #:G3)
; #:G2
; (TAGBODY)
; (PSETQ + 1)
; #:G3
; (UNLESS IF (GO #:G2))
; (RETURN-FROM NIL (PROGN (< # #) (SWAP1 #) (SETF #)))))
;
; caught WARNING:
; undefined variable: I
; --> BLOCK LET TAGBODY UNLESS
; ==>
; (IF IF
; NIL
; (GO #:G2))
;
; caught WARNING:
; undefined variable: IF
; (LIS (NTH I LIS) (NTH (+ I 1) LIS))
;
; caught STYLE-WARNING:
; undefined function: LIS
; (SWAP1 (LIS (NTH I LIS) (NTH (+ I 1) LIS)))
;
; caught STYLE-WARNING:
; undefined function: SWAP1
;
; compilation unit finished
; Undefined functions:
; LIS SWAP1
; Undefined variables:
; I IF
; caught 2 WARNING conditions
; caught 3 STYLE-WARNING conditions`enter code here`
Wow. THis is telling us a few things
The variable J in the nested DO is not used. Remove it.
The syntax for DO in the nested loop is wrong. It needs to be of the general form
(DO ((var init step))
(termination-test result-form)
statement)
The nested do is missing its termination test. Also the variable declaration for i is missing its initialization.
The Let is kind of redundant you can move the declaration of sorted into the do
(do ((sorted nil)) ((not sorted ) ... )
The form
(SWAP1 (LIS (NTH I LIS) (NTH (+ I 1) LIS)))
has two problems. Firstly SWAP1 is undefined. Secondly the form (LIS (NTH I LIS) (NTH (+ I 1) LIS)) can't possibly be right as LIS appears in a function call position. Anything that appears at the front of a form must be a function. In this cas LIS is a parameter.
Fortunately Common Lisp has an inbuilt function that will swap to values for us - its called rotatef. So the entires form would need to look like
(rotatef (nth I lis) (nth (1+ i) lis))
Once function runs, it has no result form in the do, so the sorted array will never be returned to the caller. You will see no output. You need to think about the fact you have nested loops here.
I would think a bit about your algorithm. As Zephyr Pellerin says above, a recursive solution would be much nicer, so unless your assignment is to use an iterative solution
You should study the answer of David Hodge that details all the problems of your code. Here I offer an iterative version of Bubble Sort that uses the do special form. The only main difference from the algorithm that you tried to implement with your code is the use of a variable end which is decremented each time to reduce the number of tests:
(defun bubble (lis)
(let ((sorted nil)
(end (length lis)))
(do () (sorted lis)
(setf sorted t)
(decf end)
(do ((i 0 (1+ i)))
((>= i end))
(when (< (nth i lis) (nth (1+ i) lis))
(rotatef (nth i lis) (nth (1+ i) lis))
(setf sorted nil))))))
I have written a simple procedure to find the divisors of a number (not including the number itself). I have figured out how to print them, but I would like to have this function return a list containing each of the divisors.
(define (divisors n)
(do ((i 1 (+ i 1)))
((> i (floor (/ n 2))))
(cond
((= (modulo n i) 0)
(printf "~a " i)))))
My idea is to create a local list, adding elements to it where my printf expression is, and then having the function return that list. How might I go about doing that? I am new to Scheme, and Lisp in general.
Do you necessarily have to use have to use do? here's a way:
(define (divisors n)
(do ((i 1 (add1 i))
(acc '() (if (zero? (modulo n i)) (cons i acc) acc)))
((> i (floor (/ n 2)))
(reverse acc))))
But I believe it's easier to understand if you build an output list with a named let:
(define (divisors n)
(let loop ((i 1))
(cond ((> i (floor (/ n 2))) '())
((zero? (modulo n i))
(cons i (loop (add1 i))))
(else (loop (add1 i))))))
Or if you happen to be using Racket, you can use for/fold like this:
(define (divisors n)
(reverse
(for/fold ([acc '()])
([i (in-range 1 (add1 (floor (/ n 2))))])
(if (zero? (modulo n i))
(cons i acc)
acc))))
Notice that all of the above solutions are written in a functional programming style, which is the idiomatic way to program in Scheme - without using mutation operations. It's also possible to write a procedural style solution (see #GoZoner's answer), similar to how you'd solve this problem in a C-like language, but that's not idiomatic.
Just create a local variable l and extend it instead of printing stuff. When done, return it. Like this:
(define (divisors n)
(let ((l '()))
(do ((i 1 (+ i 1)))
((> i (floor (/ n 2))))
(cond ((= (modulo n i) 0)
(set! l (cons i l))))
l))
Note that because each i was 'consed' onto the front of l, the ordering in l will be high to low. Use (reverse l) as the return value if low to high ordering is needed.