Another small filled circe sub (not as fast as fcirc)

[bplus]

I ask again:
@Pete what do you have against While... Wend same difference to me?

Why do you think Do Until is better than While?

Anyway I am testing the one against the other in 1,000,000 drawings

[a740g]

This is a fun thread!

@bplus thank you for the test program. I made some changes to your code and the fill routines to ensure they are evenly matched.

On my system, Vince's circle-fill routines almost always beat everything when the IDE C++ optimizations are enabled.

To be fair, the final numbers are extremely close.

Code: (Select All)

_DEFINE A-Z ASLONG

OPTION _EXPLICIT



CONST CCOLOR~& = _RGBA32(0, 100, 0, 100)



_TITLE "Circle Fill speed tests"



SCREEN _NEWIMAGE(1830, 680, 32)



' Dry run

SLEEP 1

_PRINTSTRING (0, 0), "Dry run..."

Run_Test 10000



' Showdown

SLEEP 5

CLS

_PRINTSTRING (0, 0), "Showdown..."

Run_Test 200000



END



SUB Run_Test (iterations AS LONG)

    STATIC AS DOUBLE start, finish

    STATIC i AS LONG



    _DISPLAY



    start = TIMER(0.001!)

    FOR i = 1 TO iterations

        FC_Dav 305, 305, 300, CCOLOR

    NEXT

    finish = TIMER(0.001!) - start

    _AUTODISPLAY

    _PRINTSTRING (100, 615), "Time for" + STR$(iterations) + " Contender Fills (Dav):" + STR$(finish)



    _DISPLAY

    start = TIMER

    FOR i = 1 TO iterations

        FC_Vince 915, 305, 300, CCOLOR

    NEXT

    finish = TIMER(0.001!) - start

    _AUTODISPLAY

    _PRINTSTRING (700, 615), "Time for" + STR$(iterations) + " Contender Fills (Vince):" + STR$(finish)



    _DISPLAY

    start = TIMER

    FOR i = 1 TO iterations

        FC_Gold 1525, 305, 300, CCOLOR

    NEXT

    finish = TIMER(0.001!) - start

    _AUTODISPLAY

    _PRINTSTRING (1300, 615), "Time for" + STR$(iterations) + " Gold Standard Circle Fills:" + STR$(finish)

END SUB



SUB FC_Gold (cx AS LONG, cy AS LONG, r AS LONG, c AS _UNSIGNED LONG)

    $CHECKING:OFF



    DIM radius AS LONG: radius = ABS(r)

    DIM radiusError AS LONG: radiusError = -radius

    DIM x AS LONG: x = radius

    DIM y AS LONG



    IF radius = 0 THEN

        PSET (cx, cy), c

        EXIT SUB

    END IF



    LINE (cx - x, cy)-(cx + x, cy), c, BF



    DO WHILE x > y

        radiusError = radiusError + _SHL(y, 1) + 1



        IF radiusError >= 0 THEN

            IF x <> y + 1 THEN

                LINE (cx - y, cy - x)-(cx + y, cy - x), c, BF

                LINE (cx - y, cy + x)-(cx + y, cy + x), c, BF

            END IF



            x = x - 1



            radiusError = radiusError - _SHL(x, 1)

        END IF



        y = y + 1



        LINE (cx - x, cy - y)-(cx + x, cy - y), c, BF

        LINE (cx - x, cy + y)-(cx + x, cy + y), c, BF

    LOOP



    $CHECKING:ON

END SUB



SUB FC_Dav (cx AS LONG, cy AS LONG, r AS LONG, c AS _UNSIGNED LONG)

    $CHECKING:OFF



    DIM r2 AS LONG: r2 = r * r

    DIM AS LONG x, y



    LINE (cx - r, cy)-(cx + r, cy), c, BF



    DO WHILE y < r

        y = y + 1



        x = SQR(r2 - y * y)



        LINE (cx - x, cy + y)-(cx + x, cy + y), c, BF

        LINE (cx - x, cy - y)-(cx + x, cy - y), c, BF

    LOOP



    $CHECKING:ON

END SUB



SUB FC_Vince (cx AS LONG, cy AS LONG, r AS LONG, c AS _UNSIGNED LONG)

    $CHECKING:OFF



    DIM e AS LONG: e = -r

    DIM x AS LONG: x = r

    DIM y AS LONG



    DO WHILE y < x

        IF e <= 0 THEN

            y = y + 1



            LINE (cx - x, cy + y)-(cx + x, cy + y), c, BF

            LINE (cx - x, cy - y)-(cx + x, cy - y), c, BF



            e = e + _SHL(y, 1)

        ELSE

            LINE (cx - y, cy - x)-(cx + y, cy - x), c, BF

            LINE (cx - y, cy + x)-(cx + y, cy + x), c, BF



            x = x - 1



            e = e - _SHL(x, 1)

        END IF

    LOOP



    LINE (cx - r, cy)-(cx + r, cy), c, BF



    $CHECKING:ON

END SUB

[bplus]

here's where it gets "fun"

I changed the order of tests and did them on fullscreen because no way I have a screen as wide as you used!
Gold run first, Dav 2nd and finish with Vince = completely different race

Code: (Select All)

_Define A-Z As LONG
Option _Explicit

Const CCOLOR~& = _RGBA32(0, 100, 0, 100)

_Title "Sam Circle Fill speed tests"

Screen _NewImage(1830, 680, 32)
_FullScreen
' Dry run
Sleep 1
_PrintString (0, 0), "Dry run..."
Run_Test 10000

' Showdown
Sleep 5
Cls
_PrintString (0, 0), "Showdown..."
Run_Test 200000

End

Sub Run_Test (iterations As Long)
    Static As Double start, finish
    Static i As Long

    _Display
    start = Timer
    For i = 1 To iterations
        FC_Gold 1525, 305, 300, CCOLOR
    Next
    finish = Timer(0.001!) - start
    _AutoDisplay
    _PrintString (1300, 615), "Time for" + Str$(iterations) + " Gold Standard Circle Fills:" + Str$(finish)

    _Display

    start = Timer(0.001!)
    For i = 1 To iterations
        FC_Dav 305, 305, 300, CCOLOR
    Next
    finish = Timer(0.001!) - start
    _AutoDisplay
    _PrintString (100, 615), "Time for" + Str$(iterations) + " Contender Fills (Dav):" + Str$(finish)

    _Display
    start = Timer
    For i = 1 To iterations
        FC_Vince 915, 305, 300, CCOLOR
    Next
    finish = Timer(0.001!) - start
    _AutoDisplay
    _PrintString (700, 615), "Time for" + Str$(iterations) + " Contender Fills (Vince):" + Str$(finish)

    '_DISPLAY
    'start = TIMER
    'FOR i = 1 TO iterations
    '    FC_Gold 1525, 305, 300, CCOLOR
    'NEXT
    'finish = TIMER(0.001!) - start
    '_AUTODISPLAY
    '_PRINTSTRING (1300, 615), "Time for" + STR$(iterations) + " Gold Standard Circle Fills:" + STR$(finish)
End Sub

Sub FC_Gold (cx As Long, cy As Long, r As Long, c As _Unsigned Long)
    $Checking:Off

    Dim radius As Long: radius = Abs(r)
    Dim radiusError As Long: radiusError = -radius
    Dim x As Long: x = radius
    Dim y As Long

    If radius = 0 Then
        PSet (cx, cy), c
        Exit Sub
    End If

    Line (cx - x, cy)-(cx + x, cy), c, BF

    Do While x > y
        radiusError = radiusError + _ShL(y, 1) + 1

        If radiusError >= 0 Then
            If x <> y + 1 Then
                Line (cx - y, cy - x)-(cx + y, cy - x), c, BF
                Line (cx - y, cy + x)-(cx + y, cy + x), c, BF
            End If

            x = x - 1

            radiusError = radiusError - _ShL(x, 1)
        End If

        y = y + 1

        Line (cx - x, cy - y)-(cx + x, cy - y), c, BF
        Line (cx - x, cy + y)-(cx + x, cy + y), c, BF
    Loop

    $Checking:On
End Sub

Sub FC_Dav (cx As Long, cy As Long, r As Long, c As _Unsigned Long)
    $Checking:Off

    Dim r2 As Long: r2 = r * r
    Dim As Long x, y

    Line (cx - r, cy)-(cx + r, cy), c, BF

    Do While y < r
        y = y + 1

        x = Sqr(r2 - y * y)

        Line (cx - x, cy + y)-(cx + x, cy + y), c, BF
        Line (cx - x, cy - y)-(cx + x, cy - y), c, BF
    Loop

    $Checking:On
End Sub

Sub FC_Vince (cx As Long, cy As Long, r As Long, c As _Unsigned Long)
    $Checking:Off

    Dim e As Long: e = -r
    Dim x As Long: x = r
    Dim y As Long

    Do While y < x
        If e <= 0 Then
            y = y + 1

            Line (cx - x, cy + y)-(cx + x, cy + y), c, BF
            Line (cx - x, cy - y)-(cx + x, cy - y), c, BF

            e = e + _ShL(y, 1)
        Else
            Line (cx - y, cy - x)-(cx + y, cy - x), c, BF
            Line (cx - y, cy + x)-(cx + y, cy + x), c, BF

            x = x - 1

            e = e - _ShL(x, 1)
        End If
    Loop

    Line (cx - r, cy)-(cx + r, cy), c, BF

    $Checking:On
End Sub

Here are results:
   

A 2nd run and Gold Standard proves itself
   

[SierraKen]

If you guys want super simple, I still like my old way....

Code: (Select All)

Screen _NewImage(800, 600, 32)



diameter = 200



Circle (400, 300), diameter, _RGB32(0, 255, 0)



Locate 1, 1: Input "Press Enter To Fill Circle", a$





For sz = .1 To diameter Step .1

    Circle (400, 300), sz, _RGB32(255, 0, 0)

Next sz

[bplus]

Thats really slow and doesn't work for transparent colors

Code: (Select All)

Screen _NewImage(800, 600, 32)

diameter = 200

Circle (400, 300), diameter, _RGB32(0, 255, 0)

Locate 1, 1: Input "Press Enter To Fill Circle", a$


For sz = .1 To diameter Step .1
    Circle (400, 300), sz, _RGB32(255, 0, 0, 10)
Next sz

This old way is slow and leaves border and does not work with transparent borders

Code: (Select All)

Screen _NewImage(800, 600, 32)

diameter = 200

Circle (400, 300), diameter, _RGB32(0, 255, 0)

Locate 1, 1: Input "Press Enter To Fill Circle", a$

Paint (400, 300), _RGB32(0, 0, 255, 40), _RGB32(0, 255, 0)

[OldMoses]

I tried doing this with Steve's earlier suggestion:

1) draw a center square of maximum size inside the circle first.  Fill it with a single LINE,,,,BF statement.
2) then calculate from the outer axis points inwards until we fill up to that same point that the square has already covered.   This should prevent overlap or any such thing and might speed up the whole process overall.

It gave an interference pattern like a circumscribed square at certain radii. Always a one pixel gap. I thought to increase the size of the central square by one pixel, but it left little points at the quadrant diagonals so that center is already maximized. No point in doing any benchmarking yet. Oh well, back to the drawing board...

Code: (Select All)

$COLOR:32
SCREEN _NEWIMAGE(1024, 512, 32)
CLS
FOR x% = 0 TO 49
    FcircBlk (x% MOD 10) * 100 + 50, (x% \ 10) * 100 + 50, x% + 10, Green
    'FCirc (x% MOD 10) * 100 + 50, (x% \ 10) * 100 + 50, x% + 10, Green
NEXT x%

SUB FcircBlk (CX AS LONG, CY AS LONG, RR AS LONG, C AS _UNSIGNED LONG)
    DIM AS LONG R, RError, X, Y, D
    R = ABS(RR) '                                               radius value along positive x
    RError = -R '                                               opposite side of circle? negative x
    X = R '                                                     point along positive x position
    Y = 0 '                                                     starting at the equator
    D = R * .7071
    IF R = 0 THEN PSET (CX, CY), C: EXIT SUB '                  zero radius is point, not circle
    LINE (CX - D, CY - D)-(CX + D, CY + D), C, BF
    WHILE X > Y
        RError = RError + Y * 2 + 1
        IF RError >= 0 THEN
            IF X <> Y + 1 THEN
                LINE (CX - Y, CY - X)-(CX + Y, CY - X), C, BF ' south
                LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF ' north
                LINE (CX - X, CY - Y)-(CX - X, CY + Y), C, BF ' west
                LINE (CX + X, CY - Y)-(CX + X, CY + Y), C, BF ' east
            END IF
            X = X - 1
            RError = RError - X * 2
        END IF
        Y = Y + 1
    WEND
    _PRINTMODE _KEEPBACKGROUND
    _PRINTSTRING (CX, CY), STR$(RR)
END SUB 'FcircBlk


SUB FCirc (CX AS LONG, CY AS LONG, RR AS LONG, C AS _UNSIGNED LONG) 'Steve's circle fill unmodified
    DIM AS LONG R, RError, X, Y
    R = ABS(RR) '                                               radius value along positive x
    RError = -R '                                               opposite side of circle? negative x
    X = R '                                                     point along positive x position
    Y = 0 '                                                     starting at the equator
    IF R = 0 THEN PSET (CX, CY), C: EXIT SUB '                  zero radius is point, not circle
    LINE (CX - X, CY)-(CX + X, CY), C, BF '                     draw equatorial line
    WHILE X > Y
        RError = RError + Y * 2 + 1 '
        IF RError >= 0 THEN
            IF X <> Y + 1 THEN
                LINE (CX - Y, CY - X)-(CX + Y, CY - X), C, BF ' draw lines for south polar latitudes
                LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF ' draw lines for north polar latitudes
            END IF
            X = X - 1
            RError = RError - X * 2
        END IF
        Y = Y + 1
        LINE (CX - X, CY - Y)-(CX + X, CY - Y), C, BF '         draw lines north equatorial latitudes
        LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF '         draw lines south equatorial latitudes
    WEND
    _PRINTMODE _KEEPBACKGROUND
    _PRINTSTRING (CX, CY), STR$(RR)
END SUB 'FCirc

[bplus]

That reminds me of fcirc4 in the Speed Tests we did years ago that I posted above where Sammy found Vince's contender.

Here it is isolated in slow mo

Code: (Select All)

_Title "Square filled center Circle Fill technique" ' b+ mod 2024-08-31
Screen _NewImage(800, 600, 32)
fCirc4 400, 300, 290, _RGB32(0, 0, 255, 100) ' <<<<<<<< using transparent color to check for overlapping lines
Sleep

'fCirc but doing octants until get to square, then just do square fill! 1.18 Gold Sdt
'this is closer to matching the Gold Standard
Sub fCirc4 (xx As Long, yy As Long, r As Long, K As _Unsigned Long)
    Dim r2 As Long, t As Long, dist As Long, tstop As Long
    r2 = r * r
    t = r 'r - 1 gets rid of nipples but...
    tstop = r * .707106781
    While t > tstop 'remove FOR loop
        dist = Sqr(r2 - t * t) ' + .5 for rounding down
        Line (xx - t, yy + dist)-(xx - t, yy - dist), K, BF
        Line (xx + t, yy + dist)-(xx + t, yy - dist), K, BF
        Line (xx + dist, yy + t)-(xx - dist, yy + t), K, BF
        Line (xx + dist, yy - t)-(xx - dist, yy - t), K, BF
        t = t - 1
        _Limit 30 ' to show off construction
    Wend
    Line (xx - tstop, yy - tstop)-(xx + tstop, yy + tstop), K, BF
End Sub

You can see there are no missing pieces with your test of different radii, you can also see what happens with overlapping lines from overlapping circles

Code: (Select All)

_Title "Square filled center Circle Fill technique" ' b+ mod 2024-089-31
Screen _NewImage(1024, 512, 32)
Cls
For x% = 0 To 49
    fCirc4 (x% Mod 10) * 100 + 50, (x% \ 10) * 100 + 50, x% + 10, _RGB32(0, 128, 0, 100)
Next x%

'fCirc but doing octants until get to square, then just do square fill! 1.18 Gold Sdt
'this is closer to matching the Gold Standard
Sub fCirc4 (xx As Long, yy As Long, r As Long, K As _Unsigned Long)
    Dim r2 As Long, t As Long, dist As Long, tstop As Long
    r2 = r * r
    t = r 'r - 1 gets rid of nipples but...
    tstop = r * .707106781
    While t > tstop 'remove FOR loop
        dist = Sqr(r2 - t * t) ' + .5 for rounding down
        Line (xx - t, yy + dist)-(xx - t, yy - dist), K, BF
        Line (xx + t, yy + dist)-(xx + t, yy - dist), K, BF
        Line (xx + dist, yy + t)-(xx - dist, yy + t), K, BF
        Line (xx + dist, yy - t)-(xx - dist, yy - t), K, BF
        t = t - 1
        _Limit 30 ' to show off construction
    Wend
    Line (xx - tstop, yy - tstop)-(xx + tstop, yy + tstop), K, BF
End Sub

In timed tests it did come close to Gold Standard

[Dav]

Lol, I never dream this thread would become so active.

A little tweaking test.  I thought removing the y = y + 1 in the WHILE/WEND in FC3 like below would speed it up a tad, but it didn't seem to.  In fact, this FOR/NEXT version usually comes in trailing behind the others on my laptop, but still fast.

- Dav

Code: (Select All)

Sub FCtweak (cx, cy, r, clr~&)

    r2 = r * r

    For y = 0 To r

        x = Sqr(r2 - y * y)

        Line (cx - x, cy + y)-(cx + x, cy + y), clr~&, BF

        If y <> 0 Then Line (cx - x, cy - y)-(cx + x, cy - y), clr~&, BF

    Next

    Line (cx - r, cy)-(cx + r, cy), clr~&, BF

End Sub

[bplus]

Lol, I never dream this thread would become so active.

A little tweaking test.  I thought removing the y = y + 1 in the WHILE/WEND in FC3 like below would speed it up a tad, but it didn't seem to.  In fact, this FOR/NEXT version usually comes in trailing behind the others on my laptop, but still fast.

- Dav

Code: (Select All)

Sub FCtweak (cx, cy, r, clr~&)

    r2 = r * r

    For y = 0 To r

        x = Sqr(r2 - y * y)

        Line (cx - x, cy + y)-(cx + x, cy + y), clr~&, BF

        If y <> 0 Then Line (cx - x, cy - y)-(cx + x, cy - y), clr~&, BF

    Next

    Line (cx - r, cy)-(cx + r, cy), clr~&, BF

End Sub

2 Things about the above:

1) a For Loop is the slowest loop structure in QB64 so use Do While, Do Until, While... or even a Goto before you use a For Loop
The jury is out whether While is slower than Do Until or Do While, anyone have proof?

2) Never put a decision in a Loop, if you don't have to, y = y+1 is much cheaper speed wise!
If y <> 0 Then ' <<< will slow down the code like crazy!!!

Comment Samuel has an updated version of FC3 that might be faster than mine?
I like how he got rid of the y = 1 statement with the Do Until
which might have been the Point Pete was trying to make with his insistence on Do While or Do Until

Samuel version of FC3 he called it FC_Dav but I was the one who made it two line statements per loop modding Dav's one line statement per loop. Lets' call it FC3 because after my mod Dav came back with y2 and now Samuel got rid of Y = 1 statement same as Dav's latest.

Code: (Select All)

Sub FC3 (cx As Long, cy As Long, r As Long, c As _Unsigned Long)
    $Checking:Off

    Dim r2 As Long: r2 = r * r
    Dim As Long x, y

    Line (cx - r, cy)-(cx + r, cy), c, BF

    Do While y < r
        y = y + 1

        x = Sqr(r2 - y * y)

        Line (cx - x, cy + y)-(cx + x, cy + y), c, BF
        Line (cx - x, cy - y)-(cx + x, cy - y), c, BF
    Loop

    $Checking:On
End Sub

Samuel put back the variable Declares all Long except Color and I am not convinced thats faster than all Single type which I found to be faster when I started playing around with Davs single Line statement per loop but he made everything Long by default. So going back to Single Type default mixes math and slows down results.

You need Long Type for R2 so make x, y Long too so you don't slow things by mixing math Types. This makes an FC3 sub more acceptable to Option Explicit specially if your overall default is Long and not Single as Samuel setup in his test code.

[Dav]

Yeah, actually yours is so different than my original that I don’t think my name should be on it anyway.  I’m just happy that something good came out it all. 

EDIT: all of this really has made me rethink about optimizing my code. I use to think the smaller the code the better, but this is not always the case. 

- Dav