R/support_functions.R

In wsteenbeek/sppt: Spatial Point Pattern Test

#' @import sp
#' @import methods
NULL

#' A convenience function to output the standard global S-value
#'
#' This function takes as input a spatial object generated by the \code{sppt} function
#' and returns the standard global S-value: the mean of all local \code{similarity}
#' values. The standard global S-value is the percentage of areas with a similar proportion
#' of test points as compared to the base points.
#'
#' @param sppt.sp  the spatialobject generated by the \code{sppt} function
#' @return         returns the standard global S-value
#' @examples
#' # set.seed(76772)
#' # myoutput <- sppt(base_points.sp = points1.sp, test_points.sp = points2.sp, uoa.sp = areas.sp)
#' # sppt:::summary_globalS.standard(myoutput)
#'
#' @keywords internal
summary_globalS.standard <- function(sppt.sp){
  mean(sppt.sp$globalS, na.rm=TRUE)
}


#' A convenience function to output the robust global S-value
#'
#' This function takes as input a spatial object generated by the \code{sppt} function
#' and returns the robust global S-value: the mean of all robust local \code{similarity}
#' values. The robust global S-value is the percentage of areas with a similar proportion
#' of test points as compared to the base points, not counting areas in which no points
#' occur in the base data and the test data.
#'
#' @param sppt.sp  the spatialobject generated by the \code{sppt} function
#' @return         returns the robust global S-value
#' @examples
#' # set.seed(76772)
#' # myoutput <- sppt(base_points.sp = points1.sp, test_points.sp = points2.sp, uoa.sp = areas.sp)
#' # sppt:::summary_globalS.robust(myoutput)
#'
#' @keywords internal
summary_globalS.robust <- function(sppt.sp){
  mean(sppt.sp$globalS.robust, na.rm=TRUE)
}


#' A convenience function to output the generalized robust global S-value
#'
#' This function takes as input a spatial object generated by the \code{sppt} function
#' and returns the generalized robust global S-value.
#'
#' @param sppt.sp  the spatialobject generated by the \code{sppt} function
#' @return         returns the generalized robust global S-value
#' @examples
#' # set.seed(76772)
#' # myoutput <- sppt(base_points.sp = points1.sp, test_points.sp = points2.sp, uoa.sp = areas.sp)
#' # sppt:::summary_globalS.generalized(myoutput)
#'
#' @keywords internal
summary_globalS.generalized <- function(sppt.sp){
  # wrap summary_globalS.generalized() in trCatch when running the function after sppt_diff
  tryCatch(
    mean(sppt.sp$generalizedS.robust, na.rm=TRUE), warning = function(cond) {return(NA)}
  )
}



#' A convenience function to output S-values
#'
#' This function takes as input a spatial object generated by the \code{sppt} function
#' and returns the standard global S-value, the robust global S-value, and the
#' generalized robust S-value in a list.
#'
#' @param sppt.sp  the spatialobject generated by the \code{sppt} function
#' @return         returns the standard, robust, and generalized robust global S-values
#' @examples
#' set.seed(76772)
#' myoutput <- sppt(base_points.sp = points1.sp, test_points.sp = points2.sp, uoa.sp = areas.sp)
#' summary_sppt(myoutput)
#'
#' @export
summary_sppt <- function(sppt.sp){

  if(is.na(summary_globalS.generalized(sppt.sp))){
    return(
      list(
        globalS.standard = summary_globalS.standard(sppt.sp),
        globalS.robust = summary_globalS.robust(sppt.sp)
      )
    )
  } else {
    return(
      list(
        globalS.standard = summary_globalS.standard(sppt.sp),
        globalS.robust = summary_globalS.robust(sppt.sp),
        globalS.generalized.robust = summary_globalS.generalized(sppt.sp)
      )
    )
  }
}