Как мне заставить функцию лесного участка работать в r?

Question

Я использую пакет foresplot. Я хочу создать лесной участок с двумя группами (самолеты, машины) и тремя переменными для каждой. Я попытался создать функцию для графических участков и линий. Тем не менее, текст таблицы лесных участков работает, а функция - нет.

пример данных

structure(list(X = c("Aeroplanes", "Sex (F)", "1", "2", "Cars", 
"Sex (F)", "1", "2"), OR = c(NA, 1.35, 7.81, 6.14, NA, 1.17, 
0.15, 0.4), Cl.low = c(NA, 1.13, 5.69, 4.36, NA, 0.74, 0.05, 
0.16), CI.high = c(NA, 1.61, 11.01, 8.83, NA, 1.88, 0.35, 0.89
), p.value = c("", "< 0.001", "< 0.001", "< 0.001", "", "0.509", 
"< 0.001", "0.034")), class = "data.frame", row.names = c(NA, 
-8L))



CI <- table2OR_ed
CI <- within (CI, rm(X,OR, p.value))
CI$CI <-apply(CI,1,function(x){
  paste0("(",paste(x, collapse=", "),")")
})  
CI$CI[which(CI$CI=="(NA, NA)")] <- NA


tabletext <- cbind(c("Transport","\n",table2OR_ex$X), 
                   c("Odds ratio","\n",table2OR_ex$OR),
                   c("Confidence Interval","\n",CI$CI))

fn <- local({
  i = 0
  no_lines <- sum(!is.na(table2OR_ex$OR)) 
  b_clrs = colorRampPalette(colors=c("pink", "blue"))(no_lines)
  l_clrs = colorRampPalette(colors=c("blue", "pink"))(no_lines) 
  function(..., clr.line, clr.marker){
    i <<- i + 1
    fpDrawDiamondCI(..., clr.line = l_clrs[i], clr.marker = b_clrs[i])
  }
})

forestplot(labeltext=tabletext, graphwidth=unit (70, "mm"), graph.pos=3, 
           mean=c(NA,NA,table2OR_ex$OR), 
           lower=c(NA,NA,table2OR_ex$CI.low), upper=c(NA,NA,table2OR_ex$CI.high),
           fn.ci_norm = fn, #use function
           txt_gp=fpTxtGp(label=gpar(fontsize=12, cex=1), 
                          ticks=gpar(fontsize=12, cex=1.4),
                          xlab=gpar(fontsize=12,cex = 1),
                          title=gpar(fontsize=12,cex = 1.2)),

           zero=1,boxsize=0.4)

Я получаю эту ошибку

Предупреждающее сообщение: In min (lower, na.rm = TRUE): нет не пропущенных аргументов min; возвращая Inf

Я проверил класс, и CI.low имеет значение null, хотя при импорте CSV это число c. Так что, возможно, это источник ошибки?

Answer 1

Попробуйте это:

library(forestplot)
#> Loading required package: grid
#> Loading required package: magrittr
#> Loading required package: checkmate
library(grDevices)
table2OR_ex <- structure(list(X = c("Aeroplanes", "Sex (F)", "1", "2", "Cars", "Sex (F)", "1", "2"), 
                     mean = c(NA, 1.35, 7.81, 6.14, NA, 1.17, 0.15, 0.4), 
                     lower = c(NA, 1.13, 5.69, 4.36, NA, 0.74, 0.05, 0.16), 
                     upper = c(NA, 1.61, 11.01, 8.83, NA, 1.88, 0.35, 0.89),
                     p.value = c("", "< 0.001", "< 0.001", "< 0.001", "", "0.509", "< 0.001", "0.034")), 

                     .Names = c("Transport", "mean", "lower", "upper", "p value"), 
                     class = "data.frame", row.names = c(NA, -8L))

tabletext <- cbind(c("Transport","\n",table2OR_ex$Transport), 
                   c("Odds ratio","\n",table2OR_ex$mean),
                   c("Confidence Interval","\n", 
                     ifelse(is.na(table2OR_ex$lower), "", paste(table2OR_ex$lower, table2OR_ex$upper, sep= " - "))))
mat <- rbind(rbind(rep(NA, 3), rbind(rep(NA, 3), as.matrix(table2OR_ex[, 2:4]))))


fn <- local({
    i = 0
    no_lines <- sum(!is.na(mat[,"mean"])) 
    b_clrs = colorRampPalette(colors=c("pink", "blue"))(no_lines)
    l_clrs = colorRampPalette(colors=c("blue", "pink"))(no_lines) 
    function(..., clr.line, clr.marker){
        i <<- i + 1
        fpDrawDiamondCI(..., clr.line = l_clrs[i], clr.marker = b_clrs[i])
    }
})

forestplot(labeltext=tabletext, 
           mat,
           graphwidth=unit (70, "mm"), 
           graph.pos=3, 
           fn.ci_norm = fn,
           clip =c(-.125, max(table2OR_ex$upper, na.rm = TRUE)),
           is.summary=c(TRUE, TRUE, rep(FALSE, 8)),
           txt_gp=fpTxtGp(label=gpar(fontsize=12, cex=1), 
                          ticks=gpar(fontsize=12, cex=1.4),
                          xlab=gpar(fontsize=12,cex = 1),
                          title=gpar(fontsize=12,cex = 1.2)),

           zero=1,
           boxsize=0.4)

^{Создано в 2020-05-02 пакетом prex (v0.3.0)}