Stalin Sort
January 19, 2021
Stalin Sort is a single-pass sort that operates in O(1) space and O(n) time. Iterate down the list of elements checking if they are in order. Any element which is out of order is sent to the gulag (eliminated from the list). At the end you have a sorted list, though it may not be a permutation of the original list. As an example, the list (1 2 5 3 5 7) is Stalin-sorted as (1 2 5 5 7); the 3 is dropped because it is less than the 5 that it follows.
Your task is to write a program that implements Stalin sort. When you are finished, you are welcome to read or run a suggested solution, or to post your own solution or discuss the exercise in the comments below.
Programming Praxis 
;; First, a functional solution, without mutation. ;; It's not the most optimized way to do it, since key is called twice per element, ;; and it' returns a new list even when the list is already sorted. (defun stalin-sort-list (list lessp &key (key (function identity))) (when list (let* ((current (first list)) (kurrent (funcall key current))) (if (null (rest list)) (list current) (let* ((next (second list)) (kext (funcall key next))) (if (funcall lessp kurrent kext) (cons current (stalin-sort-list (rest list) lessp :key key)) (stalin-sort-list (cons current (rest (rest list))) lessp :key key))))))) (assert (equal (stalin-sort-list '(1 2 5 3 5 7) (function <)) '(1 2 5 7))) (assert (equal (stalin-sort-list '(1 2 5 3 5 7) (function <=)) '(1 2 5 5 7))) ;; Here is a destructive version. ;; The list itself is modified to remove the unsorted elements. ;; We also collect the removed elements in the cells as second value. (defun nstalin-sort-list (list lessp &key (key (function identity))) (when list (loop :with gulag := (cons nil nil) :with gate := gulag :with current-cell := list :with key-current := (funcall key (car current-cell)) :with next-cell := (cdr current-cell) :with key-next :while next-cell :do (setf key-next (funcall key (car next-cell))) (if (funcall lessp key-current key-next) (setf current-cell next-cell next-cell (cdr current-cell) key-current key-next) (setf (cdr current-cell) (cdr next-cell) (cdr gate) next-cell gate (cdr gate) (cdr gate) nil next-cell (cdr current-cell))) :finally (return (values list (cdr gulag)))))) (let* ((list '(1 2 5 3 5 7)) (mutable-list (copy-list list))) (multiple-value-bind (sorted gulag) (nstalin-sort-list mutable-list (function <)) (assert (eq mutable-list sorted)) (assert (= (+ (length sorted) (length gulag)) (length list))) (assert (equal sorted '(1 2 5 7))))) (let* ((list '(1 2 5 3 5 7)) (mutable-list (copy-list list))) (multiple-value-bind (sorted gulag) (nstalin-sort-list mutable-list (function <=)) (assert (eq mutable-list sorted)) (assert (= (+ (length sorted) (length gulag)) (length list))) (assert (equal sorted '(1 2 5 5 7)))))Here is an implementation in R7RS Scheme using filter-map from SRFI 1.
(import (scheme base) (scheme write) (only (srfi 1) filter-map every)) (cond-expand ((library (org eip10 assert)) (import (org eip10 assert))) (else (define-syntax assert (syntax-rules () ((_ pred ...) (unless (and pred ...) (display "Failed assertion: ") (display '(pred ...)) (newline) (error "assertion failure"))))))) (define samples ; ((input . output) ...) '(((1 2 5 3 5 7) . (1 2 5 5 7)) (() . ()) ((1 2 4 8 13) . (1 2 4 8 13)) ((3 1 4 1 5 9 2 5) . (3 4 5 9 5)))) (define (list-sort/stalin item<? items) (if (null? items) '() (cons (car items) (filter-map (lambda (curr prev) (and (not (item<? curr prev)) curr)) (cdr items) items)))) (define (list-sort-numbers/stalin nums) (list-sort/stalin < nums)) (assert (every (lambda (sample) (equal? (list-sort-numbers/stalin (car sample)) (cdr sample))) samples))Here’s a R7RS Scheme implementation, a fix to my earlier oopsie posting.
(import (scheme base) (only (srfi 1) every)) (cond-expand ((library (org eip10 assert)) (import (org eip10 assert))) (else (import (scheme write)) (define-syntax assert (syntax-rules () ((_ pred ...) (unless (and pred ...) (display "Failed assertion: ") (display '(pred ...)) (newline) (error "assertion failure"))))))) (define samples ; ((input . output) ...) '(((1 2 5 3 5 7) . (1 2 5 5 7)) (() . ()) ((1 2 4 8 13) . (1 2 4 8 13)) ((3 1 4 1 5 9 2 5) . (3 4 5 9)))) (define (list-sort/stalin item<? items) (if (null? items) items (let f ((remaining (cdr items)) (largest-seen (car items)) (result (list (car items)))) (if (null? remaining) (reverse result) (if (item<? (car remaining) largest-seen) (f (cdr remaining) largest-seen result) (f (cdr remaining) (car remaining) (cons (car remaining) result))))))) (define (list-sort-numbers/stalin nums) (list-sort/stalin < nums)) (assert (every (lambda (sample) (equal? (list-sort-numbers/stalin (car sample)) (cdr sample))) samples))Here is my take on this, using Julia 1.5.x: https://pastebin.com/fYD31uep
I wonder if there is a practical application of this algo. Cheers!
Here’s a solution in Racket:
(define (stalin-sort in) (let loop ((data in) (out empty)) (cond ((empty? data) (reverse out)) ((or (empty? out) (>= (car data) (car out))) (loop (cdr data) (cons (car data) out))) (else (loop (cdr data) out)))))Sample output:
Klong
<:'list :" Apply < to each pair and return results" [0 1 1 0 1 1 0] a::<:'list :" Assign results to variable a" [0 1 1 0 1 1 0] (*a),a::<:'list :" Append to the front of a its first member" [0 0 1 1 0 1 1 0] &(*a),a::<:'list :" Return positions of 1's in a" [2 3 5 6] {list@x}'&(*a),a::<:'list :" Return values in list using positions above" [2 5 5 7] {[a list]; list::x; .p(list); {list@x}'&(*a),a::<:'x}([1 2 5 3 5 7]) :" Create function to display list and Stalin sort" [1 2 5 3 5 7] [1 2 5 5 7] {[a list]; list::x; .p(list); {list@x}'&(*a),a::<:'x}([3 1 2 5 3 5 7 6]) :" Create function to display list and Stalin sort" [3 1 2 5 3 5 7 6] [2 5 5 7]Clojure:
(first (reduce (fn [[elems last] cur] (if (>= cur last) [(conj elems cur) cur] [elems last])) [[] 0] [1 2 5 3 4 7]))
Or a bit more complete solution that takes in account negative numbers:
#(first (reduce (fn [[elems last] cur] (if (>= cur last) [(conj elems cur) cur] [elems last])) [[] (first %)] %))
Klong (earlier version did not work correctly for all inputs)
fn::{[l max]; l::[]; max::(*x)-1; {:[x>max; {max::x; l::l,x}(x);:[x=max; l::l,x; ""]]}'x; l} :monad {.p(x); .p(fn(x)); .p("")}'[[1 2 5 3 5 7] [1 2 4 8 13] [3 1 4 1 5 9 2 5]];:done [1 2 5 3 5 7] [1 2 5 5 7] [1 2 4 8 13] [1 2 4 8 13] [3 1 4 1 5 9 2 5] [3 4 5 9] :done@ProgrammingPraxis: What does O(1) space and O(n) time mean? Thanks, Steve
@bookofstevegraham: O(1) space means the program, at runtime, uses a constant amount of space that does not depend on the size of the input. O(n) time means the runtime is proportional to the size of the input. Big-O notation is a simple means of comparing the complexity of two algorithsm.
@ProgrammingPraxis: Thanks. So I understand that you have to modify the first list itself and not create a 2nd one to receive the result.
@bookofstevegraham: No, you could also build the result in a new list and discard the original, as I did.
@programingpraxis: Thanks. I did that in my last submission.