如何将 plsr 模型的摘要导出到 R 中的漂亮 HTML 表

Question

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

这里是一个汇总输出的例子

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

Answer 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

返回这个

Answer 2

可能的选项包括broom、texreg、stargazer 和（我自己的）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 应该是什么取决于您想要什么（例如 coef 或 scores 或 loadings - 我不熟悉软件包或统计理论）。