Fractale de Newton sur Excel
Script VBA
Sub drawfractal()Dim c As Variantn = 201xmax = 1.2xmin = -1.2ymax = 1.2ymin = -1.2For i = 1 To nFor j = 1 To nc = WorksheetFunction.Complex((ymax - ymin) * (j - 1) / (n - 1) + ymin, (xmax - xmin) * (i - 1) / (n - 1) + xmin)If c = WorksheetFunction.Complex(0, 0) ThenElseCall iterate(c, Range("A1").Offset(i - 1, j - 1))End IfNextNextEnd SubSub iterate(c As Variant, cel As Range)k = 1cond = TrueZ0 = cWhile cond = TrueZ = 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 Thencond = Falsecel.Interior.Color = vbRedElseIf WorksheetFunction.ImAbs(WorksheetFunction.ImSub(Z, WorksheetFunction.Complex(Cos(2 * WorksheetFunction.Pi() / 3), Sin(2 * WorksheetFunction.Pi() / 3)))) < 0.001 Thencond = Falsecel.Interior.Color = vbGreenElseIf WorksheetFunction.ImAbs(WorksheetFunction.ImSub(Z, WorksheetFunction.Complex(Cos(4 * WorksheetFunction.Pi() / 3), Sin(4 * WorksheetFunction.Pi() / 3)))) < 0.001 Thencond = Falsecel.Interior.Color = vbBlueEnd Ifk = k + 1If k > 255 Thencond = Falsecel.Interior.Color = vbBlackEnd IfZ0 = ZDebug.Print kWendEnd Sub
Script VBA version texte
Sub drawfractal()Dim c As Variantn = 201xmax = 1.2xmin = -1.2ymax = 1.2ymin = -1.2For i = 1 To nFor j = 1 To nc = WorksheetFunction.Complex((ymax - ymin) * (j - 1) / (n - 1) + ymin, (xmax - xmin) * (i - 1) / (n - 1) + xmin)If c = WorksheetFunction.Complex(0, 0) ThenElseCall iterate(c, Range("A1").Offset(i - 1, j - 1))End IfNextNextEnd SubSub iterate(c As Variant, cel As Range)k = 1cond = TrueZ0 = cWhile cond = TrueZ = 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 Thencond = Falsecel = 0ElseIf WorksheetFunction.ImAbs(WorksheetFunction.ImSub(Z, WorksheetFunction.Complex(Cos(2 * WorksheetFunction.Pi() / 3), Sin(2 * WorksheetFunction.Pi() / 3)))) < 0.001 Thencond = Falsecel = 1ElseIf WorksheetFunction.ImAbs(WorksheetFunction.ImSub(Z, WorksheetFunction.Complex(Cos(4 * WorksheetFunction.Pi() / 3), Sin(4 * WorksheetFunction.Pi() / 3)))) < 0.001 Thencond = Falsecel = 2End Ifk = k + 1If k > 255 Thencond = Falsecel.Interior.Color = vbBlackEnd IfZ0 = ZDebug.Print kWendEnd Sub
Commentaires