A Tcl/Tk Script for investigating Prime Numbers plotted in the Ulam Style -- KWJ
Apologies-- It recently dawned on me that the title for this page is a bit of an anachronism. In a different era, before the existence of Netscape, and certainly much before Interlope Explorer, a browser was a software tool meant for sifting through data in a non organized browsing manner. That is the context for the title.
The Prime Number Browser displays prime numbers on one of two Primal Screens, one plotted on a Coarse Grid, the other on a Fine Grid. If we think of the integers from 1 to a very large number as being connected like a string of pearls, then the Ulam method consists of laying them out in a spiral pattern on a square grid, starting with 1 at the center. An excellent description and demonstration of the Ulam method by Gerard Sookahet, can be found on the Wiki at [L1 ]. Some examples from the browser may be found at Primal Screens.
Following, is the browser script. When starting up, the script looks for a file named BigPrimeList which contains prime numbers organized as a list. If you want a small subset of primes to test out, the set of primes less than 30,000 can be found at [L2 ].
To run the browser, first make sure the BigPrimeList file is located in the same directory as the browser, then select either the Coarse Grid or Fine Grid Button. It takes a while to display a Primal Screen, so give it a bit of time (about 8 seconds for the Fine Grid on my old iMac.) After the primes are displayed, select a Prime Predicting formula from the drop down Trajectories menu. This will overlay a Trajectory of primes and non primes on the Primal Screen. Only one formula can be selected at a time, but multiple formulae can be displayed on the same screen. To erase a given trajectory, click on it again.
#!/bin/sh
# \
exec wish "$0" ${1+"$@"}
# Version of April 17, 2009:
#----------------------------------------
package require Tk
set biggestPrime 0
set color {}
set delta 20
set fgndColor black
set foundPrime 0
set granularity {}
set lastPrime {}
set M 2
set nucX {}
set nucY {}
set numIterations 5
set outLineColor lightblue1
set sqNum 1
set startingIndex $sqNum
set runningIndex [expr {$startingIndex - 1}]
set tagName line
set window {}
set x1 {}
set x2 {}
set y1 {}
set y2 {}
set xc 0
set yc 0
set xMin 10000
set xMax -10000
set yMin 10000
set yMax -10000
# Following are used for plotting various prime trajectories.
# See Proc plotFormula
set formulae { }
lappend formulae {" $m * $m - 2 " {expr { $m * $m -2} } chartreuse steelblue1}
lappend formulae {" $m * $m + 7 " {expr { $m * $m + 7} } beige red}
lappend formulae {" $m * $m - 27 " {expr { $m * $m - 27} } yellow "slate blue"}
lappend formulae {" $m * $m - 227 " {expr { $m * $m - 227} } yellow steelblue1}
lappend formulae {Legendre {expr { $m * $m + $m + 17} } yellow darkgreen}
lappend formulae {Euler {expr { $m * $m - $m + 41} } yellow Navy}
lappend formulae {" $m * $m - $m - 109 " {expr { $m * $m - $m - 109} } \
yellow "brown"}
lappend formulae {" 4 * $m * $m + 4 * $m + 59 " {expr { 4*$m*$m + 4*$m + 59} } \
yellow darkgreen}
lappend formulae {"2 * $m * $m + 29 " {expr { 2 * $m * $m + 29} } yellow red}
# Read in the list of Prime Numbers next:
# the set of primes less than 30,000 can be found at
# [http://www.kb-creative.net/data/PrimesLT30K.txt]
source {BigPrimeList}
set biggestPrime [lindex $primes end]
#--------------------------------------------------
# Proc reset
# A proc to reset variables to initial conditions.
#--------------------------------------------------
proc reset {} {
global color cX cY foundPrime lastPrime
global M nucX nucY primeColor primeIndex runningIndex
global sqNum startingIndex tagName winwd xMin xMax yMin yMax
set color {}
set cX [expr {int ($winwd / 2)}]
set cY $cX
set foundPrime 0
set granularity {}
set lastPrime {}
set M 2
set nucX {}
set nucY {}
set primeColor white
set primeIndex 0
set sqNum 1
set startingIndex $sqNum
set runningIndex [expr {$startingIndex - 1}]
set tagName line
set xMin 10000
set xMax -10000
set yMin 10000
set yMax -10000
# RadioButton Variables used in proc canvasSetup.
set ::nonPrimetrajs 0
set ::Form0 0
set ::Form1 0
set ::Form2 0
set ::Form3 0
set ::Form4 0
set ::Form5 0
set ::Form6 0
set ::Form7 0
set ::Form8 0
}
#------------------------------------------------------
# Proc coarse
# A proc to create a Primal Screen using Coarse cells.
#------------------------------------------------------
proc coarse { } {
global delta granularity numIterations tagName window
set delta 9
set granularity "coarse"
set numIterations 150
reset
canvasSetup
wm deiconify .square
update idletasks
drawSquares
if {[string compare $tagName "refLines"] == 0} {
drawCoords
odd_evenSquares
} else {
$window delete coordline
$window delete odd_even
drawCoords
odd_evenSquares
}
}
#----------------------------------------------------
# Proc fine
# A proc to create a Primal Screen using Fine cells.
#----------------------------------------------------
proc fine { } {
global biggestPrime delta granularity M numIterations numPrimes primes
global tagName window
set granularity "fine"
# For primes less than 100,000
set delta 1
# For primes less than 30,000
# set delta 2
set numIterations [expr {int (sqrt ($biggestPrime) )}]
reset
canvasSetup
wm deiconify .square
update idletasks
drawSquares
if {[string compare $tagName "refLines"] == 0} {
drawCoords
odd_evenSquares
drawBounds
} else {
$window delete coordline
$window delete odd_even
$window delete coarse_bounds
drawCoords
odd_evenSquares
drawBounds
}
set tagName refLines
set numPrimes [llength $primes]
puts "\n numPrimes is $numPrimes, biggestPrime is $biggestPrime"
puts " -- M is [incr M -1] --\n"
}
#-----------------------------------------------------------
# Proc canvasSetup
# A proc to create the Ulam Spiral canvas with buttons etc.
#-----------------------------------------------------------
proc canvasSetup { } {
global cX cY granularity xc yc winwd winht window
set window .square
catch {destroy $window}
toplevel $window
wm title $window "Ulam Spiral Canvas"
wm geometry $window +100+50
wm withdraw .
focus $window
$window config -cursor crosshair
# Determine screen width and height.
set screenwd [winfo screenwidth .]
# Create the canvas.
set winwd [expr {int ( 0.45*$screenwd )}]
# set winwd [expr {int ( 0.30*$screenwd )}]
set winht $winwd
set f1 [frame $window.f1 -relief sunken -borderwidth 2 -height 30]
pack $f1 -fill x -side top -in $window
# Next Button creates Coarse Primal Screen.
button $f1.bm -text "Coarse Grid" -width 10 -bg blue -fg white \
-command "coarse"
# Next Button creates Fine Primal Screen.
button $f1.bs -text "Fine Grid" -width 11 -bg blue -fg white \
-command "fine"
# Dropdown Menu for various trajectories.
menubutton $f1.menu -text "Trajectories" -menu $f1.menu.mnu
eval pack [winfo children $f1] -side left
set f2 [frame $window.f2 -relief flat -borderwidth 2 -height 30]
pack $f2 -fill x -side bottom -in $window.f1
set f3 [frame $window.f3 -relief flat -borderwidth 2 -height 30]
pack $f3 -fill x -side left -in $window.f2
button $f2.bq -text Quit -width 5 -bg blue -fg white -command exit
pack $f2.bq -fill x -side right -in $window.f2
set window $window.c
pack [canvas $window -width $winwd -height $winht -bg "alice blue"]
# Fill DropDown Menu next.
set m [menu $f1.menu.mnu -tearoff 0]
# Empty Trajectories here.
$m add check -label "Empty Trajectories" -variable nonPrimetrajs -command {
if {$nonPrimetrajs == 1} {
plotEmptys
} else {
$window delete nonPrimePts
}
}
$m add separator
# Various Prime Number Formulae.
$m add check -label "m*m - 2" -variable Form0 -command {
if {$Form0 == 1} {
plotFormula 0 Form0Pts
} else {
$window delete Form0Pts
}
}
$m add check -label "m*m + 7" -variable Form1 -command {
if {$Form1 == 1} {
plotFormula 1 Form1Pts
} else {
$window delete Form1Pts
}
}
$m add check -label "m*m - 27" -variable Form2 -command {
if {$Form2 == 1} {
plotFormula 2 Form2Pts
} else {
$window delete Form2Pts
}
}
$m add check -label "m*m - 227" -variable Form3 -command {
if {$Form3 == 1} {
plotFormula 3 Form3Pts
} else {
$window delete Form3Pts
}
}
$m add check -label "Legendre (m*m + m + 17)" -variable Form4 -command {
if {$Form4 == 1} {
plotFormula 4 Form4Pts
} else {
$window delete Form4Pts
}
}
$m add check -label "Euler (m*m - m + 41)" -variable Form5 -command {
if {$Form5 == 1} {
plotFormula 5 Form5Pts
} else {
$window delete Form5Pts
}
}
$m add check -label "m*m - m - 109" -variable Form6 -command {
if {$Form6 == 1} {
plotFormula 6 Form6Pts
} else {
$window delete Form6Pts
}
}
# Following produces a cool plot, with only one branch.
$m add check -label "4*m*m + 4*m + 59" -variable Form7 -command {
if {$Form7 == 1} {
plotFormula 7 Form7Pts
} else {
$window delete Form7Pts
}
}
# Following produces an Unexpected plot.
$m add check -label "2*m*m + 29" -variable Form8 -command {
if {$Form8 == 1} {
plotFormula 8 Form8Pts
} else {
$window delete Form8Pts
}
}
}
#-------------------------------
# Proc array'reverse.
# A Proc to invert the P array.
#-------------------------------
proc array'reverse {oldName newName} {
upvar 1 $oldName old $newName new
foreach {key value} [array get old] {set new($value) $key}
}
#--------------------------------------------
# Proc plotFormula
# Plot the trajectories of various formulae.
#--------------------------------------------
proc plotFormula {index tagName} {
global cX cY formulae granularity lastPrime P window
# Invert the P array, so the X Y coords of Prime P can be obtained
# from the value of the Prime itself. P was created in isPrime.
array'reverse P P2
set count 0
set numPrimesCalcd 0
#Choose the correct formula based on index.
set l1 [lindex $formulae $index]
set formulaName [lindex $l1 0]
set formula [lindex $l1 1]
set fillColor [lindex $l1 2]
set color [lindex $l1 3]
for {set m 0} {$m < $lastPrime} {incr m} {
incr count
set num [eval $formula]
set ls [array get P2 $num]
set indx1 [expr {[string first " " $ls] -1}]
set indx2 [expr {[string first " " $ls] +1}]
set coord [string range $ls $indx2 end]
if {![string match $coord ""]} {
# Primes.
# X and Y are determined from the Prime Number itself.
incr numPrimesCalcd
set indx1 [expr {[string first "," $coord] -1}]
set indx2 [expr {[string first "," $coord] +1}]
set x [expr {[string range $coord 0 $indx1] + $cX}]
set y [expr {[string range $coord $indx2 end] + $cY}]
if {[string compare $granularity "fine"] == 0} {
sm_sq $x $y 2 $color $tagName
} else {
sm_sq $x $y 8 $color $tagName
$window create text $x $y -text $num -fill $fillColor \
-font "Courier 9" -tag $tagName
}
} else {
# Non-Primes.
# X and Y are determined from the value of the non Prime.
if {$num > 0.0} {
set coords {}
set crds [ getCoords $num 1]
set x1 [lindex $crds 0]
set y1 [lindex $crds 1]
if {[string compare $granularity "fine"] == 0} {
sm_sq $x1 $y1 2 $fillColor $tagName
} else {
sm_sq $x1 $y1 8 $fillColor $tagName
$window create text $x1 $y1 -text $num -fill black \
-font "Courier 9" -tag $tagName
}
}
}
if {$num >= $lastPrime} {break}
}
set potency [expr { $numPrimesCalcd / double($count) }]
puts "\n -- Formula $formulaName calculates $numPrimesCalcd Primes out of\
$count predictions. \n Potency is $potency. \n"
}
#---------------------------------------------------
# Plot a small square at the location of integer n.
# Plots Prime and nonPrime numbers. Also returns
# x,y coords of the square.
#---------------------------------------------------
proc getCoords {n iPlot} {
global cX cY delta granularity tagName window
set Del [expr {2 * $delta}]
set srt [expr {int (sqrt ($n) )}]
set diff [expr {$n - $srt * $srt}]
if {[expr {fmod ($srt,2)}] > 0.0} {
set xsq_location [expr { $cX + ($srt/2) * $Del}]
set ysq_location [expr { $cY + ($srt/2) * $Del}]
if { $diff == 0} {
set x_displacement $xsq_location
set y_displacement $ysq_location
} elseif { $diff <= [expr { $srt + 1 }] } {
set x_displacement [expr {$xsq_location + $Del}]
set y_displacement [expr {$ysq_location - $Del * ($diff -1)}]
} else {
set x_displacement [expr {$xsq_location - $Del * ($diff - $srt - 2)}]
set y_displacement [expr {$ysq_location - $Del * $srt }]
}
} else {
set xsq_location [expr { $cX - ($srt/2 - 1) * $Del}]
set ysq_location [expr { $cY - ($srt/2) * $Del}]
if { $diff == 0} {
set x_displacement $xsq_location
set y_displacement $ysq_location
} elseif { $diff <= [expr { $srt + 1 }] } {
set x_displacement [expr {$xsq_location - $Del}]
set y_displacement [expr {$ysq_location + $Del * ($diff -1)}]
} else {
set x_displacement [expr {$xsq_location + $Del * ($diff - $srt - 2)}]
set y_displacement [expr {$ysq_location + $Del * $srt }]
}
}
if { $iPlot == "" } {
if {[string compare $granularity "fine"] == 0} {
sm_sq $x_displacement $y_displacement 2 "indian red" $tagName
} else {
sm_sq $x_displacement $y_displacement 8 "indian red" $tagName
$window create text $x_displacement $y_displacement -text $n -fill yellow \
-font "Courier 9" -tag $tagName
}
}
return [list $x_displacement $y_displacement]
}
#------------------------------
# proc plotEmptys
# Plot the empty trajectories.
#------------------------------
proc plotEmptys {} {
global lastPrime tagName
set tagName nonPrimePts
for {set m 5} {$m < $lastPrime} {incr m} {
# Empty Cells in the X direction.
set num1 [expr { round ($m * $m - 1.5 * $m)}]
if {$num1 >= $lastPrime} {break}
# Empty Cells in the Y direction.
set num2 [expr { round ($m * $m + 1.5 * $m)}]
getCoords $num1 ""
getCoords $num2 ""
# Second tier of empty cells in X & Y directions.
if { [expr { fmod($m,2)}] == 0.0} {
getCoords [expr { $num1 -1}] ""
getCoords [expr { $num2 -1}] ""
}
}
# Plot the m*m - 1 empty trajectories.
for {set m 3} {$m < $lastPrime} {incr m} {
set num3 [expr { round ($m * $m - 1)}]
if {$num3 >= $lastPrime} {break}
getCoords $num3 ""
}
}
#---------------------------------------------------
# Proc plotLine.
# Plot a line connecting the two integers, a and b.
#---------------------------------------------------
proc plotLine {a b} {
global tagName window
set coords {}
set crds [getCoords $a 1]
set x1 [lindex $crds 0]
set y1 [lindex $crds 1]
set crds [getCoords $b 1]
set x2 [lindex $crds 0]
set y2 [lindex $crds 1]
lappend coords [list $x1 $y1 $x2 $y2]
eval {$window create line} $coords \
{-tag $tagName -width 1 -fill black}
}
#---------------------------------------------------------
# Proc odd_evenSquares.
# Draw lines through those cells which are the Squares of
# Odd and Even numbers.
#---------------------------------------------------------
proc odd_evenSquares {} {
global granularity tagName
# Plot a line through the Even and Odd squares.
set tagName odd_even
if {[string compare $granularity "fine"] == 0} {
plotLine 4 99856
plotLine 1 99225
} elseif {[string compare $granularity "coarse"] == 0} {
plotLine 4 14400
plotLine 1 14161
}
}
#------------------------------------------------------------------
# Proc drawBounds.
# Draw a square that approximates the limits of the Coarse Screen.
#------------------------------------------------------------------
proc drawBounds {} {
global tagName
set tagName coarse_bounds
# Plot the boundary for the Coarse Screen.
plotLine 1766 1891
plotLine 1891 1850
plotLine 1850 1807
plotLine 1807 1766
}
#------------------------------------------------------
# Proc drawCoords.
# Overlay blue X and Y Coordinate Axes on the Ulam plot
# for reference purposes.
#------------------------------------------------------
proc drawCoords {} {
global cX cY tagName window xMin xMax yMin yMax
# Draw X Axis
set coords {}
set x1 $xMin
set y1 $cY
set x2 $xMax
set y2 $cY
lappend coords [list $x1 $y1 $x2 $y2]
eval {$window create line} $coords \
{-tag $tagName -width 0 -fill blue2}
# Draw Y Axis
set coords {}
set x1 $cX
set y1 $yMin
set x2 $cX
set y2 $yMax
lappend coords [list $x1 $y1 $x2 $y2]
eval {$window create line} $coords \
{-tag $tagName -width 0 -fill blue2}
}
#------------------------------------------------------------
# Proc drawSquares.
# Plot a square cell at proper location for each integer.
# For Coarse Screen, label each cell with integer. Indicate
# Prime numbers with colored text.
#------------------------------------------------------------
proc drawSquares {} {
global color cX cY delta nucX nucY numIterations numPrimes
global M P runningIndex startingIndex xMin xMax yMin yMax
set color white
array unset P
# Set down the initial square cell here.
square $cX $cY
set runningIndex [expr {$startingIndex + 1}]
set nucX $cX
set nucY $cY
# Now wrap inverted "L" or "L" shaped patterns around the initial cell.
for {set i 2} {$i <= $numIterations} {incr i} {
iterate $i
}
update idletasks
set xMin [expr {$xMin - $delta}]
set yMin [expr {$yMin - $delta}]
set xMax [expr {$xMax + $delta}]
set yMax [expr {$yMax + $delta}]
incr M
}
#-------------------------------------------------
# Proc iterate
# A proc to write out the integers in Ulam order.
# Draw (2*$M -1) squares in
# an L or inverted L shaped pattern.
# Draw squares in Counter-ClockWise Direction.
#-------------------------------------------------
proc iterate {m} {
global delta M nextOp nucX nucY runningIndex
set M $m
set num_Moves [expr {$M -1}]
set twoDelta [expr {2*$delta}]
set nextOp "right"
if {[expr {fmod ($M,2)}] > 0.0} {
set nextOp "left"
}
if {[string compare $nextOp "right"] == 0} {
set nucX [expr {$nucX + $twoDelta}]
square $nucX $nucY
for {set i 1} {$i <= $num_Moves} {incr i} {
set nucY [expr {$nucY - $twoDelta}]
square $nucX $nucY
}
for {set i 1} {$i <= $num_Moves} {incr i} {
set nucX [expr {$nucX - $twoDelta}]
square $nucX $nucY
}
} else {
set nucX [expr {$nucX - $twoDelta}]
square $nucX $nucY
for {set i 1} {$i <= $num_Moves} {incr i} {
set nucY [expr {$nucY + $twoDelta}]
square $nucX $nucY
}
for {set i 1} {$i <= $num_Moves} {incr i} {
set nucX [expr {$nucX + $twoDelta}]
square $nucX $nucY
}
}
}
#----------------------------------------------
# Proc isPrime.
# Determine if runningIndex is a Prime Number.
# If so, do some extra bookkeeping.
#----------------------------------------------
proc isPrime {X Y} {
global color cX cY foundPrime lastPrime P primeColor
global primeIndex primes runningIndex
# Array P's index will be the X and Y coords of the found Prime number.
set foundPrime 0
set color white
if {[lindex $primes $primeIndex] == $runningIndex} {
set color $primeColor
set foundPrime 1
set lastPrime $runningIndex
set Xindex [expr {$X -$cX}]
set Yindex [expr {$Y -$cY}]
set P($Xindex,$Yindex) $lastPrime
incr primeIndex
}
incr runningIndex
}
#----------------------------------------------------
# Proc square.
# Draw a square cell, centered on x and y and
# colored with color primeColor if the square number
# is prime. The cell will be 2 * $delta in width.
#----------------------------------------------------
proc square { x y } {
global color delta foundPrime granularity outLineColor
global primeColor sqNum window xMin xMax yMin yMax
# isPrime will determine whether runningIndex is Prime, based on list of primes.
isPrime $x $y
if {$xMin > $x} {
set xMin $x
} elseif {$xMax < $x} {
set xMax $x
}
if {$yMin > $y} {
set yMin $y
} elseif {$yMax < $y} {
set yMax $y
}
if {$foundPrime == 1} {
if {$primeColor != "white"} {
set fgnd "yellow"
} else {
set fgnd "blue"
}
set outLineColor lightblue1
} else {
set fgnd "slategray3"
set outLineColor lightblue1
}
# Calculate coords for Square.
set x1 [expr {$x - $delta}]
set y1 [expr {$y - $delta}]
set x2 [expr {$x + $delta}]
set y2 [expr {$y + $delta}]
# Create square here with fill color. primeColor is set in isPrime.
if {$color != $primeColor} {
} else {
if {[string compare $granularity "fine"] == 0} {
} elseif {[string compare $granularity "coarse"] == 0} {
$window create rectangle $x1 $y1 $x2 $y2 -fill $color \
-outline $outLineColor -width 1
}
}
# For certain squares, insert sqNum as text.
if {[string compare $granularity "coarse"] == 0 && $color == $primeColor} {
$window create text $x $y -text $sqNum -fill $fgnd -font "Times 9"
} elseif {[string compare $granularity "fine"] == 0 && $color == $primeColor} {
if {$foundPrime == 1} {
$window create text $x $y -text "+" -font "Times 9" -fill "steel blue"
}
}
incr sqNum
}
#-----------------------------------------------------------------
# Proc sm_sq.
# Draw a small square cell, centered on x and y with side length
# (2 * delt). Color square with color thisColor. Tag square
# with tagName.
#-----------------------------------------------------------------
proc sm_sq { x y delt thisColor tagName } {
global window
# Calculate coords for small square.
set x1 [expr {$x - $delt}]
set y1 [expr {$y - $delt}]
set x2 [expr {$x + $delt}]
set y2 [expr {$y + $delt}]
$window create rectangle $x1 $y1 $x2 $y2 -fill $thisColor \
-width 1 -outline black -tag $tagName
}
# Start up everything here.
canvasSetup
The script has evolved over time, with artifacts from previous versions. There are also grimy aspects of the script due to late night hacking, which currently cause me to scratch my head.
Once the the BigPrimeList file has been sourced, the Prime Integers are stored in the P array, whose arguments are the x,y coordinates of the Prime as plotted on the Screen. The coordinate mapping is done as part of creating the Ulam Spiral whenever one of the two screens is selected. Later on, the P array is inverted to yield coordinates of a given prime. Thus, given a prime integer, it's x,y coordinates can be gotten quickly.
This of course only works for primes. A late night discovery allowed me to figure the coordinates of non primes, and this is done in the getCoords proc. I've never timed the difference between the two methods. There is certainly much room for refactoring.
A strange error message often appears that I haven't a clue how to fix. When some Trajectory is chosen, the message
RCNE SendEventToEventTarget (mous Moved ) failed, -50 Error msg
I believe this is due to mouse movement when clicking on a check button. It may also just be due to running on a Mac.
I would also like to have some sort of a flash screen displayed while the script is creating a new Screen.
Primal Screens can be plotted Clockwise rather than Counter Clockwise. This takes some modification to the iterate proc. It turns out that by plotting Clockwise, the horizontal Empty Channels mentioned in Primal Screens become separated by a non empty row.
The Starting Integer Value can also be varied. I understand the integer 19 leads to interesting results. I've never tried that. It would be interesting to see how the various Trajectories look under these circumstances.
Some other Formulae to try:
| y = m² - 21 |
| y = m² + 58 |
| y = m² + m + 5 |
This script was developed on an iMac, running Leopard OS X, with TclTk 8.4.7 installed. It has a 19 inch screen, so I'm not sure how the graphics might appear or how the script will behave on other systems-- your results may vary. I would very much appreciate any improvements you might have in terms of style or speed.
ULAM DEMO PACKAGE A script demonstrating the Ulam method is found at Ulam Spiral Demo.
See also Primal Screens