Seasonality

Stel hier uw vragen over TA-script, of help anderen met het oplossen van hun probleem
Plaats reactie
Janus
Berichten: 1293
Lid geworden op: wo jan 30, 2008 2:07 am
Contacteer:

Seasonality

Bericht door Janus » za aug 31, 2019 12:42 am

Vanmorgen terwijl ik op een telefoontje zat te wachten viel mijn oog op een artikel geschreven door Perry J. Kaufman.
De titel van het artikel is: A simpel way to trade seasonality.
Hij stelt dat veel methodes om een seizoen invloed op een aandeel te meten niet voldoen.
Zijn methode werkt als volgt: bepaal het jaar gemiddelde (koersbereik) en kijk welke maand boven deze waarde sluit en welke maand onder deze waarde sluit.
Doe dit voor een aantal jaren, en kijk dan hoeveel %, bijvoorbeeld januari, boven of onder deze waarde sluit, en doe dit voor alle twaalf maanden van het jaar.
Zet deze waarde om in een percentage.
Interessant is de waarde boven 75% en onder 25%
Het idee is daarna, om wanneer de hoogste waarde (boven de 75%) valt in het begin van het jaar, en de laagste waarde (onder de 25%) later in het jaar, Hoog te verkopen en laag terug te kopen; of vice versa wanneer het patroon omgekeerd plaats vind.
Dat betekent dat je weinig handelt, dus niet geschikt voor de gemiddelde ADHD-er ;)
.
Valt er winst te behalen met zo'n benadering?
Tsja, bekijk even een tabel die ik kopieerde uit dat artikel:
Tabel:
Afbeelding
.
Tja, en toen zat ik vanavond na het eten en voor de koffie te denken: laat ik er even een ta-script voor schrijven zodat je onmiddellijk ziet of er überhaupt een patroon in een bepaalde grafiek aanwezig is.
En ik zal u vertellen, ik was verbaasd!
In sommige aandelen, indexen etc., is gewoon geen seasonal patroon aanwezig, maar in sommige wel, terwijl je dat op het eerste gezicht niet zo 1-2-3 ziet.
.
Waardoor wordt een seasonal patroon gevormd.
Dat is natuurlijk in eerste instantie door bijvoorbeeld de natuur, maar als best volgende ook de gewoonte van de mensen.
We zijn gewoonte dieren, of we nu willen of niet ;)
.
Ik geef later in dit stukje de gebruikte ta-script code die ik vanavond geschreven heb, maar kijkt u eens naar de volgende grafiek van AirFrance.
Ziet u het patroon?
Afbeelding
.
Geweldig wanneer u dat ziet, ik zag het in eerste instantie niet.
Nu laten we de geschreven ta-script code even los op deze grafiek, et Voilá:
Afbeelding
.
U ziet een seizoen gebonden patroon met een top in Maart en een bodem in Juli-Augustus.
De hoge percentages geven aan dat dit nagenoeg elk jaar plaats vindt.
Je kan daar met een stoploss blind op ingaan ;)
.
Speel een beetje met de jaren om te zien of het patroon constant is, dat voorkomt verrassingen.
.
Succes!
Ik ga nu onder de wol, bij interesse wil ik deze posting wel uitbreiden.
Ik begrijp dat de uitleg nogal summier is, bij vragen wil ik dit wel uitbreiden, maar wanneer u een beetje 'speelt' met deze indicator wordt veel duidelijk.
.

Code: Selecteer alles

{- Filename: Seasonal monthly -}
// Open een maandgrafiek
// Zorg ervoor dat de te meten periode in het venster zichtbaar is !!
// naar een idee van Perry J. Kaufman
// vertaling www.jstas.com versie 1.00  30-08-2019

Procedure
Streepje(Xx1,Xx2,Yy1,Yy2,Breed:Integer; Kleur:TColor; Lijntype:TLineType);
Begin
With CreateTrendLine(0,0,0,0) Do
 Begin
  X1PcT := Xx1;
  X2PcT := Xx2;
  Y1Pct := Yy1;
  Y2Pct := Yy2;
  Color := Kleur;
  Style := Lijntype;
  Width := Breed;
 End;
End;
//****************************************************************************
Procedure Rechthoek(Xx1,Xx2,Yy1,Yy2: Integer;Kleur1,Kleur2 : TColor);
Begin
 With CreateRectangle(0,0,0,0) Do
  Begin
   Y1PcT := Yy1;
   Y2PcT := Yy2;
   X1Pct := Xx1;
   X2Pct := Xx2;
   BkColor := Kleur1;
   Color := Kleur2;
  End;
End;
//************************************************************************
Procedure Tekst(tkst:String;wrdH,WrdV:Integer;Kleur:TColor; Groot:Integer);
Begin
With CreateText(0,0,tkst) Do
 Begin
   X1Pct := WrdH;
   Y1Pct := WrdV;
   Color := Kleur;
   Font.Size := Groot;
 End;
End;
 //**********************************************************************
Procedure Teksten(FrmH,FrmV,JrB,JrE:Integer);
Begin
Tekst
('Gemeten periode '+IntToStr(JrB)+' t/m '+ IntToStr(JrE),FrmH,FrmV+5,ClRed,10);
Tekst('25',FrmH-2,FrmV+16,ClRed,8);
Tekst('50',FrmH-2,FrmV+26,ClRed,8);
Tekst('75',FrmH-2,FrmV+36,ClRed,8);
Tekst('J',FrmH-1 ,FrmV+48,ClAqua,8);
Tekst('F',FrmH+4 ,FrmV+48,ClAqua,8);
Tekst('M',FrmH+9 ,FrmV+48,ClAqua,8);
Tekst('A',FrmH+14,FrmV+48,ClAqua,8);
Tekst('M',FrmH+19,FrmV+48,ClAqua,8);
Tekst('J',FrmH+24,FrmV+48,ClAqua,8);
Tekst('J',FrmH+29,FrmV+48,ClAqua,8);
Tekst('A',FrmH+34,FrmV+48,ClAqua,8);
Tekst('S',FrmH+39,FrmV+48,ClAqua,8);
Tekst('O',FrmH+44,FrmV+48,ClAqua,8);
Tekst('N',FrmH+49,FrmV+48,ClAqua,8);
Tekst('D',FrmH+53,FrmV+48,ClAqua,8);
End;
//************************************************************************

Var
  Avrg, MndScore : Real;
  StartDtm , EindDtm : TDateTime;
  i,j,tllr,Jr,DitJr,JrB,JrE,Mnd,Dg,FrmH,FrmV : integer;
  MndPrctg: Array[1..12] Of Real;
  JrAvrg  : Array[1980..2030] Of Real;
  HLArray : Array[1980..2030] Of Array[1..12] of Real;
  Tabel   : Array[1980..2030] Of Array[1..12] Of Real;

Begin
Indicator.NewBand := False;

StartDtm :=
   EnCodeDate(CreateParameterInteger('Start-Jaar:',1981,2020,2010,False),01,01);
EindDtm  :=
 EnCodeDate(CreateParameterInteger('Laatste Jaar:',1981,2020,2018,False),12,31);
FrmH     := CreateParameterInteger('Verplaats Frame Horizontaal',2,46,46,False);
FrmV     := CreateParameterInteger('Verplaats Frame Verticaal',0,55,0,False);

DecodeDate(now,DitJr,Mnd,Mnd);
DecodeDate(EindDtm,Jr,Mnd,Mnd);
If Jr>= DitJr Then
 Begin
  Jr := DitJr-1;
  EindDtm := EnCodeDate(Jr,12,31);
 End;

For i := 1 To BarCount-1 Do
Begin
 If(DateTime[i]>=StartDtm) And (DateTime[i]<= EindDtm) Then
  Begin
   DecodeDate(DateTime[i],Jr,Mnd,Dg);
   If (Jr>=1980) And (Jr<=2030)Then
   Tabel[Jr][Mnd]:= C[i];
  End;
End;

DecodeDate(StartDtm,JrB,Mnd,Dg);
DecodeDate( EindDtm,JrE,Mnd,Dg);
JrB := Trunc(JrB);
JrE := Trunc(JrE);

Teksten(FrmH,FrmV,JrB,JrE);

For i := JrB To JrE Do
 Begin
  Avrg := 0;
  For j := 1 To 12 Do
   Begin
    Avrg := Avrg + Tabel[i][j];
   End;
  JrAvrg[i] :=  Avrg/12.0;
 End;

For i := JrB To JrE Do
 Begin
  For j := 1 To 12 Do
   Begin
    If Tabel[i][j]>JrAvrg[i] Then
      HLArray[i][j] :=1
     Else HLArray[i][j] := 0;
   End;
 End;

For j :=1 To 12 Do
 Begin
  MndScore := 0;
   For i := JrB To JrE do
    Begin
     MndScore := MndScore + HLArray[i][j];
    End;
   MndPrctg[j] := (MndScore/(JrE-JrB+1)*100)
 End;

Rechthoek(FrmH,FrmH+54,FrmV+5,FrmV+45,ClWhite,ClGray);

For i:= 1 To 9 Do
Begin
Streepje(FrmH,FrmH+54,FrmV+Trunc((4*i)+5),FrmV+Trunc((4*i)+5),1,ClBlue,LsSolid);
 If (i=5) Then
 Streepje(FrmH,FrmH+54,FrmV+Trunc((4*i)+5),FrmV+Trunc((4*i)+5),1,ClRed,LsSolid);
End;
 
For i:= 1 To 10 Do
 Begin
  Streepje(FrmH,FrmH+54,FrmV+Trunc((4*i)+3),FrmV+Trunc((4*i)+3),1,ClGray,LsDot);
  If (i=3) Or (i=8) Then
  Streepje(FrmH,FrmH+54,FrmV+Trunc((4*i)+3),FrmV+Trunc((4*i)+3),2,ClRed,LsDot);
 End;
  
tllr := 0;
For i := 1 To 11 Do
 Begin
 Streepje((FrmH+tllr),(FrmH+5+tllr),FrmV+Round(MndPrctg[i]/2),
                                 FrmV+Round(MndPrctg[i+1]/2),2,ClBlack,LsSolid);
 Streepje((FrmH+tllr),(FrmH+Tllr),FrmV+5,FrmV+45,1,ClGray,LsDot);
 tllr := tllr+5;
 End;
// je gelooft het vast niet, maar dit is alles wat er aan code nodig is ;)
End.

.
Vriendelijke groet,
JanS ;)

hpwijk
Berichten: 40
Lid geworden op: ma okt 29, 2018 6:51 am

Re: Seasonality

Bericht door hpwijk » za aug 31, 2019 10:02 am

Jan, heb je al nagedacht over waar we jouw standbeeld mogen gaan plaatsen? :D

Weer een knap stukje werk!!

Ben jaren geleden bij een presentatie geweest van deze rakketgeleerde (letterlijk...geen domme man)

Ik heb er even mee gestoeid en zag tot op heden de Dow...kopen in jan en verkopen in december :lol:

Afbeelding

hpwijk
Berichten: 40
Lid geworden op: ma okt 29, 2018 6:51 am

Re: Seasonality

Bericht door hpwijk » za aug 31, 2019 10:19 am

Terwijl voor de Nasdaq juist geldt: start in mei en verkoop in december

Afbeelding

Wanneer ik dit door reken, dat valt inderdaad op dat beleggen in de laatste 8 maanden voor de Nasdaq inderdaad het groorste deel van de winst wordt behaald: 437.000 dollar

Afbeelding

van de 449.000 (uitgaande van een investering van 100.000 dollar terwijl je dus 4 maanden niet belegd bent...

Afbeelding

hpwijk
Berichten: 40
Lid geworden op: ma okt 29, 2018 6:51 am

Re: Seasonality

Bericht door hpwijk » za aug 31, 2019 10:32 am

Wat mij wel opvalt, is dat als je bijvoorbeeld AiriFrance neemt vanaf 1992 ipv 2010 (dus 18 jaar extra, dat de bodem nog steeds valt in augustus, maar de top is minder duidelijk in februari...de periode is dus wel van belang voor een voldoende omvang van de steekproef

Afbeelding

Janus
Berichten: 1293
Lid geworden op: wo jan 30, 2008 2:07 am
Contacteer:

Re: Seasonality

Bericht door Janus » za aug 31, 2019 12:43 pm

@ Harm,
Volgens Kaufman hangt de periode waarover je een en ander bekijkt af van wat voor soort fonds of index je bekijkt. Een fonds wat gevoelig is voor invloeden van de jaargetijden, is een ander verhaal dan een fonds wat bijvoorbeeld afhankelijk is van consumenten gedrag. Hij noemt als voorbeeld Amazon, wat invloed heeft gehad op veranderend consument gedrag wat betreft het kopen in de fysieke winkels. Het gedrag wat betreft het kopen in fysieke winkels is de laatste jaren sterk veranderd, en kan je niet vergelijken met het gedrag een 10 jaar geleden. Op die wijze kan zo'n seizoen gedrag in een bepaald fonds of index wijzigen in de loop der jaren.
Ik stuur even een klein stukje tekst mee.
Wanneer je me even een mail stuurt, dan geef ik een reply met het gehele pdf documentje.
.
Afbeelding
Vriendelijke groet,
JanS ;)

vincent
Berichten: 245
Lid geworden op: di jan 04, 2011 12:20 pm

Re: Seasonality

Bericht door vincent » za aug 31, 2019 3:54 pm

"My 2 cents'

Interessante insteek. Dank voor het delen JanS.
Afbeelding

Als ik het goed begrijp is dan bijvoorbeeld de maand januari op de Nasdaq (over 10 jaar) nagenoeg altijd negatief en kan met zo'n lage score dit 'bijna blind als short maand beschouwen'.
En wat andere indicatoren ook al getoond hebben kopen 'long' eind augustus (goh, dat is nu) en verkoop daarvan eind december.

Als ik dan Ahold bekijk, dan wordt aanschaf eind juni (en bijkoop indien lagere waarde op einde van augustus) en verkoop einde van december. De optelsom is dan 135% (echter buy-and-hold was ook 100% geweest, en dat zonder bijkoop)

http://www2.wealth-lab.com/WL5Wiki/Prin ... ASCSep2019
Op deze site gebruiken ze de '4-jaars rollende uitvoering met signalen'. AIs dat misschien nog een insteek is om goed te kijken of het effectief is? Aangezien met de huidige versie men enkel over de schouder terugkijkt en met een rollende uitvoering je ook deels naar voren gekeken hebt.
(hoewel 4 jaar een wat korte periode lijkt)

Gegroet. Vincent

Janus
Berichten: 1293
Lid geworden op: wo jan 30, 2008 2:07 am
Contacteer:

Re: Seasonality

Bericht door Janus » ma sep 02, 2019 10:44 am

Een kleine correctie gemaakt in de berekening van het %-schermpje.
.
De code is aangepast:

Code: Selecteer alles

{- Filename: Seasonal monthly -}
// Open een maandgrafiek
// Zorg ervoor dat de te meten periode in het venster zichtbaar is !!
// naar een idee van Perry J. Kaufman
// vertaling www.jstas.com versie 1.01  02-09-2019

Procedure
Streepje(Xx1,Xx2,Yy1,Yy2,Breed:Integer; Kleur:TColor; Lijntype:TLineType);
Begin
With CreateTrendLine(0,0,0,0) Do
 Begin
  X1PcT := Xx1;
  X2PcT := Xx2;
  Y1Pct := Yy1;
  Y2Pct := Yy2;
  Color := Kleur;
  Style := Lijntype;
  Width := Breed;
 End;
End;
//****************************************************************************
Procedure Rechthoek(Xx1,Xx2,Yy1,Yy2: Integer;Kleur1,Kleur2 : TColor);
Begin
 With CreateRectangle(0,0,0,0) Do
  Begin
   Y1PcT := Yy1;
   Y2PcT := Yy2;
   X1Pct := Xx1;
   X2Pct := Xx2;
   BkColor := Kleur1;
   Color := Kleur2;
  End;
End;
//************************************************************************
Procedure Tekst(tkst:String;wrdH,WrdV:Integer;Kleur:TColor; Groot:Integer);
Begin
With CreateText(0,0,tkst) Do
 Begin
   X1Pct := WrdH;
   Y1Pct := WrdV;
   Color := Kleur;
   Font.Size := Groot;
 End;
End;
 //**********************************************************************
Procedure Teksten(FrmH,FrmV,JrB,JrE:Integer);
Begin
Tekst
('Gemeten periode '+IntToStr(JrB)+' t/m '+ IntToStr(JrE),FrmH,FrmV+5,ClRed,10);
Tekst('25',FrmH-2,FrmV+16,ClRed,8);
Tekst('50',FrmH-2,FrmV+26,ClRed,8);
Tekst('75',FrmH-2,FrmV+36,ClRed,8);
Tekst('%',FrmH-2,FrmV+45,ClRed,10);
Tekst('J',FrmH-1 ,FrmV+48,ClAqua,8);
Tekst('F',FrmH+4 ,FrmV+48,ClAqua,8);
Tekst('M',FrmH+9 ,FrmV+48,ClAqua,8);
Tekst('A',FrmH+14,FrmV+48,ClAqua,8);
Tekst('M',FrmH+19,FrmV+48,ClAqua,8);
Tekst('J',FrmH+24,FrmV+48,ClAqua,8);
Tekst('J',FrmH+29,FrmV+48,ClAqua,8);
Tekst('A',FrmH+34,FrmV+48,ClAqua,8);
Tekst('S',FrmH+39,FrmV+48,ClAqua,8);
Tekst('O',FrmH+44,FrmV+48,ClAqua,8);
Tekst('N',FrmH+49,FrmV+48,ClAqua,8);
Tekst('D',FrmH+53,FrmV+48,ClAqua,8);
End;
//************************************************************************

Var
  Avrg, MndScore : Real;
  StartDtm , EindDtm : TDateTime;
  i,j,tllr,Jr,DitJr,JrB,JrE,Mnd,Dg,FrmH,FrmV : integer;
  MndPrctg: Array[1..12] Of Real;
  JrAvrg  : Array[1980..2030] Of Real;
  HLArray : Array[1980..2030] Of Array[1..12] of Real;
  Tabel   : Array[1980..2030] Of Array[1..12] Of Real;

Begin
Indicator.NewBand := False;
Indicator.ScaleRange := srCommon;

StartDtm :=
   EnCodeDate(CreateParameterInteger('Start-Jaar:',1981,2030,2014,False),01,01);
EindDtm  :=
 EnCodeDate(CreateParameterInteger('Laatste Jaar:',1981,2030,2018,False),12,31);
FrmH     := CreateParameterInteger('Verplaats Frame Horizontaal',2,46,46,False);
FrmV     := CreateParameterInteger('Verplaats Frame Verticaal',0,55,0,False);

DecodeDate(now,DitJr,Mnd,Mnd);
DecodeDate(EindDtm,Jr,Mnd,Mnd);
If Jr>= DitJr Then
 Begin
  Jr := DitJr-1;
  EindDtm := EnCodeDate(Jr,12,31);
 End;

For i := 1 To BarCount-1 Do
Begin
 If(DateTime[i]>=StartDtm) And (DateTime[i]<= EindDtm) Then
  Begin
   DecodeDate(DateTime[i],Jr,Mnd,Dg);
   If (Jr>=1980) And (Jr<=2030)Then
   Tabel[Jr][Mnd]:= C[i];
  End;
End;

DecodeDate(StartDtm,JrB,Mnd,Dg);
DecodeDate( EindDtm,JrE,Mnd,Dg);
JrB := Trunc(JrB);
JrE := Trunc(JrE);

Teksten(FrmH,FrmV,JrB,JrE);

For i := JrB To JrE Do
 Begin
  Avrg := 0;
  For j := 1 To 12 Do
   Begin
    Avrg := Avrg + Tabel[i][j];
   End;
  JrAvrg[i] :=  Avrg/12.0;
 End;

For i := JrB To JrE Do
 Begin
  For j := 1 To 12 Do
   Begin
    If Tabel[i][j]>JrAvrg[i] Then
      HLArray[i][j] :=1
     Else HLArray[i][j] := 0;
   End;
 End;

For j :=1 To 12 Do
 Begin
  MndScore := 0;
   For i := JrB To JrE do
    Begin
     MndScore := MndScore + HLArray[i][j];
    End;
   MndPrctg[j] := (MndScore/(JrE-JrB+1)*100)
 End;

Rechthoek(FrmH,FrmH+54,FrmV+5,FrmV+45,ClWhite,ClGray);

For i:= 1 To 9 Do
Begin
Streepje(FrmH,FrmH+54,FrmV+Trunc((4*i)+5),FrmV+Trunc((4*i)+5),1,ClBlue,LsSolid);
 If (i=5) Then
 Streepje(FrmH,FrmH+54,FrmV+Trunc((4*i)+5),FrmV+Trunc((4*i)+5),1,ClRed,LsSolid);
End;
 
For i:= 1 To 10 Do
 Begin
  Streepje(FrmH,FrmH+54,FrmV+Trunc((4*i)+3),FrmV+Trunc((4*i)+3),1,ClGray,LsDot);
  If (i=3) Or (i=8) Then
  Streepje(FrmH,FrmH+54,FrmV+Trunc((4*i)+3),FrmV+Trunc((4*i)+3),2,ClRed,LsDot);
 End;
  
tllr := 0;
For i := 1 To 11 Do
 Begin
 Streepje((FrmH+tllr),(FrmH+5+tllr),FrmV+5+Round((MndPrctg[i]/2)*0.8),
                       FrmV+5+Round((MndPrctg[i+1]/2)*0.8),2,ClBlack,LsSolid);
 Streepje((FrmH+tllr),(FrmH+Tllr),FrmV+5,FrmV+45,1,ClGray,LsDot);
 tllr := tllr+5;
 End;
// je gelooft het vast niet, maar dit is alles wat er aan code nodig is ;)
End.

.
Vriendelijke groet,
JanS ;)

Janus
Berichten: 1293
Lid geworden op: wo jan 30, 2008 2:07 am
Contacteer:

Re: Seasonality

Bericht door Janus » ma sep 02, 2019 11:47 pm

@Vincent, bedankt voor de link naar Wealthlab, ik vind hun staafdiagram duidelijker dan mijn lijndiagram, ik ga dat de komende dagen even ombouwen.
.
Ik zat vandaag even te kijken met deze indicator naar diverse aandelen, en ik dacht: hoe zou dit verlopen met bijvoorbeeld een bedrijf als Volkswagen, zit daar een soort van seasonal patroon in?
Wel, in VW zit een duidelijker patroon dan in bijvoorbeeld Volvo.
.
Heel opvallend, in VW, in de afgelopen 5 jaar, van begin 2014 tot en met einde 2018 (is vijf jaar ;) ) viel in 100% van de gevallen een top in April en een bodem in September, de vraag is of dit jaar hetzelfde verloopt.
In dit jaar zien we, tot nu toe, een top in April en een bodem in Augustus waarna de koers weer stijgt, maar .. September is nog niet voorbij …
Ik ben benieuwd ;)
Verder even een korte opmerking: ik betrap mezelf erop dat ik al snel verkeerde conclusies trek wat betreft de weergegeven resultaten uit het verleden met deze indicator, bedenk steeds goed wat ie weergeeft, en wat het vervolg kan zijn, wanneer dat dit jaar weer exact op dezelfde wijze -zou- verlopen.
Ik vind Volkswagen wel een opvallend voorbeeld, omdat al vijf jaar lang elke April maand een top laat zien en elke September maand een bodem, in 100% van de gevallen.
Dat is natuurlijk geen garantie voor de toekomst!
.
Grafiekje erbij ;)
Afbeelding
.
Vriendelijke groet,
JanS ;)

Janus
Berichten: 1293
Lid geworden op: wo jan 30, 2008 2:07 am
Contacteer:

Re: Seasonality

Bericht door Janus » di sep 03, 2019 5:05 pm

Ik heb de code voor de seasonal-monthly van Perry J. Kaufman aangepast, er kan nu gekozen worden voor een staafdiagram of voor een lijndiagram.
Het diagram kunt u verschuiven naar die plek in de koersgrafiek die u uitkomt.

Plaatje d'rbij ;)
Afbeelding

TA-script code:

Code: Selecteer alles

{- Filename: Seasonal monthly -}
// Open een maandgrafiek
// Zorg ervoor dat de te meten periode in het venster zichtbaar is !!
// naar een idee van Perry J. Kaufman
// vertaling www.jstas.com versie 1.02  03-09-2019

VAR
 MndPrctg: Array[1..12] Of Real;
//****************************************************************************
Procedure
Streepje(Xx1,Xx2,Yy1,Yy2,Breed:Integer; Kleur:TColor; Lijntype:TLineType);
Begin
With CreateTrendLine(0,0,0,0) Do
 Begin
  X1PcT := Xx1;
  X2PcT := Xx2;
  Y1Pct := Yy1;
  Y2Pct := Yy2;
  Color := Kleur;
  Style := Lijntype;
  Width := Breed;
  DrawBehindChart := True;
 End;
End;
//****************************************************************************
Procedure Rechthoek(Xx1,Xx2,Yy1,Yy2: Integer;Kleur1,Kleur2 : TColor);
Begin
 With CreateRectangle(0,0,0,0) Do
  Begin
   Y1PcT := Yy1;
   Y2PcT := Yy2;
   X1Pct := Xx1;
   X2Pct := Xx2;
   BkColor := Kleur1;
   Color := Kleur2;
  End;
End;
//************************************************************************
Procedure Tekst(tkst:String;wrdH,WrdV:Integer;Kleur:TColor; Groot:Integer);
Begin
With CreateText(0,0,tkst) Do
 Begin
   X1Pct := WrdH;
   Y1Pct := WrdV;
   Color := Kleur;
   Font.Size := Groot;
 End;
End;
//**********************************************************************
Function KoersjarenControle(JrB:Integer):Integer;
Var
i,Jrc,Mnd,Dg : Integer;
Begin
For i:= 1 To BarCount-1 Do
 Begin
  If (i=1) Then
   Begin
     Result :=1;
     DecodeDate(DateTime[i],Jrc,Mnd,Dg);
      If (Jrc+1 > JrB) Then
       Begin
        Tekst('Te weinig koersen-jaren in scherm!!',30,50,ClRed,25);
        Result :=0;
       End;
   End;
   i:= BarCount;
 End;
End;
//*************************************************************************
 Function ControleEindDatum(EindDtm:TDateTime):TDateTime;
Var
Jr,DitJr,Mnd,Dg : Integer;
Begin
 DecodeDate(now,DitJr,Mnd,Dg);
 DecodeDate(EindDtm,Jr,Mnd,Dg);
 If Jr>= DitJr Then
  Begin
   Jr := DitJr-1;
   Tekst('Eind-datum aangepast!',5,5,ClRed,15);
   Result := EnCodeDate(Jr,12,31);
  End;
End;
//***************************************************************************
///
Procedure VulMaandPercentagetTabel(JrB,JrE:Integer;StartDtm,EindDtm:TDateTime);
Var
i,j,Jr,Mnd,Dg : Integer;
Avrg, MndScore : Real;
JrAvrg  : Array[1980..2030] Of Real;
HLArray : Array[1980..2030] Of Array[1..12] of Real;
Tabel   : Array[1980..2030] Of Array[1..12] Of Real;
Begin
For i := 1 To BarCount-1 Do
Begin
 If(DateTime[i]>=StartDtm) And (DateTime[i]<= EindDtm) Then
  Begin
   DecodeDate(DateTime[i],Jr,Mnd,Dg);
   If (Jr>=1980) And (Jr<=2030)Then
   Tabel[Jr][Mnd]:= C[i];
  End;
End;

For i := JrB To JrE Do
 Begin
  Avrg := 0;
  For j := 1 To 12 Do
   Begin
    Avrg := Avrg + Tabel[i][j];
   End;
  JrAvrg[i] :=  Avrg/12.0;
 End;

For i := JrB To JrE Do
 Begin
  For j := 1 To 12 Do
   Begin
    If Tabel[i][j]>JrAvrg[i] Then
      HLArray[i][j] :=1
     Else HLArray[i][j] := 0;
   End;
 End;

For j :=1 To 12 Do
 Begin
  MndScore := 0;
   For i := JrB To JrE do
    Begin
     MndScore := MndScore + HLArray[i][j];
    End;
   MndPrctg[j] := (MndScore/(JrE-JrB+1)*100)
 End;
End;
//*******************************************************************
Procedure Teksten(FrmH,FrmV,JrB,JrE:Integer);
Begin
Tekst
('Gemeten periode '+IntToStr(JrB)+' t/m '+ IntToStr(JrE),FrmH,FrmV+5,ClRed,10);
Tekst('Monthly Seasonal Perry J. Kaufman',60,103,ClBLue,10);
Tekst(' 0',FrmH-2,FrmV+6 ,ClRed,8);
Tekst('25',FrmH-2,FrmV+16,ClRed,8);
Tekst('50',FrmH-2,FrmV+26,ClRed,8);
Tekst('75',FrmH-2,FrmV+36,ClRed,8);
Tekst('%',FrmH-2,FrmV+45,ClRed,10);
Tekst('J',FrmH-1 ,FrmV+48,ClAqua,8);
Tekst('F',FrmH+4 ,FrmV+48,ClAqua,8);
Tekst('M',FrmH+9 ,FrmV+48,ClAqua,8);
Tekst('A',FrmH+14,FrmV+48,ClAqua,8);
Tekst('M',FrmH+19,FrmV+48,ClAqua,8);
Tekst('J',FrmH+24,FrmV+48,ClAqua,8);
Tekst('J',FrmH+29,FrmV+48,ClAqua,8);
Tekst('A',FrmH+34,FrmV+48,ClAqua,8);
Tekst('S',FrmH+39,FrmV+48,ClAqua,8);
Tekst('O',FrmH+44,FrmV+48,ClAqua,8);
Tekst('N',FrmH+49,FrmV+48,ClAqua,8);
Tekst('D',FrmH+53,FrmV+48,ClAqua,8);
End;
//************************************************************************
Procedure Teksten2(FrmH,FrmV,JrB,JrE:Integer);
Begin
Tekst
('Gemeten periode '+IntToStr(JrB)+' t/m '+ IntToStr(JrE),FrmH,FrmV+5,ClRed,10);
Tekst('Monthly Seasonal Perry J. Kaufman',60,103,ClBLue,10);
Tekst(' 0',FrmH-2,FrmV+6 ,ClRed,8);
Tekst('25',FrmH-2,FrmV+16,ClRed,8);
Tekst('50',FrmH-2,FrmV+26,ClRed,8);
Tekst('75',FrmH-2,FrmV+36,ClRed,8);
Tekst('%',FrmH-2,FrmV+45,ClRed,10);
Tekst('J',FrmH+2 ,FrmV+48,ClRed,8);
Tekst('F',FrmH+5 ,FrmV+48,ClRed,8);
Tekst('M',FrmH+8 ,FrmV+48,ClRed,8);
Tekst('A',FrmH+11,FrmV+48,ClRed,8);
Tekst('M',FrmH+14,FrmV+48,ClRed,8);
Tekst('J',FrmH+17,FrmV+48,ClRed,8);
Tekst('J',FrmH+20,FrmV+48,ClRed,8);
Tekst('A',FrmH+23,FrmV+48,ClRed,8);
Tekst('S',FrmH+26,FrmV+48,ClRed,8);
Tekst('O',FrmH+29,FrmV+48,ClRed,8);
Tekst('N',FrmH+32,FrmV+48,ClRed,8);
Tekst('D',FrmH+35,FrmV+48,ClRed,8);
End;

//************************************************************************
Procedure LeegLijnDiagram(FrmH,FrmV,JrB,JrE :Integer);
Var
i,Tllr : Integer;
Begin
Rechthoek(FrmH,FrmH+54,FrmV+5,FrmV+45,ClWhite,ClGray);
For i:= 1 To 9 Do
Begin
Streepje(FrmH,FrmH+54,FrmV+Trunc((4*i)+5),FrmV+Trunc((4*i)+5),1,ClBlue,LsSolid);
 If (i=5) Then
 Streepje(FrmH,FrmH+54,FrmV+Trunc((4*i)+5),FrmV+Trunc((4*i)+5),1,ClRed,LsSolid);
End;

For i:= 1 To 10 Do
 Begin
  Streepje(FrmH,FrmH+54,FrmV+Trunc((4*i)+3),FrmV+Trunc((4*i)+3),1,ClGray,LsDot);
  If (i=3) Or (i=8) Then
  Streepje(FrmH,FrmH+54,FrmV+Trunc((4*i)+3),FrmV+Trunc((4*i)+3),2,ClRed,LsDot);
 End;

Tllr := 0;
For i:= 1 To 11 Do
 Begin
  Streepje((FrmH+tllr),(FrmH+Tllr),FrmV+5,FrmV+45,1,ClGray,LsDot);
  Tllr := Tllr+5;
 End;
 
Teksten(FrmH,FrmV,JrB,JrE);

End;
//**************************************************************************
Procedure Lijnweergave(FrmH,FrmV:Integer);
Var
i, Tllr : Integer;
Begin
tllr := 0;
For i := 1 To 11 Do
 Begin
  Streepje((FrmH+tllr),(FrmH+5+tllr),FrmV+5+Round((MndPrctg[i]/2)*0.8),
                       FrmV+5+Round((MndPrctg[i+1]/2)*0.8),2,ClBlack,LsSolid);
  tllr := tllr+5;
 End;
End;
//**************************************************************************
Procedure LeegStaafDiagram(FrmH,FrmV,JrB,JrE:Integer);
Var
i,Tllr : Integer;
Begin
Rechthoek(FrmH,FrmH+37,FrmV+5,FrmV+45,ClWhite,ClGray);
Tllr := 0;
For i := 1 To 12 Do
 Begin
  Streepje(FrmH+2+Tllr,FrmH+2+Tllr,FrmV+5,FrmV+45,1,ClGray,LsDot);
  Tllr := Tllr+3;
 End;
 
For i:= 1 To 9 Do
Begin
Streepje(FrmH,FrmH+37,FrmV+Trunc((4*i)+5),FrmV+Trunc((4*i)+5),1,ClGray,LsSolid);
 If (i=5) Then
 Streepje(FrmH,FrmH+37,FrmV+Trunc((4*i)+5),FrmV+Trunc((4*i)+5),1,ClRed,LsSolid);
End;

For i:= 1 To 10 Do
 Begin
  Streepje(FrmH,FrmH+37,FrmV+Trunc((4*i)+3),FrmV+Trunc((4*i)+3),1,ClGray,LsDot);
  If (i=3) Or (i=8) Then
  Streepje(FrmH,FrmH+37,FrmV+Trunc((4*i)+3),FrmV+Trunc((4*i)+3),2,ClRed,LsDot);
 End;
 
Teksten2(FrmH,FrmV,JrB,JrE);
End;
//**************************************************************************

Procedure StaafProc(FrmH,FrmV : Integer);
Var
Tllr, i : Integer;
Begin
Tllr := 0;
For i := 1 To 12 Do
 Begin
  Rechthoek((FrmH+1+tllr),(FrmH+3+tllr),FrmV+5+Round((MndPrctg[i]/2)*0.8),
                                                         FrmV+5,ClBlue,ClBlue);
  If (Round((MndPrctg[i]/2)*0.8)=0) Then
         Rechthoek ((FrmH+1+tllr),(FrmH+3+tllr),FrmV+5+1,FrmV+5,ClBlue,ClBlue);
  Tllr := Tllr +3;
 End;
End;
//***********************************************************************

Var
StartDtm , EindDtm : TDateTime;
JrB,JrE,Mnd,Dg,FrmH,FrmV,StfLijn,Doorgaan : integer;

Begin
Indicator.NewBand := False;
Indicator.ScaleRange := srCommon;

StartDtm :=
   EnCodeDate(CreateParameterInteger('Start-Jaar:',1981,2030,2014,False),01,01);
EindDtm  :=
 EnCodeDate(CreateParameterInteger('Laatste Jaar:',1981,2030,2018,False),12,31);
FrmH     := CreateParameterInteger('Verplaats Frame Horizontaal',2,63,6,False);
FrmV     := CreateParameterInteger('Verplaats Frame Verticaal',0,55,50,False);
StfLijn  :=
      CreateParameterSelect('Diagram:','Lijn-diagram'#9'Staaf-diagram',1,False);

EindDtm :=ControleEindDatum(EindDtm);
DecodeDate(StartDtm,JrB,Mnd,Dg);
DecodeDate( EindDtm,JrE,Mnd,Dg);
Doorgaan := KoersjarenControle(JrB);

If (Doorgaan=1) Then
 Begin
  VulMaandPercentagetTabel(JrB,JrE,StartDtm,EindDtm);
   If (StfLijn=0) Then
    Begin
     If FrmH>=46 Then FrmH := 46;
     LeegLijndiagram(FrmH,FrmV,JrB,JrE);
     LijnWeergave(FrmH,FrmV);
    End;
   If (StfLijn=1) Then
    Begin
     LeegStaafDiagram(FrmH,FrmV,JrB,JrE);
     StaafProc(FrmH,FrmV);
    End;
 End;
// je gelooft het vast niet, maar dit is alles wat er aan code nodig is ;)
End.

.
Vriendelijke groet,
JanS ;)

Rombout Kerstens
Berichten: 97
Lid geworden op: wo sep 14, 2005 6:27 pm
Locatie: Kantoor Keyword BV
Contacteer:

Re: Seasonality

Bericht door Rombout Kerstens » wo okt 02, 2019 2:28 pm

Ik vind het een sterk staaltje programmeerwerk Jan!

Ik denk dat Perry Kaufman het zelf trouwens ook wel zou waarderen 8)

Thanx, Rombout.

tmp1.jpg

Janus
Berichten: 1293
Lid geworden op: wo jan 30, 2008 2:07 am
Contacteer:

Re: Seasonality

Bericht door Janus » do okt 03, 2019 1:28 am

Hallo Rombout, fijn dat je het een mooie indicator vindt. Ik heb op dit forum leren te programmeren met de hulp van Eric. Ik had al enige ervaring met dbase en later toen dbase een compiler kreeg met clipper. Maar met ta-script (pascal?) heb je meer mogelijkheden. Met vallen en opstaan de afgelopen jaren, en met de nodige ondersteuning van Eric, heb ik ta-script een beetje onder de knie gekregen, zonder de nimmer aflatende hulp van Eric was dit nooit gelukt!
Vriendelijke groet,
JanS ;)

Plaats reactie