/* ANOVA - Two Way */

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
'Column 1'
'GetValue'
testlabel=result
testlabel=strip(testlabel)
if datatype(testlabel,'a')~=1 then do
	'Refresh 1'
	'Message "Please include label cells~in range selection"'
	exit
end
'SelectCell' start_cell
do x=1 to NCols
	'GetValue'
	title.x=result
	'Column 1'
end
'SelectCell' start_cell
'Down 1'
do y=1 to NRows-1
	'GetValue'
	res=result
	if datatype(res)='NUM' then do
		'GetValue'
		subtitle.y=result
		'Down 1'
	end
	else do
		'GetValue'
		subtitle.y=result
		'Down 1'
	end
end

/* Get data from cell range */
col=start_col+1
lav=0
tot=0
count.=0
total.=0
do x=2 to NCols
	'SelectCell' top_cell.col
	'Down 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
rowtot.=0
do y=1 to NRows-1
	do x=2 to NCols
		rowtot.y=(data.x.y)+rowtot.y
	end
end
	
/* Calculate Means */
meancol.=0
meanrow.=0
do x=2 to NCols
	meancol.x=total.x/count.x
end
do y=1 to NRows-1
	meanrow.y=(rowtot.y)/(NCols-1)
end

/* Calculate Standard deviation and Variance */
dat=0
meenx=0
meeny=0
sum.=0
sd.=0
var.=0
sumr.=0
sdr.=0
varr.=0
do x=2 to NCols
	sum.x=0
	meen=meancol.x
	do y =1 to count.x
	dat=data.x.y
	sum.x=(dat-meen)**2+(sum.x)
	end
	N=(count.x)-1
	var.x=(sum.x)/N
	sd.x=sqrt(var.x)
end
do y=1 to NRows-1
	sumr.y=0
	meen=meanrow.y
	do x=2 to NCols
		dat=data.x.y
		sumr.y=(dat-meen)**2+(sumr.y)
	end
	N=NCols-2
	varr.y=(sumr.y)/N
	sdr.y=sqrt(varr.y)
end

/* Calculate Totals */
/* rowtot.y=Sum of all observations in row */
/* total.x=Sum of all observations in column */
T=0 /* Grand Total of all observations */
NumObs=0
Do x=2 to NCols
	NumObs=NumObs+count.x
	T=T+total.x
end

/* Calculate Sum of Squares */
TSrows=0
TScols=0
TSrc=0
SSR=0 /* Sum of Squares Rows */
SSC=0 /* Sum of Squares Columns */
SSTotal=0 /* Sum of Squares Total */
SSI=0 /* Sum of Squares Interaction */
TS=T**2
Do y=1 to NRows-1
	TSrows=TSrows+(rowtot.y)**2
end
SSR=(TSrows/(NCols-1))-(TS/NumObs)
Do x=2 to NCols
	TScols=TScols+(total.x)**2
end
SSC=(TScols/(NRows-1))-(TS/NumObs)
Do x=2 to NCols
	do y=1 to count.x
		TSrc=(data.x.y)**2+TSrc
	end
end
SSI=TSrc-(TSrows/(NCols-1))-(TScols/(NRows-1))+(TS/NumObs)
SSTotal=TSrc-(TS/NumObs)

/* Calculate Variances */
DFR=NRows-2 /* Degrees of Freedom Rows */
DFC=NCols-2 /* Degrees of Freedom Columns */
DFI=DFR*DFC /* Degress of Freedom Interaction */
DFT=DFR+DFC+DFI /* Degrees of Freedom in Total */
VarR=SSR/DFR /* Variance Estimate for Between */
VarC=SSC/DFC /* Variance Estimate for Columns */
VarI=SSI/DFI /* Variance Estimate for Interaction */
Fcol=VarC/VarI /* F Ratio for Columns */
Frow=VarR/VarI /* F Ratio for Rows */

/* Output */
'SelectCell' out_cell
'ColumnWidth 10'
'Put "ANOVA - Two Way: No Replication"'
'Down 2'
title=""""||title.1||""""
'Put' title
'Column 1'
'ColumnWidth 10'
'Put' "Count"
'Column 1'
'ColumnWidth 10'
'Put' "Total"
'Column 1'
'ColumnWidth 10'
'Put' "Mean"
'Column 1'
'ColumnWidth 10'
'Put' "Variance"
'SelectCell' out_cell
'Down 3'
do y=1 to NRows-1
	'GetCursorPos'
	first_cell.y=result
	subtitle=""""||subtitle.y||""""
	'Put' subtitle
	'Down 1'
end

Do y=1 to NRows-1
	'SelectCell' first_cell.y
	'Column 1'
	'Put' NCols-1
	'Column 1'
	'Put' rowtot.y
	'Column 1'
	'Put' meanrow.y	
	'Column 1'
	'Put' varr.y
end
/* Here */
NR=NRows-1
'SelectCell' first_cell.NR
'Down 2'
Do x=2 to NCols
	'GetCursorPos'
	startcell.x=result
	title=""""||title.x||""""
	'Put' title
	'Down 1'
end
Do x=2 to NCols
	'SelectCell' startcell.x
	'Column 1'
	'Put' NRows-1
	'Column 1'
	'Put' total.x
	'Column 1'
	'Put' meancol.x
	'Column 1'
	'Put' var.x
end
'SelectCell' startcell.NCols
'Down 2'
'Put' "ANOVA"
'Down 1'
'Put "Source of"'
'Down 1'
'Put "  Variation"'
'GetCursorPos'
Go_cell=result
'Column 1'
'Up 1'
'Put "Sum of"'
'Down 1'
'Put "  Squares"'
'Column 1'
'Up 1'
'Put "Degrees of"'
'Down 1'
'Put "  Freedom"'
'Column 1'
'Up 1'
'Put' "Variance"
'Down 1'
'Put "  Estimate"'
'Column 1'
'Up 1'
'Put "F Ratio"'
'SelectCell' Go_cell
'Down 2'
'Put' "Rows"
'Down 1'
'Put' "Columns"
'Down 1'
'Put' "Interaction"
'Down 1'
'Put' "Total"
'SelectCell' Go_cell
'Down 2'
'Column 1'
/* Me */
'Put' SSR
'Down 1'
'Put' SSC
'Down 1'
'Put' SSI
'Down 1'
'Put' SSTotal
'Up 3'
'Column 1'
'Put' DFR
'Down 1'
'Put' DFC
'Down 1'
'Put' DFI
'Down 1'
'Put' DFT
'Up 3'
'Column 1'
'Put' VarR
'Down 1'
'Put' VarC
'Down 1'
'Put' VarI
'Up 2'
'Column 1'
'Put' Frow
'Down 1'
'Put' Fcol
'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 rexxsupport.library is unavailable."
         exit
         end
	'Message' "Unknown Syntax Error"
	exit