ropensci / stplanr

Sustainable transport planning with R
https://docs.ropensci.org/stplanr
Other
419 stars 66 forks source link

rnet merge function can't not handle attributes containing strings #554

Closed wangzhao0217 closed 6 months ago

wangzhao0217 commented 8 months ago

draft:

rnet_merge_str = function(rnet_x, rnet_y, dist = 5, funs = NULL, crs = geo_select_aeq(rnet_x), ...) {
  # Identify string columns in rnet_y
  string_cols = sapply(rnet_y, is.character)

  # Initialize funs for string columns if it is NULL
  if (is.null(funs)) {
    funs = list()
    string_col_names = names(rnet_y)[string_cols]
    for (col in string_col_names) {
      # Default behavior for string columns: concatenating unique values
      funs[[col]] = function(x) paste(unique(x), collapse = ", ")
    }
  }

  # Join the route networks using rnet_join
  rnetj = rnet_join(rnet_x, rnet_y, dist = dist, crs = crs, ...)
  rnetj_df = sf::st_drop_geometry(rnetj)

  # Apply functions to string columns as specified in funs
  res_list = lapply(names(funs), function(nm) {
    if (string_cols[nm]) {
      fn = funs[[nm]]
      res = rnetj_df %>%
        dplyr::group_by_at(1) %>%
        dplyr::summarise(dplyr::across(dplyr::all_of(nm), fn))
      names(res)[2] = nm
      return(res)
    }
    NULL  # Return NULL for non-string columns
  })
  res_list = Filter(Negate(is.null), res_list)  # Remove NULL elements

  # Combine the results into a single data frame
  res_df = dplyr::bind_cols(res_list)

  # Join the results with the original rnet_x geometry
  res_sf = dplyr::left_join(rnet_x, res_df)

  return(res_sf)
}

# Example usage of the function
funs = list(road_name = function(x) paste(unique(x), collapse = ", "))
rnet_merged = rnet_merge(rnet_x, rnet_y, funs = funs)
Robinlovelace commented 8 months ago

Thanks for this @wangzhao0217 I plan to give it a test...