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
;
