Quantcast
Channel: Active questions tagged r - Stack Overflow
Viewing all articles
Browse latest Browse all 201839

Efficient way to find species specific coefficients for a function call

$
0
0

Andrew Robinson shows in irebreakeR how to compute tree volume using diameter and height. He creates a function which uses coefficients depending on species and diameter. A simplified version looks like:

funRobinson <- function(species, diameter, height) {
  bf_params <- data.frame(species  = c("Spruce", "Oak"),
                          b0_small = c(26.729,  29.790),
                          b1_small = c( 0.01189, 0.00997),
                          b0_large = c(32.516,  85.150),
                          b1_large = c( 0.01181, 0.00841))
  dimensions <- data.frame(diameter   = diameter,
                           height     = height,
                           species    = as.character(species),
                           this_order = 1:length(species))
  dimensions <- merge(y=dimensions, x=bf_params, all.y=TRUE, all.x=FALSE)
  dimensions <- dimensions[order(dimensions$this_order, decreasing=FALSE),]
  b0 <- with(dimensions, ifelse(diameter <= 20.5, b0_small, b0_large))
  b1 <- with(dimensions, ifelse(diameter <= 20.5, b1_small, b1_large))
  b0 + b1 * dimensions$diameter^2 * dimensions$height
}

For me this method looks straight forward but it creates an additional data.frame which needs to be sorted and calls ifelse twice to distinguish between small (diameter <= 20.5) and large trees. I'm looking for a more efficient way (low memory consumption, execution time) to find species specific coefficients. I would appreciate the possibility to add coefficients for other species without editing the function.

Example data-set and Performance:

dat <- data.frame(species = c("Spruce", "Spruce", "Oak", "Oak", "Fir"),
                  diameter = c(4,   30,  4,   30,  30),
                  height  = c(30,  100, 30,  100, 100))
with(dat, funRobinson(species, diameter, height))
#[1]   32.4362 1095.4160   34.5756  842.0500        NA

library(microbenchmark)
microbenchmark(
  Robinson = with(dat, funRobinson(species, diameter, height))
)
#Unit: milliseconds
#     expr      min       lq     mean   median       uq      max neval
# Robinson 1.832604 1.860334 1.948054 1.876155 1.905009 3.054021   100


set.seed(0)
size <- 1e5
dat2 <- data.frame(species = sample(c("Spruce", "Oak", "Fir"), size=size, replace = TRUE)
       , diameter = runif(size, 1, 50)
       , height  = runif(size, 1, 100))

microbenchmark(
  Robinson = with(dat2, funRobinson(species, diameter, height))
)
#Unit: milliseconds
#     expr      min       lq     mean   median       uq      max neval
# Robinson 203.8171 219.9265 234.0798 227.5911 250.6204 278.9918   100

Viewing all articles
Browse latest Browse all 201839

Trending Articles