ordertable   macro dollars
) Macro to reorder rows and columns of a "confusion" table so that
) the diagonal dominates.
)
) Usage:
)  table <- ordertable(groups, clusters)
)  table <- ordertable(groups, classtable, nclust)
)   groups       vector of N positive integers identifying the group
)                each case belongs to
)   clusters     vector of N positive integers identifying the cluster
)                each case belongs to
)   classtable   N by m matrix of positive integers, intended to be
)                the matrix returned cluster(x,method:meth, 
)                keep:"classes")
)   nclust       integer, 2 <= nclust <= ncols(classtable) + 1.  This
)                defines a vector clusters = classtable[,nclust-1]
)   table        the reordered g = max(groups) by max(clusters)
)                confusion matrix tabs(,groups, clusters)
)
) The columns of the confusion matrix is first reordered from largest
) cluster to smallest.  Then rows are reordered in stages, so as to
) put the column maxima on the diagonal as far as possible.
)
)) 031121 Written by C. Bingham kb@umn.edu
)) 041207 Modified the algorithm
#$S(groups, classtable, nclust) or $S(groups,clusters)
@groups <- argvalue($1,"group numbers","positive integer vector")
@classes <- argvalue($2, "class table","postive integer matrix")
if (isvector(@classes)) {
	if (length(@groups) != length(@classes)) {
		error("length($1) != length($2)")
	}
} else {
	@nclust <- argvalue($3,"nclust","count")
	if (@nclust > ncols(@classes) + 1) {
		error("$3 > ncols($1) + 1")
	}
	if (@nclust == 1) {
		error("$3 = 1")
	}
	@classes <- @classes[,@nclust-1]
}

@table <- matrix(tabs(,@groups,@classes),labels:structure("G","C"))
@g <- nrows(@table)
@nclust <- ncols(@table)
if (@g == 1){
	error("$1 specifies only 1 group")
}
if (@nclust == 1) {
	error("$2 specifies only one cluster")
}

@table <- @table[,grade(tabs(,@classes),down:T)] #reorder columns
delete(@groups,@classes)
for (@i,1,min(@g-1,@nclust)) {
	# reorder rows i to g in decreasing order of column i
	@J <- grade(@table[run(@i,@g), @i],down:T)
	if (@i > 1) {
		@J <- vector(run(@i-1),@i-1 + @J)
	}
	@table <- @table[@J,]
}
delete(@i,@J,@nclust,@g)
delete(@table,return:T)

%ordertable%