Updated 2016-04-19 00:46:16 by kpv

Keith Vetter 04/18/20126 -- How can you quickly determine if a number is evenly divisible by 7? There are nice tricks for 2, 3, 4, 5, 6, 8 and 9 but 7 is trickier.

Here's a simple, graphical way to test for divisibility by seven. Start at the starred node at the bottom. Now take each digit in turn from left to right in your number. For each digit, follow that many black arrows in a row, and then add one white arrow. If you finish at the bottom, then your number is divisible by 7.

How does it work? Here's a hint: the white arrows correspond to 10x mod 7.

##+##########################################################################
#
# 7div.tcl -- Animation to test for divisibility by 7
# by Keith Vetter 2013-08-07

package require Tk

set PTS(0) {at 270 circle 0}
set PTS(1) {at 0 circle 0}
set PTS(2) {at 90 circle 0}
set PTS(3) {at 70 circle 1}
set PTS(4) {at 110 circle 1}
set PTS(5) {at 290 circle 1}
set PTS(6) {at 180 circle 0}

set ARCS(0,black) {circle 0 to 1}
set ARCS(0,white) {circle 2 to 0}
set ARCS(1,black) {circle 0 to 2}
set ARCS(1,white) {circle 1 to 3}
set ARCS(2,black) {line 10 to 3}
set ARCS(2,white) {circle 0 to 6}
set ARCS(3,black) {circle 1 to 4}
set ARCS(3,white) {line 10 to 2}
set ARCS(4,black) {line 11 to 5}
set ARCS(4,white) {line 11 to 5}
set ARCS(5,black) {circle 1 to 6}
set ARCS(5,white) {circle 1 to 1}
set ARCS(6,black) {circle 0 to 0}
set ARCS(6,white) {circle 1 to 4}

set ARROW(0) {black_delta 8 15 white_delta 0 -20}
set ARROW(1) {black_delta 20 -5 white_delta -20 0}
set ARROW(2) {black_delta -15 10 white_delta -10 -15}
set ARROW(3) {black_delta -20 -18 white_delta 10 -15}
set ARROW(4) {black_delta -15 15 white_delta 30 10}
set ARROW(5) {black_delta -20 -12 white_delta 10 -18}
set ARROW(6) {black_delta -15 5 white_delta 22 -5}

set S(rad,0,a) 350
set S(rad,0,b) 300
set S(rad,0,y) 0
set S(rad,1,a) 350
set S(rad,1,b) 150
set S(rad,1,y) 0
set d [expr {($S(rad,0,b) - $S(rad,1,b))}]
set r [expr {$d * 5 / 12.0}]
set S(rad,2,a) $r
set S(rad,2,b) $r
set S(rad,2,y) [expr {$S(rad,0,b) - $r}]
set S(cross,10) {2 3}
set S(cross,11) {4 5}
set S(animate,stepSize) 5
set S(animate,delay) 20
set S(animate,extraDelay) 1000
set S(number,candidate) 315
set S(box) 10
set S(digits,font) {Times 48 bold}
set S(breadcrumbs) 1

set S(w) [expr {2*$S(rad,0,a) + 150}]
set S(h) [expr {2*$S(rad,0,b) + 150}]
set S(state) unstarted

proc DoDisplay {} {
    global S

    wm title . "Divisible by 7"
    
    frame .digits -bd 2 -relief solid -pady 3m
    pack .digits -side bottom -fill x
    ShowNumber $S(number,candidate)
    
    canvas .c -width $S(w) -height $S(h) -bd 0 -highlightthickness 0 -bg green4
    bind .c <Configure> {CenterCanvas %W %w %h}
    pack .c -side top -fill both -expand 1
    DrawOval 0 -width 5
    DrawOval 1 -width 5
    DrawOval 2 -width 5
    DrawPoints
    DrawCrossing 10 -width 5
    DrawCrossing 11 -width 5
    DrawArrows -width 10
    .c create oval [Box {*}$S(0,xy) 30] -tag animate -fill {} -width 10 -outline red

    ::ttk::frame .ctrl -padding 1m
    ::ttk::frame .ctrl.top
    ::ttk::label .ctrl.l -text "Number to test:"
    ::ttk::entry .ctrl.e -textvariable ::S(number,candidate) -width 5
    bind .ctrl.e <Key-Return> {.ctrl.test invoke}
    ::ttk::button .ctrl.test -text "Start" -command Start
    ::ttk::button .ctrl.about -text "About" -command About
    grid .ctrl.l .ctrl.e -sticky ew -in .ctrl.top
    grid columnconfigure .ctrl.top 1 -weight 1
    pack .ctrl.top -fill x
    pack .ctrl.test .ctrl.about -expand 1 -side left
    place .ctrl -in .c -relx 1 -rely 0 -x -10 -y 10 -anchor ne
    
}
proc ShowNumber {number} {
    destroy {*}[winfo child .digits]
    set digits " "
    if {[string is integer -strict $number]} {
        set ::S(msg) "Testing if $number is divisible by 7"
        set digits $number
    } elseif {[string trim $number] eq ""} {
        set ::S(msg) ""
    } else {
        set ::S(msg) "$number is not an integer"
    }
    for {set i 0} {$i < [string length $digits]} {incr i} {
        set digit [string index $digits $i]
        label .digits.d$i -text $digit -font $::S(digits,font)
        pack .digits.d$i -side left
    }
    frame .digits.bar -bg black -padx 1
    label .digits.msg -textvariable ::S(msg) -font $::S(digits,font)
    pack .digits.bar -side left -fill y
    pack .digits.msg -side left -fill both -expand 1
}

proc HighlightDigit {how digits subIdx idx} {
    global S
    set w .digits.d$idx
    if {$how eq "over"} {
        if {$idx == 0} {
            set S(msg) "$digits is divisible by 7"
        } else {
            set S(msg) "$digits is not divisible by 7"
        }
    } elseif {$how eq "done"} {
        $w config -bd 0 -bg [lindex [$w config -bg] 3]
    } elseif {$how eq "begin"} {
        set digit [string index $digits $idx]
        $w config -bd 2 -relief raised -bg black -fg magenta
        .c itemconfig breadcrumbs -fill cyan -tag breadcrumbs,old
        set S(msg) "Processing digit '$digit'"
        return $S(animate,extraDelay)
    } elseif {$how eq "black"} {
        set digit [string index $digits $idx]
        incr subIdx
        set S(msg) "Black step #$subIdx for '$digit'"
    } elseif {$how eq "white"} {
        set digit [string index $digits $idx]
        $w config -bg white
        set S(msg) "White step for '$digit'"
    } else {
        error "unknown how: $how"
    }
    return 1
}


proc ArcCoords {from color} {
    global S PTS ARCS

    lassign $ARCS($from,$color) type which . to
    if {$type eq "line"} {
        set xy [concat $S($from,xy) $S($to,xy)]
    } else {
        set startAngle [lindex $PTS($from) 1]
        set endAngle [lindex $PTS($to) 1]
        set xy [OvalCoords $which $startAngle $endAngle 5]
    }
    return $xy
}
proc ArrowCoords {from color distance} {
    global S ARCS

    set xy [ArcCoords $from $color]
    set axy {}
    
    set soFar 0
    lassign $xy x0 y0
    foreach {x1 y1} $xy {
        set leg [expr {hypot($x1-$x0, $y1-$y0)}]
        if {$soFar + $leg < $distance} {
            lappend axy $x1 $y1
            set soFar [expr {$soFar + $leg}]
        } else {
            set short [expr {$distance - $soFar}]
            lassign [ResizeLine $x0 $y0 $x1 $y1 $short] x y
            lappend axy $x $y
            break
        }
        lassign [list $x1 $y1] x0 y0
    }
    return $axy
}
proc LineLength {xy} {
    set total 0
    lassign $xy x0 y0
    foreach {x1 y1} $xy {
        set leg [expr {hypot($x1-$x0, $y1-$y0)}]
        set total [expr {$total + $leg}]
        lassign [list $x1 $y1] x0 y0
    }
    return $total
}
proc SegmentLine {xy maxLen} {
    set segments {}
    
    lassign $xy x0 y0
    set segment [list $x0 $y0]
    set segmentLength 0
    for {set idx 2} {$idx < [llength $xy]} {incr idx 2} {
        lassign [lrange $xy $idx $idx+1] x1 y1
        set leg [expr {hypot($x1-$x0, $y1-$y0)}]
        while {$segmentLength + $leg > $maxLen} {
            set short [expr {$maxLen - $segmentLength}]
            lassign [ResizeLine $x0 $y0 $x1 $y1 $short] x y
            lappend segments [concat $segment $x $y]
            set segment [list $x $y]
            set segmentLength 0

            lassign [list $x $y] x0 y0
            set leg [expr {hypot($x1-$x0, $y1-$y0)}]
        }
        lappend segment $x1 $y1
        set segmentLength [expr {$segmentLength + $leg}]
        lassign [list $x1 $y1] x0 y0
    }
    if {$segmentLength > 0} {
        lappend segments $segment
    }
    return $segments
}

proc ResizeLine {x0 y0 x1 y1 newLength} {
    set leg [expr {hypot($x1-$x0, $y1-$y0)}]
    set dx [expr {$x1 - $x0}]
    set dy [expr {$y1 - $y0}]

    set x [expr {$x0 + $dx * $newLength / $leg}]
    set y [expr {$y0 + $dy * $newLength / $leg}]

    return [list $x $y]
}
proc CenterCanvas {W w h} {
    set w [expr {$w / 2}]
    set h [expr {$h / 2}]
    $W config -scrollregion [list -$w -$h $w $h]
}
proc DrawOval {who args} {
    global S

    set xy [OvalCoords $who 0 360 5]
    .c create line $xy -tag oval$who {*}$args
    return "oval$who"
}
proc OvalCoords {who start end {delta 5}} {
    global S
    
    set a $S(rad,$who,a)
    set b $S(rad,$who,b)
    set y0 [expr {[info exist S(rad,$who,y)] ? $S(rad,$who,y) : 0}]
    set xy {}

    # Which direction
    set clockwise [expr {($end - $start) % 360}]
    set anticlockwise [expr {($start - $end) % 360}]
    set dir [expr {$clockwise <= $anticlockwise ? "clockwise" : "anticlockwise"}]
    if {$dir eq "anticlockwise"} {
        lassign [list $start $end] end start
    }
    if {$end <= $start} { incr end 360 }
    
    for {set deg $start} {$deg <= $end} {incr deg $delta} {
        set rad [expr {acos(-1) * $deg / 180}]

        set x [expr {$a * cos($rad)}]
        set y [expr {$y0 - $b * sin($rad)}]
        set x [format %.2f $x]
        set y [format %.2f $y]
        if {$dir eq "anticlockwise"} {
            set xy [concat $x $y $xy]
        } else {
            lappend xy $x $y
        }
    }
    return $xy
}
proc DrawArrows {args} {
    global S

    for {set who 0} {$who < 7} {incr who} {
        set dx0 0 ; set dy0 0 ; set dx1 0 ; set dy1 0
        lassign $::ARROW($who) . dx0 dy0 . dx1 dy1
        set xy [ArrowCoords $who black 40]
        set id [.c create line $xy -tag arrow,$who,black -fill black -arrow last -arrowshape {12 12 7} {*}$args]
        .c move $id $dx0 $dy0

        set xy [ArrowCoords $who white 40]
        set id [.c create line $xy -tag arrow,$who,white -fill white -arrow last -arrowshape {12 12 7} {*}$args]
        .c move $id $dx1 $dy1
    }
}
proc DrawPoints {} {
    global S
    for {set i 0} {$i < 7} {incr i} {
        #lassign $S($i) who degree
        lassign $::PTS($i) . degree . whichOval
        set a $S(rad,$whichOval,a)
        set b $S(rad,$whichOval,b)
        set S($i,xy) [PointOnEllipse $degree $a $b]

        .c create oval [Box {*}$S($i,xy) $S(box)] -fill black -tag [list points p$i]
    }
    set id [.c create poly [MakeStar {*}$S(0,xy) $S(box)] -fill green1 -tag {points p0}]
    .c move $id 1 0
}
proc DrawCrossing {who args} {
    set xy [CrossingCoords $who]
    .c create line $xy {*}$args
}
proc CrossingCoords {who} {
    global S
    lassign $S(cross,$who) node1 node2
    return [concat $S($node1,xy) $S($node2,xy)]
}
proc Box {x y r} {
    return [list [expr {$x-$r}] [expr {$y-$r}] [expr {$x+$r}] [expr {$y+$r}]]
}
proc PointOnEllipse {degree a b} {
    set rad [expr {acos(-1) * $degree / 180}]

    set x [expr {$a * cos($rad)}]
    set y [expr {-$b * sin($rad)}]
    set x [expr {round($x)}] ; set y [expr {round($y)}]
    return [list $x $y]
}

proc MakeStar {x y delta} {
    set pi [expr {acos(-1)}]

    # Compute distance to inner corner
    #set x1 [expr {$delta * cos(54 * $pi/180)}]  ;# Unit vector to inner point
    set y1 [expr {sin(54 * $pi/180)}]
    set y2 [expr {$delta * sin(18 * $pi/180)}]  ;# Y value to match
    set delta2 [expr {$y2 / $y1}]

    # Now get all coordinates of the 5 outer and 5 inner points
    for {set i 0} {$i < 10} {incr i} {
        set d [expr {($i % 2) == 0 ? $delta : $delta2}]
        set theta [expr {(90 + 36 * $i) * $pi / 180}]
        set x1 [expr {$x + $d * cos($theta)}]
        set y1 [expr {$y - $d * sin($theta)}]

        lappend coords $x1 $y1
    }
    return $coords
}

proc About {} {
    set msg "7 Graphical Divisibility Test\nby Keith Vetter -- April, 2016\n\n"
    append msg "Here's a simple, graphical way to test for divisibility by seven.\n\n"
    append msg "Start at the starred node at the bottom. Now take each digit in turn "
    append msg "from left to right in your number. For each digit, follow that many "
    append msg "black arrows in a row, and then add one white arrow. If you finish at "
    append msg "the bottom, then your number is divisible by 7.\n\n"
    append msg "How does it work? Here's a hint: the white arrows correspond to 10x mod 7."

    tk_messageBox -message $msg
}

namespace eval ::Animate {}

proc ::Animate::StepsForLeg {whichNode idx digits} {
    global ARCS

    set digit [string index $digits $idx]
    
    set steps {}
    lappend steps "begin" [list - $idx]
    for {set i 0} {$i < $digit} {incr i} {
        lappend steps "black" [list $i $idx]
        lappend steps {*}[::Animate::Xy2Steps [ArcCoords $whichNode black]]
        set whichNode [lindex $ARCS($whichNode,black) 3]
    }
    lappend steps "white" [list - $idx]
    lappend steps {*}[::Animate::Xy2Steps [ArcCoords $whichNode white]]
    lappend steps "done" [list - $idx]
    
    set whichNode [lindex $ARCS($whichNode,white) 3]
    return [list $whichNode $steps]
}
proc ::Animate::Xy2Steps {xy} {
    global S

    set segments [SegmentLine $xy $S(animate,stepSize)]
    set steps [lrange [lindex $segments 0] 0 1]
    set steps {}
    foreach segment $segments {
        lappend steps {*}[lrange $segment end-1 end]
    }
    return $steps
}
proc Start {} {
    global S
    
    set S(number,candidate) [string trim $S(number,candidate)]
    if {$S(state) eq "unstarted"} {
        ResetAnimation
        set S(state) started
        7Test $S(number,candidate)
    } else {
        set S(state) unstarted
    }
}
proc 7Test {digits} {
    ShowNumber $digits
    if {[string is integer -strict $digits]} {
        DoAnimation $digits 0 {} 0
    } else {
        set ::S(state) "unstarted"
    }
}
proc ResetAnimation {} {
    .c delete breadcrumbs breadcrumbs,old
    .c coords animate [Box {*}$::S(0,xy) 30]
}
proc DoAnimation {digits idx steps where} {
    global S
    
    if {$S(state) ne "started"} return
    if {$steps eq {} && $idx >= [string length $digits]} {
        HighlightDigit "over" $digits - $where
        set S(state) "unstarted"
        return
    }
    
    set nextWhere $where
    if {$steps eq {}} {
        set digit [string index $digits $idx]
        lassign [::Animate::StepsForLeg $where $idx $digits] nextWhere steps
        incr idx
    }

    set extraDelay 1
    if {$steps ne {}} {
        set nextSteps [lassign $steps newX newY]
        if {$newX in {"begin" "black" "white" "done"}} {
            set extraDelay [HighlightDigit $newX $digits {*}$newY]
        } else {
            lassign [.c bbox animate] x0 y0 x1 y1
            set x [expr {($x1 + $x0)/2}] ; set y [expr {($y1 + $y0)/2}]
            set dx [expr {$newX - $x}] ; set dy [expr {$newY - $y}]
            if {$S(breadcrumbs)} {
                set xy [.c coords breadcrumbs]
                if {$xy eq {}} {
                    .c create line $x $y $x $y -tag breadcrumbs -fill red -width 4
                    .c raise points
                    .c raise animate
                } else {
                    lappend xy $x $y
                    .c coords breadcrumbs $xy
                }   
            }
            .c move animate $dx $dy
        }
        set delay $S(animate,delay)
        if {$extraDelay > 1} {
            set delay $extraDelay
        }
        after $delay [list DoAnimation $digits $idx $nextSteps $nextWhere]
    }
    return
}


DoDisplay
return