Record Blood Pressure

> bp <- read.csv("~/bp.csv")
# when the format is as below.

> bp
        Date  Time High Low Pulse
1 2018-01-01  8:30  138 101    70
2 2018-01-01 23:30   90  47    NA
3 2018-01-02 10:15  158 107    NA
4 2018-01-02 23:15  145  85    NA
5 2018-01-03  9:30  153 110    NA
6 2018-01-03 23:30  141  90    NA

#concatenate Data and Time column and convert to POSIX format.

> paste(bp$Date,bp$Time,sep=" ")
[1] "2018-01-01 8:30"  "2018-01-01 23:30" "2018-01-02 10:15" "2018-01-02 23:15" "2018-01-03 9:30"
[6] "2018-01-03 23:30"
> as.POSIXct(paste(bp$Date,bp$Time,sep=" "))
[1] "2018-01-01 08:30:00 JST" "2018-01-01 23:30:00 JST" "2018-01-02 10:15:00 JST" "2018-01-02 23:15:00 JST"
[5] "2018-01-03 09:30:00 JST" "2018-01-03 23:30:00 JST"

# merge POSIX format date/time sequence and Data part of CSV

> xts(bp[,c(-1,-2)],as.POSIXct(paste(bp$Date,bp$Time,sep=" ")))
                    High Low Pulse
2018-01-01 08:30:00  138 101    70
2018-01-01 23:30:00   90  47    NA
2018-01-02 10:15:00  158 107    NA
2018-01-02 23:15:00  145  85    NA
2018-01-03 09:30:00  153 110    NA
2018-01-03 23:30:00  141  90    NA

Calculate NIKKEI225 vol.3

k3 <-  "2007-01-01::2018-02-07"

# or

getSymbols("^GSPC")
k3 <- paste("2007-01-01", index(last(GSPC)),sep="::")
k3

# download other data
getSymbols("NIKKEI225",src="FRED") # download nikkei 225
# getSymbols("DEXJPUS", src = "FRED")
# getSymbols("YJUSDJPY",src="yahooj")
getSymbols('YJUSDJPY', src="yahooj",auto.assign=TRUE)
N225 <- NIKKEI225
# result <- summary(lm(to.monthly(N225[k3])[,4] ~  to.monthly(GSPC[k3])[,4] + to.monthly(DEXJPUS[k3])[,4]))  
result_nikkei <- lm(to.monthly(N225[k3])[,4] ~  to.monthly(GSPC[k3])[,4] + to.monthly(YJUSDJPY[k3])[,4])
result_nikkei$coefficients[2]*last(GSPC)[,4]+result_nikkei$coefficients[3]*as.vector(last(YJUSDJPY)[,4])+result_nikkei$coefficients[1]
# plot(merge(as.xts(predict(result_nikkei),index(residuals(result_nikkei))),to.monthly(N225[k3])[,4],residuals(result_nikkei)))
beep(2)
plot(merge(as.xts(predict(result_nikkei),index(residuals(result_nikkei))),to.monthly(N225[k3])[,4],residuals(result_nikkei)),main=paste(paste("NIKKEI225 =",round(result_nikkei$coefficients[2],4),"* GSPC +",round(result_nikkei$coefficients[3],2),"*USDJPY +",round(result_nikkei$coefficients[1],2))))

tmp.legend <- paste("R Squared is ",round(summary(result_nikkei)$r.squared,4)," \n","DF is ",round(summary(result_nikkei)$df[2],0),sep=' ')

addLegend(legend.loc = "topleft", legend.names = tmp.legend,col=3)

> result

Call:
lm(formula = to.monthly(N225[k3])[, 4] ~ to.monthly(GSPC[k3])[,
    4] + to.monthly(YJUSDJPY[k3])[, 4])

Residuals:
     Min       1Q   Median       3Q      Max
-1875.41  -473.74   -12.89   507.10  1855.32

Coefficients:
                                Estimate Std. Error t value Pr(>|t|) 
(Intercept)                   -9864.4555   499.7539  -19.74   <2e-16 ***
to.monthly(GSPC[k3])[, 4]         4.8991     0.1804   27.16   <2e-16 ***
to.monthly(YJUSDJPY[k3])[, 4]   158.2244     6.1444   25.75   <2e-16 ***
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 792.4 on 131 degrees of freedom
Multiple R-squared:  0.9655, Adjusted R-squared:  0.965
F-statistic:  1832 on 2 and 131 DF,  p-value: < 2.2e-16


summary(lm(apply.weekly(N225[k3],mean) ~  apply.weekly(GSPC[k3][,4],mean) + apply.weekly(YJUSDJPY[k3][,4],mean)))   

> summary(lm(apply.weekly(N225[k3],mean) ~  apply.weekly(GSPC[k3][,4],mean) + apply.weekly(YJUSDJPY[k3][,4],mean)))   

Call:
lm(formula = apply.weekly(N225[k3], mean) ~ apply.weekly(GSPC[k3][,
    4], mean) + apply.weekly(YJUSDJPY[k3][, 4], mean))

Residuals:
     Min       1Q   Median       3Q      Max
-1992.66  -510.50    51.79   469.11  2524.40

Coefficients:
                                        Estimate Std. Error t value Pr(>|t|) 
(Intercept)                           -1.017e+04  2.593e+02  -39.24   <2e-16 ***
apply.weekly(GSPC[k3][, 4], mean)      4.800e+00  9.568e-02   50.17   <2e-16 ***
apply.weekly(YJUSDJPY[k3][, 4], mean)  1.626e+02  3.180e+00   51.11   <2e-16 ***
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 754.9 on 445 degrees of freedom
  (132 observations deleted due to missingness)
Multiple R-squared:  0.9674, Adjusted R-squared:  0.9673
F-statistic:  6612 on 2 and 445 DF,  p-value: < 2.2e-16

# plot(merge(na.omit(apply.weekly(N225[k3],mean))[2:length(na.omit(apply.weekly(N225[k3],mean)))],predict(lm(apply.weekly(N225[k3],mean) ~  apply.weekly(GSPC[k3][,4],mean) + apply.weekly(YJUSDJPY[k3][,4],mean)))))

result <- lm(apply.weekly(N225[k3],mean) ~  apply.weekly(GSPC[k3][,4],mean) + apply.weekly(YJUSDJPY[k3][,4],mean)) 
tmp.main <- paste("NIKKEI225 =",round(result$coefficients[2],4),"* GSPC +",round(result$coefficients[3],2),"*USDJPY +",round(result$coefficients[1],2))
nikkei_week <- na.omit(apply.weekly(N225[k3],mean))
predict_nikkei_week <- predict(lm(apply.weekly(N225[k3],mean) ~  apply.weekly(GSPC[k3][,4],mean) + apply.weekly(YJUSDJPY[k3][,4],mean)))
if(length(nikkei_week) > length(predict_nikkei_week)){
  plot(merge(last(nikkei_week,n=length(predict_nikkei_week),predict_nikkei_week)),main=tmp.main)
}else{
  plot(merge(nikkei_week,last(predict_nikkei_week,n=length(nikkei_week))),main=tmp.main) 
}
# add legend at topleft
#
#
addLegend(legend.loc = "topleft", legend.names = paste("R Squared",round(summary(result)$r.squared,4),sep=':'),col=2)

or

tmp.legend <- paste("R Squared is ",round(summary(result)$r.squared,4)," \n","DF is ",round(summary(result)$df[2],0),sep=' ')
addLegend(legend.loc = "topleft", legend.names = tmp.legend,col=3)

In spite of the recent steep declines, Nikkei225 is still in the premium side.

use grid.ticks.on='months' to show grid on monthly basis.

Calculate a number of the iteration, which records decline for each month from 1950-01 to now.

for(i in seq(1,12,1)){print(length(((SP5[,4]-SP5[,1])/SP5[,1])[seq(i,length(SP5[,4]),12)][((SP5[,4]-SP5[,1])/SP5[,1])[seq(i,length(SP5[,4]),12)] < 0]))}

> for(i in seq(1,12,1)){print(length(((SP5[,4]-SP5[,1])/SP5[,1])[seq(i,length(SP5[,4]),12)][((SP5[,4]-SP5[,1])/SP5[,1])[seq(i,length(SP5[,4]),12)] < 0]))}
[1] 28
[1] 30
[1] 25
[1] 21
[1] 28
[1] 33
[1] 30
[1] 31
[1] 38
[1] 26
[1] 23
[1] 17

January records 28 times decline since 1950. September is the worst to do 38 times, which is more than 50% probability, while December is the best month to invest S&P 500.

GDP, PAYEMS,PERMIT and S&P500

> kikan
[1] "1992-01-01::2017-09-30"
> summary(lm(apply.quarterly(SP5[kikan],mean)[,1] ~ apply.quarterly(PA[kikan],mean) * apply.quarterly(PERMIT[kikan],mean) * G[kikan] - apply.quarterly(PERMIT[kikan],mean) -G[kikan] ))

Call:
lm(formula = apply.quarterly(SP5[kikan], mean)[, 1] ~ apply.quarterly(PA[kikan],
    mean) * apply.quarterly(PERMIT[kikan], mean) * G[kikan] -
    apply.quarterly(PERMIT[kikan], mean) - G[kikan])

Residuals:
    Min      1Q  Median      3Q     Max
-356.42  -70.14  -14.41   74.25  265.08

Coefficients:
                                                                                 Estimate Std. Error t value Pr(>|t|) 
(Intercept)                                                                     4.085e+03  8.181e+02   4.993 2.62e-06 ***
apply.quarterly(PA[kikan], mean)                                               -5.823e-02  1.067e-02  -5.460 3.66e-07 ***
apply.quarterly(PA[kikan], mean):apply.quarterly(PERMIT[kikan], mean)           2.845e-05  3.573e-06   7.962 3.24e-12 ***
apply.quarterly(PA[kikan], mean):G[kikan]                                       2.596e-06  3.412e-07   7.608 1.81e-11 ***
apply.quarterly(PERMIT[kikan], mean):G[kikan]                                  -7.652e-04  6.821e-05 -11.218  < 2e-16 ***
apply.quarterly(PA[kikan], mean):apply.quarterly(PERMIT[kikan], mean):G[kikan]  3.642e-09  3.657e-10   9.959  < 2e-16 ***
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 124.1 on 97 degrees of freedom
Multiple R-squared:  0.9411, Adjusted R-squared:  0.938
F-statistic: 309.9 on 5 and 97 DF,  p-value: < 2.2e-16

purchase history.

---------------------------------------------------------------------------------------------

Fully Executed 13 Jan 2014 Buy
P-500589 FAS 300 shares
Outstanding Qty: 0 shares
Total Executed Qty: 300 shares 91.3799 USD
--------------------------------------------------------------------------------------------
Fully Executed 09 Jan 2014 Buy
P-449838 FAS 100 shares
Outstanding Qty: 0 shares
Total Executed Qty: 100 shares 91.6699 USD
---------------------------------------------------------------------------------------------
Fully Executed 09 Jan 2014 Buy
P-449832 SPXL 300 shares
Outstanding Qty: 0 shares
Total Executed Qty: 300 shares 62.2399 USD
---------------------------------------------------------------------------------------------
Fully Executed 02 Jan 2014 Buy
P-296549 SPXL 200 shares
Outstanding Qty: 0 shares
Total Executed Qty: 200 shares 62.56 USD
----------------------------------------------------------------------------------------------
Fully Executed 30 Dec 2013 Buy
P-262561 SPXL 500 shares
Outstanding Qty: 0 shares
Total Executed Qty: 500 shares 62.93 USD
---------------------------------------------------------------------------------------------
Fully Executed 26 Dec 2013 Buy
P-878321 FAS 500 shares
Outstanding Qty: 0 shares
Total Executed Qty: 500 shares 89.81 USD
---------------------------------------------------------------------------------------------
Fully Executed 26 Dec 2013 Buy
P-878316 SPXL 1,000 shares
Outstanding Qty: 0 shares
Total Executed Qty: 1,000 shares 62.66 USD
---------------------------------------------------------------------------------------------
Fully Executed 23 Dec 2013 Buy
P-864555 SPXL 500 shares
Outstanding Qty: 0 shares
Total Executed Qty: 500 shares 61.57 USD
------------------------------------------------------------------------------------------------
Fully Executed 23 Dec 2013 Buy
P-864552 FAS 500 shares
Outstanding Qty: 0 shares
Total Executed Qty: 500 shares 88.50 USD
------------------------------------------------------------------------------------------------
Fully Executed 20 Dec 2013 Buy
P-844082 FAS 500 shares
Outstanding Qty: 0 shares
Total Executed Qty: 500 shares 86.00 USD
--------------- -------------- ---------- ----- -----------------
Fully Executed 08 Dec 2013 Buy
P-600562 SPXL 500 shares
Outstanding Qty: 0 shares
Total Executed Qty: 500 shares 59.85 USD
-------------------------------------------------------------------------------------------------
Fully Executed 06 Dec 2013 Buy
P-600562(598416001) SPXL 500 shares
Outstanding Qty: 0 shares
Total Executed Qty: 500 shares 58.80USD



89.81 * 500 + 62.66 * 1000 + 61.57 * 500 + 88.5 * 500 + 86 * 500 + 59.85 * 500 + 58.8 * 500 + 62.93 * 500 + 62.56 * 200
=328902.00

62.66 * 1000 + 61.57 * 500 + 59.85 * 500 + 58.8 * 500  + 62.93 * 500   + 62.56 * 200 + 62.2399 * 300
=215418.97
215418.97 / 3500
= 61.55

89.81 * 500 + 88.5 * 500 + 86 * 500  + 91.6699 * 100 + 91.3799 * 300
= 168735.9600
168735.9600 / 1900
=88.81

3000 * 63.8
=191400.0
1500 * 90.30
=135450.00