R/split_nurr.R

In dbasu-umass/bate: Computes Bias-Adjusted Treatment Effect

#' Split a region into two parts
#'
#' @param region1 Data frame with coordinates for region 1
#' @param region2 Data frame with coordinates for region 2
#' @param epsilon Closest distance
#' @param parameters A vector of parameters (real numbers) that is generated by estimating the short, intermediate and auxiliary regressions.
#' @param e The step size of the grid in the x and y directions. 
#'
#' @importFrom purrr "pmap"
#' @importFrom purrr "pmap_dbl"
#' @importFrom dplyr "select"
#' @importFrom stats "setNames"
#' 
#' @return List, where first element is region within epsilon distance of region 1 and second element which is region which is not within epsilon distance of region 1.
#' @export
#'
#' 
split_nurr <- function(region1,region2,epsilon,parameters,e){
  
  # Create data frame which returns all points on the border of region 2, the 
  # distance to the closest point in region 1, and the cubic root of that closest point
  region2.border <- Reduce(function (x,y) rbind(x,y),
                           with(get_border(region2,e),
                                pmap(list(x=delta,y=Rmax),
                                     getdistance,
                                     region=region1)))
  
  # Calculate whether the minimum distance from each point in region2 is within
  # distance epsilon from region1
  region2 <- region2.border %>% 
    mutate(withine = ifelse(distance<=epsilon | isTRUE(all.equal(distance,epsilon)),1,0)) %>% # The all.equal() is necessary because sometimes the distance is approximately epsilon
    merge(region2,all.y=TRUE) %>%
    mutate(withine = replace(withine,is.na(withine),0))
  
  # if there are no points in region2 within epsilon of region1, return NULL and region2
  if(sum(region2$withine)==0){
    region2 <- region2 %>%
      select(c("delta","Rmax"))
    return(list(NULL,region2))
  }
  
  # if all points in region2 are within epsilon of region1, return region2 
  # with calculated bias
  else if(sum(region2$withine)==nrow(region2)){
    # Calculate root for each point in region2
    region2 <- region2 %>%
      mutate(bias = pmap_dbl(list(mydelta=delta,Rmax=Rmax,closest_bias=closest_bias),
                             selectroot, parameters = parameters)) %>%
      select(-c("distance","withine","closest_bias"))
    
    return(list(region2))
  }
  
  # if there are some points in region2 within epsilon of region1, separate region2
  # into two regions, region3 which is within epsilon of region1 and region4 which is not.
  # For region3, select the roots which are closest in absolute value to the nearest point
  # in region1. Return a list of regions 3 and 4. 
  else{
    # Define region within epsilon of region1
    region3 <- region2 %>% 
      filter(withine==1)
    
    # Calculate root for each point in region3
    region3 <- region3 %>%
      mutate(bias = pmap_dbl(list(mydelta=delta,Rmax=Rmax,closest_bias=closest_bias),
                             selectroot, parameters = parameters)) %>%
      select(-c("distance","withine","closest_bias"))
    
    # Define region of points beyond epsilon from region1
    region4 <- region2 %>% 
      filter(withine==0) %>%
      select(c("delta","Rmax"))
    
    # Return list of regions 3 and 4
    return(list(region3,region4))
  }
}