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

LazStats: Use TAChart in RChartUnit.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7651 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2020-09-07 12:44:00 +00:00
parent 33197e9e71
commit 1aefc50b7f
3 changed files with 446 additions and 335 deletions
Download Patch File Download Diff File Expand all files Collapse all files

333
applications/lazstats/source/forms/analysis/statistical_process_control/rchartunit.lfm
View File

@ -1,37 +1,138 @@
object RChartFrm: TRChartFrm object RChartFrm: TRChartFrm
Left = 688 Left = 688
Height = 297 Height = 476
Top = 126 Top = 126
Width = 382 Width = 875
HelpType = htKeyword HelpType = htKeyword
HelpKeyword = 'html/RangeChart.htm' HelpKeyword = 'html/RangeChart.htm'
AutoSize = True Caption = 'Range Chart'
Caption = 'Range Charting'
ChildSizing.ControlsPerLine = 1 ChildSizing.ControlsPerLine = 1
ClientHeight = 297 ClientHeight = 476
ClientWidth = 382 ClientWidth = 875
OnActivate = FormActivate OnActivate = FormActivate
OnCreate = FormCreate OnCreate = FormCreate
OnShow = FormShow OnShow = FormShow
Position = poMainFormCenter Position = poMainFormCenter
LCLVersion = '2.1.0.0' LCLVersion = '2.1.0.0'
object Panel1: TPanel object SpecsPanel: TPanel
Left = 0
Height = 476
Top = 0
Width = 378
Align = alLeft
BevelOuter = bvNone
ClientHeight = 476
ClientWidth = 378
TabOrder = 0
object GroupLabel: TLabel
AnchorSideLeft.Control = GroupEdit
AnchorSideTop.Control = SpecsPanel
Left = 222
Height = 15
Top = 8
Width = 77
BorderSpacing.Top = 8
Caption = 'Group Variable'
ParentColor = False
end
object MeasLabel: TLabel
AnchorSideLeft.Control = MeasEdit
AnchorSideTop.Control = GroupEdit
AnchorSideTop.Side = asrBottom
Left = 222
Height = 15
Top = 64
Width = 117
BorderSpacing.Top = 16
Caption = 'Measurement Variable'
ParentColor = False
end
object GroupEdit: TEdit
AnchorSideLeft.Control = CenterBevel
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = GroupLabel
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = SpecsPanel
AnchorSideRight.Side = asrBottom
Left = 222
Height = 23
Top = 25
Width = 156
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Left = 8
BorderSpacing.Top = 2
TabOrder = 1
Text = 'GroupEdit'
end
object MeasEdit: TEdit
AnchorSideLeft.Control = CenterBevel
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = MeasLabel
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = SpecsPanel
AnchorSideRight.Side = asrBottom
Left = 222
Height = 23
Top = 81
Width = 156
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Left = 8
BorderSpacing.Top = 2
TabOrder = 2
Text = 'MeasEdit'
end
object VarListLabel: TLabel
AnchorSideLeft.Control = SpecsPanel
AnchorSideTop.Control = SpecsPanel
Left = 8 Left = 8
Height = 15
Top = 8
Width = 97
BorderSpacing.Left = 8
BorderSpacing.Top = 8
Caption = 'Selection Variables'
ParentColor = False
end
object VarList: TListBox
AnchorSideLeft.Control = SpecsPanel
AnchorSideTop.Control = VarListLabel
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = CenterBevel
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = ButtonBevel
Left = 8
Height = 402
Top = 25
Width = 206
Anchors = [akTop, akLeft, akRight, akBottom]
BorderSpacing.Left = 8
BorderSpacing.Top = 2
ItemHeight = 0
OnClick = VarListClick
TabOrder = 0
end
object ButtonPanel: TPanel
AnchorSideLeft.Control = SpecsPanel
AnchorSideRight.Control = SpecsPanel
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = SpecsPanel
Left = 0
Height = 25 Height = 25
Top = 264 Top = 443
Width = 366 Width = 378
Align = alBottom Align = alBottom
AutoSize = True AutoSize = True
BorderSpacing.Around = 8 BorderSpacing.Top = 8
BorderSpacing.Bottom = 8
BevelOuter = bvNone BevelOuter = bvNone
ClientHeight = 25 ClientHeight = 25
ClientWidth = 366 ClientWidth = 378
TabOrder = 1 TabOrder = 3
object ResetBtn: TButton object ResetBtn: TButton
AnchorSideLeft.Control = Panel1 AnchorSideLeft.Control = ButtonPanel
AnchorSideTop.Control = Panel1 AnchorSideTop.Control = ButtonPanel
AnchorSideRight.Control = ComputeBtn AnchorSideRight.Control = ComputeBtn
Left = 165 Left = 177
Height = 25 Height = 25
Top = 0 Top = 0
Width = 54 Width = 54
@ -43,10 +144,10 @@ object RChartFrm: TRChartFrm
TabOrder = 1 TabOrder = 1
end end
object ComputeBtn: TButton object ComputeBtn: TButton
AnchorSideLeft.Control = Panel1 AnchorSideLeft.Control = ButtonPanel
AnchorSideTop.Control = Panel1 AnchorSideTop.Control = ButtonPanel
AnchorSideRight.Control = CloseBtn AnchorSideRight.Control = CloseBtn
Left = 227 Left = 239
Height = 25 Height = 25
Top = 0 Top = 0
Width = 76 Width = 76
@ -59,26 +160,27 @@ object RChartFrm: TRChartFrm
end end
object HelpBtn: TButton object HelpBtn: TButton
Tag = 141 Tag = 141
AnchorSideLeft.Control = Panel1 AnchorSideLeft.Control = ButtonPanel
AnchorSideTop.Control = ResetBtn AnchorSideTop.Control = ResetBtn
AnchorSideRight.Control = ResetBtn AnchorSideRight.Control = ResetBtn
Left = 106 Left = 118
Height = 25 Height = 25
Top = 0 Top = 0
Width = 51 Width = 51
Anchors = [akTop, akRight] Anchors = [akTop, akRight]
AutoSize = True AutoSize = True
BorderSpacing.Left = 8
BorderSpacing.Right = 8 BorderSpacing.Right = 8
Caption = 'Help' Caption = 'Help'
OnClick = HelpBtnClick OnClick = HelpBtnClick
TabOrder = 0 TabOrder = 0
end end
object CloseBtn: TButton object CloseBtn: TButton
AnchorSideLeft.Control = Panel1 AnchorSideLeft.Control = ButtonPanel
AnchorSideTop.Control = Panel1 AnchorSideTop.Control = ButtonPanel
AnchorSideRight.Control = Panel1 AnchorSideRight.Control = ButtonPanel
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
Left = 311 Left = 323
Height = 25 Height = 25
Top = 0 Top = 0
Width = 55 Width = 55
@ -89,134 +191,69 @@ object RChartFrm: TRChartFrm
TabOrder = 3 TabOrder = 3
end end
end end
object Panel4: TPanel object ButtonBevel: TBevel
Left = 0 AnchorSideLeft.Control = SpecsPanel
Height = 256 AnchorSideTop.Control = ButtonPanel
Top = 0 AnchorSideRight.Control = SpecsPanel
Width = 382
Align = alClient
Anchors = [akTop, akLeft, akRight]
BevelOuter = bvNone
ClientHeight = 256
ClientWidth = 382
TabOrder = 0
object Bevel1: TBevel
AnchorSideLeft.Control = Panel4
AnchorSideLeft.Side = asrCenter
Left = 156
Height = 16
Top = 0
Width = 71
Shape = bsSpacer
end
object Label2: TLabel
AnchorSideLeft.Control = Bevel1
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = Panel4
Left = 235
Height = 15
Top = 8
Width = 77
BorderSpacing.Left = 8
BorderSpacing.Top = 8
Caption = 'Group Variable'
ParentColor = False
end
object Label3: TLabel
AnchorSideLeft.Control = Bevel1
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = GroupEdit
AnchorSideTop.Side = asrBottom
Left = 235
Height = 15
Top = 64
Width = 117
BorderSpacing.Left = 8
BorderSpacing.Top = 16
Caption = 'Measurement Variable'
ParentColor = False
end
object GroupEdit: TEdit
AnchorSideLeft.Control = Bevel1
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = Label2
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = Panel4
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
Left = 235 AnchorSideBottom.Control = ButtonPanel
Height = 23
Top = 25
Width = 139
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Left = 8
BorderSpacing.Top = 2
BorderSpacing.Right = 8
TabOrder = 1
Text = 'GroupEdit'
end
object MeasEdit: TEdit
AnchorSideLeft.Control = Bevel1
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = Label3
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = Panel4
AnchorSideRight.Side = asrBottom
Left = 235
Height = 23
Top = 81
Width = 139
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Left = 8
BorderSpacing.Top = 2
BorderSpacing.Right = 8
TabOrder = 2
Text = 'MeasEdit'
end
object Label1: TLabel
AnchorSideLeft.Control = Panel4
AnchorSideTop.Control = Panel4
Left = 8
Height = 15
Top = 8
Width = 97
BorderSpacing.Left = 8
BorderSpacing.Top = 8
Caption = 'Selection Variables'
ParentColor = False
end
object VarList: TListBox
AnchorSideLeft.Control = Panel4
AnchorSideTop.Control = Label1
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = Bevel1
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = Panel4
AnchorSideBottom.Side = asrBottom
Left = 8
Height = 223
Top = 25
Width = 219
Anchors = [akTop, akLeft, akRight, akBottom]
BorderSpacing.Left = 8
BorderSpacing.Top = 2
BorderSpacing.Bottom = 8
Constraints.MinHeight = 220
ItemHeight = 0
OnClick = VarListClick
TabOrder = 0
end
end
object Bevel2: TBevel
AnchorSideLeft.Control = Panel4
AnchorSideTop.Control = Panel1
AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = Panel1
Left = 0 Left = 0
Height = 8 Height = 8
Top = 248 Top = 427
Width = 382 Width = 378
Anchors = [akLeft, akRight, akBottom] Anchors = [akLeft, akRight, akBottom]
Shape = bsBottomLine Shape = bsBottomLine
end end
object CenterBevel: TBevel
AnchorSideLeft.Control = SpecsPanel
AnchorSideLeft.Side = asrCenter
AnchorSideTop.Control = SpecsPanel
Left = 165
Height = 10
Top = 0
Width = 49
Shape = bsSpacer
end
end
object Splitter1: TSplitter
Left = 378
Height = 476
Top = 0
Width = 5
ResizeStyle = rsPattern
end
object PageControl1: TPageControl
Left = 385
Height = 460
Top = 8
Width = 482
ActivePage = ReportPage
Align = alClient
BorderSpacing.Left = 2
BorderSpacing.Top = 8
BorderSpacing.Right = 8
BorderSpacing.Bottom = 8
TabIndex = 0
TabOrder = 2
object ReportPage: TTabSheet
Caption = 'Report'
ClientHeight = 432
ClientWidth = 474
object ReportMemo: TMemo
Left = 6
Height = 420
Top = 6
Width = 462
Align = alClient
BorderSpacing.Around = 6
Font.Height = -11
Font.Name = 'Courier New'
ParentFont = False
TabOrder = 0
end
end
object ChartPage: TTabSheet
Caption = 'Chart'
end
end
end end

226
applications/lazstats/source/forms/analysis/statistical_process_control/rchartunit.pas
View File

@ -5,13 +5,20 @@
unit RChartUnit; unit RChartUnit;
{$mode objfpc}{$H+} {$mode objfpc}{$H+}
{$include ../../../LazStats.inc}
interface interface
uses uses
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs,
StdCtrls, Printers, ExtCtrls, Buttons, StdCtrls, Printers, ExtCtrls, Buttons, ComCtrls,
MainUnit, Globals, OutputUnit, GraphLib, BlankFrmUnit, ContextHelpUnit; MainUnit, Globals, GraphLib, ContextHelpUnit,
{$IFDEF USE_TACHART}
TAChartUtils, TASources, TACustomSeries, TASeries, TALegend, TAChartAxisUtils,
ChartFrameUnit;
{$ELSE}
OutputUnit, BlankFrmUnit;
{$ENDIF}
type type
@ -19,19 +26,24 @@ type
{ TRChartFrm } { TRChartFrm }
TRChartFrm = class(TForm) TRChartFrm = class(TForm)
Bevel1: TBevel; CenterBevel: TBevel;
Bevel2: TBevel; ButtonBevel: TBevel;
HelpBtn: TButton; HelpBtn: TButton;
Panel1: TPanel; ReportMemo: TMemo;
Panel4: TPanel; PageControl1: TPageControl;
ButtonPanel: TPanel;
SpecsPanel: TPanel;
ResetBtn: TButton; ResetBtn: TButton;
ComputeBtn: TButton; ComputeBtn: TButton;
CloseBtn: TButton; CloseBtn: TButton;
MeasEdit: TEdit; MeasEdit: TEdit;
GroupEdit: TEdit; GroupEdit: TEdit;
Label1: TLabel; VarListLabel: TLabel;
Label2: TLabel; GroupLabel: TLabel;
Label3: TLabel; MeasLabel: TLabel;
Splitter1: TSplitter;
ReportPage: TTabSheet;
ChartPage: TTabSheet;
VarList: TListBox; VarList: TListBox;
procedure ComputeBtnClick(Sender: TObject); procedure ComputeBtnClick(Sender: TObject);
procedure FormActivate(Sender: TObject); procedure FormActivate(Sender: TObject);
@ -42,10 +54,11 @@ type
procedure VarListClick(Sender: TObject); procedure VarListClick(Sender: TObject);
private private
{ private declarations } { private declarations }
FAutoSized: Boolean; {$IFDEF USE_TACHART}
procedure PlotMeans(VAR means : DblDyneVec; FChartFrame: TChartFrame;
NoGrps : integer; {$ENDIF}
UCL, LCL, GrandMean : double); procedure PlotMeans(const Groups: StrDyneVec; const Means: DblDyneVec;
UCL, LCL, GrandMean: double);
public public
{ public declarations } { public declarations }
end; end;
@ -55,8 +68,10 @@ var
implementation implementation
{$R *.lfm}
uses uses
Math; Math, Utils;
{ TRChartFrm } { TRChartFrm }
@ -69,6 +84,9 @@ begin
MeasEdit.Text := ''; MeasEdit.Text := '';
for i := 1 to NoVariables do for i := 1 to NoVariables do
VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]); VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]);
{$IFDEF USE_TACHART}
FChartFrame.Clear;
{$ENDIF}
end; end;
procedure TRChartFrm.VarListClick(Sender: TObject); procedure TRChartFrm.VarListClick(Sender: TObject);
@ -90,26 +108,41 @@ procedure TRChartFrm.FormActivate(Sender: TObject);
var var
w: Integer; w: Integer;
begin begin
if FAutoSized then
exit;
w := MaxValue([HelpBtn.Width, ResetBtn.Width, ComputeBtn.Width, CloseBtn.Width]); w := MaxValue([HelpBtn.Width, ResetBtn.Width, ComputeBtn.Width, CloseBtn.Width]);
HelpBtn.Constraints.MinWidth := w; HelpBtn.Constraints.MinWidth := w;
ResetBtn.Constraints.MinWidth := w; ResetBtn.Constraints.MinWidth := w;
ComputeBtn.Constraints.MinWidth := w; ComputeBtn.Constraints.MinWidth := w;
CloseBtn.Constraints.MinWidth := w; CloseBtn.Constraints.MinWidth := w;
Constraints.MinWidth := Width; SpecsPanel.Constraints.MinWidth := Max(
Constraints.MinHeight := Height; VarListLabel.Width + MeasLabel.Width,
CloseBtn.Left + CloseBtn.Width - HelpBtn.Left + HelpBtn.BorderSpacing.Left
);
FAutoSized := true; Constraints.MinHeight := MeasEdit.Top + MeasEdit.Height + ButtonBevel.Height + ButtonPanel.Height + 2*ButtonPanel.BorderSpacing.Bottom;
end; end;
procedure TRChartFrm.FormCreate(Sender: TObject); procedure TRChartFrm.FormCreate(Sender: TObject);
begin begin
Assert(OS3MainFrm <> nil); Assert(OS3MainFrm <> nil);
{$IFDEF USE_TACHART}
FChartFrame := TChartFrame.Create(self);
FChartFrame.Parent := ChartPage;
FChartFrame.Align := alClient;
FChartFrame.BorderSpacing.Around := Scale96ToFont(8);
FChartFrame.Chart.Legend.SymbolWidth := Scale96ToFont(30);
FChartFrame.Chart.Legend.Alignment := laBottomCenter;
FChartFrame.Chart.Legend.ColumnCount := 3;
with FChartFrame.Chart.AxisList.Add do
begin
Alignment := calRight;
Marks.Source := TListChartSource.Create(self);
Marks.Style := smsLabel;
end;
{$ELSE}
if BlankFrm = nil then if BlankFrm = nil then
Application.CreateForm(TBlankfrm, BlankFrm); Application.CreateForm(TBlankFrm, BlankFrm);
{$ENDIF}
end; end;
procedure TRChartFrm.FormShow(Sender: TObject); procedure TRChartFrm.FormShow(Sender: TObject);
@ -126,15 +159,20 @@ end;
procedure TRChartFrm.ComputeBtnClick(Sender: TObject); procedure TRChartFrm.ComputeBtnClick(Sender: TObject);
var var
i, j, GrpVar, MeasVar, mingrp, maxgrp, G, range, grpsize : integer; i, j, GrpVar, MeasVar, grpsize : integer;
oldgrpsize : integer; oldgrpsize : integer;
X, UCL, LCL: double; X, UCL, LCL: double;
xmin, xmax, GrandMean, GrandSD, semean, D3Value, D4Value : double; xmin, xmax, GrandMean, GrandSD, semean, D3Value, D4Value : double;
GrandRange : double; GrandRange : double;
means, stddev, ranges : DblDyneVec; grp: String;
count : IntDyneVec; grpIndex, numGrps: Integer;
groups: StrDyneVec = nil;
means: DblDyneVec = nil;
stddev: DblDyneVec = nil;
ranges: DblDyneVec = nil;
count: IntDyneVec;
cellstring: string; cellstring: string;
sizeError : boolean; sizeError: boolean;
lReport: TStrings; lReport: TStrings;
const const
D3: array[1..24] of double = ( D3: array[1..24] of double = (
@ -172,60 +210,56 @@ begin
if cellstring = MeasEdit.Text then MeasVar := i; if cellstring = MeasEdit.Text then MeasVar := i;
end; end;
mingrp := MaxInt; numGrps := 0;
maxgrp := -MaxInt; SetLength(groups, NoCases);
for i := 1 to NoCases do for i := 1 to NoCases do
begin begin
G := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[GrpVar,i]))); grp := Trim(OS3MainFrm.DataGrid.Cells[GrpVar, i]);
if G < mingrp then mingrp := G; if IndexOfString(groups, grp) = -1 then
if G > maxgrp then maxgrp := G;
end;
range := maxgrp - mingrp + 1;
SetLength(means,range);
SetLength(count,range);
SetLength(stddev,range);
SetLength(ranges,range);
for i := 0 to range-1 do
begin begin
count[i] := 0; groups[numGrps] := grp;
means[i] := 0.0; inc(numGrps);
stddev[i] := 0.0;
ranges[i] := 0.0;
end; end;
end;
SetLength(groups, numGrps);
SetLength(means, numGrps);
SetLength(count, numGrps);
SetLength(stddev, numGrps);
SetLength(ranges, numGrps);
semean := 0.0; semean := 0.0;
GrandMean := 0.0; GrandMean := 0.0;
GrandRange := 0.0; GrandRange := 0.0;
sizeError := false; sizeError := false;
// calculate group ranges, grand mean, group sd's, semeans // calculate group ranges, grand mean, group sd's, semeans
for j := 1 to range do // groups for j := 0 to numGrps-1 do
begin begin
xmin := 1E308; xmin := 1E308;
xmax := -1E308; xmax := -1E308;
for i := 1 to NoCases do for i := 1 to NoCases do
begin begin
G := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[GrpVar,i]))); grp := Trim(OS3MainFrm.DataGrid.Cells[GrpVar, i]);
G := G - mingrp + 1; grpIndex := IndexOfString(groups, grp);
if G = j then
if grpIndex = j then
begin begin
X := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[MeasVar,i])); X := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[MeasVar, i]));
if X > xmax then xmax := X; if X > xmax then xmax := X;
if X < xmin then xmin := X; if X < xmin then xmin := X;
means[G-1] := means[G-1] + X; means[grpIndex] := means[grpIndex] + X;
count[G-1] := count[G-1] + 1; count[grpIndex] := count[grpIndex] + 1;
stddev[G-1] := stddev[G-1] + X * X; stddev[grpIndex] := stddev[grpIndex] + X*X;
semean := semean + X * X; seMean := seMean + X*X;
GrandMean := GrandMean + X; GrandMean := GrandMean + X;
end; end;
end; // next case end; // next case
ranges[j-1] := xmax - xmin; ranges[j] := xMax - xMin;
GrandRange := GrandRange + ranges[j-1]; GrandRange := GrandRange + ranges[j];
grpsize := count[j-1]; grpSize := count[j];
if j = 1 then oldgrpsize := grpsize; if j = 0 then oldGrpSize := grpSize;
if oldgrpsize <> grpsize then sizeError := true; if oldGrpSize <> grpSize then sizeError := true;
end; end;
if (grpsize < 2) or (grpsize > 25) or sizeError then if (grpsize < 2) or (grpsize > 25) or sizeError then
@ -234,7 +268,7 @@ begin
exit; exit;
end; end;
for i := 0 to range-1 do for i := 0 to numGrps-1 do
begin begin
stddev[i] := stddev[i] - sqr(means[i]) / count[i]; stddev[i] := stddev[i] - sqr(means[i]) / count[i];
stddev[i] := stddev[i] / (count[i] - 1); stddev[i] := stddev[i] / (count[i] - 1);
@ -247,7 +281,7 @@ begin
GrandSD := semean; GrandSD := semean;
semean := semean / sqrt(NoCases); semean := semean / sqrt(NoCases);
GrandMean := GrandMean / NoCases; GrandMean := GrandMean / NoCases;
GrandRange := GrandRange / range; GrandRange := GrandRange / numGrps;
D3Value := D3[grpsize-1]; D3Value := D3[grpsize-1];
D4Value := D4[grpsize-1]; D4Value := D4[grpsize-1];
{ {
@ -260,15 +294,15 @@ begin
UCL := D4Value * GrandRange; UCL := D4Value * GrandRange;
LCL := D3Value * GrandRange; LCL := D3Value * GrandRange;
// printed results // print results
lReport := TStringList.Create; lReport := TStringList.Create;
try try
lReport.Add('X Bar Chart Results'); lReport.Add('Range Chart Results');
lReport.Add(''); lReport.Add('');
lReport.Add('Group Size Mean Range Std.Dev.'); lReport.Add('Group Size Mean Ranges Std.Dev.');
lReport.Add('----- ---- --------- ------- --------'); lReport.Add('----- ---- -------- -------- --------');
for i := 0 to range-1 do for i := 0 to numGrps-1 do
lReport.Add(' %3d %3d %8.2f %8.2f %8.2f', [i+1, count[i], means[i], ranges[i], stddev[i]]); lReport.Add('%5d %4d %8.2f %8.2f %8.2f', [i+1, count[i], means[i], ranges[i], stddev[i]]);
lReport.Add(''); lReport.Add('');
lReport.Add('Grand Mean: %8.3f', [GrandMean]); lReport.Add('Grand Mean: %8.3f', [GrandMean]);
lReport.Add('Standard Deviation: %8.3f', [GrandSD]); lReport.Add('Standard Deviation: %8.3f', [GrandSD]);
@ -277,29 +311,66 @@ begin
lReport.Add('Lower Control Limit: %8.3f', [LCL]); lReport.Add('Lower Control Limit: %8.3f', [LCL]);
lReport.Add('Upper Control Limit: %8.3f', [UCL]); lReport.Add('Upper Control Limit: %8.3f', [UCL]);
{$IFDEF USE_TACHART}
ReportMemo.Lines.Assign(lReport);
{$ELSE}
DisplayReport(lReport); DisplayReport(lReport);
{$ENDIF}
finally finally
lReport.Free; lReport.Free;
end; end;
// show graph // show graph
PlotMeans(ranges, range, UCL, LCL, GrandRange); PlotMeans(groups, ranges, UCL, LCL, GrandRange);
// Clean up // Clean up
groups := nil;
ranges := nil; ranges := nil;
stddev := nil; stddev := nil;
count := nil; count := nil;
means := nil; means := nil;
end; end;
procedure TRChartFrm.PlotMeans(var means: DblDyneVec; NoGrps: integer; UCL, procedure TRChartFrm.PlotMeans(const Groups: StrDyneVec; const Means: DblDyneVec;
LCL, GrandMean: double); UCL, LCL, GrandMean: double);
const
CL_COLOR = clRed;
CL_STYLE = psDash;
var var
i, xpos, ypos, hleft, hright, vtop, vbottom, imagewide : integer; fn: String;
vhi, hwide, offset, strhi : integer; {$IFDEF USE_TACHART}
imagehi, maxval, minval, valincr, Yvalue : double; rightLabels: TListChartSource;
Title : string; ser: TChartSeries;
{$ELSE}
i, xpos, ypos, hleft, hright, vtop, vbottom, imagewide, NoGrps: integer;
vhi, hwide, offset, strhi: integer;
imagehi, maxval, minval, valincr, Yvalue: double;
Title: string;
{$ENDIF}
begin begin
fn := ExtractFileName(OS3MainFrm.FileNameEdit.Text);
{$IFDEF USE_TACHART}
rightLabels := FChartFrame.Chart.AxisList[2].Marks.Source as TListChartSource;
FChartFrame.Clear;
FChartFrame.SetTitle(Format('Range chart for "%s"', [fn]));
FChartFrame.SetXTitle(GroupEdit.Text);
FChartFrame.SetYTitle('Ranges of ' + MeasEdit.Text);
ser := FChartFrame.PlotXY(ptSymbols, nil, Means, Groups, nil, 'Group ranges', clBlack);
FChartFrame.Chart.BottomAxis.Marks.Source := ser.Source;
FChartFrame.Chart.BottomAxis.Marks.style := smsLabel;
FChartFrame.HorLine(GrandMean, clRed, psSolid, 'Mean range');
rightLabels.Add(GrandMean, GrandMean, 'Mean range');
FChartFrame.HorLine(UCL, CL_COLOR, CL_STYLE, 'UCL/LCL');
rightLabels.Add(UCL, UCL, 'UCL');
FChartFrame.HorLine(LCL, CL_COLOR, CL_STYLE, '');
rightLabels.Add(UCL, LCL, 'LCL');
{$ELSE}
NoGrps := Length(Groups);
maxval := -10000.0; maxval := -10000.0;
minval := 10000.0; minval := 10000.0;
for i := 0 to NoGrps-1 do for i := 0 to NoGrps-1 do
@ -311,8 +382,7 @@ begin
if LCL < minval then minval := LCL; if LCL < minval then minval := LCL;
BlankFrm.Show; BlankFrm.Show;
Title := 'RANGE CHART FOR : ' + OS3MainFrm.FileNameEdit.Text; BlankFrm.Caption := 'RANGE CHART FOR ' + fn;
BlankFrm.Caption := Title;
imagewide := BlankFrm.Image1.Width; imagewide := BlankFrm.Image1.Width;
imagehi := BlankFrm.Image1.Height; imagehi := BlankFrm.Image1.Height;
vtop := 20; vtop := 20;
@ -341,7 +411,7 @@ begin
strhi := BlankFrm.Image1.Canvas.TextHeight(Title); strhi := BlankFrm.Image1.Canvas.TextHeight(Title);
ypos := ypos - strhi div 2; ypos := ypos - strhi div 2;
BlankFrm.Image1.Canvas.Brush.Style := bsClear; BlankFrm.Image1.Canvas.Brush.Style := bsClear;
BlankFrm.Image1.Canvas.TextOut(xpos,ypos,Title); BlankFrm.Image1.Canvas.TextOut(xpos,ypos, Title);
// draw horizontal axis // draw horizontal axis
BlankFrm.Image1.Canvas.MoveTo(hleft,vbottom + 20); BlankFrm.Image1.Canvas.MoveTo(hleft,vbottom + 20);
@ -415,10 +485,8 @@ begin
strhi := BlankFrm.Image1.Canvas.TextHeight(Title); strhi := BlankFrm.Image1.Canvas.TextHeight(Title);
ypos := ypos - strhi div 2; ypos := ypos - strhi div 2;
BlankFrm.Image1.Canvas.TextOut(xpos,ypos,Title); BlankFrm.Image1.Canvas.TextOut(xpos,ypos,Title);
{$ENDIF}
end; end;
initialization
{$I rchartunit.lrs}
end. end.

10
applications/lazstats/source/forms/analysis/statistical_process_control/xbarunit.pas
View File

@ -103,6 +103,9 @@ begin
TargetChk.Checked := false; TargetChk.Checked := false;
for i := 1 to NoVariables do for i := 1 to NoVariables do
VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]); VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]);
{$IFDEF USE_TACHART}
FChartFrame.Clear;
{$ENDIF}
end; end;
procedure TXBarFrm.VarListClick(Sender: TObject); procedure TXBarFrm.VarListClick(Sender: TObject);
@ -321,6 +324,7 @@ begin
FChartFrame.Chart.Legend.SymbolWidth := Scale96ToFont(30); FChartFrame.Chart.Legend.SymbolWidth := Scale96ToFont(30);
FChartFrame.Chart.Legend.Alignment := laBottomCenter; FChartFrame.Chart.Legend.Alignment := laBottomCenter;
FChartFrame.Chart.Legend.ColumnCount := 3; FChartFrame.Chart.Legend.ColumnCount := 3;
FChartFrame.Chart.Title.TextFormat := tfHtml;
with FChartFrame.Chart.AxisList.Add do with FChartFrame.Chart.AxisList.Add do
begin begin
Alignment := calRight; Alignment := calRight;
@ -347,6 +351,7 @@ const
CL_STYLE = psDash; CL_STYLE = psDash;
SPEC_STYLE = psSolid; SPEC_STYLE = psSolid;
var var
fn: String;
{$IFDEF USE_TACHART} {$IFDEF USE_TACHART}
ser: TChartSeries; ser: TChartSeries;
rightLabels: TListChartSource; rightLabels: TListChartSource;
@ -361,11 +366,12 @@ var
title: String; title: String;
{$ENDIF} {$ENDIF}
begin begin
fn := ExtractFileName(OS3MainFrm.FileNameEdit.Text);
{$IFDEF USE_TACHART} {$IFDEF USE_TACHART}
rightLabels := FChartFrame.Chart.AxisList[2].Marks.Source as TListChartSource; rightLabels := FChartFrame.Chart.AxisList[2].Marks.Source as TListChartSource;
FChartFrame.Clear; FChartFrame.Clear;
FChartFrame.SetTitle('XBAR chart for ' + OS3MainFrm.FileNameEdit.Text, taLeftJustify); FChartFrame.SetTitle(Format('x&#772; chart for "%s"', [fn]));
FChartFrame.SetXTitle(GroupEdit.Text); FChartFrame.SetXTitle(GroupEdit.Text);
FChartFrame.SetYTitle(MeasEdit.Text); FChartFrame.SetYTitle(MeasEdit.Text);
@ -426,7 +432,7 @@ begin
if TargetSpec < minval then minval := TargetSpec; if TargetSpec < minval then minval := TargetSpec;
end; end;
BlankFrm.Caption := 'XBAR CHART FOR ' + OS3MainFrm.FileNameEdit.Text; BlankFrm.Caption := 'XBAR CHART FOR ' + fn;
imagewide := BlankFrm.Image1.Width; imagewide := BlankFrm.Image1.Width;
imagehi := BlankFrm.Image1.Height; imagehi := BlankFrm.Image1.Height;
vtop := 20; vtop := 20;