Support different crs

DESCRIPTION

@@ -29,7 +29,7 @@ Suggests:
     magrittr
 LinkingTo: 
     cpp11
-RoxygenNote: 7.2.1
+RoxygenNote: 7.2.3
 Roxygen: list(markdown = TRUE)
 URL: https://github.com/thomasp85/transformr
 BugReports: https://github.com/thomasp85/transformr/issues

NAMESPACE

@@ -27,6 +27,7 @@ importFrom(sf,st_bbox)
 importFrom(sf,st_cast)
 importFrom(sf,st_centroid)
 importFrom(sf,st_combine)
+importFrom(sf,st_crs)
 importFrom(sf,st_distance)
 importFrom(sf,st_geometry)
 importFrom(sf,st_geometry_type)
@@ -41,6 +42,7 @@ importFrom(sf,st_polygon)
 importFrom(sf,st_sample)
 importFrom(sf,st_sfc)
 importFrom(sf,st_touches)
+importFrom(sf,st_transform)
 importFrom(sf,st_union)
 importFrom(sf,st_voronoi)
 importFrom(stats,runif)

NEWS.md

@@ -1,5 +1,7 @@
 # transformr (development version)
 
+* Fix a bug in `tween_sf()` when tweening simple features with different crs
+
 # transformr 0.1.4
 
 * Support lambda functions in `enter` and `exit` arguments (#6)

R/tween_sf.R

@@ -20,6 +20,7 @@
 #'
 #' @importFrom tweenr .complete_states .max_id .has_frames
 #' @importFrom rlang enquo
+#' @importFrom sf st_crs st_transform
 #' @export
 #'
 #' @examples
@@ -39,15 +40,35 @@ tween_sf <- function(.data, to, ease, nframes, id = NULL, enter = NULL, exit = N
   if (!is.data.frame(.data)) {
     stop('`.data` must be a `data.frame`', call. = FALSE)
   }
+  sf_columns <- vapply(.data, inherits, logical(1), 'sfc')
+  if (!any(sf_columns)) return(tween_state(.data, to, ease, nframes, !!id, enter, exit))
+
+  for (col in sf_columns) {
+    from_crs <- st_crs(.data[[col]])
+    to_crs <- st_crs(to[[col]])
+    if (is.na(from_crs)) {
+      if (!is.na(to_crs)) {
+        st_crs(.data[[col]]) <- to_crs
+      }
+      next
+    }
+    if (is.na(to_crs)) {
+      st_crs(to[[col]]) <- from_crs
+    } else {
+      to[[col]] <- st_transform(to[[col]], from_crs)
+    }
+  }
+
   from <- .get_last_frame(.data)
   from$.phase <- rep('raw', nrow(from))
   to$.phase <- rep('raw', nrow(to))
   to$.id <- rep(NA_integer_, nrow(to))
   id <- enquo(id)
   if (.has_frames(.data)) nframes <- nframes + 1
 
+  # recalc to make sure .phase and .id columns are included
   sf_columns <- vapply(from, inherits, logical(1), 'sfc')
-  if (!any(sf_columns)) return(tween_state(.data, to, ease, nframes, !!id, enter, exit))
+
   full_set <- .complete_states(from, to, id, enter, exit, .max_id(.data))
   to$.id <- full_set$orig_to
   sf_from <- full_set$from[, sf_columns, drop = FALSE]
@@ -73,7 +94,7 @@ tween_sf_col <- function(from, to, ease, nframes) {
     tweened$id <- as.integer(tweened$id)
     tweened$sf_id <- as.integer(tweened$sf_id)
     tweened$.frame <- as.integer(tweened$.frame)
-    st_sfc(repack_sf(tweened, aligned$type, as.integer(nframes)))
+    st_sfc(repack_sf(tweened, aligned$type, as.integer(nframes)), crs = st_crs(from[[i]]))
   })
 }