ワイブル分布
物体の強度を統計的に表すために、ワイブルによって提案された確率分布。
時間に対する、劣化や寿命を統計的に表すために広く利用されています。
m ワイブル係数(形状パラメータ)
η 尺度パラメータ
時間に対する故障率
平均値は次の計算です、Γはガンマ関数
ここでのプログラムは、確率分布、上下累積分布、下側累積値からパーセント点の計算で、平均値μ、故障率λ(t)の計算はプログラムにありません。
プログラム
unit Main;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls,
VclTee.TeeGDIPlus, VCLTee.Series, VCLTee.TeEngine, VCLTee.TeeProcs,
VCLTee.Chart, Vcl.Buttons, system.Math, system.UITypes;
type
TForm1 = class(TForm)
LabeledEdit1: TLabeledEdit;
LabeledEdit2: TLabeledEdit;
LabeledEdit3: TLabeledEdit;
LabeledEdit4: TLabeledEdit;
RadioGroup1: TRadioGroup;
BitBtn1: TBitBtn;
Memo1: TMemo;
Chart1: TChart;
Series1: TLineSeries;
Series2: TPointSeries;
Series3: TLineSeries;
Series4: TLineSeries;
procedure BitBtn1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private 宣言 }
procedure imageclear;
public
{ Public 宣言 }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
//----------------------確率密度-----------------------
// t パーセント点
// m ワイブル係数
// n 尺度係数
//-----------------------------------------------------
function probability_densyty(t, m, n: double):double;
var
tsn : double;
begin
tsn := t / n;
result := m / n * power(tsn, m - 1) * exp(-power(tsn, m));
end;
//-------------------下側累積確率--------------------
// t パーセント点
// m ワイブル係数
// n 尺度係数
//-----------------------------------------------------
function lower_cumulative(t, m, n: double):double;
var
tsn : double;
begin
tsn := t / n;
result := 1 - exp(-power(tsn, m));
end;
//-------------------上側累積確率--------------------
// t パーセント点
// m ワイブル係数
// n 尺度係数
//-----------------------------------------------------
function upper_cumulative(t, m, n: double):double;
var
tsn : double;
begin
tsn := t / n;
result := exp(-power(tsn, m));
end;
//-------------------逆下側累積確率------------------
// p 下側累積確率
// m ワイブル係数
// n 尺度係数
//-----------------------------------------------------
function Inverse_lower_cumulative(p, m, n: double): double;
var
q: double;
lnp: double;
begin
if p >= 1 then begin
result := infinity;
exit;
end;
q := 1 - p;
lnp := ln(q);
result := exp(ln(-lnp * power(n, m)) / m);
end;
//-------グラフバックグラウンド消去-------
procedure TForm1.imageclear;
begin
with Chart1.BackImage.Bitmap.Canvas do begin
Brush.Color := clWhite;
Brush.Style := bsSolid;
FillRect(Rect(0, 0, Chart1.Width, Chart1.Height));
Font.Size := 11;
end;
end;
//----- 計算 グラフ描画-------
procedure TForm1.BitBtn1Click(Sender: TObject);
const
c = 200;
var
t, m, n, p: double;
i : integer;
f, pl, q, tl, ft: double;
max, dx, x, d: double;
col : Tcolor;
begin
val(LabeledEdit1.Text, m, i);
if i <> 0 then begin
MessageDlg('mの値に間違いがあります。', mtInformation,
[mbOk], 0, mbOk);
exit;
end;
if m <= 0 then begin
MessageDlg('mの値が範囲外です。', mtInformation,
[mbOk], 0, mbOk);
exit;
end;
val(LabeledEdit2.Text, n, i);
if i <> 0 then begin
MessageDlg('ηの値に間違いがあります。', mtInformation,
[mbOk], 0, mbOk);
exit;
end;
if n <= 0 then begin
MessageDlg('ηの値が範囲外です。', mtInformation,
[mbOk], 0, mbOk);
exit;
end;
val(LabeledEdit3.Text, t, i);
if i <> 0 then begin
MessageDlg('tの値に間違いがあります。', mtInformation,
[mbOk], 0, mbOk);
exit;
end;
if t < 0 then begin
MessageDlg('tの値が範囲外です。', mtInformation,
[mbOk], 0, mbOk);
exit;
end;
val(LabeledEdit4.Text, p, i);
if i <> 0 then begin
MessageDlg('pの値に間違いがあります。', mtInformation,
[mbOk], 0, mbOk);
exit;
end;
if (p < 0) or (p > 1) then begin
MessageDlg('pの値が範囲外です。', mtInformation,
[mbOk], 0, mbOk);
exit;
end;
memo1.Clear;
f := probability_densyty(t, m, n); // 確率密度
pl := lower_cumulative(t, m, n); // 下側累積確率
q := upper_cumulative(t, m, n); // 上側累積確率
tl := Inverse_lower_cumulative(p, m, n); // 逆下側累積確率
memo1.Lines.Add('確率密度(パーセント点 t=' + floatTostr(t) + ')');
memo1.Lines.Add(' f(t)=' + floatTostr(f));
memo1.Lines.Add(' 下側累積確率 F(t)=' + floatTostr(pl));
memo1.Lines.Add(' 上側累積確率 R(t)=' + floatTostr(q));
memo1.Lines.Add('パーセント点(下側累積確率 P=' + floatTostr(p) + ')');
memo1.Lines.Text := memo1.Lines.Text + ' t=' + floatTostr(tl);
Series1.Clear;
Series2.Clear;
Series3.Clear;
Series4.Clear;
imageclear;
if RadioGroup1.ItemIndex = 0 then begin
Series3.LinePen.Width := 1;
max := 5;
if t > max - 1 then max := round(t) + 1;
dx := max / c;
for i := 0 to c do begin
x := dx * i;
d := probability_densyty(x, m, n);
if x <= t then col := clRed else col := clblue;
Series1.AddXY(x, d,'', col);
Series3.AddXY(x, 0,'', col);
Series3.AddXY(x, d,'', col);
Series3.AddXY(x, 0,'', col);
end;
Series2.AddXY(t, f);
end;
if RadioGroup1.ItemIndex = 1 then begin
max := 4;
if t > max - 1 then max := round(t) + 1;
dx := max / c;
for i := 0 to c do begin
x := dx * i;
d := lower_cumulative(x, m, n);
Series1.AddXY(x, d, '', clred);
d := upper_cumulative(x, m, n);
Series4.AddXY(x, d, '', clBlue);
end;
with Chart1.BackImage.Bitmap.Canvas do begin
Font.Color := clRed;
TextOut(150,100,'赤 下側累積確率');
Font.Color := clBlue;
TextOut(150,120,'青 上側累積確率');
end;
application.ProcessMessages;
Series3.LinePen.Width := 3;
Series3.AddXY(t, 0,'', clBlack);
Series3.AddXY(t, Chart1.LeftAxis.Maximum,'', clBlack);
end;
if RadioGroup1.ItemIndex = 2 then begin
Series3.LinePen.Width := 1;
if p >= 1 then begin
with Chart1.BackImage.Bitmap.Canvas do begin
Font.Color := clBlack;
TextOut(100,60,'下側累積確率 P = 1');
TextOut(110,80,'パーセント点 t= 無限大');
exit;
end;
end;
ft := probability_densyty(tl, m, n);
max := 2;
if tl > max - 1 then max := round(tl) + 1;
dx := max / c;
for i := 0 to c do begin
x := dx * i;
d := probability_densyty(x, m, n);
if x <= tl then col := clRed else col := clblue;
Series1.AddXY(x, d,'', col);
Series3.AddXY(x, 0,'', col);
Series3.AddXY(x, d,'', col);
Series3.AddXY(x, 0,'', col);
end;
Series2.AddXY(tl, ft);
end;
end;
// 初期設定
procedure TForm1.FormCreate(Sender: TObject);
begin
memo1.Clear;
memo1.Lines.Append('ワイブル分布計算');
LabeledEdit4.EditLabel.Caption := '1 ≧ P ≧ 0' + #13#10 + '下側累積確率';
Chart1.BackImage.Bitmap.Width := Chart1.Width;
Chart1.BackImage.Bitmap.Height := Chart1.Height;
end;
end.
Weibull_Density.zip