# helper function to create polygons
generate.polygon <- function(trial) {
polygons <- c()
for (bb in 1:nrow(trial)) {
# bb coords: x,y,w,h -> always clockwise
pointsx <-
c(
trial$bb_x[bb],
(trial$bb_x[bb] + trial$bb_w[bb]),
(trial$bb_x[bb] + trial$bb_w[bb]),
trial$bb_x[bb]
)
pointsy <- c(
trial$bb_y[bb],
trial$bb_y[bb],
(trial$bb_y[bb] - trial$bb_h[bb]),
(trial$bb_y[bb] - trial$bb_h[bb])
)
poly <- data.frame(x = pointsx, y = pointsy)
poly$identifier <- trial$objectLabel[bb]
poly$org_label <- trial$objectOrigLabel[bb] #shorter names
polygons <- rbind(polygons, poly)
}
return(polygons)
}
Load fixation data & bounding box coordinates
# load fixation data table
load("./tell_me_more/IDS145_FreeView/results/resultsFix_postprocessed_final.Rda")
# choose the subject & trial to visualize
subNo <- 16 #sample(unique(resultsFix$sub), 1)
trialNo <- 28 #sample(1:length(unique(resultsFix$trial), 1)
# subset the specific trial
fixTrial <- subset(resultsFix, sub == subNo & trial == trialNo)
# mark the first & last fixation coordinates
fixTrial <- fixTrial %>% mutate(xend = c(xp[2:nrow(fixTrial)], xp[nrow(fixTrial)]),
yend = c(yp[2:nrow(fixTrial)], yp[nrow(fixTrial)]) )
firstPoint <- c(fixTrial$xp[1], fixTrial$yp[1])
# filter unused columns
fixTrial <- fixTrial %>% select(c("xp", "yp", "objectLabel", "objectOrigLabel", "bb_x", "bb_y",
"bb_w", "bb_h", "file_name", "xend", "yend"))
head(fixTrial)
## xp yp objectLabel objectOrigLabel bb_x bb_y bb_w bb_h
## 61751 232.0 336.0 73: plates plate 227 357 70 29
## 61752 197.2 264.5 64: shelves shelf 3 442 352 438
## 61753 48.0 77.8 64: shelves shelf 3 442 352 438
## 61754 144.0 193.2 64: shelves shelf 3 442 352 438
## 61755 113.0 260.5 64: shelves shelf 3 442 352 438
## 61756 224.2 263.2 66: flowerpot flowerpot 214 315 99 76
## file_name xend yend
## 61751 ADE_train_00010650.jpg 197.2 264.5
## 61752 ADE_train_00010650.jpg 48.0 77.8
## 61753 ADE_train_00010650.jpg 144.0 193.2
## 61754 ADE_train_00010650.jpg 113.0 260.5
## 61755 ADE_train_00010650.jpg 224.2 263.2
## 61756 ADE_train_00010650.jpg 151.5 260.5
Generate polygons for bb visualization: The table should contain 4
points for each bb
ann <- generate.polygon(fixTrial)
imgPath <- paste("./tell_me_more/IDS145_FreeView/exp_images",fixTrial$file_name[1], sep="/")
img <- load.image(imgPath)
head(ann)
## x y identifier org_label
## 1 227 357 73: plates plate
## 2 297 357 73: plates plate
## 3 297 328 73: plates plate
## 4 227 328 73: plates plate
## 5 3 442 64: shelves shelf
## 6 355 442 64: shelves shelf
Plot bounding boxes & object labels on the image
plot_anno <- ggplot(data = ann, aes(x=x, y=y, group=identifier))+ #,color=identifier
background_image(img)+
geom_polygon(alpha=.3, linewidth = 2, colour = "red")+
coord_fixed(xlim=c(0, dim(img)[1]), ylim=c(0, dim(img)[2]), expand=FALSE)+
scale_color_manual(values=cols)+
theme(legend.position="none") +
theme(legend.title=element_blank()) +
geom_textbox(data = fixTrial, aes(x=bb_x, y=bb_y, label=objectOrigLabel),
nudge_x = 75,
nudge_y = -10,
box.padding = unit(c(1, 1, 1, 1), "pt"),
box.margin = unit(c(1, 1, 1, 1), "pt"),
box.r = unit(3, "pt"),
width = unit(1, "inch"),
inherit.aes=FALSE,
alpha=7, size=4, color="black") +
theme(axis.text.x = element_blank(), axis.text.y = element_blank(),
axis.title.x = element_blank(), axis.title.y = element_blank(),
axis.ticks.x = element_blank(), axis.ticks.y = element_blank()) +
ggtitle(paste0("Subject", subNo, "-", "Trial", trialNo))
plot_anno
Plot fixation scanpath overlaid on the object labels
plot_spath <- plot_anno + geom_segment(data=fixTrial, aes(x=xp, y=yp, xend=xend, yend=yend),
lineend="round", arrow=arrow(length = unit(0.3, "cm"), type= "closed"),
arrow.fill="black",
alpha=1, linewidth=1, color="green", linetype=1, inherit.aes = FALSE) +
geom_point(data = fixTrial, aes(x=xp, y=yp),
color="green", size=7, alpha=5, shape=1, inherit.aes = FALSE) +
geom_point(aes(x=firstPoint[1], y = firstPoint[2]), color="yellow", size=7, shape = 21, fill="yellow") +
geom_point(aes(x=fixTrial$xend[nrow(fixTrial)], y = fixTrial$yend[nrow(fixTrial)]),
color="blue", size=7, shape = 21, fill="blue")
plot_spath
Plot fixation heatmap
plot_hmap <- plot_anno +
stat_density_2d(data = fixTrial, aes(x= xp, y=yp, fill=..level..),
geom = "polygon",
inherit.aes = FALSE,
show.legend = FALSE,
alpha=.2,color = "blue")
plot_hmap
