R/svdNorm.R

In fungible: Psychometric Functions from the Waller Lab

###################################################################
## svdNorm:  a function to create theta surrogates from 
## 0/1 item response matrix 


#' Compute theta surrogates via normalized SVD scores
#' 
#' Compute theta surrogates by calculating the normalized left singular vector
#' of a (mean-centered) data matrix.
#' 
#' 
#' @param data N(subjects)-by-p(items) matrix of 0/1 item response data.
#' @return \item{the normalized left singular vector of the mean centered data
#' matrix.}{\code{svdNorm} will center the data automatically.}
#' @author Niels Waller
#' @keywords statistics
#' @export
#' @examples
#' 
#' NSubj <- 2000
#' 
#' ## example item parameters for sample data: k=1 FMP 
#' b <- matrix(c(
#'     #b0    b1     b2    b3      b4   b5 b6 b7  k
#'   1.675, 1.974, -0.068, 0.053,  0,  0,  0,  0, 1,
#'   1.550, 1.805, -0.230, 0.032,  0,  0,  0,  0, 1,
#'   1.282, 1.063, -0.103, 0.003,  0,  0,  0,  0, 1,
#'   0.704, 1.376, -0.107, 0.040,  0,  0,  0,  0, 1,
#'   1.417, 1.413,  0.021, 0.000,  0,  0,  0,  0, 1,
#'  -0.008, 1.349, -0.195, 0.144,  0,  0,  0,  0, 1,
#'   0.512, 1.538, -0.089, 0.082,  0,  0,  0,  0, 1,
#'   0.122, 0.601, -0.082, 0.119,  0,  0,  0,  0, 1,
#'   1.801, 1.211,  0.015, 0.000,  0,  0,  0,  0, 1,
#'  -0.207, 1.191,  0.066, 0.033,  0,  0,  0,  0, 1,
#'  -0.215, 1.291, -0.087, 0.029,  0,  0,  0,  0, 1,
#'   0.259, 0.875,  0.177, 0.072,  0,  0,  0,  0, 1,
#'  -0.423, 0.942,  0.064, 0.094,  0,  0,  0,  0, 1,
#'   0.113, 0.795,  0.124, 0.110,  0,  0,  0,  0, 1,
#'   1.030, 1.525,  0.200, 0.076,  0,  0,  0,  0, 1,
#'   0.140, 1.209,  0.082, 0.148,  0,  0,  0,  0, 1,
#'   0.429, 1.480, -0.008, 0.061,  0,  0,  0,  0, 1,
#'   0.089, 0.785, -0.065, 0.018,  0,  0,  0,  0, 1,
#'  -0.516, 1.013,  0.016, 0.023,  0,  0,  0,  0, 1,
#'   0.143, 1.315, -0.011, 0.136,  0,  0,  0,  0, 1,
#'   0.347, 0.733, -0.121, 0.041,  0,  0,  0,  0, 1,
#'  -0.074, 0.869,  0.013, 0.026,  0,  0,  0,  0, 1,
#'   0.630, 1.484, -0.001, 0.000,  0,  0,  0,  0, 1), 
#'   nrow=23, ncol=9, byrow=TRUE)  
#'  
#' # generate data using the above item paramters
#' data<-genFMPData(NSubj=NSubj, bParam=b, seed=345)$data
#' 
#' # compute (initial) surrogate theta values from 
#' # the normed left singular vector of the centered 
#' # data matrix
#' thetaInit<-svdNorm(data)
#' 
svdNorm <- function(data){  
 
  #Compute theta surrogates: thetaInit
  svdOUT <- svd(sweep(data,2,apply(data,2,mean)))

  ## needed to deal with round off error
  svdu <- round(svdOUT$u[, 1], 10) 
   
  #if sum of 1st right singular vector < 0 then 
  #multiply 1st left singular vector by -1
  if(sum(svdOUT$v[,1]) < 0) svdu<- -svdu
 
  # convert into ranks
  u1.ranks <- rank(svdu)
 
  # convert into percentiles
  Ptiles <-u1.ranks/length(u1.ranks)
  
  # to avoid infinity
  Ptiles[Ptiles==1] <- 1 - 1e-10
 
  # convert into quantiles of N(0,1)
  qnorm(Ptiles, mean=0, sd = 1)
}