Eratosthenes Sieve - an ancient method for finding primes.

I wrote this script to help my 5th grader understand Eratosthenes Sieve.  The class handouts as well as the Java applets around the web didn't allow for resizing and reshaping.  With small tables (i.e., up to 100) you can't get a feel for the sieve before you run out of primes that knock out multiples.  And without being able to reshape the table, you can't see that large primes have simple patterns just like small primes.

Try sizing the table to 17 and then selecting both 8 and 9.  Check the help for more ideas.

-DL
----

 # Name:         sieve.tcl
 # Description:  Explore Eratosthenes Sieve
 # Created:      9/28/04
 set author      "Don Libes <don@libes.com>"
 set version     1.1
 set versionDate 9/29/04

 package require Tk

 set fieldWidth         4 ;# provide enough space for 4 digit numbers
 tk_setPalette          #d8d8d8     ;# light gray
 set color(compositeBg) #abeaab     ;# light green
 set color(compositeFg) red
 set color(unknownFg)   black
 #set color(unknownBg)  defined dynamically later
 set divisors(all)      {} ;# all divisors selected so far
 set numMax             2  ;# max number displayed onscreen
 set font(max)          15
 set font(min)          5
 set font(face) Courier
 switch $tcl_platform(platform) "unix" {
    set font(size) -12
 } "windows" {
    set font(size) 10
 } "macintosh" {
    set font(size) 10
 }

 proc fontChange {incr} {
    global font

    # don't let it get too small
    if {(abs($font(size)) <= $font(min)) && ($incr == -1)} return

    # or too large
    if {(abs($font(size)) >= $font(max)) && ($incr == 1)} return

    # handle negative font specs by reversing sign of incr
    if {$font(size) < 0} {
	set incr [expr {0 - $incr}]
    }

    incr font(size) $incr

    if {abs($font(size)) == $font(max)} {
	.f.plus  config -state disabled
    } else {
	.f.plus  config -state normal
    }
    if {abs($font(size)) == $font(min)} {
	.f.minus config -state disabled
    } else {
	.f.minus config -state normal
    }
    
    fontSizeUpdate
 }

 proc fontSizeUpdate {} {
    .c config -font "$::font(face) $::font(size)"
 }

 proc clear {} {
    for {set i 2} {$i < $::numMax} {incr i} {
	.c tag configure $i -background $::color(unknownBg)
    }

    set ::divisors(all) {}
    configReal
 }

 proc config {} {
    # delay resize handling to reduce jitter

    cursorBusy

    catch {after cancel $configId}
    set configId [after 200 configReal]
 }

 proc configReal {args} {
    scan [wm geometry .] "%dx%d" width height

    # reset everything
    .c delete 1.0 end
    set divs $::divisors(all)
    unset ::divisors
    set ::divisors(all) {}
    for {set i 2} {$i < $::numMax} {incr i} {
	.c tag delete $i
    }

    set i 1
    for {set h 0} {$h < $height} {incr h} {
	numCreate $i
	incr i
	set w [expr {$::fieldWidth + 1}]
	while {1} {
	    incr w [expr {$::fieldWidth+1}]
	    if {$w > $width} break
	    numCreate $i
	    incr i
	}
	.c insert end "\n"
    }
    set ::numMax $i

    foreach d $divs {
	tagClick $d
    }

    cursorIdle
 }

 proc numCreate {i} {
    if {$i == 1} {
	# avoid tagging very first character to work around text widget bug
	.c insert end " "
	.c insert end [format "%[expr {$::fieldWidth - 1}]d " $i] $i
    } else {
	.c insert end [format "%${::fieldWidth}d " $i] $i
    }
    .c tag config $i -borderwidth 2
    .c tag bind $i <1>     "tagClick $i;break"
    .c tag bind $i <Enter> "tagEnter $i;break"
    .c tag bind $i <Leave> "tagLeave $i;break"
    set ::divisors($i) {}
 }

 proc tagEnter {n} {
    if {$n == 1} {
	set ::label "1 is neither prime nor composite"
    } else {
	set factors [factors $n]
	if {1 == [llength $factors]} {
	    set ::label "$n is prime"
	} else {
	    set ::label "$n = [join $factors *]"
	}
    }

    set mult $n
    while {$mult <= $::numMax} {
	.c tag configure $mult -foreground $::color(compositeFg)
	incr mult $n
    }
 }

 proc tagLeave {n} {
    set mult $n
    while {$mult <= $::numMax} {
	.c tag configure $mult -foreground $::color(unknownFg)
	incr mult $n
    }
 }

 # on button click, mark/unmark multiples
 proc tagClick {divisor} {
    set d $divisor

    if {$divisor == 1} return

    if {-1 == [lsearch $::divisors(all) $divisor]} {
	.c tag configure $d -relief ridge
	
	# strike out multiples of this divisor
	while {1} {
	    incr d $divisor
	    if {$d > $::numMax} break
	    .c tag configure $d -background $::color(compositeBg)
	    lappend ::divisors($d) $divisor
	}
	lappend ::divisors(all) $divisor
    } else {
	.c tag configure $d -relief flat

	# unstrike out multiples
	while {1} {
	    incr d $divisor
	    if {$d > $::numMax} break
	    set i [lsearch $::divisors($d) $divisor]
	    set ::divisors($d) [lreplace $::divisors($d) $i $i]
	    if {0 == [llength $::divisors($d)]} {
		.c tag configure $d -background $::color(unknownBg)
	    }
	}
	set i [lsearch $::divisors(all) $divisor]
	set ::divisors(all) [lreplace $::divisors(all) $i $i]
    }
 }

 proc factors {n} {
    set buf {}
    set limit [expr sqrt($n)]
    for {set d 2} {$d <= $limit} {incr d} {
	while {$n % $d == 0} {
	    set n [expr {$n/$d}]
	    lappend buf $d
	}
    }
    if {$n != 1} {
	lappend buf $n
    }
    return $buf
 }

 proc about {} {
    set w .about
    if {[winfo exists $w]} {
	wm deiconify $w
	raise $w
	return
    }
    toplevel     $w
    wm title     $w "About Eratosthenes Sieve"
    wm iconname  $w "about sieve"
    wm resizable $w 0 0

    button $w.b -text Dismiss -command [list wm withdraw $w]

    label $w.title -text "Eratosthenes Sieve" -font "Times 16" \
	-borderwidth 10 -fg red
    label $w.version -text "Version $::version, Released $::versionDate"
    label $w.author -text "Written by Don Libes <don@libes.com>"
    label $w.using -text "Using Tcl $::tcl_patchLevel,\
                                Tk $::tk_patchLevel"
    grid $w.title
    grid $w.version
    grid $w.author
    grid $w.using
    grid $w.b -sticky ew
 }

 proc cursorIdle {} {
    .c config -cursor arrow
 }

 proc cursorBusy {} {
    .c config -cursor watch
    update
 }

 proc help {} {
    if {[winfo exists .help]} {
	destroy .help
	return
    }

    toplevel .help
    wm title .help "Eratosthenes Sieve Help"
    wm iconname .help "Sieve help"

    scrollbar .help.sb -command {.help.text yview}
    text .help.text -width 80 -height 24 -yscroll {.help.sb set} -wrap word

    button .help.ok -text "OK" -command {destroy .help} -relief raised
    bind .help <Return> {destroy .help;break}
    grid .help.sb -row 0 -column 0 -sticky ns
    grid .help.text -row 0 -column 1 -sticky nsew
    grid .help.ok -row 1 -columnspan 2 -sticky ew  -padx 2 -pady 2

    # let text box only expand
    grid rowconfigure .help 0 -weight 1
    grid columnconfigure .help 1 -weight 1

    .help.text tag configure h1 -foreground blue

    .help.text insert end "Eratosthenes Sieve" h1
    .help.text insert end \n\n
    .help.text insert end "To find all primes:

 Step 1. Click on \"2\".
 Step 2. Click on the next larger number that is not highlighted.
 Step 3. Go back to step 2."
    .help.text insert end \n\n

    .help.text insert end "Fun Things To Try" h1
    .help.text insert end "\n\n"
    .help.text insert end "Change the window size to make patterns more evident or to show more/less numbers.  Try making the window 19 wide and then select 9 and 10.\n\n"

    .help.text insert end "Move the mouse over a number to highlight its multiples and display its prime factorization.  What number has the largest number of prime factors?  What number has the largest number of *different* prime factors? What are the smallest such numbers?\n\n"

    .help.text insert end "Fun Things to Think About" h1
    .help.text insert end "\n\n"
    .help.text insert end "Imagine extending the sieve a long, long way.  Do you think there are infinitely many primes?  Or do you think the sieve will eventually reach a point where all subsequent numbers are divisible by previous numbers?\n\n"

    .help.text insert end Warnings h1
    .help.text insert end \n\n
    .help.text insert end "When the window has been enlarged to show many numbers, some operations may take a long time on slow computers."

    switch {$::tcl_platform(platform)} "windows" {
	.help.text insert end \n
    }
 }

 wm minsize  . 1 1
 wm maxsize  . 999 999
 wm iconname . sieve
 wm title    . "Eratosthenes Sieve"
 wm protocol . WM_DELETE_WINDOW exit

 menu .m -tearoff 0
 .m add cascade -menu .m.file -label "File"
 .m add cascade -menu .m.edit -label "Edit"
 .m add cascade -menu .m.help -label "Help"

 menu .m.file -tearoff 0
 menu .m.edit -tearoff 0
 menu .m.help -tearoff 0

 .m.file add command -label "Exit"	   -command exit
 .m.edit add command -label "Clear All"     -command clear
 .m.edit add command -label "Font Increase" -command {fontChange 1}
 .m.edit add command -label "Font Decrease" -command {fontChange -1}
 .m.help add command -label "About"         -command about
 .m.help add command -label "Help"          -command help
 . config -m .m

 frame  .f
 label  .f.l     -textvar label -relief ridge -width 30
 button .f.c     -text "Clear All" -command clear
 label  .f.font  -text "Font:"
 button .f.plus  -text "+" -command {fontChange 1}
 button .f.minus -text "-" -command {fontChange -1}

 grid .f.l     -column 0 -row 0 -sticky ens
 grid .f.c     -column 1 -row 0 -sticky wns
 grid .f.font  -column 2 -row 0 -sticky wns
 grid .f.plus  -column 3 -row 0 -sticky wns
 grid .f.minus -column 4 -row 0 -sticky wns

 grid .f       -column 0 -row 0 -sticky ewns
 text .c -setgrid 1 ;# -wrap word
 fontSizeUpdate
 set color(unknownBg) [.c cget -background]
 cursorIdle
 bind .c <1> break
 bind .c <B1-Motion> break
 grid .c -column 0 -row 1 -sticky ewns
 grid rowconfigure    . 1 -weight 1
 grid columnconfigure . 0 -weight 1

 bind .c <Configure> config