Advertisement
Guest User

Untitled

a guest
Jun 17th, 2019
49
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 6.51 KB | None | 0 0
  1. month<-c("2010-08-01", "2010-09-01", "2010-10-01", "2010-12-01", "2011-01-01", "2011-02-01",
  2. "2011-03-01", "2011-04-01", "2011-05-01", "2011-06-01", "2011-07-01", "2011-09-01",
  3. "2011-11-01", "2012-01-01", "2012-02-01", "2012-03-01", "2012-05-01", "2012-07-01",
  4. "2012-08-01")
  5. prevalence<-c(10,7.5,5.2,3.5,6.4,2.7,5.8,13.2,4.3,4.7,6.4,4.4,5.2,3.3,1.0,3.1,9.9,33.3,1.0)
  6. df<-data.frame(month, prevalence)
  7. df$month<-as.Date(df$month)
  8. plot(df$month, df$prevalence,lwd = 1.8, ylim=c(0,40),pch=16, bty='n', xaxt='n',
  9. ylab="Prevalence (%)", xlab="Month",col='black',cex=1,cex.lab=1.0,cex.axis=1.0)
  10. at <- seq(from = min(df$month), to = max(df$month), by = "month") # produces a regular sequence of dates
  11. axis.Date(side = 1, at = at, labels = FALSE, tck=-0.04)
  12. axis(side=2, at=c(0,10,20,30,40,50), labels=c("", "", "", "", "", ""), tck=-0.04)
  13. lines(df$month, df$prevalence, col='black', lwd=1.8)
  14.  
  15. at1 <- at[c(TRUE, TRUE, FALSE)]
  16. axis.Date(side = 1, at = at1, labels = FALSE, tck=-0.02)
  17.  
  18. at2 <- at[c(FALSE, FALSE, TRUE)]
  19. axis.Date(side = 1, at = at2, labels = TRUE, tck=-0.04)
  20.  
  21. minorAxis <- function(side, n = NULL, at.maj = NULL, at.min = NULL, range = NULL,
  22. tick.ratio = 0.5, labels.maj = TRUE, line = NA, pos = NA,
  23. outer = FALSE, font = NA, lty = "solid", lwd = 1,
  24. lwd.ticks = lwd, col = NULL, col.ticks = NULL, hadj = NA,
  25. padj = NA, extend = FALSE, tcl = NA, ...)
  26. {
  27.  
  28. if(side == 1 | side == 3){
  29. tick.pos <- par("xaxp")
  30. } else if (side == 2 | side == 4) {
  31. tick.pos <- par("yaxp")
  32. }
  33.  
  34. # Define the positions of major ticks ----
  35.  
  36. if(is.null(at.maj)) {
  37.  
  38. # nat.int <- (tick.pos[2] - tick.pos[1])/tick.pos[3]
  39.  
  40. at.maj <- seq(tick.pos[1], tick.pos[2],
  41. by = (tick.pos[2] - tick.pos[1])/tick.pos[3])
  42.  
  43. }
  44.  
  45. # Define range, exclude at.maj values if necessary ----
  46.  
  47. if(length(range) != 0){
  48.  
  49. eff.range <- range
  50.  
  51. r1 <- at.maj - min(range)
  52. r2 <- at.maj - max(range)
  53.  
  54. p1 <- which.min(abs(r1))
  55. p2 <- which.min(abs(r2))
  56.  
  57. if(!(abs(r1[p1]/min(range)) < 1.5e-8) & r1[p1] < 0) p1 <- p1 + 1
  58. if(!(abs(r2[p2]/max(range)) < 1.5e-8) & r2[p2] > 0) p2 <- p2 - 1
  59.  
  60. at.maj <- at.maj[p1:p2]
  61.  
  62. } else {
  63.  
  64. if(side == 1 | side == 3){
  65. eff.range <- par("usr")[1:2]
  66. } else if (side == 2 | side == 4) {
  67. eff.range <- par("usr")[3:4]
  68. }
  69.  
  70. }
  71.  
  72. # Define limits ----
  73.  
  74. if(!extend) {
  75.  
  76. if(!is.null(at.min) & length(range) == 0){
  77. limits <- c(min(c(at.min, at.maj)), max(c(at.min, at.maj)))
  78. } else {
  79. limits <- c(min(at.maj), max(at.maj))
  80. }
  81.  
  82. } else {
  83.  
  84. limits <- eff.range
  85.  
  86. }
  87.  
  88. # Standard axis when n and at.min are not given ----
  89.  
  90. if(is.null(n) & is.null(at.min)){
  91.  
  92. axis(side, at = limits, labels = FALSE, tick = TRUE, line = line,
  93. pos = pos, outer = outer, lty = lty, lwd = lwd, lwd.ticks = 0,
  94. col = col,...)
  95.  
  96. axis(side, at = at.maj, labels = labels.maj, tick = TRUE, line = line,
  97. pos = pos, outer = outer, font = font, lty = lty,
  98. lwd = 0, lwd.ticks = lwd.ticks, col = col, col.ticks = col.ticks,
  99. hadj = hadj, padj = padj, tcl = tcl,...)
  100.  
  101. } else {
  102.  
  103. # Work the minor ticks: check regularity ----
  104.  
  105. mina <- min(at.maj)
  106. maxa <- max(at.maj)
  107. difa <- maxa - mina
  108. na <- difa / (length(at.maj) - 1)
  109.  
  110. if(is.null(at.min))
  111. {
  112. # n realm ----
  113.  
  114. # Checks----
  115.  
  116. sia <- seq(mina,maxa,by = na)
  117.  
  118. if(!isTRUE(all.equal(sort(sia),sort(at.maj)))) {
  119. stop("at.maj is irregular, use at.min for minor ticks (not n)")
  120. }
  121.  
  122. if(!(is.numeric(n) & length(n) == 1)){
  123. stop("n should be a numeric of length one")
  124. }
  125.  
  126. # Work it ----
  127.  
  128. tick.pos <- c(mina,maxa,difa/na)
  129.  
  130. nat.int <- (tick.pos[2] - tick.pos[1])/tick.pos[3]
  131.  
  132. # Define the position of minor ticks ----
  133.  
  134. distance.between.minor <- nat.int/n
  135.  
  136. p <- seq(min(at.maj), max(at.maj), by = distance.between.minor)
  137. q <- sort(every_nth(p,n,empty=FALSE))
  138.  
  139. # Extend outside of major ticks range if necessary ----
  140.  
  141. if(!extend) {
  142.  
  143. tick.seq <- q
  144.  
  145. } else {
  146.  
  147. possible.low.minors <- min(at.maj) - (n:1) * distance.between.minor
  148. possible.hi.minors <- max(at.maj) + (1:n) * distance.between.minor
  149.  
  150. r3 <- possible.low.minors - min(eff.range)
  151. r4 <- possible.hi.minors - max(eff.range)
  152.  
  153. p3 <- which.min(abs(r3))
  154. p4 <- which.min(abs(r4))
  155.  
  156. if(!(abs(r3[p3]/min(eff.range)) < 1.5e-8) & r3[p3] < 0) p3 <- p3 + 1
  157. if(!(abs(r4[p4]/max(eff.range)) < 1.5e-8) & r4[p4] > 0) p4 <- p4 - 1
  158.  
  159. if(p3 < length(possible.low.minors + 1)){
  160. low.candidates <- seq(p3, length(possible.low.minors), 1)
  161. low.laureates <- possible.low.minors[low.candidates]
  162. } else {
  163. low.laureates <- NULL
  164. }
  165.  
  166. if(p4 > 0){
  167. hi.candidates <- seq(1, p4, 1)
  168. hi.laureates <- possible.hi.minors[ hi.candidates]
  169. } else {
  170. hi.laureates <- NULL
  171. }
  172.  
  173. tick.seq <- c(low.laureates,q,hi.laureates)
  174.  
  175. }
  176.  
  177. } else {
  178.  
  179. # at.min realm ----
  180.  
  181. tick.pos <- c(mina,maxa,na)
  182.  
  183. tick.seq <- sort(at.min)
  184.  
  185. if(length(range) != 0){
  186.  
  187. r3 <- tick.seq - min(eff.range)
  188. r4 <- tick.seq - max(eff.range)
  189.  
  190. p3 <- which.min(abs(r3))
  191. p4 <- which.min(abs(r4))
  192.  
  193. if(!(abs(r3[p3]/min(eff.range)) < 1.5e-8) & r3[p3] < 0) p3 <- p3 + 1
  194. if(!(abs(r4[p4]/max(eff.range)) < 1.5e-8) & r4[p4] > 0) p4 <- p4 - 1
  195.  
  196. tick.seq <- tick.seq [p3:p4]
  197.  
  198. }
  199.  
  200. }
  201.  
  202. # Define the length of ticks ----
  203.  
  204. if(is.na(tcl)) maj.tcl <- par()$tcl else if (!is.na(tcl)) maj.tcl <- tcl
  205.  
  206. min.tcl <- maj.tcl*tick.ratio
  207.  
  208. # Plot the axes ----
  209.  
  210. axis(side, at = limits, labels = FALSE, tick = TRUE, line = line,
  211. pos = pos, outer = outer, lty = lty, lwd = lwd, lwd.ticks = 0,
  212. col = col,...)
  213.  
  214. axis(side, at = at.maj, labels = labels.maj, tick = TRUE, line = line,
  215. pos = pos, outer = outer, font = font, lty = lty,
  216. lwd = 0, lwd.ticks = lwd.ticks, col = col, col.ticks = col.ticks,
  217. hadj = hadj, padj = padj, tcl = maj.tcl,...)
  218.  
  219. axis(side, at = tick.seq, labels = FALSE, tick = TRUE, line = line,
  220. pos = pos, outer = outer, lwd = 0, lwd.ticks = lwd.ticks, col = col,
  221. col.ticks = col.ticks, tcl = min.tcl,...)
  222.  
  223. }
  224. }
  225.  
  226. # Run this as example:
  227.  
  228. plot(c(0,1), c(0,1), axes = FALSE, type = "n", xlab = "", ylab = "")
  229.  
  230. minorAxis(1, n = 10, range = c(0.12,0.61))
  231.  
  232. minorAxis(3, n = 10, extend=FALSE)
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement