R/matrix.na.R

Defines functions matrix.na.z

matrix.na <- function (x, y) {
nvar <- ncol(x)
n.obs = nrow(x)
ny <- ncol(y)
if(nvar!= NROW(y)) stop
result <- matrix(NA,ncol=ny,nrow=n.obs)
for (k in 1:n.obs) {
  for (i in 1:ny ) {
   result[k,i] <- mean(x[k,] * y[,i],na.rm=TRUE)}
   }
result
}

#an attempt to do fast matrixlike operation with missing data\

matrix.na.z		 <- function(x,y,scale=TRUE) {
#first get tranpose x to make multiplication work

nvar <- ncol(x)
if(nvar != nrow(y) ) stop("matrices are not compatible")#matrices are not compatible

if(scale) x <- scale(x) #zero center and standaridize
tx <- t(x) #we want to do  it on the transposed matrix
ny <- ncol(y)
result <- matrix(NA,nrow = nrow(x),ncol= ncol(y))
result <- apply(y,2,function(x ) colSums(x * tx,na.rm=TRUE))
return((result))

}

"impute.na" <- function(x,impute="mean") {
  miss <- which(is.na(x),arr.ind=TRUE)
   if(impute=="mean") {
       		item.means <- colMeans(x,na.rm=TRUE)   #replace missing values with means
       		x[miss]<- item.means[miss[,2]]} else { 
       		item.med   <- apply(items,2,median,na.rm=TRUE) #replace missing with medians
        	x[miss]<- item.med[miss[,2]]} 
    return(x)
 }
 
 
  
score.na <- function ( keys,r,cor=TRUE,smooth=FALSE) {#score a matrix with missing correlations
covar <- apply(keys,2,function(x) colSums(apply(keys,2,function(x) colSums(r*x,na.rm=TRUE))*x,na.rm=TRUE))
count <- t(keys) %*% keys  #counts the number of items/key
bad <- apply(keys,2,function(x) colSums(apply(keys,2,function(x) colSums(is.na(r)*abs(x),na.rm=TRUE))*abs(x),na.rm=TRUE)) #the number missin
good <- apply(keys,2,function(x) colSums(apply(keys,2,function(x) colSums(!is.na(r)*abs(x),na.rm=TRUE))*abs(x),na.rm=TRUE)) #the number not missing

result <- (covar - count)/(good-count) *(good-count + bad)+ count
if(cor) result <- cov2cor(result)
if(smooth) result<- cor.smooth(result)
return(result) #the covariance matrix  use cov2cor
} 

Try the psych package in your browser

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

psych documentation built on June 27, 2024, 5:07 p.m.