Рассчитать баллы по столбцам

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 (согласно нашим новым расчетам).

Теперь с этой задачей есть небольшие трудности.Каждый ПНУМ имеет 25 испытаний.Для hitpone мы не можем рассчитать +1 для испытания 25. Для hitptwo мы не можем рассчитать +2 для испытаний 25 или испытания 24. То же самое следует сделать для hitmone: мы не можем рассчитать -1 для испытания 1 и -2 для испытаний 1 и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)
}

Все это довольно сильно зависит от правильной сортировки, поэтому убедитесь, что она отсортирована перед запуском.