-
Notifications
You must be signed in to change notification settings - Fork 2
/
nqs.hoc
3594 lines (3453 loc) · 126 KB
/
nqs.hoc
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
// $Id: nqs.hoc,v 1.678 2010/12/13 17:57:28 billl Exp $
// primarily edited in nrniv/place
if (!name_declared("VECST_INSTALLED")) {
printf("NQS ERROR: Need vecst.mod nmodl package compiled in special.\n")
quit()
}
if (!VECST_INSTALLED) install_vecst()
if (! name_declared("datestr")) load_file("setup.hoc")
load_file("decvec.hoc")
objref g[10]
gvmarkflag=0
declared("file_len")
strdef execstr,strform
strform="%s "
//* stubs for ancillary programs
double sops[21] // 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,fcdv,fcdl,sstr // strings and vecs
public objl,verbose,tmplist,vlist,vl,vlc,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,unpad,delect,fill,uniq,gr,clear,strdec,coddec,odec,fdec,vdec
public join,fillin,fillv,otl,selall
public unuselist,useslist,delrow,elimrepeats,grow,shuffle,fewind,listvecs,loose,rdcols,rdcols2
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
public cindx,mkind,cindcol,mset,mget,covarc,tomatc,noheader,csel,newval,rddif,rdatf,transpose
objref v[1],s[1],is[4],x,nil,ind,scr[3],fcd,fcds,fcdo,fcdv,fcdl,this,objl
objref cob,out,up,Xo,Yo,oval,tmplist,otl,vlist,vl,vlc,info,cindx
strdef comment,file,sstr,sstr2,sstr3,sstr4,tstr,sval,nqsvers,marksym
double m[1],refs[1]
external readnums,savenums,rdvstr,wrvstr,sfunc,repl_str,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,split
external file_len,nqsdel,chsel2,grsel2,oform,nqsselcp,tmpobj,fln,fln_lnum
//** init()
proc init () { local i,ii,flag,ofl,scnt,na,fl,rdflag
refs=-1 CODTY=10 FUNTY=11 VECTY=12 verbose=1
noheader=nval=fl=scnt=ofl=flag=rdflag=ni=0 // flag set if creating the internal NQS
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<=-10) {
flag=1 up=$o2 fl=2 ofl=-($1+10)
m=up.m
if (ofl) {
objref v[m]
for ii=0,m-1 v[ii]=new Vector()
} else if (m>0) {
objref v[m],s[m]
for ii=0,m-1 {v[ii]=new Vector() s[ii]=up.s[ii]}
}
fcd=up.fcd
fcds=up.fcds fcdl=up.fcdl fcdo=up.fcdo fcdv=up.fcdv // finish creation of .out here
} else if ($1<0) { // flag to create a large set of vectors with no labels and no .out
fl=2 noheader=ofl=-$1
if (argtype(2)==0) m=$2 else m=$o2.count()
objref v[m]
for ii=0,m-1 v[ii]=new Vector() // no s[ii] strings
if (argtype(2)==1) for ii=0,m-1 v[ii].copy($o2.o(ii))
} else {
m=$1
objref v[m],s[m]
for ii=0,m-1 { v[ii]=new Vector() s[ii]=new String2() }
}
}
if (fl!=1 && na==scnt) { // all strings
fl=2 // all args taken care of
m=na
objref v[m],s[m]
for ii=0,m-1 {i=ii+1 v[ii]=new Vector() s[ii]=new String2($si) }
}
if (fl!=2 && na>=2) if (argtype(2)==0) {
fl==2 // all args taken care of
for ii=0,m-1 v[ii].resize($2)
}
if (fl!=2) { // if first arg is not a string these other can be
if (na>=2) file=$s2
if (na>=3) comment=$s3
if (na>=4) x.x[0]=$4
}
if (!flag) {
// fcd gives field codes according to values used for argtype()
fcds=new List() fcd=new Vector(m) tmplist=new List() vlist=new List()
fcd.resize(m) fcd.fill(0) // field codes to have a field that's string based
}
x=new Vector(m) ind=x.c for ii=0,2 scr[ii]=x.c
scr.resize(0) ind.resize(0)
objl=new List() cob=this
v0sz=slorflag=0
qtset=0
chunk=100
info=new Union()
nqsvers="$Id: nqs.hoc,v 1.678 2010/12/13 17:57:28 billl Exp $" svvers=-1
if (!flag && ofl!=2) {
out=new NQS(-10-ofl,this)
if (rdflag==1) rd($s1)
if (rdflag==2) copy($o1)
}
chk()
}
// deallocate the attached nqs if destroyed
// after build NQS should have external pointer and out.up pointer +/- cob
// NB: 'this' is created and destroyed as needed
proc unref () {
return
// if (isassigned(out)) printf("AA:%d ",$1) else printf("BB:%d ",$1)
if ($1<=refs) { // don't bother if have more than 2 refs or if currently building
if (m>=0 && isassigned(out)) { // only do it on a live master nqs
if ($1<2 || eqobj(cob,out.up)) { // means that only up are left
m=-7 // indicate have started the process so don't reenter here
printf("Entering destructor for %s: %d %d %s %s %s\n",out.up,$1,refs,cob,out,out.up)
out.unref(-1) // take care of out first
}
}
}
if ($1==-1) { // for .out
cob=nil
up=nil
} else if (m==-7) { // should only be done once
m= -8
// printf("Removal of %s on call %d\n",out.up,$1)
if (isassigned(fcdo)) fcdo.remove_all
if (isassigned(fcds)) fcds.remove_all
if (isassigned(fcdv)) fcdv.resize(0)
cob=nil
up=nil
}
}
//** make sure there are no inconsistencies -- also set vl
func chk () { local ii,jj,ret
ret=1
if (out!=nil && !noheader) {
for ii=0,m-2 for jj=ii+1,m-1 {
if (sfunc.len(s[ii].s)>0 && strcmp(s[ii].s,s[jj].s)==0) {
printf("NQS:chk ERRA: %s col: %s(%d) %s(%d) with same name\n",this,s[ii].s,ii,s[jj].s,jj)
ret=0
}
}
}
listvecs(vl)
return ret
}
//** tog() toggle flag that determines whether actions are on out or this
func tog () { local ret
if (eqobj(cob,out)) ret=20 else ret=10 // report old value
if (numarg()==0) {
if (eqobj(cob,out)) { cob=this if (verbose) print "Operate on full db"
} else { cob=out if (verbose) print "Operate on output of select"
}
} else if (numarg()==1) {
if (argtype(1)==0) {
if ($1>=10) { // set
if ($1==10) cob=this else if ($1==20) cob=out else printf("tog ERRA:%d\n",$1)
} else { // just give information
if (eqobj(cob,out)) { print "Using output db"
} else { print "Using full db" }
}
} else if (argtype(1)==2) { // out,output,selected to choose these
if (strm($s1,"[Oo][Uu][Tt]") || strm($s1,"[Ss][Ee][Ll]")) {
cob=out
} else {
cob=this
}
}
}
return ret
}
//** sethdrs() set the column names to given args
// sethdrs(#,"NAME") sethdrs("NAME1","NAME2",...) sethdrs(nq) -- copy from nq
proc sethdrs () { local i,nm
nm=numarg()
// out.s should always be a pointer to s but early on was keeping different copies:
if (! eqobj(s,out.s)) printf("sets INTERRA\n")
if (nm==2 && argtype(1)==0) {
s[$1].s=$s2
} else if (nm==1) {
if ($o1.m!=m) resize($o1.m)
for i=0,m-1 s[i].s=$o1.s[i].s
} else {
if (nm>m) {
if (batch_flag) {
printf("NQS sets WARNING resized table from %d to %d\n",m,nm)
} else if (! boolean_dialog("Resize TABLE?","YES","NO")) return
printf("resizing TABLE: %d -> %d\n",m,nm) resize(nm)
}
for i=1,nm { s[i-1].s=$si }
}
}
// gethdrs() print the strings
proc gets () { printf("gets() changed to gethdrs()\n") }
proc gethdrs () { local ii,jj,kk,mm localobj o
if (numarg()==1) {
if ($1==-1) { // set the strings
if (!batch_flag && sfunc.len(s[0].s)!=0) {
printf("Overwrite headers for %s? (y/n) ",this)
getstr(tstr) chop(tstr)
if (strcmp(tstr,"y")!=0) return
}
o=new String("%s%c")
for ii=0,m-1 {
jj=ii%26 kk=int(ii/26)+1
for mm=1,kk sprint(s[ii].s,o.s,s[ii].s,65+jj)
}
} else if ($1==1) { // show the types of fields
for ii=0,m-1 printf("%s(%d) ",s[ii].s,fcd.x[ii])
} else if ($1==2) { // just the names
for ii=0,m-1 printf("%s ",s[ii].s)
}
} else {
for ii=0,m-1 printf("%s(%d) ",s[ii].s,ii) // field numbers
}
}
//* selone(COL,VAL[,FLAG]) -- uses vec.slone when just working with one col and one value
func selone () { local val,niflag
if (numarg()==3) niflag=$3 else niflag=0 // use if searching repeatedly through same vec
tog("DB") // start at full db
if (argtype(1)==2) fl=fi($s1) else fl=$1
if (fl==-1) return
val=$2
// if (!v[fl].ismono) {printf("NQS selone: must sort on %s before using\n",s[fl].s) return -1}
if (niflag) ni=ind.slone(v[fl],val,ni) else ni=ind.slone(v[fl],val)
if (selcp) {
if (ind.size==0) {
if (verbose) printf("None selected\n")
} else {
out.ind.copy(ind)
aind()
cob=out
}
} else cob=this
return ind.size
}
//* ay() is an n-dim associative array with p return values
// emulate a high-dim sparse array with optional string args, eg
// nq.ay("SU","IN",7,2,12).x // like nq_array["SU"]["IN"][7][2][12]
// an associative array could do same with non-numeric indices
// here if we have m cols can use any n of them as indices and rest are return values up to
// what a Union() can hold (2 strings, 2 objs, 2 doubles)
// if want to ignore one index can use OK as a globbing value
// for SET use an explicit set aa[5][4][7][2][12]=17 -> nq.ay(5,4,7,2,12,SET,17)
// select based on first n cols and always using EQU or SEQ
// gives more feel of an array -- assumes columns are IND0,IND1,...,VAL
// keys are SET to begin setting values, and OK to leave a value as is
// noninteger must be a set value
// eg XO=ncq.ay(SU,SU,AM,INC,SET,OK,List[35])
// alternate use with specific labels for things to be set eg
// eg XO=ncq.ay(SU,SU,AM,SET,"del",2.2,"wt")
obfunc ay () { local a,b,i,j,jo,k,na,flag,done,ix,nx,sx,ox,fl localobj key,arg,o
if (numarg()==0) {
printf("ay(I0,I1 ...[SET,V1,V2 ...])\n") return o }
tog("DB") // start at full db
a=allocvecs(key,arg)
o=new Union() o.err=1 // assume .err set to return errors
na=numarg()
vlist.remove_all
ind.resize(v.size)
if (argtype(1)==1) for ii=0,$o1.size-1 {
key.append(EQU) arg.append($o1.x[ii],0) vlist.append(v[ii])
flag=0 j=b=$o1.size
if (numarg()>1) if ($2==SET) {i=3 flag=1}
} else {
for ({i=1 flag=0 done=0} ; i<=na && !flag; {i+=1 done=0}) {
if (argtype(i)==2) {
if (fi($si,"NOERR")!=-1) break else if (fcd.x[i-1]!=2) {
printf("ay ERRA: %d %d\n",fcd.x[i-1],argtype(i)) dealloc(a) return o
}
for (j=0;j<fcds.count && !done;j+=1) if (strcmp(fcds.o(j).s,$si)==0) {
key.append(EQU) arg.append(j,0) vlist.append(v[i-1]) done=1
}
if (!done) {printf("%s ay 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==GET) { flag=2 // this is a value to start retrieval
} else 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 WARNING: mult rows %d (using %d)\n",this,ind.size,ind.x[0])
if (ind.size==0) { // printf("%s ay ERRBB: none selected\n",this)
dealloc(a) return o }
ix=ind.x[0] // just getting the first row of this
if (i==na && argtype(i)==2) if ((fl=fi($si,"NOERR"))!=-1) { // return just 1 with col label
j=getval(fl,v[fl].x[ix],ix)
if (j==0) o.x=nval else if (j==1) o.o=oval else if (j==2) o.s=sval
dealloc(a)
o.err=0
return o
}
for (;i<=na && flag==1;{i+=1 j+=1 jo=0}) { // set using the rest of the args
if (argtype(i)==0) if ($i==OK) continue // don't set this one
if (argtype(i)==2) {
if (strcmp($si,"")==0) continue // don't set this one
if ((k=fi($si,"NOERR"))!=-1) {jo=j j=k i+=1}
}
if (argtype(i)!=fcd.x[j]) {
printf("%s ay ERRC: %d %d %d\n",this,i,fcd.x[j],argtype(i)) dealloc(a) return o }
if (argtype(i)==0) { v[j].x[ix]=$i
} else if (argtype(i)==1) { set(j,ix,$oi) print $oi,ix
} else if (argtype(i)==2) { set(j,ix,$si)
} else {printf("%s ay ERRD: set %d not implemented\n",this,argtype(i)) dealloc(a) return o}
if (jo) j-=1 // back up: perhaps can but would be a bad idea to mix setting stuff
}
nx=sx=ox=-1
if (flag==2) {i=b if ((b=fi($si,"NOERR"))==-1) {
printf("nqs:ay() GET ERR %s not found\n",$si) return o }}
for (i=b;i<m;i+=1) { // return values -- get 10 of each
j=getval(i,v[i].x[ix],ix)
if (j==0) {
nx+=1
if (nx>=10) continue
o.set(s[i].s,nval)
} else if (j==1 || j==2) {
ox+=1 // string is handled as String obj
if (ox>=10) continue
if (j==2) o.set(s[i].s,sval) else o.set(s[i].s,oval)
}
}
dealloc(a)
o.err=0
return o
}
//* select() -- based loosely on SQL select
func select () { local ii,i,tmp,tmp1,ret,isv,key,arg,vc,selcpsav,savind,union,not,rxpflg localobj o
if (numarg()==0) { out.cp(this,2) cob=out return v.size }
tog("DB") // start at full db
if (size(1)==-1) { printf("%s:select ERR0: cols not all same size\n",this) return -1 }
// key holds OPs; arg holds ARGs; vc holds COL NAMEs
key=arg=vc=allocvecs(3) arg+=1 vc+=2 // key is an operator, arg is args, vc is col#
selcpsav=selcp i=1 not=rxpflg=union=savind=0
tmplist.remove_all vlist.remove_all
if (argtype(i)==0) if ($1==-1) {selcp=0 i+=1} // else is a number identifying a vector
if (argtype(i)==2) { // check first string for &&, ||, !
if (strcmp($si,"&&")==0) { savind=1 union=0 i+=1
} else if (strcmp($si,"||")==0) { savind=1 union=1 i+=1
} else if (strcmp($si,"!")==0) { savind=0 not=1 i+=1
} else if (strcmp($si,"&&!")==0) {savind=1 not=1 i+=1
} else if (strcmp($si,"||!")==0) {savind=1 union=1 not=1 i+=1 }
} else if (argtype(i)==1) { i+=1
if (argtype(i)==1 && argtype(i+1)==1) { // 3 vectors in a row are preset info for slct()
if (numarg()!=3) { printf("%s:select ERR0: 3 vecs should be mso[key],mso[arg],cols\n",this)
dealloc(key) return -1 }
if ($o1.size!=$o3.size || $o1.size*2!=$o2.size) {
printf("%s:select ERR0c: size problem %d %d %d\n",this,$o1.size,$o2.size,$o3.size)
dealloc(key) return -1 }
i=4 // have sucked up all the args
mso[key].copy($o1) mso[arg].copy($o2)
for ii=0,$o3.size-1 vlist.append(v[$o3.x[ii]])
} else if (isobj($o1,"Vector")) { ind.copy($o1) savind=1 union=0 // assume &&
} else {
printf("%s:select ERR0a: first vec obj should be ind vector\n",this) dealloc(key) return -1 }
}
if (savind) scr.copy(ind) else scr.resize(0)
while (i<=numarg()) {
if (argtype(i)==2) {
if (strcmp($si,"IND_")==0) {
if ((vn=fi($si,"NOERR"))!=-3) {
printf("NQS:select() WARNING: IND_ is a reserved word: ?%s\n",s[vn].s) }
vn=-1e9 scr[1].indgen(0,v.size-1,1) tmplist.prepend(scr[1])
} else if ((vn=fi($si))<0) { dealloc(key) return -1 }
sstr=$si // save for join: use with "NAME",EQW,OTHER_NQS
} else if (argtype(i)==0) { vn=$i // can avoid repeated string search
if (vn<0 || vn>=m) {
printf("%s:select ERR0b: can't ident arg %d: %d\n",this,i,vn) dealloc(key) return -1}
if (s[vn]!=nil) sstr=s[vn].s else sstr="UNDEFINED"
} 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-loose tmp1=$i+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-loose tmp1=$i+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<=EQY) { // pick up a vector
if (isobj($oi,"Vector")) {
if ($oi.size==0) {printf("%s:select ERR2a3: EQ[WXY] with empty vec %s\n",this,$oi)
dealloc(key) return -1}
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: EQ[WXY] needs Vec or NQS not %s?\n",this,$oi)
dealloc(key) return -1
}
} else { printf("%s:select ERR2d only EQ[WXY] 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")
}
// csel() puts col#s in ind
// csel(colname) select by column header
// csel("OP",arg1[,arg2]) runs oform() on each col then runs OP() on result
// eg with oform(){return $o1.count(0)} then csel("==",3) finds cols with 3 zeros
func csel () { local a,ii localobj v1
a=allocvecs(v1,m)
if (eqobj(cob,out) && verbose) printf(" *Selected* ")
if (numarg()==1) {
for ii=0,m-1 if (strm(s[ii].s,$s1)) v1.append(ii)
ind.copy(v1)
} else {
for ii=0,m-1 v1.append(oform(cob.v[ii]))
if (numarg()==2) { ind.indvwhere(v1,$s1,$2)
} else { ind.indvwhere(v1,$s1,$2,$3) }
}
dealloc(a)
return ind.size
}
//** complement() ind -> !ind
proc complement () { local a,b
a=b=allocvecs(2) b+=1
mso[a].indgen(0,size(1)-1,1)
mso[b].resize(mso[a].size)
mso[b].cull(mso[a],ind)
ind.copy(mso[b])
dealloc(a)
}
//** delect([NQS])
// move the selected rows from the out db [or other] back to the main db
// the assumption is that you have operated on some of the fields and now want to
// put the rows back
// ind must not have been altered since it will be used to replace the items
func delect () { local beg,ii,flag
scr.resize(v.size)
if (numarg()==1) flag=1 else flag=0
if (flag) {
if (m!=$o1.m){
printf("NQS:delect ERRa m mismatch: %s:%d vs %s:%d\n",this,m,$o1,$o1.m) return -1 }
ind.copy($o1.ind)
} else if (out.ind.size==0) { return 0
} else if (!out.ind.eq(ind) || ind.size!=out.v.size) {
printf("NQS:delect ERR ind size mismatch\n")
return -1
}
for (beg=0;beg<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) {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]
}
//** mkind(COL) sort by COL and then use mkind to put index of a single col in cindx vector
obfunc mkind () { local fl
if (eqobj(cob,out) && verbose) printf(" *Selected* ")
if (cindx==nil) cindx=new Vector(1e3)
if (argtype(1)==0) fl=$1 else fl=fi($s1)
cindcol=fl
sort(fl)
v[fl].mkind(cindx)
if (argtype(2)==1) $o2.copy(cindx)
return cindx
}
//** set("name",IND,VAL)
proc set () { local fl,ix,sel
sel=0
if (eqojt(cob,out)) { sel=1
if (verbose) printf("NQS set() WARNING: setting value in Selected db\n") }
if (argtype(1)==2) fl=fi($s1) else fl=$1
ix=$2
if (fl==-1) return
if (ix<0) ix=cob.v[fl].size+ix
// 2 LINE 'SET' MACRO
if (ix> cob.v[fl].size) { // nonexistent row
printf("%s set ERRA: col %s size %d<%d\n",this,s[fl].s,v[fl].size,ix) return
} else if (ix==cob.v[fl].size) { // single col expansion
if (sel) {printf("%s set() ERR: can't expand Selected db\n",this) return}
cob.v[fl].resize(ix+1)
}
if (argtype(3)==0) { cob.v[fl].x[ix]=$3
} else {
if (argtype(3)==1) oval=$o3 else if (argtype(3)==2) sval=$s3
cob.v[fl].x[ix]=newval(argtype(3),fl)
}
}
//** sets(IND,COLA,VAL[,COLB,VAL,...])
proc sets () { local fl,ix,i,sel,sz
sel=0 ix=$1
if (eqojt(cob,out)) { sel=1
if (verbose) printf("NQS set() WARNING: setting value in Selected db\n") }
if (ix>=cob.v.size){
printf("NQS sets ERRA: OOB %s: %d (size %d)\n",this,v[0].size,cob.v.size) return }
if (ix<0) ix=cob.v.size+ix
for i=2,numarg() {
if (argtype(i)==2) fl=fi($si) else fl=$i
if (fl==-1) return
i+=1
if (argtype(i)==0) { cob.v[fl].x[ix]=$i // shortcut
} else {
if (argtype(i)==1) oval=$oi else if (argtype(i)==2) sval=$si
cob.v[fl].x[ix]=newval(argtype(i),fl)
}
}
}
//** setcol("name",VEC)
// setcol(num,VEC)
// setcol(num,"name",VEC)
// setcol(num,"name",VEC,flag) // with flag==1 use pointer to vec instead of copying
scpflag=0
proc setcol () { local fl,flag localobj vo
if (eqobj(cob,out) && verbose) {
printf("%s setcol() ERR: attempting to set column in Selected db\n",this)
return }
if (argtype(1)==2) fl=fi($s1) else fl=$1
if (fl==-1) return
if (v[fl].size!=0) {
sprint(sstr,"WARNING %s col not empty (size %d)",s[fl].s,v[fl].size)
if (boolean_dialog(sstr,"Clear col","Cancel")) { v[fl].resize(0) } else {
printf("%s (%s) setcol() canceled\n",this,s[fl].s) return
}}
if (argtype(2)==2) { s[fl].s=$s2
} else if (argtype(2)==1) {
if (scpflag) v[fl].copy($o2) else v[fl]=$o2
return
} else { sprint(tstr,"%d",$2) s[fl].s=tstr }
if (numarg()>=3) vo=$o3
if (numarg()>=4) flag=$4 else flag=0
if (!flag || scpflag) v[fl].copy(vo) else v[fl]=vo
chk()
}
//** setcols(VEC1,VEC2,...) -- does either pointer or copy depending on scpflag
// setcols(LIST) -- does either pointer or copy depending on scpflag
// see also resize("NAME",vec, ...) for similar functionality
proc setcols () { local i,na,flag,sz
sz=na=numarg() flag=0
if (na==0) { scpflag=1-scpflag
if (scpflag) printf("setcols() will copy vecs\n") else {
printf("setcols() will use vec pointers\n") }
return
}
if (na==1 && isobj($o1,"List")) {flag=1 sz=$o1.count}
if (m==0) resize(sz)
if (eqobj(cob,out) && verbose) {
printf("%s setcols() ERR: attempting to set column in Selected db\n",this)
return }
if (!flag && na!=m) {
printf("%s setcols() ERR: need %d not %d args\n",this,m,na)
return }
if (flag) {
if (scpflag) for i=0,m-1 v[i].copy($o1.o(i)) else for i=0,m-1 v[i]=$o1.o(i)
} else if (scpflag) for i=1,m v[i-1].copy($oi) else for i=1,m v[i-1]=$oi
chk()
}
//** newval(typ,col#) -- check if a value is already on the list and if not put it there
// usuall preceded by eg:
// if (argtype(i)==0) nval=$i else if (argtype(i)==1) oval=$oi else if (argtype(i)==2) sval=$si
// NB: makes a copy of a Vector or an NQS so DON'T do eg nq.append(new Vector())
func newval () { local ret,typ,ty,fl,ii localobj o
typ=$1 fl=$2 ty=fcd.x[fl] // arg type may not be same as field type
if (ty==typ||ty==-1||(ty==FUNTY&&typ==2)||(ty==VECTY&&typ==1)) { // OK
} else { printf("nqs::newval() ERRa %d statt %d\n",typ,ty) return ERR }
if (typ==0 || ty==-1) {
return nval
} else if (ty==1) { // object handling
if (! isassigned(oval)) return -1
if (isojt(oval,v)) { o=new Vector(oval.size) o.copy(oval)
} else if (isojt(oval,this)) { o=new NQS() o.cp(oval)
} else {
for (ii=0;ii<fcdo.count;ii+=1) if (eqojt(fcdo.object(ii),oval)) { // already on list?
printf("nqs %s WARNING: 2nd pointer to same %s on fcdo\n",this,oval)
return ii
}
o=oval
}
return fcdo.append(o)-1
} else if (ty==FUNTY) { // method handling
for ({ii=0 ret=-1};ii<fcds.count;ii+=1) {
if (strcmp(fcds.object(ii).s,sval)==0) {ret=ii break}
}
if (ret==-1) ret=fcds.append(new String(sval))-1
o=new Union(ret) // .x is pointer to the string
return fcdo.append(o)-1
} else if (ty==VECTY) { // append to a vector
if (!isojt(oval,v)) { printf("nqs:newval ERRB -- put vectors in vdec col\n") return ERR }
ret=fcdv.size()
fcdv.append(oval)
return ret
} else if (ty==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,ed,nacc
fl=$1 ix=$2 flag=0
typ=fcd.x[fl] // argtype
if (typ==0) {
nval=ix
} else if (typ==CODTY) {
if (numarg()==3) nval=uncodf($3,ix) else {scr.resize(5) scr.uncode(ix)}
} else if (typ==VECTY) {
if (ix>fcdv.size-1) { printf("nqs::getval() ERR fcdv index OOB %d, %d\n",ix,fcdv.size)
return ERR
} else if (ix<0) { printf("nqs::getval() WARNING empty VECTY ptr\n\t") sval="nil" typ=2
} else {
nacc=$3 // direct index only needed here
if (nacc+1<cob.v[fl].size) ed=cob.v[fl].x[nacc+1]-1 else ed=fcdv.size-1
oval = fcdv.c(ix,ed)
}
} 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()
obfunc listvecs () { local ii,i,b localobj ol
if (eqobj(cob,out) && verbose) printf(" *Selected* ")
if (argtype(1)==1) {ol=$o1 b=2} else b=1
if (!isassigned(ol)) {
ol=new List()
if (argtype(1)==1) $o1=ol
}
ol.remove_all
if (numarg()>=b) {
for i=b,numarg() {
if (argtype(i)==2) ii=fi($si) else ii=$i
if (ii==-1) return
ol.append(cob.v[ii])
}
} else {
for ii=0,m-1 ol.append(cob.v[ii])
}
return ol
}
//*** hash([COLA],[COLB] etc.) put the vecs in the list for use with eg uncode()
proc hash () { local ii,i,fl localobj o
if (eqobj(cob,out) && verbose) {
printf("hash() ERR: can't create hash col in 'Selected'\n") return }
o=new List()
if (numarg()==0) { // do all columns
resize("hashall")
for ii=0,m-2 o.append(v[ii])
} else {
tstr="hash"
for i=1,numarg() {
if (argtype(i)==0) fl=$i else fl=fi($si)
if (fl==-1) return
sprint(tstr,"%s_%s",tstr,s[fl].s)
o.append(v[fl])
}
resize(tstr)
}
pad()
v[m-1].hash(o)
}
//*** mat=tomat([MAT]) put the cols in cols of matrix
// mat=tomat(MAT,1) or mat=tomat(1) puts the cols in rows of matrix
obfunc tomat () { local ii,transpose,fo,sz localobj mat
if (eqobj(cob,out) && verbose) printf(" *Selected* ")
fo=transpose=0 sz=size(1)
if (numarg()>=1) {
if (argtype(1)==0) transpose=$1 else {mat=$o1 fo=1}
}
if (numarg()>=2) transpose=$2
if (!isassigned(mat)) {
if (transpose) mat=new Matrix(m,sz) else mat=new Matrix(sz,m)
if (fo) $o1=mat
} else {
if (transpose) mat.resize(m,sz) else mat.resize(sz,m)
}