Logo GNT
Actualités Tests & Guides Bons Plans
GTA 6 iPhone 17 Copilot Switch 2 Temu ChatGPT Tesla
OVH Cloud OVH Cloud
Entraide Applications Microsoft Office Excel Portraits inattendus de fonctions logiques

Portraits inattendus de fonctions logiques

9 réponses
Avatar
garnote
Bonjour tout le monde,

Après avoir adapté pour VBA un algorithme permettant
d'obtenir une fractale nommée « Triangle de Sierpinski »
en utilisant la fonction logique « Or », je me suis amusé
à modifier un tantinet la macro.
Et ah ! les belles structures qui surgirent alors ;-)
Il me semble que ça vaut le coup d'oil.
Environnement de mes macros :
Résolution 1024 x 768 sur un écran de 17 pouces.
Temps d'exécution de la macro « Quatre_Portraits_Logiques »
sur AuthenticAMD AMD-K6(tm) 3D processor, 256 Mo RAM : 7 minutes.
Qui détient le record de vitesse ?


Sub Affichage()
'Ajoute une feuille et la met en forme:
Sheets.Add
Application.DisplayFullScreen = True
Cells.ColumnWidth = 0.25
Cells.RowHeight = 2.25
With ActiveWindow
.DisplayGridlines = False
.DisplayHeadings = False
.DisplayWorkbookTabs = True
End With
End Sub

Sub Triangle_De_Sierpinski()
Dim i As Integer, j As Integer
Affichage
'Pour noircir 6559 cellules:
For i = 1 To 255
For j = 1 To 255
If (i Or j) = 255 Then Cells(i, j).Interior.ColorIndex = 1
Next j
Next i
End Sub

Sub Portrait_Logique1()
Dim i As Integer, j As Integer
Affichage
'Coloriage de 65 025 cellules:
For i = 1 To 255
For j = 1 To 255
Cells(i, j).Interior.ColorIndex = 1 + ((Abs((i Imp j) + (i Xor j)))
Mod 56)
Next j
Next i
End Sub

Sub Portrait_Logique2()
Dim i As Integer, j As Integer
Affichage
For i = 1 To 255
For j = 1 To 255
Cells(i, j).Interior.ColorIndex = 1 + ((Abs(i Eqv j)) Mod 56)
Next j
Next i
End Sub

Sub Portrait_Logique3()
'Temps d'exécution sur mon ordi: 3 minutes.
Dim i As Integer, j As Integer
Affichage
'Coloriage de 130 050 cellules:
For i = 1 To 510
For j = 1 To 255
Cells(i, j).Interior.ColorIndex = Abs((i Imp j) Or (i + Not (j))) Mod
56
Next j
Next i
'Défilement vertical de la feuille:
For i = 1 To 280
ActiveWindow.SmallScroll Down:=1
Next i
End Sub

Sub Quatre_Portraits_Logiques()
Dim t1, t2
t1 = Time
Triangle_De_Sierpinski
Portrait_Logique1
Portrait_Logique2
Portrait_Logique3
t2 = Time
MsgBox Format(t2 - t1, "hh:mm:ss")
End Sub


Bonne journée,
Serge
Signaler un problème avec ce contenu

9 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Avatar
LSteph
Bonjour Serge,
Bravo, magnifique !
Et ce coup là mon micro n'a pas planté Jean Paul.
Sinon,
Ma femme était dégoutée , elle qui a commencé sa broderie il y a 3 ans...

A bientôt.

lSteph

"garnote" a écrit dans le message de news:

Bonjour tout le monde,

Après avoir adapté pour VBA un algorithme permettant
d'obtenir une fractale nommée « Triangle de Sierpinski »
en utilisant la fonction logique « Or », je me suis amusé
à modifier un tantinet la macro.
Et ah ! les belles structures qui surgirent alors ;-)
Il me semble que ça vaut le coup d'oil.
Environnement de mes macros :
Résolution 1024 x 768 sur un écran de 17 pouces.
Temps d'exécution de la macro « Quatre_Portraits_Logiques »
sur AuthenticAMD AMD-K6(tm) 3D processor, 256 Mo RAM : 7 minutes.
Qui détient le record de vitesse ?


Sub Affichage()
'Ajoute une feuille et la met en forme:
Sheets.Add
Application.DisplayFullScreen = True
Cells.ColumnWidth = 0.25
Cells.RowHeight = 2.25
With ActiveWindow
.DisplayGridlines = False
.DisplayHeadings = False
.DisplayWorkbookTabs = True
End With
End Sub

Sub Triangle_De_Sierpinski()
Dim i As Integer, j As Integer
Affichage
'Pour noircir 6559 cellules:
For i = 1 To 255
For j = 1 To 255
If (i Or j) = 255 Then Cells(i, j).Interior.ColorIndex = 1
Next j
Next i
End Sub

Sub Portrait_Logique1()
Dim i As Integer, j As Integer
Affichage
'Coloriage de 65 025 cellules:
For i = 1 To 255
For j = 1 To 255
Cells(i, j).Interior.ColorIndex = 1 + ((Abs((i Imp j) + (i Xor j)))
Mod 56)
Next j
Next i
End Sub

Sub Portrait_Logique2()
Dim i As Integer, j As Integer
Affichage
For i = 1 To 255
For j = 1 To 255
Cells(i, j).Interior.ColorIndex = 1 + ((Abs(i Eqv j)) Mod 56)
Next j
Next i
End Sub

Sub Portrait_Logique3()
'Temps d'exécution sur mon ordi: 3 minutes.
Dim i As Integer, j As Integer
Affichage
'Coloriage de 130 050 cellules:
For i = 1 To 510
For j = 1 To 255
Cells(i, j).Interior.ColorIndex = Abs((i Imp j) Or (i + Not (j)))
Mod
56
Next j
Next i
'Défilement vertical de la feuille:
For i = 1 To 280
ActiveWindow.SmallScroll Down:=1
Next i
End Sub

Sub Quatre_Portraits_Logiques()
Dim t1, t2
t1 = Time
Triangle_De_Sierpinski
Portrait_Logique1
Portrait_Logique2
Portrait_Logique3
t2 = Time
MsgBox Format(t2 - t1, "hh:mm:ss")
End Sub


Bonne journée,
Serge




Avatar
jps
ben, je vais te dire un truc, LSteph, moi, les procs à la chiche m'a eu du
garnote du québec, il y éperluette que je ne les teste plus : j'ai déjà dû
acheter 12 ordis à cause de notre bouillant prof de maths, alors, tu
comprends LSteph, j'aime bien Boulanger mais quand je vois "coloriage de
65025 cellules", moi qui n'en vois qu'une trentaine sur l'écran, y a des
limites....
jps

"LSteph" a écrit dans le message de
news:
Bonjour Serge,
Bravo, magnifique !
Et ce coup là mon micro n'a pas planté Jean Paul.
Sinon,
Ma femme était dégoutée , elle qui a commencé sa broderie il y a 3 ans...

A bientôt.

lSteph

"garnote" a écrit dans le message de news:

Bonjour tout le monde,

Après avoir adapté pour VBA un algorithme permettant
d'obtenir une fractale nommée « Triangle de Sierpinski »
en utilisant la fonction logique « Or », je me suis amusé
à modifier un tantinet la macro.
Et ah ! les belles structures qui surgirent alors ;-)
Il me semble que ça vaut le coup d'oil.
Environnement de mes macros :
Résolution 1024 x 768 sur un écran de 17 pouces.
Temps d'exécution de la macro « Quatre_Portraits_Logiques »
sur AuthenticAMD AMD-K6(tm) 3D processor, 256 Mo RAM : 7 minutes.
Qui détient le record de vitesse ?


Sub Affichage()
'Ajoute une feuille et la met en forme:
Sheets.Add
Application.DisplayFullScreen = True
Cells.ColumnWidth = 0.25
Cells.RowHeight = 2.25
With ActiveWindow
.DisplayGridlines = False
.DisplayHeadings = False
.DisplayWorkbookTabs = True
End With
End Sub

Sub Triangle_De_Sierpinski()
Dim i As Integer, j As Integer
Affichage
'Pour noircir 6559 cellules:
For i = 1 To 255
For j = 1 To 255
If (i Or j) = 255 Then Cells(i, j).Interior.ColorIndex = 1
Next j
Next i
End Sub

Sub Portrait_Logique1()
Dim i As Integer, j As Integer
Affichage
'Coloriage de 65 025 cellules:
For i = 1 To 255
For j = 1 To 255
Cells(i, j).Interior.ColorIndex = 1 + ((Abs((i Imp j) + (i Xor j)))
Mod 56)
Next j
Next i
End Sub

Sub Portrait_Logique2()
Dim i As Integer, j As Integer
Affichage
For i = 1 To 255
For j = 1 To 255
Cells(i, j).Interior.ColorIndex = 1 + ((Abs(i Eqv j)) Mod 56)
Next j
Next i
End Sub

Sub Portrait_Logique3()
'Temps d'exécution sur mon ordi: 3 minutes.
Dim i As Integer, j As Integer
Affichage
'Coloriage de 130 050 cellules:
For i = 1 To 510
For j = 1 To 255
Cells(i, j).Interior.ColorIndex = Abs((i Imp j) Or (i + Not (j)))
Mod
56
Next j
Next i
'Défilement vertical de la feuille:
For i = 1 To 280
ActiveWindow.SmallScroll Down:=1
Next i
End Sub

Sub Quatre_Portraits_Logiques()
Dim t1, t2
t1 = Time
Triangle_De_Sierpinski
Portrait_Logique1
Portrait_Logique2
Portrait_Logique3
t2 = Time
MsgBox Format(t2 - t1, "hh:mm:ss")
End Sub


Bonne journée,
Serge








Avatar
GD
Bonsour® Serge
chez moi 0:01:19
une machine "vieille" de 3 ans :
Pentium IV Intel 2.6Ghz
Radeon 9600 TX 128 Mo

il y a moyen de faire mieux ;o)))
en utilisant des application.screenupdating = False/True
0:00:37

@+

Garnote wrote:
Bonjour tout le monde,

Après avoir adapté pour VBA un algorithme permettant
d'obtenir une fractale nommée « Triangle de Sierpinski »
en utilisant la fonction logique « Or », je me suis amusé
à modifier un tantinet la macro.
Et ah ! les belles structures qui surgirent alors ;-)
Il me semble que ça vaut le coup d'oil.
Environnement de mes macros :
Résolution 1024 x 768 sur un écran de 17 pouces.
Temps d'exécution de la macro « Quatre_Portraits_Logiques »
sur AuthenticAMD AMD-K6(tm) 3D processor, 256 Mo RAM : 7 minutes.
Qui détient le record de vitesse ?


Sub Affichage()
'Ajoute une feuille et la met en forme:
Sheets.Add
Application.DisplayFullScreen = True
Cells.ColumnWidth = 0.25
Cells.RowHeight = 2.25
With ActiveWindow
.DisplayGridlines = False
.DisplayHeadings = False
.DisplayWorkbookTabs = True
End With
End Sub

Sub Triangle_De_Sierpinski()
Dim i As Integer, j As Integer
Affichage
'Pour noircir 6559 cellules:
For i = 1 To 255
For j = 1 To 255
If (i Or j) = 255 Then Cells(i, j).Interior.ColorIndex = 1
Next j
Next i
End Sub

Sub Portrait_Logique1()
Dim i As Integer, j As Integer
Affichage
'Coloriage de 65 025 cellules:
For i = 1 To 255
For j = 1 To 255
Cells(i, j).Interior.ColorIndex = 1 + ((Abs((i Imp j) + (i Xor
j))) Mod 56)
Next j
Next i
End Sub

Sub Portrait_Logique2()
Dim i As Integer, j As Integer
Affichage
For i = 1 To 255
For j = 1 To 255
Cells(i, j).Interior.ColorIndex = 1 + ((Abs(i Eqv j)) Mod 56)
Next j
Next i
End Sub

Sub Portrait_Logique3()
'Temps d'exécution sur mon ordi: 3 minutes.
Dim i As Integer, j As Integer
Affichage
'Coloriage de 130 050 cellules:
For i = 1 To 510
For j = 1 To 255
Cells(i, j).Interior.ColorIndex = Abs((i Imp j) Or (i + Not
(j))) Mod 56
Next j
Next i
'Défilement vertical de la feuille:
For i = 1 To 280
ActiveWindow.SmallScroll Down:=1
Next i
End Sub

Sub Quatre_Portraits_Logiques()
Dim t1, t2
t1 = Time
Triangle_De_Sierpinski
Portrait_Logique1
Portrait_Logique2
Portrait_Logique3
t2 = Time
MsgBox Format(t2 - t1, "hh:mm:ss")
End Sub


Bonne journée,
Serge


Avatar
twinley
Salut Garnote

53"
avec un PIV 1024 meg de ram

j'ai un peu paniqué, ça m'a semblé horriblement long, mais il fallait y
croire...

à+twinley

ben, je vais te dire un truc, LSteph, moi, les procs à la chiche m'a eu du
garnote du québec, il y éperluette que je ne les teste plus : j'ai déjà dû
acheter 12 ordis à cause de notre bouillant prof de maths, alors, tu
comprends LSteph, j'aime bien Boulanger mais quand je vois "coloriage de
65025 cellules", moi qui n'en vois qu'une trentaine sur l'écran, y a des
limites....
jps

"LSteph" a écrit dans le message de
news:

Bonjour Serge,
Bravo, magnifique !
Et ce coup là mon micro n'a pas planté Jean Paul.
Sinon,
Ma femme était dégoutée , elle qui a commencé sa broderie il y a 3 ans...

A bientôt.

lSteph

"garnote" a écrit dans le message de news:


Bonjour tout le monde,

Après avoir adapté pour VBA un algorithme permettant
d'obtenir une fractale nommée « Triangle de Sierpinski »
en utilisant la fonction logique « Or », je me suis amusé
à modifier un tantinet la macro.
Et ah ! les belles structures qui surgirent alors ;-)
Il me semble que ça vaut le coup d'oil.
Environnement de mes macros :
Résolution 1024 x 768 sur un écran de 17 pouces.
Temps d'exécution de la macro « Quatre_Portraits_Logiques »
sur AuthenticAMD AMD-K6(tm) 3D processor, 256 Mo RAM : 7 minutes.
Qui détient le record de vitesse ?


Sub Affichage()
'Ajoute une feuille et la met en forme:
Sheets.Add
Application.DisplayFullScreen = True
Cells.ColumnWidth = 0.25
Cells.RowHeight = 2.25
With ActiveWindow
.DisplayGridlines = False
.DisplayHeadings = False
.DisplayWorkbookTabs = True
End With
End Sub

Sub Triangle_De_Sierpinski()
Dim i As Integer, j As Integer
Affichage
'Pour noircir 6559 cellules:
For i = 1 To 255
For j = 1 To 255
If (i Or j) = 255 Then Cells(i, j).Interior.ColorIndex = 1
Next j
Next i
End Sub

Sub Portrait_Logique1()
Dim i As Integer, j As Integer
Affichage
'Coloriage de 65 025 cellules:
For i = 1 To 255
For j = 1 To 255
Cells(i, j).Interior.ColorIndex = 1 + ((Abs((i Imp j) + (i Xor j)))
Mod 56)
Next j
Next i
End Sub

Sub Portrait_Logique2()
Dim i As Integer, j As Integer
Affichage
For i = 1 To 255
For j = 1 To 255
Cells(i, j).Interior.ColorIndex = 1 + ((Abs(i Eqv j)) Mod 56)
Next j
Next i
End Sub

Sub Portrait_Logique3()
'Temps d'exécution sur mon ordi: 3 minutes.
Dim i As Integer, j As Integer
Affichage
'Coloriage de 130 050 cellules:
For i = 1 To 510
For j = 1 To 255
Cells(i, j).Interior.ColorIndex = Abs((i Imp j) Or (i + Not (j)))
Mod
56
Next j
Next i
'Défilement vertical de la feuille:
For i = 1 To 280
ActiveWindow.SmallScroll Down:=1
Next i
End Sub

Sub Quatre_Portraits_Logiques()
Dim t1, t2
t1 = Time
Triangle_De_Sierpinski
Portrait_Logique1
Portrait_Logique2
Portrait_Logique3
t2 = Time
MsgBox Format(t2 - t1, "hh:mm:ss")
End Sub


Bonne journée,
Serge











Avatar
garnote
Deux beaux projets ;-)

http://spanky.triumf.ca/www/fractint/images/1da0550.png


http://www.fractalus.com/kerry/gallery4/newt2.html


Serge
Avatar
GD
garnote wrote:
Deux beaux projets ;-)
il me semble qu'il existe un "ring" des sites "Fractales"...

http://www.ringsurf.com/netring?ring=Fractal_Art_Ring;action=rand

en attendant et en suivant tes liens :
http://www.fractalus.com/downloads/source/
;o)))

Avatar
twinley
Bonjour GD

ce lien issue de la liste à une dimension quasi papale...

http://www1.sedoparking.com/search/redirect.php?sid“7c5c4a65ae22079a82&idB47552&t2360&forward=http%3A%2F%2Fpagead2.googlesyndication.com%2Fpagead%2Ficlk%3Fsa%3Dl%26amp%3Bai%3DBBl1xSvBlQqzKPLHEQefzoOIN9OStCYS7gqUBwI23AcC4AhACGAIg3fz3ASgKQMoRSIg5qgEMY2FyZWVyc19zcGVjsgEEbnVsbMgBAdoBGGh0dHA6Ly9udWxsLy0zNTUxNTE1MzIxZA%26amp%3Bnum%3D2%26amp%3Badurl%3Dhttp%3A%2F%2Fwww.trusoft-international.com%26amp%3Bclient%3Dca-sedo_xml&pos=2&r=0.05&surl=http%3A%2F%2Fwww.trusoft-international.com

à+twinley

garnote wrote:

Deux beaux projets ;-)


il me semble qu'il existe un "ring" des sites "Fractales"...
http://www.ringsurf.com/netring?ring=Fractal_Art_Ring;action=rand

en attendant et en suivant tes liens :
http://www.fractalus.com/downloads/source/
;o)))





Avatar
GD
Bonsour® Max
pour passer d'une dimension quasi papale...
à une dimension "modeste"
voir ici :
minilien.com
et le résultat :
http://minilien.com/?vQy8K3ns2t

@+


http://www1.sedoparking.com/search/redirect.php?sid“7c5c4a65ae22079a82&idB47552&t2360&forward=http%3A%2F%2Fpagead2.googlesyndication.com%2Fpagead%2Ficlk%3Fsa%3Dl%26amp%3Bai%3DBBl1xSvBlQqzKPLHEQefzoOIN9OStCYS7gqUBwI23AcC4AhACGAIg3fz3ASgKQMoRSIg5qgEMY2FyZWVyc19zcGVjsgEEbnVsbMgBAdoBGGh0dHA6Ly9udWxsLy0zNTUxNTE1MzIxZA%26amp%3Bnum%3D2%26amp%3Badurl%3Dhttp%3A%2F%2Fwww.trusoft-international.com%26amp%3Bclient%3Dca-sedo_xml&pos=2&r=0.05&surl=http%3A%2F%2Fwww.trusoft-international.com


à+twinley

garnote wrote:

Deux beaux projets ;-)


il me semble qu'il existe un "ring" des sites "Fractales"...
http://www.ringsurf.com/netring?ring=Fractal_Art_Ring;action=rand

en attendant et en suivant tes liens :
http://www.fractalus.com/downloads/source/
;o)))





Avatar
twinley
Alors là ! ALORS LA ! c'est une avancée majeure...

c'est magique et ça fait moins plouc.

http://minilien.com/?K1YX3aDb4m

8-)

à+twinley

Bonsour® Max
pour passer d'une dimension quasi papale...
à une dimension "modeste"
voir ici :
minilien.com
et le résultat :
http://minilien.com/?vQy8K3ns2t

@+


http://www1.sedoparking.com/search/redirect.php?sid“7c5c4a65ae22079a82&idB47552&t2360&forward=http%3A%2F%2Fpagead2.googlesyndication.com%2Fpagead%2Ficlk%3Fsa%3Dl%26amp%3Bai%3DBBl1xSvBlQqzKPLHEQefzoOIN9OStCYS7gqUBwI23AcC4AhACGAIg3fz3ASgKQMoRSIg5qgEMY2FyZWVyc19zcGVjsgEEbnVsbMgBAdoBGGh0dHA6Ly9udWxsLy0zNTUxNTE1MzIxZA%26amp%3Bnum%3D2%26amp%3Badurl%3Dhttp%3A%2F%2Fwww.trusoft-international.com%26amp%3Bclient%3Dca-sedo_xml&pos=2&r=0.05&surl=http%3A%2F%2Fwww.trusoft-international.com


à+twinley


garnote wrote:


Deux beaux projets ;-)


il me semble qu'il existe un "ring" des sites "Fractales"...
http://www.ringsurf.com/netring?ring=Fractal_Art_Ring;action=rand

en attendant et en suivant tes liens :
http://www.fractalus.com/downloads/source/
;o)))