Nothing
# Erika Bongen ebongen@stanford.edu
#4/2/2015
###############################################################################
#~ .datasetCheckAll
###############################################################################
#~ .datasetCheckAll checks whether the items within a dataset object
#~ are NULL, have sample IDs listed in a consistent orders, have probe
#~ IDs listed in a consistant order, and are the correct type.
#~
#~ Inputs:
#~ dataset: a Dataset object to be checked (e.g. that class, pheno, expr are all present)
#~ Generates: Prints warning messages explaining the portion of the error checking failed
#~ Returns: True if passed error checking, false if otherwise.
###############################################################################
.datasetCheckAll <- function(dataset) {
nullOK <- .datasetCheckNull(dataset)
rowColOK <- .datasetCheckRowColNames(dataset)
typeOK <- .datasetCheckType(dataset)
if(!nullOK | !rowColOK | !typeOK) {
return(FALSE)
}
keysOK <- .datasetCheckKeys(dataset)
exprOK <- .datasetCheckExpr(dataset)
return(keysOK && exprOK)
}
###############################################################################
#~ .datasetCheckKeys
###############################################################################
#~ .datasetCheckNull warns the user and returns FALSE if all keys are NA
#~
#~ Inputs: datasetObject: a dataset object
#~ Generates: Warning messages if $keys is all NA
#~ Returns: TRUE if not all NA. FALSE if all NA.
###############################################################################
.datasetCheckKeys <- function(datasetObject) {
if(sum(!is.na(datasetObject$keys)) == 0) {
warning(paste("datasetObject$keys are all NA for ",datasetObject$formattedName,". Check your probe mappings to gene names."))
return(FALSE)
}
return(TRUE)
}
###############################################################################
#~ .datasetCheckExpr
###############################################################################
#~ .datasetCheckNull warns the user and returns FALSE if there is an infinite
#~ value in expr
#~
#~ Inputs: datasetObject: a dataset object
#~ Generates: Warning messages if infinite value in expr
#~ Returns: TRUE if no infinite values in expr. FALSE if infinite value in expr.
###############################################################################
.datasetCheckExpr <- function(datasetObject) {
if(sum(is.infinite(datasetObject$expr)) > 0) {
warning(paste("datasetObject$expr contains at least one infinite value in ",datasetObject$formattedName,"."))
return(FALSE)
}
return(TRUE)
}
###############################################################################
#~ .datasetCheckNull
###############################################################################
#~ .datasetCheckNull warns the user and returns FALSE if they have forgetten
#~ to set expr, pheno, or keys. It does not warn the user if the class
#~ vector is null.
#~
#~ Inputs: object: a dataset object
#~ Generates: Warning messages if $expr, $pheno, or $keys is null
#~ Returns: TRUE if nothing is null. FALSE if something is null.
###############################################################################
.datasetCheckNull <- function(datasetObject) {
isThere <- TRUE
if(is.null(datasetObject$expr)) {
warning("datasetObject$expr is null. The expression data is missing.")
isThere <- FALSE
}
if(is.null(datasetObject$pheno)) {
warning("datasetObject$pheno is null. The phenotype data is missing.")
isThere <- FALSE
}
if(is.null(datasetObject$keys)) {
warning("datasetObject$keys is null. The probe keys are missing.")
isThere <- FALSE
}
if(is.null(datasetObject$formattedName)) {
warning("datasetObject$formattedName is null. The formatted name is missing")
}
return(isThere)
}
###############################################################################
#~ .datasetCheckRowColNames
###############################################################################
#~ .datasetCheckRowColNames makes sure that expr, pheno, and class refer to the same
#~ samples in the same order. It also ensures that expr and keys refer to the
#~ same probes in the same order.
#~
#~ Inputs: object, a dataset object
#~ Generates: warning messages when expr, pheno, class, and keys don't match
#~ Returns: TRUE if the samples listed in expr, pheno, and class match and the
#~ probes listed in expr and keys match as well
###############################################################################
.datasetCheckRowColNames <- function(object) {
theyMatch <- TRUE
if (!is.null(object$expr) && !( (all(rownames(object$expr) == names(object$keys))) && (nrow(object$expr) == length(object$keys)) )) {
warning("The probes listed in expr and the probes listed in keys do not match.")
theyMatch <- FALSE
}
if(!all(colnames(object$expr) == rownames(object$pheno))) {
warning("The samples listed in expr and pheno do not match.")
theyMatch <- FALSE
}
if(length(names(object$class)) == 0 && !is.null(object$class)) {
warning("Class vector is not named.")
theyMatch <- FALSE
} else {
if(!all(names(object$class) == colnames(object$expr))) {
warning("The sample names in class do not match the sample names in expr")
theyMatch <- FALSE
}
}
return(theyMatch)
}
###############################################################################
#~ .checkClass
###############################################################################
#~ .checkClass checks to make sure that $class is either: 1) a numeric
#~ vector of 1's, 0's, -1's OR 2) NULL.
#~
#~ 1 --> Case
#~ 0 --> Control
#~ -1 --> Subject to be removed from analysis (in MANATEE)
#~
#~ Inputs: dataset, a dataset object
#~
#~ Outputs: TRUE if $class is a numeric vector of 1's, 0's, -1's OR if
#~ $class is NULL. FALSE if $class is something else.
#~ Also gives warnings explaining how $class is the wrong type.
###############################################################################
.checkClass <- function(dataset) {
isOK <- FALSE
if(is.null(dataset$class)) {
return(TRUE)
} else if (is.vector(dataset$class) && is.numeric(dataset$class) ) {
for (i in dataset$class) {
if (i != 0 && abs(i) != 1) {
warning("Values not equal to 1, 0, or -1 are present in the class vector.")
return(FALSE)
}
}
return(TRUE)
} else {
warning("Class vector is not a numeric vector.")
return(FALSE)
}
}
###############################################################################
#~ .datasetCheckType
###############################################################################
#~ .datasetCheckType makes sure that each item in dataset is the correct type
#~ pheno: data frame
#~ expr: data frame || matrix
#~ class: numeric vector containing 0's and 1's || NULL
#~ keys: vector
#~ formattedName: string || NULL
#~
#~ Input: dataset: a dataset object aka a names list containing
#~ $pheno, $expr, $class, $keys, and $formattedName.
#~
#~ Outputs: TRUE if each item is the correct type. FALSE if any item is wrong.
#~ Also gives warnings to specify which item is wrong.
###############################################################################
.datasetCheckType <- function(dataset) {
phenoOK <- is.data.frame(dataset$pheno)
exprOK <- is.matrix(dataset$expr) && is.numeric(dataset$expr)
classOK <- .checkClass(dataset)
keysOK <- is.vector(dataset$keys)
formattedNameOK <- !is.null(dataset$formattedName) && ((is.character(dataset$formattedName) && (length(dataset$formattedName) == 1)) || (dataset$formattedName == ""))
if(!phenoOK) { warning("pheno must be a data frame.")}
if(!exprOK) {warning("expr must be a numeric matrix.")}
if(!classOK) {warning("class must be either: 1) a numeric vector of 1's and 0's OR 2) NULL")}
if(!keysOK) {warning("keys must be a vector.")}
if(!formattedNameOK) {warning("formattedName must be a string or an empty string.")}
return(classOK && phenoOK && exprOK && keysOK && formattedNameOK)
}
###############################################################################
#~ .metaAnalysisCheckNull
###############################################################################
#~ Checks whether each $entry in a MetaAnalysis object is null
#~
#~ Inputs: a MetaAnaysis object
#~ Generates: A warning describing which $entry is null
#~ Returns: If no $entry is null, then returns TRUE
#~ If one or more $entry is null, then returns FALSE
###############################################################################
.metaAnalysisCheckNull <- function(metaAnalysisObject) {
isNullOK <- TRUE
metaAnalysisEntries <- c("datasetEffectSizes", "datasetEffectSizeStandardErrors",
"pooledResults", "analysisDescription")
pooledResultsEntries <- c("effectSize", "effectSizeStandardError", "effectSizePval",
"effectSizeFDR", "tauSquared", "numStudies", "cochranesQ",
"heterogeneityPval", "fisherStatUp", "fisherPvalUp",
"fisherFDRUp", "fisherStatDown", "fisherPvalDown",
"fisherFDRDown")
for (i in metaAnalysisEntries) {
if(is.null(metaAnalysisObject[[i]])) {
isNullOK <- FALSE
warning(paste(i, "is null."))
}
}
for (i in pooledResultsEntries) {
if(is.null(metaAnalysisObject$pooledResults[[i]])) {
isNullOK <- FALSE
warning(paste("$pooledResults$", i, " is null.", sep=""))
}
}
return(isNullOK)
}
###############################################################################
#~ .metaAnalysisCheckType
###############################################################################
#~ .metaAnalysisCheckType makes sure that each entry within a MetaAnalysis
#~ object is the correct type.
#~
#~ Inputs: a MetaAnalysis object
#~ Generates: a warning if an entry within the object is the incorrect type
#~ Returns: TRUE if all entries within the object are the correct type
#~ FALSE if any entry within the object is the incorrect type
###############################################################################
.metaAnalysisCheckType <- function(metaAnalysisObject) {
if (is.null(metaAnalysisObject)) {
return(FALSE)
}
isTypeOK <- TRUE
metaAnalysisEntries <- c("datasetEffectSizes", "datasetEffectSizeStandardErrors",
"pooledResults", "analysisDescription")
metaAnalysisTypes <- c("matrix", "matrix", "data frame", "string")
pooledResultsEntries <- c("effectSize", "effectSizeStandardError", "effectSizePval",
"effectSizeFDR", "tauSquared", "numStudies", "cochranesQ",
"heterogeneityPval", "fisherStatUp", "fisherPvalUp",
"fisherFDRUp", "fisherStatDown", "fisherPvalDown",
"fisherFDRDown")
pooledResultsTypes <- c("double", "double", "double", "double", "double", "integer",
"double", "double", "double", "double", "double","double",
"double", "double")
pooledResultsRanges <- c("", "non-negative", "range[0,1]", "range[0,1]",
"non-negative","non-negative","non-negative","range[0,1]",
"non-negative","range[0,1]","range[0,1]","non-negative",
"range[0,1]","range[0,1]")
for (i in 1:length(metaAnalysisEntries)) {
if(!(.checkType(metaAnalysisObject[[metaAnalysisEntries[[i]]]], metaAnalysisTypes[[i]]))) {
isTypeOK <- FALSE
warning(metaAnalysisEntries[[i]], " is the wrong type.")
}
}
for (i in 1:length(pooledResultsEntries)) {
if(!.checkType(metaAnalysisObject$pooledResults[[pooledResultsEntries[[i]]]], pooledResultsTypes[[i]], pooledResultsRanges[[i]])) {
isTypeOK <- FALSE
warning("pooledResults$", pooledResultsEntries[[i]], " is the wrong type.")
}
}
return(isTypeOK)
}
###############################################################################
#~ .metaFilterCheckNull
###############################################################################
#~ .metaFilterCheckNull takes a MetaFilter object and makes sure that all the
#~ entries within it are present. It makes sure that nothing is null.
#~ Specifically, it looks for the entries listed in filterEntries within the
#~ function (aka posGeneNames, negGeneNames, FDRThresh, effectSizeThresh, etc)
#~
#~ Inputs: a MetaFilter object
#~
#~ Generates: warning messages describing what entries are null
#~
#~ Returns: TRUE, if no entry is NULL. FALSE, if anything is null.
###############################################################################
.metaFilterCheckNull <- function(metaFilterObject) {
isNullOK <- TRUE
filterEntries <- c("posGeneNames", "negGeneNames", "FDRThresh",
"effectSizeThresh", "numberStudiesThresh", "isLeaveOneOut",
"heterogeneityPvalThresh","filterDescription", "timestamp")
for (i in filterEntries) {
if(is.null(metaFilterObject[[i]])) {
isNullOK <- FALSE
warning(paste(i, "is null."))
}
}
return(isNullOK)
}
###############################################################################
#~ .metaFilterCheckType
###############################################################################
#~ .metaFilterCheckType, takes a MetaFilter object and checks to make sure that
#~ each entry within it are the correct type.
#~ Specifically, it looks at the entries listed in filterEntries:
#~ (aka posGeneNames, negGeneNames, FDRThresh, effectSizeThresh, etc)
#~
#~ Inputs: a MetaFilter object
#~ Generates: warning messages describing which entries are the incorrect type
#~ Returns: TRUE, if each entry is the correct type. FALSE, if anything is the
#~ wrong type.
###############################################################################
.metaFilterCheckType <- function(metaFilterObject) {
isTypeOK <- TRUE
filterEntries <- c("posGeneNames", "negGeneNames", "FDRThresh",
"effectSizeThresh", "numberStudiesThresh", "isLeaveOneOut",
"heterogeneityPvalThresh","filterDescription", "timestamp")
filterTypes <- c("character vector", "character vector", "double", "double", "integer", "boolean", "double", "string", "timestamp")
filterRanges <-c("", "", "range[0,1]", "non-negative", "non-negative", "integer" , "range[0,1]", "", "")
for (j in 1:length(filterEntries)) {
if(!.checkType(metaFilterObject[[filterEntries[[j]]]], filterTypes[[j]], filterRanges[[j]])) {
warning(filterEntries[j], " is the wrong type.")
isTypeOK <- FALSE
}
}
return(isTypeOK)
}
###############################################################################
#~ .metaCheckNull
###############################################################################
#~ .metaCheckNull takes a Meta object and makes sure that each of its entries
#~ are not null. The current version does not use this function.
#~
#~ Inputs: metaObject: a Meta object
#~ Generates: warnings if any of the entries are null
#~ Returns: TRUE if none of the entries are null. FALSE if any are null
###############################################################################
.metaCheckNull <- function(metaObject) {
isNullOK <- TRUE
metaEntries <- c("originalData", "metaAnalysis", "leaveOneOutAnalysis",
"filterResults")
for (i in metaEntries) {
if(is.null(metaObject[[i]])) {
isNullOK <- FALSE
warning(paste("metaObject$", i, " is null."))
}
}
isNullOK <- isNullOK &&
return(isNullOK)
}
###############################################################################
#~ .metaCheckType
###############################################################################
#~ .metaCheckType takes a Meta object and makes sure that all of its entries
#~ are the correct type. Current method does not use this function.
#~
#~ Entries are: $originalData, $metaAnalysis, $leaveOneOutAnalysis,
#~ $filterResults
#~
#~ Inputs: metaObject: a Meta object
#~ Generates: warnings if some entries are the wrong type
#~ Results: TRUE if all of the entries are the right type.
#~ FALSE if any entries are the wrong type
###############################################################################
.metaCheckType <- function(metaObject) {
oriDataOK <- TRUE
for (aDataset in metaObject$originalData) {
oriDataOK<- (oriDataOK && .datasetCheckType(aDataset) && .datasetCheckRowColNames(aDataset))
}
if (!oriDataOK) {
warning("$originalData contains some datasets of the wrong type")
}
metaAnalyOK <- .metaAnalysisCheckType(metaObject$metaAnalysis)
if(!metaAnalyOK) {
warning("$metaAnalysis contains some entries of the wrong type")
}
looOK <- TRUE
for(metaAnaly in metaObject$leaveOneOutAnalysis) {
looOK <- (looOK && .metaAnalysisCheckType(metaAnaly))
}
if (!looOK) {
warning("$leaveOneOutAnalysis contains a MetaAnalysis object of incorrect type.")
}
filterOK <- TRUE
for (filterObj in metaObject$filterResults) {
filterOK <- (filterOK && .metaFilterCheckType(filterObj))
}
if (!filterOK) {
warning("$filterResults contains a MetaFilter object of the wrong type.")
}
return(oriDataOK && metaAnalyOK && looOK && filterOK)
}
###############################################################################
#~ .metaCheckAll
###############################################################################
#~ .metaCheckAll takes in a Meta object and checks of each entry and sub-entry
#~ is not null and is the correct type
#~
#~ Inputs: metaObject, a Meta object
#~ Generates: warning messages denoting what entries are null or the wrong type
#~ Returns: TRUE if everything is not null and the correct type.
#~ FALSE if anything is null or the wrong type.
###############################################################################
.metaCheckAll <- function(metaObject, objectStage) {
#Initialize all the checking booleans
oriDataOK <- TRUE
metaAnalyOK <- TRUE
looOK <- TRUE
filterOK <- TRUE
# Get the list of things to check
if (objectStage == "Pre-Analysis") {
thingsToCheck = c("originalData")
} else if (objectStage == "Pre-Filter") {
thingsToCheck = c("originalData", "metaAnalysis", "leaveOneOutAnalysis")
} else if (objectStage == "Post-Filter") {
thingsToCheck = c("originalData", "metaAnalysis", "leaveOneOutAnalysis", "filterResults")
} else {
warning("objectStage is not a valid type")
oriDataOK = FALSE
thingsToCheck = c("")
}
# originalData
if ("originalData" %in% thingsToCheck) {
if(is.null(metaObject$originalData)) {
warning("$originalData is null.")
oriDataOK <- FALSE
} else {
oriDataVector <- NULL
for (datasetObj in names(metaObject$originalData)) {
#oriDataOK<- (oriDataOK && .datasetCheckType(datasetObj) && .datasetCheckRowColNames(datasetObj) && .datasetCheckNull(datasetObj))
#oriDataOK <- (oriDataOK && .datasetCheckAll(metaObject$originalData[[datasetObj]]) )
oriDataVector <- c(oriDataVector,.datasetCheckAll(metaObject$originalData[[datasetObj]]))
}
for(i in 1:length(oriDataVector)){
oriDataOK <- (oriDataOK && oriDataVector[i])
}
if (!oriDataOK) {
failed_datasets <- names(metaObject$originalData)[which(oriDataVector==FALSE)]
#warning("$originalData contains some datasets that either are null, the wrong type, or have mismatched samples")
warning(paste(c("$originalData contains some datasets that either are null, the wrong type, or have mismatched samples. These are the datasets: ",
paste(failed_datasets,collapse = " ")),
sep = " "))
}
}
}
#metaAnalysis
if ("metaAnalysis" %in% thingsToCheck) {
if (is.null(metaObject$metaAnalysis)) {
warning("$metaAnalysis is null.")
metaAnalyOK <- FALSE
} else {
metaAnalyOK <- (.metaAnalysisCheckType(metaObject$metaAnalysis) && .metaAnalysisCheckNull(metaObject$metaAnalysis))
if(!metaAnalyOK) {
warning("$metaAnalysis contains some entries that are null or of the wrong type")
}
}
}
#leaveOneOutAnalysis
if (("leaveOneOutAnalysis" %in% thingsToCheck) && !is.null(metaObject$leaveOneOutAnalysis)) {
for(metaAnaly in metaObject$leaveOneOutAnalysis) {
looOK <- (looOK && .metaAnalysisCheckType(metaAnaly) && .metaAnalysisCheckNull(metaAnaly))
}
if (!looOK) {
warning("$leaveOneOutAnalysis contains MetaAnalysis object(s) that are null or of incorrect type.")
}
}
#filterResults
if ("filterResults" %in% thingsToCheck) {
if (is.null(metaObject$filterResults)) {
warning("$filterResults is null.")
filterOK <- FALSE
} else {
for (filterObj in metaObject$filterResults) {
filterOK <- (filterOK && .metaFilterCheckType(filterObj) && .metaFilterCheckNull(filterObj))
}
if (!filterOK) {
warning("$filterResults contains a MetaFilter object that is null or of the wrong type.")
}
}
}
return(oriDataOK && metaAnalyOK && looOK && filterOK)
}
###############################################################################
#~ .checkType
###############################################################################
#~ .checkType checks if the type of an object is correct
#~
#~ Inputs: object: the object to check
#~ type: string denoting the type it's supposed to be valid types are:
#~ "integer", "double", "string", "data frame", "character vector",
#~ "boolean"
#~ range: (optional) string denoting the range it's supposed to be
#~ valid ranges are: "non-negative" and "range[0,1]"
#~
#~ Generates: a warning if the object is not the correct type or range
#~
#~ Returns: TRUE if the object is the correct type and range
#~ FALSE if the object is not the correct type or range
###############################################################################
.checkType <- function(object, type, range = "") {
validTypes = c("integer", "double", "string", "data frame", "matrix",
"dataframe or matrix" ,"character vector", "boolean", "timestamp")
validRanges = c("non-negative", "range[0,1]")
typeOK <- TRUE
if (type == "integer") {
if (!(is.numeric(object) && all((object %% 1 == 0)))) {
typeOK <- FALSE
warning("'integer' object", deparse(substitute(object))," is not a numeric integer.")
}
} else if (type == "double") {
if(!is.numeric(object)) {
typeOK <- FALSE
warning("'double' object ", deparse(substitute(object))," is not numeric.")
}
} else if (type == "string") {
if (!( (is.character(object) && (length(object) == 1)) || (object == "") )) {
typeOK <- FALSE
warning("'string' object ", deparse(substitute(object)), " is not a character object of length 1.")
}
} else if (type == "data frame or matrix") {
if (!(is.data.frame(object) || is.matrix(object))) {
typeOK <- FALSE
warning("'data frame' object ", deparse(substitute(object)), " is not a data frame or matrix.")
}
} else if (type == "character vector") {
if (!is.character(object)) {
typeOK <- FALSE
warning("'character vector' object ", deparse(substitute(object)), " is not a character vector.")
}
} else if (type == "boolean") {
if (object != TRUE && object != FALSE) {
typeOK <- FALSE
warning("'boolean' object ", deparse(substitute(object)), " is not a boolean.")
}
} else if (!any(type == validTypes)) {
typeOK <- FALSE
warning("Invalid object type.")
} else if (type == "data frame") {
if (!is.data.frame(object)) {
typeOK <- FALSE
warning("'data frame' object ", deparse(substitute(object)), " is not a data frame.")
}
} else if (type == "matrix") {
if (!is.matrix(object)) {
typeOK <- FALSE
warning("'matrix' object ", deparse(substitute(object)), " is not a matrix.")
}
} else if (type == "timestamp") {
if(!(all(class(object) == c("POSIXct", "POSIXt")))) {
typeOK <- FALSE
warning("'timestamp' object ", deparse(substitute(object)), " is not a POSIXlt or POSIXct." )
}
}
if (range != "" && is.numeric(object)) {
if (range == "non-negative" && any(stats::na.omit(object) < 0)) {
typeOK <- FALSE
warning(deparse(substitute(object)), " contains negative values.")
} else if (range == "range[0,1]" && (any(stats::na.omit(object) > 1) || any(stats::na.omit(object) < 0))) {
typeOK <- FALSE
warning(deparse(substitute(object)), " is not between 0 and 1.")
} else if (!any(range == validRanges)) {
typeOK <- FALSE
warning("Invalid range type for doubles.")
}
}
return(typeOK)
}
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.