计算各列的分数

Question

首先是样本数据：

bbbv[1:25] <-1
bbbv[26:50] <-2
bbbw <- 1:25
bbbx <- sample(1:5, 50, replace=TRUE)
bbby <- sample(1:5, 50, replace=TRUE)

bbb <- data.frame(pnum=bbbv, trialnum=bbbw, guess=bbbx, target=bbby)

如果目标与猜测的数字相同，那么我们得分为1，否则为0。

bbb$hit <- ifelse(bbb$guess==bbb$target, 1, 0)

这就是问题所在。我想再计算四列：

bbb$hitpone trialnum(n) guess == trial(n+1) target
bbb$hitptwo trialnum(n) guess == trial(n+2) target
bbb$hitmone trialnum(n) guess == trial(n-1) target
bbb$hitmtwo trialnum(n) guess == trial(n-2) target

要清楚。对于hitmone，我们查看试验猜测并将其与之前的试验目标（当前试验中的-1）进行比较。对于hitmtwo，我们查看试验猜测，并将其与目标2返回（当前试验中的-2）。 hitpone和hitptwo是相同的但是在正方向（当前试验的+1和+2）。

只是要明确，就像之前我们有兴趣确定目标是否与猜测相同时我们得分1，否则为0（根据我们的新计算）。

现在这个任务有一些小麻烦。每个pnum有25个试验。对于hitpone，我们无法为试验25计算+1。对于hitptwo，我们无法计算试验25和试验24的+2。对于hitmone也是如此：我们不能为试验1计算-1，对于试验1也不能计算-2和2。

这就是我想要表格的样子。我手工嘲笑它，显示前1-3次试验和最后23-25次试验。

dput(bbb)
structure(list(pnum = c(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 2, 2, 2, 
2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2), trialnum = c(1L, 
2L, 3L, 4L, 5L, 6L, 7L, 8L, 9L, 10L, 11L, 12L, 13L, 14L, 15L, 
16L, 17L, 18L, 19L, 20L, 21L, 22L, 23L, 24L, 25L, 1L, 2L, 3L, 
4L, 5L, 6L, 7L, 8L, 9L, 10L, 11L, 12L, 13L, 14L, 15L, 16L, 17L, 
18L, 19L, 20L, 21L, 22L, 23L, 24L, 25L), guess = c(5L, 1L, 1L, 
3L, 1L, 3L, 1L, 5L, 2L, 3L, 1L, 1L, 5L, 3L, 5L, 1L, 2L, 2L, 3L, 
1L, 4L, 1L, 4L, 4L, 3L, 4L, 5L, 2L, 4L, 5L, 5L, 5L, 4L, 5L, 2L, 
3L, 1L, 1L, 5L, 1L, 1L, 3L, 1L, 2L, 4L, 1L, 2L, 3L, 1L, 1L), 
target = c(4L, 3L, 4L, 5L, 5L, 1L, 1L, 1L, 1L, 1L, 1L, 3L, 
1L, 2L, 5L, 1L, 3L, 2L, 1L, 4L, 4L, 1L, 1L, 3L, 4L, 4L, 2L, 
3L, 2L, 1L, 1L, 5L, 4L, 3L, 5L, 1L, 1L, 1L, 2L, 5L, 2L, 4L, 
3L, 1L, 1L, 2L, 5L, 3L, 3L, 3L), hit = c(0, 0, 0, 0, 0, 0, 
1, 0, 0, 0, 1, 0, 0, 0, 1, 1, 0, 1, 0, 0, 1, 1, 0, 0, 0, 
1, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 
0, 0, 0, 1, 0, 0)), .Names = c("pnum", "trialnum", "guess", 
"target", "hit"), row.names = c(NA, -50L), class = "data.frame")

Answer 1

以下是基础知识。您可以将其扩展为处理负增量，并使用by()来调用hitp()以避免子集化。

hitp <- function(dtf,inc) {
    target.shift <- shift(dtf$target,inc,wrap=FALSE,pad=TRUE)
    return(dtf$guess==target.shift)
}
bbb1 <- subset(bbb,pnum==1)
bbb1$hitpone <- hitp(bbb1,1)
bbb1$hitptwo <- hitp(bbb1,2)
bbb1$hitmone <- hitp(bbb1,-1)

打电话给看起来像这样：

unlist(by(bbb,bbb$pnum,hitp,inc=1))

shift是我为其他目的而写的程序：

shift <- function(vec,n=1,wrap=TRUE,pad=FALSE) {
    if(length(vec)<abs(n)) { 
        #stop("Length of vector must be greater than the magnitude of n \n") 
    }
    if(n==0) { 
        return(vec) 
    } else if(length(vec)==n) { 
        # return empty
        length(vec) <- 0
        return(vec)
    } else if(n>0) {
        returnvec <- vec[seq(n+1,length(vec) )]
        if(wrap) {
            returnvec <- c(returnvec,vec[seq(n)])
        } else if(pad) {
            returnvec <- c(returnvec,rep(NA,n))
        }
    } else if(n<0) {
        returnvec <- vec[seq(1,length(vec)-abs(n))]
        if(wrap) {
            returnvec <- c( vec[seq(length(vec)-abs(n)+1,length(vec))], returnvec )
        } else if(pad) {
            returnvec <- c( rep(NA,abs(n)), returnvec )
        }

    }
    return(returnvec)
}

这一切都非常依赖于正确的排序，因此请确保在运行之前对其进行排序。