STATISTICA







STATISTICA BASIC Program Sort.stb

{ This program will get the current Scrollsheet and sort the rows by a user-selected column.

Maximum number of columns is 25.

Program written, modified, or edited at StatSoft, Inc.}


randomaccess;
NoDataFileVariableNames;
{ get the Scrollsheet handle for the currently active
  (highlighted) Scrollsheet }
{get the Scrollsheet handle of the currently active (highlighted) Scrollsheet}
	handl:=GetScrollsheet (0);
	if handl=0 then begin
 	  DisplayMessageBox (MB_OK,
 	   'No Scrollsheet was found',
	   'No valid Scrollsheet was found; this program will sort the rows of Scrollsheet
by a user-selected column.');
	  stop;
	end;

	ncolumns:=ScrollsheetGetNbCols (handl);
	nrows:=ScrollsheetGetNbRows (handl);
	ntemporary:=min(ncolumns,25);
{get column names}
	kname$:='';
	for i:=1 to ntemporary do begin
	  ScrollsheetGetColName (handl, i, Name1$, Name2$);
	  iwidth:=Len (Name2$);
	  if iwidth<8 then name2$:=name2$+'        ';
	  kname$:=kname$+Mid (name2$, 1, 8)+'|';
	end;
	iselected:=DisplayListBox ('Select Scrollsheet Column', kname$, 1);
	if iselected=0 then stop;

{which rows to sort?}
	redim rangetosort(2);
	redim backuptable(nrows,ncolumns);
	rangetosort(1):=1;
	rangetosort(2):=nrows;
	kname$:='From:|To:';
	if DisplayNumericInputBox ('Select rows to sort', kname$, rangetosort)=0
        then stop;
	if (rangetosort(1)<1) or (rangetosort(2)>nrows)
		or ((rangetosort(2)-rangetosort(1))<1) then begin
	 DisplayMessageBox (MB_ICONSTOP, 'Invalid Range of Rows',
	  'Invalid range of rows to sort was selected.');
	 stop;
	end;
{how to sort}
	sortorder:=DisplayButtonBox ('Sort ascending or descending?',
	  'Ascending, raw values|Descending, raw values|Ascending, absolute
values|Descending, absolute values');
	if sortorder=0 then stop;
{allocate memory}
	rowstosort:=rangetosort(2)-rangetosort(1)+1;
	redim temparray1(rowstosort),temparray2(rowstosort);

{get values for selected column }
	ii:=0;
	for i:=rangetosort(1) to rangetosort(2) do begin
	 ii:=ii+1;
	 ScrollsheetGetValue (handl, i, iselected, temparray1(ii));
	 if sortorder>2 then temparray1(ii):=abs(temparray1(ii));
	 temparray2(ii):=ii;
	end;

{sort that column}
	if (sortorder=1) or (sortorder=3) then
	 VectorDualSort (temparray1, temparray2, SORT_ASCENDING)
	else
	 VectorDualSort (temparray1, temparray2, SORT_DESCENDING);

{make new scrollsheet}
	handl2:=NewScrollsheet (nrows, ncolumns, backuptable,
	 ?Title$, ?RowNames$, ?ColumnNames$);
{set default widths of 10 for first column, 8 for subsequent columns}
	ScrollsheetSetColumnWidth (handl2, 8, 1);
	ScrollsheetSetRowNameWidth (handl2, 10);
{headers}
	for i:=1 to 3 do begin
	 ScrollsheetGetTitle (handl, i, titleline$);
	 ScrollsheetSetTitle (handl2, i, titleline$);
	end;
	for i:=1 to ncolumns do begin
	 ScrollsheetGetColName (handl, i, Name1$, Name2$);
	 ScrollsheetSetColumnName (handl2, i, Name1$, Name2$);
	end;
{copy scrollsheet, unsorted rows}
	for i:=1 to rangetosort(1)-1 do begin
	 for j:=1 to ncolumns do begin
	  ScrollsheetGetValue (handl, i, j, scrollvalue);
	  ScrollsheetGetTextValue (handl, i, j, String$);
	  ScrollsheetSetValue (handl2, i, j, scrollvalue);
        ScrollsheetSetTextValue (handl2, i, j, String$);
 	 end;
	 ScrollsheetGetRowName (handl, i, Name$);
	 ScrollsheetSetRowName (handl2, i, Name$);
	end;
{copy scrollsheet, sorted rows}
	for i:=rangetosort(1) to rangetosort(2) do begin
	 for j:=1 to ncolumns do begin
	  ScrollsheetGetValue (handl, temparray2(i), j, scrollvalue);
	  ScrollsheetGetTextValue (handl, temparray2(i), j, String$);
	  ScrollsheetSetValue (handl2, i, j, scrollvalue);
        ScrollsheetSetTextValue (handl2, i, j, String$);
 	 end;
	 ScrollsheetGetRowName (handl, temparray2(i), Name$);
	 ScrollsheetSetRowName (handl2, i, Name$);
	end;
{copy remainder}
	for i:=rangetosort(2)+1 to nrows do begin
	 for j:=1 to ncolumns do begin
	  ScrollsheetGetValue (handl, i, j, scrollvalue);
	  ScrollsheetGetTextValue (handl, i, j, String$);
	  ScrollsheetSetValue (handl2, i, j, scrollvalue);
        ScrollsheetSetTextValue (handl2, i, j, String$);
 	 end;
	 ScrollsheetGetRowName (handl, i, Name$);
	 ScrollsheetSetRowName (handl2, i, Name$);
	end;
Back to List of Programs



[StatSoft]
2300 East 14th Street, Tulsa, OK 74104
Phone: (918) 749-1119; Fax: (918) 749-2217

[StatSoft]e-mail: info@statsoft.com

©Copyright StatSoft, Inc., 1984-2004.
StatSoft, StatSoft logo, STATISTICA, SEWSS, SEDAS, Data Miner, SEPATH and GTrees are trademarks of StatSoft, Inc.