reduce warnings of R CMD check

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: gg.layers
 Title: ggplot layers
-Version: 0.1.1
+Version: 0.1.2
 Authors@R: c(
   person("Dongdong", "Kong", role = c("aut", "cre"), 
          email = "kongdd.sysu@gmail.com", comment = c(ORCID = "0000-0003-1836-8172")))
@@ -25,8 +25,8 @@ Imports:
     methods
 Suggests: 
     testthat (>= 3.0.0),
-    data.table,
     rcolors,
+    scales,
     sf, stars, raster,
     mapview,
     lattice,
@@ -39,4 +39,4 @@ Config/testthat/edition: 3
 VignetteBuilder: knitr
 LazyData: true
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.2.3
+RoxygenNote: 7.3.0

NAMESPACE

@@ -104,7 +104,6 @@ export(label_num)
 export(layer_PosNeg)
 export(layer_PosNeg_sign)
 export(layer_barchart)
-export(layer_statistic)
 export(make_colorbar)
 export(mutate)
 export(polygon.fullhatch)
@@ -149,6 +148,7 @@ import(magrittr)
 import(rtrend)
 importFrom(broom,glance)
 importFrom(broom,tidy)
+importFrom(data.table,":=")
 importFrom(data.table,as.data.table)
 importFrom(data.table,data.table)
 importFrom(data.table,is.data.table)
@@ -187,6 +187,10 @@ importFrom(ggpp,geom_text_npc)
 importFrom(ggtext,element_markdown)
 importFrom(ggtext,element_textbox)
 importFrom(ggtext,geom_richtext)
+importFrom(graphics,abline)
+importFrom(graphics,axis)
+importFrom(graphics,par)
+importFrom(graphics,polygon)
 importFrom(grid,gpar)
 importFrom(grid,grobHeight)
 importFrom(grid,grobTree)
@@ -196,21 +200,23 @@ importFrom(grid,unit)
 importFrom(gridtext,richtext_grob)
 importFrom(gtable,gtable)
 importFrom(gtable,gtable_add_grob)
-importFrom(magrittr,`%<>%`)
-importFrom(magrittr,`%>%`)
-importFrom(rlang,`%||%`)
+importFrom(magrittr,"%<>%")
+importFrom(magrittr,"%>%")
+importFrom(rlang,"%||%")
 importFrom(rlang,inject)
 importFrom(rlang,list2)
 importFrom(rlang,try_fetch)
 importFrom(rtrend,slope_mk)
 importFrom(rtrend,slope_p)
 importFrom(stats,approx)
+importFrom(stats,cor)
 importFrom(stats,cor.test)
 importFrom(stats,lm)
 importFrom(stats,median)
 importFrom(stats,predict)
 importFrom(stats,qf)
 importFrom(stats,quantile)
+importFrom(stats,sd)
 importFrom(stats,setNames)
 importFrom(stringr,str_replace_all)
 importFrom(utils,str)

NEWS.md

@@ -1,3 +1,8 @@
+# gg.layers 0.1.2
+
+- fix `st_hatched_polygon` for `MULTIPOLYGON`
+- reduce R cmd check warnings
+
 # gg.layers 0.1.0
 
 * Added a `NEWS.md` file to track changes to the package.

R/GOF.R

@@ -2,8 +2,8 @@
 #'
 #' Good of fitting
 #'
-#' @param yobs Numeric vector, observations
-#' @param ysim Numeric vector, corresponding simulated values
+#' @param obs Numeric vector, observations
+#' @param sim Numeric vector, corresponding simulated values
 #' @param w Numeric vector, weights of every points. If w included, when
 #' calculating mean, Bias, MAE, RMSE and NSE, w will be taken into considered.
 #' @param include.cv If true, cv will be included.
@@ -30,31 +30,31 @@
 #' 4. Zhang Xiaoyang (2015), http://dx.doi.org/10.1016/j.rse.2014.10.012
 #'
 #' @examples
-#' yobs = rnorm(100)
-#' ysim = yobs + rnorm(100)/4
-#' GOF(yobs, ysim)
+#' obs = rnorm(100)
+#' sim = obs + rnorm(100)/4
+#' GOF(obs, sim)
 #' 
 #' @importFrom dplyr tibble
 #' @export
-GOF <- function(yobs, ysim, w, include.cv = FALSE, include.r = TRUE){
-    if (missing(w)) w <- rep(1, length(yobs))
+GOF <- function(obs, sim, w, include.cv = FALSE, include.r = TRUE){
+    if (missing(w)) w <- rep(1, length(obs))
 
-    # remove NA_real_ and Inf values in ysim, yobs and w
+    # remove NA_real_ and Inf values in sim, obs and w
     valid <- function(x) !is.na(x) & is.finite(x)
 
-    I <- which(valid(ysim) & valid(yobs) & valid(w))
-    # n_obs <- length(yobs)
+    I <- which(valid(sim) & valid(obs) & valid(w))
+    # n_obs <- length(obs)
     n_sim <- length(I)
 
-    ysim <- ysim[I]
-    yobs <- yobs[I]
+    sim <- sim[I]
+    obs <- obs[I]
     w     <- w[I]
 
     if (include.cv) {
-        CV_obs <- cv_coef(yobs, w)
-        CV_sim <- cv_coef(ysim, w)
+        CV_obs <- cv_coef(obs, w)
+        CV_sim <- cv_coef(sim, w)
     }
-    if (is_empty(yobs)){
+    if (is_empty(obs)){
         out <- c(RMSE = NA_real_, 
             KGE = NA_real_,
             NSE = NA_real_, MAE = NA_real_, AI = NA_real_,
@@ -67,16 +67,16 @@ GOF <- function(yobs, ysim, w, include.cv = FALSE, include.r = TRUE){
 
     # R2: the portion of regression explained variance, also known as
     # coefficient of determination
-    KGE = KGE(ysim, yobs)
+    KGE = KGE(sim, obs)
     # https://en.wikipedia.org/wiki/Coefficient_of_determination
     # https://en.wikipedia.org/wiki/Explained_sum_of_squares
-    y_mean <- sum(yobs * w) / sum(w)
+    y_mean <- sum(obs * w) / sum(w)
 
-    SSR    <- sum( (ysim - y_mean)^2 * w)
-    SST    <- sum( (yobs - y_mean)^2 * w)
+    SSR    <- sum( (sim - y_mean)^2 * w)
+    SST    <- sum( (obs - y_mean)^2 * w)
     # R2     <- SSR / SST
 
-    RE     <- ysim - yobs
+    RE     <- sim - obs
     Bias   <- sum ( w*RE)     /sum(w)                     # bias
     Bias_perc <- Bias/y_mean                              # bias percentage
     MAE    <- sum ( w*abs(RE))/sum(w)                     # mean absolute error
@@ -93,7 +93,7 @@ GOF <- function(yobs, ysim, w, include.cv = FALSE, include.r = TRUE){
         pvalue <- NA_real_
 
         tryCatch({
-            cor.obj <- cor.test(yobs, ysim, use = "complete.obs")
+            cor.obj <- cor.test(obs, sim, use = "complete.obs")
             R       <- cor.obj$estimate[[1]]
             pvalue  <- cor.obj$p.value
         }, error = function(e){
@@ -102,16 +102,16 @@ GOF <- function(yobs, ysim, w, include.cv = FALSE, include.r = TRUE){
         R2 = R^2
     }
     # In Linear regression, R2 = R^2 (R is pearson cor)
-    # R2     <- summary(lm(ysim ~ yobs))$r.squared # low efficient
+    # R2     <- summary(lm(sim ~ obs))$r.squared # low efficient
 
     # AI: Agreement Index (only good values(w==1) calculate AI)
     AI <- NA_real_
     I2 <- which(w == 1)
     if (length(I2) >= 2) {
-        yobs = yobs[I2]
-        ysim = ysim[I2]
-        y_mean = mean(yobs)
-        AI = 1 - sum( (ysim - yobs)^2 ) / sum( (abs(ysim - y_mean) + abs(yobs - y_mean))^2 )
+        obs = obs[I2]
+        sim = sim[I2]
+        y_mean = mean(obs)
+        AI = 1 - sum( (sim - obs)^2 ) / sum( (abs(sim - y_mean) + abs(obs - y_mean))^2 )
     }
 
     out <- tibble(R, pvalue, R2, NSE, KGE, RMSE, MAE, 
@@ -138,20 +138,20 @@ KGE <- function(obs, sim, w = c(1, 1, 1), ...) {
 
 #' @rdname GOF
 #' @export
-NSE <- function(yobs, ysim, w, ...) {
-    if (missing(w)) w <- rep(1, length(yobs))
+NSE <- function(obs, sim, w, ...) {
+    if (missing(w)) w <- rep(1, length(obs))
 
-    ind <- valindex(yobs, ysim)
+    ind <- valindex(obs, sim)
     w <- w[ind]
 
-    y_mean <- sum(yobs[ind] * w) / sum(w)
+    y_mean <- sum(obs[ind] * w) / sum(w)
     # R2: the portion of regression explained variance, also known as
     # coefficient of determination
 
-    # SSR <- sum((ysim - y_mean)^2 * w)
-    SST <- sum((yobs[ind] - y_mean)^2 * w)
+    # SSR <- sum((sim - y_mean)^2 * w)
+    SST <- sum((obs[ind] - y_mean)^2 * w)
     # R2     <- SSR / SST
-    RE <- ysim[ind] - yobs[ind]
+    RE <- sim[ind] - obs[ind]
     # Bias <- sum(w * RE) / sum(w) # bias
     # Bias_perc <- Bias / y_mean # bias percentage
     # MAE <- sum(w * abs(RE)) / sum(w) # mean absolute error

R/colorbar_triangle.R

@@ -1,5 +1,7 @@
 #' colourbar_triangle
 #' 
+#' @param ... parameters passed to [ggplot2::guide_colourbar]
+#' 
 #' @example R/examples/ex-colorbar_triangle.R
 #' 
 #' @references 

R/geom_prcpRunoff.R

@@ -23,8 +23,8 @@ theme_dual_axis <- function(col_left = "darkorange", col_right = "blue") {
   )
 }
 
-#' @importFrom rlang `%||%`
-#' @importFrom magrittr `%<>%` `%>%`
+#' @importFrom rlang %||%
+#' @importFrom magrittr %<>% %>%
 #' @importFrom ggplot2 ggproto GeomLine aes layer
 GeomPrcpRunoff <- ggproto(
   "GeomPrcpRunoff", GeomLine,

R/gg.layers-package.R

@@ -6,26 +6,34 @@
 #' @import grid magrittr ggplot2
 #' @importFrom gridtext richtext_grob
 #' @importFrom grid gpar
-#' @importFrom stats median approx setNames quantile lm predict cor.test qf
-#' @importFrom dplyr first last tibble 
+#' @importFrom stats median approx setNames quantile lm predict cor.test qf cor sd
+#' @importFrom dplyr first last tibble
+#' @importFrom data.table :=
+#' @importFrom graphics abline par axis polygon
 #' @importFrom utils str
 ## usethis namespace: end
 NULL
 # ' @importFrom ggplot2 geom_abline
 
 .onLoad <- function(libname, pkgname) {
-
+  if (getRversion() >= "2.15.1") {
+    utils::globalVariables(
+      c(
+        ".", ".SD", ".N", "..vars"
+      )
+    )
+  }
 }
 
 #' @keywords internal
-#' @export 
+#' @export
 init_lattice <- function() {
-    # lattice.layers:::`+.trellis`
-    # environment(latticeExtra:::`+.trellis`)
-    suppressWarnings({
-        eval(parse(text = 'environment(draw.colorkey) <- environment(lattice::xyplot)'))  
-        eval(parse(text = 'assignInNamespace("draw.colorkey", draw.colorkey, ns="lattice")'))
-    })
-    # asign_func(draw.colorkey, lattice::draw.colorkey)
-    # invisible()
+  # lattice.layers:::`+.trellis`
+  # environment(latticeExtra:::`+.trellis`)
+  suppressWarnings({
+    eval(parse(text = "environment(draw.colorkey) <- environment(lattice::xyplot)"))
+    eval(parse(text = 'assignInNamespace("draw.colorkey", draw.colorkey, ns="lattice")'))
+  })
+  # asign_func(draw.colorkey, lattice::draw.colorkey)
+  # invisible()
 }

R/layer_statistic.R

@@ -1,24 +1,26 @@
-#' @export
-layer_statistic <- function(
-  mapping = NULL, data = NULL,
-  x = 0, y = 1, hjust = 0, vjust = 1, family = "Times",
-  digit = 2,
-  color = NULL, ...)
-{
-  fun <- function(data, coords) {
-    l = data$z %>% stat_statistic()
+# #' @export
+# layer_statistic <- function(
+#   mapping = NULL, data = NULL,
+#   x = 0, y = 1, hjust = 0, vjust = 1, family = "Times",
+#   digit = 2,
+#   color = NULL, ...)
+# {
+#   fun <- function(data, coords) {
+#     l = data$z %>% stat_statistic()
 
-    fmt = glue(" = %.{digit}f ± %.{digit}f")
-    num = sprintf(fmt, l$mean, l$sd)
-    label = eval(substitute(expression(bar(italic(u))*" ± "*italic(sd)~num),
-                            list(num = num)))
+#     fmt = glue(" = %.{digit}f ± %.{digit}f")
+#     num = sprintf(fmt, l$mean, l$sd)
+#     label = eval(substitute(expression(bar(italic(u))*" ± "*italic(sd)~num),
+#                             list(num = num)))
 
-    element_grob_text(label = label,
-                      x = x, y = y,
-                      vjust = vjust, hjust = hjust, family = family, ...)
-    # richtextGrob(label, x, y, hjust, vjust, mar,
-    #     family = family, fontface = fontface, fontsize = fontsize,
-    #     color = color, ...)
-  }
-  grid_panel(fun, mapping, data)
-}
+#     element_grob_text(label = label,
+#                       x = x, y = y,
+#                       vjust = vjust, hjust = hjust, family = family, ...)
+#     # richtextGrob(label, x, y, hjust, vjust, mar,
+#     #     family = family, fontface = fontface, fontsize = fontsize,
+#     #     color = color, ...)
+#   }
+#   grid_panel(fun, mapping, data)
+# }
+
+# stat_statistic is missing

R/stat_gof.R

@@ -26,7 +26,9 @@ StatGOF <- ggproto("StatGOF", Stat,
 #' stat_gof
 #' 
 #' @inheritParams geom_richtext_npc
-#'
+#' @param label.format format string for label, default `fmt_gof`
+#' @param show.bias whether to show bias
+#' 
 #' @return No return. This function is used to calculate data for gglot2 `geom_*`,
 #' just like [ggplot2::stat_smooth()].
 #' 
@@ -55,6 +57,7 @@ stat_gof <- function(mapping = NULL, data = NULL,
   )
 }
 
+#' @inheritParams ggplot2::element_text
 #' @rdname stat_gof
 #' @export 
 geom_gof <- function(mapping = NULL, data = NULL,

R/stat_prob_2d.R

@@ -7,6 +7,9 @@ snake_class = ggplot2:::snake_class
 data_frame0 <- function(...) vctrs::data_frame(..., .name_repair = "minimal")
 
 #' prob density
+#' 
+#' @param geom Use to override the default connection between [geom_prob_2d()] and [stat_prob_2d].
+#' 
 #' @inheritParams ggplot2::stat_density_2d
 #' @example  R/examples/ex-stat_prob_2d.R
 #' @export

R/stat_signPattern.R

@@ -16,6 +16,8 @@ StatSignPattern <- ggproto("StatSignPattern", StatSf,
 #' stat_signPattern
 #' 
 #' @inheritParams ggpattern::geom_sf_pattern
+#' @param geom Use to override the default connection between [geom_signPattern()] 
+#' and [stat_signPattern].
 #' @param ... other parameters to [ggpattern::geom_sf_pattern()]
 #' 
 #' @seealso [ggpattern::geom_sf_pattern()]

R/str_format.R

@@ -43,6 +43,9 @@ label_num <- function(fmt = "%.2f") {
   function(x) sprintf(fmt, x)
 }
 
+#' @param labels character vector
+#' @param ... ignored
+#' 
 #' @rdname str_mk
 #' @export
 label_mk <- function(labels, ...) {