Neural Query System NQS Data-Mining From Within the NEURON Simulator (Lytton 2006)

 Download zip file   Auto-launch 
Help downloading and running models
Accession:97874
NQS is a databasing program with a query command modeled loosely on the SQL select command. Please see the manual NQS.pdf for details of use. An NQS database must be populated with data to be used. This package includes MFP (model fingerprint) which provides an example of NQS use with the model provided in the modeldb folder (see readme for usage).
Reference:
1 . Lytton WW (2006) Neural Query System: Data-mining from within the NEURON simulator. Neuroinformatics 4:163-76 [PubMed]
Model Information (Click on a link to find other models with that property)
Model Type: Neuron or other electrically excitable cell;
Brain Region(s)/Organism:
Cell Type(s):
Channel(s):
Gap Junctions:
Receptor(s):
Gene(s):
Transmitter(s):
Simulation Environment: NEURON;
Model Concept(s): Methods;
Implementer(s): Lytton, William [bill.lytton at downstate.edu];
// $Id: decvec.hoc,v 1.249 2005/02/09 22:12:32 billl Exp $

proc decvec() {}

//* Declarations
objref ind, tvec, vec, vec0, vec1, tmpvec, vrtmp, veclist, veccollect
objref tmpobj, XO, YO, rdm, dir
dir = new List()
tmpfile = new File()
if (! name_declared("datestr")) load_file("setup.hoc")
load_file("declist.hoc")  // declare list iterators
print "Loading decvec"

{symnum = 7 colnum = 9}
func cg () { return $1%colnum+1 } // skip white color
objref clrsym[colnum+1]
for ii=0,colnum { clrsym[ii]=new String2() }
// black->red->blue->green->orange->brown->violet->yellow->grey
{clrsym[0].s="white" clrsym[1].s="black" clrsym[2].s="red" clrsym[3].s="blue"
clrsym[4].s="green" clrsym[5].s="orange" clrsym[6].s="brown" clrsym[7].s="violet" 
clrsym[8].s="yellow" clrsym[9].s="grey"} 
{clrsym[0].t="o" clrsym[1].t="t" clrsym[2].t="s" clrsym[3].t="O" clrsym[4].t="T" 
clrsym[5].t="S" clrsym[6].t="+"}

{ MSONUM=100 MSOSIZ=100 msomax=0 msoptr=0 objref mso[MSONUM] }
double x[4],y[4]
xx=0 // declare a scalar 
ind = new Vector(100)
tvec = new Vector(100)
vec = new Vector(100)
vec0 = new Vector()
vec1 = new Vector()
vrtmp = new Vector()
veclist = new List()
veccollect = new List()
rdm = new Random()
rdm.MCellRan4()

if (!(xwindows && name_declared("xwindows"))) {
  xwindows=0
  objref graphItem
  strdef temp_string_, temp_string2_
}
strdef xtmp,space
if (wopen("xtmp")) xtmp = "xtmp" else xtmp="/tmp/xtmp"  // scratch file to save system output to

//* stuff that doesn't belong here
//** dired([list,]file) - put together list of files matching 'file', calls 'ls -1 file'
//   dired([list,]file,1) file name to read for list of files
//   dired([list,]file,2) clear dir first; if list isn't present assume 'dir'
proc dired () { local f,fs1
  f=fs1=0
  if (numarg()==0) { print "dired([list,]filename[,flag])\t\
    adds the filename to list (use wildcards) (flag:1 read file;flag:2 clear list)"
    return }
  if (argtype(1)==2) fs1=1 // list name not give, assume 'dir'
  if (fs1 && numarg()==2) {
    if ($2==2) dir.remove_all
    if ($2==1) { tmpfile.ropen($s1) f=1 }
  }
  if (numarg()==3) {
    if ($3==2) $o1.remove_all
    if ($3==1) { tmpfile.ropen($s2) f=1 }
  }
  if (!f) {
    if (fs1) {
      sprint(temp_string_,"ls -1R %s > %s",$s1,xtmp) // list in order of creation time
    } else {
      sprint(temp_string_,"ls -1R %s > %s",$s2,xtmp) // list in order of creation time
    }
    system(temp_string_)
    tmpfile.ropen(xtmp)
  }
  while (tmpfile.scanstr(temp_string_) != -1) {
    tmpobj=new String()
    tmpobj.s=temp_string_
    if (fs1) dir.append(tmpobj) else $o1.append(tmpobj)
    tmpfile.gets(temp_string_)  // get rid of the rest of the line
  }
  if (fs1) printf("%d files in dir\n",dir.count) else printf("%d files in %s\n",$o1.count,$o1)
}
// lsdir([dir])
proc lsdir () { 
  if (numarg()==1) {
    for ltr($o1) {sprint(tstr,"ls -l %s",XO.s) system(tstr)}
  } else for ltr(dir) {sprint(tstr,"ls -l %s",XO.s) system(tstr)}
}

//** lbrw(list,action) is used to put up a browser
// note action given without '()'
proc lbrw () {
  $o1.browser($s2,"s")
  sprint($s2,"%s()",$s2)
  $o1.accept_action($s2)
}

//** l2v(S1,S2) makes a list(S1) and puts all the XO.S2 into vec
// eg l2v("IClamp","amp")
proc l2v () {
  tmpobj=new List($s1)
  if (numarg()==3) YO=$o3 else YO=vec
  YO.resize(tmpobj.count) YO.resize(0)
  for ltr(tmpobj) {
    sprint(tstr,"YO.append(%s.%s)",XO,$s2)
    execute(tstr)
  }
}

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

//* vector iterator vtr2, treat two vectors as pairs
// usage 'for vtr2(&x, &y, vec1, vec2) { print x,y }'
iterator vtr2() { local i,pairwise,noi1
  noi1=pairwise=0
  if (numarg()==3) { pairwise=1 i1=0 }
  if (numarg()==4) if (argtype(4)==3) { pairwise=1 $&4=0 noi1=1}
  if (pairwise) if ($o3.size%2!=0) { print "vtr2 ERROR: vec not even sized." return }
  if (! pairwise) {
    if ($o3.size != $o4.size) { print "vtr2 ERROR: sizes differ." return }
    if (numarg()==5) {$&5=0 noi1=1} else {i1 = 0}
  }
  for i = 0,$o3.size()-1 {
    $&1 = $o3.x[i]
    if (pairwise) $&2=$o3.x[i+=1] else $&2=$o4.x[i]
    iterator_statement
    if (noi1) { if (pairwise) $&4+=1 else $&5+=1 } else i1+=1
  }
}

//** viconv(TARG,OLD_INDS,NEW_INDS)
proc viconv () { local a,b
  if (numarg()==0) { printf("viconv(TARG,OLD_INDS,NEW_INDS)\n") return }
  a=b=allocvecs(2) b+=1
  if ($o2.size!=$o3.size) {printf("OLD_INDS %d != NEW_INDS %d\n",$o2.size,$o3.size) return}
  mso[b].resize($o1.size)
  for vtr2(&x,&y,$o2,$o3) { // x -> y
    mso[a].indvwhere($o1,"==",x)
    mso[b].indset(mso[a],y)
  }
  $o1.copy(mso[b])
  dealloc(a)
}

//* iterator lvtr, step through a list and a vector together
// usage 'for lvtr(XO, &x, list, vec) { print XO,x }'
iterator lvtr() { local i
  if ($o3.count <  $o4.size) { printf("lvtr ERROR: vecsize > listsize: list %d,vec %d.\n",$o3.count,$o4.size) return }
  if ($o3.count != $o4.size) { printf("lvtr WARNING: sizes differ: list %d,vec %d.\n",$o3.count,$o4.size) }
  if (numarg()==5) {$&5=0} else {i1 = 0}
  for i = 0, $o4.size()-1 {
    $o1 = $o3.object(i)
    $&2 = $o4.x[i]
    iterator_statement
    if (numarg()==5) { $&5+=1 } else { i1+=1 }
  }
}

//* other iterators: case, scase, ocase
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
  }
}

// scasf() allows choice of string for saving
iterator scasf() { local i
  i1 = 0
  for i = 2, numarg() {
    $s1 = $si
    iterator_statement
    i1+=1
  }
}

// eg for scase2("a","b","c","d","e","f") print tmpobj.s,tmpobj.t
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
  }
}

iterator ocase() { local i
  i1 = 0
  for i = 1, numarg() {
    XO = $oi
    iterator_statement
  }
  i1+=1
}

//* strm(STR,REGEXP) == regexp string match 
func strm () { return sfunc.head($s1,$s2,"")!=-1 }

//* nind(targ,data,ind) fill the target vector with data NOT index by ind (opposite of v.index)
proc nind () { 
  if (! eqobj($o1,$o2)) $o1.copy($o2)
  $o1.indset($o3,-1e20)
  $o1.where($o1,">",-1e20)
}

//* vlk(vec)
// vlk(vec,max)
// vlk(vec,min,max)
// prints out a segment of a vector
vlk_width=20
space=" "
proc vlk () { local i,j,min,max,dual,wdh,nonl
  j=dual=0 nl=1 wdh=vlk_width
  if (numarg()==1) { min=0 max=$o1.size-1 }
  if (numarg()==2) {
    if (argtype(2)==0) {
      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 }
    } else { dual=1 min=0 max=$o1.size-1 }
  }
  if (numarg()==3) {
    if (argtype(2)==0) if ($3>-1) { min=$2 max=$3 }
    if (argtype(2)==1) { dual=1
      if ($3>=0) { min=0 max=$3 } else { min=$o1.size+$3 max=$o1.size-1 }
    }
  }
  if (numarg()==4) { min=$3 max=$4 dual=1 }
  if (min<0) min=0
  if (max>$o1.size-1) { max=$o1.size-1 printf("vlk: max beyond $o1 size\n") }
  if (dual) if (max>$o2.size-1) { max=$o2.size-1 printf("vlk: max beyond $o2 size\n") }
  for i=min,max { 
    if (dual) printf("%g:%g%s",$o1.x[i],$o2.x[i],space) else printf("%g%s",$o1.x[i],space)
    if ((j=j+1)%vlk_width==0 && nl && strcmp(space," ")==0) { print "" }
  }
  if (nl) print ""
}

//** vlkp(SRC,PVEC) uses indices in PVEC to print out values in SRC
proc vlkp () { local i,j,wdh
  j=0 nl=1 wdh=vlk_width
  if (numarg()==2) {
    for vtr(&x,$o1) {
      printf("%g%s",$o2.x[x],space)
      if ((j=j+1)%vlk_width==0 && nl && strcmp(space," ")==0) { print "" }
    }
  } else {
    for vtr(&x,$o1) { for i=2,numarg() printf("%g%s",$oi.x[x],space) 
      print "" }
  }
  if (nl) print ""
}

//* vprf() prints 1,2 or 3 vectors in parallel to output file
proc vprf () { local x2
  if (! tmpfile.isopen()) {
    print "Writing to temp file 'temp'"
    tmpfile.wopen("temp")
  }
  if (numarg()==1) { 
    for vtr(&x,$o1) { tmpfile.printf("%g\n",x) }
  } else if (numarg()==2) { 
    for vtr2(&x,&y,$o1,$o2) { tmpfile.printf("%g %g\n",x,y) }
  } else if (numarg()==3) { 
    for vtr2(&x,&y,$o1,$o2,&ii) { x2=$o3.x[ii] tmpfile.printf("%g %g %g\n",x,y,x2) }
  }
  tmpfile.close
}

//* vpr() prints 1,2 or 3 vectors in parallel to STDOUT
proc vpr () { local x2
  if (numarg()==1) { 
    for vtr(&x,$o1) { printf("%g ",x) }
  } else if (numarg()==2) { 
    for vtr2(&x,&y,$o1,$o2) { printf("%g:%g ",x,y) }
  } else if (numarg()==3) { 
    for vtr2(&x,&y,$o1,$o2,&ii) { x2=$o3.x[ii] printf("%g:%g:%g ",x,y,x2) }
  }
  print ""
}

//* readvec(vec) read from line
proc readvec () { 
  $o1.resize(0)
  while (read(xx)) $o1.append(xx)
  vlk($o1)
}
  
//* popvec(), savenums, readnums, vecsprint, savevec, savestr
//  vrsz(), vcp(), zvec(), resize, copy, empty
proc pushvec () { local i // same as .append, retained for compatability
  for i=2, numarg() $o1.append($i)
}

//** insvec(VEC,IND,VAL1[,VAL2,...]) insert values into the vector
proc insvec () { local ix,i,a // insert values into a vector
  a=allocvecs(1)  ix=$2
  for i=3, numarg() mso[a].append($i)
  $o1.insrt(ix,mso[a])
  dealloc(a)
}

//** revec() clear vector then append
proc revec () { local i // clear vector then append
  if (! isobj($o1,"Vector")) $o1 = new Vector()
  $o1.resize(0)
  if (numarg()>1) if (argtype(2)==1) { 
    for i=2, numarg() $oi.resize(0) 
  } else {
    for i=2, numarg() $o1.append($i)
  }
}

//** vrsz(VEC or NUM,VEC1,VEC2...,VECn or NUM)  -- vector resize -- to size of first arg
// optional final number is fill
proc vrsz () { local i,sz,max,fill,flag
  max=numarg()
  if (argtype(1)==1) sz=$o1.size else sz=$1
  if (argtype(max)==0) {i=max max-=1 fill=$i flag=1} else flag=0
  for i=2, max { $oi.resize(sz)  if (flag) $oi.fill(fill) }
}

//** vcp() -- copy vector segment with resizing
proc vcp () { local i,sz
  $o1.resize($4-$3+1) $o1.copy($o2,$3,$4)
}

//** zvec()
proc zvec () { local i // make vectors zero size
  for i=1, numarg() $oi.resize(0)
}

//* save and read series
//** savenums(x[,y,...]) save numbers to tmpfile via a vector
proc savenums () { local i,vv
  vv=allocvecs(1)
  for i=1, numarg() mso[vv].append($i)
  mso[vv].vwrite(tmpfile)
  dealloc(vv)
}

//** savedbls(&x,sz) save a double array of size sz
proc savedbls () { local vv,i
  vv=allocvecs(1)
  mso[vv].from_double($2,&$&1)
  mso[vv].vwrite(tmpfile)
  dealloc(vv)
}

//** readnums(&x[,&y...]) recover nums from tmpfile via a vector
func readnums () { local vv,i,cnt
  vv=allocvecs(1) cnt=0
  if (mso[vv].vread(tmpfile)) {
    if (numarg()!=mso[vv].size) {
      printf("readnums WARNING: args=%d;vec.size=%d\n",numarg(),mso[vv].size)
      if (numarg()>mso[vv].size) { 
        for i=1,mso[vv].size $&i = mso[vv].x[i-1]        
        cnt=mso[vv].size
      }
    }
    if (cnt==0) {
      for i=1,numarg() $&i = mso[vv].x[i-1]
      cnt=numarg()
    }
  } else cnt=-1
  dealloc(vv)
  return cnt
}

//** readdbls(&x,sz) read a double array of size sz
func readdbls () { local vv,i,flag
  vv=allocvecs(1) flag=1
  if (mso[vv].vread(tmpfile)) {
    mso[vv].v2d(&$&1)   // seg error risk
  } else flag=0
  dealloc(vv)
  return flag
}

//** wrvstr(str) save string to a file by converting to ascii
proc wrvstr () { local vv,i
  vv=allocvecs(1)
  str2v($s1,mso[vv])
  mso[vv].vwrite(tmpfile,1)
  dealloc(vv)
}

//** rdvstr(str) read string from a file via vread and conversion
func rdvstr () { local vv,i,flag
  flag=1
  vv=allocvecs(1)
  if (mso[vv].vread(tmpfile)) {
    if (numarg()==1) v2str(mso[vv],$s1) else v2str(mso[vv],tstr)
  } else flag=0
  dealloc(vv)
  return flag
}

//** str2v()
proc str2v () { localobj lo
  lo=new String()
  $o2.resize(0)
  lo.s=$s1
  while (sfunc.len(lo.s)>0) {
    sscanf(lo.s,"%c%*s",&x)
    sfunc.right(lo.s,1)
    $o2.append(x)
  }
}
    
//** v2str() translates from vector to string
proc v2str () { local ii,x
  $s2=""
  round($o1)
  for ii=0,$o1.size-1 { x=$o1.x[ii] sprint($s2,"%s%c",$s2,x) }
}

//* popvec() remove last entry
func popvec () { local sz, ret
  sz = $o1.size-1
  ret = $o1.x[sz]
  $o1.resize[sz]
  return ret
}

//* chkvec (look at last entry)
func chkvec () { if ($o1.size>0) return $o1.x[$o1.size-1] else return -1e10 }

// vecsprint(strdef,vec)
proc vecsprint () { local ii
  if ($o2.size>100) { return }
  for ii=0,$o2.size-1 { sprint($s1,"%s %g ",$s1,$o2.x[ii]) }
}

// savevec([list,]vec1[,vec2,...]) add vector onto veclist or other list if given as 1st arg
// don't throw out vectors
proc savevec () { local i,flag,beg
  if (numarg()==0) { savevec(hoc_obj_[0],hoc_obj_[1]) return }
  if (isobj($o1,"List")) beg=2 else beg=1
  for i=beg, numarg() { 
    if (veccollect.count>0) { // grab a vector from garbage collection
      tmpvec=veccollect.object(veccollect.count-1)
      veccollect.remove(veccollect.count-1)
    } else tmpvec = new Vector($oi.size)
    tmpvec.copy($oi)
    if (beg==2) $o1.append(tmpvec) else veclist.append(tmpvec)
    tmpvec = nil
  }
}

proc prveclist () {
  if (tmpfile.ropen($s1)) {
    printf("%s exists; save anyway? (y/n) ",$s1)
    getstr(temp_string_) chop(temp_string_)
    if (strcmp(temp_string_,"y")!=0) return
  }
  if (! tmpfile.wopen($s1)) { print "Can't open ",$s1  return }
  if (numarg()==2) {
    for ltr(XO,$o2) XO.vwrite(tmpfile)
  } else {
    for ltr(XO,veclist) XO.vwrite(tmpfile)
  }
  tmpfile.close()
}

proc rdveclist () { local flag,a
  flag=0
  a=allocvecs(1)
  if (numarg()==1) { flag=1 clrveclist() } else $o2.remove_all
  if (! tmpfile.ropen($s1)) { print "Can't open ",$s1  return }
  while (mso[a].vread(tmpfile)) {
    if (flag) savevec(mso[a]) else savevec($o2,mso[a])
  }
  tmpfile.close()
  tmpobj=veclist
  dealloc(a)
}
  
// vpad(vec,howmany,val[,right])
proc vpad () { local a
  a=allocvecs(1)
  mso[a].resize($2) mso[a].fill($3)
  if (numarg()==4) $o1.append(mso[a]) else {
    mso[a].append($o1) $o1.copy(mso[a])     }
  dealloc(a)
}

// vtrunc(vec,howmany[,right])
proc vtrunc () { local a
  if (numarg()==3) $o1.resize($o1.size-$2) else {
    $o1.reverse $o1.resize($o1.size-$2) $o1.reverse
  }
}

proc rdxy () { local a
  a = allocvecs(1)
  revec(ind,vec)
  tmpfile.ropen("aa")
  mso[a].scanf(tmpfile)
  if (mso[a].size%2!=0) {print "rdxy ERR1 ",mso[a].size return}
  for vtr2(&x,&y,mso[a]) {ind.append(x) vec.append(y)}
  print ind.size," points read from aa into ind and vec"
  dealloc(a)
}

// closest(vec,num) -- return ind for vec member closest to num
func closest () { local a,ret
  a=allocvecs(1)
  mso[a].copy($o1) mso[a].sub($2) mso[a].abs
  ret=mso[a].min_ind
  dealloc(a)
  return ret
}

// memb(TEST#,#1,#2,...) -- true if the TEST# is in the list
func memb () { local na,i
  for i=2,numarg() if ($1==$i) return 1
  return 0
}

proc clrveclist () { 
  for ltr(XO,veclist) { XO.resize(0) veccollect.append(XO) }
  veclist.remove_all()
}

// savestr(str1...) add string obj onto tmplist
proc savestr () { local i
  if (argtype(1)==1) for i=2, numarg() $o1.append(new String($si)) else {
    for i=1, numarg() tmplist.append(new String($si))
  }
}

// redund with v.count in vecst.mod
func vcount () { local val,sum
  val=$2 sum=0
  for vtr(&x,$o1) if (x==val) sum+=1
  return sum
}

// tvecl() -- transpose veclist
proc tvecl () { local cnt,sz,err,ii,p
  err = 0
  cnt = veclist.count
  sz = veclist.object(0).size
  for ltr(XO,veclist) if (XO.size!=sz) err=i1
  if (err) { print "Wrong size vector is #",i1 return }
  p = allocvecs(1,cnt)  mso[p].resize(cnt)
  for ii=0,sz-1 {
    for jj=0,cnt-1 {
      XO=veclist.object(jj)
      mso[p].x[jj] = XO.x[ii]
    }
    savevec(mso[p])
  }
  for (jj=cnt-1;jj>=0;jj-=1) { veccollect.append(veclist.object(jj)) veclist.remove(jj) }
}  

//* vinsect(v1,v2,v3) -- v1 gets intersection (common members) of v2,v3
//  replaced by v.insct() in vecst.mod
proc vinsect () {
  $o1.resize(0)
  for vtr(&x,$o2) for vtr(&y,$o3) if (x==y) $o1.append(x)
}

//* vecsplit(vec,vec1,vec2[,vec3,...])
// splits vec into other vecs given
proc vecsplit () { local num,ii,i
  num = numarg()-1 // how many
  for i=2,numarg() $oi.resize(0)
  for (ii=0;ii<$o1.size;ii+=num) {
    for i=2,numarg() if (ii+i-2<$o1.size) $oi.append($o1.x[ii+i-2])
  }
}

//* vecsort(vec,vec1,vec2[,vec3,...])
// sorts n vecs including first vec by first one
proc vecsort () { local i,inv,scr,narg
  narg=numarg()
  if (narg<2 || narg>10) {print "Wrong #args in decvec.hoc:vecsort" return}
  scr=inv=allocvecs(2) scr+=1
  $o1.sortindex(mso[inv])
  mso[scr].resize(mso[inv].size)
  sprint(temp_string_,"%s.fewind(%s,%s,%s",mso[scr],mso[inv],$o1,$o2)
  for i=3,narg sprint(temp_string_,"%s,%s",temp_string_,$oi)
  sprint(temp_string_,"%s)",temp_string_)
  execute(temp_string_)
  dealloc(inv)
}

//* vdelind()  -- delete a single index
proc vdelind () { local i,iin
  iin = $2
  if (iin<0) iin=$o1.size+iin
  if (iin>$o1.size-1 || iin<0) {
    printf("vdelind Error: index %d doesn't exist.\n",iin) return }
  if (iin<$o1.size-1) $o1.copy($o1,iin,iin+1,$o1.size-1)
  $o1.resize($o1.size-1)
}

//* mkveclist(num[,sz]) recreate veclist to have NUM vecs each of size SZ (or MSOSIZ)
proc mkveclist () { local ii,num,sz,diff
  num=$1 
  diff = num-veclist.count
  if (numarg()==2) { sz=$2 } else { sz = MSOSIZ }
  if (diff>0) {
    for ii=0,diff-1 {
    tmpvec = new Vector(sz)
    veclist.append(tmpvec)
    }
  } else if (diff<0) {
    for (ii=veclist.count-1;ii>=num;ii=ii-1) { veclist.remove(ii) }
  }
  for ltr(XO,veclist) { XO.resize(sz) }
}

//* allocvecs
// create temp set of vectors on mso
// returns starting point on mso 
// eg p = allocvecs(3)
// access these vectors by mso[p+0] ... [p+2]
func allocvecs () { local ii, llen, sz, newv
  if (numarg()==0) { print "p=allocvecs(#), access with mso[p], mso[p+1]..." return 0}
  newv = $1
  if (numarg()==2) { sz=$2 } else { sz=MSOSIZ }
  llen = msoptr
  for ii=msomax,msoptr+newv-1 { // may need new vectors
    if (ii>=MSONUM) { print "alloc ERROR: MSONUM exceeded." return 0 }
    mso[ii] = new Vector(sz)
  }
  for ii=0,newv-1 {
    mso[msoptr].resize(sz) mso[msoptr].resize(0)
    msoptr = msoptr+1
  }
  if (msomax<msoptr) msomax = msoptr
  return llen
}

//** dealloc(start)
// remove temp set of vectors from mso
proc dealloc () { local ii,min
  if (numarg()==0) { min = 0 } else { min = $1 }
  msomax = msoptr
  msoptr = min
}

//* indvwhere family
//** vwh(VEC,VAL) returns index where VEC.x[i]==VAL
func vwh () { return $o1.indwhere("==",$2) }
//** vval(VEC,STR,NUM) uses indwhere to return first value that qualifies
func vval () { return $o1.x[$o1.indwhere($s2,$3)] }
//** vcnt(VEC,STR,x[,y]) uses indvwhere and returns # of values that qualify
func vcnt () { local a,ret
  a=allocvecs(1) 
  if (numarg()==3) mso[a].indvwhere($o1,$s2,$3)
  if (numarg()==4) mso[a].indvwhere($o1,$s2,$3,$4)
  ret = mso[a].size
  // if ($o1.size>0) printf("%d/%d (%g)\n",ret,$o1.size,ret/$o1.size*100)
  dealloc(a)
  return ret
}
//** civw(DEST,SRC1,STR1,x1[,y1]...) does compound indvwhere
// overwrites tstr; DEST should be size 0 unless to be compounded
// civw(DEST,0,...) will resize DEST to 0
func civw () { local i,a,b,c,f2,x,y,sz,min
  a=b=c=allocvecs(3) b+=1 c+=2
  min=2
  // if ($o1.size>0) print "Starting with previously set index vector"
  if (argtype(2)==0) {
    if ($2==0) { $o1.resize(0) min=3
      if (argtype(3)==1) sz=$o3.size else {
        printf("ERR0: arg 3 should be obj when $2==0\n",i) return -1 }
    } else {
      printf("ERR0a: arg 2 should be 0 if a number -- zero sizes ind vector\n") 
      return -1
    }
  } else if (argtype(2)==1) sz=$o2.size else {
    printf("ERR0b: arg 2 should be obj\n",i) return -1 }
  for (i=min;i<=numarg();) {
    mso[c].copy($o1) 
    if (argtype(i)!=1) { printf("ERR1: arg %d should be obj\n",i) return -1}
    if ($oi.size!=sz)  { printf("ERR1a: all vecs should be size %d\n",sz) return -1}
    mso[a].copy($oi)  i+=1   // look in a
    if (argtype(i)!=2) { printf("ERR2: arg %d should be str\n",i) return -1}
    tstr=$si          i+=1
    if (strm(tstr,"[[(]")) f2=1 else f2=0 // opstring2 needs 2 args
    if (argtype(i)!=0) { printf("ERR3: arg %d should be dbl\n",i) return -1}
    x=$i              i+=1 
    if (f2) {
      if (argtype(i)!=0) { printf("ERR4: arg %d should be dbl\n",i) return -1}
      y=$i            i+=1
    }
    if (f2) mso[b].indvwhere(mso[a],tstr,x,y) else { // the engine
            mso[b].indvwhere(mso[a],tstr,x)   }
    $o1.resize(sz) // make sure it's big enough for insct -- shouldn't need
    if (mso[c].size>0) $o1.insct(mso[b],mso[c]) else $o1.copy(mso[b])
    if ($o1.size==0) break
  }
  dealloc(a)
  return $o1.size
}

//* vecconcat(vec1,vec2,...)
// destructive: concatenates all vecs onto vec1
proc vecconcat () { local i
  if (numarg()<2) { print "vecconcat(v1,v2,...) puts all into v1" return }
  for i=2,numarg() {
    $o1.copy($oi,$o1.size)
  }
}
  
//** vecelim(v1,v2)  eliminates items in v1 given by index vec v2
proc vecelim () {
  for vtr(&x,$o2) { $o1.x[x]= -1e20 }
  $o1.where($o1,"!=",-1e20)
}

//** redundout(vec) eliminates sequential redundent entries
// destructive
proc redundout () { local x,ii,p1
  p1=allocvecs(1)
  $o1.sort
  mso[p1].resize($o1.size)
  mso[p1].redundout($o1)
  $o1.copy(mso[p1])
  dealloc(p1)
}

// vecconv() convert $o1 by replacing instances in $o2 by corresponding instances in $o3
proc vecconv () { local a,b
  a=b=allocvecs(2) b+=1
  vrsz($o1,mso[b])
  for vtr2(&x,&y,$o2,$o3) { // x -> y
    mso[a].indvwhere($o1,"==",x)
    mso[b].indset(mso[a],y)
  }
  $o1.copy(mso[b])
}

//** veceq()  like vec.eq but don't have to be same size and shows discrepency
func veceq () { local sz1,sz2,eq,beg,ii,jj,kk
  sz1=$o1.size sz2=$o2.size
  if (numarg()==3) beg=$3 else beg=0
  if (sz1!=sz2) printf("%s %d; %s %d\n",$o1,sz1,$o2,sz2)
  ii=0 jj=beg
  while (ii<sz1 && jj<sz2) {
    if ($o1.x[ii]!=$o2.x[jj]) { 
      eq=0
      printf("Differ at %d %d\n",ii,jj) 
      for kk=-10,10 if ((ii+kk)>=0 && (ii+kk)<sz1 && (jj+kk)>=0 && (jj+kk)<sz2) {
        printf("(%d)%g:(%d)%g ",(ii+kk),$o1.x[ii+kk],(jj+kk),$o2.x[jj+kk])  }
      print ""
      break 
    } else eq=1
    ii+=1 jj=ii+beg
  }
  return eq
}

//* isstring() determine if object $o1 is of type string, if so return the string in [$s2]
func isstring () {
  sprint(tstr,"%s",$o1)
  if (sfunc.substr(tstr,"String")==0) {
    if (numarg()==2) sprint($s2,"%s",$o1.s)
    return 1
  } else {
    if (numarg()==2) sprint($s2,"%s",$o1)
    return 0
  }
}

//** isassigned() checks whether an object is Null
func isassigned () { return !isojt($o1,nil) }

//** isit() like isassigned() but takes a string instead
func isit () {
  sprint(temp_string_,"XO=%s",$s1)
  execute(temp_string_) // XO points to the thing
  return isassigned(XO)
}

//** isob(s1,s2) like isobj but takes string statt obj
func isob () {
  sprint(temp_string_,"XO=%s",$s1)
  execute(temp_string_) // XO points to the thing
  sprint(temp_string_,"%s",XO)
  if (sfunc.substr(temp_string_,$s2)==0) {
    return 1
  } else {
    return 0
  }
}

//** eqobj(o1,o2) checks whether 2 objects are the same
func eqobj () {	return object_id($o1) == object_id($o2) }
//** ocnt(STR) counts number of objects named string
func ocnt () { local ret
  tmpobj=new List($s1) ret=tmpobj.count
  tmpobj=nil
  return ret
}

//** 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
  }
}

// destructive of $s1
func str2num () { local ii
  sscanf($s1,"%d",&x)
  return x
}

func isnum () { return strm($s1,"^[-+0-9.][-+0-9.eE]+$") }

// like perl chop -- removes the last character
// chop(STR[,TERM]); TERM chop only TERM
// note that no + means must repeat char eg "))*" statt ")+"
func chop () { local ln1,match
  ln1=sfunc.len($s1) 
  if (numarg()==2) { 
    sprint($s2,"%s$",$s2) // just look for terminal character
    if ((match=sfunc.head($s1,$s2,temp_string2_))==-1) {
      return 0 
    } else {
      sfunc.left($s1,match) 
      return match
    }
  } else if (sfunc.len($s1)>=1) {
    sfunc.left($s1,ln1-1) 
    return 1
  } else {
    print "ERR: chop called on empty string" }
    return 0
}

// lchop(STR[,BEGIN]) -- chop from the left
func lchop () { local ln1,match
  ln1=sfunc.len($s1) 
  if (numarg()==2) { 
    sprint($s2,"^%s",$s2) // just look for initial chars
    if ((match=sfunc.tail($s1,$s2,temp_string2_))==-1) {
      return 0 
    } else {
      sfunc.right($s1,match) 
      return match
    }
  } else if (sfunc.len($s1)>=1) {
    sfunc.right($s1,1) 
    return 1
  } else {
    print "ERR: chop called on empty string" }
    return 0
}

proc concat () { local i
  for i=2,numarg() sprint($s1,"%s%s",$s1,$si)
}
proc concat () { local i
  for i=2,numarg() sprint($s1,"%s%s",$s1,$si)
}

// eg split("534,  43 , 2, 1.4, 34",vec[,"/"])
// split("13, 3*PI/2*tau/2, 32+7, 6, 9.2, 42/3",vec) 
//    optional 3rd str is what to split on; default is comma
proc split () { local vf
  if (isobj($o2,"Vector")) vf=1 else vf=0
  if (vf) revec($o2) else $o2.remove_all
  temp_string2_=$s1
  while (sfunc.len(temp_string2_)>0) {
    if (vf) {
      if (strm(temp_string2_,"^[^,]+[+*/-]")) {
        sfunc.head(temp_string2_,",",temp_string_)
        if (sfunc.len(temp_string_)==0) temp_string_=temp_string2_
        sprint(temp_string_,"x=%s",temp_string_) execute(temp_string_)
        $o2.append(x)
      } else if (sscanf(temp_string2_,"%lf",&x)) { $o2.append(x) // throw out non-numbers
      } else printf("split WARNING non-number: %s",temp_string2_)
    } else {
      if (numarg()==3) sfunc.head(temp_string2_,$s3,temp_string_) else {
                       sfunc.head(temp_string2_,",",temp_string_) }
      if (sfunc.len(temp_string_)==0) temp_string_=temp_string2_ // the end
      $o2.append(new String(temp_string_))
    }
    if (numarg()==3) sfunc.tail(temp_string2_,$s3,temp_string2_) else {
                     sfunc.tail(temp_string2_,",",temp_string2_) }
  }
}

// intervals(TRAIN,OUTPUT)
proc intervals () { local a
  if ($o1.size<=1) { printf("%s size <2 in intervals()\n",$o1) return }
  $o2.deriv($o1,1,1)
}

// downcase(tstr[,UPCASE]) 
proc downcase () { local len,ii,let,diff,min,max
  diff=32 min=65 max=90
  if (numarg()==2) { diff=-diff min=97 max=122 } // if flag -> upcase
  len = sfunc.len($s1)
  for ii=1,len {
    sscanf($s1,"%c%*s",&x)
    sfunc.right($s1,1)
    if (x>=min&&x<=max) {
      sprint($s1,"%s%c",$s1,x+diff)
    } else sprint($s1,"%s%c",$s1,x) // just rotate the letter
  }
}

// newlst() puts a newline in the middle of a string
proc newlst () { local l
  if (numarg()>1) l=$2 else l=int(sfunc.len($s1)/2)
  temp_string_=$s1
  temp_string2_=$s1
  sfunc.left(temp_string_,l)
  sfunc.right(temp_string2_,l)
  sprint($s1,"%s\n%s",temp_string_,temp_string2_)
}

//* rdcol(file,vec,col#,cols): read multicolumn file
func rdcol () { local col,cols,length
  if (numarg()==0) { print "\trdcol(\"file\",vec,col#,cols) // col#=1..." return 0}
  col=$3 cols=$4 length=0
  if (! tmpfile.ropen($s1)) { printf("\tERROR: can't open file \"%s\"\n",$s1) return 0}
  while (tmpfile.gets(temp_string_) != -1) length+=1 // count lines
  print length
  tmpfile.seek()
  $o2.scanf(tmpfile,length,col,cols)
  if ($o2.size!=length) printf("rdcol ERR: only read %d statt %d\n",$o2.size,length)
  return length
}

//* hist(g,vec,min,max,bins)
{clr=1 hflg=0 ers=1} // clr:color, hflg=1 draw lines; 2 draw boxes; 3 fill in; ers=erase
// style determined by hflg
// hflg==0 lines with dots
// hflg==0.x offset lines with dots
// hflg==1 outlines but not down to zero
// hflg==2 outlines with lines down to zero
// hflg==3 just dots
proc hist () { local a,b,c,min,max,wid,bins,ii,jj,offset
  if (numarg()==5) {min=$3 max=$4 bins=$5 
  } else if (numarg()==4) { min=0 max=$3 bins=$4 
  } else if (numarg()==3) { min=$o2.min-.1 max=$o2.max+.1 bins=$3 
  } else if (numarg()==2) { min=$o2.min-.1 max=$o2.max+.1 bins=int(max-min)
  } else { printf("hist(g,vec,min,max,bins)\n") return }
  wid=(max-min)/bins
  a=b=c=allocvecs(3) b+=1 c+=2
  offset=0
  if (ers) $o1.erase_all()
  mso[c].hist($o2,round(min),bins,wid) // c has values
  mso[a].resize(2*mso[c].size())
  mso[a].indgen(0.5) 
  mso[a].apply("int") 
  mso[b].index(mso[c], mso[a]) 
  mso[a].mul(wid) mso[a].add(min)
  mso[b].rotate(1)
  mso[b].x[0] = 0 
  mso[b].append(mso[b].x[mso[b].size-1],0)
  mso[a].append(max,max)
  if (hflg==1 || hflg==2) { 
    mso[b].line($o1, mso[a],clr,4)
    if (hflg==2) for vtr(&x,mso[a]) drline(x,0,x,mso[b].x[i1],$o1,clr,4)
  } else if (int(hflg)==0 || hflg==3) { 
    if (hflg%1!=0) offset=hflg // use eg -0.5+ii/8 to move back to integer
    mso[a].indgen(min,max-wid,wid)
    mso[a].add(wid/2+offset)
    print mso[a].min,mso[a].max
    // mso[c].mark($o1,mso[a],"O",6,clr,2) // this will place points where 0 count
    for jj=0,mso[a].size-1 if (mso[c].x[jj]!=0) {
      if (hflg!=3) drline(mso[a].x[jj],0,mso[a].x[jj],mso[c].x[jj],$o1,clr,4)
      $o1.mark(mso[a].x[jj],mso[c].x[jj],"O",6,clr,2) // don't place points with 0 count
    }
  }
  $o1.flush()
  $o1.size(min,max,0,mso[b].max)
  dealloc(a)
}

// rdmuniq(vec,n,rdm) -- augment vec by n unique vals from rdm
// draw n numbers without replacement, only makes sense with discrete distribution
// could do something like 
// mso[a].setrand($o3) mso[d].copy(mso[a]) 
//     mso[b].indsort(mso[a]) mso[a].sort() mso[c].redundout(mso[a],1)
// to get indices of unique values but then have to back index to original
proc rdmuniq () { local n,num,flag,xx,loop,a
  a=allocvecs(1)
  n=$2  num=0  flag=1 loop=0
  mso[a].resize(n*4) // hopefully will get what we want
  while (flag) {
    mso[a].setrand($o3)
    for ii=0,mso[a].size-1 {
      xx=mso[a].x[ii]
      if (! $o1.contains(xx)) { $o1.append(xx) num+=1 }
      if (num==n) { flag=0 break }
    }
    loop+=1
    if (loop==10) { print "rdmunq ERR; inf loop" flag=0 break }
  }
  dealloc(a)
}

// rdmord (vec,n) randomly ordered numbers 0->n-1 in vec
// eg rdmord(ind,ind.size); check: for ii=0,ind.size-1 if (ind.count(ii)!=1) print ii
proc rdmord () { local n,a
  a=allocvecs(1)
  n=$2
  rdm.uniform(0,100)
  mso[a].resize(n)
  mso[a].setrand(rdm)
  mso[a].sortindex($o1)
  dealloc(a)
}

// shuffle(VSRC[,VDEST]) randomly rearrange elements of vec
proc shuffle () { local a,b
  a=b=allocvecs(2)  b+=1
  rdmord(mso[a],$o1.size)
  mso[b].index($o1,mso[a])
  if (numarg()==2) $o2.copy(mso[b]) else $o1.copy(mso[b])
  dealloc(a)
}

// round() round off to nearest integer
func round () { local ii
  if (argtype(1)==1) {
    if ($o1.size==0) return 1e9
    for ii=0,$o1.size-1 {
      if ($o1.x[ii]>0) $o1.x[ii]=int($o1.x[ii]+0.5) else $o1.x[ii]=int($o1.x[ii]-0.5) 
    }
    return($o1.x[0])
  } else {
    if ($1>0) return int($1+0.5) else return int($1-0.5) 
  }
} 

// filevers() pulls out version of file from first line
func filevers () { localobj f1,s1,lx1
  f1=new File() s1=new String() lx1=new Union()
  if (! f1.ropen($s1)) { printf("filevers ERR, can't open %s\n",$s1) 
    return 0 }
  f1.gets(s1.s)
  if (sscanf(s1.s,"%*s $Id: %*s %*d.%d",&lx1.x)!=1) {
    printf("filevers ERR, sscanf failed %s: %s",$s1,s1.s) }
  f1.close
  return lx1.x
}

//* hocfind(FILENAME) searches through HOC_LIBRARY_PATH and locates file
obfunc hocfind () { local done localobj f1,s1,s2
  f1=new File() s1=new String() s2=new String()
  done=0
  system("echo -n $HOC_LIBRARY_PATH",s1.s)
  sprint(s1.s,"%s ",s1.s) // to look at last item
  while (sfunc.len(s1.s)>2) {
    sfunc.head(s1.s,"[ :]",s2.s)
    sprint(s2.s,"%s/%s",s2.s,$s1)
    if (f1.ropen(s2.s)) {done=1 break}
    sfunc.tail(s1.s,"[ :]",s1.s)
  }
  if (!done) if (f1.ropen($s1)) {sprint(s2.s,"./%s",$s1) done=1}
  if (!done) s2.s="NOT FOUND"
  return s2
}

//* usefiles(F1[,F2,...]) list of files returns string with list of files and versions
obfunc usefiles () { local i localobj s1,s2
  s2=new String()
  s2.s="Using "
  for i=1,numarg() {
    s1=hocfind($si)
    sprint(s2.s,"%s %s%d",s2.s,$si,filevers(s1.s))
  }
  return s2
}

proc stat () { 
printf("Sz:%d; Min:%g; Max:%g; Mean:%g; Dev:%g\n",$o1.size,$o1.min,$o1.max,$o1.mean,$o1.stdev)
}
  

Loading data, please wait...