STATISTICA







STATISTICA BASIC Program ca.stb

{ Correspondence Analysis
Dr. Stefan Funke, Braunschweig, Germany (funke@ibm.net)
07/1996
(nothing is guaranteed - use the program at your own risk)

see Greenacre M and Blasius J. 'Correspondence Analysis in the Social Sciences', Academic Press, Harcourt Brace and Company (UK), 1994, ISBN 0-12-104570-6

This program was written when STATISTICA did not have a CA module. Its plots may still be useful. }

RandomAccess;
NoDataFileVariableNames;

handle:=GetScrollsheet(0); { get active scrollsheet }

if (handle<>0) then { Scrollsheet }
  begin

     ScrollSheetGetTitle(handle,1,s$);
     s2$:=mid(s$,1,7);
     if ((s2$='Summary') or (s2$=' Häufig')) then
       begin
         inputtype:=2; { scrollsheet with summary table }
       end
     else inputtype:=3;  { scrollsheet but no summary table }
end
else inputtype:=1; { normal datafile with pretabulated data }

if (inputtype=1) then { normal datafile with pretabulated data }
	begin
        datancols:=NVars; datanrows:=NCases;
        k:=datanrows;
        m:=datancols;
        n:=0;
        ReDim inbuffer(k,m);
        ReDim x(k,m),xrel(k,m);
        for i:=1 to k do
		begin
              for j:=1 to m do
			begin
			  inbuffer(i,j):=Data(i,j);
                    n:=n+Data(i,j); { sum of cells }
			end;
		end;
         MatrixCopy (inbuffer,1,1,k,m,x,1,1);

	end;

if (inputtype=2) then { scrollsheet with summary table }
	begin
        scrollncols:=ScrollsheetGetNbCols(handle);
        scrollnrows:=ScrollsheetGetNbRows(handle);
        k:=scrollnrows-1; { number of rows }
        m:=scrollncols-1; { number of columns }
        ReDim inbuffer(k+1,m+1); { last rows and columns contain sums }
        ReDim x(k,m),xrel(k,m);
        ScrollsheetGetMatrix(handle, 1, 1, inbuffer);
        n:=inbuffer(k+1,m+1); { sum of cells }
        MatrixCopy (inbuffer,1,1,k,m,x,1,1);
      end;


if (inputtype=3) then { scrollsheet but no summary table }
	begin
	   DisplayMessageBox(MB_OK,'Aborting',
             'The scrollsheet is no summary table. Select a summary table or close all
scrollsheets to get pretabulated data from the data file');
         exit;
	end;

if (n=0) then { scrollsheet but no summary table }
	begin
	   DisplayMessageBox(MB_OK,'Aborting','Empty file or table');
         exit;
	end;

if (min(m-1,k-1)<2) then
	begin
         DisplayMessageBox(MB_OK,'Aborting','Table must have at least 3x3 cells');
         exit;
	end;

plotmode:=2;
{ If this code is re-enabled the amount of plots can be limited
if (min(m-1,k-1)>=3) then
	begin
		plotmode:=DisplayButtonBox ('Select Plots', '2D-plots|2D and 3D-Plots');
      end;
if (plotmode=0) then exit;
}

{ k= row, m = column }

ReDim rowsum(k),colsum(m);
ReDim relrowsum(k),relcolsum(m);
ReDim xrelpct(k,m);
ReDim rowprof(k+1,m+1),colprof(k+1,m+1); { row and column (%) profiles plus total}
ReDim rprof(k,m),cprof(k,m);             { row and column profiles }

ReDim rowmass(k),colmass(m); { row masses r and column masses c}
                             { correspondence matrix P = xrel()}
ReDim a(k,m);                { matrix of standardized residuals }


MatrixElemDivide (x, n, xrel);
MatrixElemMultiply (xrel, 100.0, xrelpct);


{ calculate row and column sums }

for i:=1 to m do { for all cols }
	begin
	  for j:=1 to k do { for all rows }
		begin
              colsum(i):=colsum(i)+x(j,i);
		end;
	end;
for i:=1 to k do { for all rows }
	begin
	  for j:=1 to m do { for all cols}
		begin
              rowsum(i):=rowsum(i)+x(i,j);
		end;
	end;

{ calculate row profiles }

for i:=1 to m do { for all columns }
	begin
        for j:=1 to k do { for all rows }
		begin
              rowprof(j,i):=x(j,i)/rowsum(j)*100;
              rprof(j,i):=x(j,i)/rowsum(j);
		end;
        rowprof(k+1,i):=colsum(i)/n*100;
	end;
for j:=1 to k do rowprof(j,m+1):=100.0;
rowprof(k+1,m+1):=100.0;

{ calculate column profiles }

for i:=1 to k do { for all rows }
	begin
        for j:=1 to m do { for all columns }
		begin
              colprof(i,j):=x(i,j)/colsum(j)*100;
              cprof(i,j):=x(i,j)/colsum(j);
		end;
        colprof(i,m+1):=rowsum(i)/n*100;
	end;
for j:=1 to m do colprof(k+1,j):=100.0;
colprof(k+1,m+1):=100.0;

{ calculate relative row and column sums }

for i:=1 to m do { for all cols }
	begin
	  for j:=1 to k do { for all rows }
		begin
              relcolsum(i):=relcolsum(i)+xrel(j,i);
		end;
	end;
for i:=1 to k do { for all rows }
	begin
	  for j:=1 to m do { for all cols}
		begin
              relrowsum(i):=relrowsum(i)+xrel(i,j);
		end;
	end;

for i:=1 to m do { for all cols }
	begin
        colmass(i):=colsum(i)/n;
	end;

for i:=1 to k do { for all rows }
	begin
	  rowmass(i):=rowsum(i)/n;
	end;


{ calculate standardized residuals }
for i:=1 to m do { for all columns }
	begin
        for j:=1 to k do { for all rows }
		begin

              a(j,i):=( xrel(j,i)-(rowmass(j)*colmass(i)) ) /
			sqrt(rowmass(j)*colmass(i));
		end;
	end;

ReDim umat(k,m),wmat(m),vmat(m,m);
{ umat: left singular vectors
  vmat: right singular vectors
  wmat: singular values }


MatrixSingularValuesDecomp (a, umat, wmat, vmat);

{ calculate chi^2 components, inertias, and total chi^2 }
ReDim chisqcomp(k,m);
ReDim inertcomp(k,m);
ReDim inertrow(k), inertcol(m);
chisqsum:=0;
for i:=1 to m do { for all columns }
	begin
        for j:=1 to k do { for all rows }
		begin
              prod:=rowmass(j)*colmass(i);
              diff:=xrel(j,i)-prod;
              chisqcomp(j,i):=n*(diff*diff)/prod;
              q:=(xrel(j,i)/rowmass(j))-colmass(i);
              inertcomp(j,i):=q*q/colmass(i);
              chisqsum:=chisqsum+chisqcomp(j,i);
		end;
	end;
cramersv:=sqrt(chisqsum/(n*(min(k,m)-1)));

{ calculate intertia of columns }
for i:=1 to m do { for all columns }
	begin
        for j:=1 to k do { for all rows}
		begin
              inertcol(i):=inertcol(i)+(a(j,i)*a(j,i));
		end;
	end;
{ calculate inertia of rows }
for i:=1 to k do { for all rows }
	begin
        for j:=1 to m do { for all rcols }
		begin
			inertrow(i):=inertrow(i)+(a(i,j)*a(i,j));
		end;
	end;

{ calculate total intertia }
MatrixSumOfSquares (a, totalinertia);

{ calculate principal coordinates of rows: fmat }
kk:=min(m-1,k-1);
ReDim fmat(k,kk);
for i:=1 to k do { for all rows }
	begin
		for j:=1 to kk do
			begin
                    fmat(i,j):=umat(i,j)*wmat(j)/sqrt(rowmass(i));
			end;
	end;

{ calculate principal coordinates of columns: gmat}
ReDim gmat(m,kk);
for i:=1 to m do { for all columns }
	begin
		for j:=1 to kk do
			begin
                    gmat(i,j):=vmat(i,j)*wmat(j)/sqrt(colmass(i));
			end;
	end;

{ calculate standard coordinates of rows: stcoordrow }
ReDim stcoordrow(k,kk);
for i:=1 to k do { for all rows }
	begin
		for j:=1 to kk do
			begin
                    stcoordrow(i,j):=fmat(i,j)/wmat(j);
			end;
	end;

{ calculate standard coordinates of columns: stcoordcol }
ReDim stcoordcol(m,kk);
for i:=1 to m do { for all cols }
	begin
		for j:=1 to kk do
			begin
                    stcoordcol(i,j):=gmat(i,j)/wmat(j);
			end;
	end;

{ calculate squared correlation of rows with principal axes: QCORn}
kk:=min(m-1,k-1);
ReDim corrrowpa(k,kk);
for i:=1 to k do
	begin
		for j:=1 to kk do
			begin
				corrrowpa(i,j):=rowmass(i)*fmat(i,j)*fmat(i,j)/inertrow(i);
			end;
	end;

{ calculate squared correlation of columns with principal axes: QCORn}
ReDim corrcolpa(m,kk);
for i:=1 to m do
	begin
		for j:=1 to kk do
			begin
				corrcolpa(i,j):=colmass(i)*gmat(i,j)*gmat(i,j)/inertcol(i);
			end;
	end;

{ calculate row inertia }
ReDim rowinert(k,kk);
for i:=1 to k do
	begin
		for j:=1 to kk do
			begin
				rowinert(i,j):=rowmass(i)*fmat(i,j)*fmat(i,j);
			end;
	end;

{ calculate column inertia }
ReDim colinert(m,kk);
for i:=1 to m do
	begin
		for j:=1 to kk do
			begin
				colinert(i,j):=colmass(i)*gmat(i,j)*gmat(i,j);
			end;
	end;

ReDim lambdakr(kk);
ReDim lambdakc(kk);
for i:=1 to kk do
	begin
		for j:=1 to k do
			begin
				lambdakr(i):=lambdakr(i)+rowinert(j,i);
			end;
	end;

for i:=1 to kk do
	begin
	for j:=1 to m do
			begin
				lambdakc(i):=lambdakc(i)+colinert(j,i);
			end;
	end;

{ calculate explained inertia of axis by row }
ReDim rowaxi(k,kk);

for i:=1 to k do
	begin
		for j:=1 to kk do
			begin
				rowaxi(i,j):=rowmass(i)*fmat(i,j)*fmat(i,j)/lambdakr(j);
			end;
	end;

{ calculate explained inertia of axis by row }
ReDim colaxi(m,kk);

for i:=1 to m do
	begin
		for j:=1 to kk do
			begin
				colaxi(i,j):=colmass(i)*gmat(i,j)*gmat(i,j)/lambdakc(j);
			end;
	end;

{ calculate quality of row }
Redim qualrow(k);
for i:=1 to k do
	begin
            qualrow(i):=0;
		for j:=1 to 2 do
			begin
				qualrow(i):=qualrow(i)+(rowmass(i)*fmat(i,j)*fmat(i,j)/inertrow(i
));
			end;

	end;

{ calculate quality of column }
ReDim qualcol(m);
for i:=1 to m do
	begin
            qualcol(i):=0;
		for j:=1 to 2 do
			begin
			  qualcol(i):=qualcol(i)+(colmass(i)*gmat(i,j)*gmat(i,j)/inertcol(i));
			end;
	end;

{ calculate matrix of row and column distances for 2- and n-dimensional solution }
ReDim rowdist2(k,k), coldist2(m,m),rowdistn(k,k),coldistn(m,m);
for i:=1 to k do
	begin
		for j:=1 to k do
			begin
				if (i=j) then
				begin
					rowdist2(i,j):=0;
					rowdistn(i,j):=0;
					goto skip;
				end;
				dist2:=0; distn:=0;
				for ji:=1 to kk do
					begin
					if (ji<=2) then dist2:=dist2+(
							(fmat(i,ji)-fmat(j,ji))*
							(fmat(i,ji)-fmat(j,ji))
						     );
					distn:=distn+(
							(fmat(i,ji)-fmat(j,ji))*
							(fmat(i,ji)-fmat(j,ji))
						     );
					end;
					rowdist2(i,j):=sqrt(dist2);
					rowdistn(i,j):=sqrt(distn);
skip:
			end;
	end;

for i:=1 to m do
	begin
		for j:=1 to m do
			begin
				if (i=j) then
				begin
					coldist2(i,j):=0;
					coldistn(i,j):=0;
					goto skip2
				end;
				dist2:=0; distn:=0;
				for ji:=1 to kk do
					begin
					if (ji<=2) then dist2:=dist2+(
							(gmat(i,ji)-gmat(j,ji))*
							(gmat(i,ji)-gmat(j,ji))
						     );
					distn:=distn+(
							(gmat(i,ji)-gmat(j,ji))*
							(gmat(i,ji)-gmat(j,ji))
						     );
					end;
					coldist2(i,j):=sqrt(dist2);
					coldistn(i,j):=sqrt(distn);
skip2:
		end;
	end;





colstr$:='';
if (inputtype=1) then for i:=1 to m do colstr$:=colstr$+VarName(i)+'|';
if (inputtype=2) then
	begin
        maxstrlen:=0;
        for i:=1 to m do
		begin
              ScrollsheetGetColName (handle, i, s1$,s2$);
              colstr$:=colstr$+s1$+','+s2$+'|';
              l:=len(s1$)+len(s2$)+1;
              if (l>=maxstrlen  ) then maxstrlen:=l;
            end;
        end;
xrelcolstr$:=colstr$;
barecolstr$:=colstr$;
colstr$:=colstr$+'Total';
rowstr$:='';
if (inputtype=1) then for i:=1 to k do rowstr$:=rowstr$+CaseName(i)+'|';
if (inputtype=2) then
	begin
        for i:=1 to k do
          begin
             ScrollsheetGetRowName (handle, i, s$);
             rowstr$:=rowstr$+s$+'|';
          end;
      end;

xrelrowstr$:=rowstr$;
barerowstr$:=rowstr$;
rowstr$:=rowstr$+'Total';

NewScrollsheet (k,k,rowdist2,'Row distances in 2 dimensions', barerowstr$, barerowstr$);
NewScrollsheet (m,m,coldist2,'Column distances in 2 dimensions', barecolstr$,
barecolstr$);
if (kk>2) then
begin
	NewScrollsheet (k,k,rowdistn,'Row distances in all dimensions', barerowstr$,
		barerowstr$);
	NewScrollsheet (m,m,coldistn,'Column distances in all dimensions', barecolstr$,
		barecolstr$);
end;


if (kk>=3) then
	begin
            resultcols:=12;
		ReDim resmat(k+m,resultcols);
            parstr$:='mass|sqcorr2|inr|loc1|qcor1|inr1|loc2|qcor2|inr2|loc3|qcor3|inr3';
	end;
if (kk<3) then
	begin
		resultcols:=9;
		ReDim resmat(k+m,resultcols);
            parstr$:='mass|sqcorr|inr|loc1|qcor1|inr1|loc2|qcor2|inr2';
	end;

{
  *** result table: ***
  col  1: MASS 	masses
  col  2: SQCORR	 squared correlation
  col  3: INR      inertia of each profile point
  col  4: LOC1     principal coordinate on axis 1
  col  5: QCOR1    squared correlation of profile with axis 1
  col  6: INR1	 proportion of inertia on axis 1
  col  7: LOC2     principal coordinate on axis 2
  col  8: QCOR2    squared correlation of profile with axis 2
  col  9: INR2	 proportion of inertia on axis 2
  if kk>=3:
  col 10: LOC1     principal coordinate on axis 1
  col 11: QCOR1    squared correlation of profile with axis 1
  col 12: INR1	 proportion of inertia on axis 1
}

for i:=1 to k do
	begin
	  resmat(i,1):=rowmass(i);
        resmat(i,2):=qualrow(i);
        resmat(i,3):=inertrow(i)/totalinertia;
        resmat(i,4):=fmat(i,1);
        resmat(i,5):=corrrowpa(i,1);
        resmat(i,6):=rowaxi(i,1);
        resmat(i,7):=fmat(i,2);
        resmat(i,8):=corrrowpa(i,2);
        resmat(i,9):=rowaxi(i,2);
        if (kk>=3) then
		begin
              resmat(i,10):=fmat(i,3);
		  resmat(i,11):=corrrowpa(i,3);
              resmat(i,12):=rowaxi(i,3);
		end;
	end;
for i:=k+1 to k+m do
	begin
        resmat(i,1):=colmass(i-k);
        resmat(i,2):=qualcol(i-k);
        resmat(i,3):=inertcol(i-k)/totalinertia;
        resmat(i,4):=gmat(i-k,1);
        resmat(i,5):=corrcolpa(i-k,1);
        resmat(i,6):=colaxi(i-k,1);
        resmat(i,7):=gmat(i-k,2);
        resmat(i,8):=corrcolpa(i-k,2);
        resmat(i,9):=colaxi(i-k,2);
	  if (kk>=3) then
		begin
              resmat(i,10):=gmat(i-k,3);
		  resmat(i,11):=corrcolpa(i-k,3);
              resmat(i,12):=colaxi(i-k,3);
		end;
	end;
NewScrollsheet (k+m, resultcols, resmat, 'General statistics', barerowstr$+barecolstr$,
parstr$);

ReDim resmatglob(4);
resmatglob(1):=chisqsum;
resmatglob(2):=totalinertia;
resmatglob(3):=cramersv;
resmatglob(4):=n;
NewScrollsheet (4, 1, resmatglob, 'Overall parameters', 'Total chi sq.|Total
inertia|Cramers V|n',
'Parameters');


handle2:=NewScrollsheet (k, m, xrelpct, 'Relative cell occupation (%)', xrelrowstr$,
xrelcolstr$);
handle3:=NewScrollsheet (k+1, m+1, rowprof, 'Row profiles (%)', rowstr$, colstr$);
handle4:=NewScrollsheet (k+1, m+1, colprof, 'Column profiles (%)', rowstr$, colstr$);
handle4:=NewScrollsheet (k,   m  , chisqcomp, 'Chi squared components',
rowstr$,colstr$);
ReDim prinerttab(kk,3);

for i:=1 to kk do
	begin
	   prinerttab(i,1):=wmat(i)*wmat(i);
         prinerttab(i,2):=wmat(i)*wmat(i)/totalinertia*100.0;
         for j:=1 to i do prinerttab(i,3):=prinerttab(i,3)+prinerttab(j,2);
	end;
pricolstr$:='principal inertia|explained (%)| cumulative (%)';
prirowstr$:='';
for i:=1 to kk do prirowstr$:=prirowstr$+'axis '+str(i,2,1)+'|';
handle5:=NewScrollsheet(kk,3,prinerttab,'Principal inertias and
percentages',prirowstr$,pricolstr$);


if (inputtype=2) then
	begin
        ScrollsheetSetColumnWidth (handle2, maxstrlen, 1);
        ScrollsheetSetColumnWidth (handle3, maxstrlen, 1);
        ScrollsheetSetColumnWidth (handle4, maxstrlen, 1);
	end;

axisstr$:='';
for i:=1 to kk do
	begin
		axisstr$:=axisstr$+'axis'+str(i,2,0);
		if (i<kk) then axisstr$:=axisstr$+'|';
	end;

NewScrollsheet (k, kk, fmat, 'Rows: Principal coordinates', barerowstr$, axisstr$);
NewScrollsheet (m, kk, gmat, 'Columns: Principal coordinates', barecolstr$, axisstr$);



ReDim xval1(k),yval1(k),zval1(k),xval2(m),yval2(m),zval2(m);
MatrixGetColumn (fmat, 1, xval1);
MatrixGetColumn (fmat, 2, yval1);
MatrixGetColumn (gmat, 1, xval2);
MatrixGetColumn (gmat, 2, yval2);
if (kk>=3) then
	begin
		MatrixgetColumn(fmat,3,zval1);
		MatrixgetColumn(gmat,3,zval2);
	end;


ghandlec:=NewGraph3DHistogram (HIST3D_BOXES, 'Chi squared components (total chi squared
= '+str(chisqsum,8,3)+')', 'Rows', 'Columns', 'Chi squared', m,k, chisqcomp,
barecolstr$, barerowstr$);

ghandler:=NewGraph3DHistogram (HIST3D_BOXES, 'Relative cell counts %)', 'Rows',
'Columns', 'Percent', m,k, xrelpct, barecolstr$, barerowstr$);


ghandle1:=NewGraph (SCATTERPLOT, "Row plot", "Axis2", "Axis1", k, xval1,yval1);
GraphSetDataPointLabels(ghandle1,1,k,rowstr$);
GraphSetGridlines (ghandle1, GRIDLINES_NONE);

ghandle2:=NewGraph (SCATTERPLOT, "Column plot", "Axis2", "Axis1", m, xval2,yval2);
GraphSetDataPointLabels(ghandle2,1,m,colstr$);
GraphSetGridlines (ghandle2, GRIDLINES_NONE);


if ((kk>=3) and (plotmode=2)) then
	begin
            ghandle3:=NewGraphXYZ (SCATTERPLOTXYZ, '3D Row plot', 'Axis2', 'Axis1',
		'Axis3', k, xval1, yval1, zval1);
		GraphSetDataPointLabels(ghandle3,1,k,rowstr$);
		ghandle4:=NewGraphXYZ (SCATTERPLOTXYZ, '3D Column plot', 'Axis2', 'Axis1',
		'Axis3', m, xval2, yval2, zval2);
		GraphSetDataPointLabels(ghandle4,1,m,colstr$);
	end;



ReDim xvalall(k+m),yvalall(k+m),zvalall(k+m);

for i:=1 to k do
	begin
	  xvalall(i):=xval1(i);
	  yvalall(i):=yval1(i);
	  if (kk>=3) then zvalall(i):=zval1(i);
	end;

for i:=k+1 to k+m do
	begin
	  xvalall(i):=xval2(i-k);
	  yvalall(i):=yval2(i-k);
	  if (kk>=3) then zvalall(i):=zval2(i-k);
	end;


ghandle4:=NewGraph (SCATTERPLOT, "Combined plot", "Axis2", "Axis1", k, xval1,yval1);
GraphSetDataPointLabels(ghandle4,1,k,barerowstr$);
GraphAddPlot (ghandle4, SCATTERPLOT, 'Columns', m, xval2, yval2);
GraphSetDataPointLabels(ghandle4,2,m,barecolstr$);
GraphSetPlotPointStyle (ghandle4, 2, on, P_FILLED_SQUARE, ?Size, ?Color);
GraphSetPlotPointStyle (ghandle4, 1, on, P_CIRCLE, ?Size, ?Color);
GraphSetGridlines (ghandle4, GRIDLINES_NONE);
GraphSetLegend (ghandle4, OFF, OFF);


if ((kk>=3)  and (plotmode=2)) then
	begin
		 ghandle5:=NewGraphXYZ (SCATTERPLOTXYZ, '3D combined plot', 'Axis2',
			'Axis1','Axis3', k+m, xvalall, yvalall, zvalall);
		GraphSetDataPointLabels(ghandle5,1,k+m,barerowstr$+barecolstr$);
	end;


ghandle5:=NewMatrix (MATRIX_SCATTERPLOT, 'Row plots: All combinations', '', '', kk, k,
fmat, axisstr$);
GraphSetDataPointLabels(ghandle5,1,k,barerowstr$);
GraphSetMatrixHistograms (ghandle5, MATRIX_HIST_OFF, ?NumberOfBins);
GraphSetGridlines (ghandle5, GRIDLINES_NONE);


ghandle6:=NewMatrix (MATRIX_SCATTERPLOT, 'Column plots: All combinations', '', '', kk,
m, gmat, axisstr$);
GraphSetDataPointLabels(ghandle6,1,m,barecolstr$);
GraphSetMatrixHistograms (ghandle6, MATRIX_HIST_OFF, ?NumberOfBins);
GraphSetGridlines (ghandle6, GRIDLINES_NONE);


ReDim screex(kk),screey(kk);

for i:=1 to kk do screex(i):=i;
MatrixGetColumn(prinerttab,2,screey);
ghandle7:=NewGraph (LINEPLOT, 'Scree plot', 'explained inertia (%)', 'axis number', kk,
screex, screey);
GraphSetScaling (ghandle7, AX_X, SCALING_MANUAL, 0, kk+1, 1);
GraphSetPlotPointStyle (ghandle7, 1, ON, P_FILLED_CIRCLE, ?Size, ?Color);

{ recompute table for 2 and 3 dimensional model }
ReDim Recomp2(k,m), Recomp3(k,m);
for i:=1 to k do
	begin
		for j:=1 to m do
			begin
				ksum2:=0;
				ksum3:=0;
				for ki:=1 to 2 do
					begin
						ksum2:=ksum2+fmat(i,ki)*gmat(j,ki)/
								sqrt(prinerttab(ki,1));
					end;
				if (kk>=3) then
					begin
						for ki:=1 to 3 do
							begin
								ksum3:=ksum3+fmat(i,ki)*gmat(j,ki)/
								sqrt(prinerttab(ki,1));
							end;
						end;
				{ round to nearest integer - there is no built-in function
				  to do this }
                        Recomp2(i,j):=n*rowmass(i)*colmass(j)*(1+ksum2);
				Recomp3(i,j):=n*rowmass(i)*colmass(j)*(1+ksum3);
				if (Recomp2(i,j)-trunc(Recomp2(i,j))<0.5)
                        then Recomp2(i,j):=trunc(Recomp2(i,j))
				else Recomp2(i,j):=round(Recomp2(i,j));
				if (kk>=3) then
				begin
 				  if (Recomp3(i,j)-trunc(Recomp3(i,j))<0.5)
                          then Recomp3(i,j):=trunc(Recomp3(i,j))
 				  else Recomp3(i,j):=round(Recomp3(i,j));
				end;
			end;
	end;
ReDim diff2(k,m),diff3(k,m);
for i:=1 to k do
	begin
		for j:=1 to m do
			begin
				diff2(i,j):=x(i,j)-recomp2(i,j);
				diff3(i,j):=x(i,j)-recomp3(i,j);
			end;
	end;

rcomphandle2:=NewScrollsheet (k, m, recomp2, 'Recalculated data matrix: 2D model',
barerowstr$, barecolstr$);
for i:=1 to m do ScrollsheetSetColumnFormat (rcomphandle2, i,
				SCF_INTEGER, SCF_INTEGER);

if(kk>=3) then
	begin
		rcomphandle3:=NewScrollsheet (k, m, recomp3, 'Recalculated data matrix: 3D
		model', barerowstr$, barecolstr$);
			for i:=1 to m do ScrollsheetSetColumnFormat (rcomphandle3, i,
				SCF_INTEGER, SCF_INTEGER);
	end;
grcomphandle2:=NewGraph3DHistogram (HIST3D_BOXES, '2D model: Deviations of recalculated
data ', 'Rows', 'Columns', 'Difference', m,k, diff2, barecolstr$, barerowstr$);

if (kk>=3) then
	begin
		grcomphandle3:=NewGraph3DHistogram (HIST3D_BOXES, '3D model: Deviations of
recalculated data', 'Rows', 'Columns', 'Difference', m,k, diff3, barecolstr$,
barerowstr$);
	end;

{ multivariate plot for all rows, cols, and axes }
ReDim fandgmat(k+m,kk);
for i:=1 to k do
	begin
		for j:=1 to kk do
			begin
				fandgmat(i,j):=fmat(i,j);
			end;
	end;
for i:=1+k to k+m do
	begin
		for j:=1 to kk do
			begin
				fandgmat(i,j):=gmat(i-k,j);
			end;
	end;

gcombhandle:=NewMatrix (MATRIX_SCATTERPLOT, 'Combined plots: All combinations', '', '',
kk, k+m, fandgmat, axisstr$);
GraphSetDataPointLabels(gcombhandle,1,k+m,barerowstr$+barecolstr$);
GraphSetMatrixHistograms (gcombhandle, MATRIX_HIST_OFF, ?NumberOfBins);
GraphSetGridlines (gcombhandle, GRIDLINES_NONE);
GraphSetDefaultFont (gcombhandle, ?FontName$, 8, ?Color);

NewScrollsheet (k+m, kk, fandgmat, 'All: Principal coordinates',
barerowstr$+barecolstr$, axisstr$);

if (kk>=3) then gndimhandle:=NewIconGraph (ICON_STARS, 'Multivariate plot', '','Axes are
numbered from 12:00 in clockwise order', kk, k+m, fandgmat, barerowstr$+barecolstr$, axisstr$);
Back to List of Programs



[StatSoft]
2300 East 14th Street, Tulsa, OK 74104
Phone: (918) 749-1119; Fax: (918) 749-2217

[StatSoft]e-mail: info@statsoft.com

©Copyright StatSoft, Inc., 1984-2004.
StatSoft, StatSoft logo, STATISTICA, SEWSS, SEDAS, Data Miner, SEPATH and GTrees are trademarks of StatSoft, Inc.