Open hawkinso opened 1 month ago
I actually think I got it? I adjusted the function a bit, the packages that are installed, ect... maybe this problem is just specific to my data or environment
get_primary_swimming_axis_df <- function(.data, t, x, y, .out = NULL, .frame = frame, .point = point, cutoff = NULL, overwrite = TRUE, check_reasonableness = TRUE) {
.out <- check.out(.data, .out, .out_default = c(swimaxis_x = "swimaxis_x", swimaxis_y = "swimaxis_y", exc_x = "exc_x", exc = "exc_y"), overwrite = overwrite)
.frame <- enquo(.frame) if (quo_is_null(.frame)) { assert_that(has_name(.data, as_name(.frame)), msg = "Default column 'frame' not present. Use .frame to specify the name of the frame column") }
.point <- enquo(.point) if (quo_is_null(.point)) { assert_that(has_name(.data, as_name(.point)), msg = "Default column 'point' not present. Use .point to specify the name of the point column") }
if (check_reasonableness) { centering <- .data %>% group_by(!! .frame) %>% summarize( xctr = mean({{ x }}, na.rm = TRUE), xsd = sd({{ x }}, na.rm = TRUE), yctr = mean({{ y }}, na.rm = TRUE), ysd = sd({{ y }}, na.rm = TRUE) ) %>% summarize( notcenterx = sum(xctr > xsd, na.rm = TRUE) / n(), notcentery = sum(yctr > ysd, na.rm = TRUE) / n() )
if (centering$notcenterx > 0.1 || centering$notcentery > 0.1) {
warning("Many frames seem not to be centered around zero. Did you remember to subtract the center of mass?")
}
}
swimaxis <- .data %>% group_by(!! .frame) %>% summarize( swimaxis = list(get_primary_swimming_axis({{ x }}, {{ y }})), t = first({{ t }}) ) %>% unnest_wider(swimaxis)
dt <- diff(swimaxis$t)[1]
if (!is.null(cutoff)) { filt <- build_filter(hi = cutoff, 1 / dt) swimaxis <- swimaxis %>% mutate( swimaxis_x0 = swimaxis_x, swimaxis_y0 = swimaxis_y ) %>% mutate(across(c(swimaxis_x, swimaxis_y), ~ apply_filter(filt, .))) %>% mutate( swimaxis_mag = sqrt(swimaxis_x^2 + swimaxis_y^2), across(c(swimaxis_x, swimaxis_y), ~ . / swimaxis_mag) ) %>% select(-swimaxis_mag) } else { swimaxis <- swimaxis %>% mutate( swimaxis_x0 = swimaxis_x, swimaxis_y0 = swimaxis_y ) }
swimaxis <- swimaxis %>% rename( !! .out[1] := swimaxis_x, !! .out[2] := swimaxis_y )
ab <- .data %>% ungroup() %>% select(!! .frame, !! .point, {{ x }}, {{ y }}) %>% left_join(swimaxis, by = rlang::as_name(.frame)) %>% mutate( !! .out[3] := {{ x }} swimaxis_x + {{ y }} swimaxis_y, !! .out[4] := -{{ y }} swimaxis_x + {{ x }} swimaxis_y ) %>% select(any_of(.out), !! .frame, !! .point)
final_result <- .data %>% select(-any_of(.out)) %>% left_join(ab, by = c(rlang::as_name(.frame), rlang::as_name(.point)))
return(final_result) }
This provided reasonable excursion values (centered around 0) and allowed for this graphical check which looks similar to the one in the vignette: (here I have chosen point 8, in your code you chose point 20 for your animal
So did you change the function itself? If so, create a branch, commit the change on that branch, then make a pull request and I'll take a look and integrate it with the main code.
Also send me your dataset
I am trying to extract excursion using get_primary_swimming_axis_df(), and it seems like there is a mismatch in data frame length. The data frame is set up similar to the example with points grouped by frame number. I have 928 total frames (and therefore 7424 rows), but the error suggests that it has a 4 row tibble that cannot be appended to the original data frame. The output should be appending four columns to the existing data frame that has the same length as the dataframe.
Here is the code:
dataInterp <- dataInterp |> mutate(xCM_ctr = xCM_s - xcom, yCM_ctr = yCM_s - ycom) |> get_primary_swimming_axis_df(t = Time,.point=Point, .frame = Frame, x = xCM_ctr, y = yCM_ctr)
Since I want it to return all four outputs, I did not specify the output. As a note, the xCM_ctr and yCM_ctr columns added just fine.
Here is the error message:
Error in
[[<-
: ! Assigned datamap(data[[col]], as_df, col = col)
must be compatible with existing data. ✖ Existing data has 928 rows. ✖ Assigned data has 4 rows.ℹ Only vectors of size 1 are recycled. Caused by error in
vectbl_recycle_rhs_rows()
: ! Can't recycle input of size 4 to size 928.I have the "tibble" package installed which I think is where vectbl_recycle_rhs_rows() comes from as well. I have also tried grouping by frame!
Here is what the original data frame looks like: