В первой части я привел алгоритм сортировки слиянием. Он плох тем, что рекурсивен. Казалось бы что такого. А дело в том, что из-за того что данные копируются из одного списка в другой нам приходится использовать 2n памяти, где n - это память, которая требуется для хранения массива. Поэтому на практике сортировать данные умещающие в память методом слияния неэффективно. Его имеет смысл использовать для данных, которые целиком в оперативку не влезают, например, упомянутые данные на магнитных лентах. Кстати, да будет тебе известно рынок магнитных лент неуклонно растет, хотя в обычной жизни мы с ними уже не встречаемся. Они находят свое место в системах резервного копирования, огромных по своим размерам.
Итак был приведен рекурсивный метод сортировки того, что не влезает в память.
(define (merge-sort pred ls)
(cond
[(null? ls) ls]
[(null? (cdr ls)) ls]
[else (let ([splits (split ls)])
;Вот тут довольно неприятный рекурсивный вызов.
;Он не позволит использовать в точности этот алгоритм для
;магнитных лент.
(merge pred
(merge-sort pred (car splits))
(merge-sort pred (cdr splits))))]))
Так как мы должны будем разбить начальный список на одно элементные множества, нам понадобится сделать вызов merge-sort огромное число раз. Короче в память не влезет. Из чего можно сделать вывод, что алгоритм приведенный в статье Scheme: сортировка слиянием не работоспособен.
На первой странице гугла, нормальный алгоритм merge sort я не нашел и постарался сам его модифицировать, с целью убрать рекурсивный вызов. Вот что у меня получилось.
#lang scheme ;Возвращает пару из первых n элементов списка и остатка. (define (first-n l n) (define (helper head tail counter) (cond ((or (= counter 0) (null? tail)) (cons head tail)) ;Тут не очень хороший вызов append, я так эмулирую запись в конец. ;Я пошел на это так, как в дальнейшем собираюсь сортировать не списки ;а непосредственно файлы, в которых как раз таки легко записывать именно в ;конец (else (helper (append head (list (car tail))) (cdr tail) (- counter 1))))) (helper '() l n)) ;Делит список на два помещаю в каждый попеременно n элементов (define (split l n) (define (iter l1 l2 p tail) (cond ((null? tail) (cons l1 l2)) (else (let ((items (first-n tail n))) (if p ;Опять не очень быстрый append, по той же самой причине. (iter (append l1 (car items)) l2 (not p) (cdr items)) (iter l1 (append l2 (car items)) (not p) (cdr items))))))) (iter '() '() #t l)) ;Сливает n-элементные последовательности каждого из списков. (define (merge pred l1 l2 n) ;Итеративно сливает n-элементов из каждого списка. ;Наверно можно переписать используя функцию first-n. (define (merge-n l l1 l2 c1 c2) (cond [(or (= c1 0) (null? l1)) (let ((items (first-n l2 c2))) (list (append l (car items)) l1 (cdr items)))] [(or (= c2 0) (null? l2)) (let ((items (first-n l1 c1))) (list (append l (car items)) (cdr items) l2))] [(pred (car l1) (car l2)) (merge-n (append l (list (car l1))) (cdr l1) l2 (- c1 1) c2)] [else (merge-n (append l (list (car l2))) l1 (cdr l2) c1 (- c2 1))])) (define (iter l l1 l2) (cond ((null? l1) (append l l2)) ((null? l2) (append l l1)) (else (let ((lists (merge-n l l1 l2 n n))) (iter (car lists) (cadr lists) (caddr lists)))))) (iter '() l1 l2)) ;Собственно mergesort, который последовательно делит и сливает списки длины ;1, 2, 4, 8 .... (define (mergesort pred l) (define (iter l n) (let ((splits (split l n))) (if (null? (cdr splits)) (car splits) (iter (merge pred (car splits) (cdr splits) n) (* n 2))))) (iter l 1))
После того, как написал понял, что функция first-n плохая она пытается законсить теоретически не помещающиеся в память списки. Но зато хоть от рекурсии избавился. Теперь на очереди сортировка файла и сортировка ленты. Файл имеет ту особенность, что считывают из него сначала, а записывают в конец. У магнитной ленты особенность в том, что она сначала записывается в одну сторону, а потом считывается может в другую. По мне так аналогия с cons очевидна.