diff --git a/DESCRIPTION b/DESCRIPTION index e2e7441..bc1f60f 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,8 +1,8 @@ Package: gsplot Type: Package Title: Geological Survey Plotting -Version: 0.4.4 -Date: 2015-09-16 +Version: 0.5.1 +Date: 2015-12-13 Authors@R: c( person("Jordan", "Read", role = "aut", email = "jread@usgs.gov"), person("Laura", "DeCicco", role = c("aut","cre"), diff --git a/R/access-gsplot.R b/R/access-gsplot.R index 45e13c0..4fb5755 100644 --- a/R/access-gsplot.R +++ b/R/access-gsplot.R @@ -82,7 +82,7 @@ logged.gsplot <- function(object, side=NULL){ #' @return data frame with one row per view. Each view has an x side, y side, the log command, and the view index. #' @export view_info <- function(object){ - j <- which(names(object) %in% 'view') + j <- which_views(object) viewSides <- sapply(j, function(x) object[[x]][['window']][['side']]) viewLogs <- sapply(j, function(x) object[[x]][['window']][['log']]) viewInfo <- data.frame(t(rbind(viewSides, viewLogs, j)), stringsAsFactors = FALSE) diff --git a/R/calc_views.R b/R/calc_views.R index 023d0fc..2be2818 100644 --- a/R/calc_views.R +++ b/R/calc_views.R @@ -24,12 +24,18 @@ calc_views <- function(gsplot){ return(views) } +which_views <- function(gsplot){ + grep('view.', names(gsplot)) +} + views <- function(gsplot){ - gsplot[names(gsplot) %in% 'view'] + gsplot[which_views(gsplot)] } non_views <- function(gsplot){ - gsplot[!names(gsplot) %in% 'view'] + non.views <- gsplot + non.views[which_views(non.views)] <- NULL + return(non.views) } group_views <- function(gsplot){ @@ -50,7 +56,9 @@ group_views <- function(gsplot){ views[[v.i]] <- append(views[[v.i]], to_draw) views[[v.i]][['window']][['par']] <- append_replace(views[[v.i]][['window']][['par']], tail.gs[['gs.config']][['par']]) } else{ - views <- append(views, list(view = append(to_draw, list(window=list(side=add_sides,par=tail.gs[['gs.config']][['par']]))))) + new.view <- list(append(to_draw, list(window=list(side=add_sides,par=tail.gs[['gs.config']][['par']])))) %>% + setNames(sprintf('view.%s.%s',add_sides[1],add_sides[2])) + views <- append(views, new.view) } } else { # // if field isn't associated with a side(s), it is moved up to top level (e.g., legend) @@ -88,7 +96,7 @@ which_reals <- function(values, na.value){ } set_view_window <- function(views, param, na.value=NA, remove=TRUE, ignore=NULL){ - view_i <- which(names(views) %in% "view") + view_i <- which_views(views) for (i in view_i){ values <- lapply(views[[i]][!names(views[[i]]) %in% ignore], function(x) strip_pts(x, param)) val.i <- which_reals(values, na.value) @@ -117,16 +125,18 @@ set_view_lab <- function(views){ set_view_lim <- function(views){ + y.include <- c('y','y1','y0','ytop','ybottom') + x.include <- c('x','x1','x0','xleft','xright') views <- set_view_window(views, param = 'xlim', na.value=NA, ignore='window', remove=FALSE) views <- set_view_window(views, param = 'ylim', na.value=NA, ignore='window', remove=FALSE) - data <- list(y=summarize_args(views,c('y','y1','y0'),ignore=c('window','gs.config')), - x=summarize_args(views,c('x','x1','x0'),ignore=c('window','gs.config'))) + data <- list(y=summarize_args(views, y.include, ignore=c('window','gs.config')), + x=summarize_args(views, x.include, ignore=c('window','gs.config'))) - axs <- list(yaxs=summarize_args(views,c('yaxs'),ignore=c('gs.config')), - xaxs=summarize_args(views,c('xaxs'),ignore=c('gs.config'))) + axs <- list(yaxs=summarize_args(views, c('yaxs'), ignore=c('gs.config')), + xaxs=summarize_args(views, c('xaxs'), ignore=c('gs.config'))) - definedSides <- unlist(c_unname(views),recursive = FALSE) + definedSides <- unlist(c_unname(views), recursive = FALSE) definedSides <- unique(unname(unlist(definedSides[grep("side", names(definedSides))]))) for(param in c('y','x')){ @@ -192,7 +202,7 @@ views_with_side <- function(views, side){ if(length(side) > 1) stop('side can only be length of 1') with.side = lapply(views, function(x) any(x[['window']][['side']] %in% side)) - view.match = unname(unlist(with.side[names(with.side) == 'view'])) + view.match = unname(unlist(with.side[which_views(views)])) if (is.null(view.match) || !any(view.match)) return(NULL) else @@ -200,7 +210,7 @@ views_with_side <- function(views, side){ } get_view_side <- function(views, view_i, param){ - i = which(names(views) %in% 'view')[view_i] + i = which_views(views)[view_i] sides <- views[[i]][['window']][['side']] if (param=='y') return(sides[which(sides %% 2 == 0)]) @@ -210,9 +220,9 @@ get_view_side <- function(views, view_i, param){ stop('view side undefined for ',param) } -summarize_args <- function(views, param, na.value,ignore='gs.config'){ +summarize_args <- function(views, param, na.value, ignore='gs.config'){ - view_i <- which(names(views) %in% "view") + view_i <- which_views(views) values <- list() for (i in view_i){ x <- views[[i]][!names(views[[i]]) %in% ignore] @@ -254,7 +264,7 @@ set_window <- function(list){ listOut <- list pars <- list[['par']] - for(j in which(names(list) == "view")){ + for(j in which_views(list)){ window <- list[[j]][['window']] plots <- list[[j]] diff --git a/R/callouts.R b/R/callouts.R index 0399330..f329897 100644 --- a/R/callouts.R +++ b/R/callouts.R @@ -38,10 +38,11 @@ callouts.gsplot <- function(object, ..., side=c(1,2)){ #' @param labels text to be added to callout #' @param length relative (percentage of window width and height) distance for callout #' @param angle callout line angle +#' @param cex passed to text for font size formatting #' #' @rdname callouts #' @export -callouts.default <- function(x, y=NULL, labels=NA, length=0.1, angle='auto', cex=1, ...){ +callouts.default <- function(x, y=NULL, labels=NA, length=0.1, angle='auto', cex=par()$cex, ...){ if (is.null(y)) { warning("y=NULL not currently supported in callouts.default") diff --git a/R/points.R b/R/points.R index 3a5faba..a10fca5 100644 --- a/R/points.R +++ b/R/points.R @@ -27,8 +27,8 @@ #' #' gs <- gsplot() %>% #' points(x=1:5, y=1:5, xlim=c(0,10), ylim=c(0,10), -#' callouts=list(labels=c(rep(NA, 4), "oh")), -#' error_bar=list(y.high=1)) +#' callouts(labels=c(rep(NA, 4), "oh")), +#' error_bar(y.high=1)) #' gs #' #' gs2 <- gsplot() %>% diff --git a/README_files/figure-markdown_github/unnamed-chunk-2-1.png b/README_files/figure-markdown_github/unnamed-chunk-2-1.png index 2295404..0a4c399 100644 Binary files a/README_files/figure-markdown_github/unnamed-chunk-2-1.png and b/README_files/figure-markdown_github/unnamed-chunk-2-1.png differ diff --git a/README_files/figure-markdown_github/unnamed-chunk-3-1.png b/README_files/figure-markdown_github/unnamed-chunk-3-1.png index c83fe35..36205cf 100644 Binary files a/README_files/figure-markdown_github/unnamed-chunk-3-1.png and b/README_files/figure-markdown_github/unnamed-chunk-3-1.png differ diff --git a/README_files/figure-markdown_github/unnamed-chunk-4-1.png b/README_files/figure-markdown_github/unnamed-chunk-4-1.png index 8f8c4e6..b812d81 100644 Binary files a/README_files/figure-markdown_github/unnamed-chunk-4-1.png and b/README_files/figure-markdown_github/unnamed-chunk-4-1.png differ diff --git a/man/callouts.Rd b/man/callouts.Rd index 6492541..88e3127 100644 --- a/man/callouts.Rd +++ b/man/callouts.Rd @@ -8,7 +8,7 @@ callouts(object, ...) callouts.default(x, y = NULL, labels = NA, length = 0.1, angle = "auto", - cex = 1, ...) + cex = par()$cex, ...) } \arguments{ \item{object}{gsplot object} @@ -23,6 +23,8 @@ callouts.default(x, y = NULL, labels = NA, length = 0.1, angle = "auto", \item{angle}{callout line angle} +\item{cex}{passed to text for font size formatting} + \item{\dots}{Further graphical parameters may also be supplied as arguments. See 'Details'.} } \description{ diff --git a/man/points.Rd b/man/points.Rd index e4d310d..b45d1b7 100644 --- a/man/points.Rd +++ b/man/points.Rd @@ -37,8 +37,8 @@ gsNew gs <- gsplot() \%>\% points(x=1:5, y=1:5, xlim=c(0,10), ylim=c(0,10), - callouts=list(labels=c(rep(NA, 4), "oh")), - error_bar=list(y.high=1)) + callouts(labels=c(rep(NA, 4), "oh")), + error_bar(y.high=1)) gs gs2 <- gsplot() \%>\% diff --git a/tests/testthat/test-mtext.R b/tests/testthat/test-mtext.R index 79c73d6..9c0a6d3 100644 --- a/tests/testthat/test-mtext.R +++ b/tests/testthat/test-mtext.R @@ -11,7 +11,15 @@ test_that("mtext on correct side", { expect_false(gs[[i]][['window']][['axes']]) }) - +test_that("mtext las defined for both mtext calls", { + gs <- gsplot() %>% + points(1,2) %>% + mtext(text=c(1,2,3,4), at=c(0.7,0.9,1.1,1.3), cex=0.5, las=2, side=1, line=1) %>% + mtext(text=c("yr1", "yr2"), at=c(0.8, 1.2), las=1, side=1, line=3) + + expect_true(names(gs[['view.1.2']][[2]]) %in% "las") + expect_true(names(gs[['view.1.2']][[3]]) %in% "las") +}) test_that("multiple mtext are on correct sides", { gs <- gsplot() %>% diff --git a/tests/testthat/test-rect.R b/tests/testthat/test-rect.R new file mode 100644 index 0000000..0d01f1c --- /dev/null +++ b/tests/testthat/test-rect.R @@ -0,0 +1,20 @@ +context("test rect") + +test_that("testing rectangle arguments for limits", { + + gs <- gsplot() %>% + rect(1,5,2,7, col="pink", border=NA) %>% + points(1:5, 1:5, pch=5, col="blue") %>% + lines(3:7, 1:5, col="darkgreen") %>% + error_bar(x=4, y=4, y.high=0.5, y.low=0.7, epsilon=0.5) + + expect_equal(ylim(gs)$side.2, c(1,7)) + + gs <- gsplot() %>% + rect(-1,5,2,7, col="pink", border=NA) %>% + points(1:5, 1:5, pch=5, col="blue") %>% + lines(3:7, 1:5, col="darkgreen") %>% + error_bar(x=4, y=4, y.high=0.5, y.low=0.7, epsilon=0.5) + + expect_equal(xlim(gs)$side.1, c(-1,7)) +}) \ No newline at end of file diff --git a/tests/testthat/tests-abline.R b/tests/testthat/tests-abline.R index 9560f87..c37a78b 100644 --- a/tests/testthat/tests-abline.R +++ b/tests/testthat/tests-abline.R @@ -46,7 +46,7 @@ test_that("arrows gsplot",{ ## draw arrows from point to point : s <- seq(length(x)-1) # one shorter than data gs = arrows(gs, x[s], y[s], x[s+1], y[s+1], col= 1:3) - expect_equal(gs$view$arrows$col, 1:3) + expect_equal(gs$view.1.2$arrows$col, 1:3) }) test_that("grid",{ @@ -59,7 +59,7 @@ test_that("grid",{ axis(side=3, labels=FALSE) %>% grid(side=c(1,2),col="green") %>% grid(side=c(3,4)) - expect_equal(names(gs$view),c("points","grid","window")) - expect_equal(gs$view$grid$col,"green") + expect_equal(names(gs$view.1.2),c("points","grid","window")) + expect_equal(gs$view.1.2$grid$col,"green") }) \ No newline at end of file diff --git a/tests/testthat/tests-axis.R b/tests/testthat/tests-axis.R index 38cbb27..bcec656 100644 --- a/tests/testthat/tests-axis.R +++ b/tests/testthat/tests-axis.R @@ -12,14 +12,14 @@ test_that("axis",{ }) test_that("axis gsplot",{ - gs = points(gsplot(), c(-2,3), c(-1,5)) %>% + gs = points(gsplot(mar=c(1,1,1,1)), c(-2,3), c(-1,5)) %>% axis(3) - expect_equal(names(gs), c("view","par","axis")) + expect_equal(names(gs), c("view.1.2","par","axis")) gs <- gsplot() %>% lines(1:5, c(1,10,100,1000,10000), log="y", axes=FALSE) %>% axis(side=c(2,4), labels=FALSE, n.minor=4) - expect_false(gs$view$window$axes) + expect_false(gs$view.1.2$window$axes) }) \ No newline at end of file diff --git a/tests/testthat/tests-error_bars.R b/tests/testthat/tests-error_bars.R index 7d01ee7..b451a03 100644 --- a/tests/testthat/tests-error_bars.R +++ b/tests/testthat/tests-error_bars.R @@ -9,7 +9,7 @@ test_that("testing content of gsplot list for multiple error bars defined", { gs <- points(gs, c(0,3), c(2,4)) %>% error_bar(c(0,3), c(2,4), y.high=c(2,2), x.low=c(NA,1)) - expect_true(length(which(names(gs[['view']]) == "arrows"))==2) + expect_true(length(which(names(gs[['view.1.2']]) == "arrows"))==2) })