**PRIME NUMBER BROWSER** '''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 [http://wiki.tcl.tk/11363]. 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 [http://www.kb-creative.net/data/PrimesLT30K.txt]. 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 ====== **ANNOYING DETAILS and CAVEATS** 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. **Known Issues** 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. **LET THE READER SHOW** 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] <> Graphics | Mathematics