Fixed problems with flow dimension function related to the derivative…

… calculation.

R/flow_dimension_utilities.R

@@ -17,49 +17,78 @@ NULL
 #' regression approach.
 #' @param method Method to calculate the derivative. See log_derivative
 #' @return
-#' This function returns a list with components named as x and y that contains the
-#' flow dimension y evaluated at specific points x.
+#' This function returns a list with components:
+#' \itemize{
+#' \item x: Numeric vector with times at which the second derivative is evaluated
+#' \item y: Numeric vector with the values of the second derivative of drawdown
+#' \item n: Numeric vector with the flow dimension values evaluated at each time
+#' }
 #' @author
 #' Oscar Garcia-Cabrejo, \email{[email protected]}
 #' @family flow_dimension functions
 #' @export
+#' @examples
+#' data(boulton)
+#' t <- boulton$t
+#' s <- boulton$s
+#' boulton.fdim <- flow_dimension(t,s, method = "smoothspline")
+#' plot(boulton.fdim$x, boulton.fdim$n, type = "p", log = "x", 
+#' ylim = c(0, 10))
 flow_dimension <- function(t, s, d = 2, method = "central"){
  flow_dim <- NULL
  if(method == 'central'){
- log_d <- log_derivative_central(t, s)
- y <- log(log_d$y)
- flow_dim <- log_derivative_central(t, y)
- flow_dim$n <- 2-2*flow_dim$y
+ res1a <- log_derivative_central(t, s, return.pos = F, log = F)
+ pos <- res1a$y > 0
+ res1b <- log_derivative_central(res1a$x[pos],
+ log(res1a$y[pos]*log(10)),
+ return.pos = F)
+ flow_dim$x <- res1b$x
+ flow_dim$y <- res1b$y
+ flow_dim$n <- 2-2*res1b$y
  }
  else if(method == 'horner'){
- log_d <- log_derivative_horner(t, s)
- y <- log(log_d$y)
- flow_dim <- log_derivative_horner(t, y)
- flow_dim$n <- 2-2*flow_dim$y
+ res1a <- log_derivative_horner(t, s, return.pos = F, log = F)
+ pos <- res1a$y > 0
+ res1b <- log_derivative_horner(res1a$x[pos],
+ log(res1a$y[pos]*log(10)),
+ return.pos = F)
+ flow_dim$x <- res1b$x
+ flow_dim$y <- res1b$y
+ flow_dim$n <- 2-2*res1b$y
  }
  else if(method == 'bourdet'){
- log_d <- log_derivative_bourdet(t, s, d)
- y <- log(log_d$y)
- flow_dim <- log_derivative_bourdet(t, y, d)
- flow_dim$n <- 2-2*flow_dim$y
- }
- else if(method =='spline'){
- log_d <- log_derivative_spline(t, s, n = d)
- y <- log(log_d$y)
- flow_dim <- log_derivative_spline(t, y, n = d)
- flow_dim$n <- 2-2*flow_dim$y
- }
- else if(method == 'spane'){
- log_d <- log_derivative_spane(t, s, n = d)
- y <- log(log_d$y)
- flow_dim <- log_derivative_spane(t, y, n = d)
- flow_dim$n <- 2-2*flow_dim$y
+ res1a <- log_derivative_bourdet(t, s, return.pos = F, 
+ log = F, d = d)
+ pos <- res1a$y > 0.0
+ res1b <- log_derivative_bourdet(res1a$x[pos], 
+ log(res1a$y[pos]*log(10)),
+ return.pos = F, d = d)
+ flow_dim$x <- res1b$x
+ flow_dim$y <- res1b$y
+ flow_dim$n <- 2-2*res1b$y
  }
+ # else if(method =='spline'){
+ # log_d <- log_derivative_spline(t, s, n = d)
+ # y <- log(log_d$y)
+ # flow_dim <- log_derivative_spline(t, y, n = d)
+ # flow_dim$n <- 2-2*flow_dim$y
+ # }
+ # else if(method == 'spane'){
+ # log_d <- log_derivative_spane(t, s, n = d)
+ # y <- log(log_d$y)
+ # flow_dim <- log_derivative_spane(t, y, n = d)
+ # flow_dim$n <- 2-2*flow_dim$y
+ # }
  else if(method == 'smoothspline'){
- log_d <- log_derivative_smoothspline(t, s)
- y <- log(log_d$y)
- flow_dim <- log_derivative_smoothspline(t, y)
- flow_dim$n <- 2-2*flow_dim$y
+ res1a <- log_derivative_smoothspline(t, s, return.pos = F, 
+ log = F)
+ pos <- res1a$y > 0 
+ res1b <- log_derivative_smoothspline(res1a$x[pos],
+ log(res1a$y[pos]*log(10)),
+ return.pos = F)
+ flow_dim$x <- res1b$x
+ flow_dim$y <- res1b$y
+ flow_dim$n <- 2-2*res1b$y
  }
  else if(method == 'kernelreg'){
  log_d <- log_derivative_kernelreg(t, s)
@@ -68,22 +97,34 @@ flow_dimension <- function(t, s, d = 2, method = "central"){
  flow_dim$n <- 2-2*flow_dim$y
  }
  else if(method == 'lokern'){
- log_d <- log_derivative_lokern(t, s)
- y <- log(log_d$y)
- flow_dim <- log_derivative_lokern(t, y)
- flow_dim$n <- 2-2*flow_dim$y
+ res1a <- log_derivative_lokern(t, s, return.pos = F, log = F)
+ pos <- res1a$y > 0
+ res1b <- log_derivative_lokern(res1a$x[pos], 
+ log(res1a$y[pos]*log(10)),
+ return.pos = F)
+ flow_dim$x <- res1b$x
+ flow_dim$y <- res1b$y
+ flow_dim$n <- 2-2*res1b$y
  }
  else if(method == 'locpol'){
- log_d <- log_derivative_lokern(t, s)
- y <- log(log_d$y)
- flow_dim <- log_derivative_locpol(t, y)
- flow_dim$n <- 2-2*flow_dim$y
+ res1a <- log_derivative_locpol(t, s, return.pos = F, log = F)
+ pos <- res1a$y > 0
+ res1b <- log_derivative_locpol(res1a$x[pos], 
+ log(res1a$y[pos]*log(10)),
+ return.pos = F)
+ flow_dim$x <- res1b$x
+ flow_dim$y <- res1b$y
+ flow_dim$n <- 2-2*res1b$y
  }
  else if(method == "lpridge"){
- log_d <- log_derivative_lpridge(t, s)
- y <- log(log_d$y)
- flow_dim <- log_derivative_lpridge(t, y)
- flow_dim$n <- 2-2*flow_dim$y
+ res1a <- log_derivative_lpridge(t, s, return.pos = F, log = F)
+ pos <- res1a$y > 0
+ res1b <- log_derivative_lpridge(res1a$x[pos], 
+ log(res1a$y[pos]*log(10)),
+ return.pos = F)
+ flow_dim$x <- res1b$x
+ flow_dim$y <- res1b$y
+ flow_dim$n <- 2-2*res1b$y 
  }
  else {
  stop("ERROR: Unknown derivative type. Please check and try again")