2021年5月23日日曜日

行列 転置 問題 バグ?

 
len <- 5
mdf <- matrix(1:60,ncol=12,byrow=T)

> ((mdf %>% last(.,len) %>% t() %>% as.vector()) /rep(1:12 ,len)   %>% matrix(.,nrow=12)) 
      [,1]      [,2]      [,3]      [,4]      [,5]
 [1,]    1 13.000000 25.000000 37.000000 49.000000
 [2,]    1  7.000000 13.000000 19.000000 25.000000
 [3,]    1  5.000000  9.000000 13.000000 17.000000
 [4,]    1  4.000000  7.000000 10.000000 13.000000
 [5,]    1  3.400000  5.800000  8.200000 10.600000
 [6,]    1  3.000000  5.000000  7.000000  9.000000
 [7,]    1  2.714286  4.428571  6.142857  7.857143
 [8,]    1  2.500000  4.000000  5.500000  7.000000
 [9,]    1  2.333333  3.666667  5.000000  6.333333
[10,]    1  2.200000  3.400000  4.600000  5.800000
[11,]    1  2.090909  3.181818  4.272727  5.363636
[12,]    1  2.000000  3.000000  4.000000  5.000000
> (mdf %>% last(.,len) %>% t() %>% as.vector()) /rep(1:12 ,len)   %>% matrix(.,nrow=12)
      [,1]      [,2]      [,3]      [,4]      [,5]
 [1,]    1 13.000000 25.000000 37.000000 49.000000
 [2,]    1  7.000000 13.000000 19.000000 25.000000
 [3,]    1  5.000000  9.000000 13.000000 17.000000
 [4,]    1  4.000000  7.000000 10.000000 13.000000
 [5,]    1  3.400000  5.800000  8.200000 10.600000
 [6,]    1  3.000000  5.000000  7.000000  9.000000
 [7,]    1  2.714286  4.428571  6.142857  7.857143
 [8,]    1  2.500000  4.000000  5.500000  7.000000
 [9,]    1  2.333333  3.666667  5.000000  6.333333
[10,]    1  2.200000  3.400000  4.600000  5.800000
[11,]    1  2.090909  3.181818  4.272727  5.363636
[12,]    1  2.000000  3.000000  4.000000  5.000000

# Correct!! use parse before pipe to t()
> ((mdf %>% last(.,len) %>% t() %>% as.vector()) /rep(1:12 ,len)   %>% matrix(.,nrow=12)) %>% t()
     [,1] [,2] [,3] [,4] [,5] [,6]     [,7] [,8]     [,9] [,10]    [,11] [,12]
[1,]    1    1    1    1  1.0    1 1.000000  1.0 1.000000   1.0 1.000000     1
[2,]   13    7    5    4  3.4    3 2.714286  2.5 2.333333   2.2 2.090909     2
[3,]   25   13    9    7  5.8    5 4.428571  4.0 3.666667   3.4 3.181818     3
[4,]   37   19   13   10  8.2    7 6.142857  5.5 5.000000   4.6 4.272727     4
[5,]   49   25   17   13 10.6    9 7.857143  7.0 6.333333   5.8 5.363636     5

# WRONG!!
> (mdf %>% last(.,len) %>% t() %>% as.vector()) /rep(1:12 ,len)   %>% matrix(.,nrow=12) %>% t()
     [,1] [,2]     [,3] [,4] [,5]     [,6]     [,7]  [,8]     [,9] [,10]    [,11]    [,12]
[1,]    1  3.0 3.666667 4.00  4.2 4.333333 4.428571 4.500 4.555556   4.6 4.636364 4.666667
[2,]    2  3.5 4.000000 4.25  4.4 4.500000 4.571429 4.625 4.666667   4.7 4.727273 4.750000
[3,]    3  4.0 4.333333 4.50  4.6 4.666667 4.714286 4.750 4.777778   4.8 4.818182 4.833333
[4,]    4  4.5 4.666667 4.75  4.8 4.833333 4.857143 4.875 4.888889   4.9 4.909091 4.916667
[5,]    5  5.0 5.000000 5.00  5.0 5.000000 5.000000 5.000 5.000000   5.0 5.000000 5.000000


>  ((mdf %>% last(.,len) %>% t() %>% as.vector()) /1:12)  %>% matrix(.,nrow=12)    
      [,1]      [,2]      [,3]      [,4]      [,5]
 [1,]    1 13.000000 25.000000 37.000000 49.000000
 [2,]    1  7.000000 13.000000 19.000000 25.000000
 [3,]    1  5.000000  9.000000 13.000000 17.000000
 [4,]    1  4.000000  7.000000 10.000000 13.000000
 [5,]    1  3.400000  5.800000  8.200000 10.600000
 [6,]    1  3.000000  5.000000  7.000000  9.000000
 [7,]    1  2.714286  4.428571  6.142857  7.857143
 [8,]    1  2.500000  4.000000  5.500000  7.000000
 [9,]    1  2.333333  3.666667  5.000000  6.333333
[10,]    1  2.200000  3.400000  4.600000  5.800000
[11,]    1  2.090909  3.181818  4.272727  5.363636
[12,]    1  2.000000  3.000000  4.000000  5.000000
>  ((mdf %>% last(.,len) %>% t() %>% as.vector()) /1:12)  %>% matrix(.,nrow=12)    %>% t()  #OK
     [,1] [,2] [,3] [,4] [,5] [,6]     [,7] [,8]     [,9] [,10]    [,11] [,12]
[1,]    1    1    1    1  1.0    1 1.000000  1.0 1.000000   1.0 1.000000     1
[2,]   13    7    5    4  3.4    3 2.714286  2.5 2.333333   2.2 2.090909     2
[3,]   25   13    9    7  5.8    5 4.428571  4.0 3.666667   3.4 3.181818     3
[4,]   37   19   13   10  8.2    7 6.142857  5.5 5.000000   4.6 4.272727     4
[5,]   49   25   17   13 10.6    9 7.857143  7.0 6.333333   5.8 5.363636     5

>  len
[1] 5
>  (mdf %>% last(.,len) %>% t() %>% as.vector()) /rep(seq(1,12,1),len)  %>% matrix(.,nrow=12)    %>% t() #WRONG
     [,1] [,2]     [,3] [,4] [,5]     [,6]     [,7]  [,8]     [,9] [,10]    [,11]    [,12]
[1,]    1  3.0 3.666667 4.00  4.2 4.333333 4.428571 4.500 4.555556   4.6 4.636364 4.666667
[2,]    2  3.5 4.000000 4.25  4.4 4.500000 4.571429 4.625 4.666667   4.7 4.727273 4.750000
[3,]    3  4.0 4.333333 4.50  4.6 4.666667 4.714286 4.750 4.777778   4.8 4.818182 4.833333
[4,]    4  4.5 4.666667 4.75  4.8 4.833333 4.857143 4.875 4.888889   4.9 4.909091 4.916667
[5,]    5  5.0 5.000000 5.00  5.0 5.000000 5.000000 5.000 5.000000   5.0 5.000000 5.000000
( (mdf %>% last(.,len) %>% t() %>% as.vector()) /rep(seq(1,12,1),len) ) %>% matrix(.,nrow=12)    %>% t() #OK
     [,1] [,2] [,3] [,4] [,5] [,6]     [,7] [,8]     [,9] [,10]    [,11] [,12]
[1,]    1    1    1    1  1.0    1 1.000000  1.0 1.000000   1.0 1.000000     1
[2,]   13    7    5    4  3.4    3 2.714286  2.5 2.333333   2.2 2.090909     2
[3,]   25   13    9    7  5.8    5 4.428571  4.0 3.666667   3.4 3.181818     3
[4,]   37   19   13   10  8.2    7 6.142857  5.5 5.000000   4.6 4.272727     4
[5,]   49   25   17   13 10.6    9 7.857143  7.0 6.333333   5.8 5.363636     5

2021年5月19日水曜日

1990年以降、景気後退期を除き、 VIX が40%急上昇した後の6カ月間にS&P500は平均10%のリターンを記録していると

  1. VIXの2営業日前との変化率を計算してwに代入する
  2. 40%以上上昇している日付のデータを抜き出す。同時に当該月のCLI1ヶ月デルタをcbind()する。二十九番目のエントリはCLIがまだ発表されていないため除去する。
  3. 当該月の月次データと6ヶ月後のデータを比較して変化率を計算する。


w <- VIX/lag(VIX,2)
w <- cbind(w[w[,4] > 1.4][-29],   delta=as.vector(diff(cli_xts$oecd)[substr(index(w[w[,4] > 1.4]),1,7)]) )

         VIX.Open VIX.High  VIX.Low VIX.Close VIX.Volume VIX.Adjusted    delta

2007-02-27 1.164265 1.776636 1.167954  1.730624        NaN     1.730624  0.11270
2008-09-29 1.049162 1.375391 1.137750  1.423522        NaN     1.423522 -0.83323
2010-01-22 1.203133 1.422549 1.207701  1.461991        NaN     1.461991  0.29017
2010-05-07 1.261941 1.547925 1.335158  1.643918        NaN     1.643918  0.01840
2011-08-08 1.501832 1.496726 1.451666  1.516109        NaN     1.516109 -0.26765
2011-11-01 1.384704 1.442352 1.385843  1.417448        NaN     1.417448 -0.02283
    <SKIP> 

to.monthly(GSPC)[substr(mondate(index(w[w[,7] > 0]))+6,1,7)][,4] /as.vector(to.monthly(GSPC)[substr(index(w[w[,7] > 0]),1,7)][,4])[-11]

        GSPC.Close

 8 2007   1.047746
 7 2010   1.025822
11 2010   1.083660
10 2013   1.099507
 7 2014   1.083070
12 2016   1.066689
 3 2017   1.089680
11 2017   1.097761
 2 2018   1.097983
12 2020   1.211522

平均は9.03%。

VIX TICK

original is here.

  • ファンドストラットのアナリスト、トム・リーは、滅多に見られない2つのシグナルが揃ったことで、強気相場をもたらすだろうと述べている。
  • 市場の恐怖指数である「VIX」は2日間で40%も急上昇し、「NYSE Tick Index」は2021年の最低水準まで急落した。
  • 過去のデータによると、VIXが急上昇すると「S&P500指数」も数カ月にわたって上昇する傾向があるとリーは言う。

ファンドストラット(Fundstrat)のトップアナリスト、トム・リー(Tom Lee)によると、株式市場の不安感を表す2つのシグナルの最近の動きは、市場に大規模な利益をもたらすものだという。

5月12日朝に公開したリポートでリーは、めったに起こらない2つのイベントが2021年5月11日に発生したことについて詳細を記し、それらは強気相場になるシグナルであることを説明した。

1つ目は、「恐怖指数」と呼ばれるVIX指数が、10日と11日の2日間で40%も急騰したことだ。リーによると、このようなことは1990年以降、20回しか起きていない。

2つ目は、ニューヨーク証券取引所のティック・インデックス(NYSE Tick Index:アップティック銘柄数からダウンティック銘柄数を引いた値を毎秒計測した指標)が、11日には取引開始直後に多くの売りが発生したことで史上最低となるマイナス2069まで急落したこと。これまでにマイナス1800を割り込んだのはわずか10回だけだという。

リーは、これらの出来事は市場のパニックを示していることから、強気相場となるシグナルとみなすことができると述べている。このパニックは、投資家のスタンレー・ドラッケンミラー(Stanley Druckenmiller)の連邦準備制度理事会に関する警告や、マージンコール、あるいは単に「相場の下落」に関連している可能性があるという。

「多くの投資家は、5月11日のNYSE Tick Indexの急落やVIXの急上昇をネガティブなサインと見るかもしれないが、意外にもこれらは強気のシグナルだ」とリーは言う。

「まず、強気相場は『エスカレーターに乗って、エレベーターで落ちる』ということを覚えておいてほしい。つまり、強気相場では、株価は着実に上昇して、その後、急落する。従って、VIXが急上昇し、NYSE Tick Indexが大幅にマイナスになるのはポジティブであると読むことができる」

また、1990年以降、景気後退期を除き、VIXが40%急上昇した後の6カ月間にS&P500は平均10%のリターンを記録していると、リーは付け加えた。市場が景気後退期に突入しない限り、VIXがこれほど大きく急上昇するのは「単なるパニック・リセット」だとリーは言う。

NYSE Tick Indexがマイナス1800を下回った場合、S&P500はその後の6カ月間で平均22%のリターンを記録している。

これは株価が急騰するための絶好の状況であり、プルバック(トレンドとは逆方向の値動き)するまでにS&P500は6%近く跳ね上がって4400に達する可能性があるとリーは述べている。

「結論として、我々はVIXの急上昇とTick Indexの急落をキャピチュレーション(弱気相場での投げ売り)によるものだと見ている。そして投資家がテクノロジー分野からエピセンター(パンデミックの影響を最も強く受けた産業)の銘柄に関心を移していることを意味すると考える」とリーは述べ、旅行、飲食業、ホスピタリティといった産業の回復に連動する銘柄を集めたリストを紹介した。

2021年5月15日土曜日

HiraKakuPro-W3 scale_fill_hue tidyr  gather 日本語 行列 matrix axis.ticks.x axis.text.x How to erase x-axis lable X軸のラベルを消すには 横並び 棒グラフ

 

  1. 都道府県別データから指定された期間の新規陽性者データを抜き出す。
  2. 抜き出したデータをベクターに変換し、都道府県の人口で割り人口あたりの新規陽性者データを算出する。
  3. 算出したデータを行列、さらにdata frame に変換する。
  4. 3. をtidyr::gather を使用してggplot 用に変換する。
  5. X軸テキスト消去の参考にしたのはこちら


len <- 90
target <- c(1,13,27,40,47)
data <- mdf
# wdf <- ( ((mdf[,-48] %>% last(.,len) %>% t() %>% as.vector()) /rep(as.vector(pref_pop[,1]) ,len) %>% matrix(.,nrow=47) %>% t() %>% data.frame() )%>% cbind(.,t=last(mdf$t,len)) ) <- BUG
# wdf <-  ((mdf[,-48] %>% last(.,len) %>% t() %>% as.vector()) /rep(as.vector(pref_pop[,1]) ,len) %>% matrix(.,nrow=47)) %>% t() %>% data.frame() %>% cbind(.,t=last(mdf$t,len))
wdf <- ((data[,-48] %>% last(.,len) %>% t() %>% as.vector()) /rep(as.vector(pref_pop[,1]) ,len) %>% matrix(.,nrow=47)) %>% t() %>% data.frame() %>% cbind(.,t=last(data$t,len))
colnames(wdf)[-48] <- pref_en
# df <- (wdf %>% tidyr::gather(reg_name,value,-t))
df <- (wdf %>% tidyr::gather(reg_name,value,target))
p <- ggplot(df,aes(x=t, y=value,fill=reg_name)) 
# p <- p +scale_fill_brewer(palette="Accent")
# p <- p+geom_bar(stat="identity",width=1,position = "fill")
p <- p+geom_bar(stat="identity",width=1,position = "dodge")
# p <- p + geom_histogram(bins=len,position = "fill", alpha = 0.9)

p <- p + theme_gray (base_family = "HiraKakuPro-W3")
p <- p + scale_fill_hue(name="都道府県",labels=pref_jp[target])
p <- p + theme(panel.background = element_rect(fill = "grey90",
                                               colour = "lightblue"))
plot(p)



wdf[,-48] %>% apply(.,2,sum)
df <- wdf[,-48] %>% apply(.,2,sum)
df <- data.frame(df)
df <- cbind(df,region=rownames(df))

p <- ggplot(df, aes(x = region, y = df, fill = region))
p <- p + geom_bar(stat = "identity")
p <- p + theme_gray (base_family = "HiraKakuPro-W3")
# p <- p + theme(axis.ticks.x=element_line(size=8))
p <- p + theme(axis.ticks.x=element_blank())
# p <- p + theme(axis.text.x=element_blank())
# p <- p + theme(axis.text.x=element_line(size=8)) # NG
p <- p + ylab("人口千人あたり") + xlab("")
p <- p + scale_fill_hue(name="都道府県",labels=pref_jp)
p <- p + scale_x_discrete(label=substr(pref_jp,1,1))
p <- p+theme(legend.position = 'none')    # legend terminate 凡例 消去
p <- p + theme(axis.text.x = element_text(angle = 90, hjust = 1))  # x軸 縦書き
plot(p)

"p <- p + theme(axis.text.x = element_text(angle = 90, hjust = 1))"でラベルを横倒し縦書きにできる。



2021年5月10日月曜日

横並び棒グラフ dodge tidyr gather 三指数

 
> last(dmdf,3)
    01Hokkaido 02Aomori 03Iwate 04Miyagi 05Akita 06Yamagata 07Fukushima 08Ibaraki 09Tochigi 10Gunma 11Saitama 12Chiba 13Tokyo 14Kanagawa
477          4        0       0        1       0          0           1         0         1       2         1       7       6          6
478          3        2       1        0       0          0           0         0         0       0         1       5       6          2
479          7        0       1        2       0          1           1         0         0       0         2       1       3          4
    15Niigata 16Toyama 17Ishikawa 18Fukui 19Yamanashi 20Nagano 21Gifu 22Shizuoka 23Aichi 24Mie 25Shiga 26Kyoto 27Osaka 28Hyogo 29Nara
477         0        1          1       0           0        2      1          1       3     1       3       0      50      39      4
478         0        0          4       0           0        0      0          0       2     0       0       2      41       6      0
479         0        0          1       0           0        0      0          0       5     0       0       0      19       8      0
    30Wakayama 31Tottori 32Shimane 33Okayama 34Hiroshima 35Yamaguchi 36Tokushima 37Kagawa 38Ehime 39Kochi 40Fukuoka 41Saga 42Nagasaki
477          0         0         0         3           0           0           1        0       3       0         4      0          0
478          1         0         0         4           1           0           2        0       1       0         1      0          1
479          0         0         0         2           0           2           1        0       1       0         3      0          0
    43Kumamoto 44Oita 45Miyazaki 46Kagoshima 47Okinawa          t
477          1      0          0           0         1 2021-05-07
478          0      0          0           0         0 2021-05-08
479          0      0          0           0         0 2021-05-09

> head(w)
    tokyo osaka hyogo          t
400    11     2     1 2021-02-19
401    27     4     2 2021-02-20
402    17     1     0 2021-02-21
403     9     3     1 2021-02-22
404    11     5     3 2021-02-23
405    17     4     7 2021-02-24

> dplyr::filter(df,t > as.Date("2021-05-07"))
           t variable value
1 2021-05-08    tokyo     6
2 2021-05-09    tokyo     3
3 2021-05-08    osaka    41
4 2021-05-09    osaka    19
5 2021-05-08    hyogo     6
6 2021-05-09    hyogo     8



w <- data.frame(tokyo=dmdf[,13],osaka=dmdf[,27],hyogo=dmdf[,28],t=dmdf$t)
w <- last(w,80)
df <-w  %>% tidyr::gather(variable,value,-t)  #exclude t to preserve time stamp or use "df <-w  %>% tidyr::gather(variable,value,1:3)"
# df
p <- ggplot(df,aes(x=t, y=value, color=variable,fill=variable)) 
# p <- p+geom_histogram(stat = "identity",position = "stack")
p <- p+geom_bar(stat="identity",width=1,position = "dodge")
plot(p)
# end here

# if "df <-w  %>% tidyr::gather(variable,value)  #exclude t to preserve time stamp"
# 警告メッセージ: 
# attributes are not identical across measure variables;
# they will be dropped 
# see w[1:3,] contents are numeric  and w$t is Date.



w <- data.frame(tokyo=dmdf[,13],osaka=dmdf[,27],hyogo=dmdf[,28],t=dmdf$t)
w <- last(w,80)
df <-w  %>% tidyr::gather(variable,value,-t) #exclude t to preserve time stamp or use "df <-w  %>% tidyr::gather(variable,value,1:3)"
# df
p <- ggplot(df,aes(x=t, y=value,fill=variable)) 
p <- p +scale_fill_brewer(palette="Accent")
p <- p+geom_bar(stat="identity",width=1,position = "dodge")
p <- p + theme(panel.background = element_rect(fill = "grey60",
                                               colour = "lightblue"))
plot(p)









len <- 20
w <- data.frame(spx=as.vector(last(weeklyReturn(GSPC),len)),ndx=as.vector(last(weeklyReturn(NDX),len)),dji= as.vector(last(weeklyReturn(DJI),len))    ,t=index(last(weeklyReturn(GSPC),len)))
df <-w  %>% tidyr::gather(index,weeklyreturn,-t)
df$t[len*seq(1,3,1)] <- df$t[dim(df)[1]-1]+7  # adjust each index's last entry. 3 came from gspc, ndx and di.
for(i in seq(1,len*3,1)){if((length(seq(as.Date("1970-01-05"),as.Date(df$t[i]),by='days'))%%7) != 5){df$t[i] <- df$t[i]+5-length(seq(as.Date("1970-01-05"),as.Date(df$t[i]),by='days'))%%7 }} # for the case national holiday distort date.
p <- ggplot(df,aes(x=t, y=weeklyreturn, color=index,fill=index))
p <- p + xlab("") + ylab("週間収益率")
# p <- p + geom_point(aes(y=case_per_capita,size=sign,color=r),alpha=1)
# p <- p+annotate("text",label=pref_db[,1],x=df[,2], y=df[,1]+0.1,colour='black',family = "HiraKakuProN-W3",size=3)
p <- p + theme_gray (base_family = "HiraKakuPro-W3")
p <- p + scale_color_brewer(name="指数",labels=c("ダウ30種","ナスダック","S&P500"),palette="Accent")
p <- p + scale_fill_brewer(name="指数",labels=c("ダウ30種","ナスダック","S&P500"),palette="Accent")
p <- p+geom_bar(stat="identity",width=7,position = "dodge")
plot(p)