second try

DESCRIPTION

@@ -31,7 +31,6 @@ Suggests:
     mapview,
     lattice,
     cowplot,
-    glue,
     gridExtra, 
     knitr,
     rmarkdown

R/GOF.R

@@ -121,6 +121,7 @@ GOF <- function(obs, sim, w, include.cv = FALSE, include.r = TRUE){
 }
 
 
+#' @param ... ignored
 #' @rdname GOF
 #' @export
 KGE <- function(obs, sim, w = c(1, 1, 1), ...) {

R/colorbar.R

@@ -16,8 +16,8 @@
 #' - `fontface`: The font face (bold, italic, ...)
 #' - `lineheight`:
 #' @param padding.left,padding.right padding in the left and right of the legend
-#'
 #' @param hjust,vjust used in [grid::grid.layout()]
+#' 
 #'
 #' @example R/examples/ex-make_colorbar.R
 #' @importFrom grid unit

R/colorbar_add.R

@@ -1,50 +1,56 @@
 #' add_colorbar
 #'
+#' @param p a ggplot object
+#' @param g a grob object, colorbar
+#' @param width,height width and height of the colorbar
+#' 
 #' @inheritParams make_colorbar
 #' @param space one of `c("left", "bottom")`
-#' 
+#'
 #' @import gtable ggplotify
 #' @importFrom ggplot2 ggplotGrob ggplot_add
 #' @importFrom grid grobHeight grobWidth
 #' @export
-add_colorbar <- function(p, g, 
+add_colorbar <- function(
+    p, g,
     width = NULL, height = NULL,
     title = NULL,
     space = "right",
-    legend.title = element_text(hjust = 0, vjust = 0, size = 14, family = "Times"))
-{
-    if (!("gtable" %in% class(p))) p <- ggplotGrob(p)
-    dim = dim(p)
+    legend.title = element_text(hjust = 0, vjust = 0, size = 14, family = "Times")) {
+  if (!("gtable" %in% class(p))) p <- ggplotGrob(p)
+  dim <- dim(p)
 
-    loc = p$layout %>% subset(grepl("panel", name)) #%>% .[nrow(.), ]
-    if (!is.null(title)) {
-        g_title = element_grob(legend.title, title, x = 0, y = 0.5)
-    } else {
-        g_title = nullGrob()
-    }
+  loc <- p$layout %>% subset(grepl("panel", name)) # %>% .[nrow(.), ]
+  if (!is.null(title)) {
+    g_title <- element_grob(legend.title, title, x = 0, y = 0.5)
+  } else {
+    g_title <- nullGrob()
+  }
 
-    # p2$layout$clip <- "on"
-    # g = as.grob(g)
-    if (space == "right") {
-        if (is.null(width)) {
-            width = max(grobWidth(g), grobWidth(g_title))
-        }
-        p2 = p %>% gtable_add_cols(width)
-        ans = gtable_add_grob(p2, g, l = dim[2] + 1, t = min(loc$t), b = max(loc$b), clip = "off")
-        ans <- gtable_add_grob(ans, g_title, l = dim[2] + 1, t = min(loc$t) - 1, clip = "off")
-    } else if (space == "bottom"){
-        if (is.null(height)) {
-            height = max(grobHeight(g), grobHeight(g_title))
-        }
-        p2 = p %>% gtable_add_rows(height)
-        ans = gtable_add_grob(p2, g, l = min(loc$l), r = max(loc$r), 
-            t = dim[1] + 1, clip = "off")
-        ans <- gtable_add_grob(ans, g_title, l = max(loc$r), t = dim[1] + 1, clip = "off")
-    } else {
-        stop("space only supports `right` or `bottom`")
+  # p2$layout$clip <- "on"
+  # g = as.grob(g)
+  if (space == "right") {
+    if (is.null(width)) {
+      width <- max(grobWidth(g), grobWidth(g_title))
+    }
+    p2 <- p %>% gtable_add_cols(width)
+    ans <- gtable_add_grob(p2, g, l = dim[2] + 1, t = min(loc$t), b = max(loc$b), clip = "off")
+    ans <- gtable_add_grob(ans, g_title, l = dim[2] + 1, t = min(loc$t) - 1, clip = "off")
+  } else if (space == "bottom") {
+    if (is.null(height)) {
+      height <- max(grobHeight(g), grobHeight(g_title))
     }
-    ans
-    # as.ggplot(ans)
+    p2 <- p %>% gtable_add_rows(height)
+    ans <- gtable_add_grob(p2, g,
+      l = min(loc$l), r = max(loc$r),
+      t = dim[1] + 1, clip = "off"
+    )
+    ans <- gtable_add_grob(ans, g_title, l = max(loc$r), t = dim[1] + 1, clip = "off")
+  } else {
+    stop("space only supports `right` or `bottom`")
+  }
+  ans
+  # as.ggplot(ans)
 }
 
 
@@ -59,19 +65,19 @@ gtable_add <- function(object, plot, object_name) UseMethod("gtable_add", object
 
 #' @export
 gtable_add.colorbar <- function(object, plot, object_name) {
-    # plot = plot + theme(legend.position = "none")
-    add_colorbar(plot, object)
+  # plot = plot + theme(legend.position = "none")
+  add_colorbar(plot, object)
 }
 
 #' @export
 gtable_add.default <- function(object, plot, object_name) {
-    as.ggplot(plot)
+  as.ggplot(plot)
 }
 
 #' @export
 ggplot_add.colorbar <- function(object, plot, object_name) {
-    # plot = plot + theme(legend.position = "none")
-    add_colorbar(plot, object)
+  # plot = plot + theme(legend.position = "none")
+  add_colorbar(plot, object)
 }
 
 # #' @export
@@ -86,20 +92,20 @@ colorbar_add <- function(b1, b2) UseMethod("colorbar_add", b1)
 
 #' @export
 colorbar_add.colorbar <- function(b1, b2) {
-    grobs(b1, b2, options = list(nrow = 1))
+  grobs(b1, b2, options = list(nrow = 1))
 }
 
 #' @export
 colorbar_add.gg <- function(b1, b2) {
-    add_colorbar(b2, b1)
-    # grobs(b1, b2, options = list(nrow = 1))
+  add_colorbar(b2, b1)
+  # grobs(b1, b2, options = list(nrow = 1))
 }
 
 #' @export
 print.gtable <- function(x, ..., verbose = FALSE) {
-    if (verbose) {
-        gtable:::print.gtable(r)
-    } else {
-        print(as.ggplot(x))
-    }
+  if (verbose) {
+    gtable:::print.gtable(x)
+  } else {
+    print(as.ggplot(x))
+  }
 }

R/examples/ex-geom_richtext_npc.R

@@ -29,15 +29,17 @@ d$label <- c(
   "Some text **in bold.**",
   "Linebreaks<br>Linebreaks<br>Linebreaks",
   "*x*<sup>2</sup> + 5*x* + *C*<sub>*i*</sub>",
-  "Some <span style='color:blue'>blue text **in bold.**</span><br>And *italics text.*<br>
-    And some <span style='font-size:18pt; color:black'>large</span> text."
+  "Some <span style='color:blue'>blue text **in bold.**</span><br>And 
+  *italics text.*<br>
+  And some <span style='font-size:18pt; color:black'>large</span> text."
 )
 ggplot(d, aes(npcx = x, npcy = y)) +
   geom_richtext_npc(aes(npcx = x, npcy = y, label = label))
 
 ## test for `str_mk`
 library(magrittr)
-indexes_lev = c("DOY_first", "DOY_last", "HWD", "HWI", "HWS_mean", "HWS_sum", "HWA_avg", "HWA_max", "HWA_sum")
+indexes_lev = c("DOY_first", "DOY_last", "HWD", "HWI", "HWS_mean", 
+  "HWS_sum", "HWA_avg", "HWA_max", "HWA_sum")
 labels = indexes_lev %>% str_mk() #%>% label_tag(expression = F)
 d = data.frame(x = 0.5, y = 0.5, label = labels)
 

R/geom_annotation.R

@@ -2,6 +2,7 @@
 #'
 #' @inheritParams ggplot2::geom_point
 #' @inheritParams ggplot2::annotation_custom
+#' @inheritParams grid::viewport
 #' 
 #' @param data A tibble with the column of `grob`
 #' 

R/geom_annotation_func.R

@@ -3,6 +3,7 @@
 #' @inheritParams geom_annotation
 #' @inheritParams grid::viewport
 #' 
+#' @param plot.fun function to plot, `p <- plot.fun(data, ...)`
 #' @param ... other parameters to `plot.fun`
 #' 
 #' @example R/examples/ex-geom_anno_func.R

R/geom_barchart.R

@@ -15,7 +15,7 @@ add_barchart <- function(
   dat <- as.data.frame(table(x)) %>%
     # as.data.table(table(x)) %>%
     cbind(I = 1:nrow(.)) %>%
-    mutate(perc = Freq / sum(Freq))
+    mutate(perc = .data$Freq / sum(.data$Freq))
   # mutate(perc = N/sum(N))
 
   n <- length(brks)

R/geom_boxplot2.R

@@ -7,6 +7,8 @@
 #' @inheritParams ggplot2::geom_boxplot
 #' @inheritSection ggplot2::geom_boxplot Summary statistics
 #' @param width.errorbar the width of errorbar (default 0.7)
+#' @param stat the statistical transformation to use on the data for this layer
+#' @param show.errorbar whether to show errorbar (default TRUE)
 #' 
 #' @eval ggplot2:::rd_aesthetics("geom", "boxplot")
 #' @seealso [geom_quantile()] for continuous `x`,

R/geom_latFreq.R

@@ -1,5 +1,8 @@
 #' geom_latFreq
 #' @inheritParams ggplot2::geom_point
+#' @param bbox bounding box of the plot, in the form of `c(xmin, xmax, ymin, ymax)`.
+#' @param options parameters of [make_latFreq()]
+#' 
 #' @example R/examples/ex-geom_latFreq.R
 #' @export
 geom_latFreq <- function(mapping = NULL, data = NULL,

R/geom_mk.R

@@ -34,7 +34,8 @@ GeomMK <- ggproto("GeomMK", Geom,
 #' geom_mk
 #'
 #' @inheritParams ggplot2::geom_abline
-#'
+#' @param fun_slope function to calculate slope, default [rtrend::slope_mk()]
+#' 
 #' @export
 geom_mk <- function(mapping = NULL, data = NULL,
                     stat = "identity", position = "identity",

R/geom_prcpRunoff.R

@@ -97,8 +97,15 @@ GeomPrcpRunoff <- ggproto(
 #' "blue", colour = "white", linetype = "solid", linewidth = 0.1)`. See
 #' [ggplot2::geom_tile()] for all supported parameters.
 #'
-#' @param prcp.coef,prcp.max coefficient of precipitation, `y_new = prcp.qmax
+#' @param prcp.coef coefficient of precipitation, `y_new = prcp.qmax
 #' - prcp * prcp.coef`
+#' @param prcp.color color of precipitation
+#' @param prcp.fill fill of precipitation
+#' @param prcp.qmax maximum of streamflow, used to calculate `prcp.coef`
+#' 
+#' @param sec.axis secondary axis for precipitation, returned by 
+#' [ggplot2::sec_axis()]
+#' @param sec.name name of secondary axis
 #' 
 #' @importFrom ggplot2 layer
 #' @importFrom rlang list2

R/geom_richtext_npc.R

@@ -98,6 +98,7 @@ GeomRichTextNpc <- ggplot2::ggproto("GeomRichTextNpc", GeomRichText,
   draw_key = function(...) { grid::nullGrob() }
 )
 
+#' @inheritParams grid::grid.text
 #' @rdname geom_richtext_npc
 #' @importFrom ggplot2 theme_get
 #' @export

R/geom_taylor.R

@@ -25,7 +25,12 @@ taylor_data <- function(ref, model, sd.method = "sample", normalize = FALSE, ...
 }
 
 #' geom_taylor
+#' 
 #' @inheritParams ggplot2::geom_point
+#' @param show.obs.label logical, whether to show the label of observed point.
+#' @param obj.colour color of observed point. 
+#' @param obj.size size of observed point.
+#' 
 #' @example R/examples/ex-geom_taylor.R
 #' @export
 geom_taylor <- function(mapping = NULL, data = NULL,

R/gg.layers-package.R

@@ -19,7 +19,8 @@ NULL
   if (getRversion() >= "2.15.1") {
     utils::globalVariables(
       c(
-        ".", ".SD", ".N", "..vars"
+        ".", ".SD", ".N", "..vars", 
+        "vals", "value", "r"
       )
     )
   }

R/grobs.R

@@ -10,7 +10,9 @@ grobs <- function(..., options = list(nrow = 1)) {
 
 #' add grob to a plot
 #' 
+#' @param p ggplot object
 #' @param ... grob objects
+#' @param ggplot logical, if TRUE, return a ggplot object
 #' 
 #' @example R/examples/ex-add_grob.R
 #' 

R/guide-colorbar.R

@@ -223,7 +223,7 @@ guide_train.colorbar2 <- function(guide, scale, aesthetic = NULL) {
   if (length(breaks) == 0 || all(is.na(breaks)))
     return()
 
-  ticks <- data_frame(scale$map(breaks), .name_repair = ~ aesthetic %||% scale$aesthetics[1])
+  ticks <- tibble(scale$map(breaks), .name_repair = ~ aesthetic %||% scale$aesthetics[1])
   ticks$.value <- breaks
   ticks$.label <- scale$get_labels(breaks)
 

R/layer_PosNeg_sign.R

@@ -4,8 +4,7 @@ layer_PosNeg_sign <- function(
     mapping = NULL, data = NULL,
     x = 0.5, y = 0.5, height.factor = 1.2,
     # width = unit(0.3, "npc"), height = width, just = c(0, 0),
-    size = 12, ...)
-{
+    size = 12, ...) {
   fun <- function(data, coords) {
     add_PosNeg_sign(data$z, data$mask, x, y, height.factor, size = size, ...)
   }
@@ -19,32 +18,39 @@ layer_PosNeg_sign <- function(
 #' @param ... other parameters to [element_grob_text()]
 #' @rdname layer_PosNeg
 #' @export
-add_PosNeg_sign <- function(z, mask,
-  x = 0.5, y = 0.5, height.factor = 1.2,
-  cols = c("blue", "red"), alpha = 0.8, ...)
-{
-  z = sign(z)
-  n = length(z)
-  n_pos = sum(z == 1, na.rm = TRUE)
-  n_pos_sign = sum(z == 1 & mask == 1, na.rm = TRUE)
+add_PosNeg_sign <- function(
+    z, mask,
+    x = 0.5, y = 0.5, height.factor = 1.2,
+    cols = c("blue", "red"), alpha = 0.8, ...) {
+  z <- sign(z)
+  n <- length(z)
+  n_pos <- sum(z == 1, na.rm = TRUE)
+  n_pos_sign <- sum(z == 1 & mask == 1, na.rm = TRUE)
 
-  n_neg = sum(z == -1, na.rm = TRUE)
-  n_neg_sign = sum(z == -1 & mask == 1, na.rm = TRUE)
+  n_neg <- sum(z == -1, na.rm = TRUE)
+  n_neg_sign <- sum(z == -1 & mask == 1, na.rm = TRUE)
 
-  levs = c("P", "N") #%>% rev()
-  cols = set_names(cols, c("N", "P"))
-  df = data.frame(sign = factor(c("N", "P"), levs),
-                perc      = c(n_neg, n_pos)/n,
-                perc_sign = c(n_neg_sign, n_pos_sign)/n) %>%
-    mutate(label = sprintf("%s: %.1f%% (%.1f%%)", sign, perc*100, perc_sign*100),
-            pos = c(perc[1]*0.75, perc[1] + perc[2]*0.75))
+  levs <- c("P", "N") # %>% rev()
+  cols <- set_names(cols, c("N", "P"))
+  df <- data.frame(
+    sign = factor(c("N", "P"), levs),
+    perc = c(n_neg, n_pos) / n,
+    perc_sign = c(n_neg_sign, n_pos_sign) / n
+  ) %>%
+    mutate(
+      label = sprintf(
+        "%s: %.1f%% (%.1f%%)",
+        .data$sign, .data$perc * 100, .data$perc_sign * 100
+      ),
+      pos = c(.data$perc[1] * 0.75, .data$perc[1] + .data$perc[2] * 0.75)
+    )
 
   if (is.null(mask)) {
-    df %<>% mutate(label = sprintf("%s: %.1f%%", sign, perc*100))
+    df %<>% mutate(label = sprintf("%s: %.1f%%", .data$sign, .data$perc * 100))
   }
-  g1 = element_grob_text(label = df$label[1], x = x, y = y, colour = cols[1], alpha = alpha, ...)
-  height = as.numeric(convertHeight(grobHeight(g1), "npc")) * height.factor
+  g1 <- element_grob_text(label = df$label[1], x = x, y = y, colour = cols[1], alpha = alpha, ...)
+  height <- as.numeric(convertHeight(grobHeight(g1), "npc")) * height.factor
 
-  g2 = element_grob_text(label = df$label[2], x = x, y = y - height, colour = cols[2], alpha = alpha, ...)
+  g2 <- element_grob_text(label = df$label[2], x = x, y = y - height, colour = cols[2], alpha = alpha, ...)
   grobTree(g1, g2)
 }

R/scale_fill_gradientn2.R

@@ -11,6 +11,8 @@ censor2 <- function(x, range = c(0, 1), only.finite = TRUE) {
 #' scale_fill_gradientn2
 #'
 #' @inheritParams ggplot2::scale_fill_gradientn
+#' @param oob function that handles limits outside of the scale limits
+#' 
 #' @export 
 scale_fill_gradientn2 <- function(
     ...,