parsing of different form formats, move to bslib with new sidebar

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)
     }
   )
-
 }

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)
     }
   )
-
 }

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]]
   )
 )