#!/bin/sh
# the next line restarts using wish \
exec wish "0ドル" "$@"
# 1.1 has better color scheme
set version "1.3"
#
# set these two flags to 1 to get a stand-alone version
# as used by me; set them to 0 to get plug-in netscape
# compatible version:
#
set ownwindow 0
set verbose 0
if {$verbose>=1} {
 puts "Hamming Code version $version David J C MacKay 1997"
 puts " written under tcl 8.3 on linux"
 puts " believed to require tcl 7.6 or greater"
}
global verbose ; set verbose 0
global transmitcolor decodecolor zerocolor szerocolor 
global syndromecolor receivedcolor
set textx 3
set texty 3
global errorcolor ; set errorcolor "red"
global brighterrorcolor ; set brighterrorcolor "orange"
global brightnoisecolor ; set brightnoisecolor "orange1"
set canvascolor "#000052d052ef"
global backgroundcol ; set backgroundcol gray90 ; set backgroundcol $canvascolor
set textcolor green1
set transmitcolor gold1
set decodecolor gold1
set zerocolor gray
set noisecolor red
set szerocolor white
set syndromecolor purple1
set syndromecolor slateblue1
set syndromecolor cyan1
set receivedcolor green
set inferrednoisecolor "deeppink1"
set inferrednoisecolor "pink1"
# gray50: smaller is darker.
# check.tcl --
# answered qs
# how to make buttons inactive (grey) -state inactive
# rand
# how to list multiple commands to associate with a button? can put them in quotes separated by ";"
# questions: high priority
# how to get help on functions? Sometimes man xxxx produces the C page for xxxx
# instead of the tcl page -- man n open
# how to get things to happen in my order visibly and immediately?
# how to bind an entire frame (including its contents) -- I find that
# buttons in my frame will hog an action even if they don't respond
# to it. bindtags command tells the order of binding of widgets.
# need to know about widget classes USEFUL!
# medium
# how to bind leaving-scale (fn) to the dons command?
# spacers inbetween frames?
# why do I need to declare some things global
# and others not (eg $syndrome.msg flash
# worked fine when syndrome was actually
# high level, (top) but not when I put it in 
# antoher frame
# low priority
# how to invoke the command that pushing a check button causes
# *without* changing its state?
# why did my if ($...) not work, and my if {$verbose} work?
# how to make text arranged in new lines in a frame (without making subframes)
# (e.g. I want to pack things at l.h.s.)
set top .
if {$ownwindow>=1} {
 wm title . "(7,4) Hamming Code Demonstration"
 wm iconname . "hamming"
 wm geometry . +10+10
}
############################ canvas stuff
set canvasescreated 1 ;# not to be confused with doingcanvases
set w ""
frame $w.canvases 
set w $w.canvases
set canvases $w
# make a canvas for the 7,4 case
# encoder and syndrome
set ce $w.ce
set cs $w.cs
set cn $w.cn
set ct $w.ct
# circle color
set red gray45
foreach c [list $ct $cn $cs $ce] {
 canvas $c -width 195 -height 195 -background $canvascolor
}
foreach c [list $ct $cn $cs $ce] {
# the three parity discs
 # circles hoops
 $c create oval 10 185 130 65 -outline $red -width 10 -tags z3
 $c create oval 190 185 70 65 -outline $red -width 10 -tags z2
 $c create oval 40 10 160 130 -outline $red -width 10 -tags z1
 set wi 10
 $c create oval [expr 60+$wi] [expr 85+$wi] [expr 60-$wi] [expr 85-$wi] -fill lightgray -tags t1
 $c create text 60 85 -text s1 -tags r1 
 $c create oval [expr 140+$wi] [expr 85+$wi] [expr 140-$wi] [expr 85-$wi] -fill lightgray -tags t2
 $c create text 140 85 -text s2 -tags r2 
 $c create oval [expr 100+$wi] [expr 105+$wi] [expr 100-$wi] [expr 105-$wi] -fill lightgray -tags t3
 $c create text 100 105 -text s3 -tags r3 
 $c create oval [expr 100+$wi] [expr 150+$wi] [expr 100-$wi] [expr 150-$wi] -fill lightgray -tags t4
 $c create text 100 150 -text s4 -tags r4
 $c create oval [expr 100+$wi] [expr 40+$wi] [expr 100-$wi] [expr 40-$wi] -fill lightgray -tags t5 
 $c create text 100 40 -text t5 -tags r5 
 $c create oval [expr 160+$wi] [expr 140+$wi] [expr 160-$wi] [expr 140-$wi] -fill lightgray -tags t6
 $c create text 160 140 -text t6 -tags r6 
 $c create oval [expr 50+$wi] [expr 140+$wi] [expr 50-$wi] [expr 140-$wi] -fill lightgray -tags t7
 $c create text 50 140 -text t7 -tags r7 
}
set font "Courier 20"
$ct create text $textx $texty -text Transmitted -anchor nw -fill $textcolor -font $font
$cn create text $textx $texty -text Noise -anchor nw -fill $textcolor -font $font
$cs create text $textx $texty -text Received -anchor nw -fill $textcolor -font $font
$ce create text $textx $texty -text Decoded -anchor nw -fill $textcolor -font $font
#$ct create text 0 0 -text Transmitted -anchor nw -fill $transmitcolor -font $font
#$cn create text 0 0 -text Noise -anchor nw -fill $noisecolor -font $font
#$cs create text 0 0 -text Received -anchor nw -fill $receivedcolor -font $font
#$ce create text 0 0 -text Decoded -anchor nw -fill $decodecolor -font $font
# add an extra disc to the syndrome dude, to represent y$i, and to the error panel.
foreach c [list $cs $ce] {
 set wi 10
 $c create oval [expr 60+$wi] [expr 85+$wi] [expr 60-$wi] [expr 85-$wi] -outline lightgray -tags y1 -width 0
 $c create oval [expr 140+$wi] [expr 85+$wi] [expr 140-$wi] [expr 85-$wi] -outline lightgray -tags y2 -width 0
 $c create oval [expr 100+$wi] [expr 105+$wi] [expr 100-$wi] [expr 105-$wi] -outline lightgray -tags y3 -width 0
 $c create oval [expr 100+$wi] [expr 150+$wi] [expr 100-$wi] [expr 150-$wi] -outline lightgray -tags y4 -width 0
 $c create oval [expr 100+$wi] [expr 40+$wi] [expr 100-$wi] [expr 40-$wi] -outline lightgray -tags y5 -width 0
 $c create oval [expr 160+$wi] [expr 140+$wi] [expr 160-$wi] [expr 140-$wi] -outline lightgray -tags y6 -width 0
 $c create oval [expr 50+$wi] [expr 140+$wi] [expr 50-$wi] [expr 140-$wi] -outline lightgray -tags y7 -width 0
}
foreach i {1 2 3 4 5 6 7} {
 $cs itemconfig r$i -text r$i
 $cn itemconfig r$i -text n$i
 $ce itemconfig r$i -text "<$i>"
}
####################################################################
# define buttons and status
####################################################################
set w ""
frame $w.status ; set status $w.status
frame $w.buttons ; set buttons $w.buttons
#
# make a noise level
#
global fn
scale $status.fn -orient vertical -length 184 -from 0 -to 0.5 \
	-variable fn -tickinterval 0.1 -resolution 0.01 -bigincrement 0 \
	-label "Noise level"
scale $w.buttons.fn -orient horizontal -length 200 -from 0 -to 0.5 \
	-variable fn -tickinterval 0 -resolution 0.01 -bigincrement 0 \
	-label "Noise level"
set fn 0.1
# -command {dons $fn}
# note scale automatically passes its value to the command
# but a plain "-command" gets executed every time the scale is touched
# rather than when it is set and left alone.
button $w.buttons.dismiss -text Quit -command "destroy ."
button $w.buttons.dismiss2 -text Quit -command "destroy ."
button $w.buttons.activateall -text "Systems on" -command {systemson ; dots}
button $w.buttons.unactivate -text "Systems off" -command systemsoff
button $w.buttons.allzero -text "All Zero" -command allzero
bind . <z> allzero
bind . <q> {destroy .} 
bind . <control-c> {destroy .} 
global doingcanvases ; set doingcanvases 0
checkbutton $w.buttons.canvas -variable doingcanvases -command canvaspack -text "show figure"
#
pack $w.buttons.dismiss -side right
pack $w.buttons.dismiss2 $w.buttons.activateall $w.buttons.unactivate $w.buttons.allzero $w.buttons.canvas $w.buttons.fn -side left -padx 4
pack $status -side bottom -fill x -pady 2m
pack $w.buttons -side top -fill x -pady 2m
proc systemson { } {
 global doingtransmit ; set doingtransmit 1 ;
 global doingsyndrome ; set doingsyndrome 1
 global doingreceive ; set doingreceive 1
 global doinginfer ; set doinginfer 1
 global doingdecode ; set doingdecode 1
 global doingerror ; set doingerror 1
}
proc systemsoff { } {
 global doingtransmit ; set doingtransmit 0
 global doingsyndrome ; set doingsyndrome 0
 global doingreceive ; set doingreceive 0
 global doinginfer ; set doinginfer 0
 global doingdecode ; set doingdecode 0
 global doingerror ; set doingerror 0
}
systemsoff
# systemson
global Z Noise ; set Noise 0 ; set Z 0 
global noisevec ; set noisevec 1
global totalerror ; set totalerror 0
global P N K M 
global latestchanged ; set latestchanged 0 
global noisemethod ; set noisemethod singlet
###############################################################
#
# Status
#
###############################################################
#
# make a column of status buttons
#
frame $status.buttons -relief groove -borderwidth 2
set statusb $w.status.buttons
pack $statusb -side left -anchor ne
# label $statusb.msg -justify center -text "Status" -pady 15
# pack $statusb.msg -side top
checkbutton $statusb.t -text "encode immediately" -variable doingtransmit -command {if $doingtransmit dots}
frame $statusb.noise
label $statusb.noise.l -text "Noise generation:"
pack $statusb.noise.l -side left -pady 2 -anchor w
foreach i {zero singlet cycle random} {
 radiobutton $statusb.noise.b$i -text "$i" -variable noisemethod \
	 -relief flat -value $i -command {dons $fn}
 pack $statusb.noise.b$i -side left -pady 2 -anchor w
}
checkbutton $statusb.r -text "transmit immediately" -variable doingreceive -command {if $doingreceive dors}
checkbutton $statusb.z -text "syndrome" -variable doingsyndrome -command {if $doingsyndrome dozs}
checkbutton $statusb.y -text "infer immediately" -variable doinginfer -command {if $doinginfer doys}
checkbutton $statusb.x -text "decode immediately" -variable doingdecode -command {if $doingdecode doxs}
checkbutton $statusb.e -text "errors" -variable doingerror -command {if $doingerror does}
# spacer here
checkbutton $statusb.flashy -text "flashy" -variable flashy 
# whether things flash when updated
pack $statusb.t $statusb.noise $statusb.r $statusb.z $statusb.y $statusb.x $statusb.e $statusb.flashy -side top -anchor w -padx 30
#
# make a syndrome record and number of errors
#
frame $status.numbers -relief groove -borderwidth 4 
set n $status.numbers
if { $verbose>= 2 } {
 label $n.nnn -text "Noise number: "
 label $n.nn -textvariable noisevec
 pack $n.nnn $n.nn -side top -fill x -expand 1 -pady 3
}
label $n.nl -text "Noise flipped: "
label $n.n -textvariable Noise
pack $n.nl $n.n -side top -fill x -expand 1 -pady 3
label $n.zl -text "Syndrome: "
label $n.z -textvariable Z 
pack $n.zl $n.z -side top -fill x -expand 1 -pady 3
label $n.el -text "Errors: "
label $n.e -textvariable totalerror
pack $n.el $n.e -side top -fill x -expand 1 -pady 3
# 
# put fn and numbers 
#
pack $w.status.fn $n -side left -anchor center -padx 10
# $w.status bind fn <any-leave> {dons $fn}
###############################################################
#
# Code definition
#
###############################################################
set N 7
set K 4
set M [expr $N-$K]
# Main packing:
# label .msg -wraplength 4i -justify center -text "($N,$K) Hamming Code" -padx 5 -pady 5
# pack .msg -side top
pack $ct $cn $cs $ce -side left -fill y
proc canvaspack { } {
 global canvases ; global doingcanvases 
 global status , buttons , N 
 if $doingcanvases {
	pack $canvases -side top -fill y -before $status -after $buttons
#	transfers $N ; transfern ; transferr ; transfery ; transfere ; transferz 
	alltransfer 
 } else {
	pack forget $canvases
 }
}
set bo 2
frame .encoder -relief groove -borderwidth $bo 
frame .encoder.source -background $backgroundcol
frame .encoder.transmit -background $backgroundcol
set source .encoder.source 
set transmit .encoder.transmit
frame .noise -relief flat -borderwidth $bo -background $backgroundcol
set noise .noise
frame .decoder -relief groove -borderwidth $bo -background $backgroundcol
frame .decoder.receive -background $backgroundcol
frame .decoder.syndrome -background $backgroundcol
frame .decoder.decodey -background $backgroundcol
frame .decoder.decodex -background $backgroundcol
set receive .decoder.receive 
set syndrome .decoder.syndrome
set decodey .decoder.decodey
set decodex .decoder.decodex
frame .error -relief flat -borderwidth $bo -background $backgroundcol
set error .error
pack $source $transmit \
 -side left -fill y
pack .encoder .noise .decoder .error \
 -side left -fill y -padx 6
pack $receive $syndrome $decodey $decodex \
 -side left -fill y
# generator matrix's parity block
set p "1 1 1 0 0 1 1 1 1 0 1 1"
set i -1 ;
for {set m 1} {$m<=$m} {incr m} { for {set k 1} {$k<=$k} {incr k} { incr i set P($m,$k) [lindex $p $i] if {$verbose>=2} {puts $P($m,$k)}
 }
}
###############################################################
#
# The vectors headings
#
###############################################################
set w $source
button $w.msg -justify left -text "Source bits" -command {doss 0.5}
pack $w.msg -side top
set w $transmit
button $w.msg -justify left -text "Transmitted" -command dots
bind $w <1> dots ;# any click here activates dots
bind . t dots ;# and pressing t anywhere
bind $w <2> "$statusb.t invoke" 
bind $w.msg <2> "$statusb.t invoke" ;# this is a pain!
pack $w.msg -side top
set w $noise
button $w.msg -justify left -text "Noise" -command {dons $fn}
pack $w.msg -side top
set w $receive
button $w.msg -justify left -text "Received" -command dors
bind $w <2> "$statusb.r invoke" 
pack $w.msg -side top
set w $syndrome
button $w.msg -justify left -text "Syndrome" -command dozs
bind $w <2> "$statusb.z invoke" 
pack $w.msg -side top
set w $decodey
button $w.msg -justify left -text "Inferred noise" -command doys
bind $w <2> "$statusb.y invoke"
pack $w.msg -side top
set w $decodex
button $w.msg -justify left -text "Decoded message" -command doxs
bind $w <2> "$statusb.x invoke"
pack $w.msg -side top
set w $error
button $w.msg -justify left -text "Errors" -command does
bind $w <2> "$statusb.e invoke" 
pack $w.msg -side top
###############################################################
#
# Vectors
#
###############################################################
proc alltransfer { } {
 global N
 transfers $N ; transfern ; transferr ; transfery; transferx ; transfere ; transferz 
}
proc allzero { } {
 global K N M 
 for {set k 1} {$k<=$k} {incr k} { global s$k set s$k 0 } for {set k 1} {$k<=$n} {incr k} { global x$k e$k y$k set x$k 0 ; set e$k 0 ; set y$k 0 global t$k n$k r$k set t$k 0 ; set n$k 0 ; set r$k 0 } for {set k 1} {$k<=$m} {incr k} { global z$k set z$k 0 } global canvasescreated ; if { $canvasescreated } { alltransfer } } # make the buttons for the vectors # source buttons set w $source set command "pack" for {set k 1} {$k<=$k} {incr k} { checkbutton $w.s$k -text "s$k" -variable s$k -relief flat -command { if $doingcanvases "transfers $K"; if $doingtransmit dots} -selectcolor $transmitcolor -background $backgroundcol -fg $transmitcolor append command " \$w.s$k" } append command " -side top -pady 2 -anchor w" eval $command ############################################# # more canvases stuff - bind the s dots to be like s buttons if { $canvasescreated } { foreach i {1 2 3 4} { $ct bind t$i <1> "$w.s$i toggle ; transfers $K ; if \$doingtransmit dots"
	$ct bind r$i <1> "$w.s$i toggle ; transfers $K ; if \$doingtransmit dots"
 }
}
#############################################
set w $transmit
set command "pack"
for {set k 1} {$k<=$n} {incr k} { checkbutton $w.t$k -text "t$k" -variable t$k -relief flat -command "oi transmitted; dots" -selectcolor $transmitcolor -highlightcolor "gray50" -background $backgroundcol -fg $transmitcolor append command " \$w.t$k" } append command " -side top -pady 2 -anchor w" eval $command set w $noise set command "pack" for {set k 1} {$k<=$n} {incr k} { checkbutton $w.n$k -text "n$k" -variable n$k -relief flat -command {if $doingcanvases transfern; if $doingreceive dors} -selectcolor $noisecolor -background $backgroundcol -fg $brightnoisecolor append command " \$w.n$k" } append command " -side top -pady 2 -anchor w" eval $command ###################### canvas stuff if { $canvasescreated } { foreach i {1 2 3 4 5 6 7} { $cn bind t$i <1> "$w.n$i toggle ; countNoise ; transfern ; if \$doingreceive dors"
	$cn bind r$i <1> "$w.n$i toggle ; countNoise ; transfern ; if \$doingreceive dors"
 }
}
######################################
set w $receive ;# set up the r buttons
set command "pack"
for {set k 1} {$k<=$n} {incr k} { checkbutton $w.r$k -text "r$k" -variable r$k -relief flat -command "oi received; dors" -highlightcolor "gray70" -selectcolor $receivedcolor -background $backgroundcol -fg $receivedcolor append command " \$w.r$k" } append command " -side top -pady 2 -anchor w" eval $command set w $syndrome set command "pack" for {set k $M} {$k>=1} {incr k -1} {
 checkbutton $w.z$k -text "z$k" -variable z$k -relief flat -command "oi syndrome; dozs" -selectcolor $syndromecolor -background $backgroundcol -fg $syndromecolor
 append command " \$w.z$k"
}
append command " -side bottom -pady 2 -anchor w"
eval $command
set w $decodex
set command "pack"
for {set k 1} {$k<=$n} {incr k} { checkbutton $w.x$k -text "<t$k>" -variable x$k -relief flat -command "oi decoded; doxs" -selectcolor $decodecolor -background $backgroundcol -fg $decodecolor
 append command " \$w.x$k"
}
append command " -side top -pady 2 -anchor w"
eval $command
set w $decodey
set command "pack"
for {set k 1} {$k<=$n} {incr k} { checkbutton $w.y$k -text "<n$k>" -variable y$k -relief flat -command "oi inferred; doys" -selectcolor $inferrednoisecolor -background $backgroundcol -fg $inferrednoisecolor
 append command " \$w.y$k"
}
append command " -side top -pady 2 -anchor w"
eval $command
set w $error
set command "pack"
for {set k 1} {$k<=$n} {incr k} { checkbutton $w.e$k -text "e$k" -variable e$k -relief flat -command "oi error; does" -selectcolor $errorcolor -background $backgroundcol -fg $brighterrorcolor append command " \$w.e$k" } append command " -side top -pady 2 -anchor w" eval $command ############################################################### # # Update rules # ############################################################### # this does the t's to their values proc dots { } { global transmit global verbose ; if {$verbose>=2} {puts "entering dots"}
 global N M K P p doingreceive
 for {set k 1} {$k<=$k} {incr k} { global s$k } for {set k 1} {$k<=$n} {incr k} { global t$k } # show visually that we are redoing t global flashy ; if { $flashy } { $transmit.msg flash } for {set k 1} {$k<=$k} {incr k} { set t$k [set s$k] } for {set m 1} {$m<=$m} {incr m} { set mm [expr $m + $K] set t$mm 0 ; for {set k 1} {$k<=$k} {incr k} { set t$mm [expr ([set t$mm] ^ ($P($m,$k)&[set s$k]))] } } global doingcanvases ; if { $doingcanvases } { transfers $N } update idletasks ;# to force things to happen set latestchanged 1 if $doingreceive dors } ################################### these copy bits to the canvas elements proc transfers { NN } { global transmitcolor decodecolor zerocolor global ct ; global N ; global K for {set k 1} {$k<=$k} {incr k} { global s$k } for {set k 1} {$k<=$n} {incr k} { global t$k } for {set k 1} {$k<=$nn} {incr k} { if {$k<=$k} { set this [set s$k] } else { set this [set t$k] } # puts $this # WAS [expr "$this ? $transmitcolor : $zerocolor" ] # set query # puts $query $ct itemconfig t$k -fill [expr {$this ? $transmitcolor : $zerocolor} ] } } proc transferr { } { global transmitcolor decodecolor zerocolor receivedcolor global cs ; global N for {set k 1} {$k<=$n} {incr k} { global r$k } for {set m 1} {$m<=$n} {incr m} { $cs itemconfig t$m -fill [expr {[set r$m] ? $receivedcolor : {gray} } ] } } proc transfern { } { global transmitcolor decodecolor zerocolor global cn ; global N for {set k 1} {$k<=$n} {incr k} { global n$k } for {set m 1} {$m<=$n} {incr m} { $cn itemconfig t$m -fill [expr {[set n$m] ? {red} : {gray} } ] } } proc transferz { } { global transmitcolor decodecolor szerocolor syndromecolor global cs ; global M for {set k 1} {$k<=$m} {incr k} { global z$k } for {set m 1} {$m<=$m} {incr m} { $cs itemconfig z$m -outline [expr {[set z$m] ? $syndromecolor : $szerocolor } ] } } # y isthe name forthehypothesized noise proc transfery { } { global transmitcolor decodecolor zerocolor receivedcolor global cs ; global N for {set k 1} {$k<=$n} {incr k} { global y$k } for {set m 1} {$m<=$n} {incr m} { $cs itemconfig y$m -outline [expr {[set y$m] ? {deeppink1} : $zerocolor } ] $cs itemconfig y$m -width [expr {[set y$m] ? {6} : {0} } ] } } proc transfere { } { global transmitcolor decodecolor zerocolor errorcolor global ce ; global N for {set k 1} {$k<=$n} {incr k} { global e$k } for {set m 1} {$m<=$n} {incr m} { $ce itemconfig y$m -outline [expr {[set e$m] ? $errorcolor : {white} } ] $ce itemconfig y$m -width [expr {[set e$m] ? {6} : {2} } ] # make errors show up a lot } } proc transferx { } { global transmitcolor decodecolor zerocolor global ce ; global N for {set k 1} {$k<=$n} {incr k} { global x$k } for {set m 1} {$m<=$n} {incr m} { $ce itemconfig t$m -fill [expr {[set x$m] ? $decodecolor : $zerocolor}] } } ################################### # this makes a random s proc doss { fn } { global verbose ; if {$verbose>=2} {puts "entering doss"}
 global N M K P p doingtransmit
 for {set k 1} {$k<=$k} {incr k} { global s$k } # end of declarations # show visually that we are redoing s global flashy ; if { $flashy } { $source.msg flash } for {set k 1} {$k<=$k} {incr k} { set s$k [expr (rand())>$fn ? 0:1 ]
 }
 global doingcanvases ; if { $doingcanvases } {
	transfers $K
 }
 update idletasks ;# to force things to happen
 if $doingtransmit dots
}
proc countNoise { } {
 global Noise N
 for {set k 1} {$k<=$n} {incr k} { global n$k } set Noise 0 for {set k 1} {$k<=$n} {incr k} { if [set n$k] {incr Noise} } } # this makes n proc dons { fn } { global noise global verbose ; if {$verbose>=2} {puts "entering dons"}
 global N M K P p doingreceive Noise noisevec noisemethod
 for {set k 1} {$k<=$n} {incr k} { global n$k } # end of declarations # show visually that we are redoing n global flashy ; if { $flashy } { $noise.msg flash } for {set k 1} {$k<=$n} {incr k} { set n$k 0 } incr noisevec if {$verbose>=2} { puts "noisevec = $noisevec" }
 switch $noisemethod {
	singlet {
	 if {$verbose>=2} {puts "singlet noisevec = $noisevec"}
	 if {$noisevec>$N} {set noisevec 0}
	 if {$noisevec>0} { set n$noisevec 1 }
	}
	cycle { 
	 set noi $noisevec
	 for {set k 1} {$k<=$n} {incr k} { set n$k [expr $noi%2] set noi [expr $noi/2] } } random { for {set k 1} {$k<=$n} {incr k} { set n$k [expr (rand())>$fn ? 0:1 ]
	 }
	}
	one {
	 for {set k 1} {$k<=$n} {incr k} { set n$k 1 } } zero { } } countNoise # set Noise 0 # for {set k 1} {$k<=$n} {incr k} { # if [set n$k] {incr Noise} # } global doingcanvases ; if { $doingcanvases } { transfern } update idletasks ;# to force things to happen if $doingreceive dors } global RAND_MAX ; set RAND_MAX 1000 proc ranu { } { set ret 1 # [expr (rand())] # set ret [expr (rand()/(RAND_MAX+1.0)); return $ret } # this does the r's to their values proc dors { } { global receive global verbose ; if {$verbose>=2} {puts "entering dors"}
 global N M K P p doingsyndrome
 # show visually that we are redoing 
 global flashy ; if { $flashy } { $receive.msg flash }
 for {set k 1} {$k<=$n} {incr k} { global t$k r$k n$k } for {set k 1} {$k<=$n} {incr k} { set r$k [expr [set t$k]^[set n$k]] } global doingcanvases ; if { $doingcanvases } { transferr } set latestchanged 2 update idletasks ;# to force things to happen if $doingsyndrome dozs } # this does the z's to their values proc dozs { } { global syndrome global verbose ; if {$verbose>=2} {puts "entering dozs"}
 global N M K P p doinginfer Z
 # show visually that we are redoing 
 global flashy ; if { $flashy } { $syndrome.msg flash }
 for {set k 1} {$k<=$m} {incr k} { global z$k } for {set k 1} {$k<=$n} {incr k} { global r$k } set Z 0 ; set factor 1 ;# Z will contain the binary repn of the whole syndrome for {set m 1} {$m<=$m} {incr m} { set mm [expr $m + $K] set z$m [set r$mm] ; for {set k 1} {$k<=$k} {incr k} { set z$m [expr ([set z$m] ^ ($P($m,$k)&[set r$k]))] } incr Z [expr [set z$m]*$factor] set factor ($factor*2) } global doingcanvases ; if { $doingcanvases } { transferz } set latestchanged 2 if {$verbose>=1} {puts "syndrome is $Z"}
 update idletasks ;# to force things to happen
 if $doinginfer doys
}
proc doys { } {
 global decodey
 global verbose ; if {$verbose>=2} {puts "entering doys"}
 global N M K P p doingdecode Z
 # show visually that we are redoing 
 global flashy ; if { $flashy } { $decodey.msg flash }
 for {set k 1} {$k<=$m} {incr k} { global z$k } for {set k 1} {$k<=$n} {incr k} { global r$k y$k } # how to do the decoding if we ignore the parity bits for {set m 1} {$m<=$n} {incr m} { set y$m 0 } # we need a ML decoder here! if {($N == 7)&&($K == 4)} { switch $Z { 0 { } 1 { flip 5 } 2 { flip 6 } 3 { flip 2 } 4 { flip 7 } 5 { flip 1 } 6 { flip 4 } 7 { flip 3 } } } else { puts "Don't know a decoder for N=$N, K=$K" } global doingcanvases ; if { $doingcanvases } { transfery } update idletasks ;# to force things to happen if $doingdecode doxs } proc flip { n } { global y$n set y$n 1 } proc doxs { } { global decodex global verbose ; if {$verbose>=2} {puts "entering doxs"}
 global N M K P p doingerror Z
 # show visually that we are redoing 
 global flashy ; if { $flashy } { $decodex.msg flash }
 for {set k 1} {$k<=$n} {incr k} { global r$k x$k y$k } # how to do the decoding if we ignore the parity bits for {set m 1} {$m<=$n} {incr m} { set x$m [expr [set r$m]^[set y$m]] } global doingcanvases ; if { $doingcanvases } { transferx } update idletasks ;# to force things to happen if $doingerror does } proc does { } { global error global verbose ; if {$verbose>=2} {puts "entering does"}
 global N M K P p totalerror
 # show visually that we are redoing 
 global flashy ; if { $flashy } { $error.msg flash }
 for {set k 1} {$k<=$n} {incr k} { global x$k t$k e$k } set totalerror 0 for {set m 1} {$m<=$n} {incr m} { set e$m [expr [set x$m]^[set t$m]] ; incr totalerror [set e$m] } global doingcanvases ; if { $doingcanvases } { transfere } if {$verbose>=2} {puts "Number of errors: $totalerror"}
 update idletasks ;# to force things to happen
}
proc oi { s } {
 puts "you can't change the $s bits directly"
}
allzero
.buttons.canvas select
canvaspack
# invokes canvaspack andsets variable
</div><div class="naked_ctrl">
<form action="/index.cgi/speech" method="get" name="gate">
<p><a href="http://altstyle.alfasado.net">AltStyle</a> によって変換されたページ <a href="http://www.inference.org.uk/mackay/itprnn/code/tcl/hamming.tcl">(-&gt;オリジナル)</a>
/ <label>アドレス: <input type="text" name="naked_post_url" value="http://www.inference.org.uk/mackay/itprnn/code/tcl/hamming.tcl" size="22" /></label> <label>モード: <select name="naked_post_mode">
<option value="default">デフォルト</option>
<option value="speech" selected="selected">音声ブラウザ</option>
<option value="ruby">ルビ付き</option>
<option value="contrast">配色反転</option>
<option value="larger-text">文字拡大</option>
<option value="mobile">モバイル</option>
</select>
<input type="submit" value="表示" />
</p>
</form>
</div>