[GWM] Another (more familiar) illusion, this allows the user to try out a range of arrow angles and adjust the length of one line until the lines appear equal length.  After 10 repeats, using slightly different length lines, an average ratio of length chosen to true length is printed to the console.  Reverse the direction of the arrow ends, and repeat.  With sharp arrows (20 degrees) the effect reaches about 5 to 10% reasonably repeatably for me.

See also [Atlantis Cafe Illusion] & [Bulging Line Illusion]

======
 # Optical illusions
 # i) are these the same length?- adjust the arrow angle and the length to identify maximum illusion

 proc drawarrowline { frm  len y angle mid} {
        set r 30
        set dx [expr $r*cos($angle*.017345)]
        set dy [expr $r*sin($angle*.017345)]
        $frm create line [expr $mid-$len] $y [expr $len+$mid] $y -fill black -width 3
        lappend line [expr $mid-$len - $dx] [expr $y + $dy]  [expr $mid-$len] $y [expr $mid-$len - $dx] [expr $y - $dy]

        $frm create line $line -fill black -width 3
        lset line []
        lappend line [expr $mid +$len + $dx] [expr $y + $dy] [expr $mid +$len] $y [expr $mid +$len + $dx] [expr $y - $dy]

        $frm create line $line -fill black -width 3
 }

 proc redraw { va} { ;# l2 is length of the second line; angle the angle of the arrows
         global len angle reflen
             catch [destroy .frm] {} ;# delete drawing area. Same as clear.
        set wid 125
        set frm [canvas .frm -width [expr $wid*2] -height 140]
                # draw 2 lines of length xx with 'arrows' at opposite angles
        drawarrowline $frm $reflen 50 $angle $wid
        drawarrowline $frm [expr int(35+$len*0.3)]  100 [expr int(180-$angle)] $wid
        pack .frm
 }

 proc checkok {} {
          global len angle reflen suml ntries
        lappend suml [expr 100*(35+$len*0.3)/($reflen)]
        incr ntries
 # set a new random test length and jumble up the uer set to remove hints
        set reflen [expr 42 + 15*rand()]
        set len [expr 90*rand()]
        if {$ntries>10} { Scores
        } else { redraw 0 ;# draw the new lines
        }
 }
 proc Scores {} {
          global len angle reflen  suml ntries
        if {$ntries>0} {
                set sum 0
                foreach score $suml {
                        puts "Score $score"
                        set sum [expr $sum+$score]
                }
                puts "After $ntries, average [format %.1f [expr $sum/$ntries]]% of desired length with angle $angle degrees."
                set reflen [expr 42 + 15*rand()]
                set len [expr 90*rand()]
                redraw 0
                set ntries 0
                set suml {}
        }
 }
 proc createArrowIllusion {} {
          global len angle reflen ;# arrow length, angle and compare with length
        global suml ntries
        set ntries 0
        set suml {}
        set reflen [expr 42 + 15*rand()]
        set len 60
        set angle 20
            catch [destroy .btns] {} ;# delete controls
        set btn [frame .btns]
        pack $btn -side top
        label $btn.inst -text "Adjust Length until the two lines are equal length.\nThen press 'OK' and repeat."
        menubutton $btn.angl -menu $btn.angl.opts  -text "Set Angle"
        set mn [menu $btn.angl.opts ]
        for {set i 20} {$i<165} {incr i 20} {
                $mn add command -label "$i" -command "set angle $i;redraw 0"
        }

        scale $btn.len -variable len -orient horizontal -showvalue false -label "Length" -command "redraw"
        button $btn.ok -text "OK" -command "checkok"
        button $btn.scr -text "Score" -command "Scores"
        set btnfrm [frame $btn.frm]
        pack $btn.inst $btn.angl $btn.len $btnfrm -side top
        pack $btn.ok $btn.scr -side left

        wm title . "Arrow Illusion"
 }

 createArrowIllusion
======

<<categories>> Mathematics | Graphics | Optical Illusion