summaryrefslogtreecommitdiff
path: root/ipl/packs/ibpag2/sortff.icn
blob: c198c553cf01cf898a24740b2dd01a7caa1eba6f (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
############################################################################
#
#	Name:	 sortff.icn
#
#	Title:	 sortf with multiple field arguments
#
#	Author:	 Bob Alexander and Richard L. Goerwitz
#
#	Date:    July 14, 1993
#
############################################################################
#
#  Sortff is like sortf(), except takes an unlimited number of field
#  arguments.  E.g. if you want to sort a list of structures on field
#  5, and (for those objects that have the same field 5) do a sub-sort
#  on field 2, you would use "sortff(list_of_objects, 5, 2)."
#
############################################################################

#
# sortff:  structure [x integer [x integer...]] -> structure
#          (L, [fields ...]) -> new_L
#
#     Where L is any subscriptable structure, and fields are any
#     number of integer subscripts in any desired order.  Returns
#     a copy of structure L with its elements sorted on field 1,
#     and, for those elements having an identical field 1, sub-
#     sorted on field 2, etc.
#
procedure sortff(L, fields[])
    *L <= 1 & { return copy(L) }
    return sortff_1(L, fields, 1, [])
end

procedure sortff_1(L, fields, k, uniqueObject)

    local sortField, cachedKeyValue, i, startOfRun, thisKey

    sortField := fields[k]
    L := sortf(L, sortField)	# initial sort using fields[k]
    #
    #  If more than one sort field is given, use each field successively
    #  as the current key, and, where members in L have the same value for
    #  this key, do a subsort using fields[k+1].
    #
    if fields[k +:= 1] then {
        #
        #  Set the equal-key-run pointer to the start of the list and
        #  save the value of the first key in the run.
        #
	startOfRun := 1
	cachedKeyValue := L[startOfRun][sortField] | uniqueObject
	every i := 2 to *L do {
	    thisKey := L[i][sortField] | uniqueObject
	    if not (thisKey === cachedKeyValue) then {
	        #
	        # We have an element with a sort key different from the
	        # previous.  If there's a run of more than one equal keys,
	        # sort the sublist.
	        #
		if i - startOfRun > 1 then {
		    L := L[1:startOfRun] |||
			 sortff_1(L[startOfRun:i], fields, k, uniqueObject) |||
			 L[i:0]
		}
	        # Reset the equal-key-run pointer to this key and cache.
		startOfRun := i
		cachedKeyValue := L[startOfRun][sortField] | uniqueObject
            }
	}
	#
	#  Sort a final run if it exists.
	#
	if i - startOfRun > 1 then {
	    L := L[1:startOfRun] |||
		 sortff_1(L[startOfRun:0], fields, k, uniqueObject)
	}
    }

    return L

end