Nothing
pick <- function(data, k=NULL, cutoff=NULL, byItem=FALSE){
x <- data
xnames <- dimnames(data)[[2]]
if (is.null(xnames)) xnames <- paste("Item",1:ncol(data))
if (is.null(byItem)) byItem <- FALSE
isfactor <- sapply(x,is.factor)
if(any(isfactor)){
fac_itm <- which(isfactor)
dd <- x[fac_itm]
options(warn=-1)
xx <- sapply(dd, function(x){as.numeric(as.character(x))})
options(warn=0)
# The following deals with the case that the columns are ordered categorical, but not in numerical-like values
if(sum(is.na(xx))>0){xx<-sapply(dd,as.numeric)}
x[fac_itm] <- xx
}
dims <- dim(x)
K <- ifelse(byItem,dims[2],dims[1])
k1 <- is.null(k)
c1 <- is.null(cutoff)
kc <- k1 +c1
if (kc==0) stop("The arguments k and cutoff cannot be used simultaneously. Only one of them can be different than NULL.")
if (kc==2){
x <- apply(x,byItem+1,function(col) ifelse(col >= mean(col,na.rm = T),1,0))
if (!byItem) x <- t(x)
}
if (kc==1 & c1){
x <- apply(x,byItem+1,function(col){
if(length(col)!=length(unique(as.numeric(col)))){
or <- order(jitter(as.numeric(col)),decreasing = TRUE)
col[or][1:k] <- rep(1,k)
col[or][(k+1):length(or)] <- rep(0,length(col)-k)
}else{
or <- order(as.numeric(col),decreasing = TRUE)
col[or][1:k] <- rep(1,k)
col[or][(k+1):length(or)] <- rep(0,length(col)-k)
}
return(col)
})
if (!byItem) x <- t(x)
}
if (kc==1 & k1){
ll <- length(cutoff)
ll1 <- ll==1
ll2 <- ll==K
ll3 <- sum(ll1+ll2)
if(ll1){
x <- apply(x,byItem+1, function(col) ifelse(col >= cutoff,1,0))
if (!byItem) x <- t(x)
}
if(ll2){
if (byItem){
x <- sapply(1:K, function(col) ifelse(x[,col] < cutoff[col],0,1))
dimnames(x)[[2]] <- xnames
}else{
x <- sapply(1:K, function(col) ifelse(x[col,] < cutoff[col],0,1))
x <- t(x)
dimnames(x)[[2]] <- xnames
}
}
if(ll3==0) stop("length(cutoff) must be equal to 1 or to the number of rows/columns of x")
}
if (any(apply(x,2,function(x) length(unique(x))==1))) warning("there exist items with no variance after applying pick()")
return(data.frame(x))
}
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.