R - 探索存储在变量中的图形

时间:2014-11-13 17:13:28

标签: r graph plot

我有办法在R中看到图形是如何构建到变量中的:图形背后的代码。我已经尝试过str(),deparse()和replayPlot()函数,但是这些函数没有给出我正在搜索的答案。

我正在查看“ChainLadder”包中MackChainLadder()函数返回的结果。当我绘制变量时,比如绘图(MCL),它会返回6个不同的图形。这是一种了解如何构建这些图并将其保存到变量中的方法吗?

library("ChainLadder") 
MCL <- MackChainLadder(ABC)
plot(MCL)

1 个答案:

答案 0 :(得分:0)

执行此操作的一种方法是直接查看包源代码(从此页面下载):

http://cran.r-project.org/web/packages/ChainLadder/index.html

诀窍是找到plot()调用的正确方法。我认为可能是MackChainLadderFunctions.R中的这个

    ################################################################################
## plot
##
plot.MackChainLadder <- function(x, mfrow=c(3,2), title=NULL,lattice=FALSE,...){


    .myResult <-  summary(x)$ByOrigin

    .FullTriangle <- x[["FullTriangle"]]
    .Triangle <- x[["Triangle"]]

    if(!lattice){
      if(is.null(title)) myoma <- c(0,0,0,0) else myoma <- c(0,0,2,0)

      op=par(mfrow=mfrow, oma=myoma, mar=c(4.5,4.5,2,2))

      plotdata <- t(as.matrix(.myResult[,c("Latest","IBNR")]))
        n <- ncol(plotdata)

      if(getRversion() < "2.9.0") { ## work around missing feature

        bp <- barplot(plotdata,
                      legend.text=c("Latest","Forecast"),
                      ##    args.legend=list(x="topleft"), only avilable from R version >= 2.9.0
                      names.arg=rownames(.myResult),
                      main="Mack Chain Ladder Results",
                      xlab="Origin period",
                      ylab="Amount",#paste(Currency,myUnit),
                      ylim=c(0, max(apply(.myResult[c("Ultimate", "Mack.S.E")],1,sum),na.rm=TRUE)))

      }else{
        bp <- barplot(plotdata,
                      legend.text=c("Latest","Forecast"),
                      args.legend=list(x="topleft"),
                      names.arg=rownames(.myResult),
                      main="Mack Chain Ladder Results",
                      xlab="Origin period",
                      ylab="Amount",#paste(Currency,myUnit),
                      ylim=c(0, max(apply(.myResult[c("Ultimate", "Mack.S.E")],1,sum),na.rm=TRUE)))
      }
      ## add error ticks
      ## require("Hmisc")
      errbar(x=bp, y=.myResult$Ultimate,
             yplus=(.myResult$Ultimate + .myResult$Mack.S.E),
             yminus=(.myResult$Ultimate - .myResult$Mack.S.E),
               cap=0.05,
             add=TRUE)

      matplot(t(.FullTriangle), type="l",
              main="Chain ladder developments by origin period",
              xlab="Development period", ylab="Amount", #paste(Currency, myUnit)
              )
      matplot(t(.Triangle), add=TRUE)

      Residuals=residuals(x)
      plot(standard.residuals ~ fitted.value, data=Residuals,
           ylab="Standardised residuals", xlab="Fitted")
      lines(lowess(Residuals$fitted.value, Residuals$standard.residuals), col="red")
      abline(h=0, col="grey")
      plot(standard.residuals ~ origin.period, data=Residuals,
           ylab="Standardised residuals", xlab="Origin period")
      lines(lowess(Residuals$origin.period, Residuals$standard.residuals), col="red")
      abline(h=0, col="grey")
      plot(standard.residuals ~ cal.period, data=Residuals,
           ylab="Standardised residuals", xlab="Calendar period")
      lines(lowess(Residuals$cal.period, Residuals$standard.residuals), col="red")
      abline(h=0, col="grey")
      plot(standard.residuals ~ dev.period, data=Residuals,
           ylab="Standardised residuals", xlab="Development period")
      lines(lowess(Residuals$dev.period, Residuals$standard.residuals), col="red")
      abline(h=0, col="grey")

      title( title , outer=TRUE)
      par(op)

    }else{

      ## require(grid)
      ## Set legend 
      fl <-
        grid.layout(nrow = 2, ncol = 4,
                    heights = unit(rep(1, 2), "lines"),
                    widths =
                    unit(c(2, 1, 2, 1),
                         c("cm", "strwidth", "cm",
                           "strwidth"),
                         data = list(NULL, "Chain ladder dev.", NULL,
                           "Mack's S.E.")))

      foo <- frameGrob(layout = fl)

      foo <- placeGrob(foo,
                       linesGrob(c(0.2, 0.8), c(.5, .5),
                                 gp = gpar(col=1, lty=1)),
                       row = 1, col = 1)
      foo <- placeGrob(foo,
                       linesGrob(c(0.2, 0.8), c(.5, .5),
                                 gp = gpar(col=1, lty=3)), 
                       row = 1, col = 3)
      foo <- placeGrob(foo,
                       textGrob(label = "Chain ladder dev."), 
                       row = 1, col = 2)
      foo <- placeGrob(foo,
                       textGrob(label = "Mack's S.E."), 
                       row = 1, col = 4)

      long <- expand.grid(origin=as.numeric(dimnames(.FullTriangle)$origin),
                          dev=as.numeric(dimnames(.FullTriangle)$dev))
      long$value <- as.vector(.FullTriangle)
      long$valuePlusMack.S.E <-  long$value + as.vector(x$Mack.S.E)
      long$valueMinusMack.S.E <- long$value - as.vector(x$Mack.S.E)
      sublong <- long[!is.na(long$value),]
      xyplot(valuePlusMack.S.E + valueMinusMack.S.E + value ~ dev |
             factor(origin), data=sublong, t="l", lty=c(3,3,1), as.table=TRUE,
             main="Chain ladder developments by origin period",
             xlab="Development period",
             ylab="Amount",col=1,
             legend = list(top = list(fun = foo)),...)
    }
  }