使用plot.xts的開發版本的自定義繪圖函數

Question

我正在構建一個自動將圖例添加到plot.xts對象的自定義函數。

代碼在這裏：

library(xts) 
library(PerformanceAnalytics) 
data(edhec) 
R <- edhec[,1:4] 
chartS <- function(R, 
        y = NULL, 
        multi.panel = FALSE, 
        type = "l", 
        yaxis.same = TRUE, 
        event.lines = NULL, 
        event.labels = NULL, 
        event.col = 1, 
        event.offset = 1.2, 
        event.pos = 2, 
        event.srt = 90, 
        event.cex = 1.5, 
        lty = 1, 
        lwd = 2, 
        legend.loc = NULL, 
        legend.names = NULL, ...) { 

    plot.xts(R, y = y, multi.panel = multi.panel, 
      type = type, yaxis.same = yaxis.same, lty = lty, lwd = lwd, ...) 

    plot_object <- xts:::current.xts_chob() 

    columns <- plot_object$Env$xdata 
    columnnames <- plot_object$Env$column_names 

    if(!is.null(event.lines)) { 
    # error occurred 
    addEventLines(xts(event.labels, as.Date(event.lines)), 
        offset = event.offset, pos = event.pos, 
        srt = event.srt, cex = event.cex, col = event.col, ...) 
    } 

    if(is.null(legend.loc)) 
    legend.loc <- "topright" 
    if(is.null(legend.names)) 
    legend.names <- columnnames 

    if(!multi.panel) 
    addLegend(legend.loc, legend.names, lty = lty, lwd = lwd, ...) 
} 


# chartS(R) 
# chartS(R, lty = 1:4) 
chartS(R, multi.panel = TRUE) 

我沒有繪製多個窗口，沒有消息時，我設置multi.panel = TRUE。但是，如果我刪除plot.xts以下的代碼或將它們移動到plot.xts以上，它將再次運行。下面plot.xts

library(xts) 
library(PerformanceAnalytics) 
data(edhec) 
R <- edhec[,1:4] 
chartS <- function(R, 
        y = NULL, 
        multi.panel = FALSE, 
        type = "l", 
        yaxis.same = TRUE, 
        event.lines = NULL, 
        event.labels = NULL, 
        event.col = 1, 
        event.offset = 1.2, 
        event.pos = 2, 
        event.srt = 90, 
        event.cex = 1.5, 
        lty = 1, 
        lwd = 2, 
        legend.loc = NULL, 
        legend.names = NULL, ...) { 

    plot.xts(R, y = y, multi.panel = multi.panel, 
      type = type, yaxis.same = yaxis.same, lty = lty, lwd = lwd, ...) 


} 


# chartS(R) 
# chartS(R, lty = 1:4) 
chartS(R, multi.panel = TRUE) 

移動代碼

刪除代碼爲高於plot.xts

library(xts) 
library(PerformanceAnalytics) 
data(edhec) 
R <- edhec[,1:4] 
chartS <- function(R, 
        y = NULL, 
        multi.panel = FALSE, 
        type = "l", 
        yaxis.same = TRUE, 
        event.lines = NULL, 
        event.labels = NULL, 
        event.col = 1, 
        event.offset = 1.2, 
        event.pos = 2, 
        event.srt = 90, 
        event.cex = 1.5, 
        lty = 1, 
        lwd = 2, 
        legend.loc = NULL, 
        legend.names = NULL, ...) { 


    columns <- ncol(R) 
    columnnames <- colnames(R) 

    if(!is.null(event.lines)) { 
    # error occurred 
    addEventLines(xts(event.labels, as.Date(event.lines)), 
        offset = event.offset, pos = event.pos, 
        srt = event.srt, cex = event.cex, col = event.col, ...) 
    } 

    if(is.null(legend.loc)) 
    legend.loc <- "topright" 
    if(is.null(legend.names)) 
    legend.names <- columnnames 

    if(!multi.panel) 
    addLegend(legend.loc, legend.names, lty = lty, lwd = lwd, ...) 

    plot.xts(R, y = y, multi.panel = multi.panel, 
      type = type, yaxis.same = yaxis.same, lty = lty, lwd = lwd, ...) 
} 


# chartS(R) 
# chartS(R, lty = 1:4) 
chartS(R, multi.panel = TRUE) 

任何建議？

Answer 1

您需要跟蹤您正在構建的繪圖對象，並將其返回以便自動打印。您也不應該訪問未導出的對象（xts:::current.xts_chob()），因爲不能保證它們在各個版本中保持一致。

chartS <- 
function(R, y = NULL, multi.panel = FALSE, type = "l", yaxis.same = TRUE, 
     event.lines = NULL, event.labels = NULL, event.col = 1, 
     event.offset = 1.2, event.pos = 2, event.srt = 90, event.cex = 1.5, 
     lty = 1, lwd = 2, legend.loc = NULL, legend.names = NULL, ...) 
{ 
    plot_object <- plot.xts(R, y = y, multi.panel = multi.panel, type = type, 
    yaxis.same = yaxis.same, lty = lty, lwd = lwd, ...) 

    columns <- plot_object$Env$xdata 
    columnnames <- plot_object$Env$column_names 

    if(!is.null(event.lines)) { 
    plot_object <- 
     addEventLines(xts(event.labels, as.Date(event.lines)), offset = event.offset, 
     pos = event.pos, srt = event.srt, cex = event.cex, col = event.col, ...) 
    } 

    if(is.null(legend.loc)) 
    legend.loc <- "topright" 
    if(is.null(legend.names)) 
    legend.names <- columnnames 

    if(!multi.panel) 
    plot_object <- addLegend(legend.loc, legend.names, lty = lty, lwd = lwd, ...) 

    return(plot_object) 
}