Figures fractales

Sujet: Figures fractales $Figures fractales Empty$ Mer 10 Mar 2021 - 8:22

Voici une version améliorée du programme mandel.bas fourni avec FBCroco (dans exemples\fractal).

Cette version vous permet :

- de zoomer ou dezoomer avec la souris

- d'enregistrer l'image en pressant la touche S

- d'essayer différents exemples

Un tutoriel (version actualisée d'un ancien article de "Panoramic Le Mag") sera disponible sous peu.

Code:: ' **********************************************************************
' Ensemble de Mandelbrot : f(z) = z^2 + c
' **********************************************************************

' Parametres de base (a modifier eventuellement)

const PicWidth = 800 ' Largeur de l'image
const PicHeight = 600 ' Hauteur de l'image
const InsideCol = CL_BLANC ' Couleur de la partie interne

dim Nom$ ' Nom de l'image
dim x0 ' Coord. X du centre
dim y0 ' Coord. Y du centre
dim MaxIter% ' Nb maxi d'iterations
dim ZoomFact ' Facteur de zoom
dim DistFact ' Plus negatif ==> contour plus sombre
dim ColorFact ' 0 pour noir et blanc, positif pour bandes de couleur

' ----------------------------------------------------------------------
' Exemples
' ----------------------------------------------------------------------

init_params "mandel_2", -0.75, 0, 200, 1.75, -2, -2

' Modes de coloration

' init_params "mandel_2_bw",-0.75,0,200,1.75,-2,0

' init_params "seahorse_bw",-0.7468,0.1176,5000,450,-1,0
' init_params "seahorse_color1",-0.7468,0.1176,5000,450,-1,-1
' init_params "seahorse_color2",-0.7468,0.1176,5000,450,-1,-2
' init_params "seahorse_color3",-0.7468,0.1176,5000,450,-1,-3
' init_params "seahorse_color4",-0.7468,0.1176,5000,450,-1,-4
' init_params "seahorse_stripes",-0.7468,0.1176,5000,450,-1,4

' Vallee des hippocampes

' init_params "seahorse_01",-0.762162698412697,0.165337301587302,2000,50,-1,-1.5
' init_params "seahorse_02a",-0.7957738095238091,0.171892857142858,2000,150,-1,-1.5
' init_params "seahorse_02b",-0.7468,0.1176,5000,450,-1,-1.5
' init_params "seahorse_03a",-0.74625,0.1158,10000,750,-1,-1.5
' init_params "seahorse_03b",-0.744803703703705,0.120974074074075,5000,2000,-1,-1.5
' init_params "seahorse_04",-0.744749537037038,0.121665740740742,5000,50000,-1,-1.5
' init_params "seahorse_05",-0.7447456537037051,0.121662424074075,5000,500000,-1,-1.5
' init_params "seahorse_06",-0.744746939953705,0.121662035882409,20000,2750000000,-1,-9
' init_params "seahorse_07",-0.744746939946288,0.121662035869326,20000,500000000000,0,-10
' init_params "seahorse_08",-0.744746939946223,0.121662035869296,20000,5000000000000,0,-10
' init_params "seahorse_09",-0.746254444444444,0.115045907407408,10000,1000000,-1,-6

' Vallee des elephants

' init_params "elephant_01",0.26838935290119,-0.00426891361428578,3000,2000,-1,-1.5
' init_params "elephant_02",0.26919185290119,-0.00441266361428578,3000,20000,-1,-3
' init_params "elephant_03",0.26502185290119,0.00302941971904756,10000,10000000,-1,-9
' init_params "elephant_04",0.26502185290119,0.00302941971904756,10000,100000000,-1,-8
' init_params "elephant_05",0.26502185290119,0.00302941971904756,10000,1000000000,-1,-8

' Vallee des sceptres

' init_params "scepter_01",-1.25530452380952,0.0265361904761905,5000,1000,-1,-3
' init_params "scepter_02",-1.253810337142853,0.0275574704761905,6250,5000,-1,-3.3
' init_params "scepter_03",-1.25522077380953,0.0288953571428572,10000,20000,-1,-4

' Antenne

' init_params "antenna_01",-1.7480997857143,0,200,300000,0,-3
' init_params "antenna_02",-1.7480997857143,0,2000,10000000,0,-3

' **********************************************************************

' Parametres supplementaires

const HalfPicWidth = PicWidth \ 2
const HalfPicHeight = PicHeight \ 2

const Esc = 1.0E+10 ' Rayon d'echappement
const LnEsc = log(Esc)
const Ln2 = log(2)

dim ColFact, AbsCol, ScaleFact

SetParams()

' **********************************************************************

' Programme principal

dim x%, y%, btn%, key$

mode 3, "Clic gauche : zoom + / Clic droit : zoom - / S : sauvegarde / ESC : quitte", PicWidth, PicHeight

colormap PicWidth, PicHeight, fadr(mandelbrot)

repeat
get_mouse x, y, btn

if btn = 1 or btn = 2 then
getcoord x0, y0, x, y

SetZoom(btn = 1)
SetParams()

colormap PicWidth, PicHeight, fadr(mandelbrot)
end_if

key = inkey()
if upper(key) = "S" then save()
until key = "ESCAPE"

' **********************************************************************

' Sous-programmes

sub init_params(_Nom$, _x0, _y0, _MaxIter%, _ZoomFact, _DistFact, _ColorFact)
' Initialise les parametres

Nom = _Nom
x0 = _x0
y0 = _y0
MaxIter = _MaxIter
ZoomFact = _ZoomFact
DistFact = _DistFact
ColorFact = _ColorFact
end_sub

sub init_sub (xt, yt, c@, z@, dz@)
' Initialise les iterations au point (xt, yt)

c = cmplx(xt, yt)
z = cmplx(0, 0)
dz = cmplx(0, 0)
end_sub

sub iter_sub (c@, z@, dz@, zn@, dzn@)
' Calcul d'une iteration

zn = z * z + c ' z^2 + c
dzn = 2 * z * dz + 1 ' Derivee dz/dc
end_sub

sub SetParams ()
ColFact = 0.01 * ColorFact
AbsCol = abs(ColFact)
ScaleFact = 4 / (PicHeight * ZoomFact)
end_sub

sub SetZoom (zoom%)
if zoom then
ZoomFact = 5 * ZoomFact
MaxIter = 1.25 * MaxIter
ColorFact = 1.1 * ColorFact
else
ZoomFact = ZoomFact / 5
MaxIter = MaxIter / 1.25
ColorFact = ColorFact / 1.1
end_if
end_sub

function rgbcol% (iter%, q, v)
' Determine la teinte (Hue) et la saturation d'apres le "Continuous Dwell"

dim angle, radius, h, s, r%, g%, b%

if q < 0.5 then
q = 1 - 1.5 * q
angle = 1 - q
else
q = 1.5 * q - 0.5
angle = q
end_if

radius = sqr(q)

if (ColFact > 0) and odd(iter) then
v = 0.85 * v
radius = 0.667 * radius
end if

h = frac(angle * 10) * 360
s = frac(radius)

HSVtoRGB h, s, v, r, g, b
return RGB(r, g, b)
end_function

function mdbcol% (iter%, mz, mdz)
' Coloration pour les ensembles de Mandelbrot/Julia
' Retourne la couleur RGB d'un point en fonction de :
' iter = nb d'iterations
' mz, mdz = modules de z et de (dz/dc) a l'iteration iter
' Methode de coloration d'apres R. Munafo (http://mrob.com/pub/muency/color.html)

dim lmz, dist, dwell, dscale, q, v

' Determiner la luminosite (Value) d'apres l'estimateur de distance

lmz = log(mz)

dist = 2 * mz * lmz / mdz
dscale = log(dist / ScaleFact) / Ln2 + DistFact

if dscale > 0 then
v = 1
elseif dscale > -8 then
v = 1 + dscale / 8
else
v = 0
end_if

dwell = iter + log(LnEsc / lmz) / Ln2
q = log(abs(dwell)) * AbsCol
return rgbcol(iter, q, v)
end_function

function mandelbrot% (x%, y%)
' Iteration de la fonction complexe au point (x, y)

dim iter%
dim c@, z@, dz@, zn@, dzn@
dim xt, yt, mz, mdz

xt = x0 + ScaleFact * (x - HalfPicWidth)
yt = y0 + ScaleFact * (y - HalfPicHeight)

init_sub xt, yt, c, z, dz

iter = 0
mz = cabs(z)

while iter < MaxIter and mz < Esc
iter_sub c, z, dz, zn, dzn
z = zn
dz = dzn
mz = cabs(z)
iter = iter + 1
wend

if iter = MaxIter then return InsideCol

mdz = cabs(dz)
return mdbcol(iter, mz, mdz)
end_function

sub getcoord (x0, y0, x%, y%)
' Calcule les coordonnees (x0,y0) du centre
' d'apres la position (x,y) de la souris

x0 = x0 + ScaleFact * (x - HalfPicWidth)
y0 = y0 + ScaleFact * (y - HalfPicHeight)
end_sub

sub save ()
' Sauvegarde l'image et les parametres

img_save Nom + ".png"
openout #1, Nom + ".par"
write #1, Nom, x0, y0, MaxIter, ZoomFact, DistFact, ColorFact
closeout #1
end_sub

Sujet: Re: Figures fractales $Figures fractales Empty$ Mer 10 Mar 2021 - 19:36

Le tutoriel est disponible ici

Et voici la version améliorée pour l'ensemble de Julia :

Code:: ' **********************************************************************
' Ensemble de Julia : f(z) = z^2 + c, c = (cx, cy)
' **********************************************************************

' Parametres de base (a modifier eventuellement)

const PicWidth = 800 ' Largeur de l'image
const PicHeight = 600 ' Hauteur de l'image
const InsideCol = CL_BLANC ' Couleur de la partie interne

dim Nom$ ' Nom de l'image
dim x0 ' Coord. X du centre
dim y0 ' Coord. Y du centre
dim MaxIter% ' Nb maxi d'iterations
dim ZoomFact ' Facteur de zoom
dim DistFact ' Plus negatif ==> contour plus sombre
dim ColorFact ' 0 pour noir et blanc, positif pour bandes de couleur
dim cx ' Partie reelle de c
dim cy ' Partie imaginaire de c

' ----------------------------------------------------------------------
' Exemples
' ----------------------------------------------------------------------

' init_params "julia_2_a", 0, 0, 1000, 1.75, -2, -2, -0.75, 0
init_params "julia_2_b", 0, 0, 1000, 1.75, -2, -2, -0.75, 0.1
' init_params "julia_2_c", 0, 0, 1000, 1.75, -2, -2, -0.4, 0.6
' init_params "julia_2_d", 0, 0, 1000, 1.6, -2, -2, 0.39, 0.2
' init_params "julia_scepter_01",0,0,5000,1.5,-1,-2,-1.25567119047619,0.0287028571428571
' init_params "julia_scepter_02",0,0,5000,20,-1,-3,-1.25567119047619,0.0287028571428571

' **********************************************************************

' Parametres supplementaires

const HalfPicWidth = PicWidth \ 2
const HalfPicHeight = PicHeight \ 2

const Esc = 1.0E+10 ' Rayon d'echappement
const LnEsc = log(Esc)
const Ln2 = log(2)

dim ColFact, AbsCol, ScaleFact

SetParams()

' **********************************************************************

' Programme principal

dim x%, y%, btn%, key$

mode 3, "Clic gauche : zoom + / Clic droit : zoom - / S : sauvegarde / ESC : quitte", PicWidth, PicHeight

colormap PicWidth, PicHeight, fadr(mandelbrot)

repeat
  get_mouse x, y, btn

  if btn = 1 or btn = 2 then
   getcoord x0, y0, x, y

   SetZoom(btn = 1)
   SetParams()

   colormap PicWidth, PicHeight, fadr(mandelbrot)
  end_if

  key = inkey()
  if upper(key) = "S" then save()
until key = "ESCAPE"

' **********************************************************************

sub init_params(_Nom$, _x0, _y0, _MaxIter%, _ZoomFact, _DistFact, _ColorFact, _cx, _cy)
' Initialise les parametres

  Nom = _Nom
  x0 = _x0
  y0 = _y0
  MaxIter = _MaxIter
  ZoomFact = _ZoomFact
  DistFact = _DistFact
  ColorFact = _ColorFact
  cx = _cx
  cy = _cy
end_sub

sub init_sub (xt, yt, c@, z@, dz@)
' Initialise les iterations au point (xt, yt)

  c = cmplx(cx, cy)
  z = cmplx(xt, yt)
  dz = cmplx(1, 0)
end_sub

sub iter_sub (c@, z@, dz@, zn@, dzn@)
' Calcul d'une iteration

  zn = z * z + c ' z^2 + c
  dzn = 2 * z * dz ' Derivee dz/dc
end_sub

sub SetParams ()
  ColFact = 0.01 * ColorFact
  AbsCol = abs(ColFact)
  ScaleFact = 4 / (PicHeight * ZoomFact)
end_sub

sub SetZoom (zoom%)
  if zoom then
   ZoomFact = 5 * ZoomFact
   MaxIter = 1.25 * MaxIter
   ColorFact = 1.1 * ColorFact
  else
   ZoomFact = ZoomFact / 5
   MaxIter = MaxIter / 1.25
   ColorFact = ColorFact / 1.1
  end_if
end_sub

function rgbcol% (iter%, q, v)
' Determine la teinte (Hue) et la saturation d'apres le "Continuous Dwell"

  dim angle, radius, h, s, r%, g%, b%

  if q < 0.5 then
   q = 1 - 1.5 * q
   angle = 1 - q
  else
   q = 1.5 * q - 0.5
   angle = q
  end_if

  radius = sqr(q)

  if (ColFact > 0) and odd(iter) then
   v = 0.85 * v
   radius = 0.667 * radius
  end if

  h = frac(angle * 10) * 360
  s = frac(radius)

  HSVtoRGB h, s, v, r, g, b
  return RGB(r, g, b)
end_function

function mdbcol% (iter%, mz, mdz)
' Coloration pour les ensembles de Mandelbrot/Julia
' Retourne la couleur RGB d'un point en fonction de :
' iter = nb d'iterations
' mz, mdz = modules de z et de (dz/dc) a l'iteration iter
' Methode de coloration d'apres R. Munafo (http://mrob.com/pub/muency/color.html)

  dim lmz, dist, dwell, dscale, q, v

  ' Determiner la luminosite (Value) d'apres l'estimateur de distance

  lmz = log(mz)

  dist = 2 * mz * lmz / mdz
  dscale = log(dist / ScaleFact) / Ln2 + DistFact

  if dscale > 0 then
   v = 1
  elseif dscale > -8 then
   v = 1 + dscale / 8
  else
   v = 0
  end_if

  dwell = iter + log(LnEsc / lmz) / Ln2
  q = log(abs(dwell)) * AbsCol
  return rgbcol(iter, q, v)
end_function

function mandelbrot% (x%, y%)
' Iteration de la fonction complexe au point (x, y)

  dim iter%
  dim c@, z@, dz@, zn@, dzn@
  dim xt, yt, mz, mdz

  xt = x0 + ScaleFact * (x% - HalfPicWidth)
  yt = y0 + ScaleFact * (y% - HalfPicHeight)

  init_sub xt, yt, c, z, dz

  iter = 0
  mz = cabs(z)

  while iter < MaxIter and mz < Esc
   iter_sub c, z, dz, zn, dzn
   z = zn
   dz = dzn
   mz = cabs(z)
   iter = iter + 1
  wend

  if iter = MaxIter then return InsideCol

  mdz = cabs(dz)
  return mdbcol(iter, mz, mdz)
end_function

sub getcoord (x0, y0, x%, y%)
' Calcule les coordonnees (x0,y0) du centre
' d'apres la position (x,y) de la souris

  x0 = x0 + ScaleFact * (x - HalfPicWidth)
  y0 = y0 + ScaleFact * (y - HalfPicHeight)
end_sub

sub save ()
' Sauvegarde l'image et les parametres

  img_save Nom + ".png"
  openout #1, Nom + ".par"
  write #1, Nom, x0, y0, MaxIter, ZoomFact, DistFact, ColorFact, cx, cy
  closeout #1
end_sub

Sujet: Re: Figures fractales $Figures fractales Empty$ Sam 13 Mar 2021 - 17:08

Nouveau programme pour créer les ensembles "multibrot" d'équation z^p + c

Le tutoriel correspondant est ici

Code:: ' **********************************************************************
' Ensemble de Mandelbrot ou Julia : f(z) = z^p + c
' **********************************************************************

' Parametres de base (a modifier eventuellement)

const PicWidth = 800 ' Largeur de l'image
const PicHeight = 600 ' Hauteur de l'image
const InsideCol = CL_BLANC ' Couleur de la partie interne

dim Nom$ ' Nom de l'image
dim p ' Exposant entier ou reel > 1
dim x0 ' Coord. X du centre
dim y0 ' Coord. Y du centre
dim MaxIter% ' Nb maxi d'iterations
dim ZoomFact ' Facteur de zoom
dim DistFact ' Plus negatif ==> contour plus sombre
dim ColorFact ' 0 pour noir et blanc, positif pour bandes de couleur
dim cx, cy ' Constante c pour l'ensemble de Julia
dim Julia& ' Ensemble de Julia ?

' ----------------------------------------------------------------------
' Exemples
' ----------------------------------------------------------------------

init_params "mandel_3",3,0,0,200,1.5,0,-3,0,0
' init_params "mandel_3_5",3.5,0,0,200,1.5,0,-3,0,0
' init_params "mandel_3_85",3.85,0,0,200,1.5,0,-3,0,0
' init_params "mandel_3_85_a",3.85,-0.9,0,1000,15,0,-3,0,0
' init_params "mandel_3_a1",3,-0.426398904761905,-0.0123720833333333,1000,9000,-2,-1.5,0,0
' init_params "mandel_3_a2",3,-0.426376793650794,-0.012252037037037,2000,1000000,-2,-2.7,0,0
' init_params "mandel_3_b1",3,-0.07223249999999951,0.7793075,2000,10000,-2,-4,0,0
' init_params "mandel_3_b2",3,-0.0722908333333329,0.77916,2000,100000,-2,-4,0,0
' init_params "mandel_3_c1",3,-0.162095833333333,1.09059999999999,1000,15000,-2,-3,0,0
' init_params "mandel_3_c2",3,-0.162064722222222,1.09068444444443,2000,200000,-2,-4,0,0
' init_params "mandel_3_d1",3,-0.00352499999999966,1.10407916666666,2000,2000,-2,-1.5,0,0
' init_params "mandel_3_d2",3,-0.00334750083333299,1.10434659749999,3000,10000000,-2,-5,0,0
' init_params "mandel_4",4,0,0,200,1.5,0,-3,0,0
' init_params "julia_3_b",3,0,0,1000,100,-2,-4,-0.15657115,0.818783077777778
' init_params "julia_3_c",3,0,0,2000,75,-2,-3,-0.162065888888889,1.09068990277776
' init_params "julia_5",5,0,0,1000,1.75,-2,-2,-0.5,0.64

' **********************************************************************

' Parametres supplementaires

const HalfPicWidth = PicWidth \ 2
const HalfPicHeight = PicHeight \ 2

const Esc = 1.0E+10 ' Rayon d'echappement
const LnEsc = log(Esc)

dim Lnp : Lnp = log(p)

dim ColFact, AbsCol, ScaleFact

SetParams()

' **********************************************************************

' Programme principal

dim x%, y%, btn%, key$

mode 3, "Clic gauche : zoom + / Clic droit : zoom - / S : sauvegarde / ESC : quitte", PicWidth, PicHeight

colormap PicWidth, PicHeight, fadr(mandelbrot)

repeat
  get_mouse x, y, btn

  if btn = 1 or btn = 2 then
   getcoord x0, y0, x, y

   SetZoom(btn = 1)
   SetParams()

   colormap PicWidth, PicHeight, fadr(mandelbrot)
  end_if

  key = inkey()
  if upper(key) = "S" then save()
until key = "ESCAPE"

' **********************************************************************

' Sous-programmes

sub init_params(_Nom$, _p, _x0, _y0, _MaxIter%, _ZoomFact, _DistFact, _ColorFact, _cx, _cy)
' Initialise les parametres

  Nom = _Nom
  p = _p
  x0 = _x0
  y0 = _y0
  MaxIter = _MaxIter
  ZoomFact = _ZoomFact
  DistFact = _DistFact
  ColorFact = _ColorFact
  cx = _cx
  cy = _cy

  Julia = (cx <> 0) and (cy <> 0)
end_sub

sub init_sub (xt, yt, c@, z@, dz@)
' Initialise les iterations au point (xt, yt)

  if Julia then
   c = cmplx(cx, cy)
   z = cmplx(xt, yt)
   dz = cmplx(1, 0)
  else
   c = cmplx(xt, yt)
   z = cmplx(0, 0)
   dz = cmplx(0, 0)
  end if
end_sub

sub iter_sub (c@, z@, dz@, zn@, dzn@)
' Calcul d'une iteration

  dim zpm1@

  zpm1 = z ^ (p - 1) ' z^(p-1)
  zn = z * zpm1 + c ' z^p + c
  dzn = p * zpm1 * dz ' Derivee : dz/dc

  if not Julia then dzn = dzn + 1
end_sub

sub SetParams ()
  ColFact = 0.01 * ColorFact
  AbsCol = abs(ColFact)
  ScaleFact = 4 / (PicHeight * ZoomFact)
end_sub

sub SetZoom (zoom%)
  if zoom then
   ZoomFact = 5 * ZoomFact
   MaxIter = 1.25 * MaxIter
   ColorFact = 1.1 * ColorFact
  else
   ZoomFact = ZoomFact / 5
   MaxIter = MaxIter / 1.25
   ColorFact = ColorFact / 1.1
  end_if
end_sub

function rgbcol% (iter%, q, v)
' Determine la teinte (Hue) et la saturation d'apres le "Continuous Dwell"

  dim angle, radius, h, s, r%, g%, b%

  if q < 0.5 then
   q = 1 - 1.5 * q
   angle = 1 - q
  else
   q = 1.5 * q - 0.5
   angle = q
  end_if

  radius = sqr(q)

  if (ColFact > 0) and odd(iter) then
   v = 0.85 * v
   radius = 0.667 * radius
  end if

  h = frac(angle * 10) * 360
  s = frac(radius)

  HSVtoRGB h, s, v, r, g, b
  return RGB(r, g, b)
end_function

function mdbcol% (iter%, mz, mdz)
' Coloration pour les ensembles de Mandelbrot/Julia
' Retourne la couleur RGB d'un point en fonction de :
' iter = nb d'iterations
' mz, mdz = modules de z et de (dz/dc) a l'iteration iter
' Methode de coloration d'apres R. Munafo (http://mrob.com/pub/muency/color.html)

  dim lmz, dist, dwell, dscale, q, v

  ' Determiner la luminosite (Value) d'apres l'estimateur de distance

  lmz = log(mz)

  dist = p * mz * lmz / mdz
  dscale = log(dist / ScaleFact) / Lnp + DistFact

  if dscale > 0 then
   v = 1
  elseif dscale > -8 then
   v = 1 + dscale / 8
  else
   v = 0
  end_if

  dwell = iter + log(LnEsc / lmz) / Lnp
  q = log(abs(dwell)) * AbsCol
  return rgbcol(iter, q, v)
end_function

function mandelbrot% (x%, y%)
' Iteration de la fonction complexe au point (x, y)

  dim iter%
  dim c@, z@, dz@, zn@, dzn@
  dim xt, yt, mz, mdz

  xt = x0 + ScaleFact * (x - HalfPicWidth)
  yt = y0 + ScaleFact * (y - HalfPicHeight)

  init_sub xt, yt, c, z, dz

  iter = 0
  mz = cabs(z)

  while iter < MaxIter and mz < Esc
   iter_sub c, z, dz, zn, dzn
   z = zn
   dz = dzn
   mz = cabs(z)
   iter = iter + 1
  wend

  if iter = MaxIter then return InsideCol

  mdz = cabs(dz)
  return mdbcol(iter, mz, mdz)
end_function

sub getcoord (x0, y0, x%, y%)
' Calcule les coordonnees (x0,y0) du centre
' d'apres la position (x,y) de la souris

  x0 = x0 + ScaleFact * (x - HalfPicWidth)
  y0 = y0 + ScaleFact * (y - HalfPicHeight)
end_sub

sub save ()
' Sauvegarde l'image et les parametres

  img_save Nom + ".png"
  openout #1, Nom + ".mult"
  write #1, Nom, p, x0, y0, MaxIter, ZoomFact, DistFact, ColorFact, cx, cy
  closeout #1
end_sub

Nombre de messages : 586 Date d'inscription : 06/01/2012

Les formules me laissent rêveur, mais ton code est très beau, très agréable à lire. Merci !!!

Sujet: Re: Figures fractales $Figures fractales Empty$ Mar 16 Mar 2021 - 9:12

Merci Froggy One !

Oui, les codes sont beaux, mais les images ne sont pas mal non plus Smile

As-tu essayé d'en tracer quelques-unes ?

(C'est pour le Crocodile Basic, évidemment)

Nombre de messages : 586 Date d'inscription : 06/01/2012

Hélas, trois fois hélas, que nenni ! j'ai beaucoup de centres d'intérêt et depuis le virus dont je ne dirai plus le nom, ça ne s'arrange pas, j'ai bien moins de temps libre, je suis obligé de surfer vite fait sur mes sites préférés pour me tenir au courant... la retraite ce sera la rentrée scolaire 2023, en attendant, j'essaie de ne pas trop perdre le fil. Et j'adorerais me mettre pour de bon aux fractales (pour tracer les côtes d'îles imaginaires...)
Bonne continuation en tous les cas !

Sujet: Re: Figures fractales $Figures fractales Empty$ Lun 22 Mar 2021 - 20:43

En attendant la retraite, voici un nouveau programme.

Le tutoriel correspondant est ici

En prime : un autre tutoriel sur la coloration des images.

Code:: ' **********************************************************************
' Ensembles de Mandelbrot / Julia : f(z) = (1 - t) * z^p + t * z^q + c
' **********************************************************************

' Parametres de base (a modifier eventuellement)

const PicWidth = 800 ' Largeur de l'image
const PicHeight = 600 ' Hauteur de l'image
const InsideCol = CL_BLANC ' Couleur de la partie interne

dim Nom$ ' Nom de l'image
dim p% ' Exposant entier > 1
dim q% ' Exposant entier > p
dim t ' Reel 0..1
dim ICP% ' Indice du pt. critique (0..q-p)
dim x0 ' Coord. X du centre
dim y0 ' Coord. Y du centre
dim MaxIter% ' Nb maxi d'iterations
dim ZoomFact ' Facteur de zoom
dim DistFact ' Plus negatif ==> contour plus sombre
dim ColorFact ' 0 pour noir et blanc, positif pour bandes de couleur
dim cx, cy ' Constante c pour l'ensemble de Julia
dim Julia& ' Ensemble de Julia ?

' ----------------------------------------------------------------------
' Exemples
' ----------------------------------------------------------------------

' Influence des points critiques

init_params "2_3_01_0",2,3,0.1,0,-4,0,200,0.5,-2,-3,0,0
' init_params "2_3_01_1",2,3,0.1,1,-13,0,200,0.5,-2,-3,0,0
' init_params "2_4_01_0",2,4,0.1,0,0,0,200,0.5,-2,-3,0,0
' init_params "2_4_01_1",2,4,0.1,1,0,0,200,0.5,-2,-3,0,0
' init_params "2_5_01_0",2,5,0.1,0,0,0,200,0.8,-2,-3,0,0
' init_params "2_5_01_1",2,5,0.1,1,0,-1,200,0.8,-2,-3,0,0
' init_params "2_5_01_2",2,5,0.1,2,-1,0,200,0.8,-2,-3,0,0
' init_params "2_5_01_3",2,5,0.1,3,0,1,200,0.8,-2,-3,0,0
' init_params "2_6_01_0",2,6,0.1,0,0,0,200,1,-2,-3,0,0
' init_params "2_6_01_1",2,6,0.1,1,0,-1,200,1,-2,-3,0,0
' init_params "2_6_01_4",2,6,0.1,4,0,1,200,1,-2,-3,0,0

' Transition (z^2 + c) --> (z^3 + c) (t = 0.1 --> 0.5)

' init_params "2_3_01_a",2,3,0.1,0,-4,0,100,0.5,-2,-3,0,0
' init_params "2_3_01_b",2,3,0.1,0,-8,0,200,2.5,-2,-3,0,0
' init_params "2_3_012_a",2,3,0.12,0,-3,0,200,0.6,-2,-3,0,0
' init_params "2_3_012_b",2,3,0.12,0,-6,0,1000,5,-2,-3,0,0
' init_params "2_3_012_c",2,3,0.12,0,-6.3,0.03,3000,50,-2,-3,0,0
' init_params "2_3_012_d",2,3,0.12,0,-6.28735,0.0064,3000,750,-2,-3,0,0
' init_params "2_3_012_e",2,3,0.12,0,-6.28735,0.0064,4000,3000,-2,-3,0,0
' init_params "2_3_01258_a",2,3,0.1258,0,-3,0,500,0.65,-2,-3,0,0
' init_params "2_3_01258_b",2,3,0.1258,0,-3.753,0,2500,4,-2,-3,0,0
' init_params "2_3_012595",2,3,0.12595,0,-3.753,0,3000,4,-2,-3,0,0
' init_params "2_3_0126",2,3,0.126,0,-3.753,0,3000,4,-2,-3,0,0
' init_params "2_3_01262",2,3,0.1262,0,-3.753,0,3000,4,-2,-3,0,0
' init_params "2_3_01266",2,3,0.1266,0,-3.753,0,3000,4,-2,-3,0,0
' init_params "2_3_0127",2,3,0.127,0,-3.753,0,3000,4,-2,-3,0,0
' init_params "2_3_01285",2,3,0.1285,0,-3,0,1000,0.65,-2,-3,0,0
' init_params "2_3_014",2,3,0.14,0,-3,0,1000,0.65,-2,-3,0,0
' init_params "2_3_017",2,3,0.17,0,-3,0,1000,0.65,-2,-3,0,0
' init_params "2_3_022",2,3,0.22,0,-3,0,1000,0.65,-2,-3,0,0
' init_params "2_3_028_a",2,3,0.28,0,-3,0,1000,0.65,-2,-3,0,0
' init_params "2_3_028_b",2,3,0.28,0,-1.093,-1.591,500,4,-2,-3,0,0
' init_params "2_3_03",2,3,0.3,0,-1.011,-1.591,500,4,-2,-3,0,0
' init_params "2_3_032",2,3,0.32,0,-0.95,-1.575,500,4,-2,-3,0,0
' init_params "2_3_04",2,3,0.4,0,-0.663,-1.539,500,4,-2,-3,0,0
' init_params "2_3_05",2,3,0.5,0,-0.75,0,1000,1,-2,-3,0,0

' Exemples supplementaires

' init_params "2_3_01_0_a",2,3,0.1,0,-0.929168541666667,0.236688233333334,1000,10000000,-2,-3,0,0
' init_params "2_3_01_0_b",2,3,0.1,0,-0.929168541666667,0.236688227833334,1000,100000000,-2,-3,0,0
' init_params "2_3_022_0_a",2,3,0.22,0,-2.42786858974359,0.882003205128205,5000,400,-2,-3,0,0
' init_params "2_3_022_0_b",2,3,0.22,0,-2.42786858974359,0.881642788461538,5000,3000,-2,-7,0,0
' init_params "2_3_028_0_a",2,3,0.28,0,-0.927206249999998,-1.25623958333333,2000,400,-2,-3,0,0
' init_params "2_3_028_0_b",2,3,0.28,0,-0.925643749999999,-1.25973958333333,2000,4000,-2,-3,0,0
' init_params "2_3_028_0_c",2,3,0.28,0,-0.926033333333332,-1.26001458333333,2000,10000,-2,-3,0,0
' init_params "2_3_028_0_d",2,3,0.28,0,-0.92603,-1.26015125,2000,100000,-2,-3,0,0
' init_params "2_4_02_0_a",2,4,0.2,0,0.800160875,0.621770458333332,1000,200000,-1,-6,0,0
' init_params "2_4_02_0_b",2,4,0.2,0,0.800160875,0.621770458333332,1000,1000000,-1,-7,0,0
' init_params "2_4_02_0_c",2,4,0.2,0,0.8001609333333331,0.621770424999999,2000,3000000,-1,-8,0,0
' init_params "2_4_02_0_d",2,4,0.2,0,0.800158591229444,0.621770509641665,5000,5000000000,-1,-10,0,0

' **********************************************************************

' Parametres supplementaires

const HalfPicWidth = PicWidth \ 2
const HalfPicHeight = PicHeight \ 2

const Esc = 1.0E+10 ' Rayon d'echappement
const LnEsc = log(Esc)

dim Lnp : Lnp = log(p)

dim ColFact, AbsCol, ScaleFact

SetParams()

' **********************************************************************

' Programme principal

dim x%, y%, btn%, key$

mode 3, "Clic gauche : zoom + / Clic droit : zoom - / S : sauvegarde / ESC : quitte", PicWidth, PicHeight

colormap PicWidth, PicHeight, fadr(mandelbrot)

repeat
  get_mouse x, y, btn

  if btn = 1 or btn = 2 then
   getcoord x0, y0, x, y

   SetZoom(btn = 1)
   SetParams()

   colormap PicWidth, PicHeight, fadr(mandelbrot)
  end_if

  key = inkey()
  if upper(key) = "S" then save()
until key = "ESCAPE"

' **********************************************************************

' Sous-programmes

sub init_params(_Nom$, _p%, _q%, _t, _ICP%, _x0, _y0, _MaxIter%, _ZoomFact, _DistFact, _ColorFact, _cx, _cy)
' Initialise les parametres

  Nom = _Nom
  p = _p
  q = _q
  t = _t
  ICP = _ICP
  x0 = _x0
  y0 = _y0
  MaxIter = _MaxIter
  ZoomFact = _ZoomFact
  DistFact = _DistFact
  ColorFact = _ColorFact
  cx = _cx
  cy = _cy

  Julia = (cx <> 0) or (cy <> 0)
end_sub

function CriticalPoint@(ICP%)
' Calcul du point critique d'indice ICP

  if ICP = 0 then return cmplx(0, 0)

  dim n%, k%, r, theta

  n = q - p
  r = ((p / q) * (1 / t - 1)) ^ (1 / n)

  k = ICP - 1
  theta = (2 * k + 1) * Pi / n

  return polar(r, theta)
end_function

sub init_sub (xt, yt, c@, z@, dz@)
' Initialise les iterations au point (xt, yt)

  if Julia then
   c = cmplx(cx, cy)
   z = cmplx(xt, yt)
   dz = cmplx(1, 0)
  else
   c = cmplx(xt, yt)
   z = CriticalPoint(ICP)
   dz = cmplx(0, 0)
  end if
end_sub

sub iter_sub (c@, z@, dz@, zn@, dzn@)
' Calcul d'une iteration

  dim r, zpm1@, zqm1@, rzpm1@, tzqm1@

  r = 1 - t
  zpm1 = z ^ (p - 1)
  zqm1 = z ^ (q - 1)
  rzpm1 = r * zpm1
  tzqm1 = t * zqm1
  zn = (rzpm1 + tzqm1) * z + c ' (1 - t) * z^p + t * z^q + c
  dzn = (p * rzpm1 + q * tzqm1) * dz ' Derivee dz/dc

  if not Julia then dzn = dzn + 1
end_sub

sub SetParams ()
  ColFact = 0.01 * ColorFact
  AbsCol = abs(ColFact)
  ScaleFact = 4 / (PicHeight * ZoomFact)
end_sub

sub SetZoom (zoom%)
  if zoom then
   ZoomFact = 5 * ZoomFact
   MaxIter = 1.25 * MaxIter
   ColorFact = 1.1 * ColorFact
  else
   ZoomFact = ZoomFact / 5
   MaxIter = MaxIter / 1.25
   ColorFact = ColorFact / 1.1
  end_if
end_sub

function rgbcol% (iter%, a, v)
' Determine la teinte (Hue) et la saturation d'apres le "Continuous Dwell"

  dim angle, radius, h, s, rr%, gg%, bb%

  if a < 0.5 then
   a = 1 - 1.5 * a
   angle = 1 - a
  else
   a = 1.5 * a - 0.5
   angle = a
  end_if

  radius = sqr(a)

  if (ColFact > 0) and odd(iter) then
   v = 0.85 * v
   radius = 0.667 * radius
  end if

  h = frac(angle * 10) * 360
  s = frac(radius)

  HSVtoRGB h, s, v, rr, gg, bb
  return RGB(rr, gg, bb)
end_function

function mdbcol% (iter%, mz, mdz)
' Coloration pour les ensembles de Mandelbrot/Julia
' Retourne la couleur RGB d'un point en fonction de :
' iter = nb d'iterations
' mz, mdz = modules de z et de (dz/dc) a l'iteration iter
' Methode de coloration d'apres R. Munafo (http://mrob.com/pub/muency/color.html)

  dim lmz, dist, dwell, dscale, a, v

  ' Determiner la luminosite (Value) d'apres l'estimateur de distance

  lmz = log(mz)

  dist = p * mz * lmz / mdz
  dscale = log(dist / ScaleFact) / Lnp + DistFact

  if dscale > 0 then
   v = 1
  elseif dscale > -8 then
   v = 1 + dscale / 8
  else
   v = 0
  end_if

  dwell = iter + log(LnEsc / lmz) / Lnp
  a = log(abs(dwell)) * AbsCol
  return rgbcol(iter, a, v)
end_function

function mandelbrot% (x%, y%)
' Iteration de la fonction complexe au point (x, y)

  dim iter%
  dim c@, z@, dz@, zn@, dzn@
  dim xt, yt, mz, mdz

  xt = x0 + ScaleFact * (x - HalfPicWidth)
  yt = y0 + ScaleFact * (y - HalfPicHeight)

  init_sub xt, yt, c, z, dz

  iter = 0
  mz = cabs(z)

  while iter < MaxIter and mz < Esc
   iter_sub c, z, dz, zn, dzn
   z = zn
   dz = dzn
   mz = cabs(z)
   iter = iter + 1
  wend

  if iter = MaxIter then return InsideCol

  mdz = cabs(dz)
  return mdbcol(iter, mz, mdz)
end_function

sub getcoord (x0, y0, x%, y%)
' Calcule les coordonnees (x0,y0) du centre
' d'apres la position (x,y) de la souris

  x0 = x0 + ScaleFact * (x - HalfPicWidth)
  y0 = y0 + ScaleFact * (y - HalfPicHeight)
end_sub

sub save ()
' Sauvegarde l'image et les parametres

  img_save Nom + ".png"
  openout #1, Nom + ".mix"
  write #1, Nom, p, q, t, ICP, x0, y0, MaxIter, ZoomFact, DistFact, ColorFact, cx, cy
  closeout #1
end_sub

Sujet: Re: Figures fractales $Figures fractales Empty$ Dim 28 Mar 2021 - 20:26

Ce programme trace les ensembles de Mandelbrot et Julia pour la fonction z^p + c/z^q + k

Le programme clover.bas qui figure déjà dans FBCroco est un cas particulier.

Le tutoriel est ici

Code:: ' **********************************************************************
' Ensembles de Mandelbrot / Julia : f(z) = z^p + c/z^q + k
' **********************************************************************

' Parametres de base (a modifier eventuellement)

const PicWidth = 800 ' Largeur de l'image
const PicHeight = 600 ' Hauteur de l'image
const InsideCol = CL_BLANC ' Couleur de la partie interne

dim Nom$ ' Nom de l'image
dim p% ' Exposant entier > 1
dim q% ' Exposant entier > 0
dim kx, ky ' k = cmplx(kx, ky)
dim x0 ' Coord. X du centre
dim y0 ' Coord. Y du centre
dim MaxIter% ' Nb maxi d'iterations
dim ZoomFact ' Facteur de zoom
dim DistFact ' Plus negatif ==> contour plus sombre
dim ColorFact ' 0 pour noir et blanc, positif pour bandes de couleur
dim cx, cy ' Constante c pour l'ensemble de Julia
dim Julia& ' Ensemble de Julia ?

' ----------------------------------------------------------------------
' Exemples
' ----------------------------------------------------------------------

init_params "2",2,2,0,0,-0.1,0,200,6,-2,-2.2,0,0
' init_params "2_10_a",2,10,0,0,0.042036375,0.0127114583333333,2000,2000000,-2,-3,0,0
' init_params "2_10_b",2,10,0,0,-0.00555555555555556,0.0111111111111111,2000,1.75,-2,-3,0.042036625,0.0127116166666666
' init_params "2_a",2,2,0,0,-0.295045880845238,0.0570284972619047,5000,200000000,-1,-6,0,0
' init_params "2_b",2,2,0,0,0.0198454690476193,0.0546629452380952,10000,3000000,-0.25,-10,0,0
' init_params "3",3,3,0,0,0,0,200,6,-2,-2.5,0,0
' init_params "3_1",3,1,0,0,0,0,1000,3,-2,-2.5,0,0
' init_params "4",4,4,0,0,0,0,200,6,-2,-2.75,0,0
' init_params "4_1",4,1,0,0,0,0,1000,3,-2,-2.7,0,0
' init_params "5",5,5,0,0,0,0,200,6,-2,-3,0,0
' init_params "5_1",5,1,0,0,0,0,1000,3,-2,-2.9,0,0
' init_params "5_5_05_0",5,5,0.5,0,-0.05,0,1000,15,-2,-3,0,0
' init_params "5_5_05_05",5,5,0.5,0.5,-0.1,0,1000,7.5,-2,-3,0,0
' init_params "6",6,6,0,0,0,0,200,6,-2,-3.25,0,0
' init_params "6_1",6,1,0,0,0,0,1000,3,-2,-3.100000000000001,0,0
' init_params "6_a",6,6,0,0,0.171441388888889,0.182951666666667,5000,300000,-2,-3,0,0
' init_params "6_b",6,6,0,0,0.171380555555555,0.182966666666667,1000,3000,-2,-3,0,0
' init_params "6_c",6,6,0,0,0.171441025833334,0.182956736111111,5000,200000000,-2,-5,0,0
' init_params "6_d",6,6,0,0,0.171441026556668,0.182956736185001,5000,20000000000,-2,-4,0,0
' init_params "6_e",6,6,0,0,0.171441026558043,0.182956736185793,5000,200000000000,-2,-5,0,0
' init_params "julia_2_003",2,2,-0.75,0,0,0,1000,1.5,-2,-3,0.03,0
' init_params "julia_2_005",2,2,-0.75,0,0,0,1000,1.5,-2,-3,0.05,0
' init_params "julia_2_01",2,2,0,0,0,0,1000,1.5,-2,-3,0.1,0
' init_params "julia_2_015",2,2,-0.75,0,0,0,1000,1.5,-2,-3,0.15,0
' init_params "julia_2_02",2,2,0,0,0,0,1000,1.5,-2,-3,0.2,0
' init_params "julia_2_03",2,2,0,0,0,0,1000,1.5,-2,-3,0.3,0

' **********************************************************************

' Parametres supplementaires

const HalfPicWidth = PicWidth \ 2
const HalfPicHeight = PicHeight \ 2

const Esc = 1.0E+10 ' Rayon d'echappement
const LnEsc = log(Esc)

dim Lnp : Lnp = log(p)

dim ColFact, AbsCol, ScaleFact

SetParams()

' **********************************************************************

' Programme principal

dim x%, y%, btn%, key$

mode 3, "Clic gauche : zoom + / Clic droit : zoom - / S : sauvegarde / ESC : quitte", PicWidth, PicHeight

colormap PicWidth, PicHeight, fadr(mandelbrot)

repeat
  get_mouse x, y, btn

  if btn = 1 or btn = 2 then
   getcoord x0, y0, x, y

   SetZoom(btn = 1)
   SetParams()

   colormap PicWidth, PicHeight, fadr(mandelbrot)
  end_if

  key = inkey()
  if upper(key) = "S" then save()
until key = "ESCAPE"

' **********************************************************************

' Sous-programmes

sub init_params(_Nom$, _p%, _q%, _kx, _ky, _x0, _y0, _MaxIter%, _ZoomFact, _DistFact, _ColorFact, _cx, _cy)
' Initialise les parametres

  Nom = _Nom
  p = _p
  q = _q
  kx = _kx
  ky = _ky
  x0 = _x0
  y0 = _y0
  MaxIter = _MaxIter
  ZoomFact = _ZoomFact
  DistFact = _DistFact
  ColorFact = _ColorFact
  cx = _cx
  cy = _cy

  Julia = (cx <> 0) or (cy <> 0)
end_sub

sub init_sub (xt, yt, c@, z@, dz@)
' Initialise les iterations au point (xt, yt)

  dim r

  if Julia then
   c = cmplx(cx, cy)
   z = cmplx(xt, yt)
   dz = cmplx(1, 0)
  else
   c = cmplx(xt, yt)
   r = q / p
   z = r * c
   r = 1 / (p + q)
   z = z ^ r
   dz = r * (z / c)
  end_if
end_sub

sub iter_sub (c@, z@, dz@, zn@, dzn@)
' Calcul d'une iteration

  dim pm1, mqm1, r, k@, zpm1@, zp@, zmqm1@, zmq@

  pm1 = p - 1
  mqm1 = - q - 1
  r = 1 / (p + q)
  k = cmplx(kx, ky)

  zpm1 = z ^ pm1 ' z^(p-1)
  zp = zpm1 * z ' z^p
  zmqm1 = z ^ mqm1 ' z^(-q-1)
  zmq = zmqm1 * z ' z^(-q)
  zn = zp + c * zmq + k ' z^p + c * z^(-q) + k
  dzn = (p * zpm1 - q * c * zmqm1) * dz ' Derivee : dz/dc

  if not Julia then dzn = dzn + zmq
end_sub

sub SetParams ()
  ColFact = 0.01 * ColorFact
  AbsCol = abs(ColFact)
  ScaleFact = 4 / (PicHeight * ZoomFact)
end_sub

sub SetZoom (zoom%)
  if zoom then
   ZoomFact = 5 * ZoomFact
   MaxIter = 1.25 * MaxIter
   ColorFact = 1.1 * ColorFact
  else
   ZoomFact = ZoomFact / 5
   MaxIter = MaxIter / 1.25
   ColorFact = ColorFact / 1.1
  end_if
end_sub

function rgbcol% (iter%, a, v)
' Determine la teinte (Hue) et la saturation d'apres le "Continuous Dwell"

  dim angle, radius, h, s, rr%, gg%, bb%

  if a < 0.5 then
   a = 1 - 1.5 * a
   angle = 1 - a
  else
   a = 1.5 * a - 0.5
   angle = a
  end_if

  radius = sqr(a)

  if (ColFact > 0) and odd(iter) then
   v = 0.85 * v
   radius = 0.667 * radius
  end if

  h = frac(angle * 10) * 360
  s = frac(radius)

  HSVtoRGB h, s, v, rr, gg, bb
  return RGB(rr, gg, bb)
end_function

function mdbcol% (iter%, mz, mdz)
' Coloration pour les ensembles de Mandelbrot/Julia
' Retourne la couleur RGB d'un point en fonction de :
' iter = nb d'iterations
' mz, mdz = modules de z et de (dz/dc) a l'iteration iter
' Methode de coloration d'apres R. Munafo (http://mrob.com/pub/muency/color.html)

  dim lmz, dist, dwell, dscale, a, v

  ' Determiner la luminosite (Value) d'apres l'estimateur de distance

  lmz = log(mz)

  dist = p * mz * lmz / mdz
  dscale = log(dist / ScaleFact) / Lnp + DistFact

  if dscale > 0 then
   v = 1
  elseif dscale > -8 then
   v = 1 + dscale / 8
  else
   v = 0
  end_if

  dwell = iter + log(LnEsc / lmz) / Lnp
  a = log(abs(dwell)) * AbsCol
  return rgbcol(iter, a, v)
end_function

function mandelbrot% (x%, y%)
' Iteration de la fonction complexe au point (x, y)

  dim iter%
  dim c@, z@, dz@, zn@, dzn@
  dim xt, yt, mz, mdz

  xt = x0 + ScaleFact * (x - HalfPicWidth)
  yt = y0 + ScaleFact * (y - HalfPicHeight)

  init_sub xt, yt, c, z, dz

  iter = 0
  mz = cabs(z)

  while iter < MaxIter and mz < Esc
   iter_sub c, z, dz, zn, dzn
   z = zn
   dz = dzn
   mz = cabs(z)
   iter = iter + 1
  wend

  if iter = MaxIter then return InsideCol

  mdz = cabs(dz)
  return mdbcol(iter, mz, mdz)
end_function

sub getcoord (x0, y0, x%, y%)
' Calcule les coordonnees (x0,y0) du centre
' d'apres la position (x,y) de la souris

  x0 = x0 + ScaleFact * (x - HalfPicWidth)
  y0 = y0 + ScaleFact * (y - HalfPicHeight)
end_sub

sub save] ()
' Sauvegarde l'image et les parametres

  img_save Nom + ".png"
  openout #1, Nom + ".inv"
  write #1, Nom, p, q, kx, ky, x0, y0, MaxIter, ZoomFact, DistFact, ColorFact, cx, cy
  closeout #1
end_sub

Que sont devenus les habitués du forum (Papydall, Klaus, Minibug ... ) ?

J'espère qu'il ne leur est rien arrivé de fâcheux !

En attendant leur retour, voici une autre incursion dans le monde des fractales :

Code:: ' **********************************************************************
' Ensembles de Mandelbrot / Julia : f(z) = z^k + c (k complexe)
' **********************************************************************

' Parametres de base (a modifier eventuellement)

const PicWidth = 800 ' Largeur de l'image
const PicHeight = 600 ' Hauteur de l'image
const InsideCol = CL_BLANC ' Couleur de la partie interne

dim Nom$ ' Nom de l'image
dim kx, ky ' k = cmplx(kx, ky) (kx > 1)
dim x0 ' Coord. X du centre
dim y0 ' Coord. Y du centre
dim MaxIter% ' Nb maxi d'iterations
dim ZoomFact ' Facteur de zoom
dim DistFact ' Plus negatif ==> contour plus sombre
dim ColorFact ' 0 pour noir et blanc, positif pour bandes de couleur
dim cx, cy ' Constante c pour l'ensemble de Julia
dim Julia& ' Ensemble de Julia ?

' ----------------------------------------------------------------------
' Exemples
' ----------------------------------------------------------------------

' init_params "2_001",2,0.01,-0.75,0,200,1.75,-2,-2,0,0
' init_params "2_002",2,0.02,-0.75,0,200,1.75,-2,-2,0,0
' init_params "2_005",2,0.05,-0.75,0,200,1.75,-2,-2,0,0
' init_params "2_010",2,0.1,-0.75,0,200,1.75,-2,-2,0,0
' init_params "2_1",2,1,0,0,200,0.25,-2,-3,0,0
init_params "2_1_a",2,1,-0.5960672500000011,4.19411523333334,2000,100000,-2,-3,0,0
' init_params "2_1_b",2,1,-0.597965454166667,4.19531195833333,2000,2000,-2,-6,0,0
' init_params "2_1_c",2,1,-0.564232120833334,4.26627862499999,1000,10000,-2,-6,0,0
' init_params "2_1_d",2,1,-0.564454704166667,4.2662404861111,3000,400000,-2,-7,0,0
' init_params "2_1_e",2,1,-5.1698,3.8197,2000,500,-2,-3,0,0
' init_params "2_1_f",2,1,-5.166789,3.82232049999999,2000,200000,-2,-6,0,0
' init_params "2_2",2,2,0,0,200,0.025,-2,-3,0,0
' init_params "2_3",2,3,0,0,200,0.0015,-2,-3,0,0
' init_params "2_4",2,4,0,0,200,7.0e-005,-2,-3,0,0
' init_params "3_01",3,0.1,0,0,200,1.5,-2,-3,0,0
' init_params "4_01",4,0.1,0,0,200,1.5,-2,-3,0,0
' init_params "5_01",5,0.1,0,0,200,1.5,-2,-3,0,0
' init_params "6_01",6,0.1,0,0,200,1.5,-2,-3,0,0

' **********************************************************************

' Parametres supplementaires

const HalfPicWidth = PicWidth \ 2
const HalfPicHeight = PicHeight \ 2

const Esc = 1.0E+10 ' Rayon d'echappement
const LnEsc = log(Esc)

dim Lnkx : Lnkx = log(kx)

dim ColFact, AbsCol, ScaleFact

SetParams()

' **********************************************************************

' Programme principal

dim x%, y%, btn%, key$

mode 3, "Clic gauche : zoom + / Clic droit : zoom - / S : sauvegarde / ESC : quitte", PicWidth, PicHeight

colormap PicWidth, PicHeight, fadr(mandelbrot)

repeat
  get_mouse x, y, btn

  if btn = 1 or btn = 2 then
   getcoord x0, y0, x, y

   SetZoom(btn = 1)
   SetParams()

   colormap PicWidth, PicHeight, fadr(mandelbrot)
  end_if

  key = inkey()
  if upper(key) = "S" then save()
until key = "ESCAPE"

' **********************************************************************

' Sous-programmes

sub init_params(_Nom$, _kx, _ky, _x0, _y0, _MaxIter%, _ZoomFact, _DistFact, _ColorFact, _cx, _cy)
' Initialise les parametres

  Nom = _Nom
  kx = _kx
  ky = _ky
  x0 = _x0
  y0 = _y0
  MaxIter = _MaxIter
  ZoomFact = _ZoomFact
  DistFact = _DistFact
  ColorFact = _ColorFact
  cx = _cx
  cy = _cy

  Julia = (cx <> 0) or (cy <> 0)
end_sub

sub init_sub (xt, yt, c@, z@, dz@)
' Initialise les iterations au point (xt, yt)

  if Julia then
   c = cmplx(cx, cy)
   z = cmplx(xt, yt)
   dz = cmplx(1, 0)
  else
   c = cmplx(xt, yt)
   z = cmplx(0, 0)
   dz = cmplx(0, 0)
  end if
end_sub

sub iter_sub (c@, z@, dz@, zn@, dzn@)
' Calcul d'une iteration

  dim k@, km1@, zkm1@

  k = cmplx(kx, ky)
  km1 = k - 1

  zkm1 = z ^ km1 ' z^(k-1)
  zn = z * zkm1 + c ' z^k + c
  dzn = k * zkm1 * dz ' Derivee : dz/dc

  if not Julia then dzn = dzn + 1
end_sub

sub SetParams ()
  ColFact = 0.01 * ColorFact
  AbsCol = abs(ColFact)
  ScaleFact = 4 / (PicHeight * ZoomFact)
end_sub

sub SetZoom (zoom%)
  if zoom then
   ZoomFact = 5 * ZoomFact
   MaxIter = 1.25 * MaxIter
   ColorFact = 1.1 * ColorFact
  else
   ZoomFact = ZoomFact / 5
   MaxIter = MaxIter / 1.25
   ColorFact = ColorFact / 1.1
  end_if
end_sub

function rgbcol% (iter%, q, v)
' Determine la teinte (Hue) et la saturation d'apres le "Continuous Dwell"

  dim angle, radius, h, s, r%, g%, b%

  if q < 0.5 then
   q = 1 - 1.5 * q
   angle = 1 - q
  else
   q = 1.5 * q - 0.5
   angle = q
  end_if

  radius = sqr(q)

  if (ColFact > 0) and odd(iter) then
   v = 0.85 * v
   radius = 0.667 * radius
  end if

  h = frac(angle * 10) * 360
  s = frac(radius)

  HSVtoRGB h, s, v, r, g, b
  return RGB(r, g, b)
end_function

function mdbcol% (iter%, mz, mdz)
' Coloration pour les ensembles de Mandelbrot/Julia
' Retourne la couleur RGB d'un point en fonction de :
' iter = nb d'iterations
' mz, mdz = modules de z et de (dz/dc) a l'iteration iter
' Methode de coloration d'apres R. Munafo (http://mrob.com/pub/muency/color.html)

  dim lmz, dist, dwell, dscale, q, v

  ' Determiner la luminosite (Value) d'apres l'estimateur de distance

  lmz = log(mz)

  dist = kx * mz * lmz / mdz
  dscale = log(dist / ScaleFact) / Lnkx + DistFact

  if dscale > 0 then
   v = 1
  elseif dscale > -8 then
   v = 1 + dscale / 8
  else
   v = 0
  end_if

  dwell = iter + log(LnEsc / lmz) / Lnkx

  q = log(abs(dwell)) * AbsCol
  return rgbcol(iter, q, v)
end_function

function mandelbrot% (x%, y%)
' Iteration de la fonction complexe au point (x, y)

  dim iter%
  dim c@, z@, dz@, zn@, dzn@
  dim xt, yt, mz, mdz

  xt = x0 + ScaleFact * (x - HalfPicWidth)
  yt = y0 + ScaleFact * (y - HalfPicHeight)

  init_sub xt, yt, c, z, dz

  iter = 0
  mz = cabs(z)

  while iter < MaxIter and mz < Esc
   iter_sub c, z, dz, zn, dzn
   z = zn
   dz = dzn
   mz = cabs(z)
   iter = iter + 1
  wend

  if iter = MaxIter then return InsideCol

  mdz = cabs(dz)
  return mdbcol(iter, mz, mdz)
end_function

sub getcoord (x0, y0, x%, y%)
' Calcule les coordonnees (x0,y0) du centre
' d'apres la position (x,y) de la souris

  x0 = x0 + ScaleFact * (x - HalfPicWidth)
  y0 = y0 + ScaleFact * (y - HalfPicHeight)
end_sub

sub save ()
' Sauvegarde l'image et les parametres

  img_save Nom + ".png"
  openout #1, Nom + ".comp"
  write #1, Nom, kx, ky, x0, y0, MaxIter, ZoomFact, DistFact, ColorFact, cx, cy
  closeout #1
end_sub

A faible résolution les images sont assez irrégulières et fragmentées, mais en agrandissant on peut trouver des images plus intéressantes comme celle-ci :

$Figures fractales 2_1_c10$

Ce programme trace les ensembles de Mandelbrot "inverses modifiés". Le tutoriel est ici.

Code:: ' **********************************************************************
' Ensembles de Mandelbrot / Julia : f(z) = c[(z + k)^p + 1 / (z + k)^q]
' **********************************************************************

' Parametres de base (a modifier eventuellement)

const PicWidth = 800 ' Largeur de l'image
const PicHeight = 600 ' Hauteur de l'image
const InsideCol = CL_BLANC ' Couleur de la partie interne

dim Nom$ ' Nom de l'image
dim p% ' Exposant entier > 1
dim q% ' Exposant entier > 0
dim kx, ky ' k = cmplx(kx, ky)
dim x0 ' Coord. X du centre
dim y0 ' Coord. Y du centre
dim MaxIter% ' Nb maxi d'iterations
dim ZoomFact ' Facteur de zoom
dim DistFact ' Plus negatif ==> contour plus sombre
dim ColorFact ' 0 pour noir et blanc, positif pour bandes de couleur
dim cx, cy ' Constante c pour l'ensemble de Julia
dim Julia& ' Ensemble de Julia ?

' ----------------------------------------------------------------------
' Exemples
' ----------------------------------------------------------------------

init_params "6_6_2",6,6,2,0,-0.75,0,200,2.5,-2,-4,0,0

' init_params "2_12_2",2,12,2,0,-1,0,200,1.75,-2,-3,0,0
' init_params "2_16_2",2,16,2,0,-1,0,200,1.75,-2,-3,0,0
' init_params "2_2_2",2,2,2,0,-0.597901583333334,0,1000,2.2,-2,-3,0,0
' init_params "2_2_2a",2,2,2,0,-0.597901583333334,0,1000,4000,-2,-4,0,0
' init_params "2_2_2b",2,2,2,0,-0.598070333333334,0.000182708333333333,1000,210000,-2,-8,0,0
' init_params "2_2_2_01",2,2,2,0.1,-0.6,0,1000,2.2,-2,-3,0,0
' init_params "2_2_2_05",2,2,2,0.5,-0.6,-0.1,1000,2.2,-2,-3,0,0
' init_params "2_2_2_1",2,2,2,1,-0.6,-0.2,1000,2.2,-2,-3,0,0
' init_params "2_2_2_2",2,2,2,2,-0.6,-0.43,1000,2,-2,-3,0,0
' init_params "2_2_2_2a",2,2,2,2,-0.14172824074074,0.222674537037036,1000,1800,-2,-5,0,0
' init_params "2_2_2_2b",2,2,2,2,-0.141445833333333,0.223406018518517,1000,18000,-2,-5,0,0
' init_params "2_2_2_2c",2,2,2,2,-0.141444444444444,0.223417059259258,2000,300000,-2,-7.000000000000001,0,0
' init_params "2_2_2_2d",2,2,2,2,-0.141447746944444,0.223417425648147,2000,100000000,-2,-10,0,0
' init_params "2_4_2",2,4,2,0,-1,0,200,1.75,-2,-3,0,0
' init_params "2_8_2",2,8,2,0,-1,0,200,1.75,-2,-3,0,0
' init_params "3_3_2",3,3,2,0,-0.597901583333334,0,1000,2.9,-2,-3,0,0
' init_params "3_3_2a",3,3,2,0,-0.196270520114944,0.0543316091954023,1000,10000,-2,-3,0,0
' init_params "3_3_2b",3,3,2,0,-0.196270520114944,0.0543316091954023,2000,80000,-2,-7,0,0
' init_params "3_3_2c",3,3,2,0,-0.196269728448277,0.0543308175287356,2000,260000,-2,-7,0,0
' init_params "3_3_2d",3,3,2,0,-0.196266946076481,0.0543344053492484,2000,75000000,-2,-10,0,0
' init_params "4_4_2",4,4,2,0,-0.790430318965518,0,1000,2.9,-2,-3,0,0
' init_params "4_4_2a",4,4,2,0,-0.0668464109195409,0.0130729885057472,5000,5000,-2,-7.000000000000001,0,0
' init_params "4_4_2b",4,4,2,0,-0.0669642442528742,0.0130448885057473,5000,1000000,-1,-10,0,0
' init_params "5_5_2",5,5,2,0,-0.790430318965518,0,200,2.9,-2,-3,0,0
' init_params "5_5_2a",5,5,2,0,-0.0255841695402307,0.00817583333333337,1000,15000,-2,-2,0,0
' init_params "5_5_2b",5,5,2,0,-2.00833333333333,0,1000,0.7,-2,-2,-0.0255841695402307,0.00817583333333337

' **********************************************************************

' Parametres supplementaires

const HalfPicWidth = PicWidth \ 2
const HalfPicHeight = PicHeight \ 2

const Esc = 1.0E+10 ' Rayon d'echappement
const LnEsc = log(Esc)

dim Lnp : Lnp = log(p)

dim ColFact, AbsCol, ScaleFact

SetParams()

' **********************************************************************

' Programme principal

dim x%, y%, btn%, key$

mode 3, "Clic gauche : zoom + / Clic droit : zoom - / S : sauvegarde / ESC : quitte", PicWidth, PicHeight

colormap PicWidth, PicHeight, fadr(mandelbrot)

repeat
  get_mouse x, y, btn

  if btn = 1 or btn = 2 then
   getcoord x0, y0, x, y

   SetZoom(btn = 1)
   SetParams()

   colormap PicWidth, PicHeight, fadr(mandelbrot)
  end_if

  key = inkey()
  if upper(key) = "S" then save()
until key = "ESCAPE"

' **********************************************************************

' Sous-programmes

sub init_params(_Nom$, _p%, _q%, _kx, _ky, _x0, _y0, _MaxIter%, _ZoomFact, _DistFact, _ColorFact, _cx, _cy)
' Initialise les parametres

  Nom = _Nom
  p = _p
  q = _q
  kx = _kx
  ky = _ky
  x0 = _x0
  y0 = _y0
  MaxIter = _MaxIter
  ZoomFact = _ZoomFact
  DistFact = _DistFact
  ColorFact = _ColorFact
  cx = _cx
  cy = _cy

  Julia = (cx <> 0) or (cy <> 0)
end_sub

sub init_sub (xt, yt, c@, z@, dz@)
' Initialise les iterations au point (xt, yt)

  dim r, k@

  if Julia then
   c = cmplx(cx, cy)
   z = cmplx(xt, yt)
   dz = cmplx(1, 0)
  else
   c = cmplx(xt, yt)
   k = cmplx(kx, ky)
   r = (q / p) ^ (1 / (p + q))
   z = r - k
   dz = cmplx(0, 0)
  end_if
end_sub

sub iter_sub (c@, z@, dz@, zn@, dzn@)
' Calcul d'une iteration

  dim pm1, mqm1, k@, a@, apm1@, ap@, amqm1@, amq@, g@, dg@

  pm1 = p - 1
  mqm1 = - q - 1
  k = cmplx(kx, ky)

  a = z + k
  apm1 = a ^ pm1 ' (z+k)^(p-1)
  ap = apm1 * a ' (z+k)^p
  amqm1 = a ^ mqm1 ' (z+k)^(-q-1)
  amq = amqm1 * a ' (z+k)^(-q)
  g = ap + amq ' (z+k)^p + (z+k)^(-q)
  dg = (p * apm1 - q * amqm1) * dz ' dg/dc
  zn = c * g ' c[(z+k)^p + (z+k)^(-q)]
  dzn = c * dg ' dz/dc

  if not Julia then dzn = dzn + g
end_sub

sub SetParams ()
  ColFact = 0.01 * ColorFact
  AbsCol = abs(ColFact)
  ScaleFact = 4 / (PicHeight * ZoomFact)
end_sub

sub SetZoom (zoom%)
  if zoom then
   ZoomFact = 5 * ZoomFact
   MaxIter = 1.25 * MaxIter
   ColorFact = 1.1 * ColorFact
  else
   ZoomFact = ZoomFact / 5
   MaxIter = MaxIter / 1.25
   ColorFact = ColorFact / 1.1
  end_if
end_sub

function rgbcol% (iter%, a, v)
' Determine la teinte (Hue) et la saturation d'apres le "Continuous Dwell"

  dim angle, radius, h, s, rr%, gg%, bb%

  if a < 0.5 then
   a = 1 - 1.5 * a
   angle = 1 - a
  else
   a = 1.5 * a - 0.5
   angle = a
  end_if

  radius = sqr(a)

  if (ColFact > 0) and odd(iter) then
   v = 0.85 * v
   radius = 0.667 * radius
  end if

  h = frac(angle * 10) * 360
  s = frac(radius)

  HSVtoRGB h, s, v, rr, gg, bb
  return RGB(rr, gg, bb)
end_function

function mdbcol% (iter%, mz, mdz)
' Coloration pour les ensembles de Mandelbrot/Julia
' Retourne la couleur RGB d'un point en fonction de :
' iter = nb d'iterations
' mz, mdz = modules de z et de (dz/dc) a l'iteration iter
' Methode de coloration d'apres R. Munafo (http://mrob.com/pub/muency/color.html)

  dim lmz, dist, dwell, dscale, a, v

  ' Determiner la luminosite (Value) d'apres l'estimateur de distance

  lmz = log(mz)

  if mdz > 0 then
   dist = p * mz * lmz / mdz
   dscale = log(dist / ScaleFact) / Lnp + DistFact

   if dscale > 0 then
   v = 1
   elseif dscale > -8 then
   v = 1 + dscale / 8
   else
   v = 0
   end_if
  end_if

  dwell = iter + log(LnEsc / lmz) / Lnp
  a = log(abs(dwell)) * AbsCol
  return rgbcol(iter, a, v)
end_function

function mandelbrot% (x%, y%)
' Iteration de la fonction complexe au point (x, y)

  dim iter%
  dim c@, z@, dz@, zn@, dzn@
  dim xt, yt, mz, mdz

  xt = x0 + ScaleFact * (x - HalfPicWidth)
  yt = y0 + ScaleFact * (y - HalfPicHeight)

  init_sub xt, yt, c, z, dz

  iter = 0
  mz = cabs(z)

  while iter < MaxIter and mz < Esc
   iter_sub c, z, dz, zn, dzn
   z = zn
   dz = dzn
   mz = cabs(z)
   iter = iter + 1
  wend

  if iter = MaxIter then return InsideCol

  mdz = cabs(dz)
  return mdbcol(iter, mz, mdz)
end_function

sub getcoord (x0, y0, x%, y%)
' Calcule les coordonnees (x0,y0) du centre
' d'apres la position (x,y) de la souris

  x0 = x0 + ScaleFact * (x - HalfPicWidth)
  y0 = y0 + ScaleFact * (y - HalfPicHeight)
end_sub

sub save ()
' Sauvegarde l'image et les parametres

  img_save Nom + ".png"
  openout #1, Nom + ".inv1"
  write #1, Nom, p, q, kx, ky, x0, y0, MaxIter, ZoomFact, DistFact, ColorFact, cx, cy
  closeout #1
end_sub

$Figures fractales 2_12_210$

Nombre de messages : 11 Date d'inscription : 20/09/2008

Ce programme trace les ensembles de Mandelbrot "étoilés". Le tutoriel est ici.

Code:: ' **********************************************************************
' Ensembles de Mandelbrot / Julia: f(z) = [c(z^p - z^q) - 1]^r
' **********************************************************************

' Parametres de base (a modifier eventuellement)

const PicWidth = 800 ' Largeur de l'image
const PicHeight = 600 ' Hauteur de l'image
const InsideCol = CL_BLANC ' Couleur de la partie interne

dim Nom$ ' Nom de l'image
dim p% ' Exposant entier > 1
dim q% ' Exposant entier > 0 (q <> p)
dim r% ' Exposant entier > 1
dim x0 ' Coord. X du centre
dim y0 ' Coord. Y du centre
dim MaxIter% ' Nb maxi d'iterations
dim ZoomFact ' Facteur de zoom
dim DistFact ' Plus negatif ==> contour plus sombre
dim ColorFact ' 0 pour noir et blanc, positif pour bandes de couleur
dim cx, cy ' Constante c pour l'ensemble de Julia
dim Julia& ' Ensemble de Julia ?

' ----------------------------------------------------------------------
' Exemples
' ----------------------------------------------------------------------

init_params "6_5_2",6,5,2,-14,0,500,0.15,-2,-3,0,0
' init_params "10_1_2",10,1,2,-1.5,0,500,1.2,-2,-3,0,0
' init_params "10_1_2a",10,1,2,-0.774305555555555,0.150902777777778,500,300,-1,-3.5,0,0
' init_params "10_1_2b",10,1,2,-0.774944444444444,0.152402777777778,500,3000,-1,-3.5,0,0
' init_params "10_1_2c",10,1,2,-0.774319444444444,0.152266666666667,1000,30000,-1,-4,0,0
' init_params "10_1_2d",10,1,2,-0.774317222222222,0.152262222222223,3000,200000,-1,-5,0,0
' init_params "10_2_2",10,2,2,-1.8,0,500,1,-2,-3,0,0
' init_params "10_3_2",10,3,2,-2.5,0,500,0.8,-2,-3,0,0
' init_params "10_4_2",10,4,2,-3,0,500,0.6,-2,-3,0,0
' init_params "10_9_2",10,9,2,-25,0,500,0.09,-2,-3,0,0
' init_params "15_14_2",15,14,2,-40,0,500,0.058,-2,-3,0,0
' init_params "2_1_2",2,1,2,-3,0,200,0.5,-2,-3,0,0
' init_params "3_2_2",3,2,2,-6,0,200,0.34,-2,-3,0,0
' init_params "3_2_3",3,2,3,-6.5,0,200,0.33,-2,-4,0,0
' init_params "3_2_3a",3,2,3,-11.9625,0,200,1.75,-2,-4,0,0
' init_params "3_2_3b",3,2,3,-1.27272727272727,0,500,1.2,-2,-4,0,0
' init_params "3_2_5a",3,2,5,-12.3902727272727,0,500,2.2,-2,-4,0,0
' init_params "3_2_5b",3,2,5,-0.788,0,500,1.6,-2,-4,0,0
' init_params "3_2_7a",3,2,7,-0.952,0,1000,100,-2,-3,0,0
' init_params "3_2_7b",3,2,7,-1.00275,0,1000,500,-2,-3,0,0
' init_params "3_2_7c",3,2,7,-1.0098721452991,0,2000,2250000,-2,-4,0,0
' init_params "3_2_7d",3,2,7,-1.00110747863248,0,2000,225,-2,-3,0,0
' init_params "4_3_2",4,3,2,-8.5,0,200,0.25,-2,-3,0,0
' init_params "5_4_2",5,4,2,-11,0,200,0.19,-2,-3,0,0
' init_params "6_5_2a",6,5,2,-0.85433333333333,3.17716666666667,200,50,-2,-2,0,0
' init_params "6_5_2b",6,5,2,-0.87602777777778,3.17913888888889,1000,500,-2,-1.7,0,0

' **********************************************************************

' Parametres supplementaires

const HalfPicWidth = PicWidth \ 2
const HalfPicHeight = PicHeight \ 2

const Esc = 1.0E+10 ' Rayon d'echappement
const LnEsc = log(Esc)

dim Lnp : Lnp = log(p)

dim ColFact, AbsCol, ScaleFact

SetParams()

' **********************************************************************

' Programme principal

dim x%, y%, btn%, key$

mode 3, "Clic gauche : zoom + / Clic droit : zoom - / S : sauvegarde / ESC : quitte", PicWidth, PicHeight

colormap PicWidth, PicHeight, fadr(mandelbrot)

repeat
  get_mouse x, y, btn

  if btn = 1 or btn = 2 then
   getcoord x0, y0, x, y

   SetZoom(btn = 1)
   SetParams()

   colormap PicWidth, PicHeight, fadr(mandelbrot)
  end_if

  key = inkey()
  if upper(key) = "S" then save()
until key = "ESCAPE"

' **********************************************************************

' Sous-programmes

sub init_params(_Nom$, _p%, _q%, _r%, _x0, _y0, _MaxIter%, _ZoomFact, _DistFact, _ColorFact, _cx, _cy)
' Initialise les parametres

  Nom = _Nom
  p = _p
  q = _q
  r = _r
  x0 = _x0
  y0 = _y0
  MaxIter = _MaxIter
  ZoomFact = _ZoomFact
  DistFact = _DistFact
  ColorFact = _ColorFact
  cx = _cx
  cy = _cy

  Julia = (cx <> 0) or (cy <> 0)
end_sub

sub init_sub (xt, yt, c@, z@, dz@)
' Initialise les iterations au point (xt, yt)

  dim t

  if Julia then
   c = cmplx(cx, cy)
   z = cmplx(xt, yt)
   dz = cmplx(1, 0)
  else
   c = cmplx(xt, yt)
   t = (q / p) ^ (1 / (p - q))
   z = cmplx(t, 0)
   dz = cmplx(0, 0)
  end_if
end_sub

sub iter_sub (c@, z@, dz@, zn@, dzn@)
' Calcul d'une iteration

  dim pm1, qm1, rm1, zpm1@, zp@, zqm1@, zq@, u@, urm1@, g@, dg@

  pm1 = p - 1
  qm1 = q - 1
  rm1 = r - 1

  zpm1 = z^pm1 ' z^(p-1)
  zp = zpm1 * z ' z^p
  zqm1 = z^qm1 ' z^(q-1)
  zq = zqm1 * z ' z^q
  g = zp - zq
  u = c * g - 1
  urm1 = u^rm1 ' (c * g - 1)^(r-1)
  dg = c * (p * zpm1 - q * zqm1) * dz ' c * dg/dc

  if not Julia then dg = dg + g

  zn = urm1 * u
  dzn = r * dg * urm1
end_sub

sub SetParams ()
  ColFact = 0.01 * ColorFact
  AbsCol = abs(ColFact)
  ScaleFact = 4 / (PicHeight * ZoomFact)
end_sub

sub SetZoom (zoom%)
  if zoom then
   ZoomFact = 5 * ZoomFact
   MaxIter = 1.25 * MaxIter
   ColorFact = 1.1 * ColorFact
  else
   ZoomFact = ZoomFact / 5
   MaxIter = MaxIter / 1.25
   ColorFact = ColorFact / 1.1
  end_if
end_sub

function rgbcol% (iter%, a, v)
' Determine la teinte (Hue) et la saturation d'apres le "Continuous Dwell"

  dim angle, radius, h, s, rr%, gg%, bb%

  if a < 0.5 then
   a = 1 - 1.5 * a
   angle = 1 - a
  else
   a = 1.5 * a - 0.5
   angle = a
  end_if

  radius = sqr(a)

  if (ColFact > 0) and odd(iter) then
   v = 0.85 * v
   radius = 0.667 * radius
  end if

  h = frac(angle * 10) * 360
  s = frac(radius)

  HSVtoRGB h, s, v, rr, gg, bb
  return RGB(rr, gg, bb)
end_function

function mdbcol% (iter%, mz, mdz)
' Coloration pour les ensembles de Mandelbrot/Julia
' Retourne la couleur RGB d'un point en fonction de :
' iter = nb d'iterations
' mz, mdz = modules de z et de (dz/dc) a l'iteration iter
' Methode de coloration d'apres R. Munafo (http://mrob.com/pub/muency/color.html)

  dim lmz, dist, dwell, dscale, a, v

  ' Determiner la luminosite (Value) d'apres l'estimateur de distance

  lmz = log(mz)

  dist = p * mz * lmz / mdz
  dscale = log(dist / ScaleFact) / Lnp + DistFact

  if dscale > 0 then
   v = 1
  elseif dscale > -8 then
   v = 1 + dscale / 8
  else
   v = 0
  end_if

  dwell = iter + log(LnEsc / lmz) / Lnp
  a = log(abs(dwell)) * AbsCol
  return rgbcol(iter, a, v)
end_function

function mandelbrot% (x%, y%)
' Iteration de la fonction complexe au point (x, y)

  dim iter%
  dim c@, z@, dz@, zn@, dzn@
  dim xt, yt, mz, mdz

  xt = x0 + ScaleFact * (x - HalfPicWidth)
  yt = y0 + ScaleFact * (y - HalfPicHeight)

  init_sub xt, yt, c, z, dz

  iter = 0
  mz = cabs(z)

  while iter < MaxIter and mz < Esc
   iter_sub c, z, dz, zn, dzn
   z = zn
   dz = dzn
   mz = cabs(z)
   iter = iter + 1
  wend

  if iter = MaxIter then return InsideCol

  mdz = cabs(dz)
  return mdbcol(iter, mz, mdz)
end_function

sub getcoord (x0, y0, x%, y%)
' Calcule les coordonnees (x0,y0) du centre
' d'apres la position (x,y) de la souris

  x0 = x0 + ScaleFact * (x - HalfPicWidth)
  y0 = y0 + ScaleFact * (y - HalfPicHeight)
end_sub

sub save ()
' Sauvegarde l'image et les parametres

  img_save Nom + ".png"
  openout #1, Nom + ".star"
  write #1, Nom, p, q, r, x0, y0, MaxIter, ZoomFact, DistFact, ColorFact, cx, cy
  closeout #1
end_sub

$Figures fractales 6_5_210$

Epoustouflant !

C’est magnifique !

La fonction zoom sur la partie de l’image ciblée par la souris, fonctionne parfaitement bien. L’image est ultra précise. C’est du grand Art !
Quant au temps de calcul et de génération d’une image complète, il oscille entre moins d’une seconde et 2 secondes, ce qui est très faible vu la complexité de la tâche.

Merci Jean pour tous ces partages !

Merci Marc !

J'essaie actuellement de mettre la multiprécision dans FBCroco. Cela nous permettrait d'aller plus loin dans le zoom, au prix d'une augmentation du temps de calcul évidemment.

Affaire à suivre, donc !

Premiers essais en multiprécision, avec ici des nombres de 30 chiffres (facteur de zoom = 10^18, la version avec les nombres "standard" est limitée à 10^14)

Les temps de calcul sont très longs. L'image est donc parfaitement appropriée Smile

$Figures fractales Mandel12$

Retour sur la zone d'où provient l'image précédente. Ici le zoom n'est "que" de 6,25E+13. C'est pratiquement la limite permise par les réels "standard".

$Figures fractales Mandel13$

Nombre de messages : 2693 Date d'inscription : 13/09/2009

Ooooohhhh, alors ça, c'est vraiment de belles images !!!!!!!
Bravo, Jean_debord, chapeau !!!!!!!!!
cheers

Merci, jjn4 Smile

Voici un agrandissement du centre de l'image précédente. Le zoom de 1.5E+15 nécessite la multiprécision.

$Figures fractales Mandel14$

Agrandissement du centre de l'image précédente. Zoom = 3.0E+16

$Figures fractales Mandel15$

Agrandissement suivant (zoom 1.5E+17). On voit apparaître les escargots fractals.

$Figures fractales Mandel16$

Bonjour Jean

"On retient que le diamètre d’un atome est toujours de l’ordre de : 10-15 m (1 femtomètre)"

http://webphysique.fr/taille-atome/

Very Happy

Bonjour Ouf-ça-passe

Voici quelques informations supplémentaires :

Longueur de Planck ~ 1.6E-35 m (Wikipedia)

Diamètre de l'univers observable ~ 8.8E+26 m (Wikipedia)

Rapport : 5.5E+61

On a encore de la marge !

Mais on peut aller bien plus loin avec l'ensemble de Mandelbrot. La seule limite est la taille des nombres réels que l'ordinateur peut traiter, et la performance des méthodes de coloration.

Agrandissement suivant : 9E+18. On voit apparaître une nouvelle structure au centre de l'image.

$Figures fractales Mandel17$

Agrandissement de l'image précédente (8E+19). On retrouve les escargots et on devine une nouvelle structure au centre.

$Figures fractales Mandel18$

Agrandissement 2E+21. On devine les escargots à la périphérie de la partie mauve, mais au centre qu'y a-t-il ?

$Figures fractales Mandel19$

Au centre, il y a un mini-ensemble de Mandelbrot.

Tel est le jeu : on part au voisinage d'un mini-ensemble et on fait des agrandissements jusqu'à un autre mini-ensemble, en passant par des structures plus ou moins exotiques.

$Figures fractales Mandel20$

» BAO de dessin de figures élémentaires
» Images fractales
» La beauté des fractales
» Fractales "Hopalong"
» Fractales de Newton