--- title: "R02：價格、日期與報酬率" output: github_document: toc: true toc_depth: 3 --- 本附錄對應第 2 章，從一個每天都會遇到的實證問題開始：手上只有一列列調整收盤價時，日簡單報酬與日對數報酬究竟應如何計算，日期間隔又該怎麼處理？我們實際讀取 Apple Inc.（AAPL）的固定資料，從調整收盤價重算兩種報酬，再比較複利、交易日間隔與極端日。 每一列代表一個交易日，樣本期間為 2019-01-02 至 2022-06-22，共 875 個交易日。`adjusted` 的尺度是「美元／股的調整後價格」；報酬欄位以小數表示，例如 0.01 代表 1%。資料來自原課程 S&P 500 價格檔所保留的 AAPL 序列，建置細節見 `data/DATA_SOURCES.md`。第 $t$ 日報酬要同時用到第 $t$ 日與前一交易日的價格，因此通常要等第 $t$ 日收盤價可得後才能計算；若拿它預測同一天稍早的結果，就會使用到尚未出現的資訊。 這一頁的工作是整理並描述固定歷史資料，沒有訓練期、驗證期與測試期之分，也沒有識別市場事件對 AAPL 報酬的因果效果。 ``` r knitr::opts_chunk$set( echo = TRUE, message = FALSE, warning = FALSE, fig.width = 7, fig.height = 4.5, dev = "ragg_png", dpi = 144, dev.args = list(background = "white") ) root_candidates <- c(".", "..") is_root <- vapply(root_candidates, function(x) { file.exists(file.path(x, "main.tex")) }, logical(1)) stopifnot(any(is_root)) project_root <- root_candidates[which(is_root)[1]] project_path <- function(...) file.path(project_root, ...) stopifnot( requireNamespace("ragg", quietly = TRUE), requireNamespace("systemfonts", quietly = TRUE) ) cwtex_file <- project_path("assets", "fonts", "cwTeXQKai-Medium.ttf") stopifnot(file.exists(cwtex_file)) if (!"cwTeX Online" %in% systemfonts::registry_fonts()$family) { systemfonts::register_font("cwTeX Online", cwtex_file) } plot_family <- "cwTeX Online" ``` ## 讀取、排序與入口檢查 計算落後價格以前，先把日期順序確認清楚。若檔案不是由早到晚排列，`lag()` 或相鄰列相除便會把錯誤的兩天接在一起。以下先檢查欄位，將日期轉成 `Date` 後排序，再確認沒有重複日期，而且調整價格都是正的有限值。 ``` r aapl_path <- project_path( "data", "processed", "aapl_adjusted_daily_2019_2022.csv" ) stopifnot(file.exists(aapl_path)) aapl <- read.csv(aapl_path, stringsAsFactors = FALSE) needed <- c( "date", "symbol", "company", "sector", "adjusted", "simple_return", "log_return" ) stopifnot(all(needed %in% names(aapl))) aapl$date <- as.Date(aapl$date) # 報酬是依相鄰交易日計算，排序必須發生在任何 lag 或 diff 之前。 aapl <- aapl[order(aapl$date), ] row.names(aapl) <- NULL stopifnot( !anyNA(aapl$date), !anyDuplicated(aapl$date), all(diff(aapl$date) > 0), all(aapl$symbol == "AAPL"), all(is.finite(aapl$adjusted)), all(aapl$adjusted > 0) ) data_profile <- data.frame( 資產 = unique(aapl$symbol), 起日 = min(aapl$date), 迄日 = max(aapl$date), 交易日數 = nrow(aapl), 價格單位 = "美元／股（調整後尺度）", 報酬單位 = "小數；0.01 代表 1%", 資料來源 = "原課程 S&P 500 價格檔的 AAPL 固定版本", check.names = FALSE ) knitr::kable(data_profile) ``` |資產 |起日 |迄日 | 交易日數|價格單位 |報酬單位 |資料來源 | |:----|:----------|:----------|--------:|:----------------------|:------------------|:-------------------------------------| |AAPL |2019-01-02 |2022-06-22 | 875|美元／股（調整後尺度） |小數；0.01 代表 1% |原課程 S&P 500 價格檔的 AAPL 固定版本 | 資料摘要應顯示單一資產 AAPL、875 個交易日，以及前述價格與報酬尺度。這張表把後續每個數字的分母與時間單位先固定下來；若換成週報酬或未調整收盤價，解讀也必須跟著改變。 第一筆價格沒有本檔案中的前一期價格可供比較，所以兩種報酬都應是缺值。這個缺值是報酬定義自然產生的，不需要填成 0；填入 0 反而會憑空增加一個「沒有漲跌」的交易日。 ``` r colSums(is.na(aapl[c("adjusted", "simple_return", "log_return")])) ``` ``` ## adjusted simple_return log_return ## 0 1 1 ``` ``` r stopifnot( is.na(aapl$simple_return[1]), is.na(aapl$log_return[1]), !anyNA(aapl$simple_return[-1]), !anyNA(aapl$log_return[-1]) ) ``` ## 用相鄰交易日的調整價格計算報酬 若 $P_t^*$ 是同一調整尺度下的價格，則 \[ R_t=\frac{P_t^*}{P_{t-1}^*}-1, \qquad r_t=\log P_t^*-\log P_{t-1}^*=\log(1+R_t). \] 第一個公式衡量價格的相對變動，第二個公式把相鄰價格取對數後相減。兩者都要求 \(P_t^*\) 與 \(P_{t-1}^*\) 位於同一調整尺度。資料供應者已把其採用的公司行動調整反映在 `adjusted` 中；若研究需要逐筆辨認拆股或現金股利，仍要另讀公司行動資料，單靠這一欄無法還原全部現金流。 ``` r aapl$calculated_simple <- c( NA_real_, aapl$adjusted[-1] / head(aapl$adjusted, -1) - 1 ) aapl$calculated_log <- c(NA_real_, diff(log(aapl$adjusted))) # 與固定資料內原有欄位比較，可發現排序或公式是否寫錯。 calculation_error <- data.frame( 欄位 = c("simple_return", "log_return"), 最大絕對差 = c( max(abs(aapl$simple_return - aapl$calculated_simple), na.rm = TRUE), max(abs(aapl$log_return - aapl$calculated_log), na.rm = TRUE) ), check.names = FALSE ) knitr::kable(calculation_error, digits = 14) ``` |欄位 | 最大絕對差| |:-------------|----------:| |simple_return | 0| |log_return | 0| ``` r stopifnot( calculation_error$最大絕對差[1] < 1e-12, calculation_error$最大絕對差[2] < 1e-12 ) knitr::kable( head(aapl[c( "date", "adjusted", "calculated_simple", "calculated_log" )], 6), digits = 6 ) ``` |date | adjusted| calculated_simple| calculated_log| |:----------|--------:|-----------------:|--------------:| |2019-01-02 | 38.22136| NA| NA| |2019-01-03 | 34.41423| -0.099607| -0.104924| |2019-01-04 | 35.88335| 0.042689| 0.041803| |2019-01-07 | 35.80349| -0.002226| -0.002228| |2019-01-08 | 36.48602| 0.019063| 0.018884| |2019-01-09 | 37.10561| 0.016982| 0.016839| `最大絕對差` 應小於 \(10^{-12}\)，表示重算欄位與固定資料只差浮點誤差。前六列則讓我們直接看到：第一列報酬為缺值，從第二列開始，每個報酬都連結當日與前一個交易日的調整價格。 ## 套件作法：用 `arrange()`、`mutate()` 與 `lag()` 計算報酬 原課程的 AAPL 程式先以 `tidyquant::tq_get()` 取得 Yahoo 資料，再用 `dplyr::arrange()`、`mutate()` 與 `lag()` 建立報酬。本書沿用這套工作流程，但改讀上面的固定 CSV，避免資料供應者日後修訂歷史值而使答案改變。對應來源是 `slides/L04_ARMA/W1L4_R_template_for_estimating_ARMA.R` 與 `slides/L07_ARCH_GARCH/W2L2_R_template_GARCH.R`。 `arrange()` 會把日期排好，`lag()` 會取同欄前一列，`mutate()` 則把公式加入資料框。這些函數不會替我們選擇正確的價格欄位，也不知道休市日應如何處理；資料尺度、排序鍵與缺值規則仍要由研究者先決定。 ``` r stopifnot(requireNamespace("dplyr", quietly = TRUE)) returns_package <- aapl |> # 先排序，再取落後值；顛倒次序會把原始列順序誤當成時間順序。 dplyr::arrange(date) |> dplyr::mutate( simple_return_package = adjusted / dplyr::lag(adjusted) - 1, log_return_package = log(adjusted) - log(dplyr::lag(adjusted)) ) package_return_check <- data.frame( 核對項目 = c( "簡單報酬：套件版與手動版", "對數報酬：套件版與手動版", "簡單報酬：套件版與固定資料", "對數報酬：套件版與固定資料" ), 最大絕對差 = c( max(abs( returns_package$simple_return_package - aapl$calculated_simple ), na.rm = TRUE), max(abs( returns_package$log_return_package - aapl$calculated_log ), na.rm = TRUE), max(abs( returns_package$simple_return_package - aapl$simple_return ), na.rm = TRUE), max(abs( returns_package$log_return_package - aapl$log_return ), na.rm = TRUE) ), check.names = FALSE ) knitr::kable(package_return_check, digits = 14) ``` |核對項目 | 最大絕對差| |:--------------------------|----------:| |簡單報酬：套件版與手動版 | 0| |對數報酬：套件版與手動版 | 0| |簡單報酬：套件版與固定資料 | 0| |對數報酬：套件版與固定資料 | 0| ``` r stopifnot( is.na(returns_package$simple_return_package[1]), is.na(returns_package$log_return_package[1]), max(package_return_check$最大絕對差) < 1e-12 ) ``` 四列 `最大絕對差` 都應接近零，因為手動版與套件版只是用不同語法計算同一定義。套件縮短了資料操作程式，資料責任仍然相同：先排序、保留第一筆自然產生的缺值，並確定分子與分母使用同一調整價格尺度。 ## 價格與報酬的時間圖 接著把價格水準與日報酬放在同一張圖的上下兩格。價格圖回答「資產價值如何隨時間累積」，報酬圖回答「每一交易日的相對變動有多大」；兩者的尺度與統計性質不同，不能只因來自同一欄價格就用同一模型處理。 ``` r old_par <- par( mfrow = c(2, 1), mar = c(4.5, 4, 3, 1), family = plot_family ) plot( aapl$date, aapl$adjusted, type = "l", col = "#173B57", xlab = "日期", ylab = "調整價格（美元／股）", main = "AAPL 調整價格" ) plot( aapl$date, 100 * aapl$log_return, type = "l", col = "#A34045", xlab = "日期", ylab = "日對數報酬（%）", main = "AAPL 日對數報酬" ) abline(h = 0, col = "gray60") ``` ![AAPL 調整價格與由它計算的日對數報酬。報酬圖以百分比呈現。](../R02_prices_dates_returns_files/figure-gfm/price-return-plot-1.png) ``` r par(old_par) ``` 圖中的價格水準有明顯長期變動，日報酬則大多圍繞零上下波動，偶爾出現較大的跳動。這提醒我們在建模前先說清楚研究對象是價格、簡單報酬或對數報酬；價格有趨勢，不表示報酬也沿著同一趨勢前進。 ## 簡單報酬與對數報酬的差距 小幅報酬時 $r_t\approx R_t$，所以散點應貼近 45 度線；大幅漲跌時，對數轉換的非線性會讓兩者差距擴大。下圖中的每一點都是同一交易日的 AAPL 簡單報酬與對數報酬。 ``` r old_par <- par(family = plot_family) plot( 100 * aapl$simple_return, 100 * aapl$log_return, pch = 16, cex = 0.55, col = adjustcolor("#173B57", 0.55), xlab = "日簡單報酬（%）", ylab = "日對數報酬（%）" ) abline(0, 1, lty = 2, lwd = 2, col = "#A34045") ``` ![AAPL 日簡單報酬與日對數報酬；虛線表示兩者完全相等。](../R02_prices_dates_returns_files/figure-gfm/approximation-plot-1.png) ``` r par(old_par) ``` ## 從單日報酬走到整段期間報酬 要回答「從樣本第一天持有到最後一天，調整價格總共變動多少」，單日簡單報酬要逐期複利，而對數報酬可以先相加。從第一個調整價格到最後一個調整價格，三種算法應得到相同的多期簡單報酬： 1. 每日簡單報酬逐期複利； 2. 每日對數報酬相加後轉回簡單報酬； 3. 最後價格除以最初價格再減一。 ``` r valid_simple <- aapl$simple_return[is.finite(aapl$simple_return)] valid_log <- aapl$log_return[is.finite(aapl$log_return)] compound_table <- data.frame( 方法 = c( "每日簡單報酬複利", "對數報酬相加後轉回", "期末調整價格／期初調整價格" ), 全期簡單報酬 = c( prod(1 + valid_simple) - 1, exp(sum(valid_log)) - 1, tail(aapl$adjusted, 1) / aapl$adjusted[1] - 1 ), check.names = FALSE ) knitr::kable(compound_table, digits = 8) ``` |方法 | 全期簡單報酬| |:--------------------------|------------:| |每日簡單報酬複利 | 2.541213| |對數報酬相加後轉回 | 2.541213| |期末調整價格／期初調整價格 | 2.541213| ``` r stopifnot(diff(range(compound_table$全期簡單報酬)) < 1e-12) ``` 表中的三列應在浮點誤差內相同，這也檢查了單期報酬公式與複利方向是否一致。所得全期報酬只描述所選起迄日；樣本內累積幅度不等於固定的未來成長率。 ## 交易日與日曆日不同 相鄰兩列代表相鄰交易日，卻可能跨過週末或休市日。`calendar_gap` 計算兩個交易日期之間隔了幾個日曆日，並不是在宣告中間遺漏了幾筆交易報酬。 ``` r aapl$calendar_gap <- c(NA_integer_, as.integer(diff(aapl$date))) gap_table <- as.data.frame(table(aapl$calendar_gap, useNA = "no")) names(gap_table) <- c("相鄰交易日的日曆間隔", "次數") knitr::kable(gap_table) ``` |相鄰交易日的日曆間隔 | 次數| |:--------------------|----:| |1 | 687| |2 | 6| |3 | 156| |4 | 25| 表中多於一天的間隔通常對應週末或休市。若要年度化波動、合併不同市場或對齊總體資料，下一步還要交代交易日曆、時區與缺值規則；直接把日曆日補成 0 報酬會改變樣本的統計性質。 ## 極端日先查來源，不自動刪除 最後列出絕對對數報酬最大的八個交易日。排序的目的，是把最值得回查原始來源的日期找出來，而不是先把它們排除在分析之外。 ``` r valid_rows <- aapl[is.finite(aapl$log_return), ] extreme_rows <- valid_rows[ order(abs(valid_rows$log_return), decreasing = TRUE)[1:8], c("date", "adjusted", "simple_return", "log_return") ] knitr::kable(extreme_rows, digits = 6) ``` | |date | adjusted| simple_return| log_return| |:---|:----------|---------:|-------------:|----------:| |303 |2020-03-16 | 59.64409| -0.128647| -0.137708| |302 |2020-03-13 | 68.44997| 0.119808| 0.113157| |2 |2019-01-03 | 34.41423| -0.099607| -0.104924| |301 |2020-03-12 | 61.12651| -0.098755| -0.103978| |399 |2020-07-31 | 104.94921| 0.104689| 0.099564| |309 |2020-03-24 | 60.79407| 0.100325| 0.095606| |293 |2020-03-02 | 73.58179| 0.093101| 0.089018| |318 |2020-04-06 | 64.63309| 0.087237| 0.083640| 極端報酬可能反映真實市場變動，也可能來自公司行動處理或建檔錯誤。若調整價格與原始來源一致，就應把真實極端日保留，並在後續分配或波動模型中正面處理厚尾；只有查到明確的資料錯誤時才修正。 ## 從這份價格資料可以得到的結論 這份 AAPL 固定資料顯示，先排序再取落後價格，可以一致地重算簡單報酬與對數報酬；套件作法與手動公式得到相同結果，多期複利也與起訖價格比一致。這些結果仍只是資料處理與歷史描述，沒有說明極端日由什麼事件造成，也沒有提供未來報酬預測。下一步若要研究報酬分配，應保留已查證的極端日並進入 R03；若要預測，則須從資訊可得時點出發，另行安排時間排序的樣本切分。