Advertisement
Guest User

Untitled

a guest
Sep 23rd, 2017
439
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 8.32 KB | None | 0 0
  1. global.polygon <- "/Volumes/Albacora/Dropbox/Raw Data/Shapefiles/World Present/Global_CostLine_HD_Polygon.shp"
  2. contour( global.polygon = global.polygon , file= "Data/sampling_sites.txt" , file.sep = ";" , file.dec = "." , file.strucutre = 1 , file.header = FALSE , resolution = 0.01 , buffer = c(1,1,1,1) , export.file = TRUE )
  3.  
  4. ## -----------------
  5.  
  6. contour <- function (global.polygon , file , file.sep , file.dec , file.header, resolution, buffer , file.strucutre,export.file) {
  7.  
  8. site.names <- as.character(read.table(file,sep=file.sep,dec=file.dec,header = file.header)[,1])
  9.  
  10. if(file.strucutre == 1) {
  11. site.xy <- read.table(file,sep=file.sep,dec=file.dec,header = file.header)[,c(2,3)]
  12. }
  13. if(file.strucutre == 2) {
  14. site.xy <- read.table(file,sep=file.sep,dec=file.dec,header = file.header)[,c(3,2)]
  15. }
  16.  
  17. ## ---------
  18.  
  19. if( !"wordcloud" %in% names(installed.packages()[,1]) ) {
  20.  
  21. cat( "\r" , "\r" , "Installing Dependences.", "\r", "\r")
  22. suppressMessages(suppressWarnings( try(install.packages("wordcloud" , verbose=FALSE , quiet = TRUE) , silent = TRUE) ) )
  23.  
  24. }
  25. if( !"raster" %in% names(installed.packages()[,1]) ) {
  26.  
  27. cat( "\r" , "\r" , "Installing Dependences.", "\r", "\r")
  28. suppressMessages(suppressWarnings( try(install.packages("raster" , verbose=FALSE , quiet = TRUE) , silent = TRUE) ) )
  29.  
  30. }
  31. if( !"rgeos" %in% names(installed.packages()[,1]) ) {
  32.  
  33. cat( "\r" , "\r" , "Installing Dependences.", "\r", "\r")
  34. suppressMessages(suppressWarnings( try(install.packages("rgeos" , verbose=FALSE , quiet = TRUE) , silent = TRUE) ) )
  35.  
  36. }
  37. if( !"gdistance" %in% names(installed.packages()[,1]) ) {
  38.  
  39. cat( "\r" , "\r" , "Installing Dependences.", "\r", "\r")
  40. suppressMessages(suppressWarnings( try(install.packages("gdistance" , verbose=FALSE , quiet = TRUE) , silent = TRUE) ) )
  41.  
  42. }
  43. cat( "\r" , "\r" , " ", "\r", "\r")
  44. cat( " ", "\n")
  45.  
  46. cat( " " , "Loading Dependences.")
  47. suppressMessages(suppressWarnings(try( library(raster) , silent = TRUE) ))
  48. suppressMessages(suppressWarnings(try( library(rgeos) , silent = TRUE) ))
  49. suppressMessages(suppressWarnings(try( library(gdistance) , silent = TRUE) ))
  50. suppressMessages(suppressWarnings(try( library(wordcloud) , silent = TRUE) ))
  51.  
  52. ## ---------------------------------------------------------------------------------------------
  53.  
  54. if(length(buffer) == 1) { buffer <- rep(buffer,4)}
  55. xmin <- min(site.xy[,1]) - buffer[1]
  56. xmax <- max(site.xy[,1]) + buffer[2]
  57. ymin <- min(site.xy[,2]) - buffer[3]
  58. ymax <- max(site.xy[,2]) + buffer[4]
  59.  
  60. if (xmin <= -180) { xmin <- -180}
  61. if (xmax >= 180) { xmin <- 180}
  62. if (ymin <= -90) { xmin <- -90}
  63. if (ymax >= 90) { ymax <- 90}
  64.  
  65. cat( " ", "\n")
  66. cat( " " , " ", "\n")
  67. cat( " " , ".....................................................................", "\n")
  68. cat( " " , "Generating region of interest.","\n")
  69. cat( " " , "This step may take a while depending on the resolution chosen and distance between sites.")
  70.  
  71. ocean <- shapefile(global.polygon)
  72. ocean <- crop(ocean, extent(xmin, xmax, ymin, ymax))
  73.  
  74. region.as.table <- matrix( NA ,nrow= ((ymax-ymin)/resolution) ,ncol= ((xmax-xmin)/resolution) )
  75. region.as.raster <- raster(region.as.table)
  76. extent(region.as.raster) <- c(xmin,xmax,ymin,ymax)
  77.  
  78. ocean.r <- rasterize(ocean, region.as.raster)
  79. ocean.r[!is.na(ocean.r)] <- 0
  80. ocean.r[is.na(ocean.r)] <- 1
  81.  
  82. ## ---------------------------------------------------------------------------------------------
  83. ## Relocate sites if needed
  84.  
  85. sites.to.relocate <- extract(ocean.r,site.xy[,1:2]) == 0
  86. sites.to.relocate.xy <- site.xy[sites.to.relocate,]
  87.  
  88. if( nrow(sites.to.relocate.xy) > 0 ) {
  89.  
  90. cat( " ", "\n")
  91. cat( " " , ".....................................................................", "\n")
  92. cat( " ", "\n")
  93.  
  94. if(nrow(sites.to.relocate.xy) == 1 ) {
  95.  
  96. cat( " " , " 1 site to be relocated.")
  97.  
  98. }
  99. if( nrow(sites.to.relocate.xy) > 1 ) {
  100.  
  101. cat( " " , nrow(sites.to.relocate.xy) , "sites to be relocated.")
  102. }
  103.  
  104. ocean.r.sites <- as.data.frame(ocean.r,xy=TRUE)[,1:2]
  105. ocean.r.sites <- cbind(ocean.r.sites,extract(ocean.r,ocean.r.sites))
  106. ocean.r.sites <- ocean.r.sites[ocean.r.sites[,3] == 1 , 1:2 ]
  107.  
  108. for (i in 1:nrow(sites.to.relocate.xy)) {
  109.  
  110. near.cells <- as.data.frame( sort( spDistsN1( as.matrix(ocean.r.sites), as.matrix(sites.to.relocate.xy[i,1:2]),longlat=TRUE), decreasing = FALSE,index.return = TRUE))
  111. site.xy[ which(sites.to.relocate)[i] , ] <- ocean.r.sites[ near.cells[1,2] , 1:2 ]
  112.  
  113. }
  114. }
  115.  
  116. ## -------------------------
  117.  
  118. pdf(file="Contour _ Study Region.pdf", width=200, height=200)
  119.  
  120. plot(ocean.r , col=c("#fffafa","#87ceeb"), legend=FALSE)
  121. points(site.xy[,1] , site.xy[,2], col="black",cex=10)
  122. textplot(site.xy[,1] , site.xy[,2] , site.names , cex=15, show.lines=TRUE,new=FALSE)
  123.  
  124. suppressMessages( dev.off())
  125.  
  126. ## -------------------------
  127.  
  128. cost.surface <- ocean.r
  129. projection(cost.surface) <- CRS("+proj=longlat +datum=WGS84")
  130.  
  131. raster_tr <- transition(cost.surface, mean, directions=8)
  132. raster_tr_corrected <- geoCorrection(raster_tr, type="c", multpl=FALSE)
  133.  
  134. example.sites.to.plot <- sample(1:nrow(site.xy),2,replace=FALSE)
  135.  
  136. pdf(file="Contour _ Example.pdf", width=200, height=200)
  137. plot(ocean.r , col=c("#fffafa","#87ceeb"), legend=FALSE)
  138. lines( shortestPath(raster_tr_corrected, as.matrix(site.xy[example.sites.to.plot[1],]) , as.matrix(site.xy[example.sites.to.plot[2],]) , output="SpatialLines") )
  139. points(site.xy[example.sites.to.plot,1] , site.xy[example.sites.to.plot,2], col="black",cex=10)
  140. textplot( site.xy[example.sites.to.plot,1] , site.xy[example.sites.to.plot,2] , site.names[example.sites.to.plot] ,cex=15, show.lines=TRUE, new=FALSE)
  141. suppressMessages( dev.off())
  142.  
  143. raster_cosDist <- costDistance(raster_tr_corrected, as.matrix(site.xy) , as.matrix(site.xy) )
  144. distance.marine <- as.matrix(raster_cosDist) / 1000
  145. colnames(distance.marine) <- as.factor(site.names)
  146. rownames(distance.marine) <- as.factor(site.names)
  147.  
  148. cat( " ", "\n")
  149. cat( " " , ".....................................................................", "\n")
  150. cat( " " , "Job is done.", "\n")
  151. cat( " ", "\n")
  152. cat( " " , "Comments or doubts?", "\n")
  153. cat( " " , "Please contact jorgemfa@gmail.com", "\n")
  154.  
  155. if(export.file) { write.table(distance.marine, file = "Contour _ Pairwise Marine Distances.txt" , quote = FALSE , sep = file.sep, row.names = TRUE, col.names = TRUE, na = "NA", dec = file.dec) }
  156.  
  157. if(!export.file) { print(distance.marine) }
  158. }
  159.  
  160. ## ------------------------------------------------------------------------------
  161. ## End of function
  162. ## ------------------------------------------------------------------------------
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement