Merge pull request #468 from ldecicco-USGS/axis_stuff

Axis stuff

.travis.yml

@@ -6,13 +6,13 @@
 
 language: r
 cache: packages
-sudo: false
 dist: trusty
 
 matrix:
   include:
     - os: linux
       r: release
+      env: R_CODECOV=true
     - os: linux
       r: devel
 
@@ -28,7 +28,7 @@ r_github_packages:
   - jimhester/covr
 
 after_success:
-  - Rscript -e 'covr::coveralls()'
+  - if [[ "${R_CODECOV}" ]]; then R -e 'covr::coveralls()'; fi
 
 notifications:
   email:

R/axis.R

@@ -94,28 +94,52 @@ axis.gsplot <- function(object, ..., n.minor=0, tcl.minor=NA, reverse=NULL, appe
   user.args[[fun.name]]$tcl.minor <- tcl.minor
 
   user.args[[fun.name]] <- append_replace(user.args[[fun.name]], args$option.args)
+  view.info <- view_info(object)
 
   for(side in sides){
     # append the side and give it defaults if it doesn't exist
+
+    side.name <- as.side_name(side)
+    object <- modify_side(object, args = list(), side=side)
+
     if(!append){
-      object <- modify_side(object, args = list(), side=side) 
+
+      which.axis <- which(names(object[[side.name]])== 'axis')
+      if(length(which.axis) > 1){
+        object[[side.name]] <- object[[side.name]][-which.axis[2:length(which.axis)]]
+      }
+
+      object[[side.name]][[fun.name]] <- append_replace(object[[as.side_name(side)]][[fun.name]], user.args[[fun.name]])
+    } else {
+
+      user.args$axis <- c(side = side, user.args$axis)
+      object[[side.name]] <- c(object[[side.name]],user.args)
     }
+
+    object[[side.name]][['usr.axes']] <- TRUE
 
-    object[[as.side_name(side)]][['usr.axes']] <- TRUE
-    object[[as.side_name(side)]][['axis']] <- append_replace(object[[as.side_name(side)]][['axis']], user.args[[fun.name]])
     if (!is.null(reverse)){
-      object[[as.side_name(side)]][['reverse']] <- reverse
+      object[[side.name]][['reverse']] <- reverse
+    }
+
+    class(object) <- 'gsplot'
+
+    if(!is.null(view.info) && length(views_with_side(object, side)) == 0){
+      if(side %% 2 == 1){ #odd
+        object <- view(object, side=c(side, view.info$y[1]), log=view.info$log[1])
+      } else { #even
+        object <- view(object, side=c(view.info$x[1], side), log=view.info$log[1])
+      }
     }
+
   }
 
-  class(object) <- 'gsplot'
+  # class(object) <- 'gsplot'
   return(object)
 
 }
 
 draw_axis <- function(object, side.name){
-
-
   # method isn't made for multiple axis calls
   which.axis <- which(names(object[[side.name]]) == 'axis')
   if (length(which.axis) > 1){
@@ -124,8 +148,8 @@ draw_axis <- function(object, side.name){
       tmp[[side.name]] <- tmp[[side.name]][-which.axis[which.axis %in% axis.i]]
       draw_axis(tmp, side.name)
     }
+
   }
-
   axis.args <- object[[side.name]][['axis']]
   side.lim <- object[[side.name]][['lim']]
 
@@ -142,15 +166,14 @@ draw_axis <- function(object, side.name){
 
     tcl <- NULL
     if (exists('tcl.minor',axis.args)){
-      tcl <- ifelse(is.na(axis.args$tcl.minor), par('tcl')*0.5, axis.args$tcl.minor)
+      tcl <- axis.args$tcl.minor
+
     }
 
     axis.args$n.minor <- NULL
     axis.args$tcl.minor <- NULL
 
-    do.call('Axis', axis.args)
-
-
+    do.call('Axis', axis.args)    
 
     # Minor axis:
 
@@ -186,4 +209,4 @@ draw_axis <- function(object, side.name){
     axis.args$tcl <- tcl
     do.call('Axis', axis.args)
   }
-}
+}

R/modify_side.R

@@ -27,22 +27,11 @@ modify_side <- function(object, args, side) {
   for (sideName in sideNames) {
     sideNum <- as.side(sideName)
     thisSide <- sides[[sideName]]
-
-    if("side.3" == sideName & length(views_with_side(object, 3)) == 0 & "side.1" %in% names(object)){
-      thisSide$log <- object$side.1$log
-    } else if ("side.4" == sideName & length(views_with_side(object, 4)) == 0 & "side.2" %in% names(object)){
-      thisSide$log <- object$side.2$log
-    } else if ("side.1" == sideName & length(views_with_side(object, 1)) == 0 & "side.3" %in% names(object)){
-      thisSide$log <- object$side.3$log
-    } else if ("side.2" == sideName & length(views_with_side(object, 2)) == 0 & "side.4" %in% names(object)){
-      thisSide$log <- object$side.4$log
-    }
-
+
     thisSide <- set_side_lim(args, thisSide, sideNum)
     thisSide <- set_side_log(args, thisSide, sideNum)
     thisSide <- set_side_lab(args, thisSide, sideNum)
     thisSide <- set_side_axes(args, thisSide, sideNum)
-
 
     object[[sideName]] <- thisSide
   }

tests/testthat/tests-axis.R

@@ -15,14 +15,15 @@ test_that("axis gsplot",{
   gs = points(gsplot(mar=c(1,1,1,1)), c(-2,3), c(-1,5)) %>% 
     axis(3)
   expect_true(all(names(gs) %in% c("side.1", "side.2", "side.3", 
-                                   "view.1.2", "global", "metadata")))
+                                   "view.1.2","view.3.2",
+                                   "global", "metadata")))
 
   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$side.1$axes)
-  expect_false(gs$side.2$axes)
+  expect_false(gs$side.2$axes) 
 
 })
 
@@ -52,8 +53,9 @@ test_that("axis can append a second one",{
   gs <- gsplot() %>% 
     points(0:1,0:1) %>% 
     axis(side=1, at=c(0.5,1)) %>% 
-    axis(side=1, at=c(0.25, 0.75), append=TRUE)
-  # expect_equal(sum(names(gs$side.1) == 'axis'), 2)
+    axis(side=1, at=c(0.33, 0.85), append=TRUE)
+  expect_equal(sum(names(gs$side.1) == 'axis'), 2)
+  expect_equal(sum(names(gs$side.3) == 'axis'), 0)
 })
 
 test_that("axis can append a third one and the forth clears them",{
@@ -63,7 +65,10 @@ test_that("axis can append a third one and the forth clears them",{
     axis(side=1, at=c(0.25, 0.75), append=TRUE) %>% 
     axis(side=1, at=c(0.45, 0.55), append=TRUE)
 
-  # expect_equal(sum(names(gs$side.1) == 'axis'), 3)
+  expect_equal(sum(names(gs$side.1) == 'axis'), 3)
+  expect_equal(sum(names(gs$side.3) == 'axis'), 0)
+  expect_equal(sum(names(gs$side.4) == 'axis'), 0)
+
   gs <- gsplot() %>% 
     points(0:1,0:1) %>% 
     axis(side=1, at=c(0.5,1)) %>% 
@@ -80,7 +85,7 @@ test_that("axis tracks append FALSE by default",{
     axis(side=1, at=c(0.5,1)) %>% 
     axis(side=1, at=c(0.25, 0.75)) %>% 
     axis(side=1, at=c(0.45, 0.55), append=TRUE)
-  # expect_equal(sum(names(gs$side.1) == 'axis'), 2)
+  expect_equal(sum(names(gs$side.1) == 'axis'), 2)
 })
 
 context("axis style arguments handled appropriately")
@@ -92,14 +97,16 @@ test_that("par args sent to axis() end up in axis args",{
 
 test_that("special args given to axis are retained", {
   gs <- points(gsplot(), 1, 0) %>% axis(side=1, n.minor = 4)
+  # Not printing minor ticks though!!!!
   expect_equal(gs$side.1$axis[["n.minor"]], 4)
 
   gs <- points(gsplot(), 1, 0) %>% axis(side=1, tcl.minor = -0.136)
   expect_equal(gs$side.1$axis[["tcl.minor"]], -0.136)
 })
 
 test_that("style params given to points calls are in side par, style on axis stay there",{
-  gs <- points(gsplot(), 1, 0, tcl=0.5) %>% axis(side=1, tcl = -0.136)
+  gs <- points(gsplot(), 1, 0, tcl=0.5) %>% 
+    axis(side=1, tcl = -0.136)
   expect_equal(gs$side.1$axis[["tcl"]], -0.136)
   expect_equal(gs$side.1$par[["tcl"]], 0.5)
 })
@@ -134,4 +141,48 @@ test_that("format",{
            1:12) %>%
     axis(side = 1, format="%B")
   expect_equal(gs$side.1$axis$format, "%B")
-})
+})
+
+test_that("log stuff",{
+
+  gs <- gsplot() %>%
+        points(1:100, 1:100, log="xy", side=c(3,4))  %>%
+        axis(1)
+  # Right now, only converting the log arg on print
+  # If 
+  expect_true(gs$side.1$log)
+
+  gs <- gsplot() %>%
+    points(1:100, 1:100, log="xy")  %>%
+    axis(3) 
+
+  expect_true(gs$side.3$log)
+
+  gs <- gsplot() %>%
+    points(1:100, 1:100, log="xy")  %>%
+    axis(3) %>%
+    points(1:100, 1:100, log="y", side=c(3,4))
+
+  expect_true(gs$side.3$log)
+
+  gs <- gsplot() %>%
+    points(1:100, 1:100, log="xy", side=c(3,4))  %>%
+    axis(c(1,2))
+  expect_true(gs$side.1$log)
+  expect_true(gs$side.2$log)
+
+  gs <- gsplot() %>% 
+    points(1:3, c(1,10,100)) %>% 
+    points(3:5, c(10,100,1000), col="blue", side=4, log='y') %>% 
+    axis(side=4) 
+  expect_true(gs$side.4$log)
+  expect_false(gs$side.2$log)
+
+  gs <- gsplot() %>%
+    points(1:100, 1:100, log="xy", side=c(3,4))  %>% 
+    axis(1, at=c(2,5,50), labels = FALSE) %>%
+    view(c(1,2), log="xy", axes=FALSE)
+
+  expect_true(gs$side.1$log)
+
+})

tests/testthat/tests-date_axis.R

@@ -5,12 +5,12 @@ test_that("two axis calls added to side 1", {
     points(seq(as.Date("2013-01-01"), as.Date("2013-01-31"), "days"), 1:31) %>%
     date_axis(side=1, lab.pos = "interval", tick.int="day", "snap.to"="month")
 
-  # expect_equal(length(grep(pattern = "axis", names(gs[['side.1']]))), 2)
+  expect_equal(length(grep(pattern = "axis", names(gs[['side.1']]))), 2)
 })
 
 test_that("axis ticks in the right location", {
   gs <- gsplot() %>%
-    points(seq(as.Date("2013-01-01"), as.Date("2013-12-31"), "days"), 1:31) %>%
+    points(seq(as.Date("2013-01-01"), as.Date("2013-12-31"), "days"), 1:365) %>%
     date_axis(side=1, lab.pos = "interval", tick.int="month", "snap.to"="month")
 
   ticks <- lazy_eval(gs$side.1$axis$at, data=list(object=gs))
@@ -21,22 +21,27 @@ test_that("axis ticks in the right location", {
 
 test_that("axis labels centered on interval", {
   gs <- gsplot() %>%
-    points(seq(as.Date("2013-01-01"), as.Date("2013-12-31"), "days"), 1:31) %>%
+    points(seq(as.Date("2013-01-01"), as.Date("2013-12-31"), "days"), 1:365) %>%
     date_axis(side=1, lab.pos = "interval", tick.int="month", "snap.to"="month")
 
-  # labels <- lazyeval::lazy_eval(gs$side.1[[2]]$at, data=list(object=gs))
-  # expect_true(all.equal(labels[1], as.Date("2013-01-15"), tolerance=0.01))
-  # expect_true(all.equal(labels[7], as.Date("2013-07-15"), tolerance=0.01))
-  # expect_true(all.equal(labels[12], as.Date("2013-12-15"), tolerance=0.01))
+  second.axis <- gs$side.1
+  which.axis <- which(names(second.axis)== 'axis')
+  labels <- lazyeval::lazy_eval(gs$side.1[[which.axis[2]]]$at, data=list(object=gs))
+  expect_true(all.equal(labels[1], as.Date("2013-01-15"), tolerance=0.01))
+  expect_true(all.equal(labels[7], as.Date("2013-07-15"), tolerance=0.01))
+  expect_true(all.equal(labels[12], as.Date("2013-12-15"), tolerance=0.01))
 })
 
 test_that("axis labels centered on ticks", {
   gs <- gsplot() %>%
     points(seq(as.Date("2013-01-01"), as.Date("2013-01-31"), "days"), 1:31) %>%
     date_axis(side=1, lab.pos = "tick", tick.int="day", "snap.to"="month")
 
-  # labels <- lazy_eval(gs$side.1[[2]]$at, data=list(object=gs))
-  # expect_equal(labels[1], as.Date("2013-01-01"))
-  # expect_equal(labels[7], as.Date("2013-01-07"))
-  # expect_equal(labels[22], as.Date("2013-01-22"))
+  second.axis <- gs$side.1
+  which.axis <- which(names(second.axis)== 'axis')
+
+  labels <- lazy_eval(gs$side.1[[which.axis[2]]]$at, data=list(object=gs))
+  expect_equal(labels[1], as.Date("2013-01-01"))
+  expect_equal(labels[7], as.Date("2013-01-07"))
+  expect_equal(labels[22], as.Date("2013-01-22"))
 })

tests/testthat/tests-points.R

@@ -12,7 +12,7 @@ test_that("graphics examples work", {
   plot.xy(xy, type='p')
 
   plot(1,3)
-  # points(data.frame(1,2), col='red')
+  points(data.frame(1,2), col='red')
 
 })
 

tests/testthat/tests-view_par.R

@@ -35,6 +35,6 @@ test_that("view_info", {
 
   view.information <- view_info(usrDef)
   expect_equal(nrow(view.information), 2)
-  # expect_equal(view.information$log, c("xy","y"))
-
+  expect_equal(view.information$log[view.information$name == "view.1.2"], "y")
+  expect_equal(view.information$log[view.information$name == "view.3.2"], "xy")
 })