R/RcppExports.R

In rapidsplithalf: A Fast Permutation-Based Split-Half Reliability Algorithm

# Generated by using Rcpp::compileAttributes() -> do not edit by hand
# Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393

#' stratifiedItersplits
#' 
#' Generate stratified splits for a single participant
#' 
#' This equally splits what can be equally split within groups.
#' Then it randomly splits all the leftovers to ensure near-equal split sizes.
#' This function is moreso used internally, 
#' but you can use it if you know what you are doing.
#'
#' @param splits Number of iterations.
#' @param groupsizes An integer vector of how many RTs per group need to be stratified.
#' @returns A matrix with zeroes and ones. Each column is a random split.
#' @examples
#' 
#' # We will create splits stratified by stimulus for a single participant
#' data(foodAAT)
#' currdata<-foodAAT[foodAAT$subjectid==3,]
#' currdata$stratfactor<-interaction(currdata$is_pull,currdata$is_target,currdata$stimid)
#' currdata<-currdata[order(currdata$stratfactor),]
#' groupsizes<-rle(as.character(currdata$stratfactor))$lengths
#' 
#' mysplits<-stratifiedItersplits(splits=1000,groupsizes=groupsizes)
#' 
#' # Now the data can be split with the values from any column.
#' half1<-currdata[mysplits[,1]==1,]
#' half2<-currdata[mysplits[,1]==0,]
#' 
#' # Or the split objects can be used as masks for the aggregation functions in this package
#' meansByMask(x=currdata$RT,mask=mysplits==1)
#'  
#' @export
stratifiedItersplits <- function(splits, groupsizes) {
    .Call('_rapidsplithalf_stratifiedItersplits', PACKAGE = 'rapidsplithalf', splits, groupsizes)
}

#' Bootstrap Weights
#' 
#' Create a matrix of bootstrap samples expressed as frequency weights
#'
#' @param size Number of values to bootstrap
#' @param times Number of bootstraps
#' @returns A matrix with bootstrap samples expressed as frequency weights. 
#' Each column represents a single bootstrap iteration and each row represents a case.
#' 
#' @examples
#' # Rapidly compute a bootstrapped median to obtain its standard error
#' myweights<-bootstrapWeights(size=50, times=100)
#' meds<-mediansByWeight(x=rnorm(50),weights=myweights)
#' # SE
#' sd(meds)
#' 
#' @export
bootstrapWeights <- function(size, times) {
    .Call('_rapidsplithalf_bootstrapWeights', PACKAGE = 'rapidsplithalf', size, times)
}

#' Correlate two matrices by column
#' 
#' Correlate each column of 1 matrix with the same column in another matrix
#'
#' @param x,y Matrices whose values to correlate by column.
#' @returns \code{corByColumns()} and \code{corByColumns_mask()} return 
#' a numeric vector of correlations of each pair of columns.
#' 
#' \code{corStatsByColumns()} returns a list with named items:
#' - cormean: the aggregated correlation coefficient of all column pairs (see Details)
#' - allcors: the correlations of each column pair
#' - xvar: the column variances of matrix \code{x}
#' - yvar: the column variances of matrix \code{y}
#' - covar: the covariances of each column pair
#' 
#' @md
#' @details
#' The primary use for these functions is to rapidly compute the correlations
#' between two sets of split-half scores stored in matrix columns.
#' 
#' \code{corStatsByColumns} produces the mean correlation of all column-pairs
#' using the formula \code{mean(covariances) / sqrt(mean(col1variance) * mean(col2variance))}
#' 
#' This method is more accurate than [cormean()] and was suggested by 
#' prof. John Christie of Dalhousie University.
#' 
#' @export
#' @author Sercan Kahveci
#' @examples
#' m1<-matrix((1:9)+rnorm(9),ncol=3)
#' m2<-matrix((9:1)+rnorm(9),ncol=3)
#' corByColumns(m1,m2)
#' 
corByColumns <- function(x, y) {
    .Call('_rapidsplithalf_corByColumns', PACKAGE = 'rapidsplithalf', x, y)
}

#' @rdname corByColumns
#' @param mask Logical matrix marking which data points to include.
#' @export
#' @examples
#' mask<-1-diag(3)
#' corByColumns_mask(m1,m2,mask)
#' 
corByColumns_mask <- function(x, y, mask) {
    .Call('_rapidsplithalf_corByColumns_mask', PACKAGE = 'rapidsplithalf', x, y, mask)
}

#' @rdname corByColumns
#' @export
#' @examples
#' corStatsByColumns(m1,m2)
#' 
corStatsByColumns <- function(x, y) {
    .Call('_rapidsplithalf_corStatsByColumns', PACKAGE = 'rapidsplithalf', x, y)
}

#' Fast matrix column aggregators
#' @name colAggregators
#' 
#' @param x A numeric matrix to compute column aggregates of.
#' 
#' @examples
#' x <- cbind(x1 = 3, x2 = c(4:1, 2:5))
#' colMedians(x)
#' 
#' @seealso \link[base]{colMeans}, \link{mediansByMask}, \link{maskAggregators}
#' @return A numeric vector representing values aggregated by column.
#' @export
#' @author Sercan Kahveci
colMedians <- function(x) {
    .Call('_rapidsplithalf_colMedians', PACKAGE = 'rapidsplithalf', x)
}

#' @rdname colAggregators
#' @export
#' @examples
#' colProds(x)
#' 
colProds <- function(x) {
    .Call('_rapidsplithalf_colProds', PACKAGE = 'rapidsplithalf', x)
}

#' @rdname colAggregators
#' @export
#' @examples
#' colSds(x)
#' 
colSds <- function(x) {
    .Call('_rapidsplithalf_colSds', PACKAGE = 'rapidsplithalf', x)
}

#' @rdname colAggregators
#' @param mask A logical matrix determining which data points to include in 
#' the column-wise aggregations.
#' 
#' @examples
#' mask<-cbind(rep(c(TRUE,FALSE),4),
#'             rep(c(TRUE,FALSE),each=4))
#' colMediansMasked(x,mask)
#' 
#' @export
colMediansMasked <- function(x, mask) {
    .Call('_rapidsplithalf_colMediansMasked', PACKAGE = 'rapidsplithalf', x, mask)
}

#' @rdname colAggregators
#' @export
#' @examples
#' colMeansMasked(x,mask)
#' 
colMeansMasked <- function(x, mask) {
    .Call('_rapidsplithalf_colMeansMasked', PACKAGE = 'rapidsplithalf', x, mask)
}

#' @rdname colAggregators
#' @export
#' @examples
#' colSdsMasked(x,mask)
#' 
colSdsMasked <- function(x, mask) {
    .Call('_rapidsplithalf_colSdsMasked', PACKAGE = 'rapidsplithalf', x, mask)
}

#' @title Multi-mask/weight based aggregators
#' @name maskAggregators
#' @description Methods to aggregate the same vector with different masks or frequency weights.
#' Useful for fast bootstrapping or split-half scoring.
#' A single aggregate value of \code{x} is computed for each column of the mask or weight matrix.
#' 
#' @param x A vector to aggregate over with different masks or weights.
#' @param mask Logical matrix where each column represents a separate vector of masks 
#' to aggregate \code{x} with. Only values marked \code{TRUE} are included in the aggregation.
#' 
#' @examples
#' 
#' # Demonstration of mediansByMask()
#' x<-1:6
#' mask<-rbind(c(TRUE,FALSE,FALSE),
#'             c(TRUE,FALSE,FALSE),
#'             c(FALSE,TRUE,FALSE),
#'             c(FALSE,TRUE,FALSE),
#'             c(FALSE,FALSE,TRUE),
#'             c(FALSE,FALSE,TRUE))
#' mediansByMask(x,mask)
#' 
#' # Compute split-halves for a single 
#' # participant, stratified by stimulus
#' data(foodAAT)
#' currdata<-foodAAT[foodAAT$subjectid==3,]
#' currdata$stratfactor<-
#'   interaction(currdata$is_pull,
#'               currdata$is_target,
#'               currdata$stimid)
#' currdata<-currdata[order(currdata$stratfactor),]
#' groupsizes<-
#'   rle(as.character(currdata$stratfactor))$lengths
#' mysplits<-
#'   stratifiedItersplits(splits=1000,
#'                        groupsizes=groupsizes)
#' 
#' # Median for half 1
#' mediansByMask(currdata$RT,mysplits==1)
#'  
#' @seealso \link{colMedians}, \link{colAggregators}, \link{generateSplits}
#' @return a vector with each value representing an aggregate of the same single input vector 
#' but with different masks or frequency weights applied.
#' @export
#' @author Sercan Kahveci
mediansByMask <- function(x, mask) {
    .Call('_rapidsplithalf_mediansByMask', PACKAGE = 'rapidsplithalf', x, mask)
}

#' @rdname maskAggregators
#' @examples
#' #How to use meansByMask()
#' meansByMask(x,mask)
#' sd(meansByMask(currdata$RT,mysplits==1))
#' 
#' @export
meansByMask <- function(x, mask) {
    .Call('_rapidsplithalf_meansByMask', PACKAGE = 'rapidsplithalf', x, mask)
}

#' @rdname maskAggregators
#' @export
#' @examples
#' # How to use sdsByMask() to compute
#' # mask-based D-scores
#' meansByMask(currdata$RT,mysplits==1) / 
#'   sdsByMask(currdata$RT,mysplits==1)
#' 
sdsByMask <- function(x, mask) {
    .Call('_rapidsplithalf_sdsByMask', PACKAGE = 'rapidsplithalf', x, mask)
}

#' @rdname maskAggregators
#' @param weights Integer matrix where each column represents frequency weights 
#' to weight the aggregation by.
#' @examples
#' # Compute the bootstrapped 
#' # standard error of a median
#' weights<-
#'   bootstrapWeights(size=nrow(currdata),
#'                    times=1000)
#' bootmeds<-mediansByWeight(currdata$RT,weights)
#' sd(bootmeds) # bootstrapped standard error
#' 
#' @export
mediansByWeight <- function(x, weights) {
    .Call('_rapidsplithalf_mediansByWeight', PACKAGE = 'rapidsplithalf', x, weights)
}

#' @rdname maskAggregators
#' @export
#' @examples
#' # Compute the bootstrapped 
#' # standard error of a mean
#' bootmeans<-meansByWeight(currdata$RT,weights)
#' sd(bootmeans) # bootstrapped standard error
#' # exact standard error for comparison
#' sd(currdata$RT)/sqrt(length(currdata$RT)) 
#' 
meansByWeight <- function(x, weights) {
    .Call('_rapidsplithalf_meansByWeight', PACKAGE = 'rapidsplithalf', x, weights)
}

#' @rdname maskAggregators
#' @export
#' @examples
#' # Use sdsByWeight to compute bootstrapped D-scores
#' bootsds<-sdsByWeight(currdata$RT,weights)
#' # bootstrapped standard error of D-score
#' sd(bootmeans/bootsds)
#' 
sdsByWeight <- function(x, weights) {
    .Call('_rapidsplithalf_sdsByWeight', PACKAGE = 'rapidsplithalf', x, weights)
}

#' Exclude SD-based outliers
#' 
#' Different masks (columns of a logical matrix) are applied to the same input vector, 
#' and outliers in each resulting subvector are marked with \code{FALSE} in the mask.
#' 
#' @param x Vector to exclude outliers from.
#' @param mask A logical matrix determining which data points to include and which not to.
#' @param sdlim Standard deviation limit to apply; 
#' values beyond are classified as outliers and masked.
#' @returns An updated mask.
#' @export
#' @examples
#' x<-rnorm(50)
#' x[1]<-100
#' x[2]<-50
#' mask<-matrix(TRUE,ncol=3,nrow=50)
#' mask[1,2]<-FALSE
#' mask[2,3]<-FALSE
#' excludeOutliersByMask(x,mask)
excludeOutliersByMask <- function(x, mask, sdlim = 3) {
    .Call('_rapidsplithalf_excludeOutliersByMask', PACKAGE = 'rapidsplithalf', x, mask, sdlim)
}

#' Exclude SD-based outliers in each matrix column
#' 
#' Generate or update a mask matrix based on outlyingness of values in each column.
#' @name OutlierMaskers
#' @param x Matrix in which to mark SD-based outliers by column.
#' @param sdlim Standard deviation limit to apply; 
#' values beyond are classified as outliers and masked.
#' @returns A logical matrix with outliers (and previously masked values) marked as \code{FALSE}.
#' @export
#' @examples
#' # Generate data with outliers
#' testmat<-matrix(rnorm(100),ncol=2)
#' testmat[1,]<-100
#' testmat[2,]<-50
#' 
#' # Detect outliers
#' maskOutliers(testmat)
#' 
maskOutliers <- function(x, sdlim = 3) {
    .Call('_rapidsplithalf_maskOutliers', PACKAGE = 'rapidsplithalf', x, sdlim)
}

#' @rdname OutlierMaskers
#' @param mask A logical matrix determining which data points to include and which not to.
#' @examples
#' # Generate a mask
#' testmask<-matrix(TRUE,ncol=2,nrow=50)
#' testmask[1,1]<-FALSE
#' 
#' # Detect outliers with pre-existing mask
#' maskOutliersMasked(x=testmat, 
#'                    mask=testmask, sdlim = 3)
#' 
#' @export
maskOutliersMasked <- function(x, mask, sdlim = 3) {
    .Call('_rapidsplithalf_maskOutliersMasked', PACKAGE = 'rapidsplithalf', x, mask, sdlim)
}

ReplaceErrorsFixed <- function(x, mask, error, penalty) {
    .Call('_rapidsplithalf_ReplaceErrorsFixed', PACKAGE = 'rapidsplithalf', x, mask, error, penalty)
}