/* Histogram */

options results
if ~show('P','TCALC') then do
	address command 'run sys:turbocalc/turbocalc'
	address command 'waitforport TCALC'
	loadflag=1
end
address 'TCALC'
/* Add-in Rexx Math Library needed for some routines */
signal on syntax
if ~show('l','rexxmathlib.library') then
   call addlib('rexxmathlib.library',0,-30)
if ~show('l','rexxreqtools.library') then
   call addlib('rexxreqtools.library',0,-30)
  /* add to library list */
signal off syntax

/* Start Main Routine */
if loadflag=1 then 'Load()'
'ActivateWindow()'
;'LiesCursorPos'
range=rtgetstring(,"Enter Cell Range for Input","Input Request",,'rt_pubscrname="TurboCalc"')
colon=pos(":",range)
if colon=0 then do
	'Message "Please select a range~before executing this script"'
	exit
end

/* Find cell references and cell, column numbers */
start_cell=substr(range,1,colon-1)
end_cell=substr(range,colon+1)
start_row=cellrow(start_cell)
end_row=cellrow(end_cell)
start_col=cellcol(start_cell)
end_col=cellcol(end_cell)
NRows=end_row-start_row+1
NCols=end_col-start_col+1

/* Get cell reference for output range */
out_cell=rtgetstring(,"Enter Cell Reference for Output","Input Request",,'rt_pubscrname="TurboCalc"')
if out_cell="" then exit
if length(out_cell)<2 | datatype(left(out_cell,1),'n') then do
	'Message "Invalid cell reference"'
	exit
end
/* Suppress Screen Redraw to Speed Things Up */
'Refresh 0'

/* Get cell references for top cell in each column */
'SelectCell' start_cell
do col=start_col to end_col
	'GetCursorPos'
	top_cell.col=result
	'Column 1'
end

/* Get labels for later use on output */
'SelectCell' start_cell
'GetValue'
testlabel=result
testlabel=strip(testlabel)
if datatype(testlabel,'n')=1 then do
	labelflag=0
	title="Column "||x
end
else do
	labelflag=1
	title=testlabel
end

/* Get data from cell range */
col=start_col
lav=0
tot=0
count=0
total=0
do x=1 to NCols
	'SelectCell' top_cell.col
	if labelflag=1 then 'Down 1'
	if labelflag=0 then NRows=NRows+1
	do y=1 to NRows-1
		'GetValue'
		valtest=result
		if datatype(valtest)='NUM' then do
			'GetValue'
			val=result
			val=strip(val)
			data.y=val
			total=total+val
			count=1+count
		end
		'Down 1'
	end
	
/* Sort Values */
call Sort()

/* Calculate Minimum, Maximum */
min=0
max=0
N=count
min=data.1
max=data.N

/* Get Bin Range from User */
binstart=rtgetstring(,"Enter first cell reference for Bin range (or enter N if no range)","Input Request",,'rt_pubscrname="TurboCalc"')
test=1
x=1
Nbins=0
BW=0
bin.=0
if length(binstart)>1 then do
	'SelectCell' binstart
	'GetValue'
	response=result
	response=strip(response)
	if datatype(response,'a')~=1 then do
		'Message "Not a Valid Cell Reference"'
		exit
		end
	if datatype(left(response,1),'m')=1 then 'Down 1'
	bread=0
	do while bread=0
			'GetValue'
			test=result
			test=strip(test)
			if datatype(test,'n')~=1 then leave
			Nbins=Nbins+1
			bin.x=test
			x=x+1
			'Down 1'
	end
end
else do
	Nbins=trunc(sqrt(count))
	if Nbins<5 then Nbins=5
	if Nbins>15 then Nbins=15
	bin.1=min
	BW=(max-min)/Nbins
	do x=2 to Nbins
		z=x-1
		bin.x=(bin.z)+BW
	end
end
x=1
freq.=0
do y=1 to NRows-1
	z=x+1
	if x<Nbins then 
	if (data.y)>=(bin.x) & (data.y)<(bin.z) then freq.x=(freq.x)+1
	else do
		y=y-1
		x=x+1
	end
	else freq.x=(freq.x)+1
end
Cumfreq.=0
Cumpc.=0
Cumfreq.1=freq.1
Cumpc.1=((freq.1)/count)*100
do x=2 to Nbins
	z=x-1
	Cumfreq.x=freq.x+Cumfreq.z
	Cumpc.x=((Cumfreq.x)/count)*100
end

/* Output */
'SelectCell' out_cell
'ColumnWidth 10'
'Put' "Histogram"
'Down 2'
title=""""||title||""""
'Put' title
'Down 2'
'GetCursorPos'
st_cell=result
'Put' "Bin"
'Column 1'
'Put' "Frequency"
'Column 1'
'Put "Cum. Freq."'
'Column 1'
'Put "Cum. %"'
'SelectCell' st_cell
'Down 1'
do x=1 to Nbins
	'Put' bin.x
	'Down 1'
end
'SelectCell' st_cell
'Column 1'
'Down 1'
do x=1 to Nbins
	'Put' freq.x
	'Down 1'
end
'SelectCell' st_cell
'Column 2'
'Down 1'
do x=1 to Nbins
	'Put' Cumfreq.x
	'Down 1'
end
'SelectCell' st_cell
'Column 3'
'Down 1'
do x=1 to Nbins
	'Put' Cumpc.x
	'Down 1'
end
'Refresh 1'
'Refresh 2'
'Message' "Finished"
exit

/* Procedures */

cellrow: procedure
do
	parse arg cell
	do charpos=2 to length(cell)
	if datatype(substr(cell,charpos,1),n) then return substr(cell,charpos)
	end
	return 0
end
Return

cellcol: procedure
do
	parse arg cell
	labels="ABCDEFGHIJKLMNOPQRSTUVWXYZ"
	cell=upper(cell)
	len=length(cell)
	val=0
do charpos=1 to len
	if datatype(substr(cell,charpos,1),n) then
	do cell=reverse(substr(cell,1,charpos-1))
	do x=1 to length(cell)
	val=(26**(x-1))*pos(substr(cell,x,1),labels)+val
	end
	return val
	end
	end
	return 0
end
Return
/* It is important to put the exposed array at the end of the next line */
Sort: procedure expose  NRows data.
L=(xtoy(2,int(log(NRows-1)/log(2))))-1
	Do Until L<1
	L=trunc(int(L/2))
	Do J=1 to L
			Do K=J+L To NRows-1 By L
			I=K
			dumdat=data.I
			Do while I>L
				y=I-L
				If data.y ~> dumdat then Leave
				data.I=data.y
				I=I-L
			End
			data.I=dumdat
			End
		End
	End
Return

syntax:
      if arg(1)='FAIL' then do
         'Message "Library is unavailable."'
         exit
         end