Analysis of poult locomotion

using apriltags

These Knitr Options are for appearance only

Setup Code

#====================================================================#
# Setup Options
#====================================================================#

# remove all objects if restarting script
rm(list=ls())

# set tibble width for printing
options(tibble.width = Inf)



# remove scientific notation
options(scipen=999)

#==============================================================================#
# Install Packages / Load Packages
#==============================================================================#

library(tidyverse)

── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
✔ dplyr     1.1.4     ✔ readr     2.1.5
✔ forcats   1.0.1     ✔ stringr   1.5.2
✔ ggplot2   4.0.0     ✔ tibble    3.3.0
✔ lubridate 1.9.4     ✔ tidyr     1.3.1
✔ purrr     1.1.0     
── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
✖ dplyr::filter() masks stats::filter()
✖ dplyr::lag()    masks stats::lag()
ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors

library(dplyr)
library(lubridate)
library(readxl) #install if needed
library(ggplot2)
library(ggpubr)

Warning: package 'ggpubr' was built under R version 4.5.3

library(png)

Warning: package 'png' was built under R version 4.5.3

#==============================================================================#
# Set paths
#==============================================================================#

# set all paths
path_main    <- "C:/Users/jsteibel/OneDrive/Documents/python/ArUco/Tag/"
path_data    <- str_c(path_main, "", sep="")

# str_c() is from the stringr package, which is a part of 'tidyverse'
# this concatenates two pieces of the path. We will use it a lot.

#check:
path_data

[1] "C:/Users/jsteibel/OneDrive/Documents/python/ArUco/Tag/"

Data

Data were provided by tracking program

#==============================================================================#
# Set Inputs
#==============================================================================#

# data file name
video_1 <- "apriltag_window_per_tag_log_20260502_104622_1s.csv"
video_2 <- "apriltag_window_per_tag_log_20260502_181147_1s.csv"

full_file_path_1<-str_c(path_data, video_1)
full_file_path_2<-str_c(path_data, video_2)

#check if the path is ok:
full_file_path_1

[1] "C:/Users/jsteibel/OneDrive/Documents/python/ArUco/Tag/apriltag_window_per_tag_log_20260502_104622_1s.csv"

full_file_path_2

[1] "C:/Users/jsteibel/OneDrive/Documents/python/ArUco/Tag/apriltag_window_per_tag_log_20260502_181147_1s.csv"

dt1<-read_csv(full_file_path_1)%>%
  mutate(tag_id=as.factor(tag_id),
         avg_cx_px=avg_cx_px,avg_cy_px=2160-avg_cy_px)

Rows: 137 Columns: 12
── Column specification ────────────────────────────────────────────────────────
Delimiter: ","
dbl  (8): frame_start, frame_end, tag_id, detections, avg_cx_px, avg_cy_px, ...
lgl  (2): avg_distance_m, std_distance_m
dttm (2): window_start_iso, window_end_iso

ℹ Use `spec()` to retrieve the full column specification for this data.
ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.

dt2<-read_csv(full_file_path_2)%>%
  mutate(tag_id=as.factor(tag_id),
         avg_cx_px=avg_cx_px,avg_cy_px=2160-avg_cy_px)

Rows: 724 Columns: 12
── Column specification ────────────────────────────────────────────────────────
Delimiter: ","
dbl  (8): frame_start, frame_end, tag_id, detections, avg_cx_px, avg_cy_px, ...
lgl  (2): avg_distance_m, std_distance_m
dttm (2): window_start_iso, window_end_iso

ℹ Use `spec()` to retrieve the full column specification for this data.
ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.

Summary of tracking task

let’s look at what was tracked, detection rates, etc.

frames<-c( max(dt1$frame_end), max(dt2$frame_end))
seconds<-frames/30
video=1:2
detec_b1<-c(filter(dt1,tag_id==1)%>%select(detections)%>%sum(),filter(dt2,tag_id==1)%>%select(detections)%>%sum())
detec_b0<-c(filter(dt1,tag_id==0)%>%select(detections)%>%sum(),filter(dt2,tag_id==0)%>%select(detections)%>%sum())

sec_d_1<-c(filter(dt1,tag_id==1)%>%nrow(),filter(dt2,tag_id==1)%>%nrow())
sec_d_0<-c(filter(dt1,tag_id==0)%>%nrow(),filter(dt2,tag_id==0)%>%nrow())


tibble(video,frames,seconds,detec_b1,detec_b0,sec_d_1,sec_d_0)%>%
  mutate(per_fr_1=detec_b1/frames,per_fr_0=detec_b0/frames,
         per_sec_1=sec_d_1/seconds,per_sec_0=sec_d_0/seconds)

# A tibble: 2 × 11
  video frames seconds detec_b1 detec_b0 sec_d_1 sec_d_0 per_fr_1 per_fr_0
  <int>  <dbl>   <dbl>    <dbl>    <dbl>   <int>   <int>    <dbl>    <dbl>
1     1   2772    92.4     1275     1709      54      71    0.460    0.617
2     2  12361   412.      8628    10381     339     381    0.698    0.840
  per_sec_1 per_sec_0
      <dbl>     <dbl>
1     0.584     0.768
2     0.823     0.925

For video 1: bird 1 was detected in 46% of frames and 58% of seconds. bird 0 was detected in 61% of frames and 77% of seconds For video 2: bird 1 was detected in 70% of frames and 82% of seconds. bird 0 was detected in 84% of frames and 92% of seconds

These results indicate that detecting tags is possible at the current video resolution, field of view and tag size. There are also frequent non-detection (from 54% to 16% on a per-frame basis). On a per second basis, the detection improves as there are 30 instances per seconds where the id can be read.

Inspection of tracking video hints at blurry tags due to birds running and occluded tags as the main reasons for not detecting the birds

Bird tracks displayed

Note: alignment of tracks with background image is approximate and only for illustrative purposes.

img2<-readPNG(source = "apriltag_snapshot_20260502_181147.png")
img1<-readPNG(source = "apriltag_snapshot_20260502_104622.png")

dt2%>%arrange(tag_id,frame_start)%>%
  ggplot(aes(x=avg_cx_px,y=avg_cy_px,color=tag_id))+
  background_image(img2) +
  geom_point()+
  geom_path()+
  xlim(0,3840)+ylim(0,2160)

Warning: Removed 1 row containing missing values or values outside the scale range
(`geom_point()`).

Warning: Removed 1 row containing missing values or values outside the scale range
(`geom_path()`).

dt1%>%arrange(tag_id,frame_start)%>%
  ggplot(aes(x=avg_cx_px,y=avg_cy_px,color=tag_id))+
  background_image(img1) +
  geom_point()+
  geom_path()+
  xlim(0,3840)+ylim(0,2160)

Warning: Removed 10 rows containing missing values or values outside the scale range
(`geom_point()`).

Warning: Removed 10 rows containing missing values or values outside the scale range
(`geom_path()`).

Total distance traveled by bids

total distance traveled is affected by varying video lengths.

dt1%>%arrange(tag_id,frame_start)%>%
  group_by(tag_id)%>%mutate(next_x=lead(avg_cx_px),
                             next_y=lead(avg_cy_px),
                             dst=sqrt((next_x-avg_cx_px)^2+
                                        (next_y-avg_cy_px)^2))%>%
  summarize(mdt=mean(detections,na.rm=T),
                                stdt=sd(detections,na.rm = T),
                                tdt=sum(dst,na.rm = T))

# A tibble: 5 × 4
  tag_id   mdt  stdt   tdt
  <fct>  <dbl> <dbl> <dbl>
1 0       24.1  7.58 1719.
2 1       23.6  9.48 3345.
3 130      1   NA       0 
4 223      1   NA       0 
5 <NA>     0    0       0 

dt2%>%arrange(tag_id,frame_start)%>%
  group_by(tag_id)%>%mutate(next_x=lead(avg_cx_px),
                             next_y=lead(avg_cy_px),
                             dst=sqrt((next_x-avg_cx_px)^2+
                                        (next_y-avg_cy_px)^2))%>%
  summarize(mdt=mean(detections,na.rm=T),
                                stdt=sd(detections,na.rm = T),
                                tdt=sum(dst,na.rm = T))

# A tibble: 6 × 4
  tag_id   mdt  stdt   tdt
  <fct>  <dbl> <dbl> <dbl>
1 0       27.2  6.50 7128.
2 1       25.5  8.49 7698.
3 468      1   NA       0 
4 501      1   NA       0 
5 585      1   NA       0 
6 <NA>     0   NA       0 

Conclusions

April tags of the presented size (25 mm) can be reliably detected with the current setup. Detection rate will depend on occlusion and blurriness. But this provides a good approximation to total distance traveled, as long as per-second detection is maintained at the current levels.

False detections are very rare.

Improving detection rate will require either better illumination or better camera (higher frame rate and resolution)

At high frame rate and high resolution, processing time will slow down.

Separate experimetns will be run for assessing speed with different hardware.