Matash at 08:40, 29 January 2017

2017-01-29T08:40:27Z

← Older revision		Revision as of 08:40, 29 January 2017
Line 4:		Line 4:

	<PRE>		<PRE>
			SUBROUTINE ASORT(back, give, what, mode)
	* ASORT() subroutine		* ASORT() subroutine
	* Copyright (c) 2007, Keith Robert Johnson, All Rights Reserved		* Copyright (c) 2007, Keith Robert Johnson, All Rights Reserved
Line 16:		Line 17:
	* START-HISTORY:		* START-HISTORY:
	* 28 Aug 07 Program written.		* 28 Aug 07 Program written.
			* 29 Jan 16 Modified syntax to compile on D3/WIN Namely:
			* 1. Moved SUBROUTINE command to line 1
			* 2. Changed upcase command to OCONV equivalent
	* END-HISTORY		* END-HISTORY
	*		*
Line 38:		Line 42:
	*		*
	* START-CODE		* START-CODE

	~~SUBROUTINE ASORT(back, give, what, mode)~~

	* Set a default empty returned item		* Set a default empty returned item
Line 52:		Line 54:

	* Get sort mode (default is 'AL')		* Get sort mode (default is 'AL')
	rank = ~~upcase~~(mode)		rank = oconv(mode,"MCU")
	if not(index('[[/A/AL/AR/D/DL/DR]]/','/':rank:'/',1)) then rank = 'AL'		if not(index('[[/A/AL/AR/D/DL/DR]]/','/':rank:'/',1)) then rank = 'AL'

Conversion script: link fix

2015-02-26T23:48:53Z

link fix

New page

Back to [[BasicSource]]

This is a utility to reorganise associated multivalues by sorting one of them and changing the order of all the others to match.

<PRE>
* ASORT() subroutine
* Copyright (c) 2007, Keith Robert Johnson, All Rights Reserved
*
* This program is free software in the public domain; you can
* redistribute it and/or modify it in any way you wish.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
*
* START-HISTORY:
* 28 Aug 07 Program written.
* END-HISTORY
*
* START-DESCRIPTION:
*
* This subroutine will reorganise a set of associated
* attributes by sorting the values in one of them and
* aligning all the other attributes to match that one.
*
* CALL ASORT(back, give, what, mode)
*
* back = Sorted array
* give = Unsorted array of Associated Multivalues
* what = Sort Attribute : Default '1'
* mode = Sort mode : Default 'AL'
* A or AL = ascending - left justified
* AR = ascending - right justified
* D or DL = descending - left justified
* DR = descending - right justified
*
* END-DESCRIPTION
*
* START-CODE

SUBROUTINE ASORT(back, give, what, mode)

* Set a default empty returned item
back = ''

* Get sort attribute (default is 1)
attr = what
if not(num(attr)) then attr = 1
attr = int(abs(attr))
acnt = dcount(give,@am)
if attr lt 1 or attr gt acnt then attr = 1

* Get sort mode (default is 'AL')
rank = upcase(mode)
if not(index('[[/A/AL/AR/D/DL/DR]]/','/':rank:'/',1)) then rank = 'AL'

* Initialise - note that sorted attribute defines the value count
this = '' ; that = ''
line = give<attr>
vcnt = dcount(line,@vm)

* Backward pass to preserve existing order for equal sorting values
for vnum = vcnt to 1 step -1
valu = line<1,vnum>
locate(valu,this;posn;rank) then null
ins valu before this<posn>
ins vnum before that<posn>
next vnum

* Put all the returned attributes in the correct order
for anum = 1 to acnt
line = give<anum>
for vnum = 1 to vcnt
iota = line<1,that<vnum>>
if iota ne '' or anum eq attr then back<anum,vnum> = iota
next vnum
next anum

return
</PRE>

== Comments ==

2007-08-27 by Rex Gozar<br>
Similar functionality can be achieved using [[Row2Col]] and [[QuickSort]]. The difference is more pronounced in larger (10,000 plus) datasets, where I found that LOCATE tends to slow down.

ASORT - Revision history

Matash at 08:40, 29 January 2017

Conversion script: link fix