Files
lazarus-ccr/applications/lazstats/source/forms/analysis/descriptive/multxvsyunit.pas

390 lines
9.0 KiB
ObjectPascal
Raw Normal View History

// Use file "BubblePlot2.laz" for testing
unit MultXvsYUnit;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs,
StdCtrls, ExtCtrls, Buttons, Clipbrd, ComCtrls,
MainUnit, Globals, DataProcs,
BasicStatsReportAndChartFormUnit, ReportFrameUnit, ChartFrameUnit;
type
{ TMultXvsYForm }
TMultXvsYForm = class(TBasicStatsReportAndChartForm)
XInBtn: TBitBtn;
XOutBtn: TBitBtn;
YInBtn: TBitBtn;
YOutBtn: TBitBtn;
GroupInBtn: TBitBtn;
GroupOutBtn: TBitBtn;
LinesChk: TCheckBox;
XEdit: TEdit;
YEdit: TEdit;
GroupEdit: TEdit;
OptionsGroup: TGroupBox;
LabelEdit: TEdit;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
VarList: TListBox;
procedure GroupInBtnClick(Sender: TObject);
procedure GroupOutBtnClick(Sender: TObject);
procedure VarListDblClick(Sender: TObject);
procedure VarListSelectionChange(Sender: TObject; {%H-}User: boolean);
procedure XInBtnClick(Sender: TObject);
procedure XOutBtnClick(Sender: TObject);
procedure YInBtnClick(Sender: TObject);
procedure YOutBtnClick(Sender: TObject);
private
procedure PlotXY(const XValues, YValues: DblDyneMat; const Groups: StrDyneVec);
protected
procedure AdjustConstraints; override;
procedure Compute; override;
procedure UpdateBtnStates; override;
procedure WriteToReport(const AMeans, AStdDevs: DblDyneVec);
public
constructor Create(AOwner: TComponent); override;
procedure Reset; override;
end;
var
MultXvsYForm: TMultXvsYForm;
implementation
{$R *.lfm}
uses
TATypes,
Math, Utils, MatrixUnit, GridProcs;
{ TMultXvsYForm }
constructor TMultXvsYForm.Create(AOwner: TComponent);
begin
inherited;
end;
procedure TMultXvsYForm.AdjustConstraints;
begin
ParamsPanel.Constraints.MinWidth := Max(
4*CloseBtn.Width + 3*CloseBtn.BorderSpacing.Left,
OptionsGroup.Width - XInBtn.Width div 2);
ParamsPanel.Constraints.MinHeight := GroupOutBtn.Top + GroupOutBtn.Height +
OptionsGroup.BorderSpacing.Top + OptionsGroup.Height + OptionsGroup.BorderSpacing.Bottom +
LabelEdit.Height + ButtonBevel.Height + CloseBtn.BorderSpacing.Top + CloseBtn.Height;
end;
procedure TMultXvsYForm.Compute;
var
i, N, xCol, yCol, grpCol, grp, numGrps: integer;
grpName: String;
X, Y: double;
cellstring: string;
numInGrp: IntDyneVec = nil;
xValues: DblDyneMat = nil;
yValues: DblDyneMat = nil;
grps: StrDyneVec = nil;
means: DblDyneVec = nil;
stdDevs: DblDyneVec = nil;
selected: array of Integer = nil;
begin
// FPC 3.3.1 requires dynamic arrays!
SetLength(means, 2);
SetLength(stdDevs, 2);
// Get selected variables
xCol := GetVariableIndex(OS3MainFrm.DataGrid, XEdit.Text);
yCol := GetVariableIndex(OS3MainFrm.DataGrid, YEdit.Text);
grpCol := GetVariableIndex(OS3MainFrm.DataGrid, GroupEdit.Text);
if (xCol = -1) or (yCol = -1) or (grpCol = -1) then
begin
ErrorMsg('No variable selected.');
exit;
end;
SetLength(selected, 3);
selected[0] := xCol;
selected[1] := yCol;
selected[2] := grpCol;
// Get groups
// minGrp := MaxInt;
// maxGrp := -MaxInt;
SetLength(grps, NoCases);
numGrps := 0;
for i := 1 to NoCases do
begin
grpName := Trim(OS3MainFrm.DataGrid.Cells[grpCol, i]);
if IndexOfString(grps, grpName) = -1 then
begin
grps[numGrps] := grpName;
inc(numGrps);
end;
end;
SetLength(XValues, numGrps, NoCases); // NoCases is over-dimensioned and will be trimmed later.
SetLength(YValues, numGrps, NoCases); // dto.
SetLength(numInGrp, numGrps);
N := 0;
for i := 1 to NoCases do
begin
if not GoodRecord(OS3MainFrm.Datagrid, i, selected) then continue;
inc(N);
X := StrToFloat(OS3MainFrm.DataGrid.Cells[XCol, i]);
Y := StrToFloat(OS3MainFrm.DataGrid.Cells[YCol, i]);
grpName := Trim(OS3MainFrm.DataGrid.Cells[grpCol, i]);
grp := IndexOfString(grps, grpName);
xValues[grp, numInGrp[grp]] := X;
yValues[grp, numInGrp[grp]] := Y;
inc(numInGrp[grp]);
Means[0] := Means[0] + X;
StdDevs[0] := StdDevs[0] + sqr(X);
Means[1] := Means[1] + Y;
StdDevs[1] := StdDevs[1] + sqr(Y);
end;
// Trim XValues and YValues to correct dimension.
SetLength(xValues, numGrps);
SetLength(yValues, numGrps);
for grp := 0 to numGrps-1 do
begin
SetLength(xValues[grp], numInGrp[grp]);
SetLength(yValues[grp], numInGrp[grp]);
end;
// Get descriptive data
for i := 0 to 1 do
begin
stdDevs[i] := stdDevs[i] - sqr(means[i]) / N;
stdDevs[i] := sqrt(stdDevs[i] / (N - 1));
means[i] := means[i] / N;
end;
// Print out descriptive data to report frame
WriteToReport(means, stdDevs);
// sort on X
for i := 0 to numGrps - 1 do
SortOnX(XValues[i], YValues[i]);
// Plot data
PlotXY(XValues, YValues, grps);
end;
procedure TMultXvsYForm.GroupInBtnClick(Sender: TObject);
var
i: integer;
begin
i := VarList.ItemIndex;
if (i > -1) and (GroupEdit.Text = '') then
begin
GroupEdit.Text := VarList.Items[i];
VarList.Items.Delete(i);
end;
UpdateBtnStates;
end;
procedure TMultXvsYForm.GroupOutBtnClick(Sender: TObject);
begin
if GroupEdit.Text <> '' then
begin
VarList.Items.Add(GroupEdit.Text);
GroupEdit.Text := '';
end;
UpdateBtnStates;
end;
// Routine to plot X versus multiple Y values for several groups
// Layout of X and Y matrices:
// 1st index: group index, 2nd index: point index within group
procedure TMultXvsYForm.PlotXY(const XValues, YValues: DblDyneMat;
const Groups: StrDyneVec);
var
pt: TPlotType;
grp: Integer;
clr: TColor;
grpName: String;
sym: TSeriesPointerStyle;
begin
FChartFrame.Clear;
// Titles
FChartFrame.SetTitle(LabelEdit.Text);
FChartFrame.SetXTitle(XEdit.Text);
FChartFrame.SetYTitle(YEdit.Text);
if LinesChk.Checked then pt := ptLinesAndSymbols else pt := ptSymbols;
for grp := 0 to Length(XValues)-1 do
begin
clr := DATA_COLORS[grp mod Length(DATA_COLORS)];
sym := DATA_SYMBOLS[grp mod Length(DATA_SYMBOLS)];
grpName := Format('%s %s', [GroupEdit.Text, Groups[grp]]);
FChartFrame.PlotXY(pt, XValues[grp], YValues[grp], nil, nil, grpName, clr, sym);
end;
end;
procedure TMultXvsYForm.Reset;
begin
inherited;
CollectVariableNames(OS3MainFrm.DataGrid, varList.Items);
XEdit.Text := '';
YEdit.Text := '';
GroupEdit.Text := '';
UpdateBtnStates;
end;
procedure TMultXvsYForm.VarListDblClick(Sender: TObject);
var
index: Integer;
begin
index := VarList.ItemIndex;
if index > -1 then
begin
if XEdit.Text = '' then
XEdit.Text := VarList.Items[index]
else if YEdit.Text = '' then
YEdit.Text := VarList.Items[index]
else if GroupEdit.Text = '' then
GroupEdit.Text := VarList.Items[index];
VarList.Items.Delete(index);
UpdateBtnStates;
end;
end;
procedure TMultXvsYForm.UpdateBtnStates;
var
lSelected: Boolean;
i: Integer;
begin
inherited;
lSelected := false;
for i:=0 to VarList.Items.Count-1 do
if VarList.Selected[i] then
begin
lSelected := true;
break;
end;
XInBtn.Enabled := lSelected and (XEdit.Text = '');
YInBtn.Enabled := lSelected and (YEdit.Text = '');
GroupInBtn.Enabled := lSelected and (GroupEdit.Text = '');
XOutBtn.Enabled := (XEdit.Text <> '');
YOutBtn.Enabled := (YEdit.Text <> '');
GroupOutBtn.Enabled := (GroupEdit.Text <> '');
end;
procedure TMultXvsYForm.VarListSelectionChange(Sender: TObject; User: boolean);
begin
UpdateBtnStates;
end;
procedure TMultXvsYForm.WriteToReport(const AMeans, AStdDevs: DblDyneVec);
var
lReport: TStrings;
begin
lReport := TStringList.Create;
try
lReport.Add('X VERSUS Y FOR GROUPS PLOT');
lReport.Add('');
lReport.Add('X variable: ' + XEdit.Text);
lReport.Add('Y variable: ' + YEdit.Text);
lReport.Add('Group variable: ' + GroupEdit.Text);
lReport.Add('');
lReport.Add('VARIABLE MEAN STANDARD DEVIATION');
lReport.Add('-------- -------- ------------------');
lReport.Add(' X %8.3f %14.3f', [AMeans[0], AStdDevs[0]]);
lReport.Add(' Y %8.3f %14.3f', [AMeans[1], AStdDevs[1]]);
lReport.Add('');
FReportFrame.DisplayReport(lReport);
finally
lReport.Free;
end;
end;
procedure TMultXvsYForm.XInBtnClick(Sender: TObject);
var
i: integer;
begin
i := VarList.ItemIndex;
if (i > -1) and (XEdit.Text = '') then
begin
XEdit.Text := VarList.Items[i];
VarList.Items.Delete(i);
end;
UpdateBtnStates;
end;
procedure TMultXvsYForm.XOutBtnClick(Sender: TObject);
begin
if XEdit.Text <> '' then
begin
VarList.Items.Add(XEdit.Text);
XEdit.Text := '';
end;
UpdateBtnStates;
end;
procedure TMultXvsYForm.YInBtnClick(Sender: TObject);
var
i: integer;
begin
i := VarList.ItemIndex;
if (i > -1) and (YEdit.Text = '') then
begin
YEdit.Text := VarList.Items[i];
VarList.Items.Delete(i);
end;
UpdateBtnStates;
end;
procedure TMultXvsYForm.YOutBtnClick(Sender: TObject);
begin
if YEdit.Text <> '' then
begin
VarList.Items.Add(YEdit.Text);
YEdit.Text := '';
end;
UpdateBtnStates;
end;
end.