User talk:DonaldShiner
This is my first contribution in my favorite lingua franca, QB64. [code] REDIM a(0 TO 9999) AS STRING FOR z& = LBOUND(a) TO UBOUND(a) a(z&) = CHR$((33 + RND * (256 - 33)) AND 255) <nowiki>Insert non-formatted text hereNEXT 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 [/code] </nowiki>