在forestplot中，设置字体，使文本“普通”，不起作用，为什么？

Question

我想让森林图中的所有文本都是普通的，而不是粗体的，有人知道怎么做吗？谢谢!

library(forestplot)
# Cochrane data from the 'rmeta'-package
cochrane_from_rmeta <- 
  structure(list(
    mean  = c(NA, NA, 0.578, 0.165, 0.246, 0.700, 0.348, 0.139, 1.017, NA, 0.531), 
    lower = c(NA, NA, 0.372, 0.018, 0.072, 0.333, 0.083, 0.016, 0.365, NA, 0.386),
    upper = c(NA, NA, 0.898, 1.517, 0.833, 1.474, 1.455, 1.209, 2.831, NA, 0.731)),
    .Names = c("mean", "lower", "upper"), 
    row.names = c(NA, -11L), 
    class = "data.frame")

tabletext<-cbind(
  c("", "Study", "Auckland", "Block", 
    "Doran", "Gamsu", "Morrison", "Papageorgiou", 
    "Tauesch", NA, "Summary"),
  c("Deaths", "(steroid)", "36", "1", 
    "4", "14", "3", "1", 
    "8", NA, NA),
  c("Deaths", "(placebo)", "60", "5", 
    "11", "20", "7", "7", 
    "10", NA, NA),
  c("", "OR", "0.58", "0.16", 
    "0.25", "0.70", "0.35", "0.14", 
    "1.02", NA, "0.53"))

forestplot(tabletext, 
           cochrane_from_rmeta,new_page = TRUE,
           is.summary=c(TRUE,TRUE,rep(FALSE,8),TRUE),
           clip=c(0.1,2.5), 
           xlog=TRUE, 
           col=fpColors(box="royalblue",line="darkblue", summary="royalblue"),
           txt_gp = fpTxtGp(label = gpar( font="plain"))) # doesnt work

​

​

............

Answer 1

“使用源码”...如果您查看fpTxtGp()的源代码，您将看到一些元素被硬编码为粗体；例如：

> fpTxtGp

function (label, summary, xlab, title, ticks, legend, legend.title, 
    cex = 1) 
{
## Some output omitted...
ret$title <- prGparMerge(attr(ret$label, "ref"), list(fontface = "bold", 
        cex = attr(ret$label, "ref")$cex * 1.2, just = "center"))
## More output omitted...

因此，您不能使用此函数指定普通字体。您可以将函数体复制并粘贴到一个新的自定义函数中，其中省略了不需要的粗体类型。

Answer 2

现在我已经把标题改成了素色。但是我得到的错误是，它找不到函数"prGarMerge"，该函数中的另一个函数。有没有办法把代码转到prGarMerge上？

fpTxtGp <- function (label, summary, xlab, title, ticks, legend, legend.title, 
          cex = 1) 
{
  prGparMergeMultiLevel <- function(ret, element) {
    name <- deparse(substitute(element))
    if (!inherits(element, "gpar")) {
      if (inherits(element, "list") && (inherits(element[[1]], 
                                                 "gpar") || (inherits(element[[1]], "list") && 
                                                             inherits(element[[1]][[1]], "gpar")))) {
        if (inherits(element[[1]], "gpar")) {
          ret <- lapply(element, function(x, l1) prGparMerge(l1, 
                                                             x), l1 = ret)
          attr(ret, "txt_dim") <- 1
          default_element <- ret[[1]]
        }
        else {
          el_len <- sapply(element, length, USE.NAMES = FALSE)
          if (any(el_len != el_len[1])) 
            stop("It seems that you haven't provided a square list", 
                 " for '", name, "'", ", ie all rows have the same number of elements.", 
                 " Currently the list lengths are:", 
                 " '", paste(el_len, collapse = "', '"), 
                 "'")
          ret <- lapply(element, function(l) {
            lapply(l, function(x, l1) prGparMerge(l1, 
                                                  x), l1 = ret)
          })
          attr(ret, "txt_dim") <- 2
          default_element <- ret[[1]][[1]]
        }
      }
      else {
        stop("You can only provide arguments from gpar() or a 1-2 dimensional list of gpars to the function")
      }
    }
    else {
      ret <- prGparMerge(ret, element)
      attr(ret, "txt_dim") <- 0
      default_element <- ret
    }
    attr(ret, "ref") <- default_element
    return(ret)
  }
  ret <- list()
  ret$label <- list(fontface = "plain", cex = cex)
  attr(ret$label, "ref") <- ret$label
  attr(ret$label, "txt_dim") <- 0
  if (!missing(label)) {
    ret$label <- prGparMergeMultiLevel(ret$label, label)
  }
  ret$summary <- prGparMerge(attr(ret$label, "ref"), 
                             list(fontface = "bold", cex = attr(ret$label, "ref")$cex * 
                                    1.1))
  attr(ret$summary, "ref") <- ret$summary
  attr(ret$summary, "txt_dim") <- 0
  if (!missing(summary)) {
    ret$summary <- prGparMergeMultiLevel(ret$summary, summary)
  }
  ret$title <- prGparMerge(attr(ret$label, "ref"), list(fontface = "plain", 
                                                        cex = attr(ret$label, "ref")$cex * 1.2, just = "center"))
  if (!missing(title)) {
    if (class(title) != "gpar") 
      stop("You can only provide arguments from gpar() to the function")
    ret$title <- prGparMerge(ret$title, title)
  }
  ret$xlab <- prGparMerge(attr(ret$label, "ref"), list(cex = attr(ret$label, 
                                                                  "ref")$cex * 0.6))
  if (!missing(xlab)) {
    if (class(xlab) != "gpar") 
      stop("You can only provide arguments from gpar() to the function")
    ret$xlab <- prGparMerge(ret$xlab, xlab)
  }
  ret$ticks <- prGparMerge(attr(ret$label, "ref"), list(cex = attr(ret$label, 
                                                                   "ref")$cex * 0.5))
  if (!missing(ticks)) {
    if (class(ticks) != "gpar") 
      stop("You can only provide arguments from gpar() to the function")
    ret$ticks <- prGparMerge(ret$ticks, ticks)
  }
  ret$legend <- prGparMerge(attr(ret$label, "ref"), list(cex = attr(ret$label, 
                                                                    "ref")$cex * 0.8))
  attr(ret$legend, "ref") <- ret$legend
  attr(ret$legend, "txt_dim") <- 0
  if (!missing(legend)) {
    if (class(legend) != "gpar") 
      stop("You can only provide arguments from gpar() to the function")
    ret$legend <- prGparMergeMultiLevel(ret$legend, legend)
  }
  ret$legend.title <- prGparMerge(attr(ret$label, "ref"), 
                                  list(fontface = "bold", cex = attr(ret$label, "ref")$cex * 
                                         1.1))
  if (!missing(legend.title)) {
    if (class(legend.title) != "gpar") 
      stop("You can only provide arguments from gpar() to the function")
    ret$legend.title <- prGparMerge(ret$legend.title, legend.title)
  }
  return(structure(ret, class = c("fpTxtGp", class(ret))))
}

forestplot(tabletext, 
           cochrane_from_rmeta,new_page = TRUE,
           is.summary=c(TRUE,TRUE,rep(FALSE,8),TRUE),
           clip=c(0.1,2.5), 
           xlog=TRUE, 
           col=fpColors(box="royalblue",line="darkblue", summary="royalblue"),
           txt_gp = fpTxtGp(label = gpar( font="plain"))) # doesnt work


Error in prGparMerge(ret, element) : 
  could not find function "prGparMerge"
In addition: Warning message:
In validGP(list(...)) :
 Error in prGparMerge(ret, element) : 
  could not find function "prGparMerge"