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

400 lines
9.2 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, DictionaryUnit,
BasicStatsReportAndChartFormUnit, ReportFrameUnit, ChartFrameUnit;
type
{ TMultXvsYFrm }
TMultXvsYFrm = 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
MultXvsYFrm: TMultXvsYFrm;
implementation
{$R *.lfm}
uses
TATypes,
Math, Utils, MathUnit;
{ TMultXvsYFrm }
constructor TMultXvsYFrm.Create(AOwner: TComponent);
begin
inherited;
end;
procedure TMultXvsYFrm.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 TMultXvsYFrm.Compute;
var
i, N, xCol, yCol, grpCol, grp, numGrps: integer;
grpName: String;
//minX, maxX, minY, maxY,
X, Y: double;
cellstring: string;
maxGrpSize: integer = 0;
numInGrp: IntDyneVec = nil;
xValues: DblDyneMat = nil;
yValues: DblDyneMat = nil;
grps: StrDyneVec = nil;
means: array[0..1] of Double = (0.0, 0.0);
stdDevs: array[0..1] of Double = (0.0, 0.0);
selected: array of Integer = nil;
begin
// Get selected variables
xCol := 0;
yCol := 0;
grpCol := 0;
for i := 1 to NoVariables do
begin
cellstring := OS3MainFrm.DataGrid.Cells[i, 0];
if (cellstring = XEdit.Text) then xCol := i;
if (cellstring = YEdit.Text) then yCol := i;
if (cellstring = GroupEdit.Text) then grpCol := i;
end;
if (xCol = 0) or (yCol = 0) or (grpCol = 0) 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(i, Length(selected), 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 TMultXvsYFrm.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 TMultXvsYFrm.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 TMultXvsYFrm.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 TMultXvsYFrm.Reset;
var
i: integer;
begin
inherited;
VarList.Clear;
for i := 1 to NoVariables do
VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]);
XEdit.Text := '';
YEdit.Text := '';
GroupEdit.Text := '';
LinesChk.Checked := false;
UpdateBtnStates;
end;
procedure TMultXvsYFrm.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 TMultXvsYFrm.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 TMultXvsYFrm.VarListSelectionChange(Sender: TObject; User: boolean);
begin
UpdateBtnStates;
end;
procedure TMultXVsYFrm.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 TMultXvsYFrm.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 TMultXvsYFrm.XOutBtnClick(Sender: TObject);
begin
if XEdit.Text <> '' then
begin
VarList.Items.Add(XEdit.Text);
XEdit.Text := '';
end;
UpdateBtnStates;
end;
procedure TMultXvsYFrm.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 TMultXvsYFrm.YOutBtnClick(Sender: TObject);
begin
if YEdit.Text <> '' then
begin
VarList.Items.Add(YEdit.Text);
YEdit.Text := '';
end;
UpdateBtnStates;
end;
end.