Magic Cards

GWM Presents a number of cards - you select Yes or No to check if your imagined number is there. After 6 questions the number you thought of is displayed. A classic automatic magic trick often used in Christmas Crackers.

Unless you gave an incorrect answer, when the result is GiGo - Garbage In, Garbage Out. This variation allows a range of choice other than 0-64 or 0-128 etc. The technique is identical in every way (but looks cleverer) than simple binary splitting - 'is your number <50? (Yes - is number <25; no:is number <75) until you halve your way to the target.

package require Tk

# 'magic' interactive eneration of magic cards trick
global sum
proc addresult {nres onoff nmax} {
        global sum
        if {$onoff == 1} {
                 incr sum $nres
        }
         incr  nres $nres
        puts "Result $sum $nres"
        makeCard $nmax $nres
}

proc showresult {nmax} {
    global sum
    catch {destroy .bguess} {} ;
    catch {destroy .t} {} ;# delete it. Same as clear.
    catch {destroy .byes} {} ;
    catch {destroy .bno} {} ;
    catch {destroy .end} {} ;
    button .bguess   -text "Your number was\n$sum" -command "givehelp $nmax" -font {Arial 32 bold}
    pack .bguess
}
proc givehelp {nmax} {
    global sum
    catch {destroy .bguess} {} ;
    catch {destroy .t} {} ;# delete it. Same as clear.
    catch {destroy .byes} {} ;
    catch {destroy .bno} {} ;
    catch {destroy .end} {} ;
    button .bguess   -text "Choose a number between\n0 & $nmax" -command "runtrick $nmax" -font {Arial 32 bold}
    pack .bguess
}

proc makeCard {nmax ntest} {
   catch {destroy .bguess} {} ;
   catch {destroy .t} {} ;# delete it. Same as clear.
   catch {destroy .byes} {} ;
   catch {destroy .bno} {} ;
   catch {destroy .end} {} ;

    if { $nmax >$ntest } {
        text .t  -bg beige
        button .byes   -text "Yes" -command "addresult $ntest 1 $nmax"
        button .bno   -text "No" -command "addresult $ntest 0 $nmax"
        button .end   -text "Quit" -command "exit"
        pack .t .byes .bno .end
        pack .byes .bno .end -side left
        .t insert end "Is your number in this set:\n"
        set i 1
        set nextnewl 10
        while {$i<$nmax} {
            set frac [expr (($i/$ntest))]
            if {[expr $frac%2==1 ] } {
                    .t insert end " $i"
            }
            incr i
            if {$i>$nextnewl} {
                .t insert end "\n"
                incr nextnewl 10
            }
        }
    } else {
        showresult  $nmax
    }
}

proc runtrick {nmax} {
        global sum
        set sum 0
        
        makeCard $nmax 1
}
proc starttrick {nmax} {
        givehelp $nmax
}

set sum 0
starttrick 100