NULLNAME Bins
* Fast replacement for the built in BINS-command, with minor changes
* Extremly fast in some cases, very fast in other. A large number of bins and/or a large
* amount of data located right below max and (min+max)/2 will slow the process much more
* than a high number of data to count. For some very special cases (low number of data,
* large nbins (>350)), it's faster to calculate the bin-number for each data, rather than search * a table.
* Comparison: (all data are produced by RAND, with an initial 123 RDZ)
* Program #data min delta nbins Time #data/sec
* BINS1 100 0 1/20 20 0.1878 532.3
* BINS 2.184 9.16
* BINS1 1000 0 1/100 100 2.850 350.8
* BINS 44.38 22.53
* BINS1 1000 0 1/10 10 0.5624 1778
* BINS 41.52 24.08
* BINS1 3000 0 1/100 100 7.908 380
* BINS ca. 133 ca. 22
* BINS1 3000 0 1/2 2 1.266 2370
* BINS1 3000 -1 1 1 0.891 3366
* BINS1 1000 -1 1/100 100 (vorst case) 3.226 310
* BINS1 1000 1 1/100 100 (best case) 0.726 1377
* Given a { k 1 } real matrix or a { k } vector, %min, %delta and #nbins, it returns the number
* of observations in each cell
* [[ min,min+d>[min+d,min+2d>...[min+(nbins-1)d,min+nbins*d>] and
* [number below, number above]
* Note that the last interval is open [...> and not closed [ ], as with BINS. Also note that the
* input must be a single column or a vector. The program does not handle data with exponent
* equal to 499 properly, but this should not be any problem in most cases.
::
4PICK
MDIMS
ITE
::
SWAPDROP
#1=
?SEMI
# 501
ERROROUT (Issue an "Invalid Dimension" error if not { k 1 } or { k })
;
DROP
#2+
DUP
DUP1LAMBIND (Save nbins+2 in unnamed lambda)
ONE{}N
C%0
MAKEARRY (make { nbins+2 } complex array to hold [(#0,min)(#1,min+d)
(...(#nbins,min+nbins*d)(#nbins+1,%maxreal)])
SWAP
#2*
TWO
DO
3PICK
INDEX@
PUTREALEL (fill the %C array with min, min+d, ..., min+nbins*d)
SWAPROT
OVER
%+
SWAPROT
TWO
+LOOP
%MAXREAL
1GETLAM
#2*
PUTREALEL (insert %maxreal at the end, to stop all values there)
UNROT2DROP
SWAP
CountBins ;
NULLNAME CountBins
* Given [ (0,min)(0,min+d)...(0,min+nbins*d)(0,%maxreal)], #nbins+2 in 1GETLAM,
* and [[ n*1 ]] or [ n ] (real) -> [[ %n_in_bin1]...[%n_in_binn]] [below above]
:: CODE
GOSBVL =PopASavptr * Save pointers, A[A]-> in_array
D0=A * D0->Start of array to count from
D0=D0+ 15
A=DAT0 A * A[A] = number of dimensions
D0=D0+ 5
C=DAT0 A * C[A] = number of rows(matrix)/elements(vector)
D=C A * Copy to D[A], to save it
A=A-1 A
A=A-1 A * Carry set if dim was = 1
GOC 1dim
D0=D0+ 5 * Skip the #cols field if 2dim
1dim D0=D0+ 5 * Skip #elem(1dim)/#rows(2dim)
A=DAT1 A
D1=A * D1-> Start of array to count to
D1=D1+ 16
D1=D1+ 4
LC(5) 32
B=C A
C=DAT1 A * C[A]=number of elements (=nbins+2)
CSRB.F A * Divide by 2 to get floor((nbins+2)/2)
CSL A * Multibly by 16
C=C+C A * .....and then by 2, to get the distance in nibbles from the
* first limit to the one in the middle
D1=D1+ 16
D1=D1+ 5 * Go to the first limit (complex part of first C% in vector)
AD1EX * A[A]=addr. of first limit
R0=A * save in R0
C=C+A A
D1=C
C=C+B A
R1=C
C=DAT1 W * C[A]=addr. to middle limit
B=C W * Save in B
Oloop D=D-1 A * Decrement D, carry set when last data is counted
GOC done * Exit if done
C=DAT0 W * read a data into C[W]
LA(3) #499
?C#A X * If exponent is unequal to 499, do nothin,
GOYES ok
C=C-1 X * else decrement it
ok A=B W
* D1=A * D1-> middle limit
* A=DAT1 W * A[W]=middle limit
SETDEC * required by Y<=X
GOSBVL =Y<=X * Carry set if %A[W]<=%C[W]
P= 0
A=R1.F A
GOC Iloop1 * Search the second half
A=R0.F A
Iloop1 D1=A * D1-> first limit
Iloop A=DAT1 W * A[W]=first limit
GOSBVL =Y<=X
GONC found_it * found the right cell if A is not <= C
D1=D1+ 16 * else go to next limit
D1=D1+ 16
* A=DAT1 W * copy it into A[W]
GONC Iloop * carry alway clear, faster than GOTO
done GOVLNG =GETPTRLOOP * Get pointers, exit
found_it SETHEX * Se hex mode
P= 0 * to be sure. D1 now points to the correct limit,
D1=D1- 16 * go one field back (to the real part of the %C)
A=DAT1 A
A=A+1 A
DAT1=A A * Increment by 1. Will convert from binary to % afterwards
D0=D0+ 16 * Go to next data
GONC Oloop * carry always clear, goto Oloop
ENDCODE
(Stack now contains a non-valid object, a vector consisting of (#number_in_cell,%limit))
(the real part of the %C is an internal binary, and the im. part is real.)
1GETLAM
ONE{}N
%0
MAKEARRY (make an array to hold the counts)
SWAP
(Code segment to copy/convert the binary counts to real counts. Will also "roll" the counts, )
(to get [n_in_1._cell,...,n_in_last_cell, n_above, n_below ], to ease rest of operations)
CODE
GOSBVL =PopASavptr * Save pointers, A[A]-> "complex" vector
D0=A
D0=D0+ 16
D0=D0+ 4
C=DAT0 A
D=C A * D=nbins+2
D=-D A * 2's complement, I will add D upwards, carry will be set after
* nbins+2 counts
D=D+1 A * Add one (first conversion is done separately)
D0=D0+ 5 * Go to first count
C=DAT1 A
D1=C * D1->Array to hold the counts
D1=D1+ 16
D1=D1+ 9 * Skip prolog, type, dims, cols and rows
A=DAT0 W *Read first binary to convert (number of data lower than min)
GOSBVL =HXDCW
GOSBVL =FLOAT * convert it
SETHEX
P= 0
R4=A * Save it in R4
D0=D0+ 16
D0=D0+ 16 * Goto next count
lop A=DAT0 W * load binary
GOSBVL =HXDCW
GOSBVL =FLOAT * Convert to real
SETHEX
P= 0
DAT1=A W * Write into DAT1
D0=D0+ 16
D0=D0+ 16 * Move to next binary
D1=D1+ 16 * Move to next real's place
D=D+1 A * Increment counter, to see when finished
GONC lop * If D dit not overflow, there are more to do
A=R4 * Get number_below
DAT1=A W * and write it in the last place
GOVLNG =GETPTRLOOP * Get pointers, exit to RPL
ENDCODE
1GETLAM
DUPUNROT
#1-
PULLREALEL (Get number_above)
SWAPROT
PULLREALEL (get number_below)
ROT ( n_above [[ bins+ ]] n_below -> [[ bins+ ]] n-below n_above)
{
%2
}
XEQ>ARRAY ( [[ bins+ ]] n_b n_a -> [[ bins+ ]] [n_b n_a ])
SWAP
1GETABND
#2-
ONE
TWO{}N
MATREDIM ( get rid of the last to elements of [[ bins+ ]])
SWAP
;