PureBasic Forums - English

http://www.purebasic.com
https://www.purebasic.fr/english/

sunflower: filling the space tightly with seeds

https://www.purebasic.fr/english/viewtopic.php?t=62588

Page 2 of 2

Re: sunflower: filling the space tightly with seeds

Posted: Fri Sep 11, 2015 9:15 am
by applePi
IdeasVacuum wrote:
How is that 5.3 value derived?
Hi IdeasVacuum, it is not derived, it is an experimental number to estimate visualy if the seeds with a certain radius are compact or not.
in fact 5.3 are not necessary , i just have copied the code blindly and now i see that

Code: Select all

Procedure floret(n.i) 
  r.f : ang.f : xc.f : yc.f
  r =(5.3 * Sqr(n*golden))
  ang = (n*golden)
  xc = r*Cos(ang)/100
  yc = r*Sin(ang)/100
  z\x=xc : z\y=yc 
EndProcedure
are equal to:

Code: Select all

Procedure floret(n.i) 
  r.f : ang.f : xc.f : yc.f
  r = Sqr(n*golden)
  ang = (n*golden)
  xc = r*Cos(ang)/19
  yc = r*Sin(ang)/19
  z\x=xc : z\y=yc 
EndProcedure

and 20 are even better than 19
evidently and certainly there should be a simple formula in which one of its elements is the seed (sphere) radius to replace the number 19 so instead of experiments we then have a definitive value. it is may be a simple modification but i don't catch it now.

on the other hand i have found a good picture to describe the golden angle:
Image
look http://www.math.smith.edu/phyllo/About/fibogolden.html
divide 360 by the golden mean (1.618)
360/1.618 = 222.496
360 - 222.496 = 137.503 which considered the golden angle

i have tried AttachEntityObject to attach the spheres to the first sphere instead of StaticGeometry, it is a simpler code but its FPS = 30 on my system, while in the previous code with staticGeometry it is 60. note the spheres Segments, Rings = 5x5 (CreateSphere(1,0.08, 5,5)) , so it is like a polygon, i have tried now 16,16 and it does not destroy the performance

Code: Select all

#sphere = 3

Structure coor
 x.f
 y.f
 z.f
EndStructure 

Global z.coor
Define.f KeyX , KeyY 
#golden_angle = 137.508 
Global golden.f = Radian(#golden_angle); = 2.3999 also = golden_angle*PI/180 

Procedure floret(n.i) 
  r.f : ang.f : xc.f : yc.f
  r = Sqr(n*golden)
  ang = (n*golden)
  xc = r*Cos(ang)/19
  yc = r*Sin(ang)/19
  z\x=xc : z\y=yc 
EndProcedure
 

If InitEngine3D()
   InitMouse()
   InitKeyboard()
   InitSprite()
   ExamineDesktops()
If OpenWindow(0, 0, 0, DesktopWidth(0), DesktopHeight(0), "Up/Down  to zoom in/out", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)

If OpenWindowedScreen(WindowID(0), 0, 0, DesktopWidth(0), DesktopHeight(0), 0, 0, 0)
         Add3DArchive(".",#PB_3DArchive_FileSystem)
         Add3DArchive(#PB_Compiler_Home+"Examples\3D\Data\Textures\",#PB_3DArchive_FileSystem)
         Add3DArchive(#PB_Compiler_Home+"Examples\3D\Data\GUI",#PB_3DArchive_FileSystem)
         Add3DArchive(#PB_Compiler_Home + "Examples/3D/Data/Packs/desert.zip", #PB_3DArchive_Zip)
         Parse3DScripts()
         
         Global monitor=CreateSprite(#PB_Any,120,40)
         
         CreateCamera(0,0,0,100,100)
         CameraBackColor(0,RGB(0, 0, 0))
         MoveCamera(0,0,0,10)
         
         CreateLight(0,RGB(255, 255, 95),-50,50,100)
         CreateMaterial(0,TextureID(LoadTexture(#PB_Any,"ground_diffuse.png")))
         CreateMaterial(1,TextureID(LoadTexture(#PB_Any,"Geebee2.bmp")))
                  
         CreateSphere(0,0.08, 5,5)
         CreateEntity(0,MeshID(0),MaterialID(0))
                  
         For i=1 To 2000  ; number of objects
           floret(i)
           
           CreateEntity(i,MeshID(0),MaterialID(1))
           MoveEntity(i,  z\x, z\y, 0, #PB_Absolute)
           AttachEntityObject(0, "", EntityID(i))
           
         Next
          
        CreateLight(0,RGB(255,255,255),-50,40,30)
        AmbientColor(RGB(100,100,100))
   
;SkyBox("desert07.jpg")                        

angleY.f :dir.f = 1
;ShowCursor_(1)
Repeat
  ExamineKeyboard()
  ;Event = WindowEvent()
        
       
        If KeyboardPushed(#PB_Key_Up)
          KeyY = -0.1
        ElseIf KeyboardPushed(#PB_Key_Down)
          KeyY = 0.1
        Else
          KeyY = 0
        EndIf
        
       angleY.f + 0.5*dir
       If angleY >= 45
         dir *-1
       ElseIf angleY <= -45
         dir = 1
           
       EndIf
       
          RotateEntity(0, 0, angleY, 0, #PB_Absolute)
          
          CameraLookAt(0, 0,0,0)
          RenderWorld()
              
      StartDrawing(SpriteOutput(monitor))
        DrawText(5,5,"FPS : "+Str(Engine3DStatus(#PB_Engine3D_CurrentFPS )))
        DrawText(5,20,"Tris : "+StrF(Engine3DStatus(#PB_Engine3D_NbRenderedTriangles))) 
      
      
      StopDrawing()
      DisplaySprite(monitor,0,0)
      
         MoveCamera(0, KeyX, 0, KeyY)
      
         FlipBuffers()
         
         Until WindowEvent()=#PB_Event_CloseWindow Or KeyboardPushed(#PB_Key_Escape)
         
      EndIf
   EndIf
EndIf
note: regarding of possible implementation of the whole construction with physics property so the spheres will not collide with each other there is in PB5.40 beta3 a new parameter:
Added: #PB_Entity_DisableContactResponse and #PB_Entity_EnableContactResponse for SetEntityAttribute()
the spheres will still have weights and even joints but will not collide to each other or other objects.

Re: sunflower: filling the space tightly with seeds

Posted: Fri Sep 11, 2015 10:47 am
by IdeasVacuum
Hi applePi
implementation of the whole construction with physics property so the spheres will not collide with each other
I can't see that working with this algorithm - effectively, the floret procedure would then be putting each sphere in the 'wrong location', the physics would move each of them so as not to collide, repeat - perfect occupation of space but likely not a perfect pattern?

So, needs to be a way to calculate the 19 (magnitude?). I've already got a sore head so looks like I will need to ram-raid the coffe jar :mrgreen:

Re: sunflower: filling the space tightly with seeds

Posted: Fri Sep 11, 2015 3:48 pm
by applePi
IdeasVacuum wrote:
So, needs to be a way to calculate the 19 (magnitude?)
i have simplified the problem more, removong the 19, and the procedure now:

Code: Select all

Procedure floret(n.i) 
  r.f : ang.f : xc.f : yc.f
  r = Sqr(n*golden)
  ang = (n*golden)
  xc = r*Cos(ang)
  yc = r*Sin(ang)
  z\x=xc : z\y=yc 
EndProcedure
so now the question is: how much the sphere radius needed ? i guess that it is approximately the distance/2 between every adjacent spheres centers (not sure of the word 'every' so i have used 'approx') : the distance is according to Pythagoras law like in this page https://www.mathsisfun.com/algebra/dist ... oints.html
but i have surprised that floret(i) are not necessary adjacent to floret(i+1) i have no idea how this works, so added 2 flag blue spheres to detect visually some adjacent spheres, and found floret(1) and floret(3) are adjacent

Code: Select all

floret(1)
         x1.f=z\x : y1.f = z\y
         floret(3)
         x2.f=z\x : y2.f = z\y
         c.f= (x1-x2)*(x1-x2) + (y1-y2)*(y1-y2)
         c= Sqr(c) ; Pythagoras law 
         ;Debug c/2
         
         ;rad.f = 0.08*18 ; from visual experiment
         rad.f = c/2    ; from Pythagoras
         CreateSphere(0,rad)
to see the physics effects you need PB 5.40 beta 3, and disable debugger until beta 4 announced
this is with physics but every sphere have feature of "#PB_Entity_DisableContactResponse"
the gravity are zero (line 86) so the shape will not fall down
PB 5.40 beta 3, and disable debugger

Code: Select all

#sphere = 3

Structure coor
 x.f
 y.f
 z.f
EndStructure 

Global z.coor
Define.f KeyX , KeyY 
#golden_angle = 137.508 
;#golden_angle = 138.508 ; this results in a very funny shape
Global golden.f = Radian(#golden_angle); = 2.3999 also = golden_angle*PI/180 
;Debug golden
Procedure floret(n.i) 
  r.f : ang.f : xc.f : yc.f
  r = Sqr(n*golden)
  ang = (n*golden)
  xc = r*Cos(ang)
  yc = r*Sin(ang)
  z\x=xc : z\y=yc 
EndProcedure
 

If InitEngine3D()
   InitMouse()
   InitKeyboard()
   InitSprite()
   ExamineDesktops()
If OpenWindow(0, 0, 0, DesktopWidth(0), DesktopHeight(0), "Up/Down  to zoom in/out", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)

If OpenWindowedScreen(WindowID(0), 0, 0, DesktopWidth(0), DesktopHeight(0), 0, 0, 0)
         Add3DArchive(".",#PB_3DArchive_FileSystem)
         Add3DArchive(#PB_Compiler_Home+"Examples\3D\Data\Textures\",#PB_3DArchive_FileSystem)
         Add3DArchive(#PB_Compiler_Home+"Examples\3D\Data\GUI",#PB_3DArchive_FileSystem)
         Add3DArchive(#PB_Compiler_Home + "Examples/3D/Data/Packs/desert.zip", #PB_3DArchive_Zip)
         Parse3DScripts()
         
         Global monitor=CreateSprite(#PB_Any,120,40)
         
         CreateCamera(0,0,0,100,100)
         CameraBackColor(0,RGB(0, 0, 0))
         MoveCamera(0,0,0,200)
         
         CreateLight(0,RGB(255, 255, 95),-50,50,100)
         CreateMaterial(0,TextureID(LoadTexture(#PB_Any,"ground_diffuse.png")))
         CreateMaterial(1,TextureID(LoadTexture(#PB_Any,"Geebee2.bmp")))
         
         floret(1)
         x1.f=z\x : y1.f = z\y
         floret(3)
         x2.f=z\x : y2.f = z\y
         c.f= (x1-x2)*(x1-x2) + (y1-y2)*(y1-y2)
         c= Sqr(c)
         ;Debug c/2
         
         ;rad.f = 0.08*18
         rad.f = c/2
         CreateSphere(0,rad)
         CreateEntity(0,MeshID(0),MaterialID(0))
         CreateEntityBody(0, #PB_Entity_SphereBody, 1, 0.1,0.1)
           
         For i=1 To 1000  ; number of objects
           floret(i)
                     
           CreateEntity(i,MeshID(0),MaterialID(1))
           MoveEntity(i,  z\x, z\y, 0, #PB_Absolute)
;           CreateEntityBody(i, #PB_Entity_SphereBody, 1, 0.1,0.1)
           AttachEntityObject(0, "", EntityID(i))
           CreateEntityBody(i, #PB_Entity_SphereBody, 1, 0.1,0.1)
           SetEntityAttribute(i, #PB_Entity_DisableContactResponse, 1)
           If i = 1 Or i= 3 ; just to see 2 adjacent spheres with blue
             CreateEntity(7000+flag,MeshID(0),MaterialID(0))
             MoveEntity(7000+flag,  z\x, z\y, 0.5, #PB_Absolute)
             flag+1
           EndIf
           
         Next
          
        CreateLight(0,RGB(255,255,255),-50,40,30)
        AmbientColor(RGB(100,100,100))
   
;SkyBox("desert07.jpg")                        

angleY.f :dir.f = 1
WorldGravity(0) 

;ShowCursor_(1)
Repeat
  ExamineKeyboard()
         
        If KeyboardPushed(#PB_Key_Up)
          KeyY = -20
        ElseIf KeyboardPushed(#PB_Key_Down)
          KeyY = 20
        Else
          KeyY = 0
        EndIf
        
       angleY.f + 0.5*dir
       If angleY >= 10
         dir *-1
       ElseIf angleY <= -10
         dir = 1
           
       EndIf
       
       If KeyboardReleased(#PB_Key_Space)
         
         
         CreateCube(6000+cube, 30)
         CreateEntity(6000, MeshID(6000), MaterialID(0), 50,40,600)
         CreateEntityBody(6000, #PB_Entity_BoxBody, 1, 0.1,0.1)
         ApplyEntityImpulse(6000, 0, 0, -600)
         cube+1
         
       EndIf
       
       
          RotateEntity(0, 0, angleY, 0, #PB_Absolute)
          
          CameraLookAt(0, 0,0,0)
          
          RenderWorld()
              
      StartDrawing(SpriteOutput(monitor))
        DrawText(5,5,"FPS : "+Str(Engine3DStatus(#PB_Engine3D_CurrentFPS )))
        DrawText(5,20,"Tris : "+StrF(Engine3DStatus(#PB_Engine3D_NbRenderedTriangles))) 
      
      
      StopDrawing()
      DisplaySprite(monitor,0,0)
      
      MoveCamera(0, KeyX, 0, KeyY)
      ;CameraFollow(0, EntityID(0), 0, EntityY(0) + 0, 200, 0.1, 0.1, #True)
      
      
         FlipBuffers()
         
         Until WindowEvent()=#PB_Event_CloseWindow Or KeyboardPushed(#PB_Key_Escape)
         
      EndIf
   EndIf
EndIf
now the big surprise: comment line 71
SetEntityAttribute(i, #PB_Entity_DisableContactResponse, 1)
and you will see the spheres interact , showing what is like rings, press arrow down to move the camera far away since the shape are expanding, will be more interesting if the loop are 2000 in line 63 For i=1 To 1000 ; number of objects , but my computer suffer from this

run the program again and quickly press space key to throw a cube, and we will see it makes a hole in the shape and rings so still there is physics albeit using AttachEntityObject function.
throw more cubes while moving the camera away.
more testing about this are needed.

Re: sunflower: filling the space tightly with seeds

Posted: Fri Sep 11, 2015 10:48 pm
by IdeasVacuum
:D Shame on anyone that says something cannot be done with PB

Re: sunflower: filling the space tightly with seeds

Posted: Sat Sep 12, 2015 7:26 am
by applePi
just to add, it seems every 2 fibonaci pair are adjacent here in this sunflower pattern, 0, 1, 1, 2, 3, 5, 8, 13, 21, 34, 55, 89, 144, 233, 377, 610, 987, ...
some pairs gives radius better than the others, in line 49
fibo1.f = 13: fibo2.f = 21
it gives this pattern and it is stable:
Image

but fibo1.f = 34: fibo2.f = 55
gives bigger spheres and so the pattern explosive
Image
to stop spheres from colliding uncomment line 72: SetEntityAttribute(i, #PB_Entity_DisableContactResponse, 1)

PB 5.40 beta 3, and disable debugger (until beta 4 announced)

Code: Select all

Structure coor
 x.f
 y.f
 z.f
EndStructure 

Global z.coor
Define.f KeyX , KeyY 
#golden_angle = 137.508 
;#golden_angle = 138.508 ; this results in a very funny shape
Global golden.f = Radian(#golden_angle); = 2.3999 also = golden_angle*PI/180 
;Debug golden
Procedure floret(n.i) 
  r.f : ang.f : xc.f : yc.f
  r = Sqr(n*golden)
  ang = (n*golden)
  xc = r*Cos(ang)
  yc = r*Sin(ang)
  z\x=xc : z\y=yc 
EndProcedure
 

If InitEngine3D()
   InitMouse()
   InitKeyboard()
   InitSprite()
   ExamineDesktops()
If OpenWindow(0, 0, 0, DesktopWidth(0), DesktopHeight(0), "Up/Down  to zoom in/out", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)

If OpenWindowedScreen(WindowID(0), 0, 0, DesktopWidth(0), DesktopHeight(0), 0, 0, 0)
         Add3DArchive(".",#PB_3DArchive_FileSystem)
         Add3DArchive(#PB_Compiler_Home+"Examples\3D\Data\Textures\",#PB_3DArchive_FileSystem)
         Add3DArchive(#PB_Compiler_Home+"Examples\3D\Data\GUI",#PB_3DArchive_FileSystem)
         Add3DArchive(#PB_Compiler_Home + "Examples/3D/Data/Packs/desert.zip", #PB_3DArchive_Zip)
         Parse3DScripts()
         
         Global monitor=CreateSprite(#PB_Any,120,40)
         
         CreateCamera(0,0,0,100,100)
         CameraBackColor(0,RGB(0, 0, 0))
         MoveCamera(0,0,0,200)
         
         CreateLight(0,RGB(255, 255, 95),-50,50,100)
         CreateMaterial(0,TextureID(LoadTexture(#PB_Any,"ground_diffuse.png")))
         CreateMaterial(1,TextureID(LoadTexture(#PB_Any,"Geebee2.bmp")))
         CreateMaterial(2,TextureID(LoadTexture(#PB_Any,"White.jpg")))
         
         ;determine the sphere radius from distance/2 between 2 adjacent spheres
         fibo1.f = 13: fibo2.f = 21
         ;fibo1.f = 34: fibo2.f = 55
         floret(fibo1)
         x1.f=z\x : y1.f = z\y
         floret(fibo2)
         x2.f=z\x : y2.f = z\y
         c.f= (x1-x2)*(x1-x2) + (y1-y2)*(y1-y2)
         c= Sqr(c)
         ;Debug c/2 ;sphere radius
         
         ;rad.f = 0.08*18
         rad.f = c/2
         CreateSphere(0,rad)
         CreateEntity(0,MeshID(0),MaterialID(2))
         CreateEntityBody(0, #PB_Entity_SphereBody, 1, 0.1,0.1)
           
         For i=1 To 1000  ; number of objects
           floret(i)
                     
           CreateEntity(i,MeshID(0),MaterialID(1))
           MoveEntity(i,  z\x, z\y, 0, #PB_Absolute)
           AttachEntityObject(0, "", EntityID(i))
           CreateEntityBody(i, #PB_Entity_SphereBody, 1, 0.1,0.1)
           ;SetEntityAttribute(i, #PB_Entity_DisableContactResponse, 1)
           If i = fibo1 Or i= fibo2 ; just to see 2 adjacent spheres with blue
             SetEntityMaterial(i, MaterialID(0))

           EndIf
           
         Next
          
        CreateLight(0,RGB(255,255,255),-50,40,30)
        AmbientColor(RGB(100,100,100))
   
;SkyBox("desert07.jpg")                        

angleY.f :dir.f = 1
WorldGravity(0) 

;ShowCursor_(1)
Repeat
  ExamineKeyboard()
         
        If KeyboardPushed(#PB_Key_Up)
          KeyY = -20
        ElseIf KeyboardPushed(#PB_Key_Down)
          KeyY = 20
        Else
          KeyY = 0
        EndIf
        
       angleY.f + 0.5*dir
       If angleY >= 10
         dir *-1
       ElseIf angleY <= -10
         dir = 1
           
       EndIf
       
       If KeyboardReleased(#PB_Key_Space)
         
         
         CreateCube(6000+cube, 30)
         CreateEntity(6000, MeshID(6000), MaterialID(0), 50,40,600)
         CreateEntityBody(6000, #PB_Entity_BoxBody, 1, 0.1,0.1)
         ApplyEntityImpulse(6000, 0, 0, -600)
         cube+1
         
       EndIf
       
       
          RotateEntity(0, 0, angleY, 0, #PB_Absolute)
          
          CameraLookAt(0, 0,0,0)
          
          RenderWorld()
              
      StartDrawing(SpriteOutput(monitor))
        DrawText(5,5,"FPS : "+Str(Engine3DStatus(#PB_Engine3D_CurrentFPS )))
        DrawText(5,20,"Tris : "+StrF(Engine3DStatus(#PB_Engine3D_NbRenderedTriangles))) 
      
      
      StopDrawing()
      DisplaySprite(monitor,0,0)
      
      MoveCamera(0, KeyX, 0, KeyY)
      ;CameraFollow(0, EntityID(0), 0, EntityY(0) + 0, 200, 0.1, 0.1, #True)
      
      
         FlipBuffers()
         
         Until WindowEvent()=#PB_Event_CloseWindow Or KeyboardPushed(#PB_Key_Escape)
         
      EndIf
   EndIf
EndIf

Re: sunflower: filling the space tightly with seeds

Posted: Sat Sep 12, 2015 7:37 am
by Keya
applePi wrote:just to add, it seems every 2 fibonaci pair are adjacent here in this sunflower pattern, 0, 1, 1, 2, 3, 5, 8, 13, 21, 34, 55, 89, 144, 233, 377, 610, 987, ...
some pairs gives radius better than the others, in line 49
fibo1.f = 13: fibo2.f = 21
it gives this pattern and it is stable:
but fibo1.f = 34: fibo2.f = 55
gives bigger spheres and so the pattern explosive
makes me wonder how much debugging Mother Nature had to do before she perfected it? :) :) :)

Re: sunflower: filling the space tightly with seeds

Posted: Sat Sep 12, 2015 8:40 am
by applePi
Keya, look at the cracked shape above (with sphere radius calculated with floret(13) and floret(21) , the number of cracks is 34 which are the next fibonaci number 13+21
surely this must interest the physicists, and let us contemplate about saturn rings.. etc etc
note that the physics engine used by purebasic is Bullet engine http://bulletphysics.org
Image

Re: sunflower: filling the space tightly with seeds

Posted: Sat Sep 12, 2015 7:31 pm
by Keya
just watched this 6min TEDx talk - "Arthur Benjamin: The magic of Fibonacci numbers" :)
(no surprise the sunflower spiral makes an early appearance!)
https://www.youtube.com/watch?v=SjSHVDfXHQ4
All times are UTC+01:00
Page 2 of 2

Powered by phpBB® Forum Software © phpBB Limited