unit pTForecastModel;
interface
uses
Windows, Classes, SysUtils, Forms, Controls, Graphics,
Menus, Dialogs, ComCtrls,
DB, Variants, PPUBPAS, vgctrl40_TLB,
Messages,
StdCtrls, ExtCtrls;
{
功能:负荷预测
作者:张世平
时间:2005年6月6日-2005-8-23
基类:TForecastModel
分别提供了2个方法:回归分析法 TRegression
相似日法外推法 Tsimilitude
}//TLeastSquarFit
type
TForecastModel = class
private
ForecastDate: tdatetime;
N: integer;
X: array[1..365 * 10] of double; //前n天,每天的平均数
dtP1: DOUBLE; //用最小二乘法拟合曲线求出△P1
l_array: array[1..itWidth + 1] of double; //负荷预测的结果
lastDate: string; //最近一天 日期
lastDatePJ: double; //最近一天 的平均数
function LoadData(): boolean; virtual; abstract;
function Load_pj_Data(): boolean; //本单元两个方法都需要装载前n 天平均数,装载后放在x[]中
public
constructor Create(LForecastDate: tdatetime; LhistoryN: integer); //构造函
// ForecastDate:string 预测未来日期
// historyN:integer:预测根据 ForecastDate 前 historyN天的数据
function Execute(): boolean; virtual; abstract;
function save(dDate: tdatetime): boolean;
end;
TRegression = class(TForecastModel)
private
z: array[1..365 * 2, 1..itWidth + 1] of double; //原始数据
s: array[1..365 * 2, 1..itWidth + 1] of double; //存储变化系数
protected
function LoadData(): boolean; override;
procedure Set_s;
procedure Set_s_of_N_add_1;
procedure calc_result();
public
function Execute(): boolean; override;
end;
tSimilitude = class(TForecastModel)
private
function LoadData(): boolean; override;
public
function Execute(): boolean; override;
end;
var AForecastModel: TForecastModel;
VGMaxValue, vgMinValue: double;
function do_Forecast(tmpDate, TmpDateTo: tdate; n: integer; ForecastWay: integer; sbrExplorer: TStatusBar; ProgressBar1: tProgressBar): boolean;
function bForecastBefore_CheckDate(DateTimePicker1, DateTimePicker2: tDateTimePicker; edit1: tedit): boolean;
function bForecastBefore_LoadCookies(DateTimePicker1, DateTimePicker2, DateTimePicker3: tDateTimePicker; edit1: tedit): boolean;
procedure show_vbgraph(fdate: string; vgctrl1: Tvgctrl);
function Load_VGLineColor(): boolean;
function Load_VGDate(fdate: string): boolean;
procedure Print__ForecastRepor(fdate: string);
function ImportData(StatusBar: tStatusBar; ProgressBar1: TProgressBar; fromdate, todate: tdate): boolean;
function IsHoliday(fdate: tdate): boolean;
implementation
uses Pdm, PCOMM;
function IsHoliday(fdate: tdate): boolean;
begin
result := false;
dm.sq := 'select dbo.IsHoliday(' + #39 + fdt(fdate) + #39 + ') as a';
dm.Open_SQ();
if dm.gfi('a') = 1 then result := true;
end;
function ImportData(StatusBar: tStatusBar; ProgressBar1: TProgressBar; fromdate, todate: tdate): boolean;
var tmp: string;
begin
result := false;
if fromdate > todate then
begin
msg('导入的时间前后关系不正确...');
exit;
end;
StatusBar.Panels.Items[1].Text := '正在尝试连接ORACLE...';
StatusBar.Update;
try
dm.OracleADOConnection2.Open;
except
msg('ORACLE连接错误...');
end;
StatusBar.Panels.Items[1].Text := '正在从ORACLE查询数据...';
StatusBar.Update;
dm.sq := 'select YCVALUE,SAVETIME from HISTORYYCTABLE where STATIONORDERCODE=28 ';
dm.sq := dm.sq + ' and YCORDER=0 and savetime >=to_date(' + #39 + fdt(fromDate) + #39 + ',' + #39 + 'yyyy-MM-dd' + #39 + ')';
dm.sq := dm.sq + ' and savetime<=to_date(' + #39 + fdt(todate + 1) + #39 + ',' + #39 + 'yyyy-MM-dd' + #39 + ')';
dm.sq := dm.sq + ' order by SAVETIME';
DM.ORACLEQ1.Close;
DM.ORACLEQ1.SQL.Clear;
DM.ORACLEQ1.SQL.Add(dm.sq);
DM.ORACLEQ1.Open;
StatusBar.Panels.Items[1].Text := '开始导入查询数据...';
StatusBar.Update;
ProgressBar1.Visible := true;
ProgressBar1.Min := 0;
ProgressBar1.Max := DM.ORACLEQ1.RECORDCOUNT;
ProgressBar1.Position := 0;
while not DM.ORACLEQ1.Eof do
begin
tmp := DM.ORACLEQ1.fieldbyname('savetime').asstring;
dm.sq := 'select * from t_sysdata where fdate=' + #39 + tmp + #39;
dm.Open_SQ;
if not dm.Eof then
begin
if ask(tmp + '数据已经存在,是否覆盖...') then
begin
dm.sq := 'delete from t_sysdata where fdate=' + #39 + tmp + #39 + ' and iflag=' + inttostr(Forecast_1SCADA);
dm.Exe_SQ;
DM.sq := 'INSERT INTO T_SysData (FDATE,NVALUE,iFlag) VALUES (%S,%S,%s)';
DM.SQ := FORMAT(DM.SQ, [#39 + tmp + #39, DM.ORACLEQ1.FIELDBYNAME('YCVALUE').AsString, inttostr(Forecast_1SCADA)]);
DM.Exe_SQ;
end;
end
else
begin
DM.sq := 'INSERT INTO T_SysData (FDATE,NVALUE,iFlag) VALUES (%S,%S,%s)';
DM.SQ := FORMAT(DM.SQ, [#39 + tmp + #39, DM.ORACLEQ1.FIELDBYNAME('YCVALUE').AsString, inttostr(Forecast_1SCADA)]);
DM.Exe_SQ;
end;
DM.ORACLEQ1.Next;
ProgressBar1.Position := ProgressBar1.Position + 1;
end;
ProgressBar1.Visible := false;
StatusBar.Panels.Items[1].Text := '导入查询数据完成...';
StatusBar.Update;
result := true;
end;
function Load_VGLineColor(): boolean;
var i: integer;
begin
result := false;
dm.sq := 'select top ' + inttostr(itVGLineCout) + ' * from t_color order by 曲线';
dm.Open_SQ;
if dm.RecordCount <> itVGLineCout then
begin
msg('请为曲线进行正确配色...');
exit;
end;
i := 1;
while not dm.Eof do
begin
VGLineColor
:= dm.gfs('曲线颜色');
dm.Next;
inc(i);
end;
result := false;
end;
function Load_VGDate(fdate: string): boolean;
var i: integer;
begin
result := false;
for i := 1 to itWidth do
begin
t_array_1SCADA := 0;
t_array_3Result := 0;
end;
dm.sq := 'select * from T_SYSDATA where DBO.MYDATE(fdate)=' + eFDT(fdate) + ' AND IFLAG=DBO.FLAGSCADA() ORDER BY IINDEX';
dm.Open_SQ;
while not DM.EOF do
begin
t_array_1SCADA[DM.GFI('IINDEX')+1] := dm.gfn('NVALUE');
DM.Next;
end;
dm.sq := 'exec P_GetResult ' + eFdt(fdate);
dm.Open_SQ;
//----这里还要加上cai
while not DM.EOF do
begin
t_array_3Result[DM.GFI('IINDEX')+1] := dm.gfn('NVALUE');
DM.Next;
end;
dm.sq := 'exec P_GetResult_MinMax ' + eFdt(fdate);
dm.Open_SQ;
if DM.EOF then
begin
msg('error');
exit;
end;
VGMaxValue := dm.GFN('smax');
vgMinValue := dm.GFN('smin');
result := true;
end;
procedure show_vbgraph(fdate: string; vgctrl1: Tvgctrl);
var
i: Integer;
s: string;
begin
Load_VGLineColor();
if not Load_VGDate(fdate) then begin msg('装载数据错误,原因未知!'); exit; end;
vgctrl1.Run('MYline.tbl');
vgctrl1.BackColor := rgb(46, 46, 46);
vgctrl1.Execute(WideString('Activesheet.曲线图1.ymax=' + floattostr(VGMaxValue) + ';'));
vgctrl1.Execute(WideString('Activesheet.曲线图1.ymin=' + floattostr(VGMinValue) + ';'));
vgctrl1.Execute(WideString('ZoomFit()'));
// vgctrl1.Execute(WideString('Activesheet.曲线图1.plotColor=red;'));
vgctrl1.Execute(WideString('Activesheet.text1.text=' + #39 + fdate + #39 + ';'));
//vgctrl1.Execute(WideString('Activesheet.曲线图1.plotindex='+IntToStr(AIndex)));
for i := 1 to itWidth do
begin
s := ' Activesheet.曲线图1.plotindex=0;Activesheet.曲线图1.plotcolor=' + VGLineColor[1] + ';Activesheet.曲线图1.PlotValue =' + floattostr(t_array_1SCADA) + ';';
s := s + 'Activesheet.曲线图1.plotindex=1;Activesheet.曲线图1.plotcolor=' + VGLineColor[2] + ';Activesheet.曲线图1.PlotValue =' + floattostr(t_array_3Result) + ';';
vgctrl1.Execute(WideString(s));
end;
end;
procedure Print__ForecastRepor(fdate: string);
begin
dm.sq := 'exec P_Rebrush_T_Accelerate ' + #39 + fdate + #39;
dm.Exe_SQ;
pb.reportID := 'D30_负荷预测报表.rmf';
pb.PrintMode := 'preview';
pb.MainSQL := 'select * from T_sysdata WHERE FDATE=' + #39 + fdate + #39;
pb.DetailSQL := 'select * from T_Accelerate WHERE FDATE=' + #39 + fdate + #39;
PrintReport();
end;
function do_Forecast(tmpDate, TmpDateTo: tdate; n: integer; ForecastWay: integer; sbrExplorer: TStatusBar; ProgressBar1: tProgressBar): boolean;
var a: tCursor;
begin
result := false;
ProgressBar1.Min := 0;
ProgressBar1.Max := dm.Get_DATEDIFF(tmpDate, TmpDateTo) + 1;
ProgressBar1.Position := 0;
ProgressBar1.Update;
ProgressBar1.Smooth := true;
ProgressBar1.Visible := true;
a := screen.Cursor;
try
screen.Cursor := crHourGlass;
dm.sq := 'update t_config set 值=' + inttostr(itWidth) + ' where 主键=' + #39 + '预测宽度' + #39;
dm.Exe_SQ;
dm.sq := 'exec p_InsertFastCalculate ' + efdt(tmpDate) + ',' + inttostr
;
DM.Exe_SQ;
dm.sq := 'select dbo.mydate(fdate) from T_FastCalculate group by dbo.mydate(fdate)';
dm.Open_SQ;
if dm.RecordCount <> n then
begin
msg('SCADA采集数据太少,不能进行预测...');
exit;
end;
dm.sq := 'exec P_InsertFastCalculate_Holiday ' + eFDT(tmpDate) + ',' + inttostr
;
dm.Exe_SQ;
dm.sq := 'select dbo.mydate(fdate) from T_FastCalculate_Holiday group by dbo.mydate(fdate)';
dm.Open_SQ;
if dm.RecordCount <> n then
begin
msg('SCADA采集数据太少,不能进行预测...');
exit;
end;
while tmpDate < TmpDateTo do
begin
ProgressBar1.Position := ProgressBar1.Position + 1;
sbrExplorer.Panels[1].Text := '正在预测' + fdt(tmpDate) + '负荷...';
sbrExplorer.Update;
if ForecastWay = 0 then
AForecastModel := TRegression.Create(tmpDate, N)
else
AForecastModel := TSimilitude.Create(tmpDate, N);
AForecastModel.Execute();
tmpDate := tmpDate + 1;
//可以延长下一次参加预测的数据,否则数据下降明显
//当然,你也可以不使用该inc![Thumbs down (n) (n)](https://cdn.jsdelivr.net/joypixels/assets/8.0/png/unicode/64/1f44e.png)
end;
//00000000000000000000000000000000000000
finally
AForecastModel.Free;
screen.Cursor := a;
ProgressBar1.Visible := false;
end;
sbrExplorer.Panels[1].Text := '预测完成';
result := true;
end;
function bForecastBefore_LoadCookies(DateTimePicker1, DateTimePicker2, DateTimePicker3: tDateTimePicker; edit1: tedit): boolean;
begin
dm.sq := 'select * from T_Cookies';
dm.Open_SQ;
DateTimePicker1.Date := dm.Q1.fieldbyname('fdate').AsDateTime;
DateTimePicker2.Date := dm.Q1.fieldbyname('tdate').AsDateTime;
DateTimePicker3.Date := dm.Q1.fieldbyname('fdate').AsDateTime;
edit1.Text := dm.gfs('nday');
end;
function bForecastBefore_CheckDate(DateTimePicker1, DateTimePicker2: tDateTimePicker; edit1: tedit): boolean;
begin
result := false;
if DateTimePicker1.Date > DateTimePicker2.Date then
begin
msg('预测的前后日期不对!');
exit;
end;
if trim(edit1.Text) = '' then
begin
msg('必须输入适当的天数!');
edit1.SetFocus;
exit;
end;
if not isint(edit1.Text) then
begin
msg('天数必须是大于2的整数!');
edit1.SetFocus;
exit;
end;
if strtoint(edit1.Text) < 3 then
begin
msg('天数必须是大于2的整数!');
edit1.SetFocus;
exit;
end;
dm.sq := 'select dbo.mydate(fdate) as fdate from t_sysdata where fdate<=' + #39 + fdt(DateTimePicker1.Date) + #39 + ' AND IFLAG=DBO.FlagSCADA() group by dbo.mydate(fdate) ';
dm.Open_SQ;
if dm.Q1.RecordCount < strtoint(edit1.Text) then
begin
msg('无法进行预测,SCADA采集到的数据少于' + edit1.Text + '天!');
exit;
end;
dm.sq := 'select * from T_Cookies';
dm.Open_SQ;
dm.Q1.Edit;
dm.Q1.fieldbyname('fdate').Value := DateTimePicker1.Date;
dm.Q1.fieldbyname('tdate').Value := DateTimePicker2.Date;
dm.Q1.fieldbyname('nday').Value := strtoint(edit1.text);
dm.Q1.Post;
result := true;
end;
constructor TForecastModel.Create(LForecastDate: tdatetime; LhistoryN: integer); //构造函数
begin
N := LhistoryN;
ForecastDate := LForecastDate;
end;
function TForecastModel.Load_pj_Data(): boolean;
////本单元两个方法都需要装载前n 天平均数,装载后放在x[]中
var i: integer;
begin
result := false;
dm.sq := 'exec F_GetNDayAverage ' + efdt(ForecastDate) + ',' + #39 + inttostr
+ #39;
dm.Open_SQ;
if dm.RecordCount <> N then
begin
msg('aaaaaSCADA采集得数据太少,无法预测...');
exit;
end;
i := 1;
while not dm.eof do
begin
x := dm.GFN('Naverage');
dm.Next;
inc(i);
end;
dm.Q1.Prior;
lastDate := dm.GFS('fdate');
lastDatepj := dm.GFN('Naverage');
end;
function TForecastModel.save(dDate: tdatetime): boolean;
var i: integer;
s: string;
begin
result := false;
dm.sq := 'delete from t_sysdata where dbo.mydate(FDate)=' + efdt(ddate) + ' and iflag=dbo.flagResult()';
dm.Exe_SQ;
for i := 1 to itwidth do
begin
//千万注意:下面这行 i-1
dm.sq := 'exec F_SaveForecastResult ' + efdt(ddate) + ',' + floattostr(l_array) + ',' + inttostr(i - 1);
dm.Exe_SQ;
end;
result := true;
//--还要加上已经知道的修正值
//2005-8-24 begin
//--2005-8-24 认为,还是没有必要把修正值(T_Forecast_2CAI),弄进来
//-- 因为引入了由于增加了大用户调整,用户可以随时增加了大用户调整,
//所以2个表不能合在一起
end;
function tSimilitude.LoadData(): boolean;
begin
load_pj_data(); ////本单元两个方法都需要装载前n 天平均数,装载后放在x[]中
X[n + 1] := X[n]; //Similitude目的:对最后一天加重权,即多算一天
RESULT := TRUE;
end;
function tSimilitude.Execute(): boolean;
var i: integer;
begin
result := false;
if not LoadData() then EXIT;
dtP1 := LeastSquarFit(x, n + 1); //n+1 因为 对最后一天加重权,即多算一天
dm.sq := 'select (isnull(nvalue,0)-(' + FLOATTOSTR(lastDatepj) + ')) as nvalue,iindex from t_sysdata ';
dm.sq := dm.sq + ' where dbo.mydate(fdate)=' + chr(39) + lastdate + chr(39);
dm.sq := dm.sq + ' and iflag=dbo.flagSCADA() order by IINDEX';
dm.Open_SQ;
//这里可以避开n,还是n+1 的麻烦
if dm.RecordCount <> itWidth then
begin
msg('数据异常...');
exit;
end;
i := 1;
while not dm.Eof do
begin
l_array[DM.GFI('IINDEX')] := dtP1 + dm.GFN('nvalue');
inc(i);
dm.Next;
end;
SAVE(ForecastDate);
RESULT := TRUE;
end;
function TRegression.Execute: boolean;
var i: integer;
begin
result := false;
if N < 2 then begin MSG('无法预测!要求根据2天以上的历史数据才能预测!'); EXIT; end;
if not LoadData() then exit;
dtP1 := LeastSquarFit(x, n);
Set_s();
Set_s_of_N_add_1(); //根据历史,也就是上面的s,求平均s
calc_result();
for i := 1 to itwidth do l_array := z[n + 1, i]; //这个算法结果目前在z中
save(ForecastDate);
result := true;
end;
procedure TRegression.calc_result();
var i: integer;
begin
for i := 1 to itwidth do
begin
z[n + 1, i] := s[n + 1, i] * dtP1;
end;
end;
procedure TRegression.Set_s();
var i, j: integer;
begin
for i := 1 to N do
begin
for j := 1 to itwidth do
begin
if x = 0 then
s[i, j] := 0
else
s[i, j] := z[i, j] / x;
end;
end;
end;
procedure TRegression.Set_s_of_N_add_1(); //计算机出S N+1 天 平均变化系数
var i, j: integer;
d: double;
begin
for I := 1 to itwidth do
begin
d := 0;
for j := 1 to N do d := d + s[j, i];
s[n + 1, i] := d / n;
end;
end;
function TRegression.LoadData(): boolean; //装载矩阵
var i, j: integer;
IID: INTEGER;
begin
result := false;
load_pj_data(); ////本单元两个方法都需要装载前n 天平均数,装载后放在x[]中
dm.sq := 'exec P_LoadData_Before ' + eFDT(ForecastDate) + ',' + inttostr
;
dm.Q2.Close;
dm.Q2.SQL.Clear;
dm.Q2.SQL.Add(dm.sq);
dm.Q2.Open;
if dm.q2.RecordCount <> n then
begin
msg('load data before error....'); //其实这个错误是不可能发生的
exit;
end;
i := 1; j := 1;
while not dm.q2.eof do
begin
dm.sq := 'exec P_LoadData ' + eFDT(dm.Q2.fieldbyname('fdate').AsDateTime);
dm.Open_SQ;
if dm.Eof then
begin
msg('未知错误...'); //其实这个错误是不可能发生的
exit;
end;
//dm.RecordCount多少不用管
while not dm.eof do
begin
z[i, dm.GFI('iindex')+1] := dm.gfn('nvalue');//要+1
dm.Next;
end;
//dm.GFI('iindex') 技巧啊
//解决了采集问题
inc(i);
dm.q2.next;
end;
result := true;
end;
end.