zero_crossings.R

#' Find zero crossings in an fd object
#' 
#' @import fda
#' @import magrittr
#' 
#' @param fd an fd object
#' @param Lfdobj the derivative (0, 1, 2)
#' @param slope The slope of interest at the zero crossing
#' @param eps The prediction granularity
#' @param min Localize the zero crossing search to be greater than min
#' @param max Localize the zero crossing search to be less than max
#' 


zero_crossings <- function(fd, Lfdobj = 0, slope = 1, eps = 1e-3, 
                           min = NULL, max = NULL){
  xrange <- fd$basis$rangeval
  if(is.null(min)){
    min = xrange[1]
  }
  if(is.null(max)){
    max = xrange[2]
  }
  x <- seq(min, max, by = eps)
  y <- predict(fd, Lfdobj = Lfdobj, newdata = x, returnMatrix = T)
  y_up <- matrix(y[-dim(y)[1],], ncol = ncol(y))
  y_down <- matrix(y[-1,], ncol = ncol(y))
  
  zero_cross <- sign(y_up) != sign(y_down)
  positive_slopes <- sign(y_up) < 1
  negative_slopes <- sign(y_up) > -1
  
  if(slope == 1){
    out_idx <- apply(zero_cross & positive_slopes, MARGIN = 2, FUN = which) %>%
                  lapply(., FUN = function(x){if(length(x)<1){
                                                    return(NA)
                                                  }else{
                                                return(x[1])}})%>%
                unlist()
  }else{
    out_idx <- apply(zero_cross & negative_slopes, MARGIN = 2, FUN = which) %>%
      lapply(., FUN = function(x){if(length(x)<1){
        return(NA)
      }else{
        return(x[1])}})%>%
      unlist()
  }
  out <- x[out_idx]

  return(out)
}