2024-01-11 13:42:03 +01:00
|
|
|
library(shiny)
|
2024-01-11 09:43:23 +01:00
|
|
|
server <- function(input, output, session) {
|
|
|
|
# source("https://git.nikohuru.dk/au-phd/PhysicalActivityandStrokeOutcome/raw/branch/main/side%20projects/assignment.R")
|
2024-10-10 12:14:41 +02:00
|
|
|
# source(here::here("R/group_assign.R"))
|
2024-01-11 13:42:03 +01:00
|
|
|
|
2024-11-14 14:29:46 +01:00
|
|
|
v <- shiny::reactiveValues(
|
|
|
|
ds = NULL,
|
|
|
|
pre = NULL
|
|
|
|
)
|
|
|
|
|
2024-01-11 13:42:03 +01:00
|
|
|
dat <- reactive({
|
2024-01-11 09:43:23 +01:00
|
|
|
# input$file1 will be NULL initially. After the user selects
|
|
|
|
# and uploads a file, head of that data file by default,
|
|
|
|
# or all rows if selected, will be shown.
|
2024-01-11 13:42:03 +01:00
|
|
|
|
2024-01-11 09:43:23 +01:00
|
|
|
req(input$file1)
|
|
|
|
# Make laoding dependent of file name extension (file_ext())
|
2024-11-14 14:29:46 +01:00
|
|
|
out <- read_input(input$file1$datapath)
|
|
|
|
v$ds <- "loaded"
|
|
|
|
return(out)
|
2024-01-11 09:43:23 +01:00
|
|
|
})
|
2024-01-11 13:42:03 +01:00
|
|
|
|
2024-11-14 14:29:46 +01:00
|
|
|
dat_parsed <- reactive({
|
|
|
|
req(input$file1)
|
|
|
|
if (input$input_type == "default") {
|
|
|
|
out <- dat()
|
|
|
|
} else if (input$input_type == "prio") {
|
|
|
|
req(input$id_var_prio)
|
|
|
|
req(input$prio_vars)
|
|
|
|
|
|
|
|
out <- parse_prio_form(
|
|
|
|
data = dat(),
|
|
|
|
id = input$id_var_prio,
|
|
|
|
prio.cols = input$prio_vars
|
|
|
|
)
|
|
|
|
} else if (input$input_type == "string") {
|
|
|
|
req(input$id_var_string)
|
|
|
|
req(input$string_var)
|
|
|
|
|
|
|
|
out <- parse_string_form(
|
|
|
|
data = dat(),
|
|
|
|
id = input$id_var_string,
|
|
|
|
string.col = input$string_var,
|
|
|
|
pattern = input$string_split
|
|
|
|
)
|
|
|
|
}
|
|
|
|
return(out)
|
|
|
|
})
|
|
|
|
|
|
|
|
|
|
|
|
output$id_var_prio <- shiny::renderUI({
|
|
|
|
selectInput(
|
|
|
|
inputId = "id_var_prio",
|
|
|
|
selected = 1,
|
|
|
|
label = "ID column",
|
|
|
|
choices = colnames(dat()),
|
|
|
|
multiple = FALSE
|
|
|
|
)
|
|
|
|
})
|
2024-01-11 13:42:03 +01:00
|
|
|
|
2024-11-14 14:29:46 +01:00
|
|
|
output$id_var_string <- shiny::renderUI({
|
|
|
|
selectInput(
|
|
|
|
inputId = "id_var_string",
|
|
|
|
selected = 1,
|
|
|
|
label = "ID column",
|
|
|
|
choices = colnames(dat()),
|
|
|
|
multiple = FALSE
|
|
|
|
)
|
|
|
|
})
|
|
|
|
|
|
|
|
output$prio_vars <- shiny::renderUI({
|
|
|
|
selectizeInput(
|
|
|
|
inputId = "prio_vars",
|
|
|
|
selected = NULL,
|
|
|
|
label = "Priority columns (select from first to lowest)",
|
|
|
|
choices = colnames(dat())[-match(input$id_var_prio, colnames(dat()))],
|
|
|
|
multiple = TRUE
|
|
|
|
)
|
|
|
|
})
|
|
|
|
|
|
|
|
output$string_var <- shiny::renderUI({
|
|
|
|
selectizeInput(
|
|
|
|
inputId = "string_var",
|
|
|
|
selected = NULL,
|
|
|
|
label = "Column of strings",
|
|
|
|
choices = colnames(dat())[-match(input$id_var_string, colnames(dat()))],
|
|
|
|
multiple = FALSE
|
|
|
|
)
|
|
|
|
})
|
|
|
|
|
|
|
|
dat_pre <- reactive({
|
2024-01-11 09:43:23 +01:00
|
|
|
# req(input$file2)
|
|
|
|
# Make laoding dependent of file name extension (file_ext())
|
2024-11-14 14:29:46 +01:00
|
|
|
if (!is.null(input$file2$datapath)) {
|
|
|
|
out <- read_input(input$file2$datapath)
|
2024-01-11 09:43:23 +01:00
|
|
|
} else {
|
2024-11-14 14:29:46 +01:00
|
|
|
out <- NULL
|
2024-01-11 09:43:23 +01:00
|
|
|
}
|
2024-11-14 14:29:46 +01:00
|
|
|
v$pre <- "loaded"
|
|
|
|
return(out)
|
2024-01-11 09:43:23 +01:00
|
|
|
})
|
2024-01-11 13:42:03 +01:00
|
|
|
|
2024-10-10 12:14:41 +02:00
|
|
|
groups <-
|
2024-01-11 13:42:03 +01:00
|
|
|
reactive({
|
2024-10-10 12:14:41 +02:00
|
|
|
grouped <- prioritized_grouping(
|
2024-11-14 14:29:46 +01:00
|
|
|
data = dat_parsed(),
|
2024-10-10 12:14:41 +02:00
|
|
|
excess_space = input$excess,
|
|
|
|
pre_grouped = dat_pre()
|
2024-01-11 09:43:23 +01:00
|
|
|
)
|
2024-10-10 12:14:41 +02:00
|
|
|
return(grouped)
|
2024-01-11 09:43:23 +01:00
|
|
|
})
|
2024-01-11 13:42:03 +01:00
|
|
|
|
|
|
|
|
2024-10-10 12:14:41 +02:00
|
|
|
plot.overall <- reactive({
|
|
|
|
dplyr::case_match(input$overall.plot,
|
2024-11-14 14:29:46 +01:00
|
|
|
"yes" ~ TRUE,
|
|
|
|
"no" ~ FALSE,
|
|
|
|
.default = NULL
|
|
|
|
)
|
2024-10-10 12:14:41 +02:00
|
|
|
})
|
|
|
|
|
2024-01-11 13:42:03 +01:00
|
|
|
output$raw.data.tbl <- renderTable({
|
2024-10-10 12:14:41 +02:00
|
|
|
groups()$export
|
2024-01-11 09:43:23 +01:00
|
|
|
})
|
2024-01-11 13:42:03 +01:00
|
|
|
|
2024-10-10 12:14:41 +02:00
|
|
|
output$pre.groups <- renderTable({
|
2024-01-11 09:43:23 +01:00
|
|
|
dat_pre()
|
|
|
|
})
|
2024-01-11 13:42:03 +01:00
|
|
|
|
|
|
|
output$input <- renderTable({
|
2024-01-11 09:43:23 +01:00
|
|
|
dat()
|
|
|
|
})
|
2024-01-11 13:42:03 +01:00
|
|
|
|
2024-11-14 14:29:46 +01:00
|
|
|
output$input_parsed <- renderTable({
|
|
|
|
dat_parsed()
|
|
|
|
})
|
|
|
|
|
2024-10-10 12:14:41 +02:00
|
|
|
output$groups.plt <- renderPlot({
|
2024-11-14 14:29:46 +01:00
|
|
|
grouping_plot(groups(), overall = plot.overall())
|
2024-01-11 09:43:23 +01:00
|
|
|
})
|
2024-01-11 13:42:03 +01:00
|
|
|
|
2024-11-14 14:29:46 +01:00
|
|
|
|
|
|
|
output$uploaded <- shiny::reactive({
|
|
|
|
if (is.null(v$ds)) {
|
|
|
|
"no"
|
|
|
|
} else {
|
|
|
|
"yes"
|
|
|
|
}
|
|
|
|
})
|
|
|
|
|
|
|
|
output$pre_assigned <- shiny::reactive({
|
|
|
|
if (is.null(v$pre)) {
|
|
|
|
"no"
|
|
|
|
} else {
|
|
|
|
"yes"
|
|
|
|
}
|
|
|
|
})
|
|
|
|
|
|
|
|
shiny::outputOptions(output, "uploaded", suspendWhenHidden = FALSE)
|
|
|
|
shiny::outputOptions(output, "pre_assigned", suspendWhenHidden = FALSE)
|
|
|
|
|
2024-01-11 09:43:23 +01:00
|
|
|
# Downloadable csv of selected dataset ----
|
2024-01-11 13:42:03 +01:00
|
|
|
output$downloadData <- downloadHandler(
|
2024-11-14 14:29:46 +01:00
|
|
|
filename = "prioritized_grouping.ods",
|
2024-01-11 09:43:23 +01:00
|
|
|
content = function(file) {
|
2024-11-14 14:29:46 +01:00
|
|
|
readODS::write_ods(as.data.frame(groups()$export), file)
|
2024-01-11 09:43:23 +01:00
|
|
|
}
|
|
|
|
)
|
|
|
|
}
|