R02：價格、日期與報酬率

本附錄對應第 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 報酬的因果效果。

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 後排序，再確認沒有重複日期，而且調整價格都是正的有限值。

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、875 個交易日，以及前述價格與報酬尺度。這張表把後續每個數字的分母與時間單位先固定下來；若換成週報酬或未調整收盤價，解讀也必須跟著改變。

第一筆價格沒有本檔案中的前一期價格可供比較，所以兩種報酬都應是缺值。這個缺值是報酬定義自然產生的，不需要填成 0；填入 0 反而會憑空增加一個「沒有漲跌」的交易日。

colSums(is.na(aapl[c("adjusted", "simple_return", "log_return")]))

##      adjusted simple_return    log_return 
##             0             1             1

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 中；若研究需要逐筆辨認拆股或現金股利，仍要另讀公司行動資料，單靠這一欄無法還原全部現金流。

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)

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
)

最大絕對差 應小於 \(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() 則把公式加入資料框。這些函數不會替我們選擇正確的價格欄位，也不知道休市日應如何處理；資料尺度、排序鍵與缺值規則仍要由研究者先決定。

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)

stopifnot(
  is.na(returns_package$simple_return_package[1]),
  is.na(returns_package$log_return_package[1]),
  max(package_return_check$最大絕對差) < 1e-12
)

四列 最大絕對差 都應接近零，因為手動版與套件版只是用不同語法計算同一定義。套件縮短了資料操作程式，資料責任仍然相同：先排序、保留第一筆自然產生的缺值，並確定分子與分母使用同一調整價格尺度。

價格與報酬的時間圖#

接著把價格水準與日報酬放在同一張圖的上下兩格。價格圖回答「資產價值如何隨時間累積」，報酬圖回答「每一交易日的相對變動有多大」；兩者的尺度與統計性質不同，不能只因來自同一欄價格就用同一模型處理。

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

par(old_par)

圖中的價格水準有明顯長期變動，日報酬則大多圍繞零上下波動，偶爾出現較大的跳動。這提醒我們在建模前先說清楚研究對象是價格、簡單報酬或對數報酬；價格有趨勢，不表示報酬也沿著同一趨勢前進。

簡單報酬與對數報酬的差距#

小幅報酬時 $r_t\approx R_t$，所以散點應貼近 45 度線；大幅漲跌時，對數轉換的非線性會讓兩者差距擴大。下圖中的每一點都是同一交易日的 AAPL 簡單報酬與對數報酬。

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

par(old_par)

從單日報酬走到整段期間報酬#

要回答「從樣本第一天持有到最後一天，調整價格總共變動多少」，單日簡單報酬要逐期複利，而對數報酬可以先相加。從第一個調整價格到最後一個調整價格，三種算法應得到相同的多期簡單報酬：

1. 每日簡單報酬逐期複利；
2. 每日對數報酬相加後轉回簡單報酬；
3. 最後價格除以最初價格再減一。

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)

stopifnot(diff(range(compound_table$全期簡單報酬)) < 1e-12)

表中的三列應在浮點誤差內相同，這也檢查了單期報酬公式與複利方向是否一致。所得全期報酬只描述所選起迄日；樣本內累積幅度不等於固定的未來成長率。

交易日與日曆日不同#

相鄰兩列代表相鄰交易日，卻可能跨過週末或休市日。calendar_gap 計算兩個交易日期之間隔了幾個日曆日，並不是在宣告中間遺漏了幾筆交易報酬。

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)

表中多於一天的間隔通常對應週末或休市。若要年度化波動、合併不同市場或對齊總體資料，下一步還要交代交易日曆、時區與缺值規則；直接把日曆日補成 0 報酬會改變樣本的統計性質。

極端日先查來源，不自動刪除#

最後列出絕對對數報酬最大的八個交易日。排序的目的，是把最值得回查原始來源的日期找出來，而不是先把它們排除在分析之外。

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)

極端報酬可能反映真實市場變動，也可能來自公司行動處理或建檔錯誤。若調整價格與原始來源一致，就應把真實極端日保留，並在後續分配或波動模型中正面處理厚尾；只有查到明確的資料錯誤時才修正。

從這份價格資料可以得到的結論#

這份 AAPL 固定資料顯示，先排序再取落後價格，可以一致地重算簡單報酬與對數報酬；套件作法與手動公式得到相同結果，多期複利也與起訖價格比一致。這些結果仍只是資料處理與歷史描述，沒有說明極端日由什麼事件造成，也沒有提供未來報酬預測。下一步若要研究報酬分配，應保留已查證的極端日並進入 R03；若要預測，則須從資訊可得時點出發，另行安排時間排序的樣本切分。