Merge pull request #287 from lindsaycarr/master

mtext fixes (WIP)

Author: Jordan S Read

R/mtext.R

@@ -28,6 +28,23 @@ mtext <- function(object, ...) {
 }
 
 
-mtext.gsplot <- function(object, ..., legend.name=NULL, side=c(1,2)){
-  set_window_args(object, fun.name='mtext', ..., legend.name=legend.name, side=side, def.funs=graphics::mtext)
-}
+mtext.gsplot <- function(object, ..., legend.name=NULL, side = 3){
+  
+  stopifnot(length(side) == 1)
+  
+  fun.name <- "mtext"
+  def.funs <- graphics::mtext
+  
+  user_args <- function_args(name=fun.name, package="graphics", side=side, ...)
+  
+  to.gsplot <- list(list(arguments = c(do.call(set_args, c(fun.name, user_args)), axes=FALSE),  
+                         gs.config = list(legend.name = legend.name, side = side,
+                                          par=par_arguments(user_args, def.funs)))) %>% 
+    setNames(fun.name)
+  
+  object <- append(object, to.gsplot)
+    
+  return(gsplot(object))
+  
+ # set_window_args(object, fun.name='mtext', ..., legend.name=legend.name, def.funs=graphics::mtext)
+}

inst/extdata/default.yaml

@@ -4,7 +4,6 @@ tcl: 0.3
 mgp: [1.5, 0.3, 0.0]
 yaxt: "s"
 xaxt: "s"
-las:  1
 points:
   pch: 6
   col: "red"

tests/testthat/test-mtext.R

@@ -0,0 +1,27 @@
+context("mtext")
+
+test_that("mtext on correct side", {
+  gs <- gsplot() %>% 
+    points(1,2) %>% 
+    mtext("my margin text", side=4)
+  
+  i <- which(unlist(lapply(gs, function(x) {any(names(x) %in% "mtext")})))
+  
+  expect_true(any(gs[[i]][['window']][['side']] %in% 4))
+  expect_false(gs[[i]][['window']][['axes']])
+})
+
+
+
+test_that("multiple mtext are on correct sides", {
+  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=3, line=3)
+  
+  expect_true(any(gs[[1]][['window']][['side']] %in% 1))
+  expect_true(any(names(gs[[1]]) %in% "mtext"))
+  
+  expect_true(any(gs[[2]][['window']][['side']] %in% 3))
+  expect_true(any(names(gs[[2]]) %in% "mtext"))
+})

vignettes/gsplotIntro.R

@@ -0,0 +1,93 @@
+## ----message=FALSE, echo=TRUE, fig.cap="Demo workflow", fig.width=6, fig.height=6----
+library(gsplot)
+
+MaumeeDV <- MaumeeDV
+
+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") %>%
+  lines(c(3,4,3), c(2,4,6), legend.name="Lines", ylab="Data") %>%
+  abline(b=1, a=0, legend.name="1:1") %>%
+  legend(location="topleft",title="Awesome!") %>%
+  grid() %>%
+  error_bar(x=1:3, y=c(3,1,2), y.high=c(0.5,0.25,1), y.low=0.1) %>%
+  error_bar(x=1:3, y=c(3,1,2), x.low=.2, x.high=.2, col="red",lwd=3) %>%
+  callouts(x=1, y=2.8, lwd=2, angle=250, labels="Weird data") %>%
+  title("Graphing Fun")
+demoPlot
+
+
+## ----echo=TRUE, message=FALSE--------------------------------------------
+
+sites <- unique(MaumeeDV$site_no)
+dates <- sapply(sites, function(x) MaumeeDV$Date[which(MaumeeDV$site_no==x)], USE.NAMES=TRUE)
+flow <- sapply(sites, function(x) MaumeeDV$Flow[which(MaumeeDV$site_no==x)], USE.NAMES=TRUE)
+pH <- sapply(sites, function(x) MaumeeDV$pH_Median[which(MaumeeDV$site_no==x)], USE.NAMES=TRUE)
+Wtemp <- sapply(sites, function(x) MaumeeDV$Wtemp[which(MaumeeDV$site_no==x)], USE.NAMES=TRUE)
+
+
+## ----echo=TRUE, fig.cap="Fig. 1 Simple flow timeseries using `gsplot`.", fig.width=6, fig.height=6----
+site <- '04193500'
+demoPlot <- gsplot(mgp=c(2.75, 0.3, 0.0)) %>% 
+  lines(dates[[site]], flow[[site]], col="royalblue") %>%
+  title(main=paste("Site", site), ylab="Flow, ft3/s") %>%
+  grid()
+demoPlot
+
+
+## ----echo=TRUE, fig.cap="Fig. 2 Simple flow timeseries with a logged y-axis using `gsplot`.", fig.width=6, fig.height=6----
+site <- '04193500'
+options(scipen=5)
+demoPlot <- gsplot(mgp=c(3, 0.3, 0.0)) %>% 
+  lines(dates[[site]], flow[[site]], 
+        col="royalblue", log='y', 
+        ylab= expression(paste("Discharge in ",ft^3/s))) %>%
+  title(main=paste("Site", site)) %>%
+  grid(equilogs=FALSE)
+demoPlot
+
+
+## ----echo=TRUE, fig.cap="Fig. 3 (a) pH vs water temperature, (b) pH timeseries, (c) water temperature timeseries.", fig.width=6, fig.height=6----
+site <- '04193490'
+plot1 <- gsplot() %>% 
+  points(Wtemp[[site]], pH[[site]], col="black")%>%
+  title(main=paste("Site", site), xlab="Water Temperature (deg C)", ylab="pH")
+plot2 <- gsplot() %>% 
+  lines(dates[[site]], pH[[site]], col="seagreen")%>%
+  title(main="", xlab="time", ylab="pH")
+plot3 <- gsplot() %>% 
+  lines(dates[[site]], Wtemp[[site]], col="orangered")%>%
+  title(main="", xlab="time", ylab="Water Temperature (deg C)")
+
+layout(matrix(c(1,2,3), byrow=TRUE, nrow=3))
+plot1
+plot2
+plot3
+
+
+## ----echo=TRUE, fig.cap="Fig. 4 Water temperature timeseries on primary y-axis with pH timeseries on secondary y-axis.", fig.width=6, fig.height=6----
+site <- '04193490'
+demoPlot <- gsplot(mar=c(7.1, 4.1, 4.1, 4.1)) %>% 
+  lines(dates[[site]], Wtemp[[site]], col="orangered", 
+        legend.name="Water Temperature", ylab='Water Temperature (deg C)') %>%
+  lines(dates[[site]], pH[[site]], col="seagreen", side=4, 
+        legend.name="pH", ylab='pH (pH Units)') %>%
+  title(main=paste("Site", site), xlab='time') %>% 
+  legend(location="below")
+demoPlot
+
+
+## ----echo=TRUE, fig.cap="Fig. 5 Initial plot of water temperature timeseries.", fig.width=6, fig.height=6----
+# initially plot the data
+site <- '04193490'
+demoPlot <- gsplot() %>% 
+  lines(dates[[site]], Wtemp[[site]], col="orangered") %>% 
+  title(main=paste("Site", site), xlab='time', ylab='Water Temperature (deg C)')
+demoPlot
+
+## ----echo=TRUE, fig.cap="Fig. 6 Plot of water temperature timeseries with 'Missing Data' callout retroactively added.", fig.width=6, fig.height=6----
+# notice the missing data from ~ 1991 through ~2011 and add a callout
+demoPlot <- callouts(demoPlot, x=as.Date("2000-01-01"), y=10,labels="Missing Data")
+demoPlot
+
+