Benutzer-Werkzeuge

Webseiten-Werkzeuge


usakk

binokulare Sakkaden

Nachdem die Sakkaden im li. und re. detektiert worden sind, ist die nächste Aufgabe, die zusammengehörigen Sakkaden zu finden und eine gemeinsame Liste zu formen:

mg_1.R
mgx <- function(l,r) {
dexarr <- array(dim=c(0,2))
ir <- 1
for ( il in 1:(length(l$t2)-1) ) {
while( l$t1[il] >= r$t3[ir] ) {
	dexarr <- rbind( dexarr, c(NA,ir))
	ir <- ir+1; }
if( l$t3[il] < r$t1[ir] ) dexarr <- rbind( dexarr, c(il,NA)) else {
	dexarr <- rbind( dexarr, c(il,ir)) ; ir <- ir+1; }
}
dexarr}
 
mg <- function(l,r) { mgx( rbind(l[1:3],c(9999999,Inf,Inf)),rbind(r[1:3],c(9999999,Inf,Inf))) }

Sakkaden werden als zusammengehörig angesehen, wenn die Intervalle t1:t3 der beiden Augen sich überlappen, also wenn

l$t1 < r$t3 & r$t1 < l$t3

gilt. Um ständige Abfragen auf Ende der Liste zu vermeiden, werden beide Listen mit einem Ende in weiter Zukunft abgeschlossen und die Hilfsfunktion mgx von mg aufgerufen.

Versuche mit mehr als 10% Ausfall landen auf der Badlist:

bad.list <- names(ausw.liste)[unlist(lapply(ausw.liste,
  function(x){sum(x[["nas"]][,2]-x[["nas"]][,1])/x[["N"]]>0.1}))]

Für die statistische Auswertung werden die Sakkadenpaare in einem Dataframe mg.long gesammelt. Die Multiplikationen mit 2 für die Trigger-Zeiten dient der Umrechnung auf reale Millisekunden (bei 500Hz Abtastung).

mg_2.R
mg.long <- NULL
for( fn in names(ausw.liste)) {
sakks2.mg <- with(ausw.liste[[fn]]$sakks2,mg(sakk.l,sakk.r))
tg <- with(ausw.liste[[fn]],approxfun(2*trig,trigv,method="c"))
nas <- unlist(apply(ausw.liste[[fn]]$nas,1,function(x)(2*x[1]):(2*x[2])))
mg.long <- rbind(mg.long, with(ausw.liste[[fn]]$sakks2,
	cbind(fn,sakk.l[sakks2.mg[,1],],sakk.r[sakks2.mg[,2],],
	l.na = is.element(sakk.l[sakks2.mg[,1],1],nas)
		| is.element(sakk.l[sakks2.mg[,1],2],nas)
		| is.element(sakk.l[sakks2.mg[,1],3],nas),
	r.na = is.element(sakk.r[sakks2.mg[,1],2],nas)
		| is.element(sakk.r[sakks2.mg[,2],2],nas)
		| is.element(sakk.r[sakks2.mg[,2],3],nas),
	l.tg=tg(sakk.l[sakks2.mg[,1],1]), r.tg=tg(sakk.r[sakks2.mg[,2],1]),
	l.tg100=tg(sakk.l[sakks2.mg[,1],1]+100), r.tg100=tg(sakk.r[sakks2.mg[,2],1]+100)
	)))
}

Am fertigen Dataframe werden noch einige Daten berechnet: die Sakkadenweite w.i, die Richtung phi.

mg_3.R
names(mg.long)[2:10] <- paste("l", names(mg.long)[2:10], sep=".")
names(mg.long)[9+2:10] <- paste("r", names(mg.long)[9+2:10], sep=".")
mg.long$VP <- substring(mg.long$fn,1,3)
mg.long$l.w.i <- sqrt(mg.long$l.w.h^2+mg.long$l.w.v^2)
mg.long$r.w.i <- sqrt(mg.long$r.w.h^2+mg.long$r.w.v^2)
mg.long$l.phi <- with(mg.long,atan2(l.w.h,l.w.v))*180/pi
mg.long$r.phi <- with(mg.long,atan2(r.w.h,r.w.v))*180/pi
mg.long$match.h <- with(mg.long,(l.w.h-r.w.h)^2/(l.w.h^2+r.w.h^2+0.1))
mg.long$match.v <- with(mg.long,(l.w.v-r.w.v)^2/(l.w.v^2+r.w.v^2+0.1))
 
#mg.good <- subset(mg.long,!(l.na|r.na|is.element(fn,bad.list)|l.t3-l.t1>99|r.t3-l.t1>99))
mg.good <- subset(mg.long,!(l.na|r.na|is.element(fn,bad.list)))
mg.long.binocular <- subset(mg.long,!is.na(l.t1) & ! is.na(r.t1))
mg.good.binocular <- subset(mg.good,!is.na(l.t1) & ! is.na(r.t1))
mg.micro <- subset(mg.good.binocular,l.w.h^2+l.w.v^2+r.w.h^2+r.w.v^2 < 2)
par(mfrow=c(1,3))
 
hist(subset(mg.micro,l.tg100>0&l.tg100<8)$l.w.h,br=33)
hist(subset(mg.micro,l.tg100>7&l.tg100<15)$l.w.h,br=33)
hist(subset(mg.good,abs(l.w.h)<1&l.tg100>0&l.tg100<8)$l.w.h,br=33)
hist(subset(mg.good,abs(l.w.h)<1&l.tg100>14)$l.w.h,br=33)
boxplot(l.w.h~VP,subset(mg.good,abs(l.w.h)<1&l.tg100>0&l.tg100<8))
plot(l.v.c~l.v.i,subset(mg.micro,l.tg100>7&l.tg100<15),pch=".",col=1+as.numeric(factor(substring(fn,1,3))))
rate.l <- unlist(lapply(ausw.liste,function(x)with(x$sakks2$sakk.l,median(c(t2,999999)-c(0,t2)))))
rate.r <- unlist(lapply(ausw.liste,function(x)with(x$sakks2$sakk.r,median(c(t2,999999)-c(0,t2)))))
usakk.txt · Zuletzt geändert: 2023/05/11 09:13 von 127.0.0.1