R/KernEqWPS-package.R
In CambridgeAssessmentResearch/KernEqWPS: Kernel Equating Without Pre-Smoothing
#' Kernel Equating Without Pre-Smoothing
#'
#' An R package to carry out kernel equating without needing to choose a loglinear model for pre-smoothing.
#' This is desirable since, although pre-smoothing may possibly improve accuracy, skipping this step allows kernel equating to become
#' more straightforward and easier to automate as there are no decisions to make about the order of loglinear models.
#' In addition most of the functions in this package are designed to work in cases where non-integer scores occur.
#' In other words, for most functions, it is not necessary for test scores to be integers.
#'
#' As an alternative to pre-smoothing the package relies on the kernel within kernel equating itself to supply sufficient smoothing
#' to provide accurate results.
#' This may be done either using the plug-in formula of Andersson and von Davier (2014) or by using the method of cross-validation suggested
#' by Liang and von Davier (2014).
#'
#' For the puposes of post-stratification equating (PSE) pre-smoothing would require not only fitting a model to each marginal score
#' distribution but also to the joint relationship between test and anchor forms. In this package this is avoided.
#' Instead, data from different populations is weighted so that the first n moments of scores on the anchor test match.
#' This is achieved using the Adjustment by Minimum Discriminant Information method also known as MDIA (Haberman, 1984).
#' Functions to perform MDIA weighting are included within this package and may potentially be used in contexts aside from equating.
#'
#' Aside from post-stratification and chained equating, this package also implements the hybrid equating method decribed
#' in von Davier and Chen (2013).
#'
#' Finally this package implements two experimental equating methods that were devised by training neural networks
#' to replicate known "true" equating functions within the nonequivalent groups with anchor test (NEAT) design.
#' See Benton (2017) for more details.
#'
#' @references
#' Andersson, B., & von Davier, A. A. (2014). Improving the bandwidth selection in kernel equating.
#' \emph{Journal of Educational Measurement, 51}(3), 223-238.
#'
#' Benton, T. (2017). Can AI learn to equate?,
#' \emph{presented at the International Meeting of the Psychometric Society, Zurich, 2017}. Cambridge, UK: Cambridge Assessment.
#'
#' Haberman, S. J. (1984). Adjustment by minimum discriminant information.
#' \emph{The Annals of Statistics, 12}(3), 971-988.
#'
#' Liang, T., & von Davier, A. A. (2014). Cross-validation: An alternative bandwidth-selection method in kernel equating.
#' \emph{Applied Psychological Measurement, 38}(4), 281-295.
#'
#' von Davier, A. A., & Chen, H. (2013). The Kernel Levine Equipercentile Observed-Score Equating Function. ETS Research Report Series.
#'
#' @name KernEqWPS-package
#' @title KernEqWPS (Kernel Equating Without Pre-Smoothing).
#' @author Tom Benton, Cambridge Assessment.
#' @examples
#' library(KernEqWPS)
#'
#' #break maths data into 3 pseudo-tests and then apply equating between tests
#' #define which items will go in each form
#' #(this could also be done using the "SampleItemsToHitTarget" function)
#' dim(mathsdata)
#' itesX=seq(1,121,3)#form X is every third item
#' itesY=seq(2,122,3)#form Y is every third item starting at q2
#' itesA=seq(3,123,15)#form A (external anchor) is every fifteenth item starting at q3
#'
#' #make form scores on the same items in two populations and look at some descriptive statistics
#' #population P (typical ability group)
#' XP=rowSums(mathsdata[,itesX])
#' YP=rowSums(mathsdata[,itesY])
#' AP=rowSums(mathsdata[,itesA])
#' summary(XP)
#' summary(YP)
#' summary(AP)
#' cor(cbind(XP,YP,AP))
#' #population Q (high ability group)
#' XQ=rowSums(mathsdata2[,itesX])
#' YQ=rowSums(mathsdata2[,itesY])
#' AQ=rowSums(mathsdata2[,itesA])
#' summary(XQ)
#' summary(YQ)
#' summary(AQ)
#' cor(cbind(XQ,YQ,AQ))
#'
#' #SINGLE GROUP DESIGN
#' #Equate form X to form Y in population P
#' eqEG=KernelEquateFromScoresEG(XP,YP)
#' plot(min(XP):max(XP),eqEG$yxFunc(min(XP):max(XP)),type='l',xlab="x",ylab="y(x)")#make a plot of equating line
#' plot(sort(unique(XP)),eqEG$yx,type='l',xlab="x",ylab="y(x)")#alternative way of getting plot
#'
#' #NEAT DESIGN
#' #(imagine that different populations took different forms but both took an anchor)
#' #Equate form X in population P to form Y in population Q
#'
#' #CHAINED EQUATINNG
#' eqCHAIN=KernelChainedEquate(data.frame(x=XP,a=AP),data.frame(y=YQ,a=AQ))
#' plot(min(XP):max(XP),eqCHAIN$chainedFunc(min(XP):max(XP)),type='l',xlab="x",ylab="y(x)")#make a plot of equating line
#' #compare to criterion equate from single group design
#' plot(min(XP):max(XP),eqCHAIN$chainedFunc(min(XP):max(XP))-eqEG$yxFunc(min(XP):max(XP)),type='l',xlab="x",ylab="Difference from criterion",ylim=c(-4,4))
#'
#' #POST-STRATIFICATION (PSE) EQUATINNG
#' eqPSE=PSEObservedEquate(data.frame(x=XP,a=AP),data.frame(y=YQ,a=AQ),target="x")
#' plot(min(XP):max(XP),eqPSE$KerEquiFunc(min(XP):max(XP)),type='l',xlab="x",ylab="y(x)")#make a plot of equating line
#' #compare to criterion equate from single group design
#' plot(min(XP):max(XP),eqPSE$KerEquiFunc(min(XP):max(XP))-eqEG$yxFunc(min(XP):max(XP)),type='l',xlab="x",ylab="Difference from criterion",ylim=c(-4,4))
#'
#' #LEVINE LINEAR EQUATING
#' eqLEV=LevineObservedEquate(data.frame(x=XP,a=AP),data.frame(y=YQ,a=AQ),ws=c(1,0))
#' plot(min(XP):max(XP),eqLEV$lys(min(XP):max(XP)),type='l',xlab="x",ylab="y(x)")#make a plot of equating line
#' #compare to criterion equate from single group design
#' plot(min(XP):max(XP),eqLEV$lys(min(XP):max(XP))-eqEG$yxFunc(min(XP):max(XP)),type='l',xlab="x",ylab="Difference from criterion",ylim=c(-4,4))
#'
#' #HYBRID PSE-LEVINE EQUATING
#' eqHYB=HybridEquate(data.frame(x=XP,a=AP),data.frame(y=YQ,a=AQ),target="x")
#' plot(min(XP):max(XP),eqHYB$hybridFunc(min(XP):max(XP)),type='l',xlab="x",ylab="y(x)")#make a plot of equating line
#' #compare to criterion equate from single group design
#' plot(min(XP):max(XP),eqHYB$hybridFunc(min(XP):max(XP))-eqEG$yxFunc(min(XP):max(XP)),type='l',xlab="x",ylab="Difference from criterion",ylim=c(-4,4))
#'
#' #EXPERIMENTAL EQUATING USING A TRAINED NEURAL NETWORK
#' eqNN=EquateNN(data.frame(x=XP,a=AP),data.frame(y=YQ,a=AQ),anchortargettable=table(AP))
#' plot(min(XP):max(XP),eqNN$NNEqFunc(min(XP):max(XP)),type='l',xlab="x",ylab="y(x)")#make a plot of equating line
#' #compare to criterion equate from single group design
#' plot(min(XP):max(XP),eqNN$NNEqFunc(min(XP):max(XP))-eqEG$yxFunc(min(XP):max(XP)),type='l',xlab="x",ylab="Difference from criterion",ylim=c(-4,4))
#'
#' #EXPERIMENTAL EQUATING USING An APPROXIMATION TO A TRAINED CONVOLUTIONAL NEURAL NETWORK
#' eqCNN=EquateCNN(data.frame(x=XP,a=AP),data.frame(y=YQ,a=AQ),anchortargettable=table(AP))
#' plot(min(XP):max(XP),eqCNN$CNNEqFunc(min(XP):max(XP)),type='l',xlab="x",ylab="y(x)")#make a plot of equating line
#' #compare to criterion equate from single group design
#' plot(min(XP):max(XP),eqCNN$CNNEqFunc(min(XP):max(XP))-eqEG$yxFunc(min(XP):max(XP)),type='l',xlab="x",ylab="Difference from criterion",ylim=c(-4,4))
#'
#' #weighted mean absolute errors of equating
#' distX=tabulate(XP+1)#count of XP from 1:max(XP)
#' sum(distX*abs(eqCHAIN$chainedFunc(0:max(XP))-eqEG$yxFunc(0:max(XP))))/sum(distX)
#' sum(distX*abs(eqPSE$KerEquiFunc(0:max(XP))-eqEG$yxFunc(0:max(XP))))/sum(distX)
#' sum(distX*abs(eqLEV$lys(0:max(XP))-eqEG$yxFunc(0:max(XP))))/sum(distX)
#' sum(distX*abs(eqHYB$hybridFunc(0:max(XP))-eqEG$yxFunc(0:max(XP))))/sum(distX)
#' sum(distX*abs(eqNN$NNEqFunc(0:max(XP))-eqEG$yxFunc(0:max(XP))))/sum(distX)
#' sum(distX*abs(eqCNN$CNNEqFunc(0:max(XP))-eqEG$yxFunc(0:max(XP))))/sum(distX)
#'
#' @keywords package
"_PACKAGE"
CambridgeAssessmentResearch/KernEqWPS documentation built on Feb. 23, 2024, 9:34 p.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
#' Kernel Equating Without Pre-Smoothing
#'
#' An R package to carry out kernel equating without needing to choose a loglinear model for pre-smoothing.
#' This is desirable since, although pre-smoothing may possibly improve accuracy, skipping this step allows kernel equating to become
#' more straightforward and easier to automate as there are no decisions to make about the order of loglinear models.
#' In addition most of the functions in this package are designed to work in cases where non-integer scores occur.
#' In other words, for most functions, it is not necessary for test scores to be integers.
#'
#' As an alternative to pre-smoothing the package relies on the kernel within kernel equating itself to supply sufficient smoothing
#' to provide accurate results.
#' This may be done either using the plug-in formula of Andersson and von Davier (2014) or by using the method of cross-validation suggested
#' by Liang and von Davier (2014).
#'
#' For the puposes of post-stratification equating (PSE) pre-smoothing would require not only fitting a model to each marginal score
#' distribution but also to the joint relationship between test and anchor forms. In this package this is avoided.
#' Instead, data from different populations is weighted so that the first n moments of scores on the anchor test match.
#' This is achieved using the Adjustment by Minimum Discriminant Information method also known as MDIA (Haberman, 1984).
#' Functions to perform MDIA weighting are included within this package and may potentially be used in contexts aside from equating.
#'
#' Aside from post-stratification and chained equating, this package also implements the hybrid equating method decribed
#' in von Davier and Chen (2013).
#'
#' Finally this package implements two experimental equating methods that were devised by training neural networks
#' to replicate known "true" equating functions within the nonequivalent groups with anchor test (NEAT) design.
#' See Benton (2017) for more details.
#'
#' @references
#' Andersson, B., & von Davier, A. A. (2014). Improving the bandwidth selection in kernel equating.
#' \emph{Journal of Educational Measurement, 51}(3), 223-238.
#'
#' Benton, T. (2017). Can AI learn to equate?,
#' \emph{presented at the International Meeting of the Psychometric Society, Zurich, 2017}. Cambridge, UK: Cambridge Assessment.
#'
#' Haberman, S. J. (1984). Adjustment by minimum discriminant information.
#' \emph{The Annals of Statistics, 12}(3), 971-988.
#'
#' Liang, T., & von Davier, A. A. (2014). Cross-validation: An alternative bandwidth-selection method in kernel equating.
#' \emph{Applied Psychological Measurement, 38}(4), 281-295.
#'
#' von Davier, A. A., & Chen, H. (2013). The Kernel Levine Equipercentile Observed-Score Equating Function. ETS Research Report Series.
#'
#' @name KernEqWPS-package
#' @title KernEqWPS (Kernel Equating Without Pre-Smoothing).
#' @author Tom Benton, Cambridge Assessment.
#' @examples
#' library(KernEqWPS)
#'
#' #break maths data into 3 pseudo-tests and then apply equating between tests
#' #define which items will go in each form
#' #(this could also be done using the "SampleItemsToHitTarget" function)
#' dim(mathsdata)
#' itesX=seq(1,121,3)#form X is every third item
#' itesY=seq(2,122,3)#form Y is every third item starting at q2
#' itesA=seq(3,123,15)#form A (external anchor) is every fifteenth item starting at q3
#'
#' #make form scores on the same items in two populations and look at some descriptive statistics
#' #population P (typical ability group)
#' XP=rowSums(mathsdata[,itesX])
#' YP=rowSums(mathsdata[,itesY])
#' AP=rowSums(mathsdata[,itesA])
#' summary(XP)
#' summary(YP)
#' summary(AP)
#' cor(cbind(XP,YP,AP))
#' #population Q (high ability group)
#' XQ=rowSums(mathsdata2[,itesX])
#' YQ=rowSums(mathsdata2[,itesY])
#' AQ=rowSums(mathsdata2[,itesA])
#' summary(XQ)
#' summary(YQ)
#' summary(AQ)
#' cor(cbind(XQ,YQ,AQ))
#'
#' #SINGLE GROUP DESIGN
#' #Equate form X to form Y in population P
#' eqEG=KernelEquateFromScoresEG(XP,YP)
#' plot(min(XP):max(XP),eqEG$yxFunc(min(XP):max(XP)),type='l',xlab="x",ylab="y(x)")#make a plot of equating line
#' plot(sort(unique(XP)),eqEG$yx,type='l',xlab="x",ylab="y(x)")#alternative way of getting plot
#'
#' #NEAT DESIGN
#' #(imagine that different populations took different forms but both took an anchor)
#' #Equate form X in population P to form Y in population Q
#'
#' #CHAINED EQUATINNG
#' eqCHAIN=KernelChainedEquate(data.frame(x=XP,a=AP),data.frame(y=YQ,a=AQ))
#' plot(min(XP):max(XP),eqCHAIN$chainedFunc(min(XP):max(XP)),type='l',xlab="x",ylab="y(x)")#make a plot of equating line
#' #compare to criterion equate from single group design
#' plot(min(XP):max(XP),eqCHAIN$chainedFunc(min(XP):max(XP))-eqEG$yxFunc(min(XP):max(XP)),type='l',xlab="x",ylab="Difference from criterion",ylim=c(-4,4))
#'
#' #POST-STRATIFICATION (PSE) EQUATINNG
#' eqPSE=PSEObservedEquate(data.frame(x=XP,a=AP),data.frame(y=YQ,a=AQ),target="x")
#' plot(min(XP):max(XP),eqPSE$KerEquiFunc(min(XP):max(XP)),type='l',xlab="x",ylab="y(x)")#make a plot of equating line
#' #compare to criterion equate from single group design
#' plot(min(XP):max(XP),eqPSE$KerEquiFunc(min(XP):max(XP))-eqEG$yxFunc(min(XP):max(XP)),type='l',xlab="x",ylab="Difference from criterion",ylim=c(-4,4))
#'
#' #LEVINE LINEAR EQUATING
#' eqLEV=LevineObservedEquate(data.frame(x=XP,a=AP),data.frame(y=YQ,a=AQ),ws=c(1,0))
#' plot(min(XP):max(XP),eqLEV$lys(min(XP):max(XP)),type='l',xlab="x",ylab="y(x)")#make a plot of equating line
#' #compare to criterion equate from single group design
#' plot(min(XP):max(XP),eqLEV$lys(min(XP):max(XP))-eqEG$yxFunc(min(XP):max(XP)),type='l',xlab="x",ylab="Difference from criterion",ylim=c(-4,4))
#'
#' #HYBRID PSE-LEVINE EQUATING
#' eqHYB=HybridEquate(data.frame(x=XP,a=AP),data.frame(y=YQ,a=AQ),target="x")
#' plot(min(XP):max(XP),eqHYB$hybridFunc(min(XP):max(XP)),type='l',xlab="x",ylab="y(x)")#make a plot of equating line
#' #compare to criterion equate from single group design
#' plot(min(XP):max(XP),eqHYB$hybridFunc(min(XP):max(XP))-eqEG$yxFunc(min(XP):max(XP)),type='l',xlab="x",ylab="Difference from criterion",ylim=c(-4,4))
#'
#' #EXPERIMENTAL EQUATING USING A TRAINED NEURAL NETWORK
#' eqNN=EquateNN(data.frame(x=XP,a=AP),data.frame(y=YQ,a=AQ),anchortargettable=table(AP))
#' plot(min(XP):max(XP),eqNN$NNEqFunc(min(XP):max(XP)),type='l',xlab="x",ylab="y(x)")#make a plot of equating line
#' #compare to criterion equate from single group design
#' plot(min(XP):max(XP),eqNN$NNEqFunc(min(XP):max(XP))-eqEG$yxFunc(min(XP):max(XP)),type='l',xlab="x",ylab="Difference from criterion",ylim=c(-4,4))
#'
#' #EXPERIMENTAL EQUATING USING An APPROXIMATION TO A TRAINED CONVOLUTIONAL NEURAL NETWORK
#' eqCNN=EquateCNN(data.frame(x=XP,a=AP),data.frame(y=YQ,a=AQ),anchortargettable=table(AP))
#' plot(min(XP):max(XP),eqCNN$CNNEqFunc(min(XP):max(XP)),type='l',xlab="x",ylab="y(x)")#make a plot of equating line
#' #compare to criterion equate from single group design
#' plot(min(XP):max(XP),eqCNN$CNNEqFunc(min(XP):max(XP))-eqEG$yxFunc(min(XP):max(XP)),type='l',xlab="x",ylab="Difference from criterion",ylim=c(-4,4))
#'
#' #weighted mean absolute errors of equating
#' distX=tabulate(XP+1)#count of XP from 1:max(XP)
#' sum(distX*abs(eqCHAIN$chainedFunc(0:max(XP))-eqEG$yxFunc(0:max(XP))))/sum(distX)
#' sum(distX*abs(eqPSE$KerEquiFunc(0:max(XP))-eqEG$yxFunc(0:max(XP))))/sum(distX)
#' sum(distX*abs(eqLEV$lys(0:max(XP))-eqEG$yxFunc(0:max(XP))))/sum(distX)
#' sum(distX*abs(eqHYB$hybridFunc(0:max(XP))-eqEG$yxFunc(0:max(XP))))/sum(distX)
#' sum(distX*abs(eqNN$NNEqFunc(0:max(XP))-eqEG$yxFunc(0:max(XP))))/sum(distX)
#' sum(distX*abs(eqCNN$CNNEqFunc(0:max(XP))-eqEG$yxFunc(0:max(XP))))/sum(distX)
#'
#' @keywords package
"_PACKAGE"
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.