Instantly share code, notes, and snippets.

# mplewis/bubblesort-point-list.scm

Created April 3, 2014 10:26
Show Gist options
• Save mplewis/9952068 to your computer and use it in GitHub Desktop.
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.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters. Learn more about bidirectional Unicode characters
 ;;;;; 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)))