Guest User

Untitled

a guest
Aug 29th, 2016
63
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 5.98 KB | None | 0 0
  1. dualplot <- function(x1, y1, y2, x2 = x1,
  2. col = c("#C54E6D", "#009380"),
  3. lwd = c(1, 1), colgrid = NULL,
  4. mar = c(3, 6, 3, 6) + 0.1,
  5. ylab1 = paste(substitute(y1), collapse = ""),
  6. ylab2 = paste(substitute(y2), collapse = ""),
  7. nxbreaks = 5,
  8. yleg1 = paste(gsub("\n$", "", ylab1), "(left axis)"),
  9. yleg2 = paste(ylab2, "(right axis)"),
  10. ylim1 = NULL, ylim2 = NULL, ylim.ref = NULL,
  11. xlab = "", main = NULL, legx = "topleft", legy = NULL,
  12. silent = FALSE, bty = "n", ...){
  13. # Base graphics function for drawing dual axis line plot.
  14. # Assumed to be two time series on a conceptually similar, non-identical scale
  15. #
  16. # Assumes data is in sequence of x1 and of x2 ie ordered by time
  17. #
  18. # Use with caution!
  19. # Please don't use to show growth rates and the original
  20. # series at the same time!
  21. #
  22. # Peter Ellis, 16-27 August 2016, GNU GPL-3
  23. # most parameters should be obvious:
  24. # x1 and y1 are the x and y coordinates for first line
  25. # x2 and y2 are the x and y coordinates for second line. Often x2 will == x1, but can be overridden
  26. # ylim1 and ylim2 are the vertical limits of the 2 axes. Recommended NOT to use these, as
  27. # the default algorithm will set them in a way that makes the axes equivalent to using an index (for
  28. # positive data) or mean of each series +/- 3 standard deviations (if data include negatives)
  29. # ylim.ref the two numbers in the two series to use as the reference point for converting them to indices
  30. # when drawing on the page. If both elements are 1, both series will start together at the left of the plot.
  31. # nbreaks is number of breaks in horizontal axis
  32. # lwd and mar are graphics parameters (see ?par)
  33. # colgrid is colour of gridlines; if NULL there are no gridlines
  34. # ylab1 and ylab2 are the labels for the two y axes
  35. # yleg1 and yleg2 are the labels for the two series in the legend
  36. # xlab and main are for x label and main title as in plot()
  37. # legx and legy are x and y position fed through to legend()
  38. # ... is parameters to pass to legend()
  39. # Note that default colours were chosen by colorspace::rainbow_hcl(2, c = 80, l = 50)
  40.  
  41. # strip excess attributes (eg xts etc) from the two vertical axis variables
  42. ylab1 <- as.character(ylab1)
  43. ylab2 <- as.character(ylab2)
  44. y1 <- as.numeric(y1)
  45. y2 <- as.numeric(y2)
  46.  
  47. # is ylim.ref is NULL, calculate a good default
  48. if(is.null(ylim.ref)){
  49. if (length(y1) == length(y2)){
  50. ylim.ref <- c(1, 1)
  51. } else {
  52. if (min(x1) > min(x2)){
  53. ylim.ref <- c(1, which(abs(x2 - min(x1)) == min(abs(x2 - min(x1)))))
  54. } else {
  55. ylim.ref <- c(which(abs(x1 - min(x2)) == min(abs(x1 - min(x2)))), 1)
  56. }
  57. }
  58.  
  59.  
  60. }
  61.  
  62.  
  63. oldpar <- par(mar = mar)
  64. xbreaks <- round(seq(from = min(c(x1, x2)), to = max(c(x1, x2)), length.out = nxbreaks))
  65.  
  66. # unless ylim1 or ylim2 were set, we set them to levels that make it equivalent
  67. # to a graphic drawn of indexed series (if all data positive), or to the mean
  68. # of each series +/- three standard deviations if some data are negative
  69. if(is.null(ylim1) & is.null(ylim2)){
  70. if(min(c(y1, y2), na.rm = TRUE) < 0){
  71. message("With negative values ylim1 or ylim2 need to be chosen by a method other than treating both series visually as though they are indexed. Defaulting to mean value +/- 3 times the standard deviations.")
  72. ylim1 <- c(-3, 3) * sd(y1, na.rm = TRUE) + mean(y1, na.rm = TRUE)
  73. ylim2 <- c(-3, 3) * sd(y2, na.rm = TRUE) + mean(y2, na.rm = TRUE)
  74. }
  75.  
  76.  
  77. if(ylim.ref[1] > length(y1)){
  78. stop("ylim.ref[1] must be a number shorter than the length of the first series.")
  79. }
  80. if(ylim.ref[2] > length(y2)){
  81. stop("ylim.ref[2] must be a number shorter than the length of the second series.")
  82. }
  83.  
  84. if(!silent) message("The two series will be presented visually as though they had been converted to indexes.")
  85.  
  86. # convert the variables to indexes (base value of 1 at the time specified by ylim.ref)
  87. ind1 <- as.numeric(y1) / y1[ylim.ref[1]]
  88. ind2 <- as.numeric(y2) / y2[ylim.ref[2]]
  89.  
  90. # calculate y axis limits on the "index to 1" scale
  91. indlimits <- range(c(ind1, ind2), na.rm = TRUE)
  92.  
  93. # convert that back to the original y axis scales
  94. ylim1 = indlimits * y1[ylim.ref[1]]
  95. ylim2 = indlimits * y2[ylim.ref[2]]
  96. } else {
  97. if(!silent) warning("You've chosen to set at least one of the vertical axes limits manually. Up to you, but it is often better to leave it to the defaults.")
  98. }
  99.  
  100. # draw first series - with no axes.
  101. plot(x1, y1, type = "l", axes = FALSE, lwd = lwd[1],
  102. xlab = xlab, ylab = "", col = col[1], main = main,
  103. xlim = range(xbreaks), ylim = ylim1)
  104.  
  105. # add in the gridlines if wanted:
  106. if(!is.null(colgrid)){
  107. grid(lty = 1, nx = NA, ny = NULL, col = colgrid)
  108. abline(v = xbreaks, col = colgrid)
  109. }
  110.  
  111. # add in the left hand vertical axis and its label
  112. axis(2, col = col[1], col.axis= col[1], las=1 ) ## las=1 makes horizontal labels
  113. mtext(paste0("\n", ylab1, "\n"), side = 2, col = col[1], line = 1.5)
  114.  
  115. # Allow a second plot on the same graph
  116. par(new=TRUE)
  117.  
  118. # Plot the second series:
  119. plot(x2, y2, xlab="", ylab="", axes = FALSE, type = "l", lwd = lwd[2],
  120. col = col[2], xlim = range(xbreaks), ylim = ylim2)
  121.  
  122. ## add second vertical axis (on right) and its label
  123. mtext(paste0("\n", ylab2, "\n"), side = 4, col = col[2], line = 4.5)
  124. axis(4, col = col[2], col.axis = col[2], las=1)
  125.  
  126. # Draw the horizontal time axis
  127. axis(1, at = xbreaks, labels = xbreaks)
  128.  
  129. # Add Legend
  130. legend(x = legx, y = legy, legend=c(yleg1, yleg2),
  131. text.col = col, lty = c(1, 1), lwd = lwd, col = col,
  132. bty = bty, ...)
  133.  
  134. par(oldpar)
  135. }
Add Comment
Please, Sign In to add comment