GS - La spirale d'Ulam a été créée en 1963 par le mathématicien Stanislaw Ulam durant une conférence scientifique alors qu'il s'ennuyait. Il décida de disposer des entiers sur une grille carrée selon une spirale et il marqua les nombres premiers. Certains nombres premiers semblent dessiner des motifs qui n'ont rien d'aléatoires ou qui suivent des lignes droites.
Il a publié deux articles à propos de sa découverte: - S.M. Ulam, M.L. Stein and M.B. Wells, A Visual Display of Some Properties of the Distribution of Primes, American Mathematical Monthly (71), pp516-520, 1964 et - S.M. Ulam and M.L. Stein, An Observation on the Distribution of Primes, American Mathematical Monthly (74), pp43-44, 1967.
En 1988, Jean-François Colonna de l'Ecole Polytechnique a généralisé cette spiral. Au lieu de marquer seulement les nombres premiers, il a représenté tous les entiers selon une table de couleur en correspondance avec leur nombre de diviseurs.
Si on représente seulement les entiers avec un nombre impair de diviseurs (non fait ici), ils sont tous des carrés parfaits et appartiennent tous à la même diagonale. Il y a donc plus d'entiers avec un nombre pair de diviseurs qu'avec un nombre impair.
# spiral.tcl # Author: Gerard Sookahet # Date: 03 May 2004 # Description: Ulam spiral and divisor spiral on a square grid package require Tk proc SpiralMain { N } { set w .sp catch {destroy $w} toplevel $w wm withdraw . wm title $w "Spiral number" wm geometry $w +100+10 set dim [expr {int(sqrt($N) + 10)}] set mid [expr {$dim/2}] pack [canvas $w.c -width $dim -height $dim -bg white] set f1 [frame $w.f1 -relief sunken -borderwidth 2] pack $f1 -fill x button $f1.bu -text Ulam -width 6 -bg blue -fg white \ -command "PlotUlam $w $N $mid" button $f1.bd -text Divisor -width 6 -bg blue -fg white \ -command "PlotDivisor $w $N $mid" button $f1.bq -text Quit -width 5 -bg blue -fg white -command exit eval pack [winfo children $f1] -side left } proc PlotUlam { w N mid } { $w.c delete all set pix [image create photo] $w.c create image 0 0 -anchor nw -image $pix set cmap #030303 set i $mid set j $mid set n 1 set m 1 set M [expr {int(sqrt($N))}] while {$m < $M} { for {set k 1} {$k <= $m} {incr k} { incr n incr i if [IsPrime $n] {$pix put $cmap -to $i $j} } for {set k 1} {$k <= $m} {incr k} { incr n incr j -1 if [IsPrime $n] {$pix put $cmap -to $i $j} } set mm [expr {$m + 1}] for {set k 1} {$k <= $mm} {incr k} { incr n incr i -1 if [IsPrime $n] {$pix put $cmap -to $i $j} } for {set k 1} {$k <= $mm} {incr k} { incr n incr j if [IsPrime $n] {$pix put $cmap -to $i $j} } update idletasks incr m 2 } } proc PlotDivisor { w N mid } { $w.c delete all set pix [image create photo] $w.c create image 0 0 -anchor nw -image $pix set cmap #030303 set i $mid set j $mid # Spiral initialization by hand for 1 2 3 4 5 6 7 $pix put $cmap -to $i $j incr i $pix put $cmap -to $i $j incr j -1 $pix put $cmap -to $i $j incr i -1 $pix put [colormap 1] -to $i $j incr i -1 $pix put $cmap -to $i $j incr j $pix put [colormap 2] -to $i $j incr j $pix put $cmap -to $i $j set n 7 set m 3 set M [expr {int(sqrt($N))}] while {$m < $M} { for {set k 1} {$k <= $m} {incr k} { incr n incr i $pix put [colormap [NbDivisor $n]] -to $i $j } for {set k 1} {$k <= $m} {incr k} { incr n incr j -1 $pix put [colormap [NbDivisor $n]] -to $i $j } set mm [expr {$m + 1}] for {set k 1} {$k <= $mm} {incr k} { incr n incr i -1 $pix put [colormap [NbDivisor $n]] -to $i $j } for {set k 1} {$k <= $mm} {incr k} { incr n incr j $pix put [colormap [NbDivisor $n]] -to $i $j } update idletasks incr m 2 } } # Primality testing proc IsPrime { n } { if {$n==1} {return 0} set max [expr {int(sqrt($n))}] set d 2 while {$d <= $max} { if {$n%$d == 0} {return 0} incr d } return 1 } # Return the number of divisors of an integer proc NbDivisor { n } { set max [expr {int(sqrt($n))}] set nd 0 for {set i 2} {$i <= $max} {incr i} { if {$n%$i == 0} {incr nd} } return $nd } # Arbitrary color table proc colormap { n } { set lcolor {#030303 #CD0000 #CD4F39 #EE4000 #EE6A50 #FF7F00 #EE9A00 \ #FF8C69 #FFC125 #EEEE00 #EED5B7 #D2691E #BDB76B #00FFFF \ #7FFFD4 #FFEFD5 #AB82FF #E066FF } return [lindex $lcolor $n] } # The maximum integer. The canvas is sized from its square root SpiralMain 70000
David Cobac : en remplaçant n=7 par n=41 dans la procédure PlotUlam on peut observer une particularité (cf. une formule découverte par Euler fournissant beaucoup de nombres premiers : n²+n+41).
Je me demande pourquoi initialiser la spirale pour n=1 à n=7 ?
On pourrait aussi parler de test de primalité mais là je sors du sujet ;))
GS L'initialisation, c'était juste pour faire l'économie des boucles for qui vont de 1 à 1. C'est sûr que un tour de spiral ce n'est pas une grosse économie ;-)
David Cobac Certes mais on ne peut pas commencer à 41 facilement. Je propose donc de commenter toute la partie d'initialisation et de mettre :
set n 1 set m 1
ce qui permet maintenant de commencer facilement à n'importe quel nombre entier dont 41 :) Avec un petit détail dans la procédure IsPrime à ajouter au début puisque 1 n'est pas premier :
if {$n==1} {return 0}
En tout cas cette petite application est bien sympathique. Ça donne envie d'aller représenter aussi la conjecture de Collatz...
GS Ask, it shall be given !. Voilà, c'est fait, j'ai carrément enlevé l'initialisation manuelle.
La conjecture de Collatz (problème de Syracuse) doit être aussi intéressante. Je serais curieux de voir ce que cela donne. J'imagine que le code couleur correspond au nombre de pas nécessaires pour converger vers 1.
David Cobac : en modifiant ton script, j'ai le code ci-dessous pour les temps de vol. Maintenant on pourrait représenter autre chose, comme l'altitude maximale ou la durée de vol en altitude...
package require Tk proc SpiralMain { N } { set w .sp catch {destroy $w} toplevel $w wm withdraw . wm title $w "Collatz flight \" la Ulam\"" wm geometry $w +100+10 set dim [expr {int(sqrt($N) + 10)}] set mid [expr {$dim/2}] pack [canvas $w.c -width $dim -height $dim -bg white] set f1 [frame $w.f1 -relief sunken -borderwidth 2] pack $f1 -fill x button $f1.bu -text Collatz -width 6 -bg blue -fg white \ -command "PlotFT $w $N $mid" button $f1.bq -text Quit -width 5 -bg blue -fg white -command exit eval pack [winfo children $f1] -side left } proc PlotFT { w N mid } { $w.c delete all set pix [image create photo] $w.c create image 0 0 -anchor nw -image $pix set i $mid set j $mid set n 1 set m 1 set M [expr {int(sqrt($N))}] while {$m < $M} { for {set k 1} {$k <= $m} {incr k} { incr n incr i $pix put [colormap [collatz_flighttime $n]] -to $i $j } for {set k 1} {$k <= $m} {incr k} { incr n incr j -1 $pix put [colormap [collatz_flighttime $n]] -to $i $j } set mm [expr {$m + 1}] for {set k 1} {$k <= $mm} {incr k} { incr n incr i -1 $pix put [colormap [collatz_flighttime $n]] -to $i $j } for {set k 1} {$k <= $mm} {incr k} { incr n incr j $pix put [colormap [collatz_flighttime $n]] -to $i $j } update idletasks incr m 2 } } proc collatz_flighttime { n } { set t 0 while {$n!=1} { set n [expr {$n%2==0?$n/2:3*$n+1}] incr t } return $t } proc colormap { time } { # les grandes dures de vol => en rouge if {$time>=256} {return red} # les autres en niveaux de gris set h [format %02x [expr {255 - $time}]] return #[string repeat $h 3] } # The maximum integer. The canvas is sized from its square root SpiralMain 70000