EPS 2021 SEP19

 $ cat eps.txt

12/31/2022              $57.18  $53.10          20.55   22.38           $218.03 $200.19
9/30/2022               $55.39  $51.09          21.19   23.12           $211.49 $193.83
6/30/2022               $54.10  $49.25          21.90   23.95           $204.64 $187.11
3/31/2022               $51.36  $46.74          22.12   24.06           $202.57 $186.25
12/31/2021              $50.64  $46.75          22.56   24.16           $198.62 $185.46
9/30/2021               $48.54  $44.37          24.07   26.33           $186.16 $170.15
6/30/2021 (Prelim.)     4297.50 $52.03  $48.39          25.53   28.22           $175.52 $158.76
3/31/2021       3972.89 $47.41  $45.95          26.44   30.99           $150.28 $128.20
12/31/2020      3756.07 $38.18  $31.44          30.69   39.90           $122.37 $94.13
9/30/2020       3363.00 $37.90  $32.98          27.26   34.24           $123.37 $98.22
6/30/2020       3100.29 $26.79  $17.83          24.75   31.24           $125.28 $99.23
3/31/2020       2584.59 $19.50  $11.88          18.64   22.22           $138.63 $116.33
12/31/2019      3230.78 $39.18  $35.53          20.56   23.16           $157.12 $139.47
9/30/2019       2976.74 $39.81  $33.99          19.46   22.40           $152.97 $132.90
6/30/2019       2941.76 $40.14  $34.93          19.04   21.75           $154.54 $135.27
3/31/2019       2834.40 $37.99  $35.02          18.52   21.09           $153.05 $134.39

> eps_year_xts["2020::"]

             [,1]

2020-01-01 116.33

2020-04-01  99.23

2020-07-01  98.22

2020-10-01  94.13

2021-01-01 122.64

2021-04-01 144.14

2021-07-01 153.96

2021-10-01 166.77

2022-01-01 170.06

2022-04-01 176.48

2022-07-01 182.75

2022-10-01 188.97

$ tac eps.txt | awk '{gsub("\\$","",$NF);print "eps_year_xts[\"2019::\"]["NR"] <- "$NF}'

eps_year_xts["2019::"][1] <- 134.39

eps_year_xts["2019::"][2] <- 135.27

eps_year_xts["2019::"][3] <- 132.90

eps_year_xts["2019::"][4] <- 139.47

eps_year_xts["2019::"][5] <- 116.33

eps_year_xts["2019::"][6] <- 99.23

eps_year_xts["2019::"][7] <- 98.22

eps_year_xts["2019::"][8] <- 94.13

eps_year_xts["2019::"][9] <- 128.20

eps_year_xts["2019::"][10] <- 158.76

eps_year_xts["2019::"][11] <- 170.15

eps_year_xts["2019::"][12] <- 185.46

eps_year_xts["2019::"][13] <- 186.25

eps_year_xts["2019::"][14] <- 187.11

eps_year_xts["2019::"][15] <- 193.83

eps_year_xts["2019::"][16] <- 200.19

CLI release schedule CLI リリース スケジュール

 
2021
14 September 2021
12 October 2021
10 November 2021
9 December 2021

2022
17 January 2022
9 February 2022
9 March 2022
11 April 2022
10 May 2022
13 June 2022
11 July 2022
9 August 2022
12 September 2022
11 October 2022
9 November 2022
8 December 2022

累積死亡数 vs. 20日前までの累積感染者 致死率

 

original is here.

plot.default(log(cumsum(mdf[,13])[1:543]),log(cumsum(dmdf[,13])[21:563]))
par()$usr
# > par()$usr
# [1] -0.4845012 12.5970321 -0.3095047  8.0471209
plot.default(log(cumsum(mdf[,13])[1:543]),log(cumsum(dmdf[,13])[21:563]),xlim=c(-0.48,12.59),ylim=c(-0.309,8.0471))
par(new=T)
plot.default(log(cumsum(mdf[,13])[1:543]),log(0.01*cumsum(mdf[,13])[1:543]),xlim=c(-0.48,12.59),ylim=c(-0.309,8.0471),type='l')
par(new=T)
plot.default(log(cumsum(mdf[,13])[1:543]),log(0.02*cumsum(mdf[,13])[1:543]),xlim=c(-0.48,12.59),ylim=c(-0.309,8.0471),type='l')

gap <- 20   # shift between positive and death. as new death only comes out after certain number of days of positive.

start <- 500 # day of start should be less than length(mdf$t) - gap 500 means "2021-05-30"

end <- 0 # day to end. 0 means the end of record.

dmdf$t[start]

if(end == 0){

  end <- length(mdf[,13])

}

d <- dmdf[,13][(gap+start):(end)] %>% cumsum()

p <- mdf[,13][start:(end-gap)] %>% cumsum()

df <- data.frame(death=d,positive=p)

# p <- ggplot(df, aes(x = positive, y = death))

# p <- p + geom_point(stat="identity", position="identity")

df <- cbind(df,twopercent=df$positive * 0.02)

df <- cbind(df,onepointfive=df$positive * 0.015)

df <- cbind(df,onepercent=df$positive * 0.01)

df <- cbind(df,halfpercent=df$positive * 0.005)

df <- cbind(df,qpercent=df$positive * 0.0025)

p <- ggplot(df, aes(x = positive, y = death))

p <- p + geom_point(stat="identity", position="identity")

p <- p + geom_path(aes(y=twopercent))

p <- p + geom_path(aes(y=onepointfive))

p <- p + geom_path(aes(y=onepercent))

p <- p + geom_path(aes(y=halfpercent))

p <- p + geom_path(aes(y=qpercent))

plot(p)

EPS 2021JUL30

goto https://www.spglobal.com/ → Documents → Additional Info → Index Earnings

MacBook-Pro-16:~/Downloads$ cat eps.txt 

12/31/2022 $56.05 $52.78 20.65 21.96 $211.18 $198.50

9/30/2022 $53.89 $50.61 21.33 22.71 $204.41 $191.96

6/30/2022 $51.20 $48.23 22.07 23.49 $197.58 $185.62

3/31/2022 $50.04 $46.87 22.65 24.12 $192.46 $180.74

12/31/2021 $49.28 $46.24 22.97 24.25 $189.83 $179.81

9/30/2021 $47.06 $44.27 24.39 26.42   $178.73 $165.01

6/30/2021 (9.8%) 4297.50 $46.08 $43.35 25.71 28.36   $169.57 $153.72

3/31/2021 3972.89 $47.41 $45.95 26.44 30.99 $150.28 $128.20

12/31/2020 3756.07 $38.18 $31.44 30.69 39.90   $122.37 $94.13

9/30/2020 3363.00 $37.90 $32.98 27.26 34.24   $123.37 $98.22

6/30/2020 3100.29 $26.79 $17.83 24.75 31.24   $125.28 $99.23

3/31/2020 2584.59 $19.50 $11.88 18.64 22.22   $138.63 $116.33

12/31/2019 3230.78 $39.18 $35.53 20.56 23.16   $157.12 $139.47

9/30/2019  2976.74 $39.81 $33.99 19.46 22.40   $152.97 $132.90

6/30/2019 2941.76 $40.14 $34.93 19.04 21.75   $154.54 $135.27

3/31/2019 2834.40 $37.99 $35.02 18.52 21.09   $153.05 $134.39

> eps_year_xts["2020::"]

             [,1]

2020-01-01 116.33

2020-04-01  99.23

2020-07-01  98.22

2020-10-01  94.13

2021-01-01 122.64

2021-04-01 144.14

2021-07-01 153.96

2021-10-01 166.77

2022-01-01 170.06

2022-04-01 176.48

2022-07-01 182.75

2022-10-01 188.97

MacBook-Pro-16:~/Downloads$ tac eps.txt | awk '{gsub("\\$","",$NF);print "eps_year_xts[\"2019::\"]["NR"] <- "$NF}'

eps_year_xts["2019::"][1] <- 134.39

eps_year_xts["2019::"][2] <- 135.27

eps_year_xts["2019::"][3] <- 132.90

eps_year_xts["2019::"][4] <- 139.47

eps_year_xts["2019::"][5] <- 116.33

eps_year_xts["2019::"][6] <- 99.23

eps_year_xts["2019::"][7] <- 98.22

eps_year_xts["2019::"][8] <- 94.13

eps_year_xts["2019::"][9] <- 128.20

eps_year_xts["2019::"][10] <- 153.72

eps_year_xts["2019::"][11] <- 165.01

eps_year_xts["2019::"][12] <- 179.81

eps_year_xts["2019::"][13] <- 180.74

eps_year_xts["2019::"][14] <- 185.62

eps_year_xts["2019::"][15] <- 191.96

eps_year_xts["2019::"][16] <- 198.50

dplyr filter group_by summarise

 


 df.melt[1:10,]

            t variable value
1  2020-10-01       10    13
2  2020-10-02       10    18
3  2020-10-03       10    11
4  2020-10-04       10     7
5  2020-10-05       10     5
6  2020-10-06       10    16
7  2020-10-07       10     3
8  2020-10-08       10    12
9  2020-10-09       10    20
10 2020-10-10       10    29

 df.melt[289:299,]

             t variable value
289 2020-10-01       20    60
290 2020-10-02       20    48
291 2020-10-03       20    60
292 2020-10-04       20    31
293 2020-10-05       20    17
294 2020-10-06       20    44
295 2020-10-07       20    28
296 2020-10-08       20    49
297 2020-10-09       20    60
298 2020-10-10       20    64
299 2020-10-11       20    38

dplyr::filter(df.melt,variable>=10 & variable < 21) %>% dplyr::group_by(t) %>% dplyr::summarise(.,sum(value))

# A tibble: 288 x 2
   t          `sum(value)`
   <date>            <dbl>
 1 2020-10-01           73
 2 2020-10-02           66
 3 2020-10-03           71
 4 2020-10-04           38
 5 2020-10-05           22
 6 2020-10-06           60
 7 2020-10-07           31
 8 2020-10-08           61
 9 2020-10-09           80
10 2020-10-10           93
# ... with 278 more rows

 dplyr::filter(df.melt,variable>=10 ) %>% dplyr::group_by(t) %>% dplyr::summarise(.,sum(value))

# A tibble: 289 x 2

   t          `sum(value)`

   <date>            <dbl>

 1 2020-10-01          234

 2 2020-10-02          196

 3 2020-10-03          205

 4 2020-10-04          107

 5 2020-10-05           65

 6 2020-10-06          176

 7 2020-10-07          140

 8 2020-10-08          248

 9 2020-10-09          203

10 2020-10-10          248

# ... with 279 more rows

dplyr::filter(df.melt,variable>=70 ) %>% dplyr::group_by(t) %>% dplyr::summarise(.,sum(value))

# A tibble: 289 x 2

   t          `sum(value)`

   <date>            <dbl>

 1 2020-10-01           31

 2 2020-10-02           20

 3 2020-10-03           21

 4 2020-10-04           13

 5 2020-10-05            6

 6 2020-10-06           20

 7 2020-10-07           22

 8 2020-10-08           25

 9 2020-10-09           17

10 2020-10-10           33

# ... with 279 more rows

(dplyr::filter(df.melt,variable>=70 ) %>% dplyr::group_by(t) %>% dplyr::summarise(.,sum(value)))[,2] / as.vector(dplyr::filter(df.melt,variable>=10 ) %>% dplyr::group_by(t) %>% dplyr::summarise(.,sum(value)))[,2]

    sum(value)

1   0.13247863

2   0.10204082

3   0.10243902

4   0.12149533

5   0.09230769

6   0.11363636

7   0.15714286

8   0.10080645

9   0.08374384

10  0.13306452

<Skip>

282 0.02311436

283 0.04105263

284 0.03094463

285 0.02589641

286 0.03855422

287 0.02872063

288 0.02675841

289 0.02281668

plot(as.xts( (dplyr::filter(df.melt,variable>=70 ) %>% dplyr::group_by(t) %>% dplyr::summarise(.,sum(value)))[,2] / as.vector(dplyr::filter(df.melt,variable>=10 ) %>% dplyr::group_by(t) %>% dplyr::summarise(.,sum(value)))[,2],df.melt$t[1:289]))

OR

plot(as.xts( (dplyr::filter(df.melt,variable>=70 ) %>% dplyr::group_by(t) %>% dplyr::summarise(.,sum(value)))[,2] / as.vector(dplyr::filter(df.melt,variable>=10 ) %>% dplyr::group_by(t) %>% dplyr::summarise(.,sum(value)))[,2],unique(df.melt$t)))

CLIデルタ CLI二次デルタ 月間収益率

 

(1) CLIデルタがプラスかつ二次デルタがマイナスの場合の月間収益率

func <- function(x,y,z){if(x >0 && y <0){return(z) }else(return(NA))}
date <- paste("1970",index(cli_xts) %>% last() %>% substr(.,1,7),sep="::")
i <- 12- length(diff(cli_xts$oecd)[date]) %%12
matrix(c(mapply(func,diff(cli_xts$oecd)[date],  diff(diff(cli_xts$oecd))[date]     ,as.vector(monthlyReturn(GSPC)[date])),rep(NA,i)),nrow=12) %>% t() %>% apply(.,2,mean,na.rm=T) %>% round(.,4)

 [1]  0.0047  0.0100  0.0189  0.0162 -0.0062  0.0019  0.0168  0.0091  0.0047  0.0084  0.0298  0.0187

(2) CLIデルタがプラスかつ二次デルタがプラスの場合の月間収益率

func <- function(x,y,z){if(x >0 && y >0){return(z) }else(return(NA))}
date <- paste("1970",index(cli_xts) %>% last() %>% substr(.,1,7),sep="::")
i <- 12- length(diff(cli_xts$oecd)[date]) %%12
matrix(c(mapply(func,diff(cli_xts$oecd)[date],  diff(diff(cli_xts$oecd))[date]     ,as.vector(monthlyReturn(GSPC)[date])),rep(NA,i)),nrow=12) %>% t() %>% apply(.,2,mean,na.rm=T) %>% round(.,4)

 [1] 0.0258 0.0146 0.0217 0.0420 0.0277 0.0138 0.0247 0.0099 0.0064 0.0166 0.0334 0.0184

(2) CLIデルタがマイナスかつ二次デルタがマイナスの場合の月間収益率

func <- function(x,y,z){if(x <0 && y <0){return(z) }else(return(NA))}
date <- paste("1970",index(cli_xts) %>% last() %>% substr(.,1,7),sep="::")
i <- 12- length(diff(cli_xts$oecd)[date]) %%12
matrix(c(mapply(func,diff(cli_xts$oecd)[date],  diff(diff(cli_xts$oecd))[date]     ,as.vector(monthlyReturn(GSPC)[date])),rep(NA,i)),nrow=12) %>% t() %>% apply(.,2,mean,na.rm=T) %>% round(.,4)

 [1]  0.0038 -0.0189 -0.0051  0.0098 -0.0011  0.0013 -0.0123 -0.0124 -0.0207 -0.0544 -0.0328  0.0082

(2) CLIデルタがマイナスかつ二次デルタがプラスの場合の月間収益率

func <- function(x,y,z){if(x <0 && y >0){return(z) }else(return(NA))}
date <- paste("1970",index(cli_xts) %>% last() %>% substr(.,1,7),sep="::")
i <- 12- length(diff(cli_xts$oecd)[date]) %%12
matrix(c(mapply(func,diff(cli_xts$oecd)[date],  diff(diff(cli_xts$oecd))[date]     ,as.vector(monthlyReturn(GSPC)[date])),rep(NA,i)),nrow=12) %>% t() %>% apply(.,2,mean,na.rm=T) %>% round(.,4)

 [1]  0.0066  0.0017  0.0095 -0.0002 -0.0008 -0.0014  0.0170  0.0015 -0.0138  0.0367  0.0136  0.0117

annotate , xlab , ylab , scale_color_hue, size, legend, 日本語 , 人口

 

pref_db %>% head(.,10)

   region x2010 x2015 x2016 x2017  size
2  北海道  5506  5382  5352  5320 83457
3  青森県  1373  1308  1293  1278  9645
4  岩手県  1330  1280  1268  1255 15279
5  宮城県  2348  2334  2330  2323  6862
6  秋田県  1086  1023  1010   996 11636
7  山形県  1169  1124  1113  1102  6652
8  福島県  2029  1914  1901  1882 13783
9  茨城県  2970  2917  2905  2892  6096
10 栃木県  2008  1974  1966  1957  6408
11 群馬県  2008  1973  1967  1960  6362

df <- data.frame(case_per_capita=as.vector(apply(mdf[,-48],2,sum) / pref_db$x2017),pop_density=pref_db$x2017/pref_db$size,sign=pref_db$x2017,r=pref_db[,1])

x1 <- df[,2]

y1 <- df[,1]

df <- cbind(df,lm=predict(nls(y1~a*x1^(1/4)+b,start=c(a=1,b=1),trace=TRUE)))

p <- ggplot(df, aes(x=pop_density))

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 + geom_line(aes(y=lm))

p <- p + theme_gray (base_family = "HiraKakuPro-W3")

p <- p + scale_color_hue(name="都道府県",labels=pref_db[,1])

# p <- p + guides(fill = guide_legend(reverse = F,order = 2),label = TRUE)

p <- p + guides(size = guide_legend(title="人口"))

# don't forget to set "color=". otherwise fails to show up.

p <- p + geom_smooth(aes(x=pop_density,y=case_per_capita),method = "lm",se=F,color="red",size=0.5)

# p + scale_colour_manual(values = pref_db[,3])

plot(p)

vaccine ワクチン

from here

 

 

dplyr filter arrange 行列 内積

 

dplyr::filter(js,prefecture==35) %>% dplyr::group_by(.,date) %>% dplyr::summarise(.,sum(count)) %>% last(.,20)

w <- ((dplyr::arrange(df.melt,t))[,3] %>% matrix(.,nrow=8) %>% t())%*% matrix(c(0, 0, 0, 0.001, 0.003, 0.014, 0.048, 0.125 ),ncol=1) 

dplyr::group_by(js,date,prefecture) %>% dplyr::summarise(.,sum(count))

# key を複数取るとことができる。primary key , sub key の順番？

行列 転置 問題 バグ？

 
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

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

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))"でラベルを横倒し縦書きにできる。

横並び棒グラフ 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)

名目GDP四半期伸び率 vs. CLI Delta Nominal GDP quater basis legend title #spline #gdp

 

名目GDP四半期伸び率　vs.　CLI Delta Nominal GDP quater basis を対照プロットする。

period <- "2001::2021-06"  # end period month should be march,june,september or december.

w <- (GDPC1/lag(GDPC1))[period] - 1

result <- lm(as.vector(diff(apply.quarterly(cli_xts$oecd,mean))[period]) ~ w)

df <- data.frame(delta=as.vector(diff(apply.quarterly(cli_xts$oecd,mean))[period]) ,gdp=as.vector(w)

                 ,spx= as.vector(quarterlyReturn(GSPC)[period])  )

p <- ggplot(df, aes(y=delta,x=gdp))

p <- p + theme_gray (base_family = "HiraKakuPro-W3")

p <- p + xlab("GDP四半期伸び率") + ylab("CLI delta")

p <- p + geom_point(alpha=1,aes(color=spx))

p <- p + scale_color_gradient(low = "red", high = "green")

p <- p + geom_smooth(method = "lm",se=F,size=0.5)

p <- p + geom_vline(xintercept =(-1*result$coefficients[1] / result$coefficients[2]),

                    size=0.5,linetype=2,colour="red",alpha=0.5)

p <- p + geom_hline(yintercept = last(as.vector(diff(apply.quarterly(cli_xts$oecd,mean))[period])),

                    size=0.5,linetype=2,colour="green",alpha=0.5)

p <- p + geom_vline(xintercept = last(w),

                    size=0.5,linetype=2,colour="green",alpha=0.5)

p <- p+annotate("text",label=as.character(round(-1*result$coefficients[1] / result$coefficients[2],4)),x=(-1*result$coefficients[1] / result$coefficients[2]), y=-5.1,colour='red')

p <- p+annotate("text",label=as.character(round(last(w),4)),x=last(w), y=-5.1,colour='green')

p <- p +  labs(color="S&P500\n四半期\n収益率")

plot(p)

summary(result)

spline を使用して補完の上月次GDPを算出その上でグラフを作成する。

period <- "2015::2021-09"  # end period month should be march,june,september or december.

w <- spline(GDPC1[period],xmin=1/3,xmax=length(GDPC1[period])+1/3,n=3*length(GDPC1[period])+1,method='natural')$y

# w <- w/lag(w) -1

w <- w[2:length(w)]/w[1:(length(w)-1)] - 1

# w <- (GDPC1/lag(GDPC1))[period] - 1

# result <- lm(as.vector(diff(cli_xts$oecd)[period]) ~ w)

result <- lm(as.vector(diff(cli_xts$oecd)[period]) ~ w)

df <- data.frame(delta=as.vector(diff((cli_xts$oecd))[period]) ,gdp=as.vector(w)

                 ,spx= as.vector(monthlyReturn(GSPC)[period])  )

p <- ggplot(df, aes(y=delta,x=gdp))

p <- p + theme_gray (base_family = "HiraKakuPro-W3")

p <- p + xlab("GDP補正月間伸び率") + ylab("CLI delta")

p <- p + geom_point(alpha=1,aes(color=spx))

p <- p + scale_color_gradient(low = "red", high = "green")

p <- p + geom_smooth(method = "lm",se=F,size=0.5)

p <- p + geom_vline(xintercept =(-1*result$coefficients[1] / result$coefficients[2]),

                    size=0.5,linetype=2,colour="red",alpha=0.5)

p <- p + geom_hline(yintercept = last(as.vector(diff((cli_xts$oecd))[period])),

                    size=0.5,linetype=2,colour="green",alpha=0.5)

p <- p + geom_vline(xintercept = last(w),

                    size=0.5,linetype=2,colour="green",alpha=0.5)

p <- p+annotate("text",label=as.character(round(-1*result$coefficients[1] / result$coefficients[2],4)),x=(-1*result$coefficients[1] / result$coefficients[2]), y=-5.1,colour='red')

p <- p+annotate("text",label=as.character(round(last(w),4)),x=last(w), y=-5.1,colour='green')

p <- p +  labs(color="S&P500\n月間\n収益率")

plot(p)

summary(result)

> summary(result)

Call:

lm(formula = as.vector(diff(apply.quarterly(cli_xts$oecd, mean))[period]) ~ w)

Residuals:

     Min       1Q   Median       3Q      Max 

-1.44728 -0.33122  0.01372  0.19903  2.09477 

Coefficients:

            Estimate Std. Error t value Pr(>|t|)    

(Intercept) -0.45260    0.06811  -6.645 3.53e-09 ***

w           47.61859    3.71852  12.806  < 2e-16 ***

---

Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 0.5276 on 79 degrees of freedom

Multiple R-squared:  0.6749, Adjusted R-squared:  0.6708 

F-statistic:   164 on 1 and 79 DF,  p-value: < 2.2e-16

EPS 2021APR27

 

MacBook-Pro-16:~/Downloads$ cat eps.txt 

12/31/2022 $54.64 $50.47 20.39 21.88 $202.75 $188.97

9/30/2022 $52.43 $49.07 21.08 22.63 $196.14 $182.75

6/30/2022 $48.86 $45.76 21.84 23.43 $189.30 $176.48

3/31/2022 $46.82 $43.67 22.64 24.32 $182.63 $170.06

12/31/2021 $48.03 $44.25 23.22 24.79 $178.09 $166.77

9/30/2021 $45.59 $42.80 24.58 26.86   $168.24 $153.96

6/30/2021 $42.19 $39.33 25.76 28.69   $160.55 $144.14

3/31/2021 (25.4%) 3972.89 $42.28 $40.39 28.49 33.72 $145.15 $122.64

12/31/2020 3756.07 $38.18 $31.44 30.69 39.90   $122.37 $94.13

9/30/2020 3363.00 $37.90 $32.98 27.26 34.24   $123.37 $98.22

6/30/2020 3100.29 $26.79 $17.83 24.75 31.24   $125.28 $99.23

3/31/2020 2584.59 $19.50 $11.88 18.64 22.22   $138.63 $116.33

12/31/2019 3230.78 $39.18 $35.53 20.56 23.16   $157.12 $139.47

9/30/2019  2976.74 $39.81 $33.99 19.46 22.40   $152.97 $132.90

6/30/2019 2941.76 $40.14 $34.93 19.04 21.75   $154.54 $135.27

3/31/2019 2834.40 $37.99 $35.02 18.52 21.09   $153.05 $134.39

MacBook-Pro-16:~/Downloads$  tac eps.txt | awk '{gsub("\\$","",$NF);print "eps_year_xts[\"2019::\"]["NR"] <- "$NF}'
eps_year_xts["2019::"][1] <- 134.39
eps_year_xts["2019::"][2] <- 135.27
eps_year_xts["2019::"][3] <- 132.90
eps_year_xts["2019::"][4] <- 139.47
eps_year_xts["2019::"][5] <- 116.33
eps_year_xts["2019::"][6] <- 99.23
eps_year_xts["2019::"][7] <- 98.22
eps_year_xts["2019::"][8] <- 94.13
eps_year_xts["2019::"][9] <- 122.64
eps_year_xts["2019::"][10] <- 144.14
eps_year_xts["2019::"][11] <- 153.96
eps_year_xts["2019::"][12] <- 166.77
eps_year_xts["2019::"][13] <- 170.06
eps_year_xts["2019::"][14] <- 176.48
eps_year_xts["2019::"][15] <- 182.75
eps_year_xts["2019::"][16] <- 188.97

> eps_year_xts["2020::"]

             [,1]

2020-01-01 116.33

2020-04-01  99.23

2020-07-01  98.22

2020-10-01  91.15

2021-01-01 114.36

2021-04-01 133.35

2021-07-01 141.08

2021-10-01 155.56

> eps_year_xts <- append(eps_year_xts,as.xts(rep(0,4),seq(as.Date("2022-01-01"),as.Date("2022-10-01"),by='quarters')))