2014-09-19 88 views
1

您能否提出一種將主標題添加到該圖表的方法? gridBulletGraphV功能可以找到here將主標題添加到項目符號圖

ytd2005 <- data.frame(
    measure=c("Revenue", "Profit", "Avg Order Size", "New Customers", "Cust Satisfaction"), 
    units=c("U.S. $ (1,000s)", "%", "U.S. $", "Count", "Top Rating of 5"), 
    low=c(150, 20, 350, 1400, 3.5), 
    mean=c(225, 25, 500, 2000, 4.25), 
    high=c(300, 30, 600, 2500, 5), 
    target=c(250, 26, 550, 2100, 4.2), 
    value=c(275, 22.5, 310, 1700, 4.5) 
) 

nticks <- c(7, 7, 7, 6, 7) 
format <- c("s", "p", "s", "k", "s") 

col1 <- c("#a5a7a9", "#c5c6c8", "#e6e6e7") 

gridBulletGraphV(ytd2005, nticks=nticks, format=format, bcol=col1, font=11, scfont=9) 

回答

1

您可以通過更改功能來實現。我加了ptitle="text"參數的功能,只是for (i in 1:n) {之前添加以下代碼:

# Title 
vp <- viewport(layout.pos.row = 1) 
pushViewport(vp) 
grid.text(label = ptitle, 
      just = "centre", 
      gp = gpar(fontsize=font*1.5, col="black", fontface="bold"), 
      x = .5, 
      y = 0.1) 
upViewport() 

現在,您可以調用與功能:

gridBulletGraphV(ytd2005, nticks=nticks, format=format, bcol=col1, font=11, 
       scfont=9, ptitle="Plot Title") 

其給出以下結果: enter image description here


修訂後的gridBulletGraphV功能:

gridBulletGraphV <- function(bgData, nticks=3, format="s", bcol=c("red", "yellow", "green"), tcol="black", vcol="black", font=25, scfont=15, ptitle="text") { 
    # Data Prep 
    n <- nrow(bgData) 
    nam <- c("low", "mean", "high", "target", "value") 
    datMat <- as.matrix(bgData[, nam]) 
    # Nticks/Format Prep 
    if (length(nticks) == 1) { 
    nticks <- rep(nticks, n) 
    } 
    if (length(format) == 1) { 
    format <- rep(format, n) 
    } 
    # Layout 
    hl <- rep(1, n + 2) 
    hu <- c("lines", rep("null", n), "lines") 
    layout <- grid.layout(4, n + 2, widths = unit(hl, hu), 
         heights = unit(c(1, 1, 5, 2), c("lines", "null", "null", "lines"))) 
    # Set Layout 
    grid.newpage() 
    pushViewport(plotViewport(c(0, 0, 0, 0), layout = layout)) 
    # Title 
    vp <- viewport(layout.pos.row = 1) 
    pushViewport(vp) 
    grid.text(label = ptitle, 
      just = "centre", 
      gp = gpar(fontsize=font*1.5, col="black", fontface="bold"), 
      x = .5, 
      y = 0.1) 
    upViewport() 
    for (i in 1:n) { 
    # 
    vp <- viewport(layout.pos.row = 3, 
        layout.pos.col = i+1) 
    pushViewport(vp) 
    # Sublayout 
    subLayout <- grid.layout(nrow = 1, 
          widths = unit(c(1, 2, 1), c("null", "null", "null")), 
          ncol = 3) 
    pushViewport(plotViewport(c(0, 0, 0, 0), layout=subLayout)) 
    vp <- viewport(layout.pos.row = 1, 
        layout.pos.col = 2, 
        yscale = c(0, datMat[i, 3])) 
    pushViewport(vp) 
    # x-Axis Labels 
    # Formatierung Label 
    if (format[i] == "s") { 
     brks <- labels <- round(seq(0, datMat[i, 3], length=nticks[i]), 0) 
    } else if (format[i] == "p"){ 
     brks <- labels <- round(seq(0, datMat[i, 3], length=nticks[i]), 0) 
     labels <- paste0(labels, "%") 
    } else if (format[i] == "k") { 
     brks <- labels <- round(seq(0, datMat[i, 3], length=nticks[i]), 0) 
     labels <- format(labels, digits=10, nsmall=0, decimal.mark=".", big.mark=",") 
    } 
    grid.yaxis(at=brks, label=labels, gp=gpar(fontsize=scfont, col="black", fontface="bold")) 
    grid.rect(y = c(0, datMat[i, 1:2])/datMat[i, 3], 
       height = unit(diff(c(0, datMat[i, 1:3])), "native"), 
       x = rep(0.5, 3), 
       width = 1, 
       just = "bottom", 
       gp = gpar(fill=bcol, col=bcol)) 
    grid.rect(y = c(0, datMat[i, 5]), 
       height = unit(diff(c(0, datMat[i, 5])), "native"), 
       x = 0.5, 
       width = 0.5, 
       gp = gpar(fill=vcol, col=vcol), just="bottom") 
    a <- datMat[i, 1] * 0.01 
    grid.rect(y = datMat[i, 4]/datMat[i, 3], 
       height = unit(a, "native"), 
       x = 0.5, 
       width = 0.8, 
       gp = gpar(fill=tcol, col=tcol), just="bottom") 
    upViewport(n=3) 
    # Annotation 
    pushViewport(plotViewport(c(0, 0, 0, 0), layout=layout)) 
    vp <- viewport(layout.pos.row = 2, 
        layout.pos.col = i+1) 
    pushViewport(vp) 
    # Sublayout 1: Same layout as graph 
    subLayout <- grid.layout(nrow = 1, 
          ncol = 3, 
          widths = unit(c(1, 2, 1), c("null", "null", "null"))) 
    pushViewport(plotViewport(c(0, 0, 0, 0), layout=subLayout)) 
    vp <- viewport(layout.pos.row = 1, 
        layout.pos.col = 2) 
    pushViewport(vp) 
    # Sublayout 2: two rows of text; centred middle of graph 
    subLayout <- grid.layout(nrow = 3, 
          ncol = 1, 
          widths = unit(c(1, 1), c("null", "null"))) 
    pushViewport(plotViewport(c(0, 0, 0, 0), layout=subLayout)) 
    # First Text: Measure 
    vp <- viewport(layout.pos.row = 2, 
        layout.pos.col = 1) 
    pushViewport(vp) 
    grid.text(label = bgData$measure[i], 
       just = "bottom", 
       gp = gpar(fontsize=font, col="black", fontface="bold"), 
       x = .5, 
       y = 0.1) 
    upViewport() 
    # Second Text: Unit 
    vp <- viewport(layout.pos.row = 3, 
        layout.pos.col = 1) 
    pushViewport(vp) 
    grid.text(label = bgData$units[i], 
       just = "bottom", 
       gp = gpar(fontsize=font, col="black"), 
       x = .5, 
       y = .5) 
    upViewport(n=5) 
    } 
} 
+1

非常感謝! – 2014-09-19 11:40:09

相關問題