User talk:DonaldShiner

REDIM a(0 TO 9999) AS STRING FOR z& = LBOUND(a) TO UBOUND(a) a(z&) = CHR$((33 + RND * (256 - 33)) AND 255) NEXT BucketSort a$() FOR u& = LBOUND(a$) TO UBOUND(a$) PRINT a$(u&); NEXT SUB BucketSort (a() AS STRING) REDIM Bucketcount(0 TO 255) AS LONG MinAscii% = 255 MaxAscii% = 0 Biggest% = LBOUND(BucketCount) FOR scan& = LBOUND(a) TO UBOUND(a) IF a(scan&) > "" THEN ascii% = ASC(a(scan&)) IF ascii% < MinAscii% THEN MinAscii% = ascii% END IF IF ascii% > MaxAscii% THEN MaxAscii% = ascii% END IF IF Bucketcount(ascii%) > Bucketcount(Biggest%) THEN Biggest% = ascii% END IF Bucketcount(ascii%) = Bucketcount(ascii%) + 1 END IF NEXT PRINT MinAscii%, MaxAscii% REDIM Buckets(MinAscii% TO MaxAscii%, 0 TO Bucketcount(Biggest%)) AS STRING REDIM Bucketcount(MinAscii% TO MaxAscii%) AS LONG FOR scan& = LBOUND(a) TO UBOUND(a) IF a(scan&) > "" THEN nthbucket% = ASC(a(scan&)) PRINT nthbucket% Buckets(nthbucket%, Bucketcount(nthbucket%)) = a(scan&) Bucketcount(nthbucket%) = Bucketcount(nthbucket%) + 1 END IF NEXT xsum& = LBOUND(a) FOR i% = MinAscii% TO MaxAscii% EMerge a(), 0, Bucketcount(i%) - 1 FOR j% = 0 TO Bucketcount(i%) - 1 a(xsum&) = Buckets(i%, j%) xsum& = xsum& + 1 NEXT NEXT ERASE Buckets ERASE Bucketcount END SUB SUB EMerge (Array() AS STRING, start&, finish&) IF finish& - start& = 1 THEN IF Array(start&) > Array(finish&) THEN SWAP Array(start&), Array(finish&) END IF ELSE IF finish& - start& > 1 THEN m& = start& + (finish& - start& + 1) \ 2 EMerge Array(), start&, m& EMerge Array(), m& + 1, finish& EfficientMerge Array(), start&, m&, finish& END IF END IF END SUB SUB EfficientMerge (Array() AS STRING, start&, m&, finish&) DIM b(start& TO m&) AS STRING i& = start& j& = m& + 1 ' // copy first half of array a to auxiliary array b%() DO IF i& > m& THEN EXIT DO ELSE b(i&) = Array(i&) j& = j& + 1 i& = i& + 1 END IF LOOP i& = start& j& = m& + 1 k& = start& ' // copy back next-greatest element at each time DO IF j& > finish& THEN EXIT DO ELSE IF k& < j& THEN IF b(i&) <= Array(j&) THEN Array(k&) = b(i&) i& = i& + 1 ELSE Array(k&) = Array(j&) j& = j& + 1 END IF k& = k& + 1 ELSE EXIT DO END IF END IF LOOP ' // copy back remaining elements of first half (if any) WHILE (k& < j&) Array(k&) = b(i&) k& = k& + 1 i& = i& + 1 WEND ERASE b END SUB