Nothing
#' Computes the psychometric synonym/antonym score
#'
#' Takes a matrix of item responses and identifies item pairs that are highly
#' correlated within the overall dataset.
#' What defines "highly correlated" is set by the critical value (e.g., r > .60).
#' Each respondents' psychometric synonym
#' score is then computed as the within-person correlation between the
#' identified item-pairs.
#' Alternatively computes the psychometric antonym score which is a
#' variant that uses item pairs that are highly \emph{negatively} correlated.
#'
#' @param x is a matrix of item responses
#' @param critval is the minimum magnitude of the correlation between two items
#' in order for them to be considered psychometric synonyms. Defaults to .60
#' @param anto determines whether psychometric antonyms are returned instead of
#' psychometric synonyms. Defaults to \code{FALSE}
#' @param diag additionally return the number of item pairs available for each observation. Useful if dataset contains many missing values.
#' @param resample_na if psychsyn returns NA for a respondent resample to attempt getting a non-NA result.
#' @author Richard Yentes \email{ryentes@gmail.com}, Francisco Wilhelm \email{franciscowilhelm@gmail.com}
#' @references
#' Meade, A. W., & Craig, S. B. (2012). Identifying careless responses in survey data.
#' \emph{Psychological Methods, 17(3)}, 437-455. \doi{10.1037/a0028085}
#' @seealso \code{\link{psychant}} for a more concise way to calculate the psychometric antonym score,
#' \code{\link{psychsyn_critval}} for a helper that allows to set an
#' adequate critical value for the size of the correlation.
#' @export
#' @examples
#' synonyms <- psychsyn(careless_dataset, .60)
#' antonyms <- psychsyn(careless_dataset2, .50, anto = TRUE)
#' antonyms <- psychant(careless_dataset2, .50)
#'
#' #with diagnostics
#' synonyms <- psychsyn(careless_dataset, .60, diag = TRUE)
#' antonyms <- psychant(careless_dataset2, .50, diag = TRUE)
psychsyn <- function(x, critval=.60, anto=FALSE, diag=FALSE, resample_na=TRUE) {
x <- as.matrix(x)
item_pairs <- get_item_pairs(x, critval, anto)
synonyms <- apply(x,1,syn_for_one, item_pairs, resample_na)
synonyms_df <- as.data.frame(aperm(synonyms))
colnames(synonyms_df) <- c("numPairs", "cor")
if(diag==TRUE) { return(synonyms_df) }
else { return(synonyms_df$cor) }
}
# Helper function that identifies psychometric synonyms in a given dataset
get_item_pairs <- function(x, critval=.60, anto=FALSE) {
critval <- abs(critval) #Dummy Proofing
correlations <- stats::cor(x, use = "pairwise.complete.obs")
correlations[upper.tri(correlations, diag=TRUE)] <- NA
correlations <- as.data.frame(as.table(correlations))
# Identifying item pairs differs depending on whether the user wants
# Psychometric Synonyms or Psychometric Antonyms
if(anto==FALSE) {
item_pair_names <- correlations[which(correlations$Freq > critval, arr.ind=TRUE),c(1,2)]
if(nrow(item_pair_names)==0) {
stop("No Psychometric Synonyms found.")
}
}
else if(anto==TRUE) {
item_pair_names <- correlations[which(correlations$Freq < -critval, arr.ind=TRUE),c(1,2)]
if(nrow(item_pair_names)==0) {
stop("No Psychometric Antonyms found.")
}
}
matches <- item_pair_names
return(matches)
}
# Helper function to calculate the within person correlation for a single individual
syn_for_one <- function(x, item_pairs, resample_na) {
item_pairs_omit_na <- which(!(is.na(x[item_pairs[,1]]) | is.na(x[item_pairs[,2]])))
sum_item_pairs <- length(item_pairs_omit_na)
#only execute if more than two item pairs
if(sum_item_pairs > 2) {
itemvalues <- cbind(as.numeric(x[as.numeric(item_pairs[,1])]), as.numeric(x[as.numeric(item_pairs[,2])]))
# helper that calculates within-person correlation
psychsyn_cor <- function(x) {
suppressWarnings(stats::cor(x, use = "pairwise.complete.obs", method = "pearson")[1,2])
}
# if resample_na == TRUE, re-calculate psychsyn should a result return NA
if(resample_na == TRUE) {
counter <- 1
synvalue <- psychsyn_cor(itemvalues)
while(counter <= 10 & is.na(synvalue)) {
itemvalues <- t(apply(itemvalues, 1, sample, 2, replace = F))
synvalue <- psychsyn_cor(itemvalues)
counter = counter+1
}
} else {
synvalue <- psychsyn_cor(itemvalues) # executes if resample_na == FALSE
}
} else {synvalue <- NA} # executes if insufficient item pairs
return(c(sum_item_pairs, synvalue))
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.