limits for x and y axis can be set

bs/R/OperationsModule.R

@@ -122,6 +122,9 @@ OperatorEditorSidebar <- function(id) {
       actionButton(NS(id, "as.real"), "convert to real number",
         title = "Convert a column of the dataset or an intermediate variable to a real number. For example as.real(ColName)",
         class = "add-button"),
+      actionButton(NS(id, "as.fact"), "convert to factors",
+        title = "Convert a column of the dataset or an intermediate variable to a factor. For example as.fact(ColName)",
+        class = "add-button"),
       class = "boxed-output"
     ),
     div(
@@ -710,6 +713,11 @@ OperationEditorServer <- function(id, data) {
       updated_text <- paste(current_text, "as.real(", sep = " ")
       updateTextAreaInput(session, "editable_code", value = updated_text)
     })
+    observeEvent(input$as.fact, {
+      current_text <- input$editable_code
+      updated_text <- paste(current_text, "as.fact(", sep = " ")
+      updateTextAreaInput(session, "editable_code", value = updated_text)
+    })
     observeEvent(input$dnorm, {
       current_text <- input$editable_code
       updated_text <- paste(current_text, "dnorm(", sep = " ")

bs/R/app.R

@@ -163,7 +163,7 @@ server <- function(input, output, session) {
     }
     tryCatch(
       {
-        system(paste("rm -r ", file))
+        unlink(file)
       },
       warning = function(warn) {
         showNotification(paste("A warning occurred: ", conditionMessage(warn)), duration = 0)

bs/R/check_ast.R

@@ -16,7 +16,7 @@ allowed_fcts <- function() {
     "sum", "diff", "min", "max", "scale",
     "c", "vector", "length", "matrix", "~",
     "get_rows", "get_cols",
-    "as.char", "as.int", "as.real"
+    "as.char", "as.int", "as.real", "as.fact"
   )
 }
 

bs/R/loadLibraries.R

@@ -16,6 +16,7 @@ library(MASS)
 library(Matrix)
 library(shinyjs)
 library(equatiomatic)
+# TODO: add missing libraries to the Dockerfile
 
 if (Sys.getenv("RUN_MODE") == "SERVER") {
   library(COMELN)

bs/R/plottingInternally.R

@@ -1,3 +1,33 @@
+addFacet <- function(p, facetVar, facetMode) {
+  if (facetMode == "facet_wrap") {
+    return(p + facet_wrap(. ~ .data[[facetVar]], scales = "free"))
+  } else if (facetMode == "facet_grid") {
+    return(p + facet_grid(. ~ .data[[facetVar]], scales = "free"))
+  }
+}
+
+addInterval <- function(p, df, xCol, yCol, xMin, xMax, yMin, yMax) {
+  x <- df[ , xCol]
+  y <- df[ , yCol]
+  if (is.numeric(x)) {
+    p <- p + scale_x_continuous(limits = c(xMin, xMax))
+  } else {
+    choices <- unique(x)
+    xStart <- which(xMin == choices)
+    xEnd <- which(xMax == choices)
+    p <- p + scale_x_discrete(limits = choices[xStart:xEnd])
+  }
+  if (is.numeric(y)) {
+    p <- p + scale_y_continuous(limits = c(yMin, yMax))
+  } else {
+    choices <- unique(y)
+    yStart <- which(yMin == choices)
+    yEnd <- which(yMax == choices)
+    p <- p + scale_y_discrete(limits = choices[yStart:yEnd])
+  }
+  return(p)
+}
+
 annotateDF <- function(p, method, level = 2) {
   pB <- ggplot_build(p)
   df <- pB$data[[1]]
@@ -107,18 +137,11 @@ calcParams <- function(df, formula, method) {
   }
 }
 
-addFacet <- function(p, facetVar, facetMode) {
-  if (facetMode == "facet_wrap") {
-    return(p + facet_wrap(. ~ .data[[facetVar]], scales = "free"))
-  } else if (facetMode == "facet_grid") {
-    return(p + facet_grid(. ~ .data[[facetVar]], scales = "free"))
-  }
-}
-
 DotplotFct <- function(df, x, y, xLabel, yLabel,
                        fitMethod,
                        colourVar, legendTitleColour,
-                       colourTheme, facetMode, facetVar, k = 10) {
+                       colourTheme, facetMode, facetVar, k = 10,
+                       xMin, xMax, yMin, yMax) {
   # create plot
   # ==========================================
   aes <- aes(x = .data[[x]], y = .data[[y]])
@@ -144,7 +167,7 @@ DotplotFct <- function(df, x, y, xLabel, yLabel,
 
   p <- p + xlab(xLabel)
   p <- p + ylab(yLabel)
-
+  p <- addInterval(p, df, x, y, xMin, xMax, yMin, yMax)
   if (colourVar != "") {
     p <- p + guides(colour = guide_legend(title = legendTitleColour))
     p <- p + scale_color_brewer(palette = colourTheme)
@@ -221,7 +244,8 @@ DotplotFct <- function(df, x, y, xLabel, yLabel,
 BoxplotFct <- function(df, x, y, xLabel, yLabel,
                        fillVar, legendTitleFill, fillTheme,
                        colourVar, legendTitleColour,
-                       colourTheme, facetMode, facetVar) {
+                       colourTheme, facetMode, facetVar,
+                       xMin, xMax, yMin, yMax) {
   aes <- aes(x = .data[[x]], y = .data[[y]])
   aesColour <- NULL
   aesFill <- NULL
@@ -252,6 +276,7 @@ BoxplotFct <- function(df, x, y, xLabel, yLabel,
   p <- p + guides(colour = guide_legend(title = legendTitleColour))
   p <- p + scale_fill_brewer(palette = fillTheme)
   p <- p + scale_color_brewer(palette = colourTheme)
+  p <- addInterval(p, df, x, y, xMin, xMax, yMin, yMax)
   if (facetMode != "none") {
     p <- addFacet(p, facetVar, facetMode)
   }
@@ -260,7 +285,8 @@ BoxplotFct <- function(df, x, y, xLabel, yLabel,
 
 LineplotFct <- function(df, x, y, xLabel, yLabel,
                         colourVar, legendTitleColour,
-                        colourTheme, facetMode, facetVar) {
+                        colourTheme, facetMode, facetVar,
+                        xMin, xMax, yMin, yMax) {
   aes <- aes(x = .data[[x]], y = .data[[y]])
   aesColour <- NULL
   p <- NULL
@@ -283,6 +309,7 @@ LineplotFct <- function(df, x, y, xLabel, yLabel,
   p <- p + ylab(yLabel)
   p <- p + guides(colour = guide_legend(title = legendTitleColour))
   p <- p + scale_color_brewer(palette = colourTheme)
+  p <- addInterval(p, df, x, y, xMin, xMax, yMin, yMax)
   if (facetMode != "none") {
     p <- addFacet(p, facetVar, facetMode)
   }

bs/R/utils.R

@@ -255,6 +255,10 @@ as.real <- function(v) {
   return(as.numeric(v))
 }
 
+as.fact <- function(v) {
+  return(as.factor(v))
+}
+
 # Split groups
 split <- function(df, cols, levels) {
   df_res <- NULL
@@ -269,3 +273,33 @@ split <- function(df, cols, levels) {
   }
   return(df_res)
 }
+
+# check and print notifications
+print_noti <- function(expr, message) {
+  if (!expr) {
+    showNotification(message)
+  }
+  req(expr)
+}
+
+# Check axis limits
+check_axis_limits <- function(col, min, max) {
+  if (is.numeric(col)) {
+    if (!is.numeric(min) || !is.numeric(max)) {
+      stop("Found invalid axis limits")
+    }
+    if (max <= min) {
+      stop("Found invalid axis limits: max <= min")
+    }
+    return()
+  } else {
+    choices <- unique(col)
+    if (!(min %in% choices) || !(max %in% choices)) {
+      stop("Found invalid axis limits")
+    }
+    if (which(max == choices) <= which(min == choices)) {
+      stop("Found invalid axis limits. The max value is found before the min value")
+    }
+    return()
+  }
+}