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>