0

我想将plsr模型(pls包)的摘要导出到一个漂亮的表(最好是 HTML)。我知道lm模型的好方法,但我很好奇是否有人知道一种快速的方法来提取信息plsr并将其格式化为一个漂亮的表格。我个人很难找到summary(my.plsr.model)使用时显示的相同信息str()

这是摘要输出的示例

Data:   X dimension: 405 239 
    Y dimension: 405 1
Fit method: kernelpls
Number of components considered: 20

VALIDATION: RMSEP
Cross-validated using 405 leave-one-out segments.
       (Intercept)  1 comps  2 comps  3 comps  4 comps  5 comps  6 comps  7 comps  8 comps  9 comps  10 comps
CV           1.587    1.465    1.394    1.372    1.336    1.296    1.282    1.225    1.211    1.193     1.173
adjCV        1.587    1.465    1.394    1.372    1.336    1.296    1.282    1.225    1.211    1.193     1.173
       11 comps  12 comps  13 comps  14 comps  15 comps  16 comps  17 comps  18 comps  19 comps  20 comps
CV        1.175     1.159     1.174     1.184     1.187     1.173     1.158     1.108     1.115     1.063
adjCV     1.175     1.160     1.175     1.184     1.186     1.173     1.157     1.107     1.114     1.061

TRAINING: % variance explained
      1 comps  2 comps  3 comps  4 comps  5 comps  6 comps  7 comps  8 comps  9 comps  10 comps  11 comps
X       62.23    67.88    83.52    87.71    89.28    92.02    92.71    93.67    94.66     95.36     95.82
Yvar    15.33    26.44    29.10    34.29    40.35    42.50    49.62    52.69    54.16     55.06     56.10
      12 comps  13 comps  14 comps  15 comps  16 comps  17 comps  18 comps  19 comps  20 comps
X        96.68     97.30     97.63     98.02     98.24     98.36     98.49      98.6     98.73
Yvar     56.94     58.51     61.31     63.07     64.64     66.31     67.71      69.1     70.08
4

2 回答 2

1

鉴于@dash2 的建议和与pls包开发者的互动。他说,“pls 包中的摘要函数不返回任何内容,它只是打印出摘要。(我知道,这是糟糕的设计;R 中的摘要函数习惯于返回一个对象,并单独打印功能显示它们。也许有一天我应该改变它。:))

最好的办法是查看汇总函数的实际作用,以及它如何获取信息,然后自己复制。要查看摘要功能,请执行pls:::summary.mvr

我编辑了摘要函数以提取仅在包的原始函数中不可见的数据。

#function to extract data to plot
r2_rmsep_data_func <- function(object,...){
  yvarnames <- respnames(object)
  xve <- explvar(object)
  yve <- 100 * drop(R2(object, estimate = "train", 
                       intercept = FALSE)$val)
  rmseps <- tail(c(RMSEP(object, "CV")$val),-1)
  tbl <- cbind(cumsum(xve), yve, rmseps) #modified to create columns instead of rows
  tbl <- as.data.frame(tbl) 
  rownames(tbl) <- gsub("Comp ", "", rownames(tbl), fixed = TRUE)  
  tbl <- rownames_to_column(tbl,var="Components")
  tbl$Components <- as.numeric(tbl$Components)
  colnames(tbl) <- c("Components", "Spectra", yvarnames,"RMSEP")
  return(tbl)
} 

r2_plus_error_data <- as.data.frame(r2_rmsep_data_func(Trait_plsr))

现在,使用上面建议的软件包可以轻松制作任何表格,但是我发现图表可以更好地显示数据。因此,使用一些额外的肘部油脂,我们可以将所有东西放在一起,以显示两个 y 轴与plotly.

#double y-axis plot with RMSEP on right and two R^2 lines (y and x variances explained) on the left

#plotly method
#second y-axis function
ay <- list(
  tickfont = list(color = 'rgb(80,80,80)'),
  overlaying = "y",
  side = "right",
  title = "RMSEP"
)
#vertical line function
vline <- function(x = 0, color = 'rgb(220,220,220)') {
  list(
    type = "line",
    y0 = 0, 
    y1 = 1, 
    yref = "paper",
    x0 = x, 
    x1 = x, 
    line = list(color = color, dash = "dashdot")
  )
}
#actual plot
p <- plot_ly(type = 'scatter', mode = 'lines') %>%
  add_trace(x = ~r2_plus_error_data$Components, y = ~r2_plus_error_data$Spectra, name = "Spectra", line=list(color = 'rgb(22, 96, 167)')) %>%
  add_trace(x= ~r2_plus_error_data$Components, y= ~r2_plus_error_data$M1_lb, name = Trait, line=list(color = 'rgb(205, 12, 24)')) %>% 
  add_trace(x = ~r2_plus_error_data$Components, y = ~r2_plus_error_data$RMSEP, name = "RMSEP", yaxis = "y2", line=list(color = 'rgb(128,128,128)', dash = 'dot')) %>%
  layout(
    title = "Multiple R^2 with RMSEP by Component", yaxis2 = ay,
    xaxis = list(title="Components"), 
    yaxis = list(title="Variance Explained"), 
    legend = list(orientation = 'v', 
                  x = 1.1, y = 1.06), 
    shapes = list(vline(ncomp_permut)), 
    hoverlabel = list(font=list(color="white"))
  )

p

哪个返回这个 RMSEP 和 R^2 图

于 2018-05-25T21:12:44.863 回答
0

可能的选项包括broomtexregstargazer(我自己的)huxtable包。看起来好像既没有也没有broom表格的texreg方法plsr,所以最好的办法可能是将输出转换为数据框并使用huxtable

output <- as_hux(plsr_output)
# you can now edit the output as you desire, e.g. make the first line bold:
bold(output)[1, ] <- TRUE

应该是什么plsr_output取决于您想要什么(例如coefscoresloadings-我不熟悉软件包或统计理论)。

于 2018-04-07T22:58:48.527 回答