Announcement

Collapse
No announcement yet.

need help with ARRAY ?

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • Originally posted by Robert Alvarez View Post
    Think you missed a question on the sample that I tried to make on post #95.

    MID$(sbuffer,9) = HEX$(S_DR,digits) 'element 9 for max digits ''<<<<<<------- ERROR HERE
    Error because you copied incorrectly without understanding what the line was supposed to do
    The original example was:
    MID$(sbuffer,9) = HEX$(element,digits) 'element 9 for max digits

    SInce S_DR is the name of an array and not a number, it obviously won't compile.

    Last edited by Stuart McLachlan; 1 May 2021, 06:46 AM.

    Comment


    • Following up on USING vs. HEX... If you want to create sortable, fixed-length, human-readable, and short strings, instead of hexadecimal (base 16) you can use duosexigesimal (base 32). The implementation I use -- because it is sortable -- uses 0-9 and A-V. These days I use it mostly for unique keys in databases, but it would also work in this situation.

      "Not my circus, not my monkeys."

      Comment


      • It should not be an issue to sort a UDT by two members (fields) or even parts of members (MID$, LEFT$, etc) using the ARRAY SORT USING|CALL format.

        I am getting a little confused by all the kerfuffle when PB gives you all the tools you need.



        Michael Mattias
        Tal Systems (retired)
        Port Washington WI USA
        [email protected]
        http://www.talsystems.com

        Comment


        • Yes had error because of mix up. Fixed. Test with 1676 records, time 1 second or less. Just need to figure out to put sorted file back into tmp UDT.
          Code below

          Code:
          #COMPILE EXE
          #DIM ALL
          
          TYPE CJJD2N 'AS CJD 195
          CKN1 AS STRING * 6
          CKD1 AS STRING * 8
          TO1 AS STRING * 40
          FOR1 AS STRING * 40
          MEM1 AS STRING * 20
          DR1 AS STRING * 5
          DRD AS STRING * 25
          DA AS CUR
          CR1 AS STRING * 5
          CRD AS STRING * 25
          CA AS CUR
          NN AS LONG 'NN = REC NO.
          TT AS STRING * 1 'S OR M (S=J1 M=J2)
          END TYPE
          
          FUNCTION PBMAIN AS LONG 'sort by US date (stable results)
          LOCAL I, DT AS LONG : DIM CJD AS CJJD2N
          OPEN "CJJDTMP.DAT" FOR RANDOM AS #8 LEN=195 : DT=LOF(8)\LEN(CJD)
          ' ? STR$(DT) '=16676 TIME 1 SEC OR LESS
          'DT=40
          REDIM s(1 TO DT) AS STRING
          
          FOR I=1 TO DT: GET #8,I,CJD
          s(I)=CJD.CKD1+" "+CJD.CKN1+CJD.TO1+CJD.FOR1+CJD.MEM1+CJD.DR1+" "+CJD.DRD+" "+STR$(CJD.DA)+CJD.CR1+CJD.CRD+ _
          STR$(CJD.CA)+STR$(CJD.NN)+CJD.TT
          NEXT
          
          SortbyUSDate s()
          
          
          '? JOIN$(s(),$CR),,"Sorted YMD"
          'test
          OPEN "TESTSORTOLD.DAT" FOR OUTPUT AS #18
          FOR I=1 TO DT
          PRINT #18, s(I)
          NEXT: CLOSE: BEEP
          'test
          
          ? "DONE"
          END FUNCTION
          
          SUB SortbyUSDate(sArray() AS STRING)
          LOCAL element AS LONG
          LOCAL low AS LONG
          LOCAL high AS LONG
          LOCAL digits AS LONG
          LOCAL sbuffer AS STRING
          digits = LEN(FORMAT$(ARRAYATTR(sArray(),4))) 'max digits in number of elements
          sbuffer = SPACE$(8+digits) 'allocate buffer date + HEX$(element,digits)
          low = LBOUND(sArray)
          high = UBOUND(sArray)
          REDIM ymd(low TO high) AS STRING
          FOR element = low TO high
          MID$(sbuffer,1,4) = MID$(sArray(element),5,4) 'year 1 to 4
          MID$(sbuffer,5,2) = MID$(sArray(element),1,2) 'month 5 to 6
          MID$(sbuffer,7,2) = MID$(sArray(element),3,2) 'day 7 to 8
          MID$(sbuffer,9) = HEX$(element,digits) 'element 9 for max digits
          ymd(element)=sbuffer 'copy buffer to ymd(element)
          NEXT
          ARRAY SORT ymd(), TAGARRAY sArray() 'sort new array, return passed array in new array order
          END SUB
          Robert

          Comment


          • Here is updated sample. Put back array sort to UDT. Now just have to put this sample into my regular program and check display.

            Code:
            #COMPILE EXE
            #DIM ALL
            
            TYPE CJJD2N 'AS CJD 195
            CKN1 AS STRING * 6
            CKD1 AS STRING * 8
            TO1 AS STRING * 40
            FOR1 AS STRING * 40
            MEM1 AS STRING * 20
            DR1 AS STRING * 5
            DRD AS STRING * 25
            DA AS CUR
            CR1 AS STRING * 5
            CRD AS STRING * 25
            CA AS CUR
            NN AS LONG 'NN = REC NO.
            TT AS STRING * 1 'S OR M (S=J1 M=J2)
            END TYPE
            
            FUNCTION PBMAIN AS LONG 'sort by US date (stable results)
            LOCAL I, DT AS LONG, AMTD, AMTC AS STRING : DIM CJD AS CJJD2N
            OPEN "CJJDTMP.DAT" FOR RANDOM AS #8 LEN=195 : DT=LOF(8)\LEN(CJD)
            ' ? STR$(DT) '=1676 TIME 1 SEC OR LESS
            'DT=40
            REDIM s(1 TO DT) AS STRING
            
            FOR I=1 TO DT: GET #8,I,CJD
            AMTD=FORMAT$(CJD.DA,"* #######.00"): AMTC=FORMAT$(CJD.CA,"* #######.00")
            s(I)=CJD.CKD1+" "+CJD.CKN1+CJD.TO1+CJD.FOR1+CJD.MEM1+CJD.DR1+CJD.DRD+CJD.CR1+CJD.CRD+ _
            STR$(CJD.NN)+CJD.TT+AMTD+AMTC
            NEXT
            
            SortbyUSDate s()
            
            '? JOIN$(s(),$CR),,"Sorted YMD"
            'test
            OPEN "TESTSORT.DAT" FOR OUTPUT AS #18
            FOR I=1 TO DT
            PRINT #18, s(I)
            NEXT: CLOSE: BEEP
            'test
            
            'PUT ARRAY BACK TO DR FILE
            FOR I=1 TO DT ': GET #8,I,CJD
            CJD.CKN1=s(I):
            CJD.CKD1=s(I):
            CJD.TO1=s(I):
            CJD.FOR1=s(I):
            CJD.MEM1=s(I):
            CJD.DR1=s(I):
            CJD.DRD=s(I):
            CJD.DA=VAL(s(I)):
            CJD.CR1=s(I):
            CJD.CRD=s(I):
            CJD.CA=VAL(s(I)):
            CJD.NN=VAL(s(I)):
            CJD.TT=s(I): PUT #8,I,CJD
            NEXT
            
            ? "DONE"
            END FUNCTION
            
            SUB SortbyUSDate(sArray() AS STRING)
            LOCAL element AS LONG
            LOCAL low AS LONG
            LOCAL high AS LONG
            LOCAL digits AS LONG
            LOCAL sbuffer AS STRING
            digits = LEN(FORMAT$(ARRAYATTR(sArray(),4))) 'max digits in number of elements
            sbuffer = SPACE$(8+digits) 'allocate buffer date + HEX$(element,digits)
            low = LBOUND(sArray)
            high = UBOUND(sArray)
            REDIM ymd(low TO high) AS STRING
            FOR element = low TO high
            MID$(sbuffer,1,4) = MID$(sArray(element),5,4) 'year 1 to 4
            MID$(sbuffer,5,2) = MID$(sArray(element),1,2) 'month 5 to 6
            MID$(sbuffer,7,2) = MID$(sArray(element),3,2) 'day 7 to 8
            MID$(sbuffer,9) = HEX$(element,digits) 'element 9 for max digits
            ymd(element)=sbuffer 'copy buffer to ymd(element)
            NEXT
            ARRAY SORT ymd(), TAGARRAY sArray() 'sort new array, return passed array in new array order
            END SUB
            Robert

            Comment


            • Have to recheck that part where put back to UDT may not be right.
              Robert

              Comment


              • Originally posted by Michael Mattias View Post
                It should not be an issue to sort a UDT by two members (fields) or even parts of members (MID$, LEFT$, etc) using the ARRAY SORT USING|CALL format.
                Yep, post #80 did exactly that to sort the OP's UDT correctly by date
                Code:
                'sort by year first
                IF RIGHT$(Param1.CKD1,4) < RIGHT$(Param2.CKD1,4) THEN FUNCTION = -1 : EXIT FUNCTION
                IF RIGHT$(Param1.CKD1,4) > RIGHT$((Param2.CKD1,4) THEN FUNCTION = +1 : EXIT FUNCTION
                'then by full date if years are the same
                IF Param1.CKD1 < Param2.CKD1 THEN FUNCTION = -1 : EXIT FUNCTION
                IF Param1.CKD1 > Param2.CKD1 THEN FUNCTION = +1 : EXIT FUNCTION
                ...
                I am getting a little confused by all the kerfuffle when PB gives you all the tools you need.
                Me too.

                Comment


                • Originally posted by Robert Alvarez View Post
                  Yes had error because of mix up. Fixed. Test with 1676 records, time 1 second or less. Just need to figure out to put sorted file back into tmp UDT.
                  You don't have to if you just use your earlier code with the addition of the two lines to sort year first. Instead of your new convoluted method

                  Comment


                  • Originally posted by Robert Alvarez View Post
                    Yes had error because of mix up. Fixed. Test with 1676 records, time 1 second or less. Just need to figure out to put sorted file back into tmp UDT.
                    I still don't understand:
                    1. why you are stepping through you data instead of reading/writing it in one step.
                    2. why you are using a temporary array

                    You may like to examine the following demonstration program which show sorting ascending and descending without doing either of the above.
                    (It does step through the data for display purposes, but the sort uses the more efficient block read/write)
                    '
                    Code:
                    #COMPILE EXE
                    #DIM ALL
                    #DEBUG ERROR ON
                    #DEBUG DISPLAY ON
                    
                    TYPE CJJD2N 'AS CJD 195
                        CKN1 AS STRING * 6
                        CKD1 AS STRING * 8
                        TO1 AS STRING * 40
                        FOR1 AS STRING * 40
                        MEM1 AS STRING * 20
                        DR1 AS STRING * 5
                        DRD AS STRING * 25
                        DA AS CUR
                        CR1 AS STRING * 5
                        CRD AS STRING * 25
                        CA AS CUR
                        NN AS LONG 'NN = REC NO.
                        TT AS STRING * 1 'S OR M (S=J1 M=J2)
                    END TYPE
                    
                    FUNCTION PBMAIN() AS LONG
                        LOCAL cjd AS CJJD2N
                        LOCAL ff, dt,x AS LONG
                        LOCAL filename,s  AS STRING
                    
                        filename = "CJJDTMP.DAT"
                        ff =  FREEFILE
                        OPEN filename  FOR RANDOM AS #ff LEN=195 : dt=LOF(ff)\LEN(cjd)
                        s = "Original" & $LF
                        FOR x = 1 TO dt
                            GET #ff,x,cjd
                            s += cjd.CKD1   & " " & cjd.DR1  & " " & cjd.CKN1 & $LF
                        NEXT
                        CLOSE #ff
                    
                        SortDataFile filename
                            s += $LF & "Sorted" & $LF
                        OPEN filename & "-sorted" FOR RANDOM AS #ff LEN=195 : dt=LOF(ff)\LEN(cjd)
                        FOR x = 1 TO dt
                            GET #ff,x,cjd
                            s += cjd.CKD1   & " " & cjd.DR1 & " " & cjd.CKN1 & $LF
                        NEXT
                        CLOSE #ff
                        SortDataFileD filename    'Descending
                            s += $LF & "Sorted Descending" & $LF
                        OPEN filename & "-sorted" FOR RANDOM AS #ff LEN=195 : dt=LOF(ff)\LEN(cjd)
                        FOR x = 1 TO dt
                            GET #ff,x,cjd
                            s += cjd.CKD1   & " " & cjd.DR1 & " " & cjd.CKN1 & $LF
                        NEXT
                        CLOSE #ff
                        'Show results
                        OPEN "SortResults.txt" FOR OUTPUT AS #1
                        PRINT #1, s
                        CLOSE #1
                        SHELL ("notepad.exe SortResults.txt")
                    END FUNCTION
                    
                    SUB SortDataFile (filename AS STRING)
                        LOCAL cjd AS CJJD2N
                        LOCAL lngrecs,ff AS LONG
                        ff = FREEFILE
                        OPEN filename FOR BINARY AS #ff
                        lngRecs = LOF(#ff) / LEN(cjd)
                        DIM arrCJ(lngrecs -1) AS CJJD2N
                        GET #ff,1,arrCJ()
                        CLOSE #ff
                        ARRAY SORT arrCJ(), CALL SortDataFileCB
                        OPEN filename & "-sorted"  FOR BINARY AS #ff
                        PUT #ff,1,arrCJ()
                        CLOSE #ff
                    END SUB
                    
                    SUB SortDataFileD (filename AS STRING)
                        LOCAL cjd AS CJJD2N
                        LOCAL lngrecs,ff AS LONG
                        ff = FREEFILE
                        OPEN filename FOR BINARY AS #ff
                        lngRecs = LOF(#ff) / LEN(cjd)
                        DIM arrCJ(lngrecs -1) AS CJJD2N
                        GET #ff,1,arrCJ()
                        CLOSE #ff
                        ARRAY SORT arrCJ(), CALL SortDataFileCBDesc
                        OPEN filename & "-sorted"  FOR BINARY AS #ff
                        PUT #ff,1,arrCJ()
                        CLOSE #ff
                    END SUB
                    
                    FUNCTION SortDataFileCB(Param1 AS CJJD2N, Param2 AS CJJD2N) AS LONG
                        IF RIGHT$(Param1.CKD1,4) < RIGHT$(Param2.CKD1,4) THEN FUNCTION = -1 : EXIT FUNCTION
                        IF RIGHT$(Param1.CKD1,4) > RIGHT$(Param2.CKD1,4) THEN FUNCTION = +1 : EXIT FUNCTION
                        IF Param1.CKD1 < Param2.CKD1 THEN FUNCTION = -1 : EXIT FUNCTION
                        IF Param1.CKD1 > Param2.CKD1 THEN FUNCTION = +1 : EXIT FUNCTION
                        IF Param1.DR1 < Param2.DR1 THEN FUNCTION = -1 : EXIT FUNCTION
                        IF Param1.DR1 > Param2.DR1 THEN FUNCTION = +1 : EXIT FUNCTION
                        IF Param1.CKN1 < Param2.CKN1 THEN FUNCTION = -1 : EXIT FUNCTION
                        IF Param1.CKN1 > Param2.CKN1 THEN FUNCTION = +1 : EXIT FUNCTION
                        IF Param1.TO1 < Param2.TO1 THEN FUNCTION = -1 : EXIT FUNCTION
                        IF Param1.TO1 > Param2.TO1 THEN FUNCTION = +1 : EXIT FUNCTION
                        IF Param1.FOR1 < Param2.FOR1 THEN FUNCTION = -1 : EXIT FUNCTION
                        IF Param1.FOR1 > Param2.FOR1 THEN FUNCTION = +1 : EXIT FUNCTION
                        IF Param1.MEM1 < Param2.MEM1 THEN FUNCTION = -1 : EXIT FUNCTION
                        IF Param1.MEM1 > Param2.MEM1 THEN FUNCTION = +1 : EXIT FUNCTION
                        IF Param1.DRD < Param2.DRD THEN FUNCTION = -1 : EXIT FUNCTION
                        IF Param1.DRD > Param2.DRD THEN FUNCTION = +1 : EXIT FUNCTION
                        IF Param1.DA < Param2.DA THEN FUNCTION = -1 : EXIT FUNCTION
                        IF Param1.DA > Param2.DA THEN FUNCTION = +1 : EXIT FUNCTION
                        IF Param1.CR1 < Param2.CR1 THEN FUNCTION = -1 : EXIT FUNCTION
                        IF Param1.CR1 > Param2.CR1 THEN FUNCTION = +1 : EXIT FUNCTION
                        IF Param1.CRD < Param2.CRD THEN FUNCTION = -1 : EXIT FUNCTION
                        IF Param1.CRD > Param2.CRD THEN FUNCTION = +1 : EXIT FUNCTION
                        IF Param1.CA < Param2.CA THEN FUNCTION = -1 : EXIT FUNCTION
                        IF Param1.CA > Param2.CA THEN FUNCTION = +1 : EXIT FUNCTION
                        IF Param1.NN < Param2.NN THEN FUNCTION = -1 : EXIT FUNCTION
                        IF Param1.NN > Param2.NN THEN FUNCTION = +1 : EXIT FUNCTION
                        IF Param1.TT < Param2.TT THEN FUNCTION = -1 : EXIT FUNCTION
                        IF Param1.TT > Param2.TT THEN FUNCTION = +1 : EXIT FUNCTION
                    END FUNCTION
                    
                    FUNCTION SortDataFileCBDesc(Param1 AS CJJD2N, Param2 AS CJJD2N) AS LONG
                        IF RIGHT$(Param1.CKD1,4) < RIGHT$(Param2.CKD1,4) THEN FUNCTION = +1 : EXIT FUNCTION
                        IF RIGHT$(Param1.CKD1,4) > RIGHT$(Param2.CKD1,4) THEN FUNCTION = -1 : EXIT FUNCTION
                        IF Param1.CKD1 < Param2.CKD1 THEN FUNCTION = +1 : EXIT FUNCTION
                        IF Param1.CKD1 > Param2.CKD1 THEN FUNCTION = -1 : EXIT FUNCTION
                        IF Param1.DR1 < Param2.DR1 THEN FUNCTION = +1 : EXIT FUNCTION
                        IF Param1.DR1 > Param2.DR1 THEN FUNCTION = -1 : EXIT FUNCTION
                        IF Param1.CKN1 < Param2.CKN1 THEN FUNCTION = +1 : EXIT FUNCTION
                        IF Param1.CKN1 > Param2.CKN1 THEN FUNCTION = -1 : EXIT FUNCTION
                        IF Param1.TO1 < Param2.TO1 THEN FUNCTION = +1 : EXIT FUNCTION
                        IF Param1.TO1 > Param2.TO1 THEN FUNCTION = -1 : EXIT FUNCTION
                        IF Param1.FOR1 < Param2.FOR1 THEN FUNCTION = +1 : EXIT FUNCTION
                        IF Param1.FOR1 > Param2.FOR1 THEN FUNCTION = -1 : EXIT FUNCTION
                        IF Param1.MEM1 < Param2.MEM1 THEN FUNCTION = +1 : EXIT FUNCTION
                        IF Param1.MEM1 > Param2.MEM1 THEN FUNCTION = -1 : EXIT FUNCTION
                        IF Param1.DRD < Param2.DRD THEN FUNCTION = +1 : EXIT FUNCTION
                        IF Param1.DRD > Param2.DRD THEN FUNCTION = -1 : EXIT FUNCTION
                        IF Param1.DA < Param2.DA THEN FUNCTION = +1 : EXIT FUNCTION
                        IF Param1.DA > Param2.DA THEN FUNCTION = -1 : EXIT FUNCTION
                        IF Param1.CR1 < Param2.CR1 THEN FUNCTION = +1 : EXIT FUNCTION
                        IF Param1.CR1 > Param2.CR1 THEN FUNCTION = -1 : EXIT FUNCTION
                        IF Param1.CRD < Param2.CRD THEN FUNCTION = +1 : EXIT FUNCTION
                        IF Param1.CRD > Param2.CRD THEN FUNCTION = -1 : EXIT FUNCTION
                        IF Param1.CA < Param2.CA THEN FUNCTION = +1 : EXIT FUNCTION
                        IF Param1.CA > Param2.CA THEN FUNCTION = -1 : EXIT FUNCTION
                        IF Param1.NN < Param2.NN THEN FUNCTION = +1 : EXIT FUNCTION
                        IF Param1.NN > Param2.NN THEN FUNCTION = -1 : EXIT FUNCTION
                        IF Param1.TT < Param2.TT THEN FUNCTION = +1 : EXIT FUNCTION
                        IF Param1.TT > Param2.TT THEN FUNCTION = -1 : EXIT FUNCTION
                    END FUNCTION
                    '

                    Comment


                    • Today's DailyWTF is apposite : https://thedailywtf.com/articles/an-untimely-revival

                      Click image for larger version

Name:	01-sort.png
Views:	67
Size:	76.2 KB
ID:	807300

                      Comment


                      • #108 confusing, sample code I fixed is doing what I wanted. but not finished. Do not know what you mean "just use your earlier code with the addition of the two lines"

                        1. why you are stepping through you data instead of reading/writing it in one step. <--- will check your code. Many ways to do code, some of my ways not be the best way.
                        2. why you are using a temporary array <---- the original UDT has more fields which I do not need for the reports that I am doing. could have used it but do not a change to mess that up. always use copy.

                        Rod Macia sort is good , still not done looking at that code, will do some changes to check for that , unstable problem, time was 8 sec for large but that code is still useful , may use in some other places.
                        MIke Doty sort was faster less than one second, still have work to do and check other ways to use

                        been busy , busy doing other things too.



                        Robert

                        Comment


                        • Robert maybe this will help you understand the differences
                          by the way the sample code below creates 1676 records based on the 44 you supplied, changes dates to random dates between 2019 and 2021 to help illustrate the different sorting option.
                          All 3 using PB's Array Sort with CALL.

                          Loading your sample, Creating and saving a 1676 record file, closing it, loading it all, doing all 3 sorts. Takes about 1 sec on my laptop.
                          (it does have an SSD)

                          '
                          Code:
                          #COMPILE EXE
                          #DIM ALL
                          
                          TYPE CJJD2N 'AS CJD 195
                          CKN1 AS STRING * 6
                          CKD1 AS STRING * 8
                          TO1 AS STRING * 40
                          FOR1 AS STRING * 40
                          MEM1 AS STRING * 20
                          DR1 AS STRING * 5
                          DRD AS STRING * 25
                          DA AS CUR
                          CR1 AS STRING * 5
                          CRD AS STRING * 25
                          CA AS CUR
                          NN AS LONG 'NN = REC NO.
                          TT AS STRING * 1 'S OR M (S=J1 M=J2)
                          END TYPE
                          
                          %SampleSize =1676     ' Used to greate a bigger Random Sample based on the one provided by Robert.
                          
                          FUNCTION PBMAIN
                          LOCAL DT, I, J AS LONG
                          LOCAL sT AS STRING
                          
                          RANDOMIZE TIMER
                          
                          ' Load the Sample provied by Robert (44 records)
                          DIM CJD AS CJJD2N: OPEN "CJJDTMP.DAT" FOR RANDOM AS #8 LEN=195 : DT=LOF(8)\LEN(CJD)
                          DIM S_DR(1 TO DT) AS CJJD2N
                          
                          FOR I=1 TO DT
                          GET #8,I,S_DR(I)
                          NEXT
                          CLOSE #8
                          
                          ' Create a bigger sample using the 44 records provied \
                          DIM S_New(1 TO %SampleSize) AS CJJD2N       ' Array new big data
                          OPEN "CJJDTMPROD.DAT" FOR RANDOM AS #18 LEN=195
                          FOR I=1 TO %SampleSize
                          j = RND(1,DT)                       ' choose one of the 44 records ramdomly
                          S_New(I) = S_DR(j)                  ' copy in new array
                          s_New(I).CKD1 = RanDate (2019,2021) ' changed date to a random date between 2019 and 2021
                          s_New(I).NN = I                     ' Change record number
                          PUT #18,I,s_New(I)                  ' Save record
                          NEXT I
                          CLOSE #18
                          
                          ERASE S_DR()
                          ERASE S_New ()
                          
                          ' Testing Starts Here based on new Sample......
                          OPEN "CJJDTMPROD.DAT" FOR RANDOM AS #8 LEN=195 : DT=LOF(8)\LEN(CJD)
                          ''''
                          'NEW SORT CODE
                          'DR ***************************************** DR=DEBIT RECORDS
                          DIM S_DR(1 TO DT) AS CJJD2N
                          DIM s_AmericanDate (1 TO DT) AS CJJD2N
                          DIM s_OrdinalDate (1 TO DT) AS CJJD2N
                          DIM s_OrdinalDateRecordNum (1 TO DT) AS CJJD2N
                          
                          FOR I=1 TO DT
                          GET #8,I,S_DR(I)
                          s_AmericanDate(I)=S_DR(I)                 ' Make 3 copies
                          s_OrdinalDate (I)=S_DR(I)
                          s_OrdinalDateRecordNum(I)=S_DR(I)
                          NEXT
                          
                          ARRAY SORT s_AmericanDate(), CALL RGEN_ALL_SORT_AmericanDate     ' MMDDYYYY
                          ARRAY SORT s_OrdinalDate(), CALL RGEN_ALL_SORT_OrdinalDate       ' MMDDYYYY Sort by YYYY first then MMDD
                          ARRAY SORT s_OrdinalDateRecordNum(), CALL RGEN_ALL_SORT_OrdinalDateRecordNum   'Same as above but also use original order if dates equal.
                          
                          '**************** NOT NEEDED FOR TEST *****************
                          'PUT ARRAY BACK TO DR FILE
                          'FOR I=1 TO DT ': GET #8,I,CJD
                          'CJD.CKN1=S_DR(I).CKN1: CJD.CKD1=S_DR(I).CKD1: CJD.TO1=S_DR(I).TO1: CJD.FOR1=S_DR(I).FOR1: CJD.MEM1=S_DR(I).MEM1
                          'CJD.DR1=S_DR(I).DR1: CJD.DRD=S_DR(I).DRD: CJD.DA=S_DR(I).DA: CJD.CR1=S_DR(I).CR1: CJD.CRD=S_DR(I).CRD
                          'CJD.CA=S_DR(I).CA: CJD.NN=S_DR(I).NN: CJD.TT=S_DR(I).TT: PUT #8,I,CJD
                          'NEXT
                          
                          'DR ***************
                          ''''
                          'test
                          OPEN "TESTSORTNEW.DAT" FOR OUTPUT AS #18
                          PRINT #18, "              Original                                  American String                           ORDINAL Date American string with Year    ORDINAL Date and Record order"
                          PRINT #18, "              Date          Account        Record       Date          Account        Record       Date          Account        Record       Date          Account        Record"
                          FOR I=1 TO DT' DT:
                          PRINT #18, STR$(I);"->", S_DR(I).CKD1, S_DR(I).DR1, STR$(S_DR(I).NN), _
                                                   s_AmericanDate(I).CKD1, s_AmericanDate(I).DR1, STR$(s_AmericanDate(I).NN), _
                                                   s_OrdinalDate(I).CKD1, s_OrdinalDate(I).DR1, STR$(s_OrdinalDate(I).NN), _
                                                   s_OrdinalDateRecordNum(I).CKD1, s_OrdinalDateRecordNum(I).DR1, STR$(s_OrdinalDateRecordNum(I).NN)
                          NEXT: CLOSE#18 : BEEP
                          SHELL ("notepad.exe TESTSORTNEW.DAT",3)
                          'test
                          END FUNCTION
                          
                          FUNCTION RGEN_ALL_SORT_AmericanDate(Param1 AS CJJD2N, Param2 AS CJJD2N) AS LONG
                            IF Param1.CKD1 < Param2.CKD1 THEN FUNCTION = -1 : EXIT FUNCTION
                            IF Param1.CKD1 > Param2.CKD1 THEN FUNCTION = +1 : EXIT FUNCTION
                          END FUNCTION
                          
                          FUNCTION RGEN_ALL_SORT_OrdinalDate(Param1 AS CJJD2N, Param2 AS CJJD2N) AS LONG
                            'Year first
                            IF RIGHT$(Param1.CKD1,4) < RIGHT$(Param2.CKD1,4) THEN FUNCTION = -1 : EXIT FUNCTION
                            IF RIGHT$(Param1.CKD1,4) > RIGHT$(Param2.CKD1,4) THEN FUNCTION = +1 : EXIT FUNCTION
                            'if same year also by month and day
                            IF Param1.CKD1 < Param2.CKD1 THEN FUNCTION = -1 : EXIT FUNCTION
                            IF Param1.CKD1 > Param2.CKD1 THEN FUNCTION = +1 : EXIT FUNCTION
                          END FUNCTION
                          
                          FUNCTION RGEN_ALL_SORT_OrdinalDateRecordNum(Param1 AS CJJD2N, Param2 AS CJJD2N) AS LONG
                            'Year first
                            IF RIGHT$(Param1.CKD1,4) < RIGHT$(Param2.CKD1,4) THEN FUNCTION = -1 : EXIT FUNCTION
                            IF RIGHT$(Param1.CKD1,4) > RIGHT$(Param2.CKD1,4) THEN FUNCTION = +1 : EXIT FUNCTION
                            'if same year also by month and day
                            IF Param1.CKD1 < Param2.CKD1 THEN FUNCTION = -1 : EXIT FUNCTION
                            IF Param1.CKD1 > Param2.CKD1 THEN FUNCTION = +1 : EXIT FUNCTION
                            ' Dates are same so order based on record number
                            IF Param1.NN < Param2.NN THEN FUNCTION = -1 : EXIT FUNCTION
                            IF Param1.NN > Param2.NN THEN FUNCTION = +1 : EXIT FUNCTION
                          END FUNCTION
                          
                          FUNCTION RanDate (Year1 AS LONG, Year2 AS LONG) AS STRING    ' get some ramdom dates between 2 years
                          LOCAL lrYear AS LONG
                          LOCAL lrMonth AS LONG
                          LOCAL lrDay AS LONG
                            lrYear = RND(Year1,Year2)
                            lrMonth= RND(1,12)
                              SELECT CASE lrMonth
                                  CASE 1,3,5,7,8,10,12
                                    lrDay= RND(1,31)
                                  CASE 2
                                    lrDay= 28  ' we dont care about leap years
                                  CASE ELSE
                                    lrDay= RND(1,30)
                              END SELECT
                          FUNCTION = DEC$(lrMonth,2) + DEC$(lrDay,2) + DEC$(lrYear)
                          END FUNCTION
                          '
                          DemoSort.zip

                          Comment


                          • Thanks Rod, helps better understand your array sort, will plug in my program .
                            Robert

                            Comment

                            Working...
                            X