# FLQuant
if (!isGeneric("cor")) {
setGeneric("cor", useAsDefault = cor)
}
setMethod("cor", signature("FLQuant"), function (x, y="missing", use = "pairwise.complete.obs", method = "pearson"){
if(!is.na(pmatch(use, c("complete.obs","pairwise.complete.obs")))){
x <- FLCohort(x)
}
x1 <- aperm(x, c(2,1,3,4,5,6))
cx <- apply(x1, c(3,4,5,6), function(z){
res <- cor(z, use=use, method=method)
res[upper.tri(res)] <- NA
data.frame(res)
})
dcx <- dim(x)
dcx[2] <- dim(x)[1]
dn <- dimnames(x)
dn[2] <- dimnames(x)[1]
names(dn)[2] <- quant(x)
cx <- unlist(cx)
cx <- array(cx, dim=dcx, dimnames=dn)
cx
})
setMethod("cor", signature("FLQuant","FLQuant"), function (x, y="missing", use = "complete.obs", method = "pearson"){
lst <- mcf(list(x,y))
x1 <- lst[[1]]
x2 <- lst[[2]]
arr <- array(c(c(x1), c(x2)), dim=c(dim(x1),2))
cx <- apply(arr, c(1,3,4,5,6), function(z){
x0 <- z[,1]
y0 <- z[,2]
cor(x0, y0, use=use, method=method)
})
dn <- dimnames(x)
dn[2] <- NULL
dimnames(cx) <- dn
cx
})
# missing values and 0
setGeneric("mv0", function(object, ...){
standardGeneric("mv0")
}
)
setMethod("mv0", signature("FLQuant"), function(object, ...){
arr <- apply(object@.Data, c(2,3,4,5,6), function(x){
c(sum(is.na(x)), sum(x==0, na.rm=TRUE))
})
dn <- dimnames(object)
dn[[1]] <- c("NA","0")
flq <- FLQuant(arr, dimnames=dn)
quant(flq) <- "check"
flq
})
setMethod("mv0", signature("FLQuants"), function(object, ...){
lst <- lapply(object, function(x) {
arr <- apply(x@.Data, c(2,3,4,5,6), function(y){
c(sum(is.na(y)), sum(y==0, na.rm=TRUE))
})
dn <- dimnames(x)
dn[[1]] <- c("NA","0")
names(dn)[1] <- "check"
dimnames(arr) <- dn
flq <- FLQuant(arr, dimnames=dn)
flq
})
lst <- FLQuants(lst)
names(lst) <- names(object)
lst
})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.