pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

LazStats: Use TAChart in BoxPlotUnit.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7632 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2020-08-23 17:51:36 +00:00
parent 2d32856cbc
commit b61c350fac
3 changed files with 222 additions and 348 deletions
Download Patch File Download Diff File Expand all files Collapse all files

BIN
applications/lazstats/docs/HelpNDoc/LazStats.hnd
View File

Binary file not shown.

568
applications/lazstats/source/forms/analysis/descriptive/boxplotunit.pas
View File

@ -3,13 +3,14 @@
unit BoxPlotUnit; unit BoxPlotUnit;
{$mode objfpc}{$H+} {$mode objfpc}{$H+}
{$I ../../../LazStats.inc}
interface interface
uses uses
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs,
StdCtrls, ExtCtrls, Printers, StdCtrls, ExtCtrls, Printers,
MainUnit, Globals, DataProcs, OutputUnit, BlankFrmUnit, ContextHelpUnit; MainUnit, Globals, DataProcs, OutputUnit, ContextHelpUnit;
type type
@ -41,29 +42,14 @@ type
private private
{ private declarations } { private declarations }
FAutoSized: Boolean; FAutoSized: Boolean;
function Percentile(nscrgrps : integer; function Percentile(nScoreGrps: integer; APercentile: Double;
pcnt : double; const Freq, CumFreq, Scores: DblDyneVec) : double;
VAR freq : DblDyneVec; {$IFDEF USE_TACHART}
VAR cumfreq : DblDyneVec; procedure BoxPlot(const LowQrtl, HiQrtl, TenPcnt, NinetyPcnt, Medians: DblDyneVec);
VAR scores : DblDyneVec) : double; {$ELSE}
{ procedure BoxPlot(NBars: integer; AMax, AMin: double;
procedure pBoxPlot(nbars : integer; const LowQrtl, HiQrtl, TenPcnt, NinetyPcnt, Means, Median: DblDyneVec);
max, min : double; {$ENDIF}
VAR lowqrtl : DblDyneVec;
VAR hiqrtl : DblDyneVec;
VAR tenpcnt : DblDyneVec;
VAR ninetypcnt : DblDyneVec;
VAR means : DblDyneVec;
VAR median : DblDyneVec);
}
procedure BoxPlot(nbars : integer;
max, min : double;
VAR lowqrtl : DblDyneVec;
VAR hiqrtl : DblDyneVec;
VAR tenpcnt : DblDyneVec;
VAR ninetypcnt : DblDyneVec;
VAR means : DblDyneVec;
VAR median : DblDyneVec);
public public
{ public declarations } { public declarations }
@ -74,8 +60,20 @@ var
implementation implementation
{$R *.lfm}
uses uses
Math; {$IFDEF USE_TACHART}
TAChartUtils, TAMultiSeries,
ChartUnit,
{$ELSE}
BlankFrmUnit,
{$ENDIF}
Math, Utils;
const
BOX_COLORS: Array[0..3] of TColor = (clBlue, clGreen, clFuchsia, clLime);
{ TBoxPlotFrm } { TBoxPlotFrm }
@ -90,10 +88,10 @@ begin
VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]); VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]);
end; end;
procedure TBoxPlotFrm.VarListClick(Sender: TObject); procedure TBoxPlotFrm.VarListClick(Sender: TObject);
var var
index: integer; index: integer;
begin begin
index := VarList.ItemIndex; index := VarList.ItemIndex;
if index > -1 then if index > -1 then
@ -105,6 +103,7 @@ begin
end; end;
end; end;
procedure TBoxPlotFrm.HelpBtnClick(Sender: TObject); procedure TBoxPlotFrm.HelpBtnClick(Sender: TObject);
begin begin
if ContextHelpForm = nil then if ContextHelpForm = nil then
@ -112,23 +111,30 @@ begin
ContextHelpForm.HelpMessage((Sender as TButton).tag); ContextHelpForm.HelpMessage((Sender as TButton).tag);
end; end;
procedure TBoxPlotFrm.ComputeBtnClick(Sender: TObject); procedure TBoxPlotFrm.ComputeBtnClick(Sender: TObject);
var var
i, j, k, GrpVar, MeasVar, mingrp, maxgrp, G, NoGrps, cnt : integer;
nscrgrps : integer;
X, tenpcnt, ninepcnt, qrtile1, qrtile2, qrtile3 : double;
minscr, maxscr, intvlsize, lastX : double;
cellstring: string;
means, lowqrtl, hiqrtl, tenpcntile, ninetypcntile, median : DblDyneVec;
freq : DblDyneVec;
Scores : DblDyneVec;
cumfreq : DblDyneVec;
prank : DblDyneVec;
grpsize : IntDyneVec;
done : boolean;
NoSelected : integer;
ColNoSelected : IntDyneVec;
lReport: TStrings; lReport: TStrings;
i, j, k, GrpVar, MeasVar, mingrp, maxgrp, G, NoGrps, cnt: integer;
nScoreGrps: integer;
X, tmp: Double;
// X, tenpcnt, ninepcnt, qrtile1, qrtile2, qrtile3: double;
MinScore, MaxScore, IntervalSize, lastX: double;
cellstring: string;
done: boolean;
NoSelected: integer;
Freq: DblDyneVec = nil;
Scores: DblDyneVec = nil;
CumFreq: DblDyneVec = nil;
pRank: DblDyneVec = nil;
GrpSize: IntDyneVec = nil;
Means: DblDyneVec = nil;
LowQrtl: DblDyneVec = nil;
HiQrtl: DbldyneVec = nil;
TenPcntile: DblDyneVec = nil;
NinetyPcntile: DblDyneVec = nil;
Median: DblDyneVec = nil;
ColNoSelected: IntDyneVec = nil;
begin begin
lReport := TStringList.Create; lReport := TStringList.Create;
try try
@ -145,12 +151,12 @@ begin
end; end;
if GrpVar = 0 then if GrpVar = 0 then
begin begin
MessageDlg('Group variable not selected.', mtError, [mbOK], 0); ErrorMsg('Group variable not selected.');
exit; exit;
end; end;
if MeasVar = 0 then if MeasVar = 0 then
begin begin
MessageDlg('Measurement variable not selected.', mtError, [mbOK], 0); ErrorMsg('Measurement variable not selected.');
exit; exit;
end; end;
@ -160,183 +166,182 @@ begin
ColNoSelected[1] := MeasVar; ColNoSelected[1] := MeasVar;
// get minimum and maximum group values // get minimum and maximum group values
mingrp := 10000; minGrp := MaxInt;
maxgrp := -10000; maxGrp := -MaxInt;
for i := 1 to NoCases do for i := 1 to NoCases do
begin begin
if not GoodRecord(i,NoSelected,ColNoSelected) then continue; if not GoodRecord(i, NoSelected, ColNoSelected) then continue;
G := round(StrToFloat(OS3MainFrm.DataGrid.Cells[GrpVar,i])); G := round(StrToFloat(OS3MainFrm.DataGrid.Cells[GrpVar, i]));
if G < mingrp then mingrp := G; minGrp := Min(G, minGrp);
if G > maxgrp then maxgrp := G; maxGrp := Max(G, maxGrp);
end; end;
NoGrps := maxgrp - mingrp + 1; NoGrps := maxGrp - minGrp + 1;
if NoGrps > 30 then if NoGrps > 30 then
begin begin
MessageDlg('Too many groups for a meaningful plot.', mtError, [mbOK], 0); ErrorMsg('Too many groups for a meaningful plot (max: 20)');
exit; exit;
end; end;
SetLength(freq,2 * NoCases + 1);
SetLength(Scores,2 * NoCases + 1);
SetLength(cumfreq,2 * NoCases + 1);
SetLength(prank,2 * NoCases + 1);
SetLength(grpsize,NoGrps+1);
SetLength(means,NoGrps+1);
SetLength(lowqrtl,NoGrps+1);
SetLength(hiqrtl,NoGrps+1);
SetLength(tenpcntile,NoGrps+1);
SetLength(ninetypcntile,NoGrps+1);
SetLength(median,NoGrps+1);
// initialize
for j := 1 to NoGrps do
begin
means[j-1] := 0.0;
grpsize[j-1] := 0;
end;
// get minimum and maximum scores and score interval // get minimum and maximum scores and score interval
intvlsize := 10000.0; IntervalSize := Infinity;
lastX := 0.0; lastX := 0.0;
X := StrToFloat(OS3MainFrm.DataGrid.Cells[MeasVar,1]); X := StrToFloat(OS3MainFrm.DataGrid.Cells[MeasVar, 1]);
minscr := X; MinScore := X;
maxscr := X; MaxScore := X;
for i := 1 to NoCases do for i := 1 to NoCases do
begin begin
if not GoodRecord(i,NoSelected,ColNoSelected) then continue; if not GoodRecord(i, NoSelected ,ColNoSelected) then continue;
X := StrToFloat(OS3MainFrm.DataGrid.Cells[MeasVar,i]); X := StrToFloat(OS3MainFrm.DataGrid.Cells[MeasVar, i]);
if X > maxscr then maxscr := X; MaxScore := Max(MaxScore, X);
if X < minscr then minscr := X; MinScore := Min(MinScore, X);
if i > 1 then // get interval size as minimum difference between 2 scores if i > 1 then // get interval size as minimum difference between 2 scores
begin begin
if (X <> lastX) and (abs(X - lastX) < intvlsize) then if (X <> lastX) and (abs(X - lastX) < IntervalSize) then
intvlsize := abs(X - lastX); IntervalSize := abs(X - lastX);
lastX := X; lastX := X;
end else end else
lastX := X; lastX := X;
end; end;
SetLength(Scores, 2*NoCases + 1); // over-dimensioned, will be trimmed later.
// check for excess no. of intervals and reset if needed // check for excess no. of intervals and reset if needed
nscrgrps := round((maxscr - minscr) / intvlsize); nScoreGrps := round((MaxScore - MinScore) / IntervalSize);
if nscrgrps > 2 * NoCases then if nScoreGrps > 2 * NoCases then
intvlsize := (maxscr - minscr) / NoCases; Intervalsize := (MaxScore - MinScore) / NoCases;
// setup score groups // setup score groups
done := false; done := false;
Scores[0] := minscr - intvlsize / 2.0; Scores[0] := MinScore - IntervalSize / 2.0;
nscrgrps := 0; nScoreGrps := 0;
lastX := maxscr + intvlsize + intvlsize / 2.0; lastX := MaxScore + IntervalSize + IntervalSize / 2.0;
while not done do while not done do
begin begin
nscrgrps := nscrgrps + 1; inc(nScoreGrps);
Scores[nscrgrps] := minscr + (nscrgrps * intvlsize) - intvlsize / 2.0; Scores[nScoreGrps] := MinScore + (nScoreGrps * IntervalSize) - IntervalSize / 2.0;
if Scores[nscrgrps] > lastX then done := true; if Scores[nScoreGrps] > lastX then done := true;
end; end;
Scores[nscrgrps+1] := Scores[nscrgrps] + intvlsize; Scores[nScoreGrps + 1] := Scores[nScoreGrps] + IntervalSize;
if Scores[0] < minscr then minscr := Scores[0]; if Scores[0] < MinScore then MinScore := Scores[0];
if Scores[nscrgrps] > maxscr then maxscr := Scores[nscrgrps]; if Scores[nScoreGrps] > MaxScore then MaxScore := Scores[nScoreGrps];
SetLength(Scores, nScoreGrps+1); // trim to used length
SetLength(Freq, nScoreGrps);
SetLength(CumFreq, nScoreGrps);
SetLength(pRank, nScoreGrps);
SetLength(GrpSize, NoGrps);
SetLength(Means, NoGrps);
SetLength(LowQrtl, NoGrps);
SetLength(HiQrtl, NoGrps);
SetLength(TenPcntile, NoGrps);
SetLength(NinetyPcntile, NoGrps);
SetLength(Median, NoGrps);
// do analysis for each group // do analysis for each group
for j := 1 to NoGrps do // group for j := 0 to NoGrps-1 do // group
begin begin
Means[j] := 0.0;
GrpSize[j] := 0;
// get score groups for this group j // get score groups for this group j
for i := 0 to nscrgrps do for i := 0 to nScoreGrps-1 do
begin begin
cumfreq[i] := 0.0; CumFreq[i] := 0.0;
freq[i] := 0.0; Freq[i] := 0.0;
end; end;
cnt := 0; cnt := 0;
for i := 1 to NoCases do for i := 1 to NoCases do
begin // get scores for this group j begin // get scores for this group j
if not GoodRecord(i,NoSelected,ColNoSelected) then continue; if not GoodRecord(i,NoSelected, ColNoSelected) then continue;
G := round(StrToFloat(OS3MainFrm.DataGrid.Cells[GrpVar,i])); G := round(StrToFloat(OS3MainFrm.DataGrid.Cells[GrpVar, i]));
G := G - mingrp + 1; G := G - minGrp + 1;
if G = j then // subject in this group if G = j+1 then // subject in this group
begin begin
cnt := cnt + 1; inc(cnt);
X := StrToFloat(OS3MainFrm.DataGrid.Cells[MeasVar,i]); X := StrToFloat(OS3MainFrm.DataGrid.Cells[MeasVar, i]);
means[j-1] := means[j-1] + X; Means[j] := Means[j] + X;
// find score interval and add to the frequency // find score interval and add to the frequency
for k := 0 to nscrgrps do for k := 0 to nScoreGrps do
if (X >= Scores[k]) and (X < Scores[k+1]) then if (X >= Scores[k]) and (X < Scores[k+1]) then
freq[k] := freq[k] + 1; Freq[k] := Freq[k] + 1.0;
end; end;
end; end;
grpsize[j-1] := cnt; GrpSize[j] := cnt;
if grpsize[j-1] > 0 then means[j-1] := means[j-1] / grpsize[j-1]; if GrpSize[j] > 0 then Means[j] := Means[j] / GrpSize[j];
// accumulate frequencies // accumulate frequencies
cumfreq[0] := freq[0]; CumFreq[0] := Freq[0];
for i := 1 to nscrgrps-1 do for i := 1 to nScoreGrps-1 do
cumfreq[i] := cumfreq[i-1] + freq[i]; CumFreq[i] := CumFreq[i-1] + Freq[i];
cumfreq[nscrgrps] := cumfreq[nscrgrps-1]; CumFreq[nScoreGrps] := CumFreq[nScoreGrps-1];
// get percentile ranks // get percentile ranks
prank[0] := ((cumfreq[0] / 2.0) / grpsize[j-1]) * 100.0; pRank[0] := ((CumFreq[0] / 2.0) / GrpSize[j]) * 100.0;
for i := 1 to nscrgrps-1 do for i := 1 to nScoreGrps-1 do
prank[i] := ((cumfreq[i-1] + (freq[i] / 2.0)) / grpsize[j-1]) * 100.0; pRank[i] := ((CumFreq[i-1] + (Freq[i] / 2.0)) / GrpSize[j]) * 100.0;
// get centiles required. // get centiles required.
tenpcnt := 0.10 * grpsize[j-1]; TenPcntile[j] := Percentile(nScoreGrps, 0.10 * GrpSize[j], Freq, CumFreq, Scores);
tenpcntile[j-1] := Percentile(nscrgrps,tenpcnt,freq,cumfreq,scores); NinetyPcntile[j] := Percentile(nScoreGrps, 0.90 * GrpSize[j], Freq, CumFreq, Scores);
ninepcnt := 0.90 * grpsize[j-1]; LowQrtl[j] := Percentile(nScoreGrps, 0.25 * GrpSize[j], Freq, CumFreq, Scores);
ninetypcntile[j-1] := Percentile(nscrgrps,ninepcnt,freq,cumfreq,scores); Median[j] := Percentile(nScoreGrps, 0.50 * GrpSize[j], Freq, CumFreq, Scores);
qrtile1 := 0.25 * grpsize[j-1]; HiQrtl[j] := Percentile(nScoreGrps, 0.75 * GrpSize[j], Freq, CumFreq, Scores);
lowqrtl[j-1] := Percentile(nscrgrps,qrtile1,freq,cumfreq,scores);
qrtile2 := 0.50 * grpsize[j-1];
median[j-1] := Percentile(nscrgrps,qrtile2,freq,cumfreq,scores);
qrtile3 := 0.75 * grpsize[j-1];
hiqrtl[j-1] := Percentile(nscrgrps,qrtile3,freq,cumfreq,scores);
if ShowChk.Checked then if ShowChk.Checked then
begin begin
if j > 1 then lReport.Add(''); if j > 0 then lReport.Add('');
lReport.Add('RESULTS FOR GROUP %d, MEAN = %.3f', [j, means[j-1]]); lReport.Add('RESULTS FOR GROUP %d, MEAN = %.3f', [j+1, Means[j]]);
lReport.Add(''); lReport.Add('');
lReport.Add('Centile Value'); lReport.Add('Centile Value');
lReport.Add('------------ ------'); lReport.Add('------------ ------');
lReport.Add('Ten %6.3f', [tenpcntile[j-1]]); lReport.Add('Ten %6.3f', [TenPcntile[j]]);
lReport.Add('Twenty five %6.3f', [lowqrtl[j-1]]); lReport.Add('Twenty five %6.3f', [LowQrtl[j]]);
lReport.Add('Median %6.3f', [median[j-1]]); lReport.Add('Median %6.3f', [Median[j]]);
lReport.Add('Seventy five %6.3f', [hiqrtl[j-1]]); lReport.Add('Seventy five %6.3f', [HiQrtl[j]]);
lReport.Add('Ninety %6.3f', [ninetypcntile[j-1]]); lReport.Add('Ninety %6.3f', [NinetyPcntile[j]]);
lReport.Add(''); lReport.Add('');
lReport.Add('Score Range Frequency Cum.Freq. Percentile Rank'); lReport.Add('Score Range Frequency Cum.Freq. Percentile Rank');
lReport.Add('--------------- --------- --------- ---------------'); lReport.Add('--------------- --------- --------- ---------------');
for i := 0 to nscrgrps-1 do for i := 0 to nScoreGrps-1 do
lReport.Add('%6.2f - %6.2f %6.2f %6.2f %6.2f', [ lReport.Add('%6.2f - %6.2f %6.2f %6.2f %6.2f', [
Scores[i], Scores[i+1], freq[i], cumfreq[i], prank[i] Scores[i], Scores[i+1], Freq[i], CumFreq[i], pRank[i]
]); ]);
lReport.Add(''); lReport.Add('');
end; end;
end; // get values for next group end; // get values for next group
// Show the report with the frequencies
if ShowChk.Checked then if ShowChk.Checked then
DisplayReport(lReport); DisplayReport(lReport);
// plot the boxes // Plot the boxes
BoxPlot(NoGrps, maxscr, minscr, lowqrtl, hiqrtl, tenpcntile, ninetypcntile, means, median); {$IFDEF USE_TACHART}
BoxPlot(LowQrtl, HiQrtl, TenPcntile, NinetyPcntile, Median);
{$ELSE}
BoxPlot(NoGrps, MaxScore, MinScore, LowQrtl, HiQrtl, TenPcntile, NinetyPcntile, Means, Median);
{$ENDIF}
finally finally
lReport.Free; lReport.Free;
// Clean up // Clean up
median := nil; Median := nil;
ninetypcntile := nil; NinetyPcntile := nil;
tenpcntile := nil; TenPcntile := nil;
hiqrtl := nil; HiQrtl := nil;
lowqrtl := nil; LowQrtl := nil;
means := nil; Means := nil;
grpsize := nil; GrpSize := nil;
cumfreq := nil; CumFreq := nil;
scores := nil; Scores := nil;
freq := nil; Freq := nil;
ColNoSelected := nil; ColNoSelected := nil;
end; end;
end; end;
procedure TBoxPlotFrm.FormActivate(Sender: TObject); procedure TBoxPlotFrm.FormActivate(Sender: TObject);
var var
w: Integer; w: Integer;
@ -356,30 +361,29 @@ begin
FAutoSized := true; FAutoSized := true;
end; end;
procedure TBoxPlotFrm.FormCreate(Sender: TObject); procedure TBoxPlotFrm.FormCreate(Sender: TObject);
begin begin
Assert(OS3MainFrm <> nil); Assert(OS3MainFrm <> nil);
if BlankFrm = nil then Application.CreateForm(TBlankFrm, BlankFrm);
end; end;
procedure TBoxPlotFrm.FormShow(Sender: TObject); procedure TBoxPlotFrm.FormShow(Sender: TObject);
begin begin
ResetBtnClick(self); ResetBtnClick(self);
end; end;
function TBoxPlotFrm.Percentile(nscrgrps: integer;
pcnt: double; function TBoxPlotFrm.Percentile(nScoreGrps: integer;
var freq: DblDyneVec; APercentile: double; const Freq, CumFreq, Scores: DblDyneVec) : double;
var cumfreq: DblDyneVec;
var scores: DblDyneVec) : double;
var var
i, interval: integer; i, interval: integer;
pcntile, Llimit, Ulimit, cumlower, intvlfreq: double; LLimit, ULimit, cumLower, intervalFreq: double;
begin begin
interval := 0; interval := 0;
for i := 0 to nscrgrps-1 do for i := 0 to nScoreGrps-1 do
begin begin
if cumfreq[i] > pcnt then if CumFreq[i] > APercentile then
begin begin
interval := i; interval := i;
Break; Break;
@ -388,195 +392,68 @@ begin
if interval > 0 then if interval > 0 then
begin begin
Llimit := Scores[interval]; LLimit := Scores[interval];
Ulimit := Scores[interval+1]; ULimit := Scores[interval+1];
cumlower := cumfreq[interval-1]; cumLower := CumFreq[interval-1];
intvlfreq := freq[interval]; intervalFreq := Freq[interval];
end end
else else
begin // Percentile in first interval begin // Percentile in first interval
Llimit := Scores[0]; LLimit := Scores[0];
Ulimit := Scores[1]; ULimit := Scores[1];
cumlower := 0.0; cumLower := 0.0;
intvlfreq := freq[0]; intervalFreq := Freq[0];
end; end;
if intvlfreq > 0 then if intervalFreq > 0 then
pcntile := Llimit + ((pcnt - cumlower) / intvlfreq) * (Ulimit- Llimit) Result := LLimit + ((APercentile - cumLower) / intervalFreq) * (ULimit- LLimit)
else else
pcntile := Llimit; Result := LLimit;
Result := pcntile;
end; end;
//-------------------------------------------------------------------
{
procedure TBoxPlotFrm.pBoxPlot(nbars : integer; {$IFDEF USE_TACHART}
max, min : double; procedure TBoxPlotFrm.BoxPlot(const LowQrtl, HiQrtl, TenPcnt, NinetyPcnt, Medians: DblDyneVec);
VAR lowqrtl : DblDyneVec;
VAR hiqrtl : DblDyneVec;
VAR tenpcnt : DblDyneVec;
VAR ninetypcnt : DblDyneVec;
VAR means : DblDyneVec;
VAR median : DblDyneVec);
var var
i, HTickSpace, imagewide, imagehi, vtop, vbottom, offset : integer; i: Integer;
vhi, hleft, hright, hwide, barwidth, Xpos, Ypos, strhi, strwide : integer; ser: TBoxAndWhiskerSeries;
// coords : array [1..5] of TPoint; clr: TColor;
X, Y, colcycle : integer; nBars: Integer;
X1, X2, X3, X9, X10 : integer; // X coordinates for box and lines
Y1, Y2, Y3, Y4, Y9 : integer; // Y coordinates for box and lines
Title : string;
valincr, Yvalue : double;
begin begin
Printer.Orientation := poLandscape; nBars := Length(LowQrtl);
Printer.BeginDoc; if (nBars <> Length(HiQrtl)) or (nBars <> Length(TenPcnt)) or
Title := 'BOXPLOT FOR : ' + OS3MainFrm.FileNameEdit.Text; (nBars <> Length(NinetyPcnt)) or (nBars <> Length(Medians)) then
imagewide := Printer.PageWidth; begin
imagehi := Printer.PageHeight; ErrorMsg('Box-Plot: all data arrays must have the same lengths.');
vtop := 400; exit;
vbottom := round(imagehi) - 400; end;
// vhi := vbottom - vtop;
hleft := 400;
hright := imagewide - 40;
hwide := hright - hleft;
// show title if ChartForm = nil then
Printer.Canvas.Brush.Color := clWhite; ChartForm := TChartForm.Create(Application)
strhi := Printer.Canvas.TextWidth(Title) div 2; else
strhi := imagewide div 2 - strhi; ChartForm.Clear;
Printer.Canvas.TextOut(strhi,50,Title);
// show legend // Titles
Y := Printer.Canvas.TextHeight(Title) * 2; ChartForm.SetTitle('Box-and-Whisker Plot for ' + OS3MainFrm.FileNameEdit.Text);
Y := Y + 50; ChartForm.SetFooter('BLACK: median, BOX: 25th to 75th percentile, WHISKERS: 10th and 90th percentile');
Title := 'RED: mean, BLACK: median, BOX: 25th to 75th percentile, WISKERS: 10th and 90th percentile'; ChartForm.SetXTitle(GroupEdit.Text);
X := imagewide div 2 - Printer.Canvas.TextWidth(Title) div 2; ChartForm.SetYTitle(MeasEdit.Text);
Printer.Canvas.TextOut(X,Y,Title);
Printer.Canvas.Pen.Color := clBlack; ser := TBoxAndWhiskerSeries.create(ChartForm);
Printer.Canvas.Brush.Color := clWhite; for i := 0 to nBars-1 do
begin
clr := BOX_COLORS[i mod Length(BOX_COLORS)];
ser.AddXY(i+1, TenPcnt[i], LowQrtl[i], Medians[i], HiQrtl[i], NinetyPcnt[i], '', clr);
end;
ChartForm.Chart.BottomAxis.Marks.Source := ser.ListSource;
ChartForm.Chart.BottomAxis.Marks.Style := smsXValue;
ChartForm.Chart.AddSeries(ser);
// Draw chart border ChartForm.Show;
Printer.Canvas.Rectangle(hleft,vtop,hright,vbottom);
vbottom := vbottom - 400; // decrease bottom
vhi := vbottom - vtop;
// Draw vertical axis
valincr := (max - min) / 20.0;
for i := 1 to 21 do
begin
Title := format('%8.2f',[max - ((i-1)*valincr)]);
strwide := Printer.Canvas.TextWidth(Title);
strhi := Printer.Canvas.TextHeight(Title);
xpos := 20 + hleft;
Yvalue := max - (valincr * (i-1));
ypos := round(vhi * ( (max - Yvalue) / (max - min)));
ypos := ypos + vtop - strhi div 2;
Printer.Canvas.TextOut(xpos,ypos,Title);
end;
Printer.Canvas.MoveTo(hleft + strwide + 50,vtop);
Printer.Canvas.LineTo(hleft + strwide + 50,vbottom+20);
hwide := hwide - (strwide + 50);
hleft := hleft + strwide + 50;
HTickSpace := hwide div (nbars + 1);
barwidth := HTickSpace div 2;
// draw horizontal axis
Printer.Canvas.MoveTo(hleft,vbottom + 20);
Printer.Canvas.LineTo(hright,vbottom + 20);
for i := 1 to nbars do
begin
ypos := vbottom + 10;
xpos := round((hwide / (nbars+1))* i + hleft);
Printer.Canvas.MoveTo(xpos,ypos);
ypos := ypos + 10;
Printer.Canvas.LineTo(xpos,ypos);
Title := format('%d',[i]);
offset := Printer.Canvas.TextWidth(Title) div 2;
strhi := Printer.Canvas.TextHeight(Title);
xpos := xpos - offset;
ypos := ypos + strhi;
Printer.Canvas.Pen.Color := clBlack;
Printer.Canvas.TextOut(xpos,ypos,Title);
xpos := hleft;
Printer.Canvas.TextOut(xpos,ypos,'GROUPS:');
end;
for i := 1 to nbars do
begin
colcycle := i mod 4; // select a color for box
if (colcycle = 0) then Printer.Canvas.Brush.Color := clBlue;
if (colcycle = 1) then Printer.Canvas.Brush.Color := clGreen;
if (colcycle = 2) then Printer.Canvas.Brush.Color := clFuchsia;
if (colcycle = 3) then Printer.Canvas.Brush.Color := clLime;
// plot the box front face
X9 := round(hleft + ((i) * HTickSpace) - (barwidth / 2));
X10 := X9 + barwidth;
X1 := X9;
X2 := X10;
Ypos:= round((((max - hiqrtl[i-1]) / (max - min)) * vhi) + vtop);
Y1 := Ypos;
Ypos := round((((max - lowqrtl[i-1]) / (max - min)) * vhi) + vtop);
Y2 := Ypos;
Printer.Canvas.Rectangle(X1,Y1,X2,Y2);
// draw upper 90th percentile line and end
X3 := round(X1 + barwidth / 2);
Printer.Canvas.MoveTo(X3,Y1);
Ypos := round((((max - ninetypcnt[i-1]) / (max - min)) * vhi) + vtop);
Y3 := Ypos;
Printer.Canvas.LineTo(X3,Y3);
Printer.Canvas.MoveTo(X1,Y3);
Printer.Canvas.LineTo(X2,Y3);
// draw lower 10th percentile line and end
Printer.Canvas.MoveTo(X3,Y2);
Ypos := round((((max - tenpcnt[i-1]) / (max - min)) * vhi) + vtop);
Y4 := Ypos;
Printer.Canvas.LineTo(X3,Y4);
Printer.Canvas.MoveTo(X1,Y4);
Printer.Canvas.LineTo(X2,Y4);
//plot the mean line
Printer.Canvas.Pen.Width := 10;
Printer.Canvas.Pen.Color := clRed;
Printer.Canvas.Pen.Style := psDot;
Ypos := round((((max - means[i-1]) / (max - min)) * vhi) + vtop);
Y9 := Ypos;
Printer.Canvas.MoveTo(X9,Y9);
Printer.Canvas.LineTo(X10,Y9);
Printer.Canvas.Pen.Color := clBlack;
Printer.Canvas.Pen.Style := psSolid;
//plot the median line
Printer.Canvas.Pen.Color := clBlack;
Ypos := round((((max - median[i-1]) / (max - min)) * vhi) + vtop);
Y9 := Ypos;
Printer.Canvas.MoveTo(X9,Y9);
Printer.Canvas.LineTo(X10,Y9);
Printer.Canvas.Pen.Color := clBlack;
end;
Printer.EndDoc;
Printer.Orientation := poPortrait;
end; end;
} {$ELSE}
procedure TBoxPlotFrm.BoxPlot(NBars: integer; AMax, AMin: double;
//-------------------------------------------------------------------------- const LowQrtl, HiQrtl, TenPcnt, NinetyPcnt, Means, Median: DblDyneVec);
procedure TBoxPlotFrm.BoxPlot(nbars: integer;
max, min: double;
var lowqrtl: DblDyneVec;
var hiqrtl: DblDyneVec;
var tenpcnt: DblDyneVec;
var ninetypcnt: DblDyneVec;
var means: DblDyneVec;
var median: DblDyneVec);
const
BOX_COLORS: Array[0..3] of TColor = (clBlue, clGreen, clFuchsia, clLime);
var var
i, HTickSpace, imagewide, imagehi, vtop, vbottom, offset: integer; i, HTickSpace, imagewide, imagehi, vtop, vbottom, offset: integer;
vhi, hleft, hright, hwide, barwidth, Xpos, Ypos, strhi: integer; vhi, hleft, hright, hwide, barwidth, Xpos, Ypos, strhi: integer;
@ -587,8 +464,8 @@ var
Title: string; Title: string;
valincr, Yvalue: double; valincr, Yvalue: double;
begin begin
if BlankFrm = nil then Application.CreateForm(TBlankFrm, BlankFrm);
BlankFrm.Show; BlankFrm.Show;
//BlankFrm.Image1.Canvas.Clear;
imagewide := BlankFrm.Image1.width; imagewide := BlankFrm.Image1.width;
imagehi := BlankFrm.Image1.Height; imagehi := BlankFrm.Image1.Height;
@ -604,7 +481,6 @@ begin
HTickSpace := hwide div nbars; HTickSpace := hwide div nbars;
barwidth := HTickSpace div 2; barwidth := HTickSpace div 2;
// Show title // Show title
Title := 'BOXPLOT FOR : ' + OS3MainFrm.FileNameEdit.Text; Title := 'BOXPLOT FOR : ' + OS3MainFrm.FileNameEdit.Text;
BlankFrm.Caption := Title; BlankFrm.Caption := Title;
@ -629,14 +505,14 @@ begin
BlankFrm.Image1.Canvas.TextOut(X,Y,Title); BlankFrm.Image1.Canvas.TextOut(X,Y,Title);
// Draw vertical axis // Draw vertical axis
valincr := (max - min) / 20.0; valincr := (AMax - AMin) / 20.0;
for i := 1 to 21 do for i := 1 to 21 do
begin begin
Title := format('%8.2f',[max - ((i-1)*valincr)]); Title := format('%8.2f',[AMax - ((i-1)*valincr)]);
strhi := BlankFrm.Image1.Canvas.TextHeight(Title); strhi := BlankFrm.Image1.Canvas.TextHeight(Title);
xpos := XOffset; xpos := XOffset;
Yvalue := max - (valincr * (i-1)); Yvalue := AMax - (valincr * (i-1));
ypos := round(vhi * ( (max - Yvalue) / (max - min))); ypos := round(vhi * ( (AMax - Yvalue) / (AMax - AMin)));
ypos := ypos + vtop - strhi div 2; ypos := ypos + vtop - strhi div 2;
BlankFrm.Image1.Canvas.TextOut(xpos,ypos,Title); BlankFrm.Image1.Canvas.TextOut(xpos,ypos,Title);
end; end;
@ -664,30 +540,30 @@ begin
BlankFrm.Image1.Canvas.TextOut(xpos,ypos,'GROUPS:'); BlankFrm.Image1.Canvas.TextOut(xpos,ypos,'GROUPS:');
end; end;
for i := 1 to nbars do for i := 0 to NBars - 1 do
begin begin
BlankFrm.Image1.Canvas.Brush.Color := BOX_COLORS[i mod 4]; BlankFrm.Image1.Canvas.Brush.Color := BOX_COLORS[i mod Length(BOX_COLORS)];
// plot the box front face // plot the box front face
X9 := round(hleft + ((i) * HTickSpace) - (barwidth / 2)); X9 := round(hleft + ((i+1) * HTickSpace) - (barwidth / 2));
X10 := X9 + barwidth; X10 := X9 + barwidth;
X1 := X9; X1 := X9;
X2 := X10; X2 := X10;
Y1 := round((((max - hiqrtl[i-1]) / (max - min)) * vhi) + vtop); Y1 := round((((AMax - HiQrtl[i]) / (AMax - AMin)) * vhi) + vtop);
Y2 := round((((max - lowqrtl[i-1]) / (max - min)) * vhi) + vtop); Y2 := round((((AMax - LowQrtl[i]) / (AMax - AMin)) * vhi) + vtop);
BlankFrm.Image1.Canvas.Rectangle(X1,Y1,X2,Y2); BlankFrm.Image1.Canvas.Rectangle(X1,Y1,X2,Y2);
// draw upper 90th percentile line and end // draw upper 90th percentile line and end
X3 := round(X1 + barwidth / 2); X3 := round(X1 + barwidth / 2);
BlankFrm.Image1.Canvas.MoveTo(X3,Y1); BlankFrm.Image1.Canvas.MoveTo(X3,Y1);
Y3 := round((((max - ninetypcnt[i-1]) / (max - min)) * vhi) + vtop); Y3 := round((((AMax - NinetyPcnt[i]) / (AMax - AMin)) * vhi) + vtop);
BlankFrm.Image1.Canvas.LineTo(X3,Y3); BlankFrm.Image1.Canvas.LineTo(X3,Y3);
BlankFrm.Image1.Canvas.MoveTo(X1,Y3); BlankFrm.Image1.Canvas.MoveTo(X1,Y3);
BlankFrm.Image1.Canvas.LineTo(X2,Y3); BlankFrm.Image1.Canvas.LineTo(X2,Y3);
// draw lower 10th percentile line and end // draw lower 10th percentile line and end
BlankFrm.Image1.Canvas.MoveTo(X3,Y2); BlankFrm.Image1.Canvas.MoveTo(X3,Y2);
Y4 := round((((max - tenpcnt[i-1]) / (max - min)) * vhi) + vtop); Y4 := round((((AMax - TenPcnt[i]) / (AMax - AMin)) * vhi) + vtop);
BlankFrm.Image1.Canvas.LineTo(X3,Y4); BlankFrm.Image1.Canvas.LineTo(X3,Y4);
BlankFrm.Image1.Canvas.MoveTo(X1,Y4); BlankFrm.Image1.Canvas.MoveTo(X1,Y4);
BlankFrm.Image1.Canvas.LineTo(X2,Y4); BlankFrm.Image1.Canvas.LineTo(X2,Y4);
@ -695,7 +571,7 @@ begin
//plot the means line //plot the means line
BlankFrm.Image1.Canvas.Pen.Color := clRed; BlankFrm.Image1.Canvas.Pen.Color := clRed;
BlankFrm.Image1.Canvas.Pen.Style := psDot; BlankFrm.Image1.Canvas.Pen.Style := psDot;
Y9 := round((((max - means[i-1]) / (max - min)) * vhi) + vtop); Y9 := round((((AMax - Means[i]) / (AMax - AMin)) * vhi) + vtop);
BlankFrm.Image1.Canvas.MoveTo(X9,Y9); BlankFrm.Image1.Canvas.MoveTo(X9,Y9);
BlankFrm.Image1.Canvas.LineTo(X10,Y9); BlankFrm.Image1.Canvas.LineTo(X10,Y9);
BlankFrm.Image1.Canvas.Pen.Color := clBlack; BlankFrm.Image1.Canvas.Pen.Color := clBlack;
@ -703,16 +579,14 @@ begin
//plot the median line //plot the median line
BlankFrm.Image1.Canvas.Pen.Color := clBlack; BlankFrm.Image1.Canvas.Pen.Color := clBlack;
Y9 := round((((max - median[i-1]) / (max - min)) * vhi) + vtop); Y9 := round((((AMax - Median[i]) / (AMax - AMin)) * vhi) + vtop);
BlankFrm.Image1.Canvas.MoveTo(X9,Y9); BlankFrm.Image1.Canvas.MoveTo(X9,Y9);
BlankFrm.Image1.Canvas.LineTo(X10,Y9); BlankFrm.Image1.Canvas.LineTo(X10,Y9);
BlankFrm.Image1.Canvas.Pen.Color := clBlack; BlankFrm.Image1.Canvas.Pen.Color := clBlack;
end; end;
end; end;
{$ENDIF}
initialization
{$I boxplotunit.lrs}
end. end.

2
applications/lazstats/source/forms/analysis/descriptive/plotxyunit.pas
View File

@ -363,7 +363,7 @@ begin
R, Slope, Intercept R, Slope, Intercept
])); ]));
ChartForm.SetXTitle(XEdit.Text); ChartForm.SetXTitle(XEdit.Text);
chartForm.SetYTitle(YEdit.Text); ChartForm.SetYTitle(YEdit.Text);
// Draw upper confidence band // Draw upper confidence band
if ConfChk.Checked then if ConfChk.Checked then