Advertisement
Guest User

Untitled

a guest
Apr 28th, 2017
73
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 3.04 KB | None | 0 0
  1. plot_gly_on_map <- function(newDF, global = FALSE, trend = FALSE, outputFile = "test.png"){
  2. # newDF$value <- newDF$summerSum_UHY - newDF$springSum_UHY
  3. longRange <- range(newDF$Long)
  4. latRange <- range(newDF$Lat)
  5. bbox <- make_bbox(longRange,latRange,f = 0.3)
  6. # myMap <- get_map(location=bbox, source="stamn",crop=TRUE,color="bw",maptype="terrain")
  7. myMap <- get_map(location = bbox, maptype="toner-lite", source="stamen",zoom=7,color = "bw",crop=TRUE)
  8. # ggmap(myMap)
  9. SU_locations <- unique(newDF[,c("Station","Lat","Long")])
  10.  
  11. library(png)
  12. library(grid)
  13.  
  14. globalYRange <- range(newDF$value)
  15. globalYMiddle <- mean(globalYRange)
  16.  
  17. globalXRange <- range(newDF$year)
  18.  
  19. height = 0.2
  20. width = 0.3
  21. p <- ggmap(myMap) + coord_cartesian() + coord_fixed(ratio = 1.5) + theme(axis.text = element_text(size=12))
  22.  
  23. for(i in 1:nrow(SU_locations)){
  24. station_ <- SU_locations[i,"Station"]
  25. subdf <- subset(newDF, Station == station_)
  26. mid <- SU_locations[i,c("Long","Lat")] %>% as.numeric()
  27.  
  28. model2 <- lm(value~year,data = subdf[,c("year","value")] %>% na.omit())
  29. pValue2 <- summary(model2)$coefficients[2,4]
  30.  
  31. p2 <- ggplot(subdf[,c("year","value")] %>% na.omit())
  32. # p2 <- p2 + geom_bar(aes(x = year,y = summerSum_UHY),fill = "red",stat="identity")
  33. # p2 <- p2 + geom_bar(aes(x = year,y = springSum_UHY),fill = "blue4",stat="identity")
  34. p2 <- p2 + geom_line(aes(x = year,y = value),size=0.8) +
  35. geom_point(aes(x = year,y = value),size=2)
  36.  
  37. localYRange <- range(subdf$value)
  38.  
  39. if(trend){
  40. p2 <- p2 + stat_smooth(aes(x = year, y = value),method = "lm",color = "red")
  41. }
  42.  
  43. if(global){
  44. localYRange <- globalYRange
  45. p2 <- p2 + geom_line(aes(x = x, y = y),data = data.frame(x = globalXRange, y = c(globalYMiddle,globalYMiddle)),linetype="dashed") # left boundary
  46. }
  47.  
  48. p2 <- p2 + ylim(localYRange)
  49.  
  50. # add the bounding box
  51. p2 <- p2 + geom_rect(aes(xmin = x1, xmax = x2, ymin = y1, ymax = y2),data =data.frame(x1 = globalXRange[1], x2 = globalXRange[2], y1 = localYRange[1], y2 = localYRange[2]), fill = "NA", color="black", linetype = "dashed")
  52.  
  53. # add theme
  54. p2 <- p2 + theme(axis.title.x=element_blank(), axis.text.x=element_blank(), axis.ticks.x=element_blank(),
  55. axis.title.y=element_blank(), axis.text.y=element_blank(), axis.ticks.y=element_blank(),
  56. panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
  57. panel.background = element_rect(fill = "transparent",colour = NA),
  58. plot.background = element_rect(fill = "transparent",colour = NA),
  59. # panel.border = element_rect(linetype = "dashed", fill = NA),
  60. plot.margin = unit(c(0.1,0.1,0.1,0),"cm"))
  61.  
  62. # fname <- paste0("./flux/",station_ ,"_thermo_flux.png")
  63. fname <- "tmp.png"
  64. # png(fname, width = 80, height = 60)
  65. # print(p2)
  66. # dev.off()
  67. png(fname, width = 80, height = 60)
  68. ggsave(fname, p2, bg = "transparent")
  69. dev.off()
  70.  
  71. img <- readPNG(fname)
  72. g <- rasterGrob(img, interpolate=TRUE)
  73.  
  74. p <- p + annotation_custom(g, xmin=mid[1]-width, xmax=mid[1]+width, ymin=mid[2]-height, ymax=mid[2]+height)
  75. }
  76. png(outputFile, width = 3000, height = 1500)
  77. print(p)
  78. dev.off()
  79. }
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement