PureBoard

Das deutsche PureBasic-Forum
https://www.purebasic.fr/german/

Farbberechnung für Mandelbrot-Menge (Rosetta Code)

https://www.purebasic.fr/german/viewtopic.php?t=22107

Seite 1 von 2

Farbberechnung für Mandelbrot-Menge (Rosetta Code)

Verfasst: 20.03.2010 23:31
von Christian H
Hallo,

kennt Einer von euch einen kurzen und durchschaubaren Code für eine Farbverlauf.
Ich habe gerade "Mandelbrot_set" in PureBasic geschrieben, bin aber mit den Farben unzufrieden.

Gruß Christian

Habe das Bild auf rosettacode.org aktualisiert.
Das hier die Alte Version mit der ich unzufrieden war
Bild

Re: Farbberechnung für Mandelbrot-Menge (Rosetta Code)

Verfasst: 21.03.2010 01:39
von STARGÅTE
Versuchs mal mit den "neuen" Gradient-Funktioen:

Hier zum Beispiel CustomGradient() dort kannst du n Farbverlauf angeben und der wird dann benutzt.

n Callback für deine Iteration musst du dann angeben , zB so:

Code: Alles auswählen

Structure FractalGradient
  x.l : y.l : Size.l : MaxIteration.l
EndStructure

Procedure.d Iteration(cx.d, cy.d)
  Shared FractalGradient.FractalGradient
  Protected Iter.l, x.d, y.d, xt.d, yt.d
  While x*x + y*y <= 6 And Iter < FractalGradient\MaxIteration
    xt = x*x - y*y + cx 
    yt = 2*x*y + cy 
    x = xt 
    y = yt
    Iter + 1 
  Wend 
  ProcedureReturn Iter/FractalGradient\MaxIteration
EndProcedure

Procedure.f FractalGradientCallback(x, y)
  Shared FractalGradient.FractalGradient
  With FractalGradient
    ProcedureReturn Iteration((x-\x)/\Size, (y-\y)/\Size)
  EndWith
EndProcedure

Procedure FractalGradient(x, y, Size, MaxIteration)
  Shared FractalGradient.FractalGradient
  With FractalGradient
    \x = x : \y = y : \Size = Size : \MaxIteration = MaxIteration
  EndWith
  CustomGradient(@FractalGradientCallback())
EndProcedure

Enumeration
#Image
#Window
#Gadget
EndEnumeration


CreateImage(#Image, 768, 512)
StartDrawing(ImageOutput(0))
  DrawingMode(#PB_2DDrawing_Gradient)
  FractalGradient(1024, 256, 512, 64)
  GradientColor(0.00, $000000)
  GradientColor(0.06, $0000FF)
  GradientColor(0.12, $00FFFF)
  GradientColor(0.25, $00FF00)
  GradientColor(0.50, $FF0000)
  GradientColor(1.00, $000000)
  Box(0,0,768, 512)
StopDrawing()

OpenWindow(#Window, 0, 0, ImageWidth(#Image), ImageHeight(#Image), "Fractal", #PB_Window_SystemMenu|#PB_Window_ScreenCentered)
ImageGadget(#Gadget,0,0,ImageWidth(#Image), ImageHeight(#Image), ImageID(#Image))

Repeat : Until WaitWindowEvent() = #PB_Event_CloseWindow
Der Callback für CustomGradient muss ein rückgabeWert zwischen 0 und 1 haben.
Welcher dann die AusgabeFarbe bestimmt die bei GradientColor angegeben wurde, ggf duch mischen

Re: Farbberechnung für Mandelbrot-Menge (Rosetta Code)

Verfasst: 21.03.2010 09:27
von Christian H
Zugegeben dein Code hat was. :allright:
Und wenn auch gestern die "neuen" Gradient-Funktionen mir nicht in den Sinn kamen, so hatte ich doch bei Einführung das Handbuch diesbezüglich gelesen, dennoch brauchte ich ein paar Minuten um zu verstehen was du da machst :) (was habe ich da für einen Satz gebaut)
Ich Denke nicht das es so für rosettacode.org geeignet ist.

Gruß Christian

Re: Farbberechnung für Mandelbrot-Menge (Rosetta Code)

Verfasst: 21.03.2010 11:19
von Schlumpf
wie sehen deine Ergebniswerte für das Plot denn aus...
soweit ich mich erinner, bekommt man doch sozusagen "Höhenwerte" aus der Formel,
bzw. Iterationstiefen wann die Formel ausgestiegen ist.
das sind doch fortlaufende Ganzzahlen, oder?

Re: Farbberechnung für Mandelbrot-Menge (Rosetta Code)

Verfasst: 21.03.2010 13:30
von c4s
Christian H hat geschrieben:Ich Denke nicht das es so für rosettacode.org geeignet ist.
Also wenn ich ehrlich bin finde ich Stargates Ergebnis schöner und auch der Code zeigt auf beste Weise, wie man mit den neuen Befehlen arbeiten kann.

Vielleicht könnte man den also als alternative Lösung auch einfügen?

Re: Farbberechnung für Mandelbrot-Menge (Rosetta Code)

Verfasst: 21.03.2010 14:38
von STARGÅTE
Schlumpf hat geschrieben:wie sehen deine Ergebniswerte für das Plot denn aus...
soweit ich mich erinner, bekommt man doch sozusagen "Höhenwerte" aus der Formel,
bzw. Iterationstiefen wann die Formel ausgestiegen ist.
das sind doch fortlaufende Ganzzahlen, oder?
Jo das ist mehr oder weniger das "Problem" das man immer nur ganze Zahlen bekommt, welche am anfang (außen) langsam steigen und zum Zentrum hin immer steiler werden, : 0,1,2,3,6,10,40,100 um mal zu übertreiben.

Da einen guten farbverlauf zu bekommen, der dem Auge gut tun ist schwer.

Ich hatte schon mal damit gespielt die tiefen Iteration abzuflachen, aber sah auch nicht besser aus.

Um bei der Mandelbrotmenge im außeren bereich einen fließenden Übergang zu erzeugen müsste man die Iteration selbst verändern.

Ich habs halt bei mir so gelöst das ich die GradientColors nicht linear angeordnet habe.

Re: Farbberechnung für Mandelbrot-Menge (Rosetta Code)

Verfasst: 21.03.2010 15:01
von Schlumpf
Das eigentliche Problem hierbei ist jetzt ein ansprechender Farbverlauf. Den direkt mit einer Formel aus einem einzigen Ganzzahlwert zu errechnen, ist etwas sehr aufwendig. Es ist besser den vorab in ein Array zu packen.

Dass die Funktion immer steiler wird, ist schon richtig so, dafür wird aber auch der betrachtete Ausschnitt immer kleiner. Schließlich nimmt auch die Turbulenz im gleichen Maße zu, man kann also garnicht anders als den betrachteten Ausschnitt verkleinern. Dadurch funktioniert das eigentlich auch wunderbar wenn man die Iterationstiefe linear auf den Farbverlauf anwendet.

Das Erreichen der Abbruchbedingung sollte man übrigens schwarz einfärben, um zu verdeutlichen, dass hier eine Darstellungsgrenze erreicht ist.

Recht hübsch wird das, wenn man einen gleichmäßig spektralen Farbverlauf von 1024 oder 2048 Werten hat, und mit einer maximalen Tiefe von 32768 arbeitet. Das muss natürlich so gelöst werden, dass es noch schnell genug ist.

Re: Farbberechnung für Mandelbrot-Menge (Rosetta Code)

Verfasst: 21.03.2010 15:34
von Schlumpf
Farbverlauf Beispiel

Code: Alles auswählen

Dim Color.l (511)

For n = 0 To 127
  Color(   0 + n ) = RGB(  64, 2 * n, 0 )
  Color( 128 + n ) = RGB(  64, 255, 2 * n )
  Color( 256 + n ) = RGB(  64, 255 - 2 * n , 255 )
  Color( 384 + n ) = RGB(  64, 0, 255 - 2 * n )
Next

CreateImage(0, 512, 64)
  StartDrawing(ImageOutput(0))
    For n=0 To 511
      LineXY(n,0,n,63,Color(n))
    Next
  StopDrawing()

OpenWindow(0, 0, 0, 512, 64, "Image" )
ImageGadget(0, 0, 0, 512, 64, ImageID(0))
Repeat:Until WaitWindowEvent() = #PB_Event_CloseWindow
Verwendung

Code: Alles auswählen

EnableExplicit

#Window1   = 0
#Image1    = 0
#ImgGadget = 0
 
#max_iteration = 1023
#width         = 800
#height        = 600
Define.d x0 ,y0 ,xtemp ,cr, ci
Define.i i, n, x, y ,Event ,color

Dim Color.l (255)
For n = 0 To 63
  Color(   0 + n ) = RGB(  64, 4 * n, 0 )
  Color(  64 + n ) = RGB(  64, 255, 4 * n )
  Color( 128 + n ) = RGB(  64, 255 - 4 * n , 255 )
  Color( 192 + n ) = RGB(  64, 0, 255 - 4 * n )
Next
 
If OpenWindow(#Window1, 0, 0, #width, #height, "'Mandelbrot set' PureBasic Example", #PB_Window_SystemMenu )
    If CreateImage(#Image1, #width, #height) 
    ImageGadget(#ImgGadget, 0, 0, #width, #height, ImageID(#Image1))
       For x.i = 1 To  #width -1
      StartDrawing(ImageOutput(#Image1))
         For y.i = 1 To #height -1
           x0 = 0 
           y0 = 0;
           cr = (x / #width)*2.5 -2
           ci = (y / #height)*2.5 -1.25
           i = 0
           While  (x0*x0 + y0*y0 <= 4.0) And i < #max_iteration
             i +1
             xtemp = x0*x0 - y0*y0 + cr
             y0    = 2*x0*y0 + ci
             x0    = xtemp
           Wend
           If i >= #max_iteration
              Plot(x, y,  0 )
           Else
              Plot(x, y,  Color(i & 255))
           EndIf
           
         Next
          StopDrawing() 
         SetGadgetState(#ImgGadget, ImageID(#Image1))
         While WindowEvent() : Wend
       Next
    EndIf
 
    Repeat
      Event = WaitWindowEvent()
    Until Event = #PB_Event_CloseWindow
  EndIf

Re: Farbberechnung für Mandelbrot-Menge (Rosetta Code)

Verfasst: 21.03.2010 16:32
von STARGÅTE
So, die Galerie der Iteration fand ich so geil, das ich auch eine gemacht habe:
Bild

Hinweis: Langsammere Computer sollten die Größe der ausgabe (also #Size) irgendwo bei 100-200 legen, schnellere PCs können hoch geben auf 400. In allen Fällen aber Debugger ausschalten, da es sonst 4mal länger dauert!

Code: Alles auswählen

Enumeration
 #Window : #Gadget : #Image : #Timer : #Button
EndEnumeration


; Größe der Ausgabe (Mal 3x2)
#Size = 250


Structure Complex
  Re.f : Im.f
EndStructure

Procedure HSV(Hue.f, Saturation.f, Value.f)
  Protected H = Int(Hue/60)
  Protected f.f = (Hue/60-H)
  Protected S.f = Saturation
  Protected V.f = Value * 255
  Protected p = V * (1-S)
  Protected q = V * (1-S*f)
  Protected t = V * (1-S*(1-f))
  Select H
    Case 1 : ProcedureReturn RGB(q,V,p)
    Case 2 : ProcedureReturn RGB(p,V,t)
    Case 3 : ProcedureReturn RGB(p,q,V)  
    Case 4 : ProcedureReturn RGB(t,p,V)
    Case 5 : ProcedureReturn RGB(V,p,q)  
    Default : ProcedureReturn RGB(V,t,p)
  EndSelect
EndProcedure 

Procedure.d ComplexAngle(*Complex.Complex)
  Protected Angle.f
  With *Complex
    Angle = ATan(\Im/\Re)
    If \Re < 0 : Angle + #PI : ElseIf Angle < 0 :  Angle + 2*#PI : EndIf
  EndWith
  ProcedureReturn Angle
EndProcedure



Global Dim Iteration.Complex(#Size*3, #Size*2)

Procedure CustomCallback(x, y, Color1, Color2)
  Protected Add.Complex : Add\Re = x/#Size-2 : Add\Im = y/#Size-1
  Protected Angle.f, Length.f, Darkness.f, Brightness.f, Temp.f
  Protected *Value.Complex = @Iteration(x, y)
  With *Value
    Temp = \Re*\Re - \Im*\Im
    \Im = 2*\Re*\Im + Add\Im
    \Re = Temp + Add\Re
    Length = Sqr(\Re*\Re+\Im*\Im)
    Angle = ComplexAngle(*Value)*180/#PI
  EndWith 
  If Length > 1e3 Or Length < 0
    Darkness = 0 : Brightness = 1
  ElseIf Length < 1
    Darkness = 1 : Brightness = Sqr(Length)
  Else
    Darkness = 1/Length : Brightness = 1
  EndIf
  ProcedureReturn HSV(Angle, Brightness, Darkness)
EndProcedure


CreateImage(#Image, #Size*3, #Size*2)

OpenWindow(#Window, 0, 0, ImageWidth(#Image), ImageHeight(#Image)+20, "Image", #PB_Window_MinimizeGadget|#PB_Window_ScreenCentered)
 ImageGadget(#Gadget, 0, 20, ImageWidth(#Image), ImageHeight(#Image), ImageID(#Image))
 ButtonGadget(#Button, 0, 0, #Size*3, 20, "Nächte Iteration")

Repeat
 Event = WaitWindowEvent()
 Select Event
  Case #PB_Event_Gadget
   Select EventGadget()
    Case #Button
     StartDrawing(ImageOutput(#Image))
      DrawingMode(#PB_2DDrawing_Transparent|#PB_2DDrawing_CustomFilter)
      CustomFilterCallback(@CustomCallback())
      Box(0, 0, #Size*3, #Size*2)
     StopDrawing()
     SetGadgetState(#Gadget, ImageID(#Image))
   EndSelect
  Case #PB_Event_CloseWindow
   End
 EndSelect
ForEver
PS: wer keinen Regenbogen haben will (Farbe abhängige vom Winkel der komplexen Zahl) kann unten bei
ProcedureReturn HSV(Angle, Brightness, Darkness)
Angel duch einen beliebigen Winkel ersetzen (0=Rot, 120=Grün, 240=Blau), dann wäre es ein anderer Farbverlauf


______


Hier noch n Variante mit Julia-Mengen:
Bild

Code: Alles auswählen

Enumeration
 #Window : #Gadget : #Image : #Timer : #Button
EndEnumeration



; Größe der Ausgabe (Mal 3x2)
#Size = 250
#ShiftRe = -0.8
#ShiftIm = 0.4



Structure Complex
  Re.f : Im.f
EndStructure

Procedure HSV(Hue.f, Saturation.f, Value.f)
  Protected H = Int(Hue/60)
  Protected f.f = (Hue/60-H)
  Protected S.f = Saturation
  Protected V.f = Value * 255
  Protected p = V * (1-S)
  Protected q = V * (1-S*f)
  Protected t = V * (1-S*(1-f))
  Select H
    Case 1 : ProcedureReturn RGB(q,V,p)
    Case 2 : ProcedureReturn RGB(p,V,t)
    Case 3 : ProcedureReturn RGB(p,q,V)  
    Case 4 : ProcedureReturn RGB(t,p,V)
    Case 5 : ProcedureReturn RGB(V,p,q)  
    Default : ProcedureReturn RGB(V,t,p)
  EndSelect
EndProcedure 

Procedure.d ComplexAngle(*Complex.Complex)
  Protected Angle.f
  With *Complex
    Angle = ATan(\Im/\Re)
    If \Re < 0 : Angle + #PI : ElseIf Angle < 0 :  Angle + 2*#PI : EndIf
  EndWith
  ProcedureReturn Angle
EndProcedure



Global Dim Iteration.Complex(#Size*3, #Size*2)
  For x = 0 To #Size*3
  For y = 0 To #Size*2
    Iteration(x,y)\Im = y/#Size-1
    Iteration(x,y)\Re = x/#Size-1.5
  Next
  Next 

Procedure CustomCallback(x, y, Color1, Color2)
  Protected Angle.f, Length.f, Darkness.f, Brightness.f, Temp.f
  Protected *Value.Complex = @Iteration(x, y)
  With *Value
    Temp = \Re*\Re - \Im*\Im 
    \Im = 2*\Re*\Im + #ShiftIm
    \Re = Temp + #ShiftRe
    Length = Sqr(\Re*\Re+\Im*\Im)
    Angle = ComplexAngle(*Value)*180/#PI
  EndWith 
  If Length > 1e3 Or Length < 0
    Darkness = 0 : Brightness = 1
  ElseIf Length < 1
    Darkness = 1 : Brightness = Sqr(Length)
  Else
    Darkness = 1/Sqr(Length) : Brightness = 1
  EndIf
  ProcedureReturn HSV(Angle, Brightness, Darkness)
EndProcedure


CreateImage(#Image, #Size*3, #Size*2)

OpenWindow(#Window, 0, 0, ImageWidth(#Image), ImageHeight(#Image)+20, "Image", #PB_Window_MinimizeGadget|#PB_Window_ScreenCentered)
 ImageGadget(#Gadget, 0, 20, ImageWidth(#Image), ImageHeight(#Image), ImageID(#Image))
 ButtonGadget(#Button, 0, 0, #Size*3, 20, "Nächte Iteration")

Repeat
 Event = WaitWindowEvent()
 Select Event
  Case #PB_Event_Gadget
   Select EventGadget()
    Case #Button
     StartDrawing(ImageOutput(#Image))
      DrawingMode(#PB_2DDrawing_Transparent|#PB_2DDrawing_CustomFilter)
      CustomFilterCallback(@CustomCallback())
      Box(0, 0, #Size*3, #Size*2)
     StopDrawing()
     SetGadgetState(#Gadget, ImageID(#Image))
   EndSelect
  Case #PB_Event_CloseWindow
   End
 EndSelect
ForEver
Hier könnt ihr oben
#ShiftRe = -0.8
#ShiftIm = 0.4
verändern, um so eine andere Juliamenge zu erzeugen

Re: Farbberechnung für Mandelbrot-Menge (Rosetta Code)

Verfasst: 21.03.2010 17:42
von Vera
G **l :allright: ~ ich liebe Fraktale

@Christian
bei diesem Thread lohnt es sich glatt, auch auf RosettaCode (vor dem Code) einen Link hierhin zu platzieren - oder ?

cheers ~ Vera
Alle Zeiten sind UTC+02:00
Seite 1 von 2

Powered by phpBB® Forum Software © phpBB Limited

Deutsche Übersetzung durch phpBB.de