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

Comment afficher le mot de passe d’une connexion wifi mémorisé sur une machine Windows

Techniques de Recherche sur google