// 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.