Super Code from Digital Knife Monkey Productions

Digital Knife Monkeys at Keyboards...Will Eventually Program Everything.

NSpace @ DKM

 

NOT Commercially useable code. Any use beyond personal is considered unauthorized breach of intellectual property rights of DKM and the originating coder. Permission to use this code for other than personal use will be denied.

NSpace Sub And Demo Code
'*NSpaceRoutine.bas
TYPE RGBRec
    red AS _UNSIGNED _BYTE
    green AS _UNSIGNED _BYTE
    blue AS _UNSIGNED _BYTE
END TYPE

TYPE Coord
    x AS INTEGER
    y AS INTEGER
    z AS INTEGER
END TYPE

TYPE PointRec
    x AS SINGLE
    y AS SINGLE
    z AS SINGLE
    radius AS SINGLE
    colorsRGB AS RGBRec
    inc AS Coord
    precalcRGB AS LONG
    precalcdiameter AS LONG
END TYPE

TYPE Segment
    xseg AS _UNSIGNED _BYTE
    yseg AS _UNSIGNED _BYTE
    zseg AS _UNSIGNED _BYTE
    xsegsize AS _UNSIGNED _BYTE
    ysegsize AS _UNSIGNED _BYTE
    zsegsize AS _UNSIGNED _BYTE
END TYPE

TYPE ScreenRec
    begins AS Coord
    ends AS Coord
END TYPE

xscreen& = _SCREENIMAGE
SCREEN xscreen&
CLS
DIM GScrn AS ScreenRec
GScrn.begins.x = 1
GScrn.begins.y = 1
GScrn.begins.z = 1
GScrn.ends.x = _WIDTH(xscreen&)
GScrn.ends.y = _HEIGHT(xscreen&)
GScrn.ends.z = 1024

DIM a(8191) AS PointRec
DIM SegmentMetrics AS Segment
SegmentMetrics.xseg = 16
SegmentMetrics.xsegsize = (GScrn.ends.x - GScrn.begins.x + 1) / SegmentMetrics.xseg
SegmentMetrics.yseg = 16
SegmentMetrics.ysegsize = (GScrn.ends.y - GScrn.begins.y + 1) / SegmentMetrics.yseg
SegmentMetrics.zseg = 16
SegmentMetrics.zsegsize = (GScrn.ends.z - GScrn.begins.z + 1) / SegmentMetrics.zseg
REDIM NspaceObjects(SegmentMetrics.xseg, SegmentMetrics.yseg, SegmentMetrics.zseg, SizeOf(a()) / 4)
REDIM counts%(SegmentMetrics.xseg, SegmentMetrics.yseg, SegmentMetrics.zseg)
FOR i = LBOUND(a) TO UBOUND(a)
    a(i).radius = (RND * 2) OR 1
    a(i).precalcdiameter = a(i).radius * 2
    a(i).x = a(i).radius + RND * (GScrn.ends.x - a(i).radius)
    a(i).y = a(i).radius + RND * (GScrn.ends.y - a(i).radius)
    a(i).z = a(i).radius + RND * (GScrn.ends.z - a(i).radius)
    a(i).inc.x = (6 * (1 - RND * 2)) OR 1
    a(i).inc.y = (6 * (1 - RND * 2)) OR 1
    a(i).inc.z = (6 * (1 - RND * 2)) OR 1
    a(i).colorsRGB.red = INT(RND * 256)
    a(i).colorsRGB.green = INT(RND * 256)
    a(i).colorsRGB.blue = INT(RND * 256)
    a(i).precalcRGB = _RGB(a(i).colorsRGB.red, a(i).colorsRGB.green, a(i).colorsRGB.blue)
NEXT
frames& = 0
lastframe& = 0
Start! = TIMER(.001)
xstart! = Start!

DIM XLoop AS _UNSIGNED _BYTE
DIM YLoop AS _UNSIGNED _BYTE
DIM ZLoop AS _UNSIGNED _BYTE

DO
    CLS
    FOR i = LBOUND(a) TO UBOUND(a)
        IF a(i).x - a(i).radius + a(i).inc.x < GScrn.begins.x THEN
            a(i).inc.x = -a(i).inc.x
        ELSEIF a(i).x + a(i).radius + a(i).inc.x > GScrn.ends.x THEN
            a(i).inc.x = -a(i).inc.x
        END IF
        a(i).x = a(i).x + a(i).inc.x

        IF a(i).y - a(i).radius + a(i).inc.y < GScrn.begins.y THEN
            a(i).inc.y = -a(i).inc.y
        ELSEIF a(i).y + a(i).radius + a(i).inc.y > GScrn.ends.y THEN
            a(i).inc.y = -a(i).inc.y
        END IF
        a(i).y = a(i).y + a(i).inc.y

        IF a(i).z - a(i).radius + a(i).inc.z < GScrn.begins.z THEN
            a(i).inc.z = -a(i).inc.z
        ELSEIF a(i).z + a(i).radius + a(i).inc.z > GScrn.ends.z THEN
            a(i).inc.z = -a(i).inc.z
        END IF
        a(i).z = a(i).z + a(i).inc.z
        PSET (a(i).x, a(i).y), a(i).precalcRGB
    NEXT

    NSpace a(), GScrn, SegmentMetrics, NspaceObjects(), counts%()
    FOR XLoop = 0 TO SegmentMetrics.xseg
        FOR YLoop = 0 TO SegmentMetrics.yseg
            FOR ZLoop = 0 TO SegmentMetrics.zseg
                FOR d% = 0 TO counts%(XLoop, YLoop, ZLoop) - 2
                    m& = NspaceObjects(XLoop, YLoop, ZLoop, d%)
                    FOR e% = d% + 1 TO counts%(XLoop, YLoop, ZLoop) - 1
                        n& = NspaceObjects(XLoop, YLoop, ZLoop, e%)
                        IF Collision%(a(m&), a(n&)) THEN
                            a(n&).inc.x = -a(m&).inc.x
                            a(n&).inc.y = -a(m&).inc.y
                            a(n&).inc.z = -a(m&).inc.z
                        END IF
                    NEXT
                NEXT
            NEXT
        NEXT
    NEXT

    REDIM counts%(SegmentMetrics.xseg, SegmentMetrics.yseg, SegmentMetrics.zseg)

    IF ABS(TIMER(.001) - Start!) < 2 THEN
        frames& = frames& + 1
    ELSE
        Start! = TIMER(.001)
        PRINT (frames& - lastframe&) / 2
        lastframe& = frames&
    END IF
    _DISPLAY
    d$ = INKEY$
LOOP UNTIL d$ > ""
finish! = TIMER(.001)
CLS
SCREEN 0
PRINT frames& / (finish! - xstart!)

SUB NSpace (a() AS PointRec, Scrn AS ScreenRec, SegmentsXYZ AS Segment, NspaceObjects(), Counts%())
DIM xbox, ybox, zbox AS _UNSIGNED _BYTE
DIM oxseg, oyseg, ozseg AS _UNSIGNED _BYTE
FOR m& = LBOUND(A) TO UBOUND(A)
    oxseg = a(m&).x \ SegmentsXYZ.xsegsize
    oyseg = a(m&).y \ SegmentsXYZ.ysegsize
    ozseg = a(m&).z \ SegmentsXYZ.zsegsize
    IF Counts%(oxseg, oyseg, ozseg) > UBOUND(NspaceObjects, 4) THEN
        REDIM _PRESERVE NspaceObjects(SegmentsXYZ.xseg, SegmentsXYZ.yseg, SegmentsXYZ.zseg, Counts%(oxseg, oyseg, ozseg))
        '* PRINT Counts%(oxseg, oyseg, ozseg)
    END IF
    dx% = Counts%(oxseg, oyseg, ozseg)
    NspaceObjects(oxseg, oyseg, ozseg, dx%) = m&
    Counts%(oxseg, oyseg, ozseg) = dx% + 1
    IF a(m&).radius THEN
        FOR u = -a(m&).radius TO a(m&).radius STEP a(m&).precalcdiameter
            xbox = (a(m&).x + u) \ SegmentsXYZ.xsegsize
            IF xbox >= 0 THEN
                IF xbox <= SegmentsXYZ.xseg THEN
                    ybox = (a(m&).y + u) \ SegmentsXYZ.ysegsize
                    IF ybox >= 0 THEN
                        IF ybox <= SegmentsXYZ.yseg THEN
                            zbox = (a(m&).z + u) \ SegmentsXYZ.zsegsize
                            IF zbox >= 0 THEN
                                IF zbox <= SegmentsXYZ.zseg THEN
                                    IF xbox <> oxseg OR ybox <> oyseg OR zbox <> ozseg THEN
                                        dx% = Counts%(xbox, ybox, zbox)
                                        NspaceObjects(xbox, ybox, zbox, dx%) = m&
                                        Counts%(xbox, ybox, zbox) = dx% + 1
                                    END IF
                                END IF
                            END IF
                        END IF
                    END IF
                END IF
            END IF
        NEXT
    END IF
NEXT
END SUB

FUNCTION SizeOf% (a())
SizeOf% = UBOUND(a) - LBOUND(a) + 1
END FUNCTION

FUNCTION Collision% (a AS PointRec, b AS PointRec)
Collision% = 0
IF ABS(b.x - a.x) > a.radius + b.radius THEN
    EXIT SUB
ELSE
    IF ABS(b.y - a.y) > a.radius + b.radius THEN
        EXIT SUB
    ELSE
        IF ABS(b.z - a.z) > a.radius + b.radius THEN
            EXIT SUB
        ELSE
            Collision% = -1
        END IF
    END IF
END IF
END FUNCTION

This is how NSpace works
it divides a region (2-d) or volume(3-d) into arbitarily determined but equal size rectangular or cubic regions, placing objects according to their (x,y,z) coordinates in their respective regions. it is sort of similar to applying postman's sort to each object and placing it in what i call an informal tree structure, which is actually more like a linked list. it has the ability to determine very efficiently any objects close enough to each other that there may be a possible collision, even in surrounding regions, if necessary. what i have presented in this example is the 3-d version, which can very eaily be adapted to ANY number of dimensions. Performance is also nearly linear, so even at 8192+ objects (pixels in this example), it is still able to run 40+ FPS (1366 * 768 * 32), 8192 objects, CPU@2.1 GHz (normal load).

N       FPS
512      72
1024     71
2048     63
4096     49
8192     40
12288    32 '** around cutoff for acceptable performance in video gaming
16384    24

as we can see from this the performance "curve" is nearly linear, far better than n log n and quadratic, which at 16384 objects would be unusable.But don't push your luck. 65536 items slows this to a crawl too. But then again, why would ya need that many anyway? For those with the ability to do so, this is probably convertible to a parallel algorithm. Can't do that YET in QB64!

Now Presenting the 2-d version of NSpace:
'*NSpace Sub And Demo Code (2-d)
'*NSpaceRoutine2D.bas
TYPE RGBRec
    red AS _UNSIGNED _BYTE
    green AS _UNSIGNED _BYTE
    blue AS _UNSIGNED _BYTE
END TYPE

TYPE Coord
    x AS INTEGER
    y AS INTEGER
END TYPE

TYPE PointRec
    x AS SINGLE
    y AS SINGLE
    radius AS SINGLE
    colorsRGB AS RGBRec
    inc AS Coord
    precalcRGB AS LONG
    precalcdiameter AS LONG
END TYPE

TYPE Segment
    xseg AS _UNSIGNED _BYTE
    yseg AS _UNSIGNED _BYTE
    xsegsize AS _UNSIGNED _BYTE
    ysegsize AS _UNSIGNED _BYTE
END TYPE

TYPE ScreenRec
    begins AS Coord
    ends AS Coord
END TYPE

xscreen& = _SCREENIMAGE
SCREEN xscreen&
CLS
DIM GScrn AS ScreenRec
GScrn.begins.x = 1
GScrn.begins.y = 1
GScrn.ends.x = _WIDTH(xscreen&)
GScrn.ends.y = _HEIGHT(xscreen&)
DIM a(8191) AS PointRec
DIM SegmentMetrics AS Segment
SegmentMetrics.xseg = 16
SegmentMetrics.xsegsize = (GScrn.ends.x - GScrn.begins.x + 1) / SegmentMetrics.xseg
SegmentMetrics.yseg = 16
SegmentMetrics.ysegsize = (GScrn.ends.y - GScrn.begins.y + 1) / SegmentMetrics.yseg
REDIM NspaceObjects(SegmentMetrics.xseg, SegmentMetrics.yseg, SizeOf(a()) / 4)
REDIM counts%(SegmentMetrics.xseg, SegmentMetrics.yseg)
FOR i = LBOUND(a) TO UBOUND(a)
    a(i).radius = (RND * 2) OR 1
    a(i).precalcdiameter = a(i).radius * 2
    a(i).x = a(i).radius + RND * (GScrn.ends.x - a(i).radius)
    a(i).y = a(i).radius + RND * (GScrn.ends.y - a(i).radius)
    a(i).inc.x = (6 * (1 - RND * 2)) OR 1
    a(i).inc.y = (6 * (1 - RND * 2)) OR 1
    a(i).colorsRGB.red = INT(RND * 256)
    a(i).colorsRGB.green = INT(RND * 256)
    a(i).colorsRGB.blue = INT(RND * 256)
    a(i).precalcRGB = _RGB(a(i).colorsRGB.red, a(i).colorsRGB.green, a(i).colorsRGB.blue)
NEXT
frames& = 0
lastframe& = 0
Start! = TIMER(.001)
xstart! = Start!

DIM XLoop AS _UNSIGNED _BYTE
DIM YLoop AS _UNSIGNED _BYTE

DO
    CLS
    FOR i = LBOUND(a) TO UBOUND(a)
        IF a(i).x - a(i).radius + a(i).inc.x < GScrn.begins.x THEN
            a(i).inc.x = -a(i).inc.x
        ELSEIF a(i).x + a(i).radius + a(i).inc.x > GScrn.ends.x THEN
            a(i).inc.x = -a(i).inc.x
        END IF
        a(i).x = a(i).x + a(i).inc.x

        IF a(i).y - a(i).radius + a(i).inc.y < GScrn.begins.y THEN
            a(i).inc.y = -a(i).inc.y
        ELSEIF a(i).y + a(i).radius + a(i).inc.y > GScrn.ends.y THEN
            a(i).inc.y = -a(i).inc.y
        END IF
        a(i).y = a(i).y + a(i).inc.y

        PSET (a(i).x, a(i).y), a(i).precalcRGB
    NEXT

    NSpace a(), GScrn, SegmentMetrics, NspaceObjects(), counts%()
    FOR XLoop = 0 TO SegmentMetrics.xseg
        FOR YLoop = 0 TO SegmentMetrics.yseg
            FOR d% = 0 TO counts%(XLoop, YLoop) - 2
                m& = NspaceObjects(XLoop, YLoop, d%)
                FOR e% = d% + 1 TO counts%(XLoop, YLoop) - 1
                    n& = NspaceObjects(XLoop, YLoop, e%)
                    IF Collision%(a(m&), a(n&)) THEN
                        a(n&).inc.x = -a(m&).inc.x
                        a(n&).inc.y = -a(m&).inc.y
                    END IF
                NEXT
            NEXT
        NEXT
    NEXT

    REDIM counts%(SegmentMetrics.xseg, SegmentMetrics.yseg)

    IF ABS(TIMER(.001) - Start!) < 2 THEN
        frames& = frames& + 1
    ELSE
        Start! = TIMER(.001)
        PRINT (frames& - lastframe&) / 2
        lastframe& = frames&
    END IF
    _DISPLAY
    d$ = INKEY$
LOOP UNTIL d$ > ""
finish! = TIMER(.001)
CLS
SCREEN 0
PRINT frames& / (finish! - xstart!)

SUB NSpace (a() AS PointRec, Scrn AS ScreenRec, SegmentsXYZ AS Segment, NspaceObjects(), Counts%())
DIM xbox, ybox AS _UNSIGNED _BYTE
DIM oxseg, oyseg AS _UNSIGNED _BYTE
FOR m& = LBOUND(A) TO UBOUND(A)
    oxseg = a(m&).x \ SegmentsXYZ.xsegsize
    oyseg = a(m&).y \ SegmentsXYZ.ysegsize
    IF Counts%(oxseg, oyseg) > UBOUND(NspaceObjects, 3) THEN
        REDIM _PRESERVE NspaceObjects(SegmentsXYZ.xseg, SegmentsXYZ.yseg, Counts%(oxseg, oyseg))
        '* PRINT Counts%(oxseg, oyseg)
    END IF
    dx% = Counts%(oxseg, oyseg)
    NspaceObjects(oxseg, oyseg, dx%) = m&
    Counts%(oxseg, oyseg) = dx% + 1
    IF a(m&).radius THEN
        FOR u = -a(m&).radius TO a(m&).radius STEP a(m&).precalcdiameter
            xbox = (a(m&).x + u) \ SegmentsXYZ.xsegsize
            IF xbox >= 0 THEN
                IF xbox <= SegmentsXYZ.xseg THEN
                    ybox = (a(m&).y + u) \ SegmentsXYZ.ysegsize
                    IF ybox >= 0 THEN
                        IF ybox <= SegmentsXYZ.yseg THEN
                            IF xbox <> oxseg OR ybox <> oyseg THEN
                                dx% = Counts%(xbox, ybox)
                                NspaceObjects(xbox, ybox, dx%) = m&
                                Counts%(xbox, ybox) = dx% + 1
                            END IF
                        END IF
                    END IF
                END IF
            END IF
        NEXT
    END IF
NEXT
END SUB

FUNCTION SizeOf% (a())
SizeOf% = UBOUND(a) - LBOUND(a) + 1
END FUNCTION

FUNCTION Collision% (a AS PointRec, b AS PointRec)
IF ABS(b.x - a.x) > a.radius + b.radius THEN
    Collision% = 0
ELSE
    IF ABS(b.y - a.y) > a.radius + b.radius THEN
        Collision% = 0
    ELSE
        Collision% = -1
    END IF
END IF
END FUNCTION

As you can see, this is not much different from the 3d version, except that all references and variables used for z-plane have been eliminated! ENJOY!

Sorting and Searching Algorithms
Sorting and searching are often-used procedures in programming and this section is to provide a concise collection of efficient sorting algorithms. Things to consider when using sorting algorithms are:

stable, meaning equal keys do not change relative order.
logarithmic running time
, duration increases reasonably with array size increases
reasonably easy to code (ya got it here!)
not specialized
handles only limited data types

I will generally include sorts that have at least 2 of these qualities.

One of the first sorts i'd like to present is Bitonic Sort, an algorithm for parallel processing that is surprisingly efficient for single processors also. It only sounds complex, but I have been very careful to code it in a way that will be easy to adapt for any variable type.

REDIM inta(127)
ASCENDING = -1
FOR i = LBOUND(inta) TO UBOUND(inta)
    inta(i) = RND * 4095
NEXT
bitonicSort inta(), LBOUND(inta), UBOUND(inta), ASCENDING
FOR i = LBOUND(inta) TO UBOUND(inta)
    PRINT inta(i)
NEXT

SUB bitonicSort (a(), lo, n, dir)

IF (n > 1) THEN
    m = n \ 2
    bitonicSort a(), lo, m, NOT dir
    bitonicSort a(), lo + m, n - m, dir
    bitonicMerge a(), lo, n, dir
END IF
END SUB

SUB bitonicMerge (a(), lo, n, dir)

IF (n > 1) THEN
    m = greatestPowerOfTwoLessThan(n)
    FOR i = lo TO lo + n - m
        compare a(), i, i + m, dir
    NEXT
    bitonicMerge a(), lo, m, dir
    bitonicMerge a(), lo + m, n - m, dir
END IF
END SUB

SUB compare (a(), i, j, dir)

IF (dir = (a(i) > a(j))) THEN
    exchange a(), i, j
END IF
END SUB

SUB exchange (a(), i, j)

t = a(i)
a(i) = a(j)
a(j) = t
END SUB

FUNCTION greatestPowerOfTwoLessThan (n)

k = 1
WHILE (k < n)
    k = k * 2
WEND
greatestPowerOfTwoLessThan = k / 2
END FUNCTION
'* code written and tested by codeguy.
'* MergeSort sorts sublists and then merges them. this is an example of
'* head recursion, where all recursive calls are placed before execution
'* of code following. quicksort uses tail recursion. this is a stable
'* logarithmic sort.
'* test code
REDIM Test(0 TO 255)
FOR x& = LBOUND(test) TO UBOUND(test)
    Test(x&) = RND * 32767
NEXT
MergeSort Test(), LBOUND(Test), UBOUND(Test)
M& = LBOUND(test)
FOR x& = LBOUND(test) TO UBOUND(test)
    IF Test(x&) < Test(M&) THEN
        PRINT "*sequence error*:"
        EXIT FOR
    ELSE
        M& = x&
        PRINT Test(x&),
    END IF
NEXT
ERASE Test
SYSTEM

'* The actual MergeSort algorithm
SUB MergeSort (array(), start&, finish&)
IF start& < finish& THEN '* no need to do this for 0-sized sublists
    length& = finish& - start& + 1
    middle& = start& + (finish& - start&) \ 2
    MergeSort array(), start&, middle&
    MergeSort array(), middle& + 1, finish&
    REDIM temp(0 TO length& - 1)
    FOR i& = 0 TO length& - 1
        temp(i&) = array(start& + i&)
    NEXT
    mptr& = 0
    sptr& = middle& - start& + 1
    FOR i& = 0 TO length& - 1
        IF sptr& > finish& - start& THEN
            array(i& + start&) = temp(mptr&)
            mptr& = mptr& + 1
        ELSE
            IF mptr& > middle& - start& THEN
                array(i& + start&) = temp(sptr&)
                sptr& = sptr& + 1
            ELSE
                IF temp(mptr&) > temp(sptr&) THEN
                    array(i& + start&) = temp(sptr&)
                    sptr& = sptr& + 1
                ELSE
                    array(i& + start&) = temp(mptr&)
                    mptr& = mptr& + 1
                END IF
            END IF
        END IF
    NEXT
    ERASE temp
END IF
END SUB