unit GroupFreqUnit; {$mode objfpc}{$H+} interface uses Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, Buttons, ExtCtrls, StdCtrls, LCLVersion, TASources, Globals, MainUnit, MainDM, BasicStatsChartFormUnit; type { TGroupFreqForm } TGroupFreqForm = class(TBasicStatsChartForm) ShowValuesChk: TCheckBox; GrpInBtn: TBitBtn; GrpOutBtn: TBitBtn; GrpVarEdit: TEdit; HorBarsBtn: TSpeedButton; Label1: TLabel; Label2: TLabel; PlotOptionsGroup: TGroupBox; ThreeDChk: TCheckBox; VarList: TListBox; VertBarsBtn: TSpeedButton; procedure GrpInBtnClick(Sender: TObject); procedure GrpOutBtnClick(Sender: TObject); procedure VarListDblClick(Sender: TObject); procedure VarListSelectionChange(Sender: TObject; User: boolean); private FLabelsSource: TListChartSource; protected procedure AdjustConstraints; override; procedure Compute; override; procedure Plot(XLabels: StrDyneVec; FreqValues: DblDyneVec; XTitle: String); procedure UpdateBtnStates; override; public constructor Create(AOwner: TComponent); override; procedure Reset; override; end; var GroupFreqForm: TGroupFreqForm; implementation {$R *.lfm} uses Math, TAChartUtils, TACustomSeries, TASeries, Utils, DataProcs, ChartFrameUnit; { TGroupFreqForm } constructor TGroupFreqForm.Create(AOwner: TComponent); begin inherited; FLabelsSource := TListChartSource.Create(self); end; procedure TGroupFreqForm.AdjustConstraints; begin ParamsPanel.Constraints.MinWidth := MaxValue( [ 4*CloseBtn.Width + 3*CloseBtn.BorderSpacing.Left, (PlotOptionsGroup.Width - GrpInBtn.Width div 2 + GrpVarEdit.BorderSpacing.Left)*2, (Max(Label1.Width, Label2.Width) + GrpvarEdit.BorderSpacing.Left) * 2 ]); ParamsPanel.Constraints.MinHeight := PlotOptionsGroup.Top + PlotOptionsGroup.Height + ButtonBevel.Height + CloseBtn.BorderSpacing.Top + CloseBtn.Height; Constraints.MinWidth := ParamsPanel.Constraints.MinWidth + 300; Constraints.MinHeight := ParamsPanel.Constraints.MinHeight + ParamsPanel.BorderSpacing.Top * 2; end; procedure TGroupFreqForm.Compute; var grpcol: integer; cellStr: string; i, numValues, valueIdx: integer; freq: DblDyneVec = nil; // Could be IntDyneVec, but easier plotting with Dbl values: StrDyneVec = nil; begin // get the variable to analyze grpcol := 0; for i := 1 to NoVariables do if GrpVarEdit.Text = OS3MainFrm.DataGrid.Cells[i,0] then begin grpcol := i; break; end; if grpcol = 0 then begin MessageDlg('No variable selected.', mtError, [mbOK], 0); exit; end; SetLength(values, NoCases); // over-dimension values array; will be trimmed. numvalues := 0; for i := 1 to NoCases do begin cellStr := Trim(OS3MainFrm.DataGrid.Cells[grpcol,i]); if IndexOfString(values, cellStr) = -1 then begin values[numValues] := cellStr; inc(numvalues); end; end; SetLength(values, numValues); // Trim values array to correct length // setup frequency array and count cases in each group SetLength(freq, numvalues); for i := 1 to NoCases do begin if not ValidValue(i, grpcol) then continue; cellStr := Trim(OS3MainFrm.DataGrid.Cells[grpcol, i]); valueIdx := IndexOfString(values, cellStr); if valueIdx > -1 then freq[valueIdx] := freq[valueIdx] + 1 else raise Exception.Create('Value index not found.'); // this should not happen end; // Plot frequency data Plot(values, freq, GrpVarEdit.Text); end; procedure TGroupFreqForm.GrpInBtnClick(Sender: TObject); var index: integer; begin index := VarList.ItemIndex; if (index > -1) and (GrpVarEdit.Text = '') then begin GrpVarEdit.Text := VarList.Items[index]; VarList.Items.Delete(index); end; UpdateBtnStates; end; procedure TGroupFreqForm.GrpOutBtnClick(Sender: TObject); begin if GrpVarEdit.Text <> '' then begin VarList.Items.Add(GrpVarEdit.Text); GrpVarEdit.Text := ''; end; UpdateBtnStates; end; procedure TGroupFreqForm.Plot(XLabels: StrDyneVec; FreqValues: DblDyneVec; XTitle: String); const MARGIN: array[boolean] of Integer = (4, 0); var ser: TBarSeries; YTitle: String; i: Integer; begin // Erase the chart, if it has already been used. FChartFrame.Clear; FLabelsSource.Clear; // Copy XLabels to LabelsSource for i := 0 to High(XLabels) do FLabelsSource.Add(i+1, i+1, XLabels[i]); // Define captions -- will be applied later XTitle := 'Values of ' + XTitle; YTitle := 'Frequency'; // Plot the frequencies ser := TBarSeries(FChartFrame.PlotXY(ptBars, nil, FreqValues, XLabels, nil, '', DATA_COLORS[0])); if ThreeDChk.Checked then begin ser.Depth := 20; {$IF LCL_FullVersion >= 2010000} ser.DepthBrightnessDelta := -30; {$IFEND} end; // Show/Hide series labels if ShowValuesChk.Checked then begin ser.Marks.Style := smsValue; ser.Marks.Distance := 0; ser.MarkPositionCentered := true; end else ser.Marks.Style := smsNone; ser.Marks.LinkPen.Color := clGray; // Hide legend FChartFrame.Chart.Legend.Visible := false; // Show XLabels along the x axis if HorBarsBtn.Down then begin // Rotate bars to be horizontal ser.AxisIndexX := 0; ser.AxisIndexY := 1; FChartFrame.SetXTitle(YTitle); FChartFrame.SetYTitle(XTitle); FChartFrame.Chart.Margins.Bottom := 4; FChartFrame.Chart.BottomAxis.Marks.Source := nil; FChartFrame.Chart.BottomAxis.Marks.Style := smsValue; FChartFrame.Chart.BottomAxis.Marks.Alignment := taCenter; FChartFrame.Chart.Margins.Left := MARGIN[HorBarsBtn.Down]; FChartFrame.Chart.LeftAxis.Marks.Source := FLabelsSource; FChartFrame.Chart.LeftAxis.Marks.Style := smsLabel; FChartFrame.Chart.LeftAxis.Marks.Alignment := taCenter; end else begin ser.AxisIndexX := 1; ser.AxisIndexY := 0; FChartFrame.SetXTitle(XTitle); FChartFrame.SetYTitle(YTitle); FChartFrame.Chart.Margins.Bottom := MARGIN[HorBarsBtn.Down]; FChartFrame.Chart.BottomAxis.Marks.Source := FLabelsSource; FChartFrame.Chart.BottomAxis.Marks.Style := smsLabel; FChartFrame.Chart.BottomAxis.Marks.Alignment := taCenter; FChartFrame.Chart.Margins.Left := 4; FChartFrame.Chart.LeftAxis.Marks.Source := nil; FChartFrame.Chart.LeftAxis.Marks.Style := smsValue; FChartFrame.Chart.LeftAxis.Marks.Alignment := taCenter; end; // Set Chart title FChartFrame.SetTitle('Frequency Distribution'); end; procedure TGroupFreqForm.Reset; var i: integer; begin inherited; VarList.Clear; for i := 1 to NoVariables do VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]); GrpVarEdit.Text := ''; UpdateBtnStates; end; procedure TGroupFreqForm.UpdateBtnStates; begin inherited; GrpInBtn.Enabled := (VarList.ItemIndex > -1); GrpOutBtn.Enabled := (GrpVarEdit.Text <> ''); end; procedure TGroupFreqForm.VarListDblClick(Sender: TObject); var index: Integer; begin index := VarList.ItemIndex; if (index > -1) and (GrpVarEdit.Text = '') then begin GrpVarEdit.Text := VarList.Items[index]; Varlist.Items.Delete(index); UpdateBtnStates; end; end; procedure TGroupFreqForm.VarListSelectionChange(Sender: TObject; User: boolean); begin UpdateBtnStates; end; end.