Is there a way to get 'weighted mean' in reactable groupBy in a shiny app?

Question

I want to generate a reactable in my app, group the table using the groupBy argument and in the groups get the weighted mean for each one.

The function reactable::colDef() offers a list of options of summary: mean, sum, max, min, median, count, unique and frequency.

Is there a way I can calculate the weighted mean or weighted average in a reactable using the argument groupBy?

Here's an example of a simple app that generates a reactable and summarise the mean of the x variable:

library(shiny)
library(reactable)
library(dplyr)

ui <- fluidPage(
  fluidRow(
    h1("How to get `weighted mean` with reactable groupBy:"),
    reactable::reactableOutput(
      outputId = 'table',
      width = '300px'
    )
  )
)

server <- function(input, output, session) {
  
  output$table <- reactable::renderReactable({
    
    main_data <- dplyr::tibble(
      group = c('A', 'B', 'B', 'A', 'A'),
      x = c(45, 50, 35, 14, 29),
      y = c(33, 21, 15, 50, 40)
    )
    
    reactable::reactable(
      data = main_data,
      groupBy = 'group',
      columns = list(
        x = reactable::colDef(
          aggregate = 'mean',
          format = reactable::colFormat(
            digits = 2
          )
        )
      )
    )
    
  })
  
}

shinyApp(ui, server)

In the specific example, I want to summarise the weighted mean between variables x and y like this:

dplyr::tibble(
  group = c('A', 'B', 'B', 'A', 'A'),
  x = c(45, 50, 35, 14, 29),
  y = c(33, 21, 15, 50, 40)
) %>% 
  dplyr::group_by(
    group 
  ) %>% 
  dplyr::summarise(
    weighted_mean = weighted.mean(x, y)
  )

Thank you in advance to anyone who can give me some suggestions.

Answer 1

According to the docs you could use a custom aggregate function in JavaScript.

In the code below I added a possible implementation of a weighted mean function. But be aware that I have only some basic JS knowledge so there might be more elegant ways of achieving that. (:

library(shiny)
library(reactable)
library(dplyr)

ui <- fluidPage(
  fluidRow(
    h1("How to get `weighted mean` with reactable groupBy:"),
    reactable::reactableOutput(
      outputId = "table",
      width = "300px"
    )
  )
)

server <- function(input, output, session) {
  output$table <- reactable::renderReactable({
    main_data <- dplyr::tibble(
      group = c("A", "B", "B", "A", "A"),
      x = c(45, 50, 35, 14, 29),
      y = c(33, 21, 15, 50, 40)
    )

    reactable::reactable(
      data = main_data,
      groupBy = "group",
      columns = list(
        x = reactable::colDef(
          aggregate = htmlwidgets::JS("
              function(values, rows) {
                // sum of weights
                let wt = rows
                    .map( (row) => row.y)
                    .reduce( (a, b) => a + b );

                // weighted sum
                let sum = rows
                    .map( (row) => row.x * row.y)
                    .reduce( (a, b) => a + b );

                return sum / wt;
              }
            "),
          format = reactable::colFormat(
            digits = 2
          )
        )
      )
    )
  })
}

shinyApp(ui, server)
#> 
#> Listening on http://127.0.0.1:8737