RSymphony is not ported to webR. Will not run. Will come back.

DESCRIPTION

@@ -24,7 +24,8 @@ Imports:
     httpuv,
     here,
     shiny,
-    cpp11
+    cpp11,
+    ROI.plugin.alabama
 Suggests:
     pak,
     usethis

R/group_assign.R

@@ -1,8 +1,23 @@
+#' Solve group assignment based on
+#'
+#' @param ds data set
+#' @param cap_classes class capacity. Numeric vector length 1 or length=number
+#' of groups. If NULL equal group sizes are calculated. Default is NULL.
+#' @param excess_space allowed excess group fill. Default is 1.2.
+#' @param pre_assign Pre assigned data set. Optional.
+#' @param set_solver choose the desired solver (originally "symphony").
+#'
+#' @return
+#' @export
+#'
+#' @examples
+#' read.csv(here::here("data/assign_sample.csv")) |> group_assignment()
 group_assignment <-
   function(ds,
            cap_classes = NULL,
-           excess_space = NULL,
+           excess_space = 1.2,
-           pre_assign = NULL) {
+           pre_assign = NULL,
+           set_solver="symphony") {
     require(ROI)
     require(ROI.plugin.symphony)
 
@@ -21,11 +36,7 @@ group_assignment <-
     ## Adding the option to introduce a bit of head room to the classes by
     ## the groups to a little bigger than the smallest possible
     ## Default is to allow for an extra 20 % fill
-    if (is.null(excess_space)) {
-      excess <- 1.2
-    } else {
     excess <- excess_space
-    }
 
     # generous round up of capacities
     if (is.null(cap_classes)) {
@@ -66,16 +77,16 @@ group_assignment <-
     i_m <- seq_len(num_groups)
     j_m <- seq_len(num_sub)
 
-    m <- ompr::MIPModel() %>%
+    m <- ompr::MIPModel() |>
       ompr::add_variable(grp[i, j],
                    i = i_m,
                    j = j_m,
-                   type = "binary") %>%
+                   type = "binary") |>
       ## The first constraint says that group size should not exceed capacity
       ompr::add_constraint(ompr::sum_expr(grp[i, j], j = j_m) <= capacity[i],
-                     i = i_m) %>%
+                     i = i_m) |>
       ## The second constraint says each subject can only be in one group
-      ompr::add_constraint(ompr::sum_expr(grp[i, j], i = i_m) == 1, j = j_m) %>%
+      ompr::add_constraint(ompr::sum_expr(grp[i, j], i = i_m) == 1, j = j_m) |>
       ## The objective is set to minimize the cost of the assignments
       ## Giving subjects the group with the highest possible ranking
       ompr::set_objective(ompr::sum_expr(
@@ -83,13 +94,14 @@ group_assignment <-
         i = i_m,
         j = j_m
       ),
-      "min") %>%
+      "min") |>
-      ompr::solve_model(ompr.roi::with_ROI(solver = "symphony", verbosity = 1))
+      # ompr::solve_model(ompr.roi::with_ROI(solver = "symphony", verbosity = 1))
+      ompr::solve_model(ompr.roi::with_ROI(solver = set_solver, verbosity = 1))
 
     ## Getting assignments
-    solution <- ompr::get_solution(m, grp[i, j]) %>% filter(value > 0)
+    solution <- ompr::get_solution(m, grp[i, j]) |> dplyr::filter(value > 0)
 
-    assign <- solution |> select(i,j)
+    assign <- solution |> dplyr::select(i,j)
 
     if (!is.null(rownames(cost))){
       assign$i <- rownames(cost)[assign$i]

R/server.R

@@ -1,19 +1,9 @@
+library(shiny)
 server <- function(input, output, session) {
-  library(dplyr)
-  library(tidyr)
-  library(ROI)
-  library(ROI.plugin.symphony)
-  library(ompr)
-  library(ompr.roi)
-  library(magrittr)
-  library(ggplot2)
-  library(viridisLite)
-  library(patchwork)
-  library(openxlsx)
   # source("https://git.nikohuru.dk/au-phd/PhysicalActivityandStrokeOutcome/raw/branch/main/side%20projects/assignment.R")
   source(here::here("R/group_assign.R"))
 
-  dat <- shiny::reactive({
+  dat <- reactive({
     # 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.
@@ -22,6 +12,8 @@ server <- function(input, output, session) {
     # Make laoding dependent of file name extension (file_ext())
     ext <- file_extension(input$file1$datapath)
 
+    tryCatch(
+      {
         if (ext == "csv") {
           df <- read.csv(input$file1$datapath,na.strings = c("NA", '""',""))
         } else if (ext %in% c("xls", "xlsx")) {
@@ -30,11 +22,17 @@ server <- function(input, output, session) {
         } else {
           stop("Input file format has to be either '.csv', '.xls' or '.xlsx'")
         }
+      },
+      error = function(e) {
+        # return a safeError if a parsing error occurs
+        stop(safeError(e))
+      }
+    )
 
     return(df)
   })
 
-  dat_pre <- shiny::reactive({
+  dat_pre <- reactive({
 
     # req(input$file2)
     # Make laoding dependent of file name extension (file_ext())
@@ -58,7 +56,7 @@ server <- function(input, output, session) {
   })
 
   assign <-
-    shiny::reactive({
+    reactive({
       assigned <- group_assignment(
         ds = dat(),
         excess_space = input$ecxess,
@@ -68,24 +66,24 @@ server <- function(input, output, session) {
     })
 
 
-  output$raw.data.tbl <- shiny::renderTable({
+  output$raw.data.tbl <- renderTable({
     assign()$export
   })
 
-  output$pre.assign <- shiny::renderTable({
+  output$pre.assign <- renderTable({
     dat_pre()
   })
 
-  output$input <- shiny::renderTable({
+  output$input <- renderTable({
     dat()
   })
 
-  output$assign.plt <- shiny::renderPlot({
+  output$assign.plt <- renderPlot({
     assignment_plot(assign())
   })
 
   # Downloadable csv of selected dataset ----
-  output$downloadData <- shiny::downloadHandler(
+  output$downloadData <- downloadHandler(
     filename = "group_assignment.csv",
 
     content = function(file) {

R/ui.R

@@ -1,11 +1,12 @@
-ui <- shiny::fluidPage(
+library(shiny)
+ui <- fluidPage(
   ## -----------------------------------------------------------------------------
   ## Application title
   ## -----------------------------------------------------------------------------
 
-  shiny::titlePanel("Assign groups based on costs/priorities.",
+  titlePanel("Assign groups based on costs/priorities.",
              windowTitle = "Group assignment calculator"),
-  shiny::h5(
+  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."
@@ -19,25 +20,25 @@ ui <- shiny::fluidPage(
   ## -----------------------------------------------------------------------------
   ## Single entry
   ## -----------------------------------------------------------------------------
-  shiny::sidebarLayout(
+  sidebarLayout(
-    shiny::sidebarPanel(
+    sidebarPanel(
-      shiny::numericInput(
+      numericInput(
         inputId = "ecxess",
         label = "Excess space",
         value = 1,
         step = .05
       ),
-      shiny::p("As default, the program will try to evenly distribute subjects in groups. 
+      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::a(href='https://git.nikohuru.dk/au-phd/PhysicalActivityandStrokeOutcome/src/branch/main/apps/Assignment', "Source", target="_blank"),
+      a(href='https://git.nikohuru.dk/au-phd/PhysicalActivityandStrokeOutcome/src/branch/main/apps/Assignment', "Source", target="_blank"),
       ## -----------------------------------------------------------------------------
       ## File upload
       ## -----------------------------------------------------------------------------
 
       # Input: Select a file ----
 
-      shiny::fileInput(
+      fileInput(
         inputId = "file1",
         label = "Choose main data file",
         multiple = FALSE,
@@ -45,14 +46,14 @@ ui <- shiny::fluidPage(
           ".csv",".xls",".xlsx"
         )
       ),
-      shiny::strong("Columns: ID, group1, group2, ... groupN."),
+      strong("Columns: ID, group1, group2, ... groupN."),
-      shiny::strong("NOTE: 0s will be interpreted as lowest score."),
+      strong("NOTE: 0s will be interpreted as lowest score."),
-      shiny::p("Cells should contain cost/priorities.
+      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::fileInput(
+      fileInput(
         inputId = "file2",
         label = "Choose data file for pre-assigned subjects",
         multiple = FALSE,
@@ -60,7 +61,7 @@ ui <- shiny::fluidPage(
           ".csv",".xls",".xlsx"
         )
       ),
-      shiny::h6("Columns: ID, group"),
+      h6("Columns: ID, group"),
 
 
 
@@ -71,47 +72,47 @@ ui <- shiny::fluidPage(
       # Horizontal line ----
       tags$hr(),
 
-      shiny::h4("Download results"),
+      h4("Download results"),
 
       # Button
-      shiny::downloadButton("downloadData", "Download")
+      downloadButton("downloadData", "Download")
     ),
 
-    shiny::mainPanel(shiny::tabsetPanel(
+    mainPanel(tabsetPanel(
       ## -----------------------------------------------------------------------------
       ## Plot tab
       ## -----------------------------------------------------------------------------
 
-      shiny::tabPanel(
+      tabPanel(
         "Summary",
-        shiny::h3("Assignment plot"),
+        h3("Assignment plot"),
-        shiny::p("These plots are to summarise simple performance meassures for the assignment. 
+        p("These plots are to summarise simple performance meassures for the assignment.
           'f' is group fill fraction and 'm' is mean cost in group."),
 
-        shiny::plotOutput("assign.plt")
+        plotOutput("assign.plt")
 
       ),
 
-      shiny::tabPanel(
+      tabPanel(
         "Results",
-        shiny::h3("Raw Results"),
+        h3("Raw Results"),
-        shiny::p("This is identical to the downloaded file (see panel on left)"),
+        p("This is identical to the downloaded file (see panel on left)"),
 
-        shiny::htmlOutput("raw.data.tbl", container = span)
+        htmlOutput("raw.data.tbl", container = span)
 
       ),
 
-      shiny::tabPanel(
+      tabPanel(
         "Input data Results",
-        shiny::h3("Costs/prioritis overview"),
+        h3("Costs/prioritis overview"),
 
 
-        shiny::htmlOutput("input", container = span),
+        htmlOutput("input", container = span),
 
-        shiny::h3("Pre-assigned groups"),
+        h3("Pre-assigned groups"),
-        shiny::p("Appears empty if none is uploaded."),
+        p("Appears empty if none is uploaded."),
 
-        shiny::htmlOutput("pre.assign", container = span)
+        htmlOutput("pre.assign", container = span)
 
       )
 

README.md

@@ -5,4 +5,10 @@ Reviving an old project to use shinylive with R
 
 ## Shortcoming
 
-This will only deploy a static site. No uploaded file processing is available apparently. Looking forward to developments.
+This project requires ROI.plugin.symphony to solve the problem, which depends on the RSymphony project (which again adapts SYMPHONY MILP), which is not [compiled for webR](https://repo.r-wasm.org/).
+
+Clone the project and run the solver with
+```
+shiny::runApp(appDir = here::here("R/"),launch.browser = TRUE)
+```
+

renv.lock

@@ -76,6 +76,20 @@
       ],
       "Hash": "42ce9ee4c1cf168869f4386d2cdeadd2"
     },
+    "ROI.plugin.alabama": {
+      "Package": "ROI.plugin.alabama",
+      "Version": "1.0-2",
+      "Source": "Repository",
+      "Repository": "CRAN",
+      "Requirements": [
+        "ROI",
+        "alabama",
+        "methods",
+        "stats",
+        "utils"
+      ],
+      "Hash": "097f1b625baf91f0d8999a1385054250"
+    },
     "ROI.plugin.symphony": {
       "Package": "ROI.plugin.symphony",
       "Version": "1.0-0",
@@ -110,6 +124,17 @@
       ],
       "Hash": "3f55239fe534fe91e739c77d99a4ffbf"
     },
+    "alabama": {
+      "Package": "alabama",
+      "Version": "2023.1.0",
+      "Source": "Repository",
+      "Repository": "CRAN",
+      "Requirements": [
+        "R",
+        "numDeriv"
+      ],
+      "Hash": "593db7eb170506e6b61ca0c803201924"
+    },
     "archive": {
       "Package": "archive",
       "Version": "1.1.7",
@@ -692,6 +717,16 @@
       ],
       "Hash": "a623a2239e642806158bc4dc3f51565d"
     },
+    "numDeriv": {
+      "Package": "numDeriv",
+      "Version": "2016.8-1.1",
+      "Source": "Repository",
+      "Repository": "RSPM",
+      "Requirements": [
+        "R"
+      ],
+      "Hash": "df58958f293b166e4ab885ebcad90e02"
+    },
     "ompr": {
       "Package": "ompr",
       "Version": "1.0.4",

shinylive init.R

@@ -1,3 +1,8 @@
-shinylive::export("R", "docs")
+# Typical shiny
+shiny::runApp(appDir = here::here("R/"),launch.browser = TRUE)
 
-httpuv::runStaticServer("docs")
+
+# Shinylive version
+shinylive::export(appdir = "R", destdir = "docs")
+
+httpuv::runStaticServer(dir = "docs")