Merge pull request #63 from NINAnor/style_pkg

updated readme
NINAnor · Oct 2, 2024 · 97e0c43 · 97e0c43
2 parents 345786a + 2502ec4
commit 97e0c43
Show file tree

Hide file tree

Showing 52 changed files with 785 additions and 730 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,8 +1,8 @@
 Package: NinaR
 Type: Package
 Title: Document templates and functions for NINA
-Version: 0.2.2.11
-Date: 2024-09-23
+Version: 0.2.2.12
+Date: 2024-10-02
 Author: Jens Åström
 Authors@R: c(
   person("Jens", "Åström", role = c("aut", "cre"), email = "jens.astrom@nina.no")
@@ -32,5 +32,5 @@ Imports:
   styler
 LazyData: TRUE
 Encoding: UTF-8
-RoxygenNote: 7.2.3
+RoxygenNote: 7.3.1
 VignetteBuilder: knitr
diff --git a/R/addAlpha.R b/R/addAlpha.R
@@ -9,13 +9,17 @@
 #' @seealso \code{\link{ninaPalette}}
 #' @examples
 #' set.seed(12345)
-#' barplot(runif(5), col=addAlpha(ninaPalette(), 0.4))
+#' barplot(runif(5), col = addAlpha(ninaPalette(), 0.4))
 #' @export
 
-addAlpha <- function(col, alpha=1){
-  if(missing(col))
+addAlpha <- function(col, alpha = 1) {
+  if (missing(col)) {
     stop("Please provide a vector of colours.")
-  apply(sapply(col, col2rgb)/255, 2,
-   function(x)
-    rgb(x[1], x[2], x[3], alpha = alpha))
+  }
+  apply(
+    sapply(col, col2rgb) / 255, 2,
+    function(x) {
+      rgb(x[1], x[2], x[3], alpha = alpha)
+    }
+  )
 }
diff --git a/R/addLogo.R b/R/addLogo.R
@@ -2,17 +2,11 @@
 #'
 #' Adds a NINA logo to plot
 #'
-#' Logo is based on Postscript version of logo, and is scalable
-#' (vectorized). The function uses the package grImport. See
-#' examples for usage.
-#'
-#' @param x x-position in percentage values (0-1) of
-#' npc (Normalized parent coordinates)
-#' @param y y-position in percentage values (0-1) of
-#' npc (Normalized parent coordinates)
-#' @param size size specified as width in percentage of original size (default 0.2).
-#' Height is left unspecified to scale with width, retaining
-#' original aspect ratio.
+#' Logo is based on Postscript version of logo, and is scalable (vectorized). The function uses the package grImport. See examples for usage.
+#'
+#' @param x x-position in percentage values (0-1) of npc (Normalized parent coordinates)
+#' @param y y-position in percentage values (0-1) of npc (Normalized parent coordinates)
+#' @param size size specified as width in percentage of original size (default 0.2).  Height is left unspecified to scale with width, retaining original aspect ratio.
 #'
 #' @return Adds scalable logo on current device (opens new device if no current device exists)
 #' @author Jens Astrom
@@ -21,24 +15,26 @@
 #' @import grid
 #'
 #' @examples
-#' ## Add small logo to right bottom corner
-#' plot((1:10)^2, 1:10, col=ninaPalette(), cex=4, pch=16, las=1)
+#' # Add small logo to right bottom corner.
+#' plot((1:10)^2, 1:10, col = ninaPalette(), cex = 4, pch = 16, las = 1)
 #' addLogo()
 #'
-#' #Add large logo to background of plot
-#' plot((1:10)^2, 1:10, col=ninaPalette(), cex=4, pch=16, las=1, type="n")
+#' # Add large logo to background of plot.
+#' plot((1:10)^2, 1:10, col = ninaPalette(), cex = 4, pch = 16, las = 1, type = "n")
 #' addLogo(x = 0.5, y = 0.5, size = 1)
-#' grid.rect(gp = gpar(fill = rgb(1, 1, 1, .6)))
-#' points((1:10)^2, 1:10, col=ninaPalette(), cex=4, pch=16)
+#' grid::grid.rect(gp = gpar(fill = rgb(1, 1, 1, .6)))
+#' points((1:10)^2, 1:10, col = ninaPalette(), cex = 4, pch = 16)
+#'
 #' @export
+#'
+#'
 
 addLogo <- function(x = getOption("nina.logo.x.pos", 0.85),
                     y = getOption("nina.logo.y.pos", 0.1),
                     size = 0.2) {
-
-
-logo <- grImport::readPicture(system.file("img/logo.ps.xml", package = "NinaR"))
-grid::pushViewport(grid::plotViewport())
-grImport::grid.picture(logo, width = size, x = unit(x, "npc"), y = unit(y, "npc"))
+  logo <- grImport::readPicture(system.file("img/logo.ps.xml", package = "NinaR"))
+  grid::pushViewport(grid::plotViewport())
+  grImport::grid.picture(logo, width = size, x = unit(x, "npc"), y = unit(y, "npc"))
 }
 
+
diff --git a/R/add_logo.R b/R/add_logo.R
@@ -1,6 +1,6 @@
 #' add_logo Add a NINA-logo to ggplots
 #'
-#' This is a ggplot version of addLogo. It inserts a png version of the NINA logo in a ggplot. You have to tinker a bit with the xmin, xmax, ymin, ymax values, and the stroke_scale a bit to get it to fit your particular plot. So far, no alpha capabilities.
+#' This is a ggplot version of addLogo. It inserts a png version of the NINA logo in a ggplot. You have to tinker a bit with the xmin, xmax, ymin, ymax values to get it to fit your particular plot. So far, no alpha capabilities.
 #'
 #' @param logo_type black or white logo? defaults to "black"
 #' @param xmin start position of logo along x-axis
@@ -14,16 +14,11 @@
 #'
 #' @examples
 #'
-#'
 #' p <- ggplot(tibble(x = (1:10)^2, y = 1:10), aes(x = x, y = y)) +
-# add_logo(xmin = 75, ymax = 2.5, ymin = 1, stroke_scale = 0.3) +
-#  geom_point()
-# p
-#'
-#'
+#'   add_logo(xmin = 75, ymax = 2.5, ymin = 1) +
+#'   geom_point()
+#' p
 #'
-
-
 add_logo <- function(logo_type = "no_text",
                      logo_lang = "no",
                      logo_color = "black",
@@ -32,53 +27,52 @@ add_logo <- function(logo_type = "no_text",
                      ymin = -Inf,
                      ymax = Inf,
                      ...) {
-
   logo_type <- match.arg(logo_type, choices = c("no_text", "text"))
   logo_lang <- match.arg(logo_lang, choices = c("no", "en"))
   logo_color <- match.arg(logo_color, choices = c("black", "white"))
 
 
-  if(logo_type == "no_text"){
-      if(logo_color == "black"){
+  if (logo_type == "no_text") {
+    if (logo_color == "black") {
       logo <- png::readPNG(system.file("img/NINA_logo_sort_txt.png", package = "NinaR"))
-      } else{
-        logo <- png::readPNG(system.file("img/NINA_logo_hvit_txt.png", package = "NinaR"))
+    } else {
+      logo <- png::readPNG(system.file("img/NINA_logo_hvit_txt.png", package = "NinaR"))
+    }
+  } else {
+    if (logo_color == "black") {
+      if (logo_lang == "no") {
+        logo <- png::readPNG(system.file("img/NINA_logo_sort_txt_norsk_under.png", package = "NinaR"))
+      } else {
+        logo <- png::readPNG(system.file("img/NINA_logo_sort_txt_engelsk_under.png", package = "NinaR"))
       }
     } else {
-      if(logo_color == "black"){
-        if(logo_lang == "no"){
-          logo <- png::readPNG(system.file("img/NINA_logo_sort_txt_norsk_under.png", package = "NinaR"))
-        } else
-        {
-          logo <- png::readPNG(system.file("img/NINA_logo_sort_txt_engelsk_under.png", package = "NinaR"))
-        }
-      } else
-      {
-        if(logo_lang == "no"){
-          logo <- png::readPNG(system.file("img/NINA_logo_hvit_txt_norsk_under.png", package = "NinaR"))
-        } else
-        {
-          logo <- png::readPNG(system.file("img/NINA_logo_hvit_txt_engelsk_under.png", package = "NinaR"))
-        }
-
+      if (logo_lang == "no") {
+        logo <- png::readPNG(system.file("img/NINA_logo_hvit_txt_norsk_under.png", package = "NinaR"))
+      } else {
+        logo <- png::readPNG(system.file("img/NINA_logo_hvit_txt_engelsk_under.png", package = "NinaR"))
       }
+    }
   }
 
   grob <- grid::rasterGrob(logo,
-                            interpolate = TRUE)
-
+    interpolate = TRUE
+  )
 
 
-  ggplot2::layer(data = ggplot2:::dummy_data(),
-                 stat = ggplot2:::StatIdentity,
-                 position = ggplot2:::PositionIdentity,
-                 geom = ggplot2:::GeomCustomAnn,
-                 inherit.aes = FALSE,
-                 params = list(grob = grob,
-                               xmin = xmin,
-                               xmax = xmax,
-                               ymin = ymin,
-                               ymax = ymax),
-                 ...)
 
+  ggplot2::layer(
+    data = ggplot2:::dummy_data(),
+    stat = ggplot2:::StatIdentity,
+    position = ggplot2:::PositionIdentity,
+    geom = ggplot2:::GeomCustomAnn,
+    inherit.aes = FALSE,
+    params = list(
+      grob = grob,
+      xmin = xmin,
+      xmax = xmax,
+      ymin = ymin,
+      ymax = ymax
+    ),
+    ...
+  )
 }
diff --git a/R/checkWorkload.R b/R/checkWorkload.R
@@ -19,21 +19,22 @@
 
 checkWorkload <- function(user_aggregate = TRUE,
                           sort_proc_by = c("CPU", "MEM"),
-                          procs = 50){
-
+                          procs = 50) {
   system <- Sys.info()["sysname"]
-  if(system != "Linux") stop("This only works on Linux machines!")
+  if (system != "Linux") stop("This only works on Linux machines!")
 
   sort_proc_by <- match.arg(sort_proc_by, c("CPU", "MEM"))
   sort_proc_by <- switch(sort_proc_by,
-                          "CPU" = "%CPU",
-                          "MEM" = "%MEM"
-                          )
+    "CPU" = "%CPU",
+    "MEM" = "%MEM"
+  )
 
-   noCores <- parallel::detectCores()
+  noCores <- parallel::detectCores()
 
-  top <- NCmisc::top(Table = T,
-                     procs = 100)
+  top <- NCmisc::top(
+    Table = T,
+    procs = 100
+  )
 
   memRaw <- system("free -mh ", intern = T)
   mem <- strsplit(memRaw, "\t")
@@ -42,18 +43,18 @@ checkWorkload <- function(user_aggregate = TRUE,
   mem[[3]] <- c(mem[[3]], rep(",", 3))
 
   mem <- lapply(mem, function(x) unlist(strsplit(x, ",")))
-  mem <- matrix(unlist(mem), nrow = 3, byrow=T)
+  mem <- matrix(unlist(mem), nrow = 3, byrow = T)
   dimnames(mem) <- list(mem[, 1], mem[1, ])
   mem <- as.data.frame(mem[-1, -1], optional = T, stringsAsFactors = FALSE)
 
-  if(user_aggregate){
+  if (user_aggregate) {
     top_out <- top[[1]] %>%
       group_by(USER) %>%
-      mutate_at(vars(`%CPU`,`%MEM`), as.numeric) %>%
-      summarise_at(vars(`%CPU`,`%MEM`), sum)
+      mutate_at(vars(`%CPU`, `%MEM`), as.numeric) %>%
+      summarise_at(vars(`%CPU`, `%MEM`), sum)
   } else {
     top_out <- top[[1]] %>%
-      mutate_at(vars(`%CPU`,`%MEM`), as.numeric)
+      mutate_at(vars(`%CPU`, `%MEM`), as.numeric)
   }
 
   top_out <- top_out %>%
@@ -63,6 +64,3 @@ checkWorkload <- function(user_aggregate = TRUE,
 
   return(out)
 }
-
-
-
diff --git a/R/grassConnect.R b/R/grassConnect.R
@@ -16,29 +16,28 @@
 #' }
 #' @export
 
-grassConnect <- function(location="ETRS_33N", mapset="user"){
+grassConnect <- function(location = "ETRS_33N", mapset = "user") {
   host <- NULL
   try(host <- system("hostname", intern = T))
   if (grepl("ninrstudio|ningis|lipgis|liprstudio", host)) {
-
     gisDbase <- "/data/grass"
-    #location <- "ETRS_33N"
-    if(mapset=="user") {
+    # location <- "ETRS_33N"
+    if (mapset == "user") {
       user <- Sys.info()["user"]
       mapset <- paste("u_", user, sep = "")
     }
-    if(TRUE %in% startsWith(mapset, c("u_", "p_", "g_", "gt_"))) {
+    if (TRUE %in% startsWith(mapset, c("u_", "p_", "g_", "gt_"))) {
       wd <- paste(gisDbase, location, mapset, sep = "/")
       try(system(paste("grass -text -c -e", wd)))
-      grasslib <- try(system('grass --config path', intern=TRUE))
-      rgrass::initGRASS(gisBase = grasslib, location = location,
-                        mapset = mapset, gisDbase = gisDbase, override = TRUE)
+      grasslib <- try(system("grass --config path", intern = TRUE))
+      rgrass::initGRASS(
+        gisBase = grasslib, location = location,
+        mapset = mapset, gisDbase = gisDbase, override = TRUE
+      )
     } else {
       stop("Mapset name does not follow naming convention! Please check: http://web.nina.no/giswiki/doku.php?id=ninsrv16:grassgisbase")
     }
-  }  else stop("Must be run on one of NINAs Linux servers!")
+  } else {
+    stop("Must be run on one of NINAs Linux servers!")
+  }
 }
-
-
-
-