// Use "cansas.laz" for testing. unit FreqUnit; {$mode objfpc}{$H+} interface uses lazlogger, Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, LCLVersion, StdCtrls, Buttons, ExtCtrls, ComCtrls, Spin, Globals, MainUnit, DataProcs, BasicStatsReportFormUnit, ReportFrameUnit, ChartFrameUnit; type { TFreqFrm } TFreqFrm = class(TBasicStatsReportForm) BinSelectionGroup: TGroupBox; ThreeDChk: TCheckBox; PlotOptionsGroup: TGroupBox; NoIntervalsLabel: TLabel; PageControl: TPageControl; ReportPage: TTabSheet; Panel1: TPanel; Panel2: TPanel; NormPltChk: TCheckBox; InBtn: TBitBtn; OutBtn: TBitBtn; AllBtn: TBitBtn; Label1: TLabel; Label2: TLabel; SelList: TListBox; NoIntervalsEdit: TSpinEdit; HorBarsBtn: TSpeedButton; LinePlotBtn: TSpeedButton; AreaPlotBtn: TSpeedButton; VertBarsBtn: TSpeedButton; VarList: TListBox; procedure AllBtnClick(Sender: TObject); procedure InBtnClick(Sender: TObject); procedure OutBtnClick(Sender: TObject); procedure SelListSelectionChange(Sender: TObject; {%H-}User: boolean); procedure VarListDblClick(Sender: TObject); procedure VarListSelectionChange(Sender: TObject; {%H-}User: boolean); private procedure CalcIntervals(var AMin, AMax, AIntervalSize: Double; out ANumIntervals: Integer); procedure ClearTabs; function CreateOrGetChartFrame(AColIndex: Integer; AVarName: String): TChartFrame; function GetPageCaption(AVarName: String): String; procedure PlotFreq(AChartFrame: TChartFrame; AColIndex: Integer; AVarName: String; const xLabels: StrDyneVec; const Freq: DblDyneVec); procedure PlotNormalDist(AChartFrame: TChartFrame; Freq: DblDyneVec); protected procedure AdjustConstraints; override; procedure Compute; override; procedure UpdateBtnStates; override; public constructor Create(AOwner: TComponent); override; procedure Reset; override; end; var FreqFrm: TFreqFrm; implementation {$R *.lfm} uses Math, TAChartUtils, TALegend, TASources, TACustomSeries, TASeries, Utils, MathUnit; { TFreqFrm } constructor TFreqFrm.Create(AOwner: TComponent); begin inherited; FReportFrame.Parent := ReportPage; end; procedure TFreqFrm.AdjustConstraints; begin Panel1.Constraints.MinHeight := AllBtn.Top + AllBtn.Height; Panel1.Constraints.MinWidth := Max(Label1.Width, Label2.Width) + AllBtn.Width + VarList.BorderSpacing.Right*2; ParamsPanel.Constraints.MinHeight := Panel1.Constraints.MinHeight + NormPltChk.BorderSpacing.Top + NormPltChk.Height + BinSelectionGroup.BorderSpacing.Top + BinSelectionGroup.Height + PlotOptionsGroup.BorderSpacing.Top + PlotOptionsGroup.Height + ButtonBevel.Height + CloseBtn.BorderSpacing.Top + CloseBtn.Height; ParamsPanel.Constraints.MinWidth := Max( 4*CloseBtn.Width + 3*CloseBtn.BorderSpacing.Left, Panel1.Constraints.MinWidth) + ParamsPanel.BorderSpacing.left*2; end; procedure TFreqFrm.AllBtnClick(Sender: TObject); var count, index : integer; begin count := VarList.Items.Count; for index := 0 to count-1 do SelList.Items.Add(VarList.Items[index]); VarList.Clear; ClearTabs; UpdateBtnStates; end; procedure TFreqFrm.CalcIntervals(var AMin, AMax, AIntervalsize: Double; out ANumIntervals: Integer); var intervalSize: Double; m: Double; e: Integer; begin // intervalSize := round((AMax - AMin) / NoIntervalsEdit.Value); intervalSize := (AMax - AMin) / NoIntervalsEdit.Value; if intervalSize = 0 then intervalSize := 1; MantisseAndExponent(intervalSize, m, e); m := round(m); AIntervalSize := m * IntPower(10, e); AMin := floor(AMin / AIntervalSize) * AIntervalSize; AMax := ceil(AMax / AIntervalSize) * AIntervalSize; ANumIntervals := round((AMax - AMin) / AIntervalSize); end; procedure TFreqFrm.ClearTabs; var i: Integer; begin if Assigned(FReportFrame) then FReportFrame.Clear; for i := PageControl.PageCount-1 downto 1 do PageControl.Pages[i].Free; end; procedure TFreqFrm.Compute; var i, j, k: integer; freq: DblDyneVec = nil; pcnt: DblDyneVec = nil; cumpcnt: DblDyneVec = nil; pcntilerank: DblDyneVec = nil; cumfreq: DblDyneVec = nil; XLabels: StrDyneVec = nil; XValue: DblDyneVec = nil; normDistValue: DblDyneVec = nil; value: double; NoVars: integer; cellval: string; mask: String; col: integer; min, max: double; incrSize: double = 1; nInts: integer; Sumx, Sumx2, Mean, Variance, StdDev, zlow, zhi: double; X, zproplow, zprophi, zfreq: double; nCases: integer; lReport: TStrings; chartFrame: TChartFrame; begin if SelList.Count = 0 then begin ErrorMsg('No variable(s) selected.'); exit; end; lReport := TStringList.Create; try lReport.Add('FREQUENCY ANALYSIS BY BILL MILLER'); lReport.Add(''); // Iterate through all variables NoVars := SelList.Items.Count; for i := 1 to NoVars do begin // Get column index of variable col := 1; cellval := SelList.Items[i-1]; for j := 1 to NoVariables do begin if OS3MainFrm.DataGrid.Cells[j,0] = cellval then begin col := j; if i > 1 then lReport.Add(''); lReport.Add('Frequency analysis for variable "%s"', [cellval]); break; end; end; // Get min and max values for variable in col min := Infinity; max := -Infinity; for j := 1 to NoCases do begin if not ValidValue(j, col) then continue; value := StrToFloat(OS3MainFrm.DataGrid.Cells[col,j]); if value > max then max := value; if value < min then min := value; end; CalcIntervals(min, max, incrSize, nInts); SetLength(freq, nInts); SetLength(cumFreq, nInts); SetLength(XValue, nInts); SetLength(XLabels, nInts); SetLength(pcnt, nInts); SetLength(cumPcnt, nInts); Setlength(pcntileRank, nInts); // Get frequency of cases in each interval nCases := 0; for j := 1 to NoCases do begin if not ValidValue(j, col) then continue; inc(nCases); value := StrToFloat(OS3MainFrm.DataGrid.Cells[col, j]); for k := 0 to nints-1 do if (value >= min + k * incrSize) and (value < min + ((k+1) * incrSize)) then freq[k] := freq[k] + 1.0; end; // Create x axis labels for the chart if HorBarsBtn.Down then mask := '%.2f to %.2f' else mask := '%.2f' + LineEnding + 'to' + LineEnding + '%.2f'; for j := 0 to nInts-1 do begin XValue[j] := min + j * incrSize; XLabels[j] := Format(mask, [XValue[j], XValue[j] + incrSize]); end; // Get cumulative frequencies and percents to midpoints cumFreq[0] := freq[0]; pcnt[0] := freq[0] / nCases; cumPcnt[0] := cumFreq[0] / nCases; pcntileRank[0] := (freq[0] * 0.5) / nCases; for k := 1 to nInts - 1 do begin cumfreq[k] := cumfreq[k-1] + freq[k]; pcnt[k] := freq[k] / nCases; cumPcnt[k] := cumFreq[k] / nCases; pcntileRank[k] := (cumFreq[k-1] + freq[k] * 0.5) / nCases; end; if NormPltChk.Checked then begin // Get mean and standard deviation of xvalues, then height of // the normal curve for each normally distributed corresponding z score sumx := 0.0; sumx2 := 0.0; for k := 1 to NoCases do begin if not ValidValue(k, col) then continue; value := StrToFloat(OS3MainFrm.DataGrid.Cells[col, k]); sumx := sumx + value; sumx2 := sumx2 + sqr(value); end; Mean := sumx / nCases; Variance := sumx2 - sqr(sumx) / nCases; Variance := Variance / (nCases - 1); StdDev := sqrt(Variance); SetLength(normDistValue, nInts); for k := 0 to nInts-1 do begin X := XValue[k]; if StdDev > 0.0 then zLow := (X - Mean) / StdDev else zLow := 0.0; X := XValue[k] + incrSize; if StdDev > 0.0 then zHi := (X - Mean) / StdDev else zHi := 0.0; // Get cumulative proportion for this z and translate to frequency zPropLow := NormalDist(zLow); zPropHi := NormalDist(zHi); zFreq := nCases * abs(zPropHi - zPropLow); normDistValue[k] := zFreq; end; // Print results to report lReport.Add(' FROM TO FREQ. PCNT CUM.FREQ. CUM.PCNT. %ILE RANK ND FREQ.'); lReport.Add(''); for k := 0 to nInts - 1 do lReport.Add('%8.2f%8.2f%8.0f%8.2f %8.2f %8.2f %8.2f %8.2f', [ min + k*incrSize, // from min + (k+1)*incrSize, // to freq[k], // freq pcnt[k], // pcnt cumFreq[k], // cum.freq. cumPcnt[k], // cum.pcnt. pcntileRank[k], // %ile rank normDistValue[k] // normal distribution value ]); end else begin // Print results to report lReport.Add(' FROM TO FREQ. PCNT CUM.FREQ. CUM.PCNT. %ILE RANK'); lReport.Add(''); for k := 0 to nInts - 1 do lReport.Add('%8.2f%8.2f%8.0f%8.2f %8.2f %8.2f %8.2f', [ min + k*incrSize, // from min + (k+1)*incrSize, // to freq[k], // freq pcnt[k], // pcnt cumFreq[k], // cum.freq. cumPcnt[k], // cum.pcnt. pcntileRank[k] // %ile rank ]); end; // Show report in form FReportFrame.DisplayReport(lReport); // Plot data chartFrame := CreateOrGetChartFrame(col, cellVal); chartFrame.Clear; if NormPltChk.Checked then PlotNormalDist(chartFrame, normDistValue); PlotFreq(chartFrame, col, cellVal, xLabels, freq); end; finally lReport.Free; end; end; function TFreqFrm.CreateOrGetChartFrame(AColIndex: Integer; AVarName: String): TChartFrame; var sheetTitle: String; tabSheet: TTabSheet; i: Integer; begin sheetTitle := GetPageCaption(AVarName); // Find existing sheet first. for i := 1 to PageControl.PageCount-1 do if PageControl.Pages[i].Caption = sheetTitle then begin tabSheet := PageControl.Pages[i]; Result := tabSheet.Controls[0] as TChartFrame; exit; end; // Not found: create new sheet ... tabSheet := PageControl.AddTabSheet; tabSheet.Caption := sheetTitle; tabSheet.Tag := AColIndex; // ... and add ChartFrame Result := TChartFrame.Create(tabSheet); Result.Parent := tabSheet; Result.Align := alClient; Result.Chart.Legend.Alignment := laBottomCenter; Result.Chart.Legend.ColumnCount := 3; Result.Chart.Legend.TextFormat := tfHTML; Result.Chart.BottomAxis.Intervals.MaxLength := 80; Result.Chart.BottomAxis.Intervals.MinLength := 30; end; function TFreqFrm.GetPageCaption(AVarName: String): String; begin Result := 'Plot of ' + AVarName; end; procedure TFreqFrm.InBtnClick(Sender: TObject); var i: integer; begin i := 0; while i < VarList.Items.Count do begin if (VarList.Selected[i]) then begin SelList.Items.Add(VarList.Items[i]); VarList.Items.Delete(i); i := 0; end else i := i + 1; end; ClearTabs; UpdateBtnStates; end; procedure TFreqFrm.SelListSelectionChange(Sender: TObject; User: boolean); begin UpdateBtnStates; end; procedure TFreqFrm.OutBtnClick(Sender: TObject); var i: integer; begin i := 0; while i < SelList.Items.Count do begin if (SelList.Selected[i]) then begin VarList.Items.Add(SelList.Items[i]); SelList.Items.Delete(i); i := 0; end else inc(i); end; ClearTabs; UpdateBtnStates; end; procedure TFreqFrm.PlotFreq(AChartFrame: TChartFrame; AColIndex: Integer; AVarName: String; const xLabels: StrDyneVec; const Freq: DblDyneVec); var ser: TChartSeries; isRotated: Boolean; margin: Integer; source: TListChartSource; i: Integer; begin isRotated := false; // *** BAR series *** if VertBarsBtn.Down or HorBarsBtn.Down then begin ser := AChartFrame.PlotXY(ptBars, nil, Freq, xLabels, nil, 'Data', clDefault); with (ser as TBarSeries) do begin BarBrush.Color := DATA_COLORS[(AColIndex-1) mod Length(DATA_COLORS)]; {$IF LCL_FullVersion >= 2010000} DepthBrightnessDelta := -30; {$IFEND} end; if HorBarsBtn.Down then isRotated := true; margin := 0; end else // *** LINE series *** if LinePlotBtn.Down then begin ser := AChartFrame.PlotXY(ptLines, nil, Freq, xLabels, nil, 'Data', clDefault); with TLineSeries(ser) do begin LinePen.Color := DATA_COLORS[(AColIndex-1) mod Length(DATA_COLORS)]; {$IF LCL_FullVersion >= 2010000} DepthBrightnessDelta := -30; {$IFEND} end; margin := 4; end else // *** AREA series *** if AreaPlotBtn.Down then begin ser := AChartFrame.PlotXY(ptArea, nil, Freq, xLabels, nil, 'Data', clDefault); with TAreaSeries(ser) do begin AreaBrush.Color := DATA_COLORS[(AColIndex-1) mod Length(DATA_COLORS)]; AreaLinesPen.Color := AreaBrush.Color; AreaContourPen.Color := clBlack; //AreaBrush.Color; {$IF LCL_FullVersion >= 2010000} DepthBrightnessDelta := -30; {$IFEND} end; margin := 0; end; ser.Legend.Order := 0; if ThreeDChk.Checked then ser.Depth := 20; source := TListChartSource.Create(AChartFrame); for i := 0 to ser.Source.Count-1 do source.Add(ser.Source[i]^.X, ser.Source[i]^.X, ser.Source[i]^.Text); AChartFrame.SetTitle('Frequency distribution'); AChartFrame.Chart.Legend.Visible := NormPltChk.Checked; if isRotated then begin ser.AxisIndexX := 0; ser.AxisIndexY := 1; AChartFrame.SetXTitle('Frequency'); AChartFrame.SetYTitle(AVarName + ' categories'); AChartFrame.Chart.Margins.Bottom := 4; AChartFrame.Chart.BottomAxis.Marks.Source := nil; AChartFrame.Chart.BottomAxis.Marks.Style := smsValue; AChartFrame.Chart.BottomAxis.Marks.Alignment := taCenter; AChartFrame.Chart.Margins.Left := margin; AChartFrame.Chart.LeftAxis.Marks.Source := source; AChartFrame.Chart.LeftAxis.Marks.Style := smsLabel; AChartFrame.Chart.LeftAxis.Marks.Alignment := taCenter; end else begin ser.AxisIndexX := 1; ser.AxisIndexY := 0; AChartFrame.SetXTitle(AVarName + ' categories'); AChartFrame.SetYTitle('Frequency'); AChartFrame.Chart.Margins.Bottom := margin; AChartFrame.Chart.BottomAxis.Marks.Source := source; AChartFrame.Chart.BottomAxis.Marks.Style := smsLabel; AChartFrame.Chart.BottomAxis.Marks.Alignment := taCenter; AChartFrame.Chart.Margins.Left := 4; AChartFrame.Chart.LeftAxis.Marks.Source := nil; AChartFrame.Chart.LeftAxis.Marks.Style := smsValue; AChartFrame.Chart.LeftAxis.Marks.Alignment := taCenter; end; end; procedure TFreqFrm.PlotNormalDist(AChartFrame: TChartFrame; Freq: DblDyneVec); var ser: TLineSeries; begin ser := AChartFrame.PlotXY(ptLines, nil, Freq, nil, nil, 'Normal Dist.', clBlack) as TLineSeries; if HorBarsBtn.Down then begin ser.AxisIndexX := 0; ser.AxisIndexY := 1; end; if ThreeDChk.Checked then begin ser.LinePen.Color := clGray; ser.LinePen.Width := 1; ser.Depth := 20; end else ser.LinePen.Width := 2; end; procedure TFreqFrm.Reset; var i: integer; begin inherited; VarList.Clear; SelList.Clear; for i := 1 to NoVariables do VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]); NormPltChk.Checked := false; ClearTabs; UpdateBtnStates; end; procedure TFreqFrm.UpdateBtnStates; var lSelected: Boolean; i: Integer; chartFrame: TChartFrame; begin inherited; lSelected := false; for i := 0 to VarList.Items.Count-1 do if VarList.Selected[i] then begin lSelected := true; Break; end; InBtn.Enabled := lSelected; lSelected := false; for i := 0 to SelList.Items.Count-1 do if SelList.Selected[i] then begin lSelected := true; break; end; OutBtn.Enabled := lSelected; AllBtn.Enabled := VarList.Items.Count > 0; for i := 1 to PageControl.PageCount-1 do begin chartFrame := PageControl.Pages[i].Controls[0] as TChartFrame; chartFrame.UpdateBtnStates; end; end; procedure TFreqFrm.VarListDblClick(Sender: TObject); var index: integer; begin index := VarList.ItemIndex; if index > -1 then begin SelList.Items.Add(VarList.Items[index]); VarList.Items.Delete(index); ClearTabs; UpdateBtnStates; end; end; procedure TFreqFrm.VarListSelectionChange(Sender: TObject; User: boolean); begin UpdateBtnStates; end; end.