Rosetta Code task: Julia set

[David Drake]

I created the code below for the Rosetta Code task "Julia set" found here: rosettacode.org/wiki/Julia_set.  The details are at the top of the page.  This is mostly a recoding of the Perl 6 implementation, with a few bells and whistles added to make it a little more usable.  I recommend that, when you run this, start with a larger "granularity" number (10 or so) because it runs much faster.  I have found, at least on my computer, that a setting of 1 or 2 runs VERY slowly and eventually crashes (which is why I added error trapping).

I welcome the community's thoughts and corrections.



nomainwin

[start]
   on error goto [errorHandler]

   prompt "Select granularity (1 [very fine] - 20 [very course])";gr
   gr=abs(int(gr))
   if gr<3 then
       confirm "This will take a LONG time and might crash.  Proceed?";ans$
       if ans$="no" then [start]
   end if

[setupWindow]
   UpperLeftX=1
   UpperLeftY=1
   WindowWidth=900
   WindowHeight=800
   open "Julia Set" for graphics_nf_nsb as #1
   #1 "trapclose [q];fill black;flush;down;color white;size ";gr

   w = 850
   h = 750
   zoom = 1
   maxiter = 255
   moveX = 0
   moveY = 0
   cX = -0.7
   cY = 0.27015

   global zx, zy, tmp, i, rd, gn, bu

   for x = 0 to w step gr
       for y = 0 to h step gr
           zx=1.5*(x-w/2)/(0.5*zoom*w)+moveX
           zy=1.0*(y-h/2)/(0.5*zoom*h)+moveY
           i=maxiter
           while zx*zx+zy*zy<4 and i>1
               tmp = zx * zx - zy * zy + cX
               zy = 2.0 * zx * zy + cY
               zx = tmp
               i=i-1
               call hsv2rgb i/maxiter*360,1,i
               #1 "color ";rd;" ";gn;" ";bu
               #1 "set ";x;" ";y
           wend
       next y
       scan
   next x
   #1 "flush"
   notice "Complete"
   wait

[errorHandler]
   print "Error number ";Err;" has occurred."
   print "Error message: ";Err$

[q]
   close #1
   end

sub hsv2rgb h,s,v
   c=v*s
   x=c*(1-abs(((h/60))-1))
   m=v-c
   select case
       case h < 60
           r = c
           g = x
           b = 0
       case h>=60 and h<120
           r = x
           g = c
           b = 0
       case h>=120 and h<180
           r = 0
           g = c
           b = x
       case h>=180 and h<240
           r = 0
           g = x
           b = c
       case h>=240 and h<300
           r = x
           g = 0
           b = c
       case h>=300
           r = c
           g = 0
           b = x
   end select
   rd = abs(int((r+m)*255))
   gn = abs(int((g + m)*255))
   bu = abs(int((b + m)*255))
end sub


[tsh73]

You really should move drawing code (3 liners after i=i-1)
out of WHILE loop.
It goes much faster then.

[David Drake]

Feb 25, 2020 10:04:57 GMT -5 tsh73 said:

You really should move drawing code (3 liners after i=i-1)
out of WHILE loop.
It goes much faster then.

No kidding!  Thank you so much.  I'm not sure how I let that one slip past me.

[Rod]

As well I would put the scan in the busiest section else it feels a bit unresponsive if you cancel. I also think it was crashing because you were drawing many times, moving the drawing out of the central while wend loop will likely cure that so we could take that warning out.

for x = 0 to w step gr
       for y = 0 to h step gr
           zx=1.5*(x-w/2)/(0.5*zoom*w)+moveX
           zy=1.0*(y-h/2)/(0.5*zoom*h)+moveY
           i=maxiter
           while zx*zx+zy*zy<4 and i>1
           scan
               tmp = zx * zx - zy * zy + cX
               zy = 2.0 * zx * zy + cY
               zx = tmp
               i=i-1
           wend
           call hsv2rgb i/maxiter*360,1,i
           #1 "color ";rd;" ";gn;" ";bu
           #1 "set ";x;" ";y
       next y
   next x


[David Drake]

It makes a quite lovely image.

[Carl Gundel]

Feb 25, 2020 10:04:57 GMT -5 tsh73 said:

You really should move drawing code (3 liners after i=i-1)
out of WHILE loop.
It goes much faster then.

That suggests another kind of challenge instead of making things small.  Making them fast! 

[Rod]

Well the turbo boost for fractals is symmetry. Look at the diagram it is symmetrical about a diagonal. In fact two diagonals. So calculate one quarter and draw four quarters.

[tsh73]

symmetry - 2x faster
nomainwin

[start]
   on error goto [errorHandler]

   gr=3
   prompt "Select granularity (1 [very fine] - 20 [very course])";gr
   gr=abs(int(gr))
   if gr<3 then
       confirm "This will take a LONG time and might crash.  Proceed?";ans$
       if ans$="no" then [start]
   end if

[setupWindow]
   UpperLeftX=1
   UpperLeftY=1
   WindowWidth=900
   WindowHeight=800
   open "Julia Set" for graphics_nf_nsb as #1
   #1 "trapclose [q];fill black;flush;down;color white;size ";gr

   w = 850
   h = 750
   zoom = 1
   maxiter = 255
   moveX = 0
   moveY = 0
   cX = -0.7
   cY = 0.27015

   global zx, zy, tmp, i, rd, gn, bu
   global col$, lastCol$
t0=time$("ms")
w2=int(w/2)
h2=int(h/2)

zw=0.5*zoom*w
zh=0.5*zoom*h

for x = 0-w2 to 0 step gr
       for y = 0-h2 to h2 step gr
           zx=1.5*x/zw'+moveX
           zy=y/zh'+moveY
           i=maxiter
           while zx*zx+zy*zy<4 and i>1
           scan
               tmp = zx * zx - zy * zy + cX
               zy = 2.0 * zx * zy + cY
               zx = tmp
               i=i-1
           wend
           call hsv2rgb i/maxiter*360,1,i
           if col$<>lastCol$ then
               lastCol$=col$
               #1 "color ";col$
           end if
           #1 "set ";x+w2;" ";y+h2
           #1 "set ";w2-x;" ";h2-y
       next y
   next x
   #1 "flush"
t1=time$("ms")
   notice "Complete ";t1-t0
   wait

[errorHandler]
   print "Error number ";Err;" has occurred."
   print "Error message: ";Err$

[q]
   close #1
   end

sub hsv2rgb h,s,v
   c=v*s
   x=c*(1-abs(((h/60))-1))
   m=v-c
   select case
       case h < 60
           r = c
           g = x
           b = 0
       case h>=60 and h<120
           r = x
           g = c
           b = 0
       case h>=120 and h<180
           r = 0
           g = c
           b = x
       case h>=180 and h<240
           r = 0
           g = x
           b = c
       case h>=240 and h<300
           r = x
           g = 0
           b = c
       case h>=300
           r = c
           g = 0
           b = x
   end select
   rd = abs(int((r+m)*255))
   gn = abs(int((g + m)*255))
   bu = abs(int((b + m)*255))
   col$=rd;" ";gn;" ";bu
end sub


[tsh73]

left overnight

[David Drake]

Feb 26, 2020 0:57:10 GMT -5 tsh73 said:

left overnight

Brilliant!

[tsh73]

Hello David (hello everybody)
I have some bad news about this program
I tried it in alternative LB implementation - and it dies all the time
I start looking - and I saw that sub hsv2rgb h,s,v returns R,G,B components out of 0..255 range.
I think it is just not correctly translated from Python (edit)Perl.
LB works somehow, but R G B just should stay in 0..255

try this and see
see numbers in mainwin
and see colored circle. Shouldn't it be smooth?


Now, whoever can work with Perl - could you try hsv2rgb and show how color circle looks there?
(and may be fix it in this LB program)

   global zx, zy, tmp, i, rd, gn, bu
   global col$, lastCol$

open "Julia Set" for graphics_nf_nsb as #1
   #1 "trapclose [q];fill black;flush;down;color white;size ";10

   pi = acs(-1)
   maxiter = 255
   for i = maxiter to 0 step -1
       call hsv2rgb i/maxiter*360,1,i
       print ">";col$
       a = i/maxiter*2*pi
       #1 "color ";col$
       #1 "set ";150+120*cos(a);" ";150+120*sin(a)
   next

wait
end

[q]
   close #1
   end

sub hsv2rgb h,s,v
   c=v*s
   x=c*(1-abs(((h/60))-1))
   m=v-c
   select case
       case h < 60
           r = c
           g = x
           b = 0
       case h>=60 and h<120
           r = x
           g = c
           b = 0
       case h>=120 and h<180
           r = 0
           g = c
           b = x
       case h>=180 and h<240
           r = 0
           g = x
           b = c
       case h>=240 and h<300
           r = x
           g = 0
           b = c
       case h>=300
           r = c
           g = 0
           b = x
   end select
   rd = abs(int((r+m)*255))
   gn = abs(int((g + m)*255))
   bu = abs(int((b + m)*255))
   col$=rd;" ";gn;" ";bu
end sub



[tsh73]

Just to make clearer
I don't write in Perl or Python - don't have any installed - cannot check
I tried to fiddle with LB code but I didn't like results I got

I have a code that sets color by hue - but it is always bright so it haven't got black at all
(and hue 0 corresponds to red, not blue - so background gets bright red)

[Rod]

So a color wheel is simply a change in color. You won't get black or any shade of darker in a color wheel. We need something like this?
commons.wikimedia.org/wiki/File:HSV_Color_wheel_mapping_inverted.png

[tenochtitlanuk]


   global zx, zy, tmp, i, rd, gn, bu, pi
   global col$, lastCol$

   nomainwin

   WindowWidth  =500: WindowHeight =540

   open "Julia Set" for graphics_nf_nsb as #1
   #1 "trapclose [q]; fill black; flush; down; color white; size "; 12

   pi      = acs( 0 -1)
   maxiter = 255

   for i = maxiter to 0.5 step -0.5
       call hsv2rgb i /maxiter *360, 1, i
       'print i, "<"; col$; ">", h
       a   = i /maxiter *360
       #1 "color "; col$
       #1 "set "; 250 +200 *cosR( a); " "; 250 +200 *sinR( a)
   next i

   wait
   end

[q]
   close #1
   end

sub hsv2rgb h, s, v '                           hue, saturation, value
   c   =v *s       '                           chroma
   h   =h' /60
   x   =c *( 1 -abs( ( ( h /60) mod 2) -1))
   m   =v -c   '                               matching adjustment

   select case
       case h < 60
           r = c: g = x: b = 0
       case h <120
           r = x: g = c: b = 0
       case h <180
           r = 0: g = c: b = x
       case h <240
           r = 0: g = x: b = c
       case h <300
           r = x: g = 0: b = c
       case else
           r = c: g = 0: b = x
   end select

   rd      = abs( int( ( r + m)))
   gn      = abs( int( ( g + m)))
   bu      = abs( int( ( b + m)))
   col$    =right$( "  " +str$( rd), 3) +" " +right$( "   " +str$( gn), 3) +" " +right$( "   " +str$( bu), 3)

end sub

function sinR( t): sinR =sin( t *pi /180): end function
function cosR( t): cosR =cos( t *pi /180): end function



[tenochtitlanuk]