Merge remote-tracking branch 'upstream/master'

Author: Lindsay Carr

NAMESPACE

@@ -32,6 +32,7 @@ export(segments)
 export(symbols)
 export(text)
 export(title)
+export(view_info)
 export(xlim)
 export(ylim)
 exportMethods(gsplot)

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)
 }

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)
+  }
+
 }

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){

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)
 
 }
 

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
 ```
 

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
 ```