[GS] - The Ulam Spiral was created in 1963 by the mathematician Stanislaw Ulam while he got bored during a talk at a scientific meeting. He decided to put integers on a square grid following a spiral pattern, and he checked prime numbers. Some primes seems to appear according to nonrandom patterns or straight lines. [http://gersoo.free.fr/wiki/w11363/spiral.gif] He published two articles about its discovery: - 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. - S.M. Ulam and M.L. Stein, ''An Observation on the Distribution of Primes'', American Mathematical Monthly (74), pp43-44, 1967. In 1988, Jean-François Colonna of the Ecole Polytechnique (France) generalized this spiral. Instead of checking only primes, he represents all the integer with a color table corresponding to their number of divisors. [http://gersoo.free.fr/wiki/w11363/ulam.gif] [http://gersoo.free.fr/wiki/w11363/divisor.gif] If we represents only integers with an odd number of divisors (not done here), they are all perfect square, and they all belong to the same diagonal. So there are more integers with even number of divisors than with odd number. ====== # 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 # 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 $cmap -to $i $j incr i -1 $pix put $cmap -to $i $j incr j $pix put $cmap -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 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 } { 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 ====== ---- See also [Sacks spiral] and [Vogel spiral] <> Graphics | Mathematics