/* Regression Statistics */

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
if NCols>2 then do
	'Message "Only Two Columns allowed!"'
	exit
end

/* Ensure we have X and Y in the right columns */
in=2 /* Independent variable x in second column */
de=1 /* Dependent variable y in first column */
an=rtgetstring(,"Confirm Dependent (Y) Variable is First Column: Y or N","Input Request",,'rt_pubscrname="TurboCalc"')
if an="" then exit
an=left(an,1)
an=Upper(an)
if an="N" then do 
	in=1
	de=2
	end

/* 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
	do x=1 to NCols
	title.x="Column "||x
	end
end
else do
	labelflag=1
	do x=1 to NCols
	'GetValue'
	title.x=result
	'Column 1'
	end
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
			data.x.y=val
			tot=tot+val
			total.x=tot
			count.x=1+count.x
		end
		'Down 1'
	end
	col=col+1
	tot=0
	lav=0
	val=0
end
if count.1 ~= count.2 then do
	'Message "There must be equal numbers~of values in both columns"'
	exit
end

/* Calculate Means */
mean.=0
do x=1 to NCols
	mean.x=total.x/count.x
end

/* Calculate Standard deviation and Variance */
dat=0
meenx=0
diff.=0 /* Array holding difference between value and column mean */
sum.=0 /* Array holding sum of value minus mean of value squared */
sd.=0 /* Standard deviation array */
var.=0 /* Variance array */
do x=1 to NCols
	sum.x=0
	meenx=mean.x
	do y =1 to count.x
	dat=data.x.y
	diff.x.y=dat-meenx
	sum.x=(dat-meenx)**2+(sum.x)
	end
	N=(count.x)-1
	var.x=(sum.x)/N
	sd.x=sqrt(var.x)
end
N=count.1
summulti=0 /* Sum of product of diffs */
diffMult.=0 /* Array holding values of diffx times diffy */
do y=1 to N
	diffMult.y=(diff.de.y)*(diff.in.y)
	summulti=summulti+(diffMult.y)
end

/* Calculate a & b and Predicted Y */
b=0
a=0
sumdifpa=0
Pr.=0 /* Array holding values of predicted values */
difpa.=0 /* Array holding differences between observed and predicted values */
b=summulti/(sum.in)
a=(mean.de)-b*(mean.in)
do y=1 to N
	Pr.y=a+b*(data.in.y)
	difpa.y=(data.de.y)-(Pr.y)
	sumdifpa=sumdifpa+(difpa.y)**2
end

/* Calculate standard Deviation */
stdev=0
t=0
stdev=sqrt((sumdifpa/((N-2)*(sum.in))))
t=b/stdev
df=N-2 /* Degrees of Freedom */

/* Calculate Pearson r */
rs=0
rs=((summulti)**2)/((sum.in)*(sum.de))

/* Output */
PV=0
'SelectCell' out_cell
'ColumnWidth 10'
'Put "Least Squares Regression"'
'Down 1'
'Put "Predicted Values"'
'Down 1'
do y= 1 to N
	'Put' Pr.y
	'Down 1'
end
'SelectCell' out_cell
'Down 1'
'Column 2'
'ColumnWidth 15'
'Put "Axis Intercept (a):"'
'Down 1'
'Put' a
'Down 1'
'Put "Slope of Line (b):"'
'Down 1'
'Put' b
'Down 1'
'Put "St. Deviation:"'
'Down 1'
'Put' stdev
'Down 1'
'Put "Value of t:"'
'Down 1'
'Put' t
'Down 1'
'Put "Coeff. of Determination (r sq):"'
'Down 1'
'Put' rs
'Down 1'
'Put "Deg. of Freedom:"'
'Down 1'
'Put' df
'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

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