mirror of
https://github.com/agdamsbo/prioritized.grouping.git
synced 2025-09-12 10:39:39 +02:00
parsing of different form formats, move to bslib with new sidebar
Some checks failed
pkgdown.yaml / pkgdown (push) Has been cancelled
Some checks failed
pkgdown.yaml / pkgdown (push) Has been cancelled
This commit is contained in:
parent
f26cf1c916
commit
a576a580db
12 changed files with 666 additions and 124 deletions
|
@ -13,3 +13,4 @@
|
||||||
^\.github$
|
^\.github$
|
||||||
^data/prioritized_sample\.xlsx$
|
^data/prioritized_sample\.xlsx$
|
||||||
^sample_data$
|
^sample_data$
|
||||||
|
^drafting$
|
||||||
|
|
1
.gitignore
vendored
1
.gitignore
vendored
|
@ -8,3 +8,4 @@ docs
|
||||||
data/prioritized_sample.xlsx
|
data/prioritized_sample.xlsx
|
||||||
sample_data
|
sample_data
|
||||||
app/rsconnect
|
app/rsconnect
|
||||||
|
drafting
|
||||||
|
|
|
@ -3,5 +3,7 @@
|
||||||
S3method(plot,prioritized_groups_list)
|
S3method(plot,prioritized_groups_list)
|
||||||
export(file_extension)
|
export(file_extension)
|
||||||
export(grouping_plot)
|
export(grouping_plot)
|
||||||
|
export(parse_prio_form)
|
||||||
|
export(parse_string_form)
|
||||||
export(prioritized_grouping)
|
export(prioritized_grouping)
|
||||||
export(read_input)
|
export(read_input)
|
||||||
|
|
16
NEWS.md
16
NEWS.md
|
@ -1,8 +1,22 @@
|
||||||
|
## Version 24.10.2
|
||||||
|
|
||||||
|
Working to allow direct import of online form results
|
||||||
|
|
||||||
|
* NEW: `prio2groups()` is a helper function to widen and format to apply with
|
||||||
|
valid format for `prioritized_grouping()` when importing the spreadsheet.
|
||||||
|
|
||||||
|
Wish list of supported platforms:
|
||||||
|
|
||||||
|
- Google Forms [WIP]
|
||||||
|
- Teams
|
||||||
|
- REDCap Survey
|
||||||
|
|
||||||
|
|
||||||
## Version 24.10.1
|
## Version 24.10.1
|
||||||
|
|
||||||
First proper public version. The package is mainly build for an easy to use
|
First proper public version. The package is mainly build for an easy to use
|
||||||
shiny-interface, but can as easily be used directly in *R* with the main
|
shiny-interface, but can as easily be used directly in *R* with the main
|
||||||
`prioritized_grouping` function. This function is mainly a wrapper around the `ROI`
|
`prioritized_grouping()` function. This function is mainly a wrapper around the `ROI`
|
||||||
package and the `ROI.plugin.symphony` plugin.
|
package and the `ROI.plugin.symphony` plugin.
|
||||||
|
|
||||||
File types accepted in the shiny-app are .csv, .xls(x) and .ods.
|
File types accepted in the shiny-app are .csv, .xls(x) and .ods.
|
||||||
|
|
101
R/parse_formats.R
Normal file
101
R/parse_formats.R
Normal file
|
@ -0,0 +1,101 @@
|
||||||
|
#' Parse input data with columns of priorities to columns of groups
|
||||||
|
#'
|
||||||
|
#' @description
|
||||||
|
#' This handles transforming data from a typical Google form to the format
|
||||||
|
#' compatible with `prioritized_grouping()`.
|
||||||
|
#'
|
||||||
|
#' @param data data.frame or tibble
|
||||||
|
#' @param id id column. Numeric index or column name. Default is 1.
|
||||||
|
#' @param prio.cols priority columns. Numeric indices or column names.
|
||||||
|
#' @param sort.cols flag to sort priority columns names/indices. Default=FALSE
|
||||||
|
#'
|
||||||
|
#' @return data.frame
|
||||||
|
#' @export
|
||||||
|
#'
|
||||||
|
parse_prio_form <- function(data, id = 1, prio.cols,sort.cols=FALSE) {
|
||||||
|
if (is.character(prio.cols)) {
|
||||||
|
grp.index <- match(prio.cols, names(data))
|
||||||
|
} else {
|
||||||
|
grp.index <- prio.cols
|
||||||
|
}
|
||||||
|
|
||||||
|
if (sort.cols){
|
||||||
|
prio.cols <- sort(prio.cols)
|
||||||
|
}
|
||||||
|
|
||||||
|
new.names <- names(data)
|
||||||
|
new.names[grp.index] <- seq_along(grp.index)
|
||||||
|
|
||||||
|
data <- setNames(data, new.names)
|
||||||
|
|
||||||
|
out <- split(data, seq_len(nrow(data))) |>
|
||||||
|
lapply(\(.x){
|
||||||
|
# browser()
|
||||||
|
|
||||||
|
out <- as.data.frame(matrix(c(as.character(.x[[id]]), colnames(.x)[grp.index]), nrow = 1))
|
||||||
|
setNames(out, c(
|
||||||
|
"id",
|
||||||
|
# names(.x[id]),
|
||||||
|
unname(unlist(.x[grp.index]))
|
||||||
|
))
|
||||||
|
}) |>
|
||||||
|
dplyr::bind_rows() |>
|
||||||
|
dplyr::mutate(dplyr::across(-1, as.integer))
|
||||||
|
|
||||||
|
# Sorting is not really needed, but a nice touch
|
||||||
|
out[c(names(out)[1], sort(names(out)[-1]))]
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
#' Parse input data from column of strings with prioritised group names
|
||||||
|
#'
|
||||||
|
#' @description
|
||||||
|
#' This handles transforming data from a typical Microsoft form to the format
|
||||||
|
#' compatible with `prioritized_grouping()`.
|
||||||
|
#'
|
||||||
|
#' @param data data.frame or tibble
|
||||||
|
#' @param id id column. Numeric index of column name. Default is 1.
|
||||||
|
#' @param string.col string column. Numeric index or column name.
|
||||||
|
#' @param pattern regex pattern to use for splitting priorities string with
|
||||||
|
#' `strsplit()`.
|
||||||
|
#' Default is ";".
|
||||||
|
#'
|
||||||
|
#' @return data.frame
|
||||||
|
#' @export
|
||||||
|
#'
|
||||||
|
parse_string_form <- function(data, id = 1, string.col,pattern=NULL) {
|
||||||
|
if (is.null(pattern)){
|
||||||
|
pattern <- ";"
|
||||||
|
}
|
||||||
|
|
||||||
|
if (length(string.col) != 1) {
|
||||||
|
stop("string.col is required, and has to have length 1")
|
||||||
|
}
|
||||||
|
if (is.character(string.col)) {
|
||||||
|
string.index <- match(string.col, names(data))
|
||||||
|
} else {
|
||||||
|
string.index <- string.col
|
||||||
|
}
|
||||||
|
|
||||||
|
# Cells with NAs are excluded.
|
||||||
|
# NAs happen if the priorities are not edited upon form submission, but a
|
||||||
|
# default order can not be guessed reliably if group naming is not ordered
|
||||||
|
# (like group N, group N+1...)
|
||||||
|
out <- data.frame(data[[id]], data[[string.index]]) |>
|
||||||
|
na.omit() |>
|
||||||
|
(\(.d){
|
||||||
|
split(.d, seq_len(nrow(.d)))
|
||||||
|
})() |>
|
||||||
|
lapply(\(.x){
|
||||||
|
grps <- unlist(strsplit(x=.x[[2]],split=pattern))
|
||||||
|
out <- as.data.frame(matrix(c(.x[[1]], seq_along(grps)), nrow = 1))
|
||||||
|
setNames(
|
||||||
|
out,
|
||||||
|
c("id", grps)
|
||||||
|
)
|
||||||
|
}) |>
|
||||||
|
dplyr::bind_rows()
|
||||||
|
|
||||||
|
# Sorting is not really needed, but a nice touch
|
||||||
|
out[c(names(out)[1], sort(names(out)[-1]))]
|
||||||
|
}
|
|
@ -2,7 +2,7 @@ utils::globalVariables(c("group", "grp", "i", "j", "value"))
|
||||||
|
|
||||||
#' Solve grouping based on priorities or costs.
|
#' Solve grouping based on priorities or costs.
|
||||||
#'
|
#'
|
||||||
#' @param data data set in wide format. First column should bi ID, then one column
|
#' @param data data set in wide format. First column should be ID, then one column
|
||||||
#' for each group containing cost/priorities.
|
#' for each group containing cost/priorities.
|
||||||
#' @param cap_classes class capacity. Numeric vector length 1 or length=number
|
#' @param cap_classes class capacity. Numeric vector length 1 or length=number
|
||||||
#' of groups. If NULL equal group sizes are calculated. Default is NULL.
|
#' of groups. If NULL equal group sizes are calculated. Default is NULL.
|
||||||
|
@ -39,6 +39,11 @@ prioritized_grouping <-
|
||||||
subject identifiers")
|
subject identifiers")
|
||||||
}
|
}
|
||||||
|
|
||||||
|
# Converts tibble to data.frame
|
||||||
|
if ("tbl_df" %in% class(data)){
|
||||||
|
data <- as.data.frame(data)
|
||||||
|
}
|
||||||
|
|
||||||
## This program very much trust the user to supply correctly formatted data
|
## This program very much trust the user to supply correctly formatted data
|
||||||
cost <- t(data[, -1]) # Transpose converts to matrix
|
cost <- t(data[, -1]) # Transpose converts to matrix
|
||||||
colnames(cost) <- data[, 1]
|
colnames(cost) <- data[, 1]
|
||||||
|
@ -360,3 +365,4 @@ read_input <- function(file, consider.na = c("NA", '""', "")) {
|
||||||
|
|
||||||
df
|
df
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
236
app/server.R
236
app/server.R
|
@ -1,5 +1,112 @@
|
||||||
|
|
||||||
|
|
||||||
|
########
|
||||||
|
#### Current file: R//parse_formats.R
|
||||||
|
########
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
parse_prio_form <- function(data, id = 1, prio.cols,sort.cols=FALSE) {
|
||||||
|
if (is.character(prio.cols)) {
|
||||||
|
grp.index <- match(prio.cols, names(data))
|
||||||
|
} else {
|
||||||
|
grp.index <- prio.cols
|
||||||
|
}
|
||||||
|
|
||||||
|
if (sort.cols){
|
||||||
|
prio.cols <- sort(prio.cols)
|
||||||
|
}
|
||||||
|
|
||||||
|
new.names <- names(data)
|
||||||
|
new.names[grp.index] <- seq_along(grp.index)
|
||||||
|
|
||||||
|
data <- setNames(data, new.names)
|
||||||
|
|
||||||
|
out <- split(data, seq_len(nrow(data))) |>
|
||||||
|
lapply(\(.x){
|
||||||
|
# browser()
|
||||||
|
|
||||||
|
out <- as.data.frame(matrix(c(as.character(.x[[id]]), colnames(.x)[grp.index]), nrow = 1))
|
||||||
|
setNames(out, c(
|
||||||
|
"id",
|
||||||
|
# names(.x[id]),
|
||||||
|
unname(unlist(.x[grp.index]))
|
||||||
|
))
|
||||||
|
}) |>
|
||||||
|
dplyr::bind_rows() |>
|
||||||
|
dplyr::mutate(dplyr::across(-1, as.integer))
|
||||||
|
|
||||||
|
# Sorting is not really needed, but a nice touch
|
||||||
|
out[c(names(out)[1], sort(names(out)[-1]))]
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
parse_string_form <- function(data, id = 1, string.col,pattern=NULL) {
|
||||||
|
if (is.null(pattern)){
|
||||||
|
pattern <- ";"
|
||||||
|
}
|
||||||
|
|
||||||
|
if (length(string.col) != 1) {
|
||||||
|
stop("string.col is required, and has to have length 1")
|
||||||
|
}
|
||||||
|
if (is.character(string.col)) {
|
||||||
|
string.index <- match(string.col, names(data))
|
||||||
|
} else {
|
||||||
|
string.index <- string.col
|
||||||
|
}
|
||||||
|
|
||||||
|
# Cells with NAs are excluded.
|
||||||
|
# NAs happen if the priorities are not edited upon form submission, but a
|
||||||
|
# default order can not be guessed reliably if group naming is not ordered
|
||||||
|
# (like group N, group N+1...)
|
||||||
|
out <- data.frame(data[[id]], data[[string.index]]) |>
|
||||||
|
na.omit() |>
|
||||||
|
(\(.d){
|
||||||
|
split(.d, seq_len(nrow(.d)))
|
||||||
|
})() |>
|
||||||
|
lapply(\(.x){
|
||||||
|
grps <- unlist(strsplit(x=.x[[2]],split=pattern))
|
||||||
|
out <- as.data.frame(matrix(c(.x[[1]], seq_along(grps)), nrow = 1))
|
||||||
|
setNames(
|
||||||
|
out,
|
||||||
|
c("id", grps)
|
||||||
|
)
|
||||||
|
}) |>
|
||||||
|
dplyr::bind_rows()
|
||||||
|
|
||||||
|
# Sorting is not really needed, but a nice touch
|
||||||
|
out[c(names(out)[1], sort(names(out)[-1]))]
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
########
|
########
|
||||||
#### Current file: R//prioritized_grouping.R
|
#### Current file: R//prioritized_grouping.R
|
||||||
########
|
########
|
||||||
|
@ -45,6 +152,11 @@ prioritized_grouping <-
|
||||||
subject identifiers")
|
subject identifiers")
|
||||||
}
|
}
|
||||||
|
|
||||||
|
# Converts tibble to data.frame
|
||||||
|
if ("tbl_df" %in% class(data)){
|
||||||
|
data <- as.data.frame(data)
|
||||||
|
}
|
||||||
|
|
||||||
## This program very much trust the user to supply correctly formatted data
|
## This program very much trust the user to supply correctly formatted data
|
||||||
cost <- t(data[, -1]) # Transpose converts to matrix
|
cost <- t(data[, -1]) # Transpose converts to matrix
|
||||||
colnames(cost) <- data[, 1]
|
colnames(cost) <- data[, 1]
|
||||||
|
@ -368,6 +480,7 @@ read_input <- function(file, consider.na = c("NA", '""', "")) {
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
########
|
########
|
||||||
#### Current file: app/server_raw.R
|
#### Current file: app/server_raw.R
|
||||||
########
|
########
|
||||||
|
@ -377,6 +490,11 @@ server <- function(input, output, session) {
|
||||||
# source("https://git.nikohuru.dk/au-phd/PhysicalActivityandStrokeOutcome/raw/branch/main/side%20projects/assignment.R")
|
# source("https://git.nikohuru.dk/au-phd/PhysicalActivityandStrokeOutcome/raw/branch/main/side%20projects/assignment.R")
|
||||||
# source(here::here("R/group_assign.R"))
|
# source(here::here("R/group_assign.R"))
|
||||||
|
|
||||||
|
v <- shiny::reactiveValues(
|
||||||
|
ds = NULL,
|
||||||
|
pre = NULL
|
||||||
|
)
|
||||||
|
|
||||||
dat <- reactive({
|
dat <- reactive({
|
||||||
# input$file1 will be NULL initially. After the user selects
|
# input$file1 will be NULL initially. After the user selects
|
||||||
# and uploads a file, head of that data file by default,
|
# and uploads a file, head of that data file by default,
|
||||||
|
@ -384,28 +502,95 @@ server <- function(input, output, session) {
|
||||||
|
|
||||||
req(input$file1)
|
req(input$file1)
|
||||||
# Make laoding dependent of file name extension (file_ext())
|
# Make laoding dependent of file name extension (file_ext())
|
||||||
df <- read_input(input$file1$datapath)
|
out <- read_input(input$file1$datapath)
|
||||||
return(df)
|
v$ds <- "loaded"
|
||||||
|
return(out)
|
||||||
|
})
|
||||||
|
|
||||||
|
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
|
||||||
|
)
|
||||||
|
})
|
||||||
|
|
||||||
|
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({
|
dat_pre <- reactive({
|
||||||
|
|
||||||
# req(input$file2)
|
# req(input$file2)
|
||||||
# Make laoding dependent of file name extension (file_ext())
|
# Make laoding dependent of file name extension (file_ext())
|
||||||
if (!is.null(input$file2$datapath)) {
|
if (!is.null(input$file2$datapath)) {
|
||||||
df <- read_input(input$file2$datapath)
|
out <- read_input(input$file2$datapath)
|
||||||
|
|
||||||
return(df)
|
|
||||||
} else {
|
} else {
|
||||||
return(NULL)
|
out <- NULL
|
||||||
}
|
}
|
||||||
|
v$pre <- "loaded"
|
||||||
|
return(out)
|
||||||
})
|
})
|
||||||
|
|
||||||
groups <-
|
groups <-
|
||||||
reactive({
|
reactive({
|
||||||
grouped <- prioritized_grouping(
|
grouped <- prioritized_grouping(
|
||||||
data = dat(),
|
data = dat_parsed(),
|
||||||
excess_space = input$excess,
|
excess_space = input$excess,
|
||||||
pre_grouped = dat_pre()
|
pre_grouped = dat_pre()
|
||||||
)
|
)
|
||||||
|
@ -417,7 +602,8 @@ server <- function(input, output, session) {
|
||||||
dplyr::case_match(input$overall.plot,
|
dplyr::case_match(input$overall.plot,
|
||||||
"yes" ~ TRUE,
|
"yes" ~ TRUE,
|
||||||
"no" ~ FALSE,
|
"no" ~ FALSE,
|
||||||
.default=NULL)
|
.default = NULL
|
||||||
|
)
|
||||||
})
|
})
|
||||||
|
|
||||||
output$raw.data.tbl <- renderTable({
|
output$raw.data.tbl <- renderTable({
|
||||||
|
@ -432,17 +618,39 @@ server <- function(input, output, session) {
|
||||||
dat()
|
dat()
|
||||||
})
|
})
|
||||||
|
|
||||||
|
output$input_parsed <- renderTable({
|
||||||
|
dat_parsed()
|
||||||
|
})
|
||||||
|
|
||||||
output$groups.plt <- renderPlot({
|
output$groups.plt <- renderPlot({
|
||||||
grouping_plot(groups(), overall = plot.overall())
|
grouping_plot(groups(), overall = plot.overall())
|
||||||
})
|
})
|
||||||
|
|
||||||
|
|
||||||
|
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)
|
||||||
|
|
||||||
# Downloadable csv of selected dataset ----
|
# Downloadable csv of selected dataset ----
|
||||||
output$downloadData <- downloadHandler(
|
output$downloadData <- downloadHandler(
|
||||||
filename = "prioritized_grouping.csv",
|
filename = "prioritized_grouping.ods",
|
||||||
|
|
||||||
content = function(file) {
|
content = function(file) {
|
||||||
write.csv(groups()$export, file, row.names = FALSE)
|
readODS::write_ods(as.data.frame(groups()$export), file)
|
||||||
}
|
}
|
||||||
)
|
)
|
||||||
|
|
||||||
}
|
}
|
||||||
|
|
123
app/server_raw.R
123
app/server_raw.R
|
@ -3,6 +3,11 @@ server <- function(input, output, session) {
|
||||||
# source("https://git.nikohuru.dk/au-phd/PhysicalActivityandStrokeOutcome/raw/branch/main/side%20projects/assignment.R")
|
# source("https://git.nikohuru.dk/au-phd/PhysicalActivityandStrokeOutcome/raw/branch/main/side%20projects/assignment.R")
|
||||||
# source(here::here("R/group_assign.R"))
|
# source(here::here("R/group_assign.R"))
|
||||||
|
|
||||||
|
v <- shiny::reactiveValues(
|
||||||
|
ds = NULL,
|
||||||
|
pre = NULL
|
||||||
|
)
|
||||||
|
|
||||||
dat <- reactive({
|
dat <- reactive({
|
||||||
# input$file1 will be NULL initially. After the user selects
|
# input$file1 will be NULL initially. After the user selects
|
||||||
# and uploads a file, head of that data file by default,
|
# and uploads a file, head of that data file by default,
|
||||||
|
@ -10,28 +15,95 @@ server <- function(input, output, session) {
|
||||||
|
|
||||||
req(input$file1)
|
req(input$file1)
|
||||||
# Make laoding dependent of file name extension (file_ext())
|
# Make laoding dependent of file name extension (file_ext())
|
||||||
df <- read_input(input$file1$datapath)
|
out <- read_input(input$file1$datapath)
|
||||||
return(df)
|
v$ds <- "loaded"
|
||||||
|
return(out)
|
||||||
|
})
|
||||||
|
|
||||||
|
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
|
||||||
|
)
|
||||||
|
})
|
||||||
|
|
||||||
|
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({
|
dat_pre <- reactive({
|
||||||
|
|
||||||
# req(input$file2)
|
# req(input$file2)
|
||||||
# Make laoding dependent of file name extension (file_ext())
|
# Make laoding dependent of file name extension (file_ext())
|
||||||
if (!is.null(input$file2$datapath)) {
|
if (!is.null(input$file2$datapath)) {
|
||||||
df <- read_input(input$file2$datapath)
|
out <- read_input(input$file2$datapath)
|
||||||
|
|
||||||
return(df)
|
|
||||||
} else {
|
} else {
|
||||||
return(NULL)
|
out <- NULL
|
||||||
}
|
}
|
||||||
|
v$pre <- "loaded"
|
||||||
|
return(out)
|
||||||
})
|
})
|
||||||
|
|
||||||
groups <-
|
groups <-
|
||||||
reactive({
|
reactive({
|
||||||
grouped <- prioritized_grouping(
|
grouped <- prioritized_grouping(
|
||||||
data = dat(),
|
data = dat_parsed(),
|
||||||
excess_space = input$excess,
|
excess_space = input$excess,
|
||||||
pre_grouped = dat_pre()
|
pre_grouped = dat_pre()
|
||||||
)
|
)
|
||||||
|
@ -43,7 +115,8 @@ server <- function(input, output, session) {
|
||||||
dplyr::case_match(input$overall.plot,
|
dplyr::case_match(input$overall.plot,
|
||||||
"yes" ~ TRUE,
|
"yes" ~ TRUE,
|
||||||
"no" ~ FALSE,
|
"no" ~ FALSE,
|
||||||
.default=NULL)
|
.default = NULL
|
||||||
|
)
|
||||||
})
|
})
|
||||||
|
|
||||||
output$raw.data.tbl <- renderTable({
|
output$raw.data.tbl <- renderTable({
|
||||||
|
@ -58,17 +131,39 @@ server <- function(input, output, session) {
|
||||||
dat()
|
dat()
|
||||||
})
|
})
|
||||||
|
|
||||||
|
output$input_parsed <- renderTable({
|
||||||
|
dat_parsed()
|
||||||
|
})
|
||||||
|
|
||||||
output$groups.plt <- renderPlot({
|
output$groups.plt <- renderPlot({
|
||||||
grouping_plot(groups(), overall = plot.overall())
|
grouping_plot(groups(), overall = plot.overall())
|
||||||
})
|
})
|
||||||
|
|
||||||
|
|
||||||
|
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)
|
||||||
|
|
||||||
# Downloadable csv of selected dataset ----
|
# Downloadable csv of selected dataset ----
|
||||||
output$downloadData <- downloadHandler(
|
output$downloadData <- downloadHandler(
|
||||||
filename = "prioritized_grouping.csv",
|
filename = "prioritized_grouping.ods",
|
||||||
|
|
||||||
content = function(file) {
|
content = function(file) {
|
||||||
write.csv(groups()$export, file, row.names = FALSE)
|
readODS::write_ods(as.data.frame(groups()$export), file)
|
||||||
}
|
}
|
||||||
)
|
)
|
||||||
|
|
||||||
}
|
}
|
||||||
|
|
204
app/ui.R
204
app/ui.R
|
@ -1,16 +1,75 @@
|
||||||
library(shiny)
|
library(shiny)
|
||||||
ui <- fluidPage(
|
library(bslib)
|
||||||
|
|
||||||
|
panels <- list(
|
||||||
|
bslib::nav_panel(
|
||||||
|
title = "Input data",
|
||||||
|
h3("Costs/priorities overview"),
|
||||||
|
htmlOutput("input", container = span),
|
||||||
|
conditionalPanel(
|
||||||
|
condition = "output.pre_assigned=='yes'",
|
||||||
|
h3("Pre-assigned groups"),
|
||||||
|
# p("Appears empty if none is uploaded."),
|
||||||
|
|
||||||
|
htmlOutput("pre.groups", container = span)
|
||||||
|
)
|
||||||
|
),
|
||||||
|
bslib::nav_panel(
|
||||||
|
title = "Parsed input",
|
||||||
|
htmlOutput("input_parsed")),
|
||||||
|
bslib::nav_panel(
|
||||||
|
title = "Summary",
|
||||||
|
shiny::plotOutput("groups.plt")
|
||||||
|
),
|
||||||
|
bslib::nav_panel(
|
||||||
|
title = "Results",
|
||||||
|
htmlOutput("raw.data.tbl", container = span)
|
||||||
|
)
|
||||||
|
)
|
||||||
|
|
||||||
|
# tabPanel(
|
||||||
|
# "Input data Results",
|
||||||
|
# h3("Costs/prioritis overview"),
|
||||||
|
#
|
||||||
|
#
|
||||||
|
# htmlOutput("input", container = span),
|
||||||
|
# conditionalPanel(
|
||||||
|
# condition = "output.preassigned=='yes'",
|
||||||
|
# h3("Pre-assigned groups"),
|
||||||
|
# # p("Appears empty if none is uploaded."),
|
||||||
|
#
|
||||||
|
# htmlOutput("pre.groups", container = span))
|
||||||
|
#
|
||||||
|
# ),
|
||||||
|
# tabPanel(
|
||||||
|
# "Summary",
|
||||||
|
# h3("Grouping plot"),
|
||||||
|
# p("These plots are to summarise simple performance meassures for the assignment.
|
||||||
|
# 'f' is group fill fraction and 'm' is mean cost in group."),
|
||||||
|
#
|
||||||
|
# plotOutput("groups.plt")
|
||||||
|
#
|
||||||
|
# ),
|
||||||
|
#
|
||||||
|
# tabPanel(
|
||||||
|
# "Results",
|
||||||
|
# h3("Raw Results"),
|
||||||
|
# p("This is identical to the downloaded file (see panel on left)"),
|
||||||
|
#
|
||||||
|
# htmlOutput("raw.data.tbl", container = span)
|
||||||
|
#
|
||||||
|
# )
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
ui <- bslib::page_sidebar(
|
||||||
|
theme = bslib::bs_theme(bootswatch = "minty"),
|
||||||
## -----------------------------------------------------------------------------
|
## -----------------------------------------------------------------------------
|
||||||
## Application title
|
## Application title
|
||||||
## -----------------------------------------------------------------------------
|
## -----------------------------------------------------------------------------
|
||||||
|
|
||||||
titlePanel("Group allocation based on individual subject prioritization.",
|
title = "Group allocation based on individual subject prioritization.",
|
||||||
windowTitle = "Prioritized grouping calculator"),
|
window_title = "Prioritized grouping calculator",
|
||||||
h5(
|
|
||||||
"Please note this calculator is only meant as a proof of concept for educational purposes,
|
|
||||||
and the author will take no responsibility for the results of the calculator.
|
|
||||||
Uploaded data is not kept, but please, do not upload any sensitive data."
|
|
||||||
),
|
|
||||||
|
|
||||||
## -----------------------------------------------------------------------------
|
## -----------------------------------------------------------------------------
|
||||||
## Side panel
|
## Side panel
|
||||||
|
@ -20,18 +79,14 @@ ui <- fluidPage(
|
||||||
## -----------------------------------------------------------------------------
|
## -----------------------------------------------------------------------------
|
||||||
## Single entry
|
## Single entry
|
||||||
## -----------------------------------------------------------------------------
|
## -----------------------------------------------------------------------------
|
||||||
sidebarLayout(
|
sidebar = bslib::sidebar(
|
||||||
sidebarPanel(
|
open = "open",
|
||||||
numericInput(
|
p(
|
||||||
inputId = "excess",
|
"Please note this calculator is only meant as a proof of concept for educational purposes,
|
||||||
label = "Excess space (%)",
|
and the author will take no responsibility for the results of the calculator.
|
||||||
value = 20,
|
Uploaded data is not kept, but please, do not upload any sensitive data."
|
||||||
step = 5
|
|
||||||
),
|
),
|
||||||
p("As default, the program will try to evenly distribute subjects in groups.
|
a(href = "https://git.nikohuru.dk/au-phd/PhysicalActivityandStrokeOutcome/src/branch/main/apps/Assignment", "Source", target = "_blank"),
|
||||||
This factor will add more capacity to each group, for an overall lesser cost,
|
|
||||||
but more uneven group numbers. More adjustments can be performed with the source script."),
|
|
||||||
a(href='https://git.nikohuru.dk/au-phd/PhysicalActivityandStrokeOutcome/src/branch/main/apps/Assignment', "Source", target="_blank"),
|
|
||||||
## -----------------------------------------------------------------------------
|
## -----------------------------------------------------------------------------
|
||||||
## File upload
|
## File upload
|
||||||
## -----------------------------------------------------------------------------
|
## -----------------------------------------------------------------------------
|
||||||
|
@ -48,10 +103,46 @@ ui <- fluidPage(
|
||||||
),
|
),
|
||||||
strong("Columns: ID, group1, group2, ... groupN."),
|
strong("Columns: ID, group1, group2, ... groupN."),
|
||||||
strong("NOTE: 0s will be interpreted as lowest score."),
|
strong("NOTE: 0s will be interpreted as lowest score."),
|
||||||
p("Cells should contain cost/priorities.
|
# p("Cells should contain cost/priorities.
|
||||||
Lowest score, for highest priority.
|
# Lowest score, for highest priority.
|
||||||
Non-ranked should contain a number (eg lowest score+1).
|
# Non-ranked should contain a number (eg lowest score+1).
|
||||||
Will handle missings but try to avoid."),
|
# Will handle missings but try to avoid."),
|
||||||
|
shiny::conditionalPanel(
|
||||||
|
condition = "output.uploaded=='yes'",
|
||||||
|
numericInput(
|
||||||
|
inputId = "excess",
|
||||||
|
label = "Excess space (%)",
|
||||||
|
value = 20,
|
||||||
|
step = 5
|
||||||
|
),
|
||||||
|
p("As default, the program will try to evenly distribute subjects in groups.
|
||||||
|
This factor will add more capacity to each group, for an overall lesser cost,
|
||||||
|
but more uneven group numbers. More adjustments can be performed with the source script."),
|
||||||
|
shiny::radioButtons(
|
||||||
|
inputId = "input_type",
|
||||||
|
label = "Data input type",
|
||||||
|
selected = "default",
|
||||||
|
choices = list(
|
||||||
|
"Columns of groups" = "default",
|
||||||
|
"Columns of priorities (Google)" = "prio",
|
||||||
|
"Column of strings (Microsoft)" = "string"
|
||||||
|
)
|
||||||
|
),
|
||||||
|
shiny::conditionalPanel(
|
||||||
|
condition = "input.input_type=='prio'",
|
||||||
|
uiOutput("id_var_prio"),
|
||||||
|
uiOutput("prio_vars")
|
||||||
|
),
|
||||||
|
shiny::conditionalPanel(
|
||||||
|
condition = "input.input_type=='string'",
|
||||||
|
uiOutput("id_var_string"),
|
||||||
|
uiOutput("string_var"),
|
||||||
|
shiny::textInput(
|
||||||
|
inputId = "string_split",
|
||||||
|
label = "Pattern to split string",
|
||||||
|
value = ";"
|
||||||
|
)
|
||||||
|
),
|
||||||
shiny::radioButtons(
|
shiny::radioButtons(
|
||||||
inputId = "overall.plot",
|
inputId = "overall.plot",
|
||||||
label = "Print overall mean grouping priorities/costs only?",
|
label = "Print overall mean grouping priorities/costs only?",
|
||||||
|
@ -61,8 +152,17 @@ ui <- fluidPage(
|
||||||
"No" = "no"
|
"No" = "no"
|
||||||
)
|
)
|
||||||
),
|
),
|
||||||
|
shiny::radioButtons(
|
||||||
|
inputId = "pre_assign",
|
||||||
|
label = "Add pre-assigned grouping (paedagogical return)?",
|
||||||
|
selected = "no",
|
||||||
|
choices = list(
|
||||||
|
"Yes" = "yes",
|
||||||
|
"No" = "no"
|
||||||
|
)
|
||||||
|
),
|
||||||
|
shiny::conditionalPanel(
|
||||||
|
condition = "input.pre_assign=='yes'",
|
||||||
fileInput(
|
fileInput(
|
||||||
inputId = "file2",
|
inputId = "file2",
|
||||||
label = "Choose data file for pre-assigned subjects",
|
label = "Choose data file for pre-assigned subjects",
|
||||||
|
@ -71,61 +171,25 @@ ui <- fluidPage(
|
||||||
".csv", ".xls", ".xlsx"
|
".csv", ".xls", ".xlsx"
|
||||||
)
|
)
|
||||||
),
|
),
|
||||||
h6("Columns: ID, group"),
|
h6("Columns: ID, group")
|
||||||
|
),
|
||||||
|
|
||||||
|
|
||||||
## -----------------------------------------------------------------------------
|
## -----------------------------------------------------------------------------
|
||||||
## Download output
|
## Download output
|
||||||
## -----------------------------------------------------------------------------
|
## -----------------------------------------------------------------------------
|
||||||
|
|
||||||
# Horizontal line ----
|
# Horizontal line ----
|
||||||
tags$hr(),
|
tags$hr(),
|
||||||
|
|
||||||
h4("Download results"),
|
h4("Download results"),
|
||||||
|
|
||||||
# Button
|
# Button
|
||||||
downloadButton("downloadData", "Download")
|
downloadButton("downloadData", "Download")
|
||||||
),
|
|
||||||
|
|
||||||
mainPanel(tabsetPanel(
|
|
||||||
## -----------------------------------------------------------------------------
|
|
||||||
## Plot tab
|
|
||||||
## -----------------------------------------------------------------------------
|
|
||||||
|
|
||||||
tabPanel(
|
|
||||||
"Summary",
|
|
||||||
h3("Grouping plot"),
|
|
||||||
p("These plots are to summarise simple performance meassures for the assignment.
|
|
||||||
'f' is group fill fraction and 'm' is mean cost in group."),
|
|
||||||
|
|
||||||
plotOutput("groups.plt")
|
|
||||||
|
|
||||||
),
|
|
||||||
|
|
||||||
tabPanel(
|
|
||||||
"Results",
|
|
||||||
h3("Raw Results"),
|
|
||||||
p("This is identical to the downloaded file (see panel on left)"),
|
|
||||||
|
|
||||||
htmlOutput("raw.data.tbl", container = span)
|
|
||||||
|
|
||||||
),
|
|
||||||
|
|
||||||
tabPanel(
|
|
||||||
"Input data Results",
|
|
||||||
h3("Costs/prioritis overview"),
|
|
||||||
|
|
||||||
|
|
||||||
htmlOutput("input", container = span),
|
|
||||||
|
|
||||||
h3("Pre-assigned groups"),
|
|
||||||
p("Appears empty if none is uploaded."),
|
|
||||||
|
|
||||||
htmlOutput("pre.groups", container = span)
|
|
||||||
|
|
||||||
)
|
)
|
||||||
|
),
|
||||||
))
|
bslib::navset_card_underline(
|
||||||
|
title = "Data and results",
|
||||||
|
panels[[1]],
|
||||||
|
panels[[2]],
|
||||||
|
panels[[3]],
|
||||||
|
panels[[4]]
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
|
|
24
man/parse_prio_form.Rd
Normal file
24
man/parse_prio_form.Rd
Normal file
|
@ -0,0 +1,24 @@
|
||||||
|
% Generated by roxygen2: do not edit by hand
|
||||||
|
% Please edit documentation in R/parse_formats.R
|
||||||
|
\name{parse_prio_form}
|
||||||
|
\alias{parse_prio_form}
|
||||||
|
\title{Parse input data with columns of priorities to columns of groups}
|
||||||
|
\usage{
|
||||||
|
parse_prio_form(data, id = 1, prio.cols, sort.cols = FALSE)
|
||||||
|
}
|
||||||
|
\arguments{
|
||||||
|
\item{data}{data.frame or tibble}
|
||||||
|
|
||||||
|
\item{id}{id column. Numeric index or column name. Default is 1.}
|
||||||
|
|
||||||
|
\item{prio.cols}{priority columns. Numeric indices or column names.}
|
||||||
|
|
||||||
|
\item{sort.cols}{flag to sort priority columns names/indices. Default=FALSE}
|
||||||
|
}
|
||||||
|
\value{
|
||||||
|
data.frame
|
||||||
|
}
|
||||||
|
\description{
|
||||||
|
This handles transforming data from a typical Google form to the format
|
||||||
|
compatible with \code{prioritized_grouping()}.
|
||||||
|
}
|
26
man/parse_string_form.Rd
Normal file
26
man/parse_string_form.Rd
Normal file
|
@ -0,0 +1,26 @@
|
||||||
|
% Generated by roxygen2: do not edit by hand
|
||||||
|
% Please edit documentation in R/parse_formats.R
|
||||||
|
\name{parse_string_form}
|
||||||
|
\alias{parse_string_form}
|
||||||
|
\title{Parse input data from column of strings with prioritised group names}
|
||||||
|
\usage{
|
||||||
|
parse_string_form(data, id = 1, string.col, pattern = NULL)
|
||||||
|
}
|
||||||
|
\arguments{
|
||||||
|
\item{data}{data.frame or tibble}
|
||||||
|
|
||||||
|
\item{id}{id column. Numeric index of column name. Default is 1.}
|
||||||
|
|
||||||
|
\item{string.col}{string column. Numeric index or column name.}
|
||||||
|
|
||||||
|
\item{pattern}{regex pattern to use for splitting priorities string with
|
||||||
|
\code{strsplit()}.
|
||||||
|
Default is ";".}
|
||||||
|
}
|
||||||
|
\value{
|
||||||
|
data.frame
|
||||||
|
}
|
||||||
|
\description{
|
||||||
|
This handles transforming data from a typical Microsoft form to the format
|
||||||
|
compatible with \code{prioritized_grouping()}.
|
||||||
|
}
|
|
@ -13,7 +13,7 @@ prioritized_grouping(
|
||||||
)
|
)
|
||||||
}
|
}
|
||||||
\arguments{
|
\arguments{
|
||||||
\item{data}{data set in wide format. First column should bi ID, then one column
|
\item{data}{data set in wide format. First column should be ID, then one column
|
||||||
for each group containing cost/priorities.}
|
for each group containing cost/priorities.}
|
||||||
|
|
||||||
\item{cap_classes}{class capacity. Numeric vector length 1 or length=number
|
\item{cap_classes}{class capacity. Numeric vector length 1 or length=number
|
||||||
|
|
Loading…
Add table
Reference in a new issue