You've already forked lazarus-ccr
2f33dc9f7b
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7345 8e941d3f-bd1b-0410-a28a-d453659cc2b4
510 lines
14 KiB
ObjectPascal
510 lines
14 KiB
ObjectPascal
// Use file "BubblePlot2.laz" for testing
|
|
|
|
unit MultXvsYUnit;
|
|
|
|
{$mode objfpc}{$H+}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
|
|
StdCtrls, ExtCtrls, Buttons, Clipbrd,
|
|
MainUnit, Globals, OutputUnit, DataProcs, DictionaryUnit, ContextHelpUnit;
|
|
|
|
type
|
|
|
|
{ TMultXvsYFrm }
|
|
|
|
TMultXvsYFrm = class(TForm)
|
|
Bevel1: TBevel;
|
|
HelpBtn: TButton;
|
|
Panel1: TPanel;
|
|
Panel2: TPanel;
|
|
Panel3: TPanel;
|
|
Panel4: TPanel;
|
|
XInBtn: TBitBtn;
|
|
XOutBtn: TBitBtn;
|
|
YInBtn: TBitBtn;
|
|
YOutBtn: TBitBtn;
|
|
GroupInBtn: TBitBtn;
|
|
GroupOutBtn: TBitBtn;
|
|
ResetBtn: TButton;
|
|
ComputeBtn: TButton;
|
|
CloseBtn: TButton;
|
|
DescChk: TCheckBox;
|
|
LinesChk: TCheckBox;
|
|
XEdit: TEdit;
|
|
YEdit: TEdit;
|
|
GroupEdit: TEdit;
|
|
GroupBox1: TGroupBox;
|
|
LabelEdit: TEdit;
|
|
Label1: TLabel;
|
|
Label2: TLabel;
|
|
Label3: TLabel;
|
|
Label4: TLabel;
|
|
Label5: TLabel;
|
|
VarList: TListBox;
|
|
procedure ComputeBtnClick(Sender: TObject);
|
|
procedure FormActivate(Sender: TObject);
|
|
procedure FormCreate(Sender: TObject);
|
|
procedure FormShow(Sender: TObject);
|
|
procedure GroupInBtnClick(Sender: TObject);
|
|
procedure GroupOutBtnClick(Sender: TObject);
|
|
procedure HelpBtnClick(Sender: TObject);
|
|
procedure ResetBtnClick(Sender: TObject);
|
|
procedure VarListSelectionChange(Sender: TObject; User: boolean);
|
|
procedure XInBtnClick(Sender: TObject);
|
|
procedure XOutBtnClick(Sender: TObject);
|
|
procedure YInBtnClick(Sender: TObject);
|
|
procedure YOutBtnClick(Sender: TObject);
|
|
private
|
|
{ private declarations }
|
|
FAutoSized: Boolean;
|
|
procedure PlotXY(var XValues: DblDyneMat; YValues: DblDyneMat;
|
|
MaxX, MinX, MaxY, MinY: double; N, NoY, MinGrp: integer);
|
|
procedure UpdateBtnStates;
|
|
|
|
public
|
|
{ public declarations }
|
|
end;
|
|
|
|
var
|
|
MultXvsYFrm: TMultXvsYFrm;
|
|
|
|
implementation
|
|
|
|
uses
|
|
Math,
|
|
BlankFrmUnit;
|
|
|
|
{ TMultXvsYFrm }
|
|
|
|
procedure TMultXvsYFrm.ResetBtnClick(Sender: TObject);
|
|
VAR i : integer;
|
|
begin
|
|
VarList.Clear;
|
|
for i := 1 to NoVariables do
|
|
VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]);
|
|
XEdit.Text := '';
|
|
YEdit.Text := '';
|
|
GroupEdit.Text := '';
|
|
DescChk.Checked := false;
|
|
LinesChk.Checked := false;
|
|
XInBtn.Enabled := true;
|
|
YInBtn.Enabled := true;
|
|
GroupInBtn.Enabled := true;
|
|
XOutBtn.Enabled := false;
|
|
YOutBtn.Enabled := false;
|
|
GroupOutBtn.Enabled := false;
|
|
end;
|
|
|
|
procedure TMultXvsYFrm.VarListSelectionChange(Sender: TObject; User: boolean);
|
|
begin
|
|
UpdateBtnStates;
|
|
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.ComputeBtnClick(Sender: TObject);
|
|
var
|
|
i, j, k, N, NoGrps, XCol, YCol, GrpCol, Grp, MinGrp, MaxGrp: integer;
|
|
NoSelected, MaxGrpSize: integer;
|
|
selected, NoInGrp: IntDyneVec;
|
|
YValues, XValues: DblDyneMat;
|
|
Means, StdDevs: DblDyneVec;
|
|
MinX, MaxX, MinY, MaxY, X, Y, temp: double;
|
|
cellstring: string;
|
|
lReport: TStrings;
|
|
begin
|
|
MaxGrpSize := 0;
|
|
SetLength(selected, 3);
|
|
MaxX := -1.0e308;
|
|
MinX := 1.0e308;
|
|
MaxY := -1.0e308;
|
|
MinY := 1.0e308;
|
|
MinGrp := MaxInt;
|
|
MaxGrp := -MaxInt;
|
|
XCol := 0;
|
|
YCol := 0;
|
|
GrpCol := 0;
|
|
N := 0;
|
|
|
|
// Get selected variables
|
|
for i := 1 to NoVariables do
|
|
begin
|
|
cellstring := OS3MainFrm.DataGrid.Cells[i,0];
|
|
if (cellstring = XEdit.Text) then selected[0] := i;
|
|
if (cellstring = YEdit.Text) then selected[1] := i;
|
|
if (cellstring = GroupEdit.Text) then selected[2] := i;
|
|
end;
|
|
|
|
XCol := selected[0];
|
|
YCol := selected[1];
|
|
GrpCol := selected[2];
|
|
NoSelected := 3;
|
|
|
|
if (XCol = 0) or (YCol = 0) or (GrpCol = 0) then
|
|
begin
|
|
MessageDlg('No variable selected.', mtError, [mbOK], 0);
|
|
exit;
|
|
end;
|
|
|
|
// Get number of groups
|
|
for i := 1 to NoCases do
|
|
begin
|
|
Grp := StrToInt(OS3MainFrm.DataGrid.Cells[GrpCol,i]);
|
|
if (Grp > MaxGrp) then MaxGrp := Grp;
|
|
if (Grp < MinGrp) then MinGrp := Grp;
|
|
end;
|
|
NoGrps := (MaxGrp - MinGrp) + 1;
|
|
|
|
lReport := TStringList.Create;
|
|
try
|
|
lReport.Add('X VERSUS Y FOR GROUPS PLOT');
|
|
lReport.Add('');
|
|
|
|
SetLength(YValues, NoCases+1, NoGrps+1);
|
|
SetLength(XValues, NoCases+1, NoGrps+1);
|
|
SetLength(Means, 2);
|
|
SetLength(StdDevs, 2);
|
|
SetLength(NoInGrp, NoGrps);
|
|
|
|
for i := 0 to 1 do
|
|
begin
|
|
Means[i] := 0.0;
|
|
StdDevs[i] := 0.0;
|
|
end;
|
|
for i := 0 to NoGrps - 1 do
|
|
NoInGrp[i] := 0;
|
|
|
|
for i := 1 to NoCases do
|
|
begin
|
|
if (not GoodRecord(i,NoSelected,selected))then continue;
|
|
inc(N);
|
|
X := StrToFloat(OS3MainFrm.DataGrid.Cells[XCol,i]);
|
|
if (X > MaxX) then MaxX := X;
|
|
if (X < MinX) then MinX := X;
|
|
|
|
Y := StrToFloat(OS3MainFrm.DataGrid.Cells[YCol,i]);
|
|
if (Y > MaxY) then MaxY := Y;
|
|
if (Y < MinY) then MinY := Y;
|
|
|
|
Grp := StrToInt(OS3MainFrm.DataGrid.Cells[GrpCol,i]);
|
|
Grp := Grp - MinGrp;
|
|
NoInGrp[Grp] := NoInGrp[Grp] + 1;
|
|
if (NoInGrp[Grp] > MaxGrpSize) then MaxGrpSize := NoInGrp[Grp];
|
|
YValues[NoInGrp[Grp]-1,Grp] := Y;
|
|
XValues[NoInGrp[Grp]-1,Grp] := StrToFloat(OS3MainFrm.DataGrid.Cells[XCol,i]);
|
|
end;
|
|
|
|
// get descriptive data
|
|
if (DescChk.Checked) then
|
|
begin
|
|
for i := 1 to NoCases do
|
|
begin
|
|
if (not GoodRecord(i,NoSelected,selected)) then continue;
|
|
Y := StrToFloat(OS3MainFrm.DataGrid.Cells[YCol,i]);
|
|
X := StrToFloat(OS3MainFrm.DataGrid.Cells[XCol,i]);
|
|
Means[0] := Means[0] + X;
|
|
StdDevs[0] := StdDevs[0] + X * X;
|
|
Means[1] := Means[1] + Y;
|
|
StdDevs[1] := StdDevs[1] + Y * Y;
|
|
end;
|
|
|
|
for i := 0 to 1 do
|
|
begin
|
|
StdDevs[i] := StdDevs[i] - (Means[i] * Means[i]) / N;
|
|
StdDevs[i] := sqrt(StdDevs[i] / (N - 1));
|
|
Means[i] := Means[i] / N;
|
|
end;
|
|
|
|
lReport.Add('VARIABLE MEAN STANDARD DEVIATION');
|
|
lReport.Add(' X %9.3f %14.3f', [Means[0], StdDevs[0]]);
|
|
lReport.Add(' Y %9.3f %14.3f', [Means[1], StdDevs[1]]);
|
|
lReport.Add('');
|
|
|
|
DisplayReport(lReport);
|
|
end;
|
|
|
|
// sort on X
|
|
for i := 0 to NoGrps - 1 do
|
|
begin
|
|
for j := 0 to MaxGrpSize-2 do
|
|
begin
|
|
for k := j+1 to MaxGrpSize - 1 do
|
|
begin
|
|
if (XValues[j,i] > XValues[k,i]) then // swap
|
|
begin
|
|
temp := XValues[j,i];
|
|
XValues[j,i] := XValues[k,i];
|
|
XValues[k,i] := temp;
|
|
temp := YValues[j,i];
|
|
YValues[j,i] := YValues[k,i];
|
|
YValues[k,i] := temp;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
BlankFrm.Image1.Canvas.Clear;
|
|
BlankFrm.Show;
|
|
PlotXY(XValues, YValues, MaxX, MinX, MaxY, MinY, MaxGrpSize, NoGrps, MinGrp);
|
|
|
|
finally
|
|
lReport.Free;
|
|
NoInGrp := nil;
|
|
StdDevs := nil;
|
|
Means := nil;
|
|
XValues := nil;
|
|
YValues := nil;
|
|
end;
|
|
end;
|
|
|
|
procedure TMultXvsYFrm.FormActivate(Sender: TObject);
|
|
var
|
|
w: Integer;
|
|
begin
|
|
if FAutoSized then
|
|
exit;
|
|
|
|
w := MaxValue([HelpBtn.Width, ResetBtn.Width, ComputeBtn.Width, CloseBtn.Width]);
|
|
HelpBtn.Constraints.MinWidth := w;
|
|
ResetBtn.Constraints.MinWidth := w;
|
|
ComputeBtn.Constraints.MinWidth := w;
|
|
CloseBtn.Constraints.MinWidth := w;
|
|
|
|
Constraints.MinWidth := Width;
|
|
Constraints.MinHeight := Height;
|
|
|
|
FAutoSized := true;
|
|
end;
|
|
|
|
procedure TMultXvsYFrm.FormCreate(Sender: TObject);
|
|
begin
|
|
Assert(OS3MainFrm <> nil);
|
|
if DictionaryFrm = nil then Application.CreateForm(TDictionaryFrm, DictionaryFrm);
|
|
if BlankFrm = nil then Application.CreateForm(TBlankFrm, BlankFrm);
|
|
end;
|
|
|
|
procedure TMultXvsYFrm.FormShow(Sender: TObject);
|
|
begin
|
|
ResetBtnClick(self);
|
|
end;
|
|
|
|
procedure TMultXvsYFrm.GroupOutBtnClick(Sender: TObject);
|
|
begin
|
|
if GroupEdit.Text <> '' then
|
|
begin
|
|
VarList.Items.Add(GroupEdit.Text);
|
|
GroupEdit.Text := '';
|
|
end;
|
|
UpdateBtnStates;
|
|
end;
|
|
|
|
procedure TMultXvsYFrm.HelpBtnClick(Sender: TObject);
|
|
begin
|
|
if ContextHelpForm = nil then
|
|
Application.CreateForm(TContextHelpForm, ContextHelpForm);
|
|
ContextHelpForm.HelpMessage((Sender as TButton).Tag);
|
|
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;
|
|
|
|
// routine to plot X versus multiple Y values
|
|
procedure TMultXvsYFrm.plotxy(var XValues: DblDyneMat; YValues: DblDyneMat;
|
|
MaxX, MinX, MaxY, MinY: double; N, NoY, MinGrp: integer);
|
|
var
|
|
xpos, ypos, hleft, hright, vtop, vbottom, imagewide : integer;
|
|
vhi, hwide, offset, strhi, imagehi, i, j, Grp : integer;
|
|
valincr, Yvalue, Xvalue, value : double;
|
|
Title: string;
|
|
begin
|
|
Title := LabelEdit.Text;
|
|
BlankFrm.Caption := Title;
|
|
BlankFrm.Show;
|
|
|
|
imagewide := BlankFrm.Image1.Width;
|
|
imagehi := BlankFrm.Image1.Height;
|
|
vtop := 40;
|
|
vbottom := ceil(imagehi) - 60;
|
|
vhi := vbottom - vtop;
|
|
hleft := 100;
|
|
hright := imagewide - 80;
|
|
hwide := hright - hleft;
|
|
|
|
// Draw chart border and background
|
|
BlankFrm.Image1.Canvas.Pen.Color := clBlack;
|
|
BlankFrm.Image1.Canvas.Brush.Color := clWhite;
|
|
BlankFrm.Image1.Canvas.Rectangle(0, 0, imagewide, imagehi);
|
|
|
|
// Draw title
|
|
if Title <> '' then
|
|
begin
|
|
xpos := (imagewide - BlankFrm.Image1.Canvas.TextWidth(Title)) div 2;
|
|
yPos := 2;
|
|
BlankFrm.Image1.Canvas.TextOut(xpos, ypos, Title);
|
|
end;
|
|
|
|
// draw horizontal axis
|
|
BlankFrm.Image1.Canvas.Pen.Color := clBlack;
|
|
BlankFrm.Image1.Canvas.MoveTo(hleft, vbottom);
|
|
BlankFrm.Image1.Canvas.LineTo(hright, vbottom);
|
|
valincr := (MaxX - MinX) / 10.0;
|
|
for i := 1 to 11 do
|
|
begin
|
|
ypos := vbottom;
|
|
Xvalue := MinX + valincr * (i - 1);
|
|
xpos := hLeft + ceil(hwide * ((Xvalue - MinX) / (MaxX - MinX)));
|
|
BlankFrm.Image1.Canvas.MoveTo(xpos,ypos);
|
|
ypos := ypos + 10;
|
|
BlankFrm.Image1.Canvas.LineTo(xpos,ypos);
|
|
Title := Format('%.2f', [Xvalue]);
|
|
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;
|
|
xpos := hleft + (hwide - BlankFrm.Image1.Canvas.TextWidth(XEdit.Text)) div 2;
|
|
ypos := vbottom + 30;
|
|
BlankFrm.Image1.Canvas.TextOut(xpos, ypos, XEdit.Text);
|
|
|
|
// Draw vertical axis
|
|
Title := 'Y VALUES';
|
|
xpos := hleft - BlankFrm.Image1.Canvas.TextWidth(Title) div 2;
|
|
ypos := 8;
|
|
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 := (MaxY - MinY) / 10.0;
|
|
for i := 1 to 11 do
|
|
begin
|
|
value := MaxY - ((i-1) * valincr);
|
|
Title := Format('%.2f',[value]);
|
|
strhi := BlankFrm.Image1.Canvas.TextHeight(Title);
|
|
xpos := hleft - 20 - BlankFrm.Image1.Canvas.TextWidth(Title);
|
|
Yvalue := MaxY - (valincr * (i-1));
|
|
ypos := ceil(vhi * ( (MaxY - Yvalue) / (MaxY - MinY)));
|
|
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
|
|
for j := 0 to NoY - 1 do
|
|
begin
|
|
BlankFrm.Image1.Canvas.Brush.Style := bsSolid;
|
|
BlankFrm.Image1.Canvas.Brush.Color := DATA_COLORS[j mod Length(DATA_COLORS)];
|
|
BlankFrm.Image1.Canvas.Pen.Color := DATA_COLORS[j mod Length(DATA_COLORS)];
|
|
BlankFrm.Image1.Canvas.Font.Color := DATA_COLORS[j mod Length(DATA_COLORS)];
|
|
Grp := MinGrp + j;
|
|
Title := 'GROUP ' + IntToStr(Grp);
|
|
for i := 1 to N do
|
|
begin
|
|
ypos := vtop + ceil(vhi * ( (MaxY - YValues[i-1,j]) / (MaxY - MinY)));
|
|
xpos := hleft + ceil(hwide * ( (XValues[i-1,j] - MinX) / (MaxX - MinX)));
|
|
if (i = 1) then
|
|
BlankFrm.Image1.Canvas.MoveTo(xpos, ypos);
|
|
if LinesChk.Checked then
|
|
BlankFrm.Image1.Canvas.LineTo(xpos, ypos);
|
|
BlankFrm.Image1.Canvas.Ellipse(xpos, ypos, xpos+5, ypos+5);
|
|
end;
|
|
strhi := BlankFrm.Image1.Canvas.TextHeight(Title);
|
|
BlankFrm.Image1.Canvas.Brush.Color := clWhite;
|
|
BlankFrm.Image1.Canvas.Pen.Color := clBlack;
|
|
xpos := hwide + hleft;
|
|
BlankFrm.Image1.Canvas.MoveTo(xpos, ypos-strhi);
|
|
BlankFrm.Image1.Canvas.TextOut(xpos, ypos, Title);
|
|
end;
|
|
|
|
BlankFrm.Image1.Canvas.Font.Color := clBlack;
|
|
end;
|
|
|
|
procedure TMultXvsYFrm.UpdateBtnStates;
|
|
var
|
|
lSelected: Boolean;
|
|
i: Integer;
|
|
begin
|
|
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;
|
|
|
|
initialization
|
|
{$I multxvsyunit.lrs}
|
|
|
|
end.
|
|
|