pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity
Files
c95d86dba082c99173b6dc50f714c99dba0938a4
lazarus-ccr/applications/lazstats/source_orig/correspondenceunit.pas
wp_xxyyzz 0875c16886 LazStats: Adding original source, part 2. 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7881 8e941d3f-bd1b-0410-a28a-d453659cc2b4
2020-11-16 11:04:25 +00:00

1028 lines
33 KiB
ObjectPascal
Raw Blame History

unit CorrespondenceUnit;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
StdCtrls, Buttons, MainUnit, Globals, functionsLib, OutPutUnit, DataProcs,
DictionaryUnit, contexthelpunit, MatrixLib, Math, BlankFrmUnit;
type
{ TCorrespondenceForm }
TCorrespondenceForm = class(TForm)
HelpBtn: TButton;
ResetBtn: TButton;
CancelBtn: TButton;
ComputeBtn: TButton;
ReturnBtn: TButton;
ObsChk: TCheckBox;
CheckPChk: TCheckBox;
RowCorres: TCheckBox;
ColCorrChk: TCheckBox;
BothCorrChk: TCheckBox;
PlotChk: TCheckBox;
PropsChk: TCheckBox;
ExpChk: TCheckBox;
ChiChk: TCheckBox;
YatesChk: TCheckBox;
ShowQChk: TCheckBox;
QCheckChk: TCheckBox;
EigenChk: TCheckBox;
ShowABChk: TCheckBox;
ColList: TListBox;
GroupBox1: TGroupBox;
RowEdit: TEdit;
RowIn: TBitBtn;
ColIn: TBitBtn;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
RowOut: TBitBtn;
ColOut: TBitBtn;
VarList: TListBox;
Memo1: TMemo;
procedure ColInClick(Sender: TObject);
procedure ColOutClick(Sender: TObject);
procedure ComputeBtnClick(Sender: TObject);
procedure HelpBtnClick(Sender: TObject);
procedure ResetBtnClick(Sender: TObject);
procedure plotxy(Xpoints, Ypoints : DblDyneVec; Xmax, Xmin, Ymax,
Ymin : double; N : integer;
PtLabels : StrDyneVec; titlestr,
Xlabel, Ylabel : string);
procedure RowInClick(Sender: TObject);
procedure RowOutClick(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
end;
var
CorrespondenceForm: TCorrespondenceForm;
implementation
{ TCorrespondenceForm }
procedure TCorrespondenceForm.ResetBtnClick(Sender: TObject);
VAR i : integer;
begin
VarList.Clear;
ColList.Clear;
RowEdit.Text := '';
RowIn.Visible := true;
RowOut.Visible := false;
ColIn.Visible := true;
ColOut.Visible := false;
for i := 1 to NoVariables do
VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]);
end;
procedure TCorrespondenceForm.ColInClick(Sender: TObject);
VAR i, index : integer;
begin
index := VarList.Items.Count;
i := 0;
while (i < index) do
begin
if (VarList.Selected[i]) then
begin
ColList.Items.Add(VarList.Items.Strings[i]);
VarList.Items.Delete(i);
index := index - 1;
i := 0;
end
else i := i + 1;
end;
ColOut.Visible := true;
end;
procedure TCorrespondenceForm.ColOutClick(Sender: TObject);
VAR index : integer;
begin
index := ColList.ItemIndex;
if (index < 0) then
begin
ColOut.Visible := false;
exit;
end;
VarList.Items.Add(ColList.Items.Strings[index]);
ColList.Items.Delete(index);
end;
procedure TCorrespondenceForm.ComputeBtnClick(Sender: TObject);
VAR
i, j, RowNo, ColNo, DepNo : integer;
Row, Col, NoSelected, Ncases, Nrows, Ncols, FObs, df : integer;
RowLabels, ColLabels : StrDyneVec;
ColNoSelected : IntDyneVec;
cellstring, outline, title, filename, strvalue, Instr : string;
prompt, xtitle, ytitle : string;
Freq : IntDyneMat;
Prop, Expected, CellChi : DblDyneMat;
PObs, ChiSquare, ProbChi, liklihood, probliklihood : double;
SumX, SumY, VarX, VarY, MantelHaenszel, MHprob : double;
yates : boolean;
Adjchisqr, Adjprobchi, G, dblvalue, phi, pearsonr : double;
result, intvalue, IX, IY : integer;
CoefCont, CramerV : double;
Trans : DblDyneMat; // transpose work matrix
P : DblDyneMat; // relative frequencies (n by q correspondence matrix)
r : DblDyneVec; // row vector of proportions
c : DblDyneVec; // column vector of proportions
Dr : DblDyneMat; // Diagonal matrix of row proportions
Dc : DblDyneMat; // Diagonal matric of column proportions
A : DblDyneMat; // n by q matrix whose columns are theleft generalized SVD vectors
Du : DblDyneMat; // q by q diagonal matrix of singular values
B : DblDyneMat; // m by q matrix whose columns are the right generalized SVD vectors
Q : DblDyneMat; // matrix to be decomposed by SVD into U x Da x V'
U : DblDyneMat; // left column vectors of SVD of Q
V : DblDyneMat; // right vectors of SVD of Q
W : DblDyneMat; // work matrix for transposing a matrix
F : DblDyneMat; // Row Coordinates
Gc : DblDyneMat; // Column Coordinates
n, q1, m : integer; // number of rows and columns of the P matrix
largest :integer;
errorcode : boolean;
X, Y : DblDyneVec;
Xmax, Xmin, Ymax, Ymin, Inertia : double;
labels : StrDyneVec;
begin
SetLength(ColNoSelected,NoVariables+1);
yates := false;
RowNo := 0;
for i := 1 to NoVariables do
begin
cellstring := OS3MainFrm.DataGrid.Cells[i,0];
if (cellstring = RowEdit.Text) then RowNo := i;
end;
Nrows := NoCases;
Ncols := ColList.Items.Count;
SetLength(RowLabels,Nrows+1);
SetLength(ColLabels,Ncols+1);
if (RowNo = 0) then
begin
ShowMessage('ERROR! A variable for the row labels was not entered.');
ColNoSelected := nil;
RowLabels := nil;
ColLabels := nil;
exit;
end;
ColNoSelected[0] := RowNo;
// Get Column labels
for i := 0 to Ncols-1 do
begin
ColLabels[i] := ColList.Items.Strings[i];
for j := 1 to NoVariables do
begin
cellstring := OS3MainFrm.DataGrid.Cells[j,0];
if (cellstring = ColLabels[i])then ColNoSelected[i+1] := j;
end;
end;
// Get row labels
for i := 1 to NoCases do
begin
RowLabels[i-1] := OS3MainFrm.DataGrid.Cells[RowNo,i];
end;
// allocate and initialize
SetLength(Freq,Nrows+1,Ncols+1);
SetLength(Prop,Nrows+1,Ncols+1);
SetLength(Expected,Nrows,Ncols);
SetLength(CellChi,Nrows,Ncols);
for i := 1 to Nrows + 1 do
for j := 1 to Ncols + 1 do Freq[i-1,j-1] := 0;
RowLabels[Nrows] := 'Total';
ColLabels[Ncols] := 'Total';
// get cell data
Ncases := 0;
for i := 1 to NoCases do
begin
Row := i;
for j := 1 to Ncols do
begin
Col := ColNoSelected[j];
Freq[i-1,j-1] := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[Col,Row])));
Ncases := Ncases + Freq[i-1,j-1];
end;
end;
Freq[Nrows,Ncols] := Ncases;
// Now, calculate expected values
// Get row totals first
for i := 1 to Nrows do
begin
for j := 1 to Ncols do
begin
Freq[i-1,Ncols] := Freq[i-1,Ncols] + Freq[i-1,j-1];
end;
end;
// Get col totals next
for j := 1 to Ncols do
begin
for i := 1 to Nrows do
begin
Freq[Nrows,j-1] := Freq[Nrows,j-1] + Freq[i-1,j-1];
end;
end;
// Then get expected values and cell chi-squares
ChiSquare := 0.0;
Adjchisqr := 0.0;
if ((YatesChk.Checked) and (Nrows = 2) and (Ncols = 2)) then yates := true;
if ((Nrows > 1) and (Ncols > 1)) then
begin
for i := 1 to Nrows do
begin
for j := 1 to Ncols do
begin
Expected[i-1,j-1] := Freq[Nrows,j-1] * Freq[i-1,Ncols] / Ncases;
if (Expected[i-1,j-1] > 0.0) then
CellChi[i-1,j-1] := sqr(Freq[i-1,j-1] - Expected[i-1,j-1]) / Expected[i-1,j-1]
else
begin
ShowMessage('ERROR! Zero expected value found.');
CellChi[i-1,j-1] := 0.0;
end;
ChiSquare := ChiSquare + CellChi[i-1,j-1];
end;
end;
df := (Nrows - 1) * (Ncols - 1);
if (yates = true) then // 2 x 2 corrected chi-square
begin
Adjchisqr := abs((Freq[0,0] * Freq[1,1]) - (Freq[0,1] * Freq[1,0]));
Adjchisqr := sqr(Adjchisqr - Ncases / 2.0) * Ncases; // numerator
Adjchisqr := Adjchisqr / (Freq[0,2] * Freq[1,2] * Freq[2,0] * Freq[2,1]);
Adjprobchi := 1.0 - chisquaredprob(Adjchisqr,df);
end;
end;
if (Nrows = 1) then // equal probability
begin
for j := 0 to Ncols - 1 do
begin
Expected[0,j] := Ncases / Ncols;
if (Expected[0,j] > 0) then
CellChi[0,j] := sqr(Freq[0,j] - Expected[0,j]) / Expected[0,j];
ChiSquare := ChiSquare + CellChi[0,j];
end;
df := Ncols - 1;
end;
if (Ncols = 1) then // equal probability
begin
for i := 0 to Nrows - 1 do
begin
Expected[i,0] := Ncases / Nrows;
if (Expected[i,0] > 0) then
CellChi[i,0] := sqr(Freq[i,0] - Expected[i,0]) / Expected[i,0];
ChiSquare := ChiSquare + CellChi[i,0];
end;
df := Nrows - 1;
end;
ProbChi := 1.0 - chisquaredprob(ChiSquare,df); // prob. larger chi
// Print acknowledgements
OutPutFrm.RichEdit.Lines.Add('CORRESPONDENCE ANALYSIS');
OutPutFrm.RichEdit.Lines.Add('Based on formulations of Bee-Leng Lee');
OutPutFrm.RichEdit.Lines.Add('Chapter 11 Correspondence Analysis for ViSta');
OutPutFrm.RichEdit.Lines.Add('Results are based on the Generalized Singular Value Decomposition');
OutPutFrm.RichEdit.Lines.Add('of P := A x D x B where P is the relative frequencies observed,');
OutPutFrm.RichEdit.Lines.Add('A are the left generalized singular vectors,');
OutPutFrm.RichEdit.Lines.Add('D is a diagonal matrix of generalized singular values, and');
OutPutFrm.RichEdit.Lines.Add('B is the transpose of the right generalized singular vectors.');
OutPutFrm.RichEdit.Lines.Add('NOTE: The first value and corresponding vectors are 1 and are');
OutPutFrm.RichEdit.Lines.Add('to be ignored.');
OutPutFrm.RichEdit.Lines.Add('An intermediate step is the regular SVD of the matrix Q := UDV');
OutPutFrm.RichEdit.Lines.Add('where Q := Dr^-1/2 x P x Dc^-1/2 where Dr is a diagonal matrix');
OutPutFrm.RichEdit.Lines.Add('of total row relative frequencies and Dc is a diagonal matrix');
OutPutFrm.RichEdit.Lines.Add('of total column relative frequencies.');
OutPutFrm.ShowModal;
//Print results to output form
OutPutFrm.RichEdit.Clear;
OutPutFrm.RichEdit.Lines.Add('Chi-square Analysis Results');
outline := format('No. of Cases := %d',[Ncases]);
OutPutFrm.RichEdit.Lines.Add(outline);
OutPutFrm.RichEdit.Lines.Add('');
// print tables requested by use
if (ObsChk.Checked) then
begin
IntArrayPrint(Freq, Nrows+1, Ncols+1,'Frequencies',
RowLabels, ColLabels,'OBSERVED FREQUENCIES');
OutPutFrm.ShowModal;
OutPutFrm.RichEdit.Clear;
end;
if (ExpChk.Checked)then
begin
outline := 'EXPECTED FREQUENCIES';
MAT_PRINT(Expected, Nrows, Ncols, outline, RowLabels, ColLabels, NoCases);
OutPutFrm.ShowModal;
OutPutFrm.RichEdit.Clear;
end;
outline := 'ROW PROPORTIONS';
for i := 1 to Nrows + 1 do
begin
for j := 1 to Ncols do
begin
if (Freq[i-1,Ncols] > 0.0) then
Prop[i-1,j-1] := Freq[i-1,j-1] / Freq[i-1,Ncols]
else Prop[i-1,j-1] := 0.0;
end;
if (Freq[i-1,Ncols] > 0.0) then Prop[i-1,Ncols] := 1.0
else Prop[i-1,Ncols] := 0.0;
end;
if (PropsChk.Checked) then
begin
MAT_PRINT(Prop, Nrows+1, Ncols+1, outline, RowLabels, ColLabels, NoCases);
OutPutFrm.ShowModal;
OutPutFrm.RichEdit.Clear;
end;
outline := 'COLUMN PROPORTIONS';
for j := 1 to Ncols + 1 do
begin
for i := 1 to Nrows do
begin
if (Freq[Nrows,j-1] > 0.0) then
Prop[i-1,j-1] := Freq[i-1,j-1] / Freq[Nrows,j-1]
else Prop[i-1,j-1] := 0.0;
end;
if (Freq[Nrows,j-1] > 0.0) then Prop[Nrows,j-1] := 1.0
else Prop[Nrows,j-1] := 0.0;
end;
if (PropsChk.Checked) then
begin
MAT_PRINT(Prop, Nrows+1, Ncols+1, outline, RowLabels, ColLabels, NoCases);
OutPutFrm.ShowModal;
OutPutFrm.RichEdit.Clear;
end;
outline := 'PROPORTIONS OF TOTAL N';
for i := 1 to Nrows + 1 do
for j := 1 to Ncols + 1 do Prop[i-1,j-1] := Freq[i-1,j-1] / Ncases;
Prop[Nrows,Ncols] := 1.0;
MAT_PRINT(Prop, Nrows+1, Ncols+1, outline, RowLabels, ColLabels,NoCases);
OutPutFrm.ShowModal;
OutPutFrm.RichEdit.Clear;
if (ChiChk.Checked) then
begin
outline := 'CHI-SQUARED VALUE FOR CELLS';
MAT_PRINT(CellChi, Nrows, Ncols, outline, RowLabels, ColLabels, NoCases);
OutPutFrm.ShowModal;
OutPutFrm.RichEdit.Clear;
end;
OutPutFrm.RichEdit.Lines.Add('');
outline := format('Chi-square := %8.3f with D.F. := %d. Prob. > value := %8.3f',[ChiSquare,df,ProbChi]);
OutPutFrm.RichEdit.Lines.Add(outline);
OutPutFrm.RichEdit.Lines.Add('');
if (yates = true) then
begin
outline := format('Chi-square using Yates correction = %8.3f and Prob > value := %8.3f',
[Adjchisqr,Adjprobchi]);
OutPutFrm.RichEdit.Lines.Add(outline);
end;
liklihood := 0.0;
for i := 0 to Nrows - 1 do
for j := 0 to Ncols - 1 do
if (Freq[i,j] > 0.0) then liklihood := liklihood + Freq[i,j] * (ln(Expected[i,j] / Freq[i,j]));
liklihood := -2.0 * liklihood;
probliklihood := 1.0 - chisquaredprob(liklihood,df);
outline := format('Liklihood Ratio := %8.3f with prob. > value := %6.4f',[liklihood,probliklihood]);
OutPutFrm.RichEdit.Lines.Add(outline);
OutPutFrm.RichEdit.Lines.Add('');
if ((Nrows > 1) and (Ncols > 1)) then
begin
phi := sqrt(ChiSquare / Ncases);
outline := format('phi correlation := %6.4f',[phi]);
OutPutFrm.RichEdit.Lines.Add(outline);
OutPutFrm.RichEdit.Lines.Add('');
pearsonr := 0.0;
SumX := 0.0;
SumY := 0.0;
VarX := 0.0;
VarY := 0.0;
for i := 0 to Nrows - 1 do SumX := SumX + ( (i+1) * Freq[i,Ncols] );
for j := 0 to Ncols - 1 do SumY := SumY +( (j+1) * Freq[Nrows,j] );
for i := 0 to Nrows - 1 do VarX := VarX + ( ((i+1)*(i+1)) * Freq[i,Ncols] );
for j := 0 to Ncols - 1 do VarY := VarY +( ((j+1)*(j+1)) * Freq[Nrows,j] );
VarX := VarX - ((SumX * SumX) / Ncases);
VarY := VarY - ((SumY * SumY) / Ncases);
for i := 0 to Nrows - 1 do
for j := 0 to Ncols - 1 do
pearsonr := pearsonr + ((i+1)*(j+1) * Freq[i,j]);
pearsonr := pearsonr - (SumX * SumY / Ncases);
pearsonr := pearsonr / sqrt(VarX * VarY);
outline := format('Pearson Correlation r := %6.4f',[pearsonr]);
OutPutFrm.RichEdit.Lines.Add(outline);
OutPutFrm.RichEdit.Lines.Add('');
MantelHaenszel := (Ncases-1) * (pearsonr * pearsonr);
MHprob := 1.0 - chisquaredprob(MantelHaenszel,1);
outline := format('Mantel-Haenszel Test of Linear Association := %8.3f with probability > value := %6.4f',
[MantelHaenszel, MHprob]);
OutPutFrm.RichEdit.Lines.Add(outline);
OutPutFrm.RichEdit.Lines.Add('');
CoefCont := sqrt(ChiSquare / (ChiSquare + Ncases));
outline := format('The coefficient of contingency := %8.3f',[CoefCont]);
OutPutFrm.RichEdit.Lines.Add(outline);
OutPutFrm.RichEdit.Lines.Add('');
if (Nrows < Ncols) then CramerV := sqrt(ChiSquare / (Ncases * (Nrows-1)))
else CramerV := sqrt(ChiSquare / (Ncases * ((Ncols-1))));
outline := format('Cramers V := %8.3f',[CramerV]);
OutPutFrm.RichEdit.Lines.Add(outline);
end;
OutPutFrm.ShowModal;
OutPutFrm.RichEdit.Clear;
n := Nrows;
q1 := Ncols;
if (n > q1) then largest := n
else largest := q1;
SetLength(P,n,q1);
SetLength(r,largest+1);
SetLength(c,q1);
SetLength(Dr,n,n);
SetLength(Dc,q1,q1);
SetLength(A,n,q1);
SetLength(Du,largest,largest);
SetLength(B,n,q1);
SetLength(Q,n,q1);
SetLength(U,n,n);
SetLength(V,q1,q1);
SetLength(W,largest+1,largest+1);
SetLength(Trans,q1,q1);
SetLength(F,n,q1);
SetLength(Gc,q1,q1);
// get proportion matices and vectors
for i := 0 to n - 1 do
for j := 0 to q1 - 1do P[i,j] := Prop[i,j];
for i := 0 to n - 1 do r[i] := Prop[i,q1];
for j := 0 to q1 - 1 do c[j] := Prop[n,j];
// get Dr^-1/2 and Dc^-1/2
for i := 0 to n - 1 do
begin
for j := 0 to n - 1 do
begin
if (i <> j) then Dr[i,j] := 0.0
else Dr[i,j] := 1.0 / sqrt(r[i]);
end;
end;
for i := 0 to q1 - 1 do
begin
for j := 0 to q1 -1 do
begin
if (i <> j) then Dc[i,j] := 0.0
else Dc[i,j] := 1.0 / sqrt(c[j]);
end;
end;
// get q1 := Dr^-1/2 times P times Dc^-1/2
MATAxB(W,Dr,P,n,n,n,q1,errorcode);
MATAxB(q,W,Dc,n,q1,q1,q1,errorcode);
if (ShowqChk.Checked) then
begin
outline := 'Q Matrix';
MAT_PRINT(q,n,q1,outline,RowLabels,ColLabels,NoCases);
OutPutFrm.ShowModal;
OutPutFrm.RichEdit.Clear;
(*
Instr := InputBox('Save q1 to Main Grid?','Y','N');
if (Instr = 'Y') then
begin
OS3MainFrm.CloseFileBtnClick(self);
OS3MainFrm.DataGrid.RowCount := n + 1;
OS3MainFrm.DataGrid.ColCount := q1 + 1;
for i := 0 to n - 1 do
for j := 0 to q1 - 1 do
OS3MainFrm.DataGrid.Cells[j+1,i+1] := q1[i,j];
for i := 1 to n do
OS3MainFrm.DataGrid.Cells[0,i] := 'CASE ' + IntToStr(i);
for j := 1 to q1 do
OS3MainFrm.DataGrid.Cells[j,0] := 'VAR' + IntToStr(j);
end;
end;
*)
//Obtain ordinary SVD analysis of q1
matinv(q,U,Du,V,q1);
if (EigenChk.Checked) then
begin
outline := 'U Matrix';
MAT_PRINT(U,n,q1,outline,RowLabels,ColLabels,NoCases);
// FrmOutPut.ShowModal;
outline := 'Singular Values';
MAT_PRINT(Du,q1,q1,outline,ColLabels,ColLabels,NoCases);
// FrmOutPut.ShowModal;
outline := 'V Matrix';
MAT_PRINT(V,q1,q1,outline,ColLabels,ColLabels,NoCases);
OutPutFrm.ShowModal;
OutPutFrm.RichEdit.Clear;
end;
if (qCheckChk.Checked) then
begin
// Check to see if q1 is reproduced by U x D x V'
MATAxB(W,U,Du,n,q1,q1,q1,errorcode);
for i := 0 to q1 - 1 do
for j := 0 to q1 - 1 do Trans[i,j] := V[j,i];
MATAxB(q,W,Trans,n,q1,q1,q1,errorcode);
outline := 'Reproduced Q = UDV';
MAT_PRINT(q,n,q1,outline,RowLabels,ColLabels,NoCases);
OutPutFrm.ShowModal;
OutPutFrm.RichEdit.Clear;
end;
// Get A := Dr^1/2 times U
for i := 0 to n - 1 do
begin
for j := 0 to n - 1 do
begin
if (i <> j) then Dr[i,j] := 0.0
else Dr[i,j] := sqrt(r[i]);
end;
end;
MATAxB(A,Dr,U,n,n,n,q1,errorcode);
if (ShowABChk.Checked) then
begin
outline := 'A Matrix';
MAT_PRINT(A,n,q1,outline,RowLabels,ColLabels,NoCases);
OutPutFrm.ShowModal;
OutPutFrm.RichEdit.Clear;
end;
// Get B := Dc^1/2 times V
for i := 0 to q1 - 1 do
begin
for j := 0 to q1-1 do
begin
if (i <> j) then Dc[i,j] := 0.0
else Dc[i,j] := sqrt(c[j]);
end;
end;
MATAxB(B,Dc,V,q1,q1,q1,q1,errorcode);
if (ShowABChk.Checked) then
begin
outline := 'B Matrix';
MAT_PRINT(B,q1,q1,outline,ColLabels,ColLabels,NoCases);
OutPutFrm.ShowModal;
OutPutFrm.RichEdit.Clear;
end;
if (CheckPChk.Checked) then
begin // see if P := A x Du x B'
for i := 0 to q1 - 1 do
for j := 0 to q1 - 1 do Trans[j,i] := B[i,j];
MATAxB(W,A,Du,n,q1,q1,q1,errorcode);
MATAxB(P,W,Trans,n,q1,q1,q1,errorcode);
outline := 'P = ';
MAT_PRINT(P,n,q1,outline,RowLabels,ColLabels,NoCases);
OutPutFrm.ShowModal;
OutPutFrm.RichEdit.Clear;
end;
// show intertia and scree plot
Inertia := ChiSquare / Freq[Nrows,Ncols];
outline := format('Inertia := %8.4f',[Inertia]);
OutPutFrm.RichEdit.Lines.Add(outline);
OutPutFrm.RichEdit.Lines.Add('');
OutPutFrm.ShowModal;
OutPutFrm.RichEdit.Clear;
if (PlotChk.Checked) then
begin
SetLength(X,n);
SetLength(Y,n);
SetLength(labels,q1);
Xmax := -10000.0;
Ymax := Xmax;
Xmin := 10000.0;
Ymin := Xmin;
X[0] := 1;
Y[0] := sqr(Du[1,1]);
for i := 1 to q1 - 1 do
begin
X[i] := i;
Y[i] := sqr(Du[i,i]);
outline := format('%4.3f%',[(Y[i] / Inertia)*100.0]);
labels[i] := outline; // 'Dim.' + IntToStr(i);
if (X[i] > Xmax) then Xmax := X[i];
if (X[i] < Xmin) then Xmin := X[i];
if (Y[i] > Ymax) then Ymax := Y[i];
if (Y[i] < Ymin) then Ymin := Y[i];
end;
title := 'Goodness of Fit Plot';
plotxy(X,Y,Xmax,Xmin,Ymax,Ymin,q1,labels, title,'Dimension',' ');
BlankFrm.ShowModal;
labels := nil;
Y := nil;
X := nil;
end;
// if (RowCorres.Checked)then
// begin
// Get Row coordinates F (for row profile analysis)
for i := 0 to n - 1 do
begin
for j := 0 to n - 1 do
begin
if (i <> j) then Dr[i,j] := 0.0
else Dr[i,j] := 1.0 / r[i];
end;
end;
MATAxB(W,Dr,A,n,n,n,q1,errorcode);
// ArrayPrint(W,n,q1,'Dr x A matrix',RowLabels,ColLabels,'Dr x A Matrix');
// FrmOutPut.ShowModal;
MATAxB(F,W,Du,n,q1,q1,q1,errorcode);
if (RowCorres.Checked) then
begin
outline := 'Row Dimensions (Ignore Col. 1';
MAT_PRINT(F,n,q1,outline,RowLabels,ColLabels,NoCases);
OutPutFrm.ShowModal;
OutPutFrm.RichEdit.Clear;
end;
// Get Column coordinates G (row profile analysis)
for i := 0 to q1 - 1 do
begin
for j := 0 to q1 - 1 do
begin
if (i <> j) then Dc[i,j] := 0.0
else Dc[i,j] := 1.0 / c[j];
end;
end;
MATAxB(Gc,Dc,B,q1,q1,q1,q1,errorcode);
if (RowCorres.Checked) then
begin
outline := 'Col. Dimensions (Ignore Col. 1';
MAT_PRINT(Gc,q1,q1,outline,ColLabels,ColLabels,NoCases);
OutPutFrm.ShowModal;
OutPutFrm.RichEdit.Clear;
end;
if ((PlotChk.Checked) and (RowCorres.Checked))then
begin
prompt := InputBox('X Axis Dimension','1','1');
IX := StrToInt(prompt);
prompt := InputBox('Y Axis Dimension','2','2');
IY := StrToInt(prompt);
xtitle := 'Dimension ' + IntToStr(IX);
ytitle := 'Dimension ' + IntToStr(IY);
SetLength(X,n);
SetLength(Y,n);
Xmax := -10000.0;
Ymax := Xmax;
Xmin := 10000.0;
Ymin := Xmin;
for i := 0 to n - 1 do
begin
X[i] := F[i,IX];
if (X[i] > Xmax) then Xmax := X[i];
if (X[i] < Xmin) then Xmin := X[i];
Y[i] := F[i,IY];
if (Y[i] > Ymax) then Ymax := Y[i];
if (Y[i] < Ymin) then Ymin := Y[i];
end;
title := 'Row Dimensions';
plotxy(X,Y,Xmax,Xmin,Ymax,Ymin,n,RowLabels, title,xtitle,ytitle);
BlankFrm.ShowModal;
Y := nil;
X := nil;
SetLength(X,q1);
SetLength(Y,q1);
Xmax := -10000.0;
Ymax := Xmax;
Xmin := 10000.0;
Ymin := Xmin;
for i := 0 to q1 - 1 do
begin
X[i] := Gc[i,IX];
if (X[i] > Xmax) then Xmax := X[i];
if (X[i] < Xmin) then Xmin := X[i];
Y[i] := Gc[i,IY];
if (Y[i] > Ymax) then Ymax := Y[i];
if (Y[i] < Ymin) then Ymin := Y[i];
end;
title := 'Column Dimensions';
plotxy(X,Y,Xmax,Xmin,Ymax,Ymin,q1,ColLabels, title,xtitle,ytitle);
BlankFrm.ShowModal;
Y := nil;
X := nil;
end;
// end;
// do column correspondence analysis if checked
// if (ColCorrChk.Checked) then
// begin
for i := 0 to q1 - 1 do
for j := 0 to q1 - 1 do W[i,j] := Gc[i,j]; // use last Gc
MATAxB(Gc,W,Du,q1,q1,q1,q1,errorcode); // multiply times Du
if (ColCorrChk.Checked) then
begin
outline := 'Column Dimensions (Ignore Col. 1';
MAT_PRINT(Gc,q1,q1,outline,ColLabels,ColLabels,NoCases);
OutPutFrm.ShowModal;
end;
MATAxB(F,Dr,A,n,n,n,q1,errorcode); // Get new F
if (ColCorrChk.Checked) then
begin
outline := 'Row Dimensions (Ignore Col. 1)';
MAT_PRINT(F,n,q1,outline,RowLabels,ColLabels,NoCases);
OutPutFrm.ShowModal;
OutPutFrm.RichEdit.Clear;
end;
if ((PlotChk.Checked) and (ColCorrChk.Checked)) then
begin
prompt := InputBox('X Axis Dimension','1','1');
IX := StrToInt(prompt);
prompt := InputBox('Y Axis Dimension','2','2');
IY := StrToInt(prompt);
SetLength(X,q1);
SetLength(Y,q1);
xtitle := 'Dimension ' + IntToStr(IX);
ytitle := 'Dimension ' + IntToStr(IY);
Xmax := -10000.0;
Ymax := Xmax;
Xmin := 10000.0;
Ymin := Xmin;
for i := 0 to q1 - 1 do
begin
X[i] := Gc[i,IX];
if (X[i] > Xmax) then Xmax := X[i];
if (X[i] < Xmin) then Xmin := X[i];
Y[i] := Gc[i,IY];
if (Y[i] > Ymax) then Ymax := Y[i];
if (Y[i] < Ymin) then Ymin := Y[i];
end;
title := 'Column Dimensions';
plotxy(X,Y,Xmax,Xmin,Ymax,Ymin,q1,ColLabels, title,xtitle,ytitle);
BlankFrm.ShowModal;
Y := nil;
X := nil;
SetLength(X,n);
SetLength(Y,n);
Xmax := -10000.0;
Ymax := Xmax;
Xmin := 10000.0;
Ymin := Xmin;
for i := 0 to n - 1 do
begin
X[i] := F[i,IX];
if (X[i] > Xmax) then Xmax := X[i];
if (X[i] < Xmin) then Xmin := X[i];
Y[i] := F[i,IY];
if (Y[i] > Ymax) then Ymax := Y[i];
if (Y[i] < Ymin) then Ymin := Y[i];
end;
title := 'Row Dimensions';
plotxy(X,Y,Xmax,Xmin,Ymax,Ymin,n,RowLabels, title,xtitle,ytitle);
BlankFrm.ShowModal;
Y := nil;
X := nil;
end;
// end;
// do both if checked
if (BothCorrChk.Checked) then
begin
// F is same as for Row correspondence and Gc is same as for columns
for i := 0 to n - 1 do
for j := 0 to q1 - 1 do W[i,j] := F[i,j];
MATAxB(F,W,Du,n,q1,q1,q1,errorcode);
outline := 'Row Dimensions (Ignore Col. 1';
MAT_PRINT(F,n,q1,outline,RowLabels,ColLabels,NoCases);
OutPutFrm.ShowModal;
outline := 'Column Dimensions (Ignore Col. 1)';
MAT_PRINT(Gc,q1,q1,outline,ColLabels,ColLabels,NoCases);
OutPutFrm.ShowModal;
if (PlotChk.Checked)then
begin
prompt := InputBox('X Axis Dimension','1','1');
IX := StrToInt(prompt);
prompt := InputBox('Y Axis Dimension','2','2');
IY := StrToInt(prompt);
xtitle := 'Dimension ' + IntToStr(IX);
ytitle := 'Dimension ' + IntToStr(IY);
SetLength(X,n);
SetLength(Y,n);
Xmax := -10000.0;
Ymax := Xmax;
Xmin := 10000.0;
Ymin := Xmin;
for i := 0 to n - 1 do
begin
X[i] := F[i,IX];
if (X[i] > Xmax) then Xmax := X[i];
if (X[i] < Xmin) then Xmin := X[i];
Y[i] := F[i,IY];
if (Y[i] > Ymax) then Ymax := Y[i];
if (Y[i] < Ymin) then Ymin := Y[i];
end;
title := 'Row Dimensions';
plotxy(X,Y,Xmax,Xmin,Ymax,Ymin,n,RowLabels, title,xtitle,ytitle);
BlankFrm.ShowModal;
Y := nil;
X := nil;
SetLength(X,q1);
SetLength(Y,q1);
Xmax := -10000.0;
Ymax := Xmax;
Xmin := 10000.0;
Ymin := Xmin;
for i := 0 to q1 - 1 do
begin
X[i] := Gc[i,IX];
if (X[i] > Xmax) then Xmax := X[i];
if (X[i] < Xmin) then Xmin := X[i];
Y[i] := Gc[i,IY];
if (Y[i] > Ymax) then Ymax := Y[i];
if (Y[i] < Ymin) then Ymin := Y[i];
end;
title := 'Column Dimensions';
plotxy(X,Y,Xmax,Xmin,Ymax,Ymin,q1,ColLabels, title,xtitle,ytitle);
BlankFrm.ShowModal;
Y := nil;
X := nil;
end;
end;
// FrmOutPut.ShowModal;
// clean up memory
Gc := nil;
F := nil;
Trans := nil;
W := nil;
V := nil;
q := nil;
B := nil;
Du := nil;
A := nil;
Dc := nil;
Dr := nil;
c := nil;
r := nil;
P := nil;
ColLabels := nil;
RowLabels := nil;
CellChi := nil;
Expected := nil;
Prop := nil;
Freq := nil;
ColNoSelected := nil;
end;
end;
procedure TCorrespondenceForm.HelpBtnClick(Sender: TObject);
begin
ContextHelpForm.HelpMessage((Sender as TButton).tag);
end;
procedure TCorrespondenceForm.plotxy(Xpoints, Ypoints : DblDyneVec; Xmax, Xmin, Ymax,
Ymin : double; N : integer;
PtLabels : StrDyneVec; titlestr,
Xlabel, Ylabel : string);
VAR
i, xpos, ypos, hleft, hright, vtop, vbottom, imagewide :integer;
vhi, hwide, offset, strhi, imagehi : integer;
maxval, minval, valincr, Yvalue, Xvalue, value : double;
Title, astring, outline : string;
begin
Title := 'X versus Y PLOT';
BlankFrm.Caption := Title;
imagewide := BlankFrm.Image1.Width;
imagehi := BlankFrm.Image1.Height;
BlankFrm.Image1.Canvas.FloodFill(0,0,clYellow,fsBorder);
vtop := 20;
vbottom := round(imagehi) - 80;
vhi := vbottom - vtop;
hleft := 100;
hright := imagewide - 80;
hwide := hright - hleft;
BlankFrm.Image1.Canvas.Pen.Color := clBlack;
BlankFrm.Image1.Canvas.Brush.Color := clWhite;
// Draw chart border
BlankFrm.Image1.Canvas.Rectangle(0,0,imagewide,imagehi);
// draw horizontal axis
BlankFrm.Image1.Canvas.Pen.Color := clBlack;
BlankFrm.Image1.Canvas.MoveTo(hleft,vbottom);
BlankFrm.Image1.Canvas.LineTo(hright,vbottom);
valincr := (Xmax - Xmin) / 10.0;
for i := 1 to 11 do
begin
ypos := vbottom;
Xvalue := Xmin + valincr * (i - 1);
xpos := round(hwide * ((Xvalue - Xmin) / (Xmax - Xmin)));
xpos := xpos + hleft;
BlankFrm.Image1.Canvas.MoveTo(xpos,ypos);
ypos := ypos + 10;
BlankFrm.Image1.Canvas.LineTo(xpos,ypos);
outline := format('%6.2f',[Xvalue]);
Title := outline;
offset := BlankFrm.Image1.Canvas.TextWidth(Title) div 2;
xpos := xpos - offset;
BlankFrm.Image1.Canvas.Pen.Color := clBlack;
BlankFrm.Image1.Canvas.TextOut(xpos,ypos,Title);
end;
astring := Xlabel; // 'Dimension 1';
xpos := hleft + (hwide div 2) - (BlankFrm.Image1.Canvas.TextWidth(astring) div 2);
ypos := vbottom + 20;
BlankFrm.Image1.Canvas.TextOut(xpos,ypos,astring);
// Draw vertical axis
Title := Ylabel; // 'Dimension 2';
xpos := hleft - BlankFrm.Image1.Canvas.TextWidth(Title) div 2;
ypos := vtop - BlankFrm.Image1.Canvas.TextHeight(Title);
BlankFrm.Image1.Canvas.TextOut(xpos,ypos,Title);
xpos := hleft;
ypos := vtop;
BlankFrm.Image1.Canvas.MoveTo(xpos,ypos);
ypos := vbottom;
BlankFrm.Image1.Canvas.LineTo(xpos,ypos);
valincr := (Ymax - Ymin) / 10.0;
for i := 1 to 11 do
begin
value := Ymax - ((i-1) * valincr);
outline := format('%8.3f',[value]);
Title := outline;
strhi := BlankFrm.Image1.Canvas.TextHeight(Title);
xpos := 10;
Yvalue := Ymax - (valincr * (i-1));
ypos := round(vhi * ( (Ymax - Yvalue) / (Ymax - Ymin)));
ypos := ypos + vtop - strhi div 2;
BlankFrm.Image1.Canvas.TextOut(xpos,ypos,Title);
xpos := hleft;
ypos := ypos + strhi div 2;
BlankFrm.Image1.Canvas.MoveTo(xpos,ypos);
xpos := hleft - 10;
BlankFrm.Image1.Canvas.LineTo(xpos,ypos);
end;
// draw points for x and y pairs
BlankFrm.Image1.Canvas.Font.Size := 8;
for i := 0 to N - 1 do
begin
ypos := round(vhi * ( (Ymax - Ypoints[i]) / (Ymax - Ymin)));
ypos := ypos + vtop;
xpos := round(hwide * ( (Xpoints[i] - Xmin) / (Xmax - Xmin)));
xpos := xpos + hleft;
BlankFrm.Image1.Canvas.Brush.Color := clNavy;
BlankFrm.Image1.Canvas.Brush.Style := bsSolid;
BlankFrm.Image1.Canvas.Pen.Color := clNavy;
BlankFrm.Image1.Canvas.Ellipse(xpos,ypos,xpos+5,ypos+5);
BlankFrm.Image1.Canvas.Pen.Color := clBlack;
BlankFrm.Image1.Canvas.Brush.Color := clWhite;
BlankFrm.Image1.Canvas.TextOut(xpos+3,ypos-5,PtLabels[i]);
end;
xpos := hleft + (hwide div 2) - (BlankFrm.Image1.Canvas.TextWidth(titlestr) div 2);
ypos := vbottom + 40;
BlankFrm.Image1.Canvas.TextOut(xpos,ypos,titlestr);
end;
procedure TCorrespondenceForm.RowInClick(Sender: TObject);
VAR index : integer;
begin
index := VarList.ItemIndex;
RowEdit.Text := VarList.Items.Strings[index];
VarList.Items.Delete(index);
RowIn.Visible := false;
RowOut.Visible := true;
end;
procedure TCorrespondenceForm.RowOutClick(Sender: TObject);
begin
VarList.Items.Add(RowEdit.Text);
RowEdit.Text := '';
RowIn.Visible := true;
RowOut.Visible := false;
end;
initialization
{$I correspondenceunit.lrs}
end.
Reference in New Issue View Git Blame Copy Permalink