Project SimpleTree - Development moved to Computree platform

Dear interested user. You will find on this homepage my phd work. I found a follow up post doctoral position and continued improving my method within the open source framework Computree. I extended my method to work on plot level and I am providing Windows executables of my plugin within Computree.

As I improved my method quite a bit already I highly recommend using the new software. You can get an impression of the capabilities from the following video tutorial:

You need to have a Computree user account (free) to be able to download. My new contact email is jan.hackenberg@inra.fr, although I still check my Allumni email.

I cannot update this homepage anymore according to my new progress but you still might find here valuable resources, especially in the statistic section.

    Publication

In

Hackenberg, J.; Spiecker, H.; Calders, K.; Disney, M.; Raumonen, P. SimpleTree —An Efficient Open Source Tool to Build Tree Models from TLS Clouds. Forests 2015, 6, 4245-4294.
several statistical analsysis of the QSM models are presented. An introduction about the used R scripts is given here:

The R script:

#
# Software License Agreement (BSD License)
#
# Copyright (c) 2015, Jan Hackenberg.
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions
# are met:
#  *
#  * * Redistributions of source code must retain the above copyright
#* notice, this list of conditions and the following disclaimer.
#* * Redistributions in binary form must reproduce the above
#* copyright notice, this list of conditions and the following
#* disclaimer in the documentation and/or other materials provided
#* with the distribution.
#* * Neither the name of Willow Garage, Inc. nor the names of its
#* contributors may be used to endorse or promote products derived
#* from this software without specific prior written permission.
#*
#  * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
#* "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
#* LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
#* FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
#* COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
#* INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
#                                                            * BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
#                                                            * LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
#* CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
#* LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
#* ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
#* POSSIBILITY OF SUCH DAMAGE.
#*
#  */
 
setwd('/home/hackenberg/simpleTree/output/cherry/improved')
file_name = 'cherry1.pcd_detailed.csv'
 
####################################################################################################
#total volume and total length per branch order                                  ###################
####################################################################################################
branch_order_histogram <- function(data){
  maxOrder = max(data$BranchOrder)
  order = data.frame(order=as.numeric(), sum_length=as.numeric(),sum_volume=as.numeric())
  for(i in 0:maxOrder){
    order = rbind(order,c(0,0,0))
  }
  for(i in 0:maxOrder){
    data_order = data[which(data$BranchOrder==i),]
    order[i+1,1] = i;
    order[i+1,2] = sum(data_order[,10]);
    order[i+1,3] = sum(data_order[,8]);
  }
  names(order) = c("order","length", "volume")
  order
}
 
median_radius<-function(segment)
{
  median(segment[,9])
}
 
 
####################################################################################################
#creates a matrix with an entry for every segment                                ###################
#the average segments area is one row entry, the sum of its child segments areas the other##########
####################################################################################################
area_parent_children <- function (data, binWidth){
  number_segments <- max(data[,12])
  area = data.frame(area_parent=as.numeric(),area_child=as.numeric())
  for(i in 1:number_segments)
  {
    area = rbind(area,c(0,0))
 
  }
  for(i in 1:number_segments)
  {
    data_parent = data[which(data$SegmentID==i),]
    radius = median_radius(data_parent)
    area[i,1] = radius*radius*3.1416349*10000
    data_children = data[which(data$ParentSegmentID==i),]
    segmentID_children = unique(data_children$SegmentID)
    if(!is.null(segmentID_children))
    for(j in segmentID_children)
    {
       data_child = data[which(data$SegmentID==j),]
       radius = median_radius(data_child)
       area_child = radius*radius*3.1416349*10000
       area[i,2] = area[i,2] + area_child
    }
  }
 
   names(area) = c("parent_area","child_area")
  area
}
 
####################################################################################################
#counts for every stem height bin the total volume of branches growing out of    ###################
#this segment                                                               ########################
####################################################################################################
branch_histogram <- function (data, binWidth){
  max_height <- max(data$endZ)
  branches = data.frame(height_low=as.numeric(), height_high=as.numeric(),sum_vol_branches=as.numeric())
  height = 0.0;
  ####################################################################################################
  #generate an empty frame with height bins of the stem to store the branch volume ###################
  #per bin                                                                    ########################
  ####################################################################################################
  while(height < max_height)
  {    
    branches = rbind(branches, c(height, height + binWidth, 0 ))
    height <- height + binWidth;
  }
  ####################################################################################################
  # we get the number of branches                           ##########################################
  ####################################################################################################
  number_branches = max(data$BranchID)
  ####################################################################################################
  # every stem cylinders volume and radius is added to the  ##########################################
  # height bin containing the cylinders middle height       ##########################################
  # a counter is added for each bin counting the sum of added cylinders ##############################
  ####################################################################################################
  for(i in unique(data$BranchID))
  {
    data_branch = data[which(data$BranchID==i),]
    height_branch = data_branch[1,4]
    index <- ceiling(height_branch/binWidth)
    branches[index,3] <-branches[index,3] +  sum(data_branch[,8])
  }
  names(branches) = c("branch_min_height", "branch_max_height", "branch_volume")
  branches
}
 
####################################################################################################
#Diameter (and Volume) distribution of the stem along the stem height            ###################
####################################################################################################
stemCurve <- function (data, binWidth){
  max_height <- max(data$endZ)
  stem_curve = data.frame(height_low=as.numeric(), height_high=as.numeric(),sum_radius=as.numeric(), sum_cylinders=as.numeric(), radius=as.numeric(), diameter=as.numeric(), volume = as.numeric())
  height = 0.0;
  ####################################################################################################
  #generate an empty frame, sum_radius and sum_cylinders are helper variables ########################
  #the empty frame contains one row for every height bin                      ########################
  ####################################################################################################
  while(height < max_height)
  {    
    stem_curve = rbind(stem_curve, c(height, height + binWidth, 0, 0,0,0,0))
    height <- height + binWidth;
  }
  ####################################################################################################
  # we create a helper frame containing only stem cylinders ##########################################
  ####################################################################################################
  data.stem = data[which(data$BranchID==0),]
  ####################################################################################################
  # every stem cylinders volume and radius is added to the  ##########################################
  # height bin containing the cylinders middle height       ##########################################
  # a counter is added for each bin counting the sum of added cylinders ##############################
  ####################################################################################################
  for(i in 1:length(data.stem[,1]))
  {
    height_cylinder <- (data.stem[i,4] + data.stem[i,7])/2
    index <- ceiling(height_cylinder/binWidth)
    stem_curve[index,3] <- stem_curve[index,3] + data.stem[i,9];
    stem_curve[index,4] <- stem_curve[index,4] + 1;
    stem_curve[index,7] <- stem_curve[index,7] + data.stem[i,8];
  }
  ####################################################################################################
  # we remove empty bins                                                                          ####
  ####################################################################################################
  stem_curve <- stem_curve[which(stem_curve[,4]!=0),]
  ####################################################################################################
  # mean radius is computed for each bin, radius [m]   is converted to diameter [cm]              ####
  ####################################################################################################
  for(i in  1:length(stem_curve[,1]))
  {
    stem_curve[i,5] <- stem_curve[i,3]/stem_curve[i,4];
    stem_curve[i,6] <- 200 * stem_curve[i,5];
  } 
 
  stem_curve <- data.frame(stem_curve[,1],stem_curve[,2],stem_curve[,6],stem_curve[,7])
  names(stem_curve) = c("min_height","max_height", "diameter", "volume")
  stem_curve
}
 
data  <- read.csv(file_name, sep=",")
binWidth = 0.5;
 
order = branch_order_histogram(data)
plot(order$order,order$length)
plot(order$order,order$volume)
 
data2 = data[which(data$BranchOrder!=0),]
 
branches = branch_histogram(data2,binWidth)
max(branches$branch_volume)
plot(branches$branch_min_height,branches$branch_volume)
 
stem2 = stemCurve(data,binWidth)
plot(stem2$diameter, stem2$radius)
 
area = area_parent_children(data)
plot(area$parent_area,area$child_area)
lm.area <- lm(area$child_area ~ area$parent_area)
abline(lm.area)
summary(lm.area)

Created by Pretty R at inside-R.org

    Allometry

In the picture below you see an allometric model in the form of a power function to predict biomass - more accurately spoken wood volume - from DBH. This model is derived from about 5000 measurements, all taken from a single TLS derived tree model. You can reproduce the results with my software and the according cloud (the cloud ships with my software). A R script to produce the allometric models with non linear least squares fit can be found here or can be produced from the code below.

The r-squared is very high. Utilizing r-squared for non linear models is criticised (peer-reviewed analysis), but still offered as a validation measurement in most commercial software (i.e. Prism, Origin, Matlab, SPSS, SAS). Not all models of the cherry trees result in such a high r-squared, the average number should be 0.95 for other trees I produced results for. I attached PDF files with the models here.





























#
# Software License Agreement (BSD License)
#
# Copyright (c) 2015, Jan Hackenberg, University of Freiburg.
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions
# are met:
#  *
#  * * Redistributions of source code must retain the above copyright
#* notice, this list of conditions and the following disclaimer.
#* * Redistributions in binary form must reproduce the above
#* copyright notice, this list of conditions and the following
#* disclaimer in the documentation and/or other materials provided
#* with the distribution.
#* * Neither the name of Willow Garage, Inc. nor the names of its
#* contributors may be used to endorse or promote products derived
#* from this software without specific prior written permission.
#*
#  * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
#* "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
#* LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
#* FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
#* COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
#* INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
#                                                            * BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
#                                                            * LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
#* CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
#* LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
#* ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
#* POSSIBILITY OF SUCH DAMAGE.
#*
#  */
library(nls2)
 
path.to.results = '~/simpleTree/output/test/'
path.to.pdf = '~/Schreibtisch/ery_no_allom.pdf'
test.caption = "Test Allometry"
 
setwd(path.to.results)
files <- list.files(pattern="detailed.csv$")
x <- c()
y <- c()
for(i in files) {
  setwd(path.to.results)
  data <- read.csv(i)
  x<-c(x,data[,9])
  y<-c(y,data[,11])
}
 
 
 
pdf(path.to.pdf)
x.log <- log(x)
y.log <- log(y)
lm <- lm(y.log~x.log)
 
a <- coef(lm)[1]
b <- coef(lm)[2]
expA <- exp(a)
 
data2 <- data.frame(x,y)
par(mar = c(5,6,4,2))
plot(x,y, xlim = c(0,0.15),ylim = c(0,0.75),axes = FALSE,main = as.expression(test.caption)
     ,xlab =as.expression(bquote(Radius (m)  )), ylab = as.expression(bquote(GrowthVolume (m^3)  )) ,cex.lab = 2,cex.main = 2)
axis(side = 1, at=c(0,0.05,0.1,0.15),cex.axis = 2)
axis(side = 2, at=c(0,0.25,0.5,0.75),cex.axis = 2)
box()
nls.vol <- nls(y ~ b1*x**b2,data = data2,start = list(b1 = 1156,b2 = 3.484), control = list(maxiter=500,warnOnly = TRUE))
r2nls <- 1-(deviance(nls.vol)/sum((y-mean(y))^2))
coefficients(nls.vol)[1]
coefficients(nls.vol)[2]
curve( (coefficients(nls.vol)[1] *x** coefficients(nls.vol)[2]),0,max(x),add=TRUE,col='red',lwd=4)
curve( (coefficients(nls.vol)[1]*2.5 *x** coefficients(nls.vol)[2]),0,max(x),add=TRUE,col='red',lwd=4,lty = 4)
curve( (coefficients(nls.vol)[1]/2.5 *x** coefficients(nls.vol)[2]),0,max(x),add=TRUE,col='red',lwd=4,lty = 2)
 
 
leg.txt = c( as.expression("y =         "   ~ ax^b)  , 
             #  "y =  ax^b",
             paste("a =  ",formatC(coefficients(nls.vol)[1],big.mark=",",digits = 3,format = "f")),
             paste("b =    ",formatC(coefficients(nls.vol)[2],big.mark=",",digits = 3,format = "f"))
             , "fac =      2.5"
             ,"upper border","lower border")
legend("topleft",  leg.txt
       ,col= c('red','white','white','white','red','red')
       ,bty = "n"
       ,lwd = c(4)
       ,lty = c(1,1,1,1,4,2)
       ,cex = 2
       ,pt.cex =1.3
)
dev.off()

Created by Pretty R at inside-R.org

    Allometry Potentials - Forestry

All allometric models from the zip file are put into one plot except for two. Those two were scans from P. avium planted at a different time. The rest of the trees were planted within several days by the same gardeners.

The tree models are highlighted in red and blue. It seems that there are two groups of different trees. All the red models seem to coincide quiet well, all the blue ones too.

There are several possible reasons, why the groups are inherently consistent. To name several reasons:

  1. Different scan design, different weather conditions during scan.
  2. Some of the trees have been pruned, some not.
  3. One group consists of free standing trees, the other has trees with competitors.
  4. Gene pool is different for each of the groups, potential of having 2 seed trees which generated the 2 genetiv pools.
The authors opinion:
  1. Scan design can be excluded, as the design was setup in a way to prevent this.
  2. Pruning was performed on some trees to a minor extend. The effect is considered neglectable to this research question, as both groups contain both pruned and non pruned trees. It is assumed that pruning will affect the model form after several growth periods.
  3. Both groups contained trees with one or two competitors. No pattern could be detected.
  4. As trees werent grown from clones, no assumption can be made on this.

As there are only 24 tree models included, the pattern could also be randomly generated.





















    Allometry Potentials - TLS modelling

Some cylinders in my generated model are still in-accurately fitted with my method, even when the cloud is of high quality. Those cylinders are easily detected just by visualization and they occur as overestimated cylinders (large radius) in the twigs (small GrowthVolume). The wrongly fitted cylinders coincide with the outlier measurements in the allometric model. In the screenshot two of those cylinders can be seen.

Right now the allometric modelling is performed external in R. This is used as an statistical improvement to better radius/volume prediction.

    Distance Analysis

In Highly Accurate Tree Models Derived from Terrestrial Laser Scan Data: A Method Description I proposed to evaluate quality of fit of the tree models with an histogram analysis of the distance between the point cloud and the model.

If your output folder already has some result files, you should be able to find files ending with 'dist.csv'. Those files contain the distance in millimeter for every point to the model. You can use the following R-Script to perform this analysis. You might have to adjust the path variables. Results will contain PDF files for every computed model:

The parameters are discussed in the publication in detail. In addition a csv file will be created storing all the fit evaluating paramters of one tree model per row.

 
This template downloaded form free website templates