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 の順番？