extra/rosetta-code/gnome-sort/gnome-sort.factor

   1 ! Copyright (C) 2017 Alexander Ilin.
   2 ! See https://factorcode.org/license.txt for BSD license.
   3 USING: kernel math sequences ;
   4 IN: rosetta-code.gnome-sort
   5
   6 ! https://rosettacode.org/wiki/Sorting_algorithms/Gnome_sort
   7
   8 ! Gnome sort is a sorting algorithm which is similar to
   9 ! Insertion sort, except that moving an element to its
  10 ! proper place is accomplished by a series of swaps,
  11 ! as in Bubble Sort.
  12
  13 : inc-pos ( pos seq -- pos' seq )
  14     [ 1 + ] dip ; inline
  15
  16 : dec-pos ( pos seq -- pos' seq )
  17     [ 1 - ] dip ; inline
  18
  19 : take-two ( pos seq -- elt-at-pos-1 elt-at-pos )
  20     [ dec-pos nth ] [ nth ] 2bi ; inline
  21
  22 : need-swap? ( pos seq -- pos seq ? )
  23     over 1 < [ f ] [ 2dup take-two > ] if ;
  24
  25 : swap-back ( pos seq -- pos seq' )
  26     [ take-two ] 2keep
  27     [ dec-pos set-nth ] 2keep
  28     [ set-nth ] 2keep ;
  29
  30 : gnome-sort ( seq -- sorted-seq )
  31     1 swap [ 2dup length < ] [
  32         2dup [ need-swap? ] [ swap-back dec-pos ] while
  33         2drop inc-pos
  34     ] while nip ;