# methods for computing metrics
###################################
## NSS ##
###################################
#' Computes nss distance metric
#' @description
#' Computes nss distance metric for eye object against spatiotemporal map
#' @param V scanpath which will be tested (or stm map)
#' @param SV stm map
#' @author Filip Dechterenko
#' @export
compute.nss.from.space <- function(V, SV) {
stopifnot(is.spath(V) | is.space(V))
if (class(V) == "spath") {
V <- scanpath.to.space(V)
}
return(sum(c(V$data) * c((normalize.space(SV))$data)) / sum(c(V$data)))
}
#' Computes nss distance metric
#' @description
#' Computes nss distance metric for one eye object against another
#' @param eye1 corresponding scanpath will be loaded for this eye object
#' @param eye2 corresponding stm will be loaded for this eye object and scanpath will be compared against it
#' @author Filip Dechterenko
#' @export
nss.dist <- function(eye1, eye2){
SV <- load.space(eye1$id, eye1$trial)
V <- load.scanpath(eye2$id, eye2$trial)
compute.nss.from.space(V, SV)
}
#' Computes correlation distance metric for two lists
#' @description
#' Computes correlation distance metric between two lists of spatiotemporal maps (stm) or ids of eye gaze data.
#' In second case corresponding stm are loaded from path specified in config or in parameter
#' @param list1 first list with stm or ids in format id.trial
#' @param list2 second list with stm or ids in format id.trial
#' @param spaces.dir optional parameter with path to the stored stm maps. If missing, default value is used from config
#' @author Filip Dechterenko
#' @export
corr.for.two.list <- function(list1, list2, spaces.dir = NULL){
EV1 <- empty.space()
EV2 <- empty.space()
plyr::l_ply(list1, function(x) {
if (class(x) == "space") { # we have list of spaces
EV1 <<- x + EV1
}
else if(class(x) == "character") { # we have list of ids
eye1.id <- unlist(strsplit(as.character(x), "[.]"))[1]
eye1.tr <- unlist(strsplit(as.character(x), "[.]"))[2]
SV <- load.space(as.numeric(eye1.id), as.numeric(eye1.tr), spaces.dir)
EV1 <<- SV+EV1
}
})
plyr::l_ply(list2, function(x) {
if (class(x) == "space") { # we have list of spaces
EV2 <<- x+EV2
}
else if(class(x) == "character") { # we have list of ids
eye1.id <- unlist(strsplit(as.character(x), "[.]"))[1]
eye1.tr <- unlist(strsplit(as.character(x), "[.]"))[2]
SV <- load.space(as.numeric(eye1.id),as.numeric(eye1.tr),spaces.dir)
EV2 <<- SV+EV2
}
})
return(.cdm(c(EV1$data), c(EV2$data)))
}
#' Computes correlation distance metric
#' @description
#' Computes correlation distance metric between two spatiotemporal maps or two eye gaze data (in second case corresponding stm are loaded)
#' @usage
#' corr.dist(SV1,SV2)
#' corr.dist(eye1,eye2)
#' @param SV1 first spatiotemporal map
#' @param SV2 second spatiotemporal map
#' @param eye1 first eye gaze data
#' @param eye2 second eye gaze data
#' @author Filip Dechterenko
#' @export
corr.dist<-function(eye1, eye2) {
if (class(eye1) == "eye") {
SV1 <- load.space(eye1$id, eye1$trial)
}
else {
SV1 <- eye1
}
if (class(eye2) == "eye") {
SV2 <- load.space(eye2$id, eye2$trial)
}
else {
SV2 <- eye2
}
return(.cdm(SV1$data, SV2$data))
}
#' Internal method for correlation distance metric
#' @description
#' Computes correlation c between two vectors and return 1-c (in case when c>0)or 0 (otherwise)
#' @param x first vector
#' @param y second vector
#' @author Filip Dechterenko
.cdm<-function(x, y) {
if (var(x, y) != 0) {
c <- cor(x, y)
if (c < 0) {
c <- 0
}
return(1 - c)
}
else {
return(0)
}
}
###################################
## Mean distance ##
###################################
mean_distance <- function(eye1, eye2) {
df1 <- eye1$xyt
df2 <- eye2$xyt
d <- df1 %>% full_join(df2, by = "t") %>% mutate(d = sqrt((x.x - x.y) ^ 2 + (y.x - y.y) ^ 2)) %>% summarize(d = mean(d, na.rm = T))%>% .$d
return(d)
}
###################################
## Median distance ##
###################################
median_distance <- function(eye1, eye2) {
df1 <- eye1$xyt
df2 <- eye2$xyt
d <- df1 %>% full_join(df2, by = "t") %>% mutate(d = sqrt((x.x - x.y) ^ 2 + (y.x - y.y) ^ 2)) %>% summarize(d = median(d, na.rm = T))%>% .$d
return(d)
}
#' Levenshtein distance
#' Computes levenshtein distance for two eye objects
#'
#' @param eye1 - object of class eye
#' @param eye2 - object of class eye
#' @param gr - grid for levenshtein distance
#'
#' @return Returns Levenshtein distance
#' @export
#'
#' @examples
levenhstein_distance <- function(eye1, eye2, gr, treat_missing = "spec_char") {
df1 <- eye1$xyt
df2 <- eye2$xyt
gridsize <- diff(gr$x[1:2])
roundprec <- round(1/gridsize)
df1 <- df1 %>% mutate(rx = plyr::round_any(x,gridsize), ry = plyr::round_any(y,gridsize))
df2 <- df2 %>% mutate(rx = plyr::round_any(x,gridsize), ry = plyr::round_any(y,gridsize))
s1 <- df1 %>% left_join(gr, by = c("rx"="x","ry"="y")) %>% as_data_frame() %>% select(rx,ry,chr,ix)
s2 <- df2 %>% left_join(gr, by = c("rx"="x","ry"="y")) %>% as_data_frame() %>% select(rx,ry,chr,ix)
s1 <- s1$chr
s2 <- s2$chr
n <- length(s1)
m <- length(s2)
d <- matrix(data = rep(-1, n*m), nrow = n, ncol = m)
if(treat_missing == "spec_char") {
s1[is.na(s1)] <- ".."
s2[is.na(s2)] <- ".."
}
for (i in 2:n) {
d[i,1] = d[i-1,1] + 1
}
for (j in 2:m) {
d[1,j] = d[1,j - 1] + 1
}
for (i in 2:n) {
for (j in 2:m) {
d[i,j] = min(d[i-1,j] + 1, d[i,j-1] + 1, d[i-1,j-1] + (s1[i-1] != s2[j-1]))
}
}
return((d[n,m]+1)/max(n,m))
}
#' Computes correlation distance
#'
#' @param eye1 - object of class eye
#' @param eye2 - object of class eye
#'
#' @return
#' @export
#'
#' @examples
correlation_distance <- function(eye1, eye2) {
if (class(eye1) == "space" & class(eye2) == "space") {
SV1 <- eye1
SV2 <- eye2
} else {
G <- gaussian.mask()
if(class(eye1) == "eye") {
ar.w <- attr(eye1,"arena.width")
ar.h <- attr(eye1,"arena.height")
sp1 <- as.scanpath(eye1)
if(max(abs(sp1$x)) > ar.w | max(abs(sp1$y)) > ar.h){
return(NA)
}
SV1 <- smooth.space(sp1, G)
}
if(class(eye2) == "eye") { # class of eye2 is eye
ar.w <- attr(eye2,"arena.width")
ar.h <- attr(eye2,"arena.height")
sp2 <- as.scanpath(eye2)
if(max(abs(sp2$x)) > ar.w | max(abs(sp2$y)) > ar.h){
return(NA)
}
SV2 <- smooth.space(sp2, G)
}
}
cd <- .cdm(c(SV1$data),c(SV2$data))
return(cd)
}
#' Computes Fréchet distance between two scan patterns
#'
#' @param eye1 - object of class eye
#' @param eye2 - object of class eye
#'
#' @return
#' @export
#'
#' @examples
frechet_distance <- function(eye1, eye2) {
df1 <- eye1$xyt
df2 <- eye2$xyt
require(pdist)
xy1 <- df1 %>% select(x,y) %>% as.matrix()
xy2 <- df2 %>% select(x,y) %>% as.matrix()
distm <- pdist(xy1,xy2)
n <- nrow(df1)
m <- nrow(df2)
ca <- matrix(data = rep(-1, n * m), nrow = n, ncol = m)
ca[1,1] <- distm[1, 1]
for (i in 2:n) {
ca[i,1] <- max(ca[i - 1, 1], distm[i,1])
}
for (j in 2:m) {
ca[1,j] <- max(ca[1, j - 1], distm[1,j])
}
for (i in 2:n) {
for (j in 2:m) {
ca[i,j] <- max(min(ca[i - 1, j],ca[i, j - 1], ca[i - 1, j - 1]), distm[i, j])
}
}
return(ca[n,m])
}
#' Creates grid for Levenshtein metric
#'
#' @param gridsize size in degrees of one AOI
#' @param minx minimum value of x, default is -15
#' @param maxx maximum value of x,default is 15
#' @param miny minimum value of y, default is -15
#' @param maxy maximum value of y,default is 15
#'
#' @return
#' @export
#'
#' @examples
create_grid <- function(gridsize = 0.25, minx = -15, maxx = 15, miny = -15, maxy = 15){
xAOI <- seq(minx, maxx, by = gridsize)
yAOI <- seq(miny, maxy, by = gridsize)
nx <- length(xAOI)
ny <- length(yAOI)
a <- rawToChar(as.raw(1:nx+as.numeric(charToRaw("a"))-1)) %>% strsplit("") %>% unlist()
b <- rawToChar(as.raw(1:nx+as.numeric(charToRaw("a"))-1)) %>% strsplit("") %>% unlist()
gr <- expand.grid(a,b, stringsAsFactors = F) %>% as_data_frame() %>% transmute(chr = stringr::str_c(Var1,Var2))
xy <- expand.grid(xAOI, yAOI) %>% transmute(x = Var1, y = Var2)
gr <- gr %>% mutate(ix = 1:n()) %>% cbind(xy) # grid computed
return(gr)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.