shinyweighted-averagereactablegroup-summaries

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


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.


Solution

  • 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