setClass("CESAnalysis", representation(maf = "data.table", trinucleotide_mutation_weights = "list",
mutrates = "data.table", dndscv_out_list = "list",
excluded = "data.table", selection_results = "list", coverage = "list", epistasis = "list",
ref_key = "character", advanced = "list", ref_data_dir = "character", run_history = "character", samples = "data.table",
mutations = "list"))
#' @export
.DollarNames.CESAnalysis <- function(x, pattern = "") {
features = character()
if(x@maf[, .N] > 0) {
features = c(features, "maf")
}
if(x@samples[, .N] > 0) {
features = c(features, "samples")
}
if(sum(sapply(x@mutations, function(y) y[, .N])) > 0) {
features = c(features, "variants")
}
if(length(x@selection_results) > 0) {
features = c(features, "selection")
}
if(length(x@epistasis) > 0) {
features = c(features, "epistasis")
}
if(x@excluded[, .N] > 0) {
features = c(features, "excluded")
}
if(length(x@trinucleotide_mutation_weights) > 0) {
features = c(features, "trinuc_rates")
if ("signature_weight_table" %in% names(x@trinucleotide_mutation_weights)) {
features = c(features, "mutational_signatures")
}
}
if(x@mutrates[, .N] > 0) {
features = c(features, "gene_rates")
}
if(length(x@dndscv_out_list) > 0) {
features = c(features, "dNdScv_results")
}
features = c(features, "reference_data")
if(length(x@coverage) > 0) {
features = c(features, "coverage_ranges")
}
features = c(features, "run_history")
grep(pattern, features, value=TRUE)
}
setMethod("$", "CESAnalysis",
function(x, name)
{
if(name == "maf") {
if(x@maf[, .N] > 0) {
return(maf_records(x))
}
} else if (name == "samples") {
return(get_sample_info(x))
} else if (name == "excluded") {
return(excluded_maf_records(x))
} else if (name == "trinuc_rates") {
return(get_trinuc_rates(x))
} else if (name == "mutational_signatures") {
return(list(snv_counts = x@trinucleotide_mutation_weights$trinuc_snv_counts,
raw_attributions = get_signature_weights(x, raw = T),
biological_weights = get_signature_weights(x, raw = F),
help = function() cat("See Value in ?trinuc_mutation_rates for methods and tips.\n")))
} else if (name == "gene_rates") {
return(get_gene_rates(x))
} else if (name == "variants") {
cached_variants = copy(x@advanced$cached_variants)
if (is.null(cached_variants)) {
x@advanced$cached_variants = suppressMessages(select_variants(cesa = x))
cached_variants = copy(x@advanced$cached_variants)
}
return(cached_variants)
} else if (name == "selection") {
return(snv_results(x))
} else if (name == "epistasis") {
return(epistasis_results(x))
} else if (name == "reference_data") {
ref_data = list(genome = get_cesa_bsg(x))
snv_signatures = copy(x@advanced$snv_signatures)
if (length(snv_signatures) > 0) {
ref_data = c(ref_data, list(snv_signatures = snv_signatures))
}
return(invisible(ref_data))
} else if (name == "coverage_ranges") {
return(x@coverage)
} else if(name == "dNdScv_results") {
return(lapply(x@dndscv_out_list,
function(y) {
if(is.data.table(y)) {
return(copy(y))
} else {
# for the rare user who requests all dNdScv output
return(y)
}
}))
}
else if (name == "run_history") {
CES_Run_History(x@run_history)
}
}
)
setMethod("show", "CESAnalysis",
function(object) {
genome_name = object@advanced$genome_info$build_name
cat("CESAnalysis of ", genome_name, " data\n", sep = "")
refset_version = object@advanced$refset_version
refset_version_msg = ''
if(! is.null(refset_version) && ! is.na(refset_version)) {
refset_version_msg = paste0(' (v', refset_version, ')')
}
cat("Reference data set: ", object@ref_key, refset_version_msg, "\n", sep = "")
if(object@maf[, .N] > 0) {
cat("Samples:\n")
print(object@samples[, .(num_samples = .N), by = "coverage"], row.names = F)
num_snvs = object@maf[variant_type == "snv", .N]
cat("\nMAF data: ", num_snvs, " SNVs loaded.\n", sep = "")
}
signature_sets = object@advanced$snv_signatures
if (length(signature_sets) > 0) {
signature_set_names = paste(names(signature_sets), collapse = ', ')
cat("Mutational processes: Sample-level extraction of ", signature_set_names, " SNV signatures.\n", sep = "")
}
cat("Run history: See [CESAnalysis]$run_history.\n")
cat(paste0("\n[Created in cancereffectsizeR, version ", object@advanced$version, ".]"))
}
)
setClass("CompoundVariantSet", representation(snvs = "data.table", compounds = "data.table", sample_calls = "list",
cesa_uid = "numeric", cesa_num_samples = "integer"))
setMethod("show", "CompoundVariantSet", function(object) {
num_compound = object@compounds[, .N]
num_snv = object@snvs[, .N]
plural = ifelse(num_compound == 1, '', 's')
plural2 = ifelse(num_snv == 1, '', 's')
msg = paste0("CompoundVariantSet with ", num_compound, " compound variant", plural, " consisting of ",
num_snv, " SNV", plural2, ":\n")
cat(msg)
print(object@compounds, topn = 3)
})
setMethod("length", "CompoundVariantSet", function(x) {
return(x@compounds[, .N])
})
# allow subsetting CompoundVariantSet by index or name (that is, row number/compound_name entry in compound table)
# returns a new CompoundVariantSet; fine interactively but maybe not efficient enough for high-throughput use
setMethod("[", "CompoundVariantSet", function(x, i , j, ..., drop) {
compounds = `[`(x@compounds, i, j, nomatch = NULL, ...)
sample_calls = x@sample_calls[compounds$compound_name]
snvs = x@snvs[compounds$compound_name, on = 'compound_name']
return(new("CompoundVariantSet", compounds = compounds, snvs = snvs, sample_calls = sample_calls,
cesa_uid = x@cesa_uid, cesa_num_samples = x@cesa_num_samples))
})
setMethod("[[", "CompoundVariantSet", function(x, i , j, ..., drop) {
compounds = `[`(x@compounds, i, j, nomatch = NULL, ...)
sample_calls = x@sample_calls[compounds$compound_name]
snvs = x@snvs[compounds$compound_name, on = 'compound_name']
return(new("CompoundVariantSet", compounds = compounds, snvs = snvs, sample_calls = sample_calls,
cesa_uid = x@cesa_uid, cesa_num_samples = x@cesa_num_samples))
})
setMethod('names', "CompoundVariantSet", function(x) {
return(x@compounds$compound_name)
})
setMethod('names<-', "CompoundVariantSet", function(x, value) {
if(length(x) != length(value)) {
stop('Length mismatch on name assignment.')
}
if(is.numeric(value) || is.factor(value)) {
value = as.character(value)
}
if(! is.character(value)) {
stop('Names must be type character (or numeric/factor, which get converted to character).')
}
if(uniqueN(value) != length(value)) {
stop('Names must all be unique.')
}
if(any(sapply(value, nchar) < 1)) {
stop('Names cannot have zero characters.')
}
x@compounds[, old_name := compound_name]
x@compounds[, compound_name := value]
for_snvs = x@compounds[x@snvs$compound_name, compound_name, on = 'old_name']
x@snvs[, compound_name := for_snvs]
for_sample_calls = x@compounds[names(x@sample_calls), compound_name, on = 'old_name']
names(x@sample_calls) = for_sample_calls
x@compounds$old_name = NULL
setcolorder(x@compounds, 'compound_name')
return(x)
})
# thanks to https://stackoverflow.com/a/26080137
as.list.CompoundVariantSet <-function(x) {
lapply(seq_along(x), function(i) x[i])
}
setMethod("as.list", "CompoundVariantSet", as.list.CompoundVariantSet)
#' @export
.DollarNames.CompoundVariantSet <- function(x, pattern = "") {
features = c("compounds", "snv_info", "samples_with", "definitions")
grep(pattern, features, value=TRUE)
}
setMethod("$", "CompoundVariantSet",
function(x, name)
{
if(name == "snv_info") {
return(x@snvs)
} else if (name == "compounds") {
return(x@compounds)
} else if (name == "samples_with") {
return(x@sample_calls)
}else if (name == "definitions") {
tmp = x@snvs[, .(snvs = list(snv_id)), by = "compound_name"]
return(stats::setNames(tmp$snvs, tmp$compound_name))
}
}
)
setClass("CES_Run_History", representation(history = "character"))
CES_Run_History = function(history) {
new("CES_Run_History", history = history)
}
setMethod("show", "CES_Run_History",
function(object) {
run_history = strwrap(object@history, exdent = 4)
writeLines(run_history)
}
)
as.character.CES_Run_History = function(object) {
history = object@history[object@history != ""]
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.