flag=0
proc err () { xpanel("**** ERROR ****") xlabel($s1) xpanel() }
strdef tstr
if (unix_mac_pc() == 3) {
   chdir(neuronhome())
   if (chdir("fctb")==0) flag=1
   if (chdir("..\fctb")==0) flag=1
   if (flag==0) {
     sprint(tstr,"ERROR: FCTB directory not found; should be in %s or %s/..\n",neuronhome(),neuronhome()) err(tstr)
   } else if (default_dll_loaded_== 0) {
     flag = nrn_load_dll("nrnmech.dll")
     if (flag==1) { default_dll_loaded_ = 1 } else {
       sprint(tstr,"ERROR loading %s/nrnmech.dll; remake with mknrndll.\n",getcwd()) err(tstr) }
   }
}

objref helpbox, helpdeck
proc help_list() {
  helpbox=new HBox(2)
  helpbox.intercept(1)
  xpanel("")
  xbutton("General","helpdeck.flip_to(0)")
  xbutton("Button actions","helpdeck.flip_to(1)")
  xbutton("Exercises","helpdeck.flip_to(2)")
  xpanel()

 helpdeck=new Deck()
helpdeck.intercept(1)
  xpanel("")
    xlabel("Model for Fig. 9-9 displays results of simulation from Fig. 9-7.")
    xlabel("Requires weight matrix loaded in from 9-7 in order to do anything,")
    xlabel("otherwise just displays a precalculated result.")
    xlabel("")
    xlabel("The graph demonstrates hidden unit sensory weightings after")
    xlabel("learning.  This is done by presenting single inputs (eg")
    xlabel("1000,0100,...) and so measuring the response of each hidden unit to")
    xlabel("one sensory input (eg just left head movement, just left duck movement,...).")
    xlabel("")
  xpanel()
  xpanel("")
    xlabel("Exercise is a display for the results (weight matrix) from the")
    xlabel("exercise for 9-7.  By itself, the only buttons that do anything are")
    xlabel("\"Reset\" (displays canned result) and \"Random weights\" produces ")
    xlabel("random weight matrices that will produce random results.  ")
    xlabel("")
    xlabel("Don't load weight matrices from any simulation other than the VOR")
    xlabel("simulation (Fig. 9-7) or an error will result.  When weights are")
    xlabel("loaded from an appropriate file, hidden unit values will be")
    xlabel("automatically calculated and displayed.  Multiple weight sets can be")
    xlabel("loaded and compared -- they will be graphed with color coding in the")
    xlabel("usual color order (black, red, blue, green, orange, brown, violet, yellow).")
    xlabel("")
  xpanel()
  xpanel("")
    xlabel("")
    xlabel("1. Create a few sets of random weights by hitting the \"Random")
    xlabel("weights\" button a few times.  Notice the scatter throughout this")
    xlabel("collapsed weight space.  ")
    xlabel("")
    xlabel("2. Go to Fig. 9-7 and train a few separate networks (randomize and")
    xlabel("train up to error criterion).  Export each set of weights after")
    xlabel("learning.  Import each set into the current exercise and verify that")
    xlabel("most points lie on the up-left to down-right diagonal.  Compare the")
    xlabel("weight sets by loading one after another (each will have a different")
    xlabel("color).")
    xlabel("")
    xlabel("3. Create a few random weight sets.  Find some that are far from the")
    xlabel("eventual training result (ie find sets that lie on the lower-left to")
    xlabel("upper-right diagonal).  Load one of these into Exercise 9-7, train for")
    xlabel("100 iterations and save the weights.  Do it for another 100 and save")
    xlabel("the weights and so on till training is complete (you may want to use")
    xlabel("a number >100 if training is going slowly).  Now load each of these")
    xlabel("partially trained sets into the weight viewer.  Look at how the")
    xlabel("weights for each set moves as training goes on.")
    xlabel("")
    xlabel("4. Assess some of the weight sets assessed in 9-8.  Can you say")
    xlabel("anything about how the weight-space scatter affects performance?")
  xpanel()
helpdeck.intercept(0)
  helpdeck.map()
  helpdeck.flip_to(0)
  helpbox.intercept(0)
  helpbox.map()
}
// Created 07/24/09 17:50:30 by "/usr/site/scripts/loadfiles -q -a SUP_VORres.hoc"
//================================================================
// INSERTED SUP_VORres.hoc
// =Id=  SUP_VORres.hoc,v 1.11 2002/09/30 21:25:24 billl Exp 

// load_file("SUP_VORres.hoc")
//================================================================
// INSERTED string2.hoc
// =Id=  string2.hoc,v 1.1 2002/09/07 12:55:06 billl Exp 

//*String2 template
begintemplate String2
public s,t
strdef s,t
proc init() {
    if (numarg() == 1) { s=$s1 }
    if (numarg() == 2) { s=$s1 t=$s2 }
  }
endtemplate String2
// END string2.hoc
//================================================================
//================================================================
// INSERTED bkutils.hoc
// =Id=  bkutils.hoc,v 1.73 2004/04/30 15:35:32 billl Exp 

// load_file("stdgui.hoc")
// load_file("setup.hoc")
load_file("stdrun.hoc")
if (name_declared("install_matrix")) execute("install_matrix()") 
if (name_declared("install_vecst")) execute("install_vecst()")

//* objects
objref  g[4], stim[2], nc, gp, sns, ind, vec0, vec[2], rdm[2], XO, YO, cvode
objref st,wt,scr,smat,box[4],insr,nil,sref,tmpfile,tmpobj,tmpvec,tmplist,sfunc,deck
strdef mesg,tstr,tstr2,temp_string_,filename,section
tmpfile = new File()
tmplist = new List()
fchooser_flag = 0
graph_flag = 1
double x[4],y[4]
rdm = new Random()
cvode = new CVode()
sfunc = new StringFunctions()
{ ind=new Vector() vec[0]=ind.c vec[1]=ind.c vec0=ind.c}

//* iterators and templates
//** string iterator
iterator case() { local i
    i1 = 0
    for i = 2, numarg() {
        $&1 = $i
        iterator_statement
        i1+=1
      }
  }

iterator scase() { local i
    i1 = 0
    for i = 1, numarg() {
        temp_string_ = $si
        iterator_statement
        i1+=1
      }
  }

// eg for scase2("a","b","c","d","e","f") print temp_string_,temp_string2_
iterator scase2() { local i
    i1 = 0
    if (numarg()%2==1) {print "ERROR: scase2 needs even number of args" return }
    for i = 1, numarg() {
        tmpobj=new String2()
        tmpobj.s=$si i+=1  tmpobj.t=$si
        iterator_statement
        i1+=1
      }
  }

// like perl chop -- removes the last character
proc chop () { sfunc.left($s1,sfunc.len($s1)-1) }

//** list iterator ltr
// usage 'for ltr(XO, tmplist) { print XO }'
iterator ltr() { local i
    if (numarg()==3) {$&3=0} else {i1 = 0}
    for i = 0, $o2.count() - 1 {
        $o1 = $o2.object(i)
        iterator_statement
        if (numarg()==3) { $&3+=1 } else { i1+=1 }
      }
    $o1 = nil
  }

//** list pairwise iterator ltrp
// usage 'for ltrp(XO, YO, list) { print XO,YO }' takes them pairwise
iterator ltrp() { local i
    if (numarg()==4) {$&4=0} else {i1 = 0}
    for (i=0;i<$o3.count()-1;i+=2) {
        $o1 = $o3.object(i) $o2 = $o3.object(i+1)
        iterator_statement
        if (numarg()==4) { $&4+=1 } else { i1+=1 }
      }
    $o1=nil $o2=nil
  }

//** vector iterator vtr
// usage 'for vtr(&x, vec) { print x }'
iterator vtr() { local i
    if (numarg()==3) {$&3=0} else {i1 = 0}
    for i = 0, $o2.size() - 1 {
        $&1 = $o2.x[i]
        iterator_statement
        if (numarg()==3) { $&3+=1 } else { i1+=1 }
      }
  }

//* vlk(vec) -- display vector slice -- more flexible than vec.printf
// vlk(vec,max)
// vlk(vec,min,max)
// prints out a segment of a vector
vlk_width=20
proc vlk () { local i,j,min,max,dual,wdh,nonl,nl
    j=dual=0 nl=1 wdh=vlk_width
    if (numarg()==1) { min=0 max=$o1.size-1 }
    if (numarg()==2) if ($2==0) { nl=min=0 max=$o1.size-1 // vlk(vec,0) flag to suppress new lines
          } else if ($2>0) { min=0 max=$2-1 } else { min=$o1.size+$2 max=$o1.size-1 }
    if (numarg()==3) if ($3>-1) { min=$2 max=$3 } else { min=0 max=$o1.size-1 dual=1 }
    if (numarg()==4) { min=$3 max=$4 dual=1 }
    if (min<0) min=0
    if (max>$o1.size-1) max=$o1.size-1
    if (dual) if (max>$o2.size-1) max=$o2.size-1
    for i=min,max { 
        if (dual) printf("%g:%g ",$o1.x[i],$o2.x[i]) else printf("%g ",$o1.x[i]) 
        if ((j=j+1)%vlk_width==0 && nl) { print "" }
      }
    if (nl) print ""
  }

//** savevec([list,]vec1[,vec2,...]) add vector onto veclist or other list if given as 1st arg
objref veclist
veclist = new List()
proc savevec () { local i,flag,beg
    if (isobj($o1,"List")) beg=2 else beg=1
    for i=beg, numarg() { 
        tmpvec = new Vector($oi.size)
        tmpvec.copy($oi)
        if (beg==2) $o1.append(tmpvec) else veclist.append(tmpvec)
        tmpvec = nil
      }
  }

//* graphics; symbols and colors
{symnum = 7 colnum = 9}
objectvar cl[colnum], sym[symnum]
for ii=0,colnum-1 cl[ii]=new String()
{ cl[0].s ="white" cl[1].s ="black"  cl[2].s ="red"  cl[3].s ="blue"  cl[4].s ="green"  
  cl[5].s ="orange" cl[6].s ="brown"  cl[7].s ="violet"  cl[8].s ="yellow"  }
for ii=0,symnum-1 sym[ii]=new String()
{ sym[0].s = "o" sym[1].s = "t" sym[2].s = "s"  
    sym[3].s = "O" sym[4].s = "T" sym[5].s = "S"  sym[6].s = "+"}

gcl=0  // graph color
func color () {
    gcl = (gcl+1)%colnum
    if (gcl==0) gcl=1 // throw out white
    if (numarg()==1) $o1.color(gcl)
    return gcl
  }

//** qhp() basic buttons
proc qhp () {
    if (numarg()==1) xpanel("CONTROLS",1)
    xbutton("Quit","quit()")
    xbutton("Help","help_list()")
    xbutton("Print panel","pwman_place(50,50)")  
    xbutton("Reset","reset()")
    if (numarg()==1) xvarlabel(mesg)
    if (numarg()==1) xpanel(0,0)
    mesg="" 
  }

//** allgraphs()
proc remgrs () { local ii
    for ii=0,3 graphList[ii].remove_all()
    objref graphItem
  }
proc allgraphs () { for ii=0,3 for ltr(XO,graphList[ii]) XO.exec_menu($s1) }
proc vp() { allgraphs("View = plot") }
proc allgrop () { 
    for ii=0,3 for ltr(XO,graphList[ii]) {
        sprint(tstr,"%s.%s",XO,$s1)
        execute(tstr)
      }
  }

//** grrtsize() use view=plot and then pad a little
proc grrtsize () { local h,w,frac
    if (numarg()>=1) tmpobj=$o1 else tmpobj=graphItem
    if (numarg()>=2) frac = $2 else frac=.05
    tmpobj.exec_menu("View = plot")
    tmpobj.size(&x)
    w=frac*(x[1]-x[0])  h=frac*(x[3]-x[2])
    x[0]-=2*w x[1]+=w x[2]-=4*h x[3]+=h // need extra padding on bottom
    tmpobj.size(x[0],x[1],x[2],x[3])
  }

//** isobj(o1,s2) checks whether object $o1 is of type $s2
func isobj () {
    sprint(temp_string_,"%s",$o1)
    if (sfunc.substr(temp_string_,$s2)==0) {
        return 1
      } else {
        return 0
      }
  }

// cbin(min,max): binary colormap
proc cbin () {
    $o1.colormap(2)
    $o1.colormap(0, 255, 0, 0)
    $o1.colormap(1, 255, 255, 0)
    $o1.scale($2, $3)
  }

// my version of newPlotV() leaves off the label
proc newplotv () {
    newplot()
    graphItem.addvar("","v(.5)",1,3)
  }

proc redraw0 () { plrdrf=0 } // stub with flag
proc plcback () { } // callback
objref oxv,oyv // coordinates: 0,1 line start; 2,3 last loc
oxv=new Vector(2)
oyv=new Vector(2)
plrdrf=1 // flag will be unset if using redraw stub
plhorz=0 // 1 for horizontal, 2 for verticle lines

proc pl () {
    if ($1==2) { // mouse down -- new line
        redraw0() // unset plrdrf if redraw0() not overwritten
        oxv.x[0]=oxv.x[1]=$2 oyv.x[0]=oyv.x[1]=$3
      } else {
        if (plrdrf) graphItem.erase_all
        oyv.line(graphItem,oxv,0,2)
        oxv.x[1]=$2 oyv.x[1]=$3
        if (plhorz==1) oyv.x[1]=oyv.x[0]
        if (plhorz==2) oxv.x[1]=oxv.x[0]
        oyv.line(graphItem,oxv,2,2)
        redraw0() // will redraw if defined
        if ($1==3) plcback(oxv,oyv)
      }
  }

// newplot([width,height,pointer]) OR newplot([pointer])
proc newplot () { local wd,ht
    graphItem = new Graph(0)
    if (numarg()==1) $o1=graphItem // make a pointer
    if (numarg()==3) $o3=graphItem
    if (numarg()>1) { wd=$1 ht=$2 } else { wd=500 ht=300 }
    graphItem.save_name("graphList[0].")
    graphList[0].append(graphItem)
    graphItem.view(0,-90,tstop,150,600,200,wd,ht)
  }

//* cbw(min,max): b/w binary colormap
proc cbw () {
    $o1.colormap(2)
    $o1.colormap(0, 0, 0, 0)
    $o1.colormap(1, 255, 255, 255)
    $o1.scale($2, $3)
  }

//* I/O
//** svrd(0/1,name,file_ext[,fflag]) save-0 and read-1
// eg svrd(1,"Image","img") will look for file.img files to read
// fflag -- return filename only -- don't call parser
proc svrd () { local ii,num,cnt,fflag
    rdflag=$1
    if (numarg()==4) fflag=$4 else fflag=0
    sprint(tstr2,"*.%s",$s3)
    if (rdflag==0) { // write
        sprint(tstr,"Write %s",$s2)
        tmpfile.chooser("w",tstr,tstr2,"WRITE","","")
        if (tmpfile.chooser()==1) {
            tmpfile.getname(filename)
            if (!fflag) parsr(rdflag)
          }
      } else if (rdflag==1) { // read
        sprint(tstr,"Read %s",$s2)
        tmpfile.chooser("r",tstr,tstr2,"READ","","")
        if (tmpfile.chooser()==1) {
            tmpfile.getname(filename)
            if (!fflag) parsr(rdflag)
          }
      }
    mesg=filename
    tmpfile.close
  }

//* xgetargs, d2b
//** range(val,min,max) -- return val only if in proper range
// eg stim.noise=range(stim.noise,0,1)
func range () {
    if ($1<$2) return $2 
    if ($1>$3) return $3
    return $1
  }

//** err()
proc err () {
    if (numarg()==1) mesg=$s1
    print mesg
  }

//** xvarstr(): display a list of strings in an xpanel using xvarlabel
proc xvarstr () { local ii,cnt
    // ivoc_style("*font", "fixed")
    if (unix_mac_pc() == 1) {
        ivoc_style("*font", "*helvetica-bold-r-normal*--14*")
      }
    xpanel($s1)
    for ltr(XO,$o2) xvarlabel(XO.s)
    xpanel()
  }

//** xgetargs(panel_name,command,arg1[,arg2,...],defaults)
// xgetargs("Random session","newrand","# of patts","patt size  ","overlap   ","5,33,7")
objref argv
argv = new Vector()
proc xgetargs () { local i,args
    args=numarg()-3  i=numarg()
    argv.resize(0)
    sprint(temp_string_,"argv.append(%s)",$si)
    execute(temp_string_)
    if (argv.size!=args) argv.resize(args)
    xpanel($s1)
    mesg=$s1
    xvarlabel(mesg)
    for i=3,numarg()-1 {
        sprint(temp_string_,"argv.x[%d]",i-3)
        xvalue($si,temp_string_)
      }
    sprint(temp_string_,"xgetexec(\"%s\",%d)",$s2,args)
    xbutton("Execute",temp_string_)
    xpanel()
  }

proc xgetexec () { local i,args
    args = $2
    if (argv.size!=args) { mesg="Error-close & relaunch panel" return }
    sprint(temp_string_,"%s(",$s1)
    for i=0,args-2 sprint(temp_string_,"%s%g,",temp_string_,argv.x[i])
    sprint(temp_string_,"%s%g)",temp_string_,argv.x[i])
    print temp_string_
    execute(temp_string_)
  }
  

//** d2b(): decimal to binary, gives a binary appearing number for showing
// eg for ii=0,100 printf("%010d\n",d2b(ii))
func d2b () { local num,ii,rem,res
    num=$1 ii=0 res=0
    while (num>0) {
        rem = int(2*(num/2-int(num/2))) // right digit
        num=int(num/2) // remove right digit
        res+=rem*10^ii
        ii+=1
      }
    return res
  }

//* matrix stuff

//** cvec(),rvec() put out col bzw row vecs in latex format
proc cvec () { local i
    printf("\\bpm ")
    for vtr(&x,$o1) if (i1<$o1.size-1) printf("%g \\\\ ",x)
    printf("%g \\epm\n",x)
  }

proc rvec () { local i
    printf("\\bpm ")
    for vtr(&x,$o1) if (i1<$o1.size-1) printf("%g & ",x)
    printf("%g \\epm\n",x)
  }

//** matp(mat,rows,cols) prints out matrix in latex format
proc matp () { local i,j,rows,cols
    rows=$2 cols=$3
    if ($o1.size!=rows*cols) {print "ERR: matp - mat.size != rows*cols" return}
    printf("\\bpm\n")
    for (i=0;i<rows;i+=1) {
        for (j=0;j<cols-1;j+=1) {
            printf("%4g & ",$o1.x[i*cols+j])
          }
        printf("%4g \\\\ \n",$o1.x[i*cols+j])
      }
    printf("\\epm\n")
  }

//** same as matp but not latex format
proc mpf () { local i,j,rows,cols
    rows=$2 cols=$3
    if ($o1.size!=rows*cols) {print "ERR: - mat.size != rows*cols" return}
    for (i=0;i<rows;i+=1) {
        for (j=0;j<cols-1;j+=1) {
            printf("%12.3g  ",$o1.x[i*cols+j])
          }
        printf("%12.04g \n",$o1.x[i*cols+j])
      }
  }

//** print out a matrix*vec multiplication
proc mpfv () { local i,j,rows,cols
    cols=$o2.size rows=$o1.size/cols
    for (i=0;i<rows;i+=1) {
        printf("|  ")
        for (j=0;j<cols;j+=1) {
            printf("%-12.03g  ",$o1.x[i*cols+j])
          }
        if (i<$o2.size) printf("  |   %12.04g \n",$o2.x[i]) else printf("  |\n")
      }
    if (cols>rows) for i=rows,cols-1 printf("%70.04g \n",$o2.x[i])
  }

//** mmlt(mdest,m1,m2,r2) matrix mult between 2 mats
// r2==c1 gives shared dimension
proc mmlt () { local i,j,r1,c1,r2,c2
    c1 = r2 = $4 // shared dimension (cols of 1st/rows of second)
    r1=$o2.size/c1 c2=$o3.size/r2
    printf("%dx%d * %dx%d = %dx%d\n",r1,c1,r2,c2,r1,c2)
    $o1.resize(r1*c2)
    vec[0].resize(c1) // length of a row of mat A
    vec[1].resize(r2) // length of a col of mat B
    for i=0,r1-1 for j=0,c2-1 {
        vec[0].mrow($o2,i,c1) vec[1].mcol($o3,j,c2)
        $o1.x[i*c2+j]=vec[0].dot(vec[1])
      }
    $o1.mprintf(r1,c2)
    dealloc(a)
  }

//* membrane and pp's
//** runbutton
running_ = 1
proc runbutton () {
    if (running_ == 0) { stoprun = 1  return }
    if (t>0 && t<tstop-0.1) continuerun(tstop) else run()
    stoprun=1 running_=0
  }

//** proc print_pp_location(PP), from doc/html/refman/nocmodl.html
proc print_pp_location() { local x //arg1 must be a point process
     x = $o1.get_loc()
     sectionname(section)
     printf("%s located at %s(%g)\n", $o1, section, x)
     pop_section()
  }

func get_pp () { local x
     x = $o1.get_loc()
     sectionname(section)
     section sref = new SectionRef()
     pop_section()
     return x
  }
// END bkutils.hoc
//================================================================
//================================================================
// INSERTED xtabl.hoc
// =Id=  xtabl.hoc,v 1.29 2002/09/20 14:49:46 billl Exp 

// load_file("xtabl.hoc")
// new XTABL(rows,cols,vec[,key,"NAME",arrows])
// vec.size must == rows*cols
// key identifies which XTABL in case of callbacks
// arrows = 1 puts in checkbox and scroll arrows

// notify(vec,index,row,col,key) -- new value is vec.x[index]
// index is redudant since = row*cols+col
proc notify () {} // stub for callbacks
// template XTABL(rows,cols)
begintemplate XTABL
public rows,cols,key,label,mapdv,arrow
external notify,XTABL
double rows[1],cols[1],key[1],arrow[1]

objref boxl,bxh,bxv,this
objref mapdv // map an external vector instead of maintaining double
strdef tstr,tstr2,label

proc init () { local ii,jj
    rows=$1 cols=$2  
    if ($o3.size!=rows*cols) { 
        printf("XTAB ERR0: sz %d rows %d cols %d\n",$o3.size,rows,cols) return 
      }
    mapdv=$o3
    if (numarg()>3) key=$4
    if (numarg()>4) label=$s5 else label="TABLE"
    if (numarg()>5) arrow=$6 else arrow=0
    boxl=new List()
    boxl.remove_all
    bxv=new VBox()
    boxl.append(bxv)
    bxv.intercept(1)
    for ii=0,rows-1 {
        bxh=new HBox()
        boxl.append(bxh)
        bxh.intercept(1)
        for jj=0,cols-1 {
            bxv=new VBox()
            boxl.append(bxv)
            bxv.intercept(1)
            xpanel("")
            if (rows==1) sprint(tstr,"%d",jj) else if (cols==1) sprint(tstr,"%d",ii) else {
                sprint(tstr,"%d,%d",ii,jj) }
            sprint(tstr2,"notify(%s,%d,%d,%d,%d)",this.mapdv,ii*cols+jj,ii,jj,key)
            xpvalue(tstr,&mapdv.x(ii*cols+jj),arrow,tstr2)
            xpanel()
            bxv.intercept(0)
            bxv.map()
          }
        bxh.intercept(0)
        bxh.map()
      }
    boxl.object(0).intercept(0)
    boxl.object(0).map(label)
  }
endtemplate XTABL

// proc notify () { $o1.x[$2] *= 2 } // eg -- multiply any new input by 2
// proc notify () { printf("Table#%d:%s %d,%d CHANGED TO %g BY USER\n",$5,$o1,$3,$4,$o1.x[$2]) }
// objref a
// vec.resize(15)
// a=new XTABL(5,3,vec,0,"hello")
// vec.indgen(3)
// END xtabl.hoc
//================================================================
//================================================================
// INSERTED LIMparams.hoc
// =Id=  LIMparams.hoc,v 1.8 2004/04/12 16:48:21 billl Exp 

objref hbox,vbox,hbox1,vbox1,optdeck
optdeck=new Deck()

proc decker(){}
proc deckchoices(){}
proc rdwr() {}
proc extra() {
    xpanel("")
    xmenu("Choose function")
    deckchoices()
    xmenu()
    xpanel()
    optdeck.map("")
    xpanel("")
    rdwr()
    xpanel()
    optdeck.flip_to(0)
  }

proc buildoptdeck () {
    optdeck.intercept(1)
    decker()
    optdeck.intercept(0)
    optdeck.flip_to(-1)
  }

proc draw () {
    vec.indgen(0,N-1,1) // for saving need less detail
    vec.apply($s1)
    vec.line(graphItem,1,color(),2)
    graphItem.flush
  }

proc parsr () {
    if (rdflag) tmpfile.ropen(filename) else tmpfile.wopen(filename)
    if (rdflag) {
        vec.vread(tmpfile)
        ind.indgen(0,vec.size-1,1)
        graphItem.erase
        vec.line(graphItem,ind,color(),2)
      } else vec.vwrite(tmpfile)
  }

proc mkit () {
    buildoptdeck()
    hbox=new HBox()
    hbox1=new HBox()
    vbox=new VBox()
    vbox1=new VBox()
    hbox.intercept(1)
    vbox.intercept(1)
    qhp(1)
    newplot()
    vbox.intercept(0)
    vbox.map()
    vbox1.intercept(1)
    extra()
    vbox1.intercept(0)
    vbox1.map()
    hbox.intercept(0)
    hbox.map($s1)
  }
// END LIMparams.hoc
//================================================================
//================================================================
// INSERTED delta.hoc
// =Id=  delta.hoc,v 1.104 2003/01/27 18:25:41 billl Exp  

// load_file("delta.hoc")
// pattl.remove_all
// newpatts("VOR.in") 
// bplearn()
// rdpatts("VORtest.in")
// bprecg()
// load_file("string2.hoc")
// load_file("bkutils.hoc")
//* parameters and objects
objref sti,sth,sto,pattl,wt,wtih,wtho,wtdel,vo,vh,del,wtptr,wtio
objref odelih,odelho // old weight deltas for momentum

// i=input, h=hidden, o=output
{Ni=10  Nh=10 No=10}
{vo  = new Vector(No)     vh  = new Vector(Nh)     del = new Vector(No)}
{sti = new Vector(Ni)     sth = new Vector(Nh)     sto = new Vector(No)}
{wtih= new Vector(Ni*Nh)  wtho= new Vector(Nh*No) wtdel = new Vector(Ni*No) }
{odelih= new Vector(Ni*Nh)  odelho= new Vector(Nh*No)}
wt = wtho // use this for delta
wtptr=wtih // use this for monitoring a weight
rdm.uniform(-.5,.5)
pattl=new List()
wpind=0
BVBASE=0
alpha = 1
eta = 0
thresh= .5
iters=20000
npatts=pattnum=0

objref mso[7]
for ii=0,6 mso[ii]=new Vector(0)
{ID=0 EE=1 GG=2 HH=3 TT=4 xo=5 yo=6}
objref targ
targ=new Vector(No)

//* svpatts(filename) writes pattern file
proc svpatts () {  local ii,i,j
    tmpfile.wopen($s1)
    tmpfile.printf("Ni=%d\nNh=%d\nNo=%d\nnpatts=%d\nPATTERNS:\n",Ni,Nh,No,npatts)
    for ltrp(XO,YO,pattl) { XO.printf(tmpfile,"%g ") YO.printf(tmpfile,"%g ") }
    tmpfile.close
  }

//* newpatts() reads input files and chooses algo -- delta or bp
// eg newpatts("VOR/XOR.in")
first=0
proc newpatts () {  local ii,i,j,min
    if (Nh!=0 && first==0) { Ni+=1 Nh+=1 first=1} // bias units; units for learning threshold
    if (numarg()==1) {
        tmpfile.ropen($s1)
        temp_string_="//"  Ni=Nh=No=npatts=0
        while (strcmp(temp_string_,"PATTERNS:")!=0) {
            if (sfunc.substr(temp_string_,"//")!=0) execute(temp_string_)
            tmpfile.gets(temp_string_)
            chop(temp_string_)
          }
        if (npatts==0||Ni==0||No==0) {
            sprint(mesg,"File must define Ni,No,npatts\n",$s1)
            err(mesg)
            tmpfile.close return 
          } else {
            pattl.remove_all
            for ii=1,npatts {
                mso[ID].scanf(tmpfile,Ni) savevec(pattl,mso[ID])
                mso[ID].scanf(tmpfile,No) savevec(pattl,mso[ID])
              }
          }
      } else { // just read numbers for values
        i=1 j=1
        pattl.remove_all
        if ((Nh>0 && numarg()!=npatts*(Ni-1+No)) || (Nh==0 && numarg()!=npatts*(Ni+No))) { 
            sprint(mesg,"DELTA ERR0: Must set npatts first: %d",numarg()) err(mesg)  return 
          }
        if (Nh>0) min=1 else min=0
        for ii=1,npatts {
             mso[ID].resize(0)
            for j=min,Ni-1 { mso[ID].append($i) i+=1 } // need err checking for i<=numargs()
            savevec(pattl,mso[ID])
            mso[ID].resize(0)
            for j=1,No { mso[ID].append($i) i+=1 } // need err checking for i<=numargs()
            savevec(pattl,mso[ID])
          }
      } 
    chkpattsz()
    if (Nh==0) { // delta rule
        vo.resize(No) sti.resize(Ni) sto.resize(No)
        wt.resize(Ni*No) wtdel.resize(Ni*No)
        dinit()
      } else {
        vo.resize(No) vh.resize(Nh) del.resize(No)
        sti.resize(Ni) sth.resize(Nh) sto.resize(No)
        sti.x[0]=1 sth.x[0]=1 // bias unit for threshold learning
        wtih.resize(Ni*Nh) wtho.resize(Nh*No) wtdel.resize(Ni*No)
        odelih.resize(Ni*Nh) odelho.resize(Nh*No)
        bpinit()
      }
  }

//** rdpatts() reads in new patterns to test network on
// rdpatts(file[,flag]) -- flag==1 replace patts else append
// rdpatts(npatts,flag,patt_vals...) -- flag==1 replace patts else append
proc rdpatts () {  local ii, npsav, flag, i,j, nh, ni
    nh=Nh
    if (Nh!=0 && first==0) { Ni+=1 Nh+=1 first=1} // bias units; units for learning threshold
    if (Nh>0) ni=Ni-1  // don't count in the bias unit
    if (numarg()>1) flag=$2 else flag=0
    if (flag) pattl.remove_all  // flag: remove previous patterns
    temp_string_="//"  
    npsav = (pattl.count/2)
    if (numarg()<=2) {
        if (tmpfile.ropen($s1)==0) { sprint(mesg,"ERR: Can't open ",$s1) err(mesg)  return }
        while (strcmp(temp_string_,"PATTERNS:")!=0) {
            if (sfunc.substr(temp_string_,"//")==0) {} // ignore comments
            if (sfunc.substr(temp_string_,"Ni")>=0) first=0
            print temp_string_
            execute1(temp_string_) // set parameters
            tmpfile.gets(temp_string_)
            chop(temp_string_)
          }
        if (!first) { ni=Ni-1 first=1} // Ni has been reset
        if (npatts==0) {
            sprint(mesg,"File must define npatts")
            err(mesg)
            tmpfile.close return 
          } else {
            for ii=1,npatts {
                mso[ID].scanf(tmpfile,ni) savevec(pattl,mso[ID])
                mso[ID].scanf(tmpfile,No) savevec(pattl,mso[ID])
              }
          }
      } else {
        npatts=$1
        i=3 j=1
        for ii=1,npatts {
            mso[ID].resize(0)
            for j=1,ni { mso[ID].append($i) i+=1 } // need err checking for i<=numargs()
            savevec(pattl,mso[ID])
            mso[ID].resize(0)
            for j=1,No { mso[ID].append($i) i+=1 } // need err checking for i<=numargs()
            savevec(pattl,mso[ID])
          }
      }
    if (! flag) npatts += npsav
    chkpattsz(ni)
    showpatts(0)
  }

//* delta rule learning
proc dinit () {
    if (numarg()==2) rdm.uniform($1,$2) else rdm.uniform(-.5,.5)
    wt.setrand(rdm)
    mesg=""
    rdm.uniform(0,npatts) // for picking pattern to present
  }

proc dlearn () { local ii,res
    if (Nh!=0) { printf("Nh=%d: need bplearn()\n",Nh) return }
    res=0
    for(ii=0;res<npatts && ii<iters;ii+=1) res=dlearn1()
    print ii
  }

//** dlearn1()
func dlearn1 () { local cnt,only
    cnt=0
    if (numarg()==1) only = $1 else only = -1
    for ltrp(XO,YO,pattl) {
        if (i1==only || only==-1) {
            sti.copy(XO) sto.copy(YO)
            vo.mmult(wt,sti)  
            vo.thresh(thresh)
            vo.sub(sto) // subtract target
            if (vo.max==vo.min && vo.min==0) { cnt+=1 // all correct
              } else { // wtdel = alpha*(sto - W*sti) X sti ; [where X is outer product]
                vo.mul(-alpha)
                wtdel.outprod(vo,sti)
                wt.add(wtdel)
                // printf("%d: ",i1) wt.mprintf(No,Ni)
              }
            // vlk(wt)
          }
      }
    return cnt
  }

//** drecall()
proc drecall () { local cnt,only,np
    if (Nh!=0) { printf("Nh=%d: need bplearn()\n",Nh) return }
    if (numarg()==1) only = $1 else only = -1
    cnt=0
    for ltrp(XO,YO,pattl) {
        if (i1==only || only==-1) {
            sti.copy(XO) sto.copy(YO)
            vo.mmult(wt,sti)  
            vo.thresh(thresh)
            vlk(sti,0) printf(" -> ") vlk(vo,0) 
            if (sto.eq(vo)) cnt+=1 else {  printf("( ") vlk(sto,0) printf(")\n") }
          }
      }
    if (only>-1) { np=1 if (cnt==1) mesg="Correct" else mesg="Wrong" } else np=npatts
    printf("Correct: %d/%d \nW matrix:\n",cnt,np) wt.mprintf(No,Ni)
  }

//* backprop rule learning
//**  bpinit(), chkpattsz()
//*** chkpattsz()
func chkpattsz () { local err, ni
    err=-1
    if (numarg()==1) ni=$1 else {if (Nh>0) ni=Ni-1 else ni=Ni}
    for ltrp(XO,YO,pattl) if (ni!=XO.size || No!=YO.size) err=i1
    if (err!=-1) { 
        printf("ERROR: all patts must be same size: %d,%d: \n",ni,No) 
        showpatts(err) 
        return 0 } else return 1
  }

//*** bpinit()
proc bpinit () { local ii
    mesg=""
    if (numarg()==2) rdm.uniform($1,$2) else rdm.uniform(-.5,.5)
    wtih.setrand(rdm)
    for ii=0,Ni-1 wtih.mset(0,ii,Ni,0) // clear the row projecting to the bias unit
    wtho.setrand(rdm)
    showpatts(pattnum=0)
    rdm.uniform(0,npatts) // for picking pattern to present
  }

//** bpforward
// implement learning of the theta term as an additional input unit that is always 1 and an 
// additional hidden unit = 1
proc bpforward () { local cnt
    sth.mmult(wtih,sti)  
    sth.apply("sigmoid")
    sth.x[0]=1 // also sti.x[0]=1 // "theta" weights
    sto.mmult(wtho,sth)  
    sto.apply("sigmoid")
  }

//** bplearn()
{chkpt=500 errt=1e-7 bpstop=0}
func bplearn () { local cnt,ii,jj,err,savgr
    bpstop=graph_flag=0
    if (Nh==0) { printf("Nh=0: need dlearn()\n") return }
    if (numarg()==1) if ($1==0) bpinit() else iters=$1
    for(jj=0;jj<iters && bpstop==0;jj+=1) {
        // ii=int(rdm.repick)
        ii = jj%npatts
        XO=pattl.object(2*ii) YO=pattl.object(2*ii+1)
        sti.copy(XO,1)
        bpforward()
        bpbp(YO) // backpropagate error
        chwts()
        if (jj%chkpt==chkpt-1) { 
            if (bprecall(-1)<errt) bpstop=1 
            sprint(mesg,"ITER# %d",jj)
            doNotify()
          }
      }
    printf("ITERS: %d\nERR: %g\n",jj,bprecall())
    graph_flag=1
    return(jj)
  }

// expand sigmoid out so it's easy to reach 0 and 1 but now f'(net) != o*(1-o)
{sigmul=1.4 sigsub=(sigmul-1)/2}
func sigmoid () { return sigmul/(1+exp(-$1))-sigsub }

//*** bpbp() -- back-propagation step
// reverse the expansion in back prop so that get correct 1st deriv
proc bpbp () { local tmp
    if (numarg()==1) targ.copy($o1)
    del.resize(0) del.copy(targ) del.sub(sto) // targ-outp
    if (graph_flag) {printf("Output vs. target deltas: ") vlk(del)}
    // vo=sto*(1-sto)*del
    vo.bpeval(sto,del,sigsub,sigmul)
    wtdel.resize(wtho.size)
    wtdel.transpose(wtho,No,Nh) // N_o rows and N_h columns
    vh.mmult(wtdel,vo) // backprop error
    del.resize(0) del.copy(vh) vh.bpeval(sth,del,sigsub,sigmul)
    vh.x[0]=0
    if (graph_flag) {printf("Hidden unit deltas: ") vlk(vh)}
  }

//*** chwts()
proc chwts () {
    if (eta>0) { wtdel.copy(odelho) wtdel.mul(eta) }
    odelho.outprod(vo,sth)
    odelho.mul(alpha)
    wtho.add(odelho)
    if (eta>0) { wtho.add(wtdel)
        wtdel.copy(odelih) wtdel.mul(eta) }
    odelih.outprod(vh,sti)
    odelih.mul(alpha)
    wtih.add(odelih)
    if (eta>0) wtih.add(wtdel)
  }  

//*** bpdiffr(res,outp,del) res=outp*(1-outp)*del
// replaced with compiled function: res.bpeval(outp,del)
proc bpdiffr () { local tv
    $o1.copy($o2) $o1.mul(-1) $o1.add(1) // (1-outp)
    $o1.mul($o3) // (1-outp)*del
    $o1.mul($o2) // outp*(1-outp)*del
  }

//** bprecall()
err0=.01
// bprecall(arg) arg=-1 means quiet else arg means just run that pattern
func bprecall () { local cnt,error,er,sh,verbose,tpatt
    verbose=1
    if (numarg()==1) {sh=$1 if (sh==-1) verbose=0} else sh=-1
    if (Nh==0) { printf("Nh=0: need dlearn()\n") return }
    cnt=0 error=0 
    tpatt = pattl.count
    for ltrp(XO,YO,pattl) {
        if (sh==-1 || i1==sh) {
            sti.copy(XO,1) // sti.x[0]=1 reserved for thresh weight (bias)
            bpforward()    // forward pro
            del.copy(YO) del.sub(sto) // targ-outp
            er=0.5*del.dot(del)  error+=er // so that 1st deriv will get rid of 1/2
            if (error<err0) cnt+=1
            if (verbose) { vlk(XO,0) printf(" -> ") vlk(sto,0) 
                printf("( ") vlk(YO,0) printf("\tERR: %g)\n",er) }
          }
        bpcallback()
      }
    if (verbose) {
        if (sh>-1) {printf("HIDDEN: ") vlk(sth)}
        printf("Correct: %d/%d \n",cnt,npatts)
      }
    return sumerr=error/tpatt
  }
proc bpcallback () {}

proc bppresent () {
    sti.copy($o1,1)
    bpforward()
    vlk(sto)
  }

proc bpsstep () { local cnt,error,er,sh,ii
    if (Nh==0) { printf("Nh=0: need dlearn()\n") return }
    sh=$1
    XO=pattl.object(2*sh) YO=pattl.object(2*sh+1)
    sti.copy(XO,1) // sti.x[0]=1 reserved for thresh weight
    bpforward()    // forward pro
    printf("INPUT: ")
    for vtr(&x,sti) if (i1>0) printf("%12.04g",x)
    printf("\n________________________________________________________________\nWT_ih*S_i\n")
    mpfv2(wtih,sti,0)
    printf("________________________________________________________________\nHIDDEN: ")
    for vtr(&x,sth) if (i1>0) printf("%12.04g",x)
    printf("\n________________________________________________________________\nWT_ho*S_h\n")
    mpfv2(wtho,sth)
    printf("________________________________________________________________\nOUTPUT: ")
    for vtr(&x,sto) printf("%12.04g",x)
    printf("\n________________________________________________________________\nTARGET")
    for vtr(&x,YO) printf("%12.04g",x)
    del.copy(YO) del.sub(sto) // targ-outp
    printf("\n________________________________________________________________\nDELTA")
    for vtr(&x,del) printf("%12.04g",x)
    printf("\n________________________________________________________________\n")
    er=0.5*del.dot(del)
    printf("ERR: %12.04g\n",er)
  }

//*** bprecg() graph recall results
// eye movement (circle), visual target movement (triangle),
// head movement (square), goal movement (filled circle) -- global YO
objref legl
legl=new List()
proc bprecg () { local ii,jj,flag,max
    if (numarg()==2) flag=$2 else flag=0
    legl.remove_all
    for scase("actual","desired","head","duck") legl.append(new String2(temp_string_,sym[i1+2].s))
    $o1.erase_all()
    if (npatts==0) return
    $o1.size(0,npatts+3,-2,2)
    $o1.xaxis(3)
    $o1.xaxis(0,npatts+3,0,1,0,0,0)
    $o1.yaxis(-2,2)
    grrtsize($o1)
    if (flag!=2) for ii=ID,TT mso[ii].resize(0)
    mso[ID].indgen(1,npatts,1)
    sprint(temp_string_,"proc bpcallback() { %s.append(sto.x[1]-sto.x[0]) ",mso[EE])
      sprint(temp_string_,"                 %s %s.append(sti.x[3]-sti.x[2])",temp_string_,mso[TT])
      sprint(temp_string_,"                 %s %s.append(sti.x[4]-sti.x[1])",temp_string_,mso[HH])
      sprint(temp_string_,"                 %s %s.append( YO.x[1]- YO.x[0])}",temp_string_,mso[GG])
    execute1(temp_string_)
    if (flag!=2) bprecall(-1) // else just fake it with values placed in mso[] vectors
    if (flag==1) max=GG else max=TT
    for (ii=max;ii>=EE;ii-=1) {
        jj=ii-EE
        mso[ii].mark($o1,mso[ID],sym[jj+2].s,20,jj+1,3) // y-axis is VOR; x is pursuit
      }
    legend($o1,legl)
    execute1("proc bpcallback() { }")
  }

//** legend()
proc legend () { local xv,yv,yv2,xw,yw,sz1,sz2,sz3,sz4,wd,ht,xexpand,yexpand
    sz1=$o1.size(1) sz2=$o1.size(2) sz3=$o1.size(3) sz4=$o1.size(4)
    xexpand=1.2 yexpand=1.02
    sz1*=xexpand sz2*=xexpand sz3*=yexpand sz4*=yexpand
    wd=sz2-sz1 ht=sz4-sz3 // need to translate between world and view coordinates
    $o1.align(.5,1)
    for ltr(XO,$o2) { // string2 list of strings and marks
        xv=.8 yv=1-.08*i1
        xv=.8 yv2=.98-.07*i1
        $o1.label(xv,yv2-.02,XO.s)
        xw=sz1+xv*wd  yw=sz3+yv*ht
        $o1.mark(xw,yw,XO.t,20,i1+1,3)
      }
    $o1.label(0.05,0.85,"Right")
    $o1.label(0.05,0.35,"Left")
  }

//** print out a matrix*vec multiplication
proc mpfv2 () { local i,j,rows,cols,beg
    cols=$o2.size rows=$o1.size/cols
    if (numarg()==3) beg=1 else beg=0
    for (i=beg;i<rows;i+=1) {
        for (j=0;j<cols;j+=1) {
            if (j==1) printf("|  ")
            printf("%-12.03g  ",$o1.x[i*cols+j])
          }
        if (i<$o2.size) printf("  |   %12.04g \n",$o2.x[i]) else printf("  |\n")
      }
    if (cols>rows) for i=rows,cols-1 printf("%70.04g \n",$o2.x[i])
  }

proc bpshowhid () {
    for ltrp(XO,YO,pattl) {
        sti.copy(XO,1) // sti.x[0]=1 reserved for thresh weight
        bpforward()    // forward pro
        for vtr(&x,sti) if (i1>0) printf("%g ",x)
        printf("  ->")
        for vtr(&x,sth) if (i1>0) printf("%12.04g",x)
        printf("  ->")
        for vtr(&x,sto) printf("%12.04g",x)
        print ""
      }
  }

//** showwts(), showpatts()
proc showwts () {
    if (Nh==0) {
        printf("WT I-O: \n") wt.mprintf(No,Ni)
      } else {
        printf("WT I-H: \n") wtih.mprintf(Nh,Ni)
        printf("WT H-O: \n") wtho.mprintf(No,Nh)
      }
  }

proc showpatts () { local sh,flag
    flag=0
    if (numarg()==1) sh=pattnum=$1 else flag=1
    if (sh>pattl.count/2-1) sh=pattnum=pattl.count/2-1
    if (sh<0) sh=pattnum=0
    if (pattl.count()==0) { err("No patterns defined") return }
    for ltrp(XO,YO,pattl) { 
        if (flag || i1==sh) { 
            if (Nh>0) {
                sti.copy(XO,1) targ.copy(YO)
                ind.resize(Ni+Nh+2*No)
                ind.fill(0)
                ind.copy(XO,1)
                ind.copy(YO,Ni+Nh+No)
                nc.dispcol(ind)
                doEvents()
                vlk(XO,0) printf(" -> ") vlk(YO) 
              } else {
                sti.copy(XO,0) targ.copy(YO)
                ind.resize(Ni+2*No)
                ind.fill(0)
                ind.copy(XO,0)
                ind.copy(YO,Ni+No)
                nc.disp(ind)
              }
          }
      }
  }

//*** bpgrwts() graph weights
proc bpgrwts () {
    mso[ID].resize(0) mso[xo].resize(0) mso[yo].resize(0)
    if (numarg()==3) { mso[xo].copy($o2) mso[yo].copy($o3) } else {
        bpgetwts(mso[ID],mso[xo],mso[yo]) }
    mso[yo].mark($o1,mso[xo],"O",10,gcl,1)
    mso[xo].resize(0) mso[yo].resize(0)
    mso[xo].append(1,-1) mso[yo].append(-1,1)
    mso[yo].line($o1,mso[xo])
  
    graphItem.label(0.85,0.55,"duck")
    graphItem.label(0.4,0.05,"head")
    graphItem.label(0.95,0.55,"R")
    graphItem.label(0.05,0.55,"L")
    graphItem.label(0.55,0.95,"R")
    graphItem.label(0.55,0.05,"L")
  
    grrtsize()
  }

//*** bpgetwts(scr,VOR,pursuit) returns vectors with wt differences
proc bpgetwts () { local ii
    $o1.resize(Ni)
    for ii=1,Nh-1 {
        $o1.mrow(wtih,ii,Ni)
        $o2.append($o1.x[3]-$o1.x[2]) // pursuit influence
        $o3.append($o1.x[4]-$o1.x[1]) // VOR influence
      }
  }

//* experiments
proc svinitwts () {
    rdm.ACG(3804485) // seed
    veclist.remove_all
    for ii=0,9 { bpinit() savevec(wtih,wtho) }
  }

proc bpmulti () { local ii
    vec0.resize(0)
    rdm.ACG(3804485) // seed
    for ii=0,9 { 
        print ii
        wtih.copy(veclist.object(2*ii)) // restore the weights
        wtho.copy(veclist.object(2*ii+1)) // restore the weights  
        vec0.append(bplearn())
      }
  }    

//* adapted from MPNfdfwd1.hoc33
objref box[3],nc,tb[2]

lmv=.7 // movement for drawing connection lines
mvmax=5
colr=2

//* mkitbp()
ncview=0
proc layers() {} // for labeling layers
proc extra () {} // for adding extra buttons
proc mkitbp () { 
    box[2]=new VBox() // main
    box[0]=new HBox() // main
    box[2].intercept(1)
    qhp(1)
    box[0].intercept(1)
    drawnet()
    nc.g.view(0,0,100,100,600,200,500,300) 
    nc.gcmap(BVBASE,1)  // graph of color map
    xpanel("")
    xvarlabel(mesg)
    // xcheckbox("Show units",&graph_flag)
    xcheckbox("Stop processing",&bpstop)
    xbutton("Learn","bplearn()")
    xvalue("Max iter","iters")
    xvalue("Sum Err","sumerr")
    xvalue("Targ err","errt",1)
    xvalue("Forward prop","pattnum",1,"showpatts(pattnum) sprint(mesg,\"ERR: %g\",bprecall(pattnum)) mapsts()")
    xbutton("Back prop","bpbp() chwts()")
    extra()
    xmenu("Weights")
    nc.g.menu_tool("Draw weight","drawwt")
    xbutton("Save weights","svrd(0,\"weights\",\"mat\")")
    xbutton("Read weights","svrd(1,\"weights\",\"mat\")")
    xbutton("Draw one (click on units)","nc.g.exec_menu(\"Draw weight\")")
    xbutton("Draw all","shmat(3)")
    xbutton("Show in->hid matrix","shmat(0)")
    xbutton("Show hid->out matrix","shmat(1)")
    xbutton("Randomize weights","bpinit()")
    xbutton("Clear graph","shmat(4)")
    xmenu()
    xmenu("Patterns&Units")
    xbutton("Clear all patterns","pattl.remove_all() npatts=0")
    xbutton("Load patterns","svrd(1,\"Patterns\",\"ptn\",1) rdpatts(filename)")
    xbutton("Save patterns","svrd(0,\"Patterns\",\"ptn\",1) svpatts(filename)")
    xbutton("Show patterns","showpatts(pn=(pn+1)%npatts)")
    xbutton("Show values","label()")
    xbutton("Label layers","layers()")
    xbutton("Set inputs","shmat(2)")
    xbutton("Clear graph","shmat(4)")
  
    xmenu()
    xvalue("Edit pattern #","pn",1,"pnum()")
    xvalue("Weight monitor","wtptr.x[wpind]")
    xpanel()
    box[0].intercept(0)
    box[0].map("Back-prop network")
    box[2].intercept(0)
    box[2].map("Back-prop network")
    // initvals()
  }

//** mkitdelta()
proc mkitdelta () { 
    box[2]=new VBox() // main
    box[0]=new HBox() // main
    box[2].intercept(1)
    qhp(1)
    box[0].intercept(1)
    extra0()
    xpanel("")
    xvarlabel(mesg)
    // xcheckbox("Show units",&graph_flag)
    xvalue("Recall","pattnum",1,"delrec()")
    xvalue("Delta","pattnum",1,"delshow()")
    extra()
    xmenu("Weights")
    xbutton("Save weights","svrd(0,\"weights\",\"mat\")")
    xbutton("Read weights","svrd(1,\"weights\",\"mat\")")
    xbutton("Draw weights","shmat(3)")
    xbutton("Show weight matrix","shmat(0)")
    xbutton("Randomize weights","dinit()")
    xbutton("Clear graph","shmat(4)")
    xmenu()
    xmenu("Patterns&Units")
    xbutton("Clear all patterns","pattl.remove_all() npatts=0")
    xbutton("Load patterns","svrd(1,\"Patterns\",\"ptn\",1) rdpatts(filename)")
    xbutton("Save patterns","svrd(0,\"Patterns\",\"ptn\",1) svpatts(filename)")
    xbutton("Show values","label()")
    xbutton("Set inputs","shmat(2)")
    xmenu()
    xvalue("Edit pattern #","pn",1,"pnum()")
    xpanel()
    box[0].intercept(0)
    box[0].map("Delta-rule learning: AND ")
    box[2].intercept(0)
    box[2].map("Delta-rule learning: AND ")
    // initvals()
  }

proc delrec () {
    if (pattnum<0) pattnum=0
    if (pattnum>npatts-1) pattnum=npatts-1
    showpatts(pattnum)
    drecall(pattnum) 
    mapstd()
  }

proc delshow () {
    if (pattnum<0) pattnum=0
    if (pattnum>npatts-1) pattnum=npatts-1
    showpatts(pattnum) 
    dlearn1(pattnum) 
    drecall(pattnum) 
    mapstd()
  }

//** drawwt()
wtclk=1e10
proc drawwt () { local ii,wh,wht
    if ($1==2) { 
        wh=nc.which($2,$3) 
        if (wtclk==1e10) { wtclk=wh print "Click another" } else {
            ii=wtclk jj=wh wtclk=1e10
            if (ii<Ni && jj>=Ni && jj<Ni+Nh) {
                wht=wtih.mget(jj-Ni,ii,Ni)
                wtptr=wtih  wpind=(jj-Ni)*Ni+ii
                printf("Monitoring input %d to hid %d: %g\n",ii,jj-Ni,wht)
              } else if (ii>=Ni && ii<Ni+Nh && jj>=Ni+Nh && jj<Ni+Nh+No) {
                wht=wtho.mget(jj-Nh-Ni,ii-Ni,Nh) 
                wtptr=wtho wpind=(jj-Nh-Ni)*Nh+ii-Ni
                printf("Monitoring hid %d to output %d: %g\n",ii-Ni,jj-Nh-Ni,wht)
              } else { print "Not connected" return }
            nc.line(ii,jj,1,"O",8,0,0,wht) 
          }
      }
  }

//** pnum() -- change patterns
pn=1
proc pnum () { local n
    if (numarg()==1) n=$1 else n=pn
    pattnum=pn
    if (n<0) n=0  if(n>npatts)n=npatts
    if (Nh>0) {
        tb[0]=new XTABL(Ni-1,1,pattl.object(2*n),2,"INPUT PATTERN",1)
      } else {
        tb[0]=new XTABL(Ni,1,pattl.object(2*n),2,"INPUT PATTERN",1)
      }
    tb[1]=new XTABL(No,1,pattl.object(2*n+1),3,"OUTPUT PATTERN",1)
  }

proc reset () { 
    initialize() 
    if (isobj(box[1],"VBox")) box[1].unmap
  }

proc notify () {
    if ($5==0 && $3==0) {
        err("Unused row (projection to bias unit)")
        $o1.x[$2]=0
      }
  }

//* shmat() show weight matrix
proc shmat () { local num,ii,wht,min
    num=$1
    if (num==0) {
        if (Nh==0) {
            tb[0]=new XTABL(No,Ni,wt,1,"Weight Matrix",1)
          } else {
            tb[0]=new XTABL(Nh,Ni,wtih,0,"INPUT TO HIDDEN (TOP ROW INACTIVE)",0)
            mesg="in->hid matrix: TOP ROW INACTIVE"
          }
      } else if (num==1) {
        tb[1]=new XTABL(No,Nh,wtho,1,"HIDDEN TO OUTPUT WEIGHT MATRIX",1)
      } else if (num==2) {
        xpanel("Set input units")
        xbutton("Forward prop","bpforward() mapsts()")
        if (Nh>0) min=2 else min=1
        for ii=min,Ni { // ignore first unit which is bias unit
            sprint(tstr,"Input #%d",ii-1)
            sprint(tstr2,"sti.x[%d]",ii-1)
            if (Nh>0) temp_string_="mapsts()" else temp_string_="mapstd()"
            xvalue(tstr,tstr2,1,temp_string_)
          }
        xpanel()
      } else if (num==3) { // show weights
        if (Nh==0) {
            for ii=0,Ni-1 for jj=0,No-1 {
                wht=wt.mget(jj,ii,Ni)
                if (wht<0) colr=3 else colr=2
                nc.line(ii,jj+Ni,colr,"O",8,-lmv*rdm.repick,mvmax*lmv-2*lmv*rdm.repick,wht) 
              }
          } else {
            for ii=0,Ni-1 for jj=0,Nh-1 {
                wht=wtih.mget(jj,ii,Ni)
                if (wht<0) colr=3 else colr=2
                nc.line(ii,jj+Ni,colr,"O",8,-lmv*rdm.repick,mvmax*lmv-2*lmv*rdm.repick,wht) 
              }
            for ii=0,Nh-1 for jj=0,No-1 { 
                wht=wtho.mget(jj,ii,Nh)
                if (wht<0) colr=3 else colr=2
                nc.line(ii+Ni,jj+Ni+Nh,colr,"O",8,-lmv*rdm.repick,mvmax*lmv-2*lmv*rdm.repick,wht) 
              } 
          }
      } else if (num==4) {
        nc.g.erase_all
        nc.vals.fill(0)
        if (Nh>0) nc.vals.x[0]=nc.vals.x[Ni]=1 // bias units
        nc.disp()
      }
  }

// just draw the connectivity without the bias units
proc drawconn () {
    for ii=1,Ni-1 for jj=1,Nh-1 {
        wht=wtih.mget(jj,ii,Ni)
        if (wht<0) colr=3 else colr=2
        nc.line(ii,jj+Ni,colr,"O",8,-lmv*rdm.repick,mvmax*lmv-2*lmv*rdm.repick)
      }
    for ii=1,Nh-1 for jj=0,No-1 { 
        wht=wtho.mget(jj,ii,Nh)
        if (wht<0) colr=3 else colr=2
        nc.line(ii+Ni,jj+Ni+Nh,colr,"O",8,-lmv*rdm.repick,mvmax*lmv-2*lmv*rdm.repick)
      } 
  }


proc initvals () {
    mkmat()
    nc.vals.fill(0)
    // for ii=0,1 nc.vals.x[ii]=1
    nc.disp
  }

stp=0
//* dispwait () -- display values and wait
proc dispwait () { local ii
    mesg=$s1
    if (numarg()==2) for ii=0,$o2.size-1 sprint(mesg,"%s %g ",mesg,$o2.x[ii])
    print mesg
    if (stp==0) box[1]=new VBox()
    box[1].unmap()
    box[1].intercept(1)
    xpanel("")
    if (stp==0) xbutton("Continue","cont()")
    xlabel(mesg)
    xpanel()
    box[1].intercept(0)
    box[1].map("Message",0,0,-1,-1)
  }

//** parsr()
proc parsr () { local flag
    flag=$1
    if (numarg()==2) { filename=$s2 
        if (flag==0) tmpfile.wopen(filename) else tmpfile.ropen(filename) }
    if (flag==0) { 
        vec.resize(Ni)
        for ii=0,Nh-1 {
            vec.mrow(wtih,ii,Ni) 
            vec.printf(tmpfile,"%f ")
          }
        vec.resize(Nh)
        for ii=0,No-1 {
            vec.mrow(wtho,ii,Nh) 
            vec.printf(tmpfile,"%f ")
          }
      } else { 
        wtih.scanf(tmpfile,Ni*Nh) 
        wtho.scanf(tmpfile,Nh*No) 
      }
    tmpfile.close
  }

//* mapsts()  -- display state values on the picture
proc mapsts () {
    ind.copy(sti,0)
    ind.copy(sth,Ni)  
    ind.copy(sto,Ni+Nh)
    nc.dispcol(ind)
  }

//** for delta
proc mapstd () {
    ind.resize(Ni+2*No)
    ind.copy(sti,0)
    ind.copy(vo,Ni)
    nc.disp(ind)
    shmat(3)
  }
// END delta.hoc
//================================================================

{alpha = 1 Ni=4 Nh=9 No=2 npatts=9 sigmul=3 sigsub=(sigmul-1)/2}
if (Nh!=0 && first==0) { Ni+=1 Nh+=1 first=1} // bias units; units for learning threshold
initflag=0

proc sverr () { err("**** ERR: Read weight file first. ****") }

proc extra () {
    xpanel("")
    xvarlabel(mesg)
    xbutton("Show","if (initflag) {color() bpgrwts(graphItem)} else sverr()")
    xbutton("Erase graph","gcl=0 graphItem.erase")
    xbutton("Read weights","rdwts1()")
    xbutton("Save weights","svrd(0,\"weights\",\"mat\")") 
    xbutton("Random weights","bpinit(-1,1) initflag=1 color() bpgrwts(graphItem)")
    xpanel()
  }

proc rdwts1 () {
    svrd(1,"weights","mat") 
    initflag=1 
    color() 
    bpgrwts(graphItem)
  }

proc mkmat () {
    wtih.resize(Nh*Ni)
    wtho.resize(No*Nh)
  }
mkmat()

// unused routines
proc showpatts () {}

proc reset () { 
    gcl=1
    ind.resize(0) vec.resize(0)
    ind.append(-0.37438,-0.31646,-0.02787,0.186818,0.406279,0.478434,0.58712,0.882058,0.916661)
    vec.append(0.727111 ,0.0923108,-0.179426,0.549396 ,0.406051 ,-0.319137,-0.968055,-0.358307,-0.592946)
    graphItem.erase_all
    bpgrwts(graphItem,ind,vec)
    graphItem.size(-1,1,-1,1)
  }

mkit("VOR hidden unit analysis")
reset()
// END SUP_VORres.hoc
//================================================================