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.
SUBROUTINE ASORT(back, give, what, mode) * 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. * 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 * * 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 * 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 = oconv(mode,"MCU") 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
2007-08-27 by Rex Gozar
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.