myscratchpad

前のをちょっと変えた。
正答・誤答のベクトルと比較して、正答の反応時間だけ使うようにした。

nn <- 50
rts<- round(c((rnorm(nn, mean=300, sd=20)+(300*rexp(nn)))))
rsp <- sample(c("correct", "incorrect"), 50, replace=T, prob=c(0.80, 0.20))

elrt <- function(rts, rsp="allcorrect", cres="correct", cop=2.5, ifm=FALSE) {
rts0 <- rts
ifelse(rsp=="allcorrect", rsp<-rep(cres, length(rts)), rsp<- rsp)
cres <- cres
cop <- cop
## 正答以外の反応の添字
irind <- which(rsp!=cres)
rts1 <- rts0
rts1[irind] <- NA
## 正答以外の反応の反応時間を除く
rts2 <- na.omit(rts1)
rtl <- log10(rts2) # 常用対数に変換
meanv <- mean(rtl)
sdv <- sd(rtl)
cv.l <- meanv-(cop*sdv)
cv.u <- meanv+(cop*sdv)
rtl2 <- log10(rts1) # 常用対数に変換
lind <- which(rtl2 < cv.l)
uind <- which(rtl2 > cv.u)
    nart <- rts1
    nart[lind] <- 10^(cv.l) # 対数値を元に戻す
    nart[uind] <- 10^(cv.u)
    rsp2 <- rsp
    rsp2[lind] <- "lower"
    rsp2[uind] <- "upper"
    reslist <- list()
    reslist$nart <- nart
    reslist$logrt <- rtl2
    reslist$responses <- rsp2
    reslist$outliers.l <- rts[lind]
    reslist$outliers.u <- rts[uind]
    reslist$cop <- paste(cop, "SD", sep="")
    reslist$cv <- c(cv.l, length(rts[lind]), cv.u, length(rts[uind]))
    names(reslist$cv) <-  c("lower", "nofl", "upper",  "nofu")
ifelse(ifm==FALSE, return(rtl2), return(reslist))
}
elrt(rts) # 反応ベクトルを指定しないときは全て正答とする
elrt(rts, rsp=rsp, ifm=T)
 # 反応ベクトルがあるときはrspを指定する。指定がないときは全て正反応として扱われる。
 # nartは不正解をNA、外れ値をカットオフ値で置換した生RTを返す。長さは元のrtsベクトルと同じ
 # logrtは上の対数。ベクトルの長さは同じ。メインの分析対象はこれ
## 除去・置換後の反応をとりだす
x <- elrt(rts, rsp, ifm=T)
x[[1]] # rt
x[[2]] # log
x[[3]] # 反応


# 以下のデータフレームのように、各参加者IDと反応時間のベクトルがある場合

# 参加者個々にelrt関数を適用してみる
 # データ生成
id <- gl(3,10)
rts<- round(c((rnorm(30, mean=300, sd=20)+(300*rexp(30)))))
rts[30] <- 5000 # 意図的に外れ値を入れておく
rsp <- sample(c("correct", "incorrect"), 30, replace=T, prob=c(0.80, 0.20))
dat <- data.frame(id, rts, rsp)
dat # 仮データ

res <- list()
ids <- dat[,1]
lvs <- levels(dat[,1]) # id
for (i in 1:nlevels(dat[,1])) {
  rtx <- dat[,2][ids==lvs[i]]
  rsx <- as.character(dat[,3][ids==lvs[i]])
  res1 <- elrt(rtx, rsp=rsx, ifm=T)
  res2 <- res1$logrt # 対数値のみ返す
  res[[i]] <- res2
}
 # tapplyとかmapplyで上手くできるやり方あるのかな…

unlist(res) # ベクトルで返す
 # 参加者個々じゃないと
 elrt(rts, rsp=rsp)

# 全部をつなげてみよう
data.frame(dat, unlist(res), elrt(rts, rsp=rsp))