Author Topic: Is anyone here on Quora?  (Read 3247 times)

0 Members and 1 Guest are viewing this topic.

Offline codeguy

  • Forum Regular
  • Posts: 174
    • View Profile
Is anyone here on Quora?
« on: July 05, 2020, 07:23:27 am »
sometimes (quite frequently, actually), people ask "How do I..." questions. Occasionally I whip up quick n' dirty solutions using QB64 and post them after THOROUGH testing. I may not be first, but my answers are usually quite good. So here's the code I posted with link in comments.
Code: [Select]
'https://www.quora.com/How-do-I-delete-negative-elements-from-an-array-and-print-positive-numbers-only
REDIM somearray(0 TO 16777215) AS DOUBLE
FOR s = LBOUND(somearay) TO UBOUND(somearray)
    somearray(s) = (1 / 2 - RND) * (1 + RND)
NEXT
s! = TIMER(.001)
FlashSort somearray(), LBOUND(somearray), UBOUND(somearray), 1
DIM where AS _INTEGER64
DIM x AS _INTEGER64
where = BinarySearch(somearray(), LBOUND(somearray), UBOUND(somearray), 0)
f! = TIMER(.001)
x = LBOUND(somearray)
FOR i = where TO UBOUND(somearray)
    PRINT somearray(i)
    somearray(x) = somearray(i)
    x = x + 1
NEXT
PRINT f! - s!
REDIM _PRESERVE somearray(LBOUND(somearray) TO UBOUND(somearray) - where + LBOUND(somearray))
FUNCTION BinarySearch (a() AS DOUBLE, start AS _INTEGER64, finish AS _INTEGER64, what AS DOUBLE)
    DIM a AS _INTEGER64: a = start
    DIM b AS _INTEGER64: b = finish
    DO
        where = a + (b - a) \ 2
        SELECT CASE a(where)
            CASE IS < what
                a = where + 1
            CASE IS > what
                b = where - 1
            CASE ELSE
                EXIT DO
        END SELECT
    LOOP UNTIL b < a
    BinarySearch = where
END FUNCTION
SUB FlashSort (CGSortLibArr() AS DOUBLE, start AS LONG, finish AS LONG, order&)
    '* change these:
    DIM hold AS DOUBLE
    DIM flash AS DOUBLE
    DIM ANMiN AS DOUBLE
    '* to the same type as the array being sorted

    '* change these:
    DIM KIndex AS LONG
    DIM MIndex AS LONG
    DIM SIndex AS LONG
    '* to long for qbxx as qbxx has no _unsigned types

    '* the original ratio was .125 but i kept getting array bounds errors
    MIndex = (INT(.128 * (finish - start + 1)) + 1) OR 2

    '* change these:
    DIM FlashTrackL(0 TO MIndex) AS LONG
    DIM FlashI AS LONG
    DIM FlashJ AS LONG
    DIM NextFlashJ AS LONG
    DIM FlashNMove AS LONG
    DIM MaxValueIndex AS LONG
    DIM MinValueIndex AS LONG
    DIM FinishMinusOne AS LONG
    '* to the appropriate type for the range being sorted (must match start, finish variables)

    '* don't mess:
    DIM FlashC1 AS DOUBLE '* for some reason does not work with _float
    '* with this. it needs to be a double at the very least but float gives this a far greater range
    '* more than likely more range than is practical. but ya never know (change this to double for qbxx)

    ' sorts array A with finish elements by use of
    ' index vector L with M elements, with M ca. 0.128(finish-start).
    ' Translation of Karl-Dietrich Neubert's FlashSort
    ' algorithm into BASIC by Erdmann Hess.
    ' Generalized Numeric Version -- recoded by codeguy

    '* This is the absolute quickest sorting algorithm I can find for numeric arrays. Unfortunately, generalizing this for
    '* strings may require some work. sounds like a project to me. I have changed a couple things from the original,
    '* namely that .125 has been changed to .128. It seems that after a few runs on randomized data, a subscript error
    '* kept popping up. Traced it to FlashTrackL() and added a minor (about 2.4&) increase in the upper bound of FlashTrackL().
    '* I suppose this could also be used for non-integer and non-string types as well. Note: For very large N, HashListSort()
    '* works even faster and has a similar memory footprint. But yes, this is still faster than QuickSort for N>10000 and like
    '* HashListSort, operates in asymptotically close to O(N) time.

    REM =============== CLASS FORMATION =================

    ANMiN = CGSortLibArr(start)
    MaxValueIndex = finish
    MinValueIndex = start
    FOR FlashI = start TO finish
        IF (CGSortLibArr(FlashI) > CGSortLibArr(MaxValueIndex)) THEN MaxValueIndex = FlashI
        IF (CGSortLibArr(FlashI) < CGSortLibArr(MinValueIndex)) THEN MinValueIndex = FlashI
    NEXT FlashI
    SWAP CGSortLibArr(MinValueIndex), CGSortLibArr(start): MinValueIndex = start: ANMiN = CGSortLibArr(MinValueIndex)
    SWAP CGSortLibArr(MaxValueIndex), CGSortLibArr(finish): MaxValueIndex = finish

    IF ANMiN = CGSortLibArr(MaxValueIndex) THEN
        '* this is a monotonic sequence array and by definition is already sorted
        EXIT SUB
    END IF

    DIM FlashTrackL(MIndex)
    FlashC1 = (MIndex - 1) / (CGSortLibArr(MaxValueIndex) - ANMiN)

    FOR FlashI = start + 1 TO finish - 1
        KIndex = INT(FlashC1 * (CGSortLibArr(FlashI) - ANMiN)) + 1
        FlashTrackL(KIndex) = FlashTrackL(KIndex) + 1
    NEXT

    FOR KIndex = LBOUND(FlashTrackL) + 1 TO MIndex
        FlashTrackL(KIndex) = FlashTrackL(KIndex) + FlashTrackL(KIndex - 1)
    NEXT KIndex

    REM ==================== PERMUTATION ================
    FlashNMove = 0
    FlashJ = start + 1
    KIndex = MIndex
    FinishMinusOne = finish - 1
    WHILE (FlashNMove < FinishMinusOne)
        WHILE (FlashJ > FlashTrackL(KIndex))
            FlashJ = FlashJ + 1
            KIndex = INT(FlashC1 * (CGSortLibArr(FlashJ) - ANMiN)) + 1
        WEND
        flash = CGSortLibArr(FlashJ)
        DO
            IF (FlashJ = (FlashTrackL(KIndex) + 1)) THEN
                EXIT DO
            ELSE
                IF FlashNMove < (FinishMinusOne) THEN
                    KIndex = INT(FlashC1 * (flash - ANMiN)) + 1
                    hold = CGSortLibArr(FlashTrackL(KIndex))
                    CGSortLibArr(FlashTrackL(KIndex)) = flash
                    flash = hold
                    FlashTrackL(KIndex) = FlashTrackL(KIndex) - 1
                    FlashNMove = FlashNMove + 1
                ELSE
                    EXIT DO
                END IF
            END IF
        LOOP
    WEND
    '================= Insertion Sort============
    FOR SIndex = LBOUND(FlashtrackL) + 1 TO MIndex
        '* sort subranges
        '********************* insertionsortz CGSortLibArr(), FlashTrackL(SIndex - 1), FlashTrackL(SIndex) - 1, order&
        FOR FlashI = FlashTrackL(SIndex) - 1 TO FlashTrackL(SIndex - 1) STEP -1
            IF (CGSortLibArr(FlashI + 1) < CGSortLibArr(FlashI)) THEN
                hold = CGSortLibArr(FlashI)
                NextFlashJ = FlashI
                DO
                    FlashJ = NextFlashJ
                    IF FlashJ < FlashTrackL(SIndex) THEN
                        NextFlashJ = FlashJ + 1
                        IF (CGSortLibArr(NextFlashJ) < hold) THEN
                            SWAP CGSortLibArr(FlashJ), CGSortLibArr(NextFlashJ)
                        ELSE
                            EXIT DO
                        END IF
                    ELSE
                        EXIT DO
                    END IF
                LOOP
                CGSortLibArr(FlashJ) = hold
            END IF
        NEXT
        '* 914k/Ghz when it reaches this point, assuming this array is mostly sorted.
    NEXT
    EXIT SUB
    IF order& = 1 THEN EXIT SUB
    FlashI = start
    FlashJ = finish
    WHILE FlashJ > FlashI
        SWAP CGSortLibArr(FlashI), CGSortLibArr(FlashJ)
        FlashI = FlashI + 1
        FlashJ = FlashJ - 1
    WEND
END SUB

FellippeHeitor

  • Guest
Re: Is anyone here on Quora?
« Reply #1 on: July 05, 2020, 10:19:33 am »
Good to hear we have a representative there, codeguy. I do believe I have an account with them, but barely use it.