четверг, 24 июня 2010 г.

Scheme: сортировка слиянием 2.

В первой части я привел алгоритм сортировки слиянием. Он плох тем, что рекурсивен. Казалось бы что такого. А дело в том, что из-за того что данные копируются из одного списка в другой нам приходится использовать 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 очевидна.

пятница, 28 мая 2010 г.

Scheme: сортировка слиянием.

Представляю твоему вниманию алгоритм сортировки слиянием на языке Scheme. Если мне не изменяет память этот алгоритм очень удобно применять при сортировке данных на магнитных лентах. Аналогично спискам в примере ниже, данные сначала делятся на две части и записываются на магнитные ленты, а потом с этих лент сливаются вместе и записываются на третью. Для тех кто не в курсе, Scheme это диалект Lisp, созданный для того, чтобы профессорам из MIT было легче мучить студентов.

";" служит для обозначения комментариев в коде.
#lang scheme Используется интерпретатором для определения языка.

#lang scheme
;Делим список
(define (split ls)
  ;letrec создает область значений, это нужно для рекурсивного вызова split-h
  ;Зачем? Ну хз, я бы define использовал.
  (letrec ([split-h (lambda (ls ls1 ls2)
                      (cond
                        ;Если первый список подошел концу
                        [(or (null? ls) (null? (cdr ls)))
                         ;Делаем пару из второго списка и первого. 
                         ;Переворачиваем, так как при добавлении первым идет последний добавленный.
                         (cons (reverse ls2) ls1)]
                         ;По-начальному списку спускаемся на 2 элемента вниз,
                         ;по-первому на 1. Когда дойдем до конца во втором списке будет 
                         ;первая половина начального списка.
                        [else (split-h (cddr ls)
                                (cdr ls1) (cons (car ls1) ls2))]))])
    (split-h ls ls '())))
;Сливаем списки, тут на мой взгяд все очевидно.
(define (merge pred ls1 ls2)
  (cond
    [(null? ls1) ls2]
    [(null? ls2) ls1]
    [(pred (car ls1) (car ls2))
     (cons (car ls1) (merge pred (cdr ls1) ls2))]
    [else (cons (car ls2) (merge pred ls1 (cdr ls2)))]))

(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))))]))


Оригинальная статься по данному алгоритму содержит лицензию, которую я надеюсь не нарушаю. В работе алгоритма я убедился в замечательной среде PLT-Scheme .

Некоторую проблему для меня создали квадратные скобки. Немного поискав, я узнал, что они аналогичны круглым скобкам и служат в основном для подчеркивания того, что заключенный в них код не является вызовом функций.

Если у тебя есть вопросы по работе алгоритма, или злобный преподаватель хочет модификацию, приведенного алгоритма, смело спрашивай в комментах.