SourceForge: clisp/clisp: src/sort.d@e789e5f15ae3
src/sort.d
author Vladimir Tzankov <vtzankov@gmail.com>
Tue Jan 10 14:03:56 2012 +0200 (4 months ago)
changeset 15554 e789e5f15ae3
parent 11864 dd5d46d722a7
permissions -rw-r--r--
(mt_main_actions): main thread should be the same as any other - initialize time, reader and set normal exit flag
     1 /*
     2  * n log(n) - Sort function for CLISP
     3  * Bruno Haible 1992-2003
     4  * German comments and names translated into English: Reini Urban 2007-12
     5 
     6  Goal: Sort a fixed number n of elements,
     7  with maximal time costs of O(n log(n)),
     8  without needing too many and expensive data structures.
     9 
    10  Requires these predefinitions:
    11   Identifier SORTID :
    12     Identifier, identifies the incarnation of the Package
    13   Type SORT_ELEMENT :
    14     Type of the to be sorted elements.
    15   Type SORT_KEY :
    16     Type of the key, by which we sort.
    17   Function SORT_KEYOF, with signature
    18     local SORT_KEY SORT_KEYOF (SORT_ELEMENT element);
    19     returns the sort-key of an element.
    20   Function SORT_COMPARE, with signature
    21     local signean SORT_COMPARE (SORT_KEY key1, SORT_KEY key2);
    22     returns >0 if key1>key2, <0 if key1<key2, 0 if key1=key2.
    23   Function SORT_LESS, with
    24     local bool SORT_LESS (SORT_KEY key1, SORT_KEY key2);
    25     returns true if key1<key2, false if key1>=key2.
    26 */
    27 
    28 #ifndef SORT
    29   /* Some kind of "SORT-Package" */
    30   #define SORT(incarnation,identifier)  CONCAT4(sort_,incarnation,_,identifier)
    31 #endif
    32 
    33 /* Source: Samuel P. Harbison, Guy L. Steele: C - A Reference Manual, p.61 */
    34 
    35 /* Detect, if element1 < element2: */
    36 #define less(element1,element2)                                 \
    37   SORT_LESS(SORT_KEYOF(element1),SORT_KEYOF(element2))
    38 
    39 /* sort(v,n); sorts the array v[0]..v[n-1] in ascending order. */
    40 local void SORT(SORTID,sort) (SORT_ELEMENT* v, uintL n)
    41 {
    42   var SORT_ELEMENT* w = &v[-1];
    43   /* w[1]..w[n] point to the same elements as v[0]..v[n-1] .
    44      We collect the numbers 1,...,n to a balanced binary subtree,
    45      so that k has the children 2*k and 2*k+1.
    46      A part w[r]..w[s] is sorted, if for all k with r <= k <= s counts:
    47         If 2*k <= s, then w[k] >= w[2*k], and
    48         if 2*k+1 <= s, then w[k] >= w[2*k+1],
    49      i.e. if every element has a value >= the value of both of its children.
    50      Subgoal:
    51         Let 0<r<=s and w[r+1]..w[s] already sorted.
    52         Sort w[r]..w[s].
    53         Time cost: max. O(log(s)). */
    54  #define adjust(r,s)                                                     \
    55   { var uintL i = r;                                                    \
    56     while (1) { /* Put w[i] into the subtree below i */                 \
    57       var uintL j = 2*i; /* a child of i */                             \
    58       if (j > s) /* 2*i and 2*i+1 not existent anymore -> ready */      \
    59         break;                                                          \
    60       if ((j < s) && less(w[j],w[j+1])) /* evtl. j = 2*i+1, the other child of i */ \
    61         j++;                                                            \
    62       /* j is the child of i with the greater value */                  \
    63       if (less(w[i],w[j])) {            /* if w[i] < w[j], */           \
    64         swap(SORT_ELEMENT, w[i], w[j]); /* swap w[i] and w[j] */        \
    65       }                                                                 \
    66       /* w[i] is now the greatest of the three values w[i],w[2*i],w[2*i+1]. \
    67          But we lowered w[j], so we need a tail-rexursive adjust(j,s) */ \
    68       i = j;                                                            \
    69     }                                                                   \
    70   }
    71   if (n<=1) /* nothing to do? */
    72     return;
    73   { /* Because of 2*(floor(n/2)+1) > n,
    74        w[floor(n/2)+1]..w[n] is already sorted. */
    75     var uintL r;
    76     for (r = floor(n,2); r>0; r--) {
    77       /* Here w[r+1]..w[n] is sorted. */
    78       adjust(r,n);
    79       /* Here w[r]..w[n] is sorted. */
    80     }
    81   }
    82   { /* Now w[1]..w[n] is a sorted tree.
    83      Take the actual top element w[1] and put it to the end: */
    84     var uintL s;
    85     for (s = n-1; s>0; s--) {
    86       /* Here w[1]..w[s+1] is a sorted tree, and
    87          w[s+2]..w[n] the greatest elements, sorted ascending. */
    88       swap(SORT_ELEMENT, v[0], v[s]); /* swap w[1] and w[s+1] */
    89       /* Here w[2]..w[s] is a sorted tree, and
    90          w[s+1]..w[n] the greatest elements, sorted ascending. */
    91       adjust(1,s); /* Sort w[1] into the tree */
    92       /* Here w[1]..w[s] ein sortierter Baum, und
    93          w[s+1]..w[n] the greatest elements, sorted ascending. */
    94     }
    95   }
    96 }
    97 
    98 #undef adjust
    99 #undef less