# R/scorePerformance.R In TestGardener: Information Analysis for Test and Rating Scale Data

#### Documented in scorePerformance

```scorePerformance <- function(dataList, simList) {

sumscrsave <- simList\$sumscrsave
indexsave  <- simList\$indexsave
musave     <- simList\$musave
infosave   <- simList\$infosave
index.pop  <- simList\$index.pop
mu.pop     <- simList\$mu.pop
info.pop   <- simList\$info.pop

nindex.pop <- dim(indexsave)[1]
nsample    <- dim(indexsave)[2]

indexres  <- indexsave  - matrix(index.pop, nindex.pop, nsample)
mures     <- musave     - matrix(mu.pop,    nindex.pop, nsample)
sumscrres <- sumscrsave - matrix(mu.pop,    nindex.pop, nsample)

#  compute bias's averaged over only samples

indexbias  <- apply(indexres,  1, mean)
mubias     <- apply(mures,     1, mean)
sumscrbias <- apply(sumscrres, 1, mean)

#  compute RMSE's averaged over only samples

indexRMSE  <- sqrt(apply( indexres^2, 1, mean))
muRMSE     <- sqrt(apply(    mures^2, 1, mean))
sumscrRMSE <- sqrt(apply(sumscrres^2, 1, mean))

#  compute Variance's averaged over only samples

indexstd  <- sqrt( indexRMSE^2  -  indexbias^2)
mustd     <- sqrt(    muRMSE^2  -     mubias^2)
sumscrstd <- sqrt(sumscrRMSE^2  - sumscrbias^2)

#  Set up bases for returning smooth performance curves

indbasis <- create.bspline.basis(c(0,100), 13)
indfd    <- fd(matrix(0,13,1), indbasis)

#  Lightly smooth bias results over index's

indexbiasfd  <- smooth.basis(index.pop,     indexbias, indfd)\$fd
mubiasfd     <- smooth.basis(index.pop,        mubias, indfd)\$fd
sumscrbiasfd <- smooth.basis(index.pop,    sumscrbias, indfd)\$fd

#  Lightly smooth RMSE results over index's

indexRMSEfd  <- smooth.basis(index.pop,     indexRMSE, indfd)\$fd
muRMSEfd     <- smooth.basis(index.pop,        muRMSE, indfd)\$fd
sumscrRMSEfd <- smooth.basis(index.pop,    sumscrRMSE, indfd)\$fd
#  Lightly smooth std. dev. results over index's

indexstdfd   <- smooth.basis(index.pop,     indexstd, indfd)\$fd
mustdfd      <- smooth.basis(index.pop,        mustd, indfd)\$fd
sumscrstdfd  <- smooth.basis(index.pop,    sumscrstd, indfd)\$fd

#  get results for arc length if required

if (!is.null(infosave)) {
infores    <- infosave - matrix(info.pop,nindex.pop,nsample)
infobias   <- apply(infores, 1, mean)
infoRMSE   <- sqrt(apply(infores^2, 1, mean))
infostd    <- sqrt(infoRMSE^2 - infobias^2)
infobiasfd <- smooth.basis(index.pop, infobias, indfd)\$fd
infoRMSEfd <- smooth.basis(index.pop, infoRMSE, indfd)\$fd
infostdfd  <- smooth.basis(index.pop, infostd,  indfd)\$fd
} else {
infobiasfd <- NULL
infoRMSEfd <- NULL
infostdfd  <- NULL
}

#  bundle these results into struct object simList

simListout <- simList

indfine <- seq(0,100,len=101)

simListout\$indexRMSE  <- eval.fd(indfine, indexRMSEfd)
simListout\$muRMSE     <- eval.fd(indfine, muRMSEfd)
simListout\$sumscrRMSE <- eval.fd(indfine, sumscrRMSEfd)
simListout\$indexbias  <- eval.fd(indfine, indexbiasfd)
simListout\$mubias     <- eval.fd(indfine, mubiasfd)
simListout\$sumscrbias <- eval.fd(indfine, sumscrbiasfd)
simListout\$indexstd   <- eval.fd(indfine, indexstdfd)
simListout\$mustd      <- eval.fd(indfine, mustdfd)
simListout\$sumscrstd  <- eval.fd(indfine, sumscrstdfd)

if (!is.null(infosave)) {
simListout\$infoRMSE <- eval.fd(indfine, infoRMSEfd)
simListout\$infobias <- eval.fd(indfine, infobiasfd)
simListout\$infostd  <- eval.fd(indfine, infostdfd)
} else {
simListout\$infoRMSE <- NULL
simListout\$infobias <- NULL
simListout\$infostd  <- NULL
}

return(simListout)

}
```

## Try the TestGardener package in your browser

Any scripts or data that you put into this service are public.

TestGardener documentation built on May 29, 2024, 3:31 a.m.