Adding kendall tau to gtsummary

Question

Iv created a table with gysummary using tbl_summary function.

The grouping is by tertiles: "Low tertile", "Medium tertile", "High tertile"

Using add_p, Kruskal Wallis test compares different characteristics across these 3 groups.

I wish to add a column of p-values from Kendall tau correlation (using 1,2,3 as numeric instead of "Low tertile", "Medium tertile", "High tertile".

Is this possible?

I tried calculating the correlations and saving the p values as a vector but couldn't manage to add it as a column.

Edited: Here is the reprex:

library(reprex)
#> Warning: package 'reprex' was built under R version 4.2.3
library(dplyr)
#> Warning: package 'dplyr' was built under R version 4.2.3
#> 
#> Attaching package: 'dplyr'
#> The following objects are masked from 'package:stats':
#> 
#>     filter, lag
#> The following objects are masked from 'package:base':
#> 
#>     intersect, setdiff, setequal, union
library(SciViews)
#> Warning: package 'SciViews' was built under R version 4.2.1
library(gtsummary)
#> Warning: package 'gtsummary' was built under R version 4.2.3
#> #Uighur


# Create sample data
n <- 10
data <- data.frame(
  VAT_Quantile_3 = factor(sample(c("Low tertile", "Medium tertile", "High tertile"), n, replace = TRUE)),
  Gender = factor(sample(c("Male", "Female"), n, replace = TRUE)),
  Age = c(50.1, 49.2, 48.8, 51.7, 52.6, 50.4, 49.9, 48.2, 51.1, 52.7))

tab_1<- data %>%
  select(VAT_Quantile_3, Gender , Age) %>%
  tbl_summary(by = VAT_Quantile_3,
              statistic = list(
                all_continuous() ~ "{mean} ({sd})",
                all_categorical() ~ "{n} / {N} ({p}%)"),
              digits = list(all_continuous() ~ c(1, 1),
                            all_categorical() ~ c(0,1)))  %>%
  add_p(,pvalue_fun = ~style_pvalue(., digits = 3))

#code for Kendell's tau:
cor.test(data$Age, as.numeric(data$VAT_Quantile_3), method = "kendall")
#> Warning in cor.test.default(data$Age, as.numeric(data$VAT_Quantile_3), method =
#> "kendall"): Cannot compute exact p-value with ties
#> 
#>  Kendall's rank correlation tau
#> 
#> data:  data$Age and as.numeric(data$VAT_Quantile_3)
#> z = -0.47891, p-value = 0.632
#> alternative hypothesis: true tau is not equal to 0
#> sample estimates:
#>        tau 
#> -0.1297498

^{Created on 2023-04-12 with reprex v2.0.2}

Answer 1

Here is one solution using a custom function and the incredibly versatile gtsummary::add_stat() function:

library(gtsummary)

# Create custom function using gtsummary syntax to be used in add_stat(). 
# `variable` will represent all the columns in your dataframe passed to `tbl_summary()`.
# Hardcode the variable against which you want corr (in this case `mpg`)

fn_add_tau_and_p <- function(data, variable, ...) {
  t <- cor.test(data[[variable]], data[["mpg"]], method = "kendall")
  data.frame(`tau` = style_sigfig(t$estimate), `p` = style_pvalue(t$p.value))
  
}

# test individually
fn_add_tau_and_p(mtcars, "hp")
#>       tau      p
#> tau -0.74 <0.001

# Now use `add_stat()` to add your function to `tbl_summary()`

mtcars |>
  select(hp, disp, wt, mpg, gear) |>
  tbl_summary(
  ) |>
  add_stat(fns = all_continuous() ~ fn_add_tau_and_p)

Note: you can also use broom::tidy() within your custom function as an alternative, as per example 2 here.