inst/abcdmetrics/www/R/outputs/table_evolution.R

In ucsd-dsm/abcd-metrics: ABCD Metrics shiny app

output$table_evolution <- renderReactable({
  
  if(input$aggregation_selection) {
    dta <- dta_abcd_visit() |> 
      group_by(site, timepoint, category) |> summarise(n = sum(n), .groups = "drop") |> 
      pivot_wider(names_from = c(timepoint), values_from = n)
    
    if(input$display_table == "Site %") {
      dta <- dta |> 
        group_by(site) |> 
        mutate(across(where(is.numeric), ~ round(100 * .x / sum(.x), 1) )) |> 
        ungroup()
    }
    
    if(input$display_table == "Difference _ALL SITES_ %") {
      dta <- dta |> 
        group_by(site) |> 
        mutate(across(where(is.numeric), ~ round(100 * .x / sum(.x), 1) )) |> 
        ungroup()
      
      dta_all <- dta |>
        filter(site == "_ALL SITES_") |>
        mutate(across(where(is.numeric), ~ round(100 * .x / sum(.x), 1) )) |> 
        slice(rep(row_number(), length(input$site_selection) + 1))
      
      # TODO: check that all columns are either character, factor or numeric
      dta <- bind_cols(
        dta |> select(where(is.character) | where(is.factor)),
        dta |> select(where(is.numeric)) - dta_all |> select(where(is.numeric)) |> mutate(across(where(is.numeric), ~ round(.x, 1) ))
      )
    }
    
    return(reactable(dta, striped = TRUE, pagination = FALSE))
  }
  
  if(! input$aggregation_selection) {
    dta <- dta_abcd_visit() |> 
      group_by(site, timepoint, status) |> summarise(n = sum(n), .groups = "drop") |> 
      pivot_wider(names_from = c(timepoint), values_from = n)
    
    if(input$display_table == "Site %") {
      dta <- dta |> 
        group_by(site) |> 
        mutate(across(where(is.numeric), ~ round(100 * .x / sum(.x), 1))) |> 
        ungroup()
    }
    
    if(input$display_table == "Difference _ALL SITES_ %") {
      dta <- dta |> 
        group_by(site) |> 
        mutate(across(where(is.numeric), ~ round(100 * .x / sum(.x), 1) )) |> 
        ungroup()
      
      dta_all <- dta |>
        filter(site == "_ALL SITES_") |>
        mutate(across(where(is.numeric), ~ round(100 * .x / sum(.x), 1) )) |> 
        slice(rep(row_number(), length(input$site_selection) + 1))
      
      # TODO: check that all columns are either character, factor or numeric
      dta <- bind_cols(
        dta |> select(where(is.character) | where(is.factor)),
        dta |> select(where(is.numeric)) - dta_all |> select(where(is.numeric)) |> mutate(across(where(is.numeric), ~ round(.x, 1) ))
      )
    }
    
    return(reactable(dta, striped = TRUE, pagination = FALSE))
  }
})