tytell / fishmechr

https://tytell.github.io/fishmechr/
Creative Commons Attribution 4.0 International
0 stars 0 forks source link

primary swimming axis issue #1

Open hawkinso opened 1 month ago

hawkinso commented 1 month ago

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 data map(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:

Screen Shot 2024-08-09 at 12 02 06 PM
hawkinso commented 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) {

Default output column names

.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)

Ensure .frame and .point are specified and exist in the data

.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") }

Check for reasonableness of the centering

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?")
}

}

Compute the swimming axis

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 join to add computed columns to the original data

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

Screen Shot 2024-08-09 at 12 22 27 PM
tytell commented 1 month ago

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