bv_analysis.qmd

# Loading packages
```{r}
library(tidyverse)
library(here)
```

## import data
We are importing two folders. One folder is the 'initial' folder which contains the contents of the unzipped folder that you upload to CVAT. The other folder is the 'completed' folder which contains the contents of the zipped folder that you export from CVAT. If you are only through a certain number of frames, please note that as well in the constant below.
```{r}
object_names_completed <- read_lines(here("data/completed/obj.names"))

object_data_completed <- read_lines(here("data/completed/obj.data"))

object_names_initial <- read_lines(here("data/initial/obj.names"))

object_data_initial <- read_lines(here("data/initial/obj.data"))

cdi_data <- read.csv(here("data/cdi_words.csv"))

# for future use!
total_frames_annotated <- 1000
```

```{r}
paste("Number of new detected objects:", length(object_names_completed)-length(object_names_initial))
```


```{r}
# Get all txt files from both directories
# add/remove /frames as needed after /obj_train_data
completed_files <- list.files(here("data/completed/obj_train_data/frames"), 
                               pattern = "\\.txt$", 
                               full.names = TRUE)

initial_files <- list.files(here("data/initial"), 
                            pattern = "\\.txt$", 
                            full.names = TRUE)


# Remove files ending with 'train.txt' from initial_files
initial_files <- initial_files[!grepl("train\\.txt$", initial_files)]

total_frames_annotated <- min(length(completed_files), total_frames_annotated)

completed_files <- completed_files[1:total_frames_annotated]
initial_files <- initial_files[1:total_frames_annotated]

# Function to parse a single file
parse_bbox_file <- function(file_path, source_dir) {
  # Read all lines from file
  lines <- read_lines(file_path)
  
  # Skip empty files
  if (length(lines) == 0) return(NULL)
  
  # Parse each line
  parsed <- map_dfr(lines, function(line) {
    values <- str_split(line, "\\s+")[[1]]
    tibble(
      object_id = as.integer(values[1]),
      x_center = as.numeric(values[2]),
      y_center = as.numeric(values[3]),
      width = as.numeric(values[4]),
      height = as.numeric(values[5])
    )
  })
  
  # Add filename and source directory
  parsed %>%
    mutate(
      filename = basename(file_path),
      source = source_dir,
      .before = 1
    )
}

# Parse all files from both directories
completed_data <- map_dfr(completed_files, 
                          ~parse_bbox_file(.x, "completed"))
initial_data <- map_dfr(initial_files, 
                        ~parse_bbox_file(.x, "initial"))
```

```{r}
# View the result
head(completed_data)
```

```{r}
# Add object names
completed_data <- completed_data %>%
  mutate(object_name = object_names_completed[object_id+1])
initial_data <- initial_data %>%
  mutate(object_name = object_names_initial[object_id+1])
```

```{r}
# Function to calculate IoU (Intersection over Union)
calculate_iou <- function(box1, box2) {
  # Convert from center format to corner format
  box1_x1 <- box1$x_center - box1$width / 2
  box1_y1 <- box1$y_center - box1$height / 2
  box1_x2 <- box1$x_center + box1$width / 2
  box1_y2 <- box1$y_center + box1$height / 2
  
  box2_x1 <- box2$x_center - box2$width / 2
  box2_y1 <- box2$y_center - box2$height / 2
  box2_x2 <- box2$x_center + box2$width / 2
  box2_y2 <- box2$y_center + box2$height / 2
  
  # Calculate intersection
  inter_x1 <- max(box1_x1, box2_x1)
  inter_y1 <- max(box1_y1, box2_y1)
  inter_x2 <- min(box1_x2, box2_x2)
  inter_y2 <- min(box1_y2, box2_y2)
  
  inter_width <- max(0, inter_x2 - inter_x1)
  inter_height <- max(0, inter_y2 - inter_y1)
  inter_area <- inter_width * inter_height
  
  # Calculate union
  box1_area <- box1$width * box1$height
  box2_area <- box2$width * box2$height
  union_area <- box1_area + box2_area - inter_area
  
  # IoU
  if (union_area == 0) return(0)
  return(inter_area / union_area)
}

# Match boxes between initial and completed
match_boxes <- function(filename_base) {
  init <- initial_data %>% filter(filename == filename_base)
  comp <- completed_data %>% filter(filename == filename_base)
  
  if (nrow(init) == 0 | nrow(comp) == 0) return(NULL)
  
  # For each completed box, find best matching initial box
  matches <- map_dfr(1:nrow(comp), function(i) {
    comp_box <- comp[i, ]
    
    if (nrow(init) == 0) {
      return(tibble(
        filename = filename_base,
        completed_id = i,
        initial_id = NA,
        #comp_object_id = comp_box$object_id,
        object_name = comp_box$object_name,
        iou = 0,
        matched = FALSE
      ))
    }
    
    # Calculate IoU with all initial boxes of same class
    ious <- map_dbl(1:nrow(init), function(j) {
      if (init$object_name[j] == comp_box$object_name) {
        calculate_iou(comp_box, init[j, ])
      } else {
        0
      }
    })
    
    best_match <- which.max(ious)
    best_iou <- ious[best_match]
    
    tibble(
      filename = filename_base,
      completed_id = i,
      initial_id = if(best_iou > 0) best_match else NA,
      object_name = comp_box$object_name,
      iou = best_iou,
      matched = best_iou >= 0.9  # 90% overlap threshold
    )
  })
  
  # Find initial boxes that weren't matched (false negatives)
  matched_initial <- matches %>% filter(!is.na(initial_id)) %>% pull(initial_id)
  unmatched_initial <- setdiff(1:nrow(init), matched_initial)
  
  fn_rows <- map_dfr(unmatched_initial, function(i) {
    tibble(
      filename = filename_base,
      completed_id = NA,
      initial_id = i,
      object_id = init$object_id[i],
      object_name = init$object_name[i],
      iou = 0,
      matched = FALSE
    )
  })
  
  bind_rows(matches, fn_rows)
}
```

```{r}
# Get all unique filenames
all_filenames <- unique(c(completed_data$filename, initial_data$filename))

# Match all files
all_matches <- map_dfr(all_filenames, match_boxes)

# Calculate metrics per file
file_metrics <- all_matches %>%
  group_by(filename) %>%
  summarise(
    true_positives = sum(!is.na(completed_id) & matched),
    false_negatives = sum(!is.na(completed_id) & !matched),
    false_positives = sum(is.na(completed_id)),
    total_completed = sum(!is.na(completed_id)),
    total_initial = sum(!is.na(initial_id)),
    mean_iou = mean(iou[iou > 0], na.rm = TRUE)
  ) %>%
  mutate(
    precision = true_positives / (true_positives + false_positives),
    recall = true_positives / (true_positives + false_negatives),
    f_score = 2 * (precision * recall) / (precision + recall),
    precision = ifelse(is.nan(precision), 0, precision),
    recall = ifelse(is.nan(recall), 0, recall),
    f_score = ifelse(is.nan(f_score), 0, f_score)
  )

# Overall summary metrics
overall_metrics <- all_matches %>%
  summarise(
    true_positives = sum(!is.na(completed_id) & matched),
    false_negatives = sum(!is.na(completed_id) & !matched),
    false_positives = sum(is.na(completed_id))
  ) %>%
  mutate(
    precision = true_positives / (true_positives + false_positives),
    recall = true_positives / (true_positives + false_negatives),
    f_score = 2 * (precision * recall) / (precision + recall),
    accuracy = true_positives / (true_positives + false_positives + false_negatives)
  )

class_metrics <- all_matches %>%
  group_by(object_name) %>%
  summarise(
    true_positives = sum(!is.na(completed_id) & matched),
    false_negatives = sum(!is.na(completed_id) & !matched),
    false_positives = sum(is.na(completed_id)),
    count = n(),
    completed_count = sum(!is.na(completed_id)),
    initial_count = sum(!is.na(initial_id)),
  ) %>%
  filter(initial_count >= 1) |>
  mutate(
    precision = true_positives / (true_positives + false_positives),
    recall = true_positives / (true_positives + false_negatives),
    f_score = 2 * (precision * recall) / (precision + recall),
    f_score = ifelse(is.nan(f_score), 0, f_score)
  ) %>%
  arrange(desc(f_score))

# Save results
#class_metrics <- class_metrics |> filter(!is.na(recall))
write_csv(file_metrics, here("output/file_metrics.csv"))
write_csv(class_metrics, here("output/class_metrics.csv"))
write_csv(all_matches, here("output/detailed_matches.csv"))
```

# summary stats
```{r}
summarized_class_metrics <- class_metrics |>
  summarize(precision = mean(precision, na.rm = TRUE),
            recall =mean(recall, na.rm = TRUE),
            f_score = mean(f_score, na.rm=TRUE),
            n = n())

cat("\n=== OVERALL METRICS ===\n")
cat("Total categories:", summarized_class_metrics$n)
cat(sprintf("\nPrecision: %.3f\n", summarized_class_metrics$precision))
#cat(sprintf("Recall: %.3f\n", summarized_class_metrics$recall))
#cat(sprintf("F-Score: %.3f\n", summarized_class_metrics$f_score))
```

## fun plots
```{r}
# Plot: Distribution of Intersection over Union scores
p1 <- all_matches %>%
  filter(!is.na(completed_id), iou > 0) %>%
  ggplot(aes(x = iou)) +
  geom_histogram(bins = 50, fill = "steelblue", alpha = 0.7) +
  geom_vline(xintercept = 0.9, color = "red", linetype = "dashed", size = 1) +
  labs(title = "Distribution of IoU Scores",
       subtitle = "Red line shows 90% threshold",
       x = "IoU Score",
       y = "Count") +
  theme_minimal()

# Plot: F-Score distribution per class
p2 <- class_metrics %>%
  ggplot(aes(x = precision)) +
  geom_histogram(bins = 30, fill = "forestgreen", alpha = 0.7) +
  labs(title = "F-Score Distribution Across Classes",
       x = "F-Score",
       y = "Count") +
  theme_minimal()

# Plot: Precision vs Recall
p3 <- class_metrics %>%
  ggplot(aes(x = recall, y = precision)) +
  geom_jitter(alpha = 0.5, color = "purple", width=0.05) +
  geom_abline(slope = 1, intercept = 0, linetype = "dashed", color = "gray") +
  labs(title = "Precision vs Recall per class",
       x = "Recall",
       y = "Precision") +
  theme_minimal() +
  coord_fixed()

p4 <- class_metrics %>%
  ggplot(aes(x = reorder(object_name, precision), y = precision)) +
  geom_col(fill = "coral") +
  coord_flip() +
  labs(title = "Precision by Object Class",
       x = "Object Class",
       y = "Precision") +
  theme_minimal()
```

# Display plots
```{r}
print(p1)
print(p2)
print(p3)
print(p4)
ggsave(here("output/precision_class.png"), width=5, height=12, bg="white")
```
# Prettier precision vs recall
```{r}
class_metrics_with_cdi <- class_metrics |> left_join(cdi_data, by=c("object_name"="uni_lemma"))

ggplot(data=class_metrics_with_cdi |> filter(completed_count >= 3), aes(x=recall, y=precision)) +
  geom_jitter(alpha=0.6, aes(size=completed_count, color=is_animate)) + 
  geom_abline(slope = 1, intercept = 0, linetype = "dashed", color = "gray") +
  #ggrepel::geom_label_repel(aes(label=object_name)) +
  xlim(0, 1) +
  ylim(0, 1)
```

## class-wise precision summaries
```{r}
class_metrics_with_cdi <- class_metrics |> left_join(cdi_data, by=c("object_name"="uni_lemma"))

summarized_data <- function(data, x_var, y_var, group_var) {
  return(data |>
           group_by(across(all_of(c(x_var, group_var)))) |>
           summarize(
             #across(everything(), ~ if (n_distinct(.) == 1) first(.) else NA),
             mean_value = mean(.data[[y_var]], na.rm = TRUE),
             sd_value = sd(.data[[y_var]], na.rm = TRUE),
             N = n(),
             se = sd_value / sqrt(n()),
             ci=qt(0.975, N-1)*sd_value/sqrt(N),
             lower_ci=mean_value-ci,
             upper_ci=mean_value+ci,
             .groups = 'drop') |>
           select(where(~ !all(is.na(.))))
  )
}

class_metrics_summarized <- summarized_data(class_metrics_with_cdi, "category", "precision", "category") |> filter(N > 5)

p5 <- class_metrics_summarized %>%
  ggplot(aes(x = reorder(category, mean_value), y = mean_value)) +
  geom_point() +
  geom_errorbar(aes(ymin=lower_ci, ymax=upper_ci)) +
  labs(title = "Precision by Object Category",
       x = "Object Category",
       y = "Precision") +
  theme_minimal()
p5
ggsave(here("output/precision_category.png"), p5, width=10, height=5, bg="white")
```
Send the overall precision results, the class-wise precision plot, the precision by object-category plot, and the class_metrics.csv file in the channel! Feel free to make more plots and run more analyses.