计算分数

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的-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) 
} 

这一切都依赖相当倚重正确排序，所以在运行之前确保它已经被分类。