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

Enregistrer un commentaire

Posts les plus consultés de ce blog

Nom des services Windows en Français et en Anglais

Nom long anglais Nom court Nom long français ActiveX Installer (AxInstSV) AxInstSV Programme d’installation ActiveX (AxInstSV) Adaptive Brightness SensrSvc Brillance adaptative Application Experience AeLookupSvc Expérience d’application Application Host Helper Service AppHostSvc Application Host Helper Service Application Identity AppIDSvc Identité de l’application Application Information Appinfo Informations d’application Application Layer Gateway Service ALG Service de la passerelle de la couche Application Application Management AppMgmt Gestion d’applications ASP.NET State Service aspnet_state Service d'état ASP.NET Background Intelligent Transfer Service BITS Service de transfert intelligent en arrière-plan Base Filtering Engine BFE Moteur de filtrage de base BitLocker Drive Encryption Service BDESVC Servic
Lire la suite

Analyse de Fourrier sur Excel

Image
Est-il possible de faire l’analyse de Fourier dans Excel ? C’est-à-dire peut-on connaitre le contenu fréquentiel d’un signal ? La réponse c’est oui. Pour cela nous allons utiliser un outil très puissant « l’utilitaire d’analyse ». Avant de continuer ce tutoriel vérifiez que vous avez cet outil activé. Sur le ruban Données, dans la rubrique analyse, vérifier la présence de l’utilitaire d’analyse. Sinon, dans les options, Cliquer sur Compléments puis en bas dans Gérer choisir Compléments Excel et cliquer sur le bouton atteindre. Vérifier que la case à cocher Analysis ToolPak est choisie L’utilitaire d’analyse comporte beaucoup d’outils. Celui que l’on va voir dans ce tutoriel est la FFT (Transformation de Fourier Rapide). La FFT est un algorithme de calcul de la transformée de Fourier discrète (par opposé à continue) car on manipule une fonction connue en un nombre limité de points. L’algorithme est très rapide lorsque le nombre de points de l’échantillon est une puiss
Lire la suite

How to determine eigenvalues and eignevectors of a matrix in Excel

Image
We would like to compute the eigenvalues and eigenvectors of the following matrix in Excel. BTW Excel does  not have any native function that can do that. \$\begin{bmatrix} 2 & -1 & 0\\-1 & 2 & -1\\0 & -1 & 2\end{bmatrix}\$ The characteristic polynomial of this matrix is : \$det( A - \lambda I)\$ qui donne \$(2 - \lambda)(2 - \sqrt{2} - \lambda)(2 + \sqrt{2} - \lambda)\$ . The analytical eigenvalues solutions are: \$\lambda_1=2 - \sqrt{2}=0.58578644\$, \$\lambda_2=2 \$ and \$\lambda_3=2 + \sqrt{2}=3.41421356\$ The eigenvectors are  : \$\begin{Bmatrix} 1 \\ \sqrt{2}\\1\end{Bmatrix}\$, \$\begin{Bmatrix} 1 \\0\\-1\end{Bmatrix}\$ and  \$\begin{Bmatrix} 1 \\-\sqrt{2}\\1\end{Bmatrix}\$ Procedure 1 st  method We start by creating two columns, one for   l  (from  0 to 4) and the other for   \$ det( A - \lambda I)\$ Then we plot   \$det( A - \lambda I) = f(\lambda)\$ We can clearly see the three zeros of the plotted function.  Eventu
Lire la suite