Spirale d'Ulam

 

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

Catégorie Mathématiques