0: # Have you ever had to sort a list of lists by a value in the middle of the lower lists?
1: # The Shwartzian transform will do this, but i was concerned about the speed of the operation.
2: # This module came about from implementing such a sort on the different possible groups on a
3: # unix system so that the sysadmin can choose which group to put a new user into (using
4: # a tk menu if he/she so desires).  The end result is an n log n sort technique that doesn't
5: # have to look at all of the values of the array it's sorting (relatively)...
6: # In fact, the `sort' call takes the most time of anything
7: #
8: # jynx
9: 
10: # Formats:                                              #
11: #       AnonSort(\@array, $val_to_sort_by, $is_string)  #
12: #   where $is_string is either 1 or 0.  1 if it is.     #
13: #                                                       #
14: #       binsrch(\@array, $val_to_sort_by, $is_string)   #
15: #                                                       #
16: #        -or if you want just a portion organized-      #
17: #                                                       #
18: #  binsrch(\@ar, $val, $is_string, $hi_mark, $lo_mark)  #
19: #                                                       #
20: #   NOTE: The value to sort by is the index NUMBER in   #
21: #         the anonymous arrays that you want to be the  #
22: #         pivotal position for sorting.  So for instance#
23: #         if you want the 3rd position to be sorted by, #
24: #         put 3.                                        #
25: 
26: 
27: package AnonSort;
28: use strict;
29: require Exporter;
30: our @ISA       = qw(Exporter);
31: our @EXPORT    = qw(AnonSort);
32: our @EXPORT_OK = qw(binsrch);
33: our $VERSION   = 1.0;
34: 
35: sub AnonSort {
36:    my ($anon, $val, $str);
37:    ($anon, $val, $str) = @_;
38: 
39: # pull out the values to sort by and sort
40:    my (@st, @temp);
41:    foreach (@{ $anon }) { push @st, $_->[$val] }
42:    @st = sort @st;
43: 
44: # now arrange the original array of arrays...
45: #
46: # a little note:  since this is a closed set we can sift through until we get
47: #   the first spot into where it's supposed to be because we don't have to
48: #   worry about accidently not having an element.  also, as opposed to the
49: #   bubble sort, we have a secondary list that's already sorted, so we binary
50: #   search on that until we have the right entry for a spot.  THEN and only
51: #   then step to the next spot.  then find the right entry for that spot and
52: #   so on and so forth...
53: #
54:    for (my $i = 0; $i <= $#{ $anon }; $i++) {
55:    until (($str)?($anon->[$i][$val] eq $st[$i]):($anon->[$i][$val] == $st[$i]) ){
56:       my $j = &binsrch(\@st, $anon->[$i][$val], $str);
57:       if ($i != $j) {
58:          @temp = @{ $anon->[$j] };
59:          @{ $anon->[$j] } = @{ $anon->[$i] };
60:          @{ $anon->[$i] } = @temp;
61:       }
62:    }		## end while loop.
63:    }		## end of for loop
64: 
65: # return the (now sorted) reference to the original array
66: return $anon;
67: }
68:          
69: #
70: # i have to define these for the use strict...
71: my ($s, $val, $str, $hi, $lo, $mid);
72: 
73: #
74: # this is a binary search through arrays.  it returns -1 if not found
75: #   or the palce where the value is.
76: #
77: sub binsrch {
78:    ($s, $val, $str, $hi, $lo, $mid) = @_;
79: 
80: # because of a bug, return the last element if val's in the last element...
81: # Also, the trinary operator makes the if statement bail.  Don't even think
82: # about it (i don't know why it bails, but it does)
83:    if ($str) {
84:       return $#{ $s } if ($val eq $s->[$#{ $s }]);
85:    } else {
86:       return $#{ $s } if ($val == $s->[$#{ $s }]);
87:    }
88: 
89: # if $hi and $lo aren't defined (read: first iteration), define them
90:    $hi = $#{ $s } unless defined $hi;
91:    $lo = 0   unless defined $lo;
92:    return -1 if ($lo == $hi);
93: 
94: # set mid and do the search.  recursion's ok, i'm throwing around references...
95:    $mid = int ( ($hi + $lo) / 2 );
96:    if ($str) {
97:     return $mid if ($s->[$mid] eq $val);
98:     ($hi = $mid and binsrch($s, $val, $str, $hi, $lo) ) if ($s->[$mid] gt $val);
99:     ($lo = $mid and binsrch($s, $val, $str, $hi, $lo) ) if ($s->[$mid] lt $val);
100:    } else {
101:     return $mid if ($s->[$mid] == $val);
102:     ($hi = $mid and binsrch($s, $val, $str, $hi, $lo) ) if ($s->[$mid] > $val);
103:     ($lo = $mid and binsrch($s, $val, $str, $hi, $lo) ) if ($s->[$mid] < $val);
104:    }
105: 
106: # return -1 if the value we're looking for isn't where it's supposed to be
107: # The trinary operator makes this if statement bail as well.  By bail i mean it
108: # won't even compile!
109:    if ($str) {
110:       return -1 if ($val ne $s->[$mid]);
111:    } else {
112:       return -1 if ($val != $s->[$mid]);
113:    }
114: 
115: # otherwise return the value (to previous level)
116:    return $mid;
117: }
118: 
119: 
120: 1;
121: 
122: 
123: # stop scolling, isn't that enough work?
124: #
125: # Sorry if this double posts, but the line wrapping got screwed up on the
126: # first one so this version is better for the cut and paste