// $Id: nqs.hoc,v 1.561 2007/09/14 18:53:13 billl Exp $
// primarily edited in nrniv/place
if (!name_declared("VECST_INSTALLED")) {
printf("NQS ERROR: Need vecst.mod nmodl package compiled in special.\n")
quit()
}
if (!VECST_INSTALLED) install_vecst()
if (! name_declared("datestr")) load_file("setup.hoc")
load_file("decvec.hoc")
objref g[10]
gvmarkflag=0
declared("file_len")
strdef execstr,strform,dblform,tabform
{strform="%s " dblform="%3.4g" tabform=" "}
//* stubs for ancillary programs
double sops[20] // AUGMENT TO ADD NEW OPSYM
declared("whvarg","whkey","varstr","nqsdel","chsel2","grsel2","oform")
proc oformoff () { execute1("func oform(){return NOP}") } // default no operation
oformoff()
nqsselcp=1
//* NQS template
// potential to overwrite XO,tmpfile,i1
begintemplate NQS
public cob,out,up // operate on this or out
public s,comment,file,v,m,x,ind,scr,fcd,fcds,fcdo,fcdl,sstr // strings and vecs
public objl,verbose,tmplist,vlist,vl,nval,sval,oval,selcp,rxpstr,slorflag,stub,chunk,rdpiece
public sv,rd,append,pr,pri,prs,zvec,resize,size,fi,sets,set,setcol,setcols,gets,get,fetch,tog
public cp,copy,mo,aind,it,qt,ot,ut,vt,appi,eq,fcdseq,fcdoeq,sort,select,stat,map,apply,applf
public calc,pad,delect,fill,uniq,gr,clear,strdec,coddec,odec,join,fillin,fillv,otl,selall
public unuselist,useslist,delrow,elimrepeats,grow,shuffle,fewind,listvecs,loose,rdcols
public percl,psel,svsetting,getrow,getcol,resize2,find,family,delcol,keepcols,selone
public sethdrs,gethdrs,version,svvers,i2,ay,svcols,svR,scpflag,unref,refs,qtset,keylook,cpout
public deriv,interval,renamecol,renamecols,info,getsel,tomat,frmat,marksym
objref v[1],s[1],is[4],x,nil,ind,scr[3],fcd,fcds,fcdo,fcdl,this,objl
objref cob,out,up,Xo,Yo,oval,tmplist,otl,vlist,vl,info
strdef comment,file,sstr,sstr2,sstr3,sstr4,tstr,sval,nqsvers,marksym
double m[1],refs[1]
external readnums,savenums,readdbls,savedbls,rdvstr,wrvstr,sfunc,repl_mstr,isobj,rdmord
external vlk,Union,String,tmpfile,strm,XO,execstr,i1,allocvecs,dealloc,mso,strform,dblform,tabform
external eqobj,isnum,chop,isassigned,whvarg,whkey,sops,batch_flag,g,varstr,gvmarkflag
external file_len,nqsdel,chsel2,grsel2,oform,nqsselcp
//** init()
proc init () { local i,ii,flag,scnt,na,fl,rdflag
refs=-1
nval=fl=scnt=flag=rdflag=0 // flag set if creating the internal NQS
ni=0
verbose=1
selcp=nqsselcp
svsetting=3 loose=1e-4
for ii=2,3 is[ii]=new String()
is[3].s="INDEX" is[2].s="SCRATCH"
na=numarg()
for i=1,na scnt+=(argtype(i)==2) // string count
if (na==0) scnt=-1
if (na==1) if (argtype(1)==2) rdflag=1 else if (argtype(1)==1) rdflag=2
if (na>=1) if (argtype(1)==0) {
fl=1 // 1 arg taken care of
if ($1==1e-9) {
flag=1 up=$o2 fl=2
m=up.m
if (m>0) {
objref v[m],s[m]
for ii=0,m-1 {v[ii]=new Vector() s[ii]=up.s[ii]}
}
fcd=up.fcd
fcds=up.fcds fcdl=up.fcdl fcdo=up.fcdo // finish creation of .out here
} else {
m=$1
objref v[m],s[m]
for ii=0,m-1 { v[ii]=new Vector() s[ii]=new String2() }
}
}
if (fl!=1 && na==scnt) { // all strings
fl=2 // all args taken care of
m=na
objref v[m],s[m]
for ii=0,m-1 {i=ii+1 v[ii]=new Vector() s[ii]=new String($si) }
}
if (fl!=2 && na>=2) if (argtype(2)==0) {
fl==2 // all args taken care of
for ii=0,m-1 v[ii].resize($2)
}
if (fl!=2) { // if first arg is not a string these other can be
if (na>=2) file=$s2
if (na>=3) comment=$s3
if (na>=4) x.x[0]=$4
}
if (!flag) {
// fcd gives field codes according to values used for argtype()
fcds=new List() fcd=new Vector(m) tmplist=new List() vlist=new List()
fcd.resize(m) fcd.fill(0) // field codes to have a field that's string based
}
x=new Vector(m) ind=x.c for ii=0,2 scr[ii]=x.c
scr.resize(0) ind.resize(0)
objl=new List() cob=this
v0sz=slorflag=0
qtset=0
chunk=100
info=new Union()
nqsvers="$Id: nqs.hoc,v 1.561 2007/09/14 18:53:13 billl Exp $" svvers=-1
if (!flag) {
out=new NQS(1e-9,this)
if (rdflag==1) rd($s1)
if (rdflag==2) copy($o1)
}
chk()
}
// deallocate the attached nqs if destroyed
// after build NQS should have external pointer and out.up pointer +/- cob
// NB: 'this' is created and destroyed as needed
proc unref () {
return
// if (isassigned(out)) printf("AA:%d ",$1) else printf("BB:%d ",$1)
if ($1<=refs) { // don't bother if have more than 2 refs or if currently building
if (m>=0 && isassigned(out)) { // only do it on a live master nqs
if ($1<2 || eqobj(cob,out.up)) { // means that only up are left
m=-7 // indicate have started the process so don't reenter here
printf("Entering destructor for %s: %d %d %s %s %s\n",out.up,$1,refs,cob,out,out.up)
out.unref(-1) // take care of out first
}
}
}
if ($1==-1) { // for .out
cob=nil
up=nil
} else if (m==-7) { // should only be done once
m= -8
// printf("Removal of %s on call %d\n",out.up,$1)
if (isassigned(fcdo)) fcdo.remove_all
if (isassigned(fcdo)) fcds.remove_all
cob=nil
up=nil
}
}
//** make sure there are no inconsistencies
func chk () { local ii,jj,ret
ret=1
for ii=0,m-2 for jj=ii+1,m-1 {
if (sfunc.len(s[ii].s)>0 && strcmp(s[ii].s,s[jj].s)==0) {
printf("NQS:chk ERRA: %s col: %s(%d) %s(%d) with same name\n",this,s[ii].s,ii,s[jj].s,jj)
ret=0
}
}
return ret
}
//** tog() toggle flag that determines whether actions are on out or this
func tog () { local ret
if (eqobj(cob,out)) ret=20 else ret=10 // report old value
if (numarg()==0) {
if (eqobj(cob,out)) { cob=this if (verbose) print "Operate on full db"
} else { cob=out if (verbose) print "Operate on output of select"
}
} else if (numarg()==1) {
if (argtype(1)==0) {
if ($1>=10) { // set
if ($1==10) cob=this else if ($1==20) cob=out else printf("tog ERRA:%d\n",$1)
} else { // just give information
if (eqobj(cob,out)) { print "Using output db"
} else { print "Using full db" }
}
} else if (argtype(1)==2) { // out,output,selected to choose these
if (strm($s1,"[Oo][Uu][Tt]") || strm($s1,"[Ss][Ee][Ll]")) {
cob=out
} else {
cob=this
}
}
}
return ret
}
//** sethdrs() set the column names to given args
// sethdrs(#,"NAME") sethdrs("NAME1","NAME2",...) sethdrs(nq) -- copy from nq
proc sethdrs () { local i,nm
nm=numarg()
// out.s should always be a pointer to s but early on was keeping different copies:
if (! eqobj(s,out.s)) printf("sets INTERRA\n")
if (nm==2 && argtype(1)==0) {
s[$1].s=$s2
} else if (nm==1) {
if ($o1.m!=m) resize($o1.m)
for i=0,m-1 s[i].s=$o1.s[i].s
} else {
if (nm>m) {
if (batch_flag) {
printf("NQS sets WARNING resized table from %d to %d\n",m,nm)
} else if (! boolean_dialog("Resize TABLE?","YES","NO")) return
printf("resizing TABLE: %d -> %d\n",m,nm) resize(nm)
}
for i=1,nm { s[i-1].s=$si }
}
}
// gethdrs() print the strings
proc gets () { printf("gets() changed to gethdrs()\n") }
proc gethdrs () { local ii,jj,kk,mm localobj o
if (numarg()==1) { // set the strings
o=new String("%s%c")
for ii=0,m-1 {
jj=ii%26 kk=int(ii/26)+1
for mm=1,kk sprint(s[ii].s,o.s,s[ii].s,65+jj)
}
}
for ii=0,m-1 printf("%s(%d) ",s[ii].s,ii)
}
//* selone(COL,VAL[,FLAG]) -- uses vec.selone when just working with one col and one value
func selone () { local val,niflag
if (numarg()==3) niflag=$3 else niflag=0 // use if searching repeatedly through same vec
tog("DB") // start at full db
if (argtype(1)==2) fl=fi($s1) else fl=$1
if (fl==-1) return
val=$2
// if (!v[fl].ismono) {printf("NQS selone: must sort on %s before using\n",s[fl].s) return -1}
if (niflag) ni=ind.slone(v[fl],val,ni) else ni=ind.slone(v[fl],val)
if (selcp) {
if (ind.size==0) {
if (verbose) printf("None selected\n")
} else {
out.ind.copy(ind)
aind()
cob=out
}
} else cob=this
return ind.size
}
//* ay() is an n-dim associative array with p return values
// a high-dim array would get/set based on eg aa[5][4][7][2][12] -> nq.ay(5,4,7,2,12).x
// an associative array could do same with non-numeric indices
// here if we have m cols can use any n of them as indices and rest are return values up to
// what a Union() can hold (2 strings, 2 objs, 2 doubles)
// if want to ignore one index can use OK as a globbing value
// for SET use an explicit set aa[5][4][7][2][12]=17 -> nq.ay(5,4,7,2,12,SET,17)
// select based on first n cols and always using EQU or SEQ
// gives more feel of an array -- assumes columns are IND0,IND1,...,VAL
// keys are SET to begin setting values, and OK to leave a value as is
// noninteger must be a set value
// eg XO=ncq.ay(SU,SU,AM,INC,SET,OK,List[35])
obfunc ay () { local a,b,i,j,na,flag,done,ix,nx,sx,ox localobj key,arg,o
if (numarg()==0) {
printf("ay(I0,I1 ...[SET,V1,V2 ...])\n") return o }
tog("DB") // start at full db
a=allocvecs(key,arg)
o=new Union()
na=numarg()
vlist.remove_all
ind.resize(v.size)
if (argtype(1)==1) for ii=0,$o1.size-1 {
key.append(EQU) arg.append($o1.x[ii],0) vlist.append(v[ii])
flag=0 j=b=$o1.size
if (numarg()>1) if ($2==SET) {i=3 flag=1}
} else {
for ({i=1 flag=0} ; i<=na && !flag; i+=1) {
if (argtype(i)==2) {
if (fcd.x[i-1]!=2){printf("sel ERRA: %d %d\n",fcd.x[i-1],argtype(i)) dealloc(a) return o}
for (j=0;j<fcds.count && !done;j+=1) if(strcmp(fcds.o(j).s,$si)==0) {
key.append(SEQ) arg.append(j,0) vlist.append(v[i-1]) done=1
}
if (!done) {printf("%s aq ERRE: %s not found in col %s\n",this,$si,s[i-1].s)
dealloc(a) return o }
} else if (argtype(i)==0) {
if ($i==SET) { flag=1 // this is a value to set
} else if ($i!=OK) { // ignore an OK
key.append(EQU) arg.append($i,0) vlist.append(v[i-1])
}
}
}
b=i-1 // will begin again here -- these are v[] indices hence 0- statt 1-offset
j=i-2 // have also had a SET arg to go behind
}
ind.slct(key,arg,vlist)
if (ind.size>1) { printf("%s ay ERRB: mult rows %d\n",this,ind.size) dealloc(a) return o }
if (ind.size==0) { printf("%s ay ERRBB: none selected\n",this) dealloc(a) return o }
ix=ind.x[0]
for (;i<=na && flag;{i+=1 j+=1}) { // set using the rest of the args
if (argtype(i)==0) if ($i==OK) continue // don't set this one
if (argtype(i)==2) if (strcmp($si,"")==0) continue // don't set this one
if (argtype(i)!=fcd.x[j]) {
printf("%s ay ERRC: %d %d %d\n",this,i,fcd.x[j],argtype(i)) dealloc(a) return o }
if (argtype(i)==0) { v[j].x[ix]=$i
} else if (argtype(i)==1) { set(j,ix,$oi) print $oi,ix
} else if (argtype(i)==2) { set(j,ix,$si)
} else {printf("%s ay ERRD: set %d not implemented\n",this,argtype(i)) dealloc(a) return o}
}
nx=sx=ox=-1
for (i=b;i<m;i+=1) { // return values -- only get one of each for now
j=getval(i,v[i].x[ix])
if (j==0 && nx<1) { o.x[(nx+=1)]=nval
} else if (j==2) {
if (sx==-1) o.s=sval else if (sx==0) o.t=sval
sx+=1
} else if (j==1 && ox<1) o.o[(ox+=1)]=oval
}
dealloc(a)
return o
}
//* select() -- based loosely on SQL select
func select () { local ii,i,tmp,tmp1,ret,isv,key,arg,vc,selcpsav,savind,union,not,rxpflg localobj o
if (numarg()==0) { out.cp(this,2) cob=out return v.size }
tog("DB") // start at full db
if (size(1)==-1) { printf("%s:select ERR0: cols not all same size\n",this) return -1 }
// key holds OPs; arg holds ARGs; vc holds COL NAMEs
key=arg=vc=allocvecs(3) arg+=1 vc+=2 // key is an operator, arg is args, vc is col#
selcpsav=selcp i=1 not=rxpflg=union=savind=0
tmplist.remove_all vlist.remove_all
if (argtype(i)==0) if ($1==-1) {selcp=0 i+=1} // else is a number identifying a vector
if (argtype(i)==2) { // check first string for &&, ||, !
if (strcmp($si,"&&")==0) { savind=1 union=0 i+=1
} else if (strcmp($si,"||")==0) { savind=1 union=1 i+=1
} else if (strcmp($si,"!")==0) { savind=0 not=1 i+=1
} else if (strcmp($si,"&&!")==0) {savind=1 not=1 i+=1
} else if (strcmp($si,"||!")==0) {savind=1 union=1 not=1 i+=1 }
} else if (argtype(i)==1) { i+=1
if (argtype(i)==1 && argtype(i+1)==1) { // 3 vectors in a row are preset info for slct()
if (numarg()!=3) { printf("%s:select ERR0: 3 vecs should be mso[key],mso[arg],cols\n",this)
dealloc(key) return -1 }
if ($o1.size!=$o3.size || $o1.size*2!=$o2.size) {
printf("%s:select ERR0c: size problem %d %d %d\n",this,$o1.size,$o2.size,$o3.size)
dealloc(key) return -1 }
i=4 // have sucked up all the args
mso[key].copy($o1) mso[arg].copy($o2)
for ii=0,$o3.size-1 vlist.append(v[$o3.x[ii]])
} else if (isobj($o1,"Vector")) { ind.copy($o1) savind=1 union=0 // assume &&
} else {
printf("%s:select ERR0a: first vec obj should be ind vector\n",this) dealloc(key) return -1 }
}
if (savind) scr.copy(ind) else scr.resize(0)
while (i<=numarg()) {
if (argtype(i)==2) {
if (strcmp($si,"IND_")==0) {
if ((vn=fi($si,"NOERR"))!=-3) {
printf("NQS:select() WARNING: IND_ is a reserved word: ?%s\n",s[vn].s) }
vn=-1e9 scr[1].indgen(0,v.size-1,1) tmplist.prepend(scr[1])
} else if ((vn=fi($si))<0) { dealloc(key) return -1 }
sstr=$si // save for join: use with "NAME",EQW,OTHER_NQS
} else if (argtype(i)==0) { vn=$i // can avoid repeated string search
if (vn<0 || vn>=m) {
printf("%s:select ERR0b: can't ident arg %d: %d\n",this,i,vn) dealloc(key) return -1}
sstr=s[vn].s
} else {printf("%s:select ERR1: arg %d should be col name or num\n",this,i) dealloc(key) return -1}
if (vn>=0) if (fcd.x[vn]==1) {
if (oform(fcdo.o(v[vn].x[0]))!=NOP) { // look at obj list
scr[1].resize(0)
for ii=0,v[vn].size-1 scr[1].append(oform(fcdo.o(v[vn].x[ii])))
vn=-1e9 tmplist.prepend(scr[1])
} else {
printf("NQS:select WARNING selecting on indices in an obj column: %d (?oform)\n",vn)
}
}
mso[vc].append(vn) i+=1
if (argtype(i)==0) {
if ((isv=isvarg($i))==-1) {
mso[key].append(EQU) // if arg2 is a regular number presume that op is EQU arg2
mso[arg].append($i,0)
i+=1
continue
} else { lk=$i }
} else if (argtype(i)==2) { isv=isvarg(lk=whvarg($si))
if (isv==-1) {
if (strcmp($si,"~")==0) {
mso[key].append(EBE) // approximately equal -- generate a range
i+=1
tmp=$i*(1-loose) tmp1=$i*(1+loose)
if (tmp<tmp1) mso[arg].append(tmp,tmp1) else mso[arg].append(tmp1,tmp)
i+=1
continue
} else {
printf("%s:select ERR1a: operator %s not recognized\n",this,$si) dealloc(key) return -1
}
}
} else {
printf("%s:select ERR2: arg should be symbolic (eg GTE, EQU ...) or string (eg '[)','<=') op \n",this,i)
dealloc(key) return -1
}
mso[key].append(lk) i+=1
// pick up ARGS
for ii=0,isv-1 {
if (argtype(i)==0) {
if (lk==EQV) {
if ($i<0 || $i>=m) printf("ERRQ\n") else {
mso[arg].append(0)
mso[vc].append($i)
}
} else mso[arg].append($i)
i+=1
} else if (argtype(i)==2) {
if (lk==EQV) { // look for a column id
vn=fi($si) // OPSYM exception
if (vn==-1) { printf("%s:select ERR2a EQV but what col?\n",this) dealloc(key) return -1 }
mso[arg].append(0)
mso[vc].append(vn) i+=1
} else if (lk==SEQ) {
mso[key].x[mso[key].size-1]=EQU
if (argtype(i)==1) oval=$oi else if (argtype(i)==2) sval=$si
mso[arg].append(ret=finval(vn,argtype(i),lk)) i+=1
} else if (lk==RXP) {
mso[key].x[mso[key].size-1]=EQW
mso[arg].append(0)
if (argtype(i)!=2) {printf("%s:select ERR2a1\n",this) dealloc(key) return -1}
if (rxpflg==1) {printf("%s:select ERR2a2: RXP twice\n",this) dealloc(key) return -1}
ret=tmplist.prepend(scr[2])
if (rxpstr(vn,$si,scr[2])==0) {
printf("%s:select WARNING: No RXP matches for %s\n",this,$si) }
mso[vc].append(-1e9) i+=1
} else {printf("%s:select ERR2b string arg needs EQV,SEQ or RXP?\n",this)
dealloc(key) return -1}
} else if (argtype(i)==1) {
if (lk>=EQW && lk<=EQX) { // pick up a vector
if (isobj($oi,"Vector")) {
mso[arg].append(0)
mso[vc].append(-i) i+=1
} else if (isobj($oi,"NQS")) {
mso[arg].append(0)
if ((tmp=$oi.fi(sstr,"NOERR"))!=-1) { // JOIN with output from other nqs
tmplist.prepend($oi.out.v[tmp])
} else {
o=$oi i+=1
if ((tmp=o.fi($si))==-1){printf("%s:select ERR2c: can't find %s in %s?\n",this,$si,o)
dealloc(key) return -1 }
tmplist.prepend(o.out.v[tmp])
}
mso[vc].append(-1e9) i+=1
} else { printf("%s:select ERR2c1: EQW/EQX needs Vec or NQS not %s?\n",this,$oi)
dealloc(key) return -1
}
} else { printf("%s:select ERR2d only EQW/EQX takes obj arg: %d:%d?\n",this,i,argtype(i))
dealloc(key) return -1}
} else {
whkey(lk,sstr) printf("%s:select ERR3 arg %d should be arg for %s",this,i,sstr)
dealloc(key) return -1
}
}
// args in wrong order - swap
if (isv==2) if (mso[arg].x[mso[arg].size-2]>mso[arg].x[mso[arg].size-1]) {
tmp=mso[arg].x[mso[arg].size-2]
mso[arg].x[mso[arg].size-2]=mso[arg].x[mso[arg].size-1]
mso[arg].x[mso[arg].size-1]=tmp
}
// pad so every OP sees 2 ARGS
for ii=0,2-isv-1 { mso[arg].append(0) }
}
ind.resize(v.size)
for ii=0,mso[vc].size-1 { vn=mso[vc].x[ii]
if (vn==-1e9) { // code for EQW case with NQS arg
vlist.append(tmplist.object(tmplist.count-1))
tmplist.remove(tmplist.count-1) // pop
} else if (vn<0) { i=-vn // code for EQV case where vector is in the arg list
vlist.append($oi)
} else vlist.append(v[vn])
}
if (tmplist.count!=0) { printf("NQS:select ERR5 %s.tmplist not empty\n",this) return -1 }
if (slorflag) { ind.slor(mso[key],mso[arg],vlist)
} else { ind.slct(mso[key],mso[arg],vlist) }
if (verbose==2) keylook(key) // look at the keys
if (not==1) complement() // ind->!ind
if (savind) {
if (union==1) {
scr.append(ind) scr.sort ind.resize(scr.size+ind.size)
ind.redundout(scr)
} else {
mso[key].resize(scr.size+ind.size)
mso[key].insct(scr,ind) ind.copy(mso[key]) }
}
ret=ind.size
if (selcp) {
out.ind.copy(ind)
if (ind.size==0) {
if (verbose) printf("None selected\n")
} else {
aind()
cob=out
}
} else cob=this
dealloc(key)
selcp=selcpsav
slorflag=0
return ret
}
//** keylook()
proc keylook () { local key,arg,vc,ii
if (numarg()==0) key=0 else key=$1
arg=key+1 vc=key+2
printf("slct(keys,args,cols)\n")
for ii=0,mso[key].size-1 {
whkey(mso[key].x[ii],tstr)
for jj=0,m-1 if (eqobj(v[jj],vlist.o(ii))) break
if (jj==m) jj=-1
printf("KEY: %s; ARGS: %g %g; COL: %d (%s)\n",\
tstr,mso[arg].x[2*ii],mso[arg].x[2*ii+1],jj,vlist.o(ii))
} // vlk(mso[key]) vlk(mso[arg])
}
//** selall()
proc selall () { local ii
if (numarg()==2) {
for ii=0,m-1 out.v[ii].where(v[ii],$s1,$2)
} else {
for ii=0,m-1 out.v[ii].where(v[ii],$s1,$2,$3)
}
tog("SEL")
}
//** complement() ind -> !ind
proc complement () { local a,b
a=b=allocvecs(2) b+=1
mso[a].indgen(0,size(1)-1,1)
mso[b].resize(mso[a].size)
mso[b].cull(mso[a],ind)
ind.copy(mso[b])
dealloc(a)
}
//** delect([NQS])
// move the selected rows from the out db [or other] back to the main db
// the assumption is that you have operated on some of the fields and now want to
// put the rows back
// ind must not have been altered since it will be used to replace the items
func delect () { local beg,ii,flag
scr.resize(v.size)
if (numarg()==1) flag=1 else flag=0
if (flag) {
if (m!=$o1.m){
printf("NQS:delect ERRa m mismatch: %s:%d vs %s:%d\n",this,m,$o1,$o1.m) return -1 }
ind.copy($o1.ind)
} else if (out.ind.size==0) { return 0
} else if (!out.ind.eq(ind) || ind.size!=out.v.size) {
printf("NQS:delect ERR ind size mismatch\n")
return -1
}
for (beg=0;beg<m;beg+=11) { // sindx() can only handle 11 vecs at a time
tmplist.remove_all vlist.remove_all
for ii=beg,beg+10 if (ii<m) tmplist.append(v[ii])
for ii=beg,beg+10 if (ii<m) if (flag) {
vlist.append($o1.v[ii])
} else {
vlist.append(out.v[ii])
}
ind.sindx(tmplist,vlist)
}
cob=this
return ind.size
}
//** isvarg() returns number of args an op takes or -1 if not symbolic OP
func isvarg () { local m,op // ADD NEW OPSYM CHECK
op=$1
for m=0,5 if (op<=EBE*(m+1) && op>=ALL*(m+1)) { op/=(m+1) break } // m is is field key 1-5
if (op<ALL) return -1 else if (op<GTH) return 0 else if (op<IBE) { return 1
} else if (op<=EBE) return 2 else return -1
}
//** fi(STR[,XO]) find the index for a particular string, can set a objref
// fi(STR,INDEX) return INDEXed value from that vector
// fi(STR,"NOERR") suppress error message
// fi(STR,"EXACT") string match
// fi(STR,"ALL") return vector of all indices that match regexp
func fi () { local num,flag,ii,ret,err,ext
if (refs==-1) if (isassigned(out)) { // calculate refs
// refs=sfunc.references(this,1)-1 // make sure 'this' is turned on
// printf("%d refs\n",refs)
}
ext=noerr=err=num=flag=all=0
if (numarg()>=2) if (argtype(2)==2) {
if (strcmp($s2,"NOERR")==0) noerr=1 // use "NOERR" string
if (strcmp($s2,"EXACT")==0) ext=1 // string match statt regexp
if (strcmp($s2,"ALL")==0) {all=1 $o3.resize(0)} // all regexp matches
}
for ii=0,m-1 if (strcmp(s[ii].s,$s1)==0) {flag=1 ret=ii break} // exact match
if (ext) if (flag) return ret else return -1
if (strcmp($s1,"scr")==0 || strcmp($s1,"SCR_")==0) {flag=1 ret=-2}
if (strcmp($s1,"IND_")==0) {flag=1 ret=-3}
if (!flag) for ii=0,m-1 { // make sure $s1 could be a regexp to avoid regexp error
if (sfunc.len($s1)<sfunc.len(s[ii].s) && !strm($s1,"[()]")) if (strm(s[ii].s,$s1)) {
if (num>=1) {
if (all) $o3.append(ii) else {
err=1
printf("%s fi ERR: regexp matches more than once: %d %s\n",this,ii,s[ii].s)
}
} else {
if (all) $o3.append(ii)
num+=1 ret=ii flag=1
}
}
}
if (err) printf("NQS WARNING; ambiguous regexp; fi() returning pointer for: %d %s\n",ret,s[ret].s)
if (flag) {
if (numarg()==2 && noerr==0) {
if (argtype(2)==1) {
if (ret==-2) $o2=scr else if (ret==-3) {printf("%s:fi ERRa copy what?\n",this) return ret
} else $o2=v[ret]
} else if (argtype(2)==0) {
if ($2<0 || $2>=v[ret].size) {
printf("%s:fi ERR index out of bounds: %d %d\n",this,$2,v[ret].size)
return -1
}
if (ret==-2) ret=scr.x[$2] else if (ret==-3) {printf("NQS:fi ERRb what?\n") return ret
} else ret=v[ret].x[$2]
} else { printf("%s:fi WARNING 2nd arg ignored\n",this) }
}
return ret
} else {
if (!noerr) printf("%s.fi() ERR '%s' not found\n",this,$s1)
return -1
}
}
//** find(STR) find the vector associated with a COL label
obfunc find () { local fl
if (eqobj(cob,out) && verbose) printf(" *Selected* ")
fl=fi($s1)
if (fl==-2) { return scr
} else if (fl==-3) { return ind
} else return cob.v[fl]
}
//** set("name",IND,VAL)
proc set () { local fl,ix,sel
sel=0
if (eqojt(cob,out)) { sel=1
if (verbose) printf("NQS set() WARNING: setting value in Selected db\n") }
if (argtype(1)==2) fl=fi($s1) else fl=$1
ix=$2
if (fl==-1) return
if (ix<0) ix=cob.v[fl].size+ix
// 2 LINE 'SET' MACRO
if (ix> cob.v[fl].size) { // nonexistent row
printf("%s set ERRA: col %s size %d<%d\n",this,s[fl].s,v[fl].size,ix) return
} else if (ix==cob.v[fl].size) { // single col expansion
if (sel) {printf("%s set() ERR: can't expand Selected db\n",this) return}
cob.v[fl].resize(ix+1)
}
if (argtype(3)==0) { cob.v[fl].x[ix]=$3
} else {
if (argtype(3)==1) oval=$o3 else if (argtype(3)==2) sval=$s3
cob.v[fl].x[ix]=newval(argtype(3),fl)
}
}
//** sets(IND,COLA,VAL[,COLB,VAL,...])
proc sets () { local fl,ix,i,sel,sz
sel=0 ix=$1
if (eqojt(cob,out)) { sel=1
if (verbose) printf("NQS set() WARNING: setting value in Selected db\n") }
if (ix>=cob.v.size){
printf("NQS sets ERRA: OOB %s: %d (size %d)\n",this,v[0].size,cob.v.size) return }
if (ix<0) ix=cob.v.size+ix
for i=2,numarg() {
if (argtype(i)==2) fl=fi($si) else fl=$i
if (fl==-1) return
i+=1
if (argtype(i)==0) { cob.v[fl].x[ix]=$i // shortcut
} else {
if (argtype(i)==1) oval=$oi else if (argtype(i)==2) sval=$si
cob.v[fl].x[ix]=newval(argtype(i),fl)
}
}
}
//** setcol("name",VEC)
// setcol(num,VEC)
// setcol(num,"name",VEC)
// setcol(num,"name",VEC,flag) // with flag==1 use pointer to vec instead of copying
proc setcol () { local fl,flag localobj vo
if (eqobj(cob,out) && verbose) {
printf("%s setcol() ERR: attempting to set column in Selected db\n",this)
return }
if (argtype(1)==2) fl=fi($s1) else fl=$1
if (fl==-1) return
if (v[fl].size!=0) { printf("%s setcol() ERR: clear() column before setting\n",this) return }
if (argtype(2)==2) s[fl].s=$s2 else { v[fl].copy($o2) return }
if (numarg()>=3) vo=$o3
if (numarg()>=4) flag=$4 else flag=0
if (flag) v[fl]=vo else v[fl].copy(vo)
}
//** setcols(VEC1,VEC2,...) -- does either pointer or copy depending on scpflag
// setcols(LIST) -- does either pointer or copy depending on scpflag
// see also resize("NAME",vec, ...) for similar functionality
scpflag=0
proc setcols () { local i,na,flag,sz
sz=na=numarg() flag=0
if (na==0) { scpflag=1-scpflag
if (scpflag) printf("setcols() will copy vecs\n") else {
printf("setcols() will use vec pointers\n") }
return
}
if (na==1 && isobj($o1,"List")) {flag=1 sz=$o1.count}
if (m==0) resize(sz)
if (eqobj(cob,out) && verbose) {
printf("%s setcols() ERR: attempting to set column in Selected db\n",this)
return }
if (na!=m) {
printf("%s setcols() ERR: need %d not %d args\n",this,m,na)
return }
if (flag) {
if (scpflag) for i=0,m-1 v[i].copy($o1.o(i)) else for i=0,m-1 v[i]=$o1.o(i)
} else if (scpflag) for i=1,m v[i-1].copy($oi) else for i=1,m v[i-1]=$oi
}
//** newval(typ,col#) -- check if a value is already on the list and if not put it there
// usuall preceded by eg:
// if (argtype(i)==0) nval=$i else if (argtype(i)==1) oval=$oi else if (argtype(i)==2) sval=$si
func newval () { local ret,typ,fl,ii localobj o
typ=$1 fl=$2
if (fcd.x[fl]!=typ && fcd.x[fl]!=-1) {
printf("nqs::newval() ERRa %d statt %d\n",typ,fcd.x[fl]) return ERR }
if (typ==0 || typ==-1) {
return nval
} else if (typ==1) { // object handling
if (! isassigned(oval)) return -1
if (isojt(oval,v)) { o=new Vector(oval.size) o.copy(oval)
} else if (isojt(oval,this)) { o=new NQS() o.cp(oval)
} else { printf("WARN: pointer to %s on %s fcdo\n",oval,this)
for (ii=0;ii<fcdo.count;ii+=1) if (eqojt(fcdo.object(ii),oval)) return ii // already on list?
o=oval
}
return fcdo.append(o)-1
} else if (typ==2) { // string handling
for (ii=0;ii<fcds.count;ii+=1) {
Xo=fcds.object(ii)
if (strcmp(Xo.s,sval)==0) return ii
}
return fcds.append(new String(sval))-1
}
}
//*** finval(col#,type,OP) find the location on list for an object or string
func finval () { local fl,typ,op,ii,ret
fl=$1 typ=$2 op=$3 ret=-1
if (fcd.x[fl]!=typ) { // doesn't handle fcd.x[]==-1
printf("nqs::finval ERRa type mismatch; %d %d\n",fcd.x[fl],typ) return ERR }
for ii=0,fcds.count-1 { Xo=fcds.object(ii)
if (typ==2) {
if (strcmp(Xo.s,sval)==0) return ii
} else {}
}
// if (ret==-1) printf("nqs::finval WARNING %s not found in string or object list\n",sval)
return ret
}
//*** rxpstr(col#,vec) find the location on list for an object
func rxpstr () { local fl
fl=$1 $o3.resize(0)
if (fcd.x[fl]!=2) {
printf("nqs::rxpstr ERRa type mismatch; %d %d\n",fcd.x[fl],2) return -1 }
for ii=0,fcds.count-1 if (strm(fcds.object(ii).s,$s2)) $o3.append(ii)
return $o3.size
}
//*** getval(col#,index) return type and value in nval,oval,sval as appropriate
// usually followed by eg
// if (typ==0) ... nval else if (typ==1) ... oval else if (typ==2) ... sval
func getval () { local typ,n,flag,fl,ix,ii
fl=$1 ix=$2 flag=0
typ=fcd.x[fl] // argtype
if (typ==0) {
nval=ix
} else if (typ==10) {
if (numarg()==3) nval=uncodf($3,ix) else {scr.resize(5) scr.uncode(ix)}
} else if (typ==1) { // object handling
if (ix>fcdo.count-1) {
printf("nqs::getval() ERR fcdo index OOB %d, %d\n",ix,fcdo.count) return ERR
} else if (ix<0) {
// printf("nqs::getval() WARNING empty obj ptr\n\t")
sval="nil"
typ=2
} else oval = fcdo.object(ix)
} else if (typ==2) { // string handling
if (ix==-1) {
sval="NULL"
} else if (ix<0 || ix>fcds.count-1) {
printf("nqs::getval() ERR index OOB %d, %d\n",ix,fcds.count) return ERR
} else sval=fcds.object(ix).s
} else if (typ==-1) { // string from external list
if (fcdl.count<=fl) {printf("%s getval ERRa\n",this) return -1}
if (! isobj(fcdl.object(fl),"List")) {printf("%s getval ERRb\n",this) return -1}
if (fcdl.object(fl).count<=ix) {printf("%s getval ERRc\n",this) return -1}
if (ix==-1) sval="XX" else {
if (!isobj(fcdl.object(fl).object(ix),"String")){printf("%s getval ERRd\n",this) return -1}
sval=fcdl.object(fl).object(ix).s
}
}
return typ
}
//*** useslist() connects a list of strings to fcdl to use when printing
// fcdl: list of lists to make it easy to attach lists from outside
proc useslist () { local fl,ii
if (argtype(1)==2) fl=fi($s1) else fl=$1
if (fl==-1) return
if (! isobj(fcdl,"List")) {fcdl=new List() out.fcdl=fcdl}
if (fcdl.count!=m) for ii=fcdl.count,m-1 fcdl.append(fcdl) // use fcdl as placeholder
fcdl.remove(fl) fcdl.insrt(fl,$o2) // replace:fcdl.object(fl)=$o2
fcd.x[fl]=-1
}
//*** unuselist() connects a list of strings to fcdl to use when printing
// fcdl: list of lists to make it easy to attach lists from outside
proc unuselist () { local fl,ii
if (argtype(1)==2) fl=fi($s1) else fl=$1
if (fl==-1) return
fcd.x[fl]=0
}
//*** listvecs([LIST]) put the vecs in the list for use with eg uncode()
proc listvecs () { local ii localobj ol
if (eqobj(cob,out) && verbose) printf(" *Selected* ")
if (numarg()>=1) ol=$o1 else ol=vl
if (!isassigned(ol)) { ol=new List()
if (numarg()>=1) $o1=ol else vl=ol }
ol.remove_all
for ii=0,m-1 ol.append(cob.v[ii])
}
//*** mat=tomat([MAT]) put the cols in cols of matrix
// mat=tomat(MAT,1) or mat=tomat(1) puts the cols in rows of matrix
obfunc tomat () { local ii,transpose,fo,sz localobj mat
if (eqobj(cob,out) && verbose) printf(" *Selected* ")
fo=transpose=0 sz=size(1)
if (numarg()>=1) {
if (argtype(1)==0) transpose=$1 else {mat=$o1 fo=1}
}
if (numarg()>=2) transpose=$2
if (!isassigned(mat)) {
if (transpose) mat=new Matrix(m,sz) else mat=new Matrix(sz,m)
if (fo) $o1=mat
} else {
if (transpose) mat.resize(m,sz) else mat.resize(sz,m)
}
if (transpose) {for ii=0,m-1 mat.setrow(ii,cob.v[ii])
} else for ii=0,m-1 mat.setcol(ii,cob.v[ii])
return mat
}
//*** frmat(MAT) gets cols from cols of matrix
// frmat(MAT,1) gets the cols from rows of matrix
proc frmat () { local ii,transpose,rows,cols localobj mat
if (eqobj(cob,out)) {printf("frmat() ERR cannot reset 'Selected' to matrix\n") return}
fo=transpose=0
mat=$o1
if (numarg()>=2) transpose=$2
rows=mat.nrow cols=mat.ncol
if (transpose) {
if (cols!=size(1)) pad(cols)
if (rows!=m) resize(rows)
for ii=0,m-1 mat.getrow(ii,cob.v[ii])
} else {
if (rows!=size(1)) pad(rows)
if (cols!=m) resize(cols)
for ii=0,m-1 mat.getcol(ii,cob.v[ii])
}
}
//*** prtval() use %g or %s to print values
proc prtval () { local i,typ,flag,otmp localobj f1
if (argtype(1)==0) {typ=$1 flag=0 i=2} else {f1=$o1 flag=1 typ=$2 i=3}
// oform() returns a double for printing an object
if (typ==1) if (isassigned(oval)) if ((otmp=oform(oval))!=NOP) {typ=0 nval=otmp}
if (typ==0) sstr=dblform else sstr=strform
if (numarg()==i) {
sprint(sstr,"%s%s",sstr,$si)
} else if (numarg()==i+1) {
sprint(sstr,"%s%s",$si,sstr) i+=1 sprint(sstr,"%s%s",sstr,$si)
}
if (flag) {
if (typ==0) { f1.printf(sstr,nval)
} else if (typ==1) { f1.printf(sstr,oval)
} else if (typ==2) { f1.printf(sstr,sval)
} else if (typ==10) { for ii=0,4 f1.printf("%d ",scr.x[ii])
} else if (typ==-1) { f1.printf(sstr,sval) } // special code for externally provided list
} else {
if (typ==0) { printf(sstr,nval)
} else if (typ==1) { printf(sstr,oval)
} else if (typ==2) { printf(sstr,sval)
} else if (typ==10) { for ii=0,4 printf("%d ",scr.x[ii])
} else if (typ==-1) { printf(sstr,sval) } // special code for externally provided list
}
}
//** get("name",[IND]]) if omit IND take ind from first ind.x[0]
obfunc get () { local ty,fl,ix,outf localobj lo
outf=0
if (argtype(1)==0) { fl=$1 sstr2=s[fl].s
} else if (argtype(1)==2) { fl=fi($s1) sstr2=$s1 }
if (fl==-1) { return lo }
if (eqobj(cob,out)) { outf=1
if (verbose) printf(" *Selected* ") }
if (numarg()==1) {
if (outf) ix=0 else ix=ind.x[0]
} else ix=$2
if (ix<0 || ix>=cob.v[fl].size) {
printf("%s::get ERR ix %d out of range for %s (%s)\n",this,ix,sstr2,cob) return lo }
ty=fcd.x[fl]
if (ty==0) {lo=new Union(cob.v[fl].x[ix]) if (numarg()==3) $&3=lo.x}
if (ty==1) {lo=new Union(fcdo,cob.v[fl].x[ix]) if (numarg()==3) $o3=lo.o}
if (ty==2) {lo=new Union(fcds,cob.v[fl].x[ix]) if (numarg()==3) $s3=lo.s}
if (ty==-1){lo=new Union(fcdl.object(fl),cob.v[fl].x[ix]) if (numarg()==3) $o3=lo.o}
return lo
}
//** fetch(COLA,VAL,COLB) does fast select where COLA is VAL and returns value in COLB
// fetch(COLA,VAL) return the row number
// only works with VAL as number
// ambiguity -- if 1,3 args can fetch from full db or selected else must do select first
func fetch () { local fl1,fl2,max,i localobj st,v0
if (eqobj(cob,out)) if (verbose) printf(" *Selected* ")
if (numarg()==1) {
if (argtype(1)==2) fl1=fi($s1) else fl1=$1
return cob.v[fl1].x[0]
} else if (numarg()==2) { // return the index
if (argtype(1)==2) fl1=fi($s1) else fl1=$1
if ((i=cob.v[fl1].indwhere("==",$2))<0){
printf("fetch ERR %d not found in %s\n",$2,s[fl1].s) return -1 }
return i
} else if (numarg()==3) {
if (argtype(1)==2) fl1=fi($s1) else fl1=$1
if (argtype(3)==2) fl2=fi($s3) else if (argtype(3)==0) fl2=$3 else {v0=$o3 fl2=-1}
if ((i=cob.v[fl1].indwhere("==",$2))<0) {
printf("fetch ERR %d not found in %s\n",$2,s[fl1].s) return -1 }
if (fl2>=0) return cob.v[fl2].x[i] else { // return row as a vector
v0.resize(0) for (ii=0;ii<m;ii+=1) v0.append(cob.v[ii].x[i])
return cob.v[0].x[i]
}
} else {
st=new String("select(-1,")
for i=1,numarg()-1 {
if (argtype(i)==0) sprint(st.s,"%s%g,",st.s,$i) else sprint(st.s,"%s\"%s\",",st.s,$si)
}
chop(st.s) sprint(st.s,"%s)",st.s)
execute(st.s,this)
i=numarg()
if (argtype(i)==0) fl2=$i else fl2=fi($si)
if (ind.size!=1) printf("NQS fetch WARNING -- %d lines found\n",ind.size)
if (ind.size>0) return v[fl2].x[ind.x[0]] else return -1
}
}
//** stat("COL","operation")
// stat("COL",VEC) // save into a vector: max,min,mean,sdev
// stat(NQS) // save all of them into another NQS
proc stat () { local i,vn
if (eqobj(cob,out) && verbose) printf(" *Selected* ")
if (numarg()==0) {
for i=0,m-1 { printf("%s:\t",s[i].s) stat(i) } // recursive call
return
}
if (argtype(1)==1) {
$o1.resize(5)
$o1.sethdrs("NAME","MAX","MIN","MEAN","SDEV")
$o1.strdec("NAME")
$o1.clear
for i=0,m-1 {
stat(i,scr[1]) // recursive call
$o1.append(scr[1],1)
$o1.set(0,i,s[i].s)
}
return
}
if (argtype(1)==0) vn=$1 else vn=fi($s1)
i=2
if (cob.size(1)<2) { printf("NQS:stat small NQS: %d\n",cob.size(1)) ok=0 } else ok=1
if (vn==-2) {
sprint(sstr2,"%s",cob.scr)
} else if (vn<0||vn>=m) {
return
} else if (fcd.x[vn]==10) {
scr[1].resize(cob.v.size)
field=$i i+=1
cob.v[vn].uncode(scr[1],field)
sprint(sstr2,"%s",scr[1])
} else if (fcd.x[vn]==1) { // looking at a list of vectors
//if (oform(v)==NOP){printf("%s:stat ERR: set oform() to do stats on vectors or nqs\n",this)return}
scr[1].resize(0)
for ii=0,cob.v[vn].size-1 scr[1].append(oform(fcdo.o(cob.v[vn].x[ii])))
sprint(sstr2,"%s",scr[1])
} else {
sprint(sstr2,"%s",cob.v[vn])
}
if (numarg()<i) {
sprint(sstr, "printf(\"max=%%g; \",%s.max) ",sstr2)
sprint(sstr,"%s printf(\"min=%%g; \",%s.min) ",sstr,sstr2)
if (ok) sprint(sstr,"%s printf(\"mean=%%g; \",%s.mean) ",sstr,sstr2)
if (ok) sprint(sstr,"%s printf(\"stdev=%%g; \",%s.stdev) ",sstr,sstr2)
execute(sstr)
print ""
} else if (argtype(i)==1) { // a vector
$oi.resize(0)
if (ok) {$oi.append(cob.v[vn].max,cob.v[vn].min,cob.v[vn].mean,cob.v[vn].stdev)
} else {$oi.append(cob.v[vn].max,cob.v[vn].min,cob.v[vn].min,0) }
} else if (!ok) { return
} else for (;i<=numarg();i+=1) {
if (strm($si,"[(][)]$")) {
sfunc.left($si,sfunc.len($si)-2)
sprint(sstr,"printf(\"%s()=%%g; \",%s(%s))",$si,$si,sstr2)
} else sprint(sstr,"printf(\"%s=%%g; \",%s.%s)",$si,sstr2,$si)
execute(sstr)
print ""
}
}
//** iterator it() iterates over columns
// set's global tstr and XO to string bzw vec
iterator it () { local ii
i2=0
for ii=0,m-1 {
XO=cob.v[ii] execstr=s[ii].s
iterator_statement
i2+=1
}
}
//** iterator ot() creates names for each col (same as col header) and goes through them all
iterator ot () { local i,na,val
if (! isobj(otl,"List")) { // create list to execute
otl=new List()
for i=0,m-1 {
Xo=new String(s[i].s)
if (fcd.x[i]==2) {
varstr(Xo.s,1)
sprint(Xo.s,"%s=%s.fcds.object(%s.cob.v[%d].x[i2]).s",Xo.s,this,this,i)
} else {
varstr(Xo.s)
sprint(Xo.s,"%s=%s.cob.v[%d].x[i2]",Xo.s,this,i)
}
otl.append(Xo)
}
Xo=nil
}
for (i2=0;i2<cob.v[0].size;i2+=1) {
for i=0,m-1 execute(otl.object(i).s)
iterator_statement
}
}
//** iterator qt(&x1,NAME1,&x2,NAME2,...)
// qt(&x1,NAME1,&x2,NAME2,...,&x)
// qt(&x1,NAME1,&x2,NAME2,...,5,7,&x) // just from 5 to 7
// qt(&x1,NAME1,&x2,NAME2,...,8) // ending at 8
// note &x arg location is opposite to that for ltr
// eg for sp.qt(&x,"PRID",&y,"POID",&z,"NC1",&ii,"WID1",&jj,"WT1") print x,y,z,ii,jj
// NB set qtset if resetting values
iterator qt () { local a,i,j,ii,na,val,noset,min,max,cntr localobj cols,cd
na=numarg()
a=allocvecs(cols,cd)
min=0 max=size(1)-1
if (argtype(na)==3) {i=cntr=na $&i=0 na-=1} else cntr=-1
if (argtype(na-1)==0) { // 2 values for min and max
i=na-1 min=$i i=na max=$i na-=2
}
if (na/2!=int(na/2)) { // odd number
if (argtype(na)==0) { i=na max=$i na-=1
} else {printf("%s::qt() needs even # of args\n",this) return }
}
if (eqobj(cob,out) && verbose) printf(" *Selected* ")
//*** pick up column numbers
for (i=2;i<=na;i+=2) {
if (argtype(i)!=2) val=$i else val=fi($si)
cols.append(val) // cols has col #s
if (val<0 || val>=m) { if (argtype(i)==2) printf("(%s)",$si)
printf("%s::qt() ERR %d not found\n",this,val) return }
}
cd.copy(fcd) // cd gives codes for col's
//*** pick up the arguments
for (i=1;i<=na;i+=2) {
// can't do iteration over externally defined strings (eg -1) see useslist()
if (cols.x[int(i/2)]<0) continue
if (cd.x[cols.x[int(i/2)]]!=0) {
if (argtype(i)==3) {
printf("NQS::qt() WARNING using list index statt str for col %s\n",s[cols.x[int(i/2)]].s)
cd.set(cols.x[int(i/2)],0)
}
}
if (cd.x[cols.x[int(i/2)]]==2 && argtype(i)!=2) {
printf("%s::qt() ERR %s is strdec but arg %d not string\n",this,s[cols.x[int(i/2)]].s,i) return }
if (cd.x[cols.x[int(i/2)]]==1 && argtype(i)!=1) {
printf("%s::qt() ERR %s is odec but arg %d not obj\n",this,s[cols.x[int(i/2)]].s,i) return }
}
//*** iterate through setting local variables to values in NQS
for (ii=min;ii<=max;ii+=1) {
for (i=1;i<=na;i+=2) { j=cols.x[int(i/2)]
if (cd.x[j]==0) {
$&i=cob.v[j].x[ii]
} else if (cd.x[j]==2) {
$si=fcds.object(cob.v[j].x[ii]).s
} else if (cd.x[j]==1) {
$oi=fcdo.object(cob.v[j].x[ii])
} else {
printf("%s qt ERRA: %d %d\n",this,i,j)
continue
}
}
// for i=0,m-1 qtv.x[i]=v[i].x[ii] // if want these values need a separate vector
iterator_statement
//*** if qtset -> iterate through resetting NQS according to changed variables
if (qtset) for (i=1;i<=na;i+=2) { j=cols.x[int(i/2)]
if (cd.x[j]==0) {
cob.v[j].x[ii]=$&i
} else if (cd.x[j]==2) {
fcds.object(cob.v[j].x[ii]).s=$si
} else if (cd.x[j]==1) {
if (!eqojt(fcdo.object(cob.v[j].x[ii]),$oi)) {
printf("%s qt ERRB: can't reassign obj: %d %s %s\n",this,\
i,fcdo.object(cob.v[j].x[ii]),$oi)
}
}
}
if (cntr>-1) {i=cntr $&i+=1}
}
dealloc(a)
qtset=0 // turn back off
}
//** iterator ut(&x1,NAME1,&x2,NAME2,...)
// ut(&x1,NAME1,&x2,NAME2,...,&x)
// ut(&x1,NAME1,&x2,NAME2,...,5,7,&x) // just from 5 to 7
// ut(&x1,NAME1,&x2,NAME2,...,8) // ending at 8
// note &x arg location is opposite to that for ltr
// eg for sp.ut(&x,"PRID",&y,"POID",&z,"NC1",&ii,"WID1",&jj,"WT1") print x,y,z,ii,jj
// NB set qtset if resetting values
iterator ut () { local a,i,j,ii,jj,na,val,noset,min,max,cntr localobj cols,cd
na=numarg()
a=allocvecs(cols,cd)
min=0 max=ind.size-1
if (argtype(na)==3) {i=cntr=na $&i=0 na-=1} else cntr=-1
if (argtype(na-1)==0) { // 2 values for min and max
i=na-1 min=$i i=na max=$i na-=2
}
if (na/2!=int(na/2)) { // odd number
if (argtype(na)==0) { i=na max=$i na-=1
} else {printf("%s::ut() needs even # of args\n",this) return }
}
if (eqobj(cob,out)) {printf("NQS WARNING: ut() called after full select(); switching\n")
cob=this }
//*** pick up column numbers
for (i=2;i<=na;i+=2) {
if (argtype(i)!=2) val=$i else val=fi($si)
cols.append(val) // cols has col #s
if (val<0 || val>=m) { if (argtype(i)==2) printf("(%s)",$si)
printf("%s::ut() ERR %d not found\n",this,val) return }
}
cd.copy(fcd) // cd gives codes for col's
//*** pick up the arguments
for (i=1;i<=na;i+=2) {
// can't do iteration over externally defined strings (eg -1) see useslist()
if (cols.x[int(i/2)]<0) continue
if (cd.x[cols.x[int(i/2)]]!=0) {
if (argtype(i)==3) {
printf("NQS::ut() WARNING using list index statt str for col %s\n",s[cols.x[int(i/2)]].s)
cd.set(cols.x[int(i/2)],0)
}
}
if (cd.x[cols.x[int(i/2)]]==2 && argtype(i)!=2) {
printf("%s::ut() ERR %s is strdec but arg %d not string\n",this,s[cols.x[int(i/2)]].s,i) return }
if (cd.x[cols.x[int(i/2)]]==1 && argtype(i)!=1) {
printf("%s::ut() ERR %s is odec but arg %d not obj\n",this,s[cols.x[int(i/2)]].s,i) return }
}
//*** iterate through setting local variables to values in NQS
for (jj=min;jj<=max;jj+=1) { ii=ind.x[jj]
for (i=1;i<=na;i+=2) { j=cols.x[int(i/2)]
if (cd.x[j]==0) {
$&i=cob.v[j].x[ii]
} else if (cd.x[j]==2) {
$si=fcds.object(cob.v[j].x[ii]).s
} else if (cd.x[j]==1) {
$oi=fcdo.object(cob.v[j].x[ii])
} else {
printf("%s ut ERRA: %d %d\n",this,i,j)
continue
}
}
iterator_statement
//*** if qtset -> iterate through resetting NQS according to changed variables
if (qtset) for (i=1;i<=na;i+=2) { j=cols.x[int(i/2)]
if (cd.x[j]==0) {
cob.v[j].x[ii]=$&i
} else if (cd.x[j]==2) {
fcds.object(cob.v[j].x[ii]).s=$si
} else if (cd.x[j]==1) {
if (!eqojt(fcdo.object(cob.v[j].x[ii]),$oi)) {
printf("%s ut ERRB: can't reassign obj: %d %s %s\n",this,\
i,fcdo.object(cob.v[j].x[ii]),$oi)
}
}
}
if (cntr>-1) {i=cntr $&i+=1}
}
dealloc(a)
qtset=0 // turn back off
}
//** iterator vt("proc",&x1,NAME1,&x2,NAME2,...)
proc vt () { local a,i,j,ii,na,val,noset,min,max,cntr localobj cols,cd,at
na=numarg()
a=allocvecs(cols,cd)
min=0 max=size(1)-1
if (argtype(na)==3) {i=cntr=na $&i=0 na-=1} else cntr=-1
if (argtype(na-1)==0) { // 2 values for min and max
i=na-1 min=$i i=na max=$i na-=2
}
if (na/2==int(na/2)) { // odd number
if (argtype(na)==0) { i=na max=$i na-=1
} else {printf("%s::vt() needs odd # of args\n",this) return }
}
if (eqobj(cob,out)) { printf(" vt() err: run .vt() on full set") return }
//*** pick up column numbers
for i=2,na {
if (argtype(i)!=2) val=$i else val=fi($si)
cols.append(val) // cols has col #s
if (val<0 || val>=m) { if (argtype(i)==2) printf("(%s)",$si)
printf("%s::vt() ERR %d not found\n",this,val) return }
if (fcd.x[val]!=0 && fcd.x[val]!=1) {
printf("%s::vt() ERR %d not handled (%d)\n",this,fcd.x[va],val) return }
}
//*** iterate through setting local variables to values in NQS
listvecs()
sprint(tstr,"%s.nqsvt(\"%s\",%s,%s,%s,%s)",cols,$s1,fcdo,fcd,vl,ind)
execute(tstr)
dealloc(a)
}
//** calc() spread-sheet functionality using vector functions
// takes a compound expression utilizing column names in slant brackets <>
// anything quoted can use either ' or \"
// eg sp.calc("<DIST>.c.mul(DELD).add(DEL)")
proc calc () { local ii,vn
if (numarg()==0) {
printf("eg calc(\"<SCR>.copy(<COL1>.c.mul(<COL2>).add(5))\") \ntakes a compound expression utilizing column names in slant brackets <>\nanything quoted can use either ' slash quote.\n")
return
} else sstr=$s1
if (eqobj(cob,out) && verbose) printf(" *Selected* ")
while (sfunc.tail(sstr,"<",sstr2)!=-1) {
sfunc.head(sstr2,">",sstr2)
if (strcmp(sstr2,"SCR")==0) {
sprint(sstr3,"%s",cob.scr)
} else if (isnum(sstr2)) {
sscanf(sstr2,"%d",&vn)
sprint(sstr3,"%s",cob.v[vn])
} else if ((vn=fi(sstr2))==-1) {
return // error
} else {
sprint(sstr3,"%s",cob.v[vn])
}
sprint(sstr2,"<%s>",sstr2)
repl_mstr(sstr,sstr2,sstr3,sstr4)
}
repl_mstr(sstr,"'","\"",sstr4)
execute(sstr)
}
//** sort () sort according to one index
func sort () { local beg,ii,vn
if (eqobj(cob,out) && verbose) printf(" *Selected* ")
if (argtype(1)==0) vn=$1 else vn=fi($s1)
if (vn<0||vn>=m) return -1
cob.v[vn].sortindex(cob.ind)
if (fcd.x[vn]==1) if (oform(v)!=NOP) { // looking at a list of vectors
scr.resize(0)
for ii=0,cob.v[vn].size-1 scr.append(oform(fcdo.o(cob.v[vn].x[ii])))
scr.sortindex(cob.ind)
}
if (numarg()==2) if ($2==-1) cob.ind.reverse
fewind()
return vn
}
//** percl ("FIELD",n %ile) check whether the first n% of the vector are in the top n %ile
// usage -- reverse sort according to 1 field and then ask if other field is in top n %ile
func percl () { local beg,ii,vn,nile,sz
if (eqobj(cob,out) && verbose) printf(" *Selected* ")
if (argtype(1)==0) vn=$1 else vn=fi($s1)
if (vn<0||vn>=m) return -1
sz=cob.v[vn].size
nile=int($2*sz/100)
scr[1].copy(cob.v[vn]) scr[1].sort() scr.resize(0) scr.copy(scr[1],sz-nile-1,sz-1)
scr.reverse() // the top n-ile percentile
scr[2].resize(0) scr[2].copy(cob.v[vn],0,nile) // the first set of values from NQS
// scr[1].insct(scr,scr[2]) // find all common values
for ii=0,scr[2].size-1 if (scr.contains(scr[2].x[ii])) return ii // which one is top of scr[2]
return -1
}
// family("COLA",val,"COLB","COLC")
// pick out rows that have are same as row with "COLA" val except that COLB COLC
// etc. can be anything
func family () { local a,i,ii,vn,va,nile,sz,om localobj key,arg
tog("DB") // start at full db
a=allocvecs(key,arg)
sz=size(1)
tmplist.remove_all arg.resize(0) key.resize(0)
if (select(-1,$s1,$2)!=1) printf("WARNING: NQS family found more than 1 %s=%g\n",$s1,$2)
va=fi($s1)
scr.resize(0) scr.append(va)
for i=3,numarg() scr.append(fi($si))
for i=0,m-1 if (! scr.contains(i)) {
tmplist.append(v[i])
key.append(EQU)
arg.append(v[i].x[ind.x[0]],0)
}
ind.resize(v.size)
ind.slct(key,arg,tmplist) // run select function
if (ind.size>0) {
out.ind.copy(ind)
aind()
cob=out
} else if (verbose) printf("None selected\n")
dealloc(a)
return ind.size
}
// psel(%ile,"COLA","COLB","COLC")
// psel("COLA",%ileA,"COLB",%ileB,"COLC",%ileC)
// neg %ile means bottom -- eg 10 is largest 10% and -10 is smallest 10%
// return top percentile in these columns
func psel () { local a,i,ii,vn,nile,sz,om localobj key,arg
tog("DB") // start at full db
a=allocvecs(key,arg)
om=numarg()-1
sz=size(1)
tmplist.remove_all arg.resize(0) key.resize(0)
if (argtype(1)==0) {
if (int($1*sz/100)==0) { printf("%s pselERR: unable %d%% of %d\n",this,$1,sz)
return -1 }
key.resize(om)
if ($1>0) {
nile=sz-int($1*sz/100)
key.fill(GTE)
} else {
nile=-int($1*sz/100)
key.fill(LTE)
}
for i=2,numarg() {
if (argtype(i)==0) vn=$i else vn=fi($si)
if (vn<0||vn>=m) return -1
tmplist.append(v[vn])
scr[1].copy(v[vn])
scr[1].sort()
arg.append(scr[1].x[nile],0) // 2nd arg for GTE ignored
printf("%s:%g ",$si,scr[1].x[nile])
}
} else for i=1,numarg() {
tstr=$si
vn=fi($si) i+=1
if (int($i*sz/100)==0) { printf("NQS psel(): WARNING: ignoring %d%% of %d\n",$i,sz)
continue }
if (vn<0||vn>=m) return -1
tmplist.append(v[vn])
scr[1].copy(v[vn])
scr[1].sort()
if ($i>0) {
nile=sz-int($i*sz/100)
key.append(GTE)
} else {
nile=-int($i*sz/100)
key.append(LTE)
}
arg.append(scr[1].x[nile],0) // 2nd arg for GTE ignored
printf("%s:%g ",tstr,scr[1].x[nile])
}
ind.resize(v.size)
ind.slct(key,arg,tmplist) // run select function
if (ind.size>0) {
out.ind.copy(ind)
aind()
cob=out
} else if (verbose) printf("None selected\n")
print ""
dealloc(a)
return ind.size
}
//** uniq(COLNAME) will pick out unique row (1st) for the chosen column
func uniq () { local vn
if (! eqobj(cob,out)) {printf("Only run NQS:uniq() on prior selected set.\n") return -1}
vn=sort($s1)
cob.ind.resize(cob.v.size)
cob.ind.redundout(cob.v[vn],1)
fewind()
return cob.ind.size
}
//** elimrepeats(COLA[,COLB,...])
func elimrepeats () { local a,b,i,ii,indflag localobj sl,tl,v1
if (eqobj(cob,out)) {printf("%s ERR: run elimrepeats on full db\n",this) return 0.}
if (size(1)==0) { printf("%s:elimirepeats Empty NQS\n",this) return 0.}
a=allocvecs(v1) b=1 indflag=0
sl=new List() tl=new List()
if (numarg()==0) {
for ii=0,m-1 { sl.append(v[ii]) v1.append(ii) }
b=numarg()+1
} else if (argtype(1)==0) if ($1==-1) {b=2 indflag=1}
for i=b,numarg() {
if (argtype(i)==0) ii=$i else if ((ii=fi($si))==-1) return 0
sl.append(v[ii])
v1.append(ii)
}
for ii=0,m-1 if (!v1.contains(ii)) tl.append(v[ii])
for (ii=v1.size-1;ii>=0;ii-=1) sort(v1.x[ii]) // sort them in the reverse order of calling
ii=ind.mredundout(sl,indflag,tl)
dealloc(a)
return ii
}
//** shuffle()
proc shuffle () { local a,b,i,ii,indflag localobj sl,tl,v1
if (eqobj(cob,out) && verbose) printf(" *Selected* ")
if (size(1)==0) { printf("%s:shuffle Empty NQS\n",this) return}
rdmord(ind,cob.v.size)
fewind()
}
//** fewind () -- index all of the vecs in place using vecst.mod::fewind()
proc fewind () {
cob.scr.resize(cob.v.size)
for (beg=0;beg<m;beg+=10) { // fewind() can only handle 10 vecs at a time
tmplist.remove_all
for ii=beg,beg+9 if (ii<m) tmplist.append(cob.v[ii])
cob.scr.fewind(cob.ind,tmplist)
}
cob.ind.resize(0) // prevents reusing it
}
//** aind () -- index all of the vecs into out list
proc aind () { local beg,ii
for (beg=0;beg<m;beg+=10) {
tmplist.remove_all vlist.remove_all
for ii=beg,beg+10 if (ii<m) {
out.v[ii].resize(ind.size)
tmplist.append(v[ii])
vlist.append(out.v[ii])
}
ind.findx(tmplist,vlist)
}
}
//** append(VEC[,begin]) appends to ends of given vectors
// append(x1,x2,...); append(NQS)
proc append () { local ii,jj,i,flag,begin,o1fcd localobj xo
cob=this
if (argtype(1)==1 && fcd.x[0]!=1) {
if (isobj($o1,"Vector")) { // a vector of values
if (numarg()>1) begin=$2 else begin=0
if (begin+$o1.size>m) {
printf("%s append ERR1: vec %s too large; doing nothing: %d>%d",this,$o1,begin+$o1.size,m)
} else {
for i=begin,begin+$o1.size-1 v[i].append($o1.x[i-begin])
}
} else if (isobj($o1,"NQS")) { // another NQS to add onto end
if ($o1.m != m) {
printf("%s append ERR1a, %s size %d!= %s size %d?\n",this,this,m,$o1,$o1.m)
return }
for ii=0,m-1 {
o1fcd=$o1.fcd.x[ii]
if (o1fcd==0) { v[ii].append($o1.cob.v[ii])
} else for jj=0,$o1.size(1)-1 {
xo=$o1.get(ii,jj)
if (o1fcd==1) oval=xo.o else sval=xo.s
v[ii].append(newval(o1fcd,ii))
}
}
} else { printf("%s append ERR1b, what is %s?\n",this,$o1) }
return
}
if (argtype(1)==2) if ((ii=fi($s1,"NOERR"))!=-1) { // a field name
for i=1,numarg() {
if ((ii=fi($si))==-1) return
i+=1
if (argtype(i)==0) {
v[ii].append($i)
} else {
if (argtype(i)==1) oval=$oi else if (argtype(i)==2) sval=$si
v[ii].append(newval(argtype(i),ii))
}
}
return
}
if (numarg()>m) { printf("%s append ERR2: args>m; doing nothing\n",this) return }
if (numarg()<=m) {
if (numarg()<m) printf("NQS::append() WARNING only filling %d/%d cols for %s\n\tuse NQS.pad",numarg(),m,this)
for ii=0,numarg()-1 {
i=ii+1
if (argtype(i)==0) {
v[ii].append($i)
} else {
if (argtype(i)==1) oval=$oi else if (argtype(i)==2) sval=$si
v[ii].append(newval(argtype(i),ii))
}
}
return
}
}
//** appi(index,VEC) or append(index,x1,x2,...) appends to ends of vectors starting at index
proc appi () { local i,ix,n
cob=this
if (argtype(1)==2) ix=fi($s1) else ix=$1
if (numarg()==2 && argtype(2)==1 && fcd.x[ix]==0) { // a vector
if ($o2.size>m-ix) {
printf("%s appi ERR1: vec too large; doing nothing %d %d %d %d\n",this,m,$o2.size,ix,m-ix)
} else {
n=-1
for i=ix,ix+$o2.size-1 v[i].append($o2.x[n+=1])
}
} else {
if (numarg()-1>m-ix) {
printf("%s appi ERR2: args>m; doing nothing",this)
return
}
for i=2,numarg() {
if (argtype(i)==0) {
v[ix+i-2].append($i)
} else {
if (argtype(i)==1) oval=$oi else if (argtype(i)==2) sval=$si
v[ix+i-2].append(newval(argtype(i),ix+i-2))
}
}
}
}
//** map(FUNC,arg1,...) map $s1 command to other args, replacing strings with vectors as found
// eg nqs.map("gg",0,"volt","cai",2)
proc map () { local i,agt,wf
if (numarg()==0) {
printf("map(FUNC,arg1,...) apply function to args using names for columns.\n")
return }
if (eqobj(cob,out) && verbose) printf(" *Selected* ")
sprint(sstr,"%s(",$s1) // the command
wf=0
for i=2,numarg() { // the args
agt=argtype(i)
if (agt==0) {
sprint(sstr,"%s%g,",sstr,$i)
} else if (agt==1) {
sprint(sstr,"%s%s,",sstr,$oi)
} else if (agt==2) {
if ((vn=fi($si))==-1) {
sprint(sstr,"%s\"%s\",",sstr,$si)
printf("NQS.map WARNING: including raw string: %s\n",$si) wf=1
} else if (fcd.x[vn]==1 && oform(v)!=NOP) { // look at a list of vectors
scr.resize(0)
for ii=0,v[vn].size-1 scr.append(oform(fcdo.o(cob.v[vn].x[ii])))
sprint(sstr,"%s%s,",sstr,cob.scr)
} else if (vn==-2) { // code for scr vector
sprint(sstr,"%s%s,",sstr,cob.scr)
} else {
sprint(sstr,"%s%s,",sstr,cob.v[vn])
}
} else { printf("argtype %d for arg %d not implemented for NQS:map\n",agt,i) return }
}
chop(sstr) sprint(sstr,"%s)",sstr)
if (wf && !batch_flag) if (boolean_dialog(sstr,"CANCEL","EXECUTE")) return
execute(sstr)
}
//*** gr() use map to graph
// need to assign .crosshair_action so can do visual select procedure
proc gr () { local i,nm,gn,col,lne,f3d,y,x,done localobj symb
nm=numarg() gn=0 f3d=-1
col=2 lne=4
done=0
if (sfunc.len(marksym)==0) marksym="o"
if (nm==0) { print "gr(\"Y\"[,\"X\",Z,g#,col,line])" return
} else if (nm==1) { map("gg",0,$s1,1,col,lne) done=1
} else if (nm==2) { map("gg",0,$s1,$s2,col,lne) done=1 }
i=3
if (! done) {
if (argtype(i)==2) f3d=fi($si) else i-=1
i+=1 if (i<=nm) gn=$i
i+=1 if (i<=nm) col=$i
i+=1 if (i<=nm) lne=$i
if (f3d!=-1) {
if (eqobj(cob,out) && verbose) printf(" *Selected* ")
if (!gvmarkflag) {printf("%s gr ERR: 3D and gvmarkflag=0\n",this) return}
y=fi($s1) x=fi($s2)
if (lne==1) lne=2 else lne-=2 // will augment below
if (x==-1 || y==-1) {printf("%s gr ERR: %s,%s not fi()\n",this,$s1,$s2) return}
for i=0,cob.v.size-1 {
if (i%9==0) lne+=2
g[gn].mark(cob.v[x].x[i],cob.v[y].x[i],marksym,lne,cob.v[f3d].x[i]%9+1,4)
}
} else map("gg",gn,$s1,$s2,col,lne)
}
g[gn].color(col)
// g[gn].label(0.05,0.95,$s1)
// if (nm>=2) g[gn].label(0.85,0.05,$s2)
g[gn].color(1)
if (numarg()>1) {
setgrsel(g[gn],fi($s1),fi($s2))
setchsel(g[gn],fi($s1),fi($s2))
}
}
//** grsel(): CTL-hit == Crosshair
// SHT-hit == resize
// hit-drag-release == show in square
// SHT-hit-drag-release == show new thing there
// Type: press (2), drag (1), release (3)
// Keystate: META-SHT-CTL eg 101=5 is META-CTL
proc setgrsel () {
$o1.menu_remove("Selector")
sprint(tstr,"proc p(){grsel($1,$2,$3,$4,%d,%d)}",$2,$3)
execute1(tstr,this)
$o1.menu_tool("Selector", "p")
}
proc setchsel () {
sprint(tstr,"proc q(){chsel($1,$2,$3,%d,%d)}",$2,$3)
execute1(tstr,this)
$o1.crosshair_action("q")
}
grsbegx=grsbegy=1e9
proc grsel () { local type, x0, y0, keystate, fl1,fl2,sel
type=$1 x0=$2 y0=$3 keystate=$4 fl1=$5 fl2=$6
if (type==3) {
if (grsbegx==1e9) { // no drag was done
if ((sel=select(fl2,"~",x0,fl1,"~",y0))!=0) {
pr()
} else print "Can't find ",s[fl2].s,"~ ",x0,s[fl1].s,"~ ",y0
} else { // consider a rectangle
order(&grsbegx,&x0) order(&grsbegy,&y0)
if ((sel=select(fl2,"[]",grsbegx,x0,fl1,"[]",grsbegy,y0))!=0) {
if (keystate==0) { grsel2()
} else if (keystate==3) { // CTL or SHIFT alone are being used by fvwm2
pr() // print grsbegx,x0,grsbegy,y0
}
} else printf("Can't find %s %g-%g; %s %g-%g\n",s[fl2].s,grsbegx,x0,s[fl1].s,grsbegy,y0)
grsbegx=grsbegy=1e9
}
} else if (type==1 && grsbegx==1e9) {grsbegx=x0 grsbegy=y0 }
}
// order(&x,&y) returns the values in order
proc order () { local tmp
if ($&2<$&1) { tmp=$&2 $&2=$&1 $&1=tmp }
}
proc chsel () { local ascii, x0, y0, fl1,fl2,sel
x0=$1 y0=$2 ascii=$3 fl1=$4 fl2=$5
if ((sel=select(fl2,"~",x0,fl1,"~",y0))!=0) {
if (ascii==32) { chsel2()
} else pr()
} else print "Can't find ",s[fl2].s,"~ ",x0,s[fl1].s,"~ ",y0
}
//** apply function or .op to every selected vector -- ignore return val, see applf
proc apply () { local i,fl
if (numarg()==0) {
printf("apply(FUNC,COL1,...) apply function or .op to every selected vector.\n")
printf("must be function, not proc, since will return value.\n")
return }
if (eqobj(cob,out) && verbose) printf(" *Selected* ")
if (numarg()==1) for i=0,m-1 { // apply to all vectors
if (strm($s1,"^\\.")) sprint(sstr,"%s%s" ,cob.v[i],$s1) else {
sprint(sstr,"%s(%s)",$s1,cob.v[i]) }
execute(sstr)
} else for i=2,numarg() {
if (argtype(i)==0) fl=$i else if ((fl=fi($si))==-1) return
if (fl==-2) sprint(sstr2,"%s",cob.scr) else sprint(sstr2,"%s",cob.v[fl])
if (strm($s1,"^\\.")) sprint(sstr,"%s%s" ,sstr2,$s1) else {
sprint(sstr,"%s(%s)",$s1,sstr2) }
execute(sstr)
}
}
//** applf(FUNC,COL) function or .op which returns a value
func applf () { local min,max,a,i,fl,ret,na,flag localobj v1,v2
na=numarg()
if (na==0) {
printf("applf(FUNC,'COLA'[,...,vec]) apply function or .op to selected cols.\n")
printf("applf(FUNC,vec) apply function or .op to all cols.\n")
printf("with more than one column need a final vector to copy results to\n")
printf("must use function, not proc, since will keep return value.\n")
return -1 }
a=allocvecs(v1,v2)
v1.resize(1)
if (eqobj(cob,out) && verbose) printf(" *Selected* ")
if (argtype(na)==1) {flag=na na-=1} else flag=0 // flag to copy onto an output vector
if (na==1) { min=0 max=m-1 } else { min=2 max=na }
for i=min,max {
if (na==1) { fl=i
} else {if (argtype(i)==0) fl=$i else if ((fl=fi($si))==-1) return -1}
if (fl==-2) sprint(sstr2,"%s",cob.scr) else sprint(sstr2,"%s",cob.v[fl])
if (strm($s1,"^\\.")) sprint(sstr,"%s.x[0]=%s%s" ,v1,sstr2,$s1) else {
sprint(sstr,"%s.x[0]=%s(%s)",v1,$s1,sstr2) }
execute(sstr)
v2.append(v1.x[0])
}
if (flag) {i=flag $oi.copy(v2)}
ret=v2.x[0]
dealloc(a)
return ret
}
//** fill(NAME,val[,NAME1,val1 ...])
// fill each selected vector with next arg
func fill () { local i,fl,fl2,x
if (numarg()==0) {
printf("fill(NAME,val[,NAME1,val1 ...])\n\tfill each selected vector with val\nval can be num, vector, or other col name\n")
return -1}
if (eqobj(cob,out) && verbose) printf(" *Selected* ")
for i=1,numarg() {
fl=fi($si) i+=1
if (fl==-1) return -1
field=0
if (fcd.x[fl]==10) { // code field
field=$i i+=1
}
if (argtype(i)==0) {
if (field>0) cob.v[fl].uncode(field,$i) else cob.v[fl].fill($i)
} else if (argtype(i)==1) {
if (!isobj($oi,"Vector")){
printf("%s:fill() ERRa: only fill with vector: %s\n",this,$oi) return -1}
if ($oi.size!=cob.v.size){
printf("%s:fill() ERRb: wrong vec size: %d!=%s:%d\n",this,cob.v.size,$oi,$oi.size) return -1}
if (field>0) cob.v[fl].uncode(field,$oi) else cob.v[fl].copy($oi)
} else if (argtype(i)==2) {
fl2=fi($si,"NOERR")
if (fl2== -1) { // add this string to this field?
if (fcd.x[fl]==2) {
sval=$si
x=newval(2,fl)
cob.v[fl].fill(x)
} else {
printf("%s:fill() ERRc: trying to fill field %s with string %s\n",this,s[fl].s,$si)
return -1
}
} else if (field>0) {
cob.v[fl].uncode(field,cob.v[fl2])
} else cob.v[fl].copy(cob.v[fl2])
i+=1
}
}
return cob.v[fl].size
}
//** fillin(NAME,val[,NAME1,val1 ...])
// fill in place according to indices in ind -- use with selcp==0
// can also do after a regular select() ie selcp==1 and avoid needing a delect
proc fillin () { local i,fl
if (numarg()==0) {
printf("fillin(NAME,val[,NAME1,val1 ...])\n\tfill selected vectors in place\n")
printf("\tuse after select(-1,...) eg selcp==0\n")
return
}
scr.resize(0)
for (i=2;i<=numarg();i+=2) scr.append($i)
tmplist.remove_all
for (i=1;i<=numarg();i+=2) {
if (argtype(i)==2) {
if ((fl=fi($si))==-1) return
} else fl=$i
tmplist.append(v[fl])
}
ind.sindv(tmplist,scr)
}
//** fillv(NAME,v1[,NAME1,v2 ...])
// fill from vectors v1,v2,..., places in ind -- use with selcp=0
proc fillv () { local i,fl
if (numarg()==0) {
printf("fillv(NAME,vec1[,NAME1,vec2 ...])\n\tfill selected vectors from vectors\n")
printf("\tuse after select() with selcp==0\n")
return
}
tmplist.remove_all vlist.remove_all
for (i=1;i<=numarg();i+=2) {
if (argtype(i)==2) {
if ((fl=fi($si))==-1) return
} else fl=$i
tmplist.append(v[fl])
}
for (i=2;i<=numarg();i+=2) vlist.append($oi)
ind.sindx(tmplist,vlist)
}
//** pr() print out vectors
// eg pr("COLA","COLB",3,7)
func pr () { local ii,i,min,max,na,flag,jj,e,fout,sz,nohdr
if (eqobj(cob,out) && verbose) printf(" *Selected* ")
if (m==0) {printf("%s EMPTY",this) return 0}
nohdr=flag=min=0 max=cob.v.size-1 na=numarg()
if (na>=2) {
if (argtype(na-1)==0) {
i=na na-=2
max=$i i-=1 min=$i
flag=1 // took care of numbers
}}
if (!flag && na>=1) {
if (argtype(na)==0) {
i=na na-=1
if ($i>=0) max=$i else min=max+$i // allow printing the end
}
}
// reuse flag -- means printing only certain cols
fout=flag=0 i=1 // fout==1 means print out to file
if (na>=1) if (argtype(1)==2) if (fi($s1,"NOERR")==-1) { // call it a file name
if (!tmpfile.wopen($s1)) printf("%s:Can't open %s for printing\n",this,$s1)
fout=1 i+=1
printf("==== WARNING: printing ascii to file %s ====\n",$s1)
if (numarg()==2) if (argtype(2)==2) if (strcmp($s2,"NOHEADER")==0) {nohdr=1 i+=1}
}
if (na>=i) if (argtype(i)==2 || argtype(i)==1) flag=1 // column names
if (max>size(1)){ max=size(1)-1
printf("NQS:pr WARNING: %d rows requested but %s size=%d\n",max,this,size(1)) }
if (min>size(1)){printf("NQS:pr ERROR: %s size=%d < min %d\n",this,size(1),min) return 0}
if (!fout) print ""
if (flag) {
scr[1].resize(0)
if (argtype(i)==1) scr[1].copy($oi) else for (;i<=na;i+=1) scr[1].append(fi($si))
sz=scr[1].size-1
if (!nohdr) { for i=0,sz {
ii=scr[1].x[i]
if (ii==-1) return -1
if (fout) {
if (ii<0) tmpfile.printf("%s\t",is[-ii].s) else tmpfile.printf("%s(%d)\t",s[ii].s,ii)
} else {
if (ii<0) printf("%s\t",is[-ii].s) else printf("%s(%d)\t",s[ii].s,ii)
}
} if (fout) tmpfile.printf("\n") else printf("\n") }
for jj=min,max {
for i=0,sz { ii=scr[1].x[i]
if (ii==-2) { printf(dblform,cob.scr.x[jj])
} else if (ii==-3) {
if (fout) tmpfile.printf(dblform,cob.ind.x[jj]) else printf(dblform,cob.ind.x[jj])
} else {
if (fout) { prtval(tmpfile,(e=getval(ii,cob.v[ii].x[jj])),tabform)
} else if (sz) { prtval( (e=getval(ii,cob.v[ii].x[jj])),tabform)
} else { prtval( (e=getval(ii,cob.v[ii].x[jj])),tabform) }
if (e==ERR) return ERR
}
}
if (fout) tmpfile.printf("\n") else if (sz) print "" else printf(" ")
}
} else {
if (!nohdr) {
if (fout) for ii=0,m-1 tmpfile.printf("%4.4s(%d) ",s[ii].s,ii) else {
for ii=0,m-1 printf("%4.4s(%d) ",s[ii].s,ii) }
if (fout) tmpfile.printf("\n") else print ""
}
for jj=min,max {
for ii=0,m-1 {
if (fout) prtval(tmpfile,e=getval(ii,cob.v[ii].x[jj]),tabform) else {
prtval( e=getval(ii,cob.v[ii].x[jj]),"")
printf("(%d)%s",ii,tabform)
}
if (e==ERR) return ERR
}
if (fout) tmpfile.printf("\n") else print ""
}
}
if (fout) tmpfile.close
return max-min+1
}
//** prs() print out vectors
// eg prs("COLA","COLB",3,7)
func prs () { local ii,i,min,max,na,flag,jj,kk,e,fout,sz,nohdr
if (eqobj(cob,out)) printf("NQS WARNING: prs() called after full select(); switching\n")
cob=this
if (m==0) {printf("%s EMPTY",this) return 0}
nohdr=flag=min=0 max=ind.size-1 na=numarg()
if (na>=2) {
if (argtype(na-1)==0) {
i=na na-=2
max=$i i-=1 min=$i
flag=1 // took care of numbers
}}
if (!flag && na>=1) {
if (argtype(na)==0) {
i=na na-=1
if ($i>=0) max=$i else min=max+$i // allow printing the end
}
}
// reuse flag -- means printing only certain cols
fout=flag=0 i=1 // fout==1 means print out to file
if (na>=1) if (argtype(1)==2) if (fi($s1,"NOERR")==-1) { // call it a file name
if (!tmpfile.wopen($s1)) printf("%s:Can't open %s for printing\n",this,$s1)
fout=1 i+=1
printf("==== WARNING: printing ascii to file %s ====\n",$s1)
if (numarg()==2) if (argtype(2)==2) if (strcmp($s2,"NOHEADER")==0) {nohdr=1 i+=1}
}
if (na>=i) if (argtype(i)==2 || argtype(i)==1) flag=1 // column names
if (max>ind.size()){ max=ind.size()-1
printf("NQS:prs WARNING: %d rows requested but %s size=%d\n",max,this,ind.size()) }
if (min>size(1)){printf("NQS:prs ERROR: %s size=%d < min %d\n",this,size(1),min) return 0}
if (!fout) print ""
if (flag) {
scr[1].resize(0)
if (argtype(i)==1) scr[1].copy($oi) else for (;i<=na;i+=1) scr[1].append(fi($si))
sz=scr[1].size-1
if (!nohdr) { for i=0,sz {
ii=scr[1].x[i]
if (ii==-1) return -1
if (fout) {
if (ii<0) tmpfile.printf("%s\t",is[-ii].s) else tmpfile.printf("%s(%d)\t",s[ii].s,ii)
} else {
if (ii<0) printf("%s\t",is[-ii].s) else printf("%s(%d)\t",s[ii].s,ii)
}
} if (fout) tmpfile.printf("\n") else printf("\n") }
for kk=min,max { jj=ind.x[kk]
for i=0,sz { ii=scr[1].x[i]
if (ii==-2) { printf(dblform,cob.scr.x[jj])
} else if (ii==-3) {
if (fout) tmpfile.printf(dblform,cob.ind.x[jj]) else printf(dblform,cob.ind.x[jj])
} else {
if (fout) { prtval(tmpfile,(e=getval(ii,cob.v[ii].x[jj])),tabform)
} else if (sz) { prtval( (e=getval(ii,cob.v[ii].x[jj])),tabform)
} else { prtval( (e=getval(ii,cob.v[ii].x[jj])),tabform) }
if (e==ERR) return ERR
}
}
if (fout) tmpfile.printf("\n") else if (sz) print "" else printf(" ")
}
} else {
if (!nohdr) {
if (fout) for ii=0,m-1 tmpfile.printf("%4.4s(%d) ",s[ii].s,ii) else {
for ii=0,m-1 printf("%4.4s(%d) ",s[ii].s,ii) }
if (fout) tmpfile.printf("\n") else print ""
}
for kk=min,max { jj=ind.x[kk]
for ii=0,m-1 {
if (fout) prtval(tmpfile,e=getval(ii,cob.v[ii].x[jj]),tabform) else {
prtval( e=getval(ii,cob.v[ii].x[jj]),"")
printf("(%d)%s",ii,tabform)
}
if (e==ERR) return ERR
}
if (fout) tmpfile.printf("\n") else print ""
}
}
if (fout) tmpfile.close
return max-min+1
}
//** prn() print out single index from vectors
proc prn () { local jj,ii,ix,max,e
ix=$1
if (eqobj(cob,out) && verbose) printf(" *Selected* ")
if (numarg()==2) max=$2 else max=ix
for jj=ix,max {
if (jj<0 || jj>=cob.v[0].size) {
printf("prn: Index out of range (%d)\n",cob.v[0].size) return }
for ii=0,m-1 {
printf("%s:",s[ii].s)
prtval(e=getval(ii,cob.v[ii].x[jj])," ")
if (e==ERR) return
}
print ""
}
}
//** zvec() -- clear -- resize all the vectors to 0
proc clear () { if (numarg()==1) zvec($1) else zvec() }
proc zvec () { local ii
cob=this
// fcds.remove_all fcds.append(new String("`EMPTY'"))
if (isassigned(fcdo)) fcdo.remove_all
for ii=0,m-1 {
if (numarg()==1) { v[ii].resize($1) v[ii].fill(0) }// resize the buffer if desirable
v[ii].resize(0)
}
}
//** pad() -- bring all vectors up to same length (of v[0])
func pad () { local sz,ii
cob=this
sz=-1
if (numarg()==1) sz=$1 else for ii=0,m-1 if (v[ii].size>sz) sz=v[ii].size
for ii=0,m-1 {
// if (v[ii].size>sz) printf("NQS.pad WARNING: neg padding %d\n",ii)
v[ii].resize(sz)
}
return sz
}
//** size() -- return num of vectors and size of each vector
func size () { local ii,sz,fl
if (eqobj(cob,out) && verbose) printf(" *Selected* ")
if (m==0) { print "0 x 0" return 0 } // empty
sz=cob.v.size
fl=0
for ii=1,m-1 if (cob.v[ii].size!=sz) fl=ii
if (numarg()==1) { // with 1 arg don't print anything
if (fl) {
printf("%s size ERR: cols are not same length: %s:%d %d\n",this,s[fl].s,cob.v[fl].size,sz)
sz=-1 } // generate err
return sz
}
printf("%d cols x %d rows",m,cob.v.size)
if (fl) for ii=1,m-1 printf(",%d",cob.v[ii].size)
print ""
return cob.v.size
}
//** resize(#cols[,#rows]) -- augment or dec the number of vectors
// resize("LABEL1","LABEL2",...)
// resize("LABEL1",VEC1,"LABEL2",VEC2) ... put on some vecs of same size
// resize("COL1","COL2"...) if these col names already exist just make a new copy of col
// resize(NQS) -- a horizontal 'append'
func resize () { local oldsz,newsz,i,ii,jj,vsz,na,appfl,o1m,padfl
cob=this padfl=0
na=numarg()
vsz=-1
if (argtype(na)==2) { i=na
if (strcmp($si,"PAD")==0) { padfl=1 na-=1 }
}
if (na==1) {
if (argtype(1)==0) {
appfl=0
if ($1<0) newsz=m+$1 else newsz=$1
} else if (argtype(1)==2) {
newsz=m+1 appfl=2
} else if (argtype(1)==1) { // an NQS
if (size(1)!=$o1.size(1)) {
printf("NQS resize(NQS) warning: rows differ %d %d\n",size(1),$o1.size(1))}
o1m=$o1.m
newsz=m+o1m
appfl=3
}
} else {
if (argtype(1)==0 && argtype(2)==0) {
newsz=$1 appfl=0
vsz=$2
} else if (argtype(1)==2 && argtype(2)==2) {
newsz=m+na appfl=2
} else {
if (int(na/2)!=na/2) { printf("%s Resize ERR: require even # of args",this) return -1}
newsz=m+numarg()/2
appfl=1
}
}
oldsz=m
if (m==newsz) { printf("No resize -- same size: %s\n",this)
return m
} else if (newsz>m) {
tmplist.remove_all vlist.remove_all
for ii=0,m-1 {
tmplist.append(v[ii]) tmplist.append(s[ii])
tmplist.append(out.v[ii])
}
objref v[newsz],s[newsz]
if (isassigned(out)) out.resize2(newsz) // create vectors for .out
jj=-1
for ii=0,m-1 {
v[ii]=tmplist.object(jj+=1) out.s[ii]=s[ii]=tmplist.object(jj+=1)
out.v[ii]=tmplist.object(jj+=1)
}
for ii=m,newsz-1 {
v[ii]=new Vector() out.s[ii]=s[ii]=new String()
out.v[ii]=new Vector()
}
out.m=m=newsz
tmplist.remove_all
} else {
for (ii=m-1;ii>=newsz;ii-=1) { out.v[ii]=v[ii]=nil out.s[ii]=s[ii]=nil }
out.m=m=newsz
}
x.resize(m) x.fill(0) fcd.resize(m)
out.x.resize(m) out.x.fill(0) out.fcd=fcd
if (vsz>=1) for ii=0,m-1 v[ii].resize(vsz)
if (appfl==1) { // append
for (ii=1;ii<=na;ii+=2) { i=ii
if (argtype(i)!=2) { printf("%s RESIZE ERR: arg %d should be str\n",this,i) return -1}
s[oldsz+(ii-1)/2].s=$si i+=1
if (argtype(i)==0) {
if ($i>0) v[oldsz+(ii-1)/2].resize($i)
} else if (argtype(i)==1) {
v[oldsz+(ii-1)/2].copy($oi)
} else { printf("%s RESIZE ERR2: arg %d should be num or obj\n",this,i) return -1}
}
} else if (appfl==2) {
for (i=1;i<=na;i+=1) {
if (argtype(i)!=2) { printf("%s RESIZE ERR3: arg %d should be str\n",this,i) return -1}
tstr=$si
if ((jj=fi(tstr,"EXACT"))!=-1) {
while (fi(tstr,"EXACT")!=-1) sprint(tstr,"%s0",tstr) // find unique name
}
s[oldsz+i-1].s=tstr
if (jj>=0) { printf("Resize copying Col %s to %s\n",$si,tstr) v[oldsz+i-1].copy(v[jj]) }
}
} else if (appfl==3) {
for i=0,o1m-1 {
tstr=$o1.s[i].s
while (fi(tstr,"NOERR")!=-1) sprint(tstr,"%s0",tstr)
s[oldsz+i].s=tstr
v[oldsz+i].copy($o1.v[i])
}
}
chk()
if (padfl) pad()
cob=this
return m
}
// for resizing the vector for .out
proc resize2 () { local newsz
newsz=$1
objref v[newsz],s[newsz]
}
// grow(NQS) append NQS of same size to this one
func grow () { local ii
if (m==0) { cp($o1)
} else if (m!=$o1.m) { printf("%s,%s off different size: %d %d\n",this,$o1,m,$o1.m) return 0
} else if (eqobj(cob,out)) {printf("%s ERR: run grow on full db\n",this) return 0.
} else for ii=0,m-1 v[ii].append($o1.v[ii])
return v.size
}
//** keepcols("LABEL1",...)
func keepcols () { local i,fl
scr.resize(0)
for i=1,numarg() {
if (argtype(i)==2) {
if ((fl=fi($si))==-1) return -1
} else fl=$i
scr.append(fl)
}
for (i=m-1;i>=0;i-=1) if (! scr.contains(i)) delcol(i)
return m
}
//** delcol("LABEL1"[,"LABEL2",...])
func delcol () { local ii,i
tog("DB") // start at full db
for i=1,numarg() {
if (argtype(i)==2) { if ((fl=fi($si))==-1) return -1 } else fl=$i
for (ii=fl;ii<m-1;ii+=1) {
v[ii]=v[ii+1] s[ii]=s[ii+1]
out.s[ii]=s[ii+1]
}
v[m-1]=nil s[m-1]=nil
out.v[m-1]=nil out.s[m-1]=nil
x.remove(fl) fcd.remove(fl)
if (isobj(fcdl,"List")) fcdl.remove(fl)
m -= 1
}
out.m=m
return m
}
//** delrow(#)
func delrow () { local ii,jj,kk
if (numarg()==1) {
if (eqobj(cob,out) && verbose) printf(" *Selected* ")
kk=$1
if (kk<0 || kk>=cob.v.size) {printf("delrow %d OOR (%d)\n",kk,cob.v.size-1) return -1}
for ii=0,m-1 cob.v[ii].remove(kk)
} else { // remove selected
tog("DB")
if (ind.size>1) {
sprint(sstr,"Remove %d rows from main table?",ind.size)
if (!boolean_dialog(sstr,"OK","Cancel")) { print "Cancelled" return -1 }
}
for ii=0,m-1 for (jj=ind.size-1;jj>=0;jj-=1) { kk=ind.x[jj]
v[ii].remove(kk)
}
}
return v.size
}
//** getrow(#,VEC)
obfunc getrow () { local ii localobj v1
if (eqobj(cob,out) && verbose) printf(" *Selected* ")
if (numarg()==2) v1=$o2 else v1=new Vector()
v1.resize(0)
for (ii=0;ii<m;ii+=1) v1.append(cob.v[ii].x[$1])
return v1
}
//** getcol("name") getcol("name",1) returns pointer
// getcol("name"[,VEC]) copies to VEC
// getcol("name",0) -- copies to new vector and returns it
obfunc getcol () { local fl localobj v1
if (eqobj(cob,out) && verbose) printf(" *Selected* ")
if (argtype(1)==2) fl=fi($s1) else fl=$1
if (fl==-1) return v1
if (numarg()<2) { // default returns copy
return cob.v[fl] // return pointer
} else if (argtype(2)==1) { // copy into a preexisting vector
$o2.copy(cob.v[fl])
return $o2
} else if ($2==1) {
return cob.v[fl] // return pointer
} else if ($2==0) {
v1=new Vector()
v1.copy(cob.v[fl])
return v1
}
}
//** getsel("name"[,vec]) returns the select(-1,...) values
obfunc getsel () { local ii,fl localobj v1
if (eqobj(cob,out)) printf("NQS WARNING: getsel() called after full select()\n")
if (argtype(1)==2) fl=fi($s1) else fl=$1
if (fl==-1) return v1
if (numarg()<2) v1=new Vector(ind.size) else {v1=$o2 v1.resize(ind.size)}
for ii=0,ind.size-1 v1.x[ii]=v[fl].x[ind.x[ii]]
return v1
}
//** renamecol("LABEL1","NEWNAME") -- rename column
func renamecol () { local oldsz
if (argtype(1)==2) {
if ((fl=fi($s1))==-1) return 1
} else fl=$1
s[fl].s=$s2
out.s[fl].s=$s2
return 1
}
//** renamecols("LABEL1","LABEL2"...) -- rename all column
proc renamecols () { local oldsz,i
if (numarg()<m) printf("Renaming only %d/%d cols\n",numarg(),m)
for i=1,numarg() s[i-1].s=$si
}
//** sv(FNAME[,APPEND]) save the NQS
// to sv selected -- NQS.select(...) NQS.cp(NQS.out,1) NQS.sv()
proc sv () { local i,j,cd1,vers,a,aflag
aflag=cd1=0 // flags cd1=1 -- no single value vec compression;
if (eqobj(cob,out) && verbose) printf("==== WARNING: Saving selected only ====\n")
a=allocvecs(1)
if (numarg()>0) file=$s1 else aflag=2
if (numarg()>=2) aflag=$2
if (numarg()>=3) cd1=$3 // 1:flag for not compressing
if (aflag==2) { // will just continue saving in the current file
} else if (aflag==1) { tmpfile.aopen(file)
} else {
if (tmpfile.ropen(file)) {
if (batch_flag) {
printf("NQS sv WARNING overwriting %s\n",file)
} else if (!boolean_dialog("File exists","Overwrite","Cancel")) {
print "Cancelled" return
}
}
if (! tmpfile.wopen(file)) { printf("%s: can't open file\n",this) return }
}
mso[a].resize(m) mso[a].fill(0)
// will be saved without full vectors
if (cd1==0) for i=0,m-1 if (cob.v[i].ismono(0) && cob.v[i].size>10) {
cd1=2 // 2 flag for using compression
mso[a].x[i]=1
}
if (isassigned(fcdo)) foc=fcdo.count else foc=-1
vers=version(1) // will assist for identifying file type if change format in future
savenums(m,fcds.count,(cnt=fcd.count(-1)),foc,size(1),cd1,vers,0,0) // extra for codes
wrvstr(file) wrvstr(comment)
for i=0,m-1 wrvstr(s[i].s)
fcd.vwrite(tmpfile)
for i=0,fcds.count-1 wrvstr(fcds.object(i).s)
for i=0,foc-1 {
if (isojt(fcdo.object(i),v)) {
fspitchar(1,tmpfile) // 1 for vector
fcdo.o(i).vwrite(tmpfile)
} else if (isojt(fcdo.object(i),this)) {
fspitchar(2,tmpfile) // 2 for NQS
fcdo.o(i).sv()
} else {
printf("NQS:sv() WARNING: Can't save obj %s for %s\n",fcdo.o(i),this)
fspitchar(0,tmpfile) // 0 for nil
}
}
if (cnt>0) for i=0,fcd.size-1 if (fcd.x[i]==-1) {
savenums(fcdl.object(i).count)
for j=0,fcdl.object(i).count-1 wrvstr(fcdl.object(i).object(j).s)
}
for i=0,m-1 {
if (cd1==2 && mso[a].x[i]==1) {
savenums(-1e9,cob.v[i].size,cob.v[i].x[0])
} else if (fcd.x[i]==10) {
cob.v[i].vwrite(tmpfile,4) // must save CODE fully
} else {
cob.v[i].vwrite(tmpfile,svsetting)
}
}
x.vwrite(tmpfile)
if (! aflag==2) tmpfile.close
dealloc(a)
}
//** rd(FNAME[,FLAG]) read format saved by sv()
// flag==2 - only read header
func rd () { local n,hflag,cd1,cd3,cd4,ii,oco
hflag=0 cob=this
if (numarg()>=1) if (argtype(1)==2) {
if (!tmpfile.ropen($s1)) { printf("%s: can't open file %s\n",this,$s1) return 0 }
} // else continue reading from current point in file
if (numarg()>=2) hflag=$2 // only read header
cnt=fc=foc=0
// backward compatible -- if only 2 vals then cnt=0, cd1-4 unused at present
n=readnums(&ii,&fc,&cnt,&foc,&v0sz,&cd1,&svvers,&cd3,&cd4)
if (n<9) v0sz=cd1=svvers=cd3=cd4=-1
if (cd1==2 && hflag==1) printf("NQSrdWARN0: can't do partial reads on compressed: %s\n",$s1)
if (ii!=m) resize(ii)
rdvstr(file) rdvstr(comment)
if (sfunc.len(file)==0 && numarg()>0) file=$s1
for i=0,m-1 rdvstr(s[i].s)
fcd.vread(tmpfile)
fcds.remove_all
if (isassigned(fcdl)) fcdl.remove_all
for i=0,fc-1 { fcds.append(Xo=new String()) rdvstr(Xo.s) }
if (foc>=0) { fcdo=new List() out.fcdo=fcdo }
for i=0,foc-1 {
oco=fgchar(tmpfile)
if (oco==1) {
fcdo.append(Xo=new Vector())
Xo.vread(tmpfile)
} else if (oco==2) {
fcdo.append(Xo=new NQS())
Xo.rd()
} else if (oco==0) {
printf("NQS:rd() WARNING: Nil being read for %s\n",this)
} else {
printf("NQS:rd() ERROR: unrecognized char %d for %s\n",oco,this)
}
}
if (cnt>0) for i=0,fcd.size-1 if (fcd.x[i]==-1) {
readnums(&cnt)
Yo=new List()
for j=0,cnt-1 {Xo=new String() Yo.append(Xo) rdvstr(Xo.s)}
useslist(i,Yo)
}
if (hflag==1) { // v0sz will tell size of all vectors
tell=tmpfile.tell
tmpfile.seek(0,2)
tellend=tmpfile.tell()
if (v0sz==-1) printf("%s: rd header: can't do seeks since v's not same size:%s\n",this,file)
return v0sz
} else {
v0sz=-1 // indicates that everything has been read in
for i=0,m-1 {
v[i].vread(tmpfile)
if (v[i].size>2) if (v[i].x[0]==-1e9) {
ii=v[i].x[2]
v[i].resize(v[i].x[1])
v[i].fill(ii)
}
}
x.vread(tmpfile)
}
if (foc==0) for ii=0,fcd.size-1 if (fcd.x[ii]==1) v[ii].fill(-1) // clear obj pointers
out.cp(this,0) // leave vectors empty
chk()
return 1
}
//** rdpiece() read a section of each vector
func rdpiece () { local ii,ix,end,jump,loc,bswap
ix=$1
if (numarg()>=2) bswap=$2 else bswap=0
tmpfile.seek(tell+8) // start of first one
if (ix<0) {printf("%s:rdpiece ERR: no room: neg index\n",this) return 0}
if (ix*chunk>v0sz) return 0
if ((ix+1)*chunk>v0sz) end=v0sz-ix*chunk else end=chunk
for ii=0,m-1 {
loc=tell+8+ii*(v0sz*4+8)+ix*4*chunk
tmpfile.seek(loc)
if (loc+end*4>tellend){printf("%s:rdpiece ERRA: ran out: %d %d",this,loc+end,tellend) return 0}
v[ii].fread2(tmpfile,end,3+bswap)
}
return 1
}
//** func rdcols()
// reads columns of ascii with optional labels at the top
func rdcols () { local i,ii,cols,li,errflag,num,hflag
errflag=0
if (! tmpfile.ropen($s1)) { printf("\trdcols ERR0: can't open file \"%s\"\n",$s1) return 0}
if (fcd.count(2)+fcd.count(0)!=m) {printf("\trdcols ERRA: only rd strs and dbls\n") return 0}
if (tmpfile.scanstr(sstr)==-1) {printf("\trdcols ERR1: file \"%s\"\n",$s1) return 0}
if (isnum(sstr)) hflag=0 else hflag=1 // hflag=0 -> no header
if (numarg()>1) { // names of columns
resize(numarg()-1)
for i=2,numarg() sethdrs(i-2,$si)
if (hflag) {
printf("Header in file %s: %s vs %s\n",$s1,sstr,s[0].s)
hflag=2
}
} else if (!hflag) printf("No Header for %s\n",$s1)
cols=0
if (hflag==1) {
while (! isnum(sstr)) {
cols+=1 tmpfile.scanstr(sstr)
resize(sstr)
}
} else {
cols=fcd.count(0) // assume that NQS was set up ahead
resize(cols)
}
li=file_len($s1)
if (hflag) li-=1
printf("%d cols; %d lines of data in %s.\n",cols,li,$s1)
tmpfile.ropen($s1)
if (hflag) tmpfile.gets(sstr) // remove first line
// WARN: this will screw up if numbers are to be included as strings
num=scr.scanf(tmpfile,li*cols) // note that this will skip over non-nums
if (num!=li*cols) { // err not reached since scanf dumps out
printf("WARNING: expected %d vals; found %d\n",li*cols,num) errflag=3 }
if (tmpfile.scanstr(sstr)>-1) {
printf("WARNING: %s found after reading in %d vals\n",sstr,li*cols) errflag=4 }
tmpfile.seek(0)
for ii=0,cols-1 {
if (fcd.x[ii]>0) continue
if (hflag==1) tmpfile.scanstr(s[ii].s)
v[ii].resize(li)
v[ii].copy(scr,0,ii,li*cols-1,1,cols) // v[ii].mcol(scr,ii,cols)
}
if (fcd.count(0)!=m) { // need to pick up some strings
tmpfile.seek(0)
if (hflag==1) tmpfile.gets(tstr) // throw away
}
if (errflag) { printf("rdcols ERR%d\n",errflag) return 0 }
return cols
}
//** func svR([filename])
// saves in a format that can be read by my rdnqs.R program
func svR () { local ii,jj,cols,li,errflag,num
errflag=0
if (eqobj(cob,out) && verbose) printf(" *Selected* ")
if (numarg()==1) sstr=$s1 else {
sstr=file
repl_mstr(sstr,"\.nqs$",".nqR")
}
if (tmpfile.ropen(sstr)) if (!boolean_dialog("File exists","Overwrite","Cancel")) {
print "Cancelled" return 0 }
if (! tmpfile.wopen(sstr)) { printf("\tsvR ERR0: can't open file \"%s\"\n",sstr) return 0}
tmpfile.printf("%d\n",m)
for ii=0,m-1 tmpfile.printf("%s\n",s[ii].s)
for ii=0,m-1 cob.v[ii].vwrite(tmpfile)
tmpfile.close()
return ii
}
//** func svcols(filename)
// saves numeric columns for R -- read with aa=read.table("filename")
func svcols () { local ii,jj,cols,li,errflag,num
errflag=0
if (tmpfile.ropen($s1)) if (!boolean_dialog("File exists","Overwrite","Cancel")) {
print "Cancelled" return 0 }
if (! tmpfile.wopen($s1)) { printf("\tsvcols ERR0: can't open file \"%s\"\n",$s1) return 0}
sstr2="\t" // delimiter
for ii=0,m-1 tmpfile.printf("%s%s",s[ii].s,sstr2)
tmpfile.printf("\n")
for ii=0,size(1)-1 {
tmpfile.printf("%d%s",ii,sstr2)
for jj=0,m-1 {
getval(jj,v[jj].x[ii])
tmpfile.printf("%g%s",nval,sstr2)
}
tmpfile.printf("\n")
}
tmpfile.close
return ii
}
//** join(nqs2,"PIVOT"[,"COLA",...])
// [selected fields of] nqs2 will be appended to this
// index field should only appear once in nqs2
func join () { local vn,vn1,vn2,i,ii,jj,kk,val localobj al,bl
al=new List() bl=new List()
if ((vn1=fi($s2))==-1 || (vn2=$o1.fi($s2))==-1) {
printf("NQS::join() %s not found in both %s %s\n",$s2,$o1,this) return -1 }
if (!v[vn1].ismono) { print "Sorting A..." sort(vn1) }
if (!$o1.v[vn2].ismono){print "Sorting B..." $o1.sort(vn2) }
if (!$o1.v[vn2].ismono(2)){ printf("Pivot B has repeats\n") return -1 }
scr.resize($o1.m) scr.fill(-1)
if (numarg()>2) for i=3,numarg() {
if ((vn=$o1.fi($si))==-1) return -1
if (fi($si,"NOERR")!=-1) sprint(tstr,"%sB",$si) else tstr=$si
scr.x[vn]=resize(tstr)-1 // index for this
} else for ii=0,$o1.m-1 if (! strcmp($o1.s[ii].s,$s2)==0) { // don't add pivot field
if ($o1.fcd.x[ii]!=0) {printf("%s:join ERRA not double field\n",this) return -1}
if (fi($o1.s[ii].s,"NOERR")!=-1) sprint(tstr,"%sB",$o1.s[ii].s) else tstr=$o1.s[ii].s
scr.x[ii]=resize(tstr)-1 // index for this
}
pad()
for jj=0,scr.size-1 { kk=scr.x[jj]
if (kk!=-1) { al.append(v[kk]) bl.append($o1.v[jj]) }
}
v[vn1].join($o1.v[vn2],al,bl)
return m
}
//** cp(NQS[,VEC_COPY]) copy 1 NQS to another
// default: VEC_COPY==1; side effect of NO_VEC_COPY is no fcd,fcds creation
proc copy () { if (numarg()==2) cp($o1,$2) else cp($o1) }
proc cpout () { // copy .out to this
cob=this
for ii=0,m-1 v[ii].copy(out.v[ii])
}
proc cp () { local ii,csz,veccp,outcp localobj o,oo
cob=this
csz=$o1.m
outcp=0
if (numarg()==2) veccp=$2 else veccp=1
if (m!=csz) if (isassigned(out)) resize(csz) else {
resize2(csz)
outcp=1
}
objl.remove_all
for ii=0,$o1.objl.count-1 { objl.append($o1.objl.object(ii)) }
file=$o1.file comment=$o1.comment
if (outcp) for ii=0,m-1 {
s[ii]=up.s[ii]
v[ii]=new Vector()
} else for ii=0,m-1 {
s[ii].s=$o1.s[ii].s
if (veccp) v[ii].copy($o1.v[ii]) // 2nd arg to not copy vectors
}
if (veccp==1) { // full copy
fcd.copy($o1.fcd)
for ii=0,$o1.fcds.count-1 fcds.append($o1.fcds.object(ii)) // strings not being copies
if (isobj($o1.fcdl,"List")) { fcdl=new List() out.fcdl=fcdl
for ii=0,$o1.fcdl.count-1 fcdl.append($o1.fcdl.object(ii)) }
if (isobj($o1.fcdo,"List")) { fcdo=new List() out.fcdo=fcdo
o=$o1.fcdo
for ii=0,o.count-1 {
if (isojt(o.o(ii),v)) { // a vector
oo=new Vector(o.o(ii).size) oo.copy(o.o(ii)) fcdo.append(oo)
} else if (isojt(o.o(ii),out)) { // a vector
oo=new NQS() oo.cp(o.o(ii)) fcdo.append(oo)
} else {
printf("Can't copy a %s\n",o.o(ii)) return
}
}
}
} else if (! isassigned(fcd)) { // use pointers for .out
fcd=$o1.fcd fcds=$o1.fcds fcdl=$o1.fcdl tmplist=$o1.tmplist
}
x.copy($o1.x) x.resize(m)
scr.copy($o1.scr) ind.copy($o1.ind)
}
//** eq(NQS) -- just check the vecs
func eq () { local ii,jj,af,ix,epsilon localobj v1
if (numarg()>=2) {
af=1
if ($2!=1) epsilon=$2 else epsilon=1e-5
} else af=0 // af is flag for approx eq
if ($o1.m!=m) { printf("# of cols differ %d vs %d\n",m,$o1.m) return 0 }
for ii=0,m-1 if (strcmp($o1.s[ii].s,s[ii].s)!=0) {
printf("%d col names differ: %s vs %s",ii,s[ii].s,$o1.s[ii].s) return 0 }
for ii=0,m-1 if ($o1.v[ii].size != v[ii].size) {
printf("%d col lengths differ: %d vs %d",ii,v[ii].size,$o1.v[ii].size) return 0 }
if (af) {
a=allocvecs(v1)
for ii=0,m-1 {
v1.copy(v[ii])
v1.sub($o1.v[ii])
v1.abs()
if (v1.max>epsilon) {
ix=v1.max_ind
printf("%s cols differ: \n",s[ii].s,ix,v[ii].x[ix],$o1.v[ii].x[ix])
}
}
if (numarg()>=3) $o3.copy(v1)
dealloc(a)
} else for ii=0,m-1 if (! $o1.v[ii].eq(v[ii])) {
printf("%s cols differ at ",s[ii].s)
for jj=0,v[ii].size-1 if ($o1.v[ii].x[jj] != v[ii].x[jj]) {
printf("element %d: %g vs %g",jj,v[ii].x[jj],$o1.v[ii].x[jj])
if ($o1.v[ii].x[jj]-v[ii].x[jj]<1e-5) {
printf("\n\tTry for approximately equal using flag: nq.eq(nq2,1)\n")}
return 0
}
}
if (! fcdseq($o1)) return 0
if (! fcdoeq($o1)) return 0
return 1
}
//** fcdseq() -- check that string lists are identical in two NQSs -- this is
// sufficient but not nec for comparing string columns for JOIN
// in order to use JOIN must share same fcds by setting up with strdec(NQS,...)
// (could break out separate lists for each str column -- tried in nqs.hoc220;
// but separate lists would be problem: two columns might require same indices if
// either could be used to for "JOIN" to another nqs
func fcdseq () { local ii,jj,cnt
cnt=fcds.count
if (eqobj(fcds,$o1.fcds)) {
printf("%s %s already share string list fcds\n",this,$o1)
return 1
}
if (cnt!=$o1.fcds.count) {
printf("DIFFERING (1) string lists (fcds) %d %d\n",fcds.count,$o1.fcds.count)
return 0
}
for ii=0,cnt-1 if (!strcmp(fcds.object(ii).s,$o1.fcds.object(ii).s)==0) {
printf("DIFFERING (2) string lists (fcds) %d:%s vs %s",ii,fcds.object(ii).s,$o1.fcds.object(ii).s)
return 0
}
if (numarg()==2) return 1 // just check fcds and not fcd and fcdl
if (! fcd.eq($o1.fcd)) {
printf("DIFFERING (3) col keys (fcd) ") vlk(fcd) vlk($o1.fcd)
return 0
}
if (! isassigned(fcdl) && isassigned($o1.fcdl)) {
printf("DIFFERING (4) uselists() string lists: absent in %s\n",this)
return 0
}
if (isassigned(fcdl)) {
if (! isassigned($o1.fcdl)) {
printf("DIFFERING (5) uselists() string lists absent in %s\n",$o1)
return 0
}
if (fcdl.count!=$o1.fcdl.count) {
printf("DIFFERING (6) uselists() list list counts %d vs %d",fcdl.count,$o1.fcdl.count)
return 0
}
for ii=0,fcdl.count-1 if (fcd.x[ii]==-1) {
if (!isobj(fcdl.object(ii),"List") || !isobj($o1.fcdl.object(ii),"List")) {
printf("DIFFERING (7) uselists() string lists (fcdl.obj) %d:%s vs %s",ii,\
fcdl.object(ii),$o1.fcdl.object(ii))
return 0
}
if (fcdl.object(ii).count != $o1.fcdl.object(ii).count) {
printf("DIFFERING (8) uselists() string lists counts (fcdl.obj) %d:%d vs %d",ii,\
fcdl.object(ii).count,$o1.fcdl.object(ii).count)
return 0
}
for jj=0,fcdl.object(ii).count-1 {
if (!strcmp(fcdl.object(ii).object(jj).s,$o1.fcdl.object(ii).object(jj).s)==0) {
printf("DIFFERING (9) uselists() string lists (fcdl.obj) %d,%d:%s vs %s",ii,jj,\
fcdl.object(ii).object(jj).s,$o1.fcdl.object(ii).object(jj).s)
return 0
}
}
}
}
return 1
}
//** fcdoeq() -- check that object lists are identical in two NQSs
func fcdoeq () { local ii,jj,cnt
if (! isassigned(fcdo) && ! isassigned($o1.fcdo)) return 1
if (! isassigned(fcdo)) {
printf("No object list in %s\n",this)
return 0
}
if (! isassigned($o1.fcdo)) {
printf("No object list in %s\n",$o1)
return 0
}
cnt=fcdo.count
if (cnt!=$o1.fcdo.count) {
printf("DIFFERING (1) object lists (fcdo) %d %d\n",fcdo.count,$o1.fcdo.count)
return 0
}
for ii=0,cnt-1 {
if (!isojt(fcdo.o(ii),$o1.fcdo.o(ii))) {
printf("DIFFERING (2) obj lists (fcdo) %s,%s (%s,%s)",fcdo.o(ii),$o1.fcdo.o(ii),this,$o1)
return 0
}
if (1) { // vector and nqs both use .eq() a vector: isojt(fcdo.o(ii),v)
if (! fcdo.o(ii).eq($o1.fcdo.o(ii))) {
printf("DIFFERING obj lists (fcdo) : differ %s,%s (%s,%s)",\
fcdo.o(ii),$o1.fcdo.o(ii),this,$o1)
return 0
}
}
}
return 1
}
//** strdec() -- declare these columns to be strings
func strdec () { local i,min
min=1
if (eqobj(cob,out)) {
printf("strdec() ERR: string fields can only be declared at top level\n") return 0}
if (numarg()==0) {
printf("strdec(NAME[,NAME1 ...])\n\tdeclare these field to be string fields\n") return 0}
out.fcd=fcd
if (argtype(1)==1) {
if (fcds.count>0) if (! fcdseq($o1,1)) { // just check fcds and not fcd, fcdl
printf("Pre-existing string lists differ; unable to join %s %s\n",this,$o1)
return 0
}
fcds=$o1.fcds // share string list to allow JOIN on a string field
min=2
}
for i=min,numarg() {
if (argtype(i)==2) fl=fi($si) else fl=$i
if (fl>-1) {
fcd.x[fl]=2
sval="`EMPTY'"
newval(2,fl) // don't want to put on more than one
}
}
return 1
}
//** coddec() -- declare these columns to be strings
func coddec () { local i,min
min=1
if (eqobj(cob,out)) {
printf("coddec() ERR: CODE fields can only be declared at top level\n") return 0}
if (numarg()==0) {
printf("coddec(NAME[,NAME1 ...])\n\tdeclare these field to be code fields\n") return 0}
out.fcd=fcd
for i=min,numarg() {
fl=fi($si)
if (fl>-1) fcd.x[fl]=10
}
return 1
}
//** deriv("COLA",...) generates a col with differences between each row value and preceding
proc deriv () { local fl,i
if (eqobj(cob,out)) { printf("Take deriv on whole set only\n") return }
for i=1,numarg() {
if (argtype(i)==0) fl=$i else fl=fi($si)
if (fl==-1) return
sprint(tstr,"%s'",s[fl].s) resize(tstr)
v[m-1].deriv(v[fl],1,1)
v[m-1].insrt(0,0)
}
}
//** odec() -- declare these columns to be objects
func odec () { local i,min
min=1
if (eqobj(cob,out)) {
printf("odec() ERR: object fields can only be declared at top level\n") return 0}
if (numarg()==0) {
printf("odec(NAME[,NAME1 ...])\n\tdeclare these field to be object fields\n") return 0}
out.fcd=fcd
for i=min,numarg() { fl=fi($si)
if (fl>-1) fcd.x[fl]=1
}
if (! isobj(fcdo,"List")) { fcdo=new List() out.fcdo=fcdo }
return 1
}
//** mo([flag][,STAT1,...]) -- create global objectvars that point to the vectors
// first time use flag=1 to create new global objrefs, else just shift them
// flag=1 reassign objl but don't care if they already exist
// flag=2 don't print out the assignments
// flag=3 reassign objl; make sure they're unique
// flag=4 clear the vectors
// should we also create a set of global scalars to assign to in an iterator?
proc mo () { local ii,flag,i,hf
if (numarg()>=1) flag=$1 else flag=0 // flag:create objrefs
if (flag==1 || flag==3) {
if (objl.count>0) {
if (flag==3) if (batch_flag) {
printf("NQS mo(3) WARNING: Renamed object pointers.\n")
} else if (! boolean_dialog("New name object pointers?","YES","NO")) return
if (flag==1) if (batch_flag) {
printf("NQS mo(1) WARNING: Rassigned object pointers.\n")
} else if (! boolean_dialog("Reassign object pointers?","YES","NO")) return
}
objl.remove_all
for ii=0,m-1 if (sfunc.len(s[ii].s)>0) {
sstr=s[ii].s
repl_mstr(sstr,"[^A-za-z0-9]","",execstr)
sprint(sstr,"%sv",sstr)
if (flag==3) { // make sure it's unique
hf=0
while (name_declared(sstr)) { hf=1
printf("%s exists ... ",sstr)
sprint(sstr,"%sv",sstr)
}
if (hf) printf(" -> %s\n",sstr)
} else if (name_declared(sstr)) printf("%s reassigned: ",sstr)
printf("%s -> v[%d] (%s)\n",sstr,ii,s[ii].s)
sprint(execstr,"objref %s",sstr) execute(execstr)
sprint(execstr,"%s=%s",sstr,v[ii]) execute(execstr)
objl.append(new String(sstr))
}
sprint(execstr,"objref indv") execute(execstr)
sprint(execstr,"indv=%s",ind) execute(execstr)
} else {
if (objl.count==0) {
printf("Must create vecs with mo(1)\n")
} else if (objl.count>m) {
printf("STAT:mo ERR: wrong objref count in objl: %d vs %d\n",objl.count,m)
return
} else {
if (objl.count<m) {
printf("STAT:mo WARNING: unreferenced vecs for %s: refs %d<m %d\n",this,objl.count,m) }
for ii=0,objl.count-1 {
Xo=objl.object(ii)
if (flag==0) printf("%s -> %s.v[%d] (%s)\n",Xo.s,this,ii,s[ii].s)
if (flag==4) {sprint(execstr,"%s=nil",Xo.s)
} else sprint(execstr,"%s=%s",Xo.s,v[ii])
execute(execstr)
}
}
sprint(execstr,"objref indv") execute(execstr)
if (flag!=4) { sprint(execstr,"indv=%s",ind) execute(execstr) }
}
if (numarg()>1) for i=2,numarg() { // propagate the objl to other STATs
$oi.objl.remove_all
for ii=0,objl.count-1 $oi.objl.append(objl.object(ii))
}
}
func version () { local x
if (numarg()==0) print nqsvers
sfunc.tail(nqsvers,",v [1-9]*.",tstr)
sscanf(tstr,"%d",&x)
return x
}
//* endtemplate
endtemplate NQS
//* array template -- an array pretending to be a list
begintemplate OARR
public oo,max,count,o,object,append,o2l,l2o,name,id
objref oo[1]
strdef name
proc init () {
max=$1 id=count=0
objref oo[max]
}
obfunc o () { // allow an array to pretend to be a list
if ($1<0 || $1>=max) {printf("OOB for OARR: %d >= %d\n",$1,max) return oo[0]}
if ($1>=count) printf("OARR WARNING: %d not assigned\n",$1)
return oo[$1]
}
obfunc object () { // allow an array to pretend to be a list
if ($1<0 || $1>=max) {printf("OOB for OARR: %d >= %d\n",$1,max) return oo[0]}
if ($1>=count) printf("OARR WARNING: %d not assigned\n",$1)
return oo[$1]
}
func append () {
if (count>max-1) {printf("OARR ERR: out of room: %d\n",max) return -1}
oo[count]=$o1 count+=1
return count
}
// copy array to a list
proc o2l () { local jj,min,mx
if (numarg()==3) {min=$2 mx=$3} else {min=0 mx=count}
for jj=min,mx $o1.append(oo[jj])
}
// copy list to array
proc l2o () { local jj,min,mx
if (numarg()==3) {min=$2 mx=$3} else {min=0 mx=$o1.count-1}
for jj=min,mx oo[jj]=$o1.o(jj)
}
endtemplate OARR
//* ancillary routines
//* sopset() returns symbolic arg associated with a string
proc sopset() { local i
for i=1,20 sops[i-1]=$i // AUGMENT TO ADD NEW OPSYM
}
sopset(ALL,NEG,POS,CHK,NOZ,GTH,GTE,LTH,LTE,EQU,EQV,EQW,EQX,NEQ,SEQ,RXP,IBE,EBI,IBI,EBE) // ADD NEW OPSYM NAME
proc sofset () {
for scase(XO,"ALL","NEG","POS","CHK","NOZ","GTH","GTE","LTH","LTE","EQU","EQV","EQW","EQX","NEQ","SEQ","RXP","IBE","EBI","IBI","EBE") for j=1,5 {
sprint(tstr,"%s%d=%s*%d",XO.s,j,XO.s,j+1)
execute(tstr)
}
}
sofset()
//** whvarg
func whvarg () { local ret
ret=-1
// ADD NEW OPSYM STRING
// ALL NEG POS CHK NOZ GTH GTE LTH LTE EQU EQV EQW EQX NEQ SEQ RXP IBE EBI IBI EBE
for scase("ALL","<0",">0","CHK","!=0",">",">=","<","<=","==","EQV","EQW","EQX","!=","=~","~~","[)","(]","[]","()") {
if (strcmp($s1,temp_string_)==0) {ret=i1 break}
}
if (ret==-1) return ret else return sops[ret]
}
//** whkey(KEY,STR)
// place name of KEY from vecst.mod in temp_string_
func whkey () { local key
for scase("ALL","NEG","POS","CHK","NOZ","GTH","GTE","LTH","LTE","EQU","EQV","EQW","EQX","NEQ","SEQ","RXP","IBE","EBI","IBI","EBE") { // ADD NEW OPSYM NAME
sprint(tstr,"x=%s",temp_string_) execute(tstr)
if (x==$1) {
if (numarg()==2) $s2=temp_string_ else print temp_string_
break
}
}
return x
}
//** varstr(tstr) -- make a variable out of string by removing nonalphanumeric characters
func varstr () { local a,z,A,Z,a0,a9,a_,len,ii,sflag
a=97 z=122 A=65 Z=90 a0=48 a9=57 a_=95 // ascii codes
if (numarg()==2) sflag=1 else sflag=0
len = sfunc.len($s1)
for ({x=0 ii=0};ii<len && !((x>=a&&x<=z)||(x>=A&&x<=Z));ii+=1) { // allowed first char
sscanf($s1,"%c%*s",&x)
sfunc.right($s1,1)
}
if (ii==len) { printf("varstr() ERR: no useable characters") return 0}
sprint($s1,"%c%s",x,$s1)
for (;ii<=len;ii+=1) {
sscanf($s1,"%c%*s",&x)
sfunc.right($s1,1)
if ((x>=a&&x<=z)||(x>=A&&x<=Z)||(x>=a0&&x<=a9)||(x==a_)) { // allowed chars
sprint($s1,"%s%c",$s1,x)
}
}
if (sflag) {
sprint($s1,"strdef %s",$s1)
execute($s1)
sfunc.right($s1,7) // strip leading "strdef"
} else {
sprint($s1,"%s=0",$s1)
execute($s1)
sfunc.left($s1,sfunc.len($s1)-2) // strip the =0
}
return 1
}
strdef h1
h1="Select operators: \nALL <0 >0 CHK !=0 > >= < <= == EQV EQW EQX != =~ ~~ [) (] [] ()\nALL NEG POS CHK NOZ GTH GTE LTH LTE EQU EQV EQW EQX NEQ SEQ RXP IBE EBI IBI EBE\nmost are obvious; those that are not\nEQV: value equal to same row value another column (takes string arg)\nEQW: value found in other vector (takes vector or NQS arg)\nSEQ: string equal (takes string)\nRXP: regular expression comparison (takes string)\nIBE,EBI...: I=inclusive, E=exclusive for ranges\n"
proc nqshelp () {
if (numarg()==0) {
} else {
if (strcmp($s1,"select")==0) {
// ed=new TextEditor(h1,9,160) ed.map
printf("%s",h1)
}
}
}
proc delnqs () { local i
for i=1,numarg() nqsdel($oi)
}
proc nqsdel () { localobj iq,xo
if (isassigned($o1)) {
iq=$o1
if (isassigned(iq.fcdo)) for ltr(xo,iq.fcdo) if (isojt(xo,iq)) nqsdel(xo)
if (isassigned(iq.out)) {iq.out.cob=nil iq.out=nil}
iq.cob=nil iq=nil
}
if (!istmpobj($o1)) $o1=nil
}