feat(info): add summary table for cost and duration

close #48
timflutre · Oct 23, 2024 · 991cce5 · 991cce5
1 parent 1a3e6af
commit 991cce5
Show file tree

Hide file tree

Showing 4 changed files with 87 additions and 12 deletions.
diff --git a/server.R b/server.R
@@ -65,4 +65,19 @@ shinyServer(function(input, output, session) {
   source("src/server/server_admin.R", local = TRUE, encoding = "UTF-8")$value
   source("src/server/server_about.R", local = TRUE, encoding = "UTF-8")$value
   source("src/server/server_constants.R", local = TRUE, encoding = "UTF-8")$value
+
+  # some reactive values used at different places:
+  constantsReactive <- reactivePoll(
+    5000,
+    session,
+    function() {
+      if (file.exists(DATA_DB)) {
+        file.info(DATA_DB)$mtime[1]
+      } else {
+        ""
+      }
+    },
+    getBreedingGameConstants
+  )
+
 })
diff --git a/src/server/server_constants.R b/src/server/server_constants.R
@@ -1,15 +1,3 @@
-constantsReactive <- reactivePoll(
-  5000,
-  session,
-  function() {
-    if (file.exists(DATA_DB)) {
-      file.info(DATA_DB)$mtime[1]
-    } else {
-      ""
-    }
-  },
-  getBreedingGameConstants
-)
 
 # Information page: ("How to play?")
 constants_server("chr.length.Mb", constantsReactive)("info_chr.length.Mb")

diff --git a/src/server/server_information.R b/src/server/server_information.R
@@ -30,6 +30,75 @@ output$dwnlIniData <- downloadHandler(
   }
 )
 
+output$costSummaryTable <- renderUI({
+
+  c <- constantsReactive()
+
+  costAllof <- format(c$cost.allof * c$cost.pheno.field, digits = 2)
+  costAutof <- format(c$cost.autof * c$cost.pheno.field, digits = 2)
+  costHaplo <- format(c$cost.haplodiplo * c$cost.pheno.field, digits = 2)
+
+  costGenoHD <- format(c$cost.geno.hd * c$cost.pheno.field, digits = 2)
+  costGenoLD <- format(c$cost.geno.ld * c$cost.pheno.field, digits = 2)
+  costGenoSNP <- format(c$cost.geno.single * c$cost.pheno.field, digits = 2)
+
+  costPhenoField <- format(c$cost.pheno.field, digits = 2)
+  costPhenoPatho <- format(c$cost.pheno.patho * c$cost.pheno.field, digits = 2)
+
+  costRegistration <- format(c$cost.register * c$cost.pheno.field, digits = 2)
+
+  style_pltmat <- "background-color: #ffcccb;"
+  style_pheno <- "background-color: #c2f0c2;"
+  style_geno <- "background-color: #ffedcc;"
+  style_registration <- "background-color: #e6f7ff;"
+
+  div(style = "text-align: center;",
+    tags$table(
+      border = 2, style = "width:100%; text-align:center; max-width: 75em",
+      tags$tr(
+        tags$th("Request type", style = "text-align:center"),
+        tags$th("Request detail", style = "text-align:center"),
+        tags$th("Cost (Mendels)", style = "text-align:center"),
+        tags$th("Duration (months)", style = "text-align:center"),
+
+        tags$tr(style = style_pltmat,
+          tags$td(rowspan = 3, "Plant Material"),
+          tags$td("Allofecundation"), tags$td(costAllof), tags$td(c$duration.allof)
+        ),
+        tags$tr(style = style_pltmat,
+          tags$td("Autofecundation"), tags$td(costAutof), tags$td(c$duration.autof)
+        ),
+        tags$tr(style = style_pltmat,
+          tags$td("Haplodiploidisations"), tags$td(costHaplo), tags$td(c$duration.haplodiplo)
+        ),
+
+        tags$tr(style = style_pheno,
+          tags$td(rowspan = 2, "Phenotyping"),
+          tags$td("Field"), tags$td(costPhenoField), tags$td(c$duration.pheno.field)
+        ),
+        tags$tr(style = style_pheno,
+          tags$td("Greenhouse"), tags$td(costPhenoPatho), tags$td(c$duration.pheno.patho)
+        ),
+
+        tags$tr(style = style_geno,
+          tags$td(rowspan = 3, "Genotyping"),
+          tags$td("High density"), tags$td(costGenoHD), tags$td(c$duration.geno.hd)
+        ),
+        tags$tr(style = style_geno,
+          tags$td("Low density"), tags$td(costGenoLD), tags$td(c$duration.geno.ld)
+        ),
+        tags$tr(style = style_geno,
+          tags$td("Single SNP"), tags$td(costGenoSNP), tags$td(c$duration.geno.single)
+        ),
+
+        tags$tr(style = style_registration,
+          tags$td("Registration"), tags$td(""), tags$td(costRegistration), tags$td("Instant")
+        )
+      )
+    )
+  )
+})
+
 
 
 

diff --git a/src/ui/ui_information.R b/src/ui/ui_information.R
@@ -95,6 +95,9 @@ tabItem(
           " ", strong("Single-SNP genotyping"), " has a ", strong(constants_ui("info_duration.geno.single"), "-month"), " delay and costs ", strong(constants_ui("info_cost.geno.single"), " plot"), " (", constants_ui("info_cost.geno.single.mendels"), " Mendels)."
         ),
         p(strong("Budget"), ": each team starts with a total budget of ", strong(constants_ui("info_initial.budget"), " Mendels"), ", fully available from the start."),
+        div(
+          uiOutput("costSummaryTable")
+        ),
         h2("Final trial"),
         p(
           "At the end of the game, each team will have to propose to register their best genotypes (up to", constants_ui("info_maxEvalInds"), ").",