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

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

@ -1,180 +1,89 @@
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 = 8
Height = 25
Top = 264
Width = 366
Align = alBottom
AutoSize = True
BorderSpacing.Around = 8
BevelOuter = bvNone
ClientHeight = 25
ClientWidth = 366
TabOrder = 1
object ResetBtn: TButton
AnchorSideLeft.Control = Panel1
AnchorSideTop.Control = Panel1
AnchorSideRight.Control = ComputeBtn
Left = 165
Height = 25
Top = 0
Width = 54
Anchors = [akTop, akRight]
AutoSize = True
BorderSpacing.Right = 8
Caption = 'Reset'
OnClick = ResetBtnClick
TabOrder = 1
end
object ComputeBtn: TButton
AnchorSideLeft.Control = Panel1
AnchorSideTop.Control = Panel1
AnchorSideRight.Control = CloseBtn
Left = 227
Height = 25
Top = 0
Width = 76
Anchors = [akTop, akRight]
AutoSize = True
BorderSpacing.Right = 8
Caption = 'Compute'
OnClick = ComputeBtnClick
TabOrder = 2
end
object HelpBtn: TButton
Tag = 141
AnchorSideLeft.Control = Panel1
AnchorSideTop.Control = ResetBtn
AnchorSideRight.Control = ResetBtn
Left = 106
Height = 25
Top = 0
Width = 51
Anchors = [akTop, akRight]
AutoSize = True
BorderSpacing.Right = 8
Caption = 'Help'
OnClick = HelpBtnClick
TabOrder = 0
end
object CloseBtn: TButton
AnchorSideLeft.Control = Panel1
AnchorSideTop.Control = Panel1
AnchorSideRight.Control = Panel1
AnchorSideRight.Side = asrBottom
Left = 311
Height = 25
Top = 0
Width = 55
Anchors = [akTop, akRight]
AutoSize = True
Caption = 'Close'
ModalResult = 11
TabOrder = 3
end
end
object Panel4: TPanel
Left = 0 Left = 0
Height = 256 Height = 476
Top = 0 Top = 0
Width = 382 Width = 378
Align = alClient Align = alLeft
Anchors = [akTop, akLeft, akRight]
BevelOuter = bvNone BevelOuter = bvNone
ClientHeight = 256 ClientHeight = 476
ClientWidth = 382 ClientWidth = 378
TabOrder = 0 TabOrder = 0
object Bevel1: TBevel object GroupLabel: TLabel
AnchorSideLeft.Control = Panel4 AnchorSideLeft.Control = GroupEdit
AnchorSideLeft.Side = asrCenter AnchorSideTop.Control = SpecsPanel
Left = 156 Left = 222
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 Height = 15
Top = 8 Top = 8
Width = 77 Width = 77
BorderSpacing.Left = 8
BorderSpacing.Top = 8 BorderSpacing.Top = 8
Caption = 'Group Variable' Caption = 'Group Variable'
ParentColor = False ParentColor = False
end end
object Label3: TLabel object MeasLabel: TLabel
AnchorSideLeft.Control = Bevel1 AnchorSideLeft.Control = MeasEdit
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = GroupEdit AnchorSideTop.Control = GroupEdit
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
Left = 235 Left = 222
Height = 15 Height = 15
Top = 64 Top = 64
Width = 117 Width = 117
BorderSpacing.Left = 8
BorderSpacing.Top = 16 BorderSpacing.Top = 16
Caption = 'Measurement Variable' Caption = 'Measurement Variable'
ParentColor = False ParentColor = False
end end
object GroupEdit: TEdit object GroupEdit: TEdit
AnchorSideLeft.Control = Bevel1 AnchorSideLeft.Control = CenterBevel
AnchorSideLeft.Side = asrBottom AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = Label2 AnchorSideTop.Control = GroupLabel
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = Panel4 AnchorSideRight.Control = SpecsPanel
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
Left = 235 Left = 222
Height = 23 Height = 23
Top = 25 Top = 25
Width = 139 Width = 156
Anchors = [akTop, akLeft, akRight] Anchors = [akTop, akLeft, akRight]
BorderSpacing.Left = 8 BorderSpacing.Left = 8
BorderSpacing.Top = 2 BorderSpacing.Top = 2
BorderSpacing.Right = 8
TabOrder = 1 TabOrder = 1
Text = 'GroupEdit' Text = 'GroupEdit'
end end
object MeasEdit: TEdit object MeasEdit: TEdit
AnchorSideLeft.Control = Bevel1 AnchorSideLeft.Control = CenterBevel
AnchorSideLeft.Side = asrBottom AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = Label3 AnchorSideTop.Control = MeasLabel
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = Panel4 AnchorSideRight.Control = SpecsPanel
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
Left = 235 Left = 222
Height = 23 Height = 23
Top = 81 Top = 81
Width = 139 Width = 156
Anchors = [akTop, akLeft, akRight] Anchors = [akTop, akLeft, akRight]
BorderSpacing.Left = 8 BorderSpacing.Left = 8
BorderSpacing.Top = 2 BorderSpacing.Top = 2
BorderSpacing.Right = 8
TabOrder = 2 TabOrder = 2
Text = 'MeasEdit' Text = 'MeasEdit'
end end
object Label1: TLabel object VarListLabel: TLabel
AnchorSideLeft.Control = Panel4 AnchorSideLeft.Control = SpecsPanel
AnchorSideTop.Control = Panel4 AnchorSideTop.Control = SpecsPanel
Left = 8 Left = 8
Height = 15 Height = 15
Top = 8 Top = 8
@ -185,38 +94,166 @@ object RChartFrm: TRChartFrm
ParentColor = False ParentColor = False
end end
object VarList: TListBox object VarList: TListBox
AnchorSideLeft.Control = Panel4 AnchorSideLeft.Control = SpecsPanel
AnchorSideTop.Control = Label1 AnchorSideTop.Control = VarListLabel
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = Bevel1 AnchorSideRight.Control = CenterBevel
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = Panel4 AnchorSideBottom.Control = ButtonBevel
AnchorSideBottom.Side = asrBottom
Left = 8 Left = 8
Height = 223 Height = 402
Top = 25 Top = 25
Width = 219 Width = 206
Anchors = [akTop, akLeft, akRight, akBottom] Anchors = [akTop, akLeft, akRight, akBottom]
BorderSpacing.Left = 8 BorderSpacing.Left = 8
BorderSpacing.Top = 2 BorderSpacing.Top = 2
BorderSpacing.Bottom = 8
Constraints.MinHeight = 220
ItemHeight = 0 ItemHeight = 0
OnClick = VarListClick OnClick = VarListClick
TabOrder = 0 TabOrder = 0
end end
object ButtonPanel: TPanel
AnchorSideLeft.Control = SpecsPanel
AnchorSideRight.Control = SpecsPanel
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = SpecsPanel
Left = 0
Height = 25
Top = 443
Width = 378
Align = alBottom
AutoSize = True
BorderSpacing.Top = 8
BorderSpacing.Bottom = 8
BevelOuter = bvNone
ClientHeight = 25
ClientWidth = 378
TabOrder = 3
object ResetBtn: TButton
AnchorSideLeft.Control = ButtonPanel
AnchorSideTop.Control = ButtonPanel
AnchorSideRight.Control = ComputeBtn
Left = 177
Height = 25
Top = 0
Width = 54
Anchors = [akTop, akRight]
AutoSize = True
BorderSpacing.Right = 8
Caption = 'Reset'
OnClick = ResetBtnClick
TabOrder = 1
end
object ComputeBtn: TButton
AnchorSideLeft.Control = ButtonPanel
AnchorSideTop.Control = ButtonPanel
AnchorSideRight.Control = CloseBtn
Left = 239
Height = 25
Top = 0
Width = 76
Anchors = [akTop, akRight]
AutoSize = True
BorderSpacing.Right = 8
Caption = 'Compute'
OnClick = ComputeBtnClick
TabOrder = 2
end
object HelpBtn: TButton
Tag = 141
AnchorSideLeft.Control = ButtonPanel
AnchorSideTop.Control = ResetBtn
AnchorSideRight.Control = ResetBtn
Left = 118
Height = 25
Top = 0
Width = 51
Anchors = [akTop, akRight]
AutoSize = True
BorderSpacing.Left = 8
BorderSpacing.Right = 8
Caption = 'Help'
OnClick = HelpBtnClick
TabOrder = 0
end
object CloseBtn: TButton
AnchorSideLeft.Control = ButtonPanel
AnchorSideTop.Control = ButtonPanel
AnchorSideRight.Control = ButtonPanel
AnchorSideRight.Side = asrBottom
Left = 323
Height = 25
Top = 0
Width = 55
Anchors = [akTop, akRight]
AutoSize = True
Caption = 'Close'
ModalResult = 11
TabOrder = 3
end
end
object ButtonBevel: TBevel
AnchorSideLeft.Control = SpecsPanel
AnchorSideTop.Control = ButtonPanel
AnchorSideRight.Control = SpecsPanel
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = ButtonPanel
Left = 0
Height = 8
Top = 427
Width = 378
Anchors = [akLeft, akRight, akBottom]
Shape = bsBottomLine
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 end
object Bevel2: TBevel object Splitter1: TSplitter
AnchorSideLeft.Control = Panel4 Left = 378
AnchorSideTop.Control = Panel1 Height = 476
AnchorSideRight.Control = Owner Top = 0
AnchorSideRight.Side = asrBottom Width = 5
AnchorSideBottom.Control = Panel1 ResizeStyle = rsPattern
Left = 0 end
Height = 8 object PageControl1: TPageControl
Top = 248 Left = 385
Width = 382 Height = 460
Anchors = [akLeft, akRight, akBottom] Top = 8
Shape = bsBottomLine 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 end

448
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);
if BlankFrm = nil then {$IFDEF USE_TACHART}
Application.CreateForm(TBlankfrm, BlankFrm); 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
Application.CreateForm(TBlankFrm, BlankFrm);
{$ENDIF}
end; end;
procedure TRChartFrm.FormShow(Sender: TObject); procedure TRChartFrm.FormShow(Sender: TObject);
@ -126,16 +159,21 @@ 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;
cellstring: string; groups: StrDyneVec = nil;
sizeError : boolean; means: DblDyneVec = nil;
lReport: TStrings; stddev: DblDyneVec = nil;
ranges: DblDyneVec = nil;
count: IntDyneVec;
cellstring: string;
sizeError: boolean;
lReport: TStrings;
const const
D3: array[1..24] of double = ( D3: array[1..24] of double = (
0,0,0,0,0,0.076,0.136,0.184,0.223,0.256,0.283,0.307,0.328, 0,0,0,0,0,0.076,0.136,0.184,0.223,0.256,0.283,0.307,0.328,
@ -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; begin
groups[numGrps] := grp;
inc(numGrps);
end;
end; end;
range := maxgrp - mingrp + 1;
SetLength(means,range); SetLength(groups, numGrps);
SetLength(count,range); SetLength(means, numGrps);
SetLength(stddev,range); SetLength(count, numGrps);
SetLength(ranges,range); SetLength(stddev, numGrps);
SetLength(ranges, numGrps);
for i := 0 to range-1 do
begin
count[i] := 0;
means[i] := 0.0;
stddev[i] := 0.0;
ranges[i] := 0.0;
end;
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,148 +311,182 @@ 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
maxval := -10000.0; fn := ExtractFileName(OS3MainFrm.FileNameEdit.Text);
minval := 10000.0; {$IFDEF USE_TACHART}
for i := 0 to NoGrps-1 do rightLabels := FChartFrame.Chart.AxisList[2].Marks.Source as TListChartSource;
begin
if means[i] > maxval then maxval := means[i];
if means[i] < minval then minval := means[i];
end;
if UCL > maxval then maxval := UCL;
if LCL < minval then minval := LCL;
BlankFrm.Show; FChartFrame.Clear;
Title := 'RANGE CHART FOR : ' + OS3MainFrm.FileNameEdit.Text; FChartFrame.SetTitle(Format('Range chart for "%s"', [fn]));
BlankFrm.Caption := Title; FChartFrame.SetXTitle(GroupEdit.Text);
imagewide := BlankFrm.Image1.Width; FChartFrame.SetYTitle('Ranges of ' + MeasEdit.Text);
imagehi := BlankFrm.Image1.Height;
vtop := 20;
vbottom := round(imagehi) - 80;
vhi := vbottom - vtop;
hleft := 100;
hright := imagewide - 80;
hwide := hright - hleft;
BlankFrm.Image1.Canvas.Brush.Color := clLtGray;
BlankFrm.Image1.Canvas.FillRect(0, 0, BlankFrm.Image1.Width, BlankFrm.Image1.Height);
// Draw chart border ser := FChartFrame.PlotXY(ptSymbols, nil, Means, Groups, nil, 'Group ranges', clBlack);
BlankFrm.Image1.Canvas.Pen.Color := clBlack; FChartFrame.Chart.BottomAxis.Marks.Source := ser.Source;
BlankFrm.Image1.Canvas.Brush.Color := clWhite; FChartFrame.Chart.BottomAxis.Marks.style := smsLabel;
BlankFrm.Image1.Canvas.Rectangle(hleft,vtop-10,hleft+hwide,vtop+vhi+10);
// draw Grand Mean FChartFrame.HorLine(GrandMean, clRed, psSolid, 'Mean range');
ypos := round(vhi * ( (maxval - GrandMean) / (maxval - minval))); rightLabels.Add(GrandMean, GrandMean, 'Mean range');
ypos := ypos + vtop;
xpos := hleft;
BlankFrm.Image1.Canvas.MoveTo(xpos,ypos);
xpos := hright;
BlankFrm.Image1.Canvas.Pen.Color := clRed;
BlankFrm.Image1.Canvas.LineTo(xpos,ypos);
Title := 'MEAN';
strhi := BlankFrm.Image1.Canvas.TextHeight(Title);
ypos := ypos - strhi div 2;
BlankFrm.Image1.Canvas.Brush.Style := bsClear;
BlankFrm.Image1.Canvas.TextOut(xpos,ypos,Title);
// draw horizontal axis FChartFrame.HorLine(UCL, CL_COLOR, CL_STYLE, 'UCL/LCL');
BlankFrm.Image1.Canvas.MoveTo(hleft,vbottom + 20); rightLabels.Add(UCL, UCL, 'UCL');
BlankFrm.Image1.Canvas.LineTo(hright,vbottom + 20);
for i := 1 to NoGrps do
begin
ypos := vbottom + 10;
xpos := round((hwide / NoGrps)* i + hleft);
BlankFrm.Image1.Canvas.MoveTo(xpos,ypos);
ypos := ypos + 10;
BlankFrm.Image1.Canvas.LineTo(xpos,ypos);
Title := format('%d',[i]);
offset := BlankFrm.Image1.Canvas.TextWidth(Title) div 2;
strhi := BlankFrm.Image1.Canvas.TextHeight(Title);
xpos := xpos - offset;
ypos := ypos + strhi;
BlankFrm.Image1.Canvas.Pen.Color := clBlack;
BlankFrm.Image1.Canvas.TextOut(xpos,ypos,Title);
xpos := 10;
BlankFrm.Image1.Canvas.TextOut(xpos,ypos,'GROUPS:');
end;
// Draw vertical axis FChartFrame.HorLine(LCL, CL_COLOR, CL_STYLE, '');
valincr := (maxval - minval) / 10.0; rightLabels.Add(UCL, LCL, 'LCL');
for i := 1 to 11 do {$ELSE}
begin NoGrps := Length(Groups);
Title := format('%8.2f',[maxval - ((i-1)*valincr)]); maxval := -10000.0;
strhi := BlankFrm.Image1.Canvas.TextHeight(Title); minval := 10000.0;
xpos := 10; for i := 0 to NoGrps-1 do
Yvalue := maxval - (valincr * (i-1)); begin
ypos := round(vhi * ( (maxval - Yvalue) / (maxval - minval))); if means[i] > maxval then maxval := means[i];
ypos := ypos + vtop - strhi div 2; if means[i] < minval then minval := means[i];
BlankFrm.Image1.Canvas.TextOut(xpos,ypos,Title); end;
end; if UCL > maxval then maxval := UCL;
if LCL < minval then minval := LCL;
// draw lines for means of the groups BlankFrm.Show;
ypos := round(vhi * ( (maxval - means[0]) / (maxval - minval))); BlankFrm.Caption := 'RANGE CHART FOR ' + fn;
ypos := ypos + vtop; imagewide := BlankFrm.Image1.Width;
xpos := round((hwide / NoGrps) + hleft); imagehi := BlankFrm.Image1.Height;
BlankFrm.Image1.Canvas.MoveTo(xpos,ypos); vtop := 20;
BlankFrm.Image1.Canvas.Pen.Color := clBlack; vbottom := round(imagehi) - 80;
for i := 2 to NoGrps do vhi := vbottom - vtop;
begin hleft := 100;
ypos := round(vhi * ( (maxval - means[i-1]) / (maxval - minval))); hright := imagewide - 80;
ypos := ypos + vtop; hwide := hright - hleft;
xpos := round((hwide / NoGrps)* i + hleft); BlankFrm.Image1.Canvas.Brush.Color := clLtGray;
BlankFrm.Image1.Canvas.LineTo(xpos,ypos); BlankFrm.Image1.Canvas.FillRect(0, 0, BlankFrm.Image1.Width, BlankFrm.Image1.Height);
end;
// Draw upper and lower confidence intervals // Draw chart border
ypos := round(vhi * ( (maxval - UCL) / (maxval - minval))); BlankFrm.Image1.Canvas.Pen.Color := clBlack;
ypos := ypos + vtop; BlankFrm.Image1.Canvas.Brush.Color := clWhite;
xpos := hleft; BlankFrm.Image1.Canvas.Rectangle(hleft,vtop-10,hleft+hwide,vtop+vhi+10);
BlankFrm.Image1.Canvas.MoveTo(xpos,ypos);
xpos := hright;
BlankFrm.Image1.Canvas.Pen.Color := clRed;
BlankFrm.Image1.Canvas.LineTo(xpos,ypos);
Title := 'UCL';
strhi := BlankFrm.Image1.Canvas.TextHeight(Title);
ypos := ypos - strhi div 2;
BlankFrm.Image1.Canvas.TextOut(xpos,ypos,Title);
ypos := round(vhi * ( (maxval - LCL) / (maxval - minval))); // draw Grand Mean
ypos := ypos + vtop; ypos := round(vhi * ( (maxval - GrandMean) / (maxval - minval)));
xpos := hleft; ypos := ypos + vtop;
BlankFrm.Image1.Canvas.MoveTo(xpos,ypos); xpos := hleft;
xpos := hright; BlankFrm.Image1.Canvas.MoveTo(xpos,ypos);
BlankFrm.Image1.Canvas.Pen.Color := clRed; xpos := hright;
BlankFrm.Image1.Canvas.LineTo(xpos,ypos); BlankFrm.Image1.Canvas.Pen.Color := clRed;
Title := 'LCL'; BlankFrm.Image1.Canvas.LineTo(xpos,ypos);
strhi := BlankFrm.Image1.Canvas.TextHeight(Title); Title := 'MEAN';
ypos := ypos - strhi div 2; strhi := BlankFrm.Image1.Canvas.TextHeight(Title);
BlankFrm.Image1.Canvas.TextOut(xpos,ypos,Title); ypos := ypos - strhi div 2;
BlankFrm.Image1.Canvas.Brush.Style := bsClear;
BlankFrm.Image1.Canvas.TextOut(xpos,ypos, Title);
// draw horizontal axis
BlankFrm.Image1.Canvas.MoveTo(hleft,vbottom + 20);
BlankFrm.Image1.Canvas.LineTo(hright,vbottom + 20);
for i := 1 to NoGrps do
begin
ypos := vbottom + 10;
xpos := round((hwide / NoGrps)* i + hleft);
BlankFrm.Image1.Canvas.MoveTo(xpos,ypos);
ypos := ypos + 10;
BlankFrm.Image1.Canvas.LineTo(xpos,ypos);
Title := format('%d',[i]);
offset := BlankFrm.Image1.Canvas.TextWidth(Title) div 2;
strhi := BlankFrm.Image1.Canvas.TextHeight(Title);
xpos := xpos - offset;
ypos := ypos + strhi;
BlankFrm.Image1.Canvas.Pen.Color := clBlack;
BlankFrm.Image1.Canvas.TextOut(xpos,ypos,Title);
xpos := 10;
BlankFrm.Image1.Canvas.TextOut(xpos,ypos,'GROUPS:');
end;
// Draw vertical axis
valincr := (maxval - minval) / 10.0;
for i := 1 to 11 do
begin
Title := format('%8.2f',[maxval - ((i-1)*valincr)]);
strhi := BlankFrm.Image1.Canvas.TextHeight(Title);
xpos := 10;
Yvalue := maxval - (valincr * (i-1));
ypos := round(vhi * ( (maxval - Yvalue) / (maxval - minval)));
ypos := ypos + vtop - strhi div 2;
BlankFrm.Image1.Canvas.TextOut(xpos,ypos,Title);
end;
// draw lines for means of the groups
ypos := round(vhi * ( (maxval - means[0]) / (maxval - minval)));
ypos := ypos + vtop;
xpos := round((hwide / NoGrps) + hleft);
BlankFrm.Image1.Canvas.MoveTo(xpos,ypos);
BlankFrm.Image1.Canvas.Pen.Color := clBlack;
for i := 2 to NoGrps do
begin
ypos := round(vhi * ( (maxval - means[i-1]) / (maxval - minval)));
ypos := ypos + vtop;
xpos := round((hwide / NoGrps)* i + hleft);
BlankFrm.Image1.Canvas.LineTo(xpos,ypos);
end;
// Draw upper and lower confidence intervals
ypos := round(vhi * ( (maxval - UCL) / (maxval - minval)));
ypos := ypos + vtop;
xpos := hleft;
BlankFrm.Image1.Canvas.MoveTo(xpos,ypos);
xpos := hright;
BlankFrm.Image1.Canvas.Pen.Color := clRed;
BlankFrm.Image1.Canvas.LineTo(xpos,ypos);
Title := 'UCL';
strhi := BlankFrm.Image1.Canvas.TextHeight(Title);
ypos := ypos - strhi div 2;
BlankFrm.Image1.Canvas.TextOut(xpos,ypos,Title);
ypos := round(vhi * ( (maxval - LCL) / (maxval - minval)));
ypos := ypos + vtop;
xpos := hleft;
BlankFrm.Image1.Canvas.MoveTo(xpos,ypos);
xpos := hright;
BlankFrm.Image1.Canvas.Pen.Color := clRed;
BlankFrm.Image1.Canvas.LineTo(xpos,ypos);
Title := 'LCL';
strhi := BlankFrm.Image1.Canvas.TextHeight(Title);
ypos := ypos - strhi div 2;
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;