{tidyquant}
は金融データを分析するために以下のパッケージを統合したもの
{tidyverse}
とも統合することでシームレスなデータ分析が可能{ggplot2}
とも連携することでグラフィックスも充実# 登録関数の数
ls("package:tidyquant") %>% length()
## [1] 45
# 登録関数の数
ls("package:tidyquant") %>% print()
## [1] "as_tibble" "as_xts"
## [3] "as_xts_" "coord_x_date"
## [5] "coord_x_datetime" "FANG"
## [7] "geom_barchart" "geom_bbands"
## [9] "geom_bbands_" "geom_candlestick"
## [11] "geom_ma" "geom_ma_"
## [13] "palette_dark" "palette_green"
## [15] "palette_light" "scale_color_tq"
## [17] "scale_fill_tq" "theme_tq"
## [19] "theme_tq_dark" "theme_tq_green"
## [21] "tq_exchange" "tq_exchange_options"
## [23] "tq_get" "tq_get_options"
## [25] "tq_get_stock_index_options" "tq_index"
## [27] "tq_index_options" "tq_mutate"
## [29] "tq_mutate_" "tq_mutate_fun_options"
## [31] "tq_mutate_xy" "tq_mutate_xy_"
## [33] "tq_performance" "tq_performance_"
## [35] "tq_performance_fun_options" "tq_portfolio"
## [37] "tq_portfolio_" "tq_repeat_df"
## [39] "tq_transform" "tq_transform_xy"
## [41] "tq_transmute" "tq_transmute_"
## [43] "tq_transmute_fun_options" "tq_transmute_xy"
## [45] "tq_transmute_xy_"
# データセットの確認
FANG %>% print()
## # A tibble: 4,032 × 8
## symbol date open high low close volume adjusted
## <chr> <date> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 FB 2013-01-02 27.44 28.18 27.42 28.00 69846400 28.00
## 2 FB 2013-01-03 27.88 28.47 27.59 27.77 63140600 27.77
## 3 FB 2013-01-04 28.01 28.93 27.83 28.76 72715400 28.76
## 4 FB 2013-01-07 28.69 29.79 28.65 29.42 83781800 29.42
## 5 FB 2013-01-08 29.51 29.60 28.86 29.06 45871300 29.06
## 6 FB 2013-01-09 29.67 30.60 29.49 30.59 104787700 30.59
## 7 FB 2013-01-10 30.60 31.45 30.28 31.30 95316400 31.30
## 8 FB 2013-01-11 31.28 31.96 31.10 31.72 89598000 31.72
## 9 FB 2013-01-14 32.08 32.21 30.62 30.95 98892800 30.95
## 10 FB 2013-01-15 30.64 31.71 29.88 30.10 173242600 30.10
## # ... with 4,022 more rows
# 4銘柄の株価データ等を格納している
FANG %>% nest(date:adjusted)
## # A tibble: 4 × 2
## symbol data
## <chr> <list>
## 1 FB <tibble [1,008 × 7]>
## 2 AMZN <tibble [1,008 × 7]>
## 3 NFLX <tibble [1,008 × 7]>
## 4 GOOG <tibble [1,008 × 7]>
# データ取得可能なインデックスリスト
tq_index_options()
## [1] "DOWJONES" "DJI" "DJT" "DJU" "SP100"
## [6] "SP400" "SP500" "SP600" "RUSSELL1000" "RUSSELL2000"
## [11] "RUSSELL3000" "AMEX" "AMEXGOLD" "AMEXOIL" "NASDAQ"
## [16] "NASDAQ100" "NYSE" "SOX"
# データ取得
X <- tq_index("SP500") %T>% print()
## Getting data...
## # A tibble: 502 × 2
## symbol company
## <chr> <chr>
## 1 MMM 3M
## 2 ABT ABBOTT LABORATORIES
## 3 ABBV ABBVIE INC
## 4 ACN ACCENTURE
## 5 ATVI ACTIVISION BLIZZARD
## 6 AYI ACUITY BRANDS
## 7 ADBE ADOBE SYSTEMS
## 8 AAP ADVANCE AUTO PARTS
## 9 AET AETNA
## 10 AMG AFFILIATED MANAGERS GROUP
## # ... with 492 more rows
# データ内容の確認
X %>% glimpse()
## Observations: 502
## Variables: 2
## $ symbol <chr> "MMM", "ABT", "ABBV", "ACN", "ATVI", "AYI", "ADBE", "A...
## $ company <chr> "3M", "ABBOTT LABORATORIES", "ABBVIE INC", "ACCENTURE"...
# データ取得可能な取引所リスト
tq_exchange_options()
## [1] "AMEX" "NASDAQ" "NYSE"
# データ取得
X <- tq_exchange("NASDAQ") %T>% print()
## Getting data...
## # A tibble: 3,196 × 7
## symbol company last.sale.price
## <chr> <chr> <dbl>
## 1 PIH 1347 Property Insurance Holdings, Inc. 7.20
## 2 FLWS 1-800 FLOWERS.COM, Inc. 9.60
## 3 FCCY 1st Constitution Bancorp (NJ) 18.20
## 4 SRCE 1st Source Corporation 47.00
## 5 VNET 21Vianet Group, Inc. 5.55
## 6 TWOU 2U, Inc. 38.41
## 7 JOBS 51job, Inc. 36.85
## 8 CAFD 8point3 Energy Partners LP 12.80
## 9 EGHT 8x8 Inc 14.25
## 10 AVHI A V Homes, Inc. 16.35
## # ... with 3,186 more rows, and 4 more variables: market.cap <chr>,
## # ipo.year <dbl>, sector <chr>, industry <chr>
# データ内容の確認
X %>% glimpse()
## Observations: 3,196
## Variables: 7
## $ symbol <chr> "PIH", "FLWS", "FCCY", "SRCE", "VNET", "TWOU",...
## $ company <chr> "1347 Property Insurance Holdings, Inc.", "1-8...
## $ last.sale.price <dbl> 7.2000, 9.6000, 18.2000, 47.0000, 5.5500, 38.4...
## $ market.cap <chr> "$42.9M", "$629.46M", "$145.49M", "$1.22B", "$...
## $ ipo.year <dbl> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA...
## $ sector <chr> "Finance", "Consumer Services", "Finance", "Fi...
## $ industry <chr> "Property-Casualty Insurers", "Other Specialty...
# 取得可能データ
tq_get_options()
## [1] "stock.prices" "financials" "key.stats" "key.ratios"
## [5] "dividends" "splits" "economic.data" "exchange.rates"
## [9] "metal.prices"
# データ取得
X <- tq_get("AAPL", get = "stock.prices", from = "2010-01-01") %T>% print()
## # A tibble: 1,812 × 7
## date open high low close volume adjusted
## <date> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 2010-01-04 213.43 214.50 212.38 214.01 123432400 27.72704
## 2 2010-01-05 214.60 215.59 213.25 214.38 150476200 27.77498
## 3 2010-01-06 214.38 215.23 210.75 210.97 138040000 27.33318
## 4 2010-01-07 211.75 212.00 209.05 210.58 119282800 27.28265
## 5 2010-01-08 210.30 212.00 209.06 211.98 111902700 27.46403
## 6 2010-01-11 212.80 213.00 208.45 210.11 115557400 27.22176
## 7 2010-01-12 209.19 209.77 206.42 207.72 148614900 26.91211
## 8 2010-01-13 207.87 210.93 204.10 210.65 151473000 27.29172
## 9 2010-01-14 210.11 210.46 209.02 209.43 108223500 27.13366
## 10 2010-01-15 210.93 211.60 205.87 205.93 148516900 26.68020
## # ... with 1,802 more rows
# データ項目
X %>% glimpse()
## Observations: 1,812
## Variables: 7
## $ date <date> 2010-01-04, 2010-01-05, 2010-01-06, 2010-01-07, 2010...
## $ open <dbl> 213.43, 214.60, 214.38, 211.75, 210.30, 212.80, 209.1...
## $ high <dbl> 214.50, 215.59, 215.23, 212.00, 212.00, 213.00, 209.7...
## $ low <dbl> 212.38, 213.25, 210.75, 209.05, 209.06, 208.45, 206.4...
## $ close <dbl> 214.01, 214.38, 210.97, 210.58, 211.98, 210.11, 207.7...
## $ volume <dbl> 123432400, 150476200, 138040000, 119282800, 111902700...
## $ adjusted <dbl> 27.72704, 27.77498, 27.33318, 27.28265, 27.46403, 27....
# グラフ化
X %>% ggplot(aes(date, adjusted)) + geom_line()
# データ取得
X <- tq_get("AAPL", get = "splits", from = "1990-01-01") %T>% print()
## # A tibble: 3 × 2
## date splits
## <date> <dbl>
## 1 2000-06-21 0.5000000
## 2 2005-02-28 0.5000000
## 3 2014-06-09 0.1428571
# データ項目
X %>% glimpse()
## Observations: 3
## Variables: 2
## $ date <date> 2000-06-21, 2005-02-28, 2014-06-09
## $ splits <dbl> 0.5000000, 0.5000000, 0.1428571
# データ取得
X <- tq_get("AAPL", get = "financials") %T>% print()
## # A tibble: 3 × 3
## type annual quarter
## * <chr> <list> <list>
## 1 BS <tibble [168 × 4]> <tibble [210 × 4]>
## 2 CF <tibble [76 × 4]> <tibble [95 × 4]>
## 3 IS <tibble [196 × 4]> <tibble [245 × 4]>
# 格納データを展開
X %>%
filter(type == "IS") %>%
select(annual) %>%
unnest()
## # A tibble: 196 × 4
## group category date value
## <int> <chr> <date> <dbl>
## 1 1 Revenue 2016-09-24 215639
## 2 1 Revenue 2015-09-26 233715
## 3 1 Revenue 2014-09-27 182795
## 4 1 Revenue 2013-09-28 170910
## 5 2 Other Revenue, Total 2016-09-24 NA
## 6 2 Other Revenue, Total 2015-09-26 NA
## 7 2 Other Revenue, Total 2014-09-27 NA
## 8 2 Other Revenue, Total 2013-09-28 NA
## 9 3 Total Revenue 2016-09-24 215639
## 10 3 Total Revenue 2015-09-26 233715
## # ... with 186 more rows
# 時系列に横展開
X %>%
unnest(quarter) %>%
spread(key = date, value = value)
## # A tibble: 110 × 8
## type group category `2015-12-26` `2016-03-26`
## * <chr> <int> <chr> <dbl> <dbl>
## 1 BS 1 Cash & Equivalents NA NA
## 2 BS 2 Short Term Investments 27197 45084
## 3 BS 3 Cash and Short Term Investments 38349 55283
## 4 BS 4 Accounts Receivable - Trade, Net 12953 12229
## 5 BS 5 Receivables - Other NA NA
## 6 BS 6 Total Receivables, Net 24621 19824
## 7 BS 7 Total Inventory 2451 2281
## 8 BS 8 Prepaid Expenses NA NA
## 9 BS 9 Other Current Assets, Total 10798 10204
## 10 BS 10 Total Current Assets 76219 87592
## # ... with 100 more rows, and 3 more variables: `2016-06-25` <dbl>,
## # `2016-09-24` <dbl>, `2016-12-31` <dbl>
# データ取得
X <- tq_get("plat", get = "metal.prices",
from = "2000-01-01", base.currency = "EUR") %T>% print()
## # A tibble: 1,826 × 2
## date price
## <date> <dbl>
## 1 2012-03-16 1275.45
## 2 2012-03-17 1269.03
## 3 2012-03-18 1273.60
## 4 2012-03-19 1273.03
## 5 2012-03-20 1252.22
## 6 2012-03-21 1239.01
## 7 2012-03-22 1230.04
## 8 2012-03-23 1229.18
## 9 2012-03-24 1225.72
## 10 2012-03-25 1232.14
## # ... with 1,816 more rows
# データ項目
X %>% glimpse()
## Observations: 1,826
## Variables: 2
## $ date <date> 2012-03-16, 2012-03-17, 2012-03-18, 2012-03-19, 2012-03...
## $ price <dbl> 1275.45, 1269.03, 1273.60, 1273.03, 1252.22, 1239.01, 12...
# グラフ化
X %>% ggplot(aes(date, price)) + geom_line()
data_frame(package = c("as_xts",
"as_tibble")) %>% formattable(align = "l")
package |
---|
as_xts |
as_tibble |
# データ取得
X_xts <- getSymbols("AAPL", auto.assign = FALSE)
X_xts %>% {
head(.) %>% print()
class(.) %>% print()
}
## AAPL.Open AAPL.High AAPL.Low AAPL.Close AAPL.Volume
## 2007-01-03 86.29 86.58 81.90 83.80 309579900
## 2007-01-04 84.05 85.95 83.82 85.66 211815100
## 2007-01-05 85.77 86.20 84.40 85.05 208685400
## 2007-01-08 85.96 86.53 85.28 85.47 199276700
## 2007-01-09 86.45 92.98 85.15 92.57 837324600
## 2007-01-10 94.75 97.80 93.45 97.00 738220000
## AAPL.Adjusted
## 2007-01-03 10.85709
## 2007-01-04 11.09807
## 2007-01-05 11.01904
## 2007-01-08 11.07345
## 2007-01-09 11.99333
## 2007-01-10 12.56728
## [1] "xts" "zoo"
# tibbleクラスに変換
# --- 日付は<chr>になっている
X_tbl_c <- X_xts %>% as_tibble(preserve_row_names = TRUE)
X_tbl_c %>% {
head(.) %>% print()
class(.) %>% print()
}
## # A tibble: 6 × 7
## row.names AAPL.Open AAPL.High AAPL.Low AAPL.Close AAPL.Volume
## <chr> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 2007-01-03 86.29 86.58 81.90 83.80 309579900
## 2 2007-01-04 84.05 85.95 83.82 85.66 211815100
## 3 2007-01-05 85.77 86.20 84.40 85.05 208685400
## 4 2007-01-08 85.96 86.53 85.28 85.47 199276700
## 5 2007-01-09 86.45 92.98 85.15 92.57 837324600
## 6 2007-01-10 94.75 97.80 93.45 97.00 738220000
## # ... with 1 more variables: AAPL.Adjusted <dbl>
## [1] "tbl_df" "tbl" "data.frame"
# 日付を<date>に変換
X_tbl_d <- X_tbl_c %>% mutate(row.names = ymd(row.names))
X_tbl_d %>% {
head(.) %>% print()
class(.) %>% print()
}
## # A tibble: 6 × 7
## row.names AAPL.Open AAPL.High AAPL.Low AAPL.Close AAPL.Volume
## <date> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 2007-01-03 86.29 86.58 81.90 83.80 309579900
## 2 2007-01-04 84.05 85.95 83.82 85.66 211815100
## 3 2007-01-05 85.77 86.20 84.40 85.05 208685400
## 4 2007-01-08 85.96 86.53 85.28 85.47 199276700
## 5 2007-01-09 86.45 92.98 85.15 92.57 837324600
## 6 2007-01-10 94.75 97.80 93.45 97.00 738220000
## # ... with 1 more variables: AAPL.Adjusted <dbl>
## [1] "tbl_df" "tbl" "data.frame"
# 日付列が<date>なら問題なく変換
X_tbl_d %>%
as_xts(date_col = row.names) %>%
first(5)
## [1] 86.29
# 日付列でなければ{lublidate}で<date>に変換
X_tbl_c %>%
mutate(row.names = ymd(row.names)) %>%
as_xts(date_col = row.names) %>%
first(5)
## [1] 86.29
zoo・xts・quantmod・TTR
の4つ# 関数群の確認
tq_transmute_fun_options() %>% glimpse()
## List of 4
## $ zoo : chr [1:14] "rollapply" "rollapplyr" "rollmax" "rollmax.default" ...
## $ xts : chr [1:27] "apply.daily" "apply.monthly" "apply.quarterly" "apply.weekly" ...
## $ quantmod: chr [1:25] "allReturns" "annualReturn" "ClCl" "dailyReturn" ...
## $ TTR : chr [1:61] "adjRatios" "ADX" "ALMA" "aroon" ...
時系列ローリング
の関数群を扱うtq_transmute_fun_options()$zoo
## [1] "rollapply" "rollapplyr" "rollmax"
## [4] "rollmax.default" "rollmaxr" "rollmean"
## [7] "rollmean.default" "rollmeanr" "rollmedian"
## [10] "rollmedian.default" "rollmedianr" "rollsum"
## [13] "rollsum.default" "rollsumr"
時系列apply関数
と頻度変換
の関数群を扱うtq_transmute_fun_options()$xts
## [1] "apply.daily" "apply.monthly" "apply.quarterly"
## [4] "apply.weekly" "apply.yearly" "diff.xts"
## [7] "lag.xts" "period.apply" "period.max"
## [10] "period.min" "period.prod" "period.sum"
## [13] "periodicity" "to.daily" "to.hourly"
## [16] "to.minutes" "to.minutes10" "to.minutes15"
## [19] "to.minutes3" "to.minutes30" "to.minutes5"
## [22] "to.monthly" "to.period" "to.quarterly"
## [25] "to.weekly" "to.yearly" "to_period"
tq_transmute_fun_options()$quantmod
## [1] "allReturns" "annualReturn" "ClCl"
## [4] "dailyReturn" "Delt" "HiCl"
## [7] "Lag" "LoCl" "LoHi"
## [10] "monthlyReturn" "Next" "OpCl"
## [13] "OpHi" "OpLo" "OpOp"
## [16] "periodReturn" "quarterlyReturn" "seriesAccel"
## [19] "seriesDecel" "seriesDecr" "seriesHi"
## [22] "seriesIncr" "seriesLo" "weeklyReturn"
## [25] "yearlyReturn"
tq_transmute_fun_options()$TTR
## [1] "adjRatios" "ADX" "ALMA"
## [4] "aroon" "ATR" "BBands"
## [7] "CCI" "chaikinAD" "chaikinVolatility"
## [10] "CLV" "CMF" "CMO"
## [13] "DEMA" "DonchianChannel" "DPO"
## [16] "DVI" "EMA" "EMV"
## [19] "EVWMA" "GMMA" "growth"
## [22] "HMA" "KST" "lags"
## [25] "MACD" "MFI" "momentum"
## [28] "OBV" "PBands" "ROC"
## [31] "rollSFM" "RSI" "runCor"
## [34] "runCov" "runMAD" "runMax"
## [37] "runMean" "runMedian" "runMin"
## [40] "runPercentRank" "runSD" "runSum"
## [43] "runVar" "SAR" "SMA"
## [46] "SMI" "stoch" "TDI"
## [49] "TRIX" "ultimateOscillator" "VHF"
## [52] "VMA" "volatility" "VWAP"
## [55] "VWMA" "wilderSum" "williamsAD"
## [58] "WMA" "WPR" "ZigZag"
## [61] "ZLEMA"
FANG %>% print()
## # A tibble: 4,032 × 8
## symbol date open high low close volume adjusted
## <chr> <date> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 FB 2013-01-02 27.44 28.18 27.42 28.00 69846400 28.00
## 2 FB 2013-01-03 27.88 28.47 27.59 27.77 63140600 27.77
## 3 FB 2013-01-04 28.01 28.93 27.83 28.76 72715400 28.76
## 4 FB 2013-01-07 28.69 29.79 28.65 29.42 83781800 29.42
## 5 FB 2013-01-08 29.51 29.60 28.86 29.06 45871300 29.06
## 6 FB 2013-01-09 29.67 30.60 29.49 30.59 104787700 30.59
## 7 FB 2013-01-10 30.60 31.45 30.28 31.30 95316400 31.30
## 8 FB 2013-01-11 31.28 31.96 31.10 31.72 89598000 31.72
## 9 FB 2013-01-14 32.08 32.21 30.62 30.95 98892800 30.95
## 10 FB 2013-01-15 30.64 31.71 29.88 30.10 173242600 30.10
## # ... with 4,022 more rows
FANG_annual_returns <- FANG %>%
group_by(symbol) %>%
tq_transmute(ohlc_fun = Ad,
mutate_fun = periodReturn,
period = "yearly",
type = "arithmetic") %>%
print()
## Source: local data frame [16 x 3]
## Groups: symbol [4]
##
## symbol date yearly.returns
## <chr> <date> <dbl>
## 1 FB 2013-12-31 0.95178579
## 2 FB 2014-12-31 0.42763027
## 3 FB 2015-12-31 0.34145101
## 4 FB 2016-12-30 0.09927383
## 5 AMZN 2013-12-31 0.54984265
## 6 AMZN 2014-12-31 -0.22177086
## 7 AMZN 2015-12-31 1.17783149
## 8 AMZN 2016-12-30 0.10945565
## 9 NFLX 2013-12-31 3.00141286
## 10 NFLX 2014-12-31 -0.07214057
## 11 NFLX 2015-12-31 1.34378372
## 12 NFLX 2016-12-30 0.08235711
## 13 GOOG 2013-12-31 0.54954725
## 14 GOOG 2014-12-31 -0.05965347
## 15 GOOG 2015-12-31 0.44163478
## 16 GOOG 2016-12-30 0.01705145
FANG_annual_returns %>%
ggplot(aes(x = date, y = yearly.returns, fill = symbol)) +
geom_bar(stat = "identity") +
geom_hline(yintercept = 0, color = palette_light()[[1]]) +
scale_y_continuous(labels = scales::percent) +
labs(title = "FANG: Annual Returns",
subtitle = "Get annual returns quickly with tq_transmute!",
y = "Annual Returns", x = "") +
facet_wrap(~ symbol, ncol = 2) +
theme_tq() +
scale_fill_tq()
FANG %>% print()
## # A tibble: 4,032 × 8
## symbol date open high low close volume adjusted
## <chr> <date> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 FB 2013-01-02 27.44 28.18 27.42 28.00 69846400 28.00
## 2 FB 2013-01-03 27.88 28.47 27.59 27.77 63140600 27.77
## 3 FB 2013-01-04 28.01 28.93 27.83 28.76 72715400 28.76
## 4 FB 2013-01-07 28.69 29.79 28.65 29.42 83781800 29.42
## 5 FB 2013-01-08 29.51 29.60 28.86 29.06 45871300 29.06
## 6 FB 2013-01-09 29.67 30.60 29.49 30.59 104787700 30.59
## 7 FB 2013-01-10 30.60 31.45 30.28 31.30 95316400 31.30
## 8 FB 2013-01-11 31.28 31.96 31.10 31.72 89598000 31.72
## 9 FB 2013-01-14 32.08 32.21 30.62 30.95 98892800 30.95
## 10 FB 2013-01-15 30.64 31.71 29.88 30.10 173242600 30.10
## # ... with 4,022 more rows
FANG_daily_log_returns <- FANG %>%
group_by(symbol) %>%
tq_transmute(ohlc_fun = Ad,
mutate_fun = periodReturn,
period = "daily",
type = "log",
col_rename = "monthly.returns")
FANG_daily_log_returns %>%
ggplot(aes(x = monthly.returns, fill = symbol)) +
geom_density(alpha = 0.5) +
labs(title = "FANG: Charting the Daily Log Returns",
x = "Monthly Returns", y = "Density") +
theme_tq() +
scale_fill_tq() +
facet_wrap(~ symbol, ncol = 2)
FANG %>% print()
## # A tibble: 4,032 × 8
## symbol date open high low close volume adjusted
## <chr> <date> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 FB 2013-01-02 27.44 28.18 27.42 28.00 69846400 28.00
## 2 FB 2013-01-03 27.88 28.47 27.59 27.77 63140600 27.77
## 3 FB 2013-01-04 28.01 28.93 27.83 28.76 72715400 28.76
## 4 FB 2013-01-07 28.69 29.79 28.65 29.42 83781800 29.42
## 5 FB 2013-01-08 29.51 29.60 28.86 29.06 45871300 29.06
## 6 FB 2013-01-09 29.67 30.60 29.49 30.59 104787700 30.59
## 7 FB 2013-01-10 30.60 31.45 30.28 31.30 95316400 31.30
## 8 FB 2013-01-11 31.28 31.96 31.10 31.72 89598000 31.72
## 9 FB 2013-01-14 32.08 32.21 30.62 30.95 98892800 30.95
## 10 FB 2013-01-15 30.64 31.71 29.88 30.10 173242600 30.10
## # ... with 4,022 more rows
FANG %>%
group_by(symbol) %>%
ggplot(aes(x = date, y = adjusted, color = symbol)) +
geom_line(size = 1) +
labs(title = "Daily Stock Prices",
x = "", y = "Adjusted Prices", color = "") +
facet_wrap(~ symbol, ncol = 2, scales = "free_y") +
scale_y_continuous(labels = scales::dollar) +
theme_tq() +
scale_color_tq()
FANG_monthly <- FANG %>%
group_by(symbol) %>%
tq_transmute(ohlc_fun = Ad, mutate_fun = to.period, period = "months") %>%
print()
## Source: local data frame [192 x 3]
## Groups: symbol [4]
##
## symbol date adjusted
## <chr> <date> <dbl>
## 1 FB 2013-01-31 30.98
## 2 FB 2013-02-28 27.25
## 3 FB 2013-03-28 25.58
## 4 FB 2013-04-30 27.77
## 5 FB 2013-05-31 24.35
## 6 FB 2013-06-28 24.88
## 7 FB 2013-07-31 36.80
## 8 FB 2013-08-30 41.29
## 9 FB 2013-09-30 50.23
## 10 FB 2013-10-31 50.21
## # ... with 182 more rows
FANG_monthly %>%
ggplot(aes(x = date, y = adjusted, color = symbol)) +
geom_line(size = 1) +
labs(title = "Monthly Stock Prices",
x = "", y = "Adjusted Prices", color = "") +
facet_wrap(~ symbol, ncol = 2, scales = "free_y") +
scale_y_continuous(labels = scales::dollar) +
theme_tq() +
scale_color_tq()
# Asset Returns
FANG_returns_monthly <- FANG %>%
group_by(symbol) %>%
tq_transmute(ohlc_fun = Ad,
mutate_fun = periodReturn,
period = "monthly")
# Baseline Returns
baseline_returns_monthly <- "XLK" %>%
tq_get(get = "stock.prices",
from = "2013-01-01",
to = "2016-12-31") %>%
tq_transmute(ohlc_fun = Ad,
mutate_fun = periodReturn,
period = "monthly")
returns_joined <- left_join(FANG_returns_monthly,
baseline_returns_monthly,
by = "date")
returns_joined
## Source: local data frame [192 x 4]
## Groups: symbol [?]
##
## symbol date monthly.returns.x monthly.returns.y
## <chr> <date> <dbl> <dbl>
## 1 FB 2013-01-31 0.1064285714 -0.01375376
## 2 FB 2013-02-28 -0.1204002582 0.00782312
## 3 FB 2013-03-28 -0.0612844037 0.02577700
## 4 FB 2013-04-30 0.0856137608 0.01750903
## 5 FB 2013-05-31 -0.1231544833 0.02792210
## 6 FB 2013-06-28 0.0217658727 -0.02891755
## 7 FB 2013-07-31 0.4790996977 0.03726707
## 8 FB 2013-08-30 0.1220109272 -0.01040025
## 9 FB 2013-09-30 0.2165172871 0.02532125
## 10 FB 2013-10-31 -0.0003981883 0.05024969
## # ... with 182 more rows
FANG_rolling_corr <- returns_joined %>%
tq_transmute_xy(x = monthly.returns.x,
y = monthly.returns.y,
mutate_fun = runCor,
n = 6,
col_rename = "rolling.corr.6") %>%
print()
## Source: local data frame [192 x 3]
## Groups: symbol [4]
##
## symbol date rolling.corr.6
## <chr> <date> <dbl>
## 1 FB 2013-01-31 NA
## 2 FB 2013-02-28 NA
## 3 FB 2013-03-28 NA
## 4 FB 2013-04-30 NA
## 5 FB 2013-05-31 NA
## 6 FB 2013-06-28 -0.5187598
## 7 FB 2013-07-31 0.3246464
## 8 FB 2013-08-30 0.2350187
## 9 FB 2013-09-30 0.3962240
## 10 FB 2013-10-31 0.1848326
## # ... with 182 more rows
FANG_rolling_corr %>%
ggplot(aes(x = date, y = rolling.corr.6, color = symbol)) +
geom_hline(yintercept = 0, color = palette_light()[[1]]) +
geom_line(size = 1) +
labs(title = "FANG: Six Month Rolling Correlation to XLK",
x = "", y = "Correlation", color = "") +
facet_wrap(~ symbol, ncol = 2) +
theme_tq() +
scale_color_tq()
## Warning: Removed 20 rows containing missing values (geom_path).
FANG %>% print()
## # A tibble: 4,032 × 8
## symbol date open high low close volume adjusted
## <chr> <date> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 FB 2013-01-02 27.44 28.18 27.42 28.00 69846400 28.00
## 2 FB 2013-01-03 27.88 28.47 27.59 27.77 63140600 27.77
## 3 FB 2013-01-04 28.01 28.93 27.83 28.76 72715400 28.76
## 4 FB 2013-01-07 28.69 29.79 28.65 29.42 83781800 29.42
## 5 FB 2013-01-08 29.51 29.60 28.86 29.06 45871300 29.06
## 6 FB 2013-01-09 29.67 30.60 29.49 30.59 104787700 30.59
## 7 FB 2013-01-10 30.60 31.45 30.28 31.30 95316400 31.30
## 8 FB 2013-01-11 31.28 31.96 31.10 31.72 89598000 31.72
## 9 FB 2013-01-14 32.08 32.21 30.62 30.95 98892800 30.95
## 10 FB 2013-01-15 30.64 31.71 29.88 30.10 173242600 30.10
## # ... with 4,022 more rows
FANG_macd <- FANG %>%
group_by(symbol) %>%
tq_mutate(ohlc_fun = Cl,
mutate_fun = MACD,
nFast = 12,
nSlow = 26,
nSig = 9,
maType = SMA) %>%
mutate(diff = macd - signal) %>%
select(-(open:volume)) %T>%
print()
## Source: local data frame [4,032 x 6]
## Groups: symbol [4]
##
## symbol date adjusted macd signal diff
## <chr> <date> <dbl> <dbl> <dbl> <dbl>
## 1 FB 2013-01-02 28.00 NA NA NA
## 2 FB 2013-01-03 27.77 NA NA NA
## 3 FB 2013-01-04 28.76 NA NA NA
## 4 FB 2013-01-07 29.42 NA NA NA
## 5 FB 2013-01-08 29.06 NA NA NA
## 6 FB 2013-01-09 30.59 NA NA NA
## 7 FB 2013-01-10 31.30 NA NA NA
## 8 FB 2013-01-11 31.72 NA NA NA
## 9 FB 2013-01-14 30.95 NA NA NA
## 10 FB 2013-01-15 30.10 NA NA NA
## # ... with 4,022 more rows
FANG_macd %>%
filter(date >= as_date("2016-10-01")) %>%
ggplot(aes(x = date)) +
geom_hline(yintercept = 0, color = palette_light()[[1]]) +
geom_line(aes(y = macd, col = symbol)) +
geom_line(aes(y = signal), color = "blue", linetype = 2) +
geom_bar(aes(y = diff), stat = "identity", color = palette_light()[[1]]) +
facet_wrap(~ symbol, ncol = 2, scale = "free_y") +
labs(title = "FANG: Moving Average Convergence Divergence",
y = "MACD", x = "", color = "") +
theme_tq() +
scale_color_tq()
FANG %>% print()
## # A tibble: 4,032 × 8
## symbol date open high low close volume adjusted
## <chr> <date> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 FB 2013-01-02 27.44 28.18 27.42 28.00 69846400 28.00
## 2 FB 2013-01-03 27.88 28.47 27.59 27.77 63140600 27.77
## 3 FB 2013-01-04 28.01 28.93 27.83 28.76 72715400 28.76
## 4 FB 2013-01-07 28.69 29.79 28.65 29.42 83781800 29.42
## 5 FB 2013-01-08 29.51 29.60 28.86 29.06 45871300 29.06
## 6 FB 2013-01-09 29.67 30.60 29.49 30.59 104787700 30.59
## 7 FB 2013-01-10 30.60 31.45 30.28 31.30 95316400 31.30
## 8 FB 2013-01-11 31.28 31.96 31.10 31.72 89598000 31.72
## 9 FB 2013-01-14 32.08 32.21 30.62 30.95 98892800 30.95
## 10 FB 2013-01-15 30.64 31.71 29.88 30.10 173242600 30.10
## # ... with 4,022 more rows
FANG_max_by_qtr <- FANG %>%
group_by(symbol) %>%
tq_transmute(ohlc_fun = Ad,
mutate_fun = apply.quarterly,
FUN = max,
col_rename = "max.close") %>%
mutate(year.qtr = paste0(year(date), "-Q", quarter(date))) %>%
select(-date) %T>%
print()
## Source: local data frame [64 x 3]
## Groups: symbol [4]
##
## symbol max.close year.qtr
## <chr> <dbl> <chr>
## 1 FB 32.47 2013-Q1
## 2 FB 28.97 2013-Q2
## 3 FB 51.24 2013-Q3
## 4 FB 57.96 2013-Q4
## 5 FB 72.03 2014-Q1
## 6 FB 67.60 2014-Q2
## 7 FB 79.04 2014-Q3
## 8 FB 81.45 2014-Q4
## 9 FB 85.31 2015-Q1
## 10 FB 88.86 2015-Q2
## # ... with 54 more rows
FANG_min_by_qtr <- FANG %>%
group_by(symbol) %>%
tq_transmute(ohlc_fun = Ad,
mutate_fun = apply.quarterly,
FUN = min,
col_rename = "min.close") %>%
mutate(year.qtr = paste0(year(date), "-Q", quarter(date))) %>%
select(-date) %T>%
print()
## Source: local data frame [64 x 3]
## Groups: symbol [4]
##
## symbol min.close year.qtr
## <chr> <dbl> <chr>
## 1 FB 25.13 2013-Q1
## 2 FB 22.90 2013-Q2
## 3 FB 24.37 2013-Q3
## 4 FB 44.82 2013-Q4
## 5 FB 53.53 2014-Q1
## 6 FB 56.14 2014-Q2
## 7 FB 62.76 2014-Q3
## 8 FB 72.63 2014-Q4
## 9 FB 74.05 2015-Q1
## 10 FB 77.46 2015-Q2
## # ... with 54 more rows
FANG_by_qtr <- left_join(FANG_max_by_qtr, FANG_min_by_qtr,
by = c("symbol" = "symbol",
"year.qtr" = "year.qtr"))
FANG_by_qtr %>%
ggplot(aes(x = year.qtr, color = symbol)) +
geom_segment(aes(xend = year.qtr, y = min.close, yend = max.close),
size = 1) +
geom_point(aes(y = max.close), size = 2) +
geom_point(aes(y = min.close), size = 2) +
facet_wrap(~ symbol, ncol = 2, scale = "free_y") +
labs(title = "FANG: Min/Max Price By Quarter",
y = "Stock Price", color = "") +
theme_tq() +
scale_color_tq() +
scale_y_continuous(labels = scales::dollar) +
theme(axis.text.x = element_text(angle = 90, hjust = 1),
axis.title.x = element_blank())
tq_get()
に複数のコードをインプットするとtibbleクラスでデータ取得できるc("AAPL", "GOOG", "JPM") %>%
tq_get(get = "stock.prices", from = "2016-12-20", to = "2016-12-24")
## # A tibble: 12 × 8
## symbol date open high low close volume adjusted
## <chr> <date> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 AAPL 2016-12-20 116.74 117.500 116.68 116.95 21425000 116.44514
## 2 AAPL 2016-12-21 116.80 117.400 116.78 117.06 23783200 116.55466
## 3 AAPL 2016-12-22 116.35 116.510 115.64 116.29 26085900 115.78799
## 4 AAPL 2016-12-23 115.59 116.520 115.59 116.52 14249500 116.01699
## 5 GOOG 2016-12-20 796.76 798.650 793.27 796.42 925100 796.41998
## 6 GOOG 2016-12-21 795.84 796.676 787.10 794.56 1208700 794.56000
## 7 GOOG 2016-12-22 792.36 793.320 788.58 791.26 969100 791.26001
## 8 GOOG 2016-12-23 790.90 792.740 787.28 789.91 623400 789.90997
## 9 JPM 2016-12-20 85.79 86.540 85.55 86.53 14587300 86.05385
## 10 JPM 2016-12-21 86.43 86.810 86.03 86.75 11400500 86.27264
## 11 JPM 2016-12-22 86.44 87.170 86.21 86.89 13924200 86.41187
## 12 JPM 2016-12-23 87.00 87.150 86.40 87.05 10759400 86.57099
tibble(symbol = c("AAPL", "GOOG", "JPM")) %>%
tq_get(get = "stock.prices", from = "2016-12-20", to = "2016-12-24")
## # A tibble: 12 × 8
## symbol date open high low close volume adjusted
## <chr> <date> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 AAPL 2016-12-20 116.74 117.500 116.68 116.95 21425000 116.44514
## 2 AAPL 2016-12-21 116.80 117.400 116.78 117.06 23783200 116.55466
## 3 AAPL 2016-12-22 116.35 116.510 115.64 116.29 26085900 115.78799
## 4 AAPL 2016-12-23 115.59 116.520 115.59 116.52 14249500 116.01699
## 5 GOOG 2016-12-20 796.76 798.650 793.27 796.42 925100 796.41998
## 6 GOOG 2016-12-21 795.84 796.676 787.10 794.56 1208700 794.56000
## 7 GOOG 2016-12-22 792.36 793.320 788.58 791.26 969100 791.26001
## 8 GOOG 2016-12-23 790.90 792.740 787.28 789.91 623400 789.90997
## 9 JPM 2016-12-20 85.79 86.540 85.55 86.53 14587300 86.05385
## 10 JPM 2016-12-21 86.43 86.810 86.03 86.75 11400500 86.27264
## 11 JPM 2016-12-22 86.44 87.170 86.21 86.89 13924200 86.41187
## 12 JPM 2016-12-23 87.00 87.150 86.40 87.05 10759400 86.57099
指数構成銘柄リスト(tq_index)
と連携したデータ取得も可能tq_index("DOWJONES") %>%
slice(1:3) %>%
tq_get(get = "stock.prices", from = "2016-12-20", to = "2016-12-24")
## Getting data...
## # A tibble: 12 × 9
## symbol company date open high low
## <chr> <chr> <date> <dbl> <dbl> <dbl>
## 1 MMM 3M 2016-12-20 178.34 179.33 178.06
## 2 MMM 3M 2016-12-21 178.60 179.53 178.42
## 3 MMM 3M 2016-12-22 178.89 179.46 177.98
## 4 MMM 3M 2016-12-23 179.09 179.29 178.53
## 5 ALK ALASKA AIR GROUP 2016-12-20 90.64 91.89 90.26
## 6 ALK ALASKA AIR GROUP 2016-12-21 91.26 91.59 90.05
## 7 ALK ALASKA AIR GROUP 2016-12-22 91.22 91.34 88.75
## 8 ALK ALASKA AIR GROUP 2016-12-23 89.38 90.47 89.36
## 9 AAL AMERICAN AIRLINES GROUP INC. 2016-12-20 48.50 49.50 48.50
## 10 AAL AMERICAN AIRLINES GROUP INC. 2016-12-21 49.34 49.90 49.23
## 11 AAL AMERICAN AIRLINES GROUP INC. 2016-12-22 49.35 49.45 48.46
## 12 AAL AMERICAN AIRLINES GROUP INC. 2016-12-23 48.61 48.84 48.29
## # ... with 3 more variables: close <dbl>, volume <dbl>, adjusted <dbl>
tibble(symbol = c("AAPL", "GOOG", "JPM")) %>%
mutate(stock.prices = map(.x = symbol,
~ tq_get(.x, get = "stock.prices")))
## # A tibble: 3 × 2
## symbol stock.prices
## <chr> <list>
## 1 AAPL <tibble [2,568 × 7]>
## 2 GOOG <tibble [2,568 × 7]>
## 3 JPM <tibble [2,568 × 7]>
list("AAPL", "GOOG", "AMZN", "FB") %>%
map(.x = ., ~ tq_get(.x,
get = "stock.prices",
from = "2016-12-20",
to = "2016-12-24"))
## [[1]]
## # A tibble: 4 × 7
## date open high low close volume adjusted
## <date> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 2016-12-20 116.74 117.50 116.68 116.95 21425000 116.4451
## 2 2016-12-21 116.80 117.40 116.78 117.06 23783200 116.5547
## 3 2016-12-22 116.35 116.51 115.64 116.29 26085900 115.7880
## 4 2016-12-23 115.59 116.52 115.59 116.52 14249500 116.0170
##
## [[2]]
## # A tibble: 4 × 7
## date open high low close volume adjusted
## <date> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 2016-12-20 796.76 798.650 793.27 796.42 925100 796.42
## 2 2016-12-21 795.84 796.676 787.10 794.56 1208700 794.56
## 3 2016-12-22 792.36 793.320 788.58 791.26 969100 791.26
## 4 2016-12-23 790.90 792.740 787.28 789.91 623400 789.91
##
## [[3]]
## # A tibble: 4 × 7
## date open high low close volume adjusted
## <date> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 2016-12-20 768.65 774.39 767.71 771.22 2667900 771.22
## 2 2016-12-21 770.00 771.22 765.70 770.60 2040400 770.60
## 3 2016-12-22 768.12 771.21 763.02 766.34 2518300 766.34
## 4 2016-12-23 764.55 766.50 757.99 760.59 1976900 760.59
##
## [[4]]
## # A tibble: 4 × 7
## date open high low close volume adjusted
## <date> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 2016-12-20 119.50 119.77 118.80 119.09 13528100 119.09
## 2 2016-12-21 118.92 119.20 118.48 119.04 10735800 119.04
## 3 2016-12-22 118.86 118.99 116.93 117.40 16222400 117.40
## 4 2016-12-23 117.00 117.56 116.30 117.27 10877300 117.27
# 準備:データセットの確認
FANG %>% print()
## # A tibble: 4,032 × 8
## symbol date open high low close volume adjusted
## <chr> <date> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 FB 2013-01-02 27.44 28.18 27.42 28.00 69846400 28.00
## 2 FB 2013-01-03 27.88 28.47 27.59 27.77 63140600 27.77
## 3 FB 2013-01-04 28.01 28.93 27.83 28.76 72715400 28.76
## 4 FB 2013-01-07 28.69 29.79 28.65 29.42 83781800 29.42
## 5 FB 2013-01-08 29.51 29.60 28.86 29.06 45871300 29.06
## 6 FB 2013-01-09 29.67 30.60 29.49 30.59 104787700 30.59
## 7 FB 2013-01-10 30.60 31.45 30.28 31.30 95316400 31.30
## 8 FB 2013-01-11 31.28 31.96 31.10 31.72 89598000 31.72
## 9 FB 2013-01-14 32.08 32.21 30.62 30.95 98892800 30.95
## 10 FB 2013-01-15 30.64 31.71 29.88 30.10 173242600 30.10
## # ... with 4,022 more rows
# 銘柄ごとに年率データを取得
FANG_returns_yearly <- FANG %>%
group_by(symbol) %>%
tq_transmute(ohlc_fun = Ad,
mutate_fun = periodReturn,
period = "yearly",
col_rename = "yearly.returns") %T>% print()
## Source: local data frame [16 x 3]
## Groups: symbol [4]
##
## symbol date yearly.returns
## <chr> <date> <dbl>
## 1 FB 2013-12-31 0.95178579
## 2 FB 2014-12-31 0.42763027
## 3 FB 2015-12-31 0.34145101
## 4 FB 2016-12-30 0.09927383
## 5 AMZN 2013-12-31 0.54984265
## 6 AMZN 2014-12-31 -0.22177086
## 7 AMZN 2015-12-31 1.17783149
## 8 AMZN 2016-12-30 0.10945565
## 9 NFLX 2013-12-31 3.00141286
## 10 NFLX 2014-12-31 -0.07214057
## 11 NFLX 2015-12-31 1.34378372
## 12 NFLX 2016-12-30 0.08235711
## 13 GOOG 2013-12-31 0.54954725
## 14 GOOG 2014-12-31 -0.05965347
## 15 GOOG 2015-12-31 0.44163478
## 16 GOOG 2016-12-30 0.01705145
# チャート化
FANG_returns_yearly %>%
ggplot(aes(date, yearly.returns, fill = symbol)) +
geom_bar(position = "dodge", stat = "identity") +
labs(title = "FANG: Annual Returns",
subtitle = "Mutating at scale is quick and easy!",
x = "Periods",
y = "Returns",
color = "Symbol") +
scale_y_continuous(labels = scales::percent) +
theme_tq() +
scale_fill_tq()
purrr::map()
で複数銘柄に適用する# 関数定義
get_annual_returns <- function(stock.symbol){
stock.symbol %>%
tq_get(get = "stock.prices",
from = "2007-01-01",
to = "2016-12-31") %>%
tq_transmute(ohlc_fun = Ad,
mutate_fun = periodReturn,
type = "log",
period = "yearly")
}
# データ取得
AAPL_annual_log_returns <- get_annual_returns("AAPL")
AAPL_annual_log_returns %>% print()
## # A tibble: 10 × 2
## date yearly.returns
## <date> <dbl>
## 1 2007-12-31 0.86023789
## 2 2008-12-31 -0.84191057
## 3 2009-12-31 0.90381734
## 4 2010-12-31 0.42571147
## 5 2011-12-30 0.22759789
## 6 2012-12-31 0.28191714
## 7 2013-12-31 0.07760424
## 8 2014-12-31 0.34090883
## 9 2015-12-31 -0.03060060
## 10 2016-12-30 0.11760900
AAPL_annual_log_returns %>%
ggplot(aes(x = year(date), y = yearly.returns)) +
geom_hline(yintercept = 0, color = palette_light()[[1]]) +
geom_point(size = 2, color = palette_light()[[3]]) +
geom_line(size = 1, color = palette_light()[[3]]) +
geom_smooth(method = "lm", se = FALSE) +
labs(title = "AAPL: Visualizing Trends in Annual Returns",
x = "", y = "Annual Returns", color = "") +
theme_tq()
#
mod <- AAPL_annual_log_returns %>% lm(yearly.returns ~ year(date), data = .)
mod %>% print()
##
## Call:
## lm(formula = yearly.returns ~ year(date), data = .)
##
## Coefficients:
## (Intercept) year(date)
## 58.86280 -0.02915
mod %>% tidy()
## term estimate std.error statistic p.value
## 1 (Intercept) 58.86280021 113.1073651 0.5204153 0.6168659
## 2 year(date) -0.02914567 0.0562303 -0.5183267 0.6182573
# 分析プロセスを関数化
get_model <- function(stock.symbol) {
annual_returns <- get_annual_returns(stock.symbol)
mod <- lm(yearly.returns ~ year(date), data = annual_returns)
tidy(mod)
}
# 実行テスト
get_model("AAPL")
## term estimate std.error statistic p.value
## 1 (Intercept) 58.86280021 113.1073651 0.5204153 0.6168659
## 2 year(date) -0.02914567 0.0562303 -0.5183267 0.6182573
# SP500から5銘柄を抽出
set.seed(10)
stocks <- tq_index("SP500") %>% sample_n(5)
## Getting data...
stocks %>% print()
## # A tibble: 5 × 2
## symbol company
## <chr> <chr>
## 1 KMI KINDER MORGAN
## 2 LLY ELI LILLY
## 3 HAS HASBRO
## 4 PFE PFIZER
## 5 AAPL APPLE
stocks_model_stats <- stocks %>%
mutate(model = map(symbol, get_model)) %>%
unnest() %>%
filter(term == "year(date)") %>%
arrange(desc(estimate)) %>%
select(-term) %T>%
print()
## # A tibble: 5 × 6
## symbol company estimate std.error statistic p.value
## <chr> <chr> <dbl> <dbl> <dbl> <dbl>
## 1 LLY ELI LILLY 0.02361584 0.01912303 1.2349420 0.2518902
## 2 PFE PFIZER 0.02153178 0.01427804 1.5080347 0.1699769
## 3 HAS HASBRO 0.01624251 0.02641365 0.6149289 0.5556847
## 4 AAPL APPLE -0.02914567 0.05623030 -0.5183267 0.6182573
## 5 KMI KINDER MORGAN -0.04970700 0.12666334 -0.3924340 0.7147511
stocks_model_stats %>%
ggplot(aes(symbol, estimate)) +
geom_bar(stat = "identity")
グラフ用関数群
が用意されている
<チャート作成>
geom_barchart
geom_bbands
geom_bbands_
geom_candlestick
geom_ma
geom_ma_
<軸設定>
coord_x_date
coord_x_datetime
<カラーパレット>
palette_dark
palette_green
palette_light
scale_color_tq
scale_fill_tq
<グラフテーマ>
theme_tq
theme_tq_dark
theme_tq_green
# 準備:データセットの確認
AAPL %>% head()
## # A tibble: 6 × 7
## date open high low close volume adjusted
## <date> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 2015-09-01 110.15 111.88 107.36 107.72 76845900 104.4734
## 2 2015-09-02 110.23 112.34 109.13 112.34 61888800 108.9541
## 3 2015-09-03 112.49 112.78 110.04 110.37 53233900 107.0435
## 4 2015-09-04 108.97 110.45 108.51 109.27 49996300 105.9767
## 5 2015-09-08 111.75 112.56 110.32 112.31 54843600 108.9250
## 6 2015-09-09 113.76 114.02 109.77 110.15 85010800 106.8301
# 折れ線グラフの作成
AAPL %>%
ggplot(aes(x = date, y = close)) +
geom_line() +
labs(title = "AAPL Line Chart", y = "Closing Price", x = "Date") +
theme_tq()
tidyquant::geom_barchart()
はカギ足チャートを書くために定義された関数AAPL %>%
ggplot(aes(x = date, y = close)) +
geom_barchart(aes(open = open, high = high, low = low, close = close)) +
labs(title = "AAPL Bar Chart", y = "Closing Price", x = "Date") +
theme_tq()
tidyquant::coord_x_date()
はチャート表示範囲を決定するために定義された関数AAPL %>%
ggplot(aes(x = date, y = close)) +
geom_barchart(aes(open = open, high = high, low = low, close = close)) +
labs(title = "AAPL Bar Chart",
subtitle = "Zoomed in using coord_x_date",
y = "Closing Price", x = "") +
coord_x_date(xlim = c(end - weeks(6), end),
ylim = c(100, 120)) +
theme_tq()
tidyquant::geom_barchart()
は上昇と下落の色を分けるなどの装飾が可能AAPL %>%
ggplot(aes(x = date, y = close)) +
geom_barchart(aes(open = open, high = high, low = low, close = close),
color_up = "darkgreen", color_down = "darkred", size = 1) +
labs(title = "AAPL Bar Chart",
subtitle = "Zoomed in, Experimenting with Formatting",
y = "Closing Price", x = "") +
coord_x_date(xlim = c(end - weeks(6), end),
ylim = c(100, 120)) +
theme_tq()
AAPL %>%
ggplot(aes(x = date, y = close)) +
geom_candlestick(aes(open = open, high = high, low = low, close = close)) +
labs(title = "AAPL Candlestick Chart", y = "Closing Price", x = "") +
theme_tq()
AAPL %>%
ggplot(aes(x = date, y = close)) +
geom_candlestick(aes(open = open, high = high, low = low, close = close)) +
labs(title = "AAPL Candlestick Chart",
subtitle = "Zoomed in using coord_x_date",
y = "Closing Price", x = "") +
coord_x_date(xlim = c(end - weeks(6), end),
ylim = c(100, 120)) +
theme_tq()
AAPL %>%
ggplot(aes(x = date, y = close)) +
geom_candlestick(aes(open = open, high = high, low = low, close = close),
color_up = "darkgreen", color_down = "darkred",
fill_up = "darkgreen", fill_down = "darkred") +
labs(title = "AAPL Candlestick Chart",
subtitle = "Zoomed in, Experimenting with Formatting",
y = "Closing Price", x = "") +
coord_x_date(xlim = c(end - weeks(6), end),
ylim = c(100, 120)) +
theme_tq()
geom_line() or geom_point
などの{ggplot2}の関数群とも融合できる
AAPL %>%
ggplot(aes(x = date, y = close)) +
geom_candlestick(aes(open = open, high = high, low = low, close = close)) +
geom_line(color = "steelblue", size = 1) +
geom_point(color = "steelblue", size = 3) +
labs(title = "AAPL Candlestick Chart",
subtitle = "Combining Chart Geoms",
y = "Closing Price", x = "") +
coord_x_date(xlim = c(end - weeks(6), end),
ylim = c(100, 120)) +
theme_tq()
start <- end - weeks(6)
FANG %>%
filter(date >= start - days(2 * 15)) %>%
ggplot(aes(x = date, y = close, group = symbol)) +
geom_candlestick(aes(open = open, high = high, low = low, close = close)) +
labs(title = "FANG Candlestick Chart",
subtitle = "Experimenting with Mulitple Stocks",
y = "Closing Price", x = "") +
coord_x_date(xlim = c(start, end)) +
facet_wrap(~ symbol, ncol = 2, scale = "free_y") +
theme_tq()
start <- end - weeks(6)
FANG %>%
filter(date >= start - days(2 * 15)) %>%
ggplot(aes(x = date, y = close, group = symbol)) +
geom_candlestick(aes(open = open, high = high, low = low, close = close)) +
geom_ma(ma_fun = SMA, n = 15, color = "darkblue", size = 1) +
labs(title = "FANG Candlestick Chart",
subtitle = "Experimenting with Mulitple Stocks",
y = "Closing Price", x = "") +
coord_x_date(xlim = c(start, end)) +
facet_wrap(~ symbol, ncol = 2, scale = "free_y") +
theme_tq()
AAPL %>%
ggplot(aes(x = date, y = close)) +
geom_candlestick(aes(open = open, high = high, low = low, close = close)) +
geom_ma(ma_fun = SMA, n = 50, linetype = 5, size = 1.25) +
geom_ma(ma_fun = SMA, n = 200, color = "red", size = 1.25) +
labs(title = "AAPL Candlestick Chart",
subtitle = "50 and 200-Day SMA",
y = "Closing Price", x = "") +
coord_x_date(xlim = c(end - weeks(24), end),
ylim = c(100, 120)) +
theme_tq()
AAPL %>%
ggplot(aes(x = date, y = close)) +
geom_barchart(aes(open = open, high = high, low = low, close = close)) +
geom_ma(ma_fun = EMA, n = 50, wilder = TRUE, linetype = 5, size = 1.25) +
geom_ma(ma_fun = EMA, n = 200, wilder = TRUE, color = "red", size = 1.25) +
labs(title = "AAPL Bar Chart",
subtitle = "50 and 200-Day EMA",
y = "Closing Price", x = "") +
coord_x_date(xlim = c(end - weeks(24), end),
ylim = c(100, 120)) +
theme_tq()
start <- end - weeks(6)
FANG %>%
filter(date >= start - days(2 * 50)) %>%
ggplot(aes(x = date, y = close, volume = volume, group = symbol)) +
geom_candlestick(aes(open = open, high = high, low = low, close = close)) +
geom_ma(ma_fun = VWMA, n = 15, wilder = TRUE, linetype = 5) +
geom_ma(ma_fun = VWMA, n = 50, wilder = TRUE, color = "red") +
labs(title = "FANG Bar Chart",
subtitle = "50 and 200-Day EMA, Experimenting with Multiple Stocks",
y = "Closing Price", x = "") +
coord_x_date(xlim = c(start, end)) +
facet_wrap(~ symbol, ncol = 2, scales = "free_y") +
theme_tq()
AAPL %>%
ggplot(aes(x = date, y = close, open = open,
high = high, low = low, close = close)) +
geom_candlestick() +
geom_bbands(ma_fun = SMA, sd = 2, n = 20) +
labs(title = "AAPL Candlestick Chart",
subtitle = "BBands with SMA Applied",
y = "Closing Price", x = "") +
coord_x_date(xlim = c(end - weeks(24), end),
ylim = c(100, 120)) +
theme_tq()
AAPL %>%
ggplot(aes(x = date, y = close, open = open,
high = high, low = low, close = close)) +
geom_candlestick() +
geom_bbands(ma_fun = SMA, sd = 2, n = 20,
linetype = 4, size = 1, alpha = 0.2,
fill = palette_light()[[1]],
color_bands = palette_light()[[1]],
color_ma = palette_light()[[2]]) +
labs(title = "AAPL Candlestick Chart",
subtitle = "BBands with SMA Applied, Experimenting with Formatting",
y = "Closing Price", x = "") +
coord_x_date(xlim = c(end - weeks(24), end),
ylim = c(100, 120)) +
theme_tq()
start <- end - weeks(24)
FANG %>%
filter(date >= start - days(2 * 20)) %>%
ggplot(aes(x = date, y = close,
open = open, high = high, low = low, close = close,
group = symbol)) +
geom_barchart() +
geom_bbands(ma_fun = SMA, sd = 2, n = 20, linetype = 5) +
labs(title = "FANG Bar Chart",
subtitle = "BBands with SMA Applied, Experimenting with Multiple Stocks",
y = "Closing Price", x = "") +
coord_x_date(xlim = c(start, end)) +
facet_wrap(~ symbol, ncol = 2, scales = "free_y") +
theme_tq()
AMZN %>%
ggplot(aes(x = date, y = adjusted)) +
geom_line(color = palette_light()[[1]]) +
scale_y_continuous() +
labs(title = "AMZN Line Chart",
subtitle = "Continuous Scale",
y = "Closing Price", x = "") +
theme_tq()
AMZN %>%
ggplot(aes(x = date, y = adjusted)) +
geom_line(color = palette_light()[[1]]) +
scale_y_log10() +
labs(title = "AMZN Line Chart",
subtitle = "Log Scale",
y = "Closing Price", x = "") +
theme_tq()
AMZN %>%
ggplot(aes(x = date, y = adjusted)) +
geom_line(color = palette_light()[[1]]) +
scale_y_log10() +
geom_smooth(method = "lm") +
labs(title = "AMZN Line Chart",
subtitle = "Log Scale, Applying Linear Trendline",
y = "Adjusted Closing Price", x = "") +
theme_tq()
AMZN %>%
ggplot(aes(x = date, y = adjusted)) +
geom_line(color = palette_light()[[1]]) +
scale_y_log10() +
geom_smooth(method = "loess") +
labs(title = "AMZN Line Chart",
subtitle = "Log Scale, Applying Loess Trendline",
y = "Adjusted Closing Price", x = "") +
theme_tq()
AMZN %>%
ggplot(aes(x = date, y = volume)) +
geom_segment(aes(xend = date, yend = 0, color = volume)) +
geom_smooth(method = "loess", se = FALSE) +
labs(title = "AMZN Volume Chart",
subtitle = "Charting Daily Volume",
y = "Volume", x = "") +
theme_tq() +
theme(legend.position = "none")
start <- end - weeks(24)
AMZN %>%
filter(date >= start - days(50)) %>%
ggplot(aes(x = date, y = volume)) +
geom_segment(aes(xend = date, yend = 0, color = volume)) +
geom_smooth(method = "loess", se = FALSE) +
labs(title = "AMZN Bar Chart",
subtitle = "Charting Daily Volume, Zooming In",
y = "Volume", x = "") +
coord_x_date(xlim = c(start, end)) +
scale_color_gradient(low = "red", high = "darkblue") +
theme_tq() +
theme(legend.position = "none")
theme_tq()
でコントロールするscale_color_tq()
でコントロールする- Light:
theme_tq() + scale_color_tq() + scale_fill_tq()
- Dark:
theme_tq_dark() + scale_color_tq(theme = "dark") + scale_fill_tq(theme = "dark")
- Green:
theme_tq_green() + scale_color_tq(theme = "green") + scale_fill_tq(theme = "green")
n_mavg <- 50 # Number of periods (days) for moving average
FANG %>%
filter(date >= start - days(2 * n_mavg)) %>%
ggplot(aes(x = date, y = close, color = symbol)) +
geom_line(size = 1) +
geom_ma(n = 15, color = "darkblue", size = 1) +
geom_ma(n = n_mavg, color = "red", size = 1) +
labs(title = "Light Theme",
x = "", y = "Closing Price") +
coord_x_date(xlim = c(start, end)) +
facet_wrap(~ symbol, scales = "free_y") +
theme_tq() +
scale_color_tq() +
scale_y_continuous(labels = scales::dollar)
n_mavg <- 50 # Number of periods (days) for moving average
FANG %>%
filter(date >= start - days(2 * n_mavg)) %>%
ggplot(aes(x = date, y = close, color = symbol)) +
geom_line(size = 1) +
geom_ma(n = 15, color = "darkblue", size = 1) +
geom_ma(n = n_mavg, color = "red", size = 1) +
labs(title = "Dark Theme",
x = "", y = "Closing Price") +
coord_x_date(xlim = c(start, end)) +
facet_wrap(~ symbol, scales = "free_y") +
theme_tq_dark() +
scale_color_tq(theme = "dark") +
scale_y_continuous(labels = scales::dollar)
n_mavg <- 50 # Number of periods (days) for moving average
FANG %>%
filter(date >= start - days(2 * n_mavg)) %>%
ggplot(aes(x = date, y = close, color = symbol)) +
geom_line(size = 1) +
geom_ma(n = 15, color = "darkblue", size = 1) +
geom_ma(n = n_mavg, color = "red", size = 1) +
labs(title = "Green Theme",
x = "", y = "Closing Price") +
coord_x_date(xlim = c(start, end)) +
facet_wrap(~ symbol, scales = "free_y") +
theme_tq_green() +
scale_color_tq(theme = "green") +
scale_y_continuous(labels = scales::dollar)
Ra <-
c("AAPL", "GOOG", "NFLX") %>%
tq_get(get = "stock.prices",
from = "2010-01-01",
to = "2015-12-31") %>%
group_by(symbol) %>%
tq_transmute(ohlc_fun = Ad,
mutate_fun = periodReturn,
period = "monthly",
col_rename = "Ra") %T>%
print()
## Source: local data frame [216 x 3]
## Groups: symbol [3]
##
## symbol date Ra
## <chr> <date> <dbl>
## 1 AAPL 2010-01-29 -0.10256526
## 2 AAPL 2010-02-26 0.06539619
## 3 AAPL 2010-03-31 0.14847041
## 4 AAPL 2010-04-30 0.11102125
## 5 AAPL 2010-05-28 -0.01612472
## 6 AAPL 2010-06-30 -0.02082686
## 7 AAPL 2010-07-30 0.02274081
## 8 AAPL 2010-08-31 -0.05500481
## 9 AAPL 2010-09-30 0.16721508
## 10 AAPL 2010-10-29 0.06072249
## # ... with 206 more rows
Rb <-
"XLK" %>%
tq_get(get = "stock.prices",
from = "2010-01-01",
to = "2015-12-31") %>%
tq_transmute(ohlc_fun = Ad,
mutate_fun = periodReturn,
period = "monthly",
col_rename = "Rb") %T>%
print()
## # A tibble: 72 × 2
## date Rb
## <date> <dbl>
## 1 2010-01-29 -0.09926949
## 2 2010-02-26 0.03482834
## 3 2010-03-31 0.06839788
## 4 2010-04-30 0.01255406
## 5 2010-05-28 -0.07481830
## 6 2010-06-30 -0.05396629
## 7 2010-07-30 0.07450984
## 8 2010-08-31 -0.05611310
## 9 2010-09-30 0.11663639
## 10 2010-10-29 0.05777586
## # ... with 62 more rows
ポートフォリオリターン
とベンチマークリターン
を結合RaRb <- Ra %>% left_join(Rb, by = c("date" = "date")) %T>% print()
## Source: local data frame [216 x 4]
## Groups: symbol [?]
##
## symbol date Ra Rb
## <chr> <date> <dbl> <dbl>
## 1 AAPL 2010-01-29 -0.10256526 -0.09926949
## 2 AAPL 2010-02-26 0.06539619 0.03482834
## 3 AAPL 2010-03-31 0.14847041 0.06839788
## 4 AAPL 2010-04-30 0.11102125 0.01255406
## 5 AAPL 2010-05-28 -0.01612472 -0.07481830
## 6 AAPL 2010-06-30 -0.02082686 -0.05396629
## 7 AAPL 2010-07-30 0.02274081 0.07450984
## 8 AAPL 2010-08-31 -0.05500481 -0.05611310
## 9 AAPL 2010-09-30 0.16721508 0.11663639
## 10 AAPL 2010-10-29 0.06072249 0.05777586
## # ... with 206 more rows
table.CAPM関数
に入力
RaRb_capm <- RaRb %>%
tq_performance(Ra = Ra,
Rb = Rb,
performance_fun = table.CAPM) %T>%
print()
## Source: local data frame [3 x 13]
## Groups: symbol [3]
##
## symbol ActivePremium Alpha AnnualizedAlpha Beta `Beta-` `Beta+`
## <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 AAPL 0.1176 0.0087 0.1099 1.1229 0.6366 1.0427
## 2 GOOG 0.0331 0.0028 0.0341 1.1376 1.3598 1.1651
## 3 NFLX 0.4440 0.0527 0.8514 0.3983 -1.5180 0.0048
## # ... with 6 more variables: Correlation <dbl>,
## # `Correlationp-value` <dbl>, InformationRatio <dbl>, `R-squared` <dbl>,
## # TrackingError <dbl>, TreynorRatio <dbl>
RaRb_capm %>%
select(symbol, Alpha, Beta)
## Source: local data frame [3 x 3]
## Groups: symbol [3]
##
## symbol Alpha Beta
## <chr> <dbl> <dbl>
## 1 AAPL 0.0087 1.1229
## 2 GOOG 0.0028 1.1376
## 3 NFLX 0.0527 0.3983
Sharpe Ratio
の算出を通してパフォーマンス分析のステップを確認# SharpeRatio関数を探す
# --- Bacon.risk.funsのカテゴリに含まれる
tq_performance_fun_options() %>% .$Bacon.risk.funs
## [1] "MeanAbsoluteDeviation" "Frequency" "SharpeRatio"
## [4] "MSquared" "MSquaredExcess" "HurstIndex"
# 引数の確認
args("SharpeRatio")
## function (R, Rf = 0, p = 0.95, FUN = c("StdDev", "VaR", "ES"),
## weights = NULL, annualize = FALSE, ...)
## NULL
stock_prices <-
c("AAPL", "GOOG", "NFLX") %>%
tq_get(get = "stock.prices",
from = "2010-01-01",
to = "2015-12-31") %T>%
print()
## # A tibble: 4,530 × 8
## symbol date open high low close volume adjusted
## <chr> <date> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 AAPL 2010-01-04 213.43 214.50 212.38 214.01 123432400 27.72704
## 2 AAPL 2010-01-05 214.60 215.59 213.25 214.38 150476200 27.77498
## 3 AAPL 2010-01-06 214.38 215.23 210.75 210.97 138040000 27.33318
## 4 AAPL 2010-01-07 211.75 212.00 209.05 210.58 119282800 27.28265
## 5 AAPL 2010-01-08 210.30 212.00 209.06 211.98 111902700 27.46403
## 6 AAPL 2010-01-11 212.80 213.00 208.45 210.11 115557400 27.22176
## 7 AAPL 2010-01-12 209.19 209.77 206.42 207.72 148614900 26.91211
## 8 AAPL 2010-01-13 207.87 210.93 204.10 210.65 151473000 27.29172
## 9 AAPL 2010-01-14 210.11 210.46 209.02 209.43 108223500 27.13366
## 10 AAPL 2010-01-15 210.93 211.60 205.87 205.93 148516900 26.68020
## # ... with 4,520 more rows
stock_returns_monthly <-
stock_prices %>%
group_by(symbol) %>%
tq_transmute(ohlc_fun = Ad,
mutate_fun = periodReturn,
period = "monthly",
col_rename = "Ra") %T>%
print()
## Source: local data frame [216 x 3]
## Groups: symbol [3]
##
## symbol date Ra
## <chr> <date> <dbl>
## 1 AAPL 2010-01-29 -0.10256526
## 2 AAPL 2010-02-26 0.06539619
## 3 AAPL 2010-03-31 0.14847041
## 4 AAPL 2010-04-30 0.11102125
## 5 AAPL 2010-05-28 -0.01612472
## 6 AAPL 2010-06-30 -0.02082686
## 7 AAPL 2010-07-30 0.02274081
## 8 AAPL 2010-08-31 -0.05500481
## 9 AAPL 2010-09-30 0.16721508
## 10 AAPL 2010-10-29 0.06072249
## # ... with 206 more rows
ウエイトを使ったポートフォリオ構築
は必要ないBM結合
は必要ないstock_returns_monthly %>%
tq_performance(Ra = Ra,
Rb = NULL,
performance_fun = SharpeRatio)
## Source: local data frame [3 x 4]
## Groups: symbol [3]
##
## symbol `ESSharpe(Rf=0%,p=95%)` `StdDevSharpe(Rf=0%,p=95%)`
## <chr> <dbl> <dbl>
## 1 AAPL 0.1682209 0.2872497
## 2 GOOG 0.1264633 0.1992533
## 3 NFLX 0.2351226 0.2827729
## # ... with 1 more variables: `VaRSharpe(Rf=0%,p=95%)` <dbl>
stock_returns_monthly %>%
tq_performance(Ra = Ra,
Rb = NULL,
performance_fun = SharpeRatio,
Rf = 0.03 / 12,
p = 0.99)
## Source: local data frame [3 x 4]
## Groups: symbol [3]
##
## symbol `ESSharpe(Rf=0.2%,p=99%)` `StdDevSharpe(Rf=0.2%,p=99%)`
## <chr> <dbl> <dbl>
## 1 AAPL 0.11304625 0.2528850
## 2 GOOG 0.08081889 0.1663198
## 3 NFLX 0.11634192 0.2703676
## # ... with 1 more variables: `VaRSharpe(Rf=0.2%,p=99%)` <dbl>
stock_returns_monthly <- c("AAPL", "GOOG", "NFLX") %>%
tq_get(get = "stock.prices",
from = "2010-01-01",
to = "2015-12-31") %>%
group_by(symbol) %>%
tq_transmute(ohlc_fun = Ad,
mutate_fun = periodReturn,
period = "monthly",
col_rename = "Ra") %T>%
print()
## Source: local data frame [216 x 3]
## Groups: symbol [3]
##
## symbol date Ra
## <chr> <date> <dbl>
## 1 AAPL 2010-01-29 -0.10256526
## 2 AAPL 2010-02-26 0.06539619
## 3 AAPL 2010-03-31 0.14847041
## 4 AAPL 2010-04-30 0.11102125
## 5 AAPL 2010-05-28 -0.01612472
## 6 AAPL 2010-06-30 -0.02082686
## 7 AAPL 2010-07-30 0.02274081
## 8 AAPL 2010-08-31 -0.05500481
## 9 AAPL 2010-09-30 0.16721508
## 10 AAPL 2010-10-29 0.06072249
## # ... with 206 more rows
baseline_returns_monthly <- "XLK" %>%
tq_get(get = "stock.prices",
from = "2010-01-01",
to = "2015-12-31") %>%
tq_transmute(ohlc_fun = Ad,
mutate_fun = periodReturn,
period = "monthly",
col_rename = "Rb") %T>%
print()
## # A tibble: 72 × 2
## date Rb
## <date> <dbl>
## 1 2010-01-29 -0.09926949
## 2 2010-02-26 0.03482834
## 3 2010-03-31 0.06839788
## 4 2010-04-30 0.01255406
## 5 2010-05-28 -0.07481830
## 6 2010-06-30 -0.05396629
## 7 2010-07-30 0.07450984
## 8 2010-08-31 -0.05611310
## 9 2010-09-30 0.11663639
## 10 2010-10-29 0.05777586
## # ... with 62 more rows
tq_repeat_df()
を使う
Portlifo
フィールドが追加されて数字番号が付けられる# 銘柄リストを複製
# --- 3つのポートフォリオを作成
stock_returns_monthly_multi <-
stock_returns_monthly %>%
tq_repeat_df(n = 3) %T>%
print()
## Ungrouping data frame groups: symbol
## Source: local data frame [648 x 4]
## Groups: portfolio [3]
##
## portfolio symbol date Ra
## <int> <chr> <date> <dbl>
## 1 1 AAPL 2010-01-29 -0.10256526
## 2 1 AAPL 2010-02-26 0.06539619
## 3 1 AAPL 2010-03-31 0.14847041
## 4 1 AAPL 2010-04-30 0.11102125
## 5 1 AAPL 2010-05-28 -0.01612472
## 6 1 AAPL 2010-06-30 -0.02082686
## 7 1 AAPL 2010-07-30 0.02274081
## 8 1 AAPL 2010-08-31 -0.05500481
## 9 1 AAPL 2010-09-30 0.16721508
## 10 1 AAPL 2010-10-29 0.06072249
## # ... with 638 more rows
# 銘柄数を確認
stock_returns_monthly_multi %>%
group_by(portfolio) %>%
tally()
## # A tibble: 3 × 2
## portfolio n
## <int> <int>
## 1 1 216
## 2 2 216
## 3 3 216
# ウエイト作成
weights <- c(
0.50, 0.25, 0.25,
0.25, 0.50, 0.25,
0.25, 0.25, 0.50
)
# ポートフォリオ構成銘柄
stocks <- c("AAPL", "GOOG", "NFLX")
# ポートフォリオウエイトの作成
weights_table <- stocks %>%
tibble() %>%
tq_repeat_df(n = 3) %>%
bind_cols(tibble(weights)) %>%
group_by(portfolio) %T>%
print()
## Source: local data frame [9 x 3]
## Groups: portfolio [3]
##
## portfolio . weights
## <int> <chr> <dbl>
## 1 1 AAPL 0.50
## 2 1 GOOG 0.25
## 3 1 NFLX 0.25
## 4 2 AAPL 0.25
## 5 2 GOOG 0.50
## 6 2 NFLX 0.25
## 7 3 AAPL 0.25
## 8 3 GOOG 0.25
## 9 3 NFLX 0.50
tq_portfolio()
でポートフォリオリターンを計算する
ウエイト
とリターン
をインプットしている期初ウエイト
を使う# 個別銘柄からポートフォリオリターンを計算する
portfolio_returns_monthly_multi <-
stock_returns_monthly_multi %>%
tq_portfolio(assets_col = symbol,
returns_col = Ra,
weights = weights_table,
col_rename = "Ra") %T>%
print
## Source: local data frame [216 x 3]
## Groups: portfolio [3]
##
## portfolio date Ra
## <int> <date> <dbl>
## 1 1 2010-01-29 -0.0489018445
## 2 1 2010-02-26 0.0482132938
## 3 1 2010-03-31 0.1233848612
## 4 1 2010-04-30 0.1446899884
## 5 1 2010-05-28 0.0245280152
## 6 1 2010-06-30 -0.0307681832
## 7 1 2010-07-30 0.0006001173
## 8 1 2010-08-31 0.0474360262
## 9 1 2010-09-30 0.2222062947
## 10 1 2010-10-29 0.0788975110
## # ... with 206 more rows
# 銘柄リスト
stock_returns_monthly_multi %>% tally()
# ポートフォリオ
portfolio_returns_monthly_multi %>% tally()
## # A tibble: 3 × 2
## portfolio n
## <int> <int>
## 1 1 216
## 2 2 216
## 3 3 216
## # A tibble: 3 × 2
## portfolio n
## <int> <int>
## 1 1 72
## 2 2 72
## 3 3 72
# ベンチマークリターンの結合
RaRb_multiple_portfolio <-
portfolio_returns_monthly_multi %>%
left_join(baseline_returns_monthly, by = "date") %T>%
print()
## Source: local data frame [216 x 4]
## Groups: portfolio [?]
##
## portfolio date Ra Rb
## <int> <date> <dbl> <dbl>
## 1 1 2010-01-29 -0.0489018445 -0.09926949
## 2 1 2010-02-26 0.0482132938 0.03482834
## 3 1 2010-03-31 0.1233848612 0.06839788
## 4 1 2010-04-30 0.1446899884 0.01255406
## 5 1 2010-05-28 0.0245280152 -0.07481830
## 6 1 2010-06-30 -0.0307681832 -0.05396629
## 7 1 2010-07-30 0.0006001173 0.07450984
## 8 1 2010-08-31 0.0474360262 -0.05611310
## 9 1 2010-09-30 0.2222062947 0.11663639
## 10 1 2010-10-29 0.0788975110 0.05777586
## # ... with 206 more rows
tq_performance()
につなぐだけRaRb_multiple_portfolio %>%
tq_performance(Ra = Ra, Rb = Rb, performance_fun = table.CAPM)
## Source: local data frame [3 x 13]
## Groups: portfolio [3]
##
## portfolio ActivePremium Alpha AnnualizedAlpha Beta `Beta-` `Beta+`
## <int> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 1 0.2294 0.0191 0.2549 0.9174 0.3425 0.7418
## 2 2 0.2175 0.0190 0.2538 0.8939 0.4581 0.6605
## 3 3 0.3167 0.0306 0.4355 0.7311 -0.1593 0.3944
## # ... with 6 more variables: Correlation <dbl>,
## # `Correlationp-value` <dbl>, InformationRatio <dbl>, `R-squared` <dbl>,
## # TrackingError <dbl>, TreynorRatio <dbl>
RaRb_multiple_portfolio %>%
tq_performance(Ra = Ra, Rb = NULL, performance_fun = SharpeRatio)
## Source: local data frame [3 x 4]
## Groups: portfolio [3]
##
## portfolio `ESSharpe(Rf=0%,p=95%)` `StdDevSharpe(Rf=0%,p=95%)`
## <int> <dbl> <dbl>
## 1 1 0.1699068 0.3509816
## 2 2 0.1451809 0.3298835
## 3 3 0.1492360 0.3141580
## # ... with 1 more variables: `VaRSharpe(Rf=0%,p=95%)` <dbl>
# カテゴリごとの登録数
tq_performance_fun_options() %>% map(length) %>% unlist()
## table.funs CAPM.funs SFM.funs
## 18 13 7
## descriptive.funs annualized.funs VaR.funs
## 9 4 5
## moment.funs drawdown.funs Bacon.risk.funs
## 14 6 6
## Bacon.regression.funs Bacon.relative.risk.funs Bacon.drawdown.funs
## 12 4 7
## Bacon.downside.risk.funs misc.funs
## 20 3
# 関数一覧
tq_performance_fun_options()
## $table.funs
## [1] "table.AnnualizedReturns" "table.Arbitrary"
## [3] "table.Autocorrelation" "table.CAPM"
## [5] "table.CaptureRatios" "table.Correlation"
## [7] "table.Distributions" "table.DownsideRisk"
## [9] "table.DownsideRiskRatio" "table.DrawdownsRatio"
## [11] "table.HigherMoments" "table.InformationRatio"
## [13] "table.SFM" "table.SpecificRisk"
## [15] "table.Stats" "table.TrailingPeriods"
## [17] "table.UpDownRatios" "table.Variability"
##
## $CAPM.funs
## [1] "CAPM.alpha" "CAPM.beta" "CAPM.beta.bear"
## [4] "CAPM.beta.bull" "CAPM.CML" "CAPM.CML.slope"
## [7] "CAPM.dynamic" "CAPM.epsilon" "CAPM.jensenAlpha"
## [10] "CAPM.RiskPremium" "CAPM.SML.slope" "TimingRatio"
## [13] "MarketTiming"
##
## $SFM.funs
## [1] "SFM.alpha" "SFM.beta" "SFM.CML" "SFM.CML.slope"
## [5] "SFM.dynamic" "SFM.epsilon" "SFM.jensenAlpha"
##
## $descriptive.funs
## [1] "mean" "sd" "min" "max"
## [5] "cor" "mean.geometric" "mean.stderr" "mean.LCL"
## [9] "mean.UCL"
##
## $annualized.funs
## [1] "Return.annualized" "Return.annualized.excess"
## [3] "sd.annualized" "SharpeRatio.annualized"
##
## $VaR.funs
## [1] "VaR" "ES" "ETL" "CDD" "CVaR"
##
## $moment.funs
## [1] "var" "cov" "skewness"
## [4] "kurtosis" "CoVariance" "CoSkewness"
## [7] "CoSkewnessMatrix" "CoKurtosis" "CoKurtosisMatrix"
## [10] "M3.MM" "M4.MM" "BetaCoVariance"
## [13] "BetaCoSkewness" "BetaCoKurtosis"
##
## $drawdown.funs
## [1] "AverageDrawdown" "AverageLength" "AverageRecovery"
## [4] "DrawdownDeviation" "DrawdownPeak" "maxDrawdown"
##
## $Bacon.risk.funs
## [1] "MeanAbsoluteDeviation" "Frequency" "SharpeRatio"
## [4] "MSquared" "MSquaredExcess" "HurstIndex"
##
## $Bacon.regression.funs
## [1] "CAPM.alpha" "CAPM.beta" "CAPM.epsilon"
## [4] "CAPM.jensenAlpha" "SystematicRisk" "SpecificRisk"
## [7] "TotalRisk" "TreynorRatio" "AppraisalRatio"
## [10] "FamaBeta" "Selectivity" "NetSelectivity"
##
## $Bacon.relative.risk.funs
## [1] "ActivePremium" "ActiveReturn" "TrackingError"
## [4] "InformationRatio"
##
## $Bacon.drawdown.funs
## [1] "PainIndex" "PainRatio" "CalmarRatio" "SterlingRatio"
## [5] "BurkeRatio" "MartinRatio" "UlcerIndex"
##
## $Bacon.downside.risk.funs
## [1] "DownsideDeviation" "DownsidePotential"
## [3] "DownsideFrequency" "SemiDeviation"
## [5] "SemiVariance" "UpsideRisk"
## [7] "UpsidePotentialRatio" "UpsideFrequency"
## [9] "BernardoLedoitRatio" "DRatio"
## [11] "Omega" "OmegaSharpeRatio"
## [13] "OmegaExcessReturn" "SortinoRatio"
## [15] "M2Sortino" "Kappa"
## [17] "VolatilitySkewness" "AdjustedSharpeRatio"
## [19] "SkewnessKurtosisRatio" "ProspectRatio"
##
## $misc.funs
## [1] "KellyRatio" "Modigliani" "UpDownRatios"
X <- RaRb_multiple_portfolio %>%
tq_performance(Ra = Ra, Rb = NULL, performance_fun = table.Stats) %T>%
print()
## Source: local data frame [3 x 17]
## Groups: portfolio [3]
##
## portfolio ArithmeticMean GeometricMean Kurtosis `LCLMean(0.95)` Maximum
## <int> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 1 0.0290 0.0257 1.0984 0.0096 0.2222
## 2 2 0.0287 0.0249 1.6075 0.0083 0.2270
## 3 3 0.0385 0.0310 1.7844 0.0097 0.3699
## # ... with 11 more variables: Median <dbl>, Minimum <dbl>, NAs <dbl>,
## # Observations <dbl>, Quartile1 <dbl>, Quartile3 <dbl>, SEMean <dbl>,
## # Skewness <dbl>, Stdev <dbl>, `UCLMean(0.95)` <dbl>, Variance <dbl>
X %>% glimpse()
## Observations: 3
## Variables: 17
## $ portfolio <int> 1, 2, 3
## $ ArithmeticMean <dbl> 0.0290, 0.0287, 0.0385
## $ GeometricMean <dbl> 0.0257, 0.0249, 0.0310
## $ Kurtosis <dbl> 1.0984, 1.6075, 1.7844
## $ LCLMean(0.95) <dbl> 0.0096, 0.0083, 0.0097
## $ Maximum <dbl> 0.2222, 0.2270, 0.3699
## $ Median <dbl> 0.0307, 0.0370, 0.0460
## $ Minimum <dbl> -0.2655, -0.3000, -0.4027
## $ NAs <dbl> 0, 0, 0
## $ Observations <dbl> 72, 72, 72
## $ Quartile1 <dbl> -0.0331, -0.0338, -0.0303
## $ Quartile3 <dbl> 0.0827, 0.0822, 0.1072
## $ SEMean <dbl> 0.0098, 0.0103, 0.0144
## $ Skewness <dbl> -0.3407, -0.5349, -0.1839
## $ Stdev <dbl> 0.0827, 0.0870, 0.1226
## $ UCLMean(0.95) <dbl> 0.0485, 0.0492, 0.0673
## $ Variance <dbl> 0.0068, 0.0076, 0.0150
X <- RaRb_multiple_portfolio %>%
tq_performance(Ra = Ra, Rb = Rb, performance_fun = table.CAPM) %T>%
print()
## Source: local data frame [3 x 13]
## Groups: portfolio [3]
##
## portfolio ActivePremium Alpha AnnualizedAlpha Beta `Beta-` `Beta+`
## <int> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 1 0.2294 0.0191 0.2549 0.9174 0.3425 0.7418
## 2 2 0.2175 0.0190 0.2538 0.8939 0.4581 0.6605
## 3 3 0.3167 0.0306 0.4355 0.7311 -0.1593 0.3944
## # ... with 6 more variables: Correlation <dbl>,
## # `Correlationp-value` <dbl>, InformationRatio <dbl>, `R-squared` <dbl>,
## # TrackingError <dbl>, TreynorRatio <dbl>
X %>% glimpse()
## Observations: 3
## Variables: 13
## $ portfolio <int> 1, 2, 3
## $ ActivePremium <dbl> 0.2294, 0.2175, 0.3167
## $ Alpha <dbl> 0.0191, 0.0190, 0.0306
## $ AnnualizedAlpha <dbl> 0.2549, 0.2538, 0.4355
## $ Beta <dbl> 0.9174, 0.8939, 0.7311
## $ Beta- <dbl> 0.3425, 0.4581, -0.1593
## $ Beta+ <dbl> 0.7418, 0.6605, 0.3944
## $ Correlation <dbl> 0.4761, 0.4411, 0.2562
## $ Correlationp-value <dbl> 0.0000, 0.0001, 0.0298
## $ InformationRatio <dbl> 0.9088, 0.8024, 0.7681
## $ R-squared <dbl> 0.2267, 0.1945, 0.0656
## $ TrackingError <dbl> 0.2524, 0.2711, 0.4124
## $ TreynorRatio <dbl> 0.3873, 0.3842, 0.6055
X <- RaRb_multiple_portfolio %>%
tq_performance(Ra = Ra, Rb = NULL,
performance_fun = table.AnnualizedReturns) %T>%
print()
## Source: local data frame [3 x 4]
## Groups: portfolio [3]
##
## portfolio AnnualizedReturn `AnnualizedSharpe(Rf=0%)` AnnualizedStdDev
## <int> <dbl> <dbl> <dbl>
## 1 1 0.3553 1.2395 0.2866
## 2 2 0.3434 1.1391 0.3015
## 3 3 0.4427 1.0426 0.4246
X %>% glimpse()
## Observations: 3
## Variables: 4
## $ portfolio <int> 1, 2, 3
## $ AnnualizedReturn <dbl> 0.3553, 0.3434, 0.4427
## $ AnnualizedSharpe(Rf=0%) <dbl> 1.2395, 1.1391, 1.0426
## $ AnnualizedStdDev <dbl> 0.2866, 0.3015, 0.4246
X <- RaRb_multiple_portfolio %>%
tq_performance(Ra = Ra, Rb = Rb, performance_fun = table.Correlation) %T>%
print()
## Source: local data frame [3 x 5]
## Groups: portfolio [3]
##
## portfolio `p-value` `Lower CI` `Upper CI` to.Rb
## <int> <dbl> <dbl> <dbl> <dbl>
## 1 1 2.362581e-05 0.27478771 0.6374931 0.4761450
## 2 2 1.053541e-04 0.23323258 0.6103689 0.4410690
## 3 3 2.984745e-02 0.02605864 0.4605179 0.2561806
X %>% glimpse()
## Observations: 3
## Variables: 5
## $ portfolio <int> 1, 2, 3
## $ p-value <dbl> 2.362581e-05, 1.053541e-04, 2.984745e-02
## $ Lower CI <dbl> 0.27478771, 0.23323258, 0.02605864
## $ Upper CI <dbl> 0.6374931, 0.6103689, 0.4605179
## $ to.Rb <dbl> 0.4761450, 0.4410690, 0.2561806
X <- RaRb_multiple_portfolio %>%
tq_performance(Ra = Ra, Rb = NULL, performance_fun = table.DownsideRisk) %T>%
print()
## Source: local data frame [3 x 12]
## Groups: portfolio [3]
##
## portfolio `DownsideDeviation(0%)` `DownsideDeviation(MAR=10%)`
## <int> <dbl> <dbl>
## 1 1 0.0453 0.0492
## 2 2 0.0503 0.0541
## 3 3 0.0687 0.0723
## # ... with 9 more variables: `DownsideDeviation(Rf=0%)` <dbl>,
## # GainDeviation <dbl>, `HistoricalES(95%)` <dbl>,
## # `HistoricalVaR(95%)` <dbl>, LossDeviation <dbl>,
## # MaximumDrawdown <dbl>, `ModifiedES(95%)` <dbl>,
## # `ModifiedVaR(95%)` <dbl>, SemiDeviation <dbl>
X %>% glimpse()
## Observations: 3
## Variables: 12
## $ portfolio <int> 1, 2, 3
## $ DownsideDeviation(0%) <dbl> 0.0453, 0.0503, 0.0687
## $ DownsideDeviation(MAR=10%) <dbl> 0.0492, 0.0541, 0.0723
## $ DownsideDeviation(Rf=0%) <dbl> 0.0453, 0.0503, 0.0687
## $ GainDeviation <dbl> 0.0538, 0.0528, 0.0831
## $ HistoricalES(95%) <dbl> -0.1412, -0.1623, -0.2216
## $ HistoricalVaR(95%) <dbl> -0.0811, -0.0842, -0.1313
## $ LossDeviation <dbl> 0.0519, 0.0587, 0.0811
## $ MaximumDrawdown <dbl> 0.4018, 0.4378, 0.5952
## $ ModifiedES(95%) <dbl> -0.1709, -0.1978, -0.2580
## $ ModifiedVaR(95%) <dbl> -0.1121, -0.1233, -0.1636
## $ SemiDeviation <dbl> 0.0598, 0.0642, 0.0871
X <- RaRb_multiple_portfolio %>%
tq_performance(Ra = Ra, Rb = NULL,
performance_fun = table.DownsideRiskRatio) %T>%
print()
## Source: local data frame [3 x 9]
## Groups: portfolio [3]
##
## portfolio Annualiseddownsiderisk Downsidepotential Monthlydownsiderisk
## <int> <dbl> <dbl> <dbl>
## 1 1 0.1571 0.0201 0.0453
## 2 2 0.1743 0.0220 0.0503
## 3 3 0.2378 0.0296 0.0687
## # ... with 5 more variables: Omega <dbl>, `Omega-sharperatio` <dbl>,
## # Sortinoratio <dbl>, Upsidepotential <dbl>, Upsidepotentialratio <dbl>
X %>% glimpse()
## Observations: 3
## Variables: 9
## $ portfolio <int> 1, 2, 3
## $ Annualiseddownsiderisk <dbl> 0.1571, 0.1743, 0.2378
## $ Downsidepotential <dbl> 0.0201, 0.0220, 0.0296
## $ Monthlydownsiderisk <dbl> 0.0453, 0.0503, 0.0687
## $ Omega <dbl> 2.4481, 2.3077, 2.2996
## $ Omega-sharperatio <dbl> 1.4481, 1.3077, 1.2996
## $ Sortinoratio <dbl> 0.6406, 0.5705, 0.5609
## $ Upsidepotential <dbl> 0.0491, 0.0507, 0.0681
## $ Upsidepotentialratio <dbl> 0.9776, 0.9469, 0.9335
X <- RaRb_multiple_portfolio %>%
tq_performance(Ra = Ra, Rb = Rb, performance_fun = table.HigherMoments) %T>%
print()
## Warning in bcosk(Ra[, n[1]], Rb[, n[2]]): skewness is close to zero. The
## classical definition of the coskewness statistic is not applicable and one
## should normalize using the comoment without standardization.
## Warning in bcosk(Ra[, n[1]], Rb[, n[2]]): skewness is close to zero. The
## classical definition of the coskewness statistic is not applicable and one
## should normalize using the comoment without standardization.
## Warning in bcosk(Ra[, n[1]], Rb[, n[2]]): skewness is close to zero. The
## classical definition of the coskewness statistic is not applicable and one
## should normalize using the comoment without standardization.
## Source: local data frame [3 x 6]
## Groups: portfolio [3]
##
## portfolio BetaCoKurtosis BetaCoSkewness BetaCoVariance CoKurtosis
## <int> <dbl> <dbl> <dbl> <dbl>
## 1 1 0.7593 0.2388 0.9174 0
## 2 2 0.7748 2.0455 0.8939 0
## 3 3 0.4591 0.5074 0.7311 0
## # ... with 1 more variables: CoSkewness <dbl>
X %>% glimpse()
## Observations: 3
## Variables: 6
## $ portfolio <int> 1, 2, 3
## $ BetaCoKurtosis <dbl> 0.7593, 0.7748, 0.4591
## $ BetaCoSkewness <dbl> 0.2388, 2.0455, 0.5074
## $ BetaCoVariance <dbl> 0.9174, 0.8939, 0.7311
## $ CoKurtosis <dbl> 0, 0, 0
## $ CoSkewness <dbl> 0, 0, 0
X <- RaRb_multiple_portfolio %>%
tq_performance(Ra = Ra, Rb = Rb,
performance_fun = table.InformationRatio) %T>%
print()
## Source: local data frame [3 x 4]
## Groups: portfolio [3]
##
## portfolio AnnualisedTrackingError InformationRatio TrackingError
## <int> <dbl> <dbl> <dbl>
## 1 1 0.2524 0.9088 0.0729
## 2 2 0.2711 0.8024 0.0782
## 3 3 0.4124 0.7681 0.1190
X %>% glimpse()
## Observations: 3
## Variables: 4
## $ portfolio <int> 1, 2, 3
## $ AnnualisedTrackingError <dbl> 0.2524, 0.2711, 0.4124
## $ InformationRatio <dbl> 0.9088, 0.8024, 0.7681
## $ TrackingError <dbl> 0.0729, 0.0782, 0.1190
X <- RaRb_multiple_portfolio %>%
tq_performance(Ra = Ra, Rb = NULL, performance_fun = table.Variability) %T>%
print()
## Source: local data frame [3 x 4]
## Groups: portfolio [3]
##
## portfolio AnnualizedStdDev MeanAbsolutedeviation MonthlyStdDev
## <int> <dbl> <dbl> <dbl>
## 1 1 0.2866 0.0660 0.0827
## 2 2 0.3015 0.0682 0.0870
## 3 3 0.4246 0.0913 0.1226
X %>% glimpse()
## Observations: 3
## Variables: 4
## $ portfolio <int> 1, 2, 3
## $ AnnualizedStdDev <dbl> 0.2866, 0.3015, 0.4246
## $ MeanAbsolutedeviation <dbl> 0.0660, 0.0682, 0.0913
## $ MonthlyStdDev <dbl> 0.0827, 0.0870, 0.1226
X <- RaRb_multiple_portfolio %>%
tq_performance(Ra = Ra, Rb = NULL, performance_fun = VaR) %T>%
print()
## Source: local data frame [3 x 2]
## Groups: portfolio [3]
##
## portfolio VaR
## <int> <dbl>
## 1 1 -0.1120763
## 2 2 -0.1233272
## 3 3 -0.1635992
X %>% glimpse()
## Observations: 3
## Variables: 2
## $ portfolio <int> 1, 2, 3
## $ VaR <dbl> -0.1120763, -0.1233272, -0.1635992