mysql - quantmod R getsymbols.MySQL 修改

Question

我已经研究过这个案例了 Quantmod: Error loading symbols from MySQL DB并已经尝试修复 R 中的 getSymbols.MySQL 函数

但是，我发现我的数据库只包含日期、开盘价、最高价、最低价、收盘价、成交量(不含 close.adj 列)。那么，如果我想进一步修改getSymbols.MySQL函数，该怎么办呢？

我尝试使用“fix(getSymbols.MySQL)”来修复该函数。但是，它返回

colnames<- 中出现错误( *tmp* , value = c("H0001.Open", "H0001.High", "H0001.Low", : 'dimnames' 的长度 [2] 不等于数组范围

当我连接到我的数据库时。

function (Symbols, env, return.class = "xts", db.fields = c("date", 
"o", "h", "l", "c", "v", "a"), field.names = NULL, user = NULL, 
password = NULL, dbname = NULL, host = "localhost", port = 3306, 
...) 
{
importDefaults("getSymbols.MySQL")
this.env <- environment()
for (var in names(list(...))) {
    assign(var, list(...)[[var]], this.env)
}
if (!hasArg(verbose)) 
    verbose <- FALSE
if (!hasArg(auto.assign)) 
    auto.assign <- TRUE
if (!requireNamespace("DBI", quietly = TRUE)) 
    stop("package:", dQuote("DBI"), "cannot be loaded.")
if (!requireNamespace("RMySQL", quietly = TRUE)) 
    stop("package:", dQuote("RMySQL"), "cannot be loaded.")
if (is.null(user) || is.null(password) || is.null(dbname)) {
    stop(paste("At least one connection argument (", sQuote("user"), 
        sQuote("password"), sQuote("dbname"), ") is not set"))
}
con <- DBI::dbConnect("MySQL", user = user, password = password, 
    dbname = dbname, host = host, port = port)
db.Symbols <- DBI::dbListTables(con)
if (length(Symbols) != sum(Symbols %in% db.Symbols)) {
    missing.db.symbol <- Symbols[!Symbols %in% db.Symbols]
    warning(paste("could not load symbol(s): ", paste(missing.db.symbol, 
        collapse = ", ")))
    Symbols <- Symbols[Symbols %in% db.Symbols]
}
for (i in 1:length(Symbols)) {
    if (verbose) {
        cat(paste("Loading ", Symbols[[i]], paste(rep(".", 
            10 - nchar(Symbols[[i]])), collapse = ""), sep = ""))
    }
    query <- paste("SELECT ", paste(db.fields, collapse = ","), 
        " FROM ", Symbols[[i]], " ORDER BY date")
    rs <- DBI::dbSendQuery(con, query)
    fr <- DBI::fetch(rs, n = -1)
    fr <- xts(as.matrix(fr[, -1]), order.by = as.Date(fr[, 
        1], origin = "1970-01-01"), src = dbname, updated = Sys.time())
    colnames(fr) <- paste(Symbols[[i]], c("Open", "High", 
        "Low", "Close", "Volume", "Adjusted"), sep = ".")
    fr <- convert.time.series(fr = fr, return.class = return.class)
    if (auto.assign) 
        assign(Symbols[[i]], fr, env)
    if (verbose) 
        cat("done\n")
}
DBI::dbDisconnect(con)
if (auto.assign) 
    return(Symbols)
return(fr)
}

我认为问题在于该函数被设计为读取 7 列数据而不是 6 列数据。希望有人能帮忙。

Answer 1

这是一个补丁，应该可以让您做您想做的事情。我无法测试，因为我没有可供测试的 MySQL 安装。请告诉我它是否有效。

diff --git a/R/getSymbols.R b/R/getSymbols.R
index 0a2e814..7a9be66 100644
--- a/R/getSymbols.R
+++ b/R/getSymbols.R
@@ -634,9 +634,9 @@ function(Symbols,env,return.class='xts',
             fr <- xts(as.matrix(fr[,-1]),
                       order.by=as.Date(fr[,1],origin='1970-01-01'),
                       src=dbname,updated=Sys.time())
-            colnames(fr) <- paste(Symbols[[i]],
-                                  c('Open','High','Low','Close','Volume','Adjusted'),
-                                  sep='.')
+            if(is.null(field.names))
+              field.names <- c('Open','High','Low','Close','Volume','Adjusted')
+            colnames(fr) <- paste(Symbols[[i]], field.names, sep='.')
             fr <- convert.time.series(fr=fr,return.class=return.class)
             if(auto.assign)
               assign(Symbols[[i]],fr,env)

那么你的函数调用应该是:

getSymbols.MySQL("H0001", env, return.class = 'xts',
  db.fields = c("date", "open", "high", "low", "close", "volume"),
  field.names = c("date", "open", "high", "low", "close", "volume"),
  user = 'xxxx', password = 'xxxx', host='xxxx', dbname = 'xxxx')