GGally/ 0000755 0001762 0000144 00000000000 13277410307 011435 5 ustar ligges users GGally/inst/ 0000755 0001762 0000144 00000000000 13111462351 012403 5 ustar ligges users GGally/inst/doc/ 0000755 0001762 0000144 00000000000 13277320367 013165 5 ustar ligges users GGally/inst/doc/ggscatmat.html 0000644 0001762 0000144 00000000570 13001231535 016006 0 ustar ligges users
If not automatically redirected, please visit http://ggobi.github.io/ggally/index.html for the latest vignette.
GGally/inst/doc/rd.html 0000644 0001762 0000144 00000001153 13277320367 014460 0 ustar ligges usersIf not automatically redirected, please visit (http://ggobi.github.io/ggally/rd.html).
GGally/inst/doc/ggmatrix.html 0000644 0001762 0000144 00000000570 13001231535 015656 0 ustar ligges usersIf not automatically redirected, please visit http://ggobi.github.io/ggally/index.html for the latest vignette.
GGally/inst/doc/rd.Rmd 0000644 0001762 0000144 00000001121 13006440707 014220 0 ustar ligges users --- title: "GGally" subtitle: "Extension to 'ggplot2'" author: "Barret Schloerke" copyright: "Barret Schloerke" output: packagedocs::package_docs_rd: toc: true toc_collapse: true redirect: http://ggobi.github.io/ggally/rd.html vignette: | %\VignetteIndexEntry{GGally_rd} %\VignetteEngine{packagedocs::redirect} navpills: |If not automatically redirected, please visit (http://ggobi.github.io/ggally).
GGally/inst/doc/ggcoef.html 0000644 0001762 0000144 00000000570 13001231535 015266 0 ustar ligges usersIf not automatically redirected, please visit http://ggobi.github.io/ggally/index.html for the latest vignette.
GGally/inst/doc/gglyph.html 0000644 0001762 0000144 00000000570 13001231535 015326 0 ustar ligges usersIf not automatically redirected, please visit http://ggobi.github.io/ggally/index.html for the latest vignette.
GGally/inst/doc/ggduo.html 0000644 0001762 0000144 00000000570 13001231535 015141 0 ustar ligges usersIf not automatically redirected, please visit http://ggobi.github.io/ggally/index.html for the latest vignette.
GGally/inst/doc/ggsurv.html 0000644 0001762 0000144 00000000570 13001231535 015351 0 ustar ligges usersIf not automatically redirected, please visit http://ggobi.github.io/ggally/index.html for the latest vignette.
GGally/inst/doc/ggpairs.html 0000644 0001762 0000144 00000000570 13001231535 015470 0 ustar ligges usersIf not automatically redirected, please visit http://ggobi.github.io/ggally/index.html for the latest vignette.
GGally/inst/doc/ggnetworkmap.html 0000644 0001762 0000144 00000000570 13001231535 016541 0 ustar ligges usersIf not automatically redirected, please visit http://ggobi.github.io/ggally/index.html for the latest vignette.
GGally/tests/ 0000755 0001762 0000144 00000000000 13017123421 012565 5 ustar ligges users GGally/tests/testthat.R 0000644 0001762 0000144 00000000070 13001231535 014544 0 ustar ligges users library(testthat) library(GGally) test_check("GGally") GGally/tests/testthat/ 0000755 0001762 0000144 00000000000 13277410307 014437 5 ustar ligges users GGally/tests/testthat/test-utils.R 0000644 0001762 0000144 00000000707 13277311163 016703 0 ustar ligges users context("utils") test_that("require_namespaces", { if ("survival" %in% loadedNamespaces()) unloadNamespace("survival") expect_false("package:survival" %in% search()) suppressMessages(require_namespaces(c("survival"))) expect_false("package:survival" %in% search()) expect_false(is.null(getNamespace("survival"))) expect_error( suppressWarnings(suppressMessages( require_namespaces("DOES_NOT_EXIST_qweqweqweqwe") )) ) }) GGally/tests/testthat/test-ggcorr.R 0000644 0001762 0000144 00000004764 13276725426 017047 0 ustar ligges users context("ggcorr") # nba <- read.csv("http://datasets.flowingdata.com/ppg2008.csv") data(flea) test_that("limits", { print(ggcorr(flea[, -1])) print(ggcorr(flea[, -1], limits = TRUE)) print(ggcorr(flea[, -1], limits = FALSE)) print(ggcorr(flea[, -1], limits = NULL)) print(ggcorr(flea[, -1], limits = c(-5, 5))) print(ggcorr(flea[, -1], limits = c(-0.5, 0.5))) expect_true(TRUE) }) test_that("examples", { # Default output. p <- ggcorr(flea[, -1]) expect_equal(length(p$layers), 2) # Labelled output, with coefficient transparency. p <- ggcorr(flea[, -1], label = TRUE, label_alpha = TRUE, name = "") expect_equal(length(p$layers), 3) # Custom options. p <- ggcorr( flea[, -1], geom = "circle", max_size = 6, size = 3, hjust = 0.75, nbreaks = 6, angle = -45, palette = "PuOr" # colorblind safe, photocopy-able ) expect_equal(length(p$layers), 3) p <- ggcorr(flea[, -1], label = TRUE, name = "") expect_equal(length(p$layers), 3) # test other combinations of geoms + color scales ggcorr(flea[, -1], nbreaks = 4, palette = "PuOr") ggcorr(flea[, -1], nbreaks = 4, geom = "circle") ggcorr(flea[, -1], geom = "text") ggcorr(flea[, -1], geom = "text", limits = FALSE) ggcorr(flea[, -1], nbreaks = 4, geom = "text") ggcorr(flea[, -1], nbreaks = 4, palette = "PuOr", geom = "text") ggcorr(flea[, -1], label = TRUE, label_alpha = 0.5) }) test_that("non-numeric data", { expect_warning(ggcorr(flea), "not numeric") }) test_that("null midpoint", { expect_message(ggcorr(flea[, -1], midpoint = NULL), "Color gradient") }) test_that("further options", { ggcorr(flea[, -1], geom = "circle") ggcorr(flea[, -1], geom = "circle", limits = FALSE) ggcorr(flea[, -1], geom = "tile", nbreaks = 3) ggcorr(flea[, -1], geom = "tile", limits = FALSE) expect_error(ggcorr(flea[, -1], layout.exp = "a"), "incorrect layout.exp") expect_silent({ ggcorr(flea[, -1], layout.exp = 1) }) }) test_that("data.matrix", { p <- ggcorr(data.matrix(flea[, -1])) expect_equal(length(p$layers), 2) }) test_that("cor_matrix", { p <- ggcorr(data = NULL, cor_matrix = cor(flea[, -1], use = "pairwise")) expect_equal(length(p$layers), 2) }) test_that("other geoms", { expect_error(ggcorr(flea[, -1], geom = "hexbin"), "incorrect geom") expect_silent({ ggcorr(flea[, -1], geom = "blank") }) }) test_that("backwards compatibility", { expect_silent({ ggcorr(flea[, -1], method = "everything") }) }) GGally/tests/testthat/test-wrap.R 0000644 0001762 0000144 00000002130 13001231535 016471 0 ustar ligges users context("wrap") test_that("errors", { fn <- ggally_points # named params expect_error(wrap(fn, NA), "all parameters") expect_error(wrap(fn, y = TRUE, 5), "all parameters") # named params to wrapp expect_error(wrapp(fn, list(5)), "'params' must") expect_error(wrapp(fn, table(1:10, 1:10)), "'params' must") expect_error(wrapp(fn, list(A = 4, 5)), "'params' must") # if the character fn doesn't exist expect_error(wrap("does not exist", A = 5), "The following") expect_error(wrapp("does not exist", list(A = 5)), "The following") }) test_that("wrap", { (regularPlot <- ggally_points( iris, ggplot2::aes(Sepal.Length, Sepal.Width), size = 5, color = "red" )) # Wrap ggally_points to have parameter values size = 5 and color = 'red' w_ggally_points <- wrap(ggally_points, size = 5, color = "red") (wrappedPlot <- w_ggally_points( iris, ggplot2::aes(Sepal.Length, Sepal.Width) )) # Double check the aes parameters are the same for the geom_point layer expect_true(identical(regularPlot$layers[[1]]$aes_params, wrappedPlot$layers[[1]]$aes_params)) }) GGally/tests/testthat/test-gg-plots.R 0000644 0001762 0000144 00000012532 13277311163 017276 0 ustar ligges users context("gg-plots") data(tips, package = "reshape") data(nasa) nas <- subset(nasa, x <= 2 & y == 1) expect_print <- function(x) { testthat::expect_silent(print(x)) } test_that("denstrip", { expect_message( suppressWarnings(print(ggally_denstrip(tips, mapping = aes_string("sex", "tip")))), "`stat_bin()` using `bins = 30`", fixed = TRUE ) expect_message( suppressWarnings(print(ggally_denstrip(tips, mapping = aes_string("tip", "sex")))), "`stat_bin()` using `bins = 30`", fixed = TRUE ) }) test_that("density", { p <- ggally_density( tips, mapping = ggplot2::aes_string(x = "total_bill", y = "tip", fill = "..level..") ) + ggplot2::scale_fill_gradient(breaks = c(0.05, 0.1, 0.15, 0.2)) expect_equal(p$labels$fill, "level") }) test_that("cor", { expect_warning( ggally_cor(tips, mapping = ggplot2::aes_string(x = "total_bill", y = "tip"), use = "NOTFOUND"), "correlation 'use' not found" ) ti <- tips class(ti) <- c("NOTFOUND", "data.frame") p <- ggally_cor(ti, ggplot2::aes(x = total_bill, y = tip, color = day), use = "complete.obs") expect_equal(mapping_string(get("mapping", envir = p$layers[[2]])$colour), "labelp") p <- ggally_cor( ti, ggplot2::aes(x = total_bill, y = tip, color = I("blue")), use = "complete.obs" ) expect_equal(mapping_string(get("mapping", envir = p$layers[[1]])$colour), "I(\"blue\")") expect_err <- function(..., msg = NULL) { expect_error( ggally_cor( ti, ggplot2::aes(x = total_bill, y = tip), ... ), msg ) } expect_err(corAlignPercent = 0.9, "'corAlignPercent' is deprecated") expect_err(corMethod = "pearson", "'corMethod' is deprecated") expect_err(corUse = "complete.obs", "'corUse' is deprecated") expect_print(ggally_cor(ti, ggplot2::aes(x = total_bill, y = tip, color = I("green")))) ti3 <- ti2 <- ti ti2[2, "total_bill"] <- NA ti3[2, "total_bill"] <- NA ti3[3, "tip"] <- NA ti3[4, "total_bill"] <- NA ti3[4, "tip"] <- NA expect_warn <- function(data, msg) { expect_warning( ggally_cor(data, ggplot2::aes(x = total_bill, y = tip)), msg ) } expect_warn(ti2, "Removing 1 row that") expect_warn(ti3, "Removed 3 rows containing") expect_error( ggally_cor( ti, ggplot2::aes(x = total_bill, y = tip, color = size) ), "ggally_cor: mapping color column" ) expect_silent( ggally_cor( ti, ggplot2::aes(x = total_bill, y = tip, color = as.factor(size)) ) ) }) test_that("diagAxis", { p <- ggally_diagAxis(iris, ggplot2::aes(x = Petal.Width)) pDat1 <- get("data", envir = p$layers[[2]]) attr(pDat1, "out.attrs") <- NULL testDt1 <- data.frame( xPos = c(0.076, 0.076, 0.076, 0.076, 0.076, 0.076, 0.500, 1.000, 1.500, 2.000, 2.500), yPos = c(0.500, 1.000, 1.500, 2.000, 2.500, 0.076, 0.076, 0.076, 0.076, 0.076, 0.076), lab = as.character(c(0.5, 1, 1.5, 2, 2.5, 0, 0.5, 1, 1.5, 2, 2.5)), hjust = c(0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.5, 0.5, 0.5, 0.5, 0.5), vjust = c(0.5, 0.5, 0.5, 0.5, 0.5, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0), stringsAsFactors = FALSE ) rownames(testDt1) <- 2:12 expect_equal(pDat1, testDt1) p <- ggally_diagAxis(iris, ggplot2::aes(x = Species)) pDat2 <- get("data", envir = p$layers[[2]]) attr(pDat2, "out.attrs") <- NULL testDt2 <- data.frame( x = c(0.125, 0.500, 0.875), y = c(0.875, 0.500, 0.125), lab = c("setosa", "versicolor", "virginica") ) expect_equal(pDat2, testDt2) expect_error({ ggally_diagAxis(iris, mapping = ggplot2::aes(y = Sepal.Length)) }, "mapping\\$x is null.") # nolint }) test_that("dates", { class(nas) <- c("NOTFOUND", "data.frame") p <- ggally_cor(nas, ggplot2::aes(x = date, y = ozone)) expect_equal(get("aes_params", envir = p$layers[[1]])$label, "Corr:\n0.278") p <- ggally_cor(nas, ggplot2::aes(y = date, x = ozone)) expect_equal(get("aes_params", envir = p$layers[[1]])$label, "Corr:\n0.278") p <- ggally_barDiag(nas, ggplot2::aes(x = date)) expect_equal(mapping_string(p$mapping$x), "date") expect_equal(p$labels$y, "count") }) test_that("rescale", { p <- ggally_densityDiag(tips, mapping = ggplot2::aes(x = day), rescale = FALSE) expect_true(p$labels$y == "density") expect_print(p) p <- ggally_densityDiag(tips, mapping = ggplot2::aes(x = day), rescale = TRUE) expect_true(! identical(p$labels$y, "density")) expect_print(p) p <- ggally_barDiag(tips, mapping = ggplot2::aes(x = tip), binwidth = 0.25, rescale = FALSE) expect_true(p$labels$y == "count") expect_print(p) p <- ggally_barDiag(tips, mapping = ggplot2::aes(x = tip), binwidth = 0.25, rescale = TRUE) expect_true(! identical(p$labels$y, "count")) expect_print(p) }) test_that("shrink", { p <- ggally_smooth_loess(iris, mapping = ggplot2::aes(Sepal.Width, Petal.Length)) expect_true(!is.null(p$coordinates$limits$y)) expect_print(p) p <- ggally_smooth_loess(iris, mapping = ggplot2::aes(Sepal.Width, Petal.Length), shrink = FALSE) expect_true(is.null(p$coordinates$limits$y)) expect_print(p) }) test_that("smooth_se", { p <- ggally_smooth_loess(iris, mapping = ggplot2::aes(Sepal.Width, Petal.Length), se = TRUE) expect_equal(p$layers[[2]]$stat_params$se, TRUE) expect_print(p) p <- ggally_smooth_loess(iris, mapping = ggplot2::aes(Sepal.Width, Petal.Length), se = FALSE) expect_equal(p$layers[[2]]$stat_params$se, FALSE) expect_print(p) }) GGally/tests/testthat/test-ggsurv.R 0000644 0001762 0000144 00000011624 13276725426 017072 0 ustar ligges users context("ggsurv") suppressMessages(require(survival)) suppressMessages(require(scales)) data(lung, package = "survival") data(kidney, package = "survival") sf.lung <- survival::survfit(Surv(time, status) ~ 1, data = lung) sf.kid <- survival::survfit(Surv(time, status) ~ disease, data = kidney) expect_print <- function(x) { testthat::expect_silent(print(x)) } test_that("single", { a <- ggsurv(sf.lung) expect_equivalent(mapping_string(a$mapping$x), "time") expect_equivalent(mapping_string(a$mapping$y), "surv") expect_true(is.null(a$labels$group)) expect_true(is.null(a$labels$colour)) expect_true(is.null(a$labels$linetype)) }) test_that("multiple", { a <- ggsurv(sf.kid) expect_equivalent(mapping_string(a$mapping$x), "time") expect_equivalent(mapping_string(a$mapping$y), "surv") expect_true(!is.null(a$labels$group)) expect_true(!is.null(a$labels$colour)) expect_true(!is.null(a$labels$linetype)) }) test_that("adjust plot", { a <- ggsurv(sf.kid, plot.cens = FALSE) expect_equivalent(length(a$layers), 1) a <- ggsurv(sf.kid, plot.cens = TRUE) expect_equivalent(length(a$layers), 2) }) test_that("stops", { noCensor <- subset(lung, status == 1) lungNoCensor <- survival::survfit(Surv(time, status) ~ 1, data = noCensor) # check that the surv.col and lty.est are of the correct length expect_error(ggsurv(lungNoCensor, surv.col = c("black", "red"))) expect_error(ggsurv(lungNoCensor, lty.est = 1:2)) # must have censor to plot expect_error(ggsurv(lungNoCensor, plot.cens = TRUE)) noCensor <- subset(kidney, status == 1) kidneyNoCensor <- survival::survfit(Surv(time, status) ~ disease, data = noCensor) # check that the surv.col and lty.est are of the correct length. should be 4 expect_error(ggsurv(kidneyNoCensor, surv.col = c("black", "red", "blue"))) expect_error(ggsurv(kidneyNoCensor, lty.est = 1:3)) # must have censor to plot expect_error(ggsurv(kidneyNoCensor, plot.cens = TRUE)) # must have censor to plot expect_silent( ggsurv(sf.kid, CI = TRUE, surv.col = c("black", "red", "blue", "green")) ) expect_silent( ggsurv(sf.kid, CI = TRUE, lty.est = 1:4) ) ggsurv(sf.kid, CI = TRUE, surv.col = "red") }) test_that("back.white", { sf.lung <- survival::survfit(Surv(time, status) ~ 1, data = lung) sf.kid <- survival::survfit(Surv(time, status) ~ disease, data = kidney) a <- ggsurv(sf.lung, back.white = FALSE) expect_true(length(a$theme) == 0) a <- ggsurv(sf.lung, back.white = TRUE) expect_true(length(a$theme) != 0) a <- ggsurv(sf.kid, back.white = FALSE) expect_true(length(a$theme) == 0) a <- ggsurv(sf.kid, back.white = TRUE) expect_true(length(a$theme) != 0) }) test_that("surv.col", { ggsurv(sf.lung, surv.col = "red") ggsurv(sf.kid, surv.col = "red") ggsurv(sf.kid, surv.col = c("black", "red", "blue", "green")) ggsurv(sf.kid, lty.est = 1) ggsurv(sf.kid, lty.est = 1:4) expect_true("idk how to test it happened" != "fail") }) test_that("CI", { a <- ggsurv(sf.lung, CI = FALSE) b <- ggsurv(sf.lung, CI = TRUE) expect_equivalent(length(b$layers) - length(a$layers), 2) a <- ggsurv(sf.kid, CI = FALSE) b <- ggsurv(sf.kid, CI = TRUE) expect_equivalent(length(b$layers) - length(a$layers), 2) }) test_that("multiple colors", { expect_print(ggsurv(sf.kid, plot.cens = TRUE)) expect_warning({ ggsurv(sf.kid, plot.cens = TRUE, cens.col = c("red", "blue")) }, "Color scales for censored points") # nolint expect_silent({ print( ggsurv(sf.kid, plot.cens = TRUE, cens.col = "blue") ) }) cusotm_color <- c("green", "blue", "purple", "orange") expect_silent({ print( ggsurv(sf.kid, plot.cens = TRUE, cens.col = cusotm_color) ) }) expect_warning({ ggsurv( sf.kid, plot.cens = TRUE, cens.col = cusotm_color, cens.shape = c(1, 2) ) }, "The length of the censored shapes") # nolint expect_silent({ print( ggsurv( sf.kid, plot.cens = TRUE, cens.col = cusotm_color, cens.shape = c(1, 2, 3, 4) ) ) }) }) test_that("cens.size", { a <- ggsurv(sf.lung) b <- ggsurv(sf.lung, cens.size = 5) expect_true(a$layers[[4]]$aes_params$size == 2) expect_true(b$layers[[4]]$aes_params$size != 2) a <- ggsurv(sf.kid) b <- ggsurv(sf.lung, cens.size = 5) expect_true(a$layers[[2]]$aes_params$size == 2) expect_true(b$layers[[2]]$aes_params$size != 2) }) # 881 R/ggsurv.r 231 231 0 # 883 R/ggsurv.r 242 242 0 # 884 R/ggsurv.r 247 249 0 # 885 R/ggsurv.r 248 248 0 # 886 R/ggsurv.r 251 255 0 # 887 R/ggsurv.r 252 252 0 # 888 R/ggsurv.r 254 254 0 # 889 R/ggsurv.r 256 258 0 # 890 R/ggsurv.r 263 263 0 # 891 R/ggsurv.r 274 274 0 GGally/tests/testthat/test-ggnetworkmap.R 0000644 0001762 0000144 00000016727 13277311163 020261 0 ustar ligges users context("ggnetworkmap") if ("package:igraph" %in% search()) { detach("package:igraph") } rq <- function(...) { require(..., quietly = TRUE) } rq(network) rq(sna) rq(maps) rq(ggplot2) rq(intergraph) # test igraph conversion # first 500 rows of http://datasets.flowingdata.com/tuts/maparcs/airports.csv # avoids downloading the dataset to test the package airports <- read.csv("data/airports.csv", header = TRUE) rownames(airports) <- airports$iata # select some random flights set.seed(1234) flights <- data.frame( origin = sample(airports[200:400, ]$iata, 200, replace = TRUE), destination = sample(airports[200:400, ]$iata, 200, replace = TRUE) ) # convert to network flights <- network(flights, directed = TRUE) # add geographic coordinates flights %v% "lat" <- airports[ network.vertex.names(flights), "lat" ] # nolint flights %v% "lon" <- airports[ network.vertex.names(flights), "long" ] # nolint # drop isolated airports delete.vertices(flights, which(degree(flights) < 2)) # compute degree centrality flights %v% "degree" <- degree(flights, gmode = "digraph") # add random groups flights %v% "mygroup" <- sample(letters[1:4], network.size(flights), replace = TRUE) # create a map of the USA usa <- ggplot(map_data("usa"), aes(x = long, y = lat)) + geom_polygon(aes(group = group), color = "grey65", fill = "#f9f9f9", size = 0.2) test_that("basic drawing", { # no map p <- ggnetworkmap(net = flights, size = 2) expect_true(is.null(nrow(p$data))) # overlay network data to map p <- ggnetworkmap(usa, flights, size = 2) expect_false(is.null(nrow(p$data))) }) test_that("great circles", { p <- ggnetworkmap(usa, flights, size = 2, great.circles = TRUE) expect_equal(length(p$layers), 3) expect_equal(get("aes_params", envir = p$layers[[3]])$colour, "black") }) test_that("node groups", { p <- ggnetworkmap(usa, flights, size = 2, great.circles = TRUE, node.group = degree) expect_equal(length(p$layers), 3) expect_true(is.null(get("aes_params", envir = p$layers[[3]])$colour)) expect_equal(mapping_string(get("mapping", envir = p$layers[[3]])$colour), ".ngroup") p <- ggnetworkmap(usa, flights, size = 2, great.circles = TRUE, node.color = "red") expect_equal(mapping_string(get("aes_params", envir = p$layers[[3]])$colour), "\"red\"") }) test_that("ring groups", { p <- ggnetworkmap(usa, flights, size = 2, great.circles = TRUE, node.group = degree, ring.group = mygroup) expect_equal(length(p$layers), 3) expect_true(is.null(get("aes_params", envir = p$layers[[3]])$colour)) expect_equal(mapping_string(get("mapping", envir = p$layers[[3]])$colour), ".rgroup") expect_equal(mapping_string(get("mapping", envir = p$layers[[3]])$fill), ".ngroup") }) test_that("segment color", { p <- ggnetworkmap(usa, flights, size = 2, great.circles = TRUE, node.group = degree, ring.group = mygroup, segment.color = "cornflowerblue" ) expect_equal(length(p$layers), 3) expect_true(is.null(get("aes_params", envir = p$layers[[3]])$colour)) expect_equal(mapping_string(get("mapping", envir = p$layers[[3]])$colour), ".rgroup") expect_equal(mapping_string(get("mapping", envir = p$layers[[3]])$fill), ".ngroup") expect_equal( mapping_string(get("aes_params", envir = p$layers[[2]])$colour), "\"cornflowerblue\"" ) }) test_that("weight", { p <- ggnetworkmap(usa, flights, size = 2, great.circles = TRUE, node.group = degree, ring.group = mygroup, segment.color = "cornflowerblue", weight = degree ) expect_equal(length(p$layers), 3) expect_true(is.null(get("aes_params", envir = p$layers[[3]])$colour)) expect_equal(mapping_string(get("mapping", envir = p$layers[[3]])$colour), ".rgroup") expect_equal(mapping_string(get("mapping", envir = p$layers[[3]])$fill), ".ngroup") expect_equal( mapping_string(get("aes_params", envir = p$layers[[2]])$colour), "\"cornflowerblue\"" ) expect_equal(mapping_string(get("mapping", envir = p$layers[[3]])$size), ".weight") }) test_that("labels", { p <- ggnetworkmap(usa, flights, size = 2, great.circles = TRUE, node.group = degree, ring.group = mygroup, segment.color = "cornflowerblue", weight = degree, label.nodes = TRUE) expect_equal(length(p$layers), 4) expect_true(is.null(get("aes_params", envir = p$layers[[3]])$colour)) expect_equal(mapping_string(get("mapping", envir = p$layers[[3]])$colour), ".rgroup") expect_equal(mapping_string(get("mapping", envir = p$layers[[3]])$fill), ".ngroup") expect_equal( mapping_string(get("aes_params", envir = p$layers[[2]])$colour), "\"cornflowerblue\"" ) expect_equal(mapping_string(get("mapping", envir = p$layers[[3]])$size), ".weight") expect_equal(mapping_string(get("mapping", envir = p$layers[[4]])$label), ".label") expect_true(is.null(get("aes_params", envir = p$layers[[2]])$arrow)) }) test_that("arrows", { p <- ggnetworkmap(usa, flights, size = 2, great.circles = TRUE, node.group = degree, ring.group = mygroup, segment.color = "cornflowerblue", weight = degree, label.nodes = TRUE, arrow.size = 0.2) expect_equal(length(p$layers), 4) expect_true(is.null(get("aes_params", envir = p$layers[[3]])$colour)) expect_equal(mapping_string(get("mapping", envir = p$layers[[3]])$colour), ".rgroup") expect_equal(mapping_string(get("mapping", envir = p$layers[[3]])$fill), ".ngroup") expect_equal( mapping_string(get("aes_params", envir = p$layers[[2]])$colour), "\"cornflowerblue\"" ) expect_equal(mapping_string(get("mapping", envir = p$layers[[3]])$size), ".weight") expect_equal(mapping_string(get("mapping", envir = p$layers[[4]])$label), ".label") # look at geom_params for arrow info expect_true(is.list(get("geom_params", envir = p$layers[[2]])$arrow)) }) test_that("labels", { expect_error(ggnetworkmap(usa, flights, label.nodes = c("A", "B"))) testLabels <- paste("L", 1:network.size(flights), sep = "") # does logical check p <- ggnetworkmap(usa, flights, label.nodes = testLabels) ## PROBLEM HERE: why would vertex.names be equal to testLabels? ## expect_equal(get("data", p$layers[[4]])$.label, testLabels) # does vertex.names check p <- ggnetworkmap(usa, flights, label.nodes = TRUE) expect_true(!is.null(get("data", p$layers[[4]])$.label)) # does id check flights2 <- flights flights2 %v% "id" <- testLabels p <- ggnetworkmap(usa, flights2, label.nodes = TRUE) expect_true(!is.null(get("data", p$layers[[4]])$.label)) }) ### --- test arrow.size test_that("arrow.size", { expect_error(ggnetworkmap(net = flights, arrow.size = -1), "incorrect arrow.size") expect_warning(ggnetworkmap(net = network(as.matrix(flights), directed = FALSE), arrow.size = 1), "arrow.size ignored") }) ### --- test network coercion test_that("network coercion", { expect_warning( ggnetworkmap(net = network(matrix(1, nrow = 2, ncol = 2), loops = TRUE)), "self-loops" ) expect_error(ggnetworkmap(net = 1:2), "network object") expect_error(ggnetworkmap(net = network(data.frame(1:2, 3:4), hyper = TRUE)), "hyper graphs") expect_error( ggnetworkmap(net = network(data.frame(1:2, 3:4), multiple = TRUE)), "multiplex graphs" ) }) ### --- test igraph functionality test_that("igraph conversion", { if (requireNamespace("igraph", quietly = TRUE)) { library(igraph) n <- asIgraph(flights) p <- ggnetworkmap(net = n) expect_equal(length(p$layers), 2) } }) expect_true(TRUE) GGally/tests/testthat/test-crosstalk.R 0000644 0001762 0000144 00000001725 13277315152 017553 0 ustar ligges users context("crosstalk") test_that("crosstalk works with ggduo and ggpairs", { skip_if_not_installed("crosstalk") sd <- crosstalk::SharedData$new(iris[1:4]) expect_silent({ pm <- ggpairs(sd) }) expect_error({ pm <- ggpairs(sd, 3:5) }, "Make sure your numeric" ) expect_error({ pm <- ggpairs(sd, c("Petal.Length", "Petal.Width", crosstalk_key())) }, "Columns in 'columns' not" ) expect_silent({ pm <- ggduo(sd) }) expect_error({ pm <- ggduo(sd, c(1:2, 5), 3:5) }, "Make sure your numeric 'columnsX'" ) expect_error({ pm <- ggduo( sd, c("Sepal.Length", "Sepal.Width", crosstalk_key()), c("Petal.Length", "Petal.Width") ) }, "Columns in 'columnsX' not" ) expect_error({ pm <- ggduo( sd, c("Sepal.Length", "Sepal.Width"), c("Petal.Length", "Petal.Width", crosstalk_key()) ) }, "Columns in 'columnsY' not" ) }) GGally/tests/testthat/test-ggparcoord.R 0000644 0001762 0000144 00000023066 13277311163 017675 0 ustar ligges users context("ggparcoord") set.seed(123) data(diamonds, package = "ggplot2") diamonds.samp <- diamonds[sample(1:dim(diamonds)[1], 100), ] iris2 <- iris iris2$alphaLevel <- c("setosa" = 0.2, "versicolor" = 0.3, "virginica" = 0)[iris2$Species] test_that("stops", { # basic parallel coordinate plot, using default settings # ggparcoord(data = diamonds.samp, columns = c(1, 5:10)) # this time, color by diamond cut expect_error( ggparcoord(data = diamonds.samp, columns = c(1, 5:10), groupColumn = NULL, order = "anyClass"), "can't use the 'order' methods " ) expect_error( ggparcoord(data = diamonds.samp, columns = c(1, 5:10), groupColumn = NULL, order = "allClass"), "can't use the 'order' methods " ) expect_error( ggparcoord(data = diamonds.samp, columns = c(1, 5:10), groupColumn = c(1, 2)), "invalid value for 'groupColumn'" ) expect_error( ggparcoord(data = diamonds.samp, columns = c(1, 5:10), groupColumn = 1i), "invalid value for 'groupColumn'" ) expect_error( ggparcoord(data = diamonds.samp, columns = c(1, 5:10), groupColumn = 2, scale = "notValid"), "invalid value for 'scale'" ) expect_error( ggparcoord( data = diamonds.samp, columns = c(1, 5:10), groupColumn = 2, centerObsID = nrow(diamonds.samp) + 10 ), "invalid value for 'centerObsID'" ) expect_error( ggparcoord(data = diamonds.samp, columns = c(1, 5:10), groupColumn = 2, missing = "notValid"), "invalid value for 'missing'" ) expect_error( ggparcoord(data = diamonds.samp, columns = c(1, 5:10), groupColumn = 2, order = "notValid"), "invalid value for 'order'" ) expect_error( ggparcoord(data = diamonds.samp, columns = c(1, 5:10), groupColumn = 2, order = 1i), "invalid value for 'order'" ) expect_error( ggparcoord(data = diamonds.samp, columns = c(1, 5:10), groupColumn = 2, showPoints = 1), "invalid value for 'showPoints'" ) expect_error( ggparcoord( data = diamonds.samp, columns = c(1, 5:10), groupColumn = 2, alphaLines = "notAColumn" ), "'alphaLines' column is missing in data" ) tmpDt <- diamonds.samp tmpDt$price[1] <- NA range(tmpDt$price) expect_error( ggparcoord( data = tmpDt, columns = c(1, 5:10), groupColumn = 2, alphaLines = "price" ), "missing data in 'alphaLines' column" ) expect_error( ggparcoord(data = diamonds.samp, columns = c(1, 5:10), groupColumn = 2, alphaLines = "price"), "invalid value for 'alphaLines' column; max range " ) expect_error( ggparcoord(data = diamonds.samp, columns = c(1, 5:10), groupColumn = 2, alphaLines = -0.1), "invalid value for 'alphaLines'; must be a scalar value" ) expect_error( ggparcoord(data = diamonds.samp, columns = c(1, 5:10), groupColumn = 2, alphaLines = 1.1), "invalid value for 'alphaLines'; must be a scalar value" ) expect_error( ggparcoord(data = diamonds.samp, columns = c(1, 5:10), groupColumn = 2, boxplot = 1), "invalid value for 'boxplot'" ) expect_error( ggparcoord(data = diamonds.samp, columns = c(1, 5:10), groupColumn = 2, shadeBox = c(1, 2)), "invalid value for 'shadeBox'; must be a single color" ) expect_error( ggparcoord(data = diamonds.samp, columns = c(1, 5:10), groupColumn = 2, shadeBox = "notacolor"), "invalid value for 'shadeBox'; must be a valid R color" ) expect_error( ggparcoord(diamonds.samp, columns = c(1, 5:10), groupColumn = 2, splineFactor = NULL), "invalid value for 'splineFactor'" ) }) test_that("alphaLines", { p <- ggparcoord( data = iris2, columns = 1:4, groupColumn = 5, order = "anyClass", showPoints = TRUE, title = "Parallel Coordinate Plot for the Iris Data", alphaLines = "alphaLevel" ) expect_equal(length(p$layers), 2) expect_equivalent(mapping_string(get("mapping", envir = p$layers[[1]])$alpha), "alphaLevel") }) test_that("splineFactor", { ## Use splines on values, rather than lines (all produce the same result) columns <- c(1, 5:10) p1 <- ggparcoord(diamonds.samp, columns, groupColumn = 2, splineFactor = TRUE) p2 <- ggparcoord(diamonds.samp, columns, groupColumn = 2, splineFactor = 3) splineFactor <- length(columns) * 3 p3 <- ggparcoord(diamonds.samp, columns, groupColumn = 2, splineFactor = I(splineFactor)) pList <- list(p1, p2, p3) for (p in pList) { expect_equivalent(mapping_string(get("mapping", envir = p$layers[[1]])$x), "spline.x") expect_equivalent(mapping_string(get("mapping", envir = p$layers[[1]])$y), "spline.y") tmp <- unique(as.numeric(get("data", envir = p$layers[[1]])$ggally_splineFactor)) expect_true( (tmp == 3) || (tmp == 21) ) } p <- ggparcoord( data = iris2, columns = 1:4, groupColumn = 5, splineFactor = 3, alphaLines = "alphaLevel" ) expect_equal(mapping_string(get("mapping", p$layers[[1]])$alpha), "alphaLevel") p <- ggparcoord( data = iris2, columns = 1:4, groupColumn = 5, splineFactor = 3, showPoints = TRUE ) expect_equal(length(p$layers), 2) expect_equal(mapping_string(get("mapping", p$layers[[1]])$x), "spline.x") expect_equal(mapping_string(get("mapping", p$layers[[2]])$y), "value") }) test_that("groupColumn", { ds2 <- diamonds.samp ds2$color <- mapping_string(ds2$color) # column 3 has a character # column 4 has a factor p <- ggparcoord(data = ds2, columns = c(1, 3:10), groupColumn = 2) expect_true("color" %in% levels(p$data$variable)) expect_true("clarity" %in% levels(p$data$variable)) expect_true(is.numeric(p$data$value)) expect_equal(mapping_string(p$mapping$colour), colnames(ds2)[2]) p <- ggparcoord( data = ds2, columns = c( "carat", "color", "clarity", "depth", "table", "price", "x", "y", "z" ), order = c(1, 3:10), groupColumn = "cut" ) expect_true("color" %in% levels(p$data$variable)) expect_true("clarity" %in% levels(p$data$variable)) expect_true(is.numeric(p$data$value)) expect_equal(levels(p$data$cut), levels(ds2$cut)) # group column is a regular column ## factor p <- ggparcoord(data = ds2, columns = c(1, 3:10), groupColumn = 4) expect_true("clarity" %in% levels(p$data$variable)) ## character p <- ggparcoord(data = ds2, columns = c(1, 3:10), groupColumn = 3) expect_true("color" %in% levels(p$data$variable)) ## numeric p <- ggparcoord(data = ds2, columns = c(1, 3:10), groupColumn = 1) expect_true("carat" %in% levels(p$data$variable)) }) test_that("scale", { for (scale in c("std", "robust", "uniminmax", "globalminmax", "center", "centerObs")) { p <- ggparcoord(data = diamonds.samp, columns = c(1, 5:10), groupColumn = 2, scale = scale) } expect_true(TRUE) }) test_that("missing", { ds2 <- diamonds.samp ds2[3, 1] <- NA for (missing in c("exclude", "mean", "median", "min10", "random")) { p <- ggparcoord(data = ds2, columns = c(1, 5:10), groupColumn = 2, missing = missing) } expect_true(TRUE) }) test_that("order", { if (requireNamespace("scagnostics", quietly = TRUE)) { for (ordering in c("Outlying", "Skewed", "Clumpy", "Sparse", "Striated", "Convex", "Skinny", "Stringy", "Monotonic")) { p <- ggparcoord(data = diamonds.samp, columns = c(1, 5:10), groupColumn = 2, order = ordering) expect_true(all(levels(p$data) != c("carat", "depth", "table", "price", "x", "y", "z"))) } } for (ordering in c("skewness", "allClass", "anyClass")) { p <- ggparcoord(data = diamonds.samp, columns = c(1, 5:10), groupColumn = 2, order = ordering) expect_true(all(levels(p$data) != c("carat", "depth", "table", "price", "x", "y", "z"))) } }) test_that("basic", { # no color supplied p <- ggparcoord(data = diamonds.samp, columns = c(1, 5:10)) expect_true(is.null(p$mapping$colour)) # color supplied p <- ggparcoord(data = diamonds.samp, columns = c(1, 5:10), groupColumn = 2) expect_false(is.null(p$mapping$colour)) # title supplied ttl <- "Parallel Coord. Plot of Diamonds Data" p <- ggparcoord(data = diamonds.samp, columns = c(1, 5:10), title = ttl) expect_equal(p$labels$title, ttl) col <- "blue" p <- ggparcoord(data = diamonds.samp, columns = c(1, 5:10), shadeBox = col) expect_equal(length(p$layers), 2) expect_equal(get("aes_params", envir = p$layers[[1]])$colour, col) p <- ggparcoord(data = diamonds.samp, columns = c(1, 5:10), mapping = ggplot2::aes(size = 1)) expect_equal(length(p$layers), 1) expect_equal(p$mapping$size, 1) }) test_that("size", { p <- ggparcoord(data = diamonds.samp, columns = c(1, 5:10), mapping = ggplot2::aes(size = gear)) expect_equal(mapping_string(p$mapping$size), "gear") p <- ggparcoord(data = diamonds.samp, columns = c(1, 5:10)) + ggplot2::aes(size = gear) expect_equal(mapping_string(p$mapping$size), "gear") }) test_that("columns containing only a single value do not cause an scaling error", { df <- data.frame(obs = 1:5, var1 = sample(10, 5), var2 = rep(3, 5)) # no scaling expect_silent(ggparcoord(data = df, columns = 1:3, scale = "globalminmax")) # requires scaling, must not throw an errror due to scaling the single values (to NaN) expect_silent(ggparcoord(data = df, columns = 1:3, scale = "uniminmax")) df2 <- data.frame(df, var3 = factor(c("a", "b", "c", "a", "c"))) # requires scaling, must not throw an errror due to scaling the single values (to NaN) expect_silent(ggparcoord(data = df2, columns = 1:4, scale = "uniminmax")) df3 <- data.frame(df2, var4 = factor(c("d", "d", "d", "d", "d"))) expect_silent(ggparcoord(data = df3, columns = 1:4, scale = "uniminmax")) expect_silent(ggparcoord(data = df3, columns = 1:4, scale = "robust")) expect_silent(ggparcoord(data = df3, columns = 1:4, scale = "std")) }) GGally/tests/testthat/data/ 0000755 0001762 0000144 00000000000 13277311163 015350 5 ustar ligges users GGally/tests/testthat/data/airports.csv 0000644 0001762 0000144 00000105450 13277311163 017735 0 ustar ligges users "iata","airport","city","state","country","lat","long" "00M","Thigpen ","Bay Springs","MS","USA",31.95376472,-89.23450472 "00R","Livingston Municipal","Livingston","TX","USA",30.68586111,-95.01792778 "00V","Meadow Lake","Colorado Springs","CO","USA",38.94574889,-104.5698933 "01G","Perry-Warsaw","Perry","NY","USA",42.74134667,-78.05208056 "01J","Hilliard Airpark","Hilliard","FL","USA",30.6880125,-81.90594389 "01M","Tishomingo County","Belmont","MS","USA",34.49166667,-88.20111111 "02A","Gragg-Wade ","Clanton","AL","USA",32.85048667,-86.61145333 "02C","Capitol","Brookfield","WI","USA",43.08751,-88.17786917 "02G","Columbiana County","East Liverpool","OH","USA",40.67331278,-80.64140639 "03D","Memphis Memorial","Memphis","MO","USA",40.44725889,-92.22696056 "04M","Calhoun County","Pittsboro","MS","USA",33.93011222,-89.34285194 "04Y","Hawley Municipal","Hawley","MN","USA",46.88384889,-96.35089861 "05C","Griffith-Merrillville ","Griffith","IN","USA",41.51961917,-87.40109333 "05F","Gatesville - City/County","Gatesville","TX","USA",31.42127556,-97.79696778 "05U","Eureka","Eureka","NV","USA",39.60416667,-116.0050597 "06A","Moton Municipal","Tuskegee","AL","USA",32.46047167,-85.68003611 "06C","Schaumburg","Chicago/Schaumburg","IL","USA",41.98934083,-88.10124278 "06D","Rolla Municipal","Rolla","ND","USA",48.88434111,-99.62087694 "06M","Eupora Municipal","Eupora","MS","USA",33.53456583,-89.31256917 "06N","Randall ","Middletown","NY","USA",41.43156583,-74.39191722 "06U","Jackpot/Hayden ","Jackpot","NV","USA",41.97602222,-114.6580911 "07C","Dekalb County","Auburn","IN","USA",41.30716667,-85.06433333 "07F","Gladewater Municipal","Gladewater","TX","USA",32.52883861,-94.97174556 "07G","Fitch H Beach","Charlotte","MI","USA",42.57450861,-84.81143139 "07K","Central City Municipal","Central City","NE","USA",41.11668056,-98.05033639 "08A","Wetumpka Municipal","Wetumpka","AL","USA",32.52943944,-86.32822139 "08D","Stanley Municipal","Stanley","ND","USA",48.30079861,-102.4063514 "08K","Harvard State","Harvard","NE","USA",40.65138528,-98.07978667 "08M","Carthage-Leake County","Carthage","MS","USA",32.76124611,-89.53007139 "09A","Butler-Choctaw County","Butler","AL","USA",32.11931306,-88.1274625 "09J","Jekyll Island","Jekyll Island","GA","USA",31.07447222,-81.42777778 "09K","Sargent Municipal","Sargent","NE","USA",41.63695083,-99.34038139 "09M","Charleston Municipal","Charleston","MS","USA",33.99150222,-90.078145 "09W","South Capitol Street","Washington","DC","USA",38.86872333,-77.00747583 "0A3","Smithville Municipal","Smithville","TN","USA",35.98531194,-85.80931806 "0A8","Bibb County","Centreville","AL","USA",32.93679056,-87.08888306 "0A9","Elizabethton Municipal","Elizabethton","TN","USA",36.37094306,-82.17374111 "0AK","Pilot Station","Pilot Station","AK","USA",61.93396417,-162.8929358 "0B1","Col. Dyke ","Bethel","ME","USA",44.42506444,-70.80784778 "0B4","Hartington Municipal","Hartington","NE","USA",42.60355556,-97.25263889 "0B5","Turners Falls","Montague","MA","USA",42.59136361,-72.52275472 "0B7","Warren-Sugar Bush","Warren","VT","USA",44.11672722,-72.82705806 "0B8","Elizabeth ","Fishers Island","NY","USA",41.25130806,-72.03161139 "0C0","Dacy","Chicago/Harvard","IL","USA",42.40418556,-88.63343222 "0C4","Pender Municipal","Pender","NE","USA",42.11388722,-96.72892556 "0D1","South Haven Municipal","South Haven","MI","USA",42.35083333,-86.25613889 "0D8","Gettysburg Municipal","Gettysburg","SD","USA",44.98730556,-99.9535 "0E0","Moriarty","Moriarty","NM","USA",34.98560639,-106.0094661 "0E8","Crownpoint","Crownpoint","NM","USA",35.71765889,-108.2015961 "0F2","Bowie Municipal","Bowie","TX","USA",33.60166667,-97.77556 "0F4","Loup City Municipal","Loup City","NE","USA",41.29028694,-98.99064278 "0F7","Fountainhead Lodge Airpark","Eufaula","OK","USA",35.38898833,-95.60165111 "0F8","William R Pogue Municipal","Sand Springs","OK","USA",36.17528,-96.15181028 "0F9","Tishomingo Airpark","Tishomingo","OK","USA",34.19592833,-96.67555694 "0G0","North Buffalo Suburban","Lockport","NY","USA",43.10318389,-78.70334583 "0G3","Tecumseh Municipal","Tecumseh","NE","USA",40.39944417,-96.17139694 "0G6","Williams County","Bryan","OH","USA",41.46736111,-84.50655556 "0G7","Finger Lakes Regional","Seneca Falls","NY","USA",42.88062278,-76.78162028 "0H1","Trego Wakeeney ","Wakeeney","KS","USA",39.0044525,-99.89289917 "0I8","Cynthiana-Harrison County","Cynthiana","KY","USA",38.36674167,-84.28410056 "0J0","Abbeville Municipal","Abbeville","AL","USA",31.60016778,-85.23882222 "0J4","Florala Municipal","Florala","AL","USA",31.04247361,-86.31156111 "0J6","Headland Municipal","Headland","AL","USA",31.364895,-85.30965556 "0K7","Humboldt Municipal","Humboldt","IA","USA",42.7360825,-94.24524167 "0L5","Goldfield","Goldfield","NV","USA",37.71798833,-117.2384119 "0L7","Jean","Jean","NV","USA",35.76827222,-115.3296378 "0L9","Echo Bay","Overton","NV","USA",36.31108972,-114.4638672 "0M0","Dumas Municipal","Dumas","AR","USA",33.8845475,-91.53429111 "0M1","Scott ","Parsons","TN","USA",35.63778,-88.127995 "0M4","Benton County","Camden","TN","USA",36.01122694,-88.12328833 "0M5","Humphreys County","Waverly","TN","USA",36.11659972,-87.73815889 "0M6","Panola County","Batesville","MS","USA",34.36677444,-89.90008917 "0M8","Byerley","Lake Providence","LA","USA",32.82587917,-91.187665 "0O3","Calaveras Co-Maury Rasmussen ","San Andreas","CA","USA",38.14611639,-120.6481733 "0O4","Corning Municipal","Corning","CA","USA",39.94376806,-122.1713781 "0O5","University","Davis","CA","USA",38.53146222,-121.7864906 "0Q5","Shelter Cove","Shelter Cove","CA","USA",40.02764333,-124.0733639 "0Q6","Shingletown","Shingletown","CA","USA",40.52210111,-121.8177683 "0R0","Columbia-Marion County","Columbia","MS","USA",31.29700806,-89.81282944 "0R1","Atmore Municipal","Atmore","AL","USA",31.01621528,-87.44675972 "0R3","Abbeville Chris Crusta Memorial","Abbeville","LA","USA",29.97576083,-92.08415167 "0R4","Concordia Parish","Vidalia","LA","USA",31.56683278,-91.50011889 "0R5","David G Joyce","Winnfield","LA","USA",31.96366222,-92.66026056 "0R7","Red River","Coushatta","LA","USA",31.99071694,-93.30739306 "0S7","Dorothy Scott","Oroville","WA","USA",48.958965,-119.4119622 "0S9","Jefferson County International","Port Townsend","WA","USA",48.04981361,-122.8012792 "0V2","Harriet Alexander ","Salida","CO","USA",38.53916389,-106.0458483 "0V3","Pioneer Village ","Minden","NE","USA",40.5149125,-98.94565083 "0V4","Brookneal/Campbell County","Brookneal","VA","USA",37.14172222,-79.01638889 "0V6","Mission Sioux","Mission","SD","USA",43.30694778,-100.6281936 "0V7","Kayenta","Kayenta","AZ","USA",36.70972139,-110.2367978 "10C","Galt","Chicago/Greenwood/Wonderlake","IL","USA",42.40266472,-88.37588917 "10D","Winsted Municipal","Winsted","MN","USA",44.94996278,-94.0669175 "10G","Holmes County","Millersburg","OH","USA",40.53716667,-81.95436111 "10N","Wallkill","Wallkill","NY","USA",41.62787111,-74.13375583 "10U","Owyhee","Owyhee","NV","USA",41.95323306,-116.1876014 "11A","Clayton Municipal","Clayton","AL","USA",31.88329917,-85.48491361 "11D","Clarion Cty","Clarion","PA","USA",41.22581222,-79.44098972 "11IS","Schaumburg Heliport","Chicago/Schaumburg","IL","USA",42.04808278,-88.05257194 "11J","Early County","Blakely","GA","USA",31.39698611,-84.89525694 "11R","Brenham Municipal","Brenham","TX","USA",30.219,-96.37427778 "12C","Rochelle Municipal","Rochelle","IL","USA",41.89300139,-89.07829 "12D","Tower Municipal","Tower","MN","USA",47.81833333,-92.29166667 "12J","Brewton Municipal","Brewton","AL","USA",31.05126306,-87.06796833 "12K","Superior Municipal","Superior","NE","USA",40.04636111,-98.06011111 "12Y","Le Sueur Municipal","Le Sueur","MN","USA",44.43746472,-93.91274083 "13C","Lakeview","Lakeview","MI","USA",43.45213722,-85.26480333 "13K","Eureka Municipal","Eureka","KS","USA",37.8515825,-96.29169806 "13N","Trinca","Andover","NJ","USA",40.96676444,-74.78016556 "14J","Carl Folsom","Elba","AL","USA",31.40988861,-86.08883583 "14M","Hollandale Municipal","Hollandale","MS","USA",33.18262167,-90.83065444 "14Y","Todd Field ","Long Prairie","MN","USA",45.89857556,-94.87391 "15F","Haskell Municipal","Haskell","TX","USA",33.19155556,-99.71793056 "15J","Cook County","Adel","GA","USA",31.13780556,-83.45308333 "15M","Luka ","Luka","MS","USA",34.7723125,-88.16587444 "15Z","McCarthy 2","McCarthy","AK","USA",61.43706083,-142.9037372 "16A","Nunapitchuk","Nunapitchuk","AK","USA",60.90582833,-162.4391158 "16G","Seneca County","Tiffin","OH","USA",41.09405556,-83.2125 "16J","Dawson Municipal","Dawson","GA","USA",31.74328472,-84.419285 "16S","Myrtle Creek Municipal","Myrtle Creek","OR","USA",42.99845056,-123.3095092 "17G","Port Bucyrus-Crawford County","Bucyrus","OH","USA",40.78141667,-82.97469444 "17J","Donalsonville Municipal","Donalsonville","GA","USA",31.00694444,-84.87761111 "17K","Boise City","Boise City","OK","USA",36.77430028,-102.5104364 "17M","Magee Municipal","Magee","MS","USA",31.86127139,-89.80285361 "17N","Cross Keys","Cross Keys","NJ","USA",39.70547583,-75.03300306 "17Z","Manokotak","Manokotak","AK","USA",58.98896583,-159.0499739 "18A","Franklin County","Canon","GA","USA",34.34010472,-83.13348333 "18I","McCreary County ","Pine Knot","KY","USA",36.69591306,-84.39160389 "19A","Jackson County","Jefferson","GA","USA",34.17402472,-83.56066528 "19M","C A Moore","Lexington","MS","USA",33.12546111,-90.02555694 "19N","Camden","Berlin","NJ","USA",39.77842056,-74.94780389 "19P","Port Protection SPB","Port Protection","AK","USA",56.32880417,-133.6100844 "1A3","Martin Campbell ","Copperhill","TN","USA",35.01619111,-84.34631083 "1A5","Macon County","Franklin","NC","USA",35.222595,-83.41904389 "1A6","Middlesboro-Bell County","Middlesboro","KY","USA",36.6106375,-83.73741611 "1A7","Jackson County","Gainesboro","TN","USA",36.39728139,-85.64164278 "1A9","Autauga County","Prattville","AL","USA",32.438775,-86.51044778 "1B0","Dexter Regional","Dexter","ME","USA",45.00839444,-69.23976722 "1B1","Columbia Cty","Hudson","NY","USA",42.29130028,-73.71031944 "1B3","Fair Haven","Fair Haven","VT","USA",43.61534389,-73.27455556 "1B9","Mansfield Municipal","Mansfield","MA","USA",42.00013306,-71.19677139 "1C5","Clow","Chicago/Plainfield","IL","USA",41.69597444,-88.12923056 "1D1","Milbank Municipal","Milbank","SD","USA",45.23053806,-96.56596556 "1D2","Canton -Plymouth - Mettetal","Plymouth","MI","USA",42.35003667,-83.45826833 "1D3","Platte Municipal","Platte","SD","USA",43.40332833,-98.82952972 "1D6","Hector Municipal","Hector","MN","USA",44.73107278,-94.71471333 "1D7","Webster Municipal","Webster","SD","USA",45.29329111,-97.51369889 "1D8","Redfield Municipal","Redfield","SD","USA",44.86247611,-98.52953972 "1F0","Downtown Ardmore","Ardmore","OK","USA",34.14698917,-97.12265194 "1F1","Lake Murray State Park","Overbrook","OK","USA",34.07509694,-97.10667917 "1F4","Madill Municipal","Madill","OK","USA",34.14040194,-96.81203222 "1F9","Bridgeport Municipal","Bridgeport","TX","USA",33.17533333,-97.82838889 "1G0","Wood County","Bowling Green","OH","USA",41.391,-83.63013889 "1G3","Kent State University","Kent","OH","USA",41.15186167,-81.41658306 "1G4","Grand Canyon West","Peach Springs","AZ","USA",35.99221,-113.8166164 "1G5","Freedom ","Medina","OH","USA",41.13144444,-81.76491667 "1G6","Michael ","Cicero","NY","USA",43.18166667,-76.12777778 "1H0","Creve Coeur","St Louis","MO","USA",38.72752,-90.50830417 "1H2","Effingham County Memorial","Effingham","IL","USA",39.07045083,-88.53351972 "1H3","Linn State Tech. College","Linn","MO","USA",38.47149444,-91.81531667 "1H8","Casey Municipal","Casey","IL","USA",39.30250917,-88.00406194 "1I5","Freehold","Freehold","NY","USA",42.36425,-74.06596806 "1I9","Delphi Municipal","Delphi","IN","USA",40.54281417,-86.68167194 "1J0","Tri-County","Bonifay","FL","USA",30.84577778,-85.60138889 "1K2","Lindsay Municipal","Lindsay","OK","USA",34.85007333,-97.58642028 "1K4","David J. Perry","Goldsby","OK","USA",35.1550675,-97.47039389 "1K5","Waynoka Municipal","Waynoka","OK","USA",36.56670028,-98.85231333 "1K9","Satanta Municipal","Satanta","KS","USA",37.45419111,-100.9921119 "1L0","St. John the Baptist Parish","Reserve","LA","USA",30.08720833,-90.58266528 "1L1","Lincoln Co","Panaca","NV","USA",37.78746444,-114.4216567 "1L7","Escalante Municipal","Escalante","UT","USA",37.74532639,-111.5701653 "1L9","Parowan","Parowan","UT","USA",37.85969694,-112.816055 "1M1","North Little Rock Municipal","No Lit Rock","AR","USA",34.83398056,-92.25792778 "1M2","Belzoni Municipal","Belzoni","MS","USA",33.14518056,-90.51528472 "1M4","Posey ","Haleyville","AL","USA",34.28034806,-87.60044139 "1M5","Portland Municipal","Portland","TN","USA",36.59287528,-86.47691028 "1M7","Fulton","Fulton","KY","USA",36.52589417,-88.91561611 "1MO","Mountain Grove Memorial","Mountain Grove","MO","USA",37.12071889,-92.311245 "1N2","Spadaro ","East Moriches","NY","USA",40.82787639,-72.74871083 "1N4","Woodbine Muni ","Woodbine","NJ","USA",39.21915,-74.794765 "1N7","Blairstown","Blairstown","NJ","USA",40.97114556,-74.99747556 "1N9","Allentown Queen City Muni","Allentown","PA","USA",40.57027778,-75.48830556 "1ND3","Hamry ","Kindred","ND","USA",46.6485775,-97.00564306 "1O1","Grandfield Municipal","Grandfield","OK","USA",34.23758944,-98.74200917 "1O2","Lampson ","Lakeport","CA","USA",38.99017472,-122.8997175 "1O3","Lodi","Lodi","CA","USA",38.20241667,-121.2684167 "1O4","Thomas Municipal","Thomas","OK","USA",35.73338222,-98.73063833 "1O6","Dunsmuir Municipal-Mott","Dunsmuir","CA","USA",41.26320889,-122.2719528 "1R1","Jena","Jena","LA","USA",31.671005,-92.15846722 "1R7","Brookhaven-Lincoln County","Brookhaven","MS","USA",31.6058475,-90.40931583 "1R8","Bay Minette Municipal","Bay Minette","AL","USA",30.87046278,-87.81738167 "1S0","Pierce County ","Puyallup","WA","USA",47.10391667,-122.2871944 "1S3","Tillitt ","Forsyth","MT","USA",46.27110639,-106.6239206 "1S5","Sunnyside Municipal","Sunnyside","WA","USA",46.32763139,-119.9705964 "1S6","Priest River Muni","Priest River","ID","USA",48.19018611,-116.9093644 "1U7","Bear Lake County","Paris","ID","USA",42.24714972,-111.33826 "1V0","Navajo State Park ","Navajo Dam","NM","USA",36.80833833,-107.6514444 "1V2","Grant County ","Hyannis","NE","USA",42.00942944,-101.7693439 "1V5","Boulder Muni","Boulder","CO","USA",40.03942972,-105.2258217 "1V6","Fremont County","Canon City","CO","USA",38.42838111,-105.1054994 "1V9","Blake ","Delta","CO","USA",38.78539722,-108.0636611 "20A","Robbins ","Oneonta","AL","USA",33.97231972,-86.37942722 "20M","Macon Municipal","Macon","MS","USA",33.13345889,-88.53559806 "20N","Kingston-Ulster","Kingston","NY","USA",41.9852525,-73.96409722 "20U","Beach","Beach","ND","USA",46.92362444,-103.9785389 "20V","McElroy Airfield","Kremmling","CO","USA",40.05367972,-106.3689467 "21D","Lake Elmo","St Paul","MN","USA",44.99748861,-92.85568111 "21F","Jacksboro Municipal","Jacksboro","TX","USA",33.228725,-98.14671083 "22B","Mountain Meadow Airstrip","Burlington","CT","USA",41.77287528,-73.01121667 "22I","Vinton County","McArthur","OH","USA",39.328125,-82.44182167 "22M","Pontotoc County","Pontotoc","MS","USA",34.27593833,-89.03839694 "22N","Carbon Cty-Jake Arner Memorial","Lehighton","PA","USA",40.80950889,-75.76149639 "23J","Herlong","Jacksonville","FL","USA",30.27778889,-81.80594722 "23M","Clarke County","Quitman","MS","USA",32.08487111,-88.73893389 "23N","Bayport Aerodrome","Bayport","NY","USA",40.75843139,-73.05372083 "23R","Devine Municipal","Devine","TX","USA",29.1384075,-98.94189028 "24A","Jackson County","Sylva","NC","USA",35.3168625,-83.20936806 "24J","Suwannee County","Live Oak","FL","USA",30.30105583,-83.02318778 "24N","Jicarilla Apache Nation","Dulce","NM","USA",36.828535,-106.8841914 "25J","Cuthbert-Randolph","Cuthbert","GA","USA",31.70016583,-84.82492194 "25M","Ripley ","Ripley","MS","USA",34.72226778,-89.01504944 "25R","International","Edinburg","TX","USA",26.44201083,-98.12945306 "26A","Ashland/Lineville","Ashland/Lineville","AL","USA",33.28761417,-85.80412861 "26N","Ocean City Muni cipal","Ocean City","NJ","USA",39.26347222,-74.60747222 "26R","Jackson County","Edna/Ganado","TX","USA",29.00101,-96.58194667 "26U","McDermitt State","McDermitt","OR","USA",42.00211083,-117.7231972 "27A","Elbert County-Patz ","Elberton","GA","USA",34.09519722,-82.81586417 "27D","Myers ","Canby","MN","USA",44.72801889,-96.26309972 "27J","Newberry Municipal","Newberry","SC","USA",34.30927778,-81.63972222 "27K","Georgetown-Scott County","Georgetown","KY","USA",38.23442528,-84.43468667 "28J","Kay Larkin","Palatka","FL","USA",29.65863889,-81.68855556 "29D","Grove City","Grove City","PA","USA",41.14597611,-80.16592194 "29G","Portage County","Ravenna","OH","USA",41.210195,-81.25163083 "29S","Gardiner","Gardiner","MT","USA",45.04993556,-110.7466008 "2A0","Mark Anton","Dayton","TN","USA",35.48624611,-84.93109722 "2A1","Jamestown Municipal","Jamestown","TN","USA",36.34970833,-84.94664472 "2A3","Larsen Bay","Larsen Bay","AK","USA",57.53510667,-153.9784169 "2A9","Kotlik","Kotlik","AK","USA",63.03116111,-163.5299278 "2AK","Lime Village","Lime Village","AK","USA",61.35848528,-155.4403508 "2B3","Parlin ","Newport","NH","USA",43.38812944,-72.18925417 "2B7","Pittsfield Municipal","Pittsfield","ME","USA",44.76852778,-69.37441667 "2B9","Post Mills","Post Mills","VT","USA",43.884235,-72.25370333 "2D1","Barber","Alliance","OH","USA",40.97089139,-81.09981889 "2D5","Oakes Municipal","Oakes","ND","USA",46.17301972,-98.07987556 "2F5","Lamesa Municipal","Lamesa","TX","USA",32.75627778,-101.9194722 "2F6","Skiatook Municipal","Skiatook","OK","USA",36.357035,-96.01138556 "2F7","Commerce Municipal","Commerce","TX","USA",33.29288889,-95.89641806 "2F8","Morehouse Memorial","Bastrop","LA","USA",32.75607944,-91.88057194 "2G2","Jefferson County Airpark","Steubenville","OH","USA",40.35944306,-80.70007806 "2G3","Connellsville","Connellsville","PA","USA",39.95893667,-79.65713306 "2G4","Garrett County","Oakland","MD","USA",39.58027778,-79.33941667 "2G9","Somerset County","Somerset","PA","USA",40.03911111,-79.01455556 "2H0","Shelby County","Shelbyville","IL","USA",39.41042861,-88.8454325 "2H2","Aurora Memorial Municipal","Aurora","MO","USA",36.96230778,-93.69531111 "2I0","Madisonville Municipal","Madisonville","KY","USA",37.35502778,-87.39963889 "2I5","Chanute","Rantoul","IL","USA",40.29355556,-88.14236111 "2IS","Airglades","Clewiston","FL","USA",26.74200972,-81.04978917 "2J2","Liberty County","Hinesville","GA","USA",31.78461111,-81.64116667 "2J3","Louisville Municipal","Louisville","GA","USA",32.98654083,-82.38568139 "2J5","Millen","Millen","GA","USA",32.89376972,-81.96511583 "2J9","Quincy Municipal","Quincy","FL","USA",30.59786111,-84.55741667 "2K3","Stanton County Municipal","Johnson","KS","USA",37.58271111,-101.73281 "2K4","Scott ","Mangum","OK","USA",34.89172583,-99.52675667 "2K5","Telida","Telida","AK","USA",63.39387278,-153.2689733 "2M0","Princeton-Caldwell County","Princeton","KY","USA",37.11560444,-87.85556944 "2M2","Lawrenceburg Municipal","Lawrenceburg","TN","USA",35.2343025,-87.25793222 "2M3","Sallisaw Municipal","Sallisaw","OK","USA",35.43816667,-94.80277778 "2M4","G. V. Montgomery","Forest","MS","USA",32.35347778,-89.48867944 "2M8","Charles W. Baker","Millington","TN","USA",35.27897583,-89.93147611 "2O1","Gansner ","Quincy","CA","USA",39.94378056,-120.9468983 "2O3","Angwin-Parrett ","Angwin","CA","USA",38.57851778,-122.4352572 "2O6","Chowchilla","Chowchilla","CA","USA",37.11244417,-120.2468406 "2O7","Independence","Independence","CA","USA",36.81382111,-118.2050956 "2O8","Hinton Municipal","Hinton","OK","USA",35.50592472,-98.34236111 "2P2","Washington Island","Washington Island","WI","USA",45.38620833,-86.92448056 "2Q3","Yolo Co-Davis/Woodland/Winters","Davis/Woodland/Winters","CA","USA",38.5790725,-121.8566322 "2R0","Waynesboro Municipal","Waynesboro","MS","USA",31.64599472,-88.63475667 "2R4","Peter Prince ","Milton","FL","USA",30.63762083,-86.99365278 "2R5","St Elmo","St Elmo","AL","USA",30.50190833,-88.27511667 "2R9","Karnes County","Kenedy","TX","USA",28.8250075,-97.86558333 "2S1","Vashon Municipal","Vashon","WA","USA",47.45815333,-122.4773506 "2S6","Sportsman Airpark","Newberg","OR","USA",45.29567333,-122.9553783 "2S7","Chiloquin State","Chiloquin","OR","USA",42.58319167,-121.8761261 "2S8","Wilbur","Wilbur","WA","USA",47.75320639,-118.7438936 "2T1","Muleshoe Municipal","Muleshoe","TX","USA",34.18513639,-102.6410981 "2V1","Stevens ","Pagosa Springs","CO","USA",37.277505,-107.0558742 "2V2","Vance Brand","Longmont","CO","USA",40.16367139,-105.1630369 "2V5","Wray Municipal","Wray","CO","USA",40.10032333,-102.24096 "2V6","Yuma Municipal","Yuma","CO","USA",40.10415306,-102.7129869 "2W5","Maryland","Indian Head","MD","USA",38.60053667,-77.07296917 "2W6","Captain Walter Francis Duke Regional ","Leonardtown","MD","USA",38.31536111,-76.55011111 "2Y3","Yakutat SPB","Yakutat","AK","USA",59.5624775,-139.7410994 "2Y4","Rockwell City Municipal","Rockwell City","IA","USA",42.38748056,-94.61803333 "31F","Gaines County","Seminole","TX","USA",32.67535389,-102.652685 "32M","Norfolk","Norfolk","MA","USA",42.12787528,-71.37033556 "32S","Stevensville","Stevensville","MT","USA",46.52511111,-114.0528056 "33J","Geneva Municipal","Geneva","AL","USA",31.05527778,-85.88033333 "33M","Water Valley ","Water Valley","MS","USA",34.16677639,-89.68619722 "33N","Delaware Airpark","Dover","DE","USA",39.21837556,-75.59642667 "33S","Pru ","Ritzville","WA","USA",47.12487194,-118.3927539 "34A","Laurens County","Laurens","SC","USA",34.50705556,-81.94719444 "35A","Union County, Troy Shelton ","Union","SC","USA",34.68680111,-81.64121167 "35D","Padgham ","Allegan","MI","USA",42.53098278,-85.82513556 "35S","Wasco State","Wasco","OR","USA",45.58944444,-120.6741667 "36K","Lakin","Lakin","KS","USA",37.96946389,-101.2554472 "36S","Happy Camp","Happy Camp","CA","USA",41.79067944,-123.3889444 "36U","Heber City Municipal/Russ McDonald ","Heber","UT","USA",40.48180556,-111.4288056 "37T","Calico Rock-Izard County","Calico Rock","AR","USA",36.16565278,-92.14523611 "37W","Harnett County","Erwin","NC","USA",35.37880028,-78.73362917 "38A","Shaktoolik","Shaktoolik","AK","USA",64.36263194,-161.2025369 "38S","Deer Lodge-City-County","Deer Lodge","MT","USA",46.38881583,-112.7669842 "38U","Wayne Wonderland","Loa","UT","USA",38.36247972,-111.5960164 "39N","Princeton","Princeton","NJ","USA",40.39834833,-74.65760361 "3A0","Grove Hill Municipal","Grove Hill","AL","USA",31.68932389,-87.7613875 "3A1","Folsom ","Cullman","AL","USA",34.26870833,-86.85833611 "3A2","New Tazewell Municipal","Tazewell","TN","USA",36.41008417,-83.55546167 "3A3","Anson County","Wadesboro","NC","USA",35.02397611,-80.08127333 "3AU","Augusta Municipal","Augusta","KS","USA",37.67162778,-97.07787222 "3B0","Southbridge Municipal","Southbridge","MA","USA",42.10092806,-72.03840833 "3B1","Greenville Municipal","Greenville","ME","USA",45.46302778,-69.55161111 "3B2","Marshfield","Marshfield","MA","USA",42.09824111,-70.67212083 "3B9","Chester","Chester","CT","USA",41.38390472,-72.50589444 "3BS","Jack Barstow","Midland","MI","USA",43.66291528,-84.261325 "3CK","Lake In The Hills","Lake In The Hills","IL","USA",42.20680306,-88.32304028 "3CM","James Clements Municipal","Bay City","MI","USA",43.54691667,-83.89550222 "3CU","Cable Union","Cable","WI","USA",46.19424889,-91.24640972 "3D2","Ephraim/Gibraltar","Ephraim","WI","USA",45.13535778,-87.18586556 "3D4","Frankfort Dow Memorial","Frankfort","MI","USA",44.62506389,-86.20061944 "3F3","De Soto Parish","Mansfield","LA","USA",32.07345972,-93.76551889 "3F4","Vivian","Vivian","LA","USA",32.86133333,-94.01015361 "3F7","Jones Memorial","Bristow","OK","USA",35.80685278,-96.42185556 "3FM","Fremont Municipal","Fremont","MI","USA",43.43890528,-85.99478 "3FU","Faulkton Municipal","Faulkton","SD","USA",45.03191861,-99.11566417 "3G3","Wadsworth Municipal","Wadsworth","OH","USA",41.00158222,-81.75513111 "3G4","Ashland County","Ashland","OH","USA",40.90297222,-82.25563889 "3G7","Williamson/Sodus","Williamson","NY","USA",43.23472222,-77.12097222 "3GM","Grand Haven Memorial Airpark","Grand Haven","MI","USA",43.03404639,-86.1981625 "3I2","Mason County","Point Pleasant","WV","USA",38.91463889,-82.09858333 "3I7","Phillipsburg","Phillipsburg","OH","USA",39.91344194,-84.40030889 "3J1","Ridgeland","Ridgeland","SC","USA",32.49268694,-80.99233028 "3J7","Greene County Airpark","Greensboro","GA","USA",33.59766667,-83.139 "3JC","Freeman ","Junction City","KS","USA",39.04327556,-96.84328694 "3K3","Syracuse-Hamilton County Municipal","Syracuse","KS","USA",37.99167972,-101.7462822 "3K6","St Louis-Metro East","Troy/Marine/St. Louis","IL","USA",38.73290861,-89.80656722 "3K7","Mark Hoard Memorial","Leoti","KS","USA",38.45696333,-101.3532161 "3LC","Logan County","Lincoln","IL","USA",40.15847222,-89.33497222 "3LF","Litchfield Municipal","Litchfield","IL","USA",39.16635306,-89.67489694 "3M7","Lafayette Municipal","Lafayette","TN","USA",36.518375,-86.05828083 "3M8","North Pickens ","Reform","AL","USA",33.38900611,-88.00557806 "3M9","Warren Municipal","Warren","AR","USA",33.56044333,-92.08538861 "3MY","Mt. Hawley Auxiliary","Peoria","IL","USA",40.79525917,-89.6134025 "3N6","Old Bridge","Old Bridge","NJ","USA",40.32988667,-74.34678694 "3N8","Mahnomen County ","Mahnomen","MN","USA",47.25996056,-95.92809778 "3ND0","Northwood Municipal","Northwood","ND","USA",47.72423333,-97.59042222 "3O1","Gustine","Gustine","CA","USA",37.26271722,-120.9632586 "3O3","Municipal","Purcell","OK","USA",34.97979444,-97.38586167 "3O4","Sayre Municipal","Sayre","OK","USA",35.16755222,-99.65787361 "3O5","Walters Municipal","Walters","OK","USA",34.37258444,-98.40588583 "3O7","Hollister Municipal","Hollister","CA","USA",36.89334528,-121.4102706 "3O9","Grand Lake Regional","Afton","OK","USA",36.5775775,-94.86190028 "3R0","Beeville Municipal","Beeville","TX","USA",28.36455528,-97.79208194 "3R1","Bay City Municipal","Bay City","TX","USA",28.973255,-95.86345528 "3R2","Le Gros Memorial","Crowley","LA","USA",30.16173611,-92.48396111 "3R4","Hart","Many","LA","USA",31.54489667,-93.48645306 "3R7","Jennings","Jennings","LA","USA",30.24269333,-92.67344778 "3S4","Illinois Valley","Illinois Valley (Cave Junction)","OR","USA",42.10372417,-123.6822911 "3S8","Grants Pass","Grants Pass","OR","USA",42.51011722,-123.3879894 "3S9","Condon State-Pauling ","Condon","OR","USA",45.24651889,-120.1664233 "3SG","Harry W Browne","Saginaw - H.Browne","MI","USA",43.43341028,-83.86245833 "3SQ","St Charles","St Charles","MO","USA",38.84866139,-90.50011833 "3T3","Boyceville Municipal ","Boyceville","WI","USA",45.042185,-92.0293475 "3T5","Fayette Regional Air Center","La Grange","TX","USA",29.90930556,-96.9505 "3TR","Jerry Tyler Memorial","Niles","MI","USA",41.83590806,-86.22517611 "3U3","Bowman ","Anaconda","MT","USA",46.15313278,-112.86784 "3U7","Benchmark","Benchmark","MT","USA",47.48133194,-112.8697678 "3U8","Big Sandy","Big Sandy","MT","USA",48.16247972,-110.1132631 "3V4","Fort Morgan Municipal","Fort Morgan","CO","USA",40.33423194,-103.8039508 "3WO","Shawano Municipal","Shawano","WI","USA",44.78777778,-88.56152444 "3Y2","George L Scott Municipal","West Union","IA","USA",42.98508917,-91.79060417 "3Y3","Winterset Madison County","Winterset","IA","USA",41.36276778,-94.02106194 "3Z9","Haines SPB","Haines","AK","USA",59.23495111,-135.4407181 "40J","Perry-Foley","Perry","FL","USA",30.06927778,-83.58058333 "40N","Chester Cty-G O Carlson","Coatesville","PA","USA",39.97897222,-75.86547222 "40U","Manila","Manila","UT","USA",40.98607,-109.6784811 "41U","Manti-Ephraim","Manti","UT","USA",39.32912833,-111.6146397 "42A","Melbourne Municipal","Melbourne","AR","USA",36.07079222,-91.82914667 "42C","White Cloud","White Cloud","MI","USA",43.55974139,-85.77421944 "42J","Keystone Airpark","Keystone Heights","FL","USA",29.84475,-82.04752778 "42S","Poplar","Poplar","MT","USA",48.11595861,-105.1821928 "43A","Montgomery County","Star","NC","USA",35.38819528,-79.79281667 "44B","Dover/Foxcroft","Dover-Foxcroft","ME","USA",45.18338806,-69.2328225 "44N","Sky Acres","Millbrook","NY","USA",41.70742861,-73.73802889 "45J","Rockingham-Hamlet","Rockingham","NC","USA",34.89107083,-79.75905806 "45OH","North Bass Island","North Bass Island","OH","USA",41.71932528,-82.82196917 "45R","Kountz - Hawthorne ","Kountze/Silsbee","TX","USA",30.33633806,-94.25754361 "46A","Blairsville","Blairsville","GA","USA",34.85508722,-83.996855 "46D","Carrington Municipal","Carrington","ND","USA",47.45111111,-99.15111111 "46N","Sky Park","Red Hook","NY","USA",41.98458333,-73.83596556 "47A","Cherokee County","Canton","GA","USA",34.31058333,-84.42391667 "47J","Cheraw Municipal","Cheraw","SC","USA",34.71258333,-79.95794444 "47N","Central Jersey Regional","Manville","NJ","USA",40.52438417,-74.59839194 "47V","Curtis Municipal","Curtis","NE","USA",40.63750778,-100.4712539 "48A","Cochran","Cochran","GA","USA",32.39936111,-83.27591667 "48D","Clare Municipal","Clare","MI","USA",43.83111111,-84.74133333 "48I","Braxton County","Sutton","WV","USA",38.68704444,-80.65176083 "48K","Ness City Municipal","Ness City","KS","USA",38.47110278,-99.90806667 "48S","Harlem","Harlem","MT","USA",48.56666472,-108.7729339 "48V","Tri-County","Erie","CO","USA",40.010225,-105.047975 "49A","Gilmer County","Ellijay","GA","USA",34.62786417,-84.52492889 "49T","Downtown Heliport","Dallas","TX","USA",32.77333333,-96.80027778 "49X","Chemehuevi Valley","Chemehuevi Valley","CA","USA",34.52751083,-114.4310697 "49Y","Fillmore County","Preston","MN","USA",43.67676,-92.17973444 "4A2","Atmautluak","Atmautluak","AK","USA",60.86674556,-162.2731389 "4A4","Cornelius-Moore ","Cedartown","GA","USA",34.01869444,-85.14647222 "4A5","Marshall-Searcy County","Marshall","AR","USA",35.89893667,-92.65588611 "4A6","Scottsboro Municipal","Scottsboro","AL","USA",34.68897278,-86.0058125 "4A7","Clayton County","Hampton","GA","USA",33.38911111,-84.33236111 "4A9","Isbell ","Fort Payne","AL","USA",34.4728925,-85.72221722 "4B0","South Albany","South Bethlehem","NY","USA",42.56072611,-73.83395639 "4B1","Duanesburg","Duanesburg","NY","USA",42.75840889,-74.13290472 "4B6","Ticonderoga Muni","Ticonderoga","NY","USA",43.87700278,-73.41317639 "4B7","Schroon Lake","Schroon Lake","NY","USA",43.86256083,-73.74262972 "4B8","Robertson ","Plainville","CT","USA",41.69037667,-72.8648225 "4B9","Simsbury Tri-Town","Simsbury","CT","USA",41.91676389,-72.77731778 "4C8","Albia Municipal","Albia","IA","USA",40.99445361,-92.76297194 "4D0","Abrams Municipal","Grandledge","MI","USA",42.77420167,-84.73309806 "4D9","Alma Municipal","Alma","NE","USA",40.11389972,-99.34565306 "4F2","Panola County-Sharpe ","Carthage","TX","USA",32.17608333,-94.29880556 "4F4","Gilmer-Upshur County","Gilmer","TX","USA",32.699,-94.94886111 "4G1","Greenville Muni","Greenville","PA","USA",41.44683167,-80.39126167 "4G2","Hamburg Inc.","Hamburg","NY","USA",42.7008925,-78.91475694 "4G5","Monroe County","Woodsfield","OH","USA",39.77904472,-81.10277222 "4G6","Hornell Muni","Hornell","NY","USA",42.38214444,-77.6821125 "4G7","Fairmont Muni","Fairmont","WV","USA",39.44816667,-80.16702778 "4I0","Mingo County","Williamson","WV","USA",37.68760139,-82.26097306 "4I3","Knox County","Mount Vernon","OH","USA",40.32872222,-82.52377778 "4I7","Putnam County","Greencastle","IN","USA",39.63359556,-86.8138325 "4I9","Morrow County","Mt. Gilead","OH","USA",40.52452778,-82.85005556 "4J1","Brantley County","Nahunta","GA","USA",31.21272417,-81.90539083 "4J2","Berrien County","Nashville","GA","USA",31.21255556,-83.22627778 "4J5","Quitman-Brooks County","Quitman","GA","USA",30.80575139,-83.58654889 "4J6","St Marys","St Marys","GA","USA",30.75468028,-81.55731917 "4K0","Pedro Bay","Pedro Bay","AK","USA",59.78960972,-154.1238331 "4K5","Ouzinkie","Ouzinkie","AK","USA",57.92287611,-152.5005111 "4K6","Bloomfield Municipal","Bloomfield","IA","USA",40.73210556,-92.42826889 "4KA","Tununak","Tununak","AK","USA",60.57559667,-165.2731272 "4M1","Carroll County","Berryville","AR","USA",36.38340333,-93.61685667 "4M3","Carlisle Municipal","Carlisle","AR","USA",34.80823,-91.71205083 "4M4","Clinton Municipal","Clinton","AR","USA",35.59785528,-92.45182472 "4M7","Russellville-Logan County","Russellville","KY","USA",36.79991667,-86.81016667 "4M8","Clarendon Municipal","Clarendon","AR","USA",34.64870694,-91.39457111 "4M9","Corning Municipal","Corning","AR","USA",36.40423139,-90.64792639 "4N1","Greenwood Lake","West Milford","NJ","USA",41.12854806,-74.34584611 "4O3","Blackwell-Tonkawa Municipal","Blackwell-Tonkawa","OK","USA",36.74511583,-97.34959972 "4O4","McCurtain County Regional","Idabel","OK","USA",33.909325,-94.85835278 "4O5","Cherokee Municipal","Cherokee","OK","USA",36.78336306,-98.35035083 "4PH","Polacca","Polacca","AZ","USA",35.79167222,-110.4234653 "4R1","I H Bass Jr Memorial","Lumberton","MS","USA",31.01546028,-89.48256556 "4R3","Jackson Municipal","Jackson","AL","USA",31.47210861,-87.89472083 "4R4","Fairhope Municipal","Fairhope","AL","USA",30.4621125,-87.87801972 "4R5","Madeline Island","La Pointe","WI","USA",46.78865556,-90.75866944 "4R7","Eunice","Eunice","LA","USA",30.46628389,-92.42379917 "4R9","Dauphin Island","Dauphin Island","AL","USA",30.26048083,-88.12749972 "4S1","Gold Beach Muni","Gold Beach","OR","USA",42.41344444,-124.4242742 "4S2","Hood River","Hood River","OR","USA",45.67261833,-121.5364625 "4S3","Joseph State","Joseph","OR","USA",45.35709583,-117.2532244 "4S9","Portland-Mulino","Mulino (Portland)","OR","USA",45.21632417,-122.5900839 "4SD","Reno/Stead","Reno","NV","USA",39.66738111,-119.8754169 "4T6","Mid-Way","Midlothian-Waxahachie","TX","USA",32.45609722,-96.91240972 "4U3","Liberty County","Chester","MT","USA",48.51072222,-110.9908639 "4U6","Circle Town County","Circle","MT","USA",47.41861972,-105.5619431 "4V0","Rangely","Rangely","CO","USA",40.09469917,-108.7612172 "4V1","Johnson ","Walsenburg","CO","USA",37.69640056,-104.7838747 "4V9","Antelope County","Neligh","NE","USA",42.11222889,-98.0386775 "4W1","Elizabethtown Municipal","Elizabethtown","NC","USA",34.60183722,-78.57973306 "4Z4","Holy Cross","Holy Cross","AK","USA",62.18829583,-159.7749503 "4Z7","Hyder SPB","Hyder","AK","USA",55.90331972,-130.0067031 "50I","Kentland Municipal","Kentland","IN","USA",40.75873222,-87.42821917 "50J","Berkeley County","Moncks Corner","SC","USA",33.18605556,-80.03563889 "50K","Pawnee City Municipal","Pawnee City","NE","USA",40.11611111,-96.19445278 "50R","Lockhart Municipal","Lockhart","TX","USA",29.85033333,-97.67241667 "51D","Edgeley Municipal ","Edgeley","ND","USA",46.34858333,-98.73555556 "51Z","Minto (New)","Minto","AK","USA",65.14370889,-149.3699647 "52A","Madison Municipal","Madison","GA","USA",33.61212528,-83.46044333 "52E","Timberon ","Timberon","NM","USA",32.63388889,-105.6863889 "52J","Lee County","Bishopville","SC","USA",34.24459889,-80.23729333 "53A","Dr. C.P. Savage, Sr.","Montezuma","GA","USA",32.302,-84.00747222 "53K","Osage City Municipal","Osage City","KS","USA",38.63334222,-95.80859806 "54J","Defuniak Springs","Defuniak Springs","FL","USA",30.7313,-86.15160833 "55D","Grayling Army Airfield","Grayling","MI","USA",44.68032028,-84.72886278 "55J","Fernandina Beach Municipal","Fernandina Beach","FL","USA",30.61170083,-81.462345 "55S","Packwood","Packwood","WA","USA",46.60400083,-121.6778664 "56D","Wyandot County","Upper Sandusky","OH","USA",40.88336139,-83.3145325 "56M","Warsaw Municipal","Warsaw","MO","USA",38.34688889,-93.345425 "56S","Seaside Municipal","Seaside","OR","USA",46.01649694,-123.9054167 "57B","Islesboro","Islesboro","ME","USA",44.30285556,-68.91058722 "57C","East Troy Municipal","East Troy","WI","USA",42.79711111,-88.3725 "59B","Newton ","Jackman","ME","USA",45.63199111,-70.24728944 "5A4","Okolona Mun.-Richard M. Stovall ","Okolona","MS","USA",34.01580528,-88.72618944 GGally/tests/testthat/test-ggnet2.R 0000644 0001762 0000144 00000020760 13140471254 016727 0 ustar ligges users context("ggnet2") if ("package:igraph" %in% search()) { detach("package:igraph") } rq <- function(...) { require(..., quietly = TRUE) } rq(network) # network objects rq(sna) # placement and centrality rq(ggplot2) # grammar of graphics rq(grid) # arrows rq(scales) # sizing rq(intergraph) # test igraph conversion rq(RColorBrewer) # test ColorBrewer palettes test_that("examples", { ### --- start: documented examples # random adjacency matrix x <- 10 ndyads <- x * (x - 1) density <- x / ndyads m <- matrix(0, nrow = x, ncol = x) dimnames(m) <- list(letters[ 1:x ], letters[ 1:x ]) m[ row(m) != col(m) ] <- runif(ndyads) < density m # random undirected network n <- network::network(m, directed = FALSE) n ggnet2(n, label = TRUE) # ggnet2(n, label = TRUE, shape = 15) # ggnet2(n, label = TRUE, shape = 15, color = "black", label.color = "white") # add vertex attribute x <- network.vertex.names(n) # nolint x <- ifelse(x %in% c("a", "e", "i"), "vowel", "consonant") n %v% "phono" <- x ggnet2(n, color = "phono") ggnet2(n, color = "phono", palette = c("vowel" = "gold", "consonant" = "grey")) ggnet2(n, shape = "phono", color = "phono") # random groups n %v% "group" <- sample(LETTERS[1:3], 10, replace = TRUE) ggnet2(n, color = "group", palette = "Set2") # random weights n %e% "weight" <- sample(1:3, network.edgecount(n), replace = TRUE) ggnet2(n, edge.size = "weight", edge.label = "weight") # Padgett's Florentine wedding data data(flo, package = "network") flo ggnet2(flo, label = TRUE) ggnet2(flo, label = TRUE, label.trim = 4, vjust = -1, size = 3, color = 1) # ggnet2(flo, label = TRUE, size = 12, color = "white") ### --- end: documented examples # test node assignment errors expect_error(ggnet2(n, color = NA)) expect_error(ggnet2(n, color = -1)) expect_error(ggnet2(n, color = rep("red", network.size(n) - 1))) # test node assignment ggnet2(n, color = rep("red", network.size(n))) # test node assignment errors expect_error(ggnet2(n, edge.color = NA)) expect_error(ggnet2(n, edge.color = -1)) expect_error(ggnet2(n, edge.color = rep("red", network.edgecount(n) - 1))) # test edge assignment ggnet2(n, edge.color = rep("red", network.edgecount(n))) # ggnet2(n, edge.color = "weight") # test mode = c("x", "y") ggnet2(n, mode = matrix(1, ncol = 2, nrow = 10)) n %v% "x" <- sample(1:10) n %v% "y" <- sample(1:10) ggnet2(n, mode = c("x", "y")) expect_error(ggnet2(n, mode = c("xx", "yy")), "not found") expect_error(ggnet2(n, mode = c("phono", "phono")), "not numeric") expect_error(ggnet2(n, mode = matrix(1, ncol = 2, nrow = 9)), "coordinates length") # test arrow.size expect_error(ggnet2(n, arrow.size = -1), "incorrect arrow.size") expect_warning(ggnet2(n, arrow.size = 1), "arrow.size ignored") # test arrow.gap suppressWarnings(expect_error( ggnet(n, arrow.size = 12, arrow.gap = -1), "incorrect arrow.gap" )) suppressWarnings(expect_warning( ggnet(n, arrow.size = 12, arrow.gap = 0.1), "arrow.gap ignored" # network is undirected; arrow.gap ignored )) suppressWarnings(expect_warning( ggnet(n, arrow.size = 12, arrow.gap = 0.1), "arrow.size ignored" # network is undirected; arrow.size ignored )) m <- network::network(m, directed = TRUE) ggnet2(m, arrow.size = 12, arrow.gap = 0.05) # test max_size expect_error(ggnet2(n, max_size = NA), "incorrect max_size") # test na.rm expect_error(ggnet2(n, na.rm = 1:2), "incorrect na.rm") expect_error(ggnet2(n, na.rm = "xyz"), "not found") n %v% "missing" <- ifelse(n %v% "phono" == "vowel", NA, n %v% "phono") expect_message(ggnet2(n, na.rm = "missing"), "removed") n %v% "missing" <- NA expect_warning(ggnet2(n, na.rm = "missing"), "removed all nodes") # test size = "degree" ggnet2(n, size = "degree") # test size.min expect_error(ggnet2(n, size = "degree", size.min = -1), "incorrect size.min") expect_message(ggnet2(n, size = "degree", size.min = 1), "size.min removed") expect_warning(ggnet2(n, size = "abc", size.min = 1), "not numeric") expect_warning(ggnet2(n, size = 4, size.min = 5), "removed all nodes") # test size.max expect_error(ggnet2(n, size = "degree", size.max = -1), "incorrect size.max") expect_message(ggnet2(n, size = "degree", size.max = 99), "size.max removed") expect_warning(ggnet2(n, size = "abc", size.max = 1), "not numeric") expect_warning(ggnet2(n, size = 4, size.max = 3), "removed all nodes") # test size.cut ggnet2(n, size = 1:10, size.cut = 3) ggnet2(n, size = 1:10, size.cut = TRUE) expect_error(ggnet2(n, size = 1:10, size.cut = NA), "incorrect size.cut") expect_error(ggnet2(n, size = 1:10, size.cut = "xyz"), "incorrect size.cut") expect_warning(ggnet2(n, size = "abc", size.cut = 3), "not numeric") expect_warning(ggnet2(n, size = 1, size.cut = 3), "ignored") # test alpha.palette ggnet2(n, alpha = "phono", alpha.palette = c("vowel" = 1, "consonant" = 0.5)) ggnet2(n, alpha = factor(1:10)) expect_error( ggnet2(n, alpha = "phono", alpha.palette = c("vowel" = 1)), "no alpha.palette value" ) # test color.palette # ggnet2(n, color = "phono", color.palette = c("vowel" = 1, "consonant" = 2)) ggnet2(n, color = factor(1:10)) ggnet2(n, color = "phono", palette = "Set1") # only 2 groups, palette has min. 3 expect_error(ggnet2(n, color = factor(1:10), palette = "Set1"), "too many node groups") expect_error( ggnet2(n, color = "phono", color.palette = c("vowel" = 1)), "no color.palette value" ) # test shape.palette ggnet2(n, shape = "phono", shape.palette = c("vowel" = 15, "consonant" = 19)) expect_warning(ggnet2(n, shape = factor(1:10)), "discrete values") expect_error( ggnet2(n, shape = "phono", shape.palette = c("vowel" = 1)), "no shape.palette value" ) # test size.palette ggnet2(n, size = "phono", size.palette = c("vowel" = 1, "consonant" = 2)) ggnet2(n, size = factor(1:10)) expect_error(ggnet2(n, size = "phono", size.palette = c("vowel" = 1)), "no size.palette value") # test node.label ggnet2(n, label = sample(letters, 10)) ggnet2(n, label = "phono") # test label.alpha expect_error(ggnet2(n, label = TRUE, label.alpha = "xyz"), "incorrect label.alpha") # test label.color expect_error(ggnet2(n, label = TRUE, label.color = "xyz"), "incorrect label.color") # test label.size expect_error(ggnet2(n, label = TRUE, label.size = "xyz"), "incorrect label.size") # test label.trim expect_error(ggnet2(n, label = TRUE, label.trim = "xyz"), "incorrect label.trim") ggnet2(n, label = TRUE, label.trim = toupper) # test mode expect_error(ggnet2(n, mode = "xyz"), "unsupported") expect_error(ggnet2(n, mode = letters[1:3]), "incorrect mode") # test edge.node shared colors ggnet2(n, color = "phono", edge.color = c("color", "grey")) # test edge.color expect_error(ggnet2(n, edge.color = "xyz"), "incorrect edge.color") # test edge.label.alpha expect_error( ggnet2(n, edge.label = "xyz", edge.label.alpha = "xyz"), "incorrect edge.label.alpha" ) # test edge.label.color expect_error( ggnet2(n, edge.label = "xyz", edge.label.color = "xyz"), "incorrect edge.label.color" ) # test edge.label.size expect_error(ggnet2(n, edge.label = "xyz", edge.label.size = "xyz"), "incorrect edge.label.size") # test edge.size expect_error(ggnet2(n, edge.size = "xyz"), "incorrect edge.size") # test layout.exp expect_error(ggnet2(n, layout.exp = "xyz")) ggnet2(n, layout.exp = 0.1) ### --- test bipartite functionality # weighted adjacency matrix bip <- data.frame( event1 = c(1, 2, 1, 0), event2 = c(0, 0, 3, 0), event3 = c(1, 1, 0, 4), row.names = letters[1:4] ) # weighted bipartite network bip <- network( bip, matrix.type = "bipartite", ignore.eval = FALSE, names.eval = "weights" ) # test bipartite mode ggnet2(bip, color = "mode") ### --- test network coercion expect_warning(ggnet2(network(matrix(1, nrow = 2, ncol = 2), loops = TRUE)), "self-loops") expect_error(ggnet2(1:2), "network object") expect_error(ggnet2(network(data.frame(1:2, 3:4), hyper = TRUE)), "hyper graphs") expect_error(ggnet2(network(data.frame(1:2, 3:4), multiple = TRUE)), "multiplex graphs") ### --- test igraph functionality if (requireNamespace("igraph", quietly = TRUE)) { library(igraph) # test igraph conversion p <- ggnet2(asIgraph(n), color = "group") expect_null(p$guides$colour) # test igraph degree ggnet2(n, size = "degree") expect_true(TRUE) } }) GGally/tests/testthat/test-ggmatrix_add.R 0000644 0001762 0000144 00000002107 13114357267 020176 0 ustar ligges users context("ggmatrix_add") data(tips, package = "reshape") test_that("add", { pm <- ggpairs(tips) expect_true(is.null(pm$title)) expect_true(is.null(pm$xlab)) expect_true(is.null(pm$ylab)) pm1 <- pm + labs(title = "my title", x = "x label", y = "y label") expect_equivalent(pm1$title, "my title") expect_equivalent(pm1$xlab, "x label") expect_equivalent(pm1$ylab, "y label") expect_true(is.null(pm$gg)) # first add pm2 <- pm + ggplot2::theme_bw() expect_true(! is.null(pm2$gg)) # second to nth add pm3 <- pm + ggplot2::theme_bw() expect_true(! is.null(pm3$gg)) # badd add expect_error(pm + ggplot2::geom_abline(), "'ggmatrix' does not know how to add") }) test_that("add_list", { pm <- ggpairs(tips, 1:2) pm1 <- pm + list( ggplot2::labs(x = "x title"), ggplot2::labs(title = "list title") ) expect_equal(pm1$xlab, "x title") expect_equal(pm1$title, "list title") }) test_that("v1_ggmatrix_theme", { pm <- ggpairs(tips, 1:2) pm1 <- pm + v1_ggmatrix_theme() expect_true(is.null(pm$gg)) expect_true(!is.null(pm1$gg)) }) GGally/tests/testthat/test-gglegend.R 0000644 0001762 0000144 00000004533 13276725426 017332 0 ustar ligges users context("gglegend") expect_print <- function(p, ...) { testthat::expect_silent(print(p)) } test_that("examples", { library(ggplot2) histPlot <- ggplot(diamonds, aes(price, fill = cut)) + geom_histogram(binwidth = 500) (right <- histPlot) (bottom <- histPlot + theme(legend.position = "bottom")) (top <- histPlot + theme(legend.position = "top")) (left <- histPlot + theme(legend.position = "left")) expect_legend <- function(p) { plotLegend <- grab_legend(p) expect_true(inherits(plotLegend, "gtable")) expect_true(inherits(plotLegend, "gTree")) expect_true(inherits(plotLegend, "grob")) expect_print(plotLegend) } expect_legend(right) expect_legend(bottom) expect_legend(top) expect_legend(left) }) test_that("legend", { # display regular plot expect_print( ggally_points(iris, ggplot2::aes(Sepal.Length, Sepal.Width, color = Species)) ) # Make a function that will only print the legend points_legend <- gglegend(ggally_points) expect_print(points_legend( iris, ggplot2::aes(Sepal.Length, Sepal.Width, color = Species) )) # produce the sample legend plot, but supply a string that 'wrap' understands same_points_legend <- gglegend("points") expect_identical( attr(attr(points_legend, "fn"), "original_fn"), attr(attr(same_points_legend, "fn"), "original_fn") ) # Complicated examples custom_legend <- wrap(gglegend("points"), size = 6) p <- custom_legend( iris, ggplot2::aes(Sepal.Length, Sepal.Width, color = Species) ) expect_print(p) expect_true(inherits(p, "gtable")) expect_true(inherits(p, "gTree")) expect_true(inherits(p, "grob")) # Use within ggpairs expect_silent({ pm <- ggpairs( iris, 1:2, mapping = ggplot2::aes(color = Species), upper = list(continuous = gglegend("points")) ) print(pm) }) # Use within ggpairs expect_silent({ pm <- ggpairs( iris, 1:2, mapping = ggplot2::aes(color = Species) ) pm[1, 2] <- points_legend(iris, ggplot2::aes(Sepal.Width, Sepal.Length, color = Species)) print(pm) }) }) test_that("plotNew", { points_legend <- gglegend(ggally_points) expect_print(points_legend( iris, ggplot2::aes(Sepal.Length, Sepal.Width, color = Species) )) expect_print(points_legend( iris, ggplot2::aes(Sepal.Length, Sepal.Width, color = Species) ), plotNew = TRUE) }) GGally/tests/testthat/test-ggscatmat.R 0000644 0001762 0000144 00000001654 13001231535 017504 0 ustar ligges users context("ggscatmat") data(flea) test_that("example", { flea2 <- flea flea2$species2 <- as.character(flea2$species) expect_warning(p <- ggscatmat(flea2, c(1:3)), "Factor variables are omitted in plot") expect_warning(p <- ggscatmat(flea2, c(2:3, 8)), "Factor variables are omitted in plot") expect_true(is.null(p$labels$colour)) # print(p) p <- ggscatmat(flea, columns = 2:4, color = "species") expect_true(!is.null(p$labels$colour)) # print(p) }) test_that("corMethod", { expect_silent({ p <- ggscatmat(flea, columns = 2:3, corMethod = "pearson") p <- ggscatmat(flea, columns = 2:3, corMethod = "rsquare") }) }) test_that("stops", { expect_error(ggscatmat(flea, columns = c(1, 2)), "Not enough numeric variables to") expect_error(ggscatmat(flea, columns = c(1, 1, 1)), "All of your variables are factors") expect_error(scatmat(flea, columns = c(1, 1, 1)), "All of your variables are factors") }) GGally/tests/testthat/test-ggnostic.R 0000644 0001762 0000144 00000004735 13277311163 017365 0 ustar ligges users context("ggnostic") expect_print <- function(p) { testthat::expect_silent({ print(p) }) } test_that("fn_switch", { fn1 <- function(data, mapping, ...) { return(1) } fn2 <- function(data, mapping, ...) { return(2) } fn3 <- function(data, mapping, ...) { return(3) } fn5 <- function(data, mapping, ...) { return(5) } fn <- fn_switch(list(A = fn1, B = fn2, C = fn3), "value") dummy_dt <- data.frame(A = rnorm(100), B = rnorm(100), C = rnorm(100)) chars <- c("A", "B", "C") for (i in 1:3) { mapping <- ggplot2::aes_string(value = chars[i]) expect_equal(fn(dummy_dt, mapping), i) } fn <- fn_switch(list(A = fn1, default = fn5), "value") expect_equal(fn(dummy_dt, ggplot2::aes_string(value = "A")), 1) expect_equal(fn(dummy_dt, ggplot2::aes_string(value = "B")), 5) expect_equal(fn(dummy_dt, ggplot2::aes_string(value = "C")), 5) fn <- fn_switch(list(A = fn1), "value") expect_equal(fn(dummy_dt, ggplot2::aes_string(value = "A")), 1) expect_error(fn(dummy_dt, ggplot2::aes_string(value = "B")), "function could not be found") }) test_that("model_beta_label", { mod <- lm(mpg ~ wt + qsec + am, mtcars) expect_equal(model_beta_label(mod), c("wt***", "qsec***", "am*")) expect_equal(model_beta_label(mod, lmStars = FALSE), c("wt", "qsec", "am")) }) test_that("ggnostic mtcars", { mtc <- mtcars; mtc$am <- c("0" = "automatic", "1" = "manual")[as.character(mtc$am)]; mod <- lm(mpg ~ wt + qsec + am, data = mtc); continuous_type <- list( .resid = wrap(ggally_nostic_resid, method = "loess"), .std.resid = wrap(ggally_nostic_std_resid, method = "loess") ) pm <- ggnostic( mod, mapping = ggplot2::aes(), columnsY = c("mpg", ".fitted", ".se.fit", ".resid", ".std.resid", ".sigma", ".hat", ".cooksd"), continuous = continuous_type, progress = FALSE ) expect_print(pm) pm <- ggnostic( mod, mapping = ggplot2::aes(color = am), legend = c(1, 3), continuous = continuous_type, progress = FALSE ) expect_print(pm) }) test_that("error checking", { get_cols <- function(cols) { match_nostic_columns( cols, c("mpg", broom_columns()), "columnsY" ) } expect_equivalent( get_cols(c(".resid", ".sig", ".hat", ".c")), c(".resid", ".sigma", ".hat", ".cooksd") ) expect_error( get_cols(c( "not_there", ".fitted", ".se.fit", ".resid", ".std.resid", ".sigma", ".hat", ".cooksd" )), "Could not match 'columnsY'" ) }) GGally/tests/testthat/test-ggfacet.R 0000644 0001762 0000144 00000002043 13277311163 017136 0 ustar ligges users context("ggfacet") expect_print <- function(p) { testthat::expect_silent(print(p)) } if (requireNamespace("chemometrics", quietly = TRUE)) { data(NIR, package = "chemometrics") NIR_sub <- data.frame(NIR$yGlcEtOH, NIR$xNIR[, 1:3]) test_that("warnings", { expect_warning( ggfacet(iris, columnsX = 1:5, columnsY = 1), "1 factor variables are being removed from X columns" ) expect_warning( ggfacet(iris, columnsX = 1, columnsY = 1:5), "1 factor variables are being removed from Y columns" ) }) test_that("generally works", { # factor variables expect_print( ggfacet( NIR_sub, columnsY = 1:2, columnsX = 3:5, fn = ggally_smooth_loess ) ) }) test_that("generally works", { # factor variables expect_print( ggfacet( NIR_sub, columnsY = 1:2, columnsX = 3:5, fn = ggally_smooth_loess ) ) expect_print( ggts(pigs, "time", c("gilts", "profit", "s_per_herdsz", "production", "herdsz")) ) }) } GGally/tests/testthat/test-ggcoef.R 0000644 0001762 0000144 00000001124 13277311163 016767 0 ustar ligges users context("ggcoef") suppressMessages(require(broom)) test_that("example", { expect_print <- function(x) { expect_silent(print(x)) } reg <- lm(Sepal.Length ~ Sepal.Width + Petal.Length + Petal.Width, data = iris) expect_print(ggcoef(reg)) skip_if_not_installed("MASS") d <- as.data.frame(Titanic) reg2 <- glm(Survived ~ Sex + Age + Class, family = binomial, data = d, weights = d$Freq) expect_print(ggcoef(reg2, exponentiate = TRUE)) expect_print(ggcoef( reg2, exponentiate = TRUE, exclude_intercept = TRUE, errorbar_height = .2, color = "blue" )) }) GGally/tests/testthat/test-ggsave.R 0000644 0001762 0000144 00000000447 13001231535 017005 0 ustar ligges users context("ggsave") test_that("ggsave", { pm <- ggpairs(iris, 1:2) test_file <- "test.pdf" on.exit({ unlink(test_file) }) expect_true(!file.exists(test_file)) expect_silent({ ggsave(test_file, pm, width = 7, height = 7) }) expect_true(file.exists(test_file)) }) GGally/tests/testthat/test-ggnet.R 0000644 0001762 0000144 00000016053 13277311163 016650 0 ustar ligges users context("ggnet") if ("package:igraph" %in% search()) { detach("package:igraph") } rq <- function(...) { suppressMessages(require(..., quietly = TRUE)) } rq(network) # network objects rq(sna) # placement and centrality rq(ggplot2) # grammar of graphics rq(grid) # arrows rq(scales) # sizing rq(intergraph) # test igraph conversion test_that("examples", { ### --- start: documented examples set.seed(54321) # random adjacency matrix x <- 10 ndyads <- x * (x - 1) density <- x / ndyads m <- matrix(0, nrow = x, ncol = x) dimnames(m) <- list(letters[ 1:x ], letters[ 1:x ]) m[ row(m) != col(m) ] <- runif(ndyads) < density m # random undirected network n <- network::network(m, directed = FALSE) n ggnet(n, label = TRUE, alpha = 1, color = "white", segment.color = "black") # random groups g <- sample(letters[ 1:3 ], 10, replace = TRUE) # color palette p <- c("a" = "steelblue", "b" = "forestgreen", "c" = "tomato") p <- ggnet(n, node.group = g, node.color = p, label = TRUE, color = "white") expect_equal(length(p$layers), 3) expect_true(!is.null(p$mapping$colour)) ### --- end: documented examples ### --- test deprecations # test mode = "geo" xy <- gplot.layout.circle(n) # nolint n %v% "lon" <- xy[, 1] n %v% "lat" <- xy[, 2] expect_warning(ggnet(n, mode = "geo"), "deprecated") # test names = c(x, y) expect_warning(ggnet(n, names = c("a", "b")), "deprecated") # test quantize.weights expect_warning(ggnet(n, quantize.weights = TRUE)) # test subset.threshold expect_warning(ggnet(n, subset.threshold = 2)) # test top8.nodes expect_warning(ggnet(n, top8.nodes = TRUE)) # test trim.labels expect_warning(ggnet(n, trim.labels = TRUE)) # # test subset.threshold by removing all nodes # expect_warning( # expect_error( # ggnet(n, subset.threshold = 11), # "NA/NaN/Inf" # ), # "NaNs produced" # ) # # p <- ggnet(n, mode = "geo") # expect_equal(p$data$X1, xy[, 1]) # expect_equal(p$data$X2, xy[, 2]) # test user-submitted weights ggnet(n, weight = sample(1:2, 10, replace = TRUE)) # test segment.label x <- sample(letters, network.edgecount(n)) p <- ggnet(n, segment.label = x) expect_true(mapping_string(p$layers[[2]]$mapping$x) == "midX") expect_true(mapping_string(p$layers[[2]]$mapping$y) == "midY") # test weight.cut n %v% "weights" <- 1:10 ggnet(n, weight.method = "weights", weight.cut = TRUE) ### --- test errors in set_node expect_error(ggnet(n, group = NA), "incorrect") expect_error(ggnet(n, group = 1:3), "incorrect") expect_error(ggnet(n, label = TRUE, label.size = -10:-1), "incorrect") expect_error(ggnet(n, size = "phono"), "incorrect") ggnet(n, group = "weights") ### --- test errors in set_edges expect_error(ggnet(n, segment.label = NA), "incorrect") expect_error(ggnet(n, segment.label = 1:3), "incorrect") expect_error(ggnet(n, segment.label = -11:-1), "incorrect") # unnecessary # expect_error(ggnet(n, size = "phono"), "incorrect") n %e% "weights" <- sample(1:2, network.edgecount(n), replace = TRUE) ggnet(n, segment.label = "weights") ggnet(n, segment.label = "a") ### --- test mode = c(x, y) ggnet(n, mode = matrix(1, ncol = 2, nrow = 10)) ggnet(n, mode = c("lon", "lat")) expect_error(ggnet(n, mode = c("xx", "yy")), "not found") n %v% "abc" <- "abc" expect_error(ggnet(n, mode = c("abc", "abc")), "not numeric") expect_error(ggnet(n, mode = matrix(1, ncol = 2, nrow = 9)), "coordinates length") ### --- test arrow.size expect_error(ggnet(n, arrow.size = -1), "incorrect arrow.size") expect_warning(ggnet(n, arrow.size = 1), "arrow.size ignored") ### --- test arrow.gap suppressWarnings(expect_error( ggnet(n, arrow.size = 12, arrow.gap = -1), "incorrect arrow.gap" )) suppressWarnings(expect_warning( ggnet(n, arrow.size = 12, arrow.gap = 0.1), "arrow.gap ignored" # network is undirected; arrow.gap ignored )) suppressWarnings(expect_warning( ggnet(n, arrow.size = 12, arrow.gap = 0.1), "arrow.size ignored" # network is undirected; arrow.size ignored )) m <- network::network(m, directed = TRUE) ggnet(m, arrow.size = 12, arrow.gap = 0.05) ### --- test degree centrality ggnet(n, weight = "degree") ### --- test weight.min, weight.max and weight.cut # test weight.min expect_error(ggnet(n, weight = "degree", weight.min = -1), "incorrect weight.min") expect_message(ggnet(n, weight = "degree", weight.min = 1), "weight.min removed") expect_warning(ggnet(n, weight = "degree", weight.min = 99), "removed all nodes") # test weight.max expect_error(ggnet(n, weight = "degree", weight.max = -1), "incorrect weight.max") expect_message(ggnet(n, weight = "degree", weight.max = 99), "weight.max removed") expect_warning(ggnet(n, weight = 1:10, weight.max = 0.5), "removed all nodes") expect_error(ggnet(n, weight = "abc"), "incorrect weight.method") # test weight.cut expect_error(ggnet(n, weight.cut = NA), "incorrect weight.cut") expect_error(ggnet(n, weight.cut = "a"), "incorrect weight.cut") expect_warning(ggnet(n, weight.cut = 3), "weight.cut ignored") ggnet(n, weight = "degree", weight.cut = 3) ### --- test node.group and node.color expect_warning(ggnet(n, group = 1:10, node.color = "blue"), "unequal length") ### --- test node labels and label sizes ggnet(n, label = letters[ 1:10 ], color = "white") ggnet(n, label = "abc", color = "white", label.size = 4, size = 12) expect_error(ggnet(n, label = letters[ 1:10 ], label.size = "abc"), "incorrect label.size") ### --- test node placement expect_error(ggnet(n, mode = "xyz"), "unsupported") expect_error(ggnet(n, mode = letters[1:3]), "incorrect mode") ### --- test label.trim expect_error(ggnet(n, label = TRUE, label.trim = "xyz"), "incorrect label.trim") ggnet(n, label = TRUE, color = "white", label.trim = 1) ggnet(n, label = TRUE, color = "white", label.trim = toupper) ### --- test layout.exp expect_error(ggnet(n, layout.exp = "xyz")) ggnet(n, layout.exp = 0.1) ### --- test bipartite functionality # weighted adjacency matrix bip <- data.frame( event1 = c(1, 2, 1, 0), event2 = c(0, 0, 3, 0), event3 = c(1, 1, 0, 4), row.names = letters[1:4] ) # weighted bipartite network bip <- network( bip, matrix.type = "bipartite", ignore.eval = FALSE, names.eval = "weights" ) # test bipartite mode ggnet(bip, group = "mode") ### --- test network coercion expect_warning(ggnet(network(matrix(1, nrow = 2, ncol = 2), loops = TRUE)), "self-loops") expect_error(ggnet(1:2), "network object") expect_error(ggnet(network(data.frame(1:2, 3:4), hyper = TRUE)), "hyper graphs") expect_error(ggnet(network(data.frame(1:2, 3:4), multiple = TRUE)), "multiplex graphs") ### --- test igraph functionality if (requireNamespace("igraph", quietly = TRUE)) { library(igraph) # test igraph conversion p <- ggnet(asIgraph(n)) expect_null(p$guides$colour) expect_equal(length(p$layers), 2) # test igraph degree ggnet(n, weight = "degree") expect_true(TRUE) } }) GGally/tests/testthat/test-gglyph.R 0000644 0001762 0000144 00000007100 13276725426 017041 0 ustar ligges users context("gglyph") data(nasa) nasaLate <- nasa[ nasa$date >= as.POSIXct("1998-01-01") & nasa$lat >= 20 & nasa$lat <= 40 & nasa$long >= -80 & nasa$long <= -60 , ] do_glyph <- function(...) { glyphs( nasaLate, # no lint "long", "day", "lat", "surftemp", height = 2.37, width = 2.38, ... ) } do_gg <- function(dt) { ggplot2::ggplot(dt, ggplot2::aes(gx, gy, group = gid)) + add_ref_lines(dt, color = "red", size = 0.5) + add_ref_boxes(dt, color = "blue") + ggplot2::geom_path() + ggplot2::theme_bw() + ggplot2::labs(x = "", y = "") + ggplot2::xlim(-80, -60) + ggplot2::ylim(20, 40) } test_that("examples", { dt <- do_glyph() expect_true(all(c("gx", "gy", "gid") %in% names(dt))) expect_true(all(names(nasaLate) %in% names(dt))) p <- do_gg(dt) expect_equal(length(p$layers), 3) expect_equal(as.character(get("aes_params", envir = p$layers[[1]])$colour), "red") expect_equal(as.character(get("aes_params", envir = p$layers[[2]])$colour), "blue") }) test_that("message", { expect_message(glyphs(nasaLate, "long", "day", "lat", "surftemp", height = 1), "Using width 2.38") expect_message(glyphs(nasaLate, "long", "day", "lat", "surftemp", width = 1), "Using height 2.37") }) test_that("scales", { dt <- do_glyph(x_scale = log) dt$dayLog <- dt$day dt$day <- NULL dtm <- merge(dt, nasaLate) expect_true(all(dtm$dayLog == log(dtm$day))) dt <- do_glyph(y_scale = log) dt$surftempLog <- dt$surftemp dt$surftemp <- NULL dtm <- merge(dt, nasaLate) expect_true(all(dtm$surftempLog == log(dtm$surftemp))) for (scale_fn in c(range01, max1, mean0, min0, rescale01, rescale11)) { dt <- do_glyph(y_scale = scale_fn) dt$surftempScaled <- dt$surftemp dt$surftemp <- NULL dtm <- merge(dt, nasaLate) expect_true(all(dtm$surftempScaled != dtm$surftemp)) } for (scale_fn in c(rescale01, rescale11)) { scale_fn2 <- function(x) { scale_fn(x, xlim = c(1 / 4, 3 / 4)) } dt <- do_glyph(y_scale = scale_fn2) dt$surftempScaled <- dt$surftemp dt$surftemp <- NULL dtm <- merge(dt, nasaLate) expect_true(all(dtm$surftempScaled != dtm$surftemp)) } }) test_that("polar", { dt <- do_glyph(polar = TRUE) expect_equal(attr(dt, "polar"), TRUE) # idk how to test that polar happened p <- do_gg(dt) expect_equal(length(p$layers), 3) }) test_that("fill", { dt <- do_glyph() # idk how to test that polar happened do_gg_fill <- function(...){ ggplot2::ggplot(dt, ggplot2::aes(gx, gy, group = gid)) + add_ref_lines(dt, color = "red", size = 0.5) + add_ref_boxes(dt, color = "blue", ...) + ggplot2::geom_path() + ggplot2::theme_bw() + ggplot2::labs(x = "", y = "") + ggplot2::xlim(-80, -60) + ggplot2::ylim(20, 40) } p <- do_gg_fill(fill = "green") expect_equal(mapping_string(get("aes_params", envir = p$layers[[2]])$fill), "\"green\"") p <- do_gg_fill(var_fill = "gid") expect_equal(mapping_string(get("mapping", envir = p$layers[[2]])$fill), "fill") }) test_that("print", { dt <- do_glyph() txt <- capture.output(print(dt)) expect_equal(txt[length(txt) - 2], "Cartesian glyphplot: ") expect_equal(txt[length(txt) - 1], " Size: [2.38, 2.37]") expect_equal(txt[length(txt) - 0], " Major axes: long, lat" ) dt <- do_glyph(polar = TRUE) txt <- capture.output(print(dt)) expect_equal(txt[length(txt) - 2], "Polar glyphplot: ") expect_equal(txt[length(txt) - 1], " Size: [2.38, 2.37]") expect_equal(txt[length(txt) - 0], " Major axes: long, lat" ) txt <- capture.output(print(rel(0.95))) expect_equal(txt, "[1] 0.95 *") }) GGally/tests/testthat/test-zzz_ggpairs.R 0000644 0001762 0000144 00000051732 13277311163 020120 0 ustar ligges users context("ggpairs") data(tips, package = "reshape") expect_print <- function(p) { testthat::expect_silent(print(p)) } facethistBindwidth1 <- list(combo = wrap("facethist", binwidth = 1)) facethistBindwidth1Duo <- list( comboHorizontal = wrap("facethist", binwidth = 1), comboVertical = wrap("facethist", binwidth = 1) ) test_that("structure", { expect_null <- function(x) { expect_true(is.null(x)) } expect_obj <- function(x) { expect_is(x$data, "data.frame") expect_is(x$plots, "list") expect_equivalent(length(x$plots), ncol(tips) ^ 2) expect_null(x$title) expect_null(x$xlab) expect_null(x$ylab) expect_is(x$xAxisLabels, "character") expect_is(x$yAxisLabels, "character") expect_is(x$showXAxisPlotLabels, "logical") expect_is(x$showYAxisPlotLabels, "logical") expect_null(x$legend) expect_is(x$byrow, "logical") expect_null(x$gg) expect_true("gg" %in% names(x)) } expect_obj(ggduo(tips)) expect_obj(ggpairs(tips)) }) test_that("columns", { expect_obj <- function(pm, columnsX, columnsY) { expect_equivalent(length(pm$plots), length(columnsX) * length(columnsY)) expect_equivalent(pm$xAxisLabels, columnsX) expect_equivalent(pm$yAxisLabels, columnsY) expect_equivalent(pm$ncol, length(columnsX)) expect_equivalent(pm$nrow, length(columnsY)) } columnsUsed <- c("total_bill", "tip", "sex") pm <- ggpairs(tips, columns = columnsUsed) expect_obj(pm, columnsUsed, columnsUsed) columnsX <- c("total_bill", "tip", "sex") columnsY <- c("smoker", "day", "time", "size") pm <- ggduo(tips, columnsX, columnsY) expect_obj(pm, columnsX, columnsY) }) test_that("column labels", { expect_obj <- function(pm, columnLabelsX, columnLabelsY) { expect_equivalent(pm$xAxisLabels, columnLabelsX) expect_equivalent(pm$yAxisLabels, columnLabelsY) } columnTitles <- c("A", "B", "C") pm <- ggpairs(tips, 1:3, columnLabels = columnTitles) expect_obj(pm, columnTitles, columnTitles) columnTitles <- c("Total Bill %", "Tip 123456", "Sex ( /a asdf)") pm <- ggpairs(tips, 1:3, columnLabels = columnTitles) expect_obj(pm, columnTitles, columnTitles) columnLabelsX <- c("Total Bill %", "Tip 123456", "Sex ( /a asdf)") columnLabelsY <- c("Smoker !#@", "Day 678", "1", "NULL") pm <- ggduo(tips, 1:3, 4:7, columnLabelsX = columnLabelsX, columnLabelsY = columnLabelsY) expect_obj(pm, columnLabelsX, columnLabelsY) }) test_that("character", { expect_obj <- function(pm) { expect_true(is.factor(pm$data$sex)) expect_true(is.factor(pm$data$smoker)) } tips2 <- tips tips2$sex <- as.character(tips2$sex) tips2$smoker <- as.character(tips2$smoker) expect_obj(ggpairs(tips2)) expect_obj(ggduo(tips2)) }) test_that("upper/lower/diag = blank", { columnsUsed <- 1:3 au <- ggpairs(tips, columnsUsed, upper = "blank") ad <- ggpairs(tips, columnsUsed, diag = "blank") al <- ggpairs(tips, columnsUsed, lower = "blank") for (i in 1:3) { for (j in 1:3) { if (i < j) { expect_true( is_blank_plot(au[i, j])) expect_false( is_blank_plot(ad[i, j])) expect_false( is_blank_plot(al[i, j])) } if (i > j) { expect_false( is_blank_plot(au[i, j])) expect_false( is_blank_plot(ad[i, j])) expect_true( is_blank_plot(al[i, j])) } if (i == j) { expect_false( is_blank_plot(au[i, j])) expect_true( is_blank_plot(ad[i, j])) expect_false( is_blank_plot(al[i, j])) } } } a <- ggpairs(tips, columnsUsed) a[1, 1] <- ggplot2::qplot(total_bill, data = tips) expect_false(is_blank_plot(a[1, 1])) }) test_that("stops", { expect_warning({ pm <- ggpairs(tips, axisLabels = "not_a_chosen", lower = facethistBindwidth1) }, "'axisLabels' not in ") # nolint expect_warning({ pm <- ggduo(tips, axisLabels = "not_a_chosen", types = facethistBindwidth1Duo) }, "'axisLabels' not in ") # nolint expect_warning({ pm <- ggpairs(tips, color = "sex") }, "Extra arguments: ") # nolint expect_warning({ pm <- ggduo(tips, 2:3, 2:3, types = list(combo = "facetdensity")) }, "Setting:\n\ttypes") # nolint expect_error({ ggpairs(tips, columns = c("tip", "day", "not in tips")) }, "Columns in 'columns' not found in data") # nolint expect_error({ ggduo(tips, columnsX = c("tip", "day", "not in tips"), columnsY = "smoker") }, "Columns in 'columnsX' not found in data") # nolint expect_error({ ggduo(tips, columnsX = c("tip", "day", "smoker"), columnsY = "not in tips") }, "Columns in 'columnsY' not found in data") # nolint expect_warning({ pm <- ggpairs(tips, legends = TRUE) }, "'legends' will be deprecated") # nolint expect_error({ ggpairs(tips, params = c(size = 2)) }, "'params' is a deprecated") # nolint expect_error( { ggpairs(tips, columns = 1:10) }, "Make sure your numeric 'columns' values are less than or equal to") # nolint expect_error( { ggduo(tips, columnsX = 1:10) }, "Make sure your numeric 'columnsX' values are less than or equal to") # nolint expect_error( { ggduo(tips, columnsY = 1:10) }, "Make sure your numeric 'columnsY' values are less than or equal to") # nolint expect_error({ ggpairs(tips, columns = -5:5) }, "Make sure your numeric 'columns' values are positive") # nolint expect_error({ ggduo(tips, columnsX = -5:5) }, "Make sure your numeric 'columnsX' values are positive") # nolint expect_error({ ggduo(tips, columnsY = -5:5) }, "Make sure your numeric 'columnsY' values are positive") # nolint expect_error({ ggpairs(tips, columns = (2:10) / 2) }, "Make sure your numeric 'columns' values are integers") # nolint expect_error({ ggduo(tips, columnsX = (2:10) / 2) }, "Make sure your numeric 'columnsX' values are integers") # nolint expect_error({ ggduo(tips, columnsY = (2:10) / 2) }, "Make sure your numeric 'columnsY' values are integers") # nolint expect_error({ ggpairs(tips, columns = 1:3, columnLabels = c("A", "B", "C", "Extra")) }, "The length of the 'columnLabels' does not match the length of the 'columns'") # nolint expect_error({ ggduo(tips, columnsX = 1:3, columnLabelsX = c("A", "B", "C", "Extra")) }, "The length of the 'columnLabelsX' does not match the length of the 'columnsX'") # nolint expect_error({ ggduo(tips, columnsY = 1:3, columnLabelsY = c("A", "B", "C", "Extra")) }, "The length of the 'columnLabelsY' does not match the length of the 'columnsY'") # nolint expect_error({ ggpairs(tips, upper = c("not_a_list")) }, "'upper' is not a list") # nolint expect_error({ ggpairs(tips, diag = c("not_a_list")) }, "'diag' is not a list") # nolint expect_error({ ggpairs(tips, lower = c("not_a_list")) }, "'lower' is not a list") # nolint expect_error({ ggduo(tips, types = c("not_a_list")) }, "'types' is not a list") # nolint # # couldn't get correct error message # # variables: 'colour' have non standard format: 'total_bill + tip'. # expect_error({ # ggpairs(tips, mapping = ggplot2::aes(color = total_bill + tip)) # }, "variables\\: \"colour\" have non standard format") # nolint # expect_error({ # ggduo(tips, mapping = ggplot2::aes(color = total_bill + tip)) # }, "variables\\: \"colour\" have non standard format") # nolint errorString <- "'aes_string' is a deprecated element" expect_error({ ggpairs(tips, upper = list(aes_string = ggplot2::aes(color = day))) }, errorString) # nolint expect_error({ ggpairs(tips, lower = list(aes_string = ggplot2::aes(color = day))) }, errorString) # nolint expect_error({ ggpairs(tips, diag = list(aes_string = ggplot2::aes(color = day))) }, errorString) # nolint expect_error({ ggduo(tips, types = list(aes_string = ggplot2::aes(color = day))) }, errorString) # nolint expect_diag_warn <- function(key, value) { warnString <- str_c("Changing diag\\$", key, " from '", value, "' to '", value, "Diag'") diagObj <- list() diagObj[[key]] <- value expect_warning({ pm <- ggpairs(tips, diag = diagObj) }, warnString ) } # diag # continuous # densityDiag # barDiag # blankDiag # discrete # barDiag # blankDiag expect_diag_warn("continuous", "density") expect_diag_warn("continuous", "bar") expect_diag_warn("continuous", "blank") expect_diag_warn("discrete", "bar") expect_diag_warn("discrete", "blank") }) test_that("cardinality", { expect_silent(stop_if_high_cardinality(tips, 1:ncol(tips), NULL)) expect_silent(stop_if_high_cardinality(tips, 1:ncol(tips), FALSE)) expect_error( stop_if_high_cardinality(tips, 1:ncol(tips), "not numeric"), "'cardinality_threshold' should" ) expect_error( stop_if_high_cardinality(tips, 1:ncol(tips), 2), "Column 'day' has more levels" ) }) test_that("blank types", { columnsUsed <- 1:3 pmUpper <- ggpairs(tips, columnsUsed, upper = "blank", lower = facethistBindwidth1) pmDiag <- ggpairs(tips, columnsUsed, diag = "blank", lower = facethistBindwidth1) pmLower <- ggpairs(tips, columnsUsed, lower = "blank") for (i in columnsUsed) { for (j in columnsUsed) { if (i < j) { # upper expect_true(is_blank_plot(pmUpper[i, j])) expect_false(is_blank_plot(pmDiag[i, j])) expect_false(is_blank_plot(pmLower[i, j])) } else if ( i > j) { # lower expect_false(is_blank_plot(pmUpper[i, j])) expect_false(is_blank_plot(pmDiag[i, j])) expect_true(is_blank_plot(pmLower[i, j])) } else { # diag expect_false(is_blank_plot(pmUpper[i, j])) expect_true(is_blank_plot(pmDiag[i, j])) expect_false(is_blank_plot(pmLower[i, j])) } } } columnsUsedX <- 1:3 columnsUsedY <- 4:5 pmDuo <- ggduo(tips, columnsUsedX, columnsUsedY, types = "blank") for (i in seq_along(columnsUsedX)) { for (j in seq_along(columnsUsedY)) { expect_true(is_blank_plot(pmDuo[j, i])) } } }) test_that("axisLabels", { expect_obj <- function(pm, axisLabel) { expect_true(is.null(pm$showStrips)) if (axisLabel == "show") { expect_true(pm$showXAxisPlotLabels) expect_true(pm$showYAxisPlotLabels) expect_false(is.null(pm$xAxisLabels)) expect_false(is.null(pm$yAxisLabels)) } else if (axisLabel == "internal") { for (i in 1:(pm$ncol)) { p <- pm[i, i] expect_true(inherits(p$layers[[1]]$geom, "GeomText")) expect_true(inherits(p$layers[[2]]$geom, "GeomText")) expect_equal(length(p$layers), 2) } expect_false(pm$showXAxisPlotLabels) expect_false(pm$showYAxisPlotLabels) expect_true(is.null(pm$xAxisLabels)) expect_true(is.null(pm$yAxisLabels)) } else if (axisLabel == "none") { expect_false(pm$showXAxisPlotLabels) expect_false(pm$showYAxisPlotLabels) expect_false(is.null(pm$xAxisLabels)) expect_false(is.null(pm$yAxisLabels)) } expect_print(pm) } fn <- function(axisLabels) { pm <- ggpairs( iris, c(3, 4, 5, 1), upper = "blank", lower = facethistBindwidth1, axisLabels = axisLabels, title = str_c("axisLabels = ", axisLabels), progress = FALSE ) pm } for (axisLabels in c("show", "internal", "none")) { expect_obj(fn(axisLabels), axisLabels) } plots <- ggpairs(iris, 1:3)$plots for (val in c(TRUE, FALSE)) { pm <- ggmatrix( plots, 3, 3, showAxisPlotLabels = val ) expect_equal(pm$showXAxisPlotLabels, val) expect_equal(pm$showYAxisPlotLabels, val) } fn <- function(axisLabels) { a <- ggduo( iris, c(4, 5), c(5, 1), types = facethistBindwidth1Duo, axisLabels = axisLabels, title = str_c("axisLabels = ", axisLabels) ) a } for (axisLabels in c("show", "none")) { expect_obj(fn(axisLabels), axisLabels) } }) test_that("strips and axis", { # axis should line up with left side strips pm <- ggpairs( tips, c(3, 1, 4), showStrips = TRUE, title = "Axis should line up even if strips are present", lower = list(combo = wrap("facethist", binwidth = 1)) ) expect_print(pm) # default behavior. tested in other places # expect_silent({ # pm <- ggpairs(tips, c(3, 1, 4), showStrips = FALSE) # print(pm) # }) }) test_that("dates", { startDt <- as.POSIXct("2000-01-01", tz = "UTC") endDt <- as.POSIXct("2000-04-01", tz = "UTC") dts <- seq(startDt, endDt, 86400) # 86400 = as.numeric(ddays(1)) x <- data.frame( date = dts, x1 = rnorm(length(dts)), x2 = rnorm(length(dts)), cat = sample(c("a", "b", "c"), length(dts), replace = TRUE) ) class(x) <- c("NOT_data.frame", "data.frame") a <- ggpairs( x, c(2, 1, 4, 3), mapping = ggplot2::aes(color = cat), lower = "blank", diag = list(continuous = "densityDiag"), upper = list(continuous = "cor") ) p <- a[1, 2] expect_true(inherits(p$layers[[1]]$geom, "GeomText")) expect_true(inherits(p$layers[[2]]$geom, "GeomText")) expect_equal(length(p$layers), 2) a <- ggpairs( x, c(2, 1, 4, 3), mapping = ggplot2::aes(color = cat), lower = "blank", diag = list(continuous = "barDiag"), upper = list(continuous = "cor") ) p <- a[1, 1] expect_true(inherits(p$layers[[1]]$geom, "GeomBar")) expect_equal(length(p$layers), 1) }) test_that("mapping", { pm <- ggpairs(tips, mapping = 1:3) expect_equal(pm$xAxisLabels, names(tips)[1:3]) pm <- ggpairs(tips, columns = 1:3) expect_equal(pm$xAxisLabels, names(tips)[1:3]) expect_error({ ggpairs(tips, columns = 1:3, mapping = 1:3) }, "'mapping' should not be numeric") # nolint }) test_that("user functions", { p0 <- ggally_points(tips, ggplot2::aes(x = total_bill, y = tip)) pm1 <- ggpairs(tips, 1:2, lower = list(continuous = "points")) p1 <- pm1[2, 1] expect_equivalent(p0, p1) pm2 <- ggpairs(tips, 1:2, lower = list(continuous = ggally_points)) p2 <- pm2[2, 1] expect_equivalent(p0, p2) }) test_that("NA data", { expect_is_na_plot <- function(p) { expect_true(identical(as.character(p$data$label), "NA")) expect_true(inherits(p$layers[[1]]$geom, "GeomText")) expect_equivalent(length(p$layers), 1) } expect_not_na_plot <- function(p) { expect_false(identical(as.character(p$data$label), "NA")) } expect_is_blank <- function(p) { expect_true(is_blank_plot(p)) } dd <- data.frame(x = c(1:5, rep(NA, 5)), y = c(rep(NA, 5), 2:6), z = 1:10, w = NA) pm <- ggpairs(dd) test_pm <- function(pm, na_mat) { for (i in 1:4) { for (j in 1:4) { if (na_mat[i, j]) { expect_is_na_plot(pm[i, j]) } else { if (j == 3 & i < 3) { expect_warning({ p <- pm[i, j] }, "Removed 5 rows" ) } else { p <- pm[i, j] } expect_not_na_plot(p) } } } } na_mat <- matrix(FALSE, ncol = 4, nrow = 4) na_mat[1, 2] <- TRUE na_mat[2, 1] <- TRUE na_mat[1:4, 4] <- TRUE na_mat[4, 1:4] <- TRUE test_pm(pm, na_mat) }) test_that("strip-top and strip-right", { data(tips, package = "reshape") double_strips <- function(data, mapping, ...) { dt <- count(data, c(mapping_string(mapping$x), mapping_string(mapping$y))) ggplot2::qplot( xmin = 0.25, xmax = 0.75, ymin = 1, ymax = freq, data = dt, geom = "rect" ) + ggplot2::facet_grid(paste0(mapping_string(mapping$y), " ~ ", mapping_string(mapping$x))) + ggplot2::scale_x_continuous(breaks = 0.5, labels = NULL) } pm <- ggpairs( tips, 3:6, lower = "blank", diag = "blank", upper = list(discrete = double_strips), progress = FALSE ) expect_print(pm) pm <- ggpairs( tips, 3:6, lower = "blank", diag = "blank", upper = list(discrete = double_strips), showStrips = TRUE, progress = FALSE ) expect_print(pm) }) test_that("subtypes", { # list of the different plot types to check # continuous # points # smooth # smooth_loess # density # cor # blank # combo # box # dot plot # facethist # facetdensity # denstrip # blank # discrete # ratio # facetbar # blank gn <- function(x) { fnName <- attr(x, "name") ifnull(fnName, x) } ggpairs_fn1 <- function(title, types, diag, ...) { ggpairs( tips, 1:4, axisLabels = "show", title = paste( "upper = c(cont = ", gn(types$continuous), ", combo = ", gn(types$combo), ", discrete = ", gn(types$discrete), "); diag = c(cont = ", gn(diag$continuous), ", discrete = ", gn(diag$discrete), ")", sep = ""), upper = types, lower = types, diag = diag, progress = FALSE, ... ) + ggplot2::theme(plot.title = ggplot2::element_text(size = 9)) } ggpairs_fn2 <- function(...) { ggpairs_fn1(..., mapping = ggplot2::aes(color = day), legend = c(1, 3)) } ggduo_fn1 <- function(title, types, diag, ...) { types$comboHorizontal <- types$combo types$comboVertical <- types$combo types$combo <- NULL ggduo( tips, 1:3, 1:4, axisLabels = "show", title = paste( "types = c(cont = ", gn(types$continuous), ", combo = ", gn(types$comboHorizontal), ", discrete = ", gn(types$discrete), ")", sep = ""), types = types, progress = FALSE, ... ) + ggplot2::theme(plot.title = ggplot2::element_text(size = 9)) } ggduo_fn2 <- function(...) { ggduo_fn1(..., mapping = ggplot2::aes(color = day), legend = 3) + theme(legend.position = "bottom") } # re ordered the subs so that density can have no binwidth param conSubs <- list("density", "points", "smooth", "smooth_loess", "cor", "blank") comSubs <- list( "box", "dot", "box_no_facet", "dot_no_facet", wrap("facethist", binwidth = 1), "facetdensity", wrap("denstrip", binwidth = 1), "blank" ) disSubs <- list("ratio", "facetbar", "blank") conDiagSubs <- c("densityDiag", wrap("barDiag", binwidth = 1), "blankDiag") disDiagSubs <- c("barDiag", "blankDiag") # for (fn in list(ggpairs_fn1, ggpairs_fn2, ggduo_fn1, ggduo_fn2)) { for (fn_num in 1:4) { fn <- list(ggpairs_fn1, ggpairs_fn2, ggduo_fn1, ggduo_fn2)[[fn_num]] for (i in 1:6) { conSub <- if (i <= length(conSubs)) conSubs[[i]] else "blank" comSub <- if (i <= length(comSubs)) comSubs[[i]] else "blank" disSub <- if (i <= length(disSubs)) disSubs[[i]] else "blank" diagConSub <- if (i <= length(conDiagSubs)) conDiagSubs[[i]] else "blankDiag" diagDisSub <- if (i <= length(disDiagSubs)) disDiagSubs[[i]] else "blankDiag" # print(list( # fn_num = fn_num, # types = list( # continuous = conSub, # combo = comSub, # discrete = disSub # ), # diag = list( # continuous = diagConSub, # discrete = diagDisSub # ) # )) # expect_silent({ pm <- fn( types = list( continuous = conSub, combo = comSub, discrete = disSub ), diag = list( continuous = diagConSub, discrete = diagDisSub ) ) }) if (grepl("/Users/barret/", getwd(), fixed = TRUE)) { # only if on personal machine, do viz test expect_print(pm) } } } expect_error({ ggpairs(tips, 1:2, lower = "blank", diag = "blank", upper = list(continuous = "BAD_TYPE")) }) }) # pm <- ggpairs(tips, upper = "blank") # # pm # # Custom Example # pm <- ggpairs( # tips[, c(1, 3, 4, 2)], # upper = list(continuous = "density", combo = "box"), # lower = list(continuous = "points", combo = "dot") # ) # # pm # # Use sample of the diamonds data # data(diamonds, package="ggplot2") # diamonds.samp <- diamonds[sample(1:dim(diamonds)[1], 200), ] # # Custom Example # pm <- ggpairs( # diamonds.samp[, 1:5], # upper = list(continuous = "density", combo = "box"), # lower = list(continuous = "points", combo = "dot"), # color = "cut", # alpha = 0.4, # title = "Diamonds" # ) # # pm # # Will plot four "Incorrect Plots" # bad_plots <- ggpairs( # tips[, 1:3], # upper = list(continuous = "wrongType1", combo = "wrongType2"), # lower = list(continuous = "IDK1", combo = "IDK2", discrete = "mosaic"), # ) # # bad_plots # # Only Variable Labels on the diagonal (no axis labels) # pm <- ggpairs(tips[, 1:3], axisLabels="internal") # # pm # # Only Variable Labels on the outside (no axis labels) # pm <- ggpairs(tips[, 1:3], axisLabels="none") # # pm # # Custom Examples # custom_car <- ggpairs(mtcars[, c("mpg", "wt", "cyl")], upper = "blank", title = "Custom Example") # #' # ggplot example taken from example(geom_text) # #' plot <- ggplot2::ggplot(mtcars, ggplot2::aes(x=wt, y=mpg, label=rownames(mtcars))) # #' plot <- plot + # #' ggplot2::geom_text(ggplot2::aes(colour=factor(cyl)), size = 3) + # #' ggplot2::scale_colour_discrete(l=40) # #' custom_car <- putPlot(custom_car, plot, 1, 2) # #' personal_plot <- ggally_text( # #' "ggpairs allows you\nto put in your\nown plot.\nLike that one.\n <---" # #' ) # #' custom_car <- putPlot(custom_car, personal_plot, 1, 3) # #' # custom_car GGally/tests/testthat/test-ggmatrix_getput.R 0000644 0001762 0000144 00000002406 13001231535 020740 0 ustar ligges users context("ggmatrix_getput") data(tips, package = "reshape") test_that("stops", { pm <- ggpairs(tips) p <- ggally_blankDiag() expect_error(pm["total_bill", 1], "'i' may only be a single") expect_error(pm[1, "total_bill"], "'j' may only be a single") expect_error(pm["total_bill", 1] <- p, "'i' may only be a single") expect_error(pm[1, "total_bill"] <- p, "'j' may only be a single") pm <- ggduo(tips, 1:3, 1:4) expect_error(pm[0, 1], "'i' may only be in the range") expect_error(pm[1, 0], "'j' may only be in the range") expect_error(pm[5, 1], "'i' may only be in the range") expect_error(pm[1, 4], "'j' may only be in the range") for (i in 1:4) { for (j in 1:3) { expect_silent({ p <- pm[i, j] }) } } }) test_that("get", { a <- ggpairs( tips, 1:4, axisLabels = "show" ) p <- a[2, 1] expect_equal(p$labels$x, "total_bill") expect_equal(p$labels$y, "tip") # test odd input and retrieve it a[2, 1] <- 1:4 expect_error({ a[2, 1] }, "unknown plot object type") # nolint }) test_that("put", { a <- ggpairs( tips, 1:4, axisLabels = "show" ) txt <- "My Custom Plot" a[2, 1] <- ggally_text(txt) p <- a[2, 1] expect_equal(get("aes_params", envir = p$layers[[1]])$label, txt) }) GGally/tests/testthat/test-ggmatrix.R 0000644 0001762 0000144 00000007063 13277311163 017367 0 ustar ligges users context("ggmatrix") data(tips, package = "reshape") expect_print <- function(x) { testthat::expect_silent(print(x)) } test_that("stops", { expect_error(ggmatrix(plots = matrix(), nrow = 2, ncol = 3), "'plots' must be a list()") expect_error(ggmatrix(plots = list(), nrow = "2", ncol = 3), "'nrow' must be a numeric value") expect_error(ggmatrix(plots = list(), nrow = 2, ncol = "3"), "'ncol' must be a numeric value") expect_error( ggmatrix(plots = list(), nrow = c(2, 3), ncol = 3), "'nrow' must be a single numeric value" ) expect_error( ggmatrix(plots = list(), nrow = 2, ncol = c(2, 3)), "'ncol' must be a single numeric value" ) }) test_that("expression labels", { chars <- c("col1", "col2") exprs <- c("alpha[0]", "gamma[x + y ^ z]") expect_print(ggpairs(tips, 1:2, columnLabels = exprs, labeller = "label_parsed")) expect_error(print(ggpairs(tips, 1:2, columnLabels = expression(alpha, beta))), "xAxisLabels") }) test_that("byrow", { plotList <- list() for (i in 1:6) { p <- ggally_text(paste("Plot #", i, sep = "")) p$ggally_check_val <- i plotList[[i]] <- p } a <- ggmatrix( plotList, 2, 3, c("A", "B", "C"), c("D", "E"), byrow = TRUE ) k <- 1 for (i in 1:2) { for (j in 1:3) { expect_equal(a[i, j]$ggally_check_val, k) k <- k + 1 } } a <- ggmatrix( plotList, 2, 3, c("A", "B", "C"), c("D", "E"), byrow = FALSE ) k <- 1 for (j in 1:3) { for (i in 1:2) { expect_equal(a[i, j]$ggally_check_val, k) k <- k + 1 } } a }) test_that("missing plot", { plotList <- list() for (i in c(1, 3, 5)) { p <- ggally_text(paste("Plot #", i, sep = "")) p$ggally_check_val <- i plotList[[i]] <- p } a <- ggmatrix( plotList, 2, 3, c("A", "B", "C"), c("D", "E"), byrow = TRUE ) # reaches code where there are more cells than plots print(a) expect_equal(a[1, 1]$ggally_check_val, 1) expect_equal(a[1, 3]$ggally_check_val, 3) expect_equal(a[2, 2]$ggally_check_val, 5) }) test_that("str.ggmatrix", { pm <- ggpairs(tips, 1:3, upper = "blank") pm[1, 1] <- pm[1, 1] txt <- capture.output({ str(pm) }) expect_true(any(str_detect(txt, "Custom str.ggmatrix output:"))) txt <- capture.output({ str(pm, raw = TRUE) }) expect_false(any(str_detect(txt, "Custom str.ggmatrix output:"))) }) test_that("blank", { pm <- ggpairs(tips, 1:2) pm[1, 2] <- "blank" expect_print(pm) pm[2, 1] <- NULL expect_print(pm) expect_equal(length(pm$plots), 4) expect_error({ pm[2, 2] <- "not blank" }, "character values \\(besides 'blank'\\)") # nolint }) test_that("proportions", { pm <- ggpairs(iris, 1:2, mapping = ggplot2::aes(color = Species)) pm[2, 2] <- pm[2, 2] + ggplot2::coord_flip() pm2 <- ggmatrix( data = iris, pm$plots, ncol = 2, nrow = 2, xProportions = c(2, 1), yProportions = c(1, 2), title = "big plot, small marginals" ) expect_print(pm2) # turn on progress for a quick plot # TODO - turn test back on when it uses message properly # testthat::expect_message(print(pm2, progress = TRUE)) }) test_that("ggmatrix_gtable progress", { pm <- ggpairs(iris, 1:2) expect_silent({ pg <- ggmatrix_gtable(pm) }) expect_warning({ ggmatrix_gtable(pm, progress = TRUE) }) expect_warning({ ggmatrix_gtable(pm, progress_format = "asdfasdf :plot_i") }) }) # # printShowStrips <- c(TRUE, FALSE) # if (i <= length(printShowStrips)) { # printShowStrip <- printShowStrips[i] # } else { # printShowStrip <- NULL # } # GGally/NAMESPACE 0000644 0001762 0000144 00000006101 13277311162 012651 0 ustar ligges users # Generated by roxygen2: do not edit by hand S3method("+",gg) S3method("[",ggmatrix) S3method("[",glyphplot) S3method("[<-",ggmatrix) S3method(grid.draw,ggmatrix) S3method(print,ggmatrix) S3method(print,glyphplot) S3method(print,legend_guide_box) S3method(str,ggmatrix) export(add_ref_boxes) export(add_ref_lines) export(brew_colors) export(broomify) export(eval_data_col) export(fn_switch) export(getPlot) export(ggally_barDiag) export(ggally_blank) export(ggally_blankDiag) export(ggally_box) export(ggally_box_no_facet) export(ggally_cor) export(ggally_density) export(ggally_densityDiag) export(ggally_denstrip) export(ggally_diagAxis) export(ggally_dot) export(ggally_dot_and_box) export(ggally_dot_no_facet) export(ggally_facetbar) export(ggally_facetdensity) export(ggally_facetdensitystrip) export(ggally_facethist) export(ggally_na) export(ggally_naDiag) export(ggally_nostic_cooksd) export(ggally_nostic_hat) export(ggally_nostic_resid) export(ggally_nostic_se_fit) export(ggally_nostic_sigma) export(ggally_nostic_std_resid) export(ggally_points) export(ggally_ratio) export(ggally_smooth) export(ggally_smooth_lm) export(ggally_smooth_loess) export(ggally_text) export(ggcoef) export(ggcorr) export(ggduo) export(ggfacet) export(gglegend) export(ggmatrix) export(ggmatrix_gtable) export(ggmatrix_progress) export(ggnet) export(ggnet2) export(ggnetworkmap) export(ggnostic) export(ggpairs) export(ggparcoord) export(ggscatmat) export(ggsurv) export(ggts) export(glyphplot) export(glyphs) export(grab_legend) export(is.glyphplot) export(is_character_column) export(is_horizontal) export(lowertriangle) export(mapping_color_to_fill) export(mapping_string) export(mapping_swap_x_y) export(max1) export(mean0) export(min0) export(model_beta_label) export(model_beta_variables) export(model_response_variables) export(print_if_interactive) export(putPlot) export(range01) export(rescale01) export(rescale11) export(scatmat) export(uppertriangle) export(v1_ggmatrix_theme) export(wrap) export(wrap_fn_with_param_arg) export(wrap_fn_with_params) export(wrapp) import(RColorBrewer) import(ggplot2) import(plyr) import(utils) importFrom(grDevices,colorRampPalette) importFrom(grDevices,gray.colors) importFrom(grid,gpar) importFrom(grid,grid.draw) importFrom(grid,grid.layout) importFrom(grid,grid.newpage) importFrom(grid,grid.rect) importFrom(grid,grid.text) importFrom(grid,popViewport) importFrom(grid,pushViewport) importFrom(grid,seekViewport) importFrom(grid,upViewport) importFrom(grid,viewport) importFrom(gtable,gtable_filter) importFrom(reshape,melt) importFrom(reshape,melt.data.frame) importFrom(reshape,melt.default) importFrom(rlang,"%||%") importFrom(stats,anova) importFrom(stats,complete.cases) importFrom(stats,cor) importFrom(stats,lm) importFrom(stats,mad) importFrom(stats,median) importFrom(stats,na.omit) importFrom(stats,pf) importFrom(stats,qnorm) importFrom(stats,quantile) importFrom(stats,sd) importFrom(stats,spline) importFrom(stats,symnum) importFrom(stats,terms) importFrom(stats,time) importFrom(utils,capture.output) importFrom(utils,head) importFrom(utils,installed.packages) importFrom(utils,str) GGally/NEWS.md 0000644 0001762 0000144 00000022267 13277315152 012546 0 ustar ligges users GGally 1.3.3 ---------------- `ggpairs` and `ggduo` * Become ggplot2 v2.2.2 compliant (#266) * When retrieving functions with wrap, `ggally_*` functions do not require the GGally namespace (#269) * Exported `eval_data_col`, `mapping_string`, and `mapping_swap_x_y` (5d157f6) * Exported `is_horizontal` and `is_character_column` (#270) * Logical values are now treated as discrete (#272) `ggmatrix` * `progress` parameter added to ggmatrix (and appropriate parent functions). Allows for `TRUE`, `FALSE`, `NULL`, and `function(pm){...}` (#271) `ggnostic` * Cooks distance cutoff is now at F_{p, n - p}(0.5) (#274) `ggnet2` * Replaced loading packages with loading namespaces(#262) `ggally_smooth` * Added `shrink` and `se` parameters to `ggally_smooth` (#247) `ggcoef` * Added `sort` parameter to sort by beta values (#273) `ggparcoord` * Fixed bug where x axis breaks and labels did not appear when `splineFactor = TRUE` (#279) GGally 1.3.2 ----------------- `ggpairs` and `ggduo` * Removed warning where pure numeric names gave a warning (#238, @lepennec) * Fixed ordering issue with horizontal boxplots (#239) `ggparcoord` * Fixed missing `x` aes requirement when shadebox is provided (#237, @treysp) Package * Made igraph a non required dependency for tests (#240) GGally 1.3.1 ----------------- Added new dataset `psychademic` * See `?psychademic` for more details * (And updated the broken UCLA links) Added original ggmatrix theme * added function to set theme to have clear strip background and rearrange the strip positions * added parameter `switch` to ggmatrix (and friends) to allow for strip repositioning. See `?ggplot::facet_grid` for more documentation on `switch` (#223, #224) `ggsurv` error reporting * removed a one error check that is covered in other places (#222) `+.gg` * allow to add a list of items to a ggmatrix (#228) `ggmatrix.print` * fix strip issues with ggplot2 name update GGally 1.3.0 ----------------- `ggmatrix.print` - massive update! * Now prints with a ggplot2 facet'ed structure * Column titles are now placed in the strip of a plot matrix * If there are 16 plots or more, a progress bar is displayed automatically (if interactive). Please look at the documentation for `ggmatrix_gtable` more details. `ggmatrix` legend * A legend may be added with the `legend` parameter in `ggduo`, `ggpairs`, and `ggmatrix` * May specify a (length two) numeric plot coordinate * May specify a (length one) numeric plot position * May specify a legend object retrieved from `grab_legend` `ggnostic` - New function! * Produces a `ggmatrix` of diagnostic plots from a model object * Uses broom to retrieve model information * Each column of the plot matrix is a predictor variable. The rows can display the response variables, fitted points, residuals, standardized residuals, leave one out model sigma values, diagonals of the hat matrix, and cook's distance for each point. `ggfacet` - New function! * Produces single ggplot2 object * interface is very similar to `ggduo` and `ggpairs` `fn_switch` - New function! * Provide many functions in a list but only call one function at run time according to a mapping value * Useful for `ggnostic` for different behavior depending on the y variable * Allows for a 'default' value for the default switch case `ggmatrix` - allow custom labellers for facet labels * Added labeller parameter which is supplied to `ggplot2::facet_grid()` * Allows for labels with plotmath expressions `ggmatrix` and `ggplot2::last_plot()` * If a `ggmatrix` object is printed, `ggplot2::last_plot()` will return the plot matrix `ggmatrix` and ggplot2 labels * `ggplot2::labs` `+`'ed to a ggmatrix object * `ggplot2::xlab` and `ggplot2::ylab` may be `+`'ed to a ggmatrix object * `ggplot2::ggtitle` `+`'ed to a ggmatrix object * (anything that returns a class of "labels" may be added to a ggmatrix object) `ggmatrix` and `ggplot2::ggsave()` * `ggsave` now works with `ggmatrix` objects `ggpairs` and `ggduo` check for cardinality (#197) * Before creating a ggmatrix object, a check is made for character/factor columns * If there are more than 15 (default) unique combinations, an error is thrown. * Setting `cardinality_threshold` parameter to a higher value can fix the problem (knowing single cell plots may take more time to produce) * Setting `cardinality_threshold` parameter to `NULL` can stop the check `ggmatrix` plot proportions * `ggmatrix` can set the plot proportions with the parameters `xProportions` and `yProportions` * These will change the relative size of the plot panels produced. `ggally_cor` colour aesthetic * color must be a non-numeric value `ggsurv` * added boolean to allow for legend to not be sorted * fixed bug where censored points with custom color didn't match properly (#185) Vignettes * vignettes are now displayed using `packagedocs`. More info at http://hafen.github.io/packagedocs/ `ggally_box_no_facet` and `ggally_dot_no_facet` * New methods added as defaults to pair with new ggmatrix print method GGally 1.2.0 ----------------- install requirements * relaxed install requirements on grid (5d06dfc, d57469a, 933bb14, 73b314d) ggduo - New! * plot two grouped data in a plot matrix (#173) * helpful for plotting two sets of columns, multivariate analysis, and canonical correlation analysis * be sure to check out the examples! ggally_smooth_loess - New! * uses the loess method with drawing a line (1552f96) ggally_smooth_lm - New! * uses the lm method with drawing a line (1552f96) * alias of ggally_smooth ggmatrix.print * fixed bug strips where causing spacing issue when printing axis labels (174630d) ggnetworkmap * fixed bug where checking for the package 'intergraph' couldn't be reached ggsurv * changed default of plotting multiple censored data color to match the survival line package testing * added many more tests! GGally 1.1.0 ----------------- ggcoef - New! * plot model coefficients with broom and ggplot2 PR#162 * Plotting model coefficients (http://www.r-statistics.com/2010/07/visualization-of-regression-coefficients-in-r/) gglegend - New! * pull out the legend of a plot which can also be used in ggpairs PR#155, PR#169 ggally_densityDiag * fixed bug where '...' was not respected (d0fe633) ggally_smooth * added 'method' parameter (411213c) ggally_ratio * Does not call ggfluctuation2 anymore. PR#165 ggcorr * fixed issue with unnamed correlation matrix used as input PR#146 * fixed issue undesired shifting when layout.exp was > 0 PR#171 ggfluctuation2 * is being deprecated. Please use ggally_ratio instead PR#165 ggnetworkmap * fixed issue with overlaying network on a world map PR#157 ggparcoord * Fixed odd bug where a list was trying to be forced as a double PR#162 ggpairs * Fixed improperly rotated axes with ggally_ratio PR#165 ggscatmat * added 'corMethod' parameter for use in upper triangle PR#145 ggsurv * size.est and size.ci parameters added PR#153 * ordering changed to reflect survival time PR#147 * added a vignette PR#154 wrap * documentation updated PR#152 * changes default behavior only. If an argument is supplied, the argument will take precedence github chat * https://gitter.im/ggobi/ggally is the place to visit for general questions. travis-ci * cache packages for faster checking * install covr and lintr from github for testing purposes GGally 1.0.1 ----------------- ggparcoord * fix handling of factor group variable PR#131 ggscatmat * force all char columns to factors PR#134 print.ggmatrix * add boolean for grid.newpage ggmatrix print method PR#126 GGally 1.0.0 ----------------- ggplot2 * GGally has been upgraded to run on the latest ggplot2 v1.1.0. PR#109 New functions * ggmatrix. Make a generic matrix of ggplot2 plots * ggnetworkmap. Plot a network with ggplot2 suitable for overlay on a ggmap::map ggplot, or other ggplot * ggnet2. Function for plotting network objects using ggplot2, with additional control over graphical parameters that are not supported by the ggnet function Vignettes * glyph - new! * ggmatrix - new! * ggnetworkmap - new! * ggpairs - new! * ggscatmat - new! ggmatrix * allows for bracket notation when getting or setting plots. PR#61 * full control over axis labels and axis text. PR#107, PR#111 ggpairs * is now wrapper to ggmatrix * takes in 'wrapped' functions. This better handles the case of many different parameters being supplied to different plot types. PR#90 * dates are better handled in ggpairs. Still room for improvement for default behavior, but they do not cause errors. PR#58, PR#59 * displays a 'NA' plot when all or a combination of the data is NA. PR#119 ggcorr * legend title expressions may be used. PR#55 * handles objects that may be coerced into a data.frame PR#70 gglyph * changed geom_line to geom_path in gglyph. Fixes ordering issue. PR#51 ggparcoord * remaining columns are passed through so aesthetics may be added later. PR#54 * fixed parcoord ordering issues with odd names. PR#106 * fixed scaling when unique length equals 1. PR#122 ggsurv * color censored marks the same color as the line. PR#74 * allow for different censored color marks. PR#113 ggally_density * add fake data points to extend the limits of the stat_density2d. PR#114 ggally_na * new plot type! Data * removed cityServiceFirms * added twitter_spambots GGally/data/ 0000755 0001762 0000144 00000000000 13114357267 012353 5 ustar ligges users GGally/data/psychademic.rda 0000644 0001762 0000144 00000012370 13114357267 015337 0 ustar ligges users BZh91AY&SYÉœ 1ŠÿÿÿL!Áe<7ÿÿødïçÿøGŒ1Me,äÿ÷ÿÿÿà™”oŽ H P#»u© fœØw]Þ ÞñèºpÞråŒjïï{ÀÍ9²Èjz )…LAê6iF™&44M @hÄ iè‰SQ ÈÄÈx¦ÓÕ4ô𠯧”zƒÔ 4 iê É Jy*R¨ h £ Ð žª”¤mA¡¦M 4dÓM Ða ˆ Ѧšb 1 A£Fš 2 É‘£&ƒ 0#&ƒ##FŒ˜™4a !bdÉ“#C&F¦# ˆ"ˆS$Þ„4É©¤ð§©“OI´ž(Éê=FMÔÐPõ=Ci’ ¤2hõCjzž õQ 1='©µSëýÀà+ñ´åÎ)iÑž/âÇ‹¼Ío(Ç“i§["™ÎÝž¬’bŸ~ÕÝÉM¶Úf)%—¤¬N™ÑÇt‰we¬•M]ÓMH Í;@ˆè¼‰Çq¦d¨{eæRÛlj·„äÄQÔn¡§#ȯ ‚¢†!;ïMÿD;„º8|÷ÅÛÜ\áC¡tšŽÄ¼õ¥<ëÖ& 4µÛï«oZ´¯Ì5Û m´QBTó{LilDšQE=¦ÛáÙwþGó>'éTËá~ÿwãߙί#¤ „Ý"p`)ŽÁ¤D7)‰t\_£àðë—òkoÛe>_g¾ÑDxØâ:0äæû<ÃQÙÇáj>"ø—rT’»J©wJˆŠ•,M ¥ìR{.Ø6˜Æa"MòÎÕ̸²NÖÖs¤±…ÊÁtI:ºaÂ--I¢b’CÚ)!!éã;-L‘'šyæLP“»rÄ”Ösµ¡Û+›†ÚVsÛ¦R6 6¶Îi®Dœl"=[ŠÙÈgcë#E*