Skip to content

Instantly share code, notes, and snippets.

@mplewis
Created April 3, 2014 10:26
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
Star You must be signed in to star a gist
Embed
What would you like to do?
This is a bubblesort algorithm written in Scheme. It is designed for the purpose of sorting a list of Cartesian points in the form (x . y), by distance from the origin (0 . 0) of a coordinate plane, in ascending order.
;;;;; Bubblesort Points by Ascending Distance from Origin
;;;;;; bubblesort-point-list.scm
;;;;;;; Matthew Lewis
;;;;;;;; Oct 24, 2011
;
; This is a bubblesort algorithm written in Scheme. It is designed for the purpose of sorting a list of Cartesian points in the form (x . y), by distance from the origin (0 . 0) of a coordinate plane, in ascending order.
;
; The main function is run as follows:
; (bubblesort-point-list pt-list)
;
; In this function, pt-list is a series of (x . y) values concatenated as follows:
; ((Xa . Ya) (Xb . Yb) (Xc . Yc))
;
; Output is returned in list form as follows:
; ((Xa . Ya) (Xb . Yb) (Xc . Yc))
;
; There should be no limit to the length of pt-list.
; This program does not catch exceptions and will fail if data values in the list are non-numerical.
; This program does not discriminate between points with equal distances from the origin (ex. (4, 2) vs. (4, -2)) and will not swap them.
;
(define (bubblesort-point-list pt-list)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;; Subfunctions begin below ;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; turns x and y into (x . y)
(define (make-point x y)
(cons x y))
; get the x coord of a point
(define (get-x p)
(car p))
; get the y coord of a point
(define (get-y p)
(cdr p))
; get the first point in a list
(define (get-first-point pt-list)
(car pt-list))
; get all but the first point in a list
(define (get-rest-points pt-list)
(cdr pt-list))
; return distance between p1 and p2
(define (distance p1 p2)
(sqrt (+ (expt (- (get-x p2) (get-x p1)) 2) (expt (- (get-y p2) (get-y p1)) 2))))
; get the length of pt-list and return integer
(define (get-length pt-list)
(define (getl-help templist length)
(if (null? templist)
length
(getl-help (get-rest-points templist) (+ length 1))))
(getl-help pt-list 0))
; if distance between pt-dist and pt1 is greater than pt-dist and pt2, return pt1; otherwise return pt2
(define (bubble-first pt-dist p1 p2)
(if (<= (distance pt-dist p1) (distance pt-dist p2))
p1
p2))
; if distance between pt-dist and pt1 is greater than pt-dist and pt2, return pt2; otherwise return pt1
(define (bubble-second pt-dist p1 p2)
(if (<= (distance pt-dist p1) (distance pt-dist p2))
p2
p1))
; if distance between pt-dist and pt1 is greater than pt-dist and pt2, return #f (no swap occurred); otherwise return #t (swap occurred)
(define (bubble-check pt-dist p1 p2)
(if (<= (distance pt-dist p1) (distance pt-dist p2))
#f
#t))
; cut down pt-list into a smaller list, from continuous elements pt-list(start) to pt-list(end)
(define (cut-list pt-list start end)
(define (cutl-help templist curr)
(if (= curr start)
templist
(cutl-help (cons (get-point-num pt-list (- curr 1)) templist) (- curr 1))))
(cutl-help () (+ end 1)))
; return the point found at point n in list pt-list
(define (get-point-num pt-list n)
(define (getpn-help templist curr endat)
(if (= curr endat)
(get-first-point templist)
(getpn-help (get-rest-points templist) (+ curr 1) endat)))
(getpn-help pt-list 1 n))
; origin = (0 . 0)
(define origin
(make-point 0 0))
; encloses a point (a . b) inside parens for additional CONSing: ((a . b))
(define (enclose-pt p)
(cons p ()))
; adds a point to the end of a list while maintaining list integrity: ((a . b) (c . d) (e . f))
(define (reverse-cons pull-list endpt)
(define (revc-help currpos templist)
(if (= currpos 0)
templist
(revc-help (- currpos 1) (cons (get-point-num pull-list currpos) templist))))
(revc-help (get-length pull-list) (enclose-pt endpt)))
; appends a list to the end of another list while maintaining list integrity
(define (list-append list-a list-b)
(define (lsta-help templist-a templist-b numleft)
(if (= numleft 0)
templist-a
(lsta-help (reverse-cons templist-a (get-first-point templist-b)) (get-rest-points templist-b) (- numleft 1))))
(lsta-help list-a list-b (get-length list-b)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;; Main function begins below ;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; helper function for list.
; templist = list in process of being sorted
; position = listdim of first one to be checked/swapped with enext one
; error? = boolean. if a swap is thrown at any point during the run, then error is set to #t and reset at the start of the next list run-through
(define (sort-help templist position error? dimlist)
; are we done yet? if last run through the list didn't throw a swap and we're past the end of the list,
(if (and (not error?) (= position (get-length pt-list)))
; then display the sorted list.
templist
; if position to check is past the end of the list, then...
(if (= position dimlist)
; ...restart at the front
(sort-help templist 1 #f dimlist)
; otherwise... let's do this
(cond
; first and second list vars need to be checked/swapped
((= position 1)
(sort-help
; templist: check1 + check2 + rest of list (3 ... dimlist)
(list-append
(cons
(bubble-first origin (get-point-num templist 1) (get-point-num templist 2))
(enclose-pt (bubble-second origin (get-point-num templist 1) (get-point-num templist 2))))
(cut-list templist 3 dimlist))
; position
(+ position 1)
; error?
(or error? (bubble-check origin (get-point-num templist 1) (get-point-num templist 2)))
; dimlist
dimlist))
; second-to-last and last list vars need to be checked/swapped
((= position (- (get-length pt-list) 1))
(sort-help
; templist: first of list (1 ... position - 1) + check1 + check2
(list-append
(cut-list templist 1 (- position 1))
(cons
(bubble-first origin (get-point-num templist (- dimlist 1)) (get-point-num templist dimlist))
(enclose-pt (bubble-second origin (get-point-num templist (- dimlist 1)) (get-point-num templist dimlist)))))
; position
(+ position 1)
; error?
(or error? (bubble-check origin (get-point-num templist (- dimlist 1)) (get-point-num templist dimlist)))
; dimlist
dimlist))
; check/swap whatever's in the middle instead: (position) is the first one, (position + 1) is the second one
(else
(sort-help
; templist: first of list (1 ... position - 1) + check1 + check2 + rest of list (position + 2 ... dimlist)
(list-append
(cut-list templist 1 (- position 1))
(list-append
(cons
(bubble-first origin (get-point-num templist position) (get-point-num templist (+ position 1)))
(enclose-pt (bubble-second origin (get-point-num templist position) (get-point-num templist (+ position 1)))))
(cut-list templist (+ position 2) dimlist)))
; position
(+ position 1)
; error?
(or error? (bubble-check origin (get-point-num templist position) (get-point-num templist (+ position 1))))
; dimlist
dimlist))))))
(sort-help pt-list 1 #f (get-length pt-list)))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment