Difference between revisions of "ASORT"

From Pickwiki
Jump to navigationJump to search
m (link fix)
m
 
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'
  

Latest revision as of 08:40, 29 January 2017

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


Comments

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.