Fractale de Newton sur Excel



 Script VBA 


Sub drawfractal()
Dim c As Variant
n = 201
xmax = 1.2
xmin = -1.2
ymax = 1.2
ymin = -1.2

For i = 1 To n
    For j = 1 To n
        c = WorksheetFunction.Complex((ymax - ymin) * (j - 1) / (n - 1) + ymin, (xmax - xmin) * (i - 1) / (n - 1) + xmin)
        If c = WorksheetFunction.Complex(0, 0) Then
        Else
            Call iterate(c, Range("A1").Offset(i - 1, j - 1))
        End If
    Next
Next
End Sub

Sub iterate(c As Variant, cel As Range)
k = 1
cond = True
Z0 = c
While cond = True
   Z = WorksheetFunction.ImSub(Z0, WorksheetFunction.ImDiv(WorksheetFunction.ImSub(WorksheetFunction.ImPower(Z0, 3), 1), WorksheetFunction.ImProduct(3, WorksheetFunction.ImPower(Z0, 2))))
   If WorksheetFunction.ImAbs(WorksheetFunction.ImSub(Z, WorksheetFunction.Complex(1, 0))) < 0.001 Then
        cond = False
        cel.Interior.Color = vbRed
    ElseIf WorksheetFunction.ImAbs(WorksheetFunction.ImSub(Z, WorksheetFunction.Complex(Cos(2 * WorksheetFunction.Pi() / 3), Sin(2 * WorksheetFunction.Pi() / 3)))) < 0.001 Then
        cond = False
        cel.Interior.Color = vbGreen
    ElseIf WorksheetFunction.ImAbs(WorksheetFunction.ImSub(Z, WorksheetFunction.Complex(Cos(4 * WorksheetFunction.Pi() / 3), Sin(4 * WorksheetFunction.Pi() / 3)))) < 0.001 Then
        cond = False
        cel.Interior.Color = vbBlue
   End If
   k = k + 1
   If k > 255 Then
    cond = False
    cel.Interior.Color = vbBlack
    End If
    Z0 = Z
    Debug.Print k
Wend
End Sub

Script VBA version texte

Sub drawfractal()
Dim c As Variant
n = 201
xmax = 1.2
xmin = -1.2
ymax = 1.2
ymin = -1.2

For i = 1 To n
    For j = 1 To n
        c = WorksheetFunction.Complex((ymax - ymin) * (j - 1) / (n - 1) + ymin, (xmax - xmin) * (i - 1) / (n - 1) + xmin)
        If c = WorksheetFunction.Complex(0, 0) Then
        Else
            Call iterate(c, Range("A1").Offset(i - 1, j - 1))
        End If
    Next
Next
End Sub

Sub iterate(c As Variant, cel As Range)
k = 1
cond = True
Z0 = c
While cond = True
   Z = WorksheetFunction.ImSub(Z0, WorksheetFunction.ImDiv(WorksheetFunction.ImSub(WorksheetFunction.ImPower(Z0, 3), 1), WorksheetFunction.ImProduct(3, WorksheetFunction.ImPower(Z0, 2))))
   If WorksheetFunction.ImAbs(WorksheetFunction.ImSub(Z, WorksheetFunction.Complex(1, 0))) < 0.001 Then
        cond = False
        cel = 0
    ElseIf WorksheetFunction.ImAbs(WorksheetFunction.ImSub(Z, WorksheetFunction.Complex(Cos(2 * WorksheetFunction.Pi() / 3), Sin(2 * WorksheetFunction.Pi() / 3)))) < 0.001 Then
        cond = False
        cel = 1
    ElseIf WorksheetFunction.ImAbs(WorksheetFunction.ImSub(Z, WorksheetFunction.Complex(Cos(4 * WorksheetFunction.Pi() / 3), Sin(4 * WorksheetFunction.Pi() / 3)))) < 0.001 Then
        cond = False
        cel = 2
   End If
   k = k + 1
   If k > 255 Then
    cond = False
    cel.Interior.Color = vbBlack
    End If
    Z0 = Z
    Debug.Print k
Wend
End Sub



Commentaires

Posts les plus consultés de ce blog

Nom des services Windows en Français et en Anglais

How to determine eigenvalues and eignevectors of a matrix in Excel

Analyse de Fourrier sur Excel