Download code

Jump to: navigation, search

Back to Merge_sort_(Scheme)

Download for Windows: single file, zip

Download for UNIX: single file, zip, tar.gz, tar.bz2

mergesort.scm

 1 #| The authors of this work have released all rights to it and placed it
 2 in the public domain under the Creative Commons CC0 1.0 waiver
 3 (http://creativecommons.org/publicdomain/zero/1.0/).
 4 
 5 THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
 6 EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
 7 MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
 8 IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
 9 CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
10 TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
11 SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
12 
13 Retrieved from: http://en.literateprograms.org/Merge_sort_(Scheme)?oldid=16653
14 |#
15 
16 (define (split ls)
17   (letrec ([split-h (lambda (ls ls1 ls2)
18                       (cond
19                         [(or (null? ls) (null? (cdr ls)))
20                          (cons (reverse ls2) ls1)]
21                         [else (split-h (cddr ls)
22                                 (cdr ls1) (cons (car ls1) ls2))]))])
23     (split-h ls ls '())))
24 
25 (define (merge pred ls1 ls2)
26   (cond
27     [(null? ls1) ls2]
28     [(null? ls2) ls1]
29     [(pred (car ls1) (car ls2))
30      (cons (car ls1) (merge pred (cdr ls1) ls2))]
31     [else (cons (car ls2) (merge pred ls1 (cdr ls2)))]))
32 
33 (define (merge-sort pred ls)
34   (cond
35     [(null? ls) ls]
36     [(null? (cdr ls)) ls]
37     [else (let ([splits (split ls)])
38             (merge pred
39               (merge-sort pred (car splits))
40               (merge-sort pred (cdr splits))))]))


hijacker
hijacker
hijacker
hijacker