| Код |
(require scheme)
; Функция для получения списка, состоящего из n-1 первых элементов
(define (stake n xs)
(if (and (not (null? xs))
(> n 1))
(cons (first xs)
(stake (- n 1) (rest xs)))
'()))
; Функция для получения списка, соответствующего исходному без первых n-1 элементов
(define (sdrop n xs)
(if (and (not (null? xs))
(> n 1))
(sdrop (- n 1) (rest xs))
xs))
; Функция для вставки элемента в список с учётом шага n
(define (insert x n xs)
(let ((ys (sdrop n xs)))
(cond
((null? ys)
(cons x xs))
((<= x (first ys))
(cons x xs))
(else
(append (cons (first ys)
(stake n xs))
(insert x n (rest ys)))))))
; Функция сортировки методом вставок с шагом n
(define (ssort n xs)
(cond
((null? xs) '())
(else (insert (first xs) n (ssort n (rest xs))))))
; Основная функция сортировки Шелла
(define (shell xs)
(define (logn x b) (/ (log x) (log b)))
; Вспомогательная функция для сортировки
(define (shell-aux xs t n)
(cond
((<= t 0) xs)
(else
(ssort n (shell-aux xs (- t 1) (+ (* n 2) 1))))))
(shell-aux xs (- (floor (logn (length xs) 2)) 1) 1))
; Тестирование
(define (test fn . xss)
(for ((xs (in-list xss)))
(printf "~s -> ~s\n" xs (fn xs))))
(define (run-test)
(test shell
'(21 32 13 46 3 67 65 40)
'(64 77 19 32 65 98 54 86)
'(84 9 52 2 78 11 71 41)))
|
|