Krzyż śmierci na S&P500 - czy faktycznie ma znaczenie?

 Niektórzy zwrócili niedawno uwagę, że na S&P 500 występuje tzw. krzyż śmierci, czyli 50-dniowa średnia krocząca przecinająca od góry 200-dniową średnią kroczącą:

Na ten sygnał zwrócił m.in. portal xyz.pl , dodając jednak notkę, że analitycy firmy LPL Financial zaobserwowali, że historycznie w ciągu kolejnego miesiąca indeks spadał średnio niecały 1%, a w ciągu 3 miesięcy nawet rósł. Mowa jednak o medianie, a więc średnia i dominanta mogły się sporo różnić. Podanie samej mediany jest niewystarczające.

Sprawdźmy jak to rzeczywiście wyglądało dotychczas. Zaczniemy tak jak ta firma od 1950 r. Trzeba precyzyjnie określić warunki. Nie wystarczy, że SMA50 przetnie SMA200 z góry w dół, bo za chwilę może jeszcze zawrócić i średnie mogą się znowu dotknąć albo w ogóle SMA50 może przebić z dołu w górę. Jeśli taka sytuacja dzieje się w np. w ciągu tygodnia, to sygnału nie będzie. Tak więc określamy minimalne okno tego zdarzenia. Przyjmę cały tydzień, co oznacza 3 kroki do tyłu i 3 kroki do przodu od momentu przecięcia. Taki układ warunków jest już wystarczający, chociaż może nie być przekonujący, bo nawet po przecięciu się obie średnie mogą rosnąć. Tak na intuicję wydaje się, że  powinny spadać. Z drugiej strony już sama nazwa "krzyż" sugeruje dowolne przecięcie, np. rosnącej SM200 i spadkowej SMA50. Z powodu tej różnicy w interpretacji krzyża śmierci, zrobimy 2 sprawdziany:

1) Są warunki: (a) SMA50 <= SMA200, (b) SMA50[t-3] > SMA200[t-3], (c) SMA50[t+3] < SMA200[t+3] ,

2) To samo co p. (1) i dodatkowo warunek, że obie średnie spadają.

Ostatnia sprawa to sam okres przyszłej stopy zwrotu. Sprawdzimy 1-3 miesięczne zwroty do przodu. Za 1 miesiąc przyjmiemy 21 dni, czyli 21 sesji.

Ad 1) Kod w R: 

# 1. Pobieramy dane S&P500, ładujemy pakiety, np. xts.

# 2. Przekształcamy ceny na logarytmy

logCena <- log(sp500)

# 3. Obliczamy 50-dniową i 200-dniową średnią kroczącą

sma50  <- SMA(logCena, n = 50)

sma200 <- SMA(logCena, n = 200)

# 4. Ustalamy wartość przesunięcia (krok) dla warunków – tu krok = 3

krok <- 3

# Warunki dla sygnału

war1 <- sma50 <= sma200

war2 <- lag(sma50, k = krok) > lag(sma200, k = krok)           # SMA50[t-krok] > SMA200[t-krok]

war3 <- lag(sma50, k = -krok) < lag(sma200, k = -krok)                # SMA50[t+krok] < SMA200[t+krok]

war4 <- TRUE

# 5. Tworzymy wektor sygnału: 1, gdy wszystkie warunki są spełnione, NA w przeciwnym przypadku

sygnal <- ifelse(war1 & war2 & war3 & war4, 1, 0)

sygnal <- na.omit(sygnal)

datySygnalow <- index(sygnal)

# Przypisujemy daty wszystkich sygnałów

print("Daty sygnałów (pełny szereg):")

print(datySygnalow)

# 6. Teraz dodajemy warunek, aby wyłapać jedynie moment przejścia z 0 na 1.

# To pozwala zachować tylko pierwszy dzień pojawienia się sygnału.

sygnal_krok1 <- lag(sygnal, k = 1)  # przesunięcie danych o jeden dzień do tyłu (opóźnione)

sygnal_krok1[is.na(sygnal_krok1)] <- 0  # traktujemy pierwszy dzień jako 0

unikalneDatySygnalow <- which(sygnal_krok1 == 0 & sygnal == 1)

unikalneDatySygnalow <- datySygnalow[unikalneDatySygnalow] 

print("Unikalne daty sygnału (przejście z 0 na 1):")

print(unikalneDatySygnalow)

# 7. Obliczamy dzienne logarytmiczne stopy zwrotu

logZwrot <- na.omit(diff(logCena))

# 8. Używamy rollapply do sumowania logarytmicznych stóp zwrotu na horyzoncie 21 sesji,

# ale dnia następnego po sygnale 

oknoPrzyszlosci <- 21

logZwrot_suma <- lag(rollapply(logZwrot,

                           width = oknoPrzyszlosci,

                           FUN = sum,

                           align = "left"), -1)

# 9. Przekształcamy sumy logarytmicznych stóp zwrotu na zwykłe stopy zwrotu: exp(sum) - 1

miesZwrot <- exp(logZwrot_suma) - 1

# 10. Dopasowujemy daty unikalnych sygnałów do obliczonych miesięcznych stóp zwrotu

wyniki <- data.frame(Date = unikalneDatySygnalow,

                     MonthlyReturn = as.numeric(miesZwrot[unikalneDatySygnalow]))

wyniki <- na.omit(wyniki)

print("Wyniki (data unikalnego sygnału + miesięczna stopa zwrotu):")

print(wyniki)

mean(wyniki$MonthlyReturn)

# 11. Rysujemy histogram miesięcznych stóp zwrotu dla wyłapanych sygnałów

h <- hist(wyniki$MonthlyReturn,

     breaks = 7,

     col = "lightblue",

     border = "black",

     main = "Histogram miesięcznych stóp zwrotu",

     xlab = "Stopa zwrotu",

     ylab = "Liczba sygnałów",

     freq = NULL)

# 12. Przekształcamy liczebności na prawdopodobieństwa

czestosc <- h$counts / sum(h$counts)

# 13. Ustawiamy układ dwóch wykresów oraz marginesy

par(mfrow = c(2, 1), mar = c(2, 5, 2.2, 3))

slupkiZwrotow <- 100 * round(h$mids, 3)

# 14. Rysujemy wykres słupkowy prawdopodobieństwa 1-miesięcznych stóp zwrotu

b <- barplot(czestosc,

             names.arg = slupkiZwrotow,

             col       = "lightblue",

             border    = "black",

             main      = "Prawdopodobieństwo 1-miesięcznych stóp zwrotu",

             xlab      = "",

             ylab      = "Prawdopodobieństwo",

             yaxt      = "n",

             space     = 0,

             cex.main  = 0.9)

# 15. Dodajemy oś Y z wartościami prawdopodobieństwa

axis(2, at = round(czestosc, 2), las = 2, cex = 0.7)

# 16. Zaznaczamy dominantę prawdopodobieństwa linią pionową

abline(v  = b[which.max(czestosc)],

       col  = "red",

       lty  = 2,

       lwd  = 2)

# 17. Rysujemy wykres słupkowy skumulowanego prawdopodobieństwa

par(mar = c(4, 5, 1.5, 3))

barplot(cumsum(czestosc),

        names.arg = slupkiZwrotow,

        col       = "lightblue",

        border    = "black",

        main      = "Skumulowane prawdopodobieństwo 1-miesięcznych stóp zwrotu",

        xlab      = "",

        ylab      = "Prawdopodobieństwo",

        yaxt      = "n",

        space     = 0,

        cex.main  = 0.9)

# 18. Dodajemy oś Y z wartościami skumulowanego prawdopodobieństwa

axis(2, at = round(cumsum(czestosc), 2), las = 2, cex = 0.7)

# 19. Dodajemy opis osi X

mtext(text = "Stopa zwrotu, 1-miesięczna (%)", side = 1, padj = 3.5)

# 20. Zaznaczamy dominantę skumulowanego prawdopodobieństwa linią poziomą

abline(h    = cumsum(czestosc)[which.max(czestosc)],

       col  = "red",

       lty  = 2,

       lwd  = 2)

# 21. Zaznaczamy dominantę pojedynczego prawdopodobieństwa linią pionową

abline(v    = b[which.max(czestosc)],

       col  = "red",

       lty  = 2,

       lwd  = 2)

Liczba przypadków = 35.

Otrzymane statystyki:

Okazuje się, że dominuje ujemna stopa zwrotu z medianą -2,5%, ale jej częstość to niecałe 0,4, a  skumulowane prawdopodobieństwo empiryczne 0,57. Oznacza to, że na prawie 60% będzie spadać w kolejnym miesiącu.  Skośność jednak powoduje, że sporo też jest dodatnich stóp zwrotu wokół +2,5%.

Sprawdzamy 2-miesięczne zwroty, tj. oknoPrzyszlosci <- 42.

 W kolejnych dwóch miesiącach po krzyżu śmierci dominowały wzrosty z medianą 2,5%, ale znów skośność powoduje duże ryzyko spadków.

3-miesięczna stopa zwrotu (oknoPrzyszlosci <- 63):

Po 3 miesiącach dostajemy w zasadzie czystą przypadkowość - możliwe są zarówno wzrosty jak i spadki.

Ad 2) Cały kod będzie ten sam, jedynie war4 przyjmuje teraz postać

war4 <- lag(diff(sma50, lag = krok*2 + 1), k = -krok) < 0 & lag(diff(sma200, lag = krok*2 + 1), k = -krok) < 0  # oba spadają

Dostałem 20 przypadków.

a) miesięczne zwroty:

Dostajemy tu zbliżone wyniki do pierwszej definicji krzyża śmierci, z tym, że w tym przypadku prawdopodobieństwa spadków są wyższe niż poprzednio, bo aż 0,75.

b) 2-miesięczne zwroty:

Dominanta praktycznie nie istnieje. Można tylko powiedzieć, że zwroty przechylają się minimalnie na plus.

c) 3-miesięczne zwroty

Prawdopodobieństwo 3-miesięcznych wzrostów jest w tym wypadku obiektywnie większe niż spadków (chociaż okolice do -0% też nie jest takie małe). 

Porównując otrzymane statystyki ze wspomnianym na początku badaniem mogę powiedzieć, że się one pokrywają. Oni dostali średniomiesięcznie (medianę) -1%, ja dostałem dominantę -2,5%, a przy skumulowanym prawdopodobieństwie 0,57, a 0,57*2,5 = 1,43. Podobnie jak oni dostałem także dodatnią 3-miesięczną średnią. 

Naturalne staje się na koniec pytanie, czy bieżący krzyż śmierci spełnia w ogóle określone definicje? Jeśli spełnia drugą, to oczywiście spełnia też pierwszą (bo druga jest mocniejsza), więc sprawdzamy najpierw drugą. Wszystkie sygnały są zapisane w zmiennej unikalneDatySygnalow:

> unikalneDatySygnalow
 [1] "1953-05-11" "1957-09-26" "1960-02-15" "1962-05-08" "1965-07-22" "1968-02-27" "1969-06-23"
 [8] "1977-03-03" "1980-04-22" "1984-02-06" "1987-11-04" "1990-09-07" "1994-04-19" "2000-10-30"
[15] "2010-07-02" "2011-08-12" "2015-08-28" "2016-01-11" "2018-12-07" "2020-03-27" "2025-04-14"

Ostatnia pozycja to właśnie ostatni sygnał z 14 kwietnia. Czyli druga definicja zostaje spełniona. Stąd wnioskujemy, że kolejne 21 sesji będzie spadkowych, z "prawdopodobieństwem" 0,75. To znaczy, że do połowy maja należy spodziewać się generalnie spadków. Kolejne 2 miesiące są niejednoznaczne, z lekkim przechyleniem na plus, a 3 miesiące "powinny" być dodatnie. Trudno mi uwierzyć w to ostatnie, ale wszystkiego trzeba się spodziewać przy takim rozedrganiu, z jakim mamy do czynienia.