如何在 broom 包的 tidy() 函数输出中添加星星？答案

【问题标题】：How can I add stars to broom package's tidy() function output?如何在 broom 包的 tidy() 函数输出中添加星星？
【发布时间】：2018-07-30 08:32:10
【问题描述】：

我一直在 R 中使用 broom 包的 tidy() 函数来打印我的模型摘要。

但是，tidy() 函数返回的 p 值没有星号，这对于许多习惯在模型摘要中看到星号的人来说有点奇怪。

有谁知道在输出中添加星星的方法？

【问题讨论】：

标签： r dataframe lm tidyverse broom

【解决方案1】：

我们可以使用gtools中的一个方便的函数stars.pval来做到这一点

library(gtools)
library(broom)
library(dplyr)
data(mtcars)
mtcars %>%
   lm(mpg ~ wt + qsec, .) %>%
   tidy %>%
   mutate(signif = stars.pval(p.value))
#        term  estimate std.error  statistic      p.value signif
#1 (Intercept) 19.746223 5.2520617   3.759709 7.650466e-04    ***
#2          wt -5.047982 0.4839974 -10.429771 2.518948e-11    ***
#3        qsec  0.929198 0.2650173   3.506179 1.499883e-03     **

【讨论】：

【解决方案2】：

这并不是tidy 的真正目的。它用于从各种对象制作整齐的数据帧，而不是提供有关这些对象的额外指标。

您总是可以编写一个函数来根据 p 值生成星号，并向使用tidy 生成的数据框添加一列。例如：

make_stars <- function(pval) {
  stars = ""
  if(pval <= 0.001)
    stars = "***"
  if(pval > 0.001 & pval <= 0.01)
    stars = "**"
  if(pval > 0.01 & pval <= 0.05)
    stars = "*"
  if(pval > 0.05 & pval <= 0.1)
     stars = "."
  stars
}

然后是这样的：

library(broom)
library(dplyr)

mtcars %>% 
  lm(mpg ~ wt + qsec, .) %>% 
  tidy() %>% 
  mutate(signif = sapply(p.value, function(x) make_stars(x)))

         term  estimate std.error  statistic      p.value signif
1 (Intercept) 19.746223 5.2520617   3.759709 7.650466e-04    ***
2          wt -5.047982 0.4839974 -10.429771 2.518948e-11    ***
3        qsec  0.929198 0.2650173   3.506179 1.499883e-03     **

【讨论】：

【解决方案3】：

这个问题已经得到解答，但只是想指出另一个比上面提到的gtools::stars.pval 更灵活的选项，因为它会根据您选择输入的内容返回数据帧或向量。

# loading the necessary library
library(broom)
library(dplyr)
library(groupedstats)

# using the function
df <- mtcars %>%
  stats::lm(mpg ~ wt + qsec, .) %>%
  broom::tidy(.) %>%
  groupedstats::signif_column(data = ., p = p.value)

df
#> # A tibble: 3 x 6
#>   term        estimate std.error statistic  p.value significance
#>   <chr>          <dbl>     <dbl>     <dbl>    <dbl> <chr>       
#> 1 (Intercept)   19.7       5.25       3.76 7.65e- 4 ***         
#> 2 wt            -5.05      0.484    -10.4  2.52e-11 ***         
#> 3 qsec           0.929     0.265      3.51 1.50e- 3 **

^{由reprex package (v0.3.0.9001) 于 2020 年 4 月 9 日创建}

【讨论】：

这似乎没有返回任何东西。
@jzadra 感谢您指出这一点。我已经更新了答案。
这很奇怪。没有赋值的管道链的结果应该和打印对象一样。也许它没有打印方法。

【解决方案4】：

正如 R 中的 printCoefmat 函数所使用的那样，您还可以使用 stats 包中的 symnum 函数（包含在基础 r 中）：

pv <- c(0.00001, 0.002, 0.02, 0.06, 0.12, 0.99)

stars <- symnum(pv, corr = FALSE, na = FALSE, 
       cutpoints = c(0, 0.001, 0.01, 0.05, 0.1, 1), 
       symbols = c("***", "**", "*", ".", " "))

# fetch the stars only
as.character(stars)
#> [1] "***" "**"  "*"   "."   " "   " "

# fetch the legend description
attr(stars, "legend")
#> [1] "0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1"

由reprex package (v0.2.0) 于 2018 年 9 月 10 日创建。

或者要准确回答您的问题，您可以这样使用它

library(dplyr)

pv <- c(0.00001, 0.002, 0.02, 0.06, 0.12, 0.99)

star_function <- function(x) {
  symnum(x, corr = FALSE, na = FALSE, 
         cutpoints = c(0, 0.001, 0.01, 0.05, 0.1, 1), 
         symbols = c("***", "**", "*", ".", " "))
}
stars <- star_function(pv)

# fetch the stars only
as.character(stars)
#> [1] "***" "**"  "*"   "."   " "   " "

# fetch the legend description
attr(stars, "legend")
#> [1] "0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1"

mtcars %>%
  stats::lm(mpg ~ wt + qsec, .) %>%
  broom::tidy(.) %>% 
  mutate(sign = as.character(star_function(p.value)))
#> # A tibble: 3 x 6
#>   term        estimate std.error statistic  p.value sign 
#>   <chr>          <dbl>     <dbl>     <dbl>    <dbl> <chr>
#> 1 (Intercept)   19.7       5.25       3.76 7.65e- 4 ***  
#> 2 wt            -5.05      0.484    -10.4  2.52e-11 ***  
#> 3 qsec           0.929     0.265      3.51 1.50e- 3 **

由reprex package (v0.2.0) 于 2018 年 9 月 10 日创建。

【讨论】：