diff --git a/NAMESPACE b/NAMESPACE index 00c4f0286..a9cdba643 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -140,6 +140,7 @@ importFrom(dplyr,across) importFrom(dplyr,all_of) importFrom(dplyr,arrange) importFrom(dplyr,bind_cols) +importFrom(dplyr,bind_rows) importFrom(dplyr,everything) importFrom(dplyr,group_by) importFrom(dplyr,last_col) diff --git a/R/ggfacet.R b/R/ggfacet.R index 108982315..3a85e794e 100644 --- a/R/ggfacet.R +++ b/R/ggfacet.R @@ -40,6 +40,7 @@ #' p <- ggfacet(NIR_sub, x_cols, y_cols, scales = "fixed") #' p_(p) #' } +#' @importFrom dplyr arrange .data reframe ggfacet <- function( data, mapping = NULL, columnsX = 1:ncol(data), @@ -91,19 +92,14 @@ ggfacet <- function( columnLabelsY <- columnLabelsY[!is_factor_y] } - tall_data <- ddply( - expand.grid(.x_col = columnsX, .y_col = columnsY), - c(".x_col", ".y_col"), - function(row) { - x_var <- row$.x_col[1] - y_var <- row$.y_col[1] - - ret <- data - ret[[".x_val"]] <- data[[x_var]] - ret[[".y_val"]] <- data[[y_var]] - ret - } - ) + tall_data <- expand.grid(.x_col = columnsX, .y_col = columnsY) %>% + reframe( + .by = c(".x_col", ".y_col"), + data, + .x_val = data[[.data$.x_col]], + .y_val = data[[.data$.y_col]] + ) %>% + arrange(.x_col,, .y_col) if (is.null(mapping)) { mapping <- aes() diff --git a/R/ggnetworkmap.R b/R/ggnetworkmap.R index 461178764..278485338 100644 --- a/R/ggnetworkmap.R +++ b/R/ggnetworkmap.R @@ -42,6 +42,7 @@ if (getRversion() >= "2.15.1") { #' @param ... other arguments supplied to geom_text for the node labels. Arguments pertaining to the title or other items can be achieved through \pkg{ggplot2} methods. #' @author Amos Elberg. Original by Moritz Marbach, Francois Briatte #' @details This is a function for plotting graphs generated by \code{network} or \code{igraph} in a more flexible and elegant manner than permitted by ggnet. The function does not need to be the first plot in the ggplot chain, so the graph can be plotted on top of a map or other chart. Segments can be straight lines, or plotted as great circles. Note that the great circles feature can produce odd results with arrows and with vertices beyond the plot edges; this is a \pkg{ggplot2} limitation and cannot yet be fixed. Nodes can have two color schemes, which are then plotted as the center and ring around the node. The color schemes are selected by adding scale_fill_ or scale_color_ just like any other \pkg{ggplot2} plot. If there are no rings, scale_color sets the color of the nodes. If there are rings, scale_color sets the color of the rings, and scale_fill sets the color of the centers. Note that additional arguments in the ... are passed to geom_text for plotting labels. +#' @importFrom dplyr bind_rows #' @importFrom utils installed.packages #' @examples #' # small function to display plots only if it's interactive @@ -325,11 +326,9 @@ ggnetworkmap <- function( pts <- 25 # number of intermediate points for drawing great circles i <- 0 # used to keep track of groups when getting intermediate points for great circles - edges <- ddply( - .data = edges, - .variables = c("lat1", "lat2", "lon1", "lon2"), - .parallel = FALSE, - .fun = function(x) { + edges <- edges %>% + split(edges[, c("lat1", "lat2", "lon1", "lon2")]) %>% + lapply(function(x) { p1Mat <- x[, c("lon1", "lat1")] colnames(p1Mat) <- NULL p2Mat <- x[, c("lon2", "lat2")] @@ -370,8 +369,8 @@ ggnetworkmap <- function( return(ret) } } - } - ) + }) %>% + bind_rows() edge_aes$x <- substitute(lon) edge_aes$y <- substitute(lat) diff --git a/tests/testthat/test-ggfacet.R b/tests/testthat/test-ggfacet.R index 521a8a79e..4faf0a572 100644 --- a/tests/testthat/test-ggfacet.R +++ b/tests/testthat/test-ggfacet.R @@ -1,8 +1,14 @@ -skip_if_not_installed("chemometrics") +test_that("simple test with iris data", { + p <- ggfacet(iris, columnsX = 1:2, columnsY = 3:4) + expect_s3_class(p, "ggplot") + expect_equal(dim(p$data), c(4L * nrow(iris), ncol(iris) + 4L)) -data(NIR, package = "chemometrics") -NIR_sub <- data.frame(NIR$yGlcEtOH, NIR$xNIR[, 1:3]) + expect_equal( + dim(ggfacet(mtcars, columnsX = 1:2, columnsY = 3:5)$data), + c(6L * nrow(mtcars), ncol(mtcars) + 4L) + ) +}) test_that("warnings", { expect_warning( @@ -16,6 +22,11 @@ test_that("warnings", { }) test_that("generally works", { + skip_if_not_installed("chemometrics") + + data(NIR, package = "chemometrics") + NIR_sub <- data.frame(NIR$yGlcEtOH, NIR$xNIR[, 1:3]) + # factor variables vdiffr::expect_doppelganger( "factor",