From a576a580db824d05760a36afd2f97836429f6d8d Mon Sep 17 00:00:00 2001 From: Andreas Gammelgaard Damsbo Date: Thu, 14 Nov 2024 14:29:46 +0100 Subject: [PATCH] parsing of different form formats, move to bslib with new sidebar --- .Rbuildignore | 1 + .gitignore | 1 + NAMESPACE | 2 + NEWS.md | 16 ++- R/parse_formats.R | 101 +++++++++++++++ R/prioritized_grouping.R | 8 +- app/server.R | 246 +++++++++++++++++++++++++++++++++--- app/server_raw.R | 133 ++++++++++++++++--- app/ui.R | 230 +++++++++++++++++++++------------ man/parse_prio_form.Rd | 24 ++++ man/parse_string_form.Rd | 26 ++++ man/prioritized_grouping.Rd | 2 +- 12 files changed, 666 insertions(+), 124 deletions(-) create mode 100644 R/parse_formats.R create mode 100644 man/parse_prio_form.Rd create mode 100644 man/parse_string_form.Rd diff --git a/.Rbuildignore b/.Rbuildignore index dec0635..8ad0b45 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -13,3 +13,4 @@ ^\.github$ ^data/prioritized_sample\.xlsx$ ^sample_data$ +^drafting$ diff --git a/.gitignore b/.gitignore index cb68314..be7e7fe 100644 --- a/.gitignore +++ b/.gitignore @@ -8,3 +8,4 @@ docs data/prioritized_sample.xlsx sample_data app/rsconnect +drafting diff --git a/NAMESPACE b/NAMESPACE index b7905eb..71eabd0 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -3,5 +3,7 @@ S3method(plot,prioritized_groups_list) export(file_extension) export(grouping_plot) +export(parse_prio_form) +export(parse_string_form) export(prioritized_grouping) export(read_input) diff --git a/NEWS.md b/NEWS.md index ab3e4b1..6a04cc6 100644 --- a/NEWS.md +++ b/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 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 -`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. File types accepted in the shiny-app are .csv, .xls(x) and .ods. diff --git a/R/parse_formats.R b/R/parse_formats.R new file mode 100644 index 0000000..72559ae --- /dev/null +++ b/R/parse_formats.R @@ -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]))] +} diff --git a/R/prioritized_grouping.R b/R/prioritized_grouping.R index cd96070..522f315 100644 --- a/R/prioritized_grouping.R +++ b/R/prioritized_grouping.R @@ -2,7 +2,7 @@ utils::globalVariables(c("group", "grp", "i", "j", "value")) #' 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. #' @param cap_classes class capacity. Numeric vector length 1 or length=number #' of groups. If NULL equal group sizes are calculated. Default is NULL. @@ -39,6 +39,11 @@ prioritized_grouping <- 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 cost <- t(data[, -1]) # Transpose converts to matrix colnames(cost) <- data[, 1] @@ -360,3 +365,4 @@ read_input <- function(file, consider.na = c("NA", '""', "")) { df } + diff --git a/app/server.R b/app/server.R index f9e63c8..f66be66 100644 --- a/app/server.R +++ b/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 ######## @@ -45,6 +152,11 @@ prioritized_grouping <- 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 cost <- t(data[, -1]) # Transpose converts to matrix colnames(cost) <- data[, 1] @@ -368,6 +480,7 @@ read_input <- function(file, consider.na = c("NA", '""', "")) { } + ######## #### 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(here::here("R/group_assign.R")) + v <- shiny::reactiveValues( + ds = NULL, + pre = NULL + ) + dat <- reactive({ # input$file1 will be NULL initially. After the user selects # and uploads a file, head of that data file by default, @@ -384,28 +502,95 @@ server <- function(input, output, session) { req(input$file1) # Make laoding dependent of file name extension (file_ext()) - df <- read_input(input$file1$datapath) - return(df) + out <- read_input(input$file1$datapath) + 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({ - # req(input$file2) # Make laoding dependent of file name extension (file_ext()) - if (!is.null(input$file2$datapath)){ - df <- read_input(input$file2$datapath) - - return(df) + if (!is.null(input$file2$datapath)) { + out <- read_input(input$file2$datapath) } else { - return(NULL) + out <- NULL } - + v$pre <- "loaded" + return(out) }) groups <- reactive({ grouped <- prioritized_grouping( - data = dat(), + data = dat_parsed(), excess_space = input$excess, pre_grouped = dat_pre() ) @@ -415,9 +600,10 @@ server <- function(input, output, session) { plot.overall <- reactive({ dplyr::case_match(input$overall.plot, - "yes"~TRUE, - "no"~FALSE, - .default=NULL) + "yes" ~ TRUE, + "no" ~ FALSE, + .default = NULL + ) }) output$raw.data.tbl <- renderTable({ @@ -432,17 +618,39 @@ server <- function(input, output, session) { dat() }) - output$groups.plt <- renderPlot({ - grouping_plot(groups(),overall = plot.overall()) + output$input_parsed <- renderTable({ + dat_parsed() }) + output$groups.plt <- renderPlot({ + 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 ---- output$downloadData <- downloadHandler( - filename = "prioritized_grouping.csv", - + filename = "prioritized_grouping.ods", content = function(file) { - write.csv(groups()$export, file, row.names = FALSE) + readODS::write_ods(as.data.frame(groups()$export), file) } ) - } diff --git a/app/server_raw.R b/app/server_raw.R index e32eb03..2b9fd8d 100644 --- a/app/server_raw.R +++ b/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(here::here("R/group_assign.R")) + v <- shiny::reactiveValues( + ds = NULL, + pre = NULL + ) + dat <- reactive({ # input$file1 will be NULL initially. After the user selects # and uploads a file, head of that data file by default, @@ -10,28 +15,95 @@ server <- function(input, output, session) { req(input$file1) # Make laoding dependent of file name extension (file_ext()) - df <- read_input(input$file1$datapath) - return(df) + out <- read_input(input$file1$datapath) + 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({ - # req(input$file2) # Make laoding dependent of file name extension (file_ext()) - if (!is.null(input$file2$datapath)){ - df <- read_input(input$file2$datapath) - - return(df) + if (!is.null(input$file2$datapath)) { + out <- read_input(input$file2$datapath) } else { - return(NULL) + out <- NULL } - + v$pre <- "loaded" + return(out) }) groups <- reactive({ grouped <- prioritized_grouping( - data = dat(), + data = dat_parsed(), excess_space = input$excess, pre_grouped = dat_pre() ) @@ -41,9 +113,10 @@ server <- function(input, output, session) { plot.overall <- reactive({ dplyr::case_match(input$overall.plot, - "yes"~TRUE, - "no"~FALSE, - .default=NULL) + "yes" ~ TRUE, + "no" ~ FALSE, + .default = NULL + ) }) output$raw.data.tbl <- renderTable({ @@ -58,17 +131,39 @@ server <- function(input, output, session) { dat() }) - output$groups.plt <- renderPlot({ - grouping_plot(groups(),overall = plot.overall()) + output$input_parsed <- renderTable({ + dat_parsed() }) + output$groups.plt <- renderPlot({ + 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 ---- output$downloadData <- downloadHandler( - filename = "prioritized_grouping.csv", - + filename = "prioritized_grouping.ods", content = function(file) { - write.csv(groups()$export, file, row.names = FALSE) + readODS::write_ods(as.data.frame(groups()$export), file) } ) - } diff --git a/app/ui.R b/app/ui.R index 9e62afe..6cf3442 100644 --- a/app/ui.R +++ b/app/ui.R @@ -1,16 +1,75 @@ 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 ## ----------------------------------------------------------------------------- - titlePanel("Group allocation based on individual subject prioritization.", - windowTitle = "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." - ), + title = "Group allocation based on individual subject prioritization.", + window_title = "Prioritized grouping calculator", ## ----------------------------------------------------------------------------- ## Side panel @@ -20,8 +79,36 @@ ui <- fluidPage( ## ----------------------------------------------------------------------------- ## Single entry ## ----------------------------------------------------------------------------- - sidebarLayout( - sidebarPanel( + sidebar = bslib::sidebar( + open = "open", + p( + "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." + ), + a(href = "https://git.nikohuru.dk/au-phd/PhysicalActivityandStrokeOutcome/src/branch/main/apps/Assignment", "Source", target = "_blank"), + ## ----------------------------------------------------------------------------- + ## File upload + ## ----------------------------------------------------------------------------- + + # Input: Select a file ---- + + fileInput( + inputId = "file1", + label = "Choose main data file", + multiple = FALSE, + accept = c( + ".csv", ".xls", ".xlsx", ".ods" + ) + ), + strong("Columns: ID, group1, group2, ... groupN."), + strong("NOTE: 0s will be interpreted as lowest score."), + # p("Cells should contain cost/priorities. + # Lowest score, for highest priority. + # Non-ranked should contain a number (eg lowest score+1). + # Will handle missings but try to avoid."), + shiny::conditionalPanel( + condition = "output.uploaded=='yes'", numericInput( inputId = "excess", label = "Excess space (%)", @@ -31,27 +118,31 @@ ui <- fluidPage( 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."), - a(href='https://git.nikohuru.dk/au-phd/PhysicalActivityandStrokeOutcome/src/branch/main/apps/Assignment', "Source", target="_blank"), - ## ----------------------------------------------------------------------------- - ## File upload - ## ----------------------------------------------------------------------------- - - # Input: Select a file ---- - - fileInput( - inputId = "file1", - label = "Choose main data file", - multiple = FALSE, - accept = c( - ".csv",".xls",".xlsx", ".ods" + 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 = ";" ) ), - strong("Columns: ID, group1, group2, ... groupN."), - strong("NOTE: 0s will be interpreted as lowest score."), - p("Cells should contain cost/priorities. - Lowest score, for highest priority. - Non-ranked should contain a number (eg lowest score+1). - Will handle missings but try to avoid."), shiny::radioButtons( inputId = "overall.plot", label = "Print overall mean grouping priorities/costs only?", @@ -61,71 +152,44 @@ ui <- fluidPage( "No" = "no" ) ), - - - fileInput( - inputId = "file2", - label = "Choose data file for pre-assigned subjects", - multiple = FALSE, - accept = c( - ".csv",".xls",".xlsx" + shiny::radioButtons( + inputId = "pre_assign", + label = "Add pre-assigned grouping (paedagogical return)?", + selected = "no", + choices = list( + "Yes" = "yes", + "No" = "no" ) ), - h6("Columns: ID, group"), - - - + shiny::conditionalPanel( + condition = "input.pre_assign=='yes'", + fileInput( + inputId = "file2", + label = "Choose data file for pre-assigned subjects", + multiple = FALSE, + accept = c( + ".csv", ".xls", ".xlsx" + ) + ), + h6("Columns: ID, group") + ), ## ----------------------------------------------------------------------------- ## Download output ## ----------------------------------------------------------------------------- # Horizontal line ---- tags$hr(), - h4("Download results"), # Button 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]] ) ) diff --git a/man/parse_prio_form.Rd b/man/parse_prio_form.Rd new file mode 100644 index 0000000..6153a79 --- /dev/null +++ b/man/parse_prio_form.Rd @@ -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()}. +} diff --git a/man/parse_string_form.Rd b/man/parse_string_form.Rd new file mode 100644 index 0000000..7566af9 --- /dev/null +++ b/man/parse_string_form.Rd @@ -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()}. +} diff --git a/man/prioritized_grouping.Rd b/man/prioritized_grouping.Rd index b9d2780..2056b30 100644 --- a/man/prioritized_grouping.Rd +++ b/man/prioritized_grouping.Rd @@ -13,7 +13,7 @@ prioritized_grouping( ) } \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.} \item{cap_classes}{class capacity. Numeric vector length 1 or length=number