Merge branch 'feat/fix-issue-#9' into dev

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: duflor.gui
 Title: Frontend for duflor-package
-Version: 0.0.1.9007
+Version: 0.0.1.9008
 Author: Claudius Appel
 Authors@R: c(
     person("Claudius", "Appel", email =   "[email protected]" , role = c("aut", "cre"))
@@ -22,6 +22,7 @@ Imports:
     imager,
     magrittr,
     openxlsx,
-    dplyr
+    dplyr,
+    ggplot2
 Remotes:
     Claudius-Appel/duflor

NAMESPACE

@@ -17,6 +17,14 @@ importFrom(foreach,"%dopar%")
 importFrom(foreach,foreach)
 importFrom(foreach,getDoParRegistered)
 importFrom(foreach,getDoParWorkers)
+importFrom(ggplot2,aes)
+importFrom(ggplot2,element_text)
+importFrom(ggplot2,geom_bar)
+importFrom(ggplot2,ggplot)
+importFrom(ggplot2,guides)
+importFrom(ggplot2,labs)
+importFrom(ggplot2,theme)
+importFrom(ggplot2,theme_minimal)
 importFrom(imager,display)
 importFrom(imager,draw_rect)
 importFrom(imager,grabRect)
@@ -41,11 +49,13 @@ importFrom(shiny,modalButton)
 importFrom(shiny,modalDialog)
 importFrom(shiny,numericInput)
 importFrom(shiny,observeEvent)
+importFrom(shiny,plotOutput)
 importFrom(shiny,radioButtons)
 importFrom(shiny,reactive)
 importFrom(shiny,reactiveValues)
 importFrom(shiny,removeModal)
 importFrom(shiny,removeNotification)
+importFrom(shiny,renderPlot)
 importFrom(shiny,renderText)
 importFrom(shiny,req)
 importFrom(shiny,selectInput)
@@ -79,4 +89,6 @@ importFrom(stringr,str_replace_all)
 importFrom(stringr,str_split)
 importFrom(stringr,str_to_lower)
 importFrom(stringr,str_to_upper)
+importFrom(utils,hasName)
+importFrom(utils,packageDescription)
 importFrom(utils,write.csv2)

R/app.R

@@ -32,6 +32,7 @@
 #' @importFrom shiny tabsetPanel
 #' @importFrom shiny tabPanel
 #' @importFrom shiny verbatimTextOutput
+#' @importFrom shiny plotOutput
 #' @importFrom shiny reactiveValues
 #' @importFrom shiny reactive
 #' @importFrom shiny observeEvent
@@ -40,6 +41,7 @@
 #' @importFrom shiny tags
 #' @importFrom shiny req
 #' @importFrom shiny renderText
+#' @importFrom shiny renderPlot
 #' @importFrom shiny showNotification
 #' @importFrom shiny removeNotification
 #' @importFrom shiny isolate
@@ -72,6 +74,7 @@
 #' @importFrom duflor extract_pixels_HSV
 #' @importFrom duflor apply_HSV_color_by_mask
 #' @importFrom duflor HSVtoRGB
+#' @importFrom utils packageDescription
 #' @return .
 #' @export
 #'
@@ -161,8 +164,12 @@ duflor_gui <- function() {
                            ,selectInput(inputId = "reinspected_spectrums",label = "Select spectrum to inspect",choices = names(getOption("duflor.default_hsv_spectrums")$upper_bound))
                            ,dataTableOutput("tbl_results_filtered")
                            ,checkboxInput(inputId = "mask_extreme", label = "Do a high-contrast mask?", value = FALSE)
-                           ,actionButton(inputId = "render_selected_mask",label = "Render masks for selected image",disabled = TRUE))
-                  #tabPanel("Analytics (misc1)",verbatimTextOutput("TAB3")),
+                           ,actionButton(inputId = "render_selected_mask",label = "Render masks for selected image",disabled = TRUE)),
+                  tabPanel("Results - plots"
+                           ,selectInput(inputId = "reinspected_spectrums2",label = "Select spectrum to inspect",choices = names(getOption("duflor.default_hsv_spectrums")$upper_bound))
+                           ,selectInput(inputId = "reinspected_type2",label = "Select KPI to inspect",choices = c("_fraction","_count","_area"))
+                           ,plotOutput("results_visualisation_plot")
+                           ,)
                   #tabPanel("Analytics (misc2)",verbatimTextOutput("TAB4")),
                   #tabPanel("Analytics (misc3)",verbatimTextOutput("TAB5"))
                 )
@@ -255,7 +262,7 @@ duflor_gui <- function() {
                 autoWidth = TRUE
             )
         )
-        #### REACTIVE - RESULTS_TABLE, FILTERED BY SPECTRUM ####
+        #### REACTIVE - RESULTS_TABLE/BARPLOT, FILTERED BY SPECTRUM ####
         filtered_results <- reactive({
             req(input$reinspected_spectrums)
             if (is.na(DATA$results)) { # handle empty DATA$results (this cannot be done via `req()` because `DATA$results` is initialised at startup)
@@ -282,6 +289,16 @@ duflor_gui <- function() {
                 autoWidth = TRUE
             )
         )
+        #### PLOT OUTPUT RESULTS ####
+        filtered_plot <- reactive({
+            req(input$reinspected_spectrums2,input$reinspected_type2)
+            plt <- get_KPI_plot(input, DATA)
+            return(plt)
+        })
+        output$results_visualisation_plot <- renderPlot({
+            filtered_plot()
+        })
+
         ### selected elements of the DT::renderDataTable() can be accessed in server via `input$tableID_rows_selected` - cf. https://clarewest.github.io/blog/post/making-tables-shiny/
 
         #### HIDE_PANELS_BY_DEFAULT ####

R/get_KPI_plot.R

@@ -0,0 +1,43 @@
+#' Title
+#'
+#' @return ggplot-object for the respective KPI
+#' @keywords internal
+#' @importFrom ggplot2 ggplot
+#' @importFrom ggplot2 geom_bar
+#' @importFrom ggplot2 labs
+#' @importFrom ggplot2 theme_minimal
+#' @importFrom ggplot2 theme
+#' @importFrom ggplot2 guides
+#' @importFrom ggplot2 aes
+#' @importFrom ggplot2 element_text
+#' @importFrom utils hasName
+#'
+get_KPI_plot <- function(input, DATA) {
+    key <- str_c(input$reinspected_spectrums2, input$reinspected_type2)
+    if (hasName(DATA$results$results, key)) {
+        removeNotification("spectrum.not.found.ggplot")
+        filtered_data <- DATA$results$results[[key]]
+    } else {
+        # handle spectrums not present in results-set
+        showNotification(
+            ui = "This spectrum was not analysed for this image.",
+            id = "spectrum.not.found.ggplot",
+            duration = NA,
+            type = "warning"
+        )
+        return(ggplot())
+    }
+    names <- DATA$results$results$image_name
+    group <- get_group(names)
+    # construct data
+    data <-
+        data.frame(filtered_data = filtered_data,
+                   names = names,
+                   group = group)
+    plt <- ggplot(data, aes(x = names, y = filtered_data, fill = group)) +
+        geom_bar(stat = "identity", position = "dodge") +
+        labs(x = "Names", y = "Filtered Datra") +
+        theme_minimal() +
+        theme(axis.text.x = element_text(angle = 45, hjust = 1))
+    return(plt)
+}

R/get_group.R

@@ -0,0 +1,11 @@
+#' trims numbers from groups from character-vector
+#'
+#' @param names .
+#'
+#' @return .
+#' @keywords internal
+#'
+get_group <- function(names) {
+    prefix <- gsub("\\d", "", names)
+    return(prefix)
+}