#Прямоугольные AOIs в формате "Номер AOI"-"x1(лев-верх)"-"y1(лев-верх)"-
# "x2(прав-ниж)"-"y2(прав-ниж)"-"Заметка"
#в экранных координатах
states<-data.frame(AOI=1:10, x1=NA,y1=NA,x2=NA,y2=NA, note=NA)
states[2]=c(490,590,700,490,590,700,490,590,700,380)
states[3]=c(290,290,290,350,350,350,410,410,410,560)
states[4]=c(555,655,765,555,655,765,555,655,765,895)
states[5]=c(345,345,345,405,405,405,475,475,475,815)
states[1:9,6]="task" #Матрица Равена
states[10,6]="vars" #Ответы
#Наложение областей интереса на график
ShowAOIs <- function(states)
{
for (i in 1:nrow(states))
{
x = c(states$x1[i],states$x1[i],states$x2[i],states$x2[i],states$x1[i]);
y = c(states$y1[i],states$y2[i],states$y2[i],states$y1[i],states$y1[i]);
points(x,y,col="red",type="l");
}
}
#Считываем траектории последовательность точек
trajectory = read.csv("E://RDir/eyet_2.txt", sep = "\t", header = T,comment.char = "#")
#Создадим набор координат точек фиксации
indata = data.frame(x=as.integer(trajectory$R.POR.X..px.),y=as.integer(trajectory$R.POR.Y..px.))
#Определяем, в какую зону интереса попала точка
#Функция работает с предварительно обработанными точками, можно добавить также время
classify <- function(input,states)
{
#Создадим переменную для хранения классифицированных точек
out=data.frame(state=NA,x=NA,y=NA);
#Переменная-флаг (попала ли точка в какой-нибудь AOI)
classified = FALSE;
#Для каждой из AOI будем сравнивать координаты углов с координатами точек
for (i in 1:nrow(input)) #Проходим по каждой точке
{
for (j in 1:nrow(states)) #Сравниваем с каждой AOI
if ((input$x[i]>states$x1[j])&(input$x[i]<states$x2[j])&(input$y[i]>states$y1[j])&(input$y[i]<states$y2[j]))
{
out[i,]=c(j,input$x[i],input$y[i]);
classified=TRUE;
break;#Если точка попала в какую-либо AOI, выходим из цикла
}
if(!classified) out[i,]=c(0,0,0); #Если точка не попала ни в одну из AOI, указываем зону как (0,0,0)
classified=FALSE;
}
return(out); #Возвращаем классифицированные точки с соответствующими зонами интереса
}
#Просматриваем результат классификации
cld = classify(indata[complete.cases(indata),], states)
head(cld$state,n=20)
## [1] 0 0 5 0 8 5 8 8 8 8 8 8 8 8 8 8 8 8 8 8
#Удаляем нулевые зоны интереса, они нас не интересуют
cld = cld[which(cld[,1]!=0),]
head(cld$state,n=20)
## [1] 5 8 5 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8
#Вычисление SR-матрицы
getSR <- function(states, classified, alpha, gamma)
{
#Размер матрицы - кол-во AOI
size = nrow(states);
#Вектор полученных AOIs
if (is.data.frame(classified))
cv = classified$state #Classified_Vector
else if (is.vector(classified))
cv=classified;
#Длина вектора перемещений
len=length(cv);
#Генерируем единичную матрицу I нужного размера
I = diag(1,size);
#Инициализируем новую SR-матрицу
SR = matrix(0,size,size);
#Переменная, содержащая историю изменений SR-матрицы
SRHistory = matrix(0,len,size^2);
#Заполняем матрицу данными и записываем в историю предыдущее значение матрицы
for (i in 1:(len-1))
{
SRHistory[i,] = as.vector(SR);
SR[,cv[i]] = SR[,cv[i]]+alpha*(I[,cv[i+1]]+gamma*SR[,cv[i+1]]-SR[,cv[i]]);
}
SRHistory[len,]=as.vector(SR);
#Выдаем полученную историю изменений матрицы
return(SRHistory);
}
#Вычисляем SR-матрицу
#Получаем матрицу содержащую в строках промежуточные значения SR-матрицы
SRH = getSR(states,cld,0.233,0.255)
#Итоговая SR-матрица - последняя строка промежуточных значений
SR = matrix(SRH[nrow(SRH),],ncol=sqrt(ncol(SRH)))
#Округлим значения и выведем полученную матрицу
round(SR,3)
## [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
## [1,] 0.999 0.444 0.000 0.067 0.012 0.001 0.001 0.001 0.000 0.000
## [2,] 0.001 0.564 0.002 0.016 0.282 0.014 0.000 0.011 0.001 0.000
## [3,] 0.000 0.000 0.861 0.000 0.000 0.022 0.000 0.026 0.006 0.000
## [4,] 0.268 0.021 0.000 0.448 0.002 0.000 0.018 0.000 0.000 0.000
## [5,] 0.018 0.277 0.000 0.228 0.632 0.281 0.000 0.000 0.000 0.000
## [6,] 0.000 0.000 0.462 0.001 0.000 0.990 0.000 0.165 0.043 0.000
## [7,] 0.051 0.018 0.000 0.228 0.001 0.000 1.010 0.000 0.000 0.000
## [8,] 0.000 0.014 0.001 0.001 0.401 0.031 0.294 0.706 0.475 0.000
## [9,] 0.000 0.000 0.012 0.016 0.000 0.002 0.001 0.019 0.765 0.000
## [10,] 0.002 0.001 0.003 0.297 0.013 0.002 0.018 0.414 0.048 1.342
#Вычисляем евклидовы расстояния между промежуточными значениями матрицы
SRvec <- function(srhistory)
{
len = nrow(srhistory);
res = vector(length=(len-1));
for (i in 1:(len-1))
res[i] = sum(sqrt((srhistory[i+1,]-srhistory[i,])^2))
return(res);
}
#Посмотрим, как меняется расстояние между промежуточными матрицами
plot(SRvec(SRH)[1:100],type="l",xlab="Перемещение (номер)", ylab="Евклидово расстояние")
# Из графика видно, что примерно с пятого по двадцатое перемещение
# евклидово расстояние неуклонно уменьшается.
# Посмотрим, какие области интереса соответствуют этим перемещениям
cld$state[1:25]
## [1] 5 8 5 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 4
# Можно сделать вывод , что график показывает степень удивления от перехода
# из одной области интереса в другую. Мы видим, что в какой-то момент времени
# последовательность состояний (областей, в которых оказывался взор, в данном
# случае) оказалась в восьмой зоне интереса. Чем дольше взор оставался в этой
# области, тем более ожидаемым оказывался факт попадания в эту область. Потом
# взор оказывается в четвертой области интереса , что для нас является новым
# событием, чему и соответствует пик на графике. Также мы можем заметить, что
# на графике есть похожие на описанную выше ситуацию участки. Например , с 70
# по 85 перемещение.
cld$state[70:85]
## [1] 2 2 5 2 2 2 2 2 2 2 2 2 2 2 2 2
# В данном случае взор оставался во второй области интереса.
#Выведем траекторию на график
plot(indata[which((indata[,2]>70)&(indata[,1]>300)&(indata[,1]<870)),],
type="l", xlim=c(0,1280), ylim=c(1024,0))
#Добавим на график зоны интереса
ShowAOIs(states)
