Merge pull request #270 from ldecicco-USGS/master

ldecicco-USGS · ldecicco-USGS · commit f9111460a3bf · 2015-10-09T16:13:38.000-05:00
Axis fixes
diff --git a/NAMESPACE b/NAMESPACE
@@ -32,6 +32,7 @@ export(segments)
 export(symbols)
 export(text)
 export(title)
+export(view_info)
 export(xlim)
 export(ylim)
 exportMethods(gsplot)
diff --git a/R/access-gsplot.R b/R/access-gsplot.R
@@ -72,4 +72,28 @@ logged.gsplot <- function(object, side=NULL){
     lapply(views(object), function(x) x$window$log) %>% 
       setNames(names)
   }
+}
+
+#' Get view information from a gsplot object
+#' 
+#' get the views in gsplot object
+#' 
+#' @param object a gsplot object
+#' @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')
+  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)
+  names(viewInfo) <- c("x","y","log","index")
+  
+  for(dir in c("y","x")){
+    dup_index <- which(duplicated(viewInfo[dir]) | duplicated(viewInfo[dir], fromLast=TRUE))
+    viewInfo$log[dup_index[-grep(dir,viewInfo$log)]] <- paste0(dir,viewInfo$log[dup_index[-grep(dir,viewInfo$log)]])
+  }
+  
+  viewInfo[,c("x","y","index")] <- sapply(viewInfo[,c("x","y","index")], function(x) as.integer(x))
+  
+  return(viewInfo)
 }
diff --git a/R/axis.R b/R/axis.R
@@ -24,22 +24,40 @@
 #' gs <- gsplot() %>%
 #'    points(y=c(3,1,2), x=1:3, xlim=c(0,NA),ylim=c(0,NA)) %>%
 #'    axis(side=c(4), labels=FALSE) %>%
-#'    axis(side=c(1,3), n.minor=4, labels=FALSE)
+#'    axis(side=c(1,3), n.minor=4)
 #' gs
 #' 
 #' gs <- gsplot() %>%
 #'    points(1:10, 1:10) %>%
-#'    axis(1, at = seq(0,10,by=0.1),labels=FALSE, tcl=0.15)
+#'    axis(1, at = seq(0,10,by=0.1),labels=FALSE, tcl=0.15) %>%
+#'    axis(2, reverse=TRUE)
 #' gs
 #' 
 #' gs <- gsplot() %>%
 #'    points(1:5, c(1,10,100,1000,10000), log="y", las=1) %>%
-#'    axis(side=c(2,4), labels=FALSE, n.minor=4)
+#'    axis(side=c(2,4), n.minor=4)
 #' gs
+#' 
 #' 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)
 #' gs
+#' 
+#' gs <- gsplot(xaxs='r', yaxs='r') %>%
+#'    lines(1:5, c(1,10,100,1000,10000), log="y", xaxt='n') %>%
+#'    axis(side=c(2,4), labels=FALSE, n.minor=4)
+#' gs
+#' 
+#' gs <- gsplot() %>% 
+#'   points(runif(30, 1,5), runif(30,0.5,3.5)) %>% 
+#'   axis(side=1, at=seq(1,5,by=0.25),las=3) %>%
+#'   axis(side=c(3,4), labels=FALSE)
+#' gs
+#' 
+#' usrDef <- gsplot(mar=c(4,4,4,4)) %>% 
+#'   points(x=1, y=2, side=c(3,2), cex=3, xlab='cat',log='x') %>% 
+#'   points(x=3:10,y=4:11, side=c(1,2), log='y')
+#' usrDef
 axis <- function(object, ...) {
   override("graphics", "axis", object, ...)
 }
@@ -69,10 +87,11 @@ axis.gsplot <- function(object, ..., n.minor=0, tcl.minor=0.15, reverse=NULL) {
 }
 
 draw_axis <- function(gsplot) {
-  
-  for(index in which(names(gsplot) %in% "axis")){
+
+  draw_axis_execute <- function(axisParams,n.minor){
     axisParams <- gsplot[[index]][['arguments']]
     n.minor <- gsplot[[index]][['gs.config']]$n.minor
+    
     if(n.minor == 0){
       axis(axisParams)
     } else {
@@ -81,14 +100,36 @@ draw_axis <- function(gsplot) {
       #Minor axis:
       at <- axTicks(axisParams$side)
       newAT <- c()
+      
+      if(axisParams$side %% 2 == 0){
+        logScale <- par()$ylog
+      } else {
+        logScale <- par()$xlog
+      }
+        
+      if(logScale){
+        spacing <- median(diff(log10(at)))
+        at <- c(10^(log10(at[1])-spacing),at,10^(log10(at[length(at)])+spacing))
+      } else {
+        spacing <- median(diff(at))
+        at <- c(at[1]-spacing,at,at[length(at)]+spacing)
+      }
+      
       for(i in 2:length(at)){
         newAT <- c(newAT, seq(at[i-1], length.out = n.minor, by= (at[i]-at[i-1])/n.minor))
       }
+      
       axisParams$at <- newAT
       axisParams$tcl <- gsplot[[index]][['gs.config']]$tcl.minor
       axisParams$labels <- FALSE
       axis(axisParams)
     }
-    
   }
+  
+  for(index in which(names(gsplot) %in% "axis")){
+    axisParams <- gsplot[[index]][['arguments']]
+    n.minor <- gsplot[[index]][['gs.config']]$n.minor
+    draw_axis_execute(axisParams, n.minor)
+  }
+
 }
diff --git a/R/calc_views.R b/R/calc_views.R
@@ -261,7 +261,7 @@ set_window <- function(list){
     param <- c("axes","ann","frame.plot") #Add panel.first, panel.last, asp, and "main","sub","frame.plot"...without breaking title
     varPar <- c("xaxs","yaxs","xaxt","yaxt","las")
     
-    window[param] <- TRUE
+    window[param[!(param %in% names(window))]] <- TRUE
     
     for(i in names(plots)){
       for(k in param){
diff --git a/R/print.R b/R/print.R
@@ -40,41 +40,58 @@ print.gsplot <- function(x, ...){
     plot.new()
   }
 
-  top.par <- par(no.readonly=T)
+  i <- which(names(views) %in% 'axis')
+  definded.sides <- sapply(i, function(x) views[[x]][['arguments']][['side']])
+  
+  view.info <- view_info(views)
+  view.sides.drawn <- NULL
+  
   for (i in which(names(views) %in% 'view')){
-    # par(top.par)
+
     plots = views[[i]]
     plots[['window']] <- NULL
     window = views[[i]][['window']]
     
     par(views[['par']])
     
     par(window[['par']])
-    plot.window(xlim = window$xlim, ylim = window$ylim, log = window$log)
-
-    # -- call functions -- 
-    to_gsplot(lapply(plots, function(x) x[!names(x) %in% 'legend.name']))
-
+    plot.window(xlim = window$xlim, ylim = window$ylim, log = view.info$log[i==view.info$index])
 
-    if(window$axes){
-      Axis(side=window$side[1],x=window$xlim)
-      Axis(side=window$side[2],x=window$ylim)        
+    sides.not.defined <- window$side[!(window$side %in% definded.sides)]
+    
+    if(!is.null(view.sides.drawn)){
+      view.sides.drawn <- sides.not.defined[-view.sides.drawn]
     }
-
+    
+    if(window$axes){
+      for(j in sides.not.defined){
+        if(j %% 2 != 0){
+          Axis(side=j,x=window$xlim)
+        } else {
+          Axis(side=j,x=window$ylim) 
+        }
+        view.sides.drawn <- append(view.sides.drawn, j)
+      }
+    } 
+    
     if(window$ann){
       mtext(text=window$xlab, side=window$side[1], line = 2)
       mtext(text=window$ylab, side=window$side[2], line = 2)        
     }
     
+    # -- call functions -- 
+    to_gsplot(lapply(plots, function(x) x[!names(x) %in% 'legend.name']))
+
     par(new=TRUE)
   }
   
+  draw_axis(views)
+  
   if(window$frame.plot){
     box()
   }
 
   draw_legend(views)
-  draw_axis(views)
   
 }
 
diff --git a/README.Rmd b/README.Rmd
@@ -54,7 +54,8 @@ gs <- gsplot() %>%
   lines(c(3,4,3), c(2,4,6), legend.name="Lines", ylab="logged y axis", xlab="logged x axis", log='xy') %>%
   callouts(x=8, y=4, lwd=2, angle=45, labels="Not sure about this one") %>%
   title("logged axes") %>%
-  axis(side=c(1,2,3,4), labels=FALSE, n.minor=4)
+  axis(side=c(1,2,3,4), labels=FALSE, n.minor=4) %>%
+  axis(side=c(1,2))
 gs
 ```
 
diff --git a/README.md b/README.md
@@ -51,7 +51,8 @@ gs <- gsplot() %>%
   lines(c(3,4,3), c(2,4,6), legend.name="Lines", ylab="logged y axis", xlab="logged x axis", log='xy') %>%
   callouts(x=8, y=4, lwd=2, angle=45, labels="Not sure about this one") %>%
   title("logged axes") %>%
-  axis(side=c(1,2,3,4), labels=FALSE, n.minor=4)
+  axis(side=c(1,2,3,4), labels=FALSE, n.minor=4) %>%
+  axis(side=c(1,2))
 gs
 ```
 
diff --git a/README_files/figure-markdown_github/unnamed-chunk-2-1.png b/README_files/figure-markdown_github/unnamed-chunk-2-1.png
diff --git a/README_files/figure-markdown_github/unnamed-chunk-3-1.png b/README_files/figure-markdown_github/unnamed-chunk-3-1.png
diff --git a/README_files/figure-markdown_github/unnamed-chunk-4-1.png b/README_files/figure-markdown_github/unnamed-chunk-4-1.png
diff --git a/inst/doc/gsplotIntro.R b/inst/doc/gsplotIntro.R
@@ -2,7 +2,7 @@
 library(gsplot)
 
 MaumeeDV <- MaumeeDV
-plot.new()
+
 demoPlot <- gsplot() %>%
   points(y=c(3,1,2), x=1:3, xlim=c(0,NA),ylim=c(0,NA),
          col="blue", pch=18, legend.name="Points", xlab="Index") %>%
diff --git a/inst/doc/gsplotIntro.Rmd b/inst/doc/gsplotIntro.Rmd
@@ -17,7 +17,7 @@ vignette: >
 library(gsplot)
 
 MaumeeDV <- MaumeeDV
-plot.new()
+
 demoPlot <- gsplot() %>%
   points(y=c(3,1,2), x=1:3, xlim=c(0,NA),ylim=c(0,NA),
          col="blue", pch=18, legend.name="Points", xlab="Index") %>%
diff --git a/inst/doc/gsplotIntro.html b/inst/doc/gsplotIntro.html
diff --git a/inst/extdata/default.yaml b/inst/extdata/default.yaml
@@ -2,6 +2,8 @@ xaxs: "i"
 yaxs: "i"
 tcl: 0.3
 mgp: [1.5, 0.3, 0.0]
+yaxt: "s"
+xaxt: "s"
 points:
   pch: 6
   col: "red"
diff --git a/man/axis.Rd b/man/axis.Rd
@@ -32,21 +32,39 @@ gs
 gs <- gsplot() \%>\%
    points(y=c(3,1,2), x=1:3, xlim=c(0,NA),ylim=c(0,NA)) \%>\%
    axis(side=c(4), labels=FALSE) \%>\%
-   axis(side=c(1,3), n.minor=4, labels=FALSE)
+   axis(side=c(1,3), n.minor=4)
 gs
 
 gs <- gsplot() \%>\%
    points(1:10, 1:10) \%>\%
-   axis(1, at = seq(0,10,by=0.1),labels=FALSE, tcl=0.15)
+   axis(1, at = seq(0,10,by=0.1),labels=FALSE, tcl=0.15) \%>\%
+   axis(2, reverse=TRUE)
 gs
 
 gs <- gsplot() \%>\%
    points(1:5, c(1,10,100,1000,10000), log="y", las=1) \%>\%
-   axis(side=c(2,4), labels=FALSE, n.minor=4)
+   axis(side=c(2,4), n.minor=4)
 gs
+
 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)
 gs
+
+gs <- gsplot(xaxs='r', yaxs='r') \%>\%
+   lines(1:5, c(1,10,100,1000,10000), log="y", xaxt='n') \%>\%
+   axis(side=c(2,4), labels=FALSE, n.minor=4)
+gs
+
+gs <- gsplot() \%>\%
+  points(runif(30, 1,5), runif(30,0.5,3.5)) \%>\%
+  axis(side=1, at=seq(1,5,by=0.25),las=3) \%>\%
+  axis(side=c(3,4), labels=FALSE)
+gs
+
+usrDef <- gsplot(mar=c(4,4,4,4)) \%>\%
+  points(x=1, y=2, side=c(3,2), cex=3, xlab='cat',log='x') \%>\%
+  points(x=3:10,y=4:11, side=c(1,2), log='y')
+usrDef
 }
 
diff --git a/man/view_info.Rd b/man/view_info.Rd
@@ -0,0 +1,18 @@
+% Generated by roxygen2 (4.1.1): do not edit by hand
+% Please edit documentation in R/access-gsplot.R
+\name{view_info}
+\alias{view_info}
+\title{Get view information from a gsplot object}
+\usage{
+view_info(object)
+}
+\arguments{
+\item{object}{a gsplot object}
+}
+\value{
+data frame with one row per view. Each view has an x side, y side, the log command, and the view index.
+}
+\description{
+get the views in gsplot object
+}
+
diff --git a/tests/testthat/tests-axis.R b/tests/testthat/tests-axis.R
@@ -0,0 +1,25 @@
+context("axis")
+
+test_that("axis",{
+  
+  ## Setup up coordinate system (with x == y aspect ratio):
+  plot(c(-2,3), c(-1,5), axes=FALSE)
+  ## the x- and y-axis, and an integer grid
+  axis(1)
+  axis(2)
+  axis(3)
+  
+})
+
+test_that("axis gsplot",{
+  gs = points(gsplot(), c(-2,3), c(-1,5)) %>% 
+    axis(3)
+  expect_equal(names(gs), c("view","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)
+  
+})
diff --git a/tests/testthat/tests-view_par.R b/tests/testthat/tests-view_par.R
@@ -16,3 +16,20 @@ test_that("par within view", {
   expect_equal(gs[[2]]$window$par$las, 1)
   
 })
+
+test_that("view_info", {
+  
+  gs = points(gsplot(), y=1, x=2, col="blue", pch=18, las=3)  %>% lines(2:3,4:5)  %>% points(3,4,side=c(3,4),las=1)
+  view.information <- view_info(gs)
+  expect_equal(nrow(view.information), 2)
+  expect_equal(view.information$log, c("",""))
+  
+  usrDef <- gsplot(mar=c(4,4,4,4)) %>% 
+    points(x=1, y=2, side=c(3,2), cex=3, xlab='cat',log='x') %>% 
+    points(x=3:10,y=4:11, side=c(1,2), log='y')
+  
+  view.information <- view_info(usrDef)
+  expect_equal(nrow(view.information), 2)
+  expect_equal(view.information$log, c("yx","y"))
+  
+})
diff --git a/vignettes/gsplotIntro.Rmd b/vignettes/gsplotIntro.Rmd
@@ -17,7 +17,7 @@ vignette: >
 library(gsplot)
 
 MaumeeDV <- MaumeeDV
-plot.new()
+
 demoPlot <- gsplot() %>%
   points(y=c(3,1,2), x=1:3, xlim=c(0,NA),ylim=c(0,NA),
          col="blue", pch=18, legend.name="Points", xlab="Index") %>%
