1 導入編

はじめに

  • {tidyquant}は金融データを分析するために以下のパッケージを統合したもの
    • {TTR} {xts} {zoo} {quantmod} {PerformanceAnalytics}
  • {tidyverse}とも統合することでシームレスなデータ分析が可能
  • {ggplot2}とも連携することでグラフィックスも充実
  • 参考資料:Introduction to tidyquant



登録関数

# 登録関数の数
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]>



2 データ取得

概要

  • {quantmod}が提供している外部からのデータ取得を扱う


対象関数

指数構成銘柄リスト

# データ取得可能なインデックスリスト
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"...



取引所の上場銘柄リスト

  • 直近データのみ
  • データソース:NASDAQ
# データ取得可能な取引所リスト
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...



時系列クオンツデータ

1. 取得可能データ

# 取得可能データ
tq_get_options()
## [1] "stock.prices"   "financials"     "key.stats"      "key.ratios"    
## [5] "dividends"      "splits"         "economic.data"  "exchange.rates"
## [9] "metal.prices"



2. 株価データ

# データ取得
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()



3. 分割データ

# データ取得
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



4. 財務データ

# データ取得
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>



5. 財務レシオ

6. 経済データ

7. 為替レート

8. 商品価格

# データ取得
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()



3 時系列クラスの操作

使用関数

data_frame(package = c("as_xts", 
                       "as_tibble")) %>% formattable(align = "l")
package
as_xts
as_tibble



xtsをtibbleに変換: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"



tibbleをxtsに変換:as_xts()

# 日付列が<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



4 コア関数

概要

  • 使用できる関数は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" ...



4つのパッケージ関数群

1. {zoo}の関数群

  • 主に時系列ローリングの関数群を扱う
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"



2. {xts}の関数群

  • 主に時系列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"



3. {quantmod}の関数群

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"



4. {TTR}の関数群

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"



活用事例

1. 株価をリターンに変換

準備:データセットの確認

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



ステップ1:株価をリターンに変換

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



ステップ2:グラフ化

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()



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



ステップ1:対数リターンの計算

FANG_daily_log_returns <- FANG %>%
    group_by(symbol) %>%
    tq_transmute(ohlc_fun   = Ad, 
                 mutate_fun = periodReturn, 
                 period     = "daily", 
                 type       = "log",
                 col_rename = "monthly.returns")



ステップ2:ヒストグラムに変換

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)



3. 日次データを月次データに変換

準備:データセットの確認

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



ステップ1:日次株価のグラフ化

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()



ステップ2:日次株価を月次株価に変換

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



ステップ3:月次株価のグラフ化

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()



4. 2銘柄の時系列相関の推移

ステップ1:2銘柄のリターンの取得

# 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")



ステップ2:データセットの結合

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



ステップ3:時系列相関の算出

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



ステップ4:時系列相関のグラフ化

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).



5. MACDの計算とグラフ化

準備:データセットの確認

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



ステップ1:MACDの計算

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



ステップ2:MACDのグラフ化

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()



6. 期間ごとの高値と安値を算出・グラフ化

準備:データセットの確認

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



ステップ1:期間ごとの高値を算出

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



ステップ2:期間ごとの安値を算出

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



ステップ3:高値と安値の結合

FANG_by_qtr <- left_join(FANG_max_by_qtr, FANG_min_by_qtr,
                         by = c("symbol"   = "symbol",
                                "year.qtr" = "year.qtr"))



ステップ4:高値と安値のグラフ化

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())



5 分析データの拡張とモデリング

複数銘柄のデータ取得

1. tibbleによる取得

  • tq_get()に複数のコードをインプットするとtibbleクラスでデータ取得できる
  1. コードをベクトルで渡す
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


  1. コードをtibbleクラスで渡す
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


  1. 応用:tq_index()との連携
  • 指数構成銘柄リスト(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>



2. ネストによる取得

  • 予めtibbleクラスにコードをインプットして取得データを列で追加する
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]>



3. listによる取得

  • purrr::map()を活用して一括取得
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



時系列データの操作

1. リターン系列の作成

# 準備:データセットの確認
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



2. チャートの作成

# チャート化
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}を活用したモデリング

0. 概要

  • 1銘柄でモデリングのプロセスを整理して関数化しておく
  • 作成した関数をpurrr::map()で複数銘柄に適用する



1. 銘柄での分析

1-1. データ取得関数を定義する

# 関数定義
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



1-2. リターンのグラフ化

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()



1-3. 時系列回帰分析の実行

# 
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



1-4. 分析結果の評価

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

1-5. 全プロセスのモデリング

# 分析プロセスを関数化
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

2. 複数銘柄への拡張

2-1. 銘柄リストの作成

# 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



2.2. 複数銘柄での分析

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



2.3. 結果のグラフ化

stocks_model_stats %>% 
  ggplot(aes(symbol, estimate)) + 
  geom_bar(stat = "identity")

トラブルシューディング

6 グラフィックス

概要

  • {ggplot2}のグラフと連携したグラフ作成を基本姿勢としている
  • 独自の関数として以下のようなグラフ用関数群が用意されている
    • チャート作成
    • 軸設定
    • カラーパレット
    • グラフテーマ
<チャート作成>
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



チャートタイプ

1 折れ線グラフ

# 準備:データセットの確認
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()



2 棒グラフ

1. カギ足チャートの作成

  • 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()



2. チャートのズーム

  • 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()



3. チャートの装飾

  • 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()



3 ローソク足チャート

1. ローソク足チャートの作成

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()



2. チャートのズーム

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()



3. チャートの装飾

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()



4 チャートの融合

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()



5 複数銘柄のチャート化

1. ファセットを使った分割

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()



2. 移動平均線の追加

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()



トレンドの可視化

1. 移動平均

例1 単純移動平均 (SMA 50D/200D)

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()



例2 指数移動平均 (EMA 50D/200D)

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()



例3 複数銘柄を同時にプロット化

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()



2. ボリンジャーバンド

例1 SMAにBBandを適用

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()



例2 BBandを装飾する

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()



例3 複数銘柄を同時にBBand化

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()



ggplot2の機能性の活用

1. Y軸を対数軸にする

Y軸は連続値(通常の軸)

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()



log10の対数軸を適用

  • 対数軸を導入することで細かい変化が見やすくなる
    • グラフの傾きとY軸の変化は直観的ではなくなる
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()



2. 回帰線を導入してトレンドを見る

線形回帰

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()



Loess

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()



3. 売買高をチャート化する

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") 



グラフのテーマ

0. 概要

  • 全体のテーマは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")

1. Light

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)



2. Dark

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)



3. 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 = "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)



7 パフォーマンス分析

Quick Example

1. ポートフォリオリターン

  • 個別銘柄リターン系列を作成
    • この時点ではウエイト情報はないため厳密にはポートフォリオではない
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



2. ベンチマークリターン

  • ETFのリターンをベンチマークとして取得
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



3. データ結合

  • ポートフォリオリターンベンチマークリターンを結合
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



4. CAPMの実行

  • リターンデータを{PerformanceAnalystics}が提供するtable.CAPM関数に入力
    • CAPMに関する複数データがtibble形式で出力される
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>



5. 分析結果の抽出

  • 分析結果はtibble形式なので二次加工も自由に行える
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



ワークフロー

1. はじめに

  • 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



2. 単一銘柄ポートフォリオ

ステップ1:株価の取得

  • 分析する3銘柄の株価を取得
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



ステップ2:リターンに変換

  • 株価系列をリターン系列に変換
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



ステップ3:ポートフォリオ構築・BM結合

  • 本例は個別銘柄分析なのでウエイトを使ったポートフォリオ構築は必要ない
  • SharpeRatioの算出にはベンチマークを必要としないのでBM結合は必要ない



ステップ4:パフォーマンス分析

1.デフォルト値で計算
  • グループ化された単位ごとに集計結果が出力される
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>


2. Rf(リスクフリーレート)とp(VaRの水準)を指定
  • 設定可能な引数は自由に変更できる
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>



3. 複数銘柄ポートフォリオ

ステップ1:複数銘柄のリターン取得

  • 日次株価を取得して月次リターンに変換する
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



ステップ2:ベンチマークリターンの取得

  • ベンチマークの代理指標としてETFの個別銘柄リターンを使用する
  • ポートフォリオと同様に、日次株価を取得して月次リターンに変換する
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



ステップ3:ポートフォリオリターンの計算

1. 銘柄リストの複製
  • 3パターンのポートフォリオを複製するため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



2. ポートフォリオウエイトの作成
  • 銘柄リストにウエイトを与えてポートフォリオに変換する
    • 時価ブレを考慮しない固定ウエイト(リバランスを想定)
# ウエイト作成
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



3. ポートフォリオリターンの計算
  • 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



ステップ4:パフォーマンス分析

1. ベンチマークリターンの結合
  • パフォーマンス分析の準備としてベンチマークリターンを結合
# ベンチマークリターンの結合
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



2. CAPMの出力
  • ポートフォリオとベンチマークのリターンがあれば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>



利用可能な関数

00. 関数一覧

# カテゴリごとの登録数
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"



01. table.Stats

  • 各ポートフォリオのリターン特性値を算出
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



02. table.CAPM

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



03. table.AnnualizedReturn

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



04. table.Correlation

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



05. table.DownsideRisk

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



06. table.DownsideRiskRatio

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



07. table.HigherMoments

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



08. table.InformationRatio

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



09. table.Volatility

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



10. VaR

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



11. SharpeRatio

X <- RaRb_multiple_portfolio %>%
       tq_performance(Ra = Ra, Rb = NULL, performance_fun = SharpeRatio) %T>% 
       print()
## 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>
X %>% glimpse()
## Observations: 3
## Variables: 4
## $ portfolio                 <int> 1, 2, 3
## $ ESSharpe(Rf=0%,p=95%)     <dbl> 0.1699068, 0.1451809, 0.1492360
## $ StdDevSharpe(Rf=0%,p=95%) <dbl> 0.3509816, 0.3298835, 0.3141580
## $ VaRSharpe(Rf=0%,p=95%)    <dbl> 0.2591384, 0.2328143, 0.2353659



カスタマイズして使用する

1. tq_portfolio

2. tq_performance

inserted by FC2 system