// Created 12/27/07 22:00:26 by /usr/site/scripts/loadfiles
//================================================================
// INSERTED bsticknet.hoc
//* =Id= bsticknet.hoc,v 1.36 2007/12/28 02:47:43 billl Exp
// COMMENT
// simulation to accompany "Just in time connectivity for large spiking networks"
// This is meant primarily as an illustration of both the coding framework and the general ideas
// in the paper; it would need some additional work to be a practical simulation:
// eg, this simulation will not currently run with variable time step (don't know why)
// This network was built out of the basic framework of net2spec.ho: a basic exercise result
// from the NEURON summer course.
// Although the cells are basically the same: templates B_BallStick and SE_NetStim, the overall
// structure of the network has been augmented (it was only 3 cells originally)
// There is now one NetStim and 124 BallSticks -- 100 excitatory called SU (for superficial cell)
// and 24 inhibitory call IN
// Useful globals include eg numc[SU],ix[SU],ixe[SU] for number,first index,last index of SU cells
// Parallel lists are used to facilitate intercommunication with NMODL and C code in jitcon.mod
// cells is list of cells
// ce is a list of associated JitCon's
// (each cell has its own JitCon to which it is connected via a NetCon)
// aml is list of lists of AMPA synapses
// gal is list of lists of GABAA synapses
// Global arrays are also used in common with jitcon.mod eg
// double pmat[CTYPi][CTYPi],wmat[CTYPi][CTYPi] // give connectivity density (pij) and weights
// // by cell type
// connec() is the main routine which makes the cell-cell connections using both NetCons --
// through calls to nc_append(); and via JitCons -- through calls to setdvi()
// Since presyn for all network NetCon connections are made from the JitCon, these NetCons can be
// effectively disconnected by setting the 'jcn' flag for all the JitCons
// (NB odd 'feature': jit is a single JitCon jit.flag("jcn",1) sets the jcn flag just for 'jit'
// jit.flag("jcn",1,1) sets flag for all JitCons in list ce)
// ENDCOMMENT
//================================================================
// 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")
load_file("stdgui.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
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
if (unix_mac_pc()==1) osname = "Linux" else if (unix_mac_pc()==2) {
osname = "Mac" } else if (unix_mac_pc()==3) osname = "PC"
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<ts && stoprun==0) {
step()
realtime = startsw() - rtstart
if (realtime >= 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("ERROR: %s in section %s.\n", $s1, section)
} else {
printf("ERROR: %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.14 2007/12/27 14:47:29 billl Exp
install_vecst()
install_stats()
show_panel=0
//================================================================
// INSERTED /usr/site/nrniv/local/hoc/nqs.hoc
// =Id= nqs.hoc,v 1.584 2007/12/07 22:07:55 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.370 2007/12/26 19:00:41 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
dblform="%3.4g"
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.130 2007/12/19 16:26:15 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
// 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
if (!name_declared("isobj")) execute1("func isobj(){return 0}") // place holder
begintemplate Union
public ty,x,s,t,u,v,o
strdef s,t,u,v
objref o[10]
double x[10]
external sfunc,isobj
// 1arg -- store a num, string or obj
// 2arg -- pick up type out of list
proc init() { local ii,i,ox,xx,sx
ox=xx=sx=x=x[1]=0 ty=argtype(1) // 'type' of Union defined by 1st arg on creation
// special case of number in a vector or something in a list
if (argtype(1)==1 && argtype(2)==0 && argtype(3)==-1) {
ii=$2
printf("Union WARNING: taking single element out of a Vector or List\n")
if (argtype(1)==1) {
if (isobj($o1,"Vector")) {
if (ii<0 || ii>=$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 (xx<10) {
x[xx]=$i xx+=1
} else printf("Only have 10 doubles available so can't store %g\n",$i)
} else if (ii==2) {
if (sx==0) s=$si else if (sx==1) t=$si else if (sx==2) u=$si else if (sx==3) v=$si else {
printf("Only have 4 strings available so can't store %s\n",$si) }
sx+=1
} else if (ii==1) {
if (ox<10) { o[ox]=$oi ox+=1
} else printf("Only have 10 objects available so can't store %s\n",$oi)
} else printf("Union ERR: argtype not recognized numarg %d %d\n",i,ii)
}
}
endtemplate Union
//* Iterators
//** list iterator ltr
// usage 'for ltr(tmplist) { print XO }' :: 1 arg, assumes XO as dummy
// usage 'for ltr(YO, tmplist) { print YO }' 2 arg, specify dummy
// usage 'for ltr(XO, tmplist, &x) { print XO,x }' :: x is counter (else use global i1)
// usage 'for ltr(XO, tmplist, 5) { print XO,x }' :: max; only print out 0-5
// usage 'for ltr(XO, tmplist, 5, 7) { print XO,x }' :: print 5-7
// usage 'for ltr(XO, tmplist, &x, 5) { print XO,x }' :: counter with max
// usage 'for ltr(XO, tmplist, &x, 5, 7) { print XO,x }' :: counter,min,max
iterator ltr () { local i,min,max,ifl
min=0 max=1e9 ifl=0 // iterator flag
if (numarg()==3) {
if (argtype(3)==3) {ifl=1 $&3=0}
if (argtype(3)==0) max=$3
} else if (numarg()==4) {
if (argtype(3)==0) i1=min=$3 else {ifl=1 $&3=0}
max=$4
} else if (numarg()==5) {
$&3=min=$4 max=$5 ifl=1
}
if (! ifl) i1=0
if (numarg()==1) {
for i = 0, $o1.count-1 {
XO = $o1.object(i)
iterator_statement
i1+=1
}
tmpobj=$o1
XO=nil
} else {
if (max==1e9) max=$o2.count()-1 else if (max<0) { min=$o2.count+max max=$o2.count-1
} else if (max>$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()
st.s=$s1 ret=1
// 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;ii<o.count;ii+=2) v1.append(str2num(o.o(ii).s))
if (o.count!=v1.size*2) { printf("rcsopen() discrepency: ") vlk(v1) llist(o) dealloc(a)
return 0 }
for ltr(xo,o,&x) if (x%2==0) { // every other
printf("Opening %s%d\n",xo.s,v1.x[x/2])
if (!rcsopen(xo.s,v1.x[x/2])) { dealloc(a) ret=0 }
}
dealloc(a)
return ret
}
if (numarg()>1) 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<cps) { print tti/1e3, "kilocycles"
} else if (tti<60*cps) { print tti/cps, "s"
} else print tti/cps/60,"m"
system("date")
return tti/1e3
}
func ftime () { local tti
prtime()
if (numarg()==1) execute($s1) else execute(tmstr)
tti=prtime()
return tti
}
proc setdate () {
system("date +%y%b%d",datestr)
chop(datestr)
downcase(datestr)
}
proc sortlist () { local a,err,ii,x,rev,na localobj v1,v2,xo,nl,il
il=$o1
err=rev=0
na=numarg()
for ii=2,3 if (na>=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") err()}
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)
}
// LAR: list_array is list used as an array
begintemplate LAR
public l,set,x,size,nil,resize,get
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<size) {
for (ii=size-1;ii>=newsz;ii-=1) l.remove(ii)
} else if (newsz>size) {
for ii=size,newsz-1 l.append(l)
}
size=newsz
}
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.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_
}
strdef xtmp
if (wopen("xtmp")) xtmp = "xtmp" else xtmp="/tmp/xtmp" // scratch file to save system output to
//* stuff that doesn't belong here
//** dired([list,]file) - put together list of files matching 'file', calls 'ls -1 file'
// dired([list,]file,1) file name to read for list of files
// dired([list,]file,2) clear dir first; if list isn't present assume 'dir'
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 }
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
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
}
} else {
for i = 2, numarg() {
$o1 = $oi
iterator_statement
i1+=1
}
}
}
//* 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 // clear vector then append
if (! isobj($o1,"Vector")) $o1 = new Vector()
$o1.resize(0)
if (numarg()>1) if (argtype(2)==1) {
for i=2,numarg() $oi.resize(0)
} else {
for i=2,numarg() if (argtype(i)==0) $o1.append($i) else $o1.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 () {
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()
}
// 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.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)
}
// 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
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
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 localobj o
if (numarg()==0) {
print "p=allocvecs(#) or p=allocvecs(v1,v2,...), access with mso[p], mso[p+1]..." return 0 }
sz=MSOSIZ
lflg=0
if (argtype(1)==0) {
aflg=0 newv=$1
if (numarg()>=2) if (argtype(2)==0) sz=$2 else {lflg=1 o=$o2} // append to list in arg2
if (numarg()>=3) if (argtype(3)==0) sz=$3 else {lflg=1 o=$o3}
if (lflg) o.remove_all
} else {
aflg=1
if (argtype(numarg())==0) {
i=numarg() sz=$i newv=i-1
} else newv=numarg()
}
llen = msoptr
for ii=msomax,msoptr+newv-1 { // may need new vectors
if (ii>=MSONUM) { print "alloc ERROR: MSONUM exceeded." return 0 }
mso[ii] = new Vector(sz)
}
for ii=0,newv-1 {
mso[msoptr].resize(sz)
mso[msoptr].resize(0)
msoptr = msoptr+1
}
if (msomax<msoptr) msomax = msoptr
if (aflg) for i=1,newv $oi=mso[i-1+llen]
if (lflg) for i=0,newv-1 o.append(mso[i+llen])
return llen
}
//** dealloc(start)
// remove temp set of vectors from mso
proc dealloc () { local ii,min
if (numarg()==0) { min = 0 } else { min = $1 }
msoptr = min
}
//* indvwhere family
//** vwh(VEC,VAL) returns index where VEC.x[i]==VAL
func vwh () {
if (argtype(2)==0) return $o1.indwhere("==",$2)
if (numarg()==3) return $o1.indwhere($s2,$3)
return $o1.indwhere($s2,$3,$4)
}
//** vval(VEC,STR,NUM) uses indwhere to return first value that qualifies
func vval () {
if (argtype(2)==0) return $o1.x[$o1.indwhere("==",$2)]
if (numarg()==3) return $o1.x[$o1.indwhere($s2,$3)]
return $o1.x[$o1.indwhere($s2,$3,$4)]
}
//** vcnt(VEC,STR,x[,y]) uses indvwhere and returns # of values that qualify
func vcnt () { local a,ret
a=allocvecs(1)
if (numarg()==2) mso[a].indvwhere($o1,"==",$2)
if (numarg()==3) mso[a].indvwhere($o1,$s2,$3)
if (numarg()==4) mso[a].indvwhere($o1,$s2,$3,$4)
ret = mso[a].size
// if ($o1.size>0) printf("%d/%d (%g)\n",ret,$o1.size,ret/$o1.size*100)
dealloc(a)
return ret
}
//** civw(DEST,SRC1,STR1,x1[,y1]...) does compound indvwhere
// overwrites tstr; DEST should be size 0 unless to be compounded
// civw(DEST,0,...) will resize DEST to 0
func civw () { local i,a,b,c,f2,x,y,sz,min
a=b=c=allocvecs(3) b+=1 c+=2
min=2
// if ($o1.size>0) print "Starting with previously set index vector"
if (argtype(2)==0) {
if ($2==0) { $o1.resize(0) min=3
if (argtype(3)==1) sz=$o3.size else {
printf("ERR0: arg 3 should be obj when $2==0\n",i) return -1 }
} else {
printf("ERR0a: arg 2 should be 0 if a number -- zero sizes ind vector\n")
return -1
}
} else if (argtype(2)==1) sz=$o2.size else {
printf("ERR0b: arg 2 should be obj\n",i) return -1 }
for (i=min;i<=numarg();) {
mso[c].copy($o1)
if (argtype(i)!=1) { printf("ERR1: arg %d should be obj\n",i) return -1}
if ($oi.size!=sz) { printf("ERR1a: all vecs should be size %d\n",sz) return -1}
mso[a].copy($oi) i+=1 // look in a
if (argtype(i)!=2) { printf("ERR2: arg %d should be str\n",i) return -1}
tstr=$si i+=1
if (strm(tstr,"[[(]")) f2=1 else f2=0 // opstring2 needs 2 args
if (argtype(i)!=0) { printf("ERR3: arg %d should be dbl\n",i) return -1}
x=$i i+=1
if (f2) {
if (argtype(i)!=0) { printf("ERR4: arg %d should be dbl\n",i) return -1}
y=$i i+=1
}
if (f2) mso[b].indvwhere(mso[a],tstr,x,y) else { // the engine
mso[b].indvwhere(mso[a],tstr,x) }
$o1.resize(sz) // make sure it's big enough for insct -- shouldn't need
if (mso[c].size>0) $o1.insct(mso[b],mso[c]) else $o1.copy(mso[b])
if ($o1.size==0) break
}
dealloc(a)
return $o1.size
}
//* vecconcat(vec1,vec2,...)
// destructive: concatenates all vecs onto vec1
proc vecconcat () { local i,max
max=numarg()
if (numarg()<2) { print "vecconcat(v1,v2,...) puts all into v1" return }
if (argtype(max)==0) {max-=1 $o1.resize(0)}
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<sz1 && jj<sz2) {
if ($o1.x[ii]!=$o2.x[jj]) {
eq=0
printf("Differ at %d %d\n",ii,jj)
for kk=-10,10 if ((ii+kk)>=0 && (ii+kk)<sz1 && (jj+kk)>=0 && (jj+kk)<sz2) {
printf("(%d)%g:(%d)%g ",(ii+kk),$o1.x[ii+kk],(jj+kk),$o2.x[jj+kk]) }
print ""
break
} else eq=1
ii+=1 jj=ii+beg
}
return eq
}
//* isstring() determine if object $o1 is of type string, if so return the string in [$s2]
func isstring () {
sprint(tstr,"%s",$o1)
if (sfunc.substr(tstr,"String")==0) {
if (numarg()==2) sprint($s2,"%s",$o1.s)
return 1
} else {
if (numarg()==2) sprint($s2,"%s",$o1)
return 0
}
}
//** isassigned() checks whether an object is Null
if (name_declared("VECST_INSTALLED")) {
sprint(tstr,"func isassigned () { return !isojt($o1,nil) }")
} else {
sprint(tstr,"func isassigned () { return !isobt($o1,nil) }")
}
execute1(tstr)
//** declared goes through a list of function names and makes sure they exist
// useful to check a bunch of names before entering a template that calls them as external
proc declared () { local i,nd
for i=1,numarg() {
nd=name_declared($si)
if (nd==0) { // declare it
// sprint(tstr,"func %s () {printf(\"\\tEMPTY FUNCTION %s()\\n\") return 0}",$si,$si)
sprint(tstr,"func %s () {return 0}",$si)
execute1(tstr)
} else if (nd!=1) { // 2=obj,3=sec,4=str,5=dbl
printf("NAME CONFLICT: %s can't be a func since was declared as a %d\n",$si,nd)
}
}
}
//** isit() like isassigned() but can take a string instead
obfunc isit () { local ret localobj sv,o,st
o=new Union() st=new String()
if (argtype(1)==2) {
sv=XO
sprint(st.s,"XO=%s",$s1)
execute(st.s) // XO points to the thing
ret=isassigned(XO)
o.x=ret
o.s=$s1
o.o=XO
XO=sv
return o
} else return isassigned($o1)
}
//** isob(s1,s2) like isobj but takes string statt obj
func isob () { localobj st
st=new String()
sprint(st.s,"XO=%s",$s1)
execute(st.s) // XO points to the thing
sprint(st.s,"%s",XO)
if (sfunc.substr(st.s,$s2)==0) {
return 1
} else {
return 0
}
}
//** eqobj(o1,o2) checks whether 2 objects are the same
func eqobj () { return object_id($o1) == object_id($o2) }
//** ocnt(STR) counts number of objects named string
func ocnt () { local ret
tmpobj=new List($s1) ret=tmpobj.count
tmpobj=nil
return ret
}
//** isobj(o1,s2) checks whether object $o1 is of type $s2
func isobj () { localobj st
st=new String()
sprint(st.s,"%s",$o1)
if (sfunc.substr(st.s,$s2)==0) {
return 1
} else {
return 0
}
}
//** isobt(o1,o2) checks whether object $o1 is of type $o2
func isobt () { localobj s
s=new String2()
sprint(s.s,"%s",$o1) sprint(s.t,"%s",$o2)
sfunc.head(s.s,"\\[",s.s) sfunc.head(s.t,"\\[",s.t)
if (strc(s.s,s.t)) return 1 else return 0
}
// destructive of $s1
func str2num () { local x localobj o,st
x=1e9
if (sscanf($s1,"%d",&x)!=1) {
o=new Union() st=new String()
sprint(st.s,"%s.x=%s",o,$s1) // o has temp existance in global namespace
if (!execute1(st.s,0)) printf("Can't find '%s'\n",$s1)
x=o.x
}
return x
}
func isnum () { return strm($s1,"^[-+0-9.][-+0-9.eE]*$") }
// like perl chop -- removes the last character
// chop(STR[,TERM]); TERM chop only TERM
// note that no + means must repeat char eg "))*" statt ")+"
func chop () { local ln1,match localobj st
ln1=sfunc.len($s1) st=new String()
if (numarg()==2) {
sprint($s2,"%s$",$s2) // just look for terminal character
if ((match=sfunc.head($s1,$s2,st.s))==-1) {
return 0
} else {
sfunc.left($s1,match)
return match
}
} else if (sfunc.len($s1)>=1) {
sfunc.left($s1,ln1-1)
return 1
} else {
print "ERR: chop called on empty string" }
return 0
}
// lchop(STR[,BEGIN]) -- chop from the left
func lchop () { local ln1,match 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 }
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
func split () { local vf,x,nointerp,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 o=$o2
if (numarg()>3) nointerp=1 else nointerp=0 // 4th flag nointerp: don't interpret strings
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(3)==2) st.s=$s3 else st.s="[, ]+"
if (argtype(3)==0) {
if (vf) {printf("Split err: attempting to do length split into vector: %s",o) return 0}
num=$3
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 (!nointerp) 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 && !nointerp) { // try to interpret as a variable
y=2.775434e-23 // global 'y'
sfunc.head(s.t,st.s,s.s)
if (sfunc.len(s.s)==0) s.s=s.t // the end
sprint(st.t,"y=%s",s.s)
execute1(st.t,0) // no error
if (y==2.775434e-23) {
printf("split WARNING skipping non-number: %s\n",s.s)
} else {
o.append(y)
}
done=1
}
} 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)
func parsenums () { local x localobj st
st = new String2()
revec($o2)
st.t=$s1
while (sfunc.len(st.t)>0) {
if (sscanf(st.t,"%g",&x) != 1) {
sfunc.tail(st.t,"[^-0-9]+",st.s) st.t=st.s
} else {
sfunc.tail(st.t,"[-e0-9.]+",st.s) st.t=st.s
$o2.append(x)
}
}
return $o2.size
}
// 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.size<n && ii<5;ii+=1) {
v1.resize(n*4*ii)
if (rdmuniqm4) {
v1.setrnd(5,max-min+1,see)
v1.add(min)
} else v1.setrand(ro)
v1.uniq(l,1) // preserve order
}
if (vin.size<n) {
printf("rdmuniq ERR unable to find %d uniq values [%d,%d] -- only \n",n,min,max,vin.size)
}
vin.resize(n)
dealloc(a)
}
// rdmord (vec,n) randomly ordered numbers 0->n-1 in vec
// eg rdmord(ind,ind.size); check: for ii=0,ind.size-1 if (ind.count(ii)!=1) print ii
proc rdmord () { local n,a 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<n;j+=1) cov+=($o1.x[j]-ave1)*($o2.x[j]-ave2)
cov /= (df=n-1)
sd=sqrt((var1+var2-2.0*cov)/n)
t_val=(ave1-ave2)/sd
prob=betai_stats(0.5*df,0.5,df/(df+t_val*t_val))
// printf("%g ",t_val)
return prob
}
func howfull () { local a,min,max,bins,ret localobj v1
min=0 bins=1e3
if (numarg()==4){min=$2 max=$3 bins=$4} else if (numarg()==3){max=$2 bins=$3} else max=$2
a=allocvecs(v1,bins)
$o1.bin(v1,(max-min)/bins,min,max)
ret=1-v1.count(0)/bins
dealloc(a)
return ret
}
for scase(XO,"o","t","s","O","T","S","+") clrsym.o.append(new String(XO.s))
// END /usr/site/nrniv/local/hoc/decvec.hoc
//================================================================
objref g[10]
gvmarkflag=0
declared("file_len")
strdef execstr,strform,dblform,tabform
{strform="%s " dblform="%3.4g" tabform=" "}
//* stubs for ancillary programs
double sops[20] // AUGMENT TO ADD NEW OPSYM
declared("whvarg","whkey","varstr","nqsdel","chsel2","grsel2","oform")
proc oformoff () { execute1("func oform(){return NOP}") } // default no operation
proc oform64(){execute1("func oform(){{$o1.vpr(64,1)}return OK}")} // vec.vpr(64)
oformoff()
nqsselcp=1
//* NQS template
// potential to overwrite XO,tmpfile,i1
begintemplate NQS
public cob,out,up // operate on this or out
public s,comment,file,v,m,x,ind,scr,fcd,fcds,fcdo,fcdl,sstr // strings and vecs
public objl,verbose,tmplist,vlist,vl,nval,sval,oval,selcp,rxpstr,slorflag,stub,chunk,rdpiece
public sv,rd,append,pr,pri,prs,zvec,resize,size,fi,sets,set,setcol,setcols,gets,get,fetch,tog
public cp,copy,mo,aind,it,qt,ot,ut,vt,appi,eq,fcdseq,fcdoeq,sort,select,stat,map,apply,applf
public calc,pad,delect,fill,uniq,gr,clear,strdec,coddec,odec,join,fillin,fillv,otl,selall
public unuselist,useslist,delrow,elimrepeats,grow,shuffle,fewind,listvecs,loose,rdcols
public percl,psel,svsetting,getrow,getcol,resize2,find,family,delcol,keepcols,selone
public sethdrs,gethdrs,version,svvers,i2,ay,svcols,svR,scpflag,unref,refs,qtset,keylook,cpout
public deriv,interval,renamecol,renamecols,info,getsel,tomat,frmat,marksym,vsort,hash,unnan
objref v[1],s[1],is[4],x,nil,ind,scr[3],fcd,fcds,fcdo,fcdl,this,objl
objref cob,out,up,Xo,Yo,oval,tmplist,otl,vlist,vl,info
strdef comment,file,sstr,sstr2,sstr3,sstr4,tstr,sval,nqsvers,marksym
double m[1],refs[1]
external readnums,savenums,readdbls,savedbls,rdvstr,wrvstr,sfunc,repl_mstr,isobj,rdmord
external vlk,Union,String,tmpfile,strm,XO,execstr,i1,allocvecs,dealloc,mso,strform,dblform,tabform
external eqobj,isnum,chop,isassigned,whvarg,whkey,sops,batch_flag,g,varstr,gvmarkflag
external file_len,nqsdel,chsel2,grsel2,oform,nqsselcp
//** init()
proc init () { local i,ii,flag,scnt,na,fl,rdflag
refs=-1
nval=fl=scnt=flag=rdflag=0 // flag set if creating the internal NQS
ni=0
verbose=1
selcp=nqsselcp
svsetting=4 loose=1e-6
for ii=2,3 is[ii]=new String()
is[3].s="INDEX" is[2].s="SCRATCH"
na=numarg()
for i=1,na scnt+=(argtype(i)==2) // string count
if (na==0) scnt=-1
if (na==1) if (argtype(1)==2) rdflag=1 else if (argtype(1)==1) rdflag=2
if (na>=1) if (argtype(1)==0) {
fl=1 // 1 arg taken care of
if ($1==1e-9) {
flag=1 up=$o2 fl=2
m=up.m
if (m>0) {
objref v[m],s[m]
for ii=0,m-1 {v[ii]=new Vector() s[ii]=up.s[ii]}
}
fcd=up.fcd
fcds=up.fcds fcdl=up.fcdl fcdo=up.fcdo // finish creation of .out here
} else {
m=$1
objref v[m],s[m]
for ii=0,m-1 { v[ii]=new Vector() s[ii]=new String2() }
}
}
if (fl!=1 && na==scnt) { // all strings
fl=2 // all args taken care of
m=na
objref v[m],s[m]
for ii=0,m-1 {i=ii+1 v[ii]=new Vector() s[ii]=new String($si) }
}
if (fl!=2 && na>=2) if (argtype(2)==0) {
fl==2 // all args taken care of
for ii=0,m-1 v[ii].resize($2)
}
if (fl!=2) { // if first arg is not a string these other can be
if (na>=2) file=$s2
if (na>=3) comment=$s3
if (na>=4) x.x[0]=$4
}
if (!flag) {
// fcd gives field codes according to values used for argtype()
fcds=new List() fcd=new Vector(m) tmplist=new List() vlist=new List()
fcd.resize(m) fcd.fill(0) // field codes to have a field that's string based
}
x=new Vector(m) ind=x.c for ii=0,2 scr[ii]=x.c
scr.resize(0) ind.resize(0)
objl=new List() cob=this
v0sz=slorflag=0
qtset=0
chunk=100
info=new Union()
nqsvers="=Id= nqs.hoc,v 1.584 2007/12/07 22:07:55 billl Exp " svvers=-1
if (!flag) {
out=new NQS(1e-9,this)
if (rdflag==1) rd($s1)
if (rdflag==2) copy($o1)
}
chk()
}
// deallocate the attached nqs if destroyed
// after build NQS should have external pointer and out.up pointer +/- cob
// NB: 'this' is created and destroyed as needed
proc unref () {
return
// if (isassigned(out)) printf("AA:%d ",$1) else printf("BB:%d ",$1)
if ($1<=refs) { // don't bother if have more than 2 refs or if currently building
if (m>=0 && isassigned(out)) { // only do it on a live master nqs
if ($1<2 || eqobj(cob,out.up)) { // means that only up are left
m=-7 // indicate have started the process so don't reenter here
printf("Entering destructor for %s: %d %d %s %s %s\n",out.up,$1,refs,cob,out,out.up)
out.unref(-1) // take care of out first
}
}
}
if ($1==-1) { // for .out
cob=nil
up=nil
} else if (m==-7) { // should only be done once
m= -8
// printf("Removal of %s on call %d\n",out.up,$1)
if (isassigned(fcdo)) fcdo.remove_all
if (isassigned(fcdo)) fcds.remove_all
cob=nil
up=nil
}
}
//** make sure there are no inconsistencies
func chk () { local ii,jj,ret
ret=1
for ii=0,m-2 for jj=ii+1,m-1 {
if (sfunc.len(s[ii].s)>0 && strcmp(s[ii].s,s[jj].s)==0) {
printf("NQS:chk ERRA: %s col: %s(%d) %s(%d) with same name\n",this,s[ii].s,ii,s[jj].s,jj)
ret=0
}
}
return ret
}
//** tog() toggle flag that determines whether actions are on out or this
func tog () { local ret
if (eqobj(cob,out)) ret=20 else ret=10 // report old value
if (numarg()==0) {
if (eqobj(cob,out)) { cob=this if (verbose) print "Operate on full db"
} else { cob=out if (verbose) print "Operate on output of select"
}
} else if (numarg()==1) {
if (argtype(1)==0) {
if ($1>=10) { // set
if ($1==10) cob=this else if ($1==20) cob=out else printf("tog ERRA:%d\n",$1)
} else { // just give information
if (eqobj(cob,out)) { print "Using output db"
} else { print "Using full db" }
}
} else if (argtype(1)==2) { // out,output,selected to choose these
if (strm($s1,"[Oo][Uu][Tt]") || strm($s1,"[Ss][Ee][Ll]")) {
cob=out
} else {
cob=this
}
}
}
return ret
}
//** sethdrs() set the column names to given args
// sethdrs(#,"NAME") sethdrs("NAME1","NAME2",...) sethdrs(nq) -- copy from nq
proc sethdrs () { local i,nm
nm=numarg()
// out.s should always be a pointer to s but early on was keeping different copies:
if (! eqobj(s,out.s)) printf("sets INTERRA\n")
if (nm==2 && argtype(1)==0) {
s[$1].s=$s2
} else if (nm==1) {
if ($o1.m!=m) resize($o1.m)
for i=0,m-1 s[i].s=$o1.s[i].s
} else {
if (nm>m) {
if (batch_flag) {
printf("NQS sets WARNING resized table from %d to %d\n",m,nm)
} else if (! boolean_dialog("Resize TABLE?","YES","NO")) return
printf("resizing TABLE: %d -> %d\n",m,nm) resize(nm)
}
for i=1,nm { s[i-1].s=$si }
}
}
// gethdrs() print the strings
proc gets () { printf("gets() changed to gethdrs()\n") }
proc gethdrs () { local ii,jj,kk,mm localobj o
if (numarg()==1) {
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.selone when just working with one col and one value
func selone () { local val,niflag
if (numarg()==3) niflag=$3 else niflag=0 // use if searching repeatedly through same vec
tog("DB") // start at full db
if (argtype(1)==2) fl=fi($s1) else fl=$1
if (fl==-1) return
val=$2
// if (!v[fl].ismono) {printf("NQS selone: must sort on %s before using\n",s[fl].s) return -1}
if (niflag) ni=ind.slone(v[fl],val,ni) else ni=ind.slone(v[fl],val)
if (selcp) {
if (ind.size==0) {
if (verbose) printf("None selected\n")
} else {
out.ind.copy(ind)
aind()
cob=out
}
} else cob=this
return ind.size
}
//* ay() is an n-dim associative array with p return values
// a high-dim array would get/set based on eg aa[5][4][7][2][12] -> nq.ay(5,4,7,2,12).x
// an associative array could do same with non-numeric indices
// here if we have m cols can use any n of them as indices and rest are return values up to
// what a Union() can hold (2 strings, 2 objs, 2 doubles)
// if want to ignore one index can use OK as a globbing value
// for SET use an explicit set aa[5][4][7][2][12]=17 -> nq.ay(5,4,7,2,12,SET,17)
// select based on first n cols and always using EQU or SEQ
// gives more feel of an array -- assumes columns are IND0,IND1,...,VAL
// keys are SET to begin setting values, and OK to leave a value as is
// noninteger must be a set value
// eg XO=ncq.ay(SU,SU,AM,INC,SET,OK,List[35])
obfunc ay () { local a,b,i,j,na,flag,done,ix,nx,sx,ox localobj key,arg,o
if (numarg()==0) {
printf("ay(I0,I1 ...[SET,V1,V2 ...])\n") return o }
tog("DB") // start at full db
a=allocvecs(key,arg)
o=new Union()
na=numarg()
vlist.remove_all
ind.resize(v.size)
if (argtype(1)==1) for ii=0,$o1.size-1 {
key.append(EQU) arg.append($o1.x[ii],0) vlist.append(v[ii])
flag=0 j=b=$o1.size
if (numarg()>1) if ($2==SET) {i=3 flag=1}
} else {
for ({i=1 flag=0} ; i<=na && !flag; i+=1) {
if (argtype(i)==2) {
if (fcd.x[i-1]!=2){printf("sel ERRA: %d %d\n",fcd.x[i-1],argtype(i)) dealloc(a) return o}
for (j=0;j<fcds.count && !done;j+=1) if(strcmp(fcds.o(j).s,$si)==0) {
key.append(SEQ) arg.append(j,0) vlist.append(v[i-1]) done=1
}
if (!done) {printf("%s aq ERRE: %s not found in col %s\n",this,$si,s[i-1].s)
dealloc(a) return o }
} else if (argtype(i)==0) {
if ($i==SET) { flag=1 // this is a value to set
} else if ($i!=OK) { // ignore an OK
key.append(EQU) arg.append($i,0) vlist.append(v[i-1])
}
}
}
b=i-1 // will begin again here -- these are v[] indices hence 0- statt 1-offset
j=i-2 // have also had a SET arg to go behind
}
ind.slct(key,arg,vlist)
if (ind.size>1) { printf("%s ay ERRB: mult rows %d\n",this,ind.size) dealloc(a) return o }
if (ind.size==0) { printf("%s ay ERRBB: none selected\n",this) dealloc(a) return o }
ix=ind.x[0]
for (;i<=na && flag;{i+=1 j+=1}) { // set using the rest of the args
if (argtype(i)==0) if ($i==OK) continue // don't set this one
if (argtype(i)==2) if (strcmp($si,"")==0) continue // don't set this one
if (argtype(i)!=fcd.x[j]) {
printf("%s ay ERRC: %d %d %d\n",this,i,fcd.x[j],argtype(i)) dealloc(a) return o }
if (argtype(i)==0) { v[j].x[ix]=$i
} else if (argtype(i)==1) { set(j,ix,$oi) print $oi,ix
} else if (argtype(i)==2) { set(j,ix,$si)
} else {printf("%s ay ERRD: set %d not implemented\n",this,argtype(i)) dealloc(a) return o}
}
nx=sx=ox=-1
for (i=b;i<m;i+=1) { // return values -- only get one of each for now
j=getval(i,v[i].x[ix])
if (j==0 && nx<1) { o.x[(nx+=1)]=nval
} else if (j==2) {
if (sx==-1) o.s=sval else if (sx==0) o.t=sval
sx+=1
} else if (j==1 && ox<1) o.o[(ox+=1)]=oval
}
dealloc(a)
return o
}
//* select() -- based loosely on SQL select
func select () { local ii,i,tmp,tmp1,ret,isv,key,arg,vc,selcpsav,savind,union,not,rxpflg localobj o
if (numarg()==0) { out.cp(this,2) cob=out return v.size }
tog("DB") // start at full db
if (size(1)==-1) { printf("%s:select ERR0: cols not all same size\n",this) return -1 }
// key holds OPs; arg holds ARGs; vc holds COL NAMEs
key=arg=vc=allocvecs(3) arg+=1 vc+=2 // key is an operator, arg is args, vc is col#
selcpsav=selcp i=1 not=rxpflg=union=savind=0
tmplist.remove_all vlist.remove_all
if (argtype(i)==0) if ($1==-1) {selcp=0 i+=1} // else is a number identifying a vector
if (argtype(i)==2) { // check first string for &&, ||, !
if (strcmp($si,"&&")==0) { savind=1 union=0 i+=1
} else if (strcmp($si,"||")==0) { savind=1 union=1 i+=1
} else if (strcmp($si,"!")==0) { savind=0 not=1 i+=1
} else if (strcmp($si,"&&!")==0) {savind=1 not=1 i+=1
} else if (strcmp($si,"||!")==0) {savind=1 union=1 not=1 i+=1 }
} else if (argtype(i)==1) { i+=1
if (argtype(i)==1 && argtype(i+1)==1) { // 3 vectors in a row are preset info for slct()
if (numarg()!=3) { printf("%s:select ERR0: 3 vecs should be mso[key],mso[arg],cols\n",this)
dealloc(key) return -1 }
if ($o1.size!=$o3.size || $o1.size*2!=$o2.size) {
printf("%s:select ERR0c: size problem %d %d %d\n",this,$o1.size,$o2.size,$o3.size)
dealloc(key) return -1 }
i=4 // have sucked up all the args
mso[key].copy($o1) mso[arg].copy($o2)
for ii=0,$o3.size-1 vlist.append(v[$o3.x[ii]])
} else if (isobj($o1,"Vector")) { ind.copy($o1) savind=1 union=0 // assume &&
} else {
printf("%s:select ERR0a: first vec obj should be ind vector\n",this) dealloc(key) return -1 }
}
if (savind) scr.copy(ind) else scr.resize(0)
while (i<=numarg()) {
if (argtype(i)==2) {
if (strcmp($si,"IND_")==0) {
if ((vn=fi($si,"NOERR"))!=-3) {
printf("NQS:select() WARNING: IND_ is a reserved word: ?%s\n",s[vn].s) }
vn=-1e9 scr[1].indgen(0,v.size-1,1) tmplist.prepend(scr[1])
} else if ((vn=fi($si))<0) { dealloc(key) return -1 }
sstr=$si // save for join: use with "NAME",EQW,OTHER_NQS
} else if (argtype(i)==0) { vn=$i // can avoid repeated string search
if (vn<0 || vn>=m) {
printf("%s:select ERR0b: can't ident arg %d: %d\n",this,i,vn) dealloc(key) return -1}
sstr=s[vn].s
} else {printf("%s:select ERR1: arg %d should be col name or num\n",this,i) dealloc(key) return -1}
if (vn>=0) if (fcd.x[vn]==1) {
if (oform(fcdo.o(v[vn].x[0]))!=NOP) { // look at obj list
scr[1].resize(0)
for ii=0,v[vn].size-1 scr[1].append(oform(fcdo.o(v[vn].x[ii])))
vn=-1e9 tmplist.prepend(scr[1])
} else {
printf("NQS:select WARNING selecting on indices in an obj column: %d (?oform)\n",vn)
}
}
mso[vc].append(vn) i+=1
if (argtype(i)==0) {
if ((isv=isvarg($i))!=-1) {
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 (tmp<tmp1) mso[arg].append(tmp,tmp1) else mso[arg].append(tmp1,tmp)
i+=1
continue
}
} else if (argtype(i)==2) { isv=isvarg(lk=whvarg($si))
if (isv==-1) {
if (strcmp($si,"==")==0 || strcmp($si,"~")==0) {
mso[key].append(IBI) // approximately equal -- generate a range
i+=1
tmp=$i*(1-loose) tmp1=$i*(1+loose)
if (tmp<tmp1) mso[arg].append(tmp,tmp1) else mso[arg].append(tmp1,tmp)
i+=1
continue
} else {
printf("%s:select ERR1a: operator %s not recognized\n",this,$si) dealloc(key) return -1
}
}
} else {
printf("%s:select ERR2: arg should be symbolic (eg GTE, EQU ...) or string (eg '[)','<=') op \n",this,i)
dealloc(key) return -1
}
mso[key].append(lk) i+=1
// pick up ARGS
for ii=0,isv-1 {
if (argtype(i)==0) {
if (lk==EQV) {
if ($i<0 || $i>=m) printf("ERRQ\n") else {
mso[arg].append(0)
mso[vc].append($i)
}
} else mso[arg].append($i)
i+=1
} else if (argtype(i)==2) {
if (lk==EQV) { // look for a column id
vn=fi($si) // OPSYM exception
if (vn==-1) { printf("%s:select ERR2a EQV but what col?\n",this) dealloc(key) return -1 }
mso[arg].append(0)
mso[vc].append(vn) i+=1
} else if (lk==SEQ) {
mso[key].x[mso[key].size-1]=EQU
if (argtype(i)==1) oval=$oi else if (argtype(i)==2) sval=$si
mso[arg].append(ret=finval(vn,argtype(i),lk)) i+=1
} else if (lk==RXP) {
mso[key].x[mso[key].size-1]=EQW
mso[arg].append(0)
if (argtype(i)!=2) {printf("%s:select ERR2a1\n",this) dealloc(key) return -1}
if (rxpflg==1) {printf("%s:select ERR2a2: RXP twice\n",this) dealloc(key) return -1}
ret=tmplist.prepend(scr[2])
if (rxpstr(vn,$si,scr[2])==0) {
printf("%s:select WARNING: No RXP matches for %s\n",this,$si) }
mso[vc].append(-1e9) i+=1
} else {printf("%s:select ERR2b string arg needs EQV,SEQ or RXP?\n",this)
dealloc(key) return -1}
} else if (argtype(i)==1) {
if (lk>=EQW && lk<=EQX) { // pick up a vector
if (isobj($oi,"Vector")) {
mso[arg].append(0)
mso[vc].append(-i) i+=1
} else if (isobj($oi,"NQS")) {
mso[arg].append(0)
if ((tmp=$oi.fi(sstr,"NOERR"))!=-1) { // JOIN with output from other nqs
tmplist.prepend($oi.out.v[tmp])
} else {
o=$oi i+=1
if ((tmp=o.fi($si))==-1){printf("%s:select ERR2c: can't find %s in %s?\n",this,$si,o)
dealloc(key) return -1 }
tmplist.prepend(o.out.v[tmp])
}
mso[vc].append(-1e9) i+=1
} else { printf("%s:select ERR2c1: EQW/EQX needs Vec or NQS not %s?\n",this,$oi)
dealloc(key) return -1
}
} else { printf("%s:select ERR2d only EQW/EQX takes obj arg: %d:%d?\n",this,i,argtype(i))
dealloc(key) return -1}
} else {
whkey(lk,sstr) printf("%s:select ERR3 arg %d should be arg for %s",this,i,sstr)
dealloc(key) return -1
}
}
// args in wrong order - swap
if (isv==2) if (mso[arg].x[mso[arg].size-2]>mso[arg].x[mso[arg].size-1]) {
tmp=mso[arg].x[mso[arg].size-2]
mso[arg].x[mso[arg].size-2]=mso[arg].x[mso[arg].size-1]
mso[arg].x[mso[arg].size-1]=tmp
}
// pad so every OP sees 2 ARGS
for ii=0,2-isv-1 { mso[arg].append(0) }
}
ind.resize(v.size)
for ii=0,mso[vc].size-1 { vn=mso[vc].x[ii]
if (vn==-1e9) { // code for EQW case with NQS arg
vlist.append(tmplist.object(tmplist.count-1))
tmplist.remove(tmplist.count-1) // pop
} else if (vn<0) { i=-vn // code for EQV case where vector is in the arg list
vlist.append($oi)
} else vlist.append(v[vn])
}
if (tmplist.count!=0) { printf("NQS:select ERR5 %s.tmplist not empty\n",this) return -1 }
if (slorflag) { ind.slor(mso[key],mso[arg],vlist)
} else { ind.slct(mso[key],mso[arg],vlist) }
if (verbose==2) keylook(key) // look at the keys
if (not==1) complement() // ind->!ind
if (savind) {
if (union==1) {
scr.append(ind) scr.sort ind.resize(scr.size+ind.size)
ind.redundout(scr)
} else {
mso[key].resize(scr.size+ind.size)
mso[key].insct(scr,ind) ind.copy(mso[key]) }
}
ret=ind.size
if (selcp) {
out.ind.copy(ind)
if (ind.size==0) {
if (verbose) printf("None selected\n")
} else {
aind()
cob=out
}
} else cob=this
dealloc(key)
selcp=selcpsav
slorflag=0
return ret
}
//** keylook()
proc keylook () { local key,arg,vc,ii
if (numarg()==0) key=0 else key=$1
arg=key+1 vc=key+2
printf("slct(keys,args,cols)\n")
for ii=0,mso[key].size-1 {
whkey(mso[key].x[ii],tstr)
for jj=0,m-1 if (eqobj(v[jj],vlist.o(ii))) break
if (jj==m) jj=-1
printf("KEY: %s; ARGS: %g %g; COL: %d (%s)\n",\
tstr,mso[arg].x[2*ii],mso[arg].x[2*ii+1],jj,vlist.o(ii))
} // vlk(mso[key]) vlk(mso[arg])
}
//** selall()
proc selall () { local ii
if (numarg()==2) {
for ii=0,m-1 out.v[ii].where(v[ii],$s1,$2)
} else {
for ii=0,m-1 out.v[ii].where(v[ii],$s1,$2,$3)
}
tog("SEL")
}
//** complement() ind -> !ind
proc complement () { local a,b
a=b=allocvecs(2) b+=1
mso[a].indgen(0,size(1)-1,1)
mso[b].resize(mso[a].size)
mso[b].cull(mso[a],ind)
ind.copy(mso[b])
dealloc(a)
}
//** delect([NQS])
// move the selected rows from the out db [or other] back to the main db
// the assumption is that you have operated on some of the fields and now want to
// put the rows back
// ind must not have been altered since it will be used to replace the items
func delect () { local beg,ii,flag
scr.resize(v.size)
if (numarg()==1) flag=1 else flag=0
if (flag) {
if (m!=$o1.m){
printf("NQS:delect ERRa m mismatch: %s:%d vs %s:%d\n",this,m,$o1,$o1.m) return -1 }
ind.copy($o1.ind)
} else if (out.ind.size==0) { return 0
} else if (!out.ind.eq(ind) || ind.size!=out.v.size) {
printf("NQS:delect ERR ind size mismatch\n")
return -1
}
for (beg=0;beg<m;beg+=50) { // sindx() can only handle vecst.mod:VRRY vecs at a time
tmplist.remove_all vlist.remove_all
for ii=beg,beg+49 if (ii<m) tmplist.append(v[ii])
for ii=beg,beg+49 if (ii<m) if (flag) {
vlist.append($o1.v[ii])
} else {
vlist.append(out.v[ii])
}
ind.sindx(tmplist,vlist)
}
cob=this
return ind.size
}
//** isvarg() returns number of args an op takes or -1 if not symbolic OP
func isvarg () { local m,op // ADD NEW OPSYM CHECK
op=$1
for m=0,5 if (op<=EBE*(m+1) && op>=ALL*(m+1)) { op/=(m+1) break } // m is is field key 1-5
if (op<ALL) return -1 else if (op<GTH) return 0 else if (op<IBE) { return 1
} else if (op<=EBE) return 2 else return -1
}
//** fi(STR[,XO]) find the index for a particular string, can set a objref
// fi(STR,INDEX) return INDEXed value from that vector
// fi(STR,"NOERR") suppress error message
// fi(STR,"EXACT") string match
// fi(STR,"ALL") return vector of all indices that match regexp
func fi () { local num,flag,ii,ret,err,ext
if (refs==-1) if (isassigned(out)) { // calculate refs
// refs=sfunc.references(this,1)-1 // make sure 'this' is turned on
// printf("%d refs\n",refs)
}
ext=noerr=err=num=flag=all=0
if (numarg()>=2) if (argtype(2)==2) {
if (strcmp($s2,"NOERR")==0) noerr=1 // use "NOERR" string
if (strcmp($s2,"EXACT")==0) ext=1 // string match statt regexp
if (strcmp($s2,"ALL")==0) {all=1 $o3.resize(0)} // all regexp matches
}
for ii=0,m-1 if (strcmp(s[ii].s,$s1)==0) {flag=1 ret=ii break} // exact match
if (ext) if (flag) return ret else return -1
if (strcmp($s1,"scr")==0 || strcmp($s1,"SCR_")==0) {flag=1 ret=-2}
if (strcmp($s1,"IND_")==0) {flag=1 ret=-3}
if (!flag) for ii=0,m-1 { // make sure $s1 could be a regexp to avoid regexp error
if (sfunc.len($s1)<sfunc.len(s[ii].s) && !strm($s1,"[()]")) if (strm(s[ii].s,$s1)) {
if (num>=1) {
if (all) $o3.append(ii) else {
err=1
printf("%s fi ERR: regexp matches more than once: %d %s\n",this,ii,s[ii].s)
}
} else {
if (all) $o3.append(ii)
num+=1 ret=ii flag=1
}
}
}
if (err) printf("NQS WARNING; ambiguous regexp; fi() returning pointer for: %d %s\n",ret,s[ret].s)
if (flag) {
if (numarg()==2 && noerr==0) {
if (argtype(2)==1) {
if (ret==-2) $o2=scr else if (ret==-3) {printf("%s:fi ERRa copy what?\n",this) return ret
} else $o2=v[ret]
} else if (argtype(2)==0) {
if ($2<0 || $2>=v[ret].size) {
printf("%s:fi ERR index out of bounds: %d %d\n",this,$2,v[ret].size)
return -1
}
if (ret==-2) ret=scr.x[$2] else if (ret==-3) {printf("NQS:fi ERRb what?\n") return ret
} else ret=v[ret].x[$2]
} else { printf("%s:fi WARNING 2nd arg ignored\n",this) }
}
return ret
} else {
if (!noerr) printf("%s.fi() ERR '%s' not found\n",this,$s1)
return -1
}
}
//** find(STR) find the vector associated with a COL label
obfunc find () { local fl
if (eqobj(cob,out) && verbose) printf(" *Selected* ")
fl=fi($s1)
if (fl==-2) { return scr
} else if (fl==-3) { return ind
} else return cob.v[fl]
}
//** set("name",IND,VAL)
proc set () { local fl,ix,sel
sel=0
if (eqojt(cob,out)) { sel=1
if (verbose) printf("NQS set() WARNING: setting value in Selected db\n") }
if (argtype(1)==2) fl=fi($s1) else fl=$1
ix=$2
if (fl==-1) return
if (ix<0) ix=cob.v[fl].size+ix
// 2 LINE 'SET' MACRO
if (ix> cob.v[fl].size) { // nonexistent row
printf("%s set ERRA: col %s size %d<%d\n",this,s[fl].s,v[fl].size,ix) return
} else if (ix==cob.v[fl].size) { // single col expansion
if (sel) {printf("%s set() ERR: can't expand Selected db\n",this) return}
cob.v[fl].resize(ix+1)
}
if (argtype(3)==0) { cob.v[fl].x[ix]=$3
} else {
if (argtype(3)==1) oval=$o3 else if (argtype(3)==2) sval=$s3
cob.v[fl].x[ix]=newval(argtype(3),fl)
}
}
//** sets(IND,COLA,VAL[,COLB,VAL,...])
proc sets () { local fl,ix,i,sel,sz
sel=0 ix=$1
if (eqojt(cob,out)) { sel=1
if (verbose) printf("NQS set() WARNING: setting value in Selected db\n") }
if (ix>=cob.v.size){
printf("NQS sets ERRA: OOB %s: %d (size %d)\n",this,v[0].size,cob.v.size) return }
if (ix<0) ix=cob.v.size+ix
for i=2,numarg() {
if (argtype(i)==2) fl=fi($si) else fl=$i
if (fl==-1) return
i+=1
if (argtype(i)==0) { cob.v[fl].x[ix]=$i // shortcut
} else {
if (argtype(i)==1) oval=$oi else if (argtype(i)==2) sval=$si
cob.v[fl].x[ix]=newval(argtype(i),fl)
}
}
}
//** setcol("name",VEC)
// setcol(num,VEC)
// setcol(num,"name",VEC)
// setcol(num,"name",VEC,flag) // with flag==1 use pointer to vec instead of copying
proc setcol () { local fl,flag localobj vo
if (eqobj(cob,out) && verbose) {
printf("%s setcol() ERR: attempting to set column in Selected db\n",this)
return }
if (argtype(1)==2) fl=fi($s1) else fl=$1
if (fl==-1) return
if (v[fl].size!=0) { printf("%s setcol() ERR: clear() column before setting\n",this) return }
if (argtype(2)==2) s[fl].s=$s2 else { v[fl].copy($o2) return }
if (numarg()>=3) vo=$o3
if (numarg()>=4) flag=$4 else flag=0
if (flag) v[fl]=vo else v[fl].copy(vo)
}
//** setcols(VEC1,VEC2,...) -- does either pointer or copy depending on scpflag
// setcols(LIST) -- does either pointer or copy depending on scpflag
// see also resize("NAME",vec, ...) for similar functionality
scpflag=0
proc setcols () { local i,na,flag,sz
sz=na=numarg() flag=0
if (na==0) { scpflag=1-scpflag
if (scpflag) printf("setcols() will copy vecs\n") else {
printf("setcols() will use vec pointers\n") }
return
}
if (na==1 && isobj($o1,"List")) {flag=1 sz=$o1.count}
if (m==0) resize(sz)
if (eqobj(cob,out) && verbose) {
printf("%s setcols() ERR: attempting to set column in Selected db\n",this)
return }
if (na!=m) {
printf("%s setcols() ERR: need %d not %d args\n",this,m,na)
return }
if (flag) {
if (scpflag) for i=0,m-1 v[i].copy($o1.o(i)) else for i=0,m-1 v[i]=$o1.o(i)
} else if (scpflag) for i=1,m v[i-1].copy($oi) else for i=1,m v[i-1]=$oi
}
//** newval(typ,col#) -- check if a value is already on the list and if not put it there
// usuall preceded by eg:
// if (argtype(i)==0) nval=$i else if (argtype(i)==1) oval=$oi else if (argtype(i)==2) sval=$si
func newval () { local ret,typ,fl,ii localobj o
typ=$1 fl=$2
if (fcd.x[fl]!=typ && fcd.x[fl]!=-1) {
printf("nqs::newval() ERRa %d statt %d\n",typ,fcd.x[fl]) return ERR }
if (typ==0 || typ==-1) {
return nval
} else if (typ==1) { // object handling
if (! isassigned(oval)) return -1
if (isojt(oval,v)) { o=new Vector(oval.size) o.copy(oval)
} else if (isojt(oval,this)) { o=new NQS() o.cp(oval)
} else { printf("WARN: pointer to %s on %s fcdo\n",oval,this)
for (ii=0;ii<fcdo.count;ii+=1) if (eqojt(fcdo.object(ii),oval)) return ii // already on list?
o=oval
}
return fcdo.append(o)-1
} else if (typ==2) { // string handling
for (ii=0;ii<fcds.count;ii+=1) {
Xo=fcds.object(ii)
if (strcmp(Xo.s,sval)==0) return ii
}
return fcds.append(new String(sval))-1
}
}
//*** finval(col#,type,OP) find the location on list for an object or string
func finval () { local fl,typ,op,ii,ret
fl=$1 typ=$2 op=$3 ret=-1
if (fcd.x[fl]!=typ) { // doesn't handle fcd.x[]==-1
printf("nqs::finval ERRa type mismatch; %d %d\n",fcd.x[fl],typ) return ERR }
for ii=0,fcds.count-1 { Xo=fcds.object(ii)
if (typ==2) {
if (strcmp(Xo.s,sval)==0) return ii
} else {}
}
// if (ret==-1) printf("nqs::finval WARNING %s not found in string or object list\n",sval)
return ret
}
//*** rxpstr(col#,vec) find the location on list for an object
func rxpstr () { local fl
fl=$1 $o3.resize(0)
if (fcd.x[fl]!=2) {
printf("nqs::rxpstr ERRa type mismatch; %d %d\n",fcd.x[fl],2) return -1 }
for ii=0,fcds.count-1 if (strm(fcds.object(ii).s,$s2)) $o3.append(ii)
return $o3.size
}
//*** getval(col#,index) return type and value in nval,oval,sval as appropriate
// usually followed by eg
// if (typ==0) ... nval else if (typ==1) ... oval else if (typ==2) ... sval
func getval () { local typ,n,flag,fl,ix,ii
fl=$1 ix=$2 flag=0
typ=fcd.x[fl] // argtype
if (typ==0) {
nval=ix
} else if (typ==10) {
if (numarg()==3) nval=uncodf($3,ix) else {scr.resize(5) scr.uncode(ix)}
} else if (typ==1) { // object handling
if (ix>fcdo.count-1) {
printf("nqs::getval() ERR fcdo index OOB %d, %d\n",ix,fcdo.count) return ERR
} else if (ix<0) {
// printf("nqs::getval() WARNING empty obj ptr\n\t")
sval="nil"
typ=2
} else oval = fcdo.object(ix)
} else if (typ==2) { // string handling
if (ix==-1) {
sval="NULL"
} else if (ix<0 || ix>fcds.count-1) {
printf("nqs::getval() ERR index OOB %d, %d\n",ix,fcds.count) return ERR
} else sval=fcds.object(ix).s
} else if (typ==-1) { // string from external list
if (fcdl.count<=fl) {printf("%s getval ERRa\n",this) return -1}
if (! isobj(fcdl.object(fl),"List")) {printf("%s getval ERRb\n",this) return -1}
if (fcdl.object(fl).count<=ix) {printf("%s getval ERRc\n",this) return -1}
if (ix==-1) sval="XX" else {
if (!isobj(fcdl.object(fl).object(ix),"String")){printf("%s getval ERRd\n",this) return -1}
sval=fcdl.object(fl).object(ix).s
}
}
return typ
}
//*** useslist() connects a list of strings to fcdl to use when printing
// fcdl: list of lists to make it easy to attach lists from outside
proc useslist () { local fl,ii
if (argtype(1)==2) fl=fi($s1) else fl=$1
if (fl==-1) return
if (! isobj(fcdl,"List")) {fcdl=new List() out.fcdl=fcdl}
if (fcdl.count!=m) for ii=fcdl.count,m-1 fcdl.append(fcdl) // use fcdl as placeholder
fcdl.remove(fl) fcdl.insrt(fl,$o2) // replace:fcdl.object(fl)=$o2
fcd.x[fl]=-1
}
//*** unuselist() connects a list of strings to fcdl to use when printing
// fcdl: list of lists to make it easy to attach lists from outside
proc unuselist () { local fl,ii
if (argtype(1)==2) fl=fi($s1) else fl=$1
if (fl==-1) return
fcd.x[fl]=0
}
//*** listvecs([LIST]) put the vecs in the list for use with eg uncode()
func listvecs () { local ii,i,b localobj ol
if (eqobj(cob,out) && verbose) printf(" *Selected* ")
if (argtype(1)==1) {ol=$o1 b=2} else {ol=vl b=1}
if (!isassigned(ol)) { ol=new List()
if (argtype(1)==1) $o1=ol else vl=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.count
}
//*** 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}
if (ty==1) {lo=new Union(fcdo,cob.v[fl].x[ix]) if (numarg()==3) $o3=lo.o}
if (ty==2) {lo=new Union(fcds,cob.v[fl].x[ix]) if (numarg()==3) $s3=lo.s}
if (ty==-1){lo=new Union(fcdl.object(fl),cob.v[fl].x[ix]) if (numarg()==3) $o3=lo.o}
return lo
}
//** fetch(COLA,VAL,COLB) does fast select where COLA is VAL and returns value in COLB
// fetch(COLA,VAL) return the row number
// 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;ii<m;ii+=1) v0.append(cob.v[ii].x[i])
return cob.v[0].x[i]
}
} else {
st=new String("select(-1,")
for i=1,numarg()-1 {
if (argtype(i)==0) sprint(st.s,"%s%g,",st.s,$i) else sprint(st.s,"%s\"%s\",",st.s,$si)
}
chop(st.s) sprint(st.s,"%s)",st.s)
execute(st.s,this)
i=numarg()
if (argtype(i)==0) fl2=$i else fl2=fi($si)
if (ind.size!=1) printf("NQS fetch WARNING -- %d lines found\n",ind.size)
if (ind.size>0) return v[fl2].x[ind.x[0]] else return -1
}
}
//** stat("COL","operation")
// stat("COL",VEC) // save into a vector: max,min,mean,sdev
// stat(NQS) // save all of them into another NQS
proc stat () { local i,vn
if (eqobj(cob,out) && verbose) printf(" *Selected* ")
if (numarg()==0) {
for i=0,m-1 { printf("%s:\t",s[i].s) stat(i) } // recursive call
return
}
if (argtype(1)==1) {
$o1.resize(5)
$o1.sethdrs("NAME","MAX","MIN","MEAN","SDEV")
$o1.strdec("NAME")
$o1.clear
for i=0,m-1 {
stat(i,scr[1]) // recursive call
$o1.append(scr[1],1)
$o1.set(0,i,s[i].s)
}
return
}
if (argtype(1)==0) vn=$1 else vn=fi($s1)
i=2
if (cob.size(1)<2) { printf("NQS:stat small NQS: %d\n",cob.size(1)) ok=0 } else ok=1
if (vn==-2) {
sprint(sstr2,"%s",cob.scr)
} else if (vn<0||vn>=m) {
return
} else if (fcd.x[vn]==10) {
scr[1].resize(cob.v.size)
field=$i i+=1
cob.v[vn].uncode(scr[1],field)
sprint(sstr2,"%s",scr[1])
} else if (fcd.x[vn]==1) { // looking at a list of vectors
//if (oform(v)==NOP){printf("%s:stat ERR: set oform() to do stats on vectors or nqs\n",this)return}
scr[1].resize(0)
for ii=0,cob.v[vn].size-1 scr[1].append(oform(fcdo.o(cob.v[vn].x[ii])))
sprint(sstr2,"%s",scr[1])
} else {
sprint(sstr2,"%s",cob.v[vn])
}
if (numarg()<i) {
sprint(sstr, "printf(\"max=%%g; \",%s.max) ",sstr2)
sprint(sstr,"%s printf(\"min=%%g; \",%s.min) ",sstr,sstr2)
if (ok) sprint(sstr,"%s printf(\"mean=%%g; \",%s.mean) ",sstr,sstr2)
if (ok) sprint(sstr,"%s printf(\"stdev=%%g; \",%s.stdev) ",sstr,sstr2)
execute(sstr)
print ""
} else if (argtype(i)==1) { // a vector
$oi.resize(0)
if (ok) {$oi.append(cob.v[vn].max,cob.v[vn].min,cob.v[vn].mean,cob.v[vn].stdev)
} else {$oi.append(cob.v[vn].max,cob.v[vn].min,cob.v[vn].min,0) }
} else if (!ok) { return
} else for (;i<=numarg();i+=1) {
if (strm($si,"[(][)]$")) {
sfunc.left($si,sfunc.len($si)-2)
sprint(sstr,"printf(\"%s()=%%g; \",%s(%s))",$si,$si,sstr2)
} else sprint(sstr,"printf(\"%s=%%g; \",%s.%s)",$si,sstr2,$si)
execute(sstr)
print ""
}
}
//** iterator it() iterates over columns
// set's global tstr and XO to string bzw vec
iterator it () { local ii
i2=0
for ii=0,m-1 {
XO=cob.v[ii] execstr=s[ii].s
iterator_statement
i2+=1
}
}
//** iterator ot() creates names for each col (same as col header) and goes through them all
iterator ot () { local i,na,val
if (! isobj(otl,"List")) { // create list to execute
otl=new List()
for i=0,m-1 {
Xo=new String(s[i].s)
if (fcd.x[i]==2) {
varstr(Xo.s,1)
sprint(Xo.s,"%s=%s.fcds.object(%s.cob.v[%d].x[i2]).s",Xo.s,this,this,i)
} else {
varstr(Xo.s)
sprint(Xo.s,"%s=%s.cob.v[%d].x[i2]",Xo.s,this,i)
}
otl.append(Xo)
}
Xo=nil
}
for (i2=0;i2<cob.v[0].size;i2+=1) {
for i=0,m-1 execute(otl.object(i).s)
iterator_statement
}
}
//** iterator qt(&x1,NAME1,&x2,NAME2,...)
// qt(&x1,NAME1,&x2,NAME2,...,&x)
// qt(&x1,NAME1,&x2,NAME2,...,5,7,&x) // just from 5 to 7
// qt(&x1,NAME1,&x2,NAME2,...,8) // ending at 8
// note &x arg location is opposite to that for ltr
// eg for sp.qt(&x,"PRID",&y,"POID",&z,"NC1",&ii,"WID1",&jj,"WT1") print x,y,z,ii,jj
// NB set qtset if resetting values
iterator qt () { local a,i,j,ii,na,val,noset,min,max,cntr localobj cols,cd
na=numarg()
a=allocvecs(cols,cd)
min=0 max=size(1)-1
if (argtype(na)==3) {i=cntr=na $&i=0 na-=1} else cntr=-1
if (argtype(na-1)==0) { // 2 values for min and max
i=na-1 min=$i i=na max=$i na-=2
}
if (na/2!=int(na/2)) { // odd number
if (argtype(na)==0) { i=na max=$i na-=1
} else {printf("%s::qt() needs even # of args\n",this) return }
}
if (eqobj(cob,out) && verbose) printf(" *Selected* ")
//*** pick up column numbers
for (i=2;i<=na;i+=2) {
if (argtype(i)!=2) val=$i else val=fi($si)
cols.append(val) // cols has col #s
if (val<0 || val>=m) { if (argtype(i)==2) printf("(%s)",$si)
printf("%s::qt() ERR %d not found\n",this,val) return }
}
cd.copy(fcd) // cd gives codes for col's
//*** pick up the arguments
for (i=1;i<=na;i+=2) {
// can't do iteration over externally defined strings (eg -1) see useslist()
if (cols.x[int(i/2)]<0) continue
if (cd.x[cols.x[int(i/2)]]!=0) {
if (argtype(i)==3) {
printf("NQS::qt() WARNING using list index statt str for col %s\n",s[cols.x[int(i/2)]].s)
cd.set(cols.x[int(i/2)],0)
}
}
if (cd.x[cols.x[int(i/2)]]==2 && argtype(i)!=2) {
printf("%s::qt() ERR %s is strdec but arg %d not string\n",this,s[cols.x[int(i/2)]].s,i) return }
if (cd.x[cols.x[int(i/2)]]==1 && argtype(i)!=1) {
printf("%s::qt() ERR %s is odec but arg %d not obj\n",this,s[cols.x[int(i/2)]].s,i) return }
}
//*** iterate through setting local variables to values in NQS
for (ii=min;ii<=max;ii+=1) {
for (i=1;i<=na;i+=2) { j=cols.x[int(i/2)]
if (cd.x[j]==0) {
$&i=cob.v[j].x[ii]
} else if (cd.x[j]==2) {
$si=fcds.object(cob.v[j].x[ii]).s
} else if (cd.x[j]==1) {
$oi=fcdo.object(cob.v[j].x[ii])
} else {
printf("%s qt ERRA: %d %d\n",this,i,j)
continue
}
}
// for i=0,m-1 qtv.x[i]=v[i].x[ii] // if want these values need a separate vector
iterator_statement
//*** if qtset -> iterate through resetting NQS according to changed variables
if (qtset) for (i=1;i<=na;i+=2) { j=cols.x[int(i/2)]
if (cd.x[j]==0) {
cob.v[j].x[ii]=$&i
} else if (cd.x[j]==2) {
fcds.object(cob.v[j].x[ii]).s=$si
} else if (cd.x[j]==1) {
if (!eqojt(fcdo.object(cob.v[j].x[ii]),$oi)) {
printf("%s qt ERRB: can't reassign obj: %d %s %s\n",this,\
i,fcdo.object(cob.v[j].x[ii]),$oi)
}
}
}
if (cntr>-1) {i=cntr $&i+=1}
}
dealloc(a)
qtset=0 // turn back off
}
//** iterator ut(&x1,NAME1,&x2,NAME2,...)
// 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
listvecs()
sprint(tstr,"%s.nqsvt(\"%s\",%s,%s,%s,%s)",cols,$s1,fcdo,fcd,vl,ind)
execute(tstr)
dealloc(a)
}
//** calc() spread-sheet functionality using vector functions
// takes a compound expression utilizing column names in slant brackets <>
// anything quoted can use either ' or \"
// eg sp.calc("<DIST>.c.mul(DELD).add(DEL)")
proc calc () { local ii,vn,exec
if (numarg()==0) {
printf("eg calc(\"<SCR>.copy(<COL1>.c.mul(<COL2>).add(5))\") \ntakes a compound expression utilizing column names in slant brackets <>\nanything quoted can use either ' slash quote.\n")
return
} else sstr=$s1
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) {
if (oform(v)!=NOP) { // looking at a list of vectors
cob.scr.resize(0)
for ii=0,cob.v[vn].size-1 cob.scr.append(oform(fcdo.o(cob.v[vn].x[ii])))
cob.scr.sortindex(cob.ind)
} else {printf("NQS:sort ERR define oform to sort obj field %s\n",s[vn].s) return 0}
} 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;beg+=50) { // fewind() can only handle vecst.mod:VRRY vecs at a time
tmplist.remove_all
for (ii=beg;ii<beg+50 && ii<m;ii+=1) tmplist.append(cob.v[ii])
x=cob.scr.fewind(o,tmplist,1)
}
return x
}
//** percl ("FIELD",n %ile) check whether the first n% of the vector are in the top n %ile
// usage -- reverse sort according to 1 field and then ask if other field is in top n %ile
func percl () { local beg,ii,vn,nile,sz
if (eqobj(cob,out) && verbose) printf(" *Selected* ")
if (argtype(1)==0) vn=$1 else vn=fi($s1)
if (vn<0||vn>=m) return -1
sz=cob.v[vn].size
nile=int($2*sz/100)
scr[1].copy(cob.v[vn]) scr[1].sort() scr.resize(0) scr.copy(scr[1],sz-nile-1,sz-1)
scr.reverse() // the top n-ile percentile
scr[2].resize(0) scr[2].copy(cob.v[vn],0,nile) // the first set of values from NQS
// scr[1].insct(scr,scr[2]) // find all common values
for ii=0,scr[2].size-1 if (scr.contains(scr[2].x[ii])) return ii // which one is top of scr[2]
return -1
}
// family("COLA",val,"COLB","COLC")
// pick out rows that have are same as row with "COLA" val except that COLB COLC
// etc. can be anything
func family () { local a,i,ii,vn,va,nile,sz,om localobj key,arg
tog("DB") // start at full db
a=allocvecs(key,arg)
sz=size(1)
tmplist.remove_all arg.resize(0) key.resize(0)
if (select(-1,$s1,$2)!=1) printf("WARNING: NQS family found more than 1 %s=%g\n",$s1,$2)
va=fi($s1)
scr.resize(0) scr.append(va)
for i=3,numarg() scr.append(fi($si))
for i=0,m-1 if (! scr.contains(i)) {
tmplist.append(v[i])
key.append(EQU)
arg.append(v[i].x[ind.x[0]],0)
}
ind.resize(v.size)
ind.slct(key,arg,tmplist) // run select function
if (ind.size>0) {
out.ind.copy(ind)
aind()
cob=out
} else if (verbose) printf("None selected\n")
dealloc(a)
return ind.size
}
// psel(%ile,"COLA","COLB","COLC")
// psel("COLA",%ileA,"COLB",%ileB,"COLC",%ileC)
// neg %ile means bottom -- eg 10 is largest 10% and -10 is smallest 10%
// return top percentile in these columns
func psel () { local a,i,ii,vn,nile,sz,om localobj key,arg
tog("DB") // start at full db
a=allocvecs(key,arg)
om=numarg()-1
sz=size(1)
tmplist.remove_all arg.resize(0) key.resize(0)
if (argtype(1)==0) {
if (int($1*sz/100)==0) { printf("%s pselERR: unable %d%% of %d\n",this,$1,sz)
return -1 }
key.resize(om)
if ($1>0) {
nile=sz-int($1*sz/100)
key.fill(GTE)
} else {
nile=-int($1*sz/100)
key.fill(LTE)
}
for i=2,numarg() {
if (argtype(i)==0) vn=$i else vn=fi($si)
if (vn<0||vn>=m) return -1
tmplist.append(v[vn])
scr[1].copy(v[vn])
scr[1].sort()
arg.append(scr[1].x[nile],0) // 2nd arg for GTE ignored
printf("%s:%g ",$si,scr[1].x[nile])
}
} else for i=1,numarg() {
tstr=$si
vn=fi($si) i+=1
if (int($i*sz/100)==0) { printf("NQS psel(): WARNING: ignoring %d%% of %d\n",$i,sz)
continue }
if (vn<0||vn>=m) return -1
tmplist.append(v[vn])
scr[1].copy(v[vn])
scr[1].sort()
if ($i>0) {
nile=sz-int($i*sz/100)
key.append(GTE)
} else {
nile=-int($i*sz/100)
key.append(LTE)
}
arg.append(scr[1].x[nile],0) // 2nd arg for GTE ignored
printf("%s:%g ",tstr,scr[1].x[nile])
}
ind.resize(v.size)
ind.slct(key,arg,tmplist) // run select function
if (ind.size>0) {
out.ind.copy(ind)
aind()
cob=out
} else if (verbose) printf("None selected\n")
print ""
dealloc(a)
return ind.size
}
//** uniq(COLNAME) will pick out unique row (1st) for the chosen column
func uniq () { local vn
if (! eqobj(cob,out)) {printf("Only run NQS:uniq() on prior selected set.\n") return -1}
vn=sort($s1)
cob.ind.resize(cob.v.size)
cob.ind.redundout(cob.v[vn],1)
fewind()
return cob.ind.size
}
//** elimrepeats(COLA[,COLB,...])
func elimrepeats () { local a,b,i,ii,indflag localobj sl,tl,v1
if (eqobj(cob,out)) {printf("%s ERR: run elimrepeats on full db\n",this) return 0.}
if (size(1)==0) { printf("%s:elimirepeats Empty NQS\n",this) return 0.}
a=allocvecs(v1) b=1 indflag=0
sl=new List() tl=new List()
if (numarg()==0) {
for ii=0,m-1 { sl.append(v[ii]) v1.append(ii) }
b=numarg()+1
} else if (argtype(1)==0) if ($1==-1) {b=2 indflag=1}
for i=b,numarg() {
if (argtype(i)==0) ii=$i else if ((ii=fi($si))==-1) return 0
sl.append(v[ii])
v1.append(ii)
}
for ii=0,m-1 if (!v1.contains(ii)) tl.append(v[ii])
for (ii=v1.size-1;ii>=0;ii-=1) sort(v1.x[ii]) // sort them in the reverse order of calling
ii=ind.mredundout(sl,indflag,tl)
dealloc(a)
return ii
}
//** shuffle()
proc shuffle () { local a,b,i,ii,indflag localobj sl,tl,v1
if (eqobj(cob,out) && verbose) printf(" *Selected* ")
if (size(1)==0) { printf("%s:shuffle Empty NQS\n",this) return}
rdmord(ind,cob.v.size)
fewind()
}
//** fewind () -- index all of the vecs in place using vecst.mod::fewind()
proc fewind () {
cob.scr.resize(cob.v.size)
for (beg=0;beg<m;beg+=50) { // fewind() can only handle vecst.mod:VRRY vecs at a time
tmplist.remove_all
for (ii=beg;ii<beg+50 && ii<m;ii+=1) tmplist.append(cob.v[ii])
cob.scr.fewind(cob.ind,tmplist)
}
cob.ind.resize(0) // prevents reusing it
}
//** aind () -- index all of the vecs into out list
proc aind () { local beg,ii
for (beg=0;beg<m;beg+=10) {
tmplist.remove_all vlist.remove_all
for ii=beg,beg+10 if (ii<m) {
out.v[ii].resize(ind.size)
tmplist.append(v[ii])
vlist.append(out.v[ii])
}
ind.findx(tmplist,vlist)
}
}
//** append(VEC[,begin]) appends to ends of given vectors
// append(x1,x2,...); append(NQS)
proc append () { local ii,jj,i,flag,begin,o1fcd localobj xo
cob=this
if (m==0) { printf("%s append ERR0, attempted append to uninitialized NQS\n",this) return }
if (argtype(1)==1 && fcd.x[0]!=1) {
if (isobj($o1,"Vector")) { // a vector of values
if (numarg()>1) begin=$2 else begin=0
if (begin+$o1.size>m) {
printf("%s append ERR1: vec %s too large; doing nothing: %d>%d",this,$o1,begin+$o1.size,m)
} else {
for i=begin,begin+$o1.size-1 v[i].append($o1.x[i-begin])
}
} else if (isobj($o1,"NQS")) { // another NQS to add onto end
if ($o1.m != m) {
printf("%s append ERR1a, %s size %d!= %s size %d?\n",this,this,m,$o1,$o1.m)
return }
for ii=0,m-1 {
o1fcd=$o1.fcd.x[ii]
if (o1fcd==0) { v[ii].append($o1.cob.v[ii])
} else for jj=0,$o1.size(1)-1 {
xo=$o1.get(ii,jj)
if (o1fcd==1) oval=xo.o else sval=xo.s
v[ii].append(newval(o1fcd,ii))
}
}
} else { printf("%s append ERR1b, what is %s?\n",this,$o1) }
return
}
if (argtype(1)==2) if ((ii=fi($s1,"NOERR"))!=-1) { // a field name
for i=1,numarg() {
if ((ii=fi($si))==-1) return
i+=1
if (argtype(i)==0) {
v[ii].append($i)
} else {
if (argtype(i)==1) oval=$oi else if (argtype(i)==2) sval=$si
v[ii].append(newval(argtype(i),ii))
}
}
return
}
if (numarg()>m) { printf("%s append ERR2: args>m; doing nothing\n",this) return }
if (numarg()<=m) {
if (numarg()<m) printf("NQS::append() WARNING only filling %d/%d cols for %s\n\tuse NQS.pad",numarg(),m,this)
for ii=0,numarg()-1 {
i=ii+1
if (argtype(i)==0) {
v[ii].append($i)
} else {
if (argtype(i)==1) oval=$oi else if (argtype(i)==2) sval=$si
v[ii].append(newval(argtype(i),ii))
}
}
return
}
}
//** appi(index,VEC) or append(index,x1,x2,...) appends to ends of vectors starting at index
proc appi () { local i,ix,n
cob=this
if (argtype(1)==2) ix=fi($s1) else ix=$1
if (numarg()==2 && argtype(2)==1 && fcd.x[ix]==0) { // a vector
if ($o2.size>m-ix) {
printf("%s appi ERR1: vec too large; doing nothing %d %d %d %d\n",this,m,$o2.size,ix,m-ix)
} else {
n=-1
for i=ix,ix+$o2.size-1 v[i].append($o2.x[n+=1])
}
} else {
if (numarg()-1>m-ix) {
printf("%s appi ERR2: args>m; doing nothing",this)
return
}
for i=2,numarg() {
if (argtype(i)==0) {
v[ix+i-2].append($i)
} else {
if (argtype(i)==1) oval=$oi else if (argtype(i)==2) sval=$si
v[ix+i-2].append(newval(argtype(i),ix+i-2))
}
}
}
}
//** map(FUNC,arg1,...) map $s1 command to other args, replacing strings with vectors as found
// eg nqs.map("gg",0,"volt","cai",2)
proc map () { local i,agt,wf
if (numarg()==0) {
printf("map(FUNC,arg1,...) apply function to args using names for columns.\n")
return }
if (eqobj(cob,out) && verbose) printf(" *Selected* ")
sprint(sstr,"%s(",$s1) // the command
wf=0
for i=2,numarg() { // the args
agt=argtype(i)
if (agt==0) {
sprint(sstr,"%s%g,",sstr,$i)
} else if (agt==1) {
sprint(sstr,"%s%s,",sstr,$oi)
} else if (agt==2) {
if ((vn=fi($si))==-1) {
sprint(sstr,"%s\"%s\",",sstr,$si)
printf("NQS.map WARNING: including raw string: %s\n",$si) wf=1
} else if (fcd.x[vn]==1 && oform(v)!=NOP) { // look at a list of vectors
cob.scr.resize(0)
for ii=0,cob.v[vn].size-1 cob.scr.append(oform(fcdo.o(cob.v[vn].x[ii])))
sprint(sstr,"%s%s,",sstr,cob.scr)
} else if (vn==-2) { // code for scr vector
sprint(sstr,"%s%s,",sstr,cob.scr)
} else {
sprint(sstr,"%s%s,",sstr,cob.v[vn])
}
} else { printf("argtype %d for arg %d not implemented for NQS:map\n",agt,i) return }
}
chop(sstr) sprint(sstr,"%s)",sstr)
if (wf && !batch_flag) if (boolean_dialog(sstr,"CANCEL","EXECUTE")) return
execute(sstr)
}
//*** gr() use map to graph
// need to assign .crosshair_action so can do visual select procedure
proc gr () { local i,nm,gn,col,lne,f3d,y,x,done localobj symb
nm=numarg() gn=0 f3d=-1
col=2 lne=4
done=0
if (sfunc.len(marksym)==0) marksym="o"
if (nm==0) { print "gr(\"Y\"[,\"X\",Z,g#,col,line])" return
} else if (nm==1) { map("gg",0,$s1,1,col,lne) done=1
} else if (nm==2 && 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)
func pr () { local ii,i,min,max,na,flag,jj,e,fout,sz,nohdr
if (eqobj(cob,out) && verbose) printf(" *Selected* ")
if (m==0) {printf("%s EMPTY",this) return 0}
nohdr=flag=min=0 max=cob.v.size-1 na=numarg()
if (na>=2) {
if (argtype(na-1)==0) {
i=na na-=2
max=$i i-=1 min=$i
flag=1 // took care of numbers
}}
if (!flag && na>=1) {
if (argtype(na)==0) {
i=na na-=1
if ($i>=0) max=$i else min=max+$i // allow printing the end
}
}
// reuse flag -- means printing only certain cols
fout=flag=0 i=1 // fout==1 means print out to file
if (argtype(1)==1) { flag=1 // column indices in a vector
} else if (argtype(1)==2) {
if (fi($s1,"NOERR")!=-1) { flag=1 // a column identifier
} else if (strm($s1,"[<>]")) { flag=2 i+=1 // something to calculate
} else { // assume it's 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 (argtype(i)==2) if (strcmp($si,"NOHEADER")==0) {nohdr=1 i+=1}
if (argtype(i)==1 || argtype(i)==2) flag=1
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==1) {
scr[1].resize(0)
if (argtype(i)==1) scr[1].copy($oi) else for (;i<=na;i+=1) scr[1].append(fi($si))
sz=scr[1].size-1
if (!nohdr) { for i=0,sz {
ii=scr[1].x[i]
if (ii==-1) return -1
if (fout) {
if (ii<0) tmpfile.printf("%s\t",is[-ii].s) else tmpfile.printf("%s(%d)\t",s[ii].s,ii)
} else {
if (ii<0) printf("%s\t",is[-ii].s) else printf("%s(%d)\t",s[ii].s,ii)
}
} if (fout) tmpfile.printf("\n") else printf("\n") }
for jj=min,max {
for i=0,sz { ii=scr[1].x[i]
if (ii==-2) { printf(dblform,cob.scr.x[jj])
} else if (ii==-3) {
if (fout) tmpfile.printf(dblform,cob.ind.x[jj]) else printf(dblform,cob.ind.x[jj])
} else {
if (fout) { prtval(tmpfile,(e=getval(ii,cob.v[ii].x[jj])),tabform)
} else if (sz) { prtval( (e=getval(ii,cob.v[ii].x[jj])),tabform)
} else { prtval( (e=getval(ii,cob.v[ii].x[jj])),tabform) }
if (e==ERR) return ERR
}
}
if (fout) tmpfile.printf("\n") else if (sz) print "" else printf(" ")
}
} else if (flag==2) {
calc($s1,"NOEXEC")
sprint(sstr,"XO=%s",sstr)
execute(sstr)
vlk(XO,min,max)
} else {
if (!nohdr) {
if (fout) for ii=0,m-1 tmpfile.printf("%4.4s(%d) ",s[ii].s,ii) else {
for ii=0,m-1 printf("%4.4s(%d) ",s[ii].s,ii) }
if (fout) tmpfile.printf("\n") else print ""
}
for jj=min,max {
for ii=0,m-1 {
if (fout) prtval(tmpfile,e=getval(ii,cob.v[ii].x[jj]),tabform) else {
prtval( e=getval(ii,cob.v[ii].x[jj]),"")
printf("(%d)%s",ii,tabform)
}
if (e==ERR) return ERR
}
if (fout) tmpfile.printf("\n") else print ""
}
}
if (fout) tmpfile.close
return max-min+1
}
//** prs() print out vectors
// eg prs("COLA","COLB",3,7)
func prs () { local ii,i,min,max,na,flag,jj,kk,e,fout,sz,nohdr
if (eqobj(cob,out)) printf("NQS WARNING: prs() called after full select(); switching\n")
cob=this
if (m==0) {printf("%s EMPTY",this) return 0}
nohdr=flag=min=0 max=ind.size-1 na=numarg()
if (na>=2) {
if (argtype(na-1)==0) {
i=na na-=2
max=$i i-=1 min=$i
flag=1 // took care of numbers
}}
if (!flag && na>=1) {
if (argtype(na)==0) {
i=na na-=1
if ($i>=0) max=$i else min=max+$i // allow printing the end
}
}
// reuse flag -- means printing only certain cols
fout=flag=0 i=1 // fout==1 means print out to file
if (na>=1) if (argtype(1)==2) if (fi($s1,"NOERR")==-1) { // call it a file name
if (!tmpfile.wopen($s1)) printf("%s:Can't open %s for printing\n",this,$s1)
fout=1 i+=1
printf("==== WARNING: printing ascii to file %s ====\n",$s1)
if (numarg()==2) if (argtype(2)==2) if (strcmp($s2,"NOHEADER")==0) {nohdr=1 i+=1}
}
if (na>=i) if (argtype(i)==2 || argtype(i)==1) flag=1 // column names
if (max>ind.size()){ max=ind.size()-1
printf("NQS:prs WARNING: %d rows requested but %s size=%d\n",max,this,ind.size()) }
if (min>size(1)){printf("NQS:prs ERROR: %s size=%d < min %d\n",this,size(1),min) return 0}
if (!fout) print ""
if (flag) {
scr[1].resize(0)
if (argtype(i)==1) scr[1].copy($oi) else for (;i<=na;i+=1) scr[1].append(fi($si))
sz=scr[1].size-1
if (!nohdr) { for i=0,sz {
ii=scr[1].x[i]
if (ii==-1) return -1
if (fout) {
if (ii<0) tmpfile.printf("%s\t",is[-ii].s) else tmpfile.printf("%s(%d)\t",s[ii].s,ii)
} else {
if (ii<0) printf("%s\t",is[-ii].s) else printf("%s(%d)\t",s[ii].s,ii)
}
} if (fout) tmpfile.printf("\n") else printf("\n") }
for kk=min,max { jj=ind.x[kk]
for i=0,sz { ii=scr[1].x[i]
if (ii==-2) { printf(dblform,cob.scr.x[jj])
} else if (ii==-3) {
if (fout) tmpfile.printf(dblform,cob.ind.x[jj]) else printf(dblform,cob.ind.x[jj])
} else {
if (fout) { prtval(tmpfile,(e=getval(ii,cob.v[ii].x[jj])),tabform)
} else if (sz) { prtval( (e=getval(ii,cob.v[ii].x[jj])),tabform)
} else { prtval( (e=getval(ii,cob.v[ii].x[jj])),tabform) }
if (e==ERR) return ERR
}
}
if (fout) tmpfile.printf("\n") else if (sz) print "" else printf(" ")
}
} else {
if (!nohdr) {
if (fout) for ii=0,m-1 tmpfile.printf("%4.4s(%d) ",s[ii].s,ii) else {
for ii=0,m-1 printf("%4.4s(%d) ",s[ii].s,ii) }
if (fout) tmpfile.printf("\n") else print ""
}
for kk=min,max { jj=ind.x[kk]
for ii=0,m-1 {
if (fout) prtval(tmpfile,e=getval(ii,cob.v[ii].x[jj]),tabform) else {
prtval( e=getval(ii,cob.v[ii].x[jj]),"")
printf("(%d)%s",ii,tabform)
}
if (e==ERR) return ERR
}
if (fout) tmpfile.printf("\n") else print ""
}
}
if (fout) tmpfile.close
return max-min+1
}
//** prn() print out single index from vectors
proc prn () { local jj,ii,ix,max,e
ix=$1
if (eqobj(cob,out) && verbose) printf(" *Selected* ")
if (numarg()==2) max=$2 else max=ix
for jj=ix,max {
if (jj<0 || jj>=cob.v[0].size) {
printf("prn: Index out of range (%d)\n",cob.v[0].size) return }
for ii=0,m-1 {
printf("%s:",s[ii].s)
prtval(e=getval(ii,cob.v[ii].x[jj])," ")
if (e==ERR) return
}
print ""
}
}
//** zvec() -- clear -- resize all the vectors to 0
proc clear () { if (numarg()==1) zvec($1) else zvec() }
proc zvec () { local ii
cob=this
// fcds.remove_all fcds.append(new String("`EMPTY'"))
if (isassigned(fcdo)) fcdo.remove_all
for ii=0,m-1 {
if (numarg()==1) { v[ii].resize($1) v[ii].fill(0) }// resize the buffer if desirable
v[ii].resize(0)
}
}
//** pad() -- bring all vectors up to same length (of v[0])
func pad () { local sz,ii
cob=this
sz=-1
if (numarg()==1) sz=$1 else for ii=0,m-1 if (v[ii].size>sz) sz=v[ii].size
for ii=0,m-1 {
// if (v[ii].size>sz) printf("NQS.pad WARNING: neg padding %d\n",ii)
v[ii].resize(sz)
}
return sz
}
//** size() -- return num of vectors and size of each vector
func size () { local ii,sz,fl
if (eqobj(cob,out) && verbose) printf(" *Selected* ")
if (m==0) { print "0 x 0" return 0 } // empty
sz=cob.v.size
fl=0
for ii=1,m-1 if (cob.v[ii].size!=sz) fl=ii
if (numarg()==1) { // with 1 arg don't print anything
if (fl) {
printf("%s size ERR: cols are not same length: %s:%d %d\n",this,s[fl].s,cob.v[fl].size,sz)
sz=-1 } // generate err
return sz
}
printf("%d cols x %d rows",m,cob.v.size)
if (fl) for ii=1,m-1 printf(",%d",cob.v[ii].size)
print ""
return cob.v.size
}
//** resize(#cols[,#rows]) -- augment or dec the number of vectors
// resize("LABEL1","LABEL2",...)
// resize("LABEL1",VEC1,"LABEL2",VEC2) ... put on some vecs of same size
// resize("COL1","COL2"...) if these col names already exist just make a new copy of col
// resize(NQS) -- a horizontal 'append'
func resize () { local oldsz,newsz,i,ii,jj,vsz,na,appfl,o1m,padfl
cob=this padfl=0
na=numarg()
vsz=-1
if (argtype(na)==2) { i=na
if (strcmp($si,"PAD")==0) { padfl=1 na-=1 }
}
if (na==1) {
if (argtype(1)==0) {
appfl=0
if ($1<0) newsz=m+$1 else newsz=$1
} else if (argtype(1)==2) {
newsz=m+1 appfl=2
} else if (argtype(1)==1) { // an NQS
if (size(1)!=$o1.size(1)) {
printf("NQS resize(NQS) warning: rows differ %d %d\n",size(1),$o1.size(1))}
o1m=$o1.m
newsz=m+o1m
appfl=3
}
} else {
if (argtype(1)==0 && argtype(2)==0) {
newsz=$1 appfl=0
vsz=$2
} else if (argtype(1)==2 && argtype(2)==2) {
newsz=m+na appfl=2
} else {
if (int(na/2)!=na/2) { printf("%s Resize ERR: require even # of args",this) return -1}
newsz=m+numarg()/2
appfl=1
}
}
oldsz=m
if (m==newsz) { printf("No resize -- same size: %s\n",this)
return m
} else if (newsz>m) {
tmplist.remove_all vlist.remove_all
for ii=0,m-1 {
tmplist.append(v[ii]) tmplist.append(s[ii])
tmplist.append(out.v[ii])
}
objref v[newsz],s[newsz]
if (isassigned(out)) out.resize2(newsz) // create vectors for .out
jj=-1
for ii=0,m-1 {
v[ii]=tmplist.object(jj+=1) out.s[ii]=s[ii]=tmplist.object(jj+=1)
out.v[ii]=tmplist.object(jj+=1)
}
for ii=m,newsz-1 {
v[ii]=new Vector() out.s[ii]=s[ii]=new String()
out.v[ii]=new Vector()
}
out.m=m=newsz
tmplist.remove_all
} else {
for (ii=m-1;ii>=newsz;ii-=1) { out.v[ii]=v[ii]=nil out.s[ii]=s[ii]=nil }
out.m=m=newsz
}
x.resize(m) x.fill(0) fcd.resize(m)
out.x.resize(m) out.x.fill(0) out.fcd=fcd
if (vsz>=1) for ii=0,m-1 v[ii].resize(vsz)
if (appfl==1) { // append
for (ii=1;ii<=na;ii+=2) { i=ii
if (argtype(i)!=2) { printf("%s RESIZE ERR: arg %d should be str\n",this,i) return -1}
s[oldsz+(ii-1)/2].s=$si i+=1
if (argtype(i)==0) {
if ($i>0) v[oldsz+(ii-1)/2].resize($i)
} else if (argtype(i)==1) {
v[oldsz+(ii-1)/2].copy($oi)
} else { printf("%s RESIZE ERR2: arg %d should be num or obj\n",this,i) return -1}
}
} else if (appfl==2) {
for (i=1;i<=na;i+=1) {
if (argtype(i)!=2) { printf("%s RESIZE ERR3: arg %d should be str\n",this,i) return -1}
tstr=$si
if ((jj=fi(tstr,"EXACT"))!=-1) {
while (fi(tstr,"EXACT")!=-1) sprint(tstr,"%s0",tstr) // find unique name
}
s[oldsz+i-1].s=tstr
if (jj>=0) { printf("Resize copying Col %s to %s\n",$si,tstr) v[oldsz+i-1].copy(v[jj]) }
}
} else if (appfl==3) {
for i=0,o1m-1 {
tstr=$o1.s[i].s
while (fi(tstr,"NOERR")!=-1) sprint(tstr,"%s0",tstr)
s[oldsz+i].s=tstr
v[oldsz+i].copy($o1.v[i])
}
}
chk()
if (padfl) pad()
cob=this
return m
}
// for resizing the vector for .out
proc resize2 () { local newsz
newsz=$1
objref v[newsz],s[newsz]
}
// grow(NQS) append NQS of same size to this one
func grow () { local ii
if (m==0) { cp($o1)
} else if (m!=$o1.m) { printf("%s,%s off different size: %d %d\n",this,$o1,m,$o1.m) return 0
} else if (eqobj(cob,out)) {printf("%s ERR: run grow on full db\n",this) return 0.
} else for ii=0,m-1 v[ii].append($o1.v[ii])
return v.size
}
//** keepcols("LABEL1",...)
func keepcols () { local i,fl
scr.resize(0)
for i=1,numarg() {
if (argtype(i)==2) {
if ((fl=fi($si))==-1) return -1
} else fl=$i
scr.append(fl)
}
for (i=m-1;i>=0;i-=1) if (! scr.contains(i)) delcol(i)
return m
}
//** delcol("LABEL1"[,"LABEL2",...])
func delcol () { local ii,i,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<m-1;ii+=1) {
v[ii]=v[ii+1] s[ii]=s[ii+1]
out.s[ii]=s[ii+1]
}
v[m-1]=nil s[m-1]=nil
out.v[m-1]=nil out.s[m-1]=nil
x.remove(fl) fcd.remove(fl)
if (isobj(fcdl,"List")) fcdl.remove(fl)
m -= 1
}
out.m=m
dealloc(a)
return m
}
//** delrow(#)
func delrow () { local ii,jj,kk
if (numarg()==1) {
if (eqobj(cob,out) && verbose) printf(" *Selected* ")
kk=$1
if (kk<0 || kk>=cob.v.size) {printf("delrow %d OOR (%d)\n",kk,cob.v.size-1) return -1}
for ii=0,m-1 cob.v[ii].remove(kk)
} else { // remove selected
tog("DB")
if (ind.size>1) {
sprint(sstr,"Remove %d rows from main table?",ind.size)
if (!boolean_dialog(sstr,"OK","Cancel")) { print "Cancelled" return -1 }
}
for ii=0,m-1 for (jj=ind.size-1;jj>=0;jj-=1) { kk=ind.x[jj]
v[ii].remove(kk)
}
}
return v.size
}
//** getrow(#,VEC)
obfunc getrow () { local ii localobj v1
if (eqobj(cob,out) && verbose) printf(" *Selected* ")
if (numarg()==2) v1=$o2 else v1=new Vector()
v1.resize(0)
for (ii=0;ii<m;ii+=1) v1.append(cob.v[ii].x[$1])
return v1
}
//** getcol("name") getcol("name",1) returns pointer
// getcol("name"[,VEC]) copies to VEC
// getcol("name",0) -- copies to new vector and returns it
obfunc getcol () { local a,fl,ii localobj v1,vo
if (eqobj(cob,out) && verbose) printf(" *Selected* ")
if (argtype(1)==2) fl=fi($s1) else fl=$1
if (fl==-1) return nil
v1=vo=cob.v[fl] // default returns pointer
if (fcd.x[fl]==1) {
if (oform(v)==NOP) {printf("NQS getcol Warning: returning indices for an object field\n")
} else {
v1=new Vector(vo.size)
for ii=0,vo.size-1 v1.x[ii]=oform(fcdo.o(vo.x[ii]))
if (argtype(2)==1) {$o2.copy(v1) v1=$o2}
}
} else if (argtype(2)==0) {
if ($2==0) v1=vo.c
} else if (argtype(2)==1) { // copy into a preexisting vector
v1=$o2
v1.copy(vo)
}
return v1
}
//** getsel("name"[,vec]) returns the select(-1,...) values
obfunc getsel () { local ii,fl localobj v1
if (eqobj(cob,out)) printf("NQS WARNING: getsel() called after full select()\n")
if (argtype(1)==2) fl=fi($s1) else fl=$1
if (fl==-1) return v1
if (numarg()<2) v1=new Vector(ind.size) else {v1=$o2 v1.resize(ind.size)}
for ii=0,ind.size-1 v1.x[ii]=v[fl].x[ind.x[ii]]
return v1
}
//** renamecol("LABEL1","NEWNAME") -- rename column
func renamecol () { local oldsz
if (argtype(1)==2) {
if ((fl=fi($s1))==-1) return 1
} else fl=$1
s[fl].s=$s2
out.s[fl].s=$s2
return 1
}
//** renamecols("LABEL1","LABEL2"...) -- rename all column
proc renamecols () { local oldsz,i
if (numarg()<m) printf("Renaming only %d/%d cols\n",numarg(),m)
for i=1,numarg() s[i-1].s=$si
}
//** sv(FNAME[,APPEND]) save the NQS
// to sv selected -- NQS.select(...) NQS.cp(NQS.out,1) NQS.sv()
proc sv () { local i,j,cd1,vers,a,aflag
aflag=cd1=0 // flags cd1=1 -- no single value vec compression;
if (eqobj(cob,out) && verbose) printf("==== WARNING: Saving selected only ====\n")
a=allocvecs(1)
if (numarg()>0) file=$s1 else aflag=2
if (numarg()>=2) aflag=$2
if (numarg()>=3) cd1=$3 // 1:flag for not compressing
if (aflag==2) { // will just continue saving in the current file
} else if (aflag==1) { tmpfile.aopen(file)
} else {
if (tmpfile.ropen(file)) {
if (batch_flag) {
printf("NQS sv WARNING overwriting %s\n",file)
} else if (!boolean_dialog("File exists","Overwrite","Cancel")) {
print "Cancelled" return
}
}
if (! tmpfile.wopen(file)) { printf("%s: can't open file\n",this) return }
}
mso[a].resize(m) mso[a].fill(0)
// will be saved without full vectors
if (cd1==0) for i=0,m-1 if (cob.v[i].ismono(0) && cob.v[i].size>10) {
cd1=2 // 2 flag for using compression
mso[a].x[i]=1
}
if (isassigned(fcdo)) foc=fcdo.count else foc=-1
vers=version(1) // will assist for identifying file type if change format in future
savenums(m,fcds.count,(cnt=fcd.count(-1)),foc,size(1),cd1,vers,0,0) // extra for codes
wrvstr(file) wrvstr(comment)
for i=0,m-1 wrvstr(s[i].s)
fcd.vwrite(tmpfile)
for i=0,fcds.count-1 wrvstr(fcds.object(i).s)
for i=0,foc-1 {
if (isojt(fcdo.object(i),v)) {
fspitchar(1,tmpfile) // 1 for vector
fcdo.o(i).vwrite(tmpfile)
} else if (isojt(fcdo.object(i),this)) {
fspitchar(2,tmpfile) // 2 for NQS
fcdo.o(i).sv()
} else {
printf("NQS:sv() WARNING: Can't save obj %s for %s\n",fcdo.o(i),this)
fspitchar(0,tmpfile) // 0 for nil
}
}
if (cnt>0) for i=0,fcd.size-1 if (fcd.x[i]==-1) {
savenums(fcdl.object(i).count)
for j=0,fcdl.object(i).count-1 wrvstr(fcdl.object(i).object(j).s)
}
for i=0,m-1 {
if (cd1==2 && mso[a].x[i]==1) {
savenums(-1e9,cob.v[i].size,cob.v[i].x[0])
} else if (fcd.x[i]==10) {
cob.v[i].vwrite(tmpfile,4) // must save CODE fully
} else {
cob.v[i].vwrite(tmpfile,svsetting)
}
}
x.vwrite(tmpfile)
if (! aflag==2) tmpfile.close
dealloc(a)
}
//** rd(FNAME[,FLAG]) read format saved by sv()
// flag==2 - only read header
func rd () { local n,hflag,cd1,cd3,cd4,ii,oco
hflag=0 cob=this
if (numarg()>=1) if (argtype(1)==2) {
if (!tmpfile.ropen($s1)) { printf("%s: can't open file %s\n",this,$s1) return 0 }
} // else continue reading from current point in file
if (numarg()>=2) hflag=$2 // only read header
cnt=fc=foc=0
// backward compatible -- if only 2 vals then cnt=0, cd1-4 unused at present
n=readnums(&ii,&fc,&cnt,&foc,&v0sz,&cd1,&svvers,&cd3,&cd4)
if (n<9) v0sz=cd1=svvers=cd3=cd4=-1
if (cd1==2 && hflag==1) printf("NQSrdWARN0: can't do partial reads on compressed: %s\n",$s1)
if (ii!=m) resize(ii)
rdvstr(file) rdvstr(comment)
if (sfunc.len(file)==0 && numarg()>0) file=$s1
for i=0,m-1 rdvstr(s[i].s)
fcd.vread(tmpfile)
fcds.remove_all
if (isassigned(fcdl)) fcdl.remove_all
for i=0,fc-1 { fcds.append(Xo=new String()) rdvstr(Xo.s) }
if (foc>=0) { fcdo=new List() out.fcdo=fcdo }
for i=0,foc-1 {
oco=fgchar(tmpfile)
if (oco==1) {
fcdo.append(Xo=new Vector())
Xo.vread(tmpfile)
} else if (oco==2) {
fcdo.append(Xo=new NQS())
Xo.rd()
} else if (oco==0) {
printf("NQS:rd() WARNING: Nil being read for %s\n",this)
} else {
printf("NQS:rd() ERROR: unrecognized char %d for %s\n",oco,this)
}
}
if (cnt>0) for i=0,fcd.size-1 if (fcd.x[i]==-1) {
readnums(&cnt)
Yo=new List()
for j=0,cnt-1 {Xo=new String() Yo.append(Xo) rdvstr(Xo.s)}
useslist(i,Yo)
}
if (hflag==1) { // v0sz will tell size of all vectors
tell=tmpfile.tell
tmpfile.seek(0,2)
tellend=tmpfile.tell()
if (v0sz==-1) printf("%s: rd header: can't do seeks since v's not same size:%s\n",this,file)
return v0sz
} else {
v0sz=-1 // indicates that everything has been read in
for i=0,m-1 {
v[i].vread(tmpfile)
if (v[i].size>2) if (v[i].x[0]==-1e9) {
ii=v[i].x[2]
v[i].resize(v[i].x[1])
v[i].fill(ii)
}
}
x.vread(tmpfile)
}
if (foc==0) for ii=0,fcd.size-1 if (fcd.x[ii]==1) v[ii].fill(-1) // clear obj pointers
out.cp(this,0) // leave vectors empty
chk()
return 1
}
//** rdpiece() read a section of each vector
func rdpiece () { local ii,ix,end,jump,loc,bswap
ix=$1
if (numarg()>=2) bswap=$2 else bswap=0
tmpfile.seek(tell+8) // start of first one
if (ix<0) {printf("%s:rdpiece ERR: no room: neg index\n",this) return 0}
if (ix*chunk>v0sz) return 0
if ((ix+1)*chunk>v0sz) end=v0sz-ix*chunk else end=chunk
for ii=0,m-1 {
loc=tell+8+ii*(v0sz*4+8)+ix*4*chunk
tmpfile.seek(loc)
if (loc+end*4>tellend){printf("%s:rdpiece ERRA: ran out: %d %d",this,loc+end,tellend) return 0}
v[ii].fread2(tmpfile,end,3+bswap)
}
return 1
}
//** func rdcols()
// reads columns of ascii with optional labels at the top
func rdcols () { local i,ii,cols,li,errflag,num,hflag
errflag=0
if (! tmpfile.ropen($s1)) { printf("\trdcols ERR0: can't open file \"%s\"\n",$s1) return 0}
if (fcd.count(2)+fcd.count(0)!=m) {printf("\trdcols ERRA: only rd strs and dbls\n") return 0}
if (tmpfile.scanstr(sstr)==-1) {printf("\trdcols ERR1: file \"%s\"\n",$s1) return 0}
if (isnum(sstr)) hflag=0 else hflag=1 // hflag=0 -> no header
if (numarg()>1) { // names of columns
resize(numarg()-1)
for i=2,numarg() sethdrs(i-2,$si)
if (hflag) {
printf("Header in file %s: %s vs %s\n",$s1,sstr,s[0].s)
hflag=2
}
} else if (!hflag) printf("No Header for %s\n",$s1)
cols=0
if (hflag==1) {
while (! isnum(sstr)) {
cols+=1 tmpfile.scanstr(sstr)
resize(sstr)
}
} else {
cols=fcd.count(0) // assume that NQS was set up ahead
resize(cols)
}
li=file_len($s1)
if (hflag) li-=1
printf("%d cols; %d lines of data in %s.\n",cols,li,$s1)
tmpfile.ropen($s1)
if (hflag) tmpfile.gets(sstr) // remove first line
// WARN: this will screw up if numbers are to be included as strings
num=scr.scanf(tmpfile,li*cols) // note that this will skip over non-nums
if (num!=li*cols) { // err not reached since scanf dumps out
printf("WARNING: expected %d vals; found %d\n",li*cols,num) errflag=3 }
if (tmpfile.scanstr(sstr)>-1) {
printf("WARNING: %s found after reading in %d vals\n",sstr,li*cols) errflag=4 }
tmpfile.seek(0)
for ii=0,cols-1 {
if (fcd.x[ii]>0) continue
if (hflag==1) tmpfile.scanstr(s[ii].s)
v[ii].resize(li)
v[ii].copy(scr,0,ii,li*cols-1,1,cols) // v[ii].mcol(scr,ii,cols)
}
if (fcd.count(0)!=m) { // need to pick up some strings
tmpfile.seek(0)
if (hflag==1) tmpfile.gets(tstr) // throw away
}
if (errflag) { printf("rdcols ERR%d\n",errflag) return 0 }
return cols
}
//** func svR([filename])
// saves in a format that can be read by my rdnqs.R program
func svR () { local ii,jj,cols,li,errflag,num
errflag=0
if (eqobj(cob,out) && verbose) printf(" *Selected* ")
if (numarg()==1) sstr=$s1 else {
sstr=file
repl_mstr(sstr,"\.nqs$",".nqR")
}
if (tmpfile.ropen(sstr)) if (!boolean_dialog("File exists","Overwrite","Cancel")) {
print "Cancelled" return 0 }
if (! tmpfile.wopen(sstr)) { printf("\tsvR ERR0: can't open file \"%s\"\n",sstr) return 0}
tmpfile.printf("%d\n",m)
for ii=0,m-1 tmpfile.printf("%s\n",s[ii].s)
for ii=0,m-1 cob.v[ii].vwrite(tmpfile)
tmpfile.close()
return ii
}
//** func svcols(filename)
// saves numeric columns for R -- read with aa=read.table("filename")
func svcols () { local ii,jj,cols,li,errflag,num
errflag=0
if (tmpfile.ropen($s1)) if (!boolean_dialog("File exists","Overwrite","Cancel")) {
print "Cancelled" return 0 }
if (! tmpfile.wopen($s1)) { printf("\tsvcols ERR0: can't open file \"%s\"\n",$s1) return 0}
sstr2="\t" // delimiter
for ii=0,m-1 tmpfile.printf("%s%s",s[ii].s,sstr2)
tmpfile.printf("\n")
for ii=0,size(1)-1 {
tmpfile.printf("%d%s",ii,sstr2)
for jj=0,m-1 {
getval(jj,v[jj].x[ii])
tmpfile.printf("%g%s",nval,sstr2)
}
tmpfile.printf("\n")
}
tmpfile.close
return ii
}
//** join(nqs2,"PIVOT"[,"COLA",...])
// [selected fields of] nqs2 will be appended to this
// index field should only appear once in nqs2
func join () { local vn,vn1,vn2,i,ii,jj,kk,val localobj al,bl
al=new List() bl=new List()
if ((vn1=fi($s2))==-1 || (vn2=$o1.fi($s2))==-1) {
printf("NQS::join() %s not found in both %s %s\n",$s2,$o1,this) return -1 }
if (!v[vn1].ismono) { print "Sorting A..." sort(vn1) }
if (!$o1.v[vn2].ismono){print "Sorting B..." $o1.sort(vn2) }
if (!$o1.v[vn2].ismono(2)){ printf("Pivot B has repeats\n") return -1 }
scr.resize($o1.m) scr.fill(-1)
if (numarg()>2) for i=3,numarg() {
if ((vn=$o1.fi($si))==-1) return -1
if (fi($si,"NOERR")!=-1) sprint(tstr,"%sB",$si) else tstr=$si
scr.x[vn]=resize(tstr)-1 // index for this
} else for ii=0,$o1.m-1 if (! strcmp($o1.s[ii].s,$s2)==0) { // don't add pivot field
if ($o1.fcd.x[ii]!=0) {printf("%s:join ERRA not double field\n",this) return -1}
if (fi($o1.s[ii].s,"NOERR")!=-1) sprint(tstr,"%sB",$o1.s[ii].s) else tstr=$o1.s[ii].s
scr.x[ii]=resize(tstr)-1 // index for this
}
pad()
for jj=0,scr.size-1 { kk=scr.x[jj]
if (kk!=-1) { al.append(v[kk]) bl.append($o1.v[jj]) }
}
v[vn1].join($o1.v[vn2],al,bl)
return m
}
//** cp(NQS[,VEC_COPY]) copy 1 NQS to another
// default: VEC_COPY==1; side effect of NO_VEC_COPY is no fcd,fcds creation
proc copy () { if (numarg()==2) cp($o1,$2) else cp($o1) }
proc cpout () { // copy .out to this
cob=this
for ii=0,m-1 v[ii].copy(out.v[ii])
}
proc cp () { local ii,csz,veccp,outcp localobj o,oo
cob=this
csz=$o1.m
outcp=0
if (numarg()==2) veccp=$2 else veccp=1
if (m!=csz) if (isassigned(out)) resize(csz) else {
resize2(csz)
outcp=1
}
objl.remove_all
for ii=0,$o1.objl.count-1 { objl.append($o1.objl.object(ii)) }
file=$o1.file comment=$o1.comment
if (outcp) for ii=0,m-1 {
s[ii]=up.s[ii]
v[ii]=new Vector()
} else for ii=0,m-1 {
s[ii].s=$o1.s[ii].s
if (veccp) v[ii].copy($o1.v[ii]) // 2nd arg to not copy vectors
}
if (veccp==1) { // full copy
fcd.copy($o1.fcd)
for ii=0,$o1.fcds.count-1 fcds.append($o1.fcds.object(ii)) // strings not being copies
if (isobj($o1.fcdl,"List")) { fcdl=new List() out.fcdl=fcdl
for ii=0,$o1.fcdl.count-1 fcdl.append($o1.fcdl.object(ii)) }
if (isobj($o1.fcdo,"List")) { fcdo=new List() out.fcdo=fcdo
o=$o1.fcdo
for ii=0,o.count-1 {
if (isojt(o.o(ii),v)) { // a vector
oo=new Vector(o.o(ii).size) oo.copy(o.o(ii)) fcdo.append(oo)
} else if (isojt(o.o(ii),out)) { // a vector
oo=new NQS() oo.cp(o.o(ii)) fcdo.append(oo)
} else {
printf("Can't copy a %s\n",o.o(ii)) return
}
}
}
} else if (! isassigned(fcd)) { // use pointers for .out
fcd=$o1.fcd fcds=$o1.fcds fcdl=$o1.fcdl tmplist=$o1.tmplist
}
x.copy($o1.x) x.resize(m)
scr.copy($o1.scr) ind.copy($o1.ind)
}
//** eq(NQS) -- just check the vecs
func eq () { local ii,jj,af,ix,epsilon localobj v1
if (numarg()>=2) {
af=1
if ($2!=1) epsilon=$2 else epsilon=1e-5
} else af=0 // af is flag for approx eq
if ($o1.m!=m) { printf("# of cols differ %d vs %d\n",m,$o1.m) return 0 }
for ii=0,m-1 if (strcmp($o1.s[ii].s,s[ii].s)!=0) {
printf("%d col names differ: %s vs %s",ii,s[ii].s,$o1.s[ii].s) return 0 }
for ii=0,m-1 if ($o1.v[ii].size != v[ii].size) {
printf("%d col lengths differ: %d vs %d",ii,v[ii].size,$o1.v[ii].size) return 0 }
if (af) {
a=allocvecs(v1)
for ii=0,m-1 {
v1.copy(v[ii])
v1.sub($o1.v[ii])
v1.abs()
if (v1.max>epsilon) {
ix=v1.max_ind
printf("%s cols differ: \n",s[ii].s,ix,v[ii].x[ix],$o1.v[ii].x[ix])
}
}
if (numarg()>=3) $o3.copy(v1)
dealloc(a)
} else for ii=0,m-1 if (! $o1.v[ii].eq(v[ii])) {
printf("%s cols differ at ",s[ii].s)
for jj=0,v[ii].size-1 if ($o1.v[ii].x[jj] != v[ii].x[jj]) {
printf("element %d: %g vs %g",jj,v[ii].x[jj],$o1.v[ii].x[jj])
if ($o1.v[ii].x[jj]-v[ii].x[jj]<1e-5) {
printf("\n\tTry for approximately equal using flag: nq.eq(nq2,1)\n")}
return 0
}
}
if (! fcdseq($o1)) return 0
if (! fcdoeq($o1)) return 0
return 1
}
//** fcdseq() -- check that string lists are identical in two NQSs -- this is
// sufficient but not nec for comparing string columns for JOIN
// in order to use JOIN must share same fcds by setting up with strdec(NQS,...)
// (could break out separate lists for each str column -- tried in nqs.hoc220;
// but separate lists would be problem: two columns might require same indices if
// either could be used to for "JOIN" to another nqs
func fcdseq () { local ii,jj,cnt
cnt=fcds.count
if (eqobj(fcds,$o1.fcds)) {
printf("%s %s already share string list fcds\n",this,$o1)
return 1
}
if (cnt!=$o1.fcds.count) {
printf("DIFFERING (1) string lists (fcds) %d %d\n",fcds.count,$o1.fcds.count)
return 0
}
for ii=0,cnt-1 if (!strcmp(fcds.object(ii).s,$o1.fcds.object(ii).s)==0) {
printf("DIFFERING (2) string lists (fcds) %d:%s vs %s",ii,fcds.object(ii).s,$o1.fcds.object(ii).s)
return 0
}
if (numarg()==2) return 1 // just check fcds and not fcd and fcdl
if (! fcd.eq($o1.fcd)) {
printf("DIFFERING (3) col keys (fcd) ") vlk(fcd) vlk($o1.fcd)
return 0
}
if (! isassigned(fcdl) && isassigned($o1.fcdl)) {
printf("DIFFERING (4) uselists() string lists: absent in %s\n",this)
return 0
}
if (isassigned(fcdl)) {
if (! isassigned($o1.fcdl)) {
printf("DIFFERING (5) uselists() string lists absent in %s\n",$o1)
return 0
}
if (fcdl.count!=$o1.fcdl.count) {
printf("DIFFERING (6) uselists() list list counts %d vs %d",fcdl.count,$o1.fcdl.count)
return 0
}
for ii=0,fcdl.count-1 if (fcd.x[ii]==-1) {
if (!isobj(fcdl.object(ii),"List") || !isobj($o1.fcdl.object(ii),"List")) {
printf("DIFFERING (7) uselists() string lists (fcdl.obj) %d:%s vs %s",ii,\
fcdl.object(ii),$o1.fcdl.object(ii))
return 0
}
if (fcdl.object(ii).count != $o1.fcdl.object(ii).count) {
printf("DIFFERING (8) uselists() string lists counts (fcdl.obj) %d:%d vs %d",ii,\
fcdl.object(ii).count,$o1.fcdl.object(ii).count)
return 0
}
for jj=0,fcdl.object(ii).count-1 {
if (!strcmp(fcdl.object(ii).object(jj).s,$o1.fcdl.object(ii).object(jj).s)==0) {
printf("DIFFERING (9) uselists() string lists (fcdl.obj) %d,%d:%s vs %s",ii,jj,\
fcdl.object(ii).object(jj).s,$o1.fcdl.object(ii).object(jj).s)
return 0
}
}
}
}
return 1
}
//** fcdoeq() -- check that object lists are identical in two NQSs
func fcdoeq () { local ii,jj,cnt
if (! isassigned(fcdo) && ! isassigned($o1.fcdo)) return 1
if (! isassigned(fcdo)) {
printf("No object list in %s\n",this)
return 0
}
if (! isassigned($o1.fcdo)) {
printf("No object list in %s\n",$o1)
return 0
}
cnt=fcdo.count
if (cnt!=$o1.fcdo.count) {
printf("DIFFERING (1) object lists (fcdo) %d %d\n",fcdo.count,$o1.fcdo.count)
return 0
}
for ii=0,cnt-1 {
if (!isojt(fcdo.o(ii),$o1.fcdo.o(ii))) {
printf("DIFFERING (2) obj lists (fcdo) %s,%s (%s,%s)",fcdo.o(ii),$o1.fcdo.o(ii),this,$o1)
return 0
}
if (1) { // vector and nqs both use .eq() a vector: isojt(fcdo.o(ii),v)
if (! fcdo.o(ii).eq($o1.fcdo.o(ii))) {
printf("DIFFERING obj lists (fcdo) : differ %s,%s (%s,%s)",\
fcdo.o(ii),$o1.fcdo.o(ii),this,$o1)
return 0
}
}
}
return 1
}
//** strdec() -- declare these columns to be strings
func strdec () { local i,min
min=1
if (eqobj(cob,out)) {
printf("strdec() ERR: string fields can only be declared at top level\n") return 0}
if (numarg()==0) {
printf("strdec(NAME[,NAME1 ...])\n\tdeclare these field to be string fields\n") return 0}
out.fcd=fcd
if (argtype(1)==1) {
if (fcds.count>0) if (! fcdseq($o1,1)) { // just check fcds and not fcd, fcdl
printf("Pre-existing string lists differ; unable to join %s %s\n",this,$o1)
return 0
}
fcds=$o1.fcds // share string list to allow JOIN on a string field
min=2
}
for i=min,numarg() {
if (argtype(i)==2) fl=fi($si) else fl=$i
if (fl>-1) {
fcd.x[fl]=2
sval="`EMPTY'"
newval(2,fl) // don't want to put on more than one
}
}
return 1
}
//** coddec() -- declare these columns to be strings
func coddec () { local i,min
min=1
if (eqobj(cob,out)) {
printf("coddec() ERR: CODE fields can only be declared at top level\n") return 0}
if (numarg()==0) {
printf("coddec(NAME[,NAME1 ...])\n\tdeclare these field to be code fields\n") return 0}
out.fcd=fcd
for i=min,numarg() {
fl=fi($si)
if (fl>-1) fcd.x[fl]=10
}
return 1
}
//** deriv("COLA",...) generates a col with differences between each row value and preceding
proc deriv () { local fl,i
if (eqobj(cob,out)) { printf("Take deriv on whole set only\n") return }
for i=1,numarg() {
if (argtype(i)==0) fl=$i else fl=fi($si)
if (fl==-1) return
sprint(tstr,"%s'",s[fl].s) resize(tstr)
v[m-1].deriv(v[fl],1,1)
v[m-1].insrt(0,0)
}
}
//** odec() -- declare these columns to be objects
func odec () { local i,min
min=1
if (eqobj(cob,out)) {
printf("odec() ERR: object fields can only be declared at top level\n") return 0}
if (numarg()==0) {
printf("odec(NAME[,NAME1 ...])\n\tdeclare these field to be object fields\n") return 0}
out.fcd=fcd
for i=min,numarg() { fl=fi($si)
if (fl>-1) fcd.x[fl]=1
}
if (! isobj(fcdo,"List")) { fcdo=new List() out.fcdo=fcdo }
return 1
}
//** mo([flag][,STAT1,...]) -- create global objectvars that point to the vectors
// first time use flag=1 to create new global objrefs, else just shift them
// flag=1 reassign objl but don't care if they already exist
// flag=2 don't print out the assignments
// flag=3 reassign objl; make sure they're unique
// flag=4 clear the vectors
// should we also create a set of global scalars to assign to in an iterator?
proc mo () { local ii,flag,i,hf
if (numarg()>=1) flag=$1 else flag=0 // flag:create objrefs
if (flag==1 || flag==3) {
if (objl.count>0) {
if (flag==3) if (batch_flag) {
printf("NQS mo(3) WARNING: Renamed object pointers.\n")
} else if (! boolean_dialog("New name object pointers?","YES","NO")) return
if (flag==1) if (batch_flag) {
printf("NQS mo(1) WARNING: Rassigned object pointers.\n")
} else if (! boolean_dialog("Reassign object pointers?","YES","NO")) return
}
objl.remove_all
for ii=0,m-1 if (sfunc.len(s[ii].s)>0) {
sstr=s[ii].s
repl_mstr(sstr,"[^A-za-z0-9]","",execstr)
sprint(sstr,"%sv",sstr)
if (flag==3) { // make sure it's unique
hf=0
while (name_declared(sstr)) { hf=1
printf("%s exists ... ",sstr)
sprint(sstr,"%sv",sstr)
}
if (hf) printf(" -> %s\n",sstr)
} else if (name_declared(sstr)) printf("%s reassigned: ",sstr)
printf("%s -> v[%d] (%s)\n",sstr,ii,s[ii].s)
sprint(execstr,"objref %s",sstr) execute(execstr)
sprint(execstr,"%s=%s",sstr,v[ii]) execute(execstr)
objl.append(new String(sstr))
}
sprint(execstr,"objref indv") execute(execstr)
sprint(execstr,"indv=%s",ind) execute(execstr)
} else {
if (objl.count==0) {
printf("Must create vecs with mo(1)\n")
} else if (objl.count>m) {
printf("STAT:mo ERR: wrong objref count in objl: %d vs %d\n",objl.count,m)
return
} else {
if (objl.count<m) {
printf("STAT:mo WARNING: unreferenced vecs for %s: refs %d<m %d\n",this,objl.count,m) }
for ii=0,objl.count-1 {
Xo=objl.object(ii)
if (flag==0) printf("%s -> %s.v[%d] (%s)\n",Xo.s,this,ii,s[ii].s)
if (flag==4) {sprint(execstr,"%s=nil",Xo.s)
} else sprint(execstr,"%s=%s",Xo.s,v[ii])
execute(execstr)
}
}
sprint(execstr,"objref indv") execute(execstr)
if (flag!=4) { sprint(execstr,"indv=%s",ind) execute(execstr) }
}
if (numarg()>1) for i=2,numarg() { // propagate the objl to other STATs
$oi.objl.remove_all
for ii=0,objl.count-1 $oi.objl.append(objl.object(ii))
}
}
//** 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<len && !((x>=a&&x<=z)||(x>=A&&x<=Z));ii+=1) { // allowed first char
sscanf($s1,"%c%*s",&x)
sfunc.right($s1,1)
}
if (ii==len) { printf("varstr() ERR: no useable characters") return 0}
sprint($s1,"%c%s",x,$s1)
for (;ii<=len;ii+=1) {
sscanf($s1,"%c%*s",&x)
sfunc.right($s1,1)
if ((x>=a&&x<=z)||(x>=A&&x<=Z)||(x>=a0&&x<=a9)||(x==a_)) { // allowed chars
sprint($s1,"%s%c",$s1,x)
}
}
if (sflag) {
sprint($s1,"strdef %s",$s1)
execute($s1)
sfunc.right($s1,7) // strip leading "strdef"
} else {
sprint($s1,"%s=0",$s1)
execute($s1)
sfunc.left($s1,sfunc.len($s1)-2) // strip the =0
}
return 1
}
strdef h1
h1="Select operators: \nALL <0 >0 CHK !=0 > >= < <= == EQV EQW EQX != =~ ~~ [) (] [] ()\nALL NEG POS CHK NOZ GTH GTE LTH LTE EQU EQV EQW EQX NEQ SEQ RXP IBE EBI IBI EBE\nmost are obvious; those that are not\nEQV: value equal to same row value another column (takes string arg)\nEQW: value found in other vector (takes vector or NQS arg)\nSEQ: string equal (takes string)\nRXP: regular expression comparison (takes string)\nIBE,EBI...: I=inclusive, E=exclusive for ranges\n"
proc nqshelp () {
if (numarg()==0) {
} else {
if (strcmp($s1,"select")==0) {
// ed=new TextEditor(h1,9,160) ed.map
printf("%s",h1)
}
}
}
proc delnqs () { local i
for i=1,numarg() nqsdel($oi)
}
proc nqsdel () { localobj iq,xo
if (isassigned($o1)) {
iq=$o1
if (isassigned(iq.fcdo)) for ltr(xo,iq.fcdo) if (isojt(xo,iq)) nqsdel(xo)
if (isassigned(iq.out)) {iq.out.cob=nil iq.out=nil}
iq.cob=nil iq=nil
}
if (!istmpobj($o1)) $o1=nil
}
//* 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
//================================================================
//================================================================
// INSERTED /usr/site/nrniv/local/hoc/grvec.hoc
//* =Id= grvec.hoc,v 1.634 2007/11/26 17:27:51 billl Exp
// argtype: 0:double; 1:obj; 2:str; 3:double pointer
objref g[10],printlist,grv_,panobj,panobjl
gnum=-1
if (! name_declared("show_panel")) 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
strdef name,f
double loc[1]
proc init () {
segs=1
if (numarg()>4) if (argtype(5)==0) segs=$5 else 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, ...
// 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
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 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)
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
}
$o2.vread(tmpfile) $o3.vread(tmpfile)
} else {
if (n==-2) if (! tvec.vread(tmpfile)) {
printf("rv_readvec tvec READ failure in %s %s %d\n",filename,o.name,inx)
return 0
}
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,...])
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<glist.count) graphItem=glist.o(ii) else {
printf("GRV grsel() glist exhausted\n")
return }
if (o.num==-2) { // guess should do mark
vrtmp.mark(graphItem,tvec,"O",line+2,curcol,4)
} else vrtmp.line(graphItem,o.num,curcol,line)
}
}
// tposvec(rows,cols): generate the indices for a transposed matrix of rows x cols
proc tposvec () { local rows,cols,i,j
rows=$2 cols=$3
$o1.resize($2*$3)
for (i=0;i<rows;i+=1) for (j=0;j<cols;j+=1) $o1.x[j*rows+i]=i*cols+j
}
// fliptb(rows,cols): generate the indices for a transposed matrix of rows x cols
proc fliptb () { local rows,cols,i,j,p
rows=$2 cols=$3
if ($o1.size != $2*$3) {print "Wrong size vector in fliptb()" return}
p = allocvecs(1) mso[p].resize(rows)
for (j=0;j<cols;j+=1) {
mso[p].copy($o1,j*rows,(j+1)*rows-1)
mso[p].reverse
$o1.copy(mso[p],j*rows)
}
}
//** setrange() sets the range
// setrange(x0,x1,y0,y1)
proc setrange () { local i,ii
if (numarg()==0){print "setrange(x0,x1,y0,y1)\n setrange(3) erases axes"}
if (numarg()==0) { for ltr(Xo,glist) Xo.size(0,tstop,-100,50)
} else if (numarg()==1) { for ltr(Xo,glist) Xo.xaxis($1)
} else if (numarg()==2) { for ltr(Xo,glist) Xo.size(0,tstop,$1,$2)
} else {
size[0]=$1
for ltr(Xo,glist) Xo.size($1,$2,$3,$4)
for i=1,4 size[i-1]=$i
}
for ii=0,3 if (size[ii]==0) size[ii]=glist.object(0).size(ii+1)
}
//* gxpan()
proc gxpan () { local x localobj xo,yo,g1
gcomms.remove_all
gcomms.append(new String2("Move","mvga"))
gcomms.append(new String2("Mag","magga"))
for ltr(xo,gcomms) for ltr(yo,glist) {
yo.menu_remove(xo.s)
yo.menu_tool(xo.s,xo.t)
}
gcomms.append(new String2("Crosshair",""))
xpanel("Manipulate graphs",1)
x=-1
for ltr(xo,gcomms) {sprint(tstr,"mvgaset(%d)",x+=1) xradiobutton(xo.s,tstr)}
xpanel()
}
proc mvgaset () { localobj yo
print $1,gcomms.o($1).s
for ltr(yo,glist) yo.exec_menu(gcomms.o($1).s)
}
proc mvga () { local type,x,y,keystate,sz1,sz2,sz3,sz4 localobj xo,yo
type=$1 x=$2 y=$3 keystate=$4 // 2 for press, 1 for dragging, and 3 for release
xo=glist.o(0)
sz1=xo.size(1) sz2=xo.size(2) sz3=xo.size(3) sz4=xo.size(4)
if (type == 2) {
begx=x begy=y
} else if (type==3) {
x-=begx y-=begy
size[0]=sz1-x size[1]=sz2-x size[2]=sz3-y size[3]=sz4-y
for ltr(xo,glist) xo.size(sz1-x,sz2-x,sz3-y,sz4-y)
}
}
proc magga () { local tmp,type,x,y,begx,begy,keystate,sz1,sz2,sz3,sz4 localobj xo,yo
type=$1 x=$2 y=$3 keystate=$4 // 2 for press, 1 for dragging, and 3 for release
xo=glist.o(0)
sz1=xo.size(1) sz2=xo.size(2) sz3=xo.size(3) sz4=xo.size(4)
if (type == 2) {
begx=x begy=y
} else if (type==3) {
if (x<begx) { tmp=x x=begx begx=tmp }
if (y<begy) { tmp=y y=begy begy=tmp }
size[0]=begx size[1]=x size[2]=begy size[3]=y
for ltr(xo,glist) xo.size(size[0],size[1],size[2],size[3])
}
}
//* grransel() -- graph range select
proc setgrransel () {
for ltr(Xo,glist) {
Xo.menu_remove("REVIEW")
sprint(tstr,"proc p%d(){grransel($1,$2,$3,$4,%d,%s)}",ii1,ii1,Xo)
execute1(tstr)
sprint(tstr,"p%d",ii1)
Xo.menu_tool("REVIEW", tstr)
Xo.exec_menu("REVIEW")
}
}
//** grransel(): 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
grrcnt=-1
// not debugged
proc grransel () { local type, x0, y0, keystate, ii, gr
type=$1 x0=$2 y0=$3 keystate=$4 gr=$5
graphItem=$o7 // = glist.object(gr)
if (keystate==1 && type==2) { graphItem.exec_menu("Crosshair") // CTL-MOUSE-1
} else if (keystate==3 && type==3) {
print grrcnt
if (grrcnt>-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]<sz1) sz1=x[0]
if (x[1]>sz2) sz2=x[1]
if (x[2]<sz3) sz3=x[2]
if (x[3]>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,...
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) print out the printlist with comment at head
proc pvother () {} // user can dump other vectors at top with prvec()
proc pvplist () { local inx
output_file=$s1
if (! pvplist0()) return // open file(s)
pvplist1($s2) // print string header
pvout()
if (numarg()<3) { // else leave for appending
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
secname() // a section must exist
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
secname() // a section must exist
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") { ... }
// 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<llist.count;ii1+=1) {
if (ipt.contains(ii1) && strm(llist.object(ii1).name,rxp.s)) {
XO=llist.object(ii1)
if (mff) if (strcmp(filename,XO.f)!=0) { filename=XO.f tmpfile.ropen(filename) }
tmpfile.seek(XO.loc)
if (XO.num==-2) tv1.vread(tmpfile) else {
if (XO.num<=0) {printf("vrdr INTERR; ?printStep for interpolation\n") err()}
tv1.indgen(0,tstop+0.01,XO.num) }
v1.vread(tmpfile)
v2.resize(0)
if (XO.num==-2 && !flag) v2.interpolate(tv2,tv1,v1)
i1=ii1
iterator_statement
if (numarg()>=4) { $&4+=1 }
}
}
tmpfile.close
dealloc(a)
}
//** prdr() -- used for printlist
// use regexp eg for prdr("PYR2.8") { ... }
// 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<printlist.count;ii1+=1) {
XO=printlist.object(ii1)
if (strm(XO.name,$s1)) {
sprint(tstr,"tstr=\"%s\"",XO.name) execute(tstr) // set global tstr
mso[v1].copy(XO.vec)
if (isit(XO.tvec)) mso[tv1].copy(XO.tvec)
if (!flag && isit(XO.tvec)) mso[v2].interpolate(mso[tv2],XO.tvec,XO.vec)
i1=ii1
iterator_statement
if (numarg()==3) { $&3+=1 }
}
} else for (ii1=0;ii1<llist.count;ii1+=1) {
if (strm(llist.object(ii1).name,$s1)) {
XO=llist.object(ii1)
i1=ii1
iterator_statement
if (numarg()>=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 == 0) { return }
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")
printlist.object(ii).vec.play_remove()
sprint(temp_string_,"printlist.object(%d).vec.record(&%s,%g)",\
ii,printlist.object(ii).name,printStep)
execute(temp_string_)
}
tmpfile.close
outvect = outvect+outvecint
}
//** outvec_finish () : put out the last section if needed, update the output_file name
proc outvec_finish() {
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,...
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)
print ts.s
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)}
obfunc mdl2view () { local a,ii,x0,y0 localobj o,v1
x0=$2 y0=$3
o=new Union()
a=allocvecs(v1)
for ii=1,4 v1.append($o1.size(ii))
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])
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
//================================================================
//================================================================
// INSERTED /usr/site/nrniv/local/hoc/syncode.hoc
// =Id= syncode.hoc,v 1.389 2007/06/25 00:23:43 billl Exp
//* setup
//================================================================
// INSERTED /usr/site/nrniv/local/hoc/labels.hoc
// =Id= labels.hoc,v 1.65 2007/05/31 20:14:33 billl Exp
objref NCv,CODEv,DELv
objref PRIDv,POIDv,PRv,POv,DISTv,WT0v,WT1v // mo(1) will assign these
objref CPLA,CTYP,snsm,STYP,TPA
//* utility functions
// plmin(val,var)
func plmin() { return $1 + $2*(2*u_rand() - 1) }
//* cell types:
CTYP=new List()
for scase2(XO,"NU","NU","SM","SM","DP","DP","SU","SU","IN","IN","TC","TC","RE","RE",\
"NS","NS","BU","BU","RF","RF","CL","CL") {
sprint(tstr,"%s=%d",XO.t,i1) execute(tstr)
CTYP.append(XO)
}
CTYPi=CTYP.count // number of cell types
// 1 cmp nrn, 2 cmp nrn, multi cmp nrn, intfire1, INTF, invlfire, nstim
CPLA=new List()
for scase2(XO,"1-CMP","CMP1","2-CMP","CMP2","MULTI-CMP","MC","IntFire1","IF1","INTF","IF",\
"INVLF","IFV","NStim","STM") { CPLA.append(XO)
sprint(tstr,"%s=%d",XO.t,i1) execute(tstr) }
CPLAi=CPLA.count // count of cell templates
TPA=new List()
for scase2(XO,"REAL","RL","ARTC","AC","SOMA","SO","DEND","DN") {TPA.append(XO)}
TPAi=TPA.count
ncells=0
objref nm
nm=new List()
STYP=new List()
for scase2(XO,"AMPA","AM","NMDA","NM","GABAA","GA","GABAB","GB","GABAB2","GB2",\
"IClamp","IC","AMPA/NMDA","EX","GABAA/GABAB2","IX","Exp2Syn","E2") {
STYP.append(XO) sprint(tstr,"%s=%d",XO.t,i1) execute(tstr) }
STYPi= STYP.count
objref ZTYP
ZTYP=new List()
for scase(XO,"DG","CA3","CA1","SUB","PSUB","MEC","LEC") {
sprint(tstr,"%s=%d",XO.s,i1) execute(tstr) ZTYP.append(XO)
}
objref INCOL
INCOL=new List()
for scase2(XO,"RIGHT","RIT","INCOL","INC","LEFT","LFT") { INCOL.append(XO)
sprint(tstr,"%s=%d",XO.t,i1) execute(tstr) }
INCOLi=INCOL.count
// END /usr/site/nrniv/local/hoc/labels.hoc
//================================================================
strdef syn1,syn2
thresh = -20
objref cp,svs,ncq
objref ivspks,vspks,wvspks,ncl[1][1][1]
objref sp[3], c[1], ce, nc[1], cells[10] // enough room for 10 cell types
objref vite
double numc[CTYPi],ix[CTYPi],ixe[CTYPi]
Incol=2
ncl = new List()
sp = new NQS()
//* iterator ixt()
ixi=ixj=0 // ixi steps through cell#s and ixj is consecutive
for ii=0,CTYPi-1 ixe[ii]=-1
// ctype(#,TYPE)
func ctype () { local ii
if (numarg()==2) {
return ($1>=ix[$2] && $1<=ixe[$2])
} else {
for ii=0,CTYPi-1 if ($1>=ix[ii] && $1<=ixe[ii]) return ii
return -1
}
}
iterator ixt () { local ty,col,a
ty=$1
if (numarg()>=2) col=$2 else col=-1
if (numarg()>=3) vrsz(numc[ty],$o3,"O")
if (col<0) {
for ({ixi=ix[ty] ixj=0};ixi<=ixe[ty];{ixi+=1 ixj+=1}) { XO=ce.o(ixi)
iterator_statement
}
} else {
if (col>=ncols) printf("ixt ERR: Only %d columns (%d)\n",ncols,col) else {
a=ix[ty]+col*numc[ty]/ncols
for ({ixi=a ixj=0};ixi<a+numc[ty]/ncols;{ixi+=1 ixj+=1}) { XO=ce.o(ixi)
iterator_statement
}
}
}
if (numarg()>=3) stat($o3)
}
obfunc pov () { local ty,ii localobj v1
ty=$1
v1=new Vector(1000) v1.resize(0)
v1.append(ty)
for ii=ix[ty],ixe[ty] v1.append(ii)
return v1
}
// for ltr(XO,cvode.netconlist("", "", "")) print XO.precell,XO.postcell,XO.syn
//* synapse linking -- old routines not using NQS
//** geolink(s1,s2,s3) s1 for presyns and s2 for postsyns, connect s3's
// only checks for INTF as a possible pre/post point process
// connects a layer to another assuming 1 dim netgeom
proc geolink() { local i,ii,a,sav,nowrap,noself
if (numarg()==0) { print "\tgeolink(s1,s2,s3,DEFCON)"
print " make connections from s1 to s2 connecting onto s3 type PPs."
print " DEFCON struct defines connection"
return
}
// default to yes wrap; yes within-column connect unless $s1==$s2
nowrap = !$o4.wrap noself=!$o4.self
if (strcmp($s1,$s2)==0) $o4.self=0
tmpobj=new List($s1)
// object containing a receive/event PP need fflag=1 and intf as name of PP
if (tmpobj.object(0).fflag) { // presynaptic object flag
sprint(temp_string_,"ncl.append(new NetCon(XO.intf, YO.%s))",$s3)
} else {
sprint(temp_string_,"XO.soma ncl.append(new NetCon(&v(.5), YO.%s))",$s3)
}
for ltr (XO,tmpobj,&y) { // presyn list
$o4.grot(y)
for lvtr (YO,&x,new List($s2),$o4.scr) { // postsyn list and vector
if (x==1) { // connect
print "connecting ",XO," to ",YO
execute(temp_string_)
}
}
}
XO=nil YO=nil
}
//** glink() same as geolink but takes lists statt strings
proc glink() { local i,ii,a,sav,nowrap,noself
if (numarg()==0) { print "\tgeolink(l1,l2,DEFCON)"
print " make connections from items in l1 to items in l2."
print " DEFCON struct defines connection"
return
}
// default to yes wrap; yes within-column connect unless $s1==$s2
nowrap = !$o4.wrap noself=!$o4.self
// object containing a receive/event PP need fflag=1 and intf as name of PP
if ($o1.object(0).fflag) { // presynaptic object flag
sprint(temp_string_,"ncl.append(new NetCon(XO.intf, YO.%s))",$s3)
} else {
sprint(temp_string_,"XO.soma ncl.append(new NetCon(&v(.5), YO.%s))",$s3)
}
for ltr (XO,$o1,&y) { // presyn list
$o4.grot(y)
for lvtr (YO,&x,$o2,$o4.scr) { // postsyn list and vector
if (x==1) { // connect
// print "connecting ",XO," to ",YO
execute(temp_string_)
}
}
}
XO=nil YO=nil
}
//** synlink(s1,s2,s3,[gmax,del]) s1 for presyns and s2 for postsyns, connect s3's
// eg synlink("PYR","INH","AMPA")
// provides full connectivity
proc synlink() { local gm,dl
if (numarg()==0) { print "\tsynlink(s1,s2,s3)"
print " make connections from all of type s1 to one of type s2 "
print " only connecting onto s3 type PPs."
print " Matching done with regexps."
return
}
if (numarg()==5) { gm=$4 dl=$5 } else { gm=0 dl=1 }
tmplist = new List($s3) // list of postsyn point processes
for ltr (XO,new List($s1)) { // presyn list
for ltr (YO,tmplist) {
if (pp_loc(YO,$s2,syn2)) {
sfunc.head(syn2,"\\.",syn2)
sprint(syn1,"%s",XO)
if (strcmp(syn1,syn2)!=0) { // don't allow self connects
print "connecting ",XO," to ",syn2
XO.soma ncl.append(new NetCon(&v(.5), YO, thresh, gm, dl))
}
}
}
}
}
// run NQS.mo(1) first to set up PRIDv ... vectors
//** simple netconnect routines: netconn(), netgen()
proc netconn () { local pre,post,syn,pri,poi
pre=$1 post=$2
if (numarg()==5) { syn=$3 pri=$4 poi=$5 } else { syn=0 pri=$3 poi=$4 }
cells[pre].object(pri).conn(cells[post].object(poi).syns[syn])
}
proc netgen () { ncl.append(new NetCon($o1, $o2)) }
//** syncopy() copies from one set of syns to another for colocalization
proc syncopy () {
if (numarg()==0) { printf("syncopy(to_type,[]): copy from type, post/type, pre/post/type\n") return }
sprint(temp_string_,"XO.precell.soma ncl.append(new NetCon(&v(.5),XO.postcell.%s",$s1)
if (numarg()==1) tmplist = cvode.netconlist("", "" , $s2)
if (numarg()==2) tmplist = cvode.netconlist("", $s2, $s3)
if (numarg()==3) tmplist = cvode.netconlist($s2, $s3, $s4)
for ltr(XO,tmplist) execute(temp_string_)
}
//** syn1to1(PRE,POST,SYN)
proc syn1to1 () { local pre,post,syn
pre=$1 post=$2
if (numarg()==3) syn=$3 else syn=0
if (cells[pre].count !=cells[post].count) {
printf("\tERROR: 1-to-1 connectivity requires same # of %s (=%d) and %s (=%d).\n",\
CTYP.object(pre).s,cells[pre].count,CTYP.object(post).s,cells[post].count) return }
for ltr2(XO,YO,cells[pre],cells[post]) {
printf("SRC: %s -> TRG: %s (%s)\n",XO,YO,YO.syns(syn))
XO.conn(YO.syns[syn])
}
}
//* synconn() synapse linking -- NQS routines
//** synconn(preid,postid,pre#,post#,%div)
// eg synconn(PYRi,PYRi,AMPAi,pmat[PYR][PYR])
// provides % connectivity based on C/pre==%div==%conv==D/post
// S==C*post==D*pre %conv=S/(post*pre)=C/pre=D/post
objref convec,convec1,convec2 // vectors to count how much div is from each nrn
convec = new Vector(1e3)
convec1 = convec.c // a scratch vector
convec2 = convec.c // copy of convec to blot out self-connect and redundent connects
proc synconn () { local preid,posid,pdiv,con,div,ii,jj,prn,pon,targ,sz,styp1,styp2
if (numarg()==0) { print "\tsynconn(preid,postid,prn,pon,pdiv)" return }
preid=$1 posid=$2 prn=$3 pon=$4 pdiv=$5
CODEv=sp.v[sp.fi("CODE")] PRv=sp.v[sp.fi("PR")] POv=sp.v[sp.fi("PO")]
sz=PRv.size
if (pdiv==1) {
if (preid==posid) div=pon-1 else div=pon
con=div
} else {
con=int(pdiv*prn+1) div=int(pdiv*pon)
}
if (isobj(CTYP,"List")) {
printf("%s->%s:\tdiv=%d,conv=%d (%d syns)\n",CTYP.object(preid).s,CTYP.object(posid).s,div,con,prn*div)
} else {
printf("%d->%d:\tdiv=%d,conv=%d (%d syns)\n",preid,posid,div,con,prn*div)
}
if (prn*div==0) return
sp.pad(sz+prn*div)
if (pdiv==1) {
convec.indgen(0,pon-1,1)
for ii=0,prn-1 {
if (preid==posid) {convec.indgen(0,pon-1,1) convec.remove(ii)}
POv.copy(convec,sz+ii*div)
PRv.fill(ii,sz+ii*div,sz+(ii+1)*div-1)
}
} else {
convec.resize(pon) convec.fill(0) // counter for convergence
for ii=0,prn-1 { // sources
convec2.copy(convec)
if (preid==posid) convec2.x[ii]=1e10 // block self-connect
for jj=1,div POv.set(sz+ii*div+jj-1,pickpost(pon,con)) // pick desired target
PRv.fill(ii,sz+ii*div,sz+(ii+1)*div-1)
}
}
CODEv.fill(mkcodf(preid,posid,0,0,0),sz,PRv.size-1)
}
proc syncnn () { local preb,pree,posb,pose,pdiv,con,div,ii,jj,prn,pon,targ,sz,styp1,styp2
if (numarg()==0) { print "\tsyncnn(preb,pree,posb,pose,pdiv)" return }
preb=$1 pree=$2 posb=$3 pose=$4 pdiv=$5
CODEv=sp.v[sp.fi("CODE")] PRv=sp.v[sp.fi("PR")] POv=sp.v[sp.fi("PO")]
sz=PRv.size
prn=pree-preb+1 pon=pose-posb+1
if (pdiv==1) {
if (preid==posid) div=pon-1 else div=pon
con=div
} else {
con=int(pdiv*prn+1) div=int(pdiv*pon)
}
if (isobj(CTYP,"List")) {
printf("%s->%s:\tdiv=%d,conv=%d (%d syns)\n",CTYP.object(preid).s,CTYP.object(posid).s,div,con,prn*div)
} else {
printf("%d->%d:\tdiv=%d,conv=%d (%d syns)\n",preid,posid,div,con,prn*div)
}
if (prn*div==0) return
sp.pad(sz+prn*div)
if (pdiv==1) {
convec.indgen(0,pon-1,1)
for ii=0,prn-1 {
if (preid==posid) {convec.indgen(0,pon-1,1) convec.remove(ii)}
POv.copy(convec,sz+ii*div)
PRv.fill(ii,sz+ii*div,sz+(ii+1)*div-1)
}
} else {
convec.resize(pon) convec.fill(0) // counter for convergence
for ii=0,prn-1 { // sources
convec2.copy(convec)
if (preid==posid) convec2.x[ii]=1e10 // block self-connect
for jj=1,div POv.set(sz+ii*div+jj-1,pickpost(pon,con)) // pick desired target
PRv.fill(ii,sz+ii*div,sz+(ii+1)*div-1)
}
}
PRv.add(preb) POv.add(posb)
CODEv.fill(mkcodf(preid,posid,0,0,0),sz,PRv.size-1)
}
//** synconn2() uses elimrepeats() and shuffle methods
proc synconn2 () { local preid,posid,pdiv,con,div,ii,jj,prn,pon
if (numarg()==0) { print "\tsynconn2(preid,postid,prn,pon,pdiv)" return }
preid=$2 posid=$3 prn=$4 pon=$5 pdiv=$6
$o1.clear()
PRv=$o1.v[$o1.fi("PR")] POv=$o1.v[$o1.fi("PO")]
con=int(pdiv*prn+1) div=int(pdiv*pon)
if (prn*div==0) return
printf("%s->%s:\tdiv=%d,conv=%d (%d syns)\n",CTYP.object(preid).s,CTYP.object(posid).s,div,con,prn*div)
if (pdiv==1) {
$o1.pad(prn*div)
convec.indgen(0,pon-1,1)
for ii=0,prn-1 {
POv.copy(convec,ii*div)
PRv.fill(ii,ii*div,(ii+1)*div-1)
}
} else {
$o1.pad(1.5*prn*div)
rdm.discunif(0,prn-1) PRv.setrand(rdm)
rdm.discunif(0,pon-1) POv.setrand(rdm)
$o1.elimrepeats("PR","PO")
$o1.shuffle()
$o1.pad(prn*div)
}
$o1.fill("CODE",1,preid) $o1.fill("CODE",2,posid)
}
//** synconn3() doesn't worry about eliminating repeats
proc synconn3 () { local preid,posid,pdiv,con,div,ii,jj,prn,pon
if (numarg()==0) { print "\tsynconn2(preid,postid,prn,pon,pdiv)" return }
preid=$2 posid=$3 prn=$4 pon=$5 pdiv=$6
$o1.clear()
PRv=$o1.v[$o1.fi("PR")] POv=$o1.v[$o1.fi("PO")]
con=int(pdiv*prn+1) div=int(pdiv*pon)
if (prn*div==0) return
printf("%s->%s:\tdiv=%d,conv=%d (%d syns)\n",CTYP.object(preid).s,CTYP.object(posid).s,div,con,prn*div)
$o1.pad(prn*div)
rdm.discunif(0,prn-1) PRv.setrand(rdm)
rdm.discunif(0,pon-1) POv.setrand(rdm)
$o1.fill("CODE",1,preid) $o1.fill("CODE",2,posid)
}
//*** pickpost() tries to reduce divergence variance
// pickpost(postlist,maxcon,YO)
// maxcon == -1 means to ignore convergence
// MUST do convec.resize() and convec.fill(0) before using
func pickpost () { local ran, maxcon, maxpo, min, indx
maxcon = $2 // max convergence to be allowed
maxpo = $1 // number of postsyn choices
min = convec2.min // convec should start all 0's
if (min >= maxcon) { // all full up
printf("Pickpost full WARNING: %d %d\n",min,maxcon) vlk(convec2) }
convec1.indvwhere(convec2,"==",min) // look for all the smallest to fill up first
inx = convec1.x[rdm.discunif(0,convec1.size-1)]
convec.x[inx]+=1
convec2.x[inx]=1e10 // block from reconnecting here
return inx
}
//** smap()
// excitatory cells project to AMPA and inhibitory cells to GABA
// assumes PRIDv ... defined by sp.mo(1)
objref pro,poo // pre and post pointers
func smap () { local ct,sy,conv,prdx,podx,prx,pox,delx,w0x,w1x localobj nc,ty
ty=new Union()
ct=cp.fi("PRID") sy=cp.fi("STYP")
sp.resize("NC")
sp.odec("NC")
sp.pad()
sp.mo(1)
for ii=0,PRv.size-1 {
uncodf(CODEv.x[ii],&prdx,&podx) prx=PRv.x[ii] pox=POv.x[ii]
delx=DELv.x[ii] w0x=WT0v.x[ii] w1x=WT1v.x[ii]
pro=c[prdx].object(prx) poo=c[podx].object(pox)
NCv.x[ii]=sp.fcdo.append(nc=smap1(prdx))-1
for kk=0,nc.wcnt-1 nc.weight[kk]=0
x=cp.fetch(ct,prdx,sy)
syntyp(x,ty)
nc.weight[ty.x]=w0x
if (ty.x[1]>-1) nc.weight[ty.x[1]]=w1x
nc.delay=delx
}
return ii
}
//*** smap1(SYN#) poo has postsyn and pro has pre
obfunc smap1 () { localobj si
if (poo.fflag) { YO=poo
} else {
YO=poo.po[$1]
if (isobj(YO,"List")) {
snsr($1,poo)
YO=YO.object(YO.count-1)
}
}
if (pro.fflag) { si=new NetCon(pro, YO)
} else { pro.soma si=new NetCon(&v(0.5),YO) }
return si
}
//*** snsr() handles situation where multiple PPs must be hung onto postsyn objref
proc snsr () {
printf("PROBLEM: replace snsr() which uses an execute\n")
if (isobj($o2.po[$1],"List")) {
sprint(tstr,"%s.soma %s.po[%d].append(new %s(0.5))",$o2,$o2,$1,STYP.object($1).s)
} else {
sprint(tstr,"%s.soma %s.po[%d] = new %s(0.5)",$o2,$o2,$1,STYP.object($1).s)
}
execute(tstr)
}
//** umbrella(preid,postid,max,width[,shift])
// set lateral projections from pre to post out to width
// sets direct connection (jj==ii) iff preid!=posid
proc umbrella () { local ii,jj,preid,posid,width,sh,max,sz,styp1,styp2
preid=$1 posid=$2 max=$3 width=$4
if (numarg()>=5) sh=$5 else sh=0
sz=PRv.size styp1=styp2=-1
if (width) {
for ii=0,max-1 for jj=ii-width+sh,ii+width+sh {
if (jj>=0 && jj<max && (preid!=posid || jj!=ii)) {
PRv.append(ii) POv.append(jj)
PRIDv.append(preid) POIDv.append(posid)
}
}
} else { // just within column connections
for ii=0,max-1 { PRv.append(ii) POv.append(ii) PRIDv.append(preid) POIDv.append(posid) }
}
sp.pad()
// WID0v.fill(styp1,sz,PRv.size-1)
// WID1v.fill(styp2,sz,PRv.size-1)
}
//** umbflow(preid,postid,max,width[,shift])
// like umbrella but does 'flow' boundary conditions -- reflects back on sides
proc umbflow () { local ii,jj,ja,preid,posid,width,sh,max,sz,styp1,styp2
preid=$1 posid=$2 max=$3 width=$4
if (numarg()>=5) sh=$5 else sh=0
sz=PRv.size styp1=styp2=-1
if (width) {
for ii=0,max-1 for jj=ii-width+sh,ii+width+sh {
if (preid!=posid || jj!=ii) { ja=jj
if (jj<0) ja=-jj
if (jj>max-1) ja=2*max-jj-2
PRv.append(ja) POv.append(ii)
PRIDv.append(preid) POIDv.append(posid)
}
}
} else { // just within column connections
for ii=0,max-1 { PRv.append(ii) POv.append(ii) PRIDv.append(preid) POIDv.append(posid) }
}
sp.pad()
// WID0v.fill(styp1,sz,PRv.size-1)
// WID1v.fill(styp2,sz,PRv.size-1)
}
//** nqdiv(PRID,POID,PR,PO0[,PO1,...])
// nqdiv(PRID,POID,PR,POBEG,..,POEND)
proc nqdiv () { local i,beg,end
if (numarg()==0) {
print "nqdiv(PRID,POID,PR,PO0[,PO1,...])\nnqdiv(PRID,POID,PR,POBEG,\"..\",POEND)" return }
if (numarg()==6 && argtype(5)==2) {
beg=$4 end=$6
for i=beg,end sp.append("CODE",EQU1,$1,"CODE",EQU2,$2,"PR",$3,"PO",i)
} else for i=4,numarg() sp.append("CODE",EQU1,$1,"CODE",EQU2,$2,"PR",$3,"PO",$i)
sp.pad()
}
//** nqconv(POID,PRID,PO,PR0[,PR1,...])
// nqconv(POID,PRID,PO,PRBEG,..,PREND)
proc nqconv () { local i,beg,end
if (numarg()==0) {
print "nqconv(POID,PRID,PO,PR0[,PR1,...])\nnqconv(POID,PRID,PO,PRBEG,\"..\",PREND)" return }
if (numarg()==6 && argtype(5)==2) {
beg=$4 end=$6
for i=beg,end sp.append("PRID",$2,"POID",$1,"PR",i,"PO",$3)
} else for i=4,numarg() sp.append("PRID",$2,"POID",$1,"PR",$i,"PO",$3)
sp.pad()
}
//** proc nq1to1(PRID,POID,num)
proc nq1to1 () { umbrella($1,$2,$3,0) }
//* direct weight setting routines
//** scale gmax
proc synscgmax () {
for ltr(XO,cvode.netconlist("" , "", $s1)) { XO.weight *= $2 }
}
//** set/get gmax
proc synsetgmax () {
if (numarg()==0) { print "synsetgmax(pre,post,type,wt)"
} else if (numarg()==2) {for ltr(XO,cvode.netconlist("" , "", $s1)) XO.weight=$2
} else if (numarg()==3) {for ltr(XO,cvode.netconlist("" , $s1, $s2)) XO.weight=$3
} else if (numarg()==4) {for ltr(XO,cvode.netconlist($s1 , $s2, $s3)) XO.weight=$4
} else { print "ERROR: too many args" }
if (i1==0) printf("WARNING: nothing set in synsetgmax(%s ...)\n",$s1)
}
// synnormgmax() -- like synsetgmax except normalizes the wt by convergence
proc synnormgmax () {
for ltr(XO,cvode.netconlist($s1 , $s2, $s3)) {
XO.weight=$4/cvode.netconlist($s1,XO.postcell,$s3).count
}
}
proc syngetgmax () {
if (numarg()==1) {
if (strcmp($s1,"help")==0) { printf("type,post/type,pre/post/type\n") } else {
for ltr(XO,cvode.netconlist("" , "", $s1)) printf("%g ",XO.weight) }
} else if (numarg()==2) {for ltr(XO,cvode.netconlist("" , $s1, $s2)) printf("%g ",XO.weight)
} else if (numarg()==3) {for ltr(XO,cvode.netconlist($s1 , $s2, $s3)) printf("%g ",XO.weight)
} else for ltr(XO,cvode.netconlist("","","")) printf("%g ",XO.weight)
print ""
}
//** set/get delay
proc synsetdel () {
if (numarg()==2) {for ltr(XO,cvode.netconlist("" , "", $s1)) XO.delay=$2
} else if (numarg()==3) {for ltr(XO,cvode.netconlist("" , $s1, $s2)) XO.delay=$3
} else if (numarg()==4) {for ltr(XO,cvode.netconlist($s1 , $s2, $s3)) XO.delay=$4
} else { print "ERROR: too many args" }
if (i1==0) printf("WARNING: nothing set in synsetdel(%s ...)\n",$s1)
}
proc syngetdel () {
if (numarg()==1) {for ltr(XO,cvode.netconlist("" , "", $s1)) printf("%g ",XO.delay)
} else if (numarg()==2) {for ltr(XO,cvode.netconlist("" , $s1, $s2)) printf("%g ",XO.delay)
} else if (numarg()==3) {for ltr(XO,cvode.netconlist($s1 , $s2, $s3)) printf("%g ",XO.delay)
} else for ltr(XO,cvode.netconlist("","","")) printf("%g ",XO.delay)
print ""
}
//** set/get thresh
proc synsetthr () {
if (numarg()==1) {for ltr(XO,cvode.netconlist("" , "", "")) XO.threshold=$1
} else if (numarg()==2) {for ltr(XO,cvode.netconlist($s1 , "", "")) XO.threshold=$2
} else if (numarg()==3) {for ltr(XO,cvode.netconlist($s1, "", $s2)) XO.threshold=$3
} else if (numarg()==4) {for ltr(XO,cvode.netconlist($s1 , $s2, $s3)) XO.threshold=$4
} else { print "ERROR: too many args" }
if (i1==0) printf("WARNING: nothing set in synsetthr(%s ...)\n",$s1)
}
proc syngetthr () {
if (numarg()==1) {for ltr(XO,cvode.netconlist($s1 , "", "")) printf("%g ",XO.threshold)
} else if (numarg()==2) {for ltr(XO,cvode.netconlist($s1, "", $s2)) printf("%g ",XO.threshold)
} else if (numarg()==3) {for ltr(XO,cvode.netconlist($s1 , $s2, $s3)) printf("%g ",XO.threshold)
} else for ltr(XO,cvode.netconlist("","","")) printf("%g ",XO.threshold)
print ""
}
//** synremove: remove post, pre/post, pre/post/type; synshow
proc synremove () {
if (numarg()==0) { printf("synremove: remove post, pre/post, pre/post/type\n") return }
if (numarg()==1) tmplist = cvode.netconlist("", $s1 , "")
if (numarg()==2) tmplist = cvode.netconlist("", $s1, $s2)
if (numarg()==3) tmplist = cvode.netconlist($s1 , $s2, $s3)
if (tmplist.count>0) for ltr(XO,tmplist) ncl.remove(ncl.index(XO))
tmplist = nil // need to remove these references too
if (numarg()==1) tmplist = cvode.netconlist("", $s1 , "")
if (numarg()==2) tmplist = cvode.netconlist("", $s1, $s2)
if (numarg()==3) tmplist = cvode.netconlist($s1 , $s2, $s3)
if (tmplist.count>0) for ltr(XO,tmplist) printf("ERROR: %s removed from ncl but still exists\n",XO)
tmplist = nil
}
proc synshow () {
sprint(temp_string_,"x=XO.%s",$s2)
for ltr(XO,cvode.netconlist("" , "", $s1)) { execute(temp_string_) printf("%g ",x) }
print ""
}
//* weight setting routines using NQS
//** stwt(PREID,POSTID,WT0[,WT1,norm])
// stwtnorm() causes dividing by individual convergence values
proc stwt () { local w0,w1
if (sp.select(-1,"CODE",EQU1,$1,"CODE",EQU2,$2) ==0) {
printf("WARNING NO CONNECTS FROM %d TO %d\n",$1,$2) return }
w0=$3
if (numarg()>=5) { w0=$3/$5 w1=$4/$5 } else if (numarg()>=4) { w1=$4 }
if (numarg()>=4) sp.fillin("WT0",w0,"WT1",w1) else sp.fillin("WT0",w0)
}
//** strwt(PREID,POSTID,WT0,WT1,psdev[,norm])
proc strwt () { local w0,w1,psdev
cnt=sp.select("CODE",EQU1,$1,"CODE",EQU2,$2)
if (cnt==0) {printf("WARNING NO CONNECTS FROM %d TO %d\n",$1,$2) return }
if (numarg()>=6) { w0=$3/$6 w1=$4/$6 } else { w0=$3 w1=$4 }
psdev=$5
rdm.lognormal(w0,psdev*psdev*w0*w0)
sp.out.v[sp.fi("WT0")].setrand(rdm)
if (w1!=0) {
rdm.lognormal(w1,psdev*psdev*w1*w1)
sp.out.v[sp.fi("WT1")].setrand(rdm)
}
sp.delect()
}
//** strwt2(NQS,WT0,WT1,psdev[,norm])
proc strwt2 () { local w0,w1,psdev
if (numarg()>=5) { w0=$2/$5 w1=$3/$5 } else { w0=$2 w1=$3 }
psdev=$4
rdm.lognormal(w0,psdev*psdev*w0*w0)
$o1.v[$o1.fi("WT0")].setrand(rdm)
if (w1!=0) {
rdm.lognormal(w1,psdev*psdev*w1*w1)
$o1.v[$o1.fi("WT1")].setrand(rdm)
}
}
//** strdel(PREID,POSTID,del,psdev)
proc strdel () { local del0,psdev
if (numarg()==4) {
cnt=sp.select("CODE",EQU1,$1,"CODE",EQU2,$2)
if (cnt==0) {printf("WARNING NO CONNECTS FROM %d TO %d\n",$1,$2) return }
del0=$3 psdev=$4
rdm.lognormal(del0,psdev*psdev*del0*del0)
sp.out.v[sp.fi("DEL")].setrand(rdm)
sp.delect()
} else { del0=$2 psdev=$3
rdm.lognormal(del0,psdev*psdev*del0*del0)
$o1.v[sp.fi("DEL")].setrand(rdm)
}
}
//** clrwt(PRID,POID,%clr)
proc clrwt () { local n
n=round($3*sp.select("CODE",EQU1,$1,"CODE",EQU2,$2))
sp.out.v[sp.fi("WT0")].fill(0,0,n)
sp.delect()
}
//** chksp() confirm correspondance between sp and ncl -- defunct if using multiple ncl
proc chksp () { local prid,poid,pr,po
for ltr(XO,ncl,&x) {
prid=sp.v[0].x[x] poid=sp.v[1].x[x] pr=sp.v[2].x[x] po=sp.v[3].x[x]
if (XO.pre.id!=pr || XO.pre.type!=prid || XO.syn.id!=po || XO.syn.type!=poid) {
printf("%d %d %d %d %d %d %d %d\n",XO.pre.id,pr,XO.pre.type,prid,XO.syn.id,po,XO.syn.type,poid) }}
}
//** swtmap() -- redund code to permit it to run relatively fast
// no longer overloaded to set delay, delmap() or to clr clrwts()
proc swtmap () { local ii,ct,sy,conv,prx,pox,delx,w0x,w1x localobj nc,ty
ty=new Union()
ct=cp.fi("PRID") sy=cp.fi("STYP")
if (PRv.size!=$o1.count) {
printf("swtmap ERR: size discrepency: %d vs %d\n",PRv.size,$o1.count)
return }
for ii=0,PRv.size-1 {
prdx=PRIDv.x[ii] podx=POIDv.x[ii] prx=PRv.x[ii] pox=POv.x[ii]
delx=DELv.x[ii] w0x=WT0v.x[ii] w1x=WT1v.x[ii]
nc=$o1.object(ii)
poo=nc.syn
x=cp.fetch(ct,prdx,sy)
syntyp(x,ty)
nc.weight[ty.x]=w0x
if (ty.x[1]>-1) nc.weight[ty.x[1]]=w1x
nc.delay=delx
}
}
//** wmul(PRID,POID,SYNID,MUL) multiplies set of syns by a factor
// resets from weights stored in sp
double wd0[CTYPi][CTYPi][STYPi] // prior weight delta
for ii=0,CTYPi-1 for jj=0,CTYPi-1 for kk=0,STYPi-1 wd0[ii][jj][kk]=1
proc wmul () { local ii,pr1,po1,sy1,w1,wd,sy2
pr1=$1 po1=$2 sy1=$3 w1=$4
if (wd0[pr1][po1][sy1]==0) {
if (w1!=0) printf("\nWARNING: %s->%s(%s) set to 0 can't reset\n",\
CTYP.o(pr1).s,CTYP.o(po1).s,STYP.o(sy1).s)
return
}
wd=w1/wd0[pr1][po1][sy1]
if (wd!=1) {
XO=ncl[pr1][po1][0]
for ii=0,XO.count-1 XO.o(ii).weight[sy1]*=wd
wd0[pr1][po1][sy1]=w1
} else printf(".")
}
//** wset(PRID,POID,SYNID,WT) resets weights to gaussian dist similar to strwt()
// uses sp to determine how many weights are needed
proc wset () { local num,prx,pox,sox,wet,a,err,psdev localobj v1
prx=$1 pox=$2 sox=$3 wet=$4
if (numarg()==5) psdev=$5*$5 else psdev=0
err=0 a=allocvecs(v1)
if (cp.fetch("PRID",prx,"STYP")==EX && !(sox==AM || sox==NM)) err=1
if (cp.fetch("PRID",prx,"STYP")==IX && !(sox==GA || sox==GB)) err=1
if (err) { printf("cell/syn discrepancy: %d -> %d\n",prx,sox) return }
if (Incol==2) num=sp.select(-1,"CODE",EQU1,prx,"CODE",EQU2,pox) else {
num=sp.select(-1,"CODE",EQU1,prx,"CODE",EQU2,pox,"CODE",EQU3,Incol)
}
v1.resize(num)
if (psdev) {
rdm.normal(wet,psdev*wet*wet)
v1.setrand(rdm)
} else v1.fill(wet)
vwtmap(v1,sp,sox)
dealloc(a)
}
//** wbim(PRID,POID,SYNID,PSDEV,%A,WTA,%B,WTB,...) bimodal weight setting routines
// uses sp to determine how many weights are needed
proc wbim () { local fsz,i,prx,pox,sox,wet,a,err,psdev,pcw,ptot localobj v1,v2
prx=$1 pox=$2 sox=$3 psdev=$4*$4 pcw=$5 wet=$6 ptot=0
err=0 a=allocvecs(v1,v2)
if (cp.fetch("PRID",prx,"STYP")==EX && !(sox==AM || sox==NM)) err=1
if (cp.fetch("PRID",prx,"STYP")==IX && !(sox==GA || sox==GB)) err=1
if (err) { printf("cell/syn discrepancy: %d -> %d\n",prx,sox) return }
fsz=sp.select(-1,"CODE",EQU1,prx,"CODE",EQU2,pox)
for i=5,numarg() {
pcw=$i i+=1 wet=$i //
if (pcw*fsz != int(pcw*fsz)){
printf("wbim WARNING: %d->%d non-int %gx%g=%g\n",prx,sox,pcw,fsz,pcw*fsz) }
v2.resize(int(pcw*fsz))
rdm.normal(wet,psdev*wet*wet)
v2.setrand(rdm)
v1.append(v2)
ptot+=pcw // keep track of percent filled
}
if (ptot!=1) printf("wbim WARNING: %d->%d only %g filled\n",prx,pox,ptot)
if (v1.size!=fsz) {
printf("wbim WARNING: %d->%d size error %d->%d\n",prx,sox,v1.size,fsz)
v1.resize(fsz) }
vwtmap(v1,sp,sox)
dealloc(a)
}
//** vwtmap(VEC,NQS) -- copy weights from a vector onto ncl
// vwtmap(NQS,VEC) -- copy weights from ncl into vector
func vwtmap () { local wix
if (numarg()==3) wix=$3 else wix=0
if (isojt($o2,sp)) { // copy from vector to sp.fcdo weights
if ($o1.size!=$o2.ind.size){
printf("vwtmap ERR: size discrepency: %d vs %d\n",$o1.size,$o2.ind.size)
return 0}
for ii=0,$o1.size-1 $o2.fcdo.o[$o2.ind.x[ii]].weight[wix]=$o1.x[ii]
return $o1.size
} else { // copy from ncl weights to vector
if ($o1.ind.size!=$o2.size){printf("vwtmap WARNING: resizing vec\n") $o2.resize($o1.ind.size)}
for ii=0,$o2.size-1 $o2.x[ii]=$o1.o[$o1.ind.x[ii]].weight[wix]
return $o2.size
}
}
//** wtstat(WIX) -- check id of weights directly from the ncs
// assume that have already been selected in sp.out
proc wtstat () { local wix,a,sz,fnc localobj v1
a=allocvecs(v1)
if (!eqojt(sp.cob,sp.out)) print "WARNING: no sp.select() done"
sz=sp.size(1) fnc=sp.fi("NC")
v1.resize(sz) v1.resize(0)
if (numarg()==1) wix=$1 else wix=0
// for sp.qt(XO,"NC") v1.append(XO.weight[wix]) // 5x slower
for ii=0,sz-1 v1.append(sp.fcdo.o(sp.out.v[fnc].x[ii]).weight[wix])
stat(v1)
dealloc(a)
}
// need to set delays
proc delmap () { local ii,deli,nc0,nc1
nc0=$o1.fi("NC0") nc1=$o1.fi("NC1","NOERR") deli=$o1.fi("DEL")
for ii=0,$o1.v.size-1 {
ncl.object($o1.v[nc0].x[ii]).delay=$o1.v[deli].x[ii]
if (nc1!=-1) if ($o1.v[nc1].x[ii]!=-1) {
ncl.object($o1.v[nc1].x[ii]).delay=$o1.v[deli].x[ii] }
}
}
// clrwtmap
proc clrwts () { local ii,jj,nc0,wt0,deli,nc1,wt1,typ,sy2,wid0,wid1,clr
nc0=$o1.fi("NC0") wt0=$o1.fi("WT0") deli=$o1.fi("DEL")
wid0=$o1.fi("WID0") typ=$o1.fi("TYPE")
nc1=$o1.fi("NC1","NOERR") wt1=$o1.fi("WT1","NOERR") wid1=$o1.fi("WID1","NOERR")
tobj=ncl.object($o1.v[nc0].x[ii])
for ii=0,$o1.v.size-1 {
tobj=ncl.object($o1.v[nc0].x[ii])
for jj=0,tobj.wcnt-1 tobj.weight[jj]=0 // clear
tobj.delay=1 tobj.threshold=0
if (nc1!=-1) if ($o1.v[nc1].x[ii]!=-1) for jj=0,tobj.wcnt-1 tobj.weight[jj]=0 // clear
}
}
// swtchk(sp,"WT0","NC0") compare weights to sp weights
func swtchk () { local ii,jj,nc0,wt0,n
nc0=$o1.fi($s3) wt0=$o1.fi($s2) n=0
for ii=0,$o1.v.size-1 {
if ($o1.v[nc0].x[ii]==-1) continue
tobj=ncl.object($o1.v[nc0].x[ii])
if ($o1.v[wt0].x[ii]==tobj.weight) n+=1 else {
printf("Mismatch %d: %g %g\n",ii,$o1.v[wt0].x[ii],tobj.weight) }
}
tobj=nil
return n/ii
}
// synchk() look for internal consistency
proc synchk () {
for ltr(XO,cvode.netconlist("","","")) if (isassigned(XO.postcell) && XO.weight<0) {
printf("Error for %s with wt %g\n",XO.syn,XO.weight)
}
}
//** getwt() useful in eg sp.spr("<NC0>.c.apply('getwt')")
func getwt () { return NetCon[$1].weight }
spnormflag = 0 // set this flag to normalize weights by number of projections
//** actumb(PRID,POID,WIDTH) -- clears umbrella and then set sp.ind to chosen umbrella
proc actumb () { local width,flag,divisor
width=$3
if (width==-1) flag=1 else flag=0
sp.select(-1,"CODE",EQU1,$1,"CODE",EQU2,$2)
if (! flag) { // width=-1 is flag for full connection
if (sp.fi("WT1")!=-1) sp.fillin("WT0",0,"WT1",0) else sp.fillin("WT0",0)
sp.select(-1,"CODE",EQU1,$1,"CODE",EQU2,$2,"DIST","()",-width,width)
}
if (! spnormflag) { // just set the values
if (sp.fi("WT1")!=-1 && numarg()==5) sp.fillin("WT0",$4,"WT1",$5) else sp.fillin("WT0",$4)
} else { // need to calculate convergence for individual cells here
}
}
//** inline(PRID,POID,WT) sets the in-column weights
proc inline () { local a
sp.select(-1,"CODE",EQU1,$1,"CODE",EQU2,$2,"PR",EQV,"PO")
if (numarg()==4) sp.fillin("WT0",$3,"WT1",$4) else sp.fillin("WT0",$3)
}
// stwtnorm(PREID,POSTID,WT0[,WT1,CONVVEC])
func stwtnorm () { local cv,a,b,ret
a=b=allocvecs(2) b+=1
if (sp.select("CODE",EQU1,$1,"CODE",EQU2,$2)==0) {
printf("WARNING NO CONNECTS FROM %d TO %d\n",$1,$2) return 0 }
sp.uniq("PO") // only retains unique values of PO => cv>0
mso[a].copy(sp.out.v[sp.fi("PO")])
for vtr(&x,mso[a]) {
cv=sp.select(-1,"CODE",EQU1,$1,"CODE",EQU2,$2,"PO",x) // do select without copy to out
mso[b].append(cv)
if (cv>0) {
if (numarg()==4) sp.fillin("WT0",$3/cv,"WT1",$4/cv) else sp.fillin("WT0",$3/cv)
}
}
ret=mso[b].mean // mean convergence
if (numarg()==4) if (argtype(4)==1) $o4.copy(mso[b])
if (numarg()==5) if (argtype(5)==1) $o5.copy(mso[b])
dealloc(a)
return ret
}
// wtnorm(PREID,POSTID) -- normalize the values according to convergence
func wtnorm () { local cv,a,b,ret,wt0,wt1
wt0=sp.fi("WT0") wt1=sp.fi("WT1")
if (sp.select(-1,"CODE",EQU1,$1,"CODE",EQU2,$2)==0) {
printf("WARNING NO CONNECTS FROM %d TO %d\n",$1,$2) return }
a=b=allocvecs(2) b+=1
sp.uniq("PO") // only retains unique values of PO => cv>0
mso[a].copy(sp.out.v[sp.fi("PO")])
for vtr(&x,mso[a]) {
cv=sp.select("CODE",EQU1,$1,"CODE",EQU2,$2,"PO",x)
mso[b].append(cv)
if (cv>0) {
sp.out.v[wt0].div(cv)
if (wt1>-1) sp.out.v[wt1].div(cv)
sp.delect()
}
}
ret=mso[b].mean // mean convergence
dealloc(a)
return ret
}
proc setdist () { sp.spr("DIST","<PR>.c.sub(<PO>).apply('abs')") }
proc stwtvar() { local a,idr
if (numarg()==5) idr=1 else idr=0
a=allocvecs(1)
mso[a].resize(sp.ind.size)
rdm.uniform($3*(1-$4),$3*(1+$4))
mso[a].setrand(rdm)
if (spnormflag) mso[a].div(sp.ind.size)
sp.wt[idr].indset(sp.ind,mso[a])
dealloc(a)
}
//** snc() -- set the actual netcons to the params in sp
DEL=DELD=1
proc snc () { local ii
for ii=0,sp.size-1 {
nc[sp.nc.x[ii]].threshold=0
nc[sp.nc.x[ii]].weight=sp.wt.x[ii]
nc[sp.nc.x[ii]].delay=DEL+DELD*sp.dist.x[ii]
if (sp.nc[1].x[ii]>-1) {
nc[sp.nc[1].x[ii]].weight=sp.wt[1].x[ii]
nc[sp.nc[1].x[ii]].delay=DEL+DELD*sp.dist.x[ii]
}
}
}
//** snci() -- take a vec of indices (eg sp.ind) as arg
proc snci () { local ii,jj
for jj=0,$o1.size-1 {
ii=$o1.x[jj]
nc[sp.nc.x[ii]].weight=sp.wt.x[ii]
nc[sp.nc.x[ii]].delay=DEL+DELD*sp.dist.x[ii]
if (sp.nc[1].x[ii]>-1) {
nc[sp.nc[1].x[ii]].weight=sp.wt[1].x[ii]
nc[sp.nc[1].x[ii]].delay=DEL+DELD*sp.dist.x[ii]
}
}
}
//* informational procs
//** proc print_pp_location(PP), from doc/html/refman/nocmodl.html
proc print_pp_location() { local x //arg1 must be a point process
x = $o1.get_loc()
sectionname(section)
printf("%s located at %s(%g)\n", $o1, section, x)
pop_section()
}
//** pp_loc(PP,LOC,SCRATCH) returns true if point process PP is located in LOC (regexp match)
func pp_loc () { local x //arg1 must be a point process
x = 0
$o1.get_loc()
if (numarg()==3) { sectionname($s3) }
ifsec $s2 { x = 1 }
pop_section()
return x
}
//* ndivo, ncono, sdivo, scono: objects; ndivs, ncons, sdivs, scons: strings
//** for use with INTF
iterator divr () { local ii
for ii=0,ncl.count-1 {
XO=ncl.object(ii)
if (object_id(sfunc.obj(XO.pre.p))==object_id(cells[$1].object($2))) {
iterator_statement
}
}
}
iterator conr () { local ii
for ii=0,ncl.count-1 {
XO=ncl.object(ii)
if (object_id(sfunc.obj(XO.syn.p))==object_id(cells[$1].object($2))) {
iterator_statement
}
}
}
//** iterators
// eg for syt("ns[0]","ns[1]") print XO,YO,nco
iterator syt () { local num,err
err=0
canobj($o1,"XO") canobj($o2,"YO") // canobj -- canonical object
if ((num=cvode.netconlist(XO,"",YO).count)!=1) {
printf("syt() ERROR num==%d (%s,%s)\n",num,XO,YO) err=1 }
if (!err) {
nco=cvode.netconlist(XO,"",YO).object(0)
iterator_statement
}
XO=nil YO=nil nco=nil
}
// nca makes list backwards -- syn, then postcell, then precell
iterator nca () { local ii
tmplist.remove_all
if (numarg()==0) { cvode.netconlist("", "", "",tmplist)}
if (numarg()==1) { cvode.netconlist("", "", $s1,tmplist)}
if (numarg()==2) { cvode.netconlist("", $s2, $s1,tmplist)}
if (numarg()==3) { cvode.netconlist($s3, $s2, $s1,tmplist)}
for ii=0,tmplist.count-1 {
XO=tmplist.object(ii)
iterator_statement
}
}
func wtvec () {
revec(vec)
for nca($s1) vec.append(XO.weight)
vlk(vec)
return vec.size
}
func dlyvec () {
revec(vec)
for nca($s1) vec.append(XO.delay)
vlk(vec)
return vec.size
}
iterator prtr () { local ii
tmplist.remove_all
for ii=0,cvode.netconlist("", $s1, "").count-1 {
nco=cvode.netconlist("", $s1, "").object(ii)
iterator_statement
}
}
iterator potr () { local ii
for ii=0,cvode.netconlist($s1,"","").count-1 {
nco=cvode.netconlist($s1,"","").object(ii)
iterator_statement
}
}
iterator sytr () { local ii
for ii=0,cvode.netconlist("","",$s1).count-1 {
nco=cvode.netconlist("","",$s1).object(ii)
iterator_statement
}
}
proc sdivo () {for ltr(XO,cvode.netconlist($o1, "", "")) prsxo() }
func ndivo () { return cvode.netconlist($o1, "", "").count }
func ncono () { return cvode.netconlist("", $o1, "").count }
proc scono () {for ltr(XO,cvode.netconlist("", $o1, "")) prsxo() }
func ndivs () {
if (numarg()==1) return cvode.netconlist($s1, "", "").count else {
return cvode.netconlist("" , "", "").count }
}
func ncons () { return cvode.netconlist("", $s1, "").count }
proc sdivs () { for ltr(XO,cvode.netconlist($s1, "", "")) prsxo() }
proc scons () {
if (numarg()==0) for ltr(XO,cvode.netconlist("", "", "")) prsxo()
if (numarg()==1) for ltr(XO,cvode.netconlist("", $s1, "")) prsxo()
if (numarg()==2) for ltr(XO,cvode.netconlist("", $s1, $s2)) prsxo()
if (numarg()==3) for ltr(XO,cvode.netconlist($s1, $s2,$s3)) prsxo()
}
// print pre,post,syntype,threshold,weight,delay
proc prsxo () {
if (isobj(XO.precell,"NULLobject")) {
printf("%s:%s->%s (%s) (t%g,w%g,d%g)\n",XO,XO.pre,XO.postcell,XO.syn,XO.threshold,XO.weight,XO.delay)
} else {
printf("%s:%s->%s (%s) (t%g,w%g,d%g)\n",XO,XO.precell,XO.postcell,XO.syn,XO.threshold,XO.weight,XO.delay)
}
}
//* avwtsp(), actwsc(), avwt() to get proper weight values
obfunc sysel () { local pr,po,sy,co,vb,num
if (numarg()==1) sy=$1 else { // already selected
pr=$1 po=$2 sy=$3 co=$4
num=sp.select("CODE",EQU1,pr,"CODE",EQU2,po,"CODE",EQU3,co)
if (num==0) { vec0.resize(0)
return vec0} // kludge to get an error returned
}
if ((pr==IN && sy==GA) || sy==AM) return sp.getcol("WT0",0) else return sp.getcol("WT1",0)
}
//** avwtsp(PR,PO,COL) looks at NQS db to determine weights -- 7x faster than avwt() below
// avwtsp(sp) if do select before checking this
obfunc avwtsp () { local a,s1,s2,pr,po,co,wd localobj sp0,v1,o,vr
pr=$1 po=$2 co=$3 sp0=sp o=new Union()
a=allocvecs(v1)
if (name_declared("netstem")==4) {
sprint(tstr,"%s%sS%02d.spnqs",netstem,CTYP.o(po).s,scale)
if (! strm(tstr,sp0.file)) { printf("Reading %s (was %s)\n",tstr,sp0.file)
sp0.rd(tstr)
}
}
if (pr==IN) {s1=GA s2=GB} else {s1=AM s2=NM}
if (numarg()==4) sp0=$o4.cob else {
sp0.verbose=0
vr=sysel(pr,po,s1,co)
if (vr.size==0 && verbose) {printf("%s->%s EMPTY\n",CTYP.o(pr).s,CTYP.o(po).s) return sp0}}
sp0.verbose=0
wd=ncq.ay(pr,po,s1,co).x
vr.mul(wd)
stat(vr,v1) // 0size,1max,2min,3mean,4sdev
o.x=v1.x[3]
printf("%s->%s %s %s: max: %g; min: %g; mean: %g; sdev: %g\n",\
CTYP.o(pr).s,CTYP.o(po).s,STYP.o(s1).s,INCOL.o(co).s,\
v1.x[1],v1.x[2],v1.x[3],v1.x[4])
wd=ncq.ay(pr,po,s2,co).x
vr=sysel(s2) vr.mul(wd) stat(vr,v1)
o.x[1]=v1.x[3]
printf("%s->%s %s %s: max: %g; min: %g; mean: %g; sdev: %g\n",\
CTYP.o(pr).s,CTYP.o(po).s,STYP.o(s2).s,INCOL.o(co).s,\
v1.x[1],v1.x[2],v1.x[3],v1.x[4])
sp0.verbose=1
dealloc(a)
return o
}
//** actwsc(PR,PO,SY,COCODE,COL,[,tMIN,tMAX])
func actwsc () { local ret,f1,a,wd,we,pr,po,min,max,u,y,x,sy,co,col,prspks,th,conv,diff localobj v1,v2,vr,q,p
if (numarg()==0) {
printf(" actwsc(PR,PO,SY,COCODE,COL,[,tMIN,tMAX])\n") return 0 }
pr=$1 po=$2 sy=$3 co=$4 col=$5
// min,max: just look at activity during this period
if (numarg()>5) {min=$6 max=$7} else {min=0 max=tstop}
if (min==max) f1=0 else f1=1
a=allocvecs(v1,v2) q=new NQS() q.verbose=0 p=printlist
if (f1) {
// find name for raster plot should be eg 'SU'
for ltr(XO,printlist) if (strc(XO.name,CTYP.o(pr).s)) {x=i1 break}
for ixt(pr,col) v2.append(ixi) // get the values for this col
q.resize("time",p.o(x).tvec,"ind",p.o(x).vec)
u=q.select("time","[]",min,max,"ind","[]",v2.min,v2.max) // u=number of spikes in period
min=q.applf(".min","time") max=q.applf(".max","time")
q.out.v.sort() y=q.out.v.uniq() // y= uniq spikers
if (max-min<10) diff=10 else diff=max-min
// prspks = y/diff/numc[pr]*10 // number of spikes in 1 cell spike per 10ms
prspks = y/diff/numc[pr]*ncols*10 // normalize by no. of cols
x=prspks*(conv=cp.fetch("PRID",pr,"POID",po,"CONV")) // incoming spks over 10ms
}
sp.verbose=0 vr=sysel(pr,po,sy,co) sp.verbose=1
if (vr.size==0) {dealloc(a) return -1}
vrsz(ce,v1,"O")
for ixt(po) v1.append(XO.VTH-XO.RMP)
stat(v1,v2) th=v2.x[3] // threhold stats
wd=ncq.ay(pr,po,sy,co).x // current scaling factor
we=4 // 4 cells must fire at about same time to get thresh-level drive
if (f1) {
printf("%s:%d,%d spks/%.2fms ~ %.2f spks/10ms (%d/%d)\n",\
CTYP.o(pr).s,u,y,max-min,prspks,x,conv)
printf("Thresh: %.2f+/-%.2f PSP: %.2f+/-%.2f\n",th,v2.x[4],vr.mean,vr.stdev)
printf("\tFor 1/%d continuous activation: ",we)
// wd *= threshold/spks_in/<PSP>/weighting // wd is scaling_factor
printf("\nwmul(%s,%s,%s,%s,%g)\n",\
CTYP.o(pr).t,CTYP.o(po).t,STYP.o(sy).t,INCOL.o(co).t,\
th/x/vr.mean/we*wd)
ret=th/x/vr.mean/we*wd
} else {
printf("%s->%s %s,%s: %g\n",\
CTYP.o(pr).s,CTYP.o(po).s,STYP.o(sy).s,INCOL.o(co).s,\
vr.mean*wd/th*100) // percent of threshold
ret=vr.mean*wd/th*100
}
dealloc(a)
return ret
}
//** avwt() goes through ncl list to sum weights
proc avwt () { local pr,po,sy,co localobj nc,o
pr=$1 po=$2 sy=$3 co=$4
o=ncq.ay(pr,po,sy,co)
vrsz(o.o.count,ind,"O")
for ltr(nc,o.o) ind.append(nc.weight[sy])
ind.mul(o.x) // mutiply by scale factor
if (ind.mean!=0) {
printf("%s%s %s: ",CTYP.o(pr).s,CTYP.o(po).s,STYP.o(sy).s)
stat(ind)
}
}
//* grvec addendum -- new_printlist_
//** new_printlist_nc(obj,id[,NAME]) records spikes from obj to vitem in printlist
// with NAME creates a new vitem
warn_flag=1
obfunc new_printlist_nc () { local id,thresh,yoset localobj xo,yo
id=$2 thresh=-20 yoset=0
if (!isojt(ncl,tmplist)) ncl=new List()
if (numarg()>=3) {
if (argtype(3)==2) {
printlist.append(yo=new vitem($s3,0))
yoset=1
} else if (argtype(3)==0) { thresh=$3
} else printf("new_printlist_nc arg 3 should be name or thresh\n")
}
if (numarg()>=4) thresh=$4
if (!yoset) if (printlist.count==0) {
printlist.append(yo=new vitem("SPKS",0))
} else {
yo=printlist.object(printlist.count-1) // continue with the last one
}
xo=cvode.netconlist($o1, "", "")
if (xo.count==0) {
if (! warn_flag) printf(".") else {
warn_flag=0 // only warn first time
printf("WARNING (new_printlist_nc) creating NetCon for %s ",$o1) }
if ($o1.fflag) { xo=new NetCon($o1, nil)
} else { $o1.soma xo=new NetCon(&v(x), nil) }
xo.threshold=thresh
ncl.append(xo)
} else {
xo=xo.object(0)
if (xo.threshold!=thresh && isassigned(xo.precell)) {
printf("Warning: new_printlist_nc resetting thresh for %s\n",xo)
xo.threshold=thresh
}
}
xo.record(yo.tvec,yo.vec,id)
return yo
}
//** proc new_printlist_nc2(VITEM,CELL,ID#) -- don't bother looking for an existing synapse
obfunc new_printlist_nc2 () { local id,thresh,yoset localobj xo
id=$3 thresh=-20 yoset=0
if ($o2.fflag) { xo=new NetCon($o2, nil)
} else { $o2.soma xo=new NetCon(&v(x), nil) }
xo.threshold=thresh
ncl.append(xo)
xo.record($o1.tvec,$o1.vec,id)
return xo
}
//** fipre(NETCON) find a presynaptic index for a netcon
func fipre () { local nu
if (isassigned($o1.pre)) { // a point-process
return objnum($o1.pre)
} else {
if ($o1.preloc==-1) {
printf("fipre() ERR: %s\n",$o1) err() }
sscanf(secname(),"%*[^[][%d]",&x) // find number of the cell
// eg grvecstr="PYR2 sINT sTC sRE" // use locations in this string as id
if (sfunc.len(grvecstr)==0) {
return x
} else {
sscanf(secname(),"%[^[]",tstr)
nu=sfunc.substr(grvecstr,tstr)/5
return nu*50+x
}
pop_section()
}
}
//** fspks (index,vec) put spike times for index in vec
// fspks (index,vec,num) use printlist.object(num).vec
// fspks (index,vec,spkvec,tvec)
proc fspks () { local a,b,ix
a=b=allocvecs(2) b+=1
if (numarg()==2) { ix=$1 XO=printlist.object(0).vec YO=printlist.object(0).tvec }
if (numarg()==3) { ix=$1 XO=printlist.object($3).vec YO=printlist.object($3).tvec }
if (numarg()==4) { ix=$1 XO=$o3 YO=$o4 }
revec($o2)
mso[a].indvwhere(XO,"==",ix)
$o2.index(YO,mso[a])
dealloc(a)
}
// fspks1(index,vec)
proc fspks1 () { local a,b,ix
if (numarg()==2) { ix=$1 XO=printlist.object($1).vec YO=printlist.object($1).tvec }
if (numarg()==4) { ix=$1 XO=$o3 YO=$o4 }
$o2.resize(XO.size)
$o2.xing(XO,YO,thresh) // times
}
//** spktimes(plist#,cell#) prints out spike times from a tvec/ivec printlist item
// spktimes(tvec,vec,cell#)
func spktimes () { local sz,wh,a,i localobj va,vb,tv,vv,o
a=allocvecs(va,vb)
i=0 // i serves as flag for saving to a vector
if (numarg()==4) {
tv=$o1 vv=$o2 wh=$3 i=4
} else if (numarg()==3) {
if (argtype(1)==1) {
tv=$o1 vv=$o2 wh=$3
} else {
o=printlist.object($1) wh=$2 vv=o.vec tv=o.tvec
i=3
}
} else {
if (numarg()==2) {
o=printlist.object($1) wh=$2
} else if (numarg()==1) {
o=printlist.object(0) wh=$1
} else wh=-1
vv=o.vec tv=o.tvec
}
sz=vv.size
if (wh==-1) { vlk(tv,vv)
} else {
va.indvwhere(vv,"==",wh)
vb.index(tv,va)
sz=vb.size
if (i) $oi.copy(vb) else vlk(vb)
}
dealloc(a)
return sz
}
//** ceqi() cvode.event_queue_info(3,...)
proc ceqi () { local flag,ii
flag=$1
tmplist.remove_all revec(ind,vec)
printf("\n\n\t**** t=%g ****\n\n",t)
if (flag==3) {
cvode.event_queue_info(3, ind, vec, tmplist)
for ltr(XO,tmplist,100) printf("t=%g flag=%d nc=%s\n",ind.x[i1],vec.x[i1],XO)
} else if (flag==2) {
cvode.event_queue_info(2, ind, tmplist)
for ltr(XO,tmplist,100) { printf("t=%g %s->%s:",ind.x[i1],XO.pre,XO.syn)
for ii=0,XO.wcnt-1 printf("%g ",XO.weight[ii])
print ""
}
} else if (flag==0) {
for ltr(XO,ncl,10) { printf("%s->%s:",XO.pre,XO.syn)
for ii=0,XO.wcnt-1 printf("%g ",XO.weight[ii])
print ""
}
}
}
//** new_printlist_ac(obj,name[,NAME,num])
// adds params from an artificial cell with built-in vec dumping
obfunc new_printlist_ac () { local i,max,num,svloc,sz localobj lo
npacsz=1.2
vdt = vdt_INTF
lo = new Union()
if (numarg()>=4) num=$4
if (numarg()==4) { sprint(lo.s,"%s%d.%s",$s3,$4,$s2)
} else { sprint(lo.s,"%s.%s",$o1,$s2) }
sz=npacsz*tstop/vdt
vite = new vitem(lo.s,sz)
vite.o=$o1
if ($o1.recflag==0) { // record tvec
vite.tvec=new Vector(sz)
$o1.initrec("time",vite.tvec)
} else {
for ltr(YO,printlist) if (eqobj($o1,YO.o)) vite.tvec=YO.tvec
if (!isassigned(vite.tvec)) printf("ERR INTF %s not found in printlist\n",$o1)
}
vite.tvflag=1
$o1.initrec($s2,vite.vec)
printlist.append(vite)
return vite
}
objref pfih
psgchk = 1
proc psend () { local tt
for ltr(XO,printlist) {
if (strm(XO.var,"[()][()]$")) {
revec(XO.vec,XO.tvec)
for (tt=psgchk;tt<=tstop;tt+=psgchk) {
sprint(tstr,"%s.append(%s)",XO.vec,XO.var)
cvode.event(tt,tstr)
sprint(tstr,"%s.append(t)",XO.tvec)
cvode.event(tt,tstr)
}
}
}
}
// eg new_printlist_fc("intf.M1()")
// obsolete since intf.mod no longer defines M1(),M2(),...
obfunc new_printlist_fc () {
if (! isassigned(pfih)) { pfih = new FInitializeHandler("psend()") }
if (! strm($s1,"\\(\\)$")){print "Should be func eg intf.M1()" return }
XO = new vitem($s1,0)
printlist.append(XO)
return XO
}
//* misc and commentary
// con=absolute convergence number, div=absolute div number
// con = %con * pre
// div * pre = con * post = S (total synapses)
// %div = div/post = S/(pre*post) = con/pre = %con
// div = %con * post
// maxdiv = int((1 + var) * div)
//** vari returns randomly chosen $1+/-$2, $2 is a percent
func frani () { return int(rdm.uniform($1,$2+1)) }
func uvari () { return $1 - $1*$2 + (rdm.uniform(0,1) * 2 * $1*$2) }
func gvari () { return $1 - (rdm.normal(0,1) * $1*$2) }
//** clearsyns()
proc clearsyns () {
for ltr(XO,ncl) XO.active(0)
ncl.remove_all
for ltr(XO,new List("NetCon")) printf("**** CLEARSYN WARNING %s STILL EXISTS ****\n",XO)
}
// findstr() look thru list for a string and return the index
func findstr () { local flag
flag = -1 // failure
for ltr(XO,$o2) {
if (strcmp($s1,XO.s) == 0) flag=i1
}
return flag
}
//** syntyp() reads syntyps out of cp directory
proc syntyp () { local x
x=$1
if (x==EX) {$o2.x=AM $o2.x[1]=NM // excit
} else if (x==IX) {$o2.x=GA $o2.x[1]=GB // inhib
} else $o2.x[1]=-1
}
//** excitp(PRE) -> T if cell is excitatory
func excitp () {
if ($1==SU || $1==DP || $1==TC) return 1
if ($1==RE || $1==IN) return 0
printf("ID not classified in excitp\n")
return -1
}
//* Saving and reading
//** svnet() rdnet()
proc svnet () { local ii
ii=0
if (numarg()==1) filename=$s1 else {
sprint(filename,"data/%s%c.net",datestr,97+ii)
while (tmpfile.ropen(filename)) sprint(filename,"data/%s%c.net",datestr,97+ii+=1)
printf("nqsnet output to %s\n",filename)
}
XO=usefiles("nqs.hoc","syncode.hoc","nqsnet.hoc","labels.hoc")
cp.comment=XO.s
sp.comment=XO.s
cp.sv(filename)
sp.sv(filename,1)
tmpfile.close()
}
proc rdnet () {
filename=$s1
if (!isobj(cp,"NQS")) {cp=new NQS() sp=new NQS()}
printf("reading network file %s\n",filename)
cp.rd(filename)
sp.rd() // continue reading
tmpfile.close()
}
//** svstate() rdstate() rerun()
proc svstate () {
if (! isobj(svs,"SaveState")) svs=new SaveState()
svs.save
tmpfile.wopen($s1)
svs.fwrite(tmpfile)
}
proc rdstate () {
if (! isobj(svs,"SaveState")) svs=new SaveState()
tmpfile.ropen($s1)
svs.fread(tmpfile)
svs.restore
}
proc initrr () { printf("WARNING: initrr() -- init for rerun() -- not defined\n") }
proc rerun () { local tstp,told
tstp=tstop
if (numarg()>0) rdstate($s1) else svs.restore
if (numarg()==1) if (argtype(1)==0) tstp=$1
if (numarg()>1) tstp=$2
told=t
initrr()
if (t!=told) {
printf("ERROR: initrr() appears to have reset t (finitialize()?) (%d->%d)\n",told,t)
return
}
sprint(tstr,"cvode.solve(%g)",t+tstp)
time(tstr)
finish()
}
// mkvspks(NUMCELLS,NUMGROUPS,INVL1,SPREAD,[APPEND])
// produces ivspks index vector and vspks time vector for inserting activations
// groups are not stable -- they are reconstituted at each spiking time
// NUMCELLS indices will be drawn from 0..NUMCELLS-1
// NUMGROUPS will give the separate groupings for simultaneous activation across a group
// there will be NUMCELLS/NUMGROUPS cells in each group
// INVL1 is the average interval in ms between the inputs
// SPREAD is the +/- SPREAD/2 sloppiness in this interval
// APPEND is a flag saying to add on to existing ivspks/vspks vectors
proc mkvspks () { local gcnt,numc,numg,inv1,inv2,a,ii,j,apflg localobj iv,tv
numc=$1 numg=$2 inv1=$3 inv2=$4 apflg=0
if (numarg()>=5) if ($5) apflg=1 // 5th arg is append flag
if (!apflg) revec(ivspks,vspks)
gcnt = int(numc/numg) // number of cells in each group
a=allocvecs(iv,tv)
for ({ii=20 j=0};ii<tstop-20;{ii+=inv1 j+=1e-8}) {
iv.indgen(0,numc-1,1) // assume that start from intf#0
shuffle(iv)
iv.resize(gcnt) // now have a set of cells that need to spike at
iv.add(j) // add a little bit to ensure that sortindex below preserves forward time
tv.resize(gcnt)
rdm.uniform(-inv2/2,inv2/2)
tv.setrand(rdm)
tv.add(ii)
ivspks.append(iv) vspks.append(tv)
if (j>=1-1e-8) printf("mkvspks ERR: j>=1\n") // should never happen
}
ivspks.sortindex(iv)
tv.index(vspks,iv) vspks.copy(tv)
tv.index(ivspks,iv) ivspks.copy(tv)
ivspks.rnd()
wvspks.resize(ivspks.size)
dealloc(a)
}
obfunc netconlist () {
if (numarg()==1) {
if (argtype(1)==1) return cvode.netconlist("","",$o1)
if (argtype(1)==2) return cvode.netconlist("",$s2,"")
}
return cvode.netconlist("","","")
}
//* mkncq() -- this may not be useful since will slow down smap() still more
proc smap () { } // stub
proc mkncq () { local pr,po,sy,co localobj o
if (!isassigned(ncq)) {
ncq=new NQS("PRID","POID","SYN","INCOL","SCALE","NCL")
ncq.odec("NCL")
ncq.useslist("PRID",CTYP) ncq.useslist("POID",CTYP)
ncq.useslist("SYN",STYP) ncq.useslist("INCOL",INCOL)
}
ncq.clear()
sp.out.mo(1) // for smap
// no syn specificity for ARTCELLs -- assume no NM w/out AM, no GB w/out GA
for case(&pr,DP,SU,IN) for case(&po,DP,SU,IN) for case(&co,INC,RIT,LFT) {
if (sp.select("CODE",EQU1,pr,"CODE",EQU2,po,"CODE",EQU3,co) == 0) {
// printf("%s->%s (%s) EMPTY\n",CTYP.o(pr).s,CTYP.o(po).s,INCOL.o(co).s)
} else {
if (pr==IN) sy=GA else sy=AM
o=ncl[pr][po][co]
ncq.append(pr,po,sy ,co,1,o) // AM,GA
ncq.append(pr,po,sy+1,co,1,o) // NM,GB
smap(pr,po,sy,co,o)
}
}
}
proc smap () { local prdx,w0x,w1x,pr,po,sy,co localobj o
pr=$1 po=$2 sy=$3 co=$4 o=$o5
for ii=0,PRv.size-1 { // need prior sp.out.mo(1)
w0x=WT0v.x[ii] w1x=WT1v.x[ii]
nc=new NetCon(ce.o(PRv.x[ii]),ce.o(POv.x[ii]),-10,DELv.x[ii],0)
o.append(nc)
for kk=0,nc.wcnt-1 nc.weight[kk]=0
if (pr==IN) {
nc.weight[GA]=w0x
if (w1x>0) nc.weight[GB]=w1x
} else {
nc.weight[AM]=w0x
if (w1x>0) nc.weight[NM]=w1x
}
}
}
proc smap () { printf("NOW using dedicated smap() routines in network.hoc") }
// END /usr/site/nrniv/local/hoc/syncode.hoc
//================================================================
// END init.hoc
//================================================================
// load_file("bsticknet.hoc")
objref jit, cells, ce, nclist, netcon, aml, gal
{ce=new List() cells=new List() aml=new List() gal=new List() nclist=new List()}
for ii=0,CTYPi-1 numc[ii]=0
{numc[SU]=100 ix[SU]=0 ixe[SU]=ix[SU]+numc[SU]-1}
{numc[IN]=25 ix[IN]=ixe[SU]+1 ixe[IN]=ix[IN]+numc[IN]-1}
{numc[SM]=1 ix[SM]=ixe[IN]+1 ixe[SM]=ix[SM]+numc[SM]-1}
allcells=numc[SU]+numc[IN]
scrsz=10*allcells
double pmat[CTYPi][CTYPi],wmat[CTYPi][CTYPi],wd0[CTYPi][CTYPi]
double scr[scrsz],div[CTYPi][CTYPi],delm[CTYPi][CTYPi],deld[CTYPi][CTYPi]
// S==div*PR==conv*PO; %div*PO*PR==S==%con*PR*PO; %div=%con=pmat; div=pmat*PO
pmat[SU][SU] = 0.25
pmat[SU][IN] = 0.7
pmat[SM][SU] = 0.2
pmat[SM][IN] = 0.5
pmat[IN][SU] = 0.2
pmat[IN][IN] = 0.2
wmat[SU][SU] = 0.37
wmat[SU][IN] = 0.50
wmat[SM][SU] = 0.35
wmat[SM][IN] = 0.45
wmat[IN][SU] = 0.33
wmat[IN][IN] = 0.33
{delm[SU][SU] = 3.0 deld[SU][SU] = 0.2 }
{delm[SU][IN] = 1.0 deld[SU][IN] = 0.05}
{delm[IN][SU] = 1.0 deld[IN][SU] = 0.05}
{delm[IN][IN] = 2.2 deld[IN][IN] = 0.05}
{delm[SM][SU] = 2.0 deld[SM][SU] = 0.2 }
{delm[SM][IN] = 2.0 deld[SM][IN] = 0.2 }
//Network cell templates
// B_BallStick
//Artificial cells
create acell_home_
access acell_home_
// SE_NetStim
//* template B_BallStick
begintemplate B_BallStick
public is_art
public init, topol, basic_shape, subsets, geom, memb
public syn, x, y, z, position, connect2target
public soma, dend
public all,ident,type,jc,nc,fflag,newsyn
external STYPi,AM,GA,GB,NM,thresh,IN
external lambda_f
objref syn[1],jc,all,nc
proc init () {
ident=$1 type=$2
fflag=0
topol()
subsets()
geom()
biophys()
geom_nseg()
synapses()
x=y=z=0 // only change via position
}
create soma, dend
proc topol() { local i
connect dend(0), soma(1)
basic_shape()
}
proc basic_shape() {
soma {pt3dclear() pt3dadd(0, 0, 0, 1) pt3dadd(15, 0, 0, 1)}
dend {pt3dclear() pt3dadd(15, 0, 0, 1) pt3dadd(105, 0, 0, 1)}
}
proc subsets () { local i
objref all
all=new SectionList()
soma all.append()
dend all.append()
}
proc geom() {
forsec all { }
soma { /*area=500 */ L=diam=12.6157 }
dend { L=200 diam=1 }
}
proc geom_nseg() {
forsec all { nseg=int((L/(0.1*lambda_f(100))+.9)/2)*2 + 1 }
}
proc biophys() {
forsec all {
Ra=100
cm=1
}
soma {
insert hh
gnabar_hh=0.12
gkbar_hh=0.036
gl_hh=0.0003
el_hh=-54.3
}
dend {
insert pas
g_pas=0.001
e_pas=-65
}
}
proc position() { local i
soma for i=0, n3d()-1 {
pt3dchange(i, $1-x+x3d(i), $2-y+y3d(i), $3-z+z3d(i), diam3d(i))
}
x=$1 y=$2 z=$3
}
obfunc connect2target () { localobj ncn
ncn=new NetCon(jc, $o1.newsyn(type,ident))
return ncn
}
obfunc newsyn () { local ty,id localobj sy
ty=$1 id=$2
if (ty==IN) {
dend syn[GA].append(sy=new expsyn(0.1)) // I
sy.e=-80 sy.tau=5
} else {
dend syn[AM].append(sy=new expsyn(0.8)) // E
sy.e=0 sy.tau=2
}
sy.prid=id sy.prty=ty sy.poid=ident sy.poty=type
return sy
}
proc synapses () {
objref syn[STYPi]
syn[AM]=new List() syn[GA]=new List()
jc=new JitCon(ident,type)
soma nc=new NetCon(&v(0.5),jc)
nc.weight=1 nc.delay=0 nc.threshold=thresh
}
func is_art() { return 0 }
endtemplate B_BallStick
//* template SE_NetStim
begintemplate SE_NetStim
public pp, connect2target, x, y, z, position, is_art, ident, type, jc, fflag, nc
external acell_home_,SM
objref pp,jc,nc
proc init () {
ident=$1 type=$2
fflag=1 // same as is_art()
acell_home_ pp=new NStim(0.5)
pp.interval=5
pp.number=1e9
pp.noise=0.0
pp.start=0
jc=new JitCon(ident,type)
nc=new NetCon(pp,jc)
nc.weight=1 nc.delay=0
}
func is_art() { return 1 }
obfunc connect2target () { localobj ncn
ncn=new NetCon(jc, $o1.newsyn(SM,ident))
return ncn
}
proc position(){x=$1 y=$2 z=$3}
endtemplate SE_NetStim
//* Network specification interface
func cell_append () { localobj st
st=new String($s1)
sprint(st.s,"cells.append(new %s(%g,%g))",st.s,$2,$3)
execute(st.s)
return cells.count-1
}
func nc_append () { local styp,wt,del localobj src,targ,netcon
src=cells.o($1) targ=cells.o($2) styp=$3 wt=$4 del=$5
if (targ.is_art()) { // attempting connect to a netstim
print "Connecting to netstim not currently implemented"
return 0
}
netcon=src.connect2target(targ)
netcon.weight=wt netcon.delay=del
nclist.append(netcon)
return nclist.count-1
}
//* Network instantiation
proc makecells () {
for ii=ix[SU],ixe[SU] cell_append("B_BallStick", ii, SU)
for ii=ix[IN],ixe[IN] cell_append("B_BallStick", ii, IN)
for ii=ix[SM],ixe[SM] cell_append("SE_NetStim" , ii, SM)
}
proc connec () {local a,x,prty,poty,prid,poid,syty,ii,jj,kk,w,dv,flag,seed,weed\
localobj vpo,vw,vw1,vd,xo,rw,rd,vpoa,vda
rdmuniqm4=1
nclist.remove_all
if (jit==nil) {
for ltr(xo,cells) {
if (xo.is_art()) {
aml.append(aml) gal.append(gal) ce.append(xo.jc) // place holders
} else {
aml.append(xo.syn[AM]) gal.append(xo.syn[GA]) ce.append(xo.jc)
}
}
jit=ce.o(0) // use for global calls
jit.jitcondiv()
}
a=allocvecs(vpo,vw,vw1,vd,vpoa,vda,allcells) // vecs for random poid,wts,dels
// rw=new Random() rd=new Random() rd.normal(2.2,0.1) // use same del variability throughout
for case(&prty,SM,SU,IN,&ii) { // presynaptic types
if (prty==IN) syty=GA else syty=AM // synapse type
for prid=ix[prty],ixe[prty] { // iter prid through each presyn of type prty
vrsz(0,vda,vpoa) // accumulators
for case(&poty,SU,IN,&jj) if ((dv=int(numc[poty]*pmat[prty][poty]))>0) {
div[prty][poty]=dv
vrsz(dv,vd)
flag=0 vpo.resize(0) seed=prty*allcells+poty*10+prid
vd.setrnd(4,2*0.1*2.2,seed) vd.add(0.9*2.2) // random weights,delays and ids:
// rdmuniq(vec,N,min,max,seed) generates divergence list; no redundancy
rdmuniq(vpo,dv,ix[poty],ixe[poty],seed)
w=wmat[prty][poty] vw1.resize(1) vw.resize(0)
for vtr(&kk,vpo) { // build vw piecemeal so each w is related to a seed
weed=prty*allcells+poty*100+prid*10+kk
vw1.setrnd(4,2*0.01*w,weed) // (0.99*w,1.01*w)
// print w,vw1.x[0],weed,prid,kk // compare output:jitcon.mod_17:282
vw.append(vw1.x[0])
}
vw.add(0.99*w)
if (vpo.contains(prid)) { // no self connect
vpo.remove(vwh(vpo,prid)) vrsz(-1,vw,vd) flag=1
}
for vtr2(&poid,&w,vpo,vw,&kk) nc_append(prid,poid,syty,w,vd.x[kk])
vpoa.append(vpo) vda.append(vd)
if (flag) vrsz(dv,vw,vd)
}
ce.o(prid).setdvi(vpoa,vda) // don't want to overwrite the jitcon lists
}
}
rdmuniqm4=0
dealloc(a)
}
//* run stuff
tstop=1e2
method("implicit")
proc prl () { local ii,ty localobj st,l,xo,vit
st=new String2() l=new List("JitCon")
printlist.remove_all
if (1) for ltr(xo,l,&ii) {
if (ii==0) {
vit=new_printlist_nc(xo, ii, "JitCon")
} else {
new_printlist_nc2(vit, xo, ii)
}
}
if (1) for ltr(xo,cells,&ii) {
if (ii==0) {
vit=new_printlist_nc(xo, ii, "Cells")
} else {
if (xo.fflag) xo=xo.pp
new_printlist_nc2(vit, xo, ii)
}
}
for case(&ty,SU,IN) for (ii=ix[ty];ii<ix[ty]+1e1 && ii<=ixe[ty];ii+=1) { // first 10
sprint(st.s,"cells.o(%d).soma.v(0.5)",ii) sprint(st.t,"%s%d",CTYP.o(ty).s,ii)
new_printlist_item(st.s,st.t)
}
}
makecells()
connec()
prl()
ap()
proc runeg () {
jit.flag("jcn",0,1) // unset all of the JitCon (jcn) flags
printf("running %d cells using NetCons (red)\n",allcells)
run()
{panobj.gvmarkflag=1 panobj.color=2 panobj.line=8}
gv(1)
jit.flag("jcn",1,1) // set all of the JitCons (jcn) flags
printf("running %d cells using JitEvent and JitWeight (blue)\n",allcells)
run()
{panobj.super=1 panobj.color=3 panobj.line=5}
gv(1)
}
xpanel("run model")
xbutton("click here to run model","runeg()")
xlabel("(takes about a minute)")
xpanel()
// END bsticknet.hoc
//================================================================