// Created 01/13/09 15:54:46 by "/usr/site/scripts/loadfiles batch.hoc" //================================================================ // INSERTED batch.hoc // =Id= batch.hoc,v 1.6 2004/07/03 20:22:46 billl Exp // when running loadfiles on this, need to edit nrnoc.hoc to remove // conditional: if (xwindows) ... else ... // obsolete load_file("stdgui.hoc") load_file("nrngui.hoc") {graph_flag=0 xwindows=0 batch_flag=1} //================================================================ // INSERTED /usr/site/nrniv/local/hoc/setup.hoc // =Id= setup.hoc,v 1.24 2006/11/08 00:51:51 billl Exp // variables normally controlled by SIMCTRL // load_file("setup.hoc") show_panel=0 strdef simname, filename, output_file, datestr, uname, comment, section, osname objref tmpfile,nil,graphItem,sfunc sfunc = hoc_sf_ // from stdlib.hoc proc chop () { sfunc.left($s1,sfunc.len($s1)-1) } tmpfile = new File() simname = "sim" // helpful if running multiple simulations simultaneously runnum = 1 // updated at end of run if (unix_mac_pc()==1) osname = "Linux" else if (unix_mac_pc()==2) { osname = "Mac" } else if (unix_mac_pc()==3) osname = "PC" if (!strcmp(osname,"PC")) { uname="PC" datestr="ouput" // substitute for date on PC } else { system("uname -m",uname) // keep track of type of machine for byte compatibility chop(uname) system("date +%y%b%d",datestr) chop(datestr) // may prefer to downcase later } sprint(output_file,"data/%s.%02d",datestr,runnum) // assumes a subdir called data printStep = 0.25 // time interval for saving to vector graph_flag=0 batch_flag=1 xwindows = 0 // can still save but not look without xwindows // load_file("nrnoc.hoc") // END /usr/site/nrniv/local/hoc/setup.hoc //================================================================ //================================================================ // INSERTED /usr/site/nrniv/simctrl/hoc/nrnoc.hoc // =Id= nrnoc.hoc,v 1.74 2007/11/20 07:51:52 billl Exp proc nrnoc () {} // Users should not edit nrnoc.hoc or default.hoc. Any local // changes to these files should be made in local.hoc. // key '*&*' is picked up by to indicate command for emacs proc elisp () { printf("*&* %s\n",$s1) } // if (not exists(simname)) { strdef simname, output_file, datestr, comment } // Simctrl.hoc will automatically load stdgraph.hoc which automatically // loads stdrun.hoc strdef temp_string_, user_string_ // needed for simctrl /* Global variable default values. NOTE that stdrun.hoc, stdgraph.hoc and simctrl.hoc all contain variable definitions and thus default.hoc should be loaded after these files */ //================================================================ // INSERTED /usr/site/nrniv/simctrl/hoc/default.hoc // =Id= default.hoc,v 1.5 2003/07/08 16:16:52 billl Exp /* This file contains various global defaults for hoc ** Users should not edit nrnoc.hoc or default.hoc. Any local changes to these files should be made in local.hoc. ----------------------------------------------------------------*/ /*------------------------------------------------------------ Object defaults ------------------------------------------------------------*/ /*** Define a "nil" object ***/ objectvar nil /*------------------------------------------------------------ String defaults ------------------------------------------------------------*/ /*** "Section" is used if errors are found in the initializiations ***/ strdef section /*** Misc defines used by graphic routines ***/ temp_string_ = "t" tempvar = 0 /*------------------------------------------------------------ Simulation defaults ------------------------------------------------------------*/ /* To be consistent w/the nmodl values */ FARADAY = 96520. /* Hoc default = 96484.56 */ PI = 3.14159 /* Hoc default = 3.1415927 */ /* 0=off, 1=on */ print_flag = 0 /* Write to output file */ graph_flag = 1 /* Plot output */ iv_flag = 1 /* Using Interviews plotting */ batch_flag = 0 /* Using batch_run() */ compress_flag = 0 /* Compress output file when saved */ stoprun = 0 /* 0=running, 1=stopped */ iv_loaded = 0 /* Load initial iv stuff on once */ init_seed = 830529 run_seed = 680612 t = 0 /* msec */ dt = .01 /* msec */ tstop = 100 /* msec */ printStep = 0.1 /* msec */ plotStep = 0.1 /* msec */ flushStep = 0.1 /* msec */ eventStep = 50 /* Number of nstep's before a doEvent */ secondorder = 0 celsius = 6.3 /* degC */ v_init = -70 /* (mV) */ global_ra = 200 /* (ohm-cm) specific axial resisitivity */ /*** Ion parameters ***/ ca_init = 50e-6 /* mM */ na_init = 10 /* mM */ k_init = 54.4 /* mM */ // END /usr/site/nrniv/simctrl/hoc/default.hoc //================================================================ /* Allows arrays of strings */ objref hoc_obj_[2] //================================================================ // INSERTED /usr/site/nrniv/simctrl/hoc/simctrl.hoc // =Id= simctrl.hoc,v 1.14 2000/11/27 21:59:33 billl Exp // Graphic routines for neuremacs simulation control proc sim_panel () { xpanel(simname) xvarlabel(output_file) xbutton("Init", "stdinit()") xbutton("Init & Run", "run()") xbutton("Stop", "stoprun=1") xbutton("Continue till Tstop", "continueRun(tstop)") xvalue("Continue till", "runStopAt", 1, "{continueRun(runStopAt) stoprun=1}", 1, 1) xvalue("Continue for", "runStopIn", 1, "{continueRun(t + runStopIn) stoprun=1}", 1,1) xbutton("Single Step", "steprun()") xvalue("Tstop", "tstop", 1, "tstop_changed()", 0, 1) graphmenu() sim_menu_bar() misc_menu_bar() xpanel() } proc misc_menu_bar() { xmenu("Miscellaneous") xbutton("Label Graphs", "labelgrs()") xbutton("Label With String", "labelwith()") xbutton("Label Panel", "labelpanel()") xbutton("Parameterized Function", "load_template(\"FunctionFitter\") makefitter()") xmenu() } proc sim_menu_bar() { xmenu("Simulation Control") xbutton("File Vers", "elisp(\"sim-current-files\")") xbutton("File Status...", "elisp(\"sim-rcs-status\")") xbutton("Sim Status", "elisp(\"sim-portrait\")") xbutton("Load Current Files", "elisp(\"sim-load-sim\")") xbutton("Load Templates", "elisp(\"sim-load-templates\")") xbutton("Load File...", "elisp(\"sim-load-file\")") xbutton("Save Sim...", "elisp(\"sim-save-sim\")") xbutton("Set File Vers...", "elisp(\"sim-set-file-ver\")") xbutton("Read Current Vers From Index", "elisp(\"sim-read-index-file\")") xbutton("Read Last Saved Vers", "elisp(\"sim-read-recent-versions\")") xbutton("Output to sim buffer", "elisp(\"sim-direct-output\")") xmenu() } proc labelpanel() { xpanel(simname,1) xvarlabel(output_file) xpanel() } proc labels () { labelwith($s1) labelgrs() } proc labelgrs () { local i, j, cnt for j=0,n_graph_lists-1 { cnt = graphList[j].count() - 1 for i=0,cnt labelgr(graphList[j].object(i)) } } proc labelwith () { local i, j, cnt temp_string_ = user_string_ // save the old one if (numarg() == 1) { /* interactive mode */ user_string_ = $s1 } else { string_dialog("write what?", user_string_) } for j=0,n_graph_lists-1 { cnt = graphList[j].count() - 1 for i=0,cnt { graphList[j].object(i).color(0) graphList[j].object(i).label(0.5,0.9,temp_string_) graphList[j].object(i).color(1) graphList[j].object(i).label(0.5,0.9,user_string_) } } } proc labelgr () { local i $o1.color(0) // white overwrite for (i=0;i<10;i=i+1) { // erase every possible runnum for this date sprint(temp_string_,"%s %d%d",datestr,i,i) $o1.label(0.1,0.7,temp_string_) } $o1.color(1) // back to basic black sprint(temp_string_,"%s %02d",datestr,runnum) $o1.label(0.1,0.7,temp_string_) } // END /usr/site/nrniv/simctrl/hoc/simctrl.hoc //================================================================ proc run () { running_ = 1 stdinit() continueRun(tstop) finish() } proc continueRun () { local rt, rtstart, ts if (numarg()==1) ts=$1 else ts=t+1e3 realtime = 0 rt = screen_update_invl rtstart = startsw() eventcount=0 eventslow=1 stoprun = 0 if (using_cvode_) { if (cvode.use_local_dt || (cvode.current_method()%10) == 0) { cvode.solve(ts) flushPlot() realtime = startsw() - rtstart return } } else { ts -= dt/2 } while (t= rt) { // if (!stdrun_quiet) fastflushPlot() screen_update() //really compute for at least screen_update_invl realtime = startsw() - rtstart rt = realtime + screen_update_invl } } if (using_cvode_ && stoprun == 0) { // handle the "tstop" event step() // so all recordings take place at tstop } flushPlot() realtime = startsw() - rtstart } proc stdinit() { cvode_simgraph() realtime = 0 setdt() init() initPlot() } proc init () { cvode_simgraph() initMech() initMisc1() // Initialize state vars then calculate currents // If user hand-set v in initMisc1() then v_init should be > 1000, // else all compartments will be set to v_init if (v_init < 1000) { finitialize(v_init) } else { finitialize() } // Set ca pump and leak channel for steady state setMemb() initMisc2() if (cvode_active()) cvode.re_init() else fcurrent() frecord_init() } // Initialization of mechanism variables // NOTE: if any changes are made to the NEURON block of any local mod // file, the user must add the necessary inits to initMisc1() proc initMech () { forall { if ((!ismembrane("pas")) && (!ismembrane("Passive"))) { // Allow for either pas or Passive mod file usage // errorMsg("passive not inserted") } if (ismembrane("na_ion")) { nai = na_init nai0_na_ion = na_init } if (ismembrane("k_ion")) { ki = k_init ki0_k_ion = k_init } if (ismembrane("ca_ion")) { cai = ca_init cai0_ca_ion = ca_init } } } //* setMemb complex -- multiple names for passive mech //** declarations iterator scase() { local i for i = 1, numarg() { temp_string_ = $si iterator_statement }} objref paslist,pasvars[3],XO double pasvals[2],x[1] paslist = new List() for ii=0,2 pasvars[ii]= new String() for scase("fastpas","pas","Pass","Passive") paslist.append(new String(temp_string_)) //** getval(),setval() -- return/set the hoc value of a string func retval () { return getval($s1) } func getval () { sprint(temp_string2_,"x=%s",$s1) execute(temp_string2_) return x } proc setval () { sprint(temp_string2_,"%s=%g",$s1,$2) execute(temp_string2_) } //** findpas() // assumes that we are starting in a live section since looks for pass mech there qx_=0 proc findpas () { for ii=0,paslist.count-1 { XO=paslist.object(ii) if (ismembrane(XO.s)) { // print XO.s,"found" pasvars[2].s=XO.s sprint(pasvars[0].s,"g_%s(qx_)",XO.s) for scase("e","erev","XXXX") { // look for the proper prefix sprint(temp_string_,"%s_%s",temp_string_,XO.s) if (name_declared(temp_string_)==1) break } if (name_declared(temp_string_)==0) { // not found printf("SetMemb() in nrnoc.hoc: Can't find proper 'erev' prefix for %s\n",XO.s) } else { sprint(pasvars[1].s,"%s(qx_)",temp_string_) } } } } proc setMemb () { if (!secp()) return findpas() // assume that passive name is the same in all sections forall for (qx_,0) { // will eventually want 'for (x)' to handle all the segments if (ismembrane(pasvars[2].s)) { for ii=0,1 pasvals[ii]=getval(pasvars[ii].s) setmemb2() for ii=0,1 setval(pasvars[ii].s,pasvals[ii]) } } } // secp() determine whether any sections exist func secp () { local n n=0 forall n+=1 if (n>0) return 1 else return 0 } func setother () {return 0} // callback stub proc setmemb2 () { local iSum, ii, epas, gpas if (!secp()) return gpas=pasvals[0] epas=pasvals[1] // Setup steady state voltage using leak channel iSum = 0.0 if (ismembrane("na_ion")) { iSum += ina(qx_) } if (ismembrane("k_ion")) { iSum += ik(qx_) } if (ismembrane("ca_ion")) { iSum += ica(qx_) } iSum += setother() if (iSum == 0) { // Passive cmp so set e_pas = v epas = v } else { if (gpas > 0) { // Assume g set by user, calc e epas = v + iSum/gpas } else { // Assume e set by user, calc g if (epas != v) { gpas = iSum/(epas - v) } else { gpas=0 } } if (gpas < 0) errorMsg("bad g", gpas) if (epas < -100 || epas > 0) { printf(".") // printf("%s erev: %g %g %g\n",secname(),e_pas,ina,ik) } } pasvals[0]=gpas pasvals[1]=epas } proc finish () { /* Called following completion of continueRun() */ finishMisc() if (graph_flag == 1) { if (iv_flag == 1) { flushPlot() doEvents() } else { graphmode(-1) plt(-1) } } if (print_flag == 1) { wopen("") } } /*------------------------------------------------------------ User definable GRAPHICS and PRINTING routines ------------------------------------------------------------*/ proc outputData() { // Default procedure - if outputData() doesn't exist in the run file if (graph_flag == 1) { if (iv_flag == 1) { Plot() rt = stopsw() if (rt > realtime) { realtime = rt fastflushPlot() doNotify() if (realtime == 2 && eventcount > 50) { eventslow = int(eventcount/50) + 1 } eventcount = 0 }else{ eventcount = eventcount + 1 if ((eventcount%eventslow) == 0) { doEvents() } } } else { graph(t) } } if (print_flag == 1) { if (t%printStep <= printStep) { printOut() } } } proc printOut() { /* Default procedure - if printOut() doesn't exist in the run file */ } proc initGraph() { /* Default procedure - if initGraph() doesn't exist in the run file */ graph() } proc initPrint() { /* Default procedure - if initPrint() doesn't exist in the run file */ wopen(output_file) } /*------------------------------------------------------------ User definable BATCH RUN routines ------------------------------------------------------------*/ proc nextrun() { // Called from finishmisc() following completion of batch in an autorun wopen("") runnum = runnum + 1 sprint(output_file,"data/b%s.%02d", datestr, runnum) } // commands for emacs proc update_runnum() { runnum = $1 sprint(output_file,"data/%s.%02d", datestr, runnum) print "^&^ (progn (sim-index-revert)(setq sim-runnum ",runnum,"))" } proc nrn_write_index() { printf("&INDEX& %s\n",$s1) } proc nrn_update () { elisp("nrn-update") } proc nrn_message () { printf("!&! %s\n",$s1) } /*------------------------------------------------------------ User definable INITIALIZATION and FINISH routines ------------------------------------------------------------*/ // Default procedure - if initMisc1() doesn't exist in the run file // Initializations performed prior to finitialize() // This should contain point process inits and inits for any changes // made to the NEURON block of any local mod file proc initMisc1() { } // Default procedure - if initMisc2() doesn't exist in the run file // Initializations performed after finitialize() proc initMisc2() { } // Default procedure - if finishMisc() doesn't exist in the run file proc finishMisc() { } /*------------------------------------------------------------ Miscellaneous routines ------------------------------------------------------------*/ proc errorMsg() { /* Print warning, assumes arg1 is string and arg2 if present is a variable value */ sectionname(section) if (numarg() == 0) { printf("ERROR in errorMsg(): Needs at least 1 argument.\n") } else if (numarg() == 1) { printf("INFO: %s in section %s.\n", $s1, section) } else { printf("INFORMATION: %s in section %s (var=%g).\n", $s1, section, $2) } } proc clear() { /* Clear non-interviews plot window */ plt(-3) } func mod() { local x, y /* Mod function for non-integers */ x=$1 y=$2 return (x/y - int(x/y)) } proc whatSection() { print secname() } proc print_pp_location() { local x //arg1 must be a point process x = $o1.get_loc() sectionname(temp_string_) printf("%s located at %s(%g)\n", $o1, temp_string_, x) pop_section() } //* set method with method() proc method () { local prc if (numarg()==0) { if (cvode_active() && cvode_local()) { printf("\tlocal atol=%g\n",cvode.atol) } else if (cvode_active()) { printf("\tglobal atol=%g\n",cvode.atol) } else if (secondorder==2) { printf("\tCrank-Nicholson dt=%g\n",dt) } else if (secondorder==0) { printf("\timplicit dt=%g\n",dt) } else { printf("\tMethod unrecognized\n") } return } if (numarg()==2) prc = $2 else prc=0 finitialize() if (strcmp($s1,"global")==0) { cvode_active(1) cvode.condition_order(2) if (prc) cvode.atol(prc) } else if (strcmp($s1,"local")==0) { cvode_local(1) cvode.condition_order(2) if (prc) cvode.atol(prc) } else if (strcmp($s1,"implicit")==0) { secondorder=0 cvode_active(1) cvode_active(0) if (prc) dt=prc } else if (strcmp($s1,"CN")==0) { secondorder=2 cvode_active(1) // this turns off local cvode_active(0) if (prc) dt=prc } else { printf("Integration method %s not recognized\n",$s1) } } //* Load local modifications to nrnoc.hoc and default.hoc //================================================================ // INSERTED /usr/site/nrniv/simctrl/hoc/local.hoc // $Header: /usr/site/nrniv/simctrl/hoc/RCS/local.hoc,v 1.15 2003/02/13 15:32:06 billl Exp $ // // This file contains local modifications to nrnoc.hoc and default.hoc // // Users should not edit nrnoc.hoc or default.hoc. Any local // changes to these files should be made in this file. // ------------------------------------------------------------ //* MODIFICATIONS TO NRNOC.HOC // The procedures declared here will overwrite any duplicate // procedures in nrnoc.hoc. // ------------------------------------------------------------ //*MODIFICATIONS TO DEFAULT.HOC // // Vars added here may not be handled properly within nrnoc.hoc //------------------------------------------------------------ //** String defaults //** Simulation defaults long_dt = .001 // msec objref sfunc,tmpfile sfunc = hoc_sf_ // needed to use is_name() tmpfile = new File() // check for existence before opening a user's local.hoc file proc write_comment () { tmpfile.aopen("index") tmpfile.printf("%s\n",$s1) tmpfile.close() } func asin () { return atan($1/sqrt(1-$1*$1)) } func acos () { return atan(sqrt(1-$1*$1)/$1) } objref mt[2] mt = new MechanismType(0) proc uninsert_all () { local ii forall for ii=0,mt.count()-1 { mt.select(ii) mt.selected(temp_string_) if (strcmp(temp_string_,"morphology")==0) continue if (strcmp(temp_string_,"capacitance")==0) continue if (strcmp(temp_string_,"extracellular")==0) continue if (sfunc.substr(temp_string_,"_ion")!=-1) continue mt.remove() // print ii,temp_string_ } } condor_run = 0 // define for compatability // END /usr/site/nrniv/simctrl/hoc/local.hoc //================================================================ if (xwindows && graph_flag) { nrnmainmenu() } // pwman_place(50,50) print "Init complete.\n" // END /usr/site/nrniv/simctrl/hoc/nrnoc.hoc //================================================================ //================================================================ // INSERTED init.hoc // =Id= init.hoc,v 1.19 2006/06/08 17:39:02 billl Exp gvmarkflag=0 graph_flag=0 show_panel = 0 //================================================================ // INSERTED /usr/site/nrniv/local/hoc/grvec.hoc //* =Id= grvec.hoc,v 1.646 2009/01/07 15:49:00 billl Exp // argtype: 0:double; 1:obj; 2:str; 3:double pointer objref g[10],printlist,grv_,panobj,panobjl //================================================================ // INSERTED /usr/site/nrniv/local/hoc/nqs.hoc // =Id= nqs.hoc,v 1.626 2009/01/09 14:23:37 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") //================================================================ // INSERTED /usr/site/nrniv/local/hoc/decvec.hoc // =Id= decvec.hoc,v 1.398 2009/01/10 14:13:30 billl Exp proc decvec() {} //* Declarations objref ind, tvec, vec, vec0, vec1, tmpvec, vrtmp, veclist, veccollect, pwm objref tmpobj, XO, YO, rdm, dir strdef filename,dblform,tabform,xtmp {dblform="%.4g" tabform=" "} dir = new List() tmpfile = new File() if (! name_declared("datestr")) load_file("setup.hoc") //================================================================ // INSERTED /usr/site/nrniv/local/hoc/declist.hoc // =Id= declist.hoc,v 1.152 2008/10/13 20:17:23 billl Exp //* Declarations strdef mchnms objref tmplist,tmplist2,tmpobj,aa,XO,YO if (! name_declared("datestr")) load_file("setup.hoc") tmplist = new List() proc declist() {} //* Templates //** template String2 begintemplate String2 public s,t,x,append,prepend,exec,tinit strdef s,t proc init() { if (numarg() == 1) { s=$s1 } if (numarg() == 2) { s=$s1 t=$s2 } if (numarg() == 3) { s=$s1 t=$s2 x=$3 } } proc append () { local i if (argtype(1)==2) sprint(t,"%s%s",s,$s1) for i=2,numarg() sprint(t,"%s%s",t,$si) } proc prepend () { local i if (argtype(1)==2) sprint(t,"%s%s",$s1,s) for i=2,numarg() sprint(t,"%s%s",$si,t) } proc exec () { if (numarg()==1) sprint(t,"%s%s",$s1,s) execute(t) } proc tinit() { t=$s1 } endtemplate String2 //** template DBL begintemplate DBL public x proc init () { if (numarg()==1) x=$1 else x=0 } endtemplate DBL //** template Union // USAGE: XO=new Union(val) where val can be a number string or object // XO=new Union(list,index) will pick up a string or object from list // XO=new Union(vec,index) will pick up a number from vector // XO=new Union(&dbl,index) will pick up a number from double array // Union allows storage of a double, string or object // 2 ways of storing strings: directly in XO.s (t,u,v) OR // using XO.set("NAME","STR") which is returned by XO.get("NAME").s // It is useful as a localobj in an obfunc since it will permit returning anything // It also makes it easy to pick up any kind of value out of a list, vector or array // declared() not yet declared if (!name_declared("isobj")) execute1("func isobj(){return 0}") // place holder if (!name_declared("isassigned")) execute1("func isassigned(){return 0}") // place holder if (!name_declared("llist")) execute1("proc llist(){}") // place holder begintemplate Union public ty,x,s,t,u,v,o,xptr,xg,xs,optr,og,os,get,set,xl,ol,fi,inc,list,err,pr strdef s,t,u,v,tstr objref o[10],xl,ol,this,xo double x[10],sz[1],err[1] external sfunc,isobj,isassigned,nil,DBL,llist // 1arg -- store a num, string or obj // 2arg -- pick up type out of list proc init () { local ii,i,ox,xx,sx,flag ox=xx=sx=0 ty=argtype(1) // 'type' of Union defined by 1st arg on creation sz=10 // 10 is default size of arrays; for ii=0,sz-1 for ii=0,sz-1 x[ii]=ERR // special case of number in a vector or something in a list -- 2 args: list or vec,index err=1 flag=0 if (numarg()/2==int(numarg()/2)) for (i=1;i=$o1.size) { printf("Union ERR: vec index (%d) out of bounds for %s\n",ii,$o1) return } ty=0 x=$o1.x[ii] o=$o1 } else if (isobj($o1,"List")) { if (ii<0 || ii>=$o1.count) { printf("Union ERR: list index (%d) out of bounds for %s\n",ii,$o1) return } if (isobj($o1.object(ii),"String")) { // will handle String2 ty=2 s=$o1.object(ii).s o=$o1.object(ii) x=ii } else { ty=1 o=$o1.object(ii) x=ii } } } else if (argtype(1)==3) { ty=0 x=$&1[ii] // could check - but no + bound checking possible } } else for i=1,numarg() { ii=argtype(i) if (ii==0) { if (xx0) printf("%10s\t%s\n","s",s) if (sfunc.len(t)>0) printf("%10s\t%s\n","t",t) if (sfunc.len(u)>0) printf("%10s\t%s\n","u",u) if (sfunc.len(v)>0) printf("%10s\t%s\n","v",v) } // full List obfunc newl () { localobj o o=new List() for ii=0,sz-1 o.append(o) return o } proc repl () { if (isobj($o1.o($2),"String")) { $o1.o($2).s=$s3 } else { $o1.remove($2) $o1.insrt($2,new String($s3)) } } func fi () { local ii fif=-1 for ii=0,sz-1 { if ($o1.o(ii)==$o1) { if (fif==-1) fif=ii // first empty slot if any } else if (strcmp($o1.o(ii).s,$s2)==0) return ii } return ERR } // put in pointers for the x values func xptr () { local i,ii if (numarg()>sz) {printf("More names (%d) than x items (%d) in %s:xptr\n",numarg(),sz,this) error()} if (!isassigned(xl)) xl=newl() for i=1,numarg() repl(xl,i-1,$si) return xl.count } func optr () { local i,ii if (numarg()>sz) {printf("More names %d than o items (%d) in %s:optr\n",numarg(),sz,this) error()} if (!isassigned(ol)) ol=newl() for i=1,numarg() repl(ol,i-1,$si) return ol.count } // xg() associative get of a num func xg () { local ii ii=fi(xl,$s1) if (ii==ERR) {printf("Union:og (num get) failed -- \"%s\" not found\n",$s1) return ERR} return x[ii] } // xg() associative get of an obj obfunc og () { local ii ii=fi(ol,$s1) if (ii==ERR) {printf("Union:og (obj get) failed -- \"%s\" not found\n",$s1) return nil} return o[ii] } // xs(index,"label",num) set a specific location using a string -- see set() // xs("label",num) set an existing one only func xs () { local ii,i if (!isassigned(xl)) xl=newl() if (argtype(1)==0) { i=3 ii=$1 // an index repl(xl,ii,$s2) } else { i=2 ii=fi(xl,$s1) if (ii==ERR) {printf("Union:xs (num set) failed -- no %s found\n",$s1) return ERR} } if (argtype(i)!=0) {printf("Union:xs err -- arg %d must be object\n",i) return ERR} x[ii]=$i return $i } // os(index,"label",obj) set a specific location using a string -- see set() // os("label",obj) set an existing one only obfunc os () { local ii,i if (!isassigned(ol)) ol=newl() if (argtype(1)==0) { i=3 ii=$1 // $1 is an index repl(ol,ii,$s2) } else { i=2 ii=fi(ol,$s1) if (ii==ERR) {printf("Union:os (obj set) failed -- \"%s\" not found\n",$s1) return nil} } if (argtype(i)!=1) {printf("Union:os err -- arg %d must be object\n",i) return nil} o[ii]=$oi return $oi } // get() get any type obfunc get () { local ii if ((ii=fi(ol,$s1))!=ERR) { return o[ii] } else if ((ii=fi(xl,$s1))!=ERR) { if (argtype(2)==3) { $&2=x[ii] return this } else { return new DBL(x[ii]) } } else { // printf("Union:get() \"%s\" not found\n",$s1) return nil // make returning nil the unique error } } // increment or with neg decrement something func inc () { local n if (numarg()==2) n=$2 else n=1 if ((ii=fi(xl,$s1))==ERR) {printf("Union:inc ERR: %s %s\n",this,$s1) return ERR} return x[ii]+=n } // set() set any type func set () { local ii,i,ty,fo,fx if (xl==nil) xl=newl() if (ol==nil) ol=newl() for (i=1;i$o2.count-1) max=$o2.count-1 for i = min, max { $o1 = $o2.object(i) iterator_statement if (ifl) { $&3+=1 } else { i1+=1 } } tmpobj=$o2 $o1 = nil } } //** list iterator ltrb -- backwards list iterator // usage 'for ltrb(tmplist) { print XO }' :: 1 arg, assumes XO as dummy // usage 'for ltrb(YO, tmplist) { print YO }' 2 arg, specify dummy // usage 'for ltrb(XO, tmplist, &x) { print XO,x }' :: 3 args, define counter (else i1 default) // :: note that x, i1 must be defined iterator ltrb () { local i if (numarg()==1) { i1=$o1.count-1 for (i=$o1.count()-1;i>=0;i-=1) { XO = $o1.object(i) iterator_statement i1-=1 } tmpobj=$o1 XO=nil } else { if (numarg()==3) $&3=$o2.count-1 else i1=$o2.count-1 for (i=$o2.count()-1;i>=0;i-=1) { $o1 = $o2.object(i) iterator_statement if (numarg()==3) { $&3-=1 } else { i1-=1 } } tmpobj=$o2 $o1 = nil } } //** list iterator ltr2 // usage 'for ltr2(XO, YO, list1, list2) { print XO,YO }' iterator ltr2() { local i,cnt if (numarg()==5) $&5=0 else i1=0 cnt=$o4.count if ($o3.count != $o4.count) { print "ltr2 WARNING: lists have different lengths" if ($o3.count<$o4.count) cnt=$o3.count } for i = 0, cnt-1 { $o1 = $o3.object(i) $o2 = $o4.object(i) iterator_statement if (numarg()==5) { $&5+=1 } else { i1+=1 } } $o1=nil $o2=nil } //** list pairwise iterator ltrp // usage 'for ltrp(XO, YO, list) { print XO,YO }' takes them pairwise iterator ltrp() { local i if (numarg()==4) {$&4=0} else {i1 = 0} for (i=0;i<$o3.count()-1;i+=2) { $o1 = $o3.object(i) $o2 = $o3.object(i+1) iterator_statement if (numarg()==4) { $&4+=1 } else { i1+=1 } } $o1=nil $o2=nil } //** list iterator sltr // usage 'for sltr(XO, string) { print XO }' iterator sltr() { local i tmplist = new List($s2) if (numarg()==3) {$&3=0} else {i1=0} for i = 0, tmplist.count() - 1 { $o1 = tmplist.object(i) iterator_statement if (numarg()==3) { $&3+=1 } else { i1+=1 } } $o1 = nil } //* Procedures //** append(LIST,o1,o2,...) -- like revec() makes a list of objects proc append () { local i,max if (!isassigned($o1)) $o1=new List() max=numarg() if (argtype(max)==0) {max-=1 $o1.remove_all} for i=2,max $o1.append($oi) } //** rcshead([flag]) // with flag does head from archive func rcshead () { local x,flag localobj st x=-1 flag=0 st=new String2() if (numarg()==2) { st=dirname($s1) sprint(st.t,"%sRCS/%s,v",st.s,st.t) flag=1 } else st.t=$s1 sprint(st.s,"head -1 %s",st.t) system(st.s,st.s) if (flag) sscanf(st.s,"head\t1.%d",&x) else sscanf(st.s,"%*[^,],v 1.%d",&x) return x } //** getenv() obfunc getenv () { localobj st st=new String() sprint(st.s,"echo $%s",$s1) system(st.s,st.s) sfunc.left(st.s,sfunc.len(st.s)-1) if (numarg()==2) $s2=st.s return st } //** rcsopen(file,vers[,flag]) -- version open, flag to do load_file // rcsopen(file,vers,proc_name) -- just load the single proc or func from that vers // rcsopen("nqsnet.hoc,43,network.hoc,17,params.hoc,842,run.hoc,241") will open several files func rcsopen () { local a,vers,ii,x,ret localobj st,fn,v1,o,xo st=new String2() ret=1 if (argtype(1)==2) st.s=$s1 else st.s=$o1.s // open network.hoc,params.hoc,run.hoc files for "#.#.#" if (strm(st.s,"^[^,]+,[^,]+,[^,]+,[^,]+")) { a=allocvecs(v1) o=new List() split(st.s,o) for (ii=1;ii1) vers=$2 else vers=0 if (! vers) vers=rcshead(st.s,1) // vers=0 means get latest version // do checkout fn=filname(st.s) sprint(st.t,"RCS/%s,v",st.s) if (sfunc.len(fn.t)>0) { sprint(st.t,"%sRCS/%s,v",fn.t,fn.s) print st.s,"::",st.t,"::",fn.s,"::",fn.t } else if (fexists(st.t)) { if (rcshead(st.s)!=vers) { sprint(st.t,"cp -f %s %s.OLD",st.s,st.s) system(st.t) sprint(st.t,"co -f -r1.%d %s",vers,st.s) system(st.t) } } else { // look for file in remote location getenv("SITE",st.t) sprint(st.t,"%s/nrniv/local/hoc/%s",st.t,st.s) if (! fexists(st.t)) {printf("Can't find %s\n",st.t) return 0} sprint(st.s,"%s%d",st.s,vers) printf("Found %s at %s -> %s\n",$s1,st.t,st.s) sprint(st.t,"co -f -p1.%d %s > %s",vers,st.t,st.s) system(st.t) } if (numarg()>2) { if (argtype(3)==0) { // 3rd arg 1 means do load_file statt xopen if ($3) { load_file(st.s) return 1 } else return 1 // 3rd arg 0 does co but no open } else { // 3rd arg string means locate a single proc, iter etc. sprint(st.s,"hocproc %s %s %s",st.s,$s3,".tmp") system(st.s,st.t) if (strm(st.t,"ERROR")) return 0 else { printf("Loading '%s()' from %s%d (via .tmp)\n",$s3,$s1,vers) xopen(".tmp") return 1 } } } xopen(st.s) return 1 } //** pxopen(FILE) prints out the version before opening a file proc pxopen () { local flag localobj o flag=1 o=new List("ParallelContext") if (o.count>0) if (o.o(0).id!=0) flag=0 if (flag) printf("%s version %d\n",$s1,rcshead($s1)) xopen($s1) } //** lrm(LIST,STR) will remove item with string from LIST proc lrm () { local cnt cnt=0 if (argtype(2)==2) { for ltrb(XO,$o1) if (strm(XO.s,$s2)) { $o1.remove(i1) cnt+=1 } printf("%s found %d time\n",$s2,cnt) } else { $o1.remove($o1.index($o2)) } } //** lcnt(LIST,STR) will count item with string in LIST func lcnt () { local cnt localobj xo cnt=0 for ltr(xo,$o1) if (strm(xo.s,$s2)) cnt+=1 return cnt } //** lrepl(LIST,#,OBJ) will replace item at location # with OBJ proc lrepl () { $o1.remove($2) $o1.insrt($2,$o3) } //** lswap(list,#1,#2) swap items on a list proc lswap () { local a,b if ($2<$3) {a=$2 b=$3} else {a=$3 b=$2} $o1.insrt(a,$o1.object(b)) $o1.remove(b+1) $o1.insrt(b+1,$o1.object(a+1)) $o1.remove(a+1) } //** proc shl() show a list proc shl () { if (numarg()==1) tmpobj=$o1 else tmpobj=tmplist if (tmpobj.count==0) return if (isstring(tmpobj.object(0),tstr)) { for ltr(XO,tmpobj) print XO.s } else for ltr(XO,tmpobj) print XO } //** lfu() = ltr follow-up, pick out a single item from the last ltr request // lfu(list,num[,obj]) proc lfu () { if (numarg()==1) { if (argtype(1)==0) XO=tmpobj.object($1) if (argtype(1)==1) tmpobj=$o1 } if (numarg()==2) { if (argtype(1)==1 && argtype(2)==0) {tmpobj=$o1 XO=$o1.object($2)} if (argtype(1)==0 && argtype(2)==1) {$o2=tmpobj.object($1)} } if (numarg()==3) { if (argtype(1)==1 && argtype(2)==0 && argtype(3)==1) { tmpobj=$o1 $o3=$o1.object($2) } } if (numarg()==4) { $o2=tmpobj.object($1) $o4=tmpobj.object($3) } } //** listedit() allows you to remove things by clicking proc listedit () { if (numarg()==0) { print "listedit(list,str) gives browser(list,str) for removing items" return} if (numarg()==1) { if (! isstring($o1.object(0),temp_string_)) {print "Give name for string of object?" return } sprint(temp_string_,"proc ledt1 () {sprint(temp_string_,%s,hoc_ac_,%s.object(hoc_ac_).%s)}","\"%d:%s\"",$o1,"s") } else { sprint(temp_string_,"proc ledt1 () {sprint(temp_string_,%s,hoc_ac_,%s.object(hoc_ac_).%s)}","\"%d:%s\"",$o1,$s2) } execute1(temp_string_) $o1.browser("Double click to remove",temp_string_,"ledt1()") sprint(temp_string_,"%s.remove(hoc_ac_)",$o1) $o1.accept_action(temp_string_) } //** crac() create and access proc crac () { execute("create acell_home_") execute("access acell_home_") } //** listXO() connects stuff to XO from a list proc listXO () { if (numarg()==1) { $o1.browser("Double click") sprint(temp_string_,"print hoc_ac_,\":XO -> \",%s.object(hoc_ac_) XO = %s.object(hoc_ac_)",$o1,$o1) $o1.accept_action(temp_string_) } else if (numarg()==2) { $o1.browser($s2) sprint(temp_string_,"XO = %s.object(hoc_ac_) print %s.object(hoc_ac_).%s",$o1,$o1,$s2) $o1.accept_action(temp_string_) } else if (numarg()==3) { $o1.browser($s2) sprint(temp_string_,"XO = %s.object(hoc_ac_) print %s.object(hoc_ac_).%s,%s.object(hoc_ac_).%s",$o1,$o1,$s2,$o1,$s3) $o1.accept_action(temp_string_) } } //** lcatstr(list,s1,s2,...) make new List("s1") new List("s2") ... in one list proc lcatstr() { local i if (numarg()<3) { print "lcatstr(l1,s1,s2,...) puts new Lists into l1" return } $o1 = new List($s2) for i=3,numarg() { tmplist2 = new List($si) for ltr(XO,tmplist2) { $o1.append(XO) } } } //** sublist() places a sublist in LIST0 from LIST1 index BEGIN to END inclusive proc sublist () { local ii $o1.remove_all for ii=$3,$4 { $o1.append($o2.object(ii)) } } //* catlist() concats LIST2...LISTN on end of LIST1 proc catlist () { local i for i = 2, numarg() { for ltr(YO,$oi) { $o1.append(YO) } } } //* mechlist() creates a LIST of all this CELL type's TEMPLATE type // list, cell, template // make a list of mechanisms belonging to a certain template proc mechlist () { local num,ii // mchnms = "" // not a good storage since runs out of room if (numarg()==0) { print "mechlist(list, cell, template)" return} $o1 = new List($s2) num = $o1.count for ii=0,num-1 { sprint(temp_string_,"%s.append(%s.%s)",$o1,$o1.object(ii),$s3) execute(temp_string_) sprint(mchnms,"%s/%d/%s.%s",mchnms,ii,$o1.object(ii),$s3) } for (ii=num-1;ii>=0;ii=ii-1) { $o1.remove(ii) } } //* lp() loop through a list running command in object's context // assumes list in tmplist // with 1 args run $o1.object().obj_elem // with 2 args run comm($o1.object().obj_elem) proc lp () { for ii=0,tmplist.count-1 { printf("%s ",tmplist.object(ii)) if (numarg()==2) { sprint(temp_string_,"%s(%s.%s)",$s2,tmplist.object(ii),$s1) } else { sprint(temp_string_,"%s.%s",tmplist.object(ii),$s1) } execute(temp_string_) } } //* prlp() loop through a list printing object name and result of command proc prlp () { tmpobj=tmplist if (numarg()>0) if (argtype(1)==1) tmpobj=$o1 for ltr(XO,tmpobj) { printf("%d %s ",i1,XO) if (numarg()>1) { sprint(temp_string_,"print %s.%s",XO,$s2) execute(temp_string_) } else { print "" } } } //* String functions //** repl_str(str,stra,strb): replace stra with strb in string // will only replace first string match proc repl_str() { localobj scr scr=new String() if (sfunc.head($s1,$s2,scr.s) == -1) { print $s2," not in ",$s1 return } sfunc.tail($s1,$s2,scr.s) sprint(scr.s,"%s%s",$s3,scr.s) sfunc.head($s1,$s2,$s1) sprint($s1,"%s%s",$s1,scr.s) } //** find_str(str,left,right,dest): pull out dest flanked by left and right proc find_str() { if (sfunc.tail($s1,$s2,$s4) == -1) { print $s2," not in ",$s1 return } sfunc.head($s4,$s3,$s4) } //** find_num(str,left,right): pull out number flanked by left and right func find_num() { local x localobj st st=new String() if (sfunc.tail($s1,$s2,st.s) == -1) { print $s2," not in ",$s1 return } sfunc.head(st.s,$s3,st.s) sscanf(st.s,"%g",&x) return x } //** repl_mstr(str,stra,strb): replace stra with strb in string // multiple replace proc repl_mstr () { localobj scr scr=new String() while (sfunc.head($s1,$s2,scr.s) != -1) { sfunc.tail($s1,$s2,scr.s) sprint(scr.s,"%s%s",$s3,scr.s) sfunc.head($s1,$s2,$s1) sprint($s1,"%s%s",$s1,scr.s) } } //** extract(str,stra,strb[,dest]): pull out piece of string surrounded by stra,strb obfunc str_extract() { local b,e,err localobj scr scr=new String2() err=0 b=sfunc.tail($s1,$s2,scr.s) // scr.s contains after s2 if (b==-1){printf("%s not found in %s\n",$s2,$s1) err=1} e=sfunc.head(scr.s,$s3,scr.t) // beg of s3 if (e==-1){printf("%s not found in %s\n",$s3,scr.s) err=1} if (err) scr.s="" else sfunc.left(scr.s,e) if (numarg()==4) $s4=scr.s return scr } //** clean_str(str,scratch,s1,s2,s3,...) // remove serial $si from string proc clean_str () { local i for i=3,numarg() { while (sfunc.head($s1,$si,$s2) != -1) { sfunc.tail($s1,$si,$s2) sfunc.head($s1,$si,$s1) sprint($s1,"%s%s",$s1,$s2) } } } //** aaaa() (or $o2) becomes a list of strings from file $s1 proc aaaa () { local flag if (numarg()==2) { tmpfile.ropen($s1) aa=$o2 flag=0 } else if (numarg()==1) { tmpfile.ropen($s1) flag=1 } else { tmpfile.ropen("aa") flag=1 } if (flag==1) if (isobj(aa,"List")) { aa.remove_all() } else { aa=new List() } while (tmpfile.gets(temp_string_)>0) { chop(temp_string_) tmpobj=new String(temp_string_) aa.append(tmpobj) } tmpobj=nil } //* Object identification //** objid() find information about object -- replaces var2obj, canobj, objnum obfunc objid () { local flag localobj xo xo=new Union() if (argtype(1)==1) sprint(xo.s,"tmpobj=%s",$o1) else sprint(xo.s,"tmpobj=%s",$s1) execute(xo.s) // change variable name to object name xo.o=tmpobj sprint(xo.s,"%s",xo.o) sscanf(xo.s,"%*[^[][%d]",&xo.x) return xo } //** var2obj() and canobj() -- find true object names // var2obj("tstr"[,"objvar"]) replaces variable name with actual name of the object // default into XO; optional second arg allows to place somewhere else // eg tstr="TC[0].ampa" var2obj(tstr) -> AMPA[0] proc var2obj () { local flag if (numarg()==1) flag=1 else flag=0 if (flag) sprint($s1,"XO=%s",$s1) else sprint($s1,"%s=%s",$s2,$s1) execute($s1) // change variable name to object name if (flag) sprint($s1,"%s",XO) else sprint($s1,"%s",$s2) printf("var2obj() PLEASE REPLACE WITH objid()\n") } //** objnum(OBJ) -- find object number func objnum () { local x localobj st st=new String() if (argtype(1)==1) sprint(st.s,"%s",$o1) else st.s=$s1 if (sscanf(st.s,"%*[^[][%d]",&x) != 1) x=-1 return x } proc allobjs () { hoc_stdout($s1) allobjects() hoc_stdout() } //** strnum(str,"PRE") -- pull number out of a string func strnum () { local x localobj st st=new String2($s1) sfunc.tail(st.s,$s2,st.t) if (sscanf(st.t,"%d",&x) != 1) x=-99e99 return x } //** canobj(obj[,"OBJVAR"]) -- default will assign to XO // canonical object -- return canonical identity for an object // eg canobj(tc,"YO") -- figure out what tc is and assign it to YO proc canobj () { local flag if (numarg()==1) flag=1 else flag=0 if (flag) sprint(tstr,"XO=%s",$o1) else sprint(tstr,"%s=%s",$s2,$o1) execute(tstr) // change variable name to object name sprint(tstr,"%s",$o1) printf("canobj() PLEASE REPLACE WITH objid()\n") } //* push() and pop() for objects -- returns proc push () { local i for i=2,numarg() $o1.append($oi) } //** pop() obfunc pop () { local i,cnt localobj o cnt=$o1.count-1 if (cnt==-1) { print "ERR: unable to pop" return } o=$o1.object(cnt) $o1.remove(cnt) return o } //* time() strdef tmstr tmstr="run()" func time () { local tti,uintmax,cps uintmax=4294967295 // UINT_MAX/CLOCKS_PER_SEC cps=1e6 // CLOCKS_PER_SEC tti=prtime() system("date") if (numarg()==1) execute1($s1) else execute1(tmstr) tti=prtime()-tti if (tti<0) tti+=uintmax if (tti=ii) if (argtype(ii)==0) rev=1 a=allocvecs(v1,v2,il.count) nl=new List() if (!name_declared("oform")) err=1 if (!err) if (oform(v1)==NOP) err=1 if (err) {printf("sortlist uses oform()\n") error()} for ltr(xo,il) v1.append(oform(xo)) v1.sortindex(v2) if (rev) v2.reverse for ii=0,v2.size-1 nl.append(il.o(v2.x[ii])) if ((na==2 && !rev) || na==3) $o2=nl else { il.remove_all for ltr(xo,nl) il.append(xo) } dealloc(a) } func assoc () { local i,ty,ii localobj xo // object_push(xo) ty=name_declared("s",1) object_pop() // strdef:4, dbl:5 for ltr(xo,$o2,&ii) { if (argtype(1)==2) { if (strcmp(xo.s,$s1)==0) break } else if (argtype(1)==0) { if (xo.x==$1) break } } if ($o2.count==ii) return -1 else return ii } // assoco() like assoc but returns the object instead of the index obfunc assoco () { local i,ty,ii localobj xo // object_push(xo) ty=name_declared("s",1) object_pop() // strdef:4, dbl:5 for ltr(xo,$o2,&ii) { if (argtype(1)==2) { if (strcmp(xo.s,$s1)==0) break } else if (argtype(1)==0) { if (xo.x==$1) break } } if ($o2.count==ii) return nil else return xo } // excu() does the associative search and executes the resultant string // eg excu("key",list) excu("key",list,"arg1"[,"arg2","arg3"...]) func excu () { local i,ty,ii localobj xo,o,st o=$o2 // object_push(xo) ty=name_declared("s",1) object_pop() // strdef:4, dbl:5 for ltr(xo,o,&ii) { if (argtype(1)==2) { if (strcmp(xo.s,$s1)==0) break } else if (argtype(1)==0) { if (xo.x==$1) break } } if (o.count!=ii) { if (sfunc.len(xo.t)==0) return 0 // empty string st=strcat(st,"hoc_ac_=",xo.t,"(") if (numarg()>2) { for i=3,numarg() { if (argtype(i)==2) { sprint(st.s,"%s%s,",st.s,$si) } else if (argtype(i)==0) { sprint(st.s,"%s%g,",st.s,$i) } else if (argtype(i)==1) { sprint(st.s,"%s%s,",st.s,$oi) } } chop(st.s) } strcat(st,")") execute(st.s) // print st.s return hoc_ac_ } else return 0 } // LAR: list_array is list used as an array begintemplate LAR public l,set,x,size,nil,resize,get,lt objref l,nil double size[1] proc init () { local ii size=$1 l=new List() for ii=0,size-1 l.append(l) // place holder } func set () { local ix ix=$1 if (ix>=size) {printf("LAR set OOR %d>=%d\n",ix,size) return -1} l.remove(ix) l.insrt(ix,$o2) return ix } obfunc x () { if (eqojt(l,l.o($1))) return nil else return l.o($1) } obfunc get () { if (eqojt(l,l.o($1))) return nil else return l.o($1) } proc resize () { local newsz,ii newsz=$1 if (newsz=newsz;ii-=1) l.remove(ii) } else if (newsz>size) { for ii=size,newsz-1 l.append(l) } size=newsz } iterator lt () { local ii for ii=0,size-1 if (!eqojt(l,l.o(ii))) { $o1=l.o(ii) iterator_statement } } endtemplate LAR // END /usr/site/nrniv/local/hoc/declist.hoc //================================================================ print "Loading decvec" fnum=verbose=0 {symnum = 7 colnum = 10} func cg () { return $1%(colnum-1)+1 } // skip white color objref clrsym[colnum+1] for ii=0,colnum { clrsym[ii]=new Union() clrsym[ii].x=ii%colnum } // black->red->blue->green->orange->brown->violet->yellow->grey {clrsym[0].s="white" clrsym[1].s="black" clrsym[2].s="red" clrsym[3].s="blue" clrsym[4].s="green" clrsym[5].s="orange" clrsym[6].s="brown" clrsym[7].s="violet" clrsym[8].s="yellow" clrsym[9].s="grey"} clrsym[0].o=new List() {symmax=20 symmin=2} obfunc sg () { local ii localobj o ii=$1 o=clrsym[ii%(colnum-1)+1] o.x=ii%(colnum-1)+1 o.t=clrsym[0].o.o(ii%symnum).s o.x[1]=(3-ii)%4+1 // descending line types o.x[2]=(symmax-symmin-2*ii)%(symmax-symmin+1)+symmin o.x[3]=(4-ii)%(symmax-symmin+1)+symmin o.x[4]=(int((ii+1)/5)%2+1)*4-(ii+1)%4+1 // another line type sequence return o } { MSONUM=100 MSOSIZ=100 msomax=0 msoptr=0 objref mso[MSONUM] } double x[4],y[4] xx=0 // declare a scalar ind = new Vector(100) tvec = new Vector(100) vec = new Vector(100) vec0 = new Vector(10) vec1 = new Vector(10) vrtmp = new Vector(10) veclist = new List() veccollect = new List() rdm = new Random() rdm.MCellRan4() if (!(xwindows && name_declared("xwindows"))) { xwindows=0 objref graphItem strdef temp_string_, temp_string2_ } //* stuff that doesn't belong here //** dired([list,]file) - put together list of files matching 'file', calls 'ls -1 file' // dired([list,]file,1) file name to read for list of files // dired([list,]file,2) clear dir first; if list isn't present assume 'dir' func dired () { local f,i,f1 localobj st,o f1=f=0 st=new String2() if (numarg()==0) { print "dired([list,]filename[,flag])\t\ adds the filename to list (use wildcards) (flag:1 read file;flag:2 clear list)" return 0 } if (argtype(1)==2) {o=dir st.s=$s1 i=2} else {o=$o1 st.s=$s2 i=3} while (i<=numarg()) { if (argtype(i)==2) st.t=$si else f=$i i+=1 } if (f==2) o.remove_all if (f==1) { tmpfile.ropen(st.s) } else { // f!=1 rmxtmp() if (strm(st.s,"[*?]")) f1=0 else f1=1 // is this a wildcard or a directory if (f1) { if (sfunc.len(st.t)>0) { sprint(st.t,"find %s -name %s >> %s",st.s,st.t,xtmp) } else sprint(st.t,"find %s >> %s",st.s,xtmp) } else sprint(st.t,"ls -1R %s >> %s",st.s,xtmp) system(st.t) tmpfile.ropen(xtmp) } while (tmpfile.scanstr(st.t) != -1) { if (f1) { // a directory if ((x=ftype(st.t))!=2) {print "Ignoring ",st.t,x continue} } o.append(new String(st.t)) tmpfile.gets(st.t) // get rid of the rest of the line } printf("%d files in dir\n",o.count) return o.count } // lsdir([dir]) proc lsdir () { if (numarg()==1) { for ltr($o1) {sprint(tstr,"ls -l %s",XO.s) system(tstr)} } else for ltr(dir) {sprint(tstr,"ls -l %s",XO.s) system(tstr)} } //** lbrw(list,action) is used to put up a browser // note action given without '()' proc lbrw () { $o1.browser($s2,"s") sprint($s2,"%s()",$s2) $o1.accept_action($s2) } //** l2v(S1,S2) makes a list(S1) and puts all the XO.S2 into vec // eg l2v("IClamp","amp") proc l2v () { tmpobj=new List($s1) if (numarg()==3) YO=$o3 else YO=vec YO.resize(tmpobj.count) YO.resize(0) for ltr(tmpobj) { sprint(tstr,"YO.append(%s.%s)",XO,$s2) execute(tstr) } } //* vector iterator vtr // for vtr(vec) { print x } // for vtr(&x, vec) { print x } // for vtr(&x, vec, &y) { print x,y } // for vtr(&x, vec, max_ind) { print x } // for vtr(&x, vec, min_ind, max_ind) { print x } // for vtr(&x, vec, &y, min_ind, max_ind) { print x,y } iterator vtr () { local i,j,pf,cf,b,e localobj o cf=pf=0 if (argtype(1)==1) { // 1st arg a vector or the pointer o=$o1 i=2 } else if (argtype(1)==3) { pf=1 o=$o2 i=3 // pointer alway in position 1 } b=0 e=o.size-1 // default: do whole vec // now can take counter or limits if (argtype(i)==3) {cf=i i+=1} // cf gives counter location if (argtype(i)==0) { if (argtype(i+1)==0) {b=$i i+=1 e=$i} else e=$i } if (!cf) i1=0 else {i=cf $&i=0} // default counter for j=b,e { if (pf) $&1=o.x[j] else x=o.x[j] iterator_statement if (cf) $&i+=1 else i1+=1 } } //* vector iterator vtr2, treat two vectors as pairs // usage 'for vtr2(&x, &y, vec1, vec2) { print x,y }' iterator vtr2 () { local i,pairwise,noi1 noi1=pairwise=0 if (numarg()==3) { pairwise=1 i1=0 } if (numarg()==4) if (argtype(4)==3) { pairwise=1 $&4=0 noi1=1} if (pairwise) if ($o3.size%2!=0) { print "vtr2 ERROR: vec not even sized." return } if (! pairwise) { if ($o3.size != $o4.size) { print "vtr2 ERROR: sizes differ." return } if (numarg()==5) {$&5=0 noi1=1} else {i1 = 0} } for i = 0,$o3.size()-1 { $&1 = $o3.x[i] if (pairwise) $&2=$o3.x[i+=1] else $&2=$o4.x[i] iterator_statement if (noi1) { if (pairwise) $&4+=1 else $&5+=1 } else i1+=1 } } //** viconv(TARG,OLD_INDS,NEW_INDS) proc viconv () { local a,b if (numarg()==0) { printf("viconv(TARG,OLD_INDS,NEW_INDS)\n") return } a=b=allocvecs(2) b+=1 if ($o2.size!=$o3.size) {printf("OLD_INDS %d != NEW_INDS %d\n",$o2.size,$o3.size) return} mso[b].resize($o1.size) for vtr2(&x,&y,$o2,$o3) { // x -> y mso[a].indvwhere($o1,"==",x) mso[b].indset(mso[a],y) } $o1.copy(mso[b]) dealloc(a) } //* iterator lvtr, step through a list and a vector together // usage 'for lvtr(XO, &x, list, vec) { print XO,x }' iterator lvtr () { local i if ($o3.count < $o4.size) { printf("lvtr ERROR: vecsize > listsize: list %d,vec %d.\n",$o3.count,$o4.size) return } if ($o3.count != $o4.size) { printf("lvtr WARNING: sizes differ: list %d,vec %d.\n",$o3.count,$o4.size) } if (numarg()==5) {$&5=0} else {i1 = 0} for i = 0, $o4.size()-1 { $o1 = $o3.object(i) $&2 = $o4.x[i] iterator_statement if (numarg()==5) { $&5+=1 } else { i1+=1 } } } //* other iterators: case, scase, ocase iterator case () { local i,j,max,flag if (argtype(numarg())==3) {flag=1 max=numarg()-1} else {flag=0 max=numarg()} if (flag) {i=max+1 $&i=0} else i1 = 0 for i = 2, max { $&1 = $i iterator_statement if (flag) {j=i i=max+1 $&i+=1 i=j} else i1+=1 } } iterator scase () { local i,j,min,max,flag if (argtype(numarg())==3) {flag=1 max=numarg()-1} else {flag=0 max=numarg()} if (flag) {i=max+1 $&i=0} else i1=0 if (argtype(1)==1) { if (! isobj($o1,"String")) $o1=new String() // will accept String or String2 min=2 } else min=1 for i = min,max { if (min==1) temp_string_=$si else $o1.s=$si iterator_statement if (flag) {j=i i=max+1 $&i+=1 i=j} else i1+=1 } } // eg for scase2("a","b","c","d","e","f") print tmpobj.s,tmpobj.t iterator scase2 () { local i,min,flag,na,newstr localobj o flag=i1=0 newstr=min=1 na=numarg() if (argtype(na)==0) {i=na newstr=$i na-=1} if (argtype(1)==1) {flag=1 min=2} for i=min,na { if (i==min || newstr) o=new String2() o.s=$si i+=1 o.t=$si if (flag) $o1=o else tmpobj=o iterator_statement i1+=1 } } iterator ocase () { local i i1 = 0 if (isassigned($o1)) { for i = 1, numarg() { XO = $oi iterator_statement i1+=1 } XO=nil } else { for i = 2, numarg() { $o1 = $oi iterator_statement i1+=1 } } XO=nil } //* strm(STR,REGEXP) == regexp string match func strm () { return sfunc.head($s1,$s2,"")!=-1 } func strc () { return strcmp($s1,$s2)==0 } //** count_substr(str,sub): count occurences of substring in str func count_substr () { local cnt cnt = 0 while (sfunc.tail($s1,$s2,$s1) != -1) { cnt += 1} return cnt } //* nind(targ,data,ind) fill the target vector with data NOT index by ind (opposite of v.index) proc nind () { if (! eqobj($o1,$o2)) $o1.copy($o2) $o1.indset($o3,-1e20) $o1.where($o1,">",-1e20) } //* vlk(vec) // vlk(vec,max) // vlk(vec,min,max) // vlk(vec,min,max,"INDEX") -- give index of each entry // prints out a segment of a vector vlk_width=80 proc vlkomitoff () { execute1("func vlkomit () {return NOP}") } proc vlkomit0(){execute1("func vlkomit(){if(vcnt($o1,0)==$o1.size) return 1 else return 0}")} vlkomitoff() proc vlk () { local ii,i,j,ami,min,max,wdh,nl,na,width,tablen,omfl,ixfl localobj st,v1,vi st=new String2() v1=new Vector(numarg()) vi=new Vector() nl=1 wdh=vlk_width j=0 omfl=ixfl=0 ami=2 na=numarg() min=0 max=$o1.size-1 if (vlkomit(v1)!=NOP) omfl=1 // omfl to omit printing some if (argtype(na)==2) {i=na if (strm($si,"I")) {ixfl=1 vrsz($o1,vi) vi.indgen ami=1} na-=1 } if (argtype(na)==0) {i=na if ($i<0) min=$i else max=$i na-=1 } if (argtype(na)==0) {i=na min=$i na-=1} if (max<0) max+=$o1.size if (min<0) min+=$o1.size if (max>$o1.size-1) { max=$o1.size-1 printf("vlk: max beyond $o1 size\n") } sprint(st.t,"%%s:%s",dblform) width=0 if (strm(tabform,"\t")) tablen=6 else if (strm(tabform,"\n")) tablen=-1e5 else { tablen=sfunc.len(tabform) } for ii=min,max { if (omfl) { v1.resize(0) for i=1,na v1.append($oi.x[ii]) if (vlkomit(v1)) continue } if (ixfl) sprint(st.s,dblform,vi.x[ii]) else sprint(st.s,dblform,$o1.x[ii]) for i=ami,na sprint(st.s,st.t,st.s,$oi.x[ii]) width+=(sfunc.len(st.s)+tablen) if (width>vlk_width && nl) {printf("\n") width=0} printf("%s%s",st.s,tabform) } if (nl) print "" } //** vlkp(SRC,PVEC) uses indices in PVEC to print out values in SRC proc vlkp () { local i,j,wdh j=0 nl=1 wdh=vlk_width if (numarg()==2) { for vtr(&x,$o1) { printf("%g%s",$o2.x[x],tabform) if ((j=j+1)%vlk_width==0 && nl && strcmp(tabform," ")==0) { print "" } } } else { for vtr(&x,$o1) { for i=2,numarg() printf("%g%s",$oi.x[x],tabform) print "" } } if (nl) print "" } //* vprf() prints 1,2 or 3 vectors in parallel to output file proc vprf () { local x2 if (! tmpfile.isopen()) { print "Writing to temp file 'temp'" tmpfile.wopen("temp") } if (numarg()==1) { for vtr(&x,$o1) { tmpfile.printf("%g\n",x) } } else if (numarg()==2) { for vtr2(&x,&y,$o1,$o2) { tmpfile.printf("%g %g\n",x,y) } } else if (numarg()==3) { for vtr2(&x,&y,$o1,$o2,&ii) { x2=$o3.x[ii] tmpfile.printf("%g %g %g\n",x,y,x2) } } tmpfile.close } //* vpr() prints 1,2 or 3 vectors in parallel to STDOUT proc vpr () { local x2 if (numarg()==1) { for vtr(&x,$o1) { printf("%g",x) } } else if (numarg()==2) { for vtr2(&x,&y,$o1,$o2) { printf("%g:%g ",x,y) } } else if (numarg()==3) { for vtr2(&x,&y,$o1,$o2,&ii) { x2=$o3.x[ii] printf("%g:%g:%g ",x,y,x2) } } print "" } //* readvec(vec) read from line proc readvec () { $o1.resize(0) while (read(xx)) $o1.append(xx) vlk($o1) } //* popvec(), savenums, readnums, vecsprint, savevec, savestr // vrsz(), vcp(), zvec(), resize, copy, empty proc pushvec () { local i // same as .append, retained for compatability for i=2, numarg() $o1.append($i) } //** insvec(VEC,IND,VAL1[,VAL2,...]) insert values into the vector proc insvec () { local ix,i,a // insert values into a vector a=allocvecs(1) ix=$2 for i=3, numarg() mso[a].append($i) $o1.insrt(ix,mso[a]) dealloc(a) } //** revec() clear vector then append proc revec () { local i,x localobj o,st // clear vector then append if (! isobj($o1,"Vector")) $o1=new Vector(100) if (argtype(2)==2) { o=$o1 o.resize(0) st=new String2($s2) if (strm(st.s,",")) { // use split split(st.s,o) } else if (strm(st.s," ")) { split(st.s,o," ") } else while (sfunc.len(st.s)>0) { // assume binary vector, could generalize for hex and base64 sscanf(st.s,"%1d",&x) o.append(x) sfunc.tail(st.s, ".", st.t) st.s=st.t } } else for (i=1;i<=numarg();i+=1) { ty=argtype(i) if (ty==1) { o=$oi o.resize(0) } else if (ty==0) { o.append($i) } else if (ty==3) { o.append($&i) } } } //** unvec(VEC,&a,&b,...) put values from vector back into doubles (via pointers) proc unvec () { local i if ($o1.size!=numarg()-1) { printf("unvec WARNING resizing %s to %d\n",$o1,numarg()-1) $o1.resize(numarg()-1) } for i=2,numarg() $&i=$o1.x[i-2] } //** wevec(VEC,wt0,wt1,...) returned weighted sum func wevec () { local i,sum if ($o1.size!=numarg()-1) { printf("wevec SIZE ERR %d %d\n",$o1.size,numarg()-1) return } sum=0 for i=2,numarg() sum+=$o1.x[i-2]*$i return sum } //** vrsz(VEC or NUM,VEC1,VEC2...,VECn or NUM) -- vector resize -- to size of first arg // optional final number is fill func vrsz () { local i,sz,max,fill,flag,rsz0 max=numarg() flag=rsz0=0 if (argtype(1)==1) { if (isobj($o1,"Vector")) sz=$o1.size else if (isobj($o1,"List")) sz=$o1.count } else sz=$1 if (argtype(max)==0) {i=max max-=1 fill=$i flag=1} if (argtype(max)==2) {max-=1 rsz0=1} // string means resize(0) if (sz<0) sz+=$o2.size // reduce size if (sz<0) {printf("vrsz ERR: can't resize %s to %d\n",$o2,sz) return sz} for i=2, max { $oi.resize(sz) if (rsz0) $oi.resize(0) else if (flag) $oi.fill(fill) } return sz } //** vcp() -- copy vector segment with resizing proc vcp () { local i,sz $o1.resize($4-$3+1) $o1.copy($o2,$3,$4) } //** veccut(VEC,min,max) just keep a piece of the vector // veccut(VEC,min,max,tstep) generate indices from times using tstep proc veccut () { local a localobj v1 a=allocvecs(v1) if (numarg()==4) { min=round($2/$4) max=round($3/$4) } else { min=$2 max=$3 } v1.copy($o1,min,max) $o1.copy(v1) dealloc(a) } //** zvec() proc zvec () { local i // make vectors zero size for i=1, numarg() $oi.resize(0) } //* save and read series //** savenums(x[,y,...]) save numbers to tmpfile via a vector proc savenums () { local i,vv vv=allocvecs(1) for i=1, numarg() mso[vv].append($i) mso[vv].vwrite(tmpfile) dealloc(vv) } //** savedbls(&x,sz) save a double array of size sz proc savedbls () { local vv,i vv=allocvecs(1) mso[vv].from_double($2,&$&1) mso[vv].vwrite(tmpfile) dealloc(vv) } //** readnums(&x[,&y...]) recover nums from tmpfile via a vector func readnums () { local vv,i,cnt vv=allocvecs(1) cnt=0 if (mso[vv].vread(tmpfile)) { if (numarg()!=mso[vv].size) { printf("readnums WARNING: args=%d;vec.size=%d\n",numarg(),mso[vv].size) if (numarg()>mso[vv].size) { for i=1,mso[vv].size $&i = mso[vv].x[i-1] cnt=mso[vv].size } } if (cnt==0) { for i=1,numarg() $&i = mso[vv].x[i-1] cnt=numarg() } } else cnt=-1 dealloc(vv) return cnt } //** readdbls(&x,sz) read a double array of size sz func readdbls () { local vv,i,flag vv=allocvecs(1) flag=1 if (mso[vv].vread(tmpfile)) { mso[vv].v2d(&$&1) // seg error risk } else flag=0 dealloc(vv) return flag } //** wrvstr(str) save string to a file by converting to ascii proc wrvstr () { local vv,i vv=allocvecs(1) str2v($s1,mso[vv]) mso[vv].vwrite(tmpfile,1) dealloc(vv) } //** rdvstr(str) read string from a file via vread and conversion func rdvstr () { local vv,i,flag flag=1 vv=allocvecs(1) if (mso[vv].vread(tmpfile)) { if (numarg()==1) v2str(mso[vv],$s1) else v2str(mso[vv],tstr) } else flag=0 dealloc(vv) return flag } //** str2v() proc str2v () { localobj lo lo=new String() $o2.resize(0) lo.s=$s1 while (sfunc.len(lo.s)>0) { sscanf(lo.s,"%c%*s",&x) sfunc.right(lo.s,1) $o2.append(x) } } //** v2str() translates from vector to string proc v2str () { local ii,x $s2="" round($o1) for ii=0,$o1.size-1 { x=$o1.x[ii] sprint($s2,"%s%c",$s2,x) } } //* popvec() remove last entry func popvec () { local sz, ret sz = $o1.size-1 if (sz<0) return 1e9 ret = $o1.x[sz] $o1.resize[sz] return ret } //* chkvec (look at last entry) func chkvec () { if ($o1.size>0) return $o1.x[$o1.size-1] else return -1e10 } // vecsprint(strdef,vec) proc vecsprint () { local ii if ($o2.size>100) { return } for ii=0,$o2.size-1 { sprint($s1,"%s %g ",$s1,$o2.x[ii]) } } // savevec([list,]vec1[,vec2,...]) add vector onto veclist or other list if given as 1st arg // don't throw out vectors func savevec () { local i,flag,beg localobj v1 if (numarg()==0) { savevec(hoc_obj_[0],hoc_obj_[1]) return } if (isobj($o1,"List")) beg=2 else beg=1 for i=beg, numarg() { if (veccollect.count>0) { // grab a vector from garbage collection v1=veccollect.object(veccollect.count-1) veccollect.remove(veccollect.count-1) } else v1 = new Vector($oi.size) v1.copy($oi) if (beg==2) $o1.append(v1) else veclist.append(v1) } if (beg==2) return $o1.count-1 else return veclist.count-1 } // prveclist(filename[,list]) proc prveclist () { localobj xo if (!batch_flag && tmpfile.ropen($s1)) { printf("%s exists; save anyway? (y/n) ",$s1) getstr(temp_string_) chop(temp_string_) if (strcmp(temp_string_,"y")!=0) return } if (! tmpfile.wopen($s1)) { print "Can't open ",$s1 return } if (numarg()==2) { for ltr(xo,$o2) xo.vwrite(tmpfile) } else { for ltr(xo,veclist) xo.vwrite(tmpfile) } tmpfile.close() } // prvl2(filename[,list]) --- save using a more standard fwrite proc prvl2 () { localobj xo,o if (!batch_flag && tmpfile.ropen($s1)) { printf("%s exists; save anyway? (y/n) ",$s1) getstr(temp_string_) chop(temp_string_) if (strcmp(temp_string_,"y")!=0) return } if (! tmpfile.wopen($s1)) { print "Can't open ",$s1 return } if (numarg()==2) o=$o2 else o=veclist for ltr(xo,o) {tmpfile.printf("%d\n",xo.size) xo.fwrite(tmpfile)} tmpfile.close() } // rdveclist("FILENAME"[,list]) // rdveclist("FILENAME"[,NOERASE]) proc rdveclist () { local flag,a flag=0 a=allocvecs(1) if (numarg()==1) { flag=1 clrveclist() } else if (argtype(2)==1) $o2.remove_all else flag=1 if (! tmpfile.ropen($s1)) { print "Can't open ",$s1 return } while (mso[a].vread(tmpfile)) { if (flag) savevec(mso[a]) else savevec($o2,mso[a]) } tmpfile.close() tmpobj=veclist dealloc(a) } // rdvecs("FILENAME",vec1,vec2,...) proc rdvecs () { local i if (! tmpfile.ropen($s1)) { print "Can't open ",$s1 return } for i=2,numarg() { if ($oi==nil) $oi=new Vector() if ($oi.vread(tmpfile)==0) printf("WARNING nothing to read into %s\n",$oi) } tmpfile.close() } // svvecs("FILENAME",vec1,vec2,...) proc svvecs () { local i clrveclist() for i=2,numarg() savevec($oi) prveclist($s1) clrveclist() } // vpad(vec,howmany,val[,right]) proc vpad () { local a a=allocvecs(1) mso[a].resize($2) mso[a].fill($3) if (numarg()==4) $o1.append(mso[a]) else { mso[a].append($o1) $o1.copy(mso[a]) } dealloc(a) } // vtrunc(vec,howmany[,right]) proc vtrunc () { local a if (numarg()==3) $o1.resize($o1.size-$2) else { $o1.reverse $o1.resize($o1.size-$2) $o1.reverse } } proc rdxy () { local a a = allocvecs(1) revec(ind,vec) tmpfile.ropen("aa") mso[a].scanf(tmpfile) if (mso[a].size%2!=0) {print "rdxy ERR1 ",mso[a].size return} for vtr2(&x,&y,mso[a]) {ind.append(x) vec.append(y)} print ind.size," points read from aa into ind and vec" dealloc(a) } // closest(vec,num) -- return ind for vec member closest to num func closest () { local a,ret a=allocvecs(1) mso[a].copy($o1) mso[a].sub($2) mso[a].abs ret=mso[a].min_ind dealloc(a) return ret } // memb(TEST#,#1,#2,...) -- true if the TEST# is in the list func memb () { local na,i for i=2,numarg() if ($1==$i) return 1 return 0 } proc clrveclist () { localobj o,xo if (numarg()==1) o=$o1 else o=veclist for ltr(xo,o) { xo.resize(0) veccollect.append(xo) } o.remove_all() } // savestr(str1...) add string obj onto tmplist proc savestr () { local i if (argtype(1)==1) for i=2, numarg() $o1.append(new String($si)) else { for i=1, numarg() tmplist.append(new String($si)) } } // redund with v.count in vecst.mod func vcount () { local val,sum val=$2 sum=0 for vtr(&x,$o1) if (x==val) sum+=1 return sum } // tvecl(inlist[,outlist]) -- transpose veclist obfunc tvecl () { local x,cnt,sz,err,ii,p localobj xo,il,ol il=$o1 if (numarg()>1) ol=$o2 if (!isassigned(ol)) {ol=veclist clrveclist()} else ol.remove_all err=0 cnt=il.count sz=il.o(0).size for ltr(xo,il,&x) if (xo.size!=sz) err=x if (err) { print "Wrong size vector is #",x return ol } p = allocvecs(1,cnt) mso[p].resize(cnt) for ii=0,sz-1 { for jj=0,cnt-1 mso[p].x[jj] = il.o(jj).x[ii] savevec(ol,mso[p]) } dealloc(p) return ol } //* vinsect(v1,v2,v3) -- v1 gets intersection (common members) of v2,v3 // replaced by v.insct() in vecst.mod proc vinsect () { $o1.resize(0) for vtr(&x,$o2) for vtr(&y,$o3) if (x==y) $o1.append(x) } //* vecsplit(vec,vec1,vec2[,vec3,...]) // splits vec into other vecs given proc vecsplit () { local num,ii,i num = numarg()-1 // how many for i=2,numarg() $oi.resize(0) for (ii=0;ii<$o1.size;ii+=num) { for i=2,numarg() if (ii+i-2<$o1.size) $oi.append($o1.x[ii+i-2]) } } //* vecsort(vec,vec1,vec2[,vec3,...]) // sorts n vecs including first vec by first one proc vecsort () { local i,inv,scr,narg narg=numarg() if (narg<2 || narg>10) {print "Wrong #args in decvec.hoc:vecsort" return} scr=inv=allocvecs(2) scr+=1 $o1.sortindex(mso[inv]) mso[scr].resize(mso[inv].size) sprint(temp_string_,"%s.fewind(%s,%s,%s",mso[scr],mso[inv],$o1,$o2) for i=3,narg sprint(temp_string_,"%s,%s",temp_string_,$oi) sprint(temp_string_,"%s)",temp_string_) execute(temp_string_) dealloc(inv) } //** order(&x,&y,...) put values in order proc order () { local a,i,na na=numarg() a=allocvecs(1) for i=1,na mso[a].append($&i) mso[a].sort for i=1,na $&i=mso[a].x[i-1] dealloc(a) } //** vdelind() -- delete a single index proc vdelind () { local i,iin iin = $2 if (iin<0) iin=$o1.size+iin if (iin>$o1.size-1 || iin<0) { printf("vdelind Error: index %d doesn't exist.\n",iin) return } if (iin<$o1.size-1) $o1.copy($o1,iin,iin+1,$o1.size-1) $o1.resize($o1.size-1) } //* mkveclist(num[,sz]) recreate veclist to have NUM vecs each of size SZ (or MSOSIZ) proc mkveclist () { local ii,num,sz,diff localobj xo num=$1 diff = num-veclist.count if (numarg()==2) { sz=$2 } else { sz = MSOSIZ } if (diff>0) { for ii=0,diff-1 { tmpvec = new Vector(sz) veclist.append(tmpvec) } } else if (diff<0) { for (ii=veclist.count-1;ii>=num;ii=ii-1) { veclist.remove(ii) } } for ltr(xo,veclist) { xo.resize(sz) } } //* allocvecs // create temp set of vectors on mso // returns starting point on mso // eg p = allocvecs(3) // p = allocvecs(v1,v2,v3) // where v1..v3 are localobj or objref // p = allocvecs(v1,v2,v3,...,size) // set all to size // p = allocvecs(num,list) // append num vecs to list // p = allocvecs(num,size) // num vecs of size size // p = allocvecs(num,size,list) // append num vecs of size to list // p = allocvecs(num,list,size) // allow args to be given in reverse order // access these vectors by mso[p+0] ... [p+2] func allocvecs () { local i,ii,llen,sz,newv,aflg,lflg,na localobj o if (numarg()==0) { print "p=allocvecs(#) or p=allocvecs(v1,v2,...), access with mso[p], mso[p+1]..." return 0 } sz=MSOSIZ na=numarg() lflg=0 if (argtype(1)==0) { aflg=0 newv=$1 if (na>=2) if (argtype(2)==0) sz=$2 else {lflg=1 o=$o2} // append to list in arg2 if (na>=3) if (argtype(3)==0) sz=$3 else {lflg=1 o=$o3} if (lflg) o.remove_all } else { aflg=1 if (argtype(na)==0) { i=na sz=$i newv=i-1 } else newv=na } llen = msoptr for ii=msomax,msoptr+newv-1 { // may need new vectors if (ii>=MSONUM) { print "alloc ERROR: MSONUM exceeded." return 0 } mso[ii] = new Vector(sz) } for ii=0,newv-1 { mso[msoptr].resize(sz) mso[msoptr].resize(0) msoptr = msoptr+1 } if (msomax0) printf("%d/%d (%g)\n",ret,$o1.size,ret/$o1.size*100) dealloc(a) return ret } //** civw(DEST,SRC1,STR1,x1[,y1]...) does compound indvwhere // overwrites tstr; DEST should be size 0 unless to be compounded // civw(DEST,0,...) will resize DEST to 0 func civw () { local i,a,b,c,f2,x,y,sz,min a=b=c=allocvecs(3) b+=1 c+=2 min=2 // if ($o1.size>0) print "Starting with previously set index vector" if (argtype(2)==0) { if ($2==0) { $o1.resize(0) min=3 if (argtype(3)==1) sz=$o3.size else { printf("ERR0: arg 3 should be obj when $2==0\n",i) return -1 } } else { printf("ERR0a: arg 2 should be 0 if a number -- zero sizes ind vector\n") return -1 } } else if (argtype(2)==1) sz=$o2.size else { printf("ERR0b: arg 2 should be obj\n",i) return -1 } for (i=min;i<=numarg();) { mso[c].copy($o1) if (argtype(i)!=1) { printf("ERR1: arg %d should be obj\n",i) return -1} if ($oi.size!=sz) { printf("ERR1a: all vecs should be size %d\n",sz) return -1} mso[a].copy($oi) i+=1 // look in a if (argtype(i)!=2) { printf("ERR2: arg %d should be str\n",i) return -1} tstr=$si i+=1 if (strm(tstr,"[[(]")) f2=1 else f2=0 // opstring2 needs 2 args if (argtype(i)!=0) { printf("ERR3: arg %d should be dbl\n",i) return -1} x=$i i+=1 if (f2) { if (argtype(i)!=0) { printf("ERR4: arg %d should be dbl\n",i) return -1} y=$i i+=1 } if (f2) mso[b].indvwhere(mso[a],tstr,x,y) else { // the engine mso[b].indvwhere(mso[a],tstr,x) } $o1.resize(sz) // make sure it's big enough for insct -- shouldn't need if (mso[c].size>0) $o1.insct(mso[b],mso[c]) else $o1.copy(mso[b]) if ($o1.size==0) break } dealloc(a) return $o1.size } //* vecconcat(vec1,vec2,...) // vecconcat(vec1,list) puts concat all vecs from list // destructive: concatenates all vecs onto vec1 // performs a list2vec() functionality proc vecconcat () { local i,max localobj xo max=numarg() if (numarg()<2) { print "vecconcat(v1,v2,...) puts all into v1" return } if (argtype(max)==0) {max-=1 $o1.resize(0)} if (isobj($o2,"List")) { $o1.resize(0) for ltr(xo,$o2) $o1.append(xo) } else for i=2,max $o1.append($oi) } //** vecelim(v1,v2) eliminates items in v1 given by index vec v2 proc vecelim () { for vtr(&x,$o2) { $o1.x[x]= -1e20 } $o1.where($o1,"!=",-1e20) } //** redundout(vec) eliminates sequential redundent entries // destructive func redundout () { local x,ii,p1 p1=allocvecs(1) $o1.sort mso[p1].resize($o1.size) mso[p1].redundout($o1) $o1.copy(mso[p1]) dealloc(p1) return $o1.size } //** uniq(src,dest[,cnt]) uses redundout to return random values of a vector // like redundout except nondestructive obfunc uniq () { local a localobj v1,vret a=allocvecs(v1) v1.copy($o1) v1.sort if (numarg()==3) { $o2.redundout(v1,0,$o3) } else if (numarg()==2) { $o2.redundout(v1) } else { vret=new Vector(v1.size) vret.redundout(v1) } dealloc(a) if (numarg()==1) return vret else return $o2 } //** complement(ind,max) for indices -- return values from 0..max that are not in ind proc complement () { local a,b,max a=b=allocvecs(2) b+=1 max=$2 mso[a].indgen(0,max,1) mso[b].resize(mso[a].size) mso[b].cull(mso[a],$o1) $o1.copy(mso[b]) dealloc(a) } //** albetname() generate sequential 3 char alphabetical file names (make filenames) obfunc albetname () { local na,sret localobj st na=numarg() sret=0 st=new String2() if (na==0) { fnum+=1 st.t=".id" } else if (na>=1) { if (argtype(1)==2) {st.t=$s1 fnum+=1} else fnum=$1 } if (na==2) st.t=$s2 // partially back compatible, doesn't handle albetname(tstr,".id") if (na==3) {st.t=$s3 sret=1} if (fnum>17575) printf("albetname WARN: out of names: %d > %d\n",fnum,26^3-1) sprint(st.s,"%c%c%c", fnum/26/26%26+97,fnum/26%26+97,fnum%26+97) if (sfunc.len(st.t)>0) sprint(st.s,"%s%s",st.s,st.t) if (sret) $s2=st.s return st } // save_idraw([filename,save_all,PS]) -- save idraw to file // default is to generate albetname, save selected to idraw proc save_idraw () { local sv,ps localobj st,li st=new String() find_pwm() ps=sv=1 if (argtype(1)==2) { st.s=$s1 if (argtype(2)==0) sv=$2 if (argtype(3)==0) ps=$3 } else if (argtype(1)==0) { sv=$1 if (argtype(2)==0) ps=$2 } if (sfunc.len(st.s)==0) st.s=albetname().s if (verbose) printf("Saving to %s\n",st.s) pwm.printfile(st.s, ps, sv) } proc find_pwm () { localobj li if (isassigned(pwm)) return li=new List("PWManager") if (li.count==0) pwm=new PWManager() else pwm=li.o(0) } // vecconv() convert $o1 by replacing instances in $o2 by corresponding instances in $o3 proc vecconv () { local a,b a=b=allocvecs(2) b+=1 vrsz($o1,mso[b]) for vtr2(&x,&y,$o2,$o3) { // x -> y mso[a].indvwhere($o1,"==",x) mso[b].indset(mso[a],y) } $o1.copy(mso[b]) } //** veceq() like vec.eq but don't have to be same size and shows discrepency func veceq () { local sz1,sz2,eq,beg,ii,jj,kk sz1=$o1.size sz2=$o2.size if (numarg()==3) beg=$3 else beg=0 if (sz1!=sz2) printf("%s %d; %s %d\n",$o1,sz1,$o2,sz2) ii=0 jj=beg while (ii=0 && (ii+kk)=0 && (jj+kk)=1) { sfunc.left($s1,ln1-1) return 1 } else { print "ERR: chop called on empty string" } return 0 } // lchop(STR[,BEGIN]) -- chop from the left func lchop () { local ln1,match localobj st ln1=sfunc.len($s1) st=new String() if (numarg()==2) { sprint($s2,"^%s",$s2) // just look for initial chars if ((match=sfunc.tail($s1,$s2,st.s))==-1) { return 0 } else { sfunc.right($s1,match) return match } } else if (sfunc.len($s1)>=1) { sfunc.right($s1,1) return 1 } else { print "ERR: chop called on empty string" } return 0 } // strcat(tstr,"stra","strb",...) tstr=stra+strb+... // 1st arg can be a strdef or String obj // other args can be strdef, String obj, literal string, or number handled as %g // returns String obj obfunc strcat () { local i,na localobj out na=numarg() if (argtype(1)==0) { out=new String() } else if (argtype(1)==1) { if (isassigned($o1)) out=$o1 else { out=new String() $o1=out } } else { out=new String() out.s=$s1 } // print "AA:",$s1," ",sfunc.len($s1) if (argtype(na)==0) { out.s="" na-=1 } // clear string for i=2,na { if (argtype(i)==1) { sprint(out.s,"%s%s",out.s,$oi.s) } else if (argtype(i)==2) { sprint(out.s,"%s%s",out.s,$si) } else sprint(out.s,"%s%g",out.s,$i) } if (argtype(1)==2) $s1=out.s return out } // split(string,vec) // split comma sep string into numbers // split(string,list) // split comma sep string into list of strings // split(string,list,regexp) // split regexp sep string into list of strings // split(string,vec,regexp,1) // split but don't interpret: eg "5*3"->15 or "x"->val // split(string,list,num) // split every num chars // eg split("534, 43 , 2, 1.4, 34",vec[,"/"]) // split("13, 3*PI/2*tau/2, 32+7, 6, 9.2, 42/3",vec) // optional 3rd str is what to split on; default is comma split_interp=1 func split () { local i,vf,x,done,num localobj s,st,o if (numarg()==0) { printf("eg split(\"534 43 2 1.4 34\",vec,\" \") split(\"a,b,c,d,e\",tmplist)") return -1 } s=new String2() st=new String2() s.t=$s1 if (argtype(2)!=1) { o=new Vector() vf=2 i=2 } else { o=$o2 i=3 if (isobj(o,"Vector")) { vf=1 } else { vf=0 if (!isassigned(o)) { o=new List() $o2=o } } } if (vf) revec(o) else o.remove_all if (argtype(i)==2) {st.s=$si i+=1} else st.s="[, ]+" if (argtype(i)==0) { // length split into a list eg c2 c2 c2 etc if (vf) {printf("Split err: attempting to do length split into vector: %s",o) return 0} num=$i sprint(st.s,"%%*%ds%%s",num) // eg "%2*s%s" to get all but first 2 chars sprint(st.t,"%%%ds",num) // eg "%2s" to get first 2 chars if (num>sfunc.len(s.t)){ printf("split() ERRA %s of length %d in pieces of %d?\n",s.t,sfunc.len(s.t),num) return 0} } else num=0 while (sfunc.len(s.t)>0) { done=0 if (vf) { if (split_interp) if (strm(s.t,"^[^,]+[+*/-]")) { sfunc.head(s.t,",",s.s) if (sfunc.len(s.s)==0) s.s=s.t sprint(s.s,"%s.append(%s)",o,s.s) execute(s.s) done=1 } if (!done) if (sscanf(s.t,"%lf",&x)) { o.append(x) done=1 } if (!done && split_interp) { // try to interpret as a variable hoc_ac_=ERR // global hoc_ac_ for execute1() sfunc.head(s.t,st.s,s.s) if (sfunc.len(s.s)==0) s.s=s.t // the end sprint(st.t,"hoc_ac_=%s",s.s) execute1(st.t,0) // no error if (hoc_ac_==ERR) { printf("split WARNING skipping non-parsable value: %s\n",s.s) } else { o.append(hoc_ac_) } done=1 } if (vf==2) if (o.size==0) return ERR else return o.x[0] } else { // split into a list if (num) { sscanf(s.t,st.t,s.s) o.append(new String2(s.s,s.s)) } else { sfunc.head(s.t,st.s,s.s) if (sfunc.len(s.s)==0) s.s=s.t // the end o.append(new String2(s.s,s.s)) } done=1 } if (num) { // splitting equal length strings if (sfunc.len(s.t)<=num) s.t="" else sscanf(s.t,st.s,s.t) } else { sfunc.tail(s.t,st.s,s.t) } } if (vf) return o.size else return o.count } // parsenums(STR[,VEC]) find first or all the numbers in a string func parsenums () { print "Use split(\"str\") instead" } // intervals(TRAIN,OUTPUT) func intervals () { local a if ($o1.size<=1) { printf("%s size <2 in intervals()\n",$o1) return 0} $o2.deriv($o1,1,1) return $o2.size } // invl(train,stats[,thresh]) func invl () { local a,x,sz localobj v1,v2 a=allocvecs(v1,v2) if ($o1.size<=1) { printf("%s size <2 in invl()\n",$o1) $o2.resize(5) $o2.fill(-1) dealloc(a) return 0 } if (!$o1.ismono(2)) printf("decvec::invl() WARN: %s not sorted\n",$o1) v1.deriv($o1,1,1) if (numarg()==3) { if ((x=v1.w("<",$3,-1))>0) { // tag and remove all below threshold v1.sort v1.reverse v1.resize(v1.size-x) } } stat(v1,$o2) sz=v1.size dealloc(a) return sz } // freql(train,stats) // doesn't make much sense to take the mean of inverses func freql () { local a localobj v1 a=allocvecs(v1) if ($o1.size<=1) { printf("%s size <2 in intervals()\n",$o1) return 0} v1.deriv($o1,1,1) v1.inv(1e3) stat(v1,$o2) return v1.size } // downcase(tstr[,UPCASE]) proc downcase () { local len,ii,let,diff,min,max diff=32 min=65 max=90 if (numarg()==2) { diff=-diff min=97 max=122 } // if flag -> upcase len = sfunc.len($s1) for ii=1,len { sscanf($s1,"%c%*s",&x) sfunc.right($s1,1) if (x>=min&&x<=max) { sprint($s1,"%s%c",$s1,x+diff) } else sprint($s1,"%s%c",$s1,x) // just rotate the letter } } // newlst() puts a newline in the middle of a string proc newlst () { local l if (numarg()>1) l=$2 else l=int(sfunc.len($s1)/2) temp_string_=$s1 temp_string2_=$s1 sfunc.left(temp_string_,l) sfunc.right(temp_string2_,l) sprint($s1,"%s\n%s",temp_string_,temp_string2_) } //* rdcol(file,vec,col#,cols): read multicolumn file func rdcol () { local col,cols,length if (numarg()==0) { print "\trdcol(\"file\",vec,col#,cols) // col#=1..." return 0} col=$3 cols=$4 length=0 if (! tmpfile.ropen($s1)) { printf("\tERROR: can't open file \"%s\"\n",$s1) return 0} while (tmpfile.gets(temp_string_) != -1) length+=1 // count lines print length tmpfile.seek() $o2.scanf(tmpfile,length,col,cols) if ($o2.size!=length) printf("rdcol ERR: only read %d statt %d\n",$o2.size,length) return length } //* rdmuniq(vec,n,rdm) -- augment vec by n unique vals from rdm // rdmuniq(vec,n,max) -- augment vec by n unique vals 0-max // rdmuniq(vec,n,min,max) -- augment vec by n unique vals min-max // draw n numbers without replacement, only makes sense with discrete distribution // could do something like // mso[a].setrand($o3) mso[d].copy(mso[a]) // mso[b].indsort(mso[a]) mso[a].sort() mso[c].redundout(mso[a],1) // to get indices of unique values but then have to back index to original // rdmuniqm4=1 to use setrnd() statt setrand() rdmuniqm4=0 proc rdmuniq () { local i,max,min,n,a3,a,see localobj ro,v1,v2,vin,l if (numarg()==0) { printf("rdmuniq(vec,n,rdm) - augment vec by n unique vals from rdm\ rdmuniq(vec,n) - augment vec by n unique vals 0-99\ rdmuniq(vec,n,max) - augment vec by n unique vals 0-max\ rdmuniq(vec,n,min,max) - augment vec by n unique vals min-max\ rdmuniq(vec,n,min,max,seed) - augment vec by n unique vals min-max using seed\n") return } if (rdmuniqm4 && argtype(5)!=0) { printf("flag set: rdmuniqm4==1: should use all 5 args: rdmuniq(vec,n,min,max,seed)\n") return } vin=$o1 min=max=0 see=0 n=int($2) // round down a3=argtype(3) if (a3==1) { ro=$o3 // random previously setup, min,max unknown } else if (a3==-1) { min=0 max=99 } else { max=$3 if (argtype(4)==0){min=$3 max=$4} if (argtype(5)==0) see=$5 } if (max>0) { // else rdm was an arg with unknown min,max if (max-min+1==n) { vin.indgen(min,max,1) return } else if (n>max-min+1) { printf("rdmuniq ERR incompatible: min=%d max=%d n=%d (%g vs %d)\n",min,max,n,$2,max-min+1) return } } if (!rdmuniqm4) { if (ro==nil) ro=new Random() if (see) ro.ACG($5) // seed it ro.discunif(min,max) } vin.resize(0) a=allocvecs(v1,v2) l=new List() l.append(v2) l.append(vin) for (ii=1;vin.sizen-1 in vec // eg rdmord(ind,ind.size); check: for ii=0,ind.size-1 if (ind.count(ii)!=1) print ii proc rdmord () { local n,a localobj v1 a=allocvecs(v1) n=$2 rdm.uniform(0,100) v1.resize(n) v1.setrand(rdm) v1.sortindex($o1) dealloc(a) } // shuffle(VSRC[,VDEST]) randomly rearrange elements of vec obfunc shuffle () { local a localobj v1,v2,oi,oo oi=$o1 if (numarg()==2) oo=$o2 else oo=$o1 a=allocvecs(v1,v2) rdmord(v1,oi.size) v2.index(oi,v1) oo.copy(v2) dealloc(a) return oo } // sample(vec,beg,end,vals) pick out n integer values from given range // sample(vec,end,vals) -- assumes 0 proc sample () { local min,max,vals min=0 if (numarg()==4) {min=$2 max=$3 vals=$4} else {max=$2 vals=$3} $o1.indgen(min,max,1) shuffle($o1) $o1.resize(vals) } // round() round off to nearest integer func round () { local ii if (argtype(1)==1) { if ($o1.size==0) return 1e9 for ii=0,$o1.size-1 { if ($o1.x[ii]>0) $o1.x[ii]=int($o1.x[ii]+0.5) else $o1.x[ii]=int($o1.x[ii]-0.5) } return($o1.x[0]) } else { if ($1>0) return int($1+0.5) else return int($1-0.5) } } // filevers() pulls out version of file from first line func filevers () { localobj f1,s1,lx1 f1=new File() s1=new String() lx1=new Union() if (! f1.ropen($s1)) { printf("filevers ERR, can't open %s\n",$s1) return 0 } f1.gets(s1.s) if (sscanf(s1.s,"%*s $Id: %*s %*d.%d",&lx1.x)!=1) { printf("filevers ERR, sscanf failed %s: %s",$s1,s1.s) } f1.close return lx1.x } //* hocfind(FILENAME) searches through HOC_LIBRARY_PATH and locates file obfunc hocfind () { local done localobj f1,s1,s2 f1=new File() s1=new String() s2=new String() done=0 system("echo -n $HOC_LIBRARY_PATH",s1.s) sprint(s1.s,"%s ",s1.s) // to look at last item while (sfunc.len(s1.s)>2) { sfunc.head(s1.s,"[ :]",s2.s) sprint(s2.s,"%s/%s",s2.s,$s1) if (f1.ropen(s2.s)) {done=1 break} sfunc.tail(s1.s,"[ :]",s1.s) } if (!done) if (f1.ropen($s1)) {sprint(s2.s,"./%s",$s1) done=1} if (!done) s2.s="NOT FOUND" return s2 } //* usefiles(F1[,F2,...]) list of files returns string with list of files and versions obfunc usefiles () { local i localobj s1,s2 s2=new String() s2.s="Using " for i=1,numarg() { s1=hocfind($si) sprint(s2.s,"%s %s%d",s2.s,$si,filevers(s1.s)) } return s2 } //* ttest(v1,v2) student t-test // nrniv/sync/notebook.dol:16230 // checked against http://www.physics.csbsju.edu/stats/t-test_bulk_form.html func ttest () { local prob,df df=$o1.size+$o2.size-2 t_val=($o1.mean-$o2.mean)/sqrt($o1.var/$o1.size + $o2.var/$o2.size) prob=betai_stats(0.5*df,0.5,df/(df+t_val*t_val)) return prob } // pttest() paired t-test func pttest () { local prob,sd,df,cov,j,ave1,ave2,var1,var2 n=$o1.size ave1=$o1.mean ave2=$o2.mean var1=$o1.var var2=$o2.var cov=0 if (n!=$o2.size) {printf("pttest ERR: != sizes\n",n,$o2.size) return -1} for (j=0;j=1) if (argtype(1)==0) { fl=1 // 1 arg taken care of if ($1<=-10) { flag=1 up=$o2 fl=2 ofl=-($1+10) m=up.m if (ofl) { objref v[m] for ii=0,m-1 v[ii]=new Vector() } else 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 if ($1<0) { // flag to create a large set of vectors with no labels and no .out fl=2 noheader=ofl=-$1 m=$2 objref v[m] for ii=0,m-1 v[ii]=new Vector() // no s[ii] strings } 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 String2($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.626 2009/01/09 14:23:37 billl Exp " svvers=-1 if (!flag && ofl!=2) { out=new NQS(-10-ofl,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 -- also set vl func chk () { local ii,jj,ret ret=1 if (out!=nil && !noheader) { 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 } } } listvecs(vl) 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) { if ($1==-1) { // set the strings if (!batch_flag && sfunc.len(s[0].s)!=0) { printf("Overwrite headers for %s? (y/n) ",this) getstr(tstr) chop(tstr) if (strcmp(tstr,"y")!=0) return } 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) } } else if ($1==1) { // show the types of fields for ii=0,m-1 printf("%s(%d) ",s[ii].s,fcd.x[ii]) } else if ($1==2) { // just the names for ii=0,m-1 printf("%s ",s[ii].s) } } else { for ii=0,m-1 printf("%s(%d) ",s[ii].s,ii) // field numbers } } //* selone(COL,VAL[,FLAG]) -- uses vec.slone 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 // emulate a high-dim sparse array with optional string args, eg // nq.ay("SU","IN",7,2,12).x // like nq_array["SU"]["IN"][7][2][12] // 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]) // alternate use with specific labels for things to be set eg // eg XO=ncq.ay(SU,SU,AM,SET,"del",2.2,"wt") obfunc ay () { local a,b,i,j,jo,k,na,flag,done,ix,nx,sx,ox,fl 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() o.err=1 // assume .err set to return errors 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 done=0} ; i<=na && !flag; {i+=1 done=0}) { if (argtype(i)==2) { if (fi($si,"NOERR")!=-1) break else if (fcd.x[i-1]!=2) { printf("ay ERRA: %d %d\n",fcd.x[i-1],argtype(i)) dealloc(a) return o } for (j=0;j1) printf("%s ay WARNING: mult rows %d (using %d)\n",this,ind.size,ind.x[0]) if (ind.size==0) { // printf("%s ay ERRBB: none selected\n",this) dealloc(a) return o } ix=ind.x[0] // just getting the first row of this if (i==na && argtype(i)==2) if ((fl=fi($si,"NOERR"))!=-1) { // return just 1 with col label j=getval(fl,v[fl].x[ix]) if (j==0) o.x=nval else if (j==1) o.o=oval else if (j==2) o.s=sval dealloc(a) o.err=0 return o } for (;i<=na && flag==1;{i+=1 j+=1 jo=0}) { // 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 ((k=fi($si,"NOERR"))!=-1) {jo=j j=k i+=1} } 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} if (jo) j-=1 // back up: perhaps can but would be a bad idea to mix setting stuff } nx=sx=ox=-1 if (flag==2) {i=b if ((b=fi($si,"NOERR"))==-1) { printf("nqs:ay() GET ERR %s not found\n",$si) return o }} for (i=b;i=10) continue o.set(s[i].s,nval) } else if (j==1 || j==2) { ox+=1 // string is handled as String obj if (ox>=10) continue if (j==2) o.set(s[i].s,sval) else o.set(s[i].s,oval) } } dealloc(a) o.err=0 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) { lk=$i } else { // arg2 is a regular number use "~" mso[key].append(IBI) // approximately equal -- generate a range tmp=$i*(1-loose) tmp1=$i*(1+loose) if (tmpmso[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") } func csel () { local a,ii localobj v1 a=allocvecs(v1,m) for ii=0,m-1 v1.append(oform(v[ii])) if (numarg()==2) { ind.indvwhere(v1,$s1,$2) } else { ind.indvwhere(v1,$s1,$2,$3) } dealloc(a) return ind.size } //** 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=ALL*(m+1)) { op/=(m+1) break } // m is is field key 1-5 if (op=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)=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] } //** mkind(COL) sort by COL and then use mkind to put index of a single col in cindx vector obfunc mkind () { local fl if (eqobj(cob,out) && verbose) printf(" *Selected* ") if (cindx==nil) cindx=new Vector(1e3) if (argtype(1)==0) fl=$1 else fl=fi($s1) cindcol=fl sort(fl) v[fl].mkind(cindx) if (argtype(2)==1) $o2.copy(cindx) return cindx } //** 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 scpflag=0 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) { sprint(sstr,"WARNING %s col not empty (size %d)",s[fl].s,v[fl].size) if (boolean_dialog(sstr,"Clear col","Cancel")) { v[fl].resize(0) } else { printf("%s (%s) setcol() canceled\n",this,s[fl].s) return }} if (argtype(2)==2) { s[fl].s=$s2 } else if (argtype(2)==1) { if (scpflag) v[fl].copy($o2) else v[fl]=$o2 return } else { sprint(tstr,"%d",$2) s[fl].s=tstr } if (numarg()>=3) vo=$o3 if (numarg()>=4) flag=$4 else flag=0 if (!flag || scpflag) v[fl].copy(vo) else v[fl]=vo chk() } //** 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 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 (!flag && 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 chk() } //** 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 // NB: makes a copy of a Vector or an NQS so DON'T do eg nq.append(new Vector()) func newval () { local ret,typ,ty,fl,ii localobj o typ=$1 fl=$2 ty=fcd.x[fl] // arg type may not be same as field type if (ty==typ || ty==-1 || (ty==11 && typ==2)) { // OK } else { printf("nqs::newval() ERRa %d statt %d\n",typ,ty) return ERR } if (typ==0 || ty==-1) { return nval } else if (ty==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;iifcdo.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() obfunc listvecs () { local ii,i,b localobj ol if (eqobj(cob,out) && verbose) printf(" *Selected* ") if (argtype(1)==1) {ol=$o1 b=2} else b=1 if (!isassigned(ol)) { ol=new List() if (argtype(1)==1) $o1=ol } ol.remove_all if (numarg()>=b) { for i=b,numarg() { if (argtype(i)==2) ii=fi($si) else ii=$i if (ii==-1) return ol.append(cob.v[ii]) } } else { for ii=0,m-1 ol.append(cob.v[ii]) } return ol } //*** hash([COLA],[COLB] etc.) put the vecs in the list for use with eg uncode() proc hash () { local ii,i,fl localobj o if (eqobj(cob,out) && verbose) { printf("hash() ERR: can't create hash col in 'Selected'\n") return } o=new List() if (numarg()==0) { // do all columns resize("hashall") for ii=0,m-2 o.append(v[ii]) } else { tstr="hash" for i=1,numarg() { if (argtype(i)==0) fl=$i else fl=fi($si) if (fl==-1) return sprint(tstr,"%s_%s",tstr,s[fl].s) o.append(v[fl]) } resize(tstr) } pad() v[m-1].hash(o) } //*** 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 && isassigned(oval)) { otmp=oform(oval) if (otmp==NOP) { typ=1 } else if (otmp==OK) { return // print nothing since being printed as side effect } else { typ=0 nval=otmp // print a single numeric value } } 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 } else if (ty==1) {lo=new Union(fcdo,cob.v[fl].x[ix]) if (numarg()==3) $o3=lo.o } else if (ty==11) {lo=methget(fl,cob.v[fl].x[ix]) if (numarg()==3) $o3=lo.o } else if (ty==2) {lo=new Union(fcds,cob.v[fl].x[ix]) if (numarg()==3) $s3=lo.s } else if (ty==-1){lo=new Union(fcdl.object(fl),cob.v[fl].x[ix]) if (numarg()==3) $o3=lo.o} return lo } //** mget(row,col) obfunc mget () { local ty,fl,ix,outf localobj lo outf=0 ix=$1 fl=$2 if (ix<0 || ix>=cob.v[fl].size) {printf("%s::get ERR no %d,%d\n",this,fl,ix) return lo} ty=fcd.x[fl] if (ty==0) {lo=new Union(cob.v[fl].x[ix]) if (numarg()==3) $&3=lo.x } else if (ty==1) {lo=new Union(fcdo,cob.v[fl].x[ix]) if (numarg()==3) $o3=lo.o } else if (ty==2) {lo=new Union(fcds,cob.v[fl].x[ix]) if (numarg()==3) $s3=lo.s } else if (ty==11) {lo=methget(fl,cob.v[fl].x[ix]) if (numarg()==3) $o3=lo.o } else if (ty==-1){lo=new Union(fcdl.object(fl),cob.v[fl].x[ix]) if (numarg()==3) $o3=lo.o} return lo } //** mset(row,col) proc mset () { local ty,fl,ix,outf localobj lo outf=0 ix=$1 fl=$2 if (ix<0 || ix>=cob.v[fl].size) {printf("%s::get ERR no %d,%d\n",this,fl,ix) return} ty=fcd.x[fl] if (ty==0) cob.v[fl].x[ix]=$3 else \ if (ty==1) fcds.o(cob.v[fl].x[ix])=$o3 else \ if (ty==2) fcds.o(cob.v[fl].x[ix]).s=$s3 else \ if (ty==-1)fcdl.object(fl).o(cob.v[fl].x[ix])=$o3 } //** fetch(COLA,VAL,COLB) does fast select where COLA is VAL and returns value in COLB // fetch(COLA,VAL) return the row number // fetch(COLA,VAL,COLB,XO) places COLB object in XO // 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 || argtype(4)==1) { 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) { if (numarg()==4) $o4=fcdo.o(cob.v[fl2].x[i]) return cob.v[fl2].x[i] } else { // return row as a vector v0.resize(0) for (ii=0;ii0) return v[fl2].x[ind.x[0]] else return ERR } } //** 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()==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()=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} } qtset=0 // turn back off } //** iterator ut(&x1,NAME1,&x2,NAME2,...) // like qt but iterates over selected items without a copy (ie with selcp=0) // 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 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(".c.mul(DELD).add(DEL)") proc calc () { local ii,vn,exec if (numarg()==0) { printf("eg calc(\".copy(.c.mul().add(5))\") \ntakes a compound expression utilizing column names in slant brackets <>\nanything quoted can use either ' slash quote.\n") return } else sstr=$s1 exec=1 if (argtype(2)==2) if (strcmp($s2,"NOEXEC")==0) exec=0 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) if (exec) 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 if (fcd.x[vn]==1) { cob.scr.resize(0) for ii=0,cob.v[vn].size-1 cob.scr.append(oform(fcdo.o(cob.v[vn].x[ii]))) if (cob.scr.x[0]==NOP) { // looking at a list of vectors printf("NQS:sort ERR define oform to sort obj field %s\n",s[vn].s) return 0 } cob.scr.sortindex(cob.ind) } else { cob.v[vn].sortindex(cob.ind) } if (numarg()==2) if ($2==-1) cob.ind.reverse fewind() return vn } //** vsort(vec) sort according to vec which may have redundancy func vsort () { local beg,ii,x localobj o if (eqobj(cob,out) && verbose) printf(" *Selected* ") o=$o1 if (numarg()==2) if ($2==-1) o.reverse cob.scr.resize(cob.v.size) for (beg=0;beg=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 if (verbose) 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 if (verbose) 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") if (verbose) 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 } //** covarc("vCol") -- generate covariance matrix from vectors in a single column obfunc covarc () { local a,fl,n,m localobj mat,xo,v1 if (eqobj(cob,out) && verbose) printf(" *Selected* ") if ((fl=fi($s1))==-1) return -1 if (fcd.x[fl]!=1) {printf("Must be an obj column\n") return -1} xo=get(fl,0).o if (!isojt(xo,ind)) {printf("Must be an vec column\n") return -1} n=size(1) // number of data vectors m=xo.size // size of vector a=allocvecs(v1) mat=new Matrix(m,m) cob.v[fl].covar(fcdo,v1) mat.from_vector(v1) dealloc(a) return mat } //** tomatc("vCol") -- return matrix of vectors from a single column; load into rows of mat obfunc tomatc () { local a,fl,n,m,ii localobj mat,xo,v1 if (eqobj(cob,out) && verbose) printf(" *Selected* ") if ((fl=fi($s1))==-1) return -1 if (fcd.x[fl]!=1) {printf("Must be an obj column\n") return -1} xo=get(fl,0).o if (!isojt(xo,ind)) {printf("Must be an vec column\n") return -1} n=size(1) // number of data vectors m=xo.size // size of vector mat=new Matrix(n,m) for qt(xo,fl,&ii) mat.setrow(ii,xo) return mat } //** 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} if (eqobj(cob,out)) out.ind.copy(ind) rdmord(cob.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;beg1) 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-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) { // look at a list of obj's cob.scr.resize(0) for ii=0,cob.v[vn].size-1 cob.scr.append(oform(fcdo.o(cob.v[vn].x[ii]))) if (cob.scr.x[0]==NOP) { printf("map WARNING: oform not set for %s interp; replacing with fcdo indices\n",$si) cob.scr.copy(cob.v[vn]) } 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 // print sstr 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 && argtype(2)==2) { map("gg",0,$s1,$s2,col,lne) done=1 } if (argtype(2)==2) i=3 else i=2 if (! done) { if (argtype(3)==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 if (argtype(2)==2) { map("gg",gn,$s1,$s2,col,lne) } else { print gn,col,lne map("gg",gn,$s1,1,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 (argtype(2)==2) { 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) // last args are max or min-max rows // first set of args can be any of: col_names, file object, file name (not same as col name), // vector giving col numbers 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} scr[1].resize(0) nohdr=fout=flag=min=0 max=cob.v.size-1 na=numarg() nohdr=noheader if (argtype(na)==0 && argtype(na-1)==0) { // pick up the limits first i=na na-=2 max=$i i-=1 min=$i } else if (argtype(na)==0) { i=na na-=1 if ($i>=0) max=$i else min=max+$i // allow printing the end } for i=1,na { if (argtype(i)==1) { if (isobj($oi,"Vector")) { flag=1 // column indices in a vector scr[1].copy($oi) } else if (isobj($oi,"File")) { fout=1 } else { printf("NQS::pr() Unknown object: %s\n",$oi) return 0 } } else if (argtype(i)==2) { if (fi($si,"NOERR")!=-1) { // column identifier to pick up scr[1].append(fi($si)) flag=1 } else if (strcmp($si,"NOHEADER")==0) { nohdr=1 } else if (strm($si,"[<>]")) { flag=2 // something to calculate } else { // assume it's a file name if (fout) { fi($si) return 0 } // already picked up a filename if (!tmpfile.wopen($si)) printf("%s:Can't open %s for printing\n",this,$si) fout=1 printf("==== WARNING: printing ascii to file %s ====\n",$si) } } } if (flag==0) scr[1].indgen(0,m-1,1) // didn't pick up any columns if (scr[1].min<0 || scr[1].max>m-1) { printf("NQS:pr() bad col values: ") vlk(scr[1]) return 0 } 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 && flag!=2) print "" if (flag==2) { calc($s1,"NOEXEC") sprint(sstr,"XO=%s",sstr) execute(sstr) vlk(XO,min,max) } else { 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(" ") } } if (fout) tmpfile.close return 0 } //** 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 sz=-1 if (eqobj(cob,out) && verbose) printf(" *Selected* ") if (numarg()==1) sz=$1 else for ii=0,m-1 if (cob.v[ii].size>sz) sz=cob.v[ii].size for ii=0,m-1 { // if (v[ii].size>sz) printf("NQS.pad WARNING: neg padding %d\n",ii) cob.v[ii].resize(sz) } return sz } //** size() -- return num of vectors and size of each vector func size () { local ii,sz,fl,sum 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 break} if (numarg()==1) { if ($1==2) { tog("DB") sum=0 printf("\t%d cols x %d rows",m,sum+=v.buffer_size) for ii=1,m-1 printf(",%d",cob.v[ii].buffer_size) if (out!=nil) { printf("\nOUT:\t%d cols x %d rows",m,sum+=out.v.buffer_size) for ii=1,m-1 printf(",%d",sum+=out.v[ii].buffer_size) } printf("\nApprox. usage: %g kB\n",sum*8/1e3) } else if ($1==1 && fl && !noheader) { // warn about discrepant sizes printf("%s size WARN: cols are not same length: %s:%d %d\n",this,s[fl].s,cob.v[fl].size,sz) } } else { // print basic info when have no args 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,kk,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 } kk=oldsz+i-1 s[kk].s=tstr if (jj>=0) { if (fcd.x[jj]==1) { if (verbose) printf("NQS::Resize: converting OBJ Col '%s' to DBL Col '%s'\n",$si,tstr) v[kk].resize(v[jj].size) for ii=0,v[jj].size-1 v[kk].x[ii]=oform(fcdo.o(v[jj].x[ii])) } else { if (verbose) printf("NQS::Resize copying Col %s to %s\n",$si,tstr) v[kk].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,a localobj v1 tog("DB") // start at full db a=allocvecs(v1) if (numarg()==1 && argtype(1)==1) { v1.copy($o1) } else for i=1,numarg() { if (argtype(i)==2) { if ((fl=fi($si))==-1) return -1 } else fl=$i v1.append(fl) } v1.sort v1.reverse // get rid of last ones first for i=0,v1.size-1 { fl=v1.x[i] if (fl>m-1 || fl<0) { printf("%s ERR: delcol OOB:%d\n",this,fl) dealloc(a) return -1 } for (ii=fl;ii=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]) // getrow("COL",val[,vec]) // return 1st row where "COL" is val obfunc getrow () { local i,ii,ix,fl,flag localobj v1 if (argtype(2)==0) { // fetch first matching row according to arg if (argtype(1)==2) fl=fi($s1) else fl=$1 if (fl==-1) return if (numarg()==3) v1=$o3 else v1=new Vector() v1.resize(m) v[fl].fetch($2,vl,v1) } else { if (eqobj(cob,out) && verbose) printf(" *Selected* ") ix=$1 i=2 if (argtype(i)==1) {v1=$oi i+=1} else v1=new Vector() v1.l2p(cob.vl,ix) for (ii=0;argtype(i)!=-1 && ii0) 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,noheader,0) // extra for codes wrvstr(file) wrvstr(comment) if (!noheader) 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) noheader=cd3 if (ii!=m) resize(ii) rdvstr(file) rdvstr(comment) if (sfunc.len(file)==0 && numarg()>0) file=$s1 if (!noheader) 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 // still won't read strings -- prob not worth fixing any more // -- may want to go back to v617 for this func rdcols () { local i,ii,cols,li,errflag,num,hflag,loc localobj fi,st hflag=1 errflag=0 st=new String2() if (argtype(1)==2) { fi=tmpfile st.s=$s1 loc=0 tflg=0 if (! fi.ropen(st.s)) { printf("\trdcols ERR0: can't open file \"%s\"\n",st.s) return 0} } else {fi=$o1 fi.getname(st.s) hflag=0 loc=fi.tell() tflg=1} if (fcd.count(2)+fcd.count(0)!=m) {printf("\trdcols ERRA: only rd strs and dbls\n") return 0} if (fi.scanstr(sstr)==-1) {printf("\trdcols ERR1: file \"%s\"\n",st.s) return 0} if (tflg) hflag=0 else { 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",st.s,sstr,s[0].s) hflag=2 } } else if (!hflag) printf("No Header read for %s\n",st.s) cols=0 if (hflag==1) { while (! isnum(sstr)) { cols+=1 fi.scanstr(sstr) resize(sstr) } } else { ncols=fcd.count(0) // assume that NQS was set up ahead cols=fcd.size } li=file_len(st.s) if (hflag || tflg) li-=1 // hack -- assuming that threw away one line printf("%d cols; %d lines of data in %s.\n",cols,li,st.s) fi.seek(loc) // back to top // WARN: this will screw up if numbers are to be included as strings num=scr.scanf(fi,li*ncols) // note that this will skip over non-nums if (num!=li*ncols) { // err not reached since scanf dumps out printf("WARNING: expected %d vals; found %d\n",li*ncols,num) errflag=3 } if (fi.scanstr(sstr)>-1) { printf("WARNING: %s found after reading in %d vals\n",sstr,li*cols) errflag=4 } fi.seek(loc) for ii=0,cols-1 { if (fcd.x[ii]>0) continue if (hflag) fi.scanstr(s[ii].s) v[ii].resize(li) v[ii].copy(scr,0,ii,li*ncols-1,1,cols) // v[ii].mcol(scr,ii,cols) } if (fcd.count(0)!=m) { fi.seek(loc) // need to pick up some strings for ii=0,li-1 for jj=0,cols-1 { if (fi.scanstr(st.t)==-1) {printf("ERR reading at %d\n",fi.tell()) errflag=5 return 0} if (fcd.x[jj]==2) v[jj].append(newval(2,jj)) } } 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 } noheader=$o1.noheader 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 { if (!noheader) s[ii]=up.s[ii] v[ii]=new Vector() } else for ii=0,m-1 { if (!noheader) 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 } if (!noheader) 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 if (noheader) { printf("%d cols differ: \n",ii,ix,v[ii].x[ix],$o1.v[ii].x[ix]) } else 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])) { if (noheader) { printf("%d cols differ at ",ii) } else 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 } //** fdec() -- declare these columns to be files with methods func fdec () { local i,j,na if (eqobj(cob,out)) { printf("fdec() ERR: object fields can only be declared at top level\n") return 0} na=numarg() if (na==0 || na%3!=0) { printf("fdec(\"COLNAME\",\"METHOD\",\"PATH\"[,...])\n") return 0 } out.fcd=fcd for (j=1;j<=na;j+=3) { i=j if (argtype(i)==0) fl=$i else fl=fi($si) if (fl==-1) return 0 else fcd.x[fl]=11 i+=1 s[fl].t=$si i+=1 if (sfunc.len($si)==0) { sprint(s[fl].t,"%s(\"",s[fl].t) } else sprint(s[fl].t,"%s(\"%s/",$si,s[fl].t) } if (! isobj(fcdo,"List")) { fcdo=new List() out.fcdo=fcdo } return 1 } obfunc methget () { local fl,ix localobj o fl=$1 ix=$2 if ((o=fcdo.o(ix).o)!=nil) return o sprint(tstr,"tmpobj=%s%s\")",s[fl].t,fcds.o(fcdo.o(ix).x).s) execute(tstr) o=tmpobj // need to use external global tmpobj fcdo.o(ix).o=o return o } //** coddec() -- declare these columns to be coded 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 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=1,numarg() { if (argtype(i)==0) fl=$i else 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 %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)) } } //** unnan() gets rid of nans and inf's in numerical cols proc unnan () { local ii for ii=0,m-1 if (fcd.x[ii]==0) v[ii].unnan(0) } 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=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 tmpobj=nil } //* pmap() maps a function arg1 onto multiple args or a , sep string of args proc pmap () { local i,na localobj st st=new String() na=numarg() sprint(st.s,"%s(",$s1) // 1st arg is name of proc for i=2,na sprint(st.s,"%s%s,",st.s,$si) if (na>=2) chop(st.s) sprint(st.s,"%s)",st.s) execute1(st.s) } func fmap () { local i,na localobj st,o st=new String() o=new DBL() na=numarg() sprint(st.s,"%s.x=%s(",o,$s1) // 1st arg is name of proc for i=2,na sprint(st.s,"%s%s,",st.s,$si) if (na>=2) chop(st.s) sprint(st.s,"%s)",st.s) execute1(st.s) return o.x } //* bugs and missing features // 1. for NQS, does resize work with object columns? i.e. // > > nqs1 has an object column // > > can i do nqs2.resize(nqs1) to add nqs1 to nqs2? // > looks like I haven't bothered with that case (nqs.hoc_579:2188) // 2. oc> for ii=2,3 nq[ii-2].resize(nq[ii]) -- meaningless err messages? // (~/nrniv/place/load.hoc_54:60) // NQS[48] fi ERR: regexp matches more than once: 1 spkstats.killp // NQS[48] fi ERR: regexp matches more than once: 2 spkstats.prup // END /usr/site/nrniv/local/hoc/nqs.hoc //================================================================ gnum=-1 declare("show_panel",1) obfunc file_with_dot(){} // stubs to declare later, otherwise external barfs obfunc filname(){} obfunc dirname(){} func file_len(){} proc tog (){if (numarg()==1) print $&1=1-$&1 else print gvmarkflag=1-gvmarkflag} proc pvout2 () { } // stub for manipulating printlist proc rv2 () { } // stub for manipulating the vectors before graphing proc rv3 () { } // stub for manipulating the label func setfilt2 () { return 0 } // stub for setting filter func dir2mf2() {return 1} // stub for checking whether to include a trace //* template vfile_line (vector file line) template gives information about a line // in a file that gives a vector: name, size and location begintemplate vfile_line public name, size, loc, segs, num, ix, f, ty strdef name,f double loc[1] proc init () { segs=1 ty=4 if (argtype(5)==0) segs=$5 else if (argtype(5)==2) f=$s5 name=$s1 size=$2 num=$4 double loc[segs] loc[0] = $3 ix=-1 // can be used as index if needed } endtemplate vfile_line //* template vitem (vector item) is an internal vector used to store output from // new vitem(var_name,vec_size,friendly_name) // new vitem(var_name,vec_size,1) -- force tvec creation even if not cvode_local // a simulation holds the name and the vector itself tvflag_on=1 begintemplate vitem external cvode,tvflag_on,isassigned public tvec,vec,name,tvflag,pstep,o,code,resize objref tvec,vec,o,this // o not set here but used for Acells strdef tstr,name // variable name proc init () { name=$s1 tvflag=0 pstep=0 code=0 if (cvode.active()) { if (cvode.use_local_dt()) tvflag=1 else tvflag=-1 } if (tvflag_on) tvflag=1 if (argtype(2)==0) vec=new Vector($2) else if (argtype(2)==1) vec=$o2 if (argtype(3)==0) { // sloppy -- what if pstep=1?? if ($3==1) tvflag=1 else {tvflag=0 pstep=$3} } else if (argtype(3)==1) { tvec=$o3 tvflag=1 // don't create another one } if (argtype(4)==0) if ($4==1) tvflag=1 else {tvflag=0 pstep=$4} if (tvflag==1 && !isassigned(tvec)) tvec=new Vector($2) if (tvflag==-1) { sprint(tstr,"if (!isassigned(tvec)) tvec=new Vector(%d)",$2) execute(tstr) sprint(tstr,"%s.tvec=tvec",this) execute(tstr) } } proc resize () { vec.resize($1) if (isassigned(tvec)) tvec.resize($1) } endtemplate vitem //* main template: GRV // the attributes of a particular set of graphs including line colors, // world coordinates, etc // glist is a list of all graphs created from this panel // llist is a list of available names and associated vectors or locations begintemplate GRV public color,line,super,curcol,comment,vecpanel,mesg,tmplist,gxpan public glist,oglist,llist,tvec,size,shift,vsz,vjmp,tloc,vloc,remote public entries,segments,clear,keepgr public read_vfile,rvaltdisp,read_file,grvec,remgrs,clear,record,read_pclamp public cpplitem,chgplname,npl,new_pri,prlexp,numovecs,fchooser public read_vdotfile,rpanel,panobjl,ddir,filter public rlist,rvlist,attrpanl,wvpanl,remgrs,collapsegrs,viewplot,nvwall public geall,lblall,relbl,grall,grsel,tposvec,fliptb,setrange,setgrransel,grransel public chrange,rv,rv_readvec,rvec,rvl,read_rfile,gv public grrtsize,ge,pvall,pvother,pvplist,pvclose,vf2fwf public pvnext,pvout,prvec,pv,lpvec,nvplt,apbrowse,apkill public newpl,find_secname,mkmenu,dir2pr,dir2mf,read_mf public mkpanel,pbrgr,remprl,filename,onum,po,stub,go public rvtr,vrdr,prdr,tmpobj,printlist,output_file,attr0,attrnum,s,vite public glist,llist,tvec,ind,vec,vrtmp,tmpvec,tf1,tmpobj,apvb,printStep public gvmarkflag,gveraseflag,fchooser_flag,byte_store,bst,szstr,regexp,tmpfile public magga,mvga,ll double size[4],vsz[2],wvloc[4],x[4] objref glist, oglist, llist, tvec, ind, vec, vrtmp, tmpvec, tf1, tmpobj, apvb, ovb, printlist objref vite,scob,printlist,szstr[4],g,this,tmplist,panobj,panobjl,Xo,Yo,tmpfile, gcomms strdef comment,recstr,grvecstr,readtag,rvvec_name,grep,tstr,tstr2,ddir,filter strdef temp_string_,temp_string2_,output_file,s,filename,mesg,regexp external sfunc,osname,vfile_line,vitem,uname,nil,simname,gnum,XO,YO,graphList,isassigned external isobj,isit,mso,msoptr,allocvecs,dealloc,tstop,method,cvode,show_panel,rv2,rv3,setfilt2 external cvode_active,cvode_local,datestr,runnum,i1,graphItem,GRV,strm,objnum,DBL,dir2mf2 external file_with_dot,count_substr,file_len,filname,dirname,dir,grv_,repl_mstr,pvout2 // list iterator ltr // usage 'for ltr(YO, tmplist) { print YO }' iterator ltr () { local i ii1=0 for i = 0,$o2.count-1 { $o1 = $o2.object(i) iterator_statement ii1+=1 } $o1=nil } proc init () { local flag,nopan flag=1e9 if (numarg()==1) if (argtype(1)==0) flag=$1 if (numarg()==2) if (argtype(2)==0) flag=$2 else printf("2nd arg for GRV should be flag\n") nopan=0 color=1 line=1 curcol=1 keepgr=tloc=-1 nvec=bvec=super=0 vjmp=50 entries=1 segments=1 fchooser_flag=0 vsz[0] = 300 vsz[1] = 200 glist = new List() tmpfile = new File() oglist = glist // save old glist for after superimpose llist=new List() gcomms=new List() printlist=llist tvec=new Vector(0) ind=tvec.c vec=tvec.c vrtmp=tvec.c tmpvec=tvec.c rvvec_name = "vec" ddir = "data/" printStep=gvmarkflag=gveraseflag=mff=0 remote=0 entries=segments=shift=0 tloc=vloc=vjmp=x=y=luprd=0 wvloc[0]=50 wvloc[1]=50 wvloc[2]=800 wvloc[3]=150 onum=objnum(this) for ii=0,3 { szstr[ii] = new String() } if (sfunc.substr(osname,"inux")==1) grep="grep -a" else grep="grep" readtag = "^//[:pbCM ]" // regexp used to identify header in mixed binary files { szstr[0].s="Set xmin" szstr[1].s="Set xmax" szstr[2].s="Set ymin" szstr[3].s="Set ymax" } multi_files = 1 // set 0 to show individual segments of multi-seg files dec_runnum = 0 // whether to decrement runnum when saving a new file byte_store = 4 // store as ascii (0), byte (1), int (2), float (3), double (4) tvec_bytesize = 4 // always store tvecs with more precision outvecint = 0 // dump vectors every outvecint time if not 0 outvect = 0 // time for next vec dump labelm = 1 // set to 0 to turn off labeling attr0=0 // default is a panel for reading files if (flag==0) { // make a sim-recording panel if (numarg()>1) printf("GRV WARNING: creating simpan, ignoring filename\n") attr0=1 attrnum=0 if (! isobj(panobjl,"List")) panobjl = new List() attrnum=panobjl.append(this)-1 if (attrnum!=0) printf("GRV WARNING: attr0 with attrnum=%d!\n",attrnum) if (show_panel) vecpanel() sprint(tstr,"printlist=%s.printlist",this) execute(tstr) sprint(s,"GRV[%d]:%s (sim vecs)",objnum(this),simname) return } panobjl=grv_.panobjl attrnum=panobjl.append(this)-1 if (flag==-2) nopan=1 if (flag==-1) { fchooser() // ask user for filename } else if (numarg()>=1) { if (argtype(1)==2) read_vfile($s1) } if (!nopan) attrpanl() } //** newfile() calls fchooser proc newfile () { localobj o o = apvb fchooser() attrpanl() } //** bst() selects byte_store func bst () { if (numarg()>=1) byte_store=$1 if (numarg()>=2) tvec_bytesize=$2 return byte_store } //* attrpanl() gives attributes for a set of graphs proc attrpanl () { local ii,jj sfunc.tail(filename,"data.*/",grvecstr) apvb=new VBox() apvb.intercept(1) xpanel(temp_string_) xvarlabel(filename) if (sfunc.len(mesg)>40) sfunc.left(mesg,40) xvarlabel(mesg) xvalue("Color(-1=multi)","color",1,"if (color==0) curcol=0",0,1) xvalue("Line","line",1,"",0,1) xpanel() xpanel("",1) xbutton("Superimpose: ","tog(&super) if (super==0) gnum=-1 sprint(mesg,\"super=%d\",super)") xbutton("Where?","sprimp()") xbutton("Restore","glist=oglist sprint(mesg,\"Restore graph list\")") xpanel() xpanel("",1) xbutton("Limits","wvpanl()") xbutton("Erase","geall()") xbutton("Mark","togmark()") if (attr0) xbutton("Panel","pbrgr(\"Graph\",\"gv\")") else { xbutton("New file","newfile()") } xpanel() xpanel("",1) xmenu("Graphs") xbutton("Erase/redraw","gveraseflag=-(gveraseflag-1) if (gveraseflag==1) super=1 else super=0 sprint(mesg,\"Erase=%d\",gveraseflag)") xbutton("Erase graphs","geall()") xbutton("Remove graphs","remgrs()") xbutton("Clean graph list","collapsegrs()") xbutton("Erase axes","setrange(3)") xbutton("Draw axes","setrange(0)") xbutton("Label graphs","lblall()") sprint(tstr,"execute(\"disptray(%d)\")",onum) xbutton("Make tray",tstr) xbutton("View = plot","for ltr(Xo,glist) Xo.exec_menu(\"View = plot\")") xbutton("Crosshair","for ltr(Xo,glist) Xo.exec_menu(\"Crosshair\")") xbutton("New view","for ltr(Xo,glist) Xo.exec_menu(\"NewView\")") xbutton("Zoom","for ltr(Xo,glist) Xo.exec_menu(\"Zoom in/out\")") xbutton("Delete Text","for ltr(Xo,glist) Xo.exec_menu(\"Delete\")") xbutton("Move Text","for ltr(Xo,glist) Xo.exec_menu(\"Move Text\")") xbutton("Change Text","for ltr(Xo,glist) Xo.exec_menu(\"Change Text\")") xmenu() // sprint(temp_string_,"remote",attrnum) // sprint(temp_string2_,"grall(%d)",attrnum) // xvalue("Graph all",temp_string_,0,temp_string2_) if (attr0) redo_printlist() else xbutton("Show full panel","rpanel()") xpanel() apvb.intercept(0) if (attr0) { sprint(s,"GRV[%d] %s SIM CONTROL",objnum(this),simname) } else { if (sfunc.len(filename)>0) filname(filename,grvecstr) sprint(s,"GRV[%d] %s:%s",objnum(this),simname,grvecstr) } apvb.map(s) } //** sprimp() superimpose on another sim proc sprimp () { super=1 sprint(tstr,"SUPERIMPOSE %s ON?",s) ovb=new VBox() ovb.intercept(1) xpanel(tstr) xvalue("Superimpose on Graph[#]","gnum",1) for ltr(Xo,panobjl) { sprint(temp_string2_,"glist=%s.glist sprint(mesg,\"Using graph list from %s\") ovb.unmap() ovb=nil",Xo,Xo) xbutton(Xo.s,temp_string2_) } xpanel() ovb.intercept(0) ovb.map(tstr) ovb.dismiss_action("ovb.unmap ovb=nil") } //** fchooser() finds file and then create panel from it using rpanel proc fchooser () { if (fchooser_flag == 0) { // create panel first time only if (setfilt2(filter)) { // do nothing } else if (strm(filter,"\\*")) { // do nothing } else sprint(filter,"*%s*",datestr) tmpfile.chooser("","Read from a file",filter,"Open","Cancel",ddir) } fchooser_flag = 1 if (tmpfile.chooser()) { // find out whether this is a vector file or not tmpfile.getname(filename) if (strm(filename,"\.mf")) read_mf() else read_vfile() } } //** newpan() create a new panel and call fchooser from there proc newpan () { tmpobj=new GRV(-1) } //** read_vfile() creates a panattr object from information in a file // (uses grep to avoid loading big file) // assumes file in tmpfile func read_vfile () { local flag, ii, sz, loc, mult, sze, cloc, segs if (numarg()>=2) if (strcmp(filename,$s1)==0) return 2 // check if file is already active if (attr0) { if (!boolean_dialog("Look at file data instead of sim?","YES","NO")) { printf("Read file cancelled\n") return 0 } } else { attr0=0 } if (numarg()>=1) filename=$s1 else tmpfile.getname(filename) if (strm(filename,"\.mf$")) return read_mf(filename) sprint(s,"GRV[%d] %s: %s",objnum(this),simname,filename) clear() // grab hold of the different lines using grep file_with_dot(filename,temp_string_) // put .filename into temp_string_ if (!tmpfile.ropen(temp_string_)) { print "E1: Can't open ",temp_string_ // avoid grep error return 0 } else flag = 1 // signifies that .file exists to use as key while ((numr = tmpfile.gets(tstr)) != -1) { // throw out the leading '//' // read the line if (sfunc.head(tstr,"//[^b]",temp_string2_)==0) { read_vinfo() // a line giving info about the file (eg comment) } else { // NB: code in v60:516 to pickup byte_store value if (flag && entries > 1) { // a .file with MULTI segs tmpfile.seek(-numr,1) // backup to beginning of line read_vdotfile() } else if (segments > 1) { // mult segs: different times for same var tmpfile.seek(-numr,1) // backup to beginning of line segments = read_vsegs() //**** NEEDS to be recovered from grvec.hoc442 } else { // read each line in for itself if ( sscanf(tstr,"//b%1ld %g %s %ld %ld",&bvec,&nvec,tstr2,&sze,&loc)!=5) { if (sscanf(tstr,"//b%1ld %s %ld %ld",&bvec,tstr2,&sze,&loc)!=4) { printf("**** GRV read_vfile() parse ERR on %s in %s",tstr,filename) } else if (printStep==-2) nvec=-2 else nvec=-1 // guess } if (nvec==2) { printf("read_vfile forward compat. **** WARNING ****\n\t****consider edit of %s dot file to change 2 to -2\n",filename) nvec=-2 } if (strcmp(tstr2,"CVODE1.0 tvec")==0) { tvec.resize(0) printStep=-1 tloc = loc // where to find tvec later } else { tmpobj = new vfile_line(tstr2,sze,loc,nvec) // name size loc num tmpobj.ty=bvec llist.append(tmpobj) tmpobj = nil } } } } if (llist.count==0) { printf("grvec.hoc::read_vfile ERR no vecs read from %s\n",filename)} if (entries==1) entries = llist.count if (! flag && segments>1) write_vsegs() // create key .file if (! tmpfile.ropen(filename)) { print "E3: Can't open ",filename return 0 } if (printStep==-1) rtvec() // code for cvode_active() mff=0 return 1 } //** rtvec() reads tvec if it exists, returns -1 if it doesn't func rtvec () { if (tloc > -1) { tmpfile.seek(tloc) tvec.vread(tmpfile) return 1 } else { return 0 } } proc write_vsegs () { print "NEEDS to be ported from grvec.hoc442" } //** read_vinfo() proc read_vinfo () { if (strm(tstr,"//printStep")) { sfunc.tail(tstr," ",tstr) // just take end of string following space sscanf(tstr,"%g",&printStep) // printstep==-1 means cvode } else if (strm(tstr,"^//:")) { // a comment sfunc.tail(tstr,"//: *",tstr) sfunc.head(tstr,"\n",comment) // chop final newline mesg=comment } else if (strm(tstr,"^//CPU")) { // the machine type for byte storage sfunc.tail(tstr," ",tstr) if (! strm(tstr,uname)) { printf("%s written from %s\n",filename,tstr) } } else if (strm(tstr,"^//MULTI")) { // multiple lines for each entry sfunc.tail(tstr," ",tstr) if (sscanf(tstr,"%d %d",&entries,&segments)==2) { if (! multi_files) printf("**************** GRV read_vinfo ERRa\n") } else segments=1 } else { printf("Line:\t%s\n\tnot recognized in %s\n",tstr,filename) } } //** read_vdotfile() read .file in abbreviated format (see write_vsegs) proc read_vdotfile() { local loc,entries,segments,ii entries=entries segments=segments for i=1,entries { // read this abbreviated file version (much faster) tmpfile.scanstr(temp_string_) loc = tmpfile.scanvar() tmpobj = new vfile_line(temp_string_,-1,loc,segments) // don't set size llist.append(tmpobj) for ii=1,segments-1 { tmpobj.loc[ii] = tmpfile.scanvar() } } } //** rpanel() creates a panel from information in llist proc rpanel () { local ii if (llist.count > 8) { rlist() return } sprint(temp_string_,"%s ",simname) xpanel(temp_string_) xlabel(filename) for ii=0,llist.count-1 { sprint(temp_string2_,"rv(%d)",ii) xbutton(llist.object(ii).name,temp_string2_) } xbutton("Attributes","attrpanl()") sprint(temp_string_,"lpvec(filename,vrtmp,%g)",printStep) xbutton("Print last vec",temp_string_) xbutton("Erase","ge()") xpanel() } //** rlist(): like rpanel() but puts up a browser list instead of a panel proc rlist () { sprint(tstr,"%d items on list: Enter regexp for subset or \"All\"",llist.count) if (llist.count>50 || numarg()>=1) { if (numarg()>=1) regexp=$s1 else if (!string_dialog(tstr,regexp)) return if (! strm(regexp,"[Aa][Ll][Ll]")) { if (! isobj(tmplist,"List")) tmplist = new List() tmplist.remove_all for ltr(Xo,llist) { Xo.ix=ii1 if (strm(Xo.name,regexp)) tmplist.append(Xo) } tmplist.browser(filename,"name") tmplist.accept_action("rv(tmplist.object(hoc_ac_).ix)") printf("%d selected\n",tmplist.count) return } } llist.browser(filename,"name") llist.accept_action("rv(hoc_ac_)") } //** rvlist(): like rpanel() but puts up a browser list instead of a panel proc rvlist () { local flag,rdstr rdstr = 1 flag = $1 if (numarg()==2) { recstr=$s2 rdstr=0 } if (flag==0) { llist.browser(filename,"name") llist.accept_action("rvec(hoc_ac_)") } else if (flag==1) { // proc(vec) if (rdstr) string_dialog("Procedure name: proc, called as proc(vec)",recstr) llist.browser(recstr,"name") sprint(temp_string_,"rv_readvec(hoc_ac_,%s) execute1(\"%s(%s)\")",rvvec_name,recstr,rvvec_name) llist.accept_action(temp_string_) print ":",recstr,":",temp_string_,":",rvvec_name } else if (flag==2) { // vec.command if (rdstr) string_dialog("comm: print vec.comm",recstr) llist.browser(recstr,"name") sprint(temp_string_,"{rvec(hoc_ac_) print %s.%s}",rvvec_name,recstr) llist.accept_action(temp_string_) } } //* rv() reads line of vector file into IV graph via vector // rv(llist_ind1[,llist_ind2]) // rvaltdisp(tvec,vec,name) func rvaltdisp () { return 0 } // if returns 1 means there is an alternate display for rv obfunc rv () { local inx,inx2 localobj o // open the file and go to correct position if (numarg() == 0) { print "rv(ind1,ind2) reads into vrtmp bzw vec" return this} inx = $1 if (attr0) {return gv(inx)} o=llist.object(inx) if (numarg()>1) inx2 = $2 else inx2 = -1 // to graph one vec against another rv_readvec(inx,vrtmp) rv2(vrtmp,tvec) // create a new plot if necessary and set color if (vrtmp.size==0) { // assume this is a spike train in tvec nvplt(ind,vrtmp) ind.resize(tvec.size) ind.fill(0) ind.mark(graphItem,tvec,"O",line,curcol) } else if (inx2>-1) { // only make sense if they share the same tvec rv_readvec(inx2,vec) nvplt(vec,vrtmp) if (numarg() >= 3) { vec.mark(graphItem,vrtmp,$s3,line,curcol) } else { vec.mark(graphItem,vrtmp,"O",line,curcol) } } else if (o.num==-2) { nvplt(vrtmp,tvec) if (gvmarkflag) { if (! rvaltdisp(tvec,vrtmp,llist.object(inx).name)) { vrtmp.mark(graphItem,tvec,"O",line,curcol,4) } } else vrtmp.line(graphItem,tvec,curcol,line) } else if (o.num==-1) { printf("rv() PROBLEM: CVODE global read not implemented\n") } else { if (o.num==0) { printf("rv WARNING: taking printstep %g for %s\n",printStep,o.name) o.num=printStep } nvplt(vrtmp,o.num) if (gvmarkflag) { vrtmp.mark(graphItem,o.num,"O",line,curcol,4) } else vrtmp.line(graphItem,o.num,curcol,line) } // too much fussing with labels if (sfunc.substr(filename,"batch")!=-1 || \ sfunc.substr(filename,"data")==-1) { grvecstr = filename } else sfunc.tail(filename,"data",grvecstr) if (sfunc.len(llist.object(inx).name)>40) { grvecstr=llist.object(inx).name } else { sprint(grvecstr,"%s:%s",grvecstr,llist.object(inx).name) } rv3(grvecstr) if (super == 0 && labelm) { graphItem.label(0,0.9,grvecstr) } else if (labelm) graphItem.label(0.0,0.95,grvecstr) return graphItem } //* gv(vnum) graphs vector obfunc gv () { local a,inx,lin localobj o,v1,vtmp inx=-1 lin=line a=allocvecs(vtmp) if (numarg()==0) { inx = hoc_ac_ } else { if (argtype(1)==0) inx = $1 if (argtype(1)==2) { for ltr(Xo,printlist) if (strm(Xo.name,$s1)) inx=ii1 if (inx==-1) {print $s1," not found" return this}} } if (numarg()>=2) { color=curcol=$2 } if (numarg()>=3) { lin=$3 } o = printlist.object(inx) vtmp.copy(o.vec) rv2(o.vec) // alters vtmp if (o.vec.size==0) { // assume that this is spk trace if (o.tvec.size==0) { printf("\tNO SPIKES IN %s\n",printlist.object(inx).name) } else { nvplt(o.tvec) ind.resize(o.tvec.size) ind.fill(1) ind.mark(graphItem,o.tvec,"O",lin,curcol) } } else { if (o.tvflag!=0) { // o.tvec should point to tvec if tvflag==-1 nvplt(o.vec,o.tvec) if (gvmarkflag) { o.vec.mark(graphItem,o.tvec,"O",lin,curcol) } else { o.vec.line(graphItem,o.tvec,curcol,lin) } } else { if (o.pstep==0) { printf("gv WARNING: vitem.pstep not set with tvflag==0 (%s)\n",o) o.pstep=printStep } nvplt(o.vec,o.pstep) if (gvmarkflag) { o.vec.mark(graphItem,o.pstep,"O",lin,curcol) } else { o.vec.line(graphItem,o.pstep,curcol,lin) } } if (labelm) { grvecstr=printlist.object(inx).name rv3(grvecstr) graphItem.label(0.,0.9,grvecstr) } } o.vec.copy(vtmp) // in case has been changed by rv2() dealloc(a) return graphItem } // go(n) will goto location in the data file obfunc go () { localobj o if (argtype(1)==0) { inx=$1 o=llist.object(inx) } else o=$o1 tmpfile.seek(o.loc) return o } // rv_readvec(index,vec) // read vector #index from file into vector vec func rv_readvec () { local inx,ii,n,bvec localobj o if (argtype(1)==0) { inx=$1 o=llist.object(inx) } else o=$o1 n=o.num if (mff) {tstr=filename filename=o.f} tmpfile.getname(temp_string_) // may not be necessary? if (strcmp(temp_string_,filename)!=0 || tmpfile.isopen()==0) { // don't reopen file if there if (! tmpfile.ropen(filename)) { print "ERROR rv() can't read ",filename return 0 } } tmpfile.seek(o.loc) bvec=o.ty if (numarg()>=3) { if (n!=-2) { printf("ERROR rv() called with 2 vecs but only find 1 in %s %s %d\n",filename,o.name,inx) return 0 } if (bvec>5) { $o2.fread(tmpfile,o.size,bvec-5) $o3.fread(tmpfile,o.size,bvec-5) } else { $o2.vread(tmpfile) $o3.vread(tmpfile) } } else { if (n==-2) { if (bvec>5) { tvec.fread(tmpfile,o.size,bvec-5) // no error check } else if (!tvec.vread(tmpfile)) { printf("rv_readvec tvec READ failure in %s %s %d\n",filename,o.name,inx) return 0 } if (bvec>5) { $o2.fread(tmpfile,o.size,bvec-5) // no error check } else if (! $o2.vread(tmpfile)) { printf("rv_readvec vec READ failure in %s %s %d\n",filename,o.name,inx) return 0 } } if (n==-2 && (tvec.size != $o2.size)) { printf("rv_readvec size mismatch in %s %s %d\n",filename,o.name,inx) return 0 } } if (segments>1) { // needs rewrite tmpvec = new Vector($o2.size) for ii=1,segments-1 { tmpfile.seek(llist.object(inx).loc[ii]) tmpvec.vread(tmpfile) $o2.copy(tmpvec,$o2.size) } tmpvec = nil } if (mff) filename=tstr // restore return n } //** vf2fwf() take a file in vformat and prints out as multiple fwrites proc vf2fwf () { local ii localobj f f=new File() f.wopen($s1) for ii=0,entries-1 { rv_readvec(ii,vrtmp) vrtmp.fwrite(f) printf("%d ",vrtmp.size) } f.close printf("\n dt=%g\n",printStep) } //** rvec(num[,vec]) writes to vec, or contents of rvvec_name or // to vector of same name if rvvec_name is empty proc rvec () { local flag,on flag=0 if (sfunc.len(rvvec_name)==0) flag=1 if (numarg()<1) on=hoc_ac_ else on=$1 if (numarg()>1) sprint(rvvec_name,"%s",$o2) if (sfunc.len(rvvec_name)==0) rvvec_name=llist.object(on).name printf("Copying %s to %s\n",llist.object(on).name,rvvec_name) sprint(temp_string_,"%s.rv_readvec(%d,%s)",this,on,rvvec_name) if (flag) rvvec_name="" // clear it again if (! execute1(temp_string_)) print "ERROR: Declare target as a vector" if (numarg()==4) $o4.copy(tvec) } //** rvl() reads line of vector file into IV graph via vector // rvl(name,pos[,pos2,pos3,etc]) proc rvl () { local i // open the file and go to correct position tmpfile.getname(temp_string_) if (strcmp(temp_string_,filename)!=0 || tmpfile.isopen()==0) { tmpfile.ropen(filename) } // only open if necessary if (tmpfile.isopen==0) { printf("ERROR: %s not found.\n",filename) return } if (numarg() == 3) { tmpfile.seek($3) tmpfile.gets(temp_string_) // throw away line vrtmp.vread(tmpfile) } else { tmpvec = new Vector() for i=3,numarg() { tmpfile.seek($i) tmpvec.vread(tmpfile) vrtmp.copy(tmpvec,vrtmp.size) } } tmpvec = nil nvplt(vrtmp) vrtmp.line(graphItem,printStep,curcol,line) // graph it and label the graph if (sfunc.substr(filename,"batch")!=-1) { grvecstr = filename } else { sfunc.tail(filename,"data",grvecstr) } sprint(grvecstr,"%s:%s",grvecstr,$s2) if (super==0 && labelm) { graphItem.label(0,0.9,grvecstr) } else if (labelm) graphItem.label(grvecstr) } //* utility programs (not all used or even all usable) //** nvplt() put up new voltage plot obfunc nvplt () { local xs,ys,flag,prstep prstep=10 if (super == 0) flag=1 else { if (gnum>-1) { sprint(tstr,"{Graph[%d]}",gnum) if (execute1(tstr,0)) { // Graph[gnum] exists if (Graph[gnum].view_count>0) { graphItem=Graph[gnum] flag=0 } } } else if (isobj(graphItem,"Graph")) if (graphItem.view_count() > 0) { flag=0 } else { flag=1 } // else need new graph } if (flag) { if (numarg()==2) if (argtype(2)==0) prstep=$2 else prstep=-1 if (size[1] != 0) { // xmax is set newpl(size[0],size[1],size[2],size[3]) } else if (prstep<0) { newpl(0,$o2.max,$o1.min,$o1.max) } else { newpl(0,$o1.size()*prstep,$o1.min,$o1.max) } } else if (gveraseflag) graphItem.erase_all if (color == -1) { curcol += 1 if (curcol == 0 || curcol>7) curcol = 1 } else curcol = color graphItem.color(curcol) g=graphItem return g } //** grrtsize() use view=plot and then pad a little proc grrtsize () { local h,w,frac if (numarg()>=1) tmpobj=$o1 else tmpobj=graphItem if (numarg()>=2) frac = $2 else frac=.05 tmpobj.exec_menu("View = plot") tmpobj.size(&x) w=frac*(x[1]-x[0]) h=frac*(x[3]-x[2]) x[0]-=2*w x[1]+=w x[2]-=4*h x[3]+=h // need extra padding on bottom tmpobj.size(x[0],x[1],x[2],x[3]) } //** newpl() proc newpl () { local w,h if (numarg()==5) newPlot($1,$2,$3,$4) // 5th arg is flag if (numarg()==8) {wvloc[0]=$5 wvloc[1]=$6 wvloc[2]=$7 wvloc[3]=$8} graphItem = new Graph(0) g=graphItem graphItem.xaxis() // view axis for x and y graphItem.view($1,$3,$2-$1,$4-$3,wvloc[0],wvloc[1],wvloc[2],wvloc[3]) glist.append(graphItem) } //** find_secname(variable,result): put secname into result proc find_secname () { localobj o if ((sfunc.head($s1,"\.[_A-Za-z0-9]+$",$s2))==0) { // strip off stuff after terminal . printf("grvec.hoc:find_secname ERR: no section found: %s\n",$s1) err() } if ( strm($s1,"\.[_A-Za-z0-9]+[(][0-9.]+[)]$")) { // form eg v(0.5) sfunc.head($s1,"\.[_A-Za-z0-9]+[(][0-9.]+[)]$",$s2) } else { o=isit($s2) if (o.x) { // the stem is an obj o.o.get_loc() sectionname($s2) pop_section() } else { printf("grvec.hoc:f_s ERR0: Can't find sec: %s\n",$s1) err() } } } //** vecpanel() main panel proc vecpanel () { if (! attr0) {printf("vecpanel (main panel) can only be run from attr0\n") return } fchooser_flag = 0 // used to initialize the file chooser sprint(temp_string_,"%s Vectors",simname) xpanel(temp_string_) xbutton("Graph from file","newpan()") xbutton("Sim vectors","pbrgr(\"Graph\",\"gv\")") xbutton("Sim attributes","attrpanl(0)") xbutton("Save Sim","pvall()") xbutton("Panels","apbrowse()") redo_printlist() xpanel() } //** lpvec(title,vector,printstep) dumps a single vector onto the printer using jgraph proc lpvec () { local inx,ii tmpfile.wopen("lptmp") tmpfile.printf("newgraph\nnewcurve pts\n") for ii = 0,$o2.size-1 { tmpfile.printf("%g ",ii*$3) $o2.printf(tmpfile,"%g",ii,ii) } tmpfile.printf("marktype none\nlinetype solid\ntitle : %s\n",$s1) tmpfile.close() system("jgraph -P lptmp > lptmp2") system("lpt lptmp2") } //** remgrs() -- clears glist proc remgrs () { local ii for ltr(Xo,glist) Xo.unmap if (keepgr!=-1) { for (ii=glist.count-1;ii>0;ii-=1) glist.remove(ii) // leave #1 } else glist.remove_all } //** clear() -- clears llist proc clear () { entries=1 segments=1 comment = "" llist.remove_all() } //** ll() same as external llist proc ll () { if (numarg()==1) { if (attr0==1) { for ltr(XO,printlist) if (strm(XO.name,$s1)) print ii1,XO.name,XO.vec.size } else for ltr(XO,llist) if (strm(XO.name,$s1)) print ii1,XO.name,XO.size } else { if (attr0==1) { for ltr(XO,printlist) print ii1,XO.name,XO.vec.size } else for ltr(XO,llist) print ii1,XO.name,XO.size } } //* read_pclamp(file,vscale,tscale): read physiol data file, similar to read_file() proc read_pclamp () { local ii,cols,pt,length,pstep,tscale,vscale if (! tmpfile.ropen($s1)) { printf("\tERROR: can't open file \"%s\"\n",$s1) } if (numarg()>=2) vscale=$2 else vscale=1 if (numarg()>=3) tscale=$3 else tscale=1e3 printlist.remove_all() method("implicit") printStep=0.1 tmpfile.gets(temp_string_) length=1 while (! strm(temp_string_,"^\"Time")) { length += 1 tmpfile.gets(temp_string_) // first word in line was not a number so next line } temp_string2_ = temp_string_ // column def line cols = count_substr(temp_string_,"[(]") // destructive function pt = tmpfile.tell() length = file_len($s1) - length vrtmp.scanf(tmpfile,length,1,cols) // tvec pstep=vrtmp.x[1]-vrtmp.x[0] pstep*=tscale // typically gives it in s statt ms print "Reading ", cols, " columns; ", length, " lines; tstep=",pstep for ii=2,cols { // pick up all of the columns tmpfile.seek(pt) vrtmp.scanf(tmpfile,length,ii,cols) vrtmp.mul(vscale) // correct for a common scaling npl("col",ii,vrtmp,pstep) } if (1) { sprint(temp_string2_,"%s:%s",$s1,temp_string2_) file_with_dot($s1,filename,"v") // put vfilename into name print "Saving to ",filename pvplist(filename,temp_string2_) } } //* read_file(file,cols[,length]): read multicolumn file // see also read_pclamp() above func read_file () { local ii,cols,pt,length if (numarg()==0) { print "\tread_file(\"file\",cols)" print "\t(must set tstop and printStep.)" return 0 } printStep=10 if (cvode_status()!=0) print "WARNING: Turn off cvode." if (numarg()==3) { length = $3 } else { length=tstop/printStep } cols = $2 if (! tmpfile.ropen($s1)) { printf("\tERROR: can't open file \"%s\"\n",$s1) return 0} // printlist.remove_all() tmpfile.scanstr(temp_string_) pt = 0 // skip over a comment line; note that this will skip extra line if comment line is // just one word long while (sfunc.head(temp_string_,"[^-+0-9.e]",temp_string2_) != -1) { tmpfile.gets(temp_string_) // first word in line was not a number so next line pt = tmpfile.tell() // location at next line tmpfile.scanstr(temp_string_) // get first word here print temp_string2_ } for ii=1,cols { // pick up all of the columns tmpfile.seek(pt) vrtmp.scanf(tmpfile,length,ii,cols) npl("col",ii,vrtmp) } return 1 } //* read_rfile(file): read multirow file // use col2row to transpose columnar file first proc read_rfile() { local num if (numarg()==0) { print "\tread_rfile(\"file\")" return } if (! tmpfile.ropen($s1)) { printf("\tERROR: can't open file \"%s\"\n",$s1) return} printlist.remove_all() while (tmpfile.scanstr(temp_string_) != -1) { // read lines num = tmpfile.scanvar() // pick up number of items in col vrtmp.scanf(tmpfile,num) npl(temp_string_,vrtmp) } } //* redo_printlist() menu allows removal or addition of inidividual items proc redo_printlist () { xmenu("Printlist") xbutton("Save Sim","pvall()") xbutton("Add var to printlist","redolist(0)") xbutton("Clear printlist","printlist.remove_all()") xbutton("Remove item from printlist","redolist(1)") xbutton("Vector.op","redolist(2)") xbutton("Proc(vector)","redolist(6)") xbutton("Link XO->vec,YO->tvec","redolist(7)") xbutton("Graph vector","redolist(4)") xbutton("Save printlist","redolist(5)") xbutton("Archive to file:","pbrgr(\"Archive\",\"pv\")") xbutton("Add all obj's of this type to printlist","redolist(3)") xmenu() } //* redolist() set of functions for altering the printlist called by redo_printlist() proc redolist () { local ii,flag if (! isobj(printlist,"List")) printlist = new List() flag = $1 rdstr = 1 if (numarg()==2) { recstr=$s2 rdstr=0 } if (flag==0) { if (! isobj(scob,"SymChooser")) scob = new SymChooser() if (scob.run()) { scob.text(temp_string_) npl(temp_string_) } } else if (flag==1) { // remove item printlist.browser("Double click on item to remove","name") printlist.accept_action("printlist.remove(hoc_ac_)") } else if (flag==2) { // .op if (rdstr) string_dialog("Enter operation to be run on vec",recstr) temp_string_ = "\"%s.%s = %g\\n\"" sprint(temp_string_,"printf(%s,printlist.object(hoc_ac_).name,\"%s\",x=printlist.object(hoc_ac_).vec.%s)",temp_string_,recstr,recstr) printlist.browser(recstr,"name") printlist.accept_action(temp_string_) } else if (flag==3) { // put another set of things on list if (! isobj(scob,"SymChooser")) scob = new SymChooser() if (rdstr) string_dialog("String to be used as suffix for all items on list",recstr) scob.run() scob.text(temp_string_) tmplist = new List(temp_string_) record(tmplist,recstr) } else if (flag==4) { // show it pbrgr("Graph","gv") } else if (flag==5) { fchooser_flag = 0 tmpfile.chooser("a","Add printlist to file") if (tmpfile.chooser()==1) { tmpfile.printf("\nproc make_printlist() { \n") tmpfile.printf(" printlist.remove_all()\n") for ii=0,printlist.count-1 { tmpfile.printf(" npl(\"%s\")\n",printlist.object(ii).name) } tmpfile.printf("}\nmake_printlist()\n") tmpfile.close() } } else if (flag==6) { // proc(vec) if (rdstr) string_dialog("Enter procedure name \"proc\",called as proc(vec,var,num)",recstr) printlist.browser(recstr,"name") sprint(temp_string_,"%s(printlist.object(hoc_ac_).vec,printlist.object(hoc_ac_).name,hoc_ac_)",recstr) printlist.accept_action(temp_string_) } else if (flag==7) { // XO is pointer to vec printlist.browser("XO","name") sprint(temp_string_,"{tmpobj=printlist.object(hoc_ac_) print hoc_ac_,tmpobj.name XO=tmpobj.vec YO=tmpobj.tvec}") printlist.accept_action(temp_string_) } } //** mkmenu(title,action,proc) makes a menu from printlist proc mkmenu () { local ii xmenu($s1) for ii=0,printlist.count-1 { sprint(temp_string_,"%s %s",$s2,printlist.object(ii).name) sprint(temp_string2_,"%s(%d)",$s3,ii) xbutton(temp_string_,temp_string2_) } sprint(temp_string_,"mkpanel(\"%s\",\"%s\",\"%s\")",$s1,$s2,$s3) xbutton("Leave up",temp_string_) xmenu() } //** pbrgr(browser name,action) is used to put up a browser // note action given without '()' proc pbrgr () { if (printlist.count == 1) { gv(0) } else if (printlist.count <= 8) { mkpanel("Vector",$s1,$s2) } else { sprint(temp_string_,"%s:%s",simname,$s1) printlist.browser(temp_string_,"name") sprint(temp_string2_,"%s()",$s2) printlist.accept_action(temp_string2_) } } //** mkpanel(title,action,proc) makes a panel from printlist proc mkpanel () { local ii sprint(temp_string_,"%s:%s",simname,$s1) xpanel(temp_string_) for ii=0,printlist.count-1 { sprint(temp_string_,"%s %s",$s2,printlist.object(ii).name) sprint(temp_string2_,"%s(%d)",$s3,ii) xbutton(temp_string_,temp_string2_) } xpanel() } //** remprl() -- remove printlist item by name proc remprl () { local flag flag=0 if (numarg()==2) flag=1 else print "LISTING ONLY; rerun with 2 args to remove" for (ii=printlist.count-1;ii>=0;ii-=1) { Xo=printlist.object(ii) if (strm(Xo.name,$s1)) if (flag) printlist.remove(ii) else print Xo.name } } // for ltr(XO,glist) { print XO,XO.view_count } //** wvpanl() proc wvpanl () { local ii sfunc.tail(filename,"data.*/",grvecstr) sprint(temp_string_,"%s:%s (WVPANL)",simname,grvecstr) xpanel(temp_string_) sprint(temp_string_,"%d Vectors",llist.count) xlabel(temp_string_) for ii=0,3 { sprint(temp_string_,"size[%d]",ii) sprint(temp_string2_,"chrange(%d)",ii) xvalue(szstr[ii].s,temp_string_,0,temp_string2_,0,1) } xvalue("Shift L/R","shift",0,"chrange(-2)",0,1) xmenu("Other") xbutton("Clear/Set to G0","chrange(-1)") xbutton("View=plot","viewplot()") xbutton("0,tstop,-90,50","setrange(0,tstop,-90,50)") // xbutton("Clean graph list","collapsegrs()") xbutton("Attributes","attrpanl()") xmenu() xpanel() if (glist.count>0) for ii=0,3 if (size[ii]==0) size[ii]=glist.object(0).size(ii+1) } //** chrange() changes range for a set of graphs (called from attrpanl) proc chrange () { local cnt, flag, ii, sz1, sz2, sz3, sz4 if (numarg()==1) { flag = $1 } else { flag = -1 } cnt = glist.count() for (ii=cnt-1;ii>=0;ii=ii-1) if (glist.object(ii).view_count() == 0) glist.remove(ii) cnt = glist.count() // check again after removing any with no views if (cnt==0) { for ii=0,3 size[ii]=0 return } // flag -1 means set everything from the first graph if (flag==-1) for ii=0,3 size[ii] = glist.object(0).size(ii+1) if (flag==-2) for ii=0+luprd,1+luprd size[ii] += shift // shift right or left if (flag==5) { size[0]=0 size[1]=tstop } // just set x // for each of the graphs for ltr(Xo,glist) { sz1=Xo.size(1) sz2=Xo.size(2) sz3=Xo.size(3) sz4=Xo.size(4) if (flag==0) Xo.size(size[0],sz2,sz3,sz4) if (flag==1) Xo.size(sz1,size[1],sz3,sz4) if (flag==2) Xo.size(sz1,sz2,size[2],sz4) if (flag==3) Xo.size(sz1,sz2,sz3,size[3]) if (flag==-1 || flag==4) Xo.size(size[0],size[1],size[2],size[3]) if ((flag==-2 && !luprd) || flag==5) Xo.size(size[0],size[1],sz3,sz4) if (flag==-2 && luprd) Xo.size(sz1,sz2,size[2],size[3]) } for ii=0,3 if (size[ii]==0) size[ii]=glist.object(0).size(ii+1) } //** grall() graphs all of the lines from the file // use vector $o2 as indices for vectors (see tposvec) proc grall () { local cnt,ii,min,max,gr,skip,iskp,vind,sind,a if (numarg()==0) {printf("grall(min,max,gr_offset,skipgr,iskp]): graph vectors.\n") return } sind=vind=0 cnt = llist.count() min=0 max=cnt-1 // will reset max if is vector with numarg()==2 // with 2 args, vector $o2 gives indices for vectors (see tposvec) if (numarg()>=1) { if (argtype(1)==0) { min=$1 } else { // a vector of indices or a string for prdr/vrdr a=allocvecs(1) if (argtype(1)==1) { vind=1 mso[a].copy($o1) } else sind=1 } } if (numarg()>1) { max=$2 if (max<0) max+=llist.count } if (numarg()>2) gr=$3 else gr=0 if (numarg()>3) skip=$4 else skip=1 if (numarg()>4) iskp=$5 else iskp=1 if (iskp==0) iskp=1 if (super==1 && glist.count==0) { remgrs() print "Creating plot" skip=0 newPlot(0,tstop,-100,100) glist.append(graphItem)} if (super==0 && glist.count==0) size[1]=0 if (sind) { // for vrdr(aa,$s2,1,1) aa.x(0).append(ii1) vind=1 } if (vind) { min=0 max=mso[a].size-1 } for (ii=min;ii<=max;ii+=iskp) { if (super == 1) { if (gr >= glist.count()) break graphItem = glist.object(gr) gr=gr+skip } if (vind) rv(mso[a].x[ii]) else rv(ii) } if (vind) dealloc(a) } // go through tmplist selected in rlist and graph onto glist proc grsel () { localobj o for ii=0,tmplist.count-1 { rv_readvec((o=tmplist.o(ii)),vrtmp) if (ii-1) { printf("Graphing %s\n",printlist.object(grrcnt).name) graphItem.erase_all() rv(grrcnt) graphItem.exec_menu("View = plot") } graphItem.size(size[0],size[1],size[2],size[3]) } else if (keystate==2 && type==2) { grrcnt=-1 } else if (keystate==2 && type==1) { x+=1 // slow it down five-fold if (x>5) { grrcnt=(grrcnt+1)%printlist.count printf("%d: %s\n",grrcnt,printlist.object(grrcnt).name) x=0 } } else if (keystate==0 && type==2) { x=x0 y=y0 } else if (keystate==0 && type==3) { graphItem.size(x,x0,y,y0) // resize to chosen square } } //** remgrs() gets rid of all of the graphs (called from attrpanl) proc remgrs () { local ii,cnt if (isobj(graphItem,"Graph")) { graphItem.unmap graphItem = nil } for ltr (Xo,glist) Xo.unmap() glist.remove_all } //** collapsegrs () take off of glist graphs that have been closed on screen proc collapsegrs () { local ii for (ii=glist.count-1;ii>=0;ii-=1) { if (glist.object(ii).view_count() == 0) { glist.remove(ii) } } } //** viewplot() set the world for each graph correctly proc viewplot () { local cnt,ii,flag,sz1,sz2,sz3,sz4 if (numarg()==1) flag=$1 else flag=-1 if (flag==0) { sz1=sz3=1e10 sz2=sz4=-1e10 } for ltr(Xo,glist) { Xo.size(&x[0]) if (flag==0) { if (x[0]sz2) sz2=x[1] if (x[2]sz4) sz4=x[3] } else if (flag==9) { Xo.size(0,tstop,x[2],x[3]) } else { Xo.size(x[0],x[1],x[2],x[3]) } } if (flag==9) { size[0]=0 size[1]=tstop } if (flag==0) for ltr(Xo,glist) Xo.size(sz1,sz2,sz3,sz4) } //** nvwall() changes the size of the graphs proc nvwall () { local cnt,ii,sz1,sz2,sz3,sz4,wd,ht if (numarg()==2) { wd=$1 ht=$2 } else { wd=vsz[0] ht=vsz[1] } cnt = glist.count() for (ii=cnt-1;ii>=0;ii=ii-1) { if (glist.object(ii).view_count()==0) {glist.remove(ii) } else { sz1 = glist.object(ii).size(1) sz2 = glist.object(ii).size(2) sz3 = glist.object(ii).size(3) sz4 = glist.object(ii).size(4) glist.object(ii).unmap() vloc = vloc+vjmp if (vloc > 700) { vloc = 0 } glist.object(ii).view(sz1,sz3,sz2-sz1,sz4-sz3,0,vloc,wd,ht) } } } //** geall() erases all of the graphs proc geall () { local cnt,ii cnt = glist.count() for ii=0,cnt-1 { glist.object(ii).erase_all() } } //** lblall(label,#,xloc,yloc) put label on all of the graphs // arg3 tells which single graph to put it on proc lblall () { local cnt,ii,min,max,lx,ly if (numarg()==0) { printf("lblall([,loc])\n") return } cnt = glist.count() if (numarg()>1) { min=max=$2 } else { min=0 max=cnt-1 } if (numarg()==5) { lx=$3 ly=$4 } else { lx=0.1 ly=0.8 } if (numarg()>1) { if (sfunc.len($s1)>0) { temp_string_ = $s1 }} for ii=min,max { glist.object(ii).color(color) glist.object(ii).label(lx,ly,temp_string_) } } //** relbl() put appropriate label on all of the graphs proc relbl () { local cnt,ii,min,max,lx,ly if (numarg()==0) { printf("relbl([str])\n") return } cnt = glist.count() if (numarg()==4) { lx=$3 ly=$4 } else { lx=0.1 ly=0.8 } if (numarg()>1) glist.object(0).label($s2) for ii=0,glist.count-1 { Xo=glist.object(0) Yo=llist.object(0) Xo.color(0) Xo.label(0.,.9,Yo.name) Xo.color(color) Xo.label(lx,ly,Yo.vec.label) } } //** toggle functions proc tog (){if (numarg()==0) print super=1-super else print $&1=1-$&1} proc togmark () { if (gvmarkflag==0) { gvmarkflag=1 if (line<4) line+=1 } else { gvmarkflag=0 if (line>6) line-=1 } sprint(tstr,"gvmarkflag=%d",gvmarkflag) // set external gvmarkflag as well execute(tstr) sprint(mesg,"mark=%d",gvmarkflag) } //* panobjl stuff proc apbrowse () { panobjl.browser("attrpanls","s") panobjl.accept_action("panobjl.object(hoc_ac_).attrpanl()") } //** po(NUM) set global panobj to that number proc po () { sprint(tstr,"panobj=GRV[%d]",$1) execute(tstr) } proc apkill () { panobjl.browser("attrpanls","s") panobjl.accept_action("panobjl.remove(hoc_ac_)") } //* printlist stuff //** record(list,what,vecptr) from items in $o1 object(ii).$s2 in vectors // $o1 is the list arg $s2 is the thing to be recorded [eg soma.v(0.5)] // optional $3 is the name of an object belonging to list items that will // serve as a pointer to the recording vector proc record () { local ii, dur, na3 if (isobj($o1,"List")) for ltr(Xo,$o1) { sprint(recstr,"%s.%s",Xo,$s2) npl(recstr) if (numarg()==3) { sprint(temp_string_,"%s.%s=printlist.object(printlist.count-1).vec",Xo,$s3) execute(temp_string_) // only way to get call by ref for object } } else forsec $o1 { // assume sectionlist sprint(recstr,"%s.%s",secname(),$s2) npl(recstr) if (numarg()==3) { sprint(temp_string_,"%s.%s=printlist.object(printlist.count-1).vec",Xo,$s3) execute(temp_string_) // only way to get call by ref for object } } } //** npl(name) adds this item to the printlist // npl(name,vec) adds this vec to the printlist // npl(name,vec,tvec) adds this vec to the printlist // npl(var,name) use name instead of variable name // npl(var,ptr) provide an objref to point to the vec // npl(name,num,vec)??adds this vec to the printlist under name_num0,name_num1,etc proc npl () { local dur,nflag,tvflag,prstep // METHOD DEPENDENT if (! isobj(printlist,"List")) printlist = new List() tvflag=nflag=0 prstep=0.05 if (cvode_status()==0.0) { sprint(tstr,"%s.printStep=printStep",this) execute(tstr) prstep=printStep } else if (cvode_status()==1.1) { tvflag=1 } else if (cvode_status()==1.0) { // ?? } if (outvecint == 0) dur = tstop else dur = outvecint grvecstr = $s1 repl_mstr(grvecstr," ","",temp_string2_) // no longer splits on '/' // eg npl(name,ii,vec) if (numarg()>=4) if ($4<=0) tvflag=1 else { tvflag=0 prstep=$4 } if (numarg()>=3) { // allows formation of tags on the fly if (argtype(3)==0) { if ($3<=0) tvflag=1 else { tvflag=0 prstep=$3 } } else if (argtype(2)==0) { sprint(temp_string_,"%s%s",grvecstr,":%d") sprint(temp_string_,temp_string_,$2) vite = new vitem(temp_string_,$o3.size) vite.vec.copy($o3) if (numarg()==4) if (argtype(4)==1) { vite.tvec.copy($o4) vite.tvflag=1 vite.pstep=0 } else if (argtype(4)==0) { vite.pstep=$4 } else printf("Arg 4 unrecognized in npl?\n") printlist.append(vite) return } else if (argtype(2)==1) { vite = new vitem(grvecstr,$o2.size,1) vite.vec.copy($o2) vite.tvec.copy($o3) printlist.append(vite) return } } if (numarg()>=2) { // second arg is a vector to store if (argtype(2)==1) { vite = new vitem(grvecstr,$o2.size) vite.tvflag=tvflag vite.pstep=prstep vite.vec.copy($o2) printlist.append(vite) return } else if (argtype(2)==2) { // give explicit name for the thing to store nflag=1 } } if (cvode_status()==1.0) { if (tvec.buffer_size==0){tvec.resize(dur/prstep+10) tvec.resize(0)} tvec.record(&t) } else if (isobj(tvec,"Vector")) if (tvec.size!=0) { tvec.resize(0) tvec.play_remove() } if (nflag) { if (tvflag) { vite = new vitem($s2,dur/prstep+10,1) } else { vite = new vitem($s2,dur/prstep+10,prstep) } } else { if (tvflag) { vite = new vitem(grvecstr,dur/prstep+10,1) } else { vite = new vitem(grvecstr,dur/prstep+10,prstep) } } if (numarg()==2) if (argtype(2)==1) $o2=vite.vec // allow user to assign a pointer printlist.append(vite) if (tvflag) { vite.vec.resize(dur/prstep+10) vite.tvec.resize(dur/prstep+10) find_secname(grvecstr,temp_string_) // with lvardt, need to assign in proper context sprint(temp_string_,"%s {cvode.record(&%s,%s.vite.vec,%s.vite.tvec)}",temp_string_,grvecstr,this,this) } else if (cvode_status()==1.0) { // don't give an explicit prstep vite.vec.resize(dur/prstep+10) sprint(temp_string_,"%s.vite.vec.record(&%s)",this,grvecstr) } else { sprint(temp_string_,"%s.vite.vec.record(&%s,%g)",this,grvecstr,prstep) } if (! execute1(temp_string_)) print "Unable to excute ",temp_string_ vite=nil } //** store cvode state in a double in form active.local func cvode_status () { return cvode.active() + cvode.use_local_dt()/10 } proc ulv () { } //** pvall() dumps all vectors to output_file // Save logic: // 1) Interactive mode: you're watching simulations while printing out // data. You see something you like and save it - the runnum in the // index file then corrsponds to the number on the data file, it is // subsequently augmented // 2) Batch mode: you're running very long sims and saving directly to // vector files. You put together a simulation you want and save it // immediately rather than waiting for the sim to return (in 1 or 2 // days). To correspond, the data file (v*) must then be numbered // 'runnum-dec_runnum' proc pvall () { if (numarg()>=1) { comment = $s1 // a comment } else if (sfunc.len(comment)==0) { sprint(tstr,"%s.comment=comment",this) execute(tstr) sprint(tstr,"Use: %s ?",comment) if (!boolean_dialog(tstr)) return } if (numarg()>=2) output_file=$s2 else { sprint(output_file,"%sv%s.%02d",ddir,datestr,runnum-dec_runnum) while (tmpfile.ropen(output_file)) { runnum = runnum+1 printf("%s found, trying %sv%s.%02d\n",output_file,ddir,datestr,runnum-dec_runnum) sprint(output_file,"%sv%s.%02d",ddir,datestr,runnum-dec_runnum) } } printf("Saving to %s\n",output_file) pvplist(output_file,comment) sprint(output_file,"%sv%s.%02d",ddir,datestr,runnum) comment="" } //** pvplist(file,comment,tback) print out the printlist with comment at head proc pvother () {} // user can dump other vectors at top with prvec() proc pvplist () { local inx,tmin,tmax,tback localobj oq,xo output_file=$s1 if (! pvplist0()) return // open file(s) pvplist1($s2) // print string header if (numarg()==3) if ($3>1) { tback=$3 tmax=printlist.o(0).tvec.max if (tmax>tback) { tmin=tmax-tback oq=new NQS() for ltr(xo,printlist) { oq.setcols(xo.tvec,xo.vec) oq.select(0,">",tmin) oq.cpout() oq.resize(0) } } } pvout() if (numarg()<3) { // leave for appending if $3==1 tmpfile.close() tf1.close() } else if ($3>1) { tmpfile.close() tf1.close() } } //** pvclose() -- close files used for writing proc pvclose () { tmpfile.close() tf1.close() } //** pvplist0() -- open output_file and ancillary dot file if needed func pvplist0 () { localobj st st=new String2() file_with_dot(output_file,st.s) // put .filename into st.s if (numarg()==0) { if (tmpfile.ropen(st.s)) { printf("WARNING: removing %s\n",st.s) sprint(st.t,"rm %s",st.s) system(st.t) } if (tmpfile.wopen(st.s)==0) { print "Can't open ",st.s return 0} if (! isojt(tf1,tmpfile)) tf1=new File() tf1.wopen(output_file) } else { if (tmpfile.aopen(st.s)==0) { print "Can't open ",st.s," to append" return 0} if (! isojt(tf1,tmpfile)) tf1=new File() tf1.aopen(output_file) } return 1 } //** prplist1() proc pvplist1 () { tmpfile.printf("//: %s\n",$s1) // comment if (cvode_status()==1.1) { tmpfile.printf("//printStep -2\n") } else if (cvode_status()==1.0) { tmpfile.printf("//printStep -1\n") } else { sprint(tstr,"%s.printStep=printStep",this) execute(tstr) tmpfile.printf("//printStep %g\n",printStep) } if (byte_store) tmpfile.printf("//CPU %s\n",uname) } //** pvnext() append another printlist set to same file proc pvnext () { local ii if ($1==0) { pvplist(output_file,comment,1) return } pvplist0(0) // open for appending pvout() printf("Append to %s\n",output_file) tmpfile.close() tf1.close } //** pvout() called by pvplist() and pvnext(), actually puts out the vecs proc pvout () { // METHOD DEPENDENT pvout2() if (cvode_status()==1.0 && tvec.max>0) { tmpfile.printf("//b%d 1 %s %d %d\n",tvec_bytesize,"CVODE1.0 tvec",tvec.size,tf1.tell) tvec.vwrite(tf1,tvec_bytesize) } for ltr(Xo,printlist) { // no whitespace allowed if (Xo.code==2) continue if (sfunc.len(Xo.vec.label)>0) sprint(temp_string_,"%s__(%s)",Xo.vec.label,Xo.name) else { temp_string_=Xo.name } pvpone(Xo) } } //** dir2pr(item#[,OUTFILE,OUTCOMMENT]) read the files in dir and add one item to printlist // see also collect.hoc for batch use proc dir2pr () { local ix,ps printlist.remove_all ix=$1 for ltr(Xo,dir) { read_vfile(Xo.s) rv_readvec(ix,vrtmp) ps=llist.o(ix).num // pstep: need if want to save a fixed step entry grv_.npl(comment,vrtmp,tvec) } if (numarg()==3) { grv_.pvplist($s2,$s3) read_vfile($s2) } } //** dir2mf(FILENAME,COMMENT) read the files in dir and create a master file proc dir2mf () { local ix,ps,n localobj f f=new File() f.wopen($s1) f.printf("//: %s\n",$s2) for ltr(Xo,dir) { read_vfile(Xo.s) n=-1 for ltr(Yo,llist) if (dir2mf2(n+=1)) { // repl_mstr(comment," ",";",temp_string2_) // no spaces allowed // sprint(temp_string_,"%s_%s",Yo.name,comment) f.printf("//b%d %g %s %d %d %s\n",bvec,Yo.num,Yo.name,Yo.size,Yo.loc,filename) } } f.close() } //** read_mf() reads a master file // assumes file in tmpfile func read_mf () { local ii,sz,loc,mult,sze,cloc,segs localobj o if (attr0) { if (!boolean_dialog("Look at file data instead of sim?","YES","NO")) { printf("Read file cancelled\n") return 0 } } else { attr0=0 } if (numarg()==1) filename=$s1 else tmpfile.getname(filename) sprint(s,"GRV[%d] %s: %s",objnum(this),simname,filename) clear() if (!tmpfile.ropen(filename)) { print "E1: Can't open ",filename return 0 } while ((numr = tmpfile.gets(tstr)) != -1 && (sfunc.head(tstr,"//[^b]",temp_string2_)==0)) { read_vinfo() // a line giving info about the file (eg comment) } tmpfile.seek(-numr,1) // back up ii=0 while ((numr = tmpfile.gets(tstr)) != -1) { if (((ii+=1)%10000)==0) printf("%d ",ii) if (sscanf(tstr,"//b%1ld %g %s %ld %ld %s",&bvec,&nvec,tstr2,&sze,&loc,tstr)!=6) { printf("**** GRV read_mf() parse ERR on %s in %s",tstr,filename) return 0 } llist.append(new vfile_line(tstr2,sze,loc,nvec,tstr)) // name size loc num } if (llist.count==0) { printf("grvec.hoc::read_mf ERR nothing read from %s\n",filename) return 0 } entries=llist.count mff=1 return 1 } //** prvec(name,vec,byte_flag[,file]) proc prvec () { local bflag if (numarg()>3) { tmpfile.aopen($s4) } bflag = $3 tmpfile.printf("//b%d 1 %s %d %d\n",bflag,$s1,$o2.size,tf1.tell()) $o2.vwrite(tf1,bflag) if (numarg()>3) { tmpfile.close() } } //** pv() dumps a single vector into output_file proc pv () { local inx sprint(output_file,"%sv%s.%02d",ddir,datestr,runnum-dec_runnum) if (numarg()==0) { inx = hoc_ac_ } else { inx = $1 } printf("Printing %s to %s\n",printlist.object(inx).name,output_file) // string_dialog("Name for saved vector",printlist.object(inx).name) if (tmpfile.ropen(output_file)) { // file exists already file_with_dot(output_file,temp_string_) // put .filename into temp_string_ tmpfile.aopen(temp_string_) tf1.aopen(output_file) printf("Appending to %s\n",output_file) } else { pvplist0() pvplist1(comment) } pvpone() tmpfile.close() tf1.close } //** pvpone() -- write out a vector or vector pair to the file proc pvpone () { // METHOD DEPENDENT if (byte_store) { if (isassigned($o1.tvec)) { tmpfile.printf("//b%d -2 %s %d %d\n",byte_store,temp_string_,$o1.vec.size,tf1.tell) $o1.tvec.vwrite(tf1,tvec_bytesize) } else if ($o1.pstep>0) { tmpfile.printf("//b%d %g %s %d %d\n",byte_store,$o1.pstep,temp_string_,$o1.vec.size,tf1.tell) } else { tmpfile.printf("//b%d -1 %s %d %d\n",byte_store,temp_string_,$o1.vec.size,tf1.tell) } $o1.vec.vwrite(tf1,byte_store) } } //** cpplitem([num]) copy X0 to new item in printlist, optional arg can be pos or neg proc cpplitem () { local num,cnt cnt = printlist.count if (numarg()>0) {if ($1>=0) num=$1 else num=cnt+$1} else num=cnt-1 if (num>cnt-1 || num<0) { printf("%d!: Only %d items (0-%d) in list.\n",num,cnt,cnt-1) return } if (numarg()>1) grvecstr=$s2 else sprint(grvecstr,"Copy_of_%s",printlist.object(num).name) npl(grvecstr,printlist.object(num).vec) print printlist.count-1,":XO -> ",grvecstr XO = printlist.object(printlist.count-1).vec } //** chgplname([num],STR) change name of item in printlist proc chgplname () { local num,cnt cnt = printlist.count if (numarg()>0) {if ($1>=0) num=$1 else num=cnt+$1} else num=cnt-1 if (num>cnt-1 || num<0) { printf("%d!: Only %d items (0-%d) in list.\n",num,cnt,cnt-1) return } printlist.object(num).name=$s2 } // new_pri(NAME,TVEC,VEC) quick and dirty new_printlist_item proc new_pri () { vite = new vitem($s1,$o2.size) if (numarg()==3) { vite.tvec.copy($o2) vite.vec.copy($o3) } else vite.vec.copy($o2) printlist.append(vite) vite=nil } //* prlexp(sz) expands all the vectors in printlist to size sz proc prlexp () { sz = $1 tvec.resize(sz) for ltr(Xo,printlist) { Xo.vec.resize(sz) } } //* iterators for printlist and files //** rvtr() read vector iterator // usage 'for rvtr(vec) XO.vec.printf' where # is attrpanl# // not debugged for presence of tvec in cvode iterator rvtr () { local i,flag,s4flag if (numarg()>=2) {$&2=0} else {i1 = 0} if (numarg()==3) s4flag=1 else s4flag=0 for i = 0, entries-1 { tstr = llist.object(i).name if (s4flag) {if (strm(tstr,$s3)) flag=1 else flag=0} if (flag) { rv_readvec(i,$o1) iterator_statement if (numarg()>=2) { $&2+=1 } else { i1+=1 } } } } //** vrdr(vlist[,REGEXP or INDV,flag,&y]) -- used for llist // similar to rvtr() but does interpolation // use regexp eg for prdr("PYR2.8") { etc } // optional flag to NOT interpolate // indv gives set of llist nums to search through (can use with "" as regexp) // sets 4 vectors in vlist: voltage,times,interp v, interp t iterator vrdr () { local flag,a,ii localobj rxp,v1,tv1,v2,tv2,ipt if (numarg()==0) printf("\t**** HELP:: vrdr(vlist[,REGEXP or INDV,flag,&y]) ****\n") curcol=0 rxp=new String() a=allocvecs(ipt) if (!isojt($o1,llist)) $o1=new List() if ($o1.count==4) { // use the list we're given for ii=0,3 if (!isojt($o1.o(ii),vrtmp)) { printf("vrdr: Nonvector in vlist:%s\n",$o1.o(ii)) return } } else { $o1.remove_all for ii=0,3 $o1.append(new Vector()) } v1=$o1.o(0) tv1=$o1.o(1) v2=$o1.o(2) tv2=$o1.o(3) ipt.indgen(0,llist.count-1,1) if (numarg()>=2) if (argtype(2)==1) { ipt.copy($o2) } else if (argtype(2)==2) { rxp.s=$s2 } else { printf("vrdr() ERR arg 2 should be vector or string\n") } if (numarg()>=3) flag=$3 else flag=0 if (numarg()>=4) {$&4=0} else {ii1 = 0} if (!flag) { if (tvec.max != tstop) printf("WARNING: tvec set?: %g %g\n",tstop,tvec.max) tv2.copy(tvec) // tvec must be preassigned for interpolation } tmpfile.ropen(filename) for (ii1=0;ii1=4) { $&4+=1 } } } tmpfile.close dealloc(a) } //** prdr() -- used for printlist // use regexp eg for prdr("PYR2.8") { etc } // optional flag to NOT interpolate // ind=tvec, vec1=original trace, vec interpolated on tvec // note that i1 here gives list number, not sequential // eg for panobj.prdr("V$",1) gv(i1) iterator prdr () { local flag if (numarg()>1) flag=$2 else flag=0 if (numarg()==3) {$&3=0} else {i1 = 0} v1=tv1=v2=tv2=allocvecs(4) tv1+=1 v2+=2 tv2+=3 if (!flag) { if (tvec.max != tstop) printf("WARNING: tvec set?: %g %g\n",tstop,tvec.max) mso[tv2].copy(tvec) // tvec must be preassigned for interpolation } curcol=0 if (attr0) for (ii1=0;ii1=3) { $&3+=1 } } } dealloc(v1) } //* outvec() routines for printing out in sections - NOT DEBUGGED //** outvec_init([output_file,comment]) proc outvec_init() { local segs if (numarg()>0) { output_file = $s1 } else { sprint(output_file,"%sv%s.%02d",ddir,datestr,runnum-dec_runnum) while (tmpfile.ropen(output_file)) { runnum = runnum+1 // don't allow an overwrite sprint(output_file,"%sv%s.%02d",ddir,datestr,runnum-dec_runnum) } } if (numarg()>1) { comment = $s2 } print "\nOutput to ",output_file if (print_flag) { print "WARNING: print_flag=1 --> 0\n" print_flag = 0 } if (outvecint==0 || outvecint>tstop) { printf("WARNING: outvecint being set to tstop\n") outvecint = tstop } outvect = outvecint segs = int(tstop/outvecint) if (tstop/outvecint > segs) { segs=segs+1 } tmpfile.wopen(output_file) if (strcmp(comment,"")!=0) { tmpfile.printf("//: %s\n",comment) } tmpfile.printf("//printStep %g\n",printStep) tmpfile.printf("//MULTI %d %d\n",printlist.count,segs) tmpfile.close() } //** outvecs() : print out the vectors and reset them for recording proc outvecs () { local ii if (t outvect-outvecint+2*dt) { tmpfile.aopen(output_file) for ii=0,printlist.count-1 { tmpfile.printf("//b%d 1 %s %d %d\n",byte_store,printlist.object(ii).name,t-outvecint,tmpfile.tell()) printlist.object(ii).vec.vwrite(tmpfile,byte_store) tmpfile.printf("\n") } tmpfile.close() } } //* endtemplate; assignments: endtemplate GRV printStep=0.1 grv_ = new GRV(0) {panobj=grv_ printlist=grv_.printlist panobjl=grv_.panobjl} //* external routines //** new_printlist_item(name) adds this item to the printlist // new_printlist_item(name,vec) adds this vec to the printlist // new_printlist_item(name,vec,tvec) adds this vec to the printlist // new_printlist_item(var,name) use name instead of variable name // new_printlist_item(var,ptr) provide an objref to point to the vec // new_printlist_item(name,num,vec)??adds this vec to the printlist under name_num0,name_num1,etc proc new_printlist_item () { local dur,nflag,tvflag if (! isassigned(grv_)) { grv_ = new GRV(0) printlist=grv_.printlist } if (numarg()==1) { grv_.npl($s1) } else if (numarg()==2) { if (argtype(2)==1) { grv_.npl($s1,$o2) } else if (argtype(2)==2) { grv_.npl($s1,$s2) } else grv_.npl($s1,$2) } else if (numarg()==3) { if (argtype(2)==1) { grv_.npl($s1,$o2,$o3) } else if (argtype(2)==0) { grv_.npl($s1,$2,$o3) } } } //** llist() print out contents of a list proc llist () { local done localobj o,st,xo st=new String() o=panobj if (numarg()==2) st.s=$s2 if (numarg()>=1) { if (argtype(1)==1) { if (isobj($o1,"List")) { if ($o1.count==0) {print "empty list" return} if (isobj($o1.object(0),"String2")) { for ltr(xo,$o1) if (strm(xo.s,st.s)) print xo.s,xo.t } else if (isobj($o1.object(0),"String")) { for ltr(xo,$o1) if (strm(xo.s,st.s)) print xo.s } else if (isobj($o1.object(0),"Vector")) { done=0 if (name_declared("oform")) if (oform(vec)!=NOP) { for ltr(xo,$o1) print xo,oform(xo) done=1 } if (!done) for ltr(xo,$o1) print xo,xo.size } else if (isobj($o1.object(0),"Union")) { for ltr(xo,$o1) if (strm(xo.s,st.s)) print xo,xo.s,xo.t,xo.u,xo.v } else for ltr(xo,$o1) print xo return } else o=$o1 } else if (argtype(1)==2) st.s=$s1 } if (o.attr0) { for ltr(xo,printlist) if (strm(xo.name,st.s)) print i1,xo.name,xo.vec.size } else for ltr(xo,o.llist) if (strm(xo.name,st.s)) print i1,xo.name,xo.size } //** cpprl(PRINTLIST,TMPLIST) copies printlist vitem's to tmplist proc cpprl () { localobj xo,yo $o2.remove_all for ltr(xo,$o1) { $o2.append((yo=new vitem(xo.name,xo.vec.size))) yo.tvflag=xo.tvflag yo.pstep=xo.pstep yo.o=xo.o yo.vec.copy(xo.vec) if (yo.tvflag) {yo.tvec=new Vector() yo.tvec.copy(xo.tvec)} } } //** abbreviated proc calls proc gvpwpl () { pwman_place(500,500) } proc vp () { grv_.vecpanel } obfunc gvnew () { if (numarg()==1) { if (argtype(1)==0) { panobj=new GRV($1) } else if (argtype(1)==2) { panobj=new GRV($s1) } else if (argtype(1)==1) { $o1=new GRV(-2) panobj=$o1 } } else if (numarg()==2) { if ($2>0) { panobj=panobjl.object($2) panobj.read_vfile($s1) } else panobj=new GRV($s1,$2) // file,flag } else panobj=new GRV(1) // default return panobj } proc ap () { local ii,attr0,nopan localobj o nopan=ii=0 if (numarg()==0) { o=panobj } else if (numarg()>=1) { if (argtype(1)==0) { ii=$1 o=grv_.panobjl.object(ii) if (ii<0 || ii>=grv_.panobjl.count) { printf("**** ap(%d) ERR panobj #%d not found -- run gvnew() \n",ii,ii) return } } else o=$o1 } if (numarg()>=2) if (argtype(2)==0) if ($2==-2) nopan=1 attr0=o.attr0 o.attrpanl() if (!nopan) if (attr0) o.pbrgr("Graph","gv") else o.rpanel() panobj=o } proc disptray () { print "Must load boxes.hoc to get trays" } //** gg() graph vectors and functions directly //** gs(#) select graph (by setting g and graphItem to this Graph# proc gs () { if (argtype(1)==1) { g=$o1 graphItem=g } else if (numarg()==2) { g[$1]=Graph[$2] } else { g=Graph[$1] graphItem=g } } // gg(g[i],vec) gg(vec,step) gg(vec,ind) gg(g,"FUNC","min,max") [color,line,symbol] strdef symb symb = "O" gvmarkflag=0 obfunc gg () { local gp,na,newgr,clr,a,stp,i,tmp localobj ty,ts,abs,ord,o,go a=allocvecs(ty,abs,ord) ts=new String2() na=numarg() newgr=1 ty.resize(10) ty.fill(-1) for i=1,na ty.x[i]=argtype(i) i=1 clr=panobj.color lne=panobj.line if (ty.x[i]==0) { gp=$i i+=1 } else gp=0 if (gp<10) { if (isassigned(g[gp])) if (g[gp].view_count>0) newgr=0 if (newgr) g[gp]=new Graph() go=graphItem=g[gp] graphList[0].append(g[gp]) panobj.glist.append(g[gp]) } else { graphItem=go=new Graph() graphList[0].append(go) panobj.glist.append(go) } if (gvmarkflag) ts.t="mark" else ts.t="line" if (na==1 && ty.x[0]==0) { return // gg(#) just put up the graph } else if (na==i && ty.x[i]==1) { sprint(ts.t,"%s.%s(%s,1",$oi,ts.t,go) // gg(vec) } else if (ty.x[i]==2) { // gg("FUNC","min,max,step") min=0 max=10 stp=0 ts.s=$si i+=1 if (ty.x[i]==2) { split($si,abs,"[:/]") min=abs.x[0] max=abs.x[1] if (abs.size==3) stp=abs.x[2] i+=1 } if (stp==0) stp=(max-min)/200 abs.indgen(min,max,stp) ord.copy(abs) if (!name_declared(ts.s)) { // look for an x that will become $1 if (!strm(ts.s,"[$]1")) { printf("gg ERR Can't find '$1' in %s\n",ts.s) return nil } sprint(ts.s,"func _gg_f(){return %s}",ts.s) execute1(ts.s) print ts.s ts.s="_gg_f" } ord.apply(ts.s) sprint(ts.t,"%s.%s(%s,%s",ord,ts.t,go,abs) } else if (ty.x[i]==1 && ty.x[i+1]==0) { // gg(vec,step) o=$oi i+=1 if (isobj(o,"List")) { tmp=$i i+=1 if (int($i)!=$i) { // a timestep sprint(ts.t,"%s.%s(%s,%g",o.o(tmp),ts.t,go,$i) i+=1 } else { sprint(ts.t,"%s.%s(%s,%s",o.o(tmp),ts.t,go,o.o($i)) i+=1 } } else { // vector sprint(ts.t,"%s.%s(%s,%g",o,ts.t,go,$i) i+=1 } } else if (ty.x[i]==1 && ty.x[i+1]==1) { // gg(vec,ind) o=$oi i+=1 sprint(ts.t,"%s.%s(%s,%s",o,ts.t,go,$oi) i+=1 } if (ty.x[i]==0) { clr=$i i+=1 } if (ty.x[i]==0) { lne=$i i+=1 } if (ty.x[i]==2) { symb=$si i+=1 } if (sfunc.len(ts.t)>4) { if (gvmarkflag) { sprint(ts.s,"%s,\"%s\",%d,%d,1)",ts.t,symb,lne,clr) } else { sprint(ts.s,"%s,%d,%d)",ts.t,clr,lne) } execute(ts.s) } dealloc(a) return graphItem } //*** ge() erases IV graph proc ge () { if (numarg()==0) graphItem.erase_all() else g[$1].erase_all } //** gv() calls internal gv proc gv () { local inx,na // EXTERNAL VERSION -- same name in template na=numarg() if (argtype(1)==0) { inx = $1 } else if (argtype(1)==2) { for ltr(XO,printlist) if (strm(XO.name,$s1)) inx=i1 if (inx==-1) {print $s1," not found" return } } if (na==1) grv_.gv(inx) else if (na==2) grv_.gv(inx,$2) else if (na==3) grv_.gv(inx,$2,$3) } //** restore_printlist() restores the plist from a file in an attrnum objref vite proc restore_printlist () { local cnt,ii,attrnum,savlvar localobj aa,st printf("NOT WORKING\n") st=new String() attrnum=$1 printlist.remove_all panobj=grv_.panobjl.object(attrnum) for panobj.vrdr(aa,"",1) { vite= new vitem(st.s,aa.o(0).size) vite.vec.copy(aa.o(0)) printlist.append(vite) } } //** dirname(full,path) filname(full,file) splits up path/file // eg filname("/home/billl/nrniv/thal/params.hoc",temp_string_) // temp_string_ => params.hoc obfunc dirname () { localobj st st=new String2() sfunc.head($s1,"[^/]+$",st.s) sfunc.tail($s1,st.s,st.t) if (numarg()==2) $s2=st.s return st } //** filname() obfunc filname () { localobj st st=new String2() sfunc.head($s1,"[^/]+$",st.t) sfunc.tail($s1,st.t,st.s) if (numarg()==2) $s2=st.s return st } //** file_with_dot(filename,[result,prefix]): put .filename into result obfunc file_with_dot () { localobj st st=dirname($s1) if (numarg()==3) { sprint(st.s,"%s%s%s",st.s,$s3,st.t) } else sprint(st.s,"%s.%s", st.s, st.t) if (numarg()>=2) $s2=st.s return st } //* fexists() func fexists () { localobj o o=new File() return o.ropen($s1) } //** ftype() func ftype () { local ty localobj st ty=0 st=new String2() sprint(st.t,"stat -c %%F %s 2>&1",$s1) system(st.t,st.s) chop(st.s) if (strm(st.s,"\n")) { return 10 // more than 1 file -- ie * used } else if (strm(st.s,"No such")) { return -1 } else if (strm(st.s,"directory")) { return 0 } else if (strm(st.s,"symbolic")) { return 8 } else if (strm(st.s,"regular")) { return 2 } else { // not identified printf("File %s is a %s\n",$s1,st.s) return -2 } } //** file_len() uses wc func file_len () { local x localobj st st=new String() sprint(st.s,"wc -l \"%s\"",$s1) system(st.s,st.s) sscanf(st.s,"%d",&x) return x } func cvode_status () { return cvode.active() + cvode.use_local_dt()/10 } proc pvall () { localobj o o=panobjl.o(0) if (! o.attr0) { printf("pvall() ERR %s not attr0==0\n",o) } else o.pvall() } //** procbutt() put up a single proc in a button proc procbutt () { xpanel($s1) xbutton($s1,$s1) xpanel(500,500) } // mdl2view(g,X,Y) converts model coordinates to view coordinates // eg {XO=mdl2view(g,12,533.7) g.label(XO.x,XO.x[1],"AA",2,2,0.5,0.5,1)} // translate from world coordinates into view coordinates obfunc mdl2view () { local a,ii,x0,y0 localobj o,v1,g g=$o1 x0=$2 y0=$3 if (argtype(4)==1) v1=$o4 else { v1=new Vector(4) g.size(&v1.x[0]) } o=new Union() o.x= (x0-v1.x[0])/(v1.x[1]-v1.x[0]) o.x[1]=(y0-v1.x[2])/(v1.x[3]-v1.x[2]) o.x[2]=o.x[0]*0.8+0.1 o.x[3]=o.x[1]*0.8+0.1 // scale and move over to where graph usually is return o } proc stopper () { xpanel("STOP") xbutton("STOP","stoprun=1") xbutton("FINI","finish()") xbutton("CONT","time(\"cvode.solve(tstop)\")") xbutton("RUN","time()") xpanel() } // END /usr/site/nrniv/local/hoc/grvec.hoc //================================================================ //load_file("nqs.hoc") //load_file("decnqs.hoc") //================================================================ // INSERTED /usr/site/nrniv/local/hoc/boxes.hoc // =Id= boxes.hoc,v 1.55 2006/03/26 20:28:29 billl Exp // load_file("boxes.hoc") proc boxes () {} // factor(num) finds the factors that are closest together // NB: must be at top since declared external in template BX func factor () { local num, srt, ii num = $1 srt = int(sqrt(num)) for (ii=srt;iinum/ii) ii=num/ii // return smaller factor return ii } // template for putting up trays and decks begintemplate BX public mktray,mkdeck,name,boxes,map,unmap,closebox public min,max,attrnum,rows,cols,trnum,gl,stub,label external factor objref boxes[3], ob, gitem,gl,XO,nil double min[1],max[1],trnum[1] strdef temp_string_,name proc init () { min = -1 max = -1 trnum=$1 gl = new List() } //mktray(panattr) graph out from llist of a panattr proc mktray () { local ci, ri, gi, m1, m2, bi ob = $o1 cols=$3 rows=$2 if (numarg()==6) {xs=$4 ys=$5} else {xs=100 ys=50} ri = 0 // count the rows gi = 0 // count the graphs boxes[0] = new VBox() boxes[0].dismiss_action("closebox()") boxes[0].intercept(1) name="" xpanel("",1) xvarlabel(name) xpanel() for ri=0,rows-1 { boxes[2] = new HBox() boxes[2].intercept(1) for ci=0,cols-1 { gitem = new Graph(0) gitem.view(0,-100,1000,50,0,0,xs,ys) gl.append(gitem) ob.glist.append(gitem) gi = gi+1 } boxes[2].intercept(0) boxes[2].map("") } boxes[0].intercept(0) if (strcmp(name,"")==0) name=ob.filename sprint(name,"%d:%s",trnum,name) boxes[0].map(name) } proc map() { boxes[0].map() } proc unmap() { boxes[0].unmap() } proc closebox () { local ii for (ii=gl.count-1;ii>=0;ii-=1) { XO=gl.object(ii) XO.unmap } ob.glist.remove_all gl.remove_all boxes[0].unmap boxes[0]=nil boxes[2]=nil } proc mkdeck () { local rows, cols, ci, ri, gi, m1, m2 ob = $o1 if (min==-1 || max==-1) { m1 = 0 m2 = ob.llist.count()-1 } else { m1=min m2=max } cnt = m2-m1+1 cols=factor(cnt) rows=cnt/factor(cnt) ri = 0 // count the rows gi = 0 // count the graphs boxes[0] = new VBox() boxes[0].intercept(1) xpanel("",1) xbutton("Next","boxes[1].flip_to(decknum=decknum+1)") xbutton("Previous","boxes[1].flip_to(decknum=decknum-1)") xpanel() boxes[1] = new Deck() boxes[1].intercept(1) for ri=0,rows-1 { boxes[2] = new HBox() boxes[2].intercept(1) for ci=0,cols-1 { ob.rv(gi+m1) gi = gi+1 } boxes[2].intercept(0) boxes[2].map("") } boxes[1].intercept(0) boxes[1].map("") boxes[0].intercept(0) boxes[0].map("Deck") decknum = 0 boxes[1].flip_to(decknum) if (! ob.attr0) { for ii = 0,gi-1 { ob.glist.object(ii).label(0.3,0.5,ob.llist.object(ii).name) } } } endtemplate BX objref boxer, boxerl boxerl = new List() proc mktray () { local i,na,namef localobj o if (numarg()==0) { print "mktray(attrnum,rows,cols[,xsize,ysize,label])" print "Create a tray for attr panel ATTRNUM to superimpose upon." return } boxer = new BX(boxerl.count) boxerl.append(boxer) trnum=boxer.trnum if (argtype(numarg())==2) { namef=1 na=numarg()-1 i=numarg() } else { namef=0 na=numarg() } if (na==2) o=panobj else if (argtype(1)==0) o=GRV[$1] else o=$o1 o.super = 1 if (na==5) { boxer.mktray(o,$2,$3,$4,$5) } else if (na==3) { boxer.mktray(o,$2,$3) } else if (na==2) { boxer.mktray(o,$1,$2) printf("Mapping trays to %s\n",o) } if (namef) boxer.name=$si } proc rmtray () { local ix ix=$1 if (boxerl.count<=1) boxerl.remove_all else { for (ii=boxerl.count-1;ii>=0;ii-=1) { if (boxerl.object(ii).attrnum==attrnum) boxerl.remove(ii) }} remgrs(attrnum) GRV[ix].super=0 } proc trsz () { if (boxerl.count>0) for ltr (XO,boxerl) printf("%d:%d x %d\n",XO.attrnum,XO.rows,XO.cols) } proc mktrpanl () { xgetargs("Make Tray","mktray","Which","rows","cols","xsize","ysize","0,2,3,100,50") } //* disptray() redisp() redispv() proc disptray () { local ix,ii,jj,kk if (numarg()==0) {print "disptray(ix[,cols])" return} ix=$1 ii=GRV[ix].llist.count if (numarg()==2) jj=$2 else jj=factor(ii) kk=GRV[ix].glist.count mktray(GRV[ix],round(ii/jj),jj,100,50) GRV[ix].grall(0,ii-1) for ltr(XO,GRV[ix].glist) if(i1>=kk) { XO.size(&x[0]) XO.size(x[0],x[1],x[2],x[3]) } } proc redisp () { local supsav panobj=$o1 if (numarg()>=2) trnum=$2 supsav=panobj.super panobj.super=1 for ltr(graphItem,boxerl.object(trnum).gl) { graphItem.erase_all() panobj.rv(i1) } panobj.super=supsav } // for bxit () {} go through all the graphs in tray trnum // for bxit (g1,g2,g3,g4) {} go through selected graphs // for bxit (-1,g1,g2) {} go through g1-g2 bxn=-1 proc bxop () { g=boxerl.object(trnum).gl.object($1) graphItem=g} proc bxinc () { if (bxn>=boxerl.object(trnum).gl.count) bxn=0 else bxn+=1 g=boxerl.object(trnum).gl.object(bxn) graphItem=g } iterator bxit () { local i,ii i1=0 if (numarg()>0) { if (numarg()==3 && $1==-1) { for ii = $2, $3 { g=boxerl.object(trnum).gl.object(ii) graphItem=g iterator_statement i1+=1 } } else { for i = 1, numarg() { if (numarg()==1) XO=$o1.object(ii) g=boxerl.object(trnum).gl.object($i) graphItem=g iterator_statement i1+=1 } } } else { for ii=0,boxerl.object(trnum).gl.count-1 { g=boxerl.object(trnum).gl.object(ii) graphItem=g iterator_statement i1+=1 } } } // redispv(VEC,ATTRNUM,TRNUM) -- all args optional proc redispv () { local supsav panobj=$o1 if (numarg()>=2) trnum=$2 supsav=panobj.super panobj.super=1 for bxit() { g.erase_all() if (numarg()>0) panobj.rv($o1.x[i1]) else panobj.rv(vec.x[i1]) } panobj.super=supsav } proc bxcomm () { if (numarg()==1) boxerl.object(boxerl.count-1).name=$s1 else { boxerl.object(boxerl.count-1).name=comment } } //* gin() search through param strings to graph particular members of llist // eg regexp="SPCX SPTC SPSM " then 'gin(1)' to create regexp: 'SPCX.+%sSPTC.+%sSPSM.+%s' // gin("5","","") will find examples with SPCX=5 and graph SPTC against SPSM // ginpr() will search through llist and just print out the file names // meant to be used after running dir2pr() to get a summary file strdef regexp proc gin () { local i,a a=allocvecs(1) revec(mso[a]) tstr=regexp for i=1,numarg() repl_str(tstr,"%s",$si,temp_string2_) // replace sprint for ltr(XO,panobj.llist,&y) if (strm(XO.name,tstr)) mso[a].append(y) if (mso[a].size!=boxer.rows*boxer.cols) { printf("gin() ERR: %d!=%dx%d\n",mso[a].size,boxer.rows,boxer.cols) dealloc(a) return } geall(1) for bxit() panobj.rv(mso[a].x[i1]) tstr=regexp repl_mstr(tstr,".\\+%s","=%s,",temp_string2_) chop(tstr) for i=1,numarg() repl_str(tstr,"%s",$si,temp_string2_) sprint(tstr,"%s: %s",panobj.filename,tstr) bxcomm(tstr) print tstr dealloc(a) } proc ginpr () { local base,i if (numarg()==0) { print "Set regexp to begin: eg\n\tregexp=\"SMTC SPSM NSTC \" (space at end)" print "Then call ginpr(regexp) to reset regexp" print "Then call eg ginpr(\"0.015\",\"\",\"\") to list or gin(...) to graph" return } if (numarg()==1) { regexp=$s1 repl_mstr(regexp," ",".+%s,",tstr) chop(regexp,",") print regexp return } base=1 tstr=regexp // where they start numbering for i=1,numarg() repl_str(tstr,"%s",$si,temp_string2_) // replace sprint for ltr(XO,panobj.llist,&y) if (strm(XO.name,tstr)) printf("%03d %s\n",base+y,XO.name) } // END /usr/site/nrniv/local/hoc/boxes.hoc //================================================================ //================================================================ // INSERTED /usr/site/nrniv/local/hoc/parset.hoc // =Id= parset.hoc,v 1.112 2009/01/13 15:44:25 billl Exp proc parset () {} declare("mesg","hello") // load_file("parset.hoc") //* minimal usage // load_file("soma.hoc") // cvode_active(0) // prsfor("AMP","stim.amp",1,1.8,.2) // prsvals("LEAK","gl_hh",1e-3,3e-3,4e-3,5e-3) // new_printlist_item("soma.v(0.5)") // sims=setprs() // exerun() // xpospanl() //* usage // ob=new PRS("PARAM NAME","clear command") // ob.append("allele1","set command #1") // ob.append("allele2","set command #1") // ... or // ob=new PRS("PARAM NAME","clear command","allele1","set command #1","allele2","set command #2",...) // see autorun() for calling sequence // // with setting simple params use // ob=new PRS("PARAM NAME","stem_name=",num1,num2,...) // ob.appnums(num3,num4,num5,...) // NB: finish with sims=setprs() objref prsl,prsl2,ob,prslp,bx,XX,YY,pc strdef tt prsl=new List() prsl2=new List() // prsl2 is for reading -- includes dumped states as list prslp = prsl // default for prsl pointer trnum=-1 // permit side effect outside of template proc prsadd () { prslp.append($o1) } // for ltr(XX,prsl) for ltr(YY,XX.l) print YY.s,YY.t //* template PRS begintemplate PRS public n,l,clr,name,clear,exe,exec,nam,com,comm,do,append,appnums,v,pcomm,post,ale strdef name,clr,stem,tstr double n[1],flag[1] objref l,ob,nil,v,this,pcomm external prsadd,sfunc,chop,String2 proc init () { local i,j n=numarg()-2 l=new List() v=new Vector() // v vector gives order in which to run the params name = $s1 clr=$s2 pcomm=new String() // post command // if the clear command ends with equal sign this is a stem for all the param setting if (sfunc.tail(clr,"=",stem)>-1 && sfunc.len(stem)==0) { flag=1 sfunc.head(clr,"=",stem) sprint(clr,"%s=0",stem) } else { flag=0 if (n%2!=0) { print "ERROR: Must give name/command pairs" return } n/=2 } if (n>0) for i=3,numarg() { if (flag) { ob = new String2() sprint(ob.s,"%g",$i) sprint(ob.t,"%s=%g",stem,$i) } else { ob=new String2($si) i+=1 ob.t=$si } l.append(ob) } prsadd(this) } proc append () { local i,nn nn=numarg() if (nn%2!=0) { print "ERROR: Must give name/command pairs" return } n+=(nn/2) for i=1,numarg() { ob = new String2($si) i+=1 if (flag) sprint(ob.t,"%s=%s",stem,$si) else ob.t=$si l.append(ob) } ob=nil } proc post () { pcomm.s=$s1 } // use appnums() if have "name=" stem and not giving different names proc appnums () { local i if (! flag) { print "ERROR: Must have stem 'name='" return } n+=numarg() for i=1,numarg() { ob = new String2() sprint(ob.s,"%g",$i) sprint(ob.t,"%s=%g",stem,$i) l.append(ob) } ob=nil } // exec, clear and comm take object number for list l proc exe () { // set allele indicated in v vector sprint(tstr,"{%s %s}",l.object(v.x[$1]).t,pcomm.s) execute1(tstr) } proc exec () { // set allele indicated by index sprint(tstr,"{%s %s}",l.object($1).t,pcomm.s) execute1(tstr) } proc clear () { execute(clr) } // run clear command for this proc nam () { // append name of this param to comment if (sfunc.len($s1)) sprint($s1,"%s,%s",$s1,name) else $s1=name } proc com () { // append comment indicated in v vector if (sfunc.len($s1)) sprint($s1,"%s, %s",$s1,l.object(v.x[$2]).s) else $s1=l.object(v.x[$2]).s } proc comm () { // append comment by index if (sfunc.len($s1)) sprint($s1,"%s, %s",$s1,l.object($2).s) else $s1=l.object($2).s } obfunc ale () { return new String2(name,l.object(v.x[$1]).s) } proc do () { clear() exe($1) com($s2,$1) } // clear,exe,com endtemplate PRS //* prsset(#[,print]) read and set params from comment proc prsset () { local ii,sz localobj bb,name,val bb=new List() split(panobj.llist.o($1).name,bb,"[:_/=,]") sz=bb.count if (sz/2!=int(sz/2)) print "WARNING: not even # of name/num pairs: ",sz for (ii=bb.count-2;ii>=0;ii-=2) { name=bb.o(ii) val=bb.o(ii+1) if (!isnum(name.s) && isnum(val.s)) { // name=val sprint(tstr,"%s=%s",name.s,val.s) if (numarg()==2) print tstr else execute(tstr) } else { printf("WARNING: can't execute %s=%s\n",name.s,val.s) } } } //* setprs() -- set parameters // sets up v vector that gives order in which to run them func setprs () { local nn,snum,flag,verbose if (numarg()==1) flag=1 else flag=0 // flag -- called during file parse verbose=0 snum=1 nn=1 if (verbose) temp_string_="" for ltr(XX,prsl) snum*=XX.n // total number of sims to be run if (verbose) for ltr(XX,prsl) sprint(temp_string_,"%s %d(%s) x",temp_string_,XX.n,XX.name) for ltr(XX,prsl) { // go through the parameters XX.v.resize(snum) divup(XX.v,XX.n,nn) // make ind a vector of indices for nn *= XX.n } if (verbose) {chop(temp_string_) print temp_string_} // check that using cvode local if (cvode_local()==0 && flag==0) { // called before a run cvode_local(1) printlist.remove_all() print "WARNING: must recreate printlist before running exerun()" } return snum } //** divup(vec,grp_size,sets) -- #_grps = vec.size/grp_size proc divup () { local sets,num,grp,sz,ii,jj,kk,ll sz=$o1.size grp=$2 sets=$3 num=sz/sets/grp kk=-1 for ll=1,sets for jj=0,grp-1 for ii=1,num $o1.x[kk+=1]=jj } //* autoset // sims = setprs() // if (ncells=1) st.s=$s1 panobj=grv_ system("date") prsnames(panobj.comment) for ltr(XX,printlist) tl.append(new String(XX.name)) for ii=0,sims-1 { for ltr(XX,prsl) XX.clear for ltr(XX,prsl) XX.exe(ii) exeruncall(ii) ok = execute1("run1()") if (ok) prsplist2(tl,ii,st.s) printf("%d/%d: %s (%d)\n",ii+1,sims,tt,ok) panobj.pvnext(ii) } for ltr2(XX,YY,printlist,tl) XX.name=YY.s // restore labels prssave() system("date") prsshow() } proc mpirun () { local ii,ok localobj XX,YY,o,tl,st pc = new ParallelContext() if (sims==0) {printf("parset not initialized\n") return } tl=new List() st=new String() if (numarg()>=1) st.s=$s1 panobj=grv_ for ltr(XX,printlist) tl.append(new String(XX.name)) for ltr(XX,prsl) XX.clear printf("Master launch: %s",tstr) pc.runworker() // master returns immediately, workers wait for jobs for ii=0,sims-1 pc.submit("mpirun2",ii) while (pc.working) {} // await results pc.done // wait for workers to finish printing } proc mpirun2 () { local ii ii=$1 for ltr(XX,prsl) XX.exe(ii) sprint(output_file,"data/%s/v%s.%02d",datestr,datestr,runnum+ii) comment=output_file prsnames(comment,ii) exeruncall(ii) ok = execute1("run1()") printf("%s in %s from %d (%d,%d)\n",comment,output_file,ii,pc.id,ok) panobj.pvplist(output_file,comment) } proc pard () {} proc pardisp () { local ii tmpfile.wopen($s1) prsnames(comment) tmplist.remove_all // save the label names in tmplist for ltr(XX,printlist) {tmpobj=new String(XX.vec.label) tmplist.append(tmpobj)} // for ltr(XX,prsl) vlk(XX.v) for ii=0,sims-1 { for ltr(XX,prsl) XX.clear for ltr(XX,prsl) { XX.exe(ii) tmpfile.printf("\t%d:%d: %s :: %s\n",ii,i1,XX.l.object(XX.v.x[ii]).s,XX.l.object(XX.v.x[ii]).t) } exeruncall(ii) pard (ii) // callback stub tmpfile.printf("%d/%d: %s\n",ii+1,sims,tt) } for ltr2(XX,YY,printlist,tmplist) XX.vec.label=YY.s // restore labels tmpfile.close } //** autopr() prints out a series of pictures, use cutps and ps2gif afterward proc autopr () { for ltr(XX,dir) { geall(1) read_vfile(1,XX.s) grall(1) sprint(filename,"%s.ps",XX.s) print_session(0, filename) } } //* xpostray(name1,name2): organize name1 vs name2 on a tray objref xposvec xposvec = new Vector() xpf=1 // flag for new disp or superimpose // ppo -- just show the comment proc ppo () { local i for i=1,xposvec.size xposvec.x[i-1]=$i xpostray(-1) } // execute the xposvec given as arguments -- allows setting for a run proc expo () { local i for i=1,numarg() { XX=prsl.object(i-1) XX.clear XX.exec($i) // exec doesn't use the xposvec printf("%s:%s,%s\n",XX.name,XX.l.object($i).s,XX.l.object($i).t) } exeruncall() } // display the xposvec given as arguments proc xpo () { local i for i=1,xposvec.size xposvec.x[i-1]=$i if (xpf==1 && panobj.super==0) { print "ERROR: no tray available to draw on" return } xpostray(xpf) } // eliminate labels written by rv() proc rv3 () { $s1="" } proc xpostray () { local rows,cols,i,j,k,p,g1,flag,xs,ys,sz localobj grvecstr,XX,YY,ob if (numarg()==1) flag=$1 else flag=0 if (vcount(xposvec,-1)!=1 || vcount(xposvec,-2)!=1) { sprint(mesg,"ERR: Rows/cols?: xpo(%d",xposvec.x[0]) for vtr(&x,xposvec) if (i1>0) sprint(mesg,"%s,%d",mesg,x) sprint(mesg,"%s)",mesg) print mesg return } p = allocvecs(1) grvecstr=new String() g1 = panobj.glist.count grvecstr.s = "" for vtr(&x,xposvec,&y) { if (x==-1) XX=prsl2.object(y) else { // rows if (x==-2) YY=prsl2.object(y) else { // cols sprint(grvecstr.s,"%s%s %s;",grvecstr.s,prsl2.object(y).name,prsl2.object(y).l.object(x).s) }}} if (sfunc.len(grvecstr.s)>0) chop(grvecstr.s) sprint(grvecstr.s,"%s - %s v %s:%s",panobj.filename,XX.name,YY.name,grvecstr.s) printf("xpo(%d",xposvec.x[0]) for vtr(&x,xposvec) if (i1>0) printf(",%d",x) print ")" print grvecstr.s rows=XX.n cols=YY.n sz=rows*cols // printf("%d x %d\n",rows,cols) if (flag==-1) { return } if (flag) { ob=boxerl.object(trnum) // specify tray ob.name = grvecstr.s if (rows!=ob.rows || cols!=ob.cols) { sprint(mesg,"ERROR: tray %dx%d; not %dx%d\n",ob.rows,ob.cols,rows,cols) print mesg return } for ltr(graphItem,ob.gl) graphItem.erase_all() g1 -= sz } else { if (cols>5) xs=1200/cols-50 else xs=200 if (rows>7) ys=900/rows-50 else ys=100 mktray(panobj,rows,cols,xs,ys) boxer.name=grvecstr.s trnum=boxerl.index(boxer) ob=boxer } mso[p].resize(sz) for vtr2(&x,&y,XX.v,YY.v,&y[1]) if (xprsok(y[1])) mso[p].x[x*cols+y]=y[1] for lvtr(graphItem, &x, ob.gl, mso[p]) { panobj.rv(x) sprint(grvecstr.s,"%s:%s v %s:%s",XX.name,XX.l.object(XX.v.x[x]).s,YY.name,YY.l.object(YY.v.x[x]).s) graphItem.label(0.1,0.9,grvecstr.s) } panobj.viewplot() dealloc(p) } //** xprsok() // need to avoid XX,YY,x,y globals since nested func xprsok () { local i,flag i=$1 flag=1 for lvtr(tmpobj,&x[1],prsl2,xposvec) { if (x[1]!=-1 && x[1]!=-2 && x[1]!=tmpobj.v.x[i]) {flag=0 continue} } return flag } proc xpostrmp () { ob=boxerl.object(boxerl.count-1) // last tray ob.boxes[0].unmap ob.boxes[0].map(ob.name) } // prsfor(NAME,VAL,FROM,TO,INC) // eg prsfor("LEAK","g_Pass",1e-3,9e-3,1e-3) proc prsfor () { local from,to,inc,ii if (numarg()==0) { print "prsfor(NAME,VAL,FROM,TO,INC)" return } from=$3 to=$4 inc=$5 sprint(tt,"ob=new PRS(\"%s\",\"%s=\"",$s1,$s2) for (ii=from;ii<=to;ii+=inc) sprint(tt,"%s,%g",tt,ii) sprint(tt,"%s)",tt) execute(tt) } // prsvals(NAME,VAL,val1,val2,...) // eg prsvals("LEAK","g_Pass",1e-3,9e-3,30e-3,75e-3) proc prsvals () { local i if (numarg()==0) { print "prsvals(NAME,VAL,val1,val2,...)" return } sprint(tt,"ob=new PRS(\"%s\",\"%s=\"",$s1,$s2) for i=3,numarg() sprint(tt,"%s,%g",tt,$i) sprint(tt,"%s)",tt) execute(tt) } //** xpospanl() -- panel for choosing params to graph proc xpospanl () { local ii localobj ob bx=new VBox() bx.intercept(1) if (0) if (attrnum==0 && sims!=printlist.count) { printf("WARNING: not enough printlist items (%d); read from file\n",sims) prsread() } labelm = 0 // xpostray() will do own labeling if (0) if (attrnum==0 && printlist.count>1) { prsl2prsl2() ob=prsl2 } else ob = prsl ob = prsl xposvec.resize(ob.count) xpanel("Set params") xvarlabel(mesg) for ltr(XX,ob,&x) { xmenu(XX.name) for ltr(YY,XX.l,&y) { sprint(temp_string_, "xposvec.x[%d]=%d",x,y) xradiobutton(YY.s, temp_string_) } sprint(temp_string_, "xposvec.x[%d]=%d",x,-1) xradiobutton("ROWS", temp_string_) sprint(temp_string_, "xposvec.x[%d]=%d",x,-2) xradiobutton("COLS", temp_string_) xmenu() } xbutton("Make tray","xpostray()") xbutton("Reuse tray","xpostray(1)") xvalue("Tray #","trnum",1) xbutton("Remove trays","rmtray(attrnum)") xbutton("Limits","panobj.wvpanl()") xbutton("Read file","prsread()") xpanel() sprint(tstr,"PARSET:%s",filename) bx.intercept(0) bx.map(tstr) if (xposvec.size>1) { xposvec.fill(0) xposvec.x[0]=-1 xposvec.x[1]=-2 } else { print "Something wrong in parset." } } //** prsl2prsl2() adds the printlist onto prsl2 proc prsl2prsl2 () { local p,prct,ii,jj p=allocvecs(1) print "Adding printlist items onto parameter lists" prct = printlist.count prscp(prsl2,prsl) for ltr(XX,prsl2,&x) { // expand out each of the param entries mso[p].copy(XX.v) // save temporarily XX.v.resize(sims*prct) // intersperse 'pointers' to printlist items for vtr(&x,mso[p]) for ii=0,prct-1 XX.v.x[i1*prct+ii]=x } ob = new PRS("states","{}") prsl.remove(prsl.count-1) // automatically added on to prsl, take it off for ltr(XX,printlist) if (sfunc.len(XX.vec.label)==0) { ob.append(XX.name,"{}") } else ob.append(XX.vec.label,"{}") ob.v.resize(sims*prct) for ii=0,sims-1 for jj=0,prct-1 ob.v.x[ii*prct+jj]=jj prsl2.append(ob) dealloc(p) } //** proc prscp(p1,p2) -- copy from p2 to p1 proc prscp () { $o1.remove_all tmpobj=prsl prslp=$o1 for ltr(XX,$o2) { ob = new PRS(XX.name,XX.clr) for ltr(YY,XX.l) ob.append(YY.s,YY.t) ob.v.copy(XX.v) } prslp=tmpobj // restore the pointer } //* prsnames,-vals,-show,-show2 proc prsnames () { localobj XX,st if (numarg()==2) for ltr(XX,prsl) { st=XX.ale($2) sprint($s1,"%s, %s=%s",$s1,st.s,st.t) } else for ltr(XX,prsl) XX.nam($s1) } proc prsvls () { $s1="" for ltr(XX,prsl) XX.com($s1,$2) } proc prsshow () { local flag if (numarg()==1) flag=$1 else flag=0 prsnames(tt) print tt if (flag==2) for ii=0,sims-1 { tt="" prsvls(tt,ii) printf("%s; ",tt) } else for ltr(XX,prsl) { tt="" sprint(tt,"%s: %d (",XX.name,XX.n) for ltr(YY,XX.l) sprint(tt,"%s%s,",tt,YY.s) sfunc.left(tt,sfunc.len(tt)-1) printf("%s)\n",tt) } } //** prsplist() -- rename the items in printlist proc prsplist () { local min,max,flag prsnames(tt) comment=tt if (printlist.count != sims) { print "ERROR prsplist" return } for ltr(YY,printlist,&x) { tt="" for ltr(XX,prsl) sprint(tt,"%s,%s:%s",tt,XX.name,XX.l.object(XX.v.x[x]).s) sfunc.right(tt,1) sprint(YY.name,"%s",tt) } } //** prsplist2() -- used by exerun // put a suitable combination title on the printlist item.vec.label proc prsplist2 () { local ii,x localobj XX,YY ii=$2 if (numarg()==3) sprint(tt,",%s",$s3) else tt="" for ltr(XX,prsl) sprint(tt,"%s,%s=%s",tt,XX.name,XX.l.object(XX.v.x[ii]).s) sfunc.right(tt,1) // get rid of leading , for ltr(YY,printlist,&x) sprint(YY.name,"%s:%s",tt,$o1.o(x).s) } //** prspars(#) show the params for that exe # proc prspars () { ii=$1 tt="" for ltr(XX,prsl) sprint(tt,"%s,%s:%s",tt,XX.name,XX.l.object(XX.v.x[ii]).s) sfunc.right(tt,1) print tt } //** prsid(str) find the exe # for the param string func prsid () { local ii for ii=0,sims-1 { tt="" for ltr(XX,prsl) sprint(tt,"%s,%s:%s",tt,XX.name,XX.l.object(XX.v.x[ii]).s) sfunc.right(tt,1) if (strc($s1,tt)) break } if (ii==sims) return -1 else return ii } //* prssave,prsread proc prssave () { local ii if (numarg()==1) file_with_p($s1,temp_string_,temp_string2_) else { file_with_p(panobj.output_file,temp_string_,temp_string2_) } tmpfile.wopen(temp_string_) print "Writing ",temp_string_ if (printlist.count<=1) ob=prsl else { prsl2prsl2() ob=prsl2 } for ltr(XX,ob) { tmpfile.printf("%s\n",XX.name) if (sfunc.len(XX.clr)) tmpfile.printf("%s\n",XX.clr) else tmpfile.printf("{}\n") tmpfile.printf("%d\n",XX.l.count) for ltr(YY,XX.l) { tmpfile.printf("%s\n",YY.s) if (sfunc.len(YY.t)) tmpfile.printf("%s\n",YY.t) else tmpfile.printf("{}\n") } } tmpfile.close() } // run prsread() after reading in file proc prsread () { local ii,num if (0) { file_with_p($s1,tt,temp_string2_) read_vfile(1,$s1) } else { file_with_p(panobj.filename,tt,temp_string2_) } prsparsef(tt) prscp(prsl2,prsl) xpospanl() } //** parse files; used by prsread() // usage: for ltr(XX,dir) {prsparsef(XX.s) prsshow() } proc prsparsef () { local ii,num print "Reading ",$s1 prsl.remove_all if (! tmpfile.ropen($s1)) { print $s1," not found." return } while ((numr = tmpfile.scanstr(temp_string_)) != -1) { tmpfile.gets(temp_string2_) chop(temp_string2_) ob = new PRS(temp_string_,temp_string2_) num = tmpfile.scanvar() for ii=1,num { tmpfile.gets(temp_string_) tmpfile.gets(temp_string2_) chop(temp_string_) chop(temp_string2_) ob.append(temp_string_,temp_string2_) } } sims = setprs(1) } // showpars() prs explorer using dired proc showpars () { dired(dir,"data/p*") lbrw(dir,"showpars1") } proc showpars1 () { local outv tstr=dir.object(hoc_ac_).s prsparsef(tstr) if (strcmp(prsl.object(prsl.count-1).name,"states")==0) { outv=prsl.object(prsl.count-1).l.count printf("%d sims x %d states\n",sims/outv,outv) } else printf("%d sims\n",sims) prsshow() } //** file_with_p(filename,result,scratch): replace v99 with p99 in result proc file_with_p() { if (sfunc.substr($s1,"/") == -1) { sprint($s2,".%s",$s1) } else { sfunc.tail($s1,".*/v",$s3) sfunc.head($s1,"/[^/]+$",$s2) sprint($s2,"%s/p%s",$s2,$s3) } } // END /usr/site/nrniv/local/hoc/parset.hoc //================================================================ // END init.hoc //================================================================ //================================================================ // INSERTED labels.hoc // =Id= labels.hoc,v 1.2 1998/08/16 00:24:08 billl Exp // external fgabaa,fgabab, fampa, fnmda, ftc, fre, fgen //* syn types: fgabaa = 0 fgabab = 1 fampa = 2 fnmda = 3 func fgabaa (){return 0 } func fgabab (){return 1 } func fampa () {return 2 } func fnmda () {return 3 } func finj () {return 4 } //* cell types: ftc = 0 fre = 1 fgen = 2 func ctypes () {return 6 } func ftc () {return 0 } func fre () {return 1 } func fti () {return 2 } func fin () {return 3 } func fpy () {return 4 } func fgen (){return 5 } //* field types: nrn=1, syn=3, clm=3, idx=4 func nrn() { return 1 } // neuron type (either RE or TC) func syn() { return 2 } // synapse type (GABAA, GABAB, AMPA, NMDA) func clm() { return 3 } // column number func idx() { return 4 } // nrn number in the column //* utility functions // plmin(val,var) func plmin() { return $1 + $2*(2*u_rand() - 1) } // END labels.hoc //================================================================ //================================================================ // INSERTED geom.hoc // =Id= geom.hoc,v 1.32 1998/09/25 20:12:05 billl Exp //* RE Cell sRE // TEMPLATE FILE FOR DEFINING RETICULAR NEURONS // -------------------------------------------- // // One compartment model and currents derived from: // // Destexhe, A., Contreras, D., Sejnowski, T.J. and Steriade, M. // A model of spindle rhythmicity in the isolated thalamic reticular // nucleus. J. Neurophysiol. 72: 803-818, 1994. // // Destexhe, A., Contreras, D., Steriade, M., Sejnowski, T.J., // and Huguenard, J.R. In vivo, in vitro and computational analysis of // dendritic calcium currents in thalamic reticular neurons. // Journal of Neuroscience 16: 169-185, 1996. // // Modifications: // // - passive parameters estimated from simplex // - IT2: Q10=2.5, strong conductance for broad bursts // - no IK[Ca], no ICAN // - Ca++: simple decay only // // // This model is described in detail in: // // Destexhe, A., Bal, T., McCormick, D.A. and Sejnowski, T.J. // Ionic mechanisms underlying synchronized oscillations and propagating // waves in a model of ferret thalamic slices. Journal of Neurophysiology // 76: 2049-2070, 1996. (see http://www.cnl.salk.edu/~alain) // // // Alain Destexhe, Salk Institute and Laval University, 1995 //** begintemplate sRE begintemplate sRE // create a new template object public soma public nmda, ampa, gabaa, gabab public up external fgabaa,fgabab, fampa, fnmda, ftc, fre, fgen objectvar nmda, ampa, gabaa, gabab objref this,up create soma[1] // one-compartment of 14260 um2 soma { nseg = 1 diam = 70 L = 64.86 cm=1 } proc init() { local v_potassium, v_sodium type = fre() num = $1 access soma v_potassium = -100 // potassium reversal potential v_sodium = 50 // sodium reversal potential soma { Ra = 100 // geometry nseg = 1 diam = 70 L = 64.86 } soma { gabaa = new GABAA(0.5) gabab = new GABAB(0.5) ampa = new AMPA(0.5) nmda = new NMDA(0.5) } } endtemplate sRE //* TC Cell sTC // TEMPLATE FILE FOR DEFINING THALAMOCORTICAL NEURONS // -------------------------------------------------- // // One compartment model and currents derived from: // // McCormick, D.A. and Huguenard, J.R. A model of the // electrophysiological properties of thalamocortical relay neurons. // J. Neurophysiology 68: 1384-1400, 1992. // // - passive: parameters idem Rinzel // - HH: Traub with higher threshold // - IT: m2h, nernst, tau_h modified with double exponential // - Ih: Huguenard with Ca++ dependence added, Ca++-binding protein // - Ca++: simple decay, faster than McCormick // // // This model is described in detail in: // // Destexhe, A., Bal, T., McCormick, D.A. and Sejnowski, T.J. // Ionic mechanisms underlying synchronized oscillations and propagating // waves in a model of ferret thalamic slices. Journal of Neurophysiology // 76: 2049-2070, 1996. (see http://www.cnl.salk.edu/~alain) // // // Alain Destexhe, Salk Institute and Laval University, 1995 //** begintemplate sTC begintemplate sTC // create a new template object public soma , kl public nmda, ampa, gabaa, gabab public up external fgabaa,fgabab, fampa, fnmda, ftc, fre, fgen objectvar nmda, ampa, gabaa, gabab objref this,up create soma[1] // one compartment of about 29000 um2 soma { nseg = 1 diam = 96 L = 96 cm = 1 } objectvar kl proc init() { local v_potassium, v_sodium type = ftc() num = $1 access soma objectvar kl kl = new kleak() v_potassium = -100 // potassium reversal potential v_sodium = 50 // sodium reversal potential soma { gabaa = new GABAA(0.5) gabab = new GABAB(0.5) ampa = new AMPA(0.5) nmda = new NMDA(0.5) } soma { diam = 96 // geometry L = 96 // so that area is about 29000 um2 nseg = 1 kl.loc(0.5) // K-leak Ra = 100 } } endtemplate sTC //* Thalamic interneuron (sTI) //** begintemplate sTI begintemplate sTI public soma,dend public nmda, ampa, gabaa, gabab, p, inhib, excit, inj public up external fgabaa,fgabab, fampa, fnmda, ftc, fre, finj, fgen objectvar nmda, ampa, gabaa, gabab, inj objref this,up create soma, dend[1] proc init () { local i,j ndend = 14 create soma, dend[ndend] soma { gabaa = new GABAA(0.5) gabab = new GABAB(0.5) ampa = new AMPA(0.5) nmda = new NMDA(0.5) } forsec "soma" { nseg = 1 diam = 10 L = 16 cm = 1 } for i = 0, ndend-13 dend[i] { nseg = 1 diam = 3.25 L = 240 cm = 1 } for i = 2, ndend-1 dend[i] { nseg = 1 diam = 1.75 L = 180 cm = 1 } for i = 0, 1 connect dend[i](0), soma (0+i) for i = 2, ndend-7 connect dend[i](0), dend[0] (1) for i = 8, ndend-1 connect dend[i](0), dend[1] (1) forall Ra = 100 } endtemplate sTI //* 2 CMP Thalamic interneuron (tTI) //** begintemplate tTI begintemplate tTI public soma,dend public nmda, ampa, gabaa, gabab, p, inhib, excit, inj public up external fgabaa,fgabab, fampa, fnmda, ftc, fre, finj, fgen objectvar nmda, ampa, gabaa, gabab, inj objref this,up create soma, dend proc init () { local i,j create soma, dend soma { gabaa = new GABAA(0.5) gabab = new GABAB(0.5) ampa = new AMPA(0.5) nmda = new NMDA(0.5) } forsec "soma" { nseg = 1 diam = 10 L = 16 cm = 1 } forsec "dend" { nseg = 1 diam = 50 L = 50 cm = 3 } connect dend(0), soma (1) forall Ra = 50 } endtemplate tTI //* Cortical interneuron sINT // TEMPLATE FILE FOR DEFINING RETICULAR NEURONS // -------------------------------------------- // // One compartment model and currents derived from: // // Destexhe, A., Contreras, D. and Steriade, M. // Mechanisms underlying the synchronizing action of corticothalamic // feedback through inhibition of thalamic relay cells // J. Neurophysiol. //** begintemplate sINT begintemplate sINT // create a new template object public soma public nmda, ampa, gabaa, gabab public up external fgabaa,fgabab, fampa, fnmda, ftc, fre, fpy, fin, fgen objectvar nmda, ampa, gabaa, gabab objref this,up create soma[1] // one-compartment of 14260 um2 soma { nseg = 1 diam = 70 L = 64.86 cm=1 } proc init() { local v_potassium, v_sodium v_potassium = -100 // potassium reversal potential v_sodium = 50 // sodium reversal potential type = fin() num = $1 access soma soma { gabaa = new GABAA(0.5) gabab = new GABAB(0.5) ampa = new AMPA(0.5) nmda = new NMDA(0.5) } soma { Ra = 100 // geometry nseg = 1 diam = 70 L = 64.86 } } endtemplate sINT //* Cortical pyramidal cell sPYR //** begintemplate sPYR begintemplate sPYR // create a new template object public soma public nmda, ampa, gabaa, gabab public up external fgabaa,fgabab, fampa, fnmda, ftc, fre, fpy, fin, fgen objectvar nmda, ampa, gabaa, gabab objref this,up create soma[1] // one compartment of about 29000 um2 soma { nseg = 1 diam = 96 L = 96 cm = 1 } proc init() { local v_potassium, v_sodium v_potassium = -100 // potassium reversal potential v_sodium = 50 // sodium reversal potential type = fpy() num = $1 access soma soma { gabaa = new GABAA(0.5) gabab = new GABAB(0.5) ampa = new AMPA(0.5) nmda = new NMDA(0.5) } soma { diam = 96 // geometry L = 96 // so that area is about 29000 um2 nseg = 1 Ra = 100 } } endtemplate sPYR // END geom.hoc //================================================================ //================================================================ // INSERTED network.hoc // =Id= network.hoc,v 1.281 2009/01/13 15:52:27 billl Exp // unnecessary:? // rcsopen("labels.hoc,2,geom.hoc,32") //* Create cells //* param settings sims = ncells = 1 objectvar TC[ncells],RE[ncells],TI[ncells],PY[ncells],IN[ncells] ind.resize(ncells) // number of columns vec.resize(ncells) for ii=0,ncells-1 { // PY[ii] = new sPYR(0.5,ii) // IN[ii] = new sINT(0.5,ii) // TC[ii] = new sTC(0.5,ii) TI[ii] = new sTI(0.5,ii) // RE[ii] = new sRE(0.5,ii) } create nullseg nullseg v= -1000 access nullseg //* stimulation objref pg[2] // pg[0] = new SpikeGenerator(0.5) // genlink(pg[0],"sTI","ampa") // genlink(pg[0],"sTC","ampa") objectvar stim[ncells] for ii=0,ncells-1 TI[ii].soma stim[ii] = new IClamp(0.5) // END network.hoc //================================================================ //================================================================ // INSERTED params.hoc // =Id= params.hoc,v 1.848 2009/01/13 16:03:48 billl Exp celsius=36 printStep = dt = 0.25 tstop=1000 v_potassium = -100 // potassium reversal potential v_sodium = 50 // sodium reversal potential v_init = -69 // set the individual ones by hand cao0_ca_ion = 2 Cao0_Ca_ion = 1 //* cell params //** TI forsec "TI.*soma" { insert naf2 gmax_naf2 = 0.06 mvhalf_naf2 = -40 mvalence_naf2 = 5 hvhalf_naf2 = -43 hvalence_naf2 = -6 insert kdr2 gmax_kdr2 = 0.07 mvhalf_kdr2 = -31 mvalence_kdr2 = 3.8 insert Pass g_Pass = 18e-6 erev_Pass = -72.5 insert ical pcabar_ical = 9.0e-4 sh1_ical = -10 sh2_ical = 0 insert ical3 pcabar_ical3 = 9.0e-4 sh1_ical3 = -10 sh2_ical3 = 0 insert it2 gcabar_it2 = 4.0e-4 shift1_it2 = 7 shift2_it2 = 0 mx_it2 = 3.0 hx_it2 = 1.5 sm_it2 = 4.8 sh_it2 = 4.6 insert cad kt_cad = 0e-6 kt2_cad = 0e-7 k_cad = 7.5e-3 taur_cad = 150 cainf_cad = 1e-8 taur2_cad = 80 cainf2_cad = 5.2e-5 caix_cad = 5.0e-5 insert Cad kt_Cad = 0e-6 k_Cad = 7.5e-3 taur_Cad = 150 Cainf_Cad = 1e-8 taur2_Cad = 80 Cainf2_Cad = 5.2e-5 Caix_Cad = 5.0e-5 insert iahp gkbar_iahp = 0.4 beta_iahp = 0.02 cac_iahp = 0.8e-3 rat_iahp = 0.2 insert ican gbar_ican =2e-5 beta_ican = 0.003 cac_ican = 1.1e-4 rat_ican = 0.1 x_ican = 8 insert iar ghbar_iar = 1.3e-4 shift_iar = -0.0 erev_iar = -44 stp_iar = 7.4 } forsec "TI.*dend" { insert Pass g_Pass = 8e-6 erev_Pass = -72.5 } for i=0,ncells-1 { // TC[i].kl.gmax = 0.003 } // setup first TC cell as an initiator (spontaneous waxing-waning) // TC[0].soma.ghbar_iarad = 2.5e-5 // long interspindle period // TC[0].kl.gmax = 0.005 // TC[0].soma.ghbar_iarad = 2e-5 // shorter interspindle period // TC[0].kl.gmax = 0.005 //* synapse params //** stim for ii=0,ncells-1 { stim[ii].del = 0 stim[ii].dur = 200 stim[ii].amp = .02 } // END params.hoc //================================================================ //================================================================ // INSERTED run.hoc // =Id= run.hoc,v 1.375 2009/01/13 16:03:49 billl Exp finitialize() cvode_active(0) cvode_local(1) if (1) { cvode.atol(1e-9) cvode.rtol(1e-2) } if (0) { cvode.atol(1e-4) cvode.rtol(0) } // very precise byte_store=1 proc exepars () { for ii=0,sims-1 for ltr(XO,prsl) TI[ii].soma XO.clear for ii=0,sims-1 for ltr(XO,prsl) TI[ii].soma XO.exe(ii) } exepars() //* graphics labelm=0 // rmtray(0) // mktray(0,8,6,60,20) // setrange(0) setrange(0,-1) // grtis("STIM") strdef tt proc grtis () { posvec($s1,ind) geall(0) grall(0,ind) prsnames(tt) panobj.glist.object(0).label(0.05,0.8,tt) for vtr(&x,ind,&y) { tt="" prsvals(tt,x) // print x,y,tt panobj.glist.object(y).label(0.00,0.1,tt) } } //* init stuff proc initMisc1 () { // setMemb() // if (cvode_change()) nprl() } proc setMemb() { local i_forward, i_back, iSum forall { if (ismembrane("Pass")) { iSum = 0.0 if (ismembrane("na_ion")) { iSum = iSum + ina } if (ismembrane("k_ion")) { iSum = iSum + ik } if (ismembrane("ca_ion")) { iSum = iSum + ica } if (ismembrane("Ca_ion")) { iSum = iSum + iCa } if (ismembrane("k2_ion")) { iSum = iSum + ik2 } if (ismembrane("k3_ion")) { iSum = iSum + ik3 } if (ismembrane("other_ion")) { iSum = iSum + iother } if (ismembrane("other2_ion")) { iSum = iSum + iother2 } if (ismembrane("ns_ion")) { iSum = iSum + ins } // Non-specific // if (issection("soma")) { print ina,ik,ica,iCa,ik2,ik3,iother,iother2,iSum } if (iSum == 0) { // Pas cmp so set e_pas = v erev_Pass = v } else { if (g_Pass > 0) { // Assume g set by user, calc e erev_Pass = v + iSum/g_Pass } else { // Assume e set by user, calc g if (erev_Pass != v) { g_Pass = iSum/(erev_Pass - v) } else { // error: g_Pass <= 0 errorMsg("bad g", g_Pass) } } if (erev_Pass < -100 || erev_Pass > 0) { errorMsg("erev out of bounds", erev_Pass) } } } } } //* nprl cvode_state = cvode_status() func cvode_change () { if (cvode_state!=cvode_status()) { cvode_state=cvode_status() return 1 } else { return 0 } } proc nprl () { printlist.remove_all() panobj.record(new List("sTI"),"soma.v(0.5)") } gg() g.addvar("TI.soma.v(0.5)") {printf("cvode_active().cvode_local() = %.1f\n",cvode_status())} xpanel("run the model") xbutton("click here to run","{run() g.exec_menu(\"View = plot\")}") xpanel() // END run.hoc //================================================================ // END batch.hoc //================================================================