library(dplyr)
##
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
##
## filter, lag
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
library(tidyr)
library(stringr)
library(lme4)
## Loading required package: Matrix
##
## Attaching package: 'Matrix'
## The following objects are masked from 'package:tidyr':
##
## expand, pack, unpack
library(lmerTest)
##
## Attaching package: 'lmerTest'
## The following object is masked from 'package:lme4':
##
## lmer
## The following object is masked from 'package:stats':
##
## step
library(readxl)
library(ggplot2)
#Automatic Pig Detection and Tracking Using Open-Source Zero-Shot Learning Tools
# propose five titles.
#detection for 1400 images ==> why remove stacking, why daytime.
#automatic detection + tracking
#Results of tracking
# Compare type of errors in individually or group.
# More activities in pen, more tracking error.
ToBeLabelled_ELAN_labelledbyYB_20240221 <- read_excel("../GSAM2_output/ToBeLabelled_ELAN_labelledbyYB_20240221.xlsx")
label_0221 = ToBeLabelled_ELAN_labelledbyYB_20240221[,1:14]
ToBeLabelled_ELAN_labeledbyYB_20240223 <- read_excel("../GSAM2_output/ToBeLabelled_ELAN_labeledbyYB_20240223.xlsx")
## New names:
## • `` -> `...16`
## • `` -> `...17`
## • `` -> `...18`
## • `` -> `...19`
label_0223 = ToBeLabelled_ELAN_labeledbyYB_20240223[,1:14]
labels = rbind.data.frame(label_0221,
label_0223)
dim(labels)
## [1] 4925 14
table(labels$`Stacking or not for pig` == 'x')
##
## TRUE
## 2522
# Define the function
extract_info_func <- function(input_string) {
library(stringr)
camera <- str_extract(input_string, "^[^_]+")
date <- str_extract(input_string, "\\d{8}")
hour <- str_extract(input_string, "(?<=\\d{8})\\d{2}")
return(c(camera = camera, date = date, hour = hour))
}
# Apply the function and add new columns
library(stringr)
labels <- labels %>%
rowwise() %>%
mutate(info = list(extract_info_func(`Camera Number`))) %>%
unnest_wider(info) %>%
filter(!str_starts(`Pig Number`, "Out")) %>%
filter(`Pig Number` != 'Else')
labels$video_unit = paste0(labels$Date,"_", labels$`Camera Number`, "_", labels$Time)
## duplicated_label
#Remove the duplicated labels happened due to incorrect mask, cover two pigs or ID switch to existed pig.
library(dplyr)
labels <- labels %>%
group_by(video_unit, `Pig Number`) %>%
mutate(
dup_count = if_else(`Pig Number` != "?", n(), NA_integer_), # count how many times each appears
duplicated_score = if_else(!is.na(dup_count) & dup_count > 1, 1 / dup_count, 0), # assign 1/n if duplicated
`Duplicated label` = if_else(
`Pig Number` != "?" & dup_count > 1,
"x",
NA_character_
)
) %>%
ungroup()
labels$stack = ifelse(is.na(labels$`Stacking or not for pig`), 0, 1)
labels$incorrect_mask = ifelse(is.na(labels$`Incorrect mask`), 0, 1)
# labels$duplicated_label = ifelse(is.na(labels$`Duplicated label`), 0, 1)
labels$id_switch = ifelse(is.na(labels$`ID switch`), 0, 1)
labels$lost_track = ifelse(is.na(labels$`Lost track`), 0, 1)
#generate video pile challenage column.
labels = labels %>% group_by(Date, `Camera Number`, Time) %>% mutate(pile = ifelse(sum(stack), 1, 0))
Tracking unit
summary_table <- labels %>%
filter(stack == 0) %>% # not stacking for each track
group_by(Date) %>%
summarise(
number_of_record = n(),
correct_track = sum(incorrect_mask == 0 &
duplicated_score == 0 &
id_switch == 0 &
lost_track == 0, na.rm = TRUE),
ratio_correct = round(correct_track / number_of_record * 100, 2),
se_ratio_correct = round(sqrt((ratio_correct / 100) * (1 - (ratio_correct / 100)) / number_of_record) * 100, 2),
ratio_se_format = paste(ratio_correct, "±", se_ratio_correct)
)
summary_table
## # A tibble: 2 × 6
## Date number_of_record correct_track ratio_correct se_ratio_correct
## <dbl> <int> <int> <dbl> <dbl>
## 1 20240221 1313 1148 87.4 0.91
## 2 20240223 945 789 83.5 1.21
## # ℹ 1 more variable: ratio_se_format <chr>
library(dplyr)
library(tidyr)
# Compute per-date statistics
summary_table <- labels %>%
filter(stack == 0) %>%
group_by(Date) %>%
summarise(
number_of_record = n(),
incorrect_mask = paste(
round(sum(incorrect_mask) / number_of_record * 100, 2), "±",
round(sqrt((sum(incorrect_mask) / number_of_record) *
(1 - (sum(incorrect_mask) / number_of_record)) /
number_of_record) * 100, 2)
),
duplicated_score = paste(
round(sum(duplicated_score) / number_of_record * 100, 2), "±",
round(sqrt((sum(duplicated_score) / number_of_record) *
(1 - (sum(duplicated_score) / number_of_record)) /
number_of_record) * 100, 2)
),
id_switch = paste(
round(sum(id_switch) / number_of_record * 100, 2), "±",
round(sqrt((sum(id_switch) / number_of_record) *
(1 - (sum(id_switch) / number_of_record)) /
number_of_record) * 100, 2)
),
lost_track = paste(
round(sum(lost_track) / number_of_record * 100, 2), "±",
round(sqrt((sum(lost_track) / number_of_record) *
(1 - (sum(lost_track) / number_of_record)) /
number_of_record) * 100, 2)
)
)
summary_table
## # A tibble: 2 × 6
## Date number_of_record incorrect_mask duplicated_score id_switch lost_track
## <dbl> <int> <chr> <chr> <chr> <chr>
## 1 20240221 1313 6.78 ± 0.69 3.2 ± 0.49 2.51 ± 0… 0.46 ± 0.…
## 2 20240223 945 9.1 ± 0.94 4.07 ± 0.64 2.12 ± 0… 0.21 ± 0.…
Observation unit
labels_ob_unit <- labels %>%
# filter(stack == 0) %>%
group_by(Date, `Camera Number`, Time) %>%
summarise(
n_stack = sum(stack),
n_active_track = n(),
incorrect_mask = sum(incorrect_mask),
duplicated_score = sum(duplicated_score),
id_switch = sum(id_switch),
lost_track = sum(lost_track),
correct_track = sum(incorrect_mask==0 & duplicated_score == 0 & id_switch == 0 & lost_track == 0),
.groups = 'drop' # Prevents retaining the grouping structure after summarization
)
labels_ob_unit <- labels_ob_unit %>%
rowwise() %>%
mutate(info = list(extract_info_func(`Camera Number`))) %>%
unnest_wider(info)
# View(labels_ob_unit)
labels_ob_unit$pile <- labels_ob_unit %>%
group_by(Date, `Camera Number`, Time) %>%
mutate(pile = if_else(n_stack != 0, 1, 0)) %>%
pull(pile)
labels_ob_unit %>% group_by(Date) %>% summarise(record_num = n(),
stack_num = sum(n_stack != 0),#if stack exists
all_stack_num = sum(n_stack/n_active_track==1),#if all pigs stack
stack_size_avg = round(mean(n_stack),2),#average stack size
detected_pig_size_avg = round(mean(n_active_track),2),#average detected pig
# incorrect_mask_percent = round(mean(incorrect_mask/n_active_track*100),2),
# duplicated_label_percent = round(mean(duplicated_label/n_active_track)*100,2),
# id_switch_percent = round(mean(id_switch/n_active_track)*100,2),
# lost_track_percent = round(mean(lost_track/n_active_track)*100,2)
)
## # A tibble: 2 × 6
## Date record_num stack_num all_stack_num stack_size_avg detected_pig_size_avg
## <dbl> <int> <int> <int> <dbl> <dbl>
## 1 2.02e7 308 237 85 4.21 8.47
## 2 2.02e7 235 205 62 5.2 9.22
table(labels_ob_unit$Date, labels_ob_unit$n_stack == 0) #number of videos with piled pigs.
##
## FALSE TRUE
## 20240221 237 71
## 20240223 205 30
summary_table_ob <- labels_ob_unit %>%
filter(n_stack/n_active_track != 1) %>%
# filter(n_stack == 0) %>%
group_by(Date) %>%
summarise(
number_of_record = n(),
correct_num = sum(correct_track),
ratio_correct = sum(correct_track) / number_of_record,
se_ratio_correct = sqrt(ratio_correct * (1 - ratio_correct) / number_of_record),
ratio_se_correct = paste0(
round(ratio_correct * 100, 2), " ± ", round(se_ratio_correct * 100, 2)
)
)
summary_table_ob
## # A tibble: 2 × 6
## Date number_of_record correct_num ratio_correct se_ratio_correct
## <dbl> <int> <int> <dbl> <dbl>
## 1 20240221 223 75 0.336 0.0316
## 2 20240223 173 39 0.225 0.0318
## # ℹ 1 more variable: ratio_se_correct <chr>
## ratio of stacking in videos
# Compute per-date statistics
summary_table <- labels_ob_unit %>%
filter(n_stack/n_active_track != 1) %>% #remove the videos with all pigs
group_by(Date) %>%
summarise(
number_of_record = n(),
incorrect_mask = paste(
round(sum(incorrect_mask !=0) / number_of_record * 100, 2), "±",
round(sqrt((sum(incorrect_mask!=0) / number_of_record) *
(1 - (sum(incorrect_mask!=0) / number_of_record)) /
number_of_record) * 100, 2)
),
duplicated_score = paste(
round(sum(duplicated_score!=0) / number_of_record * 100, 2), "±",
round(sqrt((sum(duplicated_score!=0) / number_of_record) *
(1 - (sum(duplicated_score!=0) / number_of_record)) /
number_of_record) * 100, 2)
),
id_switch = paste(
round(sum(id_switch) / number_of_record * 100, 2), "±",
round(sqrt((sum(id_switch!=0) / number_of_record) *
(1 - (sum(id_switch!=0) / number_of_record)) /
number_of_record) * 100, 2)
),
lost_track = paste(
round(sum(lost_track) / number_of_record * 100, 2), "±",
round(sqrt((sum(lost_track!=0) / number_of_record) *
(1 - (sum(lost_track!=0) / number_of_record)) /
number_of_record) * 100, 2)
)
)
summary_table
## # A tibble: 2 × 6
## Date number_of_record incorrect_mask duplicated_score id_switch lost_track
## <dbl> <int> <chr> <chr> <chr> <chr>
## 1 20240221 223 61.88 ± 3.25 21.52 ± 2.75 30.49 ± … 4.04 ± 1.…
## 2 20240223 173 73.41 ± 3.36 24.28 ± 3.26 19.08 ± … 1.73 ± 0.…
Statistical Analysis
Incorrect Mask
Duplicated label
Id switch
Lost track