Author Topic: Mandelbrot (Read 5963 times)

Mike Lobanovsky · « **Reply #15 on:** October 16, 2015, 12:18:16 PM »

Hello John,

Here's its FBSL equivalent with interpreted loops and JIT compiled iteration kernel, performing on my PC at ~60% of your sample speed for 512 iterations in a 640x480 window, persistent and resizable. (N.B. no DIB sections this time, Peter)

Code: OxygenBasic

Dim MaxIter = 512
Dim width = 640
Dim height = 480
Dim colors[MaxIter]
 
FillColorTable()
 
Dim hDC = GetDC(ME), hMemDC = CreateCompatibleDC(NULL)
Dim hBmp = CreateCompatibleBitmap(hDC, width, height)
Dim hOldBmp = SelectObject(hMemDC, hBmp): SetStretchBltMode(hDC, 4) ' HALFTONE
Dim t = GetTickCount()
 
GenMandelbrot(-3, -2, 2.5, 2)
 
FbslSetText(ME, "-= JRS Compatible Mandel =-  TIME: " & (GetTickCount() - t) / 1000 & " SECONDS")
Resize(ME, 0, 0, width, height)
Center(ME)
Show(ME)
 
Begin Events
  Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
  End Type
  
  Static rc As RECT
  
  If CBMSG = &H111 AndAlso CBWPARAM = 2 Then ' WM_COMMAND && Esc
    PostMessage(ME, &H10, 0, 0) ' WM_CLOSE
  ElseIf CBMSG = &HF OrElse CBMSG = &H5 Then ' WM_PAINT || WM_SIZE
    GetClientRect(ME, @rc)
    ValidateRect(ME, NULL)
    StretchBlt(hDC, 0, 0, rc.Right, rc.Bottom, hMemDC, 0, 0, width, height, &HCC0020) ' SRCCOPY
    Return 0
  ElseIf CBMSG = &H10 Then ' WM_CLOSE
    DeleteObject(SelectObject(hMemDC, hOldBmp))
    DeleteDC(hMemDC)
    ReleaseDC(ME, hDC)
  End If
End Events
 
Sub GenMandelbrot(xMn, yMn, xMx, yMx)
  Dim iX, iY, cx, cy, dx, dy
  
  dx = (xMx - xMn) / (width - 1)
  dy = (yMx - yMn) / (height - 1)
  
  For iY = 0 To height
    cy = yMn + iY * dy
    For iX = 0 To width
      cx = xMn + iX * dx
      If Iterate(MaxIter, cx, cy) <> MaxIter Then SetPixel(hMemDC, iX, iY, colors[Iterate])
    Next
  Next
End Sub
 
DynC Iterate(%mi, !!cx, !!cy) As Long
  long main(long MaxIter, double cx, double cy)
  {
    int iters = 0;
    double X = cx, Y = cy, X2 = X * X, Y2 = Y * Y, temp;
    
    while ((iters < MaxIter) && (X2 + Y2 < 4)) {
      temp = cx + X2 - Y2;
      Y = cy + 2 * X * Y;
      Y2 = Y * Y;
      X = temp;
      X2 = X * X;
      iters++;
    }
    return iters;
  }
End DynC
 
Sub FillColorTable()
  Dim r, g, b
  Dim rd, gd, bd
  Dim rr, gg, bb
  Dim i, j, wid
  
  Dim clr[3]
  clr[1] = RGB(0, 255, 0)
  clr[2] = RGB(255, 255, 0)
  clr[3] = RGB(255, 0, 0)
  
  wid = MaxIter / 64
  
  For j = 0 To 2
    toRGB(clr[j], r, g, b)
    toRGB(clr[j + 1], rr, gg, bb)
    rd = (rr - r) / (wid + 1)
    gd = (gg - g) / (wid + 1)
    bd = (bb - b) / (wid + 1)
    For i = 0 To wid
      colors[j * wid + i] = RGB(r, g, b)
      r = r + rd
      g = g + gd
      b = b + bd
    Next
  Next
End Sub
 
Sub toRGB(c, r, g, b)
  r = c BAnd &HFF
  g = (c BAnd &HFF00) / &H100
  b = (c BAnd &HFF0000) / &H10000
End Sub

[attachment deleted by admin]

Aurel · « **Reply #16 on:** October 16, 2015, 12:58:23 PM »

Quote

How long does Peter's latest big_julia take on your PC?

Mike
It takes 3.043 seconds ...is that Ok to?

/
well really why John remove post ?
I don't get it

in fact maybe i can built-in into ruben such a mandelbrot function
and lock buffer to speed up slow interpreter (ruben)

/

Peter · « **Reply #17 on:** October 16, 2015, 01:53:36 PM »

Hi,
another mandelbrot.

Code: [Select]

include "asm.inc"
window 600,500,1

sys ma=16
single xs=-2.5,ys=-2,zml=1.25

Function cfunc(sys p,w) as sys
  pP=(p*1792)/w
  sys red,green,blue
  if pP <256
     red=0
     green=0
     blue=pP
  else if pP <512
     red=0
     green=pP-256
     blue=255
  else if pP <768
     red=0
     green=255
     blue =255-(pP-512)
  else if pP <1024 
     red= pP-768
     green=255
     blue=0
  else if pP <1280
     red=255
     green=255-(pP-1024)
     blue=0
  else if pP <1536
     red=255
     green=0
     blue=pP-1280
  else
     red=255
     green=pP-1536
     blue=255
  end if    
  Return RGB(red,green+4,blue)
End Function

Sub funcpix(sys ix,iy, single x,y,zm) 
    single xC=(xs)+(single(ix)+.5)/100/zm)
    single yC=(ys)+(single(iy)-.5)/100/zm)
    single x0=(xs)+(single(ix)+.5)/100/zm)
    single y0=(ys)+(single(iy)-.5)/100/zm)
    single x2=xc*xc
    single y2=yc*yc
    sys it
    while (x2+y2) < (2*2) and it < ma  
    yc = 2*xc*yc + y0
    xc = x2 - y2 + x0
    x2 = xc*xc
    y2 = yc*yc
    it +=1
    wend
    if it=ma 
       PutPixel ix,iy,rgb(41,60,194) 
    else
       PutPixel ix,iy,cfunc(it,ma) 
    end if
End Sub    

t = ticks
For i=0 to 600
   For j=0 to 500
     funcpix(i,j,xs,ys,zml)
   Next
 Next
 color 255,255,255
 text 0,0,12,"TIME: " + (ticks()-t)/1000 + " SECONDS" 

 WaitKey
 WinExit

[attachment deleted by admin]

Mike Lobanovsky · « **Reply #18 on:** October 16, 2015, 01:54:35 PM »

Yep Aurel, those timings seem plausible for a single-core 1.7GHz Pentium. My Intel Pentium has four cores running in parallel with each other at roughly two times the speed of yours, which gives a tremendous boost even to single-threaded applications. But my CPU isn't the fastest one these days either.

As for the built-in Mandelbrot function, you might do it but for what purpose? We don't use fractals every day so its practicality would be next to zero...

Mike Lobanovsky · « **Reply #19 on:** October 16, 2015, 02:53:15 PM »

Hehe Peter,

Your latest Mandel won't do; it does only 16 iterations against John's and my 512. That's cheating.

In the meantime, here are your bananas on my PC: (FBSL's one is resizable)

Code: OxygenBasic

'vonoroi.bas for SmallBASIC 2015-10-14 MGA/B+
'modified bluatigro code from JB 2015-09-07 vonoroi diagram
'further modified into O2 banana by peter
'and finally, devoured by ML's FBSL 
 
Dim width = 800, height = 600, points = 240
Dim hDC = GetDC(ME), hMemDC = CreateCompatibleDC(NULL)
Dim hBmp = CreateCompatibleBitmap(hDC, width, height)
Dim hOldBmp = SelectObject(hMemDC, hBmp): SetStretchBltMode(hDC, 4) ' HALFTONE
Dim t = GetTickCount()
 
PetersBanana(hMemDC)
 
FbslSetText(ME, "-= Peter's Banana =-  TIME: " & (GetTickCount() - t) / 1000 & " SECONDS")
Resize(ME, 0, 0, width, height)
Center(ME)
Show(ME)
 
Begin Events
  Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
  End Type
  
  Static rc As RECT
  
  If CBMSG = &H111 AndAlso CBWPARAM = 2 Then ' WM_COMMAND && Esc
    PostMessage(ME, &H10, 0, 0) ' WM_CLOSE
  ElseIf CBMSG = &HF OrElse CBMSG = &H5 Then ' WM_PAINT || WM_SIZE
    GetClientRect(ME, @rc)
    ValidateRect(ME, NULL)
    StretchBlt(hDC, 0, 0, rc.Right, rc.Bottom, hMemDC, 0, 0, width, height, &HCC0020) ' SRCCOPY
    Return 0
  ElseIf CBMSG = &H10 Then ' WM_CLOSE
    DeleteObject(SelectObject(hMemDC, hOldBmp))
    DeleteDC(hMemDC)
    ReleaseDC(ME, hDC)
  End If
End Events
 
DynC PetersBanana(%dc, %w = width, %p = points)
  #define rnd(x, y) (rand() % (y - x) + (x))
  #define RGB(r, g, b) (b) << 16 | (g) << 8 | (r)
  
  void __attribute__((stdcall)) SetPixelV(int, int, int, int);
  double fabs(double);
  
  void main(int hdc, int sq, int points)
  {
    int x[240], y[240], kl[240]; // can't dim arrays with a var in DynC
    int xx, yy, i, a, b, g, r, d, q, kkl, s2 = sq >> 1;
    
    for (i = 0; i < points; i++) {
      x[i] = rnd(32, sq);
      y[i] = rnd(32, sq);
      r = 255 - x[i] / (double)sq * 255;
      g = 127 - 127 * (fabs(s2 - x[i]) / s2) + 127 - 127 * (fabs(s2 - y[i]) / s2);
      b = y[i] / (double)sq * 255;
      kl[i] = RGB(r, g, b);
    }
    
    for (xx = 0; xx < sq; xx++) {
      for (yy = 0; yy < sq; yy++) {
        d = 307201;
        for (i = 0; i < points; i++) {
          a = x[i] - xx; b = y[i] - yy;
          q = a * a + b * b;
          if (q < d) {
            d = q;
            kkl = i;
          }
        }
        SetPixelV(hdc, xx, yy, kl[kkl]);
      }
    }
  }
End DynC

[attachment deleted by admin]

Mike Lobanovsky · « **Reply #20 on:** October 17, 2015, 03:53:48 AM »

Hi John,

There still seems to be some room left that evidently attributes to my CPU being slightly faster than your fastest compilation (VC):

Code: OxygenBasic

Type RECT
  %left %top
  %right %bottom
End Type
 
Dim MaxIter = 512
Dim width = 640
Dim height = 480
 
Dim hDC = GetDC(ME), hMemDC = CreateCompatibleDC(NULL)
Dim hBmp = CreateCompatibleBitmap(hDC, width, height)
Dim hOldBmp = SelectObject(hMemDC, hBmp): SetStretchBltMode(hDC, 4) ' HALFTONE
Dim rc As RECT: SetRect(@rc, 10, 35, width + 10, height + 35)
Dim t = GetTickCount()
 
GenMandelbrot(-3, -2, 2.5, 2)
 
FbslSetText(ME, "-= JRS Compatible Mandel =-  TIME: " & (GetTickCount() - t) / 1000 & " SECONDS")
AdjustWindowRectEx(@rc, &HCF0000, FALSE, &H100) ' WS_OVERLAPPEDWINDOW && WS_EX_WINDOWEDGE
Resize(ME, 0, 0, rc.right - rc.left, rc.bottom - rc.top)
Center(ME): Show(ME)
 
Begin Events
  If CBMSG = &H111 AndAlso CBWPARAM = 2 Then ' WM_COMMAND && Esc
    PostMessage(ME, &H10, 0, 0) ' WM_CLOSE
  ElseIf CBMSG = &HF OrElse CBMSG = &H5 Then ' WM_PAINT || WM_SIZE
    GetClientRect(ME, @rc)
    ValidateRect(ME, NULL)
    StretchBlt(hDC, 0, 0, rc.right, rc.bottom, hMemDC, 0, 0, width, height, &HCC0020) ' SRCCOPY
    Return 0
  ElseIf CBMSG = &H10 Then ' WM_CLOSE
    DeleteObject(SelectObject(hMemDC, hOldBmp))
    DeleteDC(hMemDC)
    ReleaseDC(ME, hDC)
  End If
End Events
 
Sub GenMandelbrot(xMn, yMn, xMx, yMx)
  Dim iX, iY, cx, cy, dx, dy
  
  dx = (xMx - xMn) / (width - 1)
  dy = (yMx - yMn) / (height - 1)
  
  For iY = 0 To height
    cy = yMn + iY * dy
    For iX = 0 To width
      cx = xMn + iX * dx
      If Iterate(MaxIter, cx, cy) <> MaxIter Then
        SetPixel(hMemDC, iX, iY, RGB(160 - Iterate * 32, 208 - Iterate * 16, 232 - Iterate * 8))
      End If
    Next
  Next
End Sub
 
DynC Iterate(%mi, !!cx, !!cy) As Long
  long main(long MaxIter, double cx, double cy)
  {
    int iters = 0;
    double X = cx, Y = cy, X2 = X * X, Y2 = Y * Y, temp;
    
    while ((iters < MaxIter) && (X2 + Y2 < 4)) {
      temp = cx + X2 - Y2;
      Y = cy + 2 * X * Y;
      Y2 = Y * Y;
      X = temp;
      X2 = X * X;
      iters++;
    }
    return iters;
  }
End DynC

[attachment deleted by admin]

JRS · « **Reply #21 on:** October 17, 2015, 08:16:02 PM »

64 bit SDL and Script BASIC on Windows 7 64 bit.

Code: Script BASIC

' ScriptBasic GFX - Mandelbrot
 
IMPORT gfx.inc
 
s = gfx::Window(640,480,"ScriptBasic GFX Mandelbrot")
ts = gfx::Time()
FOR y = 0 TO 479
  FOR x = 0 TO 639
    cx = (x - 320) / 120
    cy = (y - 240) / 120
    rit = gfx::Mandelbrot(cx, cy, 510)
    gfx::PixelRGBA s, x, y, rit * 32, rit * 16, rit * 8, 255
  NEXT
NEXT
te = gfx::Time()
gfx::stringColor s, 20, 15, "Time: " & FORMAT("%.4f",(te-ts)/1000) & " Seconds." & CHR(0), 0x000000ff
gfx::Update
WHILE gfx::KeyName(1) <> "+escape"
WEND
gfx::Close
 

Code: C

besFUNCTION(gfx_Mandelbrot)
  DIM AS double cx, cy, zx, zy, tp;
  DIM AS int iter;
  besARGUMENTS("rri")
    AT cx, AT cy, AT iter
  besARGEND
  DEF_WHILE (zx * zx + zy * zy < 4 AND iter > 0)
  BEGIN_WHILE
    tp = zx * zx - zy * zy + cx;
    zy = 2 * zx * zy + cy;
    zx = tp;
    iter = iter - 1;
  WEND
  besRETURN_LONG(iter);
besEND
 

Peter · « **Reply #22 on:** October 18, 2015, 03:44:50 AM »

Hi,
Potato Mandel

Code: [Select]

include "asm.inc"
window 800,600,1

Loadimage "bmp/potato.bmp"

int cells=1000
single headx, heady

single px[3000]  
single py[3000] 

single radX[3000]
single radY[3000]

single angle[3000] 
single cRadius[3000] 
single frequency[3000] 

headx = scrw()/2
heady = scrh()/2

for i=0 to cells
   radx[i] = Rand(-7,7)  
   rady[i] = Rand(-4,4)
   frequency[i] = Rand(-9,9)
   cRadius[i] = Rand(16,30)
next

while key(27)=0
  cls 0,0,0
  for i=0 to cells
     if i=0 
        px[i]=headx+sin(angle[i])*radx[i]
        py[i]=heady+cos(angle[i])*rady[i]
     else
        px[i]=px[i-1]+cos(angle[i])*radx[i] 
        py[i]=py[i-1]+sin(angle[i])*rady[i] 
     endif   
        drawimage 1,px[i],py[i]
	angle[i] = angle[i] + rad(frequency[i])
   next
   color 255,255,255
   text 316,32,12,"MANDEL POTATO"
   redraw
   wait 10
wend
winexit

[attachment deleted by admin]

Peter · « **Reply #23 on:** October 18, 2015, 04:42:57 AM »

Hi,
Mandel Complex

Code: [Select]

include "asm.inc"
window 800,600,1

single x,y,zx,zy,cx,cy,tmp, sys MaxIter=512,zoom=150

ts = ticks
For y=0 to <scrH
For x=0 to <scrW
    zx=0
    zy=0
    cx= (x-400)/zoom	
    cy= (y-300)/zoom
    Iter = MaxIter
    while zx * zx + zy * zy < 4 && iter > 0 
      tmp = zx * zx - zy * zy + cX
      zy  = 2 * zx * zy + cY
      zx  = tmp
      iter--
    wend      
    PutPixel x,y,iter+iter*256+iter*65536/5
Next
Next
color 255,255,255
text 0,0,12,"TIME: " (ticks()-ts)/1000 " SECONDS" 
waitkey
winExit

[attachment deleted by admin]

JRS · « **Reply #24 on:** October 18, 2015, 07:31:57 AM »

Quote

FBSL's one is re-sizable

That feature alone make all the others static dummies.

Mike Lobanovsky · « **Reply #25 on:** October 18, 2015, 08:25:55 AM »

Yeah Peter, that's fast.

Code: OxygenBasic

Type RECT
  %Left %top
  %Right %bottom
End Type
 
Dim width = 800, height = 600, maxiter = 512, zoom = 150
Dim hDC = GetDC(ME), hMemDC = CreateCompatibleDC(NULL)
Dim hBmp = CreateCompatibleBitmap(hDC, width, height)
Dim hOldBmp = SelectObject(hMemDC, hBmp): SetStretchBltMode(hDC, 4) ' HALFTONE
Dim rc As RECT: SetRect(@rc, 10, 35, width + 10, height + 35)
Dim t = GetTickCount()
 
Mandelbrot(hMemDC)
 
FbslSetText(ME, "-= Peter's Fast Mandelbrot =-  TIME: " &(GetTickCount() - t) / 1000 & " SECONDS")
AdjustWindowRectEx(@rc, &HCF0000, FALSE, &H100) ' WS_OVERLAPPEDWINDOW && WS_EX_WINDOWEDGE
Resize(ME, 0, 0, rc.Right - rc.Left, rc.bottom - rc.top)
Center(ME): Show(ME)
 
Begin Events
  If CBMSG = &H111 AndAlso CBWPARAM = 2 Then ' WM_COMMAND && Esc
    PostMessage(ME, &H10, 0, 0) ' WM_CLOSE
  ElseIf CBMSG = &HF OrElse CBMSG = &H5 Then ' WM_PAINT || WM_SIZE
    GetClientRect(ME, @rc)
    ValidateRect(ME, NULL)
    StretchBlt(hDC, 0, 0, rc.Right, rc.Bottom, hMemDC, 0, 0, width, height, &HCC0020) ' SRCCOPY
    Return 0
  ElseIf CBMSG = &H10 Then ' WM_CLOSE
    DeleteObject(SelectObject(hMemDC, hOldBmp))
    DeleteDC(hMemDC)
    ReleaseDC(ME, hDC)
  End If
End Events
 
DynC Mandelbrot(%dc, %w = width, %h = height, %i = maxiter, !!z = zoom)
  void __attribute__((stdcall)) SetPixelV(int, int, int, int);
  
  void main(int hdc, int srcW, int srcH, int maxiter, double zoom)
  {
    int x, y, iter;
    double zx, zy, cx, cy, sq, tmp;
    
    for (y = 0; y < srcH; y++) {
      for (x = 0; x < srcW; x++) {
        zx = zy = 0.0;
        cx = (x - 400) / zoom;
        cy = (y - 300) / zoom;
        iter = maxiter;
        while (zx * zx + zy * zy < 4 && iter-- > 0) {
          tmp = zx * zx - zy * zy + cx;
          zy = 2 * zx * zy + cy;
          zx = tmp;
        }
        SetPixelV(hdc, x, y, iter + (iter << 8) + (iter << 16) / 5);
      }
    }
  }
End DynC

[attachment deleted by admin]

Peter · « **Reply #26 on:** October 19, 2015, 08:51:42 AM »

Hello,

Mandelbrot Robustly.

Code: [Select]

include "asm.inc"
window 800,480,1

Sub filledcircle(x1, y1, r)
r=r/2
for y=-r to r 
for x=-r to r
    if x*x+y*y <= r*r
       setpixel x1+x, y1+y
    end if	
next
next
End Sub

float ts = ticks
color 255,255,255
text 10,10,10,"PRESS ANY KEY"

for i=40 to 680 step 80
    color 200,200,255-i*10
    filledcircle i-200,240,i-240
next
color 255,255,255
float tz = ticks
text 0,460,12,"Time: " (tz-ts)/1000 " seconds"
waitkey
winExit

[attachment deleted by admin]

Mike Lobanovsky · « **Reply #27 on:** October 19, 2015, 10:03:12 AM »

Oxygen Basic

News:

Author Topic: Mandelbrot (Read 5963 times)

Mike Lobanovsky

Re: Mandelbrot

Aurel

Re: Mandelbrot

Peter

Re: Mandelbrot

Mike Lobanovsky

Re: Mandelbrot

Mike Lobanovsky

Re: Mandelbrot

Mike Lobanovsky

Re: Mandelbrot

JRS

Re: Mandelbrot

Peter

Re: Mandelbrot

Peter

Re: Mandelbrot

JRS

Re: Mandelbrot

Mike Lobanovsky

Re: Mandelbrot

Peter

Re: Mandelbrot

Mike Lobanovsky

Re: Mandelbrot