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.

Pages: 1 2

14 Responses to “Stalin Sort”

  1. informatimago said
    ;; 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)))))
    
    
  2. chaw said

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

  3. chaw said

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

  4. Zack said

    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!

  5. Kevin Short said

    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:

    > (stalin-sort '(1 2 5 3 5 7))
    '(1 2 5 5 7)
    > (stalin-sort '(5 4 3 2 1))
    '(5)
    > (stalin-sort '())
    '()
    > (stalin-sort '(5 4 3 2 1 6 1 6 2 7 8 1 3 3 4 2))
    '(5 6 6 7 8)
    
  6. Steve said

    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]
    
    
  7. Clojure:

    (first (reduce (fn [[elems last] cur] (if (>= cur last) [(conj elems cur) cur] [elems last])) [[] 0] [1 2 5 3 4 7]))

  8. 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 %)] %))

  9. Steve said

    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
    
    
  10. @ProgrammingPraxis: What does O(1) space and O(n) time mean? Thanks, Steve

  11. programmingpraxis said

    @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.

  12. @ProgrammingPraxis: Thanks. So I understand that you have to modify the first list itself and not create a 2nd one to receive the result.

  13. programmingpraxis said

    @bookofstevegraham: No, you could also build the result in a new list and discard the original, as I did.

  14. @programingpraxis: Thanks. I did that in my last submission.

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out /  Change )

Google photo

You are commenting using your Google account. Log Out /  Change )

Twitter picture

You are commenting using your Twitter account. Log Out /  Change )

Facebook photo

You are commenting using your Facebook account. Log Out /  Change )

Connecting to %s

%d bloggers like this: