'How to create a flexible data stratification table?
When working with data all roads for me lead to "stratification tables" so one can get a feel for the dispersion of the data. Visualization is both by numeric table and plot.
Can someone please recommend a flexible way to generate a stratification table; by "flexible" I mean where the user can input stratification parameters? In the below code I present a sample data frame, and the ways I'd like the user to be eventually able to cut (stratify) the data.
I'm pretty new to R and have always run stratifications in Excel. In the image at the bottom you can see you how I normally stratify in Excel, with the end product highlighted in yellow. I also include a 2nd image that shows the formulas used to generate the stratification table in the first image.
I've been trying to limit the use of packages (other than shiny and the amazing dplyr, DT) but I imagine there are some nice packages too for running stratifications.
Note that my stratifications are run as of a specific point-in-time (in my data there 2 ways to measure time, via Period_1 and Period_2). So only those rows meeting that time criteria are included in the stratification.
Does anyone have suggestions for doing this?
Code:
library(shiny)
library(tidyverse)
library(shinyWidgets)
ui <-
fluidPage(
h5(strong("Raw data:")),
tableOutput("data"),
h5(strong("Grouped data:")),
radioButtons(
inputId = "grouping",
label = NULL,
choiceNames = c("By period 1", "By period 2"),
choiceValues = c("Period_1", "Period_2"),
selected = "Period_1",
inline = TRUE
),
tableOutput("summed_data"),
h5(strong("Point-in-time stratification table:")),
selectInput(inputId = "time",
label = "Choose a point-in-time:",
list(`By Period_1:` = list("2020-01", "2020-02", "2020-03", "2020-04"),
`By Period_2:` = list(1, 2, 3, 4)),
selected = "2020-04"),
numericInput(label = "Stratify by range of values:", 'strat_gap','',value=5,step=1,width = '100%'),
panel(
checkboxGroupInput(
inputId = "vars",
label = "Select characteristics to filter data by:",
choices = c("Category"),
selected = c("Category"),
inline = TRUE
),
selectizeGroupUI(
id = "my-filters",
params = list(
Category = list(inputId = "Category", title = "Category:")
)
),
status = "primary"
),
)
server <- function(input, output, session) {
data <- reactive({
data.frame(
ID = c(1,1,2,2,2,2,3,3,3),
Period_1 = c("2020-03", "2020-04", "2020-01", "2020-02", "2020-03", "2020-04", "2020-02", "2020-03", "2020-04"),
Period_2 = c(1, 2, 1, 2, 3, 4, 1, 2, 3),
Category = c("Toad", "Toad", "Stool", "Stool", "Stool", "Stool","Toad","Toad","Toad"),
Values = c(15, 25, 35, 45, 55, 87, 10, 20, 30)
)
})
choice <- reactive(input$grouping)
summed_data <- reactive({
data() %>%
group_by(across(choice())) %>%
select("Values") %>%
summarise(across(everything(), sum, na.rm = TRUE)) %>%
filter(across(1,.fns = ~ .x %>% negate(is.na)() ))
})
output$data <- renderTable(data())
output$summed_data <- renderTable(summed_data())
}
shinyApp(ui, server)
Excel example (2nd image shows stratification formulas):
Sources
This article follows the attribution requirements of Stack Overflow and is licensed under CC BY-SA 3.0.
Source: Stack Overflow
| Solution | Source |
|---|


