├── LICENSE ├── Layer_Stacking_modular.R └── README.md /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2017 Eayrey 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /Layer_Stacking_modular.R: -------------------------------------------------------------------------------- 1 | ############################################################################### 2 | # LAYER STACKING # 3 | # # 4 | # # 5 | # Layer stacking is a novel algorithm for segmenting individual trees from a # 6 | # LiDAR point cloud. Layer stacking works best on small-medium sized areas # 7 | # (<10ha), and with Leaf Off High resolution LiDAR (+5ppm). It is also # 8 | # important to normalize the LiDAR data using a digital elevation model prior # 9 | # to running layer stacking. # 10 | # # 11 | # As with most segmentation algorithms, there are parameters which may # 12 | # require region and LiDAR specific fine tuning. # 13 | # # 14 | ############################################################################### 15 | 16 | #Please specify the folder in which LiDAR files are stored. Only ".las" files 17 | # can be stored here 18 | fpath <- "H:\\Temp\\LS\\lidar\\"#"C:\\location\\location" 19 | 20 | #Please specify the folder in which the processed csv files will be stored. 21 | Output <- "H:\\Temp\\LS\\"#"C:\\location\\location" 22 | 23 | #Number of processor cores to use for parallel processesing 24 | #Default is the number of cores you have in your machine minus 1. 25 | n= detectCores(all.tests = FALSE, logical = TRUE)-1 26 | 27 | #If this is a predominantly hardwood stand (trees without leaves/needles), 28 | # set this switch to true. 29 | hw=FALSE 30 | 31 | #Consider using this switch if you're working with very high density LiDAR, or small tree crowns, or you feel too few trees were segmented 32 | #Essentially runs a finer filter over the LiDAR and may detect trees very small or close to one another 33 | d=FALSE 34 | 35 | #Specify a cutoff value for filtering tree crowns, which referes to the 36 | #number standard deviations below which an abnormally large tree crown 37 | #segment will be allowed. A small number may be needed in dense forests with 38 | #small tree crowns, a larger number may be needed in forests with large trees 39 | c=3.5 40 | if (hw==TRUE){ 41 | c=2.5 42 | } 43 | 44 | #Threshold for removing small trees. Takes out trees with less than t clusters identified. 45 | #Generally trees shorter than this threshold will be removed. 46 | t=3 47 | 48 | #parameters to tinker with if trees are being over or under segmented 49 | 50 | #Refers to the width of buffers places around each cluster. A larger value may be 51 | #needed with low density LiDAR, or larger trees 52 | #0.5m was ideal for the high density LiDAR tested. 53 | buf_width=0.6 54 | 55 | #Refers to the width of the tree's core. Clusters touching this core 56 | #will be considered part of that tree. A larger value may be 57 | #needed with low density LiDAR, or larger tree crowns 58 | #0.6m was ideal for the high density LiDAR tested. 59 | core_width=0.6 60 | 61 | #the following packages are required 62 | library(rLiDAR) 63 | library(doParallel) 64 | library(raster) 65 | library(sp) 66 | library(rgeos) 67 | library(prevR) 68 | library(fpc) 69 | 70 | #################Buffer function############################ 71 | buffer.groups<-function(group, buf_width=.6){ 72 | pts <- SpatialPoints(group[,1:2]) 73 | buffered_layer=gBuffer(pts, width=buf_width) 74 | buffered_layer=disaggregate(buffered_layer) 75 | for (i in 1:length(buffered_layer)){ 76 | poly=buffered_layer[i] 77 | outerRings = Filter(function(f){f@ringDir==1},poly[1]@polygons[[1]]@Polygons) 78 | outerBounds = SpatialPolygons(list(Polygons(outerRings,ID=1))) 79 | if (i==1){buffers=outerBounds}else{buffers=rbind.SpatialPolygons(buffers, outerBounds, makeUniqueIDs =TRUE)} 80 | } 81 | return(buffers) 82 | } 83 | 84 | ##########Layer Stacking################################### 85 | 86 | layer_stacker=function(inFile, buffer.groups,Output, p, n, t, c,d, hw, buf_width, core_width){ 87 | #seperate into layers at 1m intervals 88 | inFile=data.frame(inFile) 89 | inFile=unique(inFile) 90 | inFile$layer= round(inFile$Z) 91 | inFile=subset(inFile,inFile$layer>0) 92 | layers=split(inFile, inFile$layer) 93 | 94 | #####################Local MAxima######################## 95 | #Generates the number of local maxima for different LiDAR smoothing levels. 96 | 97 | high_pts=inFile 98 | e=extent(min(high_pts[,1]), max(high_pts[,1]),min(high_pts[,2]),max(high_pts[,2])) 99 | #1m Raster, .5m Raster, and 2m Raster 100 | r1 <- raster(e, ncol=(e[2]-e[1]), nrow=(e[4]-e[3])) 101 | r_forth<- raster(e, ncol=(e[2]-e[1])*4, nrow=(e[4]-e[3])*4) 102 | x1 <- rasterize(inFile[,1:2], r1, inFile[,3], fun=max) 103 | smoothed1=focal(x1, w=matrix(1, nrow=3, ncol=3),fun=function(x){mean(x,na.rm=TRUE)}) 104 | localmax1 <- focal(smoothed1,w=matrix(1,nrow=3,ncol=3), fun = max, pad=TRUE, padValue=NA) 105 | trueLM1<-(smoothed1==localmax1)*x1 106 | trueLM1[trueLM1==0]<-NA 107 | 108 | #################Initial clusters########################### 109 | cl=makeCluster(n) 110 | registerDoParallel(cl) 111 | rasters=foreach(i=1:(length(layers)), .errorhandling="pass") %dopar% { 112 | library(raster) 113 | library(sp) 114 | library(rgeos) 115 | library("fpc") 116 | layer=data.frame(layers[i]) 117 | 118 | if (i<=3){ 119 | if (length(layer)>1){ 120 | db=dbscan(layer[,1:2], eps=1.5, MinPts=5) 121 | lowlayer=layer 122 | lowlayer$group<-db$cluster 123 | lowlayer=subset(lowlayer, group==0) 124 | layer<-lowlayer 125 | } 126 | } 127 | 128 | LM1=trueLM1 129 | LM1[LM11 && length(bbb)==length(coords)){ 144 | bbb=bbb[!duplicated(coords)]} 145 | 146 | x <- rasterize(bbb, r_forth) 147 | layer_raster=x>=0 148 | #Adding additional weight to polygons near the top 149 | if (hw==FALSE){ 150 | if (i/length(layers)>=.7){ 151 | layer_raster7=x>=0 152 | layer_raster=layer_raster+layer_raster7 153 | } 154 | if (i/length(layers)>=.8){ 155 | layer_raster8=x>=0 156 | layer_raster=layer_raster+layer_raster8 157 | } 158 | if (i/length(layers)>=.9){ 159 | layer_raster9=x>=0 160 | layer_raster=layer_raster+layer_raster9 161 | } 162 | } 163 | layer_raster[is.na(layer_raster[])] <- 0 164 | c(layer_raster) 165 | } 166 | #stopCluster(cl) 167 | 168 | #Construct the overlap map from individual rasters 169 | for (r in 1:length(rasters)){ 170 | #plot(rasters[[r]][[1]]) 171 | if (r==1){overlap_map_forth=rasters[[r]][[1]]}else{overlap_map_forth=overlap_map_forth+rasters[[r]][[1]]} 172 | } 173 | 174 | #Local maxima on the overlap maps 175 | r_half<- raster(e, ncol=(e[2]-e[1])*2, nrow=(e[4]-e[3])*2) 176 | overlap_map_half=resample(overlap_map_forth, r_half) 177 | overlap_map1=resample(overlap_map_forth, r1) 178 | 179 | smoothed1=focal(overlap_map1, w=matrix(1, nrow=3, ncol=3),fun=function(x){mean(x,na.rm=TRUE)}) 180 | smoothed_half=focal(overlap_map_half, w=matrix(1, nrow=3, ncol=3),fun=function(x){mean(x,na.rm=TRUE)}) 181 | smoothed_forth=focal(overlap_map_forth, w=matrix(1, nrow=3, ncol=3),fun=function(x){mean(x,na.rm=TRUE)}) 182 | 183 | localmax1 <- focal(smoothed1,w=matrix(1,nrow=3,ncol=3), fun = max, pad=TRUE, padValue=NA) 184 | localmax_half <- focal(smoothed_half,w=matrix(1,nrow=3,ncol=3), fun = max, pad=TRUE, padValue=NA) 185 | localmax_forth <- focal(smoothed_forth,w=matrix(1,nrow=3,ncol=3), fun = max, pad=TRUE, padValue=NA) 186 | 187 | trueLM1<-(smoothed1==localmax1)*overlap_map1 188 | trueLM_half<-(smoothed_half==localmax_half)*overlap_map_half 189 | trueLM_forth<-(smoothed_forth==localmax_forth)*overlap_map_forth 190 | 191 | trueLM1[trueLM1==0]<-NA 192 | trueLM_half[trueLM_half==0]<-NA 193 | trueLM_forth[trueLM_forth==0]<-NA 194 | 195 | #####Clustering for polygons 196 | #cl=makeCluster(n) 197 | #registerDoParallel(cl) 198 | polys=foreach(i=1:(length(layers)), .errorhandling="pass") %dopar% { 199 | library(raster) 200 | library(sp) 201 | library(rgeos) 202 | library("fpc") 203 | 204 | layer=data.frame(layers[i]) 205 | layer=unique(layer) 206 | 207 | if (i<=3){ 208 | if (length(layer)>1){ 209 | db=dbscan(layer[,1:2], eps=1.5, MinPts=5) 210 | lowlayer=layer 211 | lowlayer$group<-db$cluster 212 | lowlayer=subset(lowlayer, group==0) 213 | layer<-lowlayer 214 | } 215 | } 216 | 217 | points1=rasterToPoints(trueLM1) 218 | points_half=rasterToPoints(trueLM_half) 219 | 220 | points_forth=rasterToPoints(trueLM_forth) 221 | 222 | if (nrow(points1)==0 || nrow(layer)1] 314 | layer_ps 315 | } 316 | #stopCluster(cl) 317 | 318 | ####################CLIP OUT TREE POLYGONS############################## 319 | #cl=makeCluster(n) 320 | #registerDoParallel(cl) 321 | tree_polys=foreach(gr=1:length(buf_cores), .errorhandling="pass") %dopar% { 322 | library(sp) 323 | library(rgeos) 324 | library(prevR) 325 | core=buf_cores[gr,1] 326 | poly_attributes=slot(core,"polygons") 327 | coords=matrix(sapply(core@polygons, function(x) coordinates(x@Polygons[[1]])),ncol=2,byrow=F) 328 | 329 | poly_areas=NULL 330 | for (l in 1:(length(polys2))){ 331 | layer_ps=polys2[[l]] 332 | if (typeof(layer_ps)=="S4"){ 333 | ids=sapply(slot(layer_ps, "polygons"), function(x) slot(x, "ID")) 334 | polysin=lapply(ids, function(x) {point.in.SpatialPolygons(coords[,1],coords[,2], layer_ps[match(x,ids)])}) 335 | polysin=unlist(lapply(polysin,any))==T 336 | layer_in=layer_ps[polysin] 337 | layer_in=SpatialPolygonsDataFrame(layer_in, data=data.frame(row.names=sapply(slot(layer_in, "polygons"), function(x) slot(x, "ID")),rep(l,length(layer_in)))) 338 | colnames(layer_in@data)=c("height") 339 | #nnn<-1:length(layer_ps) 340 | #results[[l]][[2]]=layer_ps[-nnn[polysin]] 341 | if (l==1){in_polys=layer_in 342 | }else{in_polys=rbind(in_polys,layer_in,makeUniqueIDs = TRUE)} 343 | } 344 | } 345 | 346 | if (length(in_polys)>1){ 347 | #ANOTHER somewhat ARBITRARY THRESHOLD FOR REMOVING POLYS NOT CENTERED AT THE CORE OF THE TREE 348 | center_pt=gCentroid(core) 349 | in_poly_centroids=lapply(seq(to=nrow(in_polys)), function(x){gCentroid(in_polys[x,])}) 350 | in_poly_centroids=matrix(coordinates(in_poly_centroids), ncol=2, byrow=TRUE) 351 | dists=spDistsN1(in_poly_centroids, center_pt) 352 | if (length(dists)>0){ 353 | sd_cutoff=sd(dists[dists>core_width])*c 354 | goods=dists0){ 361 | sd_cutoff=sd(poly_areas[poly_areas>.8])*c 362 | goods=poly_areas=t){ 378 | TRUE 379 | }else{FALSE} 380 | } 381 | bigts=unlist(lapply(tree_polys, large_trees)) 382 | tree_polys=tree_polys[bigts] 383 | 384 | ###################CLIP LIDAR POINTS###################### 385 | 386 | #cl=makeCluster(n) 387 | #registerDoParallel(cl) 388 | segmented=foreach(l=1:length(layers), .combine='rbind', .errorhandling="pass") %dopar% { 389 | library(sp) 390 | library(prevR) 391 | layer=data.frame(layers[l]) 392 | layer$TreeNumber=NA 393 | colnames(layer)= c("X","Y","Z","Intensity","ReturnNumber","Layer","TreeNumber") #c("X","Y","Z","Layer","TreeNumber") 394 | for (t in 1:length(tree_polys)){ 395 | tree=tree_polys[t][[1]][[1]] 396 | #tree=in_polys 397 | polyin=tree@data==l 398 | nnn<-1:length(polyin) 399 | num_polys=seq(1:sum(polyin)) 400 | 401 | core_poly=tree[tree@data$height>50,] 402 | pointsinc=point.in.SpatialPolygons(layer[,1],layer[,2], core_poly) 403 | if (length(nnn[polyin])>0){ 404 | polyin=tree[nnn[polyin],] 405 | pointsin=(lapply(num_polys, function(x) {point.in.SpatialPolygons(layer[,1],layer[,2], polyin[x,])})) 406 | pointsin=Reduce("|",pointsin) 407 | pointsin=pointsin | pointsinc 408 | layer[pointsin,]$TreeNumber=t+1 409 | 410 | if (sum(pointsin>0)){ 411 | layer[pointsin,]$TreeNumber=t+1 412 | } 413 | } 414 | } 415 | layer 416 | } 417 | stopCluster(cl) 418 | 419 | write.csv(segmented, file=paste(Output, substr(a[p], 1, nchar(a[p])-4), "_Done", ".csv",sep="")) 420 | } 421 | 422 | a <- list.files(fpath) 423 | 424 | for (p in 1:length(a)){ 425 | inFile=readLAS(paste(fpath,a[p],sep="\\")) 426 | ptm <- proc.time() 427 | layer_stacker(inFile, buffer.groups,Output, p, n, t, c,d, hw, buf_width, core_width) 428 | proc.time() - ptm 429 | print (p/length(a)*100) 430 | } 431 | 432 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Layer-Stacking 2 | 3 | A rough implementation of Layer Stacking, an algorithm developed for segmenting individual trees from a LiDAR point cloud. Note that refinement of parameters for individual forests and point clouds is generally required for meaningful results. 4 | 5 | Ayrey, E., Fraver, S., Kershaw Jr, J. A., Kenefic, L. S., Hayes, D., Weiskittel, A. R., & Roth, B. E. (2017). Layer Stacking: A Novel Algorithm for Individual Forest Tree Segmentation from LiDAR Point Clouds. Canadian Journal of Remote Sensing, 1-13. 6 | --------------------------------------------------------------------------------