DSSM 24.08.0: Feature/203 json for mapr

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: DSSM
 Title: Pandora & IsoMemo spatiotemporal modeling
-Version: 24.06.0.2
+Version: 24.08.0
 Authors@R: c(
             person("Marcus", "Gross", email = "marcus.gross@inwt-statistics.de", role = c("cre", "aut")),
             person("Antonia", "Runge", email = "antonia.runge@inwt-statistics.de", role = c("aut"))
@@ -28,7 +28,6 @@ Imports:
     ks (>= 1.0.0),
     leaflet (>= 1.1.0),
     magick,
-    magrittr (>= 1.5),
     maps (>= 3.2.0),
     mapview,
     MASS (>= 7.3.5),

NAMESPACE

@@ -86,6 +86,7 @@ importFrom(coda,heidel.diag)
 importFrom(coda,mcmc)
 importFrom(coda,raftery.diag)
 importFrom(colourpicker,colourInput)
+importFrom(dplyr,"%>%")
 importFrom(dplyr,arrange)
 importFrom(dplyr,distinct)
 importFrom(dplyr,filter)
@@ -193,7 +194,6 @@ importFrom(magick,image_read)
 importFrom(magick,image_read_pdf)
 importFrom(magick,image_read_svg)
 importFrom(magick,image_write)
-importFrom(magrittr,"%>%")
 importFrom(maps,map)
 importFrom(maps,map.scale)
 importFrom(mgcv,Predict.matrix)
@@ -225,6 +225,8 @@ importFrom(shinyWidgets,pickerInput)
 importFrom(shinyWidgets,updatePickerInput)
 importFrom(shinycssloaders,withSpinner)
 importFrom(shinyjs,alert)
+importFrom(shinyjs,disable)
+importFrom(shinyjs,enable)
 importFrom(shinyjs,hide)
 importFrom(shinyjs,runjs)
 importFrom(shinyjs,show)
@@ -270,6 +272,7 @@ importFrom(utils,packageVersion)
 importFrom(utils,read.csv)
 importFrom(utils,read.csv2)
 importFrom(utils,write.table)
+importFrom(utils,zip)
 importFrom(webshot,is_phantomjs_installed)
 importFrom(yaml,read_yaml)
 importFrom(zip,zipr)

NEWS.md

@@ -1,3 +1,8 @@
+# DSSM 24.08.0
+
+## New Features
+- adds option to TimeR and KernelTimeR to download a zipm file that can be uploaded in MapR (#203)
+
 # DSSM 24.06.0
 
 ## New Features

R/00-Namespace.R

@@ -7,7 +7,8 @@
 #'  fillIsoData handleDescription has_internet importDataUI importDataServer importOptions
 #'  prefixSysTime previewDataUI previewDataServer tryCatchWithWarningsAndErrors
 #'  updateNameEntryIfDuplicate
-#' @importFrom dplyr arrange distinct filter group_by group_by_at left_join select summarise ungroup
+#' @importFrom dplyr "%>%" arrange distinct filter group_by group_by_at left_join select summarise
+#'  ungroup
 #' @importFrom DT datatable renderDataTable dataTableOutput
 #' @importFrom elevatr get_elev_point
 #' @importFrom geometry convhulln inhulln
@@ -26,7 +27,6 @@
 #'  layersControlOptions leaflet leafletProxy leafletOutput markerClusterOptions popupOptions
 #'  removeControl removeScaleBar removeShape renderLeaflet scaleBarOptions setMaxBounds setView
 #' @importFrom magick image_animate image_join image_read image_read_pdf image_read_svg image_write
-#' @importFrom magrittr "%>%"
 #' @importFrom maps map map.scale
 #' @importFrom MASS mvrnorm kde2d
 #' @importFrom mgcv gam gamm smoothCon s Predict.matrix rig te
@@ -39,15 +39,15 @@
 #' @importFrom rlang .data
 #' @importFrom sf st_as_sf st_centroid st_combine st_coordinates
 #' @importFrom shinycssloaders withSpinner
-#' @importFrom shinyjs alert runjs useShinyjs hide show
+#' @importFrom shinyjs alert runjs useShinyjs hide show enable disable
 #' @importFrom shinyMatrix matrixInput updateMatrixInput
 #' @importFrom shinyWidgets pickerInput updatePickerInput
 #' @importFrom stats aggregate as.formula cor cov density dist dnorm dunif kmeans
 #'  mahalanobis median model.matrix na.exclude na.omit pchisq  pf pnorm predict
 #'  qnorm quantile rbeta residuals rgamma rnorm runif sd var
 #' @importFrom sp point.in.polygon plot SpatialPoints
 #' @importFrom stringi stri_escape_unicode
-#' @importFrom utils available.packages compareVersion install.packages head
+#' @importFrom utils available.packages compareVersion install.packages head zip
 #'  packageVersion read.csv read.csv2 write.table installed.packages capture.output
 #' @importFrom webshot is_phantomjs_installed
 #' @importFrom yaml read_yaml

R/02-plotExport.R

@@ -63,20 +63,42 @@ plotExport <- function(input,
                                choices = c(
                                  "Gif + graphic files" = "gifAndZip",
                                  "Graphic files" = "onlyZip",
-                                 "Gif file" = "onlyGif"))),
+                                 "Gif file" = "onlyGif",
+                                 "MapR files" = "mapr")),
+                   conditionalPanel(
+                     condition = "input.typeOfSeries == 'mapr'",
+                     ns = session$ns,
+                     helpText("MapR only supports .png export. Ignoring 'Filetype' input.")
+                   )
+                   ),
             column(width = 4,
                    conditionalPanel(
-                     condition = "input.typeOfSeries != 'onlyZip'",
+                     condition = "input.typeOfSeries == 'gifAndZip' || input.typeOfSeries == 'onlyGif'",
                      ns = session$ns,
                      numericInput(session$ns("fpsGif"), "Frames per second", value = 2, min = 1, max = 10)
-                   )),
-            column(width = 4,
-                   style = "margin-top: 1.5em;",
+                   ),
                    conditionalPanel(
-                     condition = "input.typeOfSeries != 'onlyZip'",
+                     condition = "input.typeOfSeries == 'mapr'",
                      ns = session$ns,
+                     textInput(session$ns("mapr-group"), "Group", value = "Groupname"),
+                     textInput(session$ns("mapr-measure"), "Measure", value = "Mean")
+                   )
+                   ),
+                   conditionalPanel(
+                     condition = "input.typeOfSeries == 'gifAndZip' || input.typeOfSeries == 'onlyGif'",
+                     ns = session$ns,
+                     column(width = 4, style = "margin-top: 2em;",
                      checkboxInput(session$ns("reverseGif"), "Reverse time order")
-                   ))
+                     )
+                   ),
+                   conditionalPanel(
+                     condition = "input.typeOfSeries == 'mapr'",
+                     ns = session$ns,
+                     column(width = 4,
+                     textInput(session$ns("mapr-variable"), "Variable", value = "Variable"),
+                     textInput(session$ns("mapr-measureunit"), "Measure unit", value = "Measure Unit")
+                   )
+                   )
             )
         )
       ),
@@ -85,6 +107,15 @@ plotExport <- function(input,
     ))
   })
 
+  observe({
+  if(any(c(input$`mapr-group`,input$`mapr-variable`,input$`mapr-measure`,input$`mapr-measureunit`) == "") && input$typeOfSeries == "mapr"){
+    shinyjs::disable("exportExecute")
+  } else {
+  shinyjs::enable("exportExecute")
+  }
+  }) %>% bindEvent(c(input$typeOfSeries,input$`mapr-group`,input$`mapr-variable`,input$`mapr-measure`,input$`mapr-measureunit`),
+                  ignoreInit = TRUE)
+
   output$plot <- renderPlot({
     replayPlot(plotObj())
   })
@@ -116,8 +147,16 @@ plotExport <- function(input,
                             plotObj = plotObj(),
                             predictions = predictions()) %>%
           suppressWarnings() %>%
-          tryCatchWithWarningsAndErrors(errorTitle = "Export of graphic faild")
+          tryCatchWithWarningsAndErrors(errorTitle = "Export of graphic failed")
       } else {
+        if (input$typeOfSeries == "mapr") {
+          exportMapRFiles(file = file,
+                          plotFun = plotFun(),
+                          Model = Model(),
+                          input = input) %>%
+            suppressWarnings() %>%
+            tryCatchWithWarningsAndErrors(errorTitle = "Export of series of graphics failed")
+        } else {
         exportGraphicSeries(exportType = exportType(),
                             file = file,
                             width = input$width,
@@ -133,7 +172,8 @@ plotExport <- function(input,
                             reverseGif = input$reverseGif,
                             fpsGif = input$fpsGif) %>%
           suppressWarnings() %>%
-          tryCatchWithWarningsAndErrors(errorTitle = "Export of series of graphics faild")
+          tryCatchWithWarningsAndErrors(errorTitle = "Export of series of graphics failed")
+        }
       }
     }
   )
@@ -148,9 +188,30 @@ plotExport <- function(input,
 #' @param typeOfSeries one of "gifAndZip", "onlyZip", "onlyGif"
 #' @param i (numeric) number of i-th plot of a series of plots
 nameFile <- function(plotType, exportType, isTimeSeries, typeOfSeries, i = NULL) {
-  paste0(getFileName(plotType = plotType, isTimeSeries = isTimeSeries, i = i),
-         getFileExt(exportType = exportType, isTimeSeries = isTimeSeries,
-                    typeOfSeries = typeOfSeries, isCollection = is.null(i)))
+  # set file name
+  fileName <- getFileName(plotType = plotType, isTimeSeries = isTimeSeries, i = i)
+
+  # set file extension
+  if (!isTimeSeries || !is.null(i)) {
+    ## file extension for single plots: from user input 'exportType'
+
+    # use 'tif' instead of 'geo-tiff'
+    if (exportType == 'geo-tiff') {
+      fileExt <- "tif"
+    } else {
+      fileExt <- exportType
+    }
+  } else {
+    ## file extension for series of plots: from user input 'typeOfSeries'
+    fileExt <- switch(typeOfSeries,
+                      gifAndZip = "zip",
+                      onlyZip = "zip",
+                      onlyGif = "gif",
+                      mapr = "zipm")
+  }
+
+  # return file name with extension
+  paste0(fileName, ".", fileExt)
 }
 
 
@@ -163,21 +224,92 @@ getFileName <- function(plotType, isTimeSeries, i = NULL) {
   plotType
 }
 
+exportMapRFiles <- function(file, plotFun, Model, input) {
+  withProgress(message = "Generating series ...", value = 0, {
+    times <- seq(input$minTime, input$maxTime, by = abs(input$intTime))
 
-#' Get File Ext
-#'
-#' Get file extension
-#'
-#' @param isCollection (logical) TRUE if this is the container file, FALSE if this is an element file
-#' @inheritParams nameFile
-getFileExt <- function(exportType, isTimeSeries, typeOfSeries, isCollection = FALSE) {
-  if (exportType == 'geo-tiff') exportType <- "tif"
+    # create all file names to be put into a zip
+    figFileNames <- sapply(times,
+                           function(i) {
+                             paste0("data","/",
+                                    gsub(" ", "", input$`mapr-group`),"/",
+                                    gsub(" ", "", input$`mapr-variable`),"/",
+                                    gsub(" ", "", input$`mapr-measure`),"/",
+                                    i,".png")
+                           })
 
-  if (!isTimeSeries || !isCollection) return(paste0(".", exportType))
+    lapply(unique(dirname(figFileNames)), dir.create, recursive = TRUE, showWarnings = FALSE)
 
-  if (typeOfSeries == "onlyGif") return(".gif") else return(".zip")
+    for (i in times) {
+      incProgress(1 / length(times), detail = paste("time: ", i))
+      figFilename <- figFileNames[[which(times == i)]]
+
+      # save desired file type
+      writeGraphics(exportType = "png",
+                    plot = plotFun(model = Model, time = i),
+                    filename = figFilename,
+                    width = input$width,
+                    height = input$height)
+    }
+
+    json_list <- create_image_list_json(input, figFileNames, times)
+
+    # Save JSON content to a temporary file
+    json_file <- file.path("image_list.json")
+    jsonlite::write_json(json_list, json_file, pretty = TRUE)
+
+    zip(file, files = c(json_file, figFileNames))
+
+    # Clean up the temporary files
+    file.remove(figFileNames)
+    file.remove(json_file)
+    unlink(file.path("data"), recursive = TRUE)
+  })
+}
+
+create_image_list_json <- function(input, figFileNames, times){
+  image_list <- list(
+    Selections = list(
+      list(
+        Group = input$`mapr-group`,
+        Group_DOI = 1,
+        Variable = list(
+          list(
+            Variable_name = input$`mapr-variable`,
+            Variable_DOI = 1,
+            Measure = list(
+              list(
+                Measure_name = input$`mapr-measure`,
+                Measure_unit = input$`mapr-measureunit`,
+                images = list(
+                )
+              )
+            )
+          )
+        )
+      )
+    )
+  )
+
+  for (image in figFileNames){
+
+    time <- as.character(times[[which(figFileNames == image)]])
+
+    single_image <- list(
+      x_display_value = time,
+      file_type = "png",
+      location_type = "local",
+      address = gsub("data/","",image)
+    )
+
+    # Add the images to the list
+    image_list$Selections[[1]]$Variable[[1]]$Measure[[1]]$images <- append(image_list$Selections[[1]]$Variable[[1]]$Measure[[1]]$images, list(single_image))
+  }
+
+  image_list
 }
 
+
 exportGraphicSeries <- function(exportType, file,
                                 width, height, plotFun, Model, predictions,
                                 modelType, minTime, maxTime, intTime,