{- Filename: Regressie-proef -} // //programma'tje voor onderzoek mogelijkheden regressie lijn //versie 1.00 //www.jstas.com. // Type Deviaties = Record EndDat : TDateTime; sX : Array Of Real; Xma, SdvX, Mltp : Real; nPer,Meth,Ywrd,CrrAmp,CrrPlts,BlkPlts, BlkAmp,BndPlts,BndAmp,pLambda,CrwgvKz : Integer; sYma,sDevY,sBFLine,sRr,sMm,sBb,sBF,sY,sHpr, sHP1,sHP2,sHP3 : TSeries; wgvReg,wgvBFL,DevBr,DevBF,Crrwrg,Balk, BandBr,HdPr,ClrBFL : Boolean; End; Var dv : Deviaties; //***************************************************************************** Procedure Initialisaties(); Begin dv.sY := C; Indicator.newband := False; Indicator.ScaleRange := SrCommon; dv.sHP1 := CreateSeries(BarCount); dv.sHP2 := CreateSeries(BarCount); dv.sHP3 := CreateSeries(BarCount); End; //***************************************************************************** Procedure UserChoices(); Begin dv.nPer := CreateParameterInteger('Periode:',2,300,20,False); dv.Meth := CreateParameterSelect('Methode:','1' #9'2',1,False); dv.wgvBFL := CreateParameterBoolean('Best-Fit-Line weergave?',True,False); dv.ClrBFL := CreateParameterBoolean('Best-Fit-Line inkleuren?',False,False); dv.devBF := CreateParameterBoolean('Deviatieband weergave',False,False); dv.Ywrd := CreateParameterSelect ('Band berekenen op:','BestFitLine'#9'Slotkoers',1,False); dv.Mltp := CreateParameterInteger('Band Factor /tiende',1,100,20,False) /10.0; dv.wgvReg := CreateParameterBoolean('Regressielijn weergave?',False,False); dv.EndDat := CreateParameterDate('Einddatum Regressielijn', EncodeDate(2015,10,23)); dv.DevBr := CreateParameterBoolean('Deviatieband Regressie lijn?',True,False); dv.Crrwrg := CreateParameterBoolean('Correlatielijn weergave',False,False); dv.CrwgvKz:= CreateParameterSelect('Display methode: ','1'#9'2',0,False); dv.CrrAmp := CreateParameterInteger('Amplitude Corr.',6,90,8,False); dv.CrrPlts:= CreateParameterInteger('Plaats Corr.signaal',4,96,95,False); dv.Balk := CreateParameterBoolean('Kleurbalk weergeven',False,False); dv.BlkPlts:= CreateParameterInteger('Plaats kleurbalk',0,95,1,False); dv.BlkAmp := CreateParameterInteger('Hoogte kleurbalk',2,99,5,False); dv.BandBr := CreateParameterBoolean('Band-breedte weergave',False,False); dv.BndPlts:= CreateParameterInteger('Plaats band-breedte',5,95,80,False); dv.BndAmp := CreateParameterInteger('Amplitude Band-breedte',1,50,5,False); dv.HdPr := CreateParameterBoolean('Hodrick-Prescot lijn weergave',False,False); dv.pLambda := CreateParameterInteger('Lambda =', 0, 10000000, 5, TRUE); End; //****************************************************************************** Function StdDevX(sX:Array Of Real; periode:Integer ;xMA:Real;Meth:Integer):Real; var i : integer; Begin For i:= 1 To Periode Do Result := Result + Sqr(sX[i]-xMA); Result := Sqrt(Result/(Periode-Meth)); /// End; //***************************************************************************** Function StdDevY(sY:Tseries;Per,Meth:Integer):TSeries; Var i,Tel : integer; Som : Real; Begin Result := CreateSeries(BarCount); For i:=Per To BarCount-1 Do Begin For Tel:=0 To Per-1 Do Som := Som + sqr(sY[i-Tel]-dv.sYma[i]); Result[i] := Sqrt(Som/(Per-Meth)); /// Som := 0; End; End; //***************************************************************************** Procedure Tekst(Dat:TDateTime;Yy,Size:Integer;Tkst:String;Clr:TColor); Begin With CreateText(Dat,0,Tkst) Do Begin Y1Pct := Yy; Color := Clr; Font.Size := Size; End; end; //***************************************************************************** function LastValidIndex(aSer:TSeries):integer; var i, Count: integer; begin Count:=GetArrayLength(aSer); if (Count>0) then begin result:=0; for i:=Count-1 downto 0 do begin if IsValid(aSer[i]) then begin result:=i; break; end; end; end; end; //***************************************************************************** //Het Hodrick-Prescott filter is geschreven door AlbertH van het ta-script forum function HodrickPrescot(aSSer:TSeries; aLambda:double):TSeries; var i, L:integer; H1, H2, H3, H4, H5, HH1, HH2, HH3, HH5, HB, HC, Z: double; {are zero} FVI, LVI: integer; a, b, c :Array of double; begin if (BarCount>1) then begin result:= CreateSeries(BarCount); {--------------------------------------------------------------------------} FVI:=FirstValidIndex(aSser); LVI:=LastValidIndex(aSser); L:=LVI-FVI+1; if (L>0) then begin {------------------------------------------------------------------------} {--- init variables ---} {------------------------------------------------------------------------} SetArrayLength(a, L); SetArrayLength(b, L); SetArrayLength(c, L); FillSeries(result, NaN); H1 :=0; H2 :=0; H3 :=0; H4 :=0; H5 :=0; HH1:=0; HH2:=0; HH3:=0; HH5:=0; HB :=0; HC :=0; Z :=0; {------------------------------------------------------------------------} {--- Calculate filter output ---} {------------------------------------------------------------------------} a[0]:= 1.0+aLambda; b[0]:=-2.0*aLambda; c[0]:=aLambda; {---} for i:=1 to L-3 do begin a[i]:= 6.0*aLambda+1.0; b[i]:=-4.0*aLambda; c[i]:=aLambda; end; {---} a[1] := 5.0*aLambda+1.0; a[L-1]:= 1.0+aLambda; a[L-2]:= 5.0*aLambda+1.0; b[L-2]:=-2.0*aLambda; b[L-1]:= 0.0; c[L-2]:= 0.0; c[L-1]:= 0.0; {------------------------------------------------------------------------} {--- Forward ---} {------------------------------------------------------------------------} for i:=0 to L-1 do begin Z :=a[i]-H4*H1-HH5*HH2; {---} HB :=b[i]; HH1 :=H1; H1 :=(HB-H4*H2)/Z; b[i]:=H1; {---} HC :=c[i]; HH2 :=H2; H2 :=HC/Z; c[i]:=H2; {---} a[i]:=(aSser[FVI+i]-HH3*HH5-H3*H4)/Z; HH3 :=H3; H3 :=a[i]; H4 :=HB-H5*HH1; HH5 :=H5; H5 :=HC; end; {------------------------------------------------------------------------} {--- Backward ---} {------------------------------------------------------------------------} H2:=0.0; H1:=a[L-1]; result[FVI+L-1]:=H1; for i:=L-2 downto 0 do begin result[FVI+i]:=a[i]-b[i]*H1-c[i]*H2; H2:=H1; H1:=result[FVI+i]; end; {------------------------------------------------------------------------} SetArrayLength(a, 0); SetArrayLength(b, 0); SetArrayLength(c, 0); end; end; end; //****************************************************************************** Procedure Calculate(sY:TSeries); Var i : Integer; Begin dv.sYma := ma(sY,maSimple,dv.nPer); dv.Xma := (dv.nPer+1)/2; SetArrayLength(dv.sX,dv.nPer+1); For i:= 1 To dv.nPer Do dv.sX[i] := i ; dv.SdvX := StdDevX(dv.sX,dv.nPer,dv.Xma,dv.Meth); dv.sDevY:=StdDevY(sY,dv.nPer,dv.Meth); End; //***************************************************************************** Function Corr(sY : TSeries):Tseries; //Rr Var i,n : Integer; Som : Real; Begin Result := CreateSeries(BarCount); For i := dv.nPer To BarCount-1 Do Begin Som := 0; For n := 1 To dv.nPer Do Som := Som +(sY[i-n+1]-dv.sYma[i])*(dv.sX[n]-dv.Xma); If ( (dv.SdvX*dv.sDevY[i])>0 ) Then Som := Som/ (dv.SdvX*dv.sDevY[i]); Result[i] := (Som/(dv.nPer))*-1.0; End; End; //***************************************************************************** Function Helling():TSeries; //Mm Var i : Integer; Begin Result := CreateSeries(BarCount); For i := dv.nPer To BarCount-1 Do Result[i] := dv.sRr[i]*(dv.sDevY[i]/dv.Sdvx); End; //***************************************************************************** Function Snijpunt():Tseries; //Bb X=0 Var i : Integer; Begin Result := CreateSeries(BarCount); For i := dv.nPer To BarCount-1 Do Result[i] := dv.sYma[i]- (dv.sMm[i]*dv.Xma)+dv.sMM[i]; End; //****************************************************************************** Function BestFitLine(): TSeries; Var i : Integer; Begin Result := CreateSeries(BarCount); For i := dv.nPer To BarCount-1 Do Begin Result[i] := dv.sBb[i]+(dv.sMm[i]*dv.nPer); End; End; //****************************************************************************** Procedure RegLine(); Var h1,h2,h3 : Real; i,iStart : Integer; Dat1 : TDateTime; Begin For i:= 1 To BarCount-1 Do If (DateTime[i]=dv.EndDat) Then Begin iStart := i; h1 := dv.sMm[i]*dv.nPer ; h2 := dv.sBB[i]; h3 := dv.sDevY[i]; End; For i:= 1 To BarCount-1 Do If (i=(iStart-dv.nPer+1)) Then Dat1 := DateTime[i]; With CreateTrendLine(Dat1,h2,dv.EndDat,h1+h2) Do Begin Color := ClGreen; Width := 2; End; If dv.DevBr Then Begin CreateTrendLine(Dat1,h2+h3,dv.EndDat,h1+h2+h3).Color := ClRed; CreateTrendLine(Dat1,h2-h3,dv.EndDat,h1+h2-h3).Color := ClRed; End; End; //****************************************************************************** Procedure TekenBFLlijn(); Var i : Integer; Kleur : TColor; Lijn1,Lijn2,Lijn3 : TSeries; Begin Lijn1 := CreateSeries(BarCount); Lijn2 := CreateSeries(BarCount); Lijn3 := CreateSeries(BarCount); If dv.wgvBFL Then Begin Lijn1 := dv.sBF; If dv.devBF Then Begin Case dv.Ywrd Of 0: Begin Lijn2 := AddSeries(dv.sBF, MultiPlySeriesBy (StdDevY(dv.sBF,dv.nPer,dv.Meth),dv.Mltp)); Lijn3 := SubtractSeries(dv.sBF,MultiPlySeriesBy (StdDevY(dv.sBF,dv.nPer,dv.Meth),dv.Mltp)); End; 1: Begin Lijn2 := AddSeries(dv.sBF,MultiPlySeriesBy(dv.sDevY,dv.Mltp)); Lijn3 := SubtractSeries(dv.sBF,MultiPlySeriesBy(dv.sDevY,dv.Mltp)); End; End; End; End; With CreateLine(Lijn1) Do Begin Color := ClBlue; Width := 2; End; CreateLine(Lijn2).Color := ClGray; CreateLine(Lijn3).Color := ClGray; If dv.ClrBFL Then Begin For i := 1 To BarCount-1 Do Begin Kleur := ClRed; If IsValid(dv.sBF[i-1]) Then Begin If (dv.sBF[i]>=dv.sBF[i-1]) Then Kleur:=ClGreen; End; SetBarColor(0,i,Kleur); End; End; End; //****************************************************************************** Procedure Trendlijn (Aa,Cc:TDateTime; Bb,Dd,Yy1,Yy2:Real;Klr:TColor;Stijl:TTrendLineStyle); Begin With CreateTrendLine(Aa,Bb,Cc,Dd) Do Begin Y1Pct := Yy1; Y2Pct := Yy2; Color := Klr; Style := Stijl; End; End; //****************************************************************************** Procedure CorrWeergaveLijn(); Var i : Integer; Begin For i := 1 To BarCount-1 Do Begin Case dv.CrwgvKz Of 0: If IsValid(dv.sRr[i-1]) Then TrendLijn(DateTime[i-1],DateTime[i],0,0, (dv.sRR[i-1]*dv.CrrAmp/2)+dv.CrrPlts,(dv.sRR[i]*dv.CrrAmp/2)+dv.CrrPlts, ClBlue,lsSolid); 1: If IsValid(dv.sRr[i-1]) Then TrendLijn(DateTime[i-1],DateTime[i],0,0, Abs(dv.sRR[i-1]*dv.CrrAmp/2)+dv.CrrPlts,Abs(dv.sRR[i]*dv.CrrAmp/2)+ dv.CrrPlts,ClBlue,lsSolid); End; End; TrendLijn(0,now,0,0,dv.CrrPlts,dv.CrrPlts,clBlack,lsSolid); TrendLijn(0,now,0,0,(dv.CrrAmp/4)+dv.CrrPLts,(dv.CrrAmp/4)+dv.CrrPLts,ClGray, lsDot); If (dv.CrwgvKz=0) Then TrendLijn(0,now,0,0,dv.CrrPlts-(dv.CrrAmp/4),dv.CrrPlts-(dv.CrrAmp/4),ClGray, lsDot); Tekst(now,dv.CrrPLts+2,10,'Correlatie',ClRed); End; //****************************************************************************** Procedure Kleurbalk(); Var R,B,G,i : Integer; Bk : TColor; Cr : Real; Begin B := 0; For i := dv.nPer To BarCount-1 Do Begin Cr := dv.sRr[i]; Cr := Abs(Cr); G := Round(Cr*255); R := Round(255-(Cr*255)); If Cr>0.5 Then G := 255; If Cr<0.5 Then R := 255; Bk := RGB(R,G,B); With CreateRectAngle(DateTime[i],0,DateTime[i-1],0) Do Begin Y1Pct := dv.BlkPlts; Y2Pct := dv.BlkPlts+dv.BlkAmp; Color := Bk; BkColor := Bk; DrawBehindChart := True; End; End; Tekst(now,dv.BlkPlts+2,10,'Betrouwbaarheid',ClRed); End; //***************************************************************************** Procedure Bandbreedte(); Var i : Integer; Dlr : Real; Begin Dlr := Highest(dv.sDevY,1,BarCount-1)/dv.BndAmp; For i := 1 To BarCOunt-1 Do Begin If IsValid(dv.sDevY[i-1]) Then Begin TrendLijn(DateTime[i-1],DateTime[i],0,0, dv.sDevY[i-1]/Dlr+dv.BndPlts,dv.sDevY[i]/Dlr+dv.BndPlts,ClBlue,lsSolid); TrendLijn(DateTime[i-1],DateTime[i],0,0, dv.BndPlts-dv.sDevY[i-1]/Dlr,dv.BndPlts-dv.sDevY[i]/Dlr,ClBlue,lsSolid); End; End; TrendLijn(0,now,0,0,dv.BndPlts,dv.BndPlts,ClBlack,lsDot); Tekst(now,dv.BndPlts+2,10,'BandBreedte',ClRed); End; //***************************************************************************** Procedure HodrickPrescotLijn(); Begin dv.sHPr := HodrickPrescot(Close, dv.pLambda); dv.sHP1 := dv.sHPR; dv.sHP2 := AddSeries(dv.sHPr,StdDev(C,20)); dv.sHP3 := SubtractSeries(dv.sHPr,StdDev(C,20)); End; //****************************************************************************** Procedure Tekenlijnen(); Begin CreateLine(dv.sHP1).Color := ClRed; CreateLine(dv.sHP2).Color := ClGray; CreateLine(dv.sHP3).COlor := ClGray; End; //****************************************************************************** Begin Initialisaties(); UserChoices(); Calculate(dv.sY); dv.sRr := Corr(C); dv.sMm := Helling(); dv.sBB := Snijpunt(); dv.sBF := Ma(BestFitLine(),maSimple,2); If dv.wgvReg Then RegLine(); TekenBFLlijn(); If dv.Crrwrg Then CorrWeergaveLijn(); If dv.Balk Then Kleurbalk(); If dv.BandBr Then Bandbreedte(); If dv.HdPr Then HodrickPrescotLijn(); Tekenlijnen(); End. //////////////////