Found 158347 results in 8934 files, showing top 50 files (show more).
ExploreModelMatrix:R/ExploreModelMatrix.R: [ ] |
---|
177: class = "fa fa-question-circle",
|
658: class = "fa fa-question-circle",
|
55: ExploreModelMatrix <- function(sampleData = NULL, designFormula = NULL) {
|
1: #' Explore model matrix
|
5: #' matrix graphically in an interactive application.
|
41: #' @importFrom stats model.matrix as.formula relevel cov2cor
|
90: title = paste0("Design matrix visualization (ExploreModelMatrix v",
|
199: class = "fa fa-question-circle",
|
215: id = "design_matrix_box",
|
219: "Design matrix",
|
221: shiny::div(id = "paneltour_design_matrix_box",
|
224: class = "fa fa-question-circle",
|
229: # title = "Design matrix",
|
232: inputId = "design_matrix_type",
|
237: shiny::uiOutput("design_matrix")
|
243: id = "design_matrix_rank_box",
|
249: shiny::div(id = "paneltour_design_matrix_rank_box",
|
252: class = "fa fa-question-circle",
|
259: "Rank of design matrix: ",
|
260: shiny::textOutput("design_matrix_rank"),
|
261: "Number of columns in design matrix: ",
|
262: shiny::textOutput("design_matrix_ncol"),
|
264: "observations - rank of design matrix): "),
|
265: shiny::textOutput("design_matrix_resdf")
|
274: id = "pinv_design_matrix_box",
|
278: "Pseudoinverse of design matrix",
|
280: shiny::div(id = "paneltour_pinv_design_matrix_box",
|
283: class = "fa fa-question-circle",
|
288: # title = "Pseudoinverse of design matrix",
|
291: shiny::uiOutput("pinv_design_matrix")
|
306: class = "fa fa-question-circle",
|
324: id = "cooccurrence_matrix_box",
|
330: shiny::div(id = "paneltour_cooccurrence_matrix_box",
|
333: class = "fa fa-question-circle",
|
340: shiny::uiOutput("cooccurrence_matrix")
|
346: id = "correlation_matrix_box",
|
352: shiny::div(id = "paneltour_correlation_matrix_box",
|
355: class = "fa fa-question-circle",
|
363: shiny::uiOutput("correlation_matrix")
|
447: label = "Text size, matrix entries",
|
465: label = "Text size, matrix entries",
|
486: label = "Text size, matrix entries",
|
498: label = "Text size, matrix entries",
|
561: # Define input to drop columns in design matrix -------------------------
|
569: mm <- stats::model.matrix(stats::as.formula(input$designformula),
|
678: # Generate design matrix ------------------------------------------------
|
679: output$design_matrix_R <- shiny::renderPrint({
|
691: output$design_matrix_DT <- DT::renderDataTable({
|
706: output$design_matrix <- shiny::renderUI({
|
707: if (input$design_matrix_type == "R output") {
|
708: shiny::verbatimTextOutput("design_matrix_R")
|
709: } else if (input$design_matrix_type == "data table") {
|
710: DT::dataTableOutput("design_matrix_DT")
|
712: stop("Unknown design matrix display type")
|
716: # Plot design matrix pseudoinverse --------------------------------------
|
717: output$pinv_design_matrix_plot <- shiny::renderPlot({
|
768: output$pinv_design_matrix <- shiny::renderUI({
|
782: shiny::plotOutput("pinv_design_matrix_plot",
|
788: output$correlation_matrix_plot <- shiny::renderPlot({
|
845: output$correlation_matrix <- shiny::renderUI({
|
859: shiny::plotOutput("correlation_matrix_plot",
|
908: # Check rank and number of columns of design matrix ---------------------
|
909: output$design_matrix_rank <- shiny::renderText({
|
925: output$design_matrix_ncol <- shiny::renderText({
|
941: output$design_matrix_resdf <- shiny::renderText({
|
974: msg <- paste0("**The design matrix is not full rank.**<br><br> ",
|
976: "in the design matrix can be obtained by ",
|
984: "and columns in the design matrix with all zero ",
|
1018: "in your design matrix as you have samples in ",
|
1044: # Generate design matrix plot -------------------------------------------
|
1075: # Plot cooccurrence matrix ----------------------------------------------
|
1076: output$cooccurrence_matrix_plot <- shiny::renderPlot({
|
1093: output$cooccurrence_matrix <- shiny::renderUI({
|
1101: shiny::plotOutput("cooccurrence_matrix_plot",
|
1123: "sample_table_summary_box", "design_matrix_box",
|
1124: "design_matrix_rank_box", "pinv_design_matrix_box",
|
1125: "vifs_box", "cooccurrence_matrix_box",
|
1126: "correlation_matrix_box"),
|
23: #' app <- ExploreModelMatrix(
|
91: utils::packageVersion("ExploreModelMatrix"), ")"),
|
612: designMatrix = NULL)
|
688: generated_output()$designmatrix
|
700: DT::datatable(data.frame(generated_output()$designmatrix,
|
797: if (is.null(generated_output()$designmatrix)) {
|
800: tmp <- generated_output()$designmatrix
|
918: if (is.null(generated_output()$designmatrix)) {
|
921: qr(generated_output()$designmatrix)$rank
|
934: if (is.null(generated_output()$designmatrix)) {
|
937: ncol(generated_output()$designmatrix)
|
950: if (is.null(generated_output()$designmatrix)) {
|
953: nrow(generated_output()$designmatrix) -
|
954: qr(generated_output()$designmatrix)$rank
|
966: if (is.null(generated_output()$designmatrix)) {
|
969: if (qr(generated_output()$designmatrix)$rank >=
|
970: ncol(generated_output()$designmatrix)) {
|
973: nonestim <- limma::nonEstimable(generated_output()$designmatrix)
|
1009: if (is.null(generated_output()$designmatrix)) {
|
1012: if (qr(generated_output()$designmatrix)$rank <
|
1013: nrow(generated_output()$designmatrix)) {
|
1109: package = "ExploreModelMatrix"),
|
1131: package = "ExploreModelMatrix"),
|
RNAmodR:R/SequenceData-class.R: [ ] |
---|
194: S4Vectors::setValidity2(Class = "SequenceData", .valid.SequenceData)
|
121: sequenceDataClass <- function(dataType){
|
219: classes <- unlist(lapply(from,class))
|
239: className <- sequenceDataClass(type)
|
306: classes <- lapply(args,class)
|
330: classes <- lapply(args,class)
|
584: className <- sequenceDataClass(dataType)
|
3: #' @include SequenceDataFrame-class.R
|
7: #' @name SequenceData-class
|
10: #' @title The SequenceData class
|
15: #' The \code{SequenceData} class is implemented to contain data on each position
|
19: #' \code{SequenceData} class is a virtual class, from which specific classes can
|
23: #' \item{\code{\link[=CoverageSequenceData-class]{CoverageSequenceData}}}
|
24: #' \item{\code{\link[=EndSequenceData-class]{End5SequenceData}},
|
25: #' \code{\link[=EndSequenceData-class]{End3SequenceData}},
|
26: #' \code{\link[=EndSequenceData-class]{EndSequenceData}}}
|
27: #' \item{\code{\link[=NormEndSequenceData-class]{NormEnd5SequenceData}},
|
28: #' \code{\link[=NormEndSequenceData-class]{NormEnd5SequenceData}}}
|
29: #' \item{\code{\link[=PileupSequenceData-class]{PileupSequenceData}}}
|
30: #' \item{\code{\link[=ProtectedEndSequenceData-class]{ProtectedEndSequenceData}}}
|
39: #' The \code{SequenceData} class is derived from the
|
40: #' \code{\link[IRanges:DataFrameList-class]{CompressedSplitDataFrameList}} class
|
46: #' The \code{SequenceDataFrame} class is a virtual class and contains data for
|
48: #' elements from a \code{SequenceData} object, the SequenceDataFrame class is
|
50: #' \code{\link[=SequenceData-class]{SequenceData}} object. Therefore, a matching
|
51: #' \code{SequenceData} and \code{SequenceDataFrame} class must be implemented.
|
53: #' The \code{SequenceDataFrame} class is derived from the
|
54: #' \code{\link[S4Vectors:DataFrame-class]{DataFrame}} class.
|
60: #' @param dataType The prefix for construction the class name of the
|
84: #' \code{minQuality = 5L}, but this is class dependent).}
|
91: #' @slot sequencesType a \code{character} value for the class name of
|
120: # class names must be compatible with this class name generation function
|
125: stop("Class '",ans,"' not found: ",tmp)
|
131: function(x) class(x)
|
158: matrix(unlist(data_col_types, use.names = FALSE), nrow = 1,
|
163: cat("- ",class(seqinfo(object)), " object with ",
|
231: stop("Cannot coerce ",class(from)," to ",className,".")
|
296: #' @rdname SequenceData-class
|
320: #' @rdname SequenceData-class
|
520: .SequenceDataFrame(class = gsub("SequenceData","",className),
|
603: # create the class
|
667: #' @rdname SequenceData-class
|
676: #' @rdname SequenceData-class
|
684: #' @rdname SequenceData-class
|
692: #' @rdname SequenceData-class
|
700: #' @rdname SequenceData-class
|
708: #' @rdname SequenceData-class
|
716: #' @rdname SequenceData-class
|
724: #' @rdname SequenceData-class
|
732: #' @rdname SequenceData-class
|
740: #' @rdname SequenceData-class
|
748: #' @rdname SequenceData-class
|
756: #' @rdname SequenceData-class
|
764: #' @rdname SequenceData-class
|
783: stop("This functions needs to be implemented by '",class(x),"'.",
|
867: "genomic coordinates. Contact the maintainer of the class used.",
|
888: stop("This functions needs to be implemented by '",class(x),"'.",
|
20: #' be extended. Currently the following classes are implemented:
|
61: #' \code{SequenceData} subclass to be constructed.
|
76: #' \code{SequenceData} classes use all arguments. The arguments are:
|
102: setClass("SequenceData",
|
123: tmp <- try(getClass(ans))
|
130: setMethod("classNameForDisplay", "SequenceData",
|
143: cat(classNameForDisplay(object), " with ", k, " elements ",
|
155: paste0("<", classNameForDisplay(x)[1],">")
|
198: coerceSequenceDataToCompressedSplitDataFrameList <- function(className){
|
200: signature = c(from = className, to = "CompressedSplitDataFrameList"),
|
216: coerceToSequenceData <- function(className) {
|
220: from <- from[classes == paste0(className,"Frame")]
|
222: FUN <- match.fun(className)
|
226: if(is(from,className)){
|
228: } else if(is(from,paste0(className,"Frame"))) {
|
240: coerceSequenceDataToCompressedSplitDataFrameList(className)
|
241: setAs("ANY", className, coerceToSequenceData(className))
|
242: setAs("list", className, coerceToSequenceData(className))
|
307: if(length(unique(classes)) != 1L){
|
331: if(length(unique(classes)) != 1L){
|
458: .SequenceData <- function(className, bamfiles, ranges, sequences, seqinfo, args,
|
466: proto <- new(className)
|
474: stop("Minimum quality is not set for '", className ,"'.",
|
528: ans <- new(className,
|
586: bamfiles <- .norm_bamfiles(bamfiles, className)
|
588: annotation <- .norm_annotation(annotation, className)
|
589: sequences <- .norm_sequences(sequences, className)
|
591: seqinfo <- .norm_seqnames(bamfiles, annotation, sequences, seqinfo, className)
|
604: .SequenceData(className, bamfiles, grl, sequences, seqinfo, args)
|
861: # this needs to be implemented by each subclass
|
457: #' @importClassesFrom IRanges PartitioningByWidth PartitioningByEnd
|
VariantAnnotation:R/methods-VCF-class.R: [ ] |
---|
20: class <- "CollapsedVCF"
|
522: .showVCFSubclass <- function(object)
|
466: SnpMatrixToVCF <- function(from, seqSource)
|
2: ### VCF class methods
|
29: class <- "ExpandedVCF"
|
39: new(class, SummarizedExperiment(assays=geno, rowRanges=rowRanges,
|
248: setReplaceMethod("geno", c("VCF", "character", "matrix"),
|
256: setReplaceMethod("geno", c("VCF", "numeric", "matrix"),
|
264: setReplaceMethod("geno", c("VCF", "missing", "matrix"),
|
403: if (!.compare(lapply(args, class)))
|
404: stop("'...' objects must be of the same VCF class")
|
441: if (!.compare(lapply(args, class)))
|
442: stop("'...' objects must be of the same VCF class")
|
501: GT <- matrix(GT, byrow=TRUE, ncol=nrowGT)
|
565: cat("class:", classNameForDisplay(object), "\n")
|
545: cat(margin, classNameForDisplay(x), " with ",
|
553: cat(margin, classNameForDisplay(x), " with ",
|
561: cat(margin, classNameForDisplay(x), " of length ", lo,
|
TENxIO:R/TENxFileList-class.R: [ ] |
---|
213: matrix <- grep("matrix.mtx", names(fdata), fixed = TRUE, value = TRUE)
|
40: validClasses <- vapply(object, function(ifile) {
|
3: #' @description This class was designed to mainly handle tarballs from
|
8: #' 1. `matrix.mtx.gz` - the counts matrix
|
24: #' @return A `TENxFileList` class object
|
28: Class = "TENxFileList",
|
46: "Some files are not of class 'TENxFile'"
|
66: #' 1. `matrix.mtx.gz` - the counts matrix
|
89: #' "extdata", "pbmc_granulocyte_sorted_3k_ff_bc_ex_matrix.tar.gz",
|
140: #' @describeIn TENxFileList-class Obtain file paths for all files in the object
|
150: #' @describeIn TENxFileList-class An intermediate method for decompressing
|
201: #' @describeIn TENxFileList-class Recursively import files within a
|
216: mat <- datalist[[matrix]]
|
26: #' @exportClass TENxFileList
|
27: .TENxFileList <- setClass(
|
43: if (all(validClasses))
|
RNAmodR:R/Modifier-class.R: [ ] |
---|
327: S4Vectors::setValidity2(Class = "Modifier", .valid_Modifier)
|
2: #' @include SequenceData-class.R
|
3: #' @include SequenceDataSet-class.R
|
4: #' @include SequenceDataList-class.R
|
13: #' @name Modifier-class
|
16: #' @title The Modifier class
|
19: #' The \code{Modifier} class is a virtual class, which provides the central
|
36: #' implemented to store additional arguments, which the base class does not
|
40: #' \code{Modifier()} with a \code{className} matching the specific class to be
|
80: #' @param className The name of the class which should be constructed.
|
86: #' requirements of specific \code{Modifier} class.}
|
99: #' @param seqinfo An optional \code{\link[GenomeInfoDb:Seqinfo-class]{Seqinfo}}
|
107: #' \item{additional parameters depending on the specific \code{Modifier} class}
|
119: #' \code{\link[Modstrings:ModDNAString]{ModDNAString}} class.
|
121: #' @slot dataType the class name(s) of the \code{SequenceData} class used
|
154: #' @param x,object a \code{Modifier} or \code{ModifierSet} class
|
166: #' \item{\code{modifierType}:} {a character vector with the appropriate class
|
167: #' Name of a \code{\link[=Modifier-class]{Modifier}}.}
|
169: #' the \code{Modifier} class.}
|
171: #' "RNA" or "DNA" modifications are detected by the \code{Modifier} class.}
|
192: #' modifierType(mi) # The class name of the Modifier object
|
212: #' @rdname Modifier-class
|
246: elementTypes <- vapply(data,class,character(1))
|
249: " ",class(x),". '",paste(dataType(x), collapse = "','"),"' are ",
|
255: class(x),". '",paste(dataType(x), collapse = "','"),"' are ",
|
352: as.matrix(format(as.data.frame(
|
356: matrix(unlist(lapply(settings[[i]], function(x) {
|
372: cat("A", class(object), "object containing",dataType(object),
|
471: definition = function(x){class(x)[[1L]]})
|
601: #' @param x a \code{Modifier} or \code{ModifierSet} class
|
745: "required SequenceData class names.",
|
750: "class names.",
|
753: bamfiles <- bamfiles[match(class,names(bamfiles))]
|
767: function(class){
|
768: do.call(class, c(list(bamfiles = bamfiles,
|
837: #' @rdname Modifier-class
|
846: #' @rdname Modifier-class
|
854: #' @rdname Modifier-class
|
862: #' @rdname Modifier-class
|
870: #' @rdname Modifier-class
|
879: #' @rdname Modifier-class
|
888: #' @rdname Modifier-class
|
907: #' \code{\link[=SequenceData-class]{SequenceData}} object and can be used
|
908: #' directly on a \code{\link[=SequenceData-class]{SequenceData}} object or
|
909: #' indirectly via a \code{\link[=Modifier-class]{Modifier}} object.
|
912: #' \code{\link[=SequenceData-class]{SequenceData}} object, the result summarized
|
913: #' as defined for the individual \code{Modifier} class and stored in the
|
919: #' \code{Modifier} class. The stored data from the \code{aggregate} slot can be
|
928: #' @param x a \code{\link[=SequenceData-class]{SequenceData}},
|
930: #' \code{\link[=Modifier-class]{Modifier}} or
|
931: #' \code{\link[=Modifier-class]{ModfierSet}} object.
|
957: #' \item{\code{\link[=SequenceData-class]{SequenceData}}} {a
|
959: #' \item{\code{\link[=SequenceDataSet-class]{SequenceDataSet}} or
|
960: #' \code{\link[=SequenceDataList-class]{SequenceDataList}}} {a \code{SimpleList}
|
962: #' \item{\code{\link[=Modifier-class]{Modifier}} or
|
963: #' \code{\link[=ModifierSet-class]{ModifierSet}}} {an updated \code{Modifier}
|
982: "Contact the maintainer of the class used.",
|
987: "maintainer of the class used.",
|
993: "genomic coordinates. Contact the maintainer of the class used.",
|
1024: '",class(x),"'.",call. = FALSE)
|
1058: #' \code{\link[=Modifier-class]{Modifier}} class. Usually this is done
|
1069: #' object and has to be implemented for each individual \code{Modifier} class.
|
1118: '",class(x),"'.",call. = FALSE)
|
1124: #' @rdname Modifier-class
|
1130: #' @rdname Modifier-class
|
23: #' Each subclass has to implement the following functions:
|
138: #' @return a \code{Modifier} object of type \code{className}
|
146: #' For the \code{Modifier} and \code{ModifierSet} classes a number of functions
|
214: setClass("Modifier",
|
216: slots = c(seqtype = "character", # this have to be populated by subclass,
|
217: mod = "character", # this have to be populated by subclass
|
218: score = "character", # this have to be populated by subclass
|
219: dataType = "list_OR_character", # this have to be populated by subclass
|
355: classinfo <-
|
357: paste0("<", classNameForDisplay(x)[1],
|
361: out <- rbind(classinfo, out)
|
697: ans <- getClass(ans)@prototype
|
708: .Modifier <- function(className, data){
|
709: proto <- new(className) # create prototype object for mod normalization only
|
720: new(className,
|
729: .load_SequenceData <- function(classes, bamfiles, annotation, sequences,
|
731: if(is.list(classes)){
|
738: if(length(classes) != length(bamfiles)){
|
739: stop("'x' has invalid length. '",paste(classes, collapse = "' and '"),
|
740: "' ",ifelse(length(classes) > 1L,"are","is")," required.",
|
748: if(all(classes %in% names(bamfiles))){
|
754: data <- bpmapply(.load_SequenceData, classes, bamfiles,
|
760: data <- bplapply(classes, .load_SequenceData, bamfiles,
|
765: } else if(is.character(classes)){
|
766: data <- lapply(classes,
|
781: .new_ModFromCharacter <- function(className, x, annotation, sequences, seqinfo,
|
783: # Check that external classes are implemented correctly
|
784: className <- .norm_modifiertype(className)
|
786: proto <- new(className)
|
789: return(new2(className, mod = .norm_mod(proto)))
|
791: bamfiles <- .norm_bamfiles(x, className) # check bam files
|
796: annotation <- .norm_annotation(annotation, className)
|
797: sequences <- .norm_sequences(sequences, className)
|
798: seqinfo <- .norm_seqnames(bamfiles, annotation, sequences, seqinfo, className)
|
806: .new_ModFromSequenceData(className, data, ...)
|
809: .new_ModFromSequenceData <- function(className, x, ...){
|
811: ans <- .Modifier(className, x)
|
842: def = function(className, x, annotation, sequences, seqinfo, ...)
|
850: function(className, x, annotation = NULL, sequences = NULL,
|
852: .new_ModFromSequenceData(className, x, ...)
|
858: function(className, x, annotation = NULL, sequences = NULL,
|
860: .new_ModFromSequenceData(className, x, ...)
|
866: function(className, x, annotation = NULL, sequences = NULL,
|
868: .new_ModFromSequenceData(className, x, ...)
|
874: function(className, x, annotation = NULL, sequences = NULL,
|
876: .new_ModFromCharacter(className, x, annotation, sequences, seqinfo,
|
883: function(className, x, annotation = NULL, sequences = NULL,
|
885: .new_ModFromCharacter(className, x, annotation, sequences, seqinfo,
|
892: function(className, x, annotation = NULL, sequences = NULL,
|
894: .new_ModFromCharacter(className, x, annotation, sequences, seqinfo,
|
926: #' classes wrapper of the \code{aggregate} function exist as well.
|
1126: setClass("RNAModifier",
|
1132: setClass("DNAModifier",
|
27: #' subclasses \code{RNAModifier} and \code{DNAModifier} are already available
|
206: setClassUnion("list_OR_character",
|
208: #' @importClassesFrom Rsamtools BamFileList PileupFiles
|
209: setClassUnion("list_OR_BamFileList",
|
scTHI:R/TME_classification.R: [ ] |
---|
132: Class <- apply(NES, 2, function(x) {
|
146: ClassLegend <- phenotype$Color
|
150: Classification <- list(Class, ClassLegend)
|
39: TME_classification <- function(expMat,
|
9: #' @param expMat Gene expression matrix where rows are genes
|
32: #' Class <- TME_classification(scExample)
|
33: #' @return A list with two items: Class (character) and ClassLegend
|
137: Class <- apply(NES, 2, function(x) {
|
141: Class[colSums(NES != 0) < nNES] <- "nc"
|
142: phenotype <- signaturesColors[Class, ]
|
143: rownames(phenotype) <- names(Class)
|
144: Class <- phenotype$ALLPhenotypeFinal
|
145: names(Class) <- rownames(phenotype)
|
149: #print(sort(table(Class), decreasing = TRUE))
|
151: names(Classification) <- c("Class", "ClassLegend")
|
1: #' TME_classification
|
3: #' The function allows the user to classify non-tumor cells in tumor
|
26: #' @param nNES Default is 0.58, so each cell is classified with
|
37: #' TME_classification
|
147: names(ClassLegend) <- phenotype$ALLPhenotypeFinal
|
148: ClassLegend <- ClassLegend[!duplicated(ClassLegend)]
|
152: return(Classification)
|
GenomicRanges:R/GPos-class.R: [ ] |
---|
189: Class <- sub("IPos$", "GPos", as.character(class(pos)))
|
395: .COL2CLASS <- c(
|
400: classinfo <- makeClassinfoRowForCompactPrinting(x, .COL2CLASS)
|
368: .from_GPos_to_naked_character_matrix_for_display <- function(x)
|
35: "Starting with BioC 3.10, the class attribute of all ",
|
43: if (class(x) == "GPos")
|
64: ### IRanges/R/IPos-class.R for what that means), they are also on the same
|
188: ## class name returned by class(pos).
|
191: new_GRanges(Class, seqnames=seqnames, ranges=pos, strand=strand,
|
220: class(from) <- "UnstitchedGPos" # temporarily broken instance!
|
228: class(from) <- "StitchedGPos" # temporarily broken instance!
|
252: ### FROM THE TARGET CLASS! (This is a serious flaw in as() current
|
264: class(from) <- "GRanges" # temporarily broken instance!
|
277: ### CTSS class in the CAGEr package) need to define a coercion method to
|
315: if (class(object) != "GPos")
|
330: message("[updateObject] ", class(object), " object ",
|
341: if (class(object) == "GPos") {
|
343: message("[updateObject] Settting class attribute of GPos ",
|
345: class(object) <- class(new("StitchedGPos"))
|
351: class(object), " object is current.\n",
|
376: .from_GPos_to_naked_character_matrix_for_display
|
384: stop(c(wmsg("This ", class(x), " object uses internal representation ",
|
7: setClass("GPos",
|
15: setClass("UnstitchedGPos",
|
22: setClass("StitchedGPos",
|
380: print.classinfo=FALSE, print.seqinfo=FALSE)
|
394: if (print.classinfo) {
|
402: stopifnot(identical(colnames(classinfo), colnames(out)))
|
403: out <- rbind(classinfo, out)
|
419: show_GPos(object, print.classinfo=TRUE, print.seqinfo=TRUE)
|
375: setMethod("makeNakedCharacterMatrixForDisplay", "GPos",
|
391: ## makePrettyMatrixForCompactPrinting() assumes that head() and tail()
|
393: out <- makePrettyMatrixForCompactPrinting(x)
|
QUBIC:src/matrix.h: [ ] |
---|
7: template<typename T> class Matrix {
|
12: Matrix(std::size_t reserved_count) {
|
2: #define MATRIX_H
|
1: #ifndef MATRIX_H
|
SeqVarTools:R/duplicateDiscordance.R: [ ] |
---|
563: class <- .getGenotypeClass(geno)
|
258: class.map <- c("alt", "het", "ref")
|
366: class1 <- .getGenotypeClass(dos1)
|
367: class2 <- .getGenotypeClass(dos2)
|
480: class1 <- .getGenotypeClass(dos1)
|
481: class2 <- .getGenotypeClass(dos2)
|
567: class1 <- class[samp.pairs$sample.id.1,,drop=FALSE]
|
568: class2 <- class[samp.pairs$sample.id.2,,drop=FALSE]
|
255: .getGenotypeClass <- function(x){
|
260: # 0 = alt/alt, 1 = het, 2 = ref/ref, so we can just subset class map by the dosage plus 1
|
261: tmp <- class.map[x + 1]
|
264: if (is.matrix(x)) tmp <- matrix(tmp, nrow=nrow(x))
|
375: n.concordant[i] <- sum(.getMatchesHetHom(class1, class2)[sel])
|
377: n.concordant[i] <- sum(.getMatchesConc(class1, class2)[sel])
|
378: n.alt[i] <- sum(.getAlt(class1, class2)[sel])
|
379: n.alt.conc[i] <- sum(.getMatchesAltConc(class1, class2)[sel])
|
380: n.het.ref[i] <- sum(.getMatchesHetRef(class1, class2)[sel])
|
381: n.het.alt[i] <- sum(.getMatchesHetAlt(class1, class2)[sel])
|
382: n.ref.alt[i] <- sum(.getMatchesRefAlt(class1, class2)[sel])
|
389: n.concordant <- n.concordant + .getMatchesHetHom(class1, class2)
|
391: n.concordant <- n.concordant + .getMatchesConc(class1, class2)
|
392: n.alt <- n.alt + .getAlt(class1, class2)
|
393: n.alt.conc <- n.alt.conc + .getMatchesAltConc(class1, class2)
|
394: n.het.ref <- n.het.ref + .getMatchesHetRef(class1, class2)
|
395: n.het.alt <- n.het.alt + .getMatchesHetAlt(class1, class2)
|
396: n.ref.alt <- n.ref.alt + .getMatchesRefAlt(class1, class2)
|
486: n.concordant[i] <- sum(.getMatchesConc(class1, class2)[sel])
|
487: n.alt[i] <- sum(.getAlt(class1, class2)[sel])
|
488: n.alt.conc[i] <- sum(.getMatchesAltConc(class1, class2)[sel])
|
489: n.het.ref[i] <- sum(.getMatchesHetRef(class1, class2)[sel])
|
490: n.het.alt[i] <- sum(.getMatchesHetAlt(class1, class2)[sel])
|
491: n.ref.alt[i] <- sum(.getMatchesRefAlt(class1, class2)[sel])
|
494: n.concordant <- n.concordant + .getMatchesConc(class1, class2)
|
495: n.alt <- n.alt + .getAlt(class1, class2)
|
496: n.alt.conc <- n.alt.conc + .getMatchesAltConc(class1, class2)
|
497: n.het.ref <- n.het.ref + .getMatchesHetRef(class1, class2)
|
498: n.het.alt <- n.het.alt + .getMatchesHetAlt(class1, class2)
|
499: n.ref.alt <- n.ref.alt + .getMatchesRefAlt(class1, class2)
|
564: rownames(class) <- sample.id
|
572: n.variants = rowSums(.getNonMissing(class1, class2)),
|
573: n.concordant = rowSums(.getMatchesConc(class1, class2)),
|
574: n.alt = rowSums(.getAlt(class1, class2)),
|
575: n.alt.conc = rowSums(.getMatchesAltConc(class1, class2)),
|
576: n.het.ref = rowSums(.getMatchesHetRef(class1, class2)),
|
577: n.het.alt = rowSums(.getMatchesHetAlt(class1, class2)),
|
578: n.ref.alt = rowSums(.getMatchesRefAlt(class1, class2))
|
583: n.samples = colSums(.getNonMissing(class1, class2)),
|
584: n.concordant = colSums(.getMatchesConc(class1, class2)),
|
585: n.alt = colSums(.getAlt(class1, class2)),
|
586: n.alt.conc = colSums(.getMatchesAltConc(class1, class2)),
|
587: n.het.ref = colSums(.getMatchesHetRef(class1, class2)),
|
588: n.het.alt = colSums(.getMatchesHetAlt(class1, class2)),
|
589: n.ref.alt = colSums(.getMatchesRefAlt(class1, class2))
|
123: # definition for the signature with two SeqVarGDSClass objects
|
257: # map for genotype classes
|
ShortRead:R/methods-QA.R: [ ] |
---|
243: class <- class(..1)
|
33: function (class, useFilter = TRUE, addFilter = TRUE, ..., html)
|
37: sprintf("%s.html", class))
|
42: new(class, useFilter = mkScalar(as.logical(useFilter)),
|
191: cat("source:", class(object@src),
|
193: elts <- paste(sapply(object, class), collapse = " ")
|
325: q0 <- as(do.call(class(quality(obj)), list(alphabet)), "matrix")
|
408: q0 <- as(do.call(class(quality(obj)), list(alphabet)), "matrix")
|
424: names(elts) <- sapply(object, class)
|
476: if (length(f)) DataFrame(Flag=f, Summary=class(x))
|
discordant:R/discordant.R: [ ] |
---|
114: class <- cbind(.assignClass(v1, param1, components),
|
236: classMatrix <- discordPPMatrix
|
128: sub.class <- cbind(.assignClass(subSamples$v1, param1, components),
|
163: classVector <- finalResult$class
|
227: discordClass <- c(2,3,4,6,7,8)
|
235: discordPPMatrix <- matrix(NA, nrow = featureSize, ncol = featureSize)
|
269: .assignClass <- function(x, param, components) {
|
34: #' \item{discordPPMatrix}{Matrix of differentially correlated posterior
|
38: #' \item{classMatrix}{Matrix of classes that have hte highest posterior
|
40: #' \item{probMatrix}{Matrix of posterior probabilities where rows are each
|
54: #' The posterior probabilities for each class are generated and outputted into
|
55: #' the value probMatrix. The value probMatrix is a matrix where each column is a
|
56: #' class and each row is a feature pair. The values discordPPVector and
|
58: #' probability for each feature pair. The values classVector and classMatrix
|
59: #' are the class with the highest posterior probability for each feature pair.
|
131: pd <- tryCatch({em.normal.partial.concordant(sub.pdata, sub.class,
|
160: finalResult <- .subSampleData(pdata, class, mu, sigma, nu, tau, pi,
|
165: pd <- tryCatch({em.normal.partial.concordant(pdata, class, components)},
|
172: classVector <- pd$class
|
178: em.normal.partial.concordant <- function(data, class, components) {
|
184: g <- as.integer(nlevels(as.factor(class)))
|
190: zx <- .unmap(class[,1], components = components)
|
191: zy <- .unmap(class[,2], components = components)
|
219: class = apply(array(results[[3]], dim = c(n,g*g)),
|
239: classMatrix[diag] <- classVector
|
241: colnames(classMatrix) <- rownames(x)
|
244: discordPPMatrix <- matrix(discordPPV, nrow = featureSize,
|
246: classMatrix <- matrix(classVector, nrow = featureSize, byrow = FALSE)
|
248: colnames(classMatrix) <- rownames(y)
|
253: rownames(classMatrix) <- rownames(x)
|
261: classMatrix = classMatrix, classVector = classVector,
|
266: # Internal function to assign class to vector based on number of components and
|
294: mat1 <- matrix(v1, nrow = nrow(x), byrow = FALSE)
|
295: mat2 <- matrix(v2, nrow = nrow(x), byrow = FALSE)
|
36: #' \item{classVector}{Vector of classes that have the highest posterior
|
41: #' molecular feature pair and columns are nine different classes}
|
48: #' are five components, then there are two more classes for very negative
|
50: #' combinations for these components are made into classes. If there are three
|
51: #' components, there are 9 classes. If there are five components, there are 25
|
52: #' classes.
|
57: #' discordPPMatrix are the summed differential correlation posterior
|
115: .assignClass(v2, param2, components))
|
129: .assignClass(subSamples$v2, param2, components))
|
175: rtn <- .prepareOutput(x, y, pd, zTable, classVector, components)
|
224: .prepareOutput <- function(x, y, pd, zTable, classVector, components) {
|
229: discordClass <- setdiff(1:25, c(1, 7, 13, 19, 25))
|
232: discordPPV <- apply(zTable, 1, function(x) sum(x[discordClass]) / sum(x))
|
237: diag <- lower.tri(discordPPMatrix, diag = FALSE)
|
238: discordPPMatrix[diag] <- discordPPV
|
240: colnames(discordPPMatrix) <- rownames(x)
|
247: colnames(discordPPMatrix) <- rownames(y)
|
252: rownames(discordPPMatrix) <- rownames(x)
|
255: names(classVector) <- vector_names
|
260: return(list(discordPPMatrix = discordPPMatrix, discordPPVector = discordPPV,
|
262: probMatrix = zTable, loglik = pd$loglik))
|
Modstrings:R/Modstrings-separate.R: [ ] |
---|
844: class <- paste0(class(x),"Set")
|
602: .pos_to_logical_matrix <- function(x, at)
|
53: qualities <- matrix(unlist(qualities),nrow = nlength,byrow = TRUE)
|
54: f_qualities <- matrix(unlist(lapply(coverage(split(ranges,f_names)),
|
578: # convert the position information into a logical list or matrix
|
605: m <- matrix(rep(FALSE,sum(width)),length(x))
|
622: m <- matrix(unlist(m),length(m),byrow = TRUE)
|
694: at <- .pos_to_logical_matrix(as(x, paste0(seqtype(x), "StringSet")),
|
730: at <- .pos_to_logical_matrix(as(x, paste0(seqtype(x), "StringSet"))[f],
|
775: at <- .pos_to_logical_matrix(as(x, paste0(seqtype(x), "StringSet"))[f],
|
835: modValues <- .norm_seqtype_modtype(unlist(mod), seqtype, "short", class(x))
|
845: current_letter <- as(do.call(class, list(current_letter)),
|
846: gsub("Mod","",class))
|
864: at <- .pos_to_logical_matrix(as(x, paste0(seqtype(x), "StringSet")),
|
CHETAH:R/Utils_CHETAH.R: [ ] |
---|
877: class <- class(toplot[,1])
|
680: Classify <- function(input, thresh = 0.1, return_clas = FALSE) {
|
695: classification <- nodeDown(conf = conf, prof = prof, node = 1,
|
984: classification <- input$celltype_CHETAH
|
1143: ClassifyReference <- function(ref_cells, ref_ct = "celltypes",
|
1277: classification <- input$celltype_CHETAH
|
118: CHETAHclassifier <- function (input,
|
20: #' an expression matrix with one (average) reference expression profile
|
147: is(clust_dist(matrix(seq_len(4), nrow = 2)), "dist"),
|
241: input = input, # the input expression matrix
|
242: ref_cells = ref_cells, ## matrix of all reference cells
|
243: ref_types = ref_types, ## types of the ref_cells matrix
|
244: ref_profiles = ref_profiles) ## matrix of the average reference profiles per cell type
|
432: ## Add the profile scores and correlations of all types to one matrix
|
624: ## as.matrix: in cases were a sparse Matrix is used
|
626: cor_i <- suppressWarnings(cor(as.matrix(SummarizedExperiment::assay(input, Env$input_c)[genes, , drop = FALSE]),
|
627: as.matrix(ref_profiles[genes, type, drop = FALSE]),
|
633: cor_t <- suppressWarnings(cor(as.matrix(SummarizedExperiment::assay(ref_cells, Env$ref_c)[genes , current_cells, drop = FALSE]),
|
634: as.matrix(ref_profiles[genes, type, drop = FALSE]),
|
636: cor_ob <- suppressWarnings(cor(as.matrix(SummarizedExperiment::assay(ref_cells, Env$ref_c)[genes , otherbranch_c, drop = FALSE]),
|
637: as.matrix(ref_profiles[genes, type, drop = FALSE]),
|
703: # To make a profile_matrix from a list of reference matrices
|
880: if(class == "factor") {
|
888: if(class == "numeric" | class == 'integer') {
|
909: # Plot boxplots grouped by a class variable
|
910: PlotBox <- function(toplot, class, col = NULL, grad_col = NULL,
|
914: class <- data.frame(class, stringsAsFactors = TRUE)
|
915: col <- col[levels(class[,1])]
|
920: data <- cbind.data.frame(toplot, class)
|
921: colnames(data) <- c("score", "class")
|
924: plot <- ggplot(data, aes_string(x = 'class', y = 'score')) +
|
937: plot <- plot + geom_jitter(aes_string(color = 'class'), size = 0.1)
|
945: plot <- plot + geom_boxplot(aes_string(color = 'class'),
|
1050: #' @param return return the matrix that was used to produce the plot
|
1081: ## Make empty correlation matrix
|
1082: cors <- matrix(NA, nrow = ncol(ref_profiles), ncol = ncol(ref_profiles))
|
1123: #' @param return return the matrix that was used to produce the plot
|
1154: ## Make the correlation matrix
|
1162: cors <- matrix(NA, nrow = lngt, ncol = lngt+1)
|
1195: prof_df <- as.matrix(prof[[node]]) ## approximately 400x faster than on DataFrame
|
1196: conf_df <- as.matrix(conf[[node]])
|
9: #' CHETAH classifies an input dataset by comparing it to
|
27: #' by \code{\link{Classify}})
|
60: #' @param plot.tree Plot the classification tree.
|
74: #' \item \strong{classification} a named vector: the classified types
|
76: #' \item \strong{tree} the hclust object of the classification tree
|
78: #' \item \strong{nodecoor} the coordinates of the nodes of the classification tree
|
93: #' to produce a classification tree (ct).
|
99: #' If this is not the case, classification for the cell will stop in the current node.
|
101: #' these classifications are called \strong{final types}
|
102: #' For other cells, assignment will stop in a node. These classifications
|
174: message("Running without reference cells: classification will only be based on correlations \n")
|
212: ## Make an environment to store the classification information and variables in
|
221: tree = NULL, # will be filled with the classification tree
|
246: ## For plotting purposes, find the x coordinates of the nodes of the classification tree
|
294: ## Add the (visible) classification meta-data
|
295: input <- Classify(input = input, thresh = thresh)
|
303: # of the current node of the classification tree,
|
312: ## (Re)construct the classification tree and cut at the highest node
|
653: #' (Re)classify after running \code{\link{CHETAHclassifier}} using a confidence threshold \cr
|
659: #' Selecting 0 will classify all cells, whereas 2 will result i
|
660: #' n (almost) no cells to be classified. \cr
|
662: #' @param return_clas Instead of returning the SingleCellExperiment, only return the classification vector
|
669: #' ## Classify all cells
|
670: #' input_mel <- Classify(input_mel, 0)
|
672: #' ## Classify only cells with a very high confidence
|
673: #' input_mel <- Classify(input_mel, 1)
|
676: #' input_mel <- Classify(input_mel)
|
678: #' ## Return only the classification vector
|
679: #' celltypes <- Classify(input_mel, 1, return_clas = TRUE)
|
697: names(classification) <- rownames(prof[[1]])
|
698: input$celltype_CHETAH <- classification
|
699: if (return_clas) return(classification) else return(input)
|
728: #' Plots the chetah classification tree with nodes numbered
|
739: #' A ggplot object of the classification tree
|
806: ggtitle("Classification Tree")
|
871: theme_classic() +
|
926: theme_classic() +
|
951: #' Plot the CHETAH classification on 2D visulization like t-SNE
|
952: #' + the corresponding classification tree,
|
958: #' @param tree plot the tree, along with the classification
|
959: #' @param pt.size the point-size of the classication plot
|
961: #' the classification plot should be returned
|
999: extra_nodes <- unique(classification)[!(unique(classification) %in% names(meta_data$nodetypes[[1]]))]
|
1025: toplot <- classification
|
1115: #' Use a reference dataset to classify itself.
|
1128: #' the columns the classifion labels.
|
1131: #' classified to the type of the column name.
|
1133: #' that is classified to an intermediate type
|
1135: #' A good reference would classify nearly 100% of cells of type A to type A.
|
1142: #' ClassifyReference(ref_cells = headneck_ref)
|
1146: ## Classify
|
1190: } ## ClassifyReference
|
1194: ## Do the classification of this node
|
1253: #' In the CHETAH classification, replace the name of a Node
|
1262: #' @param return_clas Instead of returning the SingleCellExperiment, only return the classification vector
|
1265: #' The SingleCellExperiment with the new classification or if `return_clas = TRUE` the classification vector.
|
1282: classification[classification == nodename] <- replacement
|
1295: classification[classification %in% replace] <- replacement
|
1296: input$celltype_CHETAH <- classification
|
1297: if (return_clas) return(classification) else return(input)
|
1304: #' Launch a web page to interactively go trough the classification
|
117: #' input_mel <- CHETAHclassifier(input = input_mel, ref_cells = headneck_ref)
|
299: } ### CHETAHclassifier
|
302: # Called by the CHETAHclassifier. Determines the branches
|
346: # Called by the CHETAHclassifier via SplitNode.
|
657: #' @param input a SingleCellExperiment on which \code{\link{CHETAHclassifier}} has been run
|
730: #' @param input a SingleCellExperiment on which \code{\link{CHETAHclassifier}} has been run
|
820: #' @param input a SingleCellExperiment on which \code{\link{CHETAHclassifier}} has been run
|
955: #' @param input a SingleCellExperiment on which \code{\link{CHETAHclassifier}} has been run
|
1045: #' \code{\link{CHETAHclassifier}}'s ref_cells
|
1047: #' \code{\link{CHETAHclassifier}}'s ref_profiles
|
1051: #' @param n_genes as in \code{\link{CHETAHclassifier}}
|
1052: #' @param fix_ngenes as in \code{\link{CHETAHclassifier}}
|
1053: #' @param print_steps as in \code{\link{CHETAHclassifier}}
|
1054: #' @param only_pos as in \code{\link{CHETAHclassifier}}
|
1120: #' \code{\link{CHETAHclassifier}}'s ref_cells
|
1125: #' \code{\link{CHETAHclassifier}}
|
1147: input <- CHETAHclassifier(input = ref_cells,
|
1256: #' @param input a SingleCellExperiment on which \code{\link{CHETAHclassifier}} has been run
|
1306: #' @param input a SingleCellExperiment on which \code{\link{CHETAHclassifier}} has been run
|
1342: if (is.null(input@int_metadata$CHETAH)) stop('Please run CHETAHclassifier on the SingleCellExperiment object before calling this funtion')
|
BioNERO:R/gcn_inference.R: [ ] |
---|
1281: matrix <- list_mat[[x]]
|
150: cor_matrix <- calculate_cor_adj(cor_method, norm.exp, SFTpower, net_type)$cor
|
151: adj_matrix <- calculate_cor_adj(cor_method, norm.exp, SFTpower, net_type)$adj
|
514: cor_matrix <- cor(as.matrix(MEs), trait, use = "p", method = cor_method)
|
689: cor_matrix <- cor(
|
1247: cor_matrix <- net$correlation_matrix
|
112: #' \item Adjacency matrix
|
116: #' \item Correlation matrix
|
149: if(verbose) { message("Calculating adjacency matrix...") }
|
153: #Convert to matrix
|
154: gene_ids <- rownames(adj_matrix)
|
155: adj_matrix <- matrix(adj_matrix, nrow=nrow(adj_matrix))
|
156: rownames(adj_matrix) <- gene_ids
|
157: colnames(adj_matrix) <- gene_ids
|
159: #Calculate TOM from adjacency matrix
|
160: if(verbose) { message("Calculating topological overlap matrix (TOM)...") }
|
162: TOM <- WGCNA::TOMsimilarity(adj_matrix, TOMType = tomtype)
|
229: kwithin <- WGCNA::intramodularConnectivity(adj_matrix, new.module_colors)
|
232: adjacency_matrix = adj_matrix,
|
236: correlation_matrix = cor_matrix,
|
342: ## Heatmap data frame: 3 columns named `col`, `class`, and `value`
|
350: class = setname,
|
358: nrows <- length(unique(heatmap_df$class))
|
367: geom_tile(aes(x = .data$value, y = .data$class, fill = .data$col)) +
|
411: expr <- as.matrix(t(norm.exp))
|
434: # Create a matrix of labels for the original and all resampling runs
|
435: labels <- matrix(0, nGenes, nRuns + 1)
|
445: ## Convert matrix to list of vectors
|
513: trait <- get_model_matrix(metadata, column_idx = x)
|
515: pvalues <- WGCNA::corPvalueStudent(cor_matrix, nSamples = ncol(exp))
|
519: cor_long <- reshape2::melt(cor_matrix, value.name = "cor", varnames = v)
|
561: # Get a wide matrix of correlations
|
565: cormat <- as.matrix(cormat)
|
568: # Create a matrix of correlations and P-value symbols to display
|
569: ## Get a matrix of P-values and convert values to symbols
|
573: pmat <- pval2symbol(as.matrix(pmat))
|
674: # Make sure samples in expression matrix and sample metadata match
|
688: trait <- get_model_matrix(metadata, column_idx = x)
|
690: as.matrix(t(exp)), trait, use = "p", method = cor_method
|
692: pvalues <- WGCNA::corPvalueStudent(cor_matrix, nSamples = ncol(exp))
|
696: cor_long <- reshape2::melt(cor_matrix, value.name = "cor", varnames = v)
|
748: # Get a wide matrix of correlations
|
752: cormat <- as.matrix(cormat)
|
755: # Create a matrix of correlations and P-value symbols to display
|
756: ## Get a matrix of P-values and convert values to symbols
|
760: pmat <- pval2symbol(as.matrix(pmat))
|
1158: edges <- net$correlation_matrix
|
1181: #' Get edge list from an adjacency matrix for a group of genes
|
1203: #' the correlation matrix was calculated. Only required
|
1212: #' edge lists by filtering the original correlation matrix by the thresholds
|
1246: # Define objects containing correlation matrix and data frame of genes and modules
|
1253: cor_matrix <- cor_matrix[keep, keep]
|
1258: cor_matrix <- cor_matrix[genes, genes]
|
1261: # Should we filter the matrix?
|
1263: # Create edge list from correlation matrix
|
1264: edges <- cormat_to_edgelist(cor_matrix)
|
1277: list_mat <- replicate(length(cutoff), cor_matrix, simplify = FALSE)
|
1282: matrix[matrix < cutoff[x] ] <- NA
|
1283: diag(matrix) <- 0
|
1286: degree <- rowSums(matrix, na.rm=TRUE)
|
1289: matrix[lower.tri(matrix, diag=TRUE)] <- NA
|
1291: # Convert symmetrical matrix to edge list (Gene1, Gene2, Weight)
|
1292: matrix <- na.omit(data.frame(as.table(matrix)))
|
1293: result <- list(matrix = matrix, degree = degree)
|
1322: stop("Please, specify the number of samples used to calculate the correlation matrix")
|
1343: # Create edge list from correlation matrix without filtering
|
1344: edgelist <- cormat_to_edgelist(cor_matrix)
|
psichomics:R/analysis.R: [ ] |
---|
888: warn <- tags$div(class="alert alert-warning", role="alert",
|
969: error <- tagList(h4("t-test"), tags$div(class="alert alert-danger",
|
116: #' @param data One-row data frame/matrix or vector: values per sample for a
|
118: #' @param match Matrix: match between samples and subjects
|
119: #' @param clinical Data frame or matrix: clinical dataset (only required if the
|
254: class(survTime) <- c("data.frame", "survTime")
|
407: class(res) <- c("survTerms", class(res))
|
556: if ("simpleError" %in% class(survTerms)) {
|
686: if ("simpleError" %in% class(survTerms)) return(NA)
|
831: #' @param stat Data frame or matrix: values of the analyses to be performed (if
|
975: warn <- tags$div(class="alert alert-warning", role="alert",
|
1220: type <- sapply(cols, function(i) class(df[[i]]))
|
1861: #' @param data Numeric, data frame or matrix: gene expression data or
|
2005: #' @param data Data frame or matrix
|
2026: # Remove matrix rownames from melted data
|
2064: #' @return A list with class \code{"htest"} containing the following components:
|
2103: class(rval) <- "htest"
|
2373: if (!is.matrix(num)) {
|
2374: num <- t(as.matrix(num))
|
2406: #' @param data Data frame or matrix: gene expression or alternative splicing
|
2527: if (!is.matrix(adjust)) adjust <- t(as.matrix(adjust))
|
2710: type <- sapply(cols, function(i) class(stats[[i]]))
|
2841: #' @param psi Data frame or matrix: alternative splicing quantification
|
3178: div(class="col-sm-6 col-md-4",
|
3179: div(class="thumbnail", style="background:#eee;",
|
3180: div(class="caption", uiOutput(ns(id)))))
|
3193: class="btn-info btn-md btn-block", class="visible-lg visible-md"),
|
3196: class="btn-info btn-xs btn-block", class="visible-sm visible-xs"))
|
3214: actionButton(ns("analyse"), "Perform analyses", class="btn-primary"),
|
3224: div(class="row", card("ttest"), card("levene")),
|
3226: div(class="row", card("wilcox"), card("kruskal"), card("fligner")))
|
3307: event, class=NULL, showPath=FALSE, showText=FALSE,
|
3315: event, class=NULL, showPath=FALSE, showText=FALSE,
|
interactiveDisplay:inst/www/js/d3.v2.js: [ ] |
---|
5000: var chord = {}, chords, groups, matrix, n, padding = 0, sortGroups, sortSubgroups, sortChords;
|
5001: chord.matrix = function(x) {
|
408: function classedConstant() {
|
412: function classedFunction() {
|
2585: var d3_arraySubclass = [].__proto__ ? function(array, prototype) {
|
3640: d3_selectionPrototype.classed = function(name, value) {
|
404: function d3_selection_classedRe(name) {
|
420: function d3_selection_classedName(name) {
|
2: function d3_class(ctor, properties) {
|
2595: d3_class(d3_Map, {
|
2751: d3.transpose = function(matrix) {
|
2752: return d3.zip.apply(d3, matrix);
|
3138: return new d3_transform(t ? t.matrix : d3_transformIdentity);
|
4382: ...(87 bytes skipped)...electAll(".minor").data(subticks, String), subtickEnter = subtick.enter().insert("line", "g").attr("class", "tick minor").style("opacity", 1e-6), subtickExit = d3.transition(subtick.exit()).style("opacity"...(78 bytes skipped)...
|
4384: ...(31 bytes skipped)...ge(scale), path = g.selectAll(".domain").data([ 0 ]), pathEnter = path.enter().append("path").attr("class", "domain"), pathUpdate = d3.transition(path);
|
4387: tickEnter.append("line").attr("class", "tick");
|
4511: bg.enter().append("rect").attr("class", "background").style("visibility", "hidden").style("cursor", "crosshair");
|
4512: fg.enter().append("rect").attr("class", "extent").style("cursor", "move");
|
4513: tz.enter().append("g").attr("class", function(d) {
|
4937: x += matrix[i][j];
|
4951: return sortSubgroups(matrix[i][a], matrix[i][b]);
|
4960: var di = groupIndex[i], dj = subgroupIndex[di][j], v = matrix[di][dj], a0 = x, a1 = x += v * k;
|
5002: if (!arguments.length) return matrix;
|
5003: n = (matrix = x) && matrix.length;
|
367: d3_arraySubclass(groups, d3_selectionPrototype);
|
407: function d3_selection_classed(name, value) {
|
416: name = name.trim().split(/\s+/).map(d3_selection_classedName);
|
418: return typeof value === "function" ? classedFunction : classedConstant;
|
421: var re = d3_selection_classedRe(name);
|
423: if (c = node.classList) return value ? c.add(name) : c.remove(name);
|
424: var c = node.className, cb = c.baseVal != null, cv = cb ? c.baseVal : c;
|
429: if (cb) c.baseVal = cv; else node.className = cv;
|
433: if (cb) c.baseVal = cv; else node.className = cv;
|
516: d3_arraySubclass(selection, d3_selection_enterPrototype);
|
520: d3_arraySubclass(groups, d3_transitionPrototype);
|
651: point = point.matrixTransform(container.getScreenCTM().inverse());
|
3644: if (value = node.classList) {
|
3647: value = node.className;
|
3649: while (++i < n) if (!d3_selection_classedRe(name[i]).test(value)) return false;
|
3653: for (value in name) this.each(d3_selection_classed(value, name[value]));
|
3656: return this.each(d3_selection_classed(name, value));
|
4638: ...(171 bytes skipped)... !/^(n|s)$/.test(resizing) && x, resizingY = !/^(e|w)$/.test(resizing) && y, dragging = eventTarget.classed("extent"), center, origin = mouse(), offset;
|
BANDITS:R/create_data.R: [ ] |
---|
395: Class = rep(classes_tmp, Ngenes)
|
405: class = do.call(c, Class)
|
231: cond_1_gene_per_class = ( n == 1 )
|
316: n_genes_per_class = vapply(genes_in_classes_Together, length, FUN.VALUE = integer(1))
|
411: class_byGene = split(class, gene)
|
273: classes_split_per_gene_Unique = split(all_classes_vector[cond_1_gene_per_class_FINAL], genes_names_Unique)
|
289: classes_Unique = lapply(seq_len(N_genes_Unique), function(x){
|
328: classes_split_per_gene_Together = split( all_classes_vector_Together,
|
343: classes_associated_to_GROUPs = list()
|
382: classes_bigGroup = classes_associated_to_GROUPs[[p]]
|
392: classes_tmp = classes_split_per_gene_Together[classes_bigGroup]
|
424: classes_split_bigGroup = lapply(seq_along(class_byGene), function(x){
|
435: classes_split_bigGroup_num = lapply(classes_split_bigGroup, function(y){
|
441: classes_split_bigGroup_Unique = lapply(seq_along(classes_split_bigGroup), function(id){
|
445: classes_split_bigGroup_Unique_num = lapply(seq_along(classes_split_bigGroup_num), function(id){
|
479: classes_Unique_bigGroup = lapply(seq_len(N_genes_Unique_bigGroup), function(x){
|
530: classes_ALL_together_per_GROUP = lapply(classes_associated_to_GROUPs, function(x){
|
246: cond_1_gene_per_class_FINAL = split(df_tmp$More_genes_in_classes, df_tmp$Class_id)
|
187: all_classes = unique( unlist( lapply(x, function(y){y$class_ids}) ) )
|
191: all_classes_vector = vapply( all_classes, strsplit, split = sep, fixed = TRUE, FUN.VALUE = list(1) )
|
195: match_classes = lapply(x, function(u) match(u$class_ids, all_classes) )
|
212: df_all_classes = data.frame( Class_id=rep(seq_along(n), n), Tr_id = unlist(all_classes_vector) )
|
218: genes_in_classes = split(df_all_classes$Gene_id, df_all_classes$Class_id)
|
233: More_genes_in_classes = unique(unlist(genes_in_classes[cond_1_gene_per_class ==FALSE])) # list the genes happearing together in at least 1 class
|
314: all_classes_vector_Together = all_classes_vector[cond_1_gene_per_class_FINAL==FALSE]
|
315: genes_in_classes_Together = genes_in_classes[cond_1_gene_per_class_FINAL==FALSE]
|
324: genes_in_classes_vector_Together = vapply( genes_in_classes_Together, paste, collapse = sep, FUN.VALUE = character(1) )
|
335: genes_in_classes_split_per_gene_Together = strsplit(names(classes_split_per_gene_Together), split = sep, fixed = TRUE )
|
7: #' @param gene_to_transcript a matrix or data.frame with a list of gene-to-transcript correspondances.
|
15: #' @param kallisto_counts (for kallisto input only) a matrix or data.frame,
|
18: #' The matrix must be unfiltered and the order or rows must be unchanged.
|
29: #' @return A \code{\linkS4class{BANDITS_data}} object.
|
83: ...(18 bytes skipped)...\link{eff_len_compute}}, \code{\link{filter_transcripts}}, \code{\link{filter_genes}}, \code{\linkS4class{BANDITS_data}}
|
104: # check that gene_to_transcript is a matrix or data.frame object
|
105: if( !is.data.frame(gene_to_transcript) & !is.matrix(gene_to_transcript) ){
|
106: message("'gene_to_transcript' must be a matrix or data.frame")
|
111: message("'gene_to_transcript' must be a 2 column matrix or data.frame")
|
188: # unique( unlist( sapply(x, function(y){y$class_ids}) ) )
|
194: # match the class id of each sample to the long vector containing all classes ids.
|
199: # I find the counts of each equiv class in all the samples.
|
200: all_counts = matrix(0, nrow = length(all_classes), ncol = N)
|
201: # I set the matrix to 0: in case of no matching (class not present in a sample)
|
208: # nr of transcripts per class:
|
215: # all_classes_vector is a list: every element of the list corresponds to a class.
|
235: # 1 - mean(cond_1_gene_per_class) # mean of equiv classes with tr from > 1 gene.
|
237: # sum(all_counts[!cond_1_gene_per_class,])/sum(all_counts)
|
241: # check what classes have at least 1 gene happearing with other genes in at least 1 class:
|
244: df_tmp = data.frame( Class_id=rep(seq_along(n), n), Gene_id = unlist(genes_in_classes))
|
247: cond_1_gene_per_class_FINAL = !vapply(cond_1_gene_per_class_FINAL, any, FUN.VALUE = logical(1))
|
248: # !sapply(cond_1_gene_per_class_FINAL, any)
|
251: genes_names_Unique = as.character( genes_in_classes[cond_1_gene_per_class_FINAL] )
|
275: # Collect the counts associated to each class in every gene.
|
276: counts_split_per_gene_Unique = split(data.frame(all_counts[cond_1_gene_per_class_FINAL,]), genes_names_Unique)
|
279: # and make a matrix of 0, 1 indicating, for each class, what transcripts they have.
|
313: all_counts_Together = all_counts[cond_1_gene_per_class_FINAL==FALSE,]
|
321: # maybe I can use a similar approach to the one used to build the classes from the transcripts, although a 2,000 * 17,000 matrix would be quite big...
|
396: Class = unname(Class, force = TRUE) # remove names of top lists of Class
|
397: Class = lapply(Class, unname, force = TRUE) # remove names of each list in Class
|
406: gene = rep(Gene, vapply(Class, length, FUN.VALUE = integer(1)) )
|
407: # sapply(Class, length) )
|
413: genes_bigGroup = names(class_byGene)
|
425: X = class_byGene[[x]]
|
471: # and make a matrix of 0, 1 indicating, for each class, what transcripts they have.
|
510: # Collect the counts associated to each class
|
513: # Then "unlist" the classes and counts of each group: turn them into a single class and cont matrix.
|
540: # and make a matrix of 0, 1 indicating, for each class, what transcripts they have.
|
546: # and then each classes_ALL_together_per_GROUP[[i]][[j]][[1]] has a list per equiv class
|
577: df_eff_len_Unique = data.frame( Class_id=rep(seq_along(n), n), Tr_id = unlist(Transcripts_per_GROUP))
|
580: eff_len_tr_Together = split(df_eff_len_Unique$eff_len, df_eff_len_Unique$Class_id)
|
585: # For each Group, I match (on the truth matrix), the tr_id with the gene_to_transcript
|
590: # use the gene_to_transcript matrix
|
594: df_tmp = data.frame( Class_id=rep(seq_along(n), n), Tr_id = unlist(Transcripts_per_GROUP))
|
597: genes_per_GROUP = split(df_tmp$Gene_id, df_tmp$Class_id)
|
672: # Make a class out of the results:
|
3: #' \code{create_data} imports the equivalence classes and create a 'BANDITS_data' object.
|
9: #' @param salmon_path_to_eq_classes (for salmon input only) a vector of length equals to the number of samples:
|
10: #' each element indicates the path to the equivalence classes of the respective sample (computed by salmon).
|
11: #' @param kallisto_equiv_classes (for kallisto input only) a vector of length equals to the number of samples:
|
12: #' each element indicates the path to the equivalence classes ('.ec' files) of the respective sample (computed by kallisto).
|
14: #' each element indicates the path to the counts of the equivalence classes ('.tsv' files) of the respective sample (computed by kallisto).
|
26: #' When equivalence classes contain transcripts from distinct genes, these genes are analyzed together.
|
56: #' # specify the path to the equivalence classes:
|
57: #' equiv_classes_files = file.path(data_dir, "STAR-salmon", sample_names, "aux_info", "eq_classes.txt")
|
62: #' salmon_path_to_eq_classes = equiv_classes_files,
|
69: #' kallisto_equiv_classes = file.path(data_dir, "kallisto", sample_names, "pseudoalignments.ec")
|
74: #' kallisto_equiv_classes = kallisto_equiv_classes,
|
88: salmon_path_to_eq_classes = NULL,
|
89: kallisto_equiv_classes = NULL,
|
127: n_cores = ifelse(salmon_or_kallisto == "salmon", length(salmon_path_to_eq_classes), length(kallisto_equiv_classes))
|
162: if(salmon_or_kallisto == "salmon"){ # load salmon equivalence classes:
|
164: path_to_eq_classes = salmon_path_to_eq_classes,
|
167: }else{ # load kallisto equivalence classes:
|
169: kallisto_equiv_classes = kallisto_equiv_classes,
|
186: # merge the ids of all classes here:
|
192: # sapply( all_classes, strsplit, split = sep, fixed = TRUE )
|
196: # match_classes is a list, every element of the list refers to a sample.
|
197: # match_classes may now have some NAs.
|
203: match_NA = is.na(match_classes[[i]])
|
204: all_counts[match_classes[[i]][match_NA==FALSE],i] = x[[i]]$counts[match_NA==FALSE]
|
205: # here I filter the classes which were filtered out when filtering the transcripts.
|
209: n = vapply(all_classes_vector, length, FUN.VALUE = integer(1))
|
210: # sapply(all_classes_vector, length)
|
211: # create a data.frame structure keeping the info of what transcritps belong to what classes:
|
213: rownames(df_all_classes) = c()
|
214: # then match equivalence classes to their genes (see readDGE)
|
216: df_all_classes$Gene_id = Gene_id[match(df_all_classes$Tr_id, Tr_id)]
|
219: genes_in_classes = lapply(genes_in_classes, unique)
|
224: genes_SELECTED = unique( df_all_classes$Gene_id ) # All genes
|
227: n = vapply(genes_in_classes, length, FUN.VALUE = integer(1))
|
228: # sapply(genes_in_classes, length)
|
230: ## I need to consider classes with 1 gene only...easy: "cond = sapply(genes_in_classes, length) == 1"
|
232: # sapply(genes_in_class...(7 bytes skipped)...gth) == 1 # But I also need to make sure that the genes respecting "cond" does not happear in other classes!
|
238: # mean counts from these classes
|
242: # in other words, check whether it's on the "More_genes_in_classes" list or not.
|
245: df_tmp$More_genes_in_classes = df_tmp$Gene_id %in% More_genes_in_classes
|
259: genes_SELECTED_Together = unique( df_all_classes$Gene_id[df_all_classes$Gene_id %in% genes_SELECTED_Unique ==FALSE] );
|
272: # Collect, for each gene, the classes associated to it.
|
280: Transcripts_per_gene_Unique = lapply(classes_split_per_gene_Unique, function(x){ unique(unlist(x)) })
|
286: #Error in classes_split_per_gene_Unique[[x]] : subscript out of bounds
|
287: # length(classes_split_per_gene_Unique) == length(counts_split_per_gene_Unique) # TRUE
|
290: m = vapply(classes_split_per_gene_Unique[[x]], function(y){ Transcripts_per_gene_Unique[[x]] %in% y }, FUN.VALUE = l...(53 bytes skipped)...
|
291: # sapply(classes_split_per_gene_Unique[[x]], function(y){ Transcripts_per_gene_Unique[[x]] %in% y })
|
317: # sapply(genes_in_classes_Together, length)
|
319: # First, I need to separate classes corresponding to 1 gene only to classes corresponding to >1 gene...DONE
|
325: # sapply( genes_in_classes_Together, paste, collapse = sep )
|
326: names( genes_in_classes_vector_Together ) = genes_in_classes_vector_Together
|
329: genes_in_classes_vector_Together )
|
332: genes_in_classes_vector_Together )
|
334: # I look for what classes each gene appers in and record whether it happears uniquely or not.
|
336: n_genes = vapply(genes_in_classes_split_per_gene_Together, length, FUN.VALUE = integer(1))
|
337: # sapply(genes_in_classes_split_per_gene_Together, length)
|
340: # I make group of genes to be modelled together and make a correspondance with the classes in classes_split_per_gene_Together
|
350: classes_associated_to_GROUPs[[g_id]] = which( vapply(genes_in_classes_split_per_gene_Together, function(x){ genes_SELECTED_Together[i] %in% x}, FUN.VALUE = logical(1))...(2 bytes skipped)...
|
351: # which( sapply(genes_in_classes_split_per_gene_Together, function(x){ genes_SELECTED_Together[i] %in% x}) )
|
352: GROUPs_of_genes[[g_id]] = unique( unlist(genes_in_classes_split_per_gene_Together[classes_associated_to_GROUPs[[g_id]]]) ) # Genes associated to i-th gene
|
358: classes_associated_to_GROUPs[[g_id]] = unique( c(classes_associated_to_GROUPs[[g_id]],
|
359: which( vapply(genes_in_classes_split_per_gene_Together,
|
362: unlist(genes_in_classes_split_per_gene_Together[classes_associated_to_GROUPs[[g_id]]]) ) )
|
384: # Split genes and define their classes:
|
386: classes_split_per_gene_Together = split( all_classes_vector_Together,
|
387: genes_in_classes_vector_Together )
|
389: genes_in_classes_vector_Together )
|
390: Gene = unlist(genes_in_classes_split_per_gene_Together[classes_bigGroup])
|
393: Ngenes = vapply(genes_in_classes_split_per_gene_Together[classes_bigGroup], length, FUN.VALUE = integer(1))
|
394: # sapply(genes_in_classes_split_per_gene_Together[classes_bigGroup], length)
|
400: Counts = rep(counts_split_per_gene_Together[classes_bigGroup], vapply(genes_in_classes_split_per_gene_Together[classes_bigGroup], length, FUN.VALUE = integer(1)))
|
401: # sapply(genes_in_classes_split_per_gene_Together[classes_bigGroup], length))
|
410: # Split counts and classes by their gene name.
|
432: # Merge Identical classes and add up corresponding counts:
|
434: # put transcript names of classes together as tr1_tr2
|
440: DUPS = lapply(classes_split_bigGroup_num, duplicated)
|
442: classes_split_bigGroup[[id]][ DUPS[[id]] == FALSE ]
|
446: classes_split_bigGroup_num[[id]][ DUPS[[id]] == FALSE ]
|
449: # Select the counts for the unique classes:
|
454: # Select the counts for the duplicated classes:
|
462: match_dups = classes_split_bigGroup_num[[id]][DUPS[[id]]] == classes_split_bigGroup_Unique_num[[id]][i] # I look for the matching between the unique classes and duplicatd ones (eliminated)
|
464: ...(26 bytes skipped)...+ colSums(counts_byGene_DUPS[[id]][match_dups,]) # I add the counts of the corresponding duplicated classes
|
473: Transcripts_per_gene_bigGroup = lapply(classes_split_bigGroup_Unique, function(x){ unique(unlist(x)) })
|
477: N_genes_Unique_bigGroup = length(classes_split_bigGroup_Unique);
|
480: m = vapply(classes_split_bigGroup_Unique[[x]], function(y){ Transcripts_per_gene_bigGroup[[x]] %in% y }, FUN.VALUE =...(57 bytes skipped)...
|
481: # sapply(classes_split_bigGroup_Unique[[x]], function(y){ Transcripts_per_gene_bigGroup[[x]] %in% y })
|
484: # TO DO: REMOVE CLASSES from transcripts which are not present!
|
485: # AND merge classes which are identical.
|
502: classes_Unique = c( classes_Unique, classes_Unique_bigGroup)
|
506: classes_associated_to_GROUPs = classes_associated_to_GROUPs[-bigGroup]
|
512: # I now need to select the classes and counts associated to each "group" of genes
|
514: counts_ALL_together_per_GROUP = lapply(classes_associated_to_GROUPs, function(x){
|
517: #counts_ALL_together_per_GROUP = lapply(classes_associated_to_GROUPs, function(x){
|
533: res[[i]] = classes_split_per_gene_Together[x[i]]
|
541: Transcripts_per_GROUP = lapply(classes_ALL_together_per_GROUP, function(x){ unique(unlist(x)) })
|
545: # since classes_ALL_together_per_GROUP[[i]] has a list per gene,
|
547: # I need to unlist manually classes_ALL_together_per_GROUP
|
549: N_GROUPS = length(classes_ALL_together_per_GROUP)
|
550: classes_ALL_together_per_GROUP_unlisted = list()
|
552: classes_ALL_together_per_GROUP_unlisted[[i]] = list(classes_ALL_together_per_GROUP[[i]][[1]][[1]][[1]])
|
553: J = length(classes_ALL_together_per_GROUP[[i]])
|
555: K = length(classes_ALL_together_per_GROUP[[i]][[j]][[1]])
|
558: classes_ALL_together_per_GROUP_unlisted[[i]] = c(classes_ALL_together_per_GROUP_unlisted[[i]],
|
559: list(classes_ALL_together_per_GROUP[[i]][[j]][[1]][[k]]))
|
565: # From the transcripts, I create the classes
|
566: classes_Together = lapply(seq_along(classes_ALL_together_per_GROUP_unlisted), function(x){
|
567: # m = sapply(classes_ALL_together_per_GROUP_unlisted[[x]], function(y){ Transcripts_per_GROUP[[x]] %in% unlist(y) })
|
568: m = vapply(classes_ALL_together_per_GROUP_unlisted[[x]], function(y){ Transcripts_per_GROUP[[x]] %in% unlist(y) }, F...(59 bytes skipped)...
|
615: classes_Unique = classes_Unique[SEL_tr]
|
633: classes_Together = classes_Together[SEL_tr]
|
637: # automatically check the coherence of the matrixed in UNIQUE:
|
641: K = length(Transcripts_per_gene_Unique[[i]]); J = ncol(data.frame(classes_Unique[[i]]))
|
643: {length(eff_len_tr_Unique[[i]]) == K} & {nrow(data.frame(classes_Unique[[i]])) == K} & {nrow(counts_split_per_gene_Unique[[i]]) == J} & {ncol(counts_split_per_ge...(22 bytes skipped)...
|
647: message("something wrong in Unique classes")
|
651: # automatically check the coherence of the matrixed in TOGETHER:
|
656: K = nrow(classes_Together[[i]]); J = ncol(classes_Together[[i]])
|
662: message("something wrong in Together classes")
|
682: classes = c(classes_Unique, classes_Together),
|
scde:R/functions.R: [ ] |
---|
6015: matrix <- gcl$vmap[rev(gcl$row.order), results$hvc$order, drop = FALSE]
|
6083: matrix <- results$rcm[rev(results$tvc$order), results$hvc$order]
|
6324: matrix <- results$rcm[rev(results$tvc$order), results$hvc$order]
|
1079: winsorize.matrix <- function(mat, trim) {
|
3405: calculate.joint.posterior.matrix <- function(lmatl, n.samples = 100, bootstrap = TRUE, n.cores = 15) {
|
3422: calculate.batch.joint.posterior.matrix <- function(lmatll, composition, n.samples = 100, n.cores = 15) {
|
3810: get.exp.posterior.matrix <- function(m1, counts, marginals, grid.weight = rep(1, nrow(marginals)), rescale = TRUE, n.cores =...(17 bytes skipped)...
|
3826: get.exp.logposterior.matrix <- function(m1, counts, marginals, grid.weight = rep(1, nrow(marginals)), rescale = TRUE, n.cores =...(6 bytes skipped)...
|
109: ##' Filter counts matrix
|
111: ##' Filter counts matrix based on gene and cell requirements
|
113: ##' @param counts read count matrix. The rows correspond to genes, columns correspond to individual cells
|
118: ##' @return a filtered read count matrix
|
145: ##' @param counts read count matrix. The rows correspond to genes (should be named), columns correspond to individual cells. The matrix should contain integer counts
|
163: ##' @return a model matrix, with rows corresponding to different cells, and columns representing different parameters of the d...(16 bytes skipped)...
|
184: ...(114 bytes skipped)...thod is designed to work on read counts - do not pass normalized read counts (e.g. FPKM values). If matrix contains read counts, but they are stored as numeric values, use counts<-apply(counts,2,function(x)...(49 bytes skipped)...
|
208: ##' @param counts count matrix
|
228: fpkm <- log10(exp(as.matrix(fpkm))+1)
|
229: wts <- as.numeric(as.matrix(1-fail[, colnames(fpkm)]))
|
262: ##' @param counts read count matrix
|
264: ...(41 bytes skipped)...e two groups of cells being compared. The factor entries should correspond to the rows of the model matrix. The factor should have two levels. NAs are allowed (cells will be omitted from comparison).
|
265: ##' @param batch a factor (corresponding to rows of the model matrix) specifying batch assignment of each cell, to perform batch correction
|
284: ##' \code{difference.posterior} returns a matrix of estimated expression difference posteriors (rows - genes, columns correspond to different magnit...(64 bytes skipped)...
|
305: stop("ERROR: provided count data does not cover all of the cells specified in the model matrix")
|
309: counts <- as.matrix(counts[, ci])
|
416: ##' @param models model matrix
|
417: ##' @param counts count matrix
|
513: ##' @param counts read count matrix
|
516: ##' @param batch a factor describing which batch group each cell (i.e. each row of \code{models} matrix) belongs to
|
523: ##' @return \subsection{default}{ a posterior probability matrix, with rows corresponding to genes, and columns to expression levels (as defined by \code{prior$x})
|
525: ...(24 bytes skipped)...ndividual.posterior.modes}{ a list is returned, with the \code{$jp} slot giving the joint posterior matrix, as described above. The \code{$modes} slot gives a matrix of individual expression posterior mode values on log scale (rows - genes, columns -cells)}
|
526: ...(85 bytes skipped)...st} slot giving a list of individual posterior matrices, in a form analogous to the joint posterior matrix, but reported on log scale }
|
538: ...(43 bytes skipped)...counts))) { stop("ERROR: provided count data does not cover all of the cells specified in the model matrix") }
|
545: counts <- as.matrix(counts[, ci, drop = FALSE])
|
571: # prepare matrix models
|
574: mm <- matrix(NA, nrow(models), length(mn))
|
575: mm[, which(!is.na(mc))] <- as.matrix(models[, mc[!is.na(mc)], drop = FALSE])
|
645: # models - entire model matrix, or a subset of cells (i.e. select rows) of the model matrix for which the estimates should be obtained
|
647: # return - a matrix of log(FPM) estimates with genes as rows and cells as columns (in the model matrix order).
|
653: ##' @param counts count matrix
|
655: ##' @return a matrix of expression magnitudes on a log scale (rows - genes, columns - cells)
|
666: ...(43 bytes skipped)...counts))) { stop("ERROR: provided count data does not cover all of the cells specified in the model matrix") }
|
672: # magnitudes can either be a per-cell matrix or a single vector of values which will be evaluated for each cell
|
676: ##' Returns estimated drop-out probability for each cell (row of \code{models} matrix), given either an expression magnitude
|
678: ##' @param magnitudes a vector (\code{length(counts) == nrows(models)}) or a matrix (columns correspond to cells) of expression magnitudes, given on a log scale
|
679: ##' @param counts a vector (\code{length(counts) == nrows(models)}) or a matrix (columns correspond to cells) of read counts from which the expression magnitude should be estimate...(1 bytes skipped)...
|
681: ##' @return a vector or a matrix of drop-out probabilities
|
704: if(is.matrix(magnitudes)) { # a different vector for every cell
|
705: ...(55 bytes skipped)...es))) { stop("ERROR: provided magnitude data does not cover all of the cells specified in the model matrix") }
|
730: ##' @param counts read count matrix (must contain the row corresponding to the specified gene)
|
732: ##' @param groups a two-level factor specifying between which cells (rows of the models matrix) the comparison should be made
|
733: ##' @param batch optional multi-level factor assigning the cells (rows of the model matrix) to different batches that should be controlled for (e.g. two or more biological replicates). The e...(224 bytes skipped)...
|
759: counts <- as.matrix(counts[gene, ci, drop = FALSE])
|
819: layout(matrix(c(1:3), 3, 1, byrow = TRUE), heights = c(2, 1, 2), widths = c(1), FALSE)
|
926: ##' @param counts count matrix
|
927: ...(8 bytes skipped)...am reference a vector of expression magnitudes (read counts) corresponding to the rows of the count matrix
|
936: ##' @return matrix of scde models
|
977: if(class(ml[[i]]) == "try-error") {
|
988: #l <- layout(matrix(seq(1, 4*length(ids)), nrow = length(ids), byrow = TRUE), rep(c(1, 1, 1, 0.5), length(ids)), rep(1,...(23 bytes skipped)...
|
989: l <- layout(matrix(seq(1, 4), nrow = 1, byrow = TRUE), rep(c(1, 1, 1, 0.5), 1), rep(1, 4), FALSE)
|
1000: # make a joint model matrix
|
1011: ##' Determine principal components of a matrix using per-observation/per-variable weights
|
1015: ##' @param mat matrix of variables (columns) and observations (rows)
|
1026: ##' @return a list containing eigenvector matrix ($rotation), projections ($scores), variance (weighted) explained by each component ($var), total (...(45 bytes skipped)...
|
1030: ##' mat <- matrix( c(rnorm(5*10,mean=0,sd=1), rnorm(5*10,mean=5,sd=1)), 10, 10) # random matrix
|
1032: ##' matw <- matrix( c(rnorm(5*10,mean=0,sd=1), rnorm(5*10,mean=5,sd=1)), 10, 10) # random weight matrix
|
1040: stop("bwpca: weight matrix contains NaN values")
|
1043: stop("bwpca: value matrix contains NaN values")
|
1046: matw <- matrix(1, nrow(mat), ncol(mat))
|
1061: ##' Winsorize matrix
|
1065: ##' @param mat matrix
|
1068: ##' @return Winsorized matrix
|
1072: ##' mat <- matrix( c(rnorm(5*10,mean=0,sd=1), rnorm(5*10,mean=5,sd=1)), 10, 10) # random matrix
|
1075: ##' win.mat <- winsorize.matrix(mat, 0.1)
|
1100: ##' @param counts count matrix (integer matrix, rows- genes, columns- cells)
|
1133: ...(114 bytes skipped)...thod is designed to work on read counts - do not pass normalized read counts (e.g. FPKM values). If matrix contains read counts, but they are stored as numeric values, use counts<-apply(counts,2,function(x)...(49 bytes skipped)...
|
1162: #celld <- WGCNA::cor(log10(matrix(as.numeric(as.matrix(ca)), nrow = nrow(ca), ncol = ncol(ca))+1), method = cor.method, use = "p", nThreads = n.cores)
|
1164: celld <- WGCNA::cor(sqrt(matrix(as.numeric(as.matrix(ca[, ids])), nrow = nrow(ca), ncol = length(ids))), method = cor.method, use = "p", nThreads = n.co...(4 bytes skipped)...
|
1166: celld <- stats::cor(sqrt(matrix(as.numeric(as.matrix(ca[, ids])), nrow = nrow(ca), ncol = length(ids))), method = cor.method, use = "p")
|
1174: # TODO: correct for batch effect in cell-cell similarity matrix
|
1176: # number batches 10^(seq(0, n)) compute matrix of id sums, NA the diagonal,
|
1178: bm <- matrix(bid, byrow = TRUE, nrow = length(bid), ncol = length(bid))+bid
|
1181: # use tapply to calculate means shifts per combination reconstruct shift vector, matrix, subtract
|
1221: if(class(ml[[i]]) == "try-error") {
|
1239: l <- layout(matrix(seq(1, 4), nrow = 1, byrow = TRUE), rep(c(1, 1, 1, ifelse(local.theta.fit, 1, 0.5)), 1), rep(1, 4),...(7 bytes skipped)...
|
1263: # make a joint model matrix
|
1278: ##' @param models model matrix (select a subset of rows to normalize variance within a subset of cells)
|
1279: ##' @param counts read count matrix
|
1288: ##' @param weight.k k value to use in the final weight matrix
|
1294: ##' @param gene.length optional vector of gene lengths (corresponding to the rows of counts matrix)
|
1307: ##' \item{matw} { weight matrix corresponding to the expression matrix}
|
1334: stop(paste("supplied count matrix (cd) is missing data for the following cells:[", paste(rownames(models)[!rownames(models) %in% coln...(44 bytes skipped)...
|
1343: if(verbose) { cat("Winsorizing count matrix ... ") }
|
1345: #tfpm <- log(winsorize.matrix(exp(fpm), trim = trim))
|
1346: tfpm <- winsorize.matrix(fpm, trim)
|
1430: if(verbose) { cat("calculating weight matrix ... ") }
|
1450: # calculate batch-specific version of the weight matrix if needed
|
1695: # use milder weight matrix
|
1787: ##' (weighted) projection of the expression matrix onto a specified aspect (some pattern
|
1794: ##' @param center whether the matrix should be re-centered following pattern subtraction
|
1796: ##' @return a modified varinfo object with adjusted expression matrix (varinfo$mat)
|
1850: ##' @param center whether the expression matrix should be recentered
|
1989: ##' Determine de-novo gene clusters, their weighted PCA lambda1 values, and random matrix expectation.
|
1995: ##' @param n.samples number of randomly generated matrix samples to test the background distribution of lambda1 on
|
2004: ...(10 bytes skipped)... secondary.correlation whether clustering should be performed on the correlation of the correlation matrix instead
|
2014: ##' \item{varm} {standardized lambda1 values for each randomly generated matrix cluster}
|
2036: mat <- winsorize.matrix(mat, trim = trim)
|
2060: gd <- as.dist(1-WGCNA::cor(as.matrix(gd), method = "p", nThreads = n.cores))
|
2062: gd <- as.dist(1-cor(as.matrix(gd), method = "p"))
|
2103: # generate random normal matrix
|
2105: m <- matrix(rnorm(nrow(mat)*n.cells), nrow = nrow(mat), ncol = n.cells)
|
2113: m <- winsorize.matrix(m, trim = trim)
|
2124: gd <- as.dist(1-WGCNA::cor(as.matrix(gd), method = "p", nThreads = 1))
|
2126: gd <- as.dist(1-cor(as.matrix(gd), method = "p"))
|
2230: ##' \item{xv} {a matrix of normalized aspect patterns (rows- significant aspects, columns- cells}
|
2231: ##' \item{xvw} { corresponding weight matrix }
|
2505: ##' @param distance distance matrix
|
2569: if(trim > 0) { xvl$d <- winsorize.matrix(xvl$d, trim) } # trim prior to determining the top sets
|
2593: ...(35 bytes skipped)...f whether to return just the hclust result or a list containing the hclust result plus the distance matrix and gene values
|
2690: ##' @param mat Numeric matrix
|
2694: ##' @param row.cols Matrix of row colors.
|
2695: ##' @param col.cols Matrix of column colors. Useful for visualizing cell annotations such as batch labels.
|
2708: if(class(row.clustering) == "hclust") { row.clustering <- as.dendrogram(row.clustering) }
|
2709: if(class(cell.clustering) == "hclust") { cell.clustering <- as.dendrogram(cell.clustering) }
|
2730: ##' @param col.cols Matrix of column colors. Useful for visualizing cell annotations such as batch labels. Default NULL.
|
2840: layout(matrix(c(1:3), 3, 1, byrow = TRUE), heights = c(2, 1, 2), widths = c(1), FALSE)
|
2953: m1@concomitant@x <- matrix()
|
2955: mod@x <- matrix()
|
2956: mod@y <- matrix()
|
3083: # vil - optional binary matrix (corresponding to counts) with 0s marking likely drop-out observations
|
3118: f <- calcNormFactors(as.matrix(counts[gis, !is.na(groups)]), ...)
|
3127: fpkm <- log10(exp(as.matrix(fpkm))+1)
|
3128: wts <- as.numeric(as.matrix(1-fail[, colnames(fpkm)]))
|
3218: # pair cell name matrix
|
3267: m1@concomitant@x <- matrix()
|
3269: mod@x <- matrix()
|
3270: mod@y <- matrix()
|
3309: if(class(ml[[i]]) == "try-error") {
|
3327: #l <- layout(matrix(seq(1, 4*length(ids)), nrow = length(ids), byrow = TRUE), rep(c(1, 1, 1, 0.5), length(ids)), rep(1,...(23 bytes skipped)...
|
3328: l <- layout(matrix(seq(1, 4), nrow = 1, byrow = TRUE), rep(c(1, 1, 1, ifelse(linear.fit, 1, 0.5)), 1), rep(1, 4), FALS...(2 bytes skipped)...
|
3344: # make a joint model matrix
|
3367: if(class(m1@model[[2]]) == "FLXMRnb2gthC") { # linear fit model
|
3386: df <- get.exp.logposterior.matrix(group.ifm[[nam]], dat[, nam], marginals, n.cores = inner.cores, grid.weight = prior$grid.weight)
|
3403: # calculate joint posterior matrix for a given group of experiments
|
3420: # lmatll - list of posterior matrix lists (as obtained from calculate.posterior.matrices)
|
3467: # calculate a joint posterior matrix with bootstrap
|
3502: if(class(m1@components[[2]][[2]]) == "FLXcomponentE") {
|
3589: #matrix(cbind(ifelse(rdf$count<= zero.count.threshold, 0.95, 0.05), ifelse(rdf$count > zero.count.threshold...(15 bytes skipped)...
|
3604: l <- layout(matrix(c(1:4), 1, 4, byrow = TRUE), c(1, 1, 1, 0.5), rep(1, 4), FALSE)
|
3654: fdf <- data.frame(y = rowMeans(matrix(log10(rdf$fpm[1:(n.zero.windows*bw)]+1), ncol = bw, byrow = TRUE)), zf = rowMeans(matrix(as.integer(rdf$cluster[1:(n.zero.windows*bw)] == 1), ncol = bw, byrow = TRUE)))
|
3663: cm0 <- exp(model.matrix(mt, data = mf) %*% m1@concomitant@coef)
|
3716: # df: count matrix
|
3717: # xr: expression level for each row in the matrix
|
3740: # counts - observed count matrix corresponding to the models
|
3780: cm0 <- exp(model.matrix(mt, data = mf) %*% m1@concomitant@coef)
|
3797: cm0 <- model.matrix(mt, data = mf) %*% m1@concomitant@coef
|
3805: # returns a matrix of posterior values, with rows corresponding to genes, and
|
3812: #message(paste("get.exp.posterior.matrix() :", round((1-length(uc)/length(counts))*100, 3), "% savings"))
|
3828: #message(paste("get.exp.logposterior.matrix() :", round((1-length(uc)/length(counts))*100, 3), "% savings"))
|
3841: # similar to get.exp.posterior.matrix(), but returns inverse ecdf list
|
3848: # similar to get.exp.posterior.matrix(), but returns inverse ecdf list
|
3871: cm0 <- exp(model.matrix(mt, data = mf) %*% m1@concomitant@coef)
|
4138: m <- matrix(sapply(components, function(x) x@logLik(model@x, model@y)), nrow = nrow(model@y))
|
4141: m <- matrix(do.call(cbind, lapply(seq_along(components), function(i) {
|
4175: m <- matrix(sapply(components, function(x) x@logLik(model@x, model@y)), nrow = nrow(model@y))
|
4178: m <- matrix(do.call(cbind, lapply(seq_along(components), function(i) {
|
4223: m <- matrix(sapply(components, function(x) x@logLik(model@x, model@y)), nrow = nrow(model@y))
|
4226: m <- matrix(do.call(cbind, lapply(seq_along(components), function(i) {
|
4363: class = "family")
|
4403: class(fit) <- c("glm", "lm")
|
4467: class(fit) <- c("negbin.th", "glm", "lm")
|
4488: x <- as.matrix(x)
|
4490: ynames <- if (is.matrix(y))
|
4611: stop(gettextf("X matrix has rank %d, but only %d observations",
|
4711: fit$qr <- as.matrix(fit$qr)
|
4718: Rmat <- as.matrix(Rmat)
|
4749: "qraux", "pivot", "tol")], class = "qr"), family = family,
|
4856: if (!is.matrix(x)) {
|
5008: # weight matrix should have the same dimensions as the data matrix
|
5154: stop("'x' must be a numeric matrix")
|
5259: if(is.matrix(ColSideColors)) {
|
5261: stop("'ColSideColors' matrix must have the same number of columns as length ncol(x)")
|
5306: if(is.matrix(ColSideColors)) {
|
5307: image(t(matrix(1:length(ColSideColors), byrow = TRUE, nrow = nrow(ColSideColors), ncol = ncol(ColSideColors))), co...(70 bytes skipped)...
|
5357: # rook class for browsing differential expression results
|
5572: mat <- winsorize.matrix(mat, trim = trim)
|
5583: dd <- as.dist(1-abs(cor(t(as.matrix(d)))))
|
5599: vd <- as.dist(1-cor(as.matrix(d)))
|
5669: ##' @param colcols optional column color matrix
|
5678: ##' @param box whether to draw a box around the plotted matrix
|
5680: ##' @param return.details whether the function should return the matrix as well as full PCA info instead of just PC1 vector
|
5726: mat <- winsorize.matrix(mat, trim = trim)
|
5766: mat <- winsorize.matrix(mat, trim = trim)
|
5791: dd <- as.dist(1-abs(cor(t(as.matrix(d)))))
|
5807: vd <- as.dist(1-cor(as.matrix(d)))
|
5965: ##' A Reference Class to represent the PAGODA application
|
5967: ##' This ROOK application class enables communication with the client-side ExtJS framework and Inchlib HTML5 canvas libraries to cr...(44 bytes skipped)...
|
5973: ##' @field mat Matrix of posterior mode count estimates
|
5974: ##' @field matw Matrix of weights associated with each estimate in \code{mat}
|
6016: matrix <- list(data = as.numeric(t(matrix)),
|
6017: dim = dim(matrix),
|
6018: rows = rownames(matrix),
|
6019: cols = colnames(matrix),
|
6024: ol <- list(matrix = matrix)
|
6026: rcmvar <- matrix(gcl$rotation[rev(gcl$row.order), , drop = FALSE], ncol = 1)
|
6033: colcols <- matrix(gcl$oc[results$hvc$order], nrow = 1)
|
6084: matrix <- list(data = as.numeric(t(matrix)),
|
6085: dim = dim(matrix),
|
6086: rows = rownames(matrix),
|
6087: cols = colnames(matrix),
|
6090: range = range(matrix)
|
6095: rcmvar <- matrix(apply(results$rcm[rev(results$tvc$order), , drop = FALSE], 1, var), ncol = 1)
|
6105: ol <- list(matrix = matrix, rowcols = rowcols, colcols = colcols, coldend = treeg, trim = trim)
|
6159: patc <- .Call("matCorr", as.matrix(t(mat)), as.matrix(pat, ncol = 1) , PACKAGE = "scde")
|
6325: body <- paste(capture.output(write.table(round(matrix, 1), sep = "\t")), collapse = "\n")
|
1081: wm <- .Call("winsorizeMatrix", mat, trim, PACKAGE = "scde")
|
1755: ## # construct mat multiplier submatrix
|
3723: x <- FLXgetModelmatrix(m1@model[[1]], edf, m1@model[[1]]@formula)
|
3724: #cx <- FLXgetModelmatrix(m1@concomitant, edf, m1@concomitant@formula)
|
3889: setClass("FLXMRnb2glm", contains = "FLXMRglm", package = "flexmix")
|
3951: setClass("FLXMRnb2glmC", representation(vci = "ANY"), contains = "FLXMRnb2glm", package = "flexmix")
|
3962: setClass("FLXMRnb2gam", contains = "FLXMRglm", package = "flexmix")
|
3964: setClass("FLXcomponentE",
|
3970: setClass("FLXMRnb2gth", contains = "FLXMRglm", package = "flexmix")
|
4125: setClass("FLXMRnb2gthC", representation(vci = "ANY"), contains = "FLXMRnb2gth", package = "flexmix")
|
4210: setClass("FLXMRglmC", representation(vci = "ANY"), contains = "FLXMRglm", package = "flexmix")
|
4261: setClass("FLXMRglmCf", representation(mu = "numeric"), contains = "FLXMRglmC", package = "flexmix")
|
4286: setClass("FLXPmultinomW", contains = "FLXPmultinom")
|
4862: if(!is.numeric(unclass(x[[i]]))) {
|
5359: ViewDiff <- setRefClass(
|
5981: ViewPagodaApp <- setRefClass(
|
mdp:R/mdp.R: [ ] |
---|
747: for(class in unique(sort(x_temp[, colClass]))) {
|
579: class_means <- vector()
|
743: compute_zscore_classes <- function(x, colScore = 2, colClass = 3) {
|
9: #' @param pdata \code{data frame} of phenodata with a column headed Class and the
|
11: #' @param control_lab character \code{vector} specifying the control class
|
31: #' matrix is taken and values less than the std are set to zero.
|
33: #' \item Gene scores - mean z-score value for each gene in each class
|
35: #' value in each class
|
92: if (!("Sample" %in% names(pdata) && "Class" %in% names(pdata))) {
|
93: stop("Please label phenodata columns as 'Sample' and 'Class'")
|
96: } else if (sum(control_lab %in% pdata$Class) == 0) {
|
97: stop("Please provide a control label that matches a class in the phenodata")
|
98: } else if (sum(pdata$Class %in% control_lab) < 2) {
|
138: control_samples <- as.character(pdata$Sample[pdata$Class == control_lab])
|
139: test_samples <- as.character(pdata$Sample[pdata$Class != control_lab])
|
146: # find gene scores and gene frequency for each class
|
268: #' control_samples <- example_pheno$Sample[example_pheno$Class == 'baseline']
|
317: #' control_samples <- example_pheno$Sample[example_pheno$Class == 'baseline']
|
354: #' Computes gene scores for each gene within each class and perturbation freq
|
356: #' @param pdata phenotypic data with Class and Sample columns
|
357: #' @param control_lab character specifying control class
|
365: all_groups <- unique(pdata$Class) # find all groups
|
373: # find average expression of gene in each class
|
374: gene_average <- rowMeans(zscore[, as.character(pdata$Sample[pdata$Class == group])])
|
378: # find frequency that gene is perturbed in each class
|
379: gene_average <- rowMeans(zscore[, as.character(pdata$Sample[pdata$Class == group])] > 0)
|
397: #' @param control_lab label specificying control class
|
433: #' @param pdata phenotypic data with Sample and Class columns
|
452: Class = pdata[names(sample_scores), "Class"])
|
463: #' Data frame must have Score, Sample and Class columns
|
466: #' Must have columns 'Sample', 'Score' and 'Class'
|
473: #' class as light blue as a default
|
484: !("Class" %in% names(sample_data)) |
|
486: stop("Sample data must be data frame with colnames 'Class' 'Sample' 'Score'")
|
512: # make color for each class, with control class as light blue
|
513: groups <- unique(sample_data$Class)
|
522: if (!(control_lab %in% sample_data$Class)) {
|
544: fill = "Class")) +
|
580: for (j in unique(sample_data$Class)) {
|
581: class_means = c(class_means,
|
582: mean(sample_data[sample_data$Class == j,
|
585: names(class_means) <- unique(sample_data$Class)
|
586: class_means <- class_means[order(class_means)]
|
592: x = "Class",
|
593: fill = "Class")) +
|
600: x = "Class",
|
603: ggplot2::scale_x_discrete(limits = names(class_means)) +
|
647: # A matrix specifying the layout.
|
649: # something like matrix(c(1,2,3,3), nrow=2, byrow=TRUE), then
|
667: layout <- matrix(seq(1, cols * ceiling(numPlots/cols)),
|
684: # Get the i,j matrix positions of the regions
|
702: #' @param control_lab label that specifies control class
|
742: #' Computes the Z score of each class
|
748: mdp_score_temp <- x_temp[x_temp[, colClass] == class,]
|
749: mdp_score_temp$zscore_class <- scale(mdp_score_temp[, colScore])
|
758: #' Calculate the zscore inside specific class to identify pontential outliers
|
764: stop("Control variable: ", control, " didn't identified like as class!")
|
766: x_temp$outlier <- ifelse(x_temp[, colClass] == control & x_temp$zscore_class > threshold, 1, ifelse(x_temp[, colClass] != control & x_temp$zscore_class < -threshold, 1, 0))
|
40: #' higher gene scores in the test classes compared to the control.
|
170: sample_results <- check_outlier_samples(x = compute_zscore_classes(x = sample_results), control = control_lab)
|
760: check_outlier_samples <- function(x, colScore = 2, colClass = 3, control = "healthy", threshold = 2) {
|
763: if(!control %in% unique(sort(x_temp[, colClass]))) {
|
TRONCO:R/visualization.R: [ ] |
---|
2377: matrix = matrix(0, nrow = length(keys) + 3, ncol = 1)
|
407: pheat.matrix = data.lifting(x,data)
|
1223: draw_matrix <- function(matrix,
|
98: ## This function sorts a matrix to enhance mutual exclusivity
|
198: stop('"group.samples" should be matrix with sample names and group assignment.')
|
364: data.lifting <- function(obj, matrix) {
|
375: function(obj, matrix) {
|
377: ## Are you sure (obj %in% # matrix)
|
380: if (obj %in% matrix) {
|
385: rownames(matrix)))]
|
386: sub.data = matrix[keys.subset, , drop = FALSE]
|
394: matrix[keys.subset, ] = sub.data
|
404: return(list(data=matrix, colors=map.gradient))
|
408: map.gradient = pheat.matrix$colors
|
409: data = pheat.matrix$data
|
785: data = matrix(0, nrow = ngenes(x), ncol = ntypes(x))
|
882: tmp = as.matrix(subdata[which(refcol == i), ]);
|
1060: t = c(as.vector(as.matrix(annotation_col)), colnames(annotation_col))
|
1083: c(as.vector(as.matrix(annotation_row)),
|
1161: stop("Gaps do not match with matrix size")
|
1182: dist = matrix(0, nrow = 2 * n - 1, ncol = 2, dimnames = list(NULL, c("x", "y")))
|
1230: n = nrow(matrix)
|
1231: m = ncol(matrix)
|
1248: gp = gpar(fill = matrix, col = border_color))
|
1383: return(as.matrix(new))
|
1550: heatmap_motor <- function(matrix,
|
1585: nrow = nrow(matrix),
|
1586: ncol = ncol(matrix),
|
1634: ## gt = heatmap_motor(matrix, cellwidth = cellwidth,
|
1650: heatmap_motor(matrix,
|
1711: ## Draw matrix.
|
1713: elem = draw_matrix(matrix, border_color, gaps_row, gaps_col, fmat, fontsize_number, number_color)
|
1714: res = gtable_add_grob(res, elem, t = 4, l = 3, clip = "off", name = "matrix")
|
1810: mat = as.matrix(mat)
|
1811: return(matrix(scale_vec_colours(as.vector(mat),
|
1972: #' @param mat numeric matrix of the values to be plotted.
|
1994: #' of the above it is assumed that a distance matrix is provided.
|
2032: #' the cells. If this is a matrix (with same dimensions as original matrix), the contents
|
2033: #' of the matrix are shown instead of original values.
|
2067: #' # Create test matrix
|
2068: #' test = matrix(rnorm(200), 20, 10)
|
2144: ## Preprocess matrix.
|
2146: mat = as.matrix(mat)
|
2172: if (is.matrix(display_numbers) | is.data.frame(display_numbers)) {
|
2174: stop("If display_numbers provided as matrix, its dimensions have to match with mat")
|
2177: display_numbers = as.matrix(display_numbers)
|
2178: fmat = matrix(as.character(display_numbers), nrow = nrow(display_numbers), ncol = ncol(display_numbers))
|
2182: fmat = matrix(sprintf(number_format, mat), nrow = nrow(mat), ncol = ncol(mat))
|
2185: fmat = matrix(NA, nrow = nrow(mat), ncol = ncol(mat))
|
2259: ## Select only the ones present in the matrix.
|
2378: rownames(matrix) = c(keys, 'soft', 'co-occurrence', 'other')
|
2379: ## colnames(matrix) = paste(to, collapse = ':')
|
2380: colnames(matrix) = to[1]
|
2420: matrix['co-occurrence', ] = length(co.occurrences)
|
2421: cat('Co-occurrence in #samples: ', matrix['co-occurrence', ], '\n')
|
2426: matrix[keys[i], ] = length(intersect(to.samples, hard.pattern.samples[[keys[i]]]))
|
2427: cat('Hard exclusivity in #samples:', matrix[keys, ], '\n')
|
2433: matrix['other', ] = length(intersect(to.samples, union))
|
2434: cat('Other observations in #samples:', matrix['other', ], '\n')
|
2438: matrix['soft', ] = length(to.samples) - colSums(matrix)
|
2439: cat('Soft exclusivity in #samples:', matrix['soft', ], '\n')
|
2443: sector.color = rep('gray', nrow(matrix) + 1)
|
2444: link.color = rep('gray', nrow(matrix))
|
2446: names(sector.color) = c(rownames(matrix), colnames(matrix))
|
2447: names(link.color) = rownames(matrix)
|
2465: idx.max = which(matrix == max(matrix))
|
2466: link.style = matrix(0, nrow=nrow(matrix), ncol=ncol(matrix))
|
2467: rownames(link.style) = rownames(matrix)
|
2468: colnames(link.style) = colnames(matrix)
|
2482: sector.color[colnames(matrix)] = as.colors(x)[as.events(x, genes = to[1], types=to[2])[, 'type' ]]
|
2489: ## rownames(matrix)[i] = paste(paste(rep(' ', i), collapse = ''), events.names[i, 'event' ])
|
2491: rownames(matrix)[i] = paste(paste(rep(' ', i), collapse = ''), events.names[i, 'event' ])
|
2492: else rownames(matrix)[i] = events.names[i, 'event' ]
|
2494: names(sector.color)[i] = rownames(matrix)[i]
|
2499: cat('Circlize matrix.\n')
|
2500: print(matrix)
|
2508: chordDiagram(matrix,
|
2536: layout(matrix(c(1,2,3,3), ncol = 2, byrow = TRUE), heights = c(4, 1))
|
2551: print(matrix)
|
2553: ## barplot(matrix[, 1], widths, space = 0)
|
2555: rownames(matrix)[length(keys) + 1] = '2 or more\n(soft-exclusivity)'
|
2556: rownames(matrix)[length(keys) + 2] = 'all together\n(co-occurrence)'
|
2558: rownames(matrix)[nrow(matrix)] = 'none of the\nevents'
|
2560: summary = matrix[ (length(keys) + 1):nrow(matrix), 1, drop = FALSE]
|
2561: summary = rbind( sum(matrix[1:length(keys),]), summary)
|
2586: exclus = matrix[1:length(keys), 1, drop = FALSE]
|
2617: c(paste(sum(matrix[1:length(keys) ,]), 'with 1 event (hard exclusivity)'),
|
2618: paste(matrix[length(keys) + 1, ], 'with 2 or more events'),
|
2619: paste(matrix[length(keys) + 2, ], 'with all events (co-occurrence)'),
|
2620: paste(matrix[length(keys) + 3, ], 'with no events')
|
20: #' @param ann.stage Boolean value to annotate stage classification, default depends on \code{x}
|
GRaNIE:R/core.R: [ ] |
---|
6302: d = tibble::add_row(d, r_positive = r_pos, class = classCur, peak_gene.p.raw.class = pclassCur, n = 0)
|
762: peak.GC.class = cut(.data$`G|C`, breaks = seq(0,1,1/nBins), include.lowest = TRUE, ordered_result = TRUE)) %>%
|
973: peaks_GC_class = cut(GC_data.df$peak.GC.perc, breaks = seq(0,1,1/nBins), include.lowest = TRUE, ordered_result = T...(4 bytes skipped)...
|
1999: matrix1.norm.TFs.df = dplyr::filter(matrix1, .data$ENSEMBL %in% mapping$TF.ENSEMBL, rowSums != 0)
|
480: .storeAsMatrixOrSparseMatrix <- function(GRN, df, ID_column, slotName, threshold = 0.1) {
|
798: .normalizeCountMatrix <- function(GRN, data, normalization, additionalParams =list()) {
|
5240: classPeaks = class(GRN@data$peaks$counts)
|
5253: classRNA = class(GRN@data$RNA$counts)
|
6297: for (classCur in networkType_details) {
|
6350: classAll = c(as.character(d2$class), d3$r_positive),
|
3110: GC.class.cur = GC_classes_foreground.df$peak.GC.class[i]
|
6379: peak_gene.p.raw.class.bin = as.numeric(.data$peak_gene.p.raw.class)) %>%
|
774: GC_classes.df = GC.data %>%
|
1807: TFBS_bindingMatrix.df = .intersectTFBSPeaks_JASPAR(GRN, consensus.gr, verbose = FALSE, ...)
|
2318: AR_classification_wrapper <- function(GRN, significanceThreshold_Wilcoxon = 0.05,
|
2751: GC_classes_perTF.l = list()
|
2780: GC_classes_foreground.df = peaksForeground %>%
|
2788: GC_classes_background.df = peaksBackground %>%
|
2835: GC_classes_all.df = dplyr::full_join(GC_classes_foreground.df, GC_classes_background.df, suffix = c(".fg",".bg"), by = "peak.GC.class") %>%
|
3065: GC_classes_all.l = list()
|
6390: .classFreq_label <- function(tbl_freq) {
|
1585: PFMatrixList <- TFBSTools::getMatrixSet(JASPAR2022::JASPAR2022, opts = options_JASPAR)
|
1936: PFMatrixList = GRN@config$parameters$internal$PFMatrixList
|
6298: for (pclassCur in levels(peakGeneCorrelations.all.cur$peak_gene.p.raw.class)) {
|
3: #' Create and initialize an empty \code{\linkS4class{GRN}} object.
|
15: #' @return Empty \code{\linkS4class{GRN}} object
|
126: #' Add data to a \code{\linkS4class{GRN}} object.
|
128: #' This function adds both RNA and peak data to a \code{\linkS4class{GRN}} object, along with data normalization.
|
169: #' @return An updated \code{\linkS4class{GRN}} object, with added data from this function(e.g., slots \code{GRN@data$peaks} and \code{GRN@da...(8 bytes skipped)...
|
310: countsPeaks.norm.df = .normalizeCountMatrix(GRN, data = counts_peaks %>% tibble::column_to_rownames("peakID") %>% as.matrix(),
|
317: countsRNA.norm.df = .normalizeCountMatrix(GRN, data = counts_rna %>% tibble::column_to_rownames("ENSEMBL") %>% as.matrix(),
|
383: # Store the matrices either as normal or sparse matrix
|
438: columnTypes = sapply(counts_df, class) %>% table()
|
484: # Store as sparse matrix if enough 0s
|
490: as.matrix()
|
493: fractionZero = (length(df.m) - Matrix::nnzero(df.m)) / length(df.m)
|
497: futile.logger::flog.info(paste0("Storing ", slotName, " matrix as sparse matrix because fraction of 0s is > ", threshold, " (", round(fractionZero,2), ")"))
|
775: dplyr::group_by(.data$peak.GC.class) %>%
|
778: tidyr::complete(.data$peak.GC.class, fill = list(n = 0)) %>%
|
782: #ggplot2::ggplot(GC.data, ggplot2::aes(GC.class)) + geom_histogram(stat = "count") + ggplot2::theme_bw()
|
784: #ggplot2::ggplot(GC_classes.df , ggplot2::aes(GC.class, n_rel)) + geom_bar(stat = "identity") + ggplot2::theme_bw()
|
876: # the normalization factors matrix should not have 0's in it
|
976: GC_class = peaks_GC_class,
|
1044: .gcqn <- function(data, GC_class, summary= 'mean', round= FALSE) {
|
1046: gcBinNormCounts <- matrix(NA, nrow = nrow(data), ncol = ncol(data), dimnames = list(rownames(data),colnames(data)))
|
1048: for (ii in 1:nlevels(GC_class)) {
|
1050: id <- which(GC_class == levels(GC_class)[ii])
|
1083: # gcBinNormCounts <- matrix(NA, nrow=nrow(counts), ncol=ncol(counts), dimnames=list(rownames(counts),colnames(counts)))
|
1084: # for(ii in 1:nlevels(peaksAnnotation$peak.GC.class)) {
|
1085: # id <- which(peaksAnnotation$peak.GC.class==levels(peaksAnnotation$peak.GC.class)[ii])
|
1115: # input = as.matrix(rawCounts[,-rmCols])
|
1117: # input = as.matrix(rawCounts)
|
1177: #' Filter RNA-seq and/or peak data from a \code{\linkS4class{GRN}} object
|
1183: ...(166 bytes skipped)...s_peak_gene}}. \strong{This function does NOT (re)filter existing connections when the \code{\linkS4class{GRN}} object already contains connections. Thus, upon re-execution of this function with different ...(60 bytes skipped)...
|
1208: #' @return An updated \code{\linkS4class{GRN}} object, with added data from this function.
|
1459: #' Add TFBS to a \code{\linkS4class{GRN}} object.
|
1482: #' @return An updated \code{\linkS4class{GRN}} object, with additional information added from this function(\code{GRN@annotation$TFs} in par...(8 bytes skipped)...
|
1735: #' Overlap peaks and TFBS for a \code{\linkS4class{GRN}} object
|
1743: #' @return An updated \code{\linkS4class{GRN}} object, with added data from this function (\code{GRN@data$TFs$TF_peak_overlap} in particular...(1 bytes skipped)...
|
1839: # Collect binary 0/1 binding matrix from all TF and concatenate
|
1846: GRN@data$TFs$TF_peak_overlap = .asSparseMatrix(as.matrix(GRN@data$TFs$TF_peak_overlap),
|
1952: #overlapsAll_mtx <- overlapsAll_mtx[,Matrix::colSums(motifmatchr::motifMatches(overlapsAll_mtx))!=0]
|
1986: .correlateMatrices <- function(matrix1, matrix_peaks, mapping, corMethod = "pearson", whitespacePrefix = " ") {
|
1996: rowSums = rowSums(dplyr::select(matrix1, -"ENSEMBL"))
|
2001: nFiltered1 = dplyr::filter(matrix1, !.data$ENSEMBL %in% mapping$TF.ENSEMBL) %>% nrow()
|
2002: nFiltered2 = dplyr::filter(matrix1, rowSums == 0) %>% nrow()
|
2004: diff = nrow(matrix1) - nrow(matrix1.norm.TFs.df)
|
2006: message = paste0(whitespacePrefix, "Retain ", nrow(matrix1.norm.TFs.df), " unique genes from TF/gene data out of ", nrow(matrix1),
|
2012: if (nrow(matrix1.norm.TFs.df) == 0) {
|
2017: mapping.exp = dplyr::filter(mapping, .data$TF.ENSEMBL %in% matrix1.norm.TFs.df$ENSEMBL)
|
2018: futile.logger::flog.info(paste0(whitespacePrefix, "Correlate TF/gene data for ", nrow(matrix1.norm.TFs.df), " unique Ensembl IDs (TFs) and peak counts for ", nrow(matrix_peaks), " peaks."))
|
2021: # matrix1: rows: all TF genes, columns: all samples
|
2022: # matrix_peaks: rows: peak IDs, columns: samples
|
2027: dataX = t(dplyr::select(matrix1.norm.TFs.df, -"ENSEMBL"))
|
2028: dataY = t(dplyr::select(matrix_peaks, -"peakID"))
|
2034: colnames(cor.m) = matrix1.norm.TFs.df$ENSEMBL
|
2035: rownames(cor.m) = matrix_peaks$peakID
|
2088: #' @return An updated \code{\linkS4class{GRN}} object, with added data from this function
|
2114: # Input: Raw peak counts per TF and TF-binding matrix
|
2130: TF.activity.m = matrix(NA, nrow = length(allTF), ncol = length(GRN@config$sharedSamples),
|
2140: # Filter count matrix to those peaks with TFBS
|
2188: #' @return An updated \code{\linkS4class{GRN}} object, with added data from this function.
|
2279: # Therefore, use TF names as row names, same as with the TF Activity matrix
|
2302: #' Run the activator-repressor classification for the TFs for a \code{\linkS4class{GRN}} object
|
2312: #' @return An updated \code{\linkS4class{GRN}} object, with additional information added from this function.
|
2343: message = paste0("Could not find peak - TF matrix. Run the function overlapPeaksAndTFBS first / again")
|
2394: TF_peak_cor = .correlateMatrices(matrix1 = counts1,
|
2395: matrix_peaks = counts_peaks,
|
2424: t.cor.sel.matrix = .asMatrixFromSparse(GRN@data$TFs$classification[[permIndex]] [[connectionTypeCur]]$TF_peak_cor_foreground),
|
2425: t.cor.sel.matrix.non = .asMatrixFromSparse(GRN@data$TFs$classification[[permIndex]] [[connectionTypeCur]]$TF_peak_cor_background),
|
2439: fileCur = paste0(outputFolder, .getOutputFileName("plot_class_density"), "_", connectionTypeCur, suffixFile, ".pdf")
|
2449: fileCur = paste0(outputFolder, .getOutputFileName("plot_class_medianClass"), "_", connectionTypeCur, suffixFile, ".pdf")
|
2462: fileCur = paste0(outputFolder, .getOutputFileName("plot_class_densityClass"), "_", connectionTypeCur, suffixFile, ".pdf")
|
2494: .asSparseMatrix(as.matrix(GRN@data$TFs$classification[[permIndex]] [[connectionTypeCur]]$TF_peak_cor_foreground), convertNA_to_zero = TRUE)
|
2496: .asSparseMatrix(as.matrix(GRN@data$TFs$classification[[permIndex]] [[connectionTypeCur]]$TF_peak_cor_background), convertNA_to_zero = TRUE)
|
2523: #' Add TF-peak connections to a \code{\linkS4class{GRN}} object
|
2541: #' @return An updated \code{\linkS4class{GRN}} object, with additional information added from this function.
|
2592: message = paste0("Could not find peak - TF matrix. Run the function overlapPeaksAndTFBS first / again")
|
2601: if (!"peak.GC.class" %in% colnames(GRN@annotation$peaks)) {
|
2706: peaksCor.m = .correlateMatrices( matrix1 = counts_connectionTypeCur,
|
2707: matrix_peaks = counts_peaks,
|
2734: cols_select = c("peak.ID", "peak.GC.class", "peak.GC.perc", "peak.width")
|
2781: dplyr::group_by(.data$peak.GC.class) %>%
|
2784: tidyr::complete(.data$peak.GC.class, fill = list(n = 0)) %>%
|
2789: dplyr::group_by(.data$peak.GC.class) %>%
|
2792: tidyr::complete(.data$peak.GC.class, fill = list(n = 0)) %>%
|
2852: peaksBackgroundGCCur = peaksBackground %>% dplyr::filter(.data$peak.GC.class == GC_classes_foreground.df$peak.GC.class[i])
|
2867: #futile.logger::flog.info(paste0("Resampling for bin ", GC_classes_foreground.df$peak.GC.class[i],
|
3115: dplyr::filter(.data$peak.GC.class == GC.class.cur) %>%
|
3123: futile.logger::flog.info(paste0(" GC.class ", GC.class.cur, ": Required: ", requiredNoPeaks, ", available: ", availableNoPeaks, ignoredStr))
|
3128: futile.logger::flog.info(paste0(" Mimicking distribution FAILED (GC class ", GC.class.cur, " could not be mimicked."))
|
3151: #' Add peak-gene connections to a \code{\linkS4class{GRN}} object
|
3174: #' @return An updated \code{\linkS4class{GRN}} object, with additional information added from this function.
|
3568: #res.m = matrix(NA, ncol = 2, nrow = nrow(overlaps.sub.filt.df), dimnames = list(NULL, c("p.raw", "peak_gene.r")))
|
3632: res.m = matrix(NA, ncol = 2, nrow = end - start + 1, dimnames = list(NULL, c("p.raw", "r")))
|
3722: #' @return An updated \code{\linkS4class{GRN}} object, with additional information added from this function.
|
4428: #' Add TF-gene correlations to a \code{\linkS4class{GRN}} object.
|
4437: #' @return An updated \code{\linkS4class{GRN}} object, with additional information added from this function.
|
4552: #' Add SNP data to a \code{\linkS4class{GRN}} object and associate SNPs to peaks.
|
4590: #' @return An updated \code{\linkS4class{GRN}} object, with additional information added from this function.
|
4817: ...(4 bytes skipped)...enerate a summary for the number of connections for different filtering criteria for a \code{\linkS4class{GRN}} object.
|
4836: #' @return An updated \code{\linkS4class{GRN}} object, with additional information added from this function.
|
5136: #' @return An small example \code{\linkS4class{GRN}} object
|
5203: #' Get counts for the various data defined in a \code{\linkS4class{GRN}} object
|
5205: #' Get counts for the various data defined in a \code{\linkS4class{GRN}} object.
|
5206: ...(10 bytes skipped)...{Note: This function, as all \code{get} functions from this package, does NOT return a \code{\linkS4class{GRN}} object.}
|
5210: #' @param asMatrix...(128 bytes skipped)... without an ID column (see \code{includeIDColumn}). If set to \code{TRUE}, counts are returned as a matrix with the ID column as row names.
|
5220: ...(37 bytes skipped)... the type as indicated by the function parameters. This function does **NOT** return a \code{\linkS4class{GRN}} object.
|
5241: if ("matrix" %in% classPeaks) {
|
5246: message = paste0("Unsupported class for GRN@data$peaks$counts. Contact the authors.")
|
5254: if ("matrix" %in% classRNA) {
|
5259: message = paste0("Unsupported class for GRN@data$RNA$counts. Contact the authors.")
|
5309: #' Extract connections or links from a \code{\linkS4class{GRN}} object as a data frame.
|
5313: ...(10 bytes skipped)...{Note: This function, as all \code{get} functions from this package, does NOT return a \code{\linkS4class{GRN}} object.}
|
5326: ...(5 bytes skipped)...eturn A data frame with the requested connections. This function does **NOT** return a \code{\linkS4class{GRN}} object. Depending on the arguments, the
|
5528: ...(0 bytes skipped)...#' Retrieve parameters for previously used function calls and general parameters for a \code{\linkS4class{GRN}} object.
|
5530: ...(10 bytes skipped)...{Note: This function, as all \code{get} functions from this package, does NOT return a \code{\linkS4class{GRN}} object.}
|
5536: #' @return The requested parameters. This function does **NOT** return a \code{\linkS4class{GRN}} object.
|
5583: #' Summarize a \code{\linkS4class{GRN}} object to a named list for comparison with other \code{\linkS4class{GRN}} objects.
|
5585: ...(10 bytes skipped)...{Note: This function, as all \code{get} functions from this package, does NOT return a \code{\linkS4class{GRN}} object.}
|
5589: ...(1 bytes skipped)...' @return A named list summarizing the GRN object. This function does **NOT** return a \code{\linkS4class{GRN}} object, but instead a named lsit with the
|
5635: scarcity_peaks_all = (length(GRN@data$peaks$counts) - Matrix::nnzero(GRN@data$peaks$counts)) / length(GRN@data$peaks$counts)
|
5637: scarcity_peaks_filt = (length(peaks.filt) - Matrix::nnzero(peaks.filt)) / length(peaks.filt)
|
5652: scarcity_RNA_all = (length(GRN@data$RNA$counts) - Matrix::nnzero(GRN@data$RNA$counts)) / length(GRN@data$RNA$counts)
|
5654: scarcity_RNA_filt = (length(RNA.filt) - Matrix::nnzero(RNA.filt)) / length(RNA.filt)
|
5847: #' @return An updated \code{\linkS4class{GRN}} object, with some slots being deleted (\code{GRN@data$TFs$classification} as well as \code{GRN@stats$connectionDetails.l})
|
5881: #' @return An updated \code{\linkS4class{GRN}} object, with the output directory being adjusted accordingly
|
6164: "plot_class_density" = "TF_classification_densityPlots",
|
6165: "plot_class_medianClass" = "TF_classification_stringencyThresholds",
|
6166: "plot_class_densityClass" = "TF_classification_summaryHeatmap",
|
6291: dplyr::group_by(.data$r_positive, class, .data$peak_gene.p.raw.class) %>%
|
6300: row = which(d$r_positive == r_pos & d$class == classCur & as.character(d$peak_gene.p.raw.class) == as.character(pclassCur))
|
6308: # Restore the "ordered" factor for class
|
6309: d$peak_gene.p.raw.class = factor(d$peak_gene.p.raw.class, ordered = TRUE, levels = levels(peakGeneCorrelations.all.cur$peak_gene.p.raw.class))
|
6314: dplyr::group_by(.data$r_positive, .data$class) %>%
|
6320: dplyr::group_by(class, .data$peak_gene.p.raw.class) %>%
|
6329: normFactor_real = dplyr::filter(dsum, class == !! (networkType_details[1])) %>% dplyr::pull(.data$sum_n) %>% sum() /
|
6330: dplyr::filter(dsum, class == !! (networkType_details[2])) %>% dplyr::pull(.data$sum_n) %>% sum()
|
6334: dplyr::group_by(.data$peak_gene.p.raw.class, .data$r_positive) %>%
|
6335: dplyr::summarise(n_real = .data$n[class == !! (names(colors_vec)[1]) ],
|
6336: n_background = .data$n[class == !! (names(colors_vec)[2]) ]) %>%
|
6344: stopifnot(identical(levels(d2$peak_gene.p.raw.class), levels(d3$peak_gene.p.raw.class)))
|
6347: d_merged <- tibble::tibble(peak_gene.p.raw.class = c(as.character(d2$peak_gene.p.raw.class),
|
6348: as.character(d3$peak_gene.p.raw.class)),
|
6353: peak_gene.p.raw.class = factor(.data$peak_gene.p.raw.class, levels = levels(d2$peak_gene.p.raw.class)))
|
6355: d4 = tibble::tibble(peak_gene.p.raw.class = unique(d$peak_gene.p.raw.class),
|
6362: row_d2 = which(d2$class == networkType_details[1] & d2$peak_gene.p.raw.class == d4$peak_gene.p.raw.class[i])
|
6366: row_d2 = which(d2$class == paste0("random_",range) & d2$peak_gene.p.raw.class == d4$peak_gene.p.raw.class[i])
|
6370: row_d3 = which(d3$r_positive == TRUE & d3$peak_gene.p.raw.class == d4$peak_gene.p.raw.class[i])
|
6372: row_d3 = which(d3$r_positive == FALSE & d3$peak_gene.p.raw.class == d4$peak_gene.p.raw.class[i])
|
6380: dplyr::arrange(.data$peak_gene.p.raw.class.bin)
|
6382: d4_melt = reshape2::melt(d4, id = c("peak_gene.p.raw.class.bin", "peak_gene.p.raw.class")) %>%
|
6435: ...(36 bytes skipped)...ources of biological and technical variation for features (TFs, peaks, and genes) in a \code{\linkS4class{GRN}} object
|
6455: #' @return An updated \code{\linkS4class{GRN}} object, with additional information added from this function to \code{GRN@stats$varianceParti...(111 bytes skipped)...
|
6513: coltypes = meta %>% dplyr::summarise_all(class)
|
6588: # row_order <- matrixStats::rowVars(as.matrix(data.l[[dataType]]) ) %>% order(decreasing = T)
|
87: # Stringencies for AR classification
|
93: # Colors for the different classifications
|
192: checkmate::assertClass(GRN, "GRN")
|
384: GRN@data$peaks$counts = .storeAsMatrixOrSparseMatrix(GRN, df = data.l[["peaks"]], ID_column = "peakID", slotName = "GRN@data$peaks$counts")
|
387: GRN@data$peaks$counts_raw = .storeAsMatrixOrSparseMatrix(GRN, df = counts_peaks %>% dplyr::select("peakID", tidyselect::one_of(GRN@config$sharedSamples)),
|
391: GRN@data$RNA$counts = .storeAsMatrixOrSparseMatrix(GRN, df = data.l[["RNA"]], ID_column = "ENSEMBL", slotName = "GRN@data$RNA$counts")
|
394: GRN@data$RNA$counts_raw = .storeAsMatrixOrSparseMatrix(GRN, df = counts_rna %>% dplyr::select("ENSEMBL", tidyselect::one_of(GRN@config$sharedSamples)),
|
498: df.m = .asSparseMatrix(df.m, convertNA_to_zero = FALSE,
|
614: countsPeaks.clean = getCounts(GRN, type = "peaks", permuted = FALSE, asMatrix = TRUE, includeFiltered = TRUE)
|
619: rowMedians_peaks = matrixStats::rowMedians(countsPeaks.clean)
|
620: CV_peaks = matrixStats::rowSds(countsPeaks.clean) / rowMeans_peaks
|
710: countsRNA.m = getCounts(GRN, type = "rna", permuted = FALSE, asMatrix = TRUE, includeFiltered = TRUE)
|
716: rowMedians_rna = matrixStats::rowMedians(countsRNA.m)
|
717: CV_rna = matrixStats::rowSds(countsRNA.m) / rowMeans_rna
|
790: GRN@stats$GC$peaks = GC_classes.df
|
800: checkmate::assertMatrix(data)
|
811: dd <- suppressMessages(DESeq2::DESeqDataSetFromMatrix(countData = data,
|
1032: refdist <- matrixStats::rowMedians(counts.sort)
|
1073: # counts = getCounts(GRN, type = "peaks", asMatrix = TRUE, includeFiltered = TRUE)
|
1137: # dd <- DESeq2::DESeqDataSetFromMatrix(countData = countDataNew,
|
1225: checkmate::assertClass(GRN, "GRN")
|
1493: checkmate::assertClass(GRN, "GRN")
|
1753: checkmate::assertClass(GRN, "GRN")
|
1811: TFBS_bindingMatrix.df = cbind(TFBS_bindingMatrix.df, rep(FALSE, nrow(TFBS_bindingMatrix.df)))
|
1812: colnames(TFBS_bindingMatrix.df)[ncol(TFBS_bindingMatrix.df)] = "isFiltered"
|
1813: GRN@data$TFs$TF_peak_overlap = TFBS_bindingMatrix.df %>% methods::as("dMatrix")
|
1826: TFBS_bindingMatrix.df = tibble::as_tibble(res.l)
|
1828: if (!all(colnames(TFBS_bindingMatrix.df) %in% GRN@config$allTF)) {
|
1840: GRN@data$TFs$TF_peak_overlap = TFBS_bindingMatrix.df %>%
|
2093: checkmate::assertClass(GRN, "GRN")
|
2120: countsPeaks = .normalizeCountMatrix(GRN, data = GRN@data$peaks$counts_orig, normalization = normalization)
|
2191: checkmate::assertClass(GRN, "GRN")
|
2246: countsNorm = .normalizeCountMatrix(GRN, data = data %>% dplyr::select(-"ENSEMBL"), normalization = normalization)
|
2300: ######## AR classification ########
|
2305: ...(47 bytes skipped)...c[0,1]. Default 0.05. Significance threshold for Wilcoxon test that is run in the end for the final classification. See the Vignette and *diffTF* paper for details.
|
2316: #' # GRN = AR_classification_wrapper(GRN, outputFolder = ".", forceRerun = FALSE)
|
2326: checkmate::assertClass(GRN, "GRN")
|
2340: GRN@data$TFs$classification$TF.translation.orig = GRN@annotation$TFs
|
2362: if (is.null(GRN@data$TFs$classification[[permIndex]] [[connectionTypeCur]])) {
|
2363: if (is.null(GRN@data$TFs$classification[[permIndex]])) {
|
2364: GRN@data$TFs$classification[[permIndex]] = list()
|
2366: GRN@data$TFs$classification[[permIndex]] [[connectionTypeCur]] = list()
|
2369: if (is.null(GRN@data$TFs$classification[[permIndex]] [[connectionTypeCur]]$TF_cor_median_foreground) |
|
2370: is.null(GRN@data$TFs$classification[[permIndex]] [[connectionTypeCur]]$TF_cor_median_background) |
|
2371: is.null(GRN@data$TFs$classification[[permIndex]] [[connectionTypeCur]]$TF_peak_cor_foreground) |
|
2372: is.null(GRN@data$TFs$classification[[permIndex]] [[connectionTypeCur]]$TF_peak_cor_background) |
|
2373: is.null(GRN@data$TFs$classification[[permIndex]] [[connectionTypeCur]]$TF_peak_cor) |
|
2377: GRN@data$TFs$classification[[permIndex]] [[connectionTypeCur]] = list()
|
2400: GRN@data$TFs$classification[[permIndex]] [[connectionTypeCur]]$TF_cor_median_foreground = res.l[["median_foreground"]]...(0 bytes skipped)...
|
2401: GRN@data$TFs$classification[[permIndex]] [[connectionTypeCur]]$TF_cor_median_background = res.l[["median_background"]]...(0 bytes skipped)...
|
2402: GRN@data$TFs$classification[[permIndex]] [[connectionTypeCur]]$TF_peak_cor_foreground = res.l[["foreground"]]
|
2403: GRN@data$TFs$classification[[permIndex]] [[connectionTypeCur]]$TF_peak_cor_background = res.l[["background"]]
|
2405: GRN@data$TFs$classification[[permIndex]] [[connectionTypeCur]]$TF_peak_cor = TF_peak_cor
|
2408: # Final classification: Calculate thresholds by calculating the quantiles of the background and compare the real ...(24 bytes skipped)...
|
2410: if (is.null(GRN@data$TFs$classification[[permIndex]] [[connectionTypeCur]]$act.rep.thres.l) | forceRerun) {
|
2411: GRN@data$TFs$classification[[permIndex]] [[connectionTypeCur]]$act.rep.thres.l =
|
2412: .calculate_classificationThresholds(.asMatrixFromSparse(GRN@data$TFs$classification[[permIndex]] [[connectionTypeCur]]$TF_peak_cor_background),
|
2416: if (is.null(GRN@data$TFs$classification[[permIndex]] [[connectionTypeCur]]$TF.classification) | forceRerun) {
|
2418: GRN@data$TFs$classification[[permIndex]] [[connectionTypeCur]]$TF.classification =
|
2420: output.global.TFs = GRN@data$TFs$classification$TF.translation.orig %>% dplyr::mutate(TF = .data$TF.ID),
|
2421: median.cor.tfs = GRN@data$TFs$classification[[permIndex]] [[connectionTypeCur]]$TF_cor_median_foreground,
|
2422: act.rep.thres.l = GRN@data$TFs$classification[[permIndex]] [[connectionTypeCur]]$act.rep.thres.l,
|
2430: # PLOTS FOR THE RNA-SEQ CLASSIFICATION
|
2441: .plot_density(.asMatrixFromSparse(GRN@data$TFs$classification[[permIndex]] [[connectionTypeCur]]$TF_peak_cor_foreground),
|
2442: .asMatrixFromSparse(GRN@data$TFs$classification[[permIndex]] [[connectionTypeCur]]$TF_peak_cor_background),
|
2452: median.cor.tfs = .asMatrixFromSparse(GRN@data$TFs$classification[[permIndex]] [[connectionTypeCur]]$TF_cor_median_foreground),
|
2453: median.cor.tfs.non = .asMatrixFromSparse(GRN@data$TFs$classification[[permIndex]] [[connectionTypeCur]]$TF_cor_median_background),
|
2455: act.rep.thres.l = GRN@data$TFs$classification[[permIndex]] [[connectionTypeCur]]$act.rep.thres.l,
|
2465: TF_peak_cor = GRN@data$TFs$classification[[permIndex]] [[connectionTypeCur]]$TF_peak_cor
|
2467: .plot_heatmapAR(TF.peakMatrix.df = peak_TF_overlapCur.df,
|
2472: median.cor.tfs = .asMatrixFromSparse(GRN@data$TFs$classification[[permIndex]] [[connectionTypeCur]]$TF_cor_median_foreground),
|
2473: median.cor.tfs.non = .asMatrixFromSparse(GRN@data$TFs$classification[[permIndex]] [[connectionTypeCur]]$TF_cor_median_background),
|
2474: act.rep.thres.l = GRN@data$TFs$classification[[permIndex]] [[connectionTypeCur]]$act.rep.thres.l,
|
2475: finalClassification = GRN@data$TFs$classification[[permIndex]] [[connectionTypeCur]]$TF.classification,
|
2485: GRN@data$TFs$classification[[permIndex]] [[connectionTypeCur]]$TF_cor_median_foreground = NULL
|
2486: GRN@data$TFs$classification[[permIndex]] [[connectionTypeCur]]$TF_cor_median_background = NULL
|
2487: GRN@data$TFs$classification[[permIndex]] [[connectionTypeCur]]$TF_peak_cor_foreground = NULL
|
2488: GRN@data$TFs$classification[[permIndex]] [[connectionTypeCur]]$TF_peak_cor_background = NULL
|
2489: GRN@data$TFs$classification[[permIndex]] [[connectionTypeCur]]$act.rep.thres.l = NULL
|
2493: GRN@data$TFs$classification[[permIndex]] [[connectionTypeCur]]$TF_peak_cor_foreground =
|
2495: GRN@data$TFs$classification[[permIndex]] [[connectionTypeCur]]$TF_peak_cor_background =
|
2558: checkmate::assertClass(GRN, "GRN")
|
2803: minPerc = .findMaxBackgroundSize(GC_classes_foreground.df, GC_classes_background.df, peaksBackground,
|
2840: GC_classes_perTF.l[[TFCur]] = GC_classes_all.df
|
2850: for (i in seq_len(nrow(GC_classes_foreground.df))) {
|
2858: #Select the minimum, which for low % GC classes is smaller than the required number to mimic the foreground 100%
|
2861: nPeaksCur = GC_classes_all.df$n.bg.needed[i]
|
2863: nPeaksCur = min(GC_classes_all.df$n.bg.needed[i], nrow(peaksBackgroundGCCur))
|
2866: if (GC_classes_all.df$n.bg.needed[i] > nrow(peaksBackgroundGCCur)) {
|
2868: #": Needed: ", GC_classes_all.df$n.bg.needed[i], ", available: ", nrow(peaksBackgroundGCCur)))
|
2884: plots_GC.l[[connectionTypeCur]][[TFCur]] = .generateTF_GC_diagnosticPlots(TFCur, GC_classes_foreground.df, GC_classes_background.df, GC_classes_all.df, peaksForeground, peaksBackground, peaksBackgroundGC)
|
3066: GC_classes_all.l[[connectionTypeCur]] = GC_classes_perTF.l %>%
|
3073: GC_classes_all.l = NULL
|
3084: GC_details = GC_classes_all.l
|
3088: .findMaxBackgroundSize <- function(GC_classes_foreground.df, GC_classes_background.df, peaksBackground, threshold_percentage = 0.05) {
|
3107: for (i in seq_len(nrow(GC_classes_foreground.df))) {
|
3109: n_rel = GC_classes_foreground.df$n_rel[i]
|
3114: availableNoPeaks = GC_classes_background.df %>%
|
3132: if (i == nrow(GC_classes_foreground.df)) {
|
3138: } # end of for (i in 1:nrow(GC_classes_foreground.df)) {
|
3191: checkmate::assertClass(GRN, "GRN")
|
3767: checkmate::assertClass(GRN, "GRN")
|
4446: checkmate::assertClass(GRN, "GRN")
|
4602: checkmate::assertClass(GRN, "GRN")
|
4773: # Some SNPs may now be classified as "LD" although they ALSO overlap the peak in fact
|
4855: checkmate::assertClass(GRN, "GRN")
|
5211: ...(10 bytes skipped)...includeIDColumn Logical. \code{TRUE} or \code{FALSE}. Default \code{TRUE}. Only relevant if \code{asMatrix = FALSE}. If set to \code{TRUE}, an explicit ID column is returned (no row names). If set to \code{...(45 bytes skipped)...
|
5221: getCounts <- function(GRN, type, permuted = FALSE, asMatrix = FALSE, includeIDColumn = TRUE, includeFiltered = FALSE) {
|
5223: checkmate::assertClass(GRN, "GRN")
|
5228: checkmate::assertFlag(asMatrix)
|
5243: } else if ("dgCMatrix" %in% classPeaks) {
|
5256: } else if ("dgCMatrix" %in% classRNA) {
|
5288: if (!asMatrix) {
|
5327: ...(2 bytes skipped)... data frame that is returned has different columns, which however can be divided into the following classes according to their name:
|
5382: checkmate::assertClass(GRN, "GRN")
|
5543: checkmate::assertClass(GRN, "GRN")
|
5619: checkmate::assertClass(GRN, "GRN")
|
5636: peaks.filt = getCounts(GRN, type = "peaks", asMatrix = TRUE)
|
5653: RNA.filt = getCounts(GRN, type = "rna", asMatrix = TRUE)
|
5844: #' Optional convenience function to delete intermediate data from the function \code{\link{AR_classification_wrapper}} and summary statistics that may occupy a lot of space
|
5854: checkmate::assertClass(GRN, "GRN")
|
5862: GRN@data$TFs$classification[[permIndex]]$TF_cor_median_foreground = NULL
|
5863: GRN@data$TFs$classification[[permIndex]]$TF_cor_median_background = NULL
|
5864: GRN@data$TFs$classification[[permIndex]]$TF_peak_cor_foreground = NULL
|
5865: GRN@data$TFs$classification[[permIndex]]$TF_peak_cor_background = NULL
|
5866: GRN@data$TFs$classification[[permIndex]]$act.rep.thres.l = NULL
|
5887: checkmate::assertClass(GRN, "GRN")
|
5973: GRN@data$peaks[["counts"]] = .storeAsMatrixOrSparseMatrix(GRN, df = GRN@data$peaks$counts_norm %>% dplyr::select(-"isFiltered"),
|
6001: GRN@data$RNA[["counts"]] = .storeAsMatrixOrSparseMatrix(GRN, df = GRN@data$RNA$counts_norm.l[["0"]] %>% dplyr::select(-"isFiltered"),
|
6295: # Some classes might be missing, add them here with explicit zeros
|
6352: dplyr::mutate(classAll = factor(.data$classAll, levels = c(paste0("real_",range), paste0("random_",range), "TRUE", "FALSE")),
|
6397: checkmate::assertClass(GRN, "GRN")
|
6408: expMeans.m = getCounts(GRN, type = "rna", permuted = FALSE, asMatrix = TRUE)
|
6419: ...(5 bytes skipped)... mean = rowMeans(getCounts(GRN, type = "peaks", permuted = FALSE, asMatrix = TRUE))) %>%
|
6472: checkmate::assertClass(GRN, "GRN")
|
88: par.l$internal$allClassificationThresholds = c(0.1, 0.05, 0.01, 0.001)
|
1475: ...(15 bytes skipped)...ode{NULL}, the specific genome version as provided in the object is used within \code{TFBSTools::getMatrixSet} in the \code{opts} list for \code{species},
|
1477: #' For more details, see \code{?TFBSTools::getMatrixSet}.
|
1480: ...(4 bytes skipped)...param ... Additional named elements for the \code{opts} function argument from \code{?TFBSTools::getMatrixSet} that is used to query the JASPAR database.
|
1588: GRN@config$parameters$internal$PFMatrixList = PFMatrixList
|
1592: TFsWithTFBSPredictions <- unlist(lapply(PFMatrixList, function(x) {return(TFBSTools::name(x))}), use.names = FALSE)
|
1593: IDsWithTFBSPredictions <- unlist(lapply(PFMatrixList, function(x) {return(TFBSTools::ID(x))}), use.names = FALSE)
|
1717: GRN@config$parameters$internal$PFMatrixList = GRN@config$parameters$internal$PFMatrixList[allTF]
|
1932: if (is.null(GRN@config$parameters$internal$PFMatrixList)) {
|
1933: message = paste0(" GRN@config$parameters$internal$PFMatrixList is NULL but shouldnt be. Rerun the function addTFBS.")
|
1939: TF_names <- unlist(lapply(PFMatrixList, function(x) {return(TFBSTools::name(x))}), use.names = FALSE)
|
1940: TF_IDs <- unlist(lapply(PFMatrixList, function(x) {return(TFBSTools::ID(x))}), use.names = FALSE)
|
1942: overlapsAll <- motifmatchr::matchMotifs(PFMatrixList, consensusPeaks, out = 'matches',
|
2060: peak_TF_overlapCur.df = .asMatrixFromSparse(GRN@data$TFs$TF_peak_overlap, convertZero_to_NA = FALSE) %>%
|
2419: .finalizeClassificationAndAppend(
|
5244: result = .asMatrixFromSparse(GRN@data$peaks$counts, convertZero_to_NA = FALSE)
|
5257: result = .asMatrixFromSparse(GRN@data$RNA$counts, convertZero_to_NA = FALSE)
|
Pi:R/xMLcaret.r: [ ] |
---|
88: class <- as.factor(gs_targets[!is.na(ind)])
|
87: df_predictor_class <- as.data.frame(df_predictor[ind[!is.na(ind)],])
|
102: ...(4 bytes skipped)...Control <- caret::trainControl(method=c("repeatedcv","cv","oob")[1], number=nfold, repeats=nrepeat, classProbs=TRUE, summaryFunction=caret::twoClassSummary, allowParallel=FALSE)
|
830: vec_ap <- dnet::dPvalAggregate(pmatrix=df_pval, method=aggregateBy)
|
1: #' Function to integrate predictor matrix in a supervised manner via machine learning algorithms using caret.
|
3: #' \code{xMLcaret} is supposed to integrate predictor matrix...(165 bytes skipped)...s: 1) Gold Standard Positive (GSP) targets; 2) Gold Standard Negative (GSN) targets; 3) a predictor matrix...(17 bytes skipped)... in rows and predictors in columns, with their predictive scores inside it. It returns an object of class 'sTarget'.
|
10: ...(71 bytes skipped)...idataion. Per fold creates balanced splits of the data preserving the overall distribution for each class (GSP and GSN), therefore generating balanced cross-vallidation train sets and testing sets. By defa...(44 bytes skipped)...
|
18: #' an object of class "sTarget", a list with following components:
|
20: #' \item{\code{model}: an object of class "train" as a best model}
|
29: #' \item{\code{evidence}: an object of the class "eTarget", a list with following components "evidence" and "metag"}
|
85: ## predictors + class
|
89: levels(class) <- c("GSN","GSP")
|
90: df_predictor_class$class <- class
|
94: ...(40 bytes skipped)...ds (%d in GSP, %d in GSN) are used for supervised integration of %d predictors/features (%s).", sum(class=="GSP"), sum(class=="GSN"), ncol(df_predictor), as.character(now)), appendLF=TRUE)
|
119: fit_gbm <- caret::train(class ~ .,
|
120: data = df_predictor_class,
|
158: fit_svm <- caret::train(class ~ .,
|
159: data = df_predictor_class,
|
195: fit_rda <- caret::train(class ~ .,
|
196: data = df_predictor_class,
|
231: fit_knn <- caret::train(class ~ .,
|
232: data = df_predictor_class,
|
267: fit_pls <- caret::train(class ~ .,
|
268: data = df_predictor_class,
|
305: suppressMessages(fit_nnet <- caret::train(class ~ .,
|
306: data = df_predictor_class,
|
346: fit_rf <- caret::train(class ~ .,
|
347: data = df_predictor_class,
|
384: class = c("numeric", 'numeric'),
|
446: fit_myrf <- caret::train(class ~ .,
|
447: data = df_predictor_class,
|
486: fit_crf <- caret::train(class ~ .,
|
487: data = df_predictor_class,
|
524: fit_glmnet <- caret::train(class ~ .,
|
525: data = df_predictor_class,
|
556: fit_glm <- caret::train(class ~ .,
|
557: data = df_predictor_class,
|
589: fit_bglm <- caret::train(class ~ .,
|
590: data = df_predictor_class,
|
627: fit_blr <- caret::train(class ~ .,
|
628: data = df_predictor_class,
|
669: fit_xgbl <- caret::train(class ~ .,
|
670: data = df_predictor_class,
|
712: fit_xgbt <- caret::train(class ~ .,
|
713: data = df_predictor_class,
|
747: message(sprintf("Extract the performance matrix of %d rows/repeats*folds X 2 (AUC and F-max) (%s).", nfold*nrepeat, as.character(now)), appendLF=TR...(3 bytes skipped)...
|
792: message(sprintf("Extract the full prediction matrix of %d rows/genes X %d columns/repeats*folds, aggregated via '%s' (%s) ...", nrow(df_predictor_class), nfold*nrepeat, aggregateBy, as.character(now)), appendLF=TRUE)
|
818: df_full <- as.matrix(xSparseMatrix(df_full, verbose=FALSE))
|
917: class(sTarget) <- "sTarget"
|
34: #' @seealso \code{\link{xPierMatrix}}, \code{\link{xPredictROCR}}, \code{\link{xPredictCompare}}, \code{\link{xSparseMatrix}}, \code{\link{xSymbol2GeneID}}
|
57: df_predictor <- xPierMatrix(list_pNode, displayBy="score", combineBy="union", aggregateBy="none", RData.location=RData.location...(12 bytes skipped)...
|
61: eTarget <- xPierMatrix(list_pNode, displayBy="evidence", combineBy="union", aggregateBy="none", verbose=FALSE, RData.locat...(30 bytes skipped)...
|
103: fitControl_withoutParameters <- caret::trainControl(method="none", classProbs=TRUE, allowParallel=FALSE)
|
381: type = "Classification",
|
394: fit = function(x, y, wts, param, lev, last, classProbs, ...) {
|
432: levels = function(x) x$classes,
|
HiCBricks:R/Brick_functions.R: [ ] |
---|
2168: Matrix <- Brick_get_matrix(Brick = Brick, chr1 = chr1, chr2 = chr2,
|
2255: Matrix <- Brick_get_vector_values(Brick = Brick, chr1=chr1, chr2=chr2,
|
554: Matrix_info <- return_configuration_matrix_info(Brick)
|
776: Matrix.list.df <- do.call(rbind,chr1.list)
|
1322: Brick_load_matrix = function(Brick = NA, chr1 = NA, chr2 = NA, resolution = NA,
|
1613: Matrix.list <- Brick_list_matrices(Brick = Brick, chr1 = chr1,
|
1657: Matrix.list <- Brick_list_matrices(Brick = Brick, chr1 = chr1, chr2 = chr2,
|
1713: Matrix.list <- Brick_list_matrices(Brick = Brick, chr1 = chr1, chr2 = chr2,
|
1803: Matrix.list <- Brick_list_matrices(Brick = Brick, chr1 = chr1, chr2 = chr2,
|
1898: Matrix.list <- Brick_list_matrices(Brick = Brick, chr1 = chr1, chr2 = chr2,
|
2228: Brick_get_matrix = function(Brick, chr1, chr2, x_coords,
|
2364: Class.type <- ._Check_numeric
|
2365: Class.exp <- c("numeric","integer")
|
2574: Brick_get_entire_matrix = function(Brick, chr1, chr2, resolution){
|
2592: entire_matrix <- dataset_handle[]
|
2848: a_matrix <- .remove_nas(Brick_get_entire_matrix(Brick = Brick,
|
2850: normalised_matrix <- .normalize_by_distance_values(a_matrix)
|
2851: correlation_matrix <- cor(normalised_matrix)
|
206: Configuration_matrix_list <- list()
|
1419: Brick_load_cis_matrix_till_distance = function(Brick = NA, chr = NA,
|
1607: Brick_matrix_isdone = function(Brick, chr1, chr2, resolution = NA){
|
1651: Brick_matrix_issparse = function(Brick, chr1, chr2, resolution = NA){
|
1703: Brick_matrix_maxdist = function(Brick, chr1, chr2, resolution = NA){
|
1758: Brick_matrix_exists = function(Brick, chr1, chr2, resolution = NA){
|
1797: Brick_matrix_minmax = function(Brick, chr1, chr2, resolution = NA){
|
1843: Brick_matrix_dimensions = function(Brick, chr1, chr2, resolution = NA){
|
1892: Brick_matrix_filename = function(Brick, chr1, chr2, resolution = NA){
|
2124: Brick_get_matrix_within_coords = function(Brick, x_coords,
|
2647: Brick_get_matrix_mcols = function(Brick, chr1, chr2, resolution,
|
2706: Brick_list_matrix_mcols = function(){
|
8: #' table associated to the Hi-C experiment, creates a 2D matrix
|
10: #' project. At the end, this function will return a S4 object of class
|
21: #' contains 250 entries in the binning table, the _cis_ Hi-C data matrix for
|
24: #' matrices for chr1,chr2 will be a matrix with dimension 250 rows and
|
60: #' set to matrix dimensions/100.
|
74: #' A value of length 1 of class character or numeric specifying the resolution
|
95: #' \item Min - min value of Hi-C matrix
|
96: #' \item Max - max value of Hi-C matrix
|
97: #' \item sparsity - specifies if this is a sparse matrix
|
99: #' \item Done - specifies if a matrix has been loaded
|
101: #' \item matrix - \strong{dataset} - contains the matrix
|
138: #' the function will return an object of class BrickContainer.
|
235: Configuration_matrix_list <- return_configuration_matrix_info(
|
267: Configuration_matrix_list[[paste(chrom1, chrom2,
|
281: Configuration_matrix_list,
|
527: #' for that chromosome in a Hi-C matrix.
|
555: current_resolution <- vapply(Matrix_info, function(a_list){
|
561: chrom1_binned_length <- vapply(Matrix_info[current_resolution],
|
565: chrom1s <- vapply(Matrix_info[current_resolution],
|
569: chrom1_max_sizes <- vapply(Matrix_info[current_resolution],
|
646: #' An object of class ranges specifying the ranges to store in the Brick.
|
652: #' When an object of class BrickContainer is provided, resolution defines the
|
661: #' When an object of class BrickContainer is provided, num_cpus defines the
|
692: if(!(class(ranges) %in% "GRanges") | ("list" %in% class(ranges))){
|
693: stop("Object of class Ranges expected")
|
720: #' List the matrix pairs present in the Brick store.
|
727: #' @inheritParams Brick_load_matrix
|
733: #' minimum and maximum values in the matrix, done is a logical value
|
734: #' specifying if a matrix has been loaded and sparsity specifies if a matrix
|
735: #' is defined as a sparse matrix.
|
777: rownames(Matrix.list.df) <- NULL
|
778: return(Matrix.list.df)
|
954: BrickContainer_class_check(Brick)
|
1127: #' Indexes is a column of class \code{IRanges::IntegerList}, which is
|
1169: stop("Provided chr, start, end do not match expected class ",
|
1263: #' Load a NxM dimensional matrix into the Brick store.
|
1269: #' the rows of the matrix
|
1273: #' the columns of the matrix
|
1275: #' @param matrix_file \strong{Required}.
|
1277: #' matrix into the Brick store.
|
1280: #' The delimiter of the matrix file.
|
1283: #' If a matrix was loaded before, it will not be replaced. Use remove_prior to
|
1284: #' override and replace the existing matrix.
|
1290: #' If true, designates the matrix as being a sparse matrix, and computes the
|
1306: #' out_dir <- file.path(tempdir(), "matrix_load_test")
|
1314: #' Matrix_file <- system.file(file.path("extdata",
|
1318: #' Brick_load_matrix(Brick = My_BrickContainer, chr1 = "chr2L",
|
1319: #' chr2 = "chr2L", matrix_file = Matrix_file, delim = " ",
|
1323: matrix_file = NA, delim = " ", remove_prior = FALSE, num_rows = 2000,
|
1326: BrickContainer_class_check(Brick)
|
1328: resolution = resolution, matrix_file = matrix_file,
|
1348: if(!Brick_matrix_exists(Brick = Brick, chr1 = chr1, chr2 = chr2,
|
1352: if(Brick_matrix_isdone(Brick = Brick, chr1 = chr1,
|
1354: stop("A matrix was preloaded before. ",
|
1367: Matrix.file = matrix_file, delim = delim, Group.path = Group.path,
|
1375: #' Load a NxN dimensional sub-distance \emph{cis} matrix into
|
1380: #' @inheritParams Brick_load_matrix
|
1384: #' the rows and cols of the matrix
|
1388: #' it does not make sense to load the entire matrix into the data structure, as
|
1389: #' after a certain distance, the matrix will become extremely sparse. This
|
1403: #' out_dir <- file.path(tempdir(), "matrix_load_dist_test")
|
1411: #' Matrix_file <- system.file(file.path("extdata",
|
1415: #' Brick_load_cis_matrix_till_distance(Brick = My_BrickContainer,
|
1416: #' chr = "chr2L", resolution = 100000, matrix_file = Matrix_file,
|
1420: resolution = NA, matrix_file, delim = " ", distance, remove_prior = FALSE,
|
1425: matrix_file = matrix_file, delim = delim, distance = distance,
|
1443: if(!Brick_matrix_exists(Brick = Brick, chr1 = chr,
|
1447: if(Brick_matrix_isdone(Brick = Brick, chr1 = chr,
|
1449: stop("A matrix was preloaded before. Use remove_prior = TRUE to ",
|
1461: RetVar <- ._Process_matrix_by_distance(Brick = Brick_filepath,
|
1462: Matrix.file = matrix_file, delim = delim, Group.path = Group.path,
|
1470: #' Load a NxN dimensional matrix into the Brick store from an mcool file.
|
1472: #' Read an mcool contact matrix coming out of 4D nucleome projects into a
|
1477: #' @inheritParams Brick_load_matrix
|
1489: #' @param matrix_chunk \strong{Optional}. Default 2000.
|
1490: #' The nxn matrix square to fill per iteration in a mcool file.
|
1493: #' cooler_read_limit sets the upper limit for the number of records per matrix
|
1495: #' matrix_chunk value will be re-evaluated dynamically.
|
1521: #' resolution = 50000, matrix_chunk = 2000, remove_prior = TRUE,
|
1527: #' @seealso \code{\link{Create_many_Bricks_from_mcool}} to create matrix from
|
1533: matrix_chunk = 2000, cooler_read_limit = 10000000, remove_prior = FALSE,
|
1569: resolution = resolution, matrix_chunk = matrix_chunk,
|
1575: #' Check if a matrix has been loaded for a chromosome pair.
|
1579: #' @inheritParams Brick_load_matrix
|
1581: #' @return Returns a logical vector of length 1, specifying if a matrix has
|
1588: #' out_dir <- file.path(tempdir(), "matrix_isdone_test")
|
1596: #' Matrix_file <- system.file(file.path("extdata",
|
1600: #' Brick_load_matrix(Brick = My_BrickContainer, chr1 = "chr2L",
|
1601: #' chr2 = "chr2L", matrix_file = Matrix_file, delim = " ",
|
1604: #' Brick_matrix_isdone(Brick = My_BrickContainer, chr1 = "chr2L",
|
1609: if(!Brick_matrix_exists(Brick = Brick, chr1 = chr1, chr2 = chr2,
|
1615: return(Matrix.list[Matrix.list$chr1 == chr1 &
|
1616: Matrix.list$chr2 == chr2, "done"])
|
1619: #' Check if a matrix for a chromosome pair is sparse.
|
1623: #' @inheritParams Brick_load_matrix
|
1625: #' @return Returns a logical vector of length 1, specifying if a matrix was
|
1626: #' loaded as a sparse matrix.
|
1632: #' out_dir <- file.path(tempdir(), "matrix_issparse_test")
|
1640: #' Matrix_file <- system.file(file.path("extdata",
|
1644: #' Brick_load_matrix(Brick = My_BrickContainer, chr1 = "chr2L",
|
1645: #' chr2 = "chr2L", matrix_file = Matrix_file, delim = " ",
|
1648: #' Brick_matrix_issparse(Brick = My_BrickContainer, chr1 = "chr2L",
|
1653: if(!Brick_matrix_exists(Brick = Brick, chr1 = chr1, chr2 = chr2,
|
1659: return(Matrix.list[Matrix.list$chr1 == chr1 &
|
1660: Matrix.list$chr2 == chr2, "sparsity"])
|
1664: #' Get the maximum loaded distance from the diagonal of any matrix.
|
1666: #' If values beyond a certain distance were not loaded in the matrix, this
|
1670: #' `Brick_matrix_maxdist` will return this parameter.
|
1674: #' @inheritParams Brick_load_matrix
|
1677: #' distance loaded for that matrix
|
1684: #' out_dir <- file.path(tempdir(), "matrix_maxdist_test")
|
1692: #' Matrix_file <- system.file(file.path("extdata",
|
1696: #' Brick_load_matrix(Brick = My_BrickContainer, chr1 = "chr2L",
|
1697: #' chr2 = "chr2L", matrix_file = Matrix_file, delim = " ",
|
1700: #' Brick_matrix_maxdist(Brick = My_BrickContainer, chr1 = "chr2L",
|
1705: if(!Brick_matrix_exists(Brick = Brick, chr1 = chr1, chr2 = chr2,
|
1709: if(!Brick_matrix_isdone(Brick = Brick, chr1 = chr1, chr2 = chr2,
|
1715: return((Matrix.list[Matrix.list$chr1 == chr1 &
|
1716: Matrix.list$chr2 == chr2, "distance"]))
|
1722: #' are provided. If a user is in doubt regarding whether a matrix is present or
|
1729: #' @inheritParams Brick_load_matrix
|
1731: #' @return Returns a logical vector of length 1, specifying if the matrix
|
1739: #' out_dir <- file.path(tempdir(), "matrix_exists_test")
|
1747: #' Matrix_file <- system.file(file.path("extdata",
|
1751: #' Brick_load_matrix(Brick = My_BrickContainer, chr1 = "chr2L",
|
1752: #' chr2 = "chr2L", matrix_file = Matrix_file, delim = " ",
|
1755: #' Brick_matrix_exists(Brick = My_BrickContainer, chr1 = "chr2L",
|
1765: #' Return the value range of the matrix
|
1769: #' @inheritParams Brick_load_matrix
|
1772: #' maximum finite real values in the matrix.
|
1778: #' out_dir <- file.path(tempdir(), "matrix_minmax_test")
|
1786: #' Matrix_file <- system.file(file.path("extdata",
|
1790: #' Brick_load_matrix(Brick = My_BrickContainer, chr1 = "chr2L",
|
1791: #' chr2 = "chr2L", matrix_file = Matrix_file, delim = " ",
|
1794: #' Brick_matrix_minmax(Brick = My_BrickContainer, chr1 = "chr2L",
|
1799: if(!Brick_matrix_exists(Brick = Brick, chr1 = chr1, chr2 = chr2,
|
1805: Filter <- Matrix.list$chr1 == chr1 & Matrix.list$chr2 == chr2
|
1806: Extent <- c(Matrix.list[Filter, "min"],Matrix.list[Filter, "max"])
|
1810: #' Return the dimensions of a matrix
|
1814: #' @inheritParams Brick_load_matrix
|
1816: #' @return Returns the dimensions of a Hi-C matrix for any given
|
1824: #' out_dir <- file.path(tempdir(), "matrix_dimension_test")
|
1832: #' Matrix_file <- system.file(file.path("extdata",
|
1836: #' Brick_load_matrix(Brick = My_BrickContainer, chr1 = "chr2L",
|
1837: #' chr2 = "chr2L", matrix_file = Matrix_file, delim = " ",
|
1840: #' Brick_matrix_dimensions(Brick = My_BrickContainer, chr1 = "chr2L",
|
1844: if(!Brick_matrix_exists(Brick = Brick, chr1 = chr1, chr2 = chr2,
|
1853: dataset.path = Reference.object$hdf.matrix.name,
|
1859: #' Return the filename of the loaded matrix
|
1863: #' @inheritParams Brick_load_matrix
|
1866: #' the currently loaded matrix.
|
1873: #' out_dir <- file.path(tempdir(), "matrix_filename_test")
|
1881: #' Matrix_file <- system.file(file.path("extdata",
|
1885: #' Brick_load_matrix(Brick = My_BrickContainer, chr1 = "chr2L",
|
1886: #' chr2 = "chr2L", matrix_file = Matrix_file, delim = " ",
|
1889: #' Brick_matrix_filename(Brick = My_BrickContainer, chr1 = "chr2L",
|
1894: if(!Brick_matrix_exists(Brick = Brick, chr1 = chr1, chr2 = chr2,
|
1900: Filter <- Matrix.list$chr1 == chr1 & Matrix.list$chr2 == chr2
|
1901: Extent <- Matrix.list[Filter, "filename"]
|
1914: #' A string specifying the chromosome for the cis Hi-C matrix from which values
|
1947: #' Matrix_file <- system.file(file.path("extdata",
|
1951: #' Brick_load_matrix(Brick = My_BrickContainer, chr1 = "chr2L",
|
1952: #' chr2 = "chr2L", matrix_file = Matrix_file, delim = " ",
|
1966: #' @seealso \code{\link{Brick_get_matrix_within_coords}} to get matrix by
|
1967: #' using matrix coordinates, \code{\link{Brick_fetch_row_vector}} to get values
|
1969: #' to get values using matrix coordinates, \code{\link{Brick_get_matrix}} to
|
1970: #' get matrix by using matrix coordinates.
|
1979: if(!Brick_matrix_exists(Brick = Brick, chr1 = chr,
|
1981: !Brick_matrix_isdone(Brick = Brick, chr1 = chr,
|
1993: Max.dist <- Brick_matrix_maxdist(Brick = Brick, chr1 = chr, chr2 = chr,
|
1997: "this matrix was at a distance of "
|
2041: Name = Reference.object$hdf.matrix.name,
|
2055: #' Return a matrix subset between two regions.
|
2057: #' `Brick_get_matrix_within_coords` will fetch a matrix subset after
|
2060: #' This function calls \code{\link{Brick_get_matrix}}.
|
2075: #' If true, will force the retrieval operation when matrix contains loaded
|
2080: #' the matrix is returned.
|
2082: #' @return Returns a matrix of dimension x_coords binned length by y_coords
|
2090: #' out_dir <- file.path(tempdir(), "get_matrix_coords_test")
|
2098: #' Matrix_file <- system.file(file.path("extdata",
|
2102: #' Brick_load_matrix(Brick = My_BrickContainer, chr1 = "chr2L",
|
2103: #' chr2 = "chr2L", matrix_file = Matrix_file, delim = " ",
|
2106: #' Brick_get_matrix_within_coords(Brick = My_BrickContainer,
|
2111: #' Brick_get_matrix_within_coords(Brick = My_BrickContainer,
|
2118: #' @seealso \code{\link{Brick_get_matrix}} to get matrix by using matrix
|
2122: #' \code{\link{Brick_get_vector_values}} to get values using matrix
|
2136: " found x_coords class ", class(x_coords), " and y_coords class ",
|
2137: class(y_coords))
|
2152: if(!Brick_matrix_isdone(Brick = Brick, chr1 = chr1, chr2 = chr2,
|
2154: stop(chr1," ",chr2," matrix is yet to be loaded into the class.")
|
2171: return(Matrix)
|
2174: #' Return a matrix subset.
|
2176: #' `Brick_get_matrix` will fetch a matrix subset between row values
|
2182: #' @inheritParams Brick_load_matrix
|
2191: #' If provided a data transformation with FUN will be applied before the matrix
|
2194: #' @inheritParams Brick_get_matrix_within_coords
|
2196: #' @return Returns a matrix of dimension x_coords length by y_coords length.
|
2203: #' out_dir <- file.path(tempdir(), "get_matrix_test")
|
2211: #' Matrix_file <- system.file(file.path("extdata",
|
2215: #' Brick_load_matrix(Brick = My_BrickContainer, chr1 = "chr2L",
|
2216: #' chr2 = "chr2L", matrix_file = Matrix_file, delim = " ",
|
2219: #' Brick_get_matrix(Brick = My_BrickContainer, chr1 = "chr2L", chr2 = "chr2L",
|
2222: #' @seealso \code{\link{Brick_get_matrix_within_coords}} to get matrix by using
|
2223: #' matrix genomic coordinates, \code{\link{Brick_get_values_by_distance}} to
|
2227: #' matrix coordinates.
|
2243: if(!Brick_matrix_isdone(Brick = Brick, chr1 = chr1, chr2 = chr2,
|
2245: stop(chr1,chr2," matrix is yet to be loaded into the class.\n")
|
2258: return(Matrix)
|
2260: return(FUN(Matrix))
|
2266: #' `Brick_fetch_row_vector` will fetch any given rows from a matrix. If
|
2273: #' @inheritParams Brick_load_matrix
|
2293: #' @inheritParams Brick_get_matrix_within_coords
|
2300: #' If provided a data transformation with FUN will be applied before the matrix
|
2320: #' Matrix_file <- system.file(file.path("extdata",
|
2324: #' Brick_load_matrix(Brick = My_BrickContainer, chr1 = "chr2L",
|
2325: #' chr2 = "chr2L", matrix_file = Matrix_file, delim = " ",
|
2334: #' @seealso \code{\link{Brick_get_matrix_within_coords}} to get matrix by
|
2335: #' using matrix genomic coordinates, \code{\link{Brick_get_values_by_distance}}
|
2338: #' subset them, \code{\link{Brick_get_matrix}} to get matrix by using
|
2339: #' matrix coordinates.
|
2354: max.dist <- Brick_matrix_maxdist(Brick = Brick, chr1 = chr1, chr2 = chr2,
|
2357: stop("Provided Chromosomes does not appear to be of class character")
|
2359: if(!Brick_matrix_isdone(Brick = Brick, chr1 = chr1, chr2 = chr2,
|
2361: stop(chr1,chr2," matrix is yet to be loaded.")
|
2368: Class.type <- is.character
|
2369: Class.exp <- "character"
|
2371: if(!Class.type(vector)){
|
2372: stop("vector must be of class ",
|
2373: ifelse(length(Class.exp)>1,paste(Class.exp,collapse=" or "),
|
2374: paste(Class.exp))," when by has value ",by)
|
2437: #' other matrix retrieval functions.
|
2441: #' @inheritParams Brick_load_matrix
|
2457: #' @inheritParams Brick_get_matrix_within_coords
|
2460: #' returns a matrix of dimension xaxis length by yaxis length.
|
2477: #' Matrix_file <- system.file(file.path("extdata",
|
2481: #' Brick_load_matrix(Brick = My_BrickContainer, chr1 = "chr2L",
|
2482: #' chr2 = "chr2L", matrix_file = Matrix_file, delim = " ",
|
2501: stop("Provided Chromosomes does not appear to be of class character")
|
2503: if(!Brick_matrix_isdone(Brick = Brick, chr1 = chr1, chr2 = chr2,
|
2505: stop(chr1,chr2," matrix is yet to be loaded.")
|
2513: Max.dist <- Brick_matrix_maxdist(Brick = Brick, chr1 = chr1, chr2 = chr2,
|
2518: "this matrix was at a distance of ",
|
2527: Brick = Brick_filepath, Name = Reference.object$hdf.matrix.name,
|
2536: #' Return an entire matrix for provided chromosome pair for a resolution.
|
2538: #' `Brick_get_entire_matrix` will return the entire matrix for the entire
|
2539: #' chromosome pair provided an object of class BrickContainer, and values for
|
2544: #' @inheritParams Brick_load_matrix
|
2546: #' @return Returns an object of class matrix with dimensions corresponding to
|
2563: #' Matrix_file <- system.file(file.path("extdata",
|
2567: #' Brick_load_matrix(Brick = My_BrickContainer, chr1 = "chr2L",
|
2568: #' chr2 = "chr2L", matrix_file = Matrix_file, delim = " ",
|
2571: #' Entire_matrix <- Brick_get_entire_matrix(Brick = My_BrickContainer,
|
2579: stop("Provided Chromosomes does not appear to be of class character")
|
2581: if(!Brick_matrix_isdone(Brick = Brick, chr1 = chr1, chr2 = chr2,
|
2583: stop(chr1,chr2," matrix is yet to be loaded.")
|
2590: Brick = Brick_filepath, Name = Reference_object$hdf.matrix.name,
|
2594: return(entire_matrix)
|
2597: #' Get the matrix metadata columns in the Brick store.
|
2599: #' `Brick_get_matrix_mcols` will get the specified matrix metadata column for
|
2600: #' a chr1 vs chr2 Hi-C data matrix. Here, chr1 represents the rows and chr2
|
2601: #' represents the columns of the matrix. For cis Hi-C matrices, where
|
2615: #' @inheritParams Brick_load_matrix
|
2618: #' A character vector of length 1 specifying the matrix metric to retrieve
|
2620: #' @return Returns a 1xN dimensional vector containing the specified matrix
|
2628: #' out_dir <- file.path(tempdir(), "get_matrix_mcols_test")
|
2636: #' Matrix_file <- system.file(file.path("extdata",
|
2640: #' Brick_load_matrix(Brick = My_BrickContainer, chr1 = "chr2L",
|
2641: #' chr2 = "chr2L", matrix_file = Matrix_file, delim = " ",
|
2644: #' Brick_get_matrix_mcols(Brick = My_BrickContainer, chr1 = "chr2L",
|
2652: Meta.cols <- Reference.object$hdf.matrix.meta.cols()
|
2653: BrickContainer_class_check(Brick)
|
2657: if(!Brick_matrix_exists(Brick = Brick, chr1 = chr1, chr2 = chr2,
|
2659: stop("Matrix for this chromsome pair does not exist.\n")
|
2661: if(!Brick_matrix_isdone(Brick = Brick, chr1 = chr1, chr2 = chr2,
|
2663: stop("Matrix for this chromsome pair is yet to be loaded.\n")
|
2668: if(!Brick_matrix_issparse(Brick = Brick, chr1 = chr1, chr2 = chr2,
|
2670: stop("This matrix is not a sparse matrix.",
|
2685: #' List the matrix metadata columns in the Brick store.
|
2687: #' `Brick_get_matrix_mcols` will list the names of all matrix metadata
|
2690: #' @return Returns a vector containing the names of all matrix metadata columns
|
2697: #' out_dir <- file.path(tempdir(), "list_matrix_mcols_test")
|
2705: #' Brick_list_matrix_mcols()
|
2708: Meta.cols <- Reference.object$hdf.matrix.meta.cols()
|
2714: #' upper triangle sparse matrix
|
2716: #' `Brick_export_to_sparse` will accept as input an object of class
|
2719: #' objects as a upper triangle sparse matrix (col > row) containing
|
2746: #' Matrix_file <- system.file(file.path("extdata",
|
2750: #' Brick_load_matrix(Brick = My_BrickContainer, chr1 = "chr2L",
|
2751: #' chr2 = "chr2L", matrix_file = Matrix_file, delim = " ",
|
2833: #' Matrix_file <- system.file(file.path("extdata",
|
2837: #' Brick_load_matrix(Brick = My_BrickContainer, chr1 = "chr2L",
|
2838: #' chr2 = "chr2L", matrix_file = Matrix_file, delim = " ",
|
2847: BrickContainer_class_check(Brick)
|
2852: correlation_matrix <- .remove_nas(correlation_matrix)
|
2856: pca_list <- prcomp(correlation_matrix)
|
2868: #' @inheritParams Brick_load_matrix
|
2873: #' sparse matrix
|
2875: #' @param matrix_chunk \strong{Optional}. Default 2000.
|
2876: #' The nxn matrix square to fill per iteration.
|
2900: #' Matrix_file <- system.file(file.path("extdata",
|
2904: #' Brick_load_matrix(Brick = My_BrickContainer, chr1 = "chr2L",
|
2905: #' chr2 = "chr2L", matrix_file = Matrix_file, delim = " ",
|
2918: resolution = NULL, batch_size = 1000000, matrix_chunk = 2000,
|
2921: BrickContainer_class_check(Brick)
|
2930: delim = delim, resolution = resolution, matrix_chunk = matrix_chunk,
|
173: Reference.object <- GenomicMatrix$new()
|
330: Reference.object <- GenomicMatrix$new()
|
426: Reference.object <- GenomicMatrix$new()
|
468: Reference.object <- GenomicMatrix$new()
|
549: Reference.object <- GenomicMatrix$new()
|
617: Reference.object <- GenomicMatrix$new()
|
691: Reference.object <- GenomicMatrix$new()
|
756: Reference.object <- GenomicMatrix$new()
|
810: Reference.object <- GenomicMatrix$new()
|
892: Reference.object <- GenomicMatrix$new()
|
953: Reference.object <- GenomicMatrix$new()
|
1086: Reference.object <- GenomicMatrix$new()
|
1325: Reference.object <- GenomicMatrix$new()
|
1366: RetVar <- ._ProcessMatrix_(Brick = Brick_filepath,
|
1423: Reference.object <- GenomicMatrix$new()
|
1535: Reference.object <- GenomicMatrix$new()
|
1608: Reference.object <- GenomicMatrix$new()
|
1652: Reference.object <- GenomicMatrix$new()
|
1704: Reference.object <- GenomicMatrix$new()
|
1798: Reference.object <- GenomicMatrix$new()
|
1848: Reference.object <- GenomicMatrix$new()
|
1893: Reference.object <- GenomicMatrix$new()
|
1977: Reference.object <- GenomicMatrix$new()
|
2494: Reference.object <- GenomicMatrix$new()
|
2575: Reference_object <- GenomicMatrix$new()
|
2651: Reference.object <- GenomicMatrix$new()
|
2707: Reference.object <- GenomicMatrix$new()
|
2760: Reference.object <- GenomicMatrix$new()
|
2920: Reference.object <- GenomicMatrix$new()
|
spatzie:R/find_ep_coenrichment.R: [ ] |
---|
255: matrixClass = jaspar_matrix_class)
|
247: jaspar_matrix_class <- "PFM"
|
40: #' matrix file containing multiple motifs to scan for, gz-zipped files allowed
|
41: #' @param motifs_file_matrix_format type of position-specific scoring matrices
|
44: #' \code{pfm}: \tab position frequency matrix, elements are absolute
|
46: #' \code{ppm}: \tab position probability matrix, elements are probabilities,
|
48: #' \code{pwm}: \tab position weight matrix, elements are log likelihoods
|
99: #' motifs_file_matrix_format = "pfm",
|
125: motifs_file_matrix_format = c("pfm", "ppm",
|
133: motifs_file_matrix_format <- match.arg(motifs_file_matrix_format,
|
158: stop("'int_raw_data' data type unsupported: ", class(int_raw_data))
|
221: promoter_left <- S4Vectors::elementMetadata(anchor1)[, "node.class"] == "promoter"
|
222: promoter_right <- S4Vectors::elementMetadata(anchor2)[, "node.class"] == "promoter"
|
246: if (motifs_file_matrix_format == "pfm") {
|
248: } else if (motifs_file_matrix_format == "ppm") {
|
249: jaspar_matrix_class <- "PWMProb"
|
250: } else if (motifs_file_matrix_format == "pwm") {
|
251: jaspar_matrix_class <- "PWM"
|
118: #' @importFrom TFBSTools readJASPARMatrix
|
254: motifs <- TFBSTools::readJASPARMatrix(motifs_file,
|
ISAnalytics:R/internal-functions.R: [ ] |
---|
134: rlang::warn(warn, class = "missing_crit_tags")
|
259: ), class = "missing_req_col_err")
|
290: ), class = "missing_req_col_err")
|
478: rlang::inform(warn_empty_iss, class = "warn_empty_iss")
|
587: class = "warn_empty_iss"
|
649: rlang::abort(error_msg(tags_names), class = "missing_tags_err")
|
758: rlang::abort(single_err, class = "tag_dupl_err")
|
823: rlang::abort(compact_msg, class = "tag_type_err")
|
1279: rlang::abort(add_types_err, class = "add_types_err")
|
1434: class = "xls_file"
|
1612: class = "na_concat"
|
1716: class = "filter_warn"
|
2078: class = "missing_path_col"
|
2542: rlang::inform(missing_msg, class = "auto_mode_miss")
|
2590: matrix <- rlang::exec(.import_single_matrix,
|
2741: class = "coll_matrix_issues"
|
2807: rlang::abort(not_date_err, class = "not_date_coll_err")
|
4156: rlang::abort(err_msg, class = "genomic_file_char")
|
4246: rlang::warn(warn_miss, class = "warn_miss_genes")
|
4609: class = "missing_cols_key"
|
4659: rlang::inform(flag_msg, class = "flag_logic_long")
|
4991: rlang::abort(format_err, class = "outlier_format_err")
|
5012: rlang::abort(err_length, class = "pop_size_err_length")
|
215: matrix_type = purrr::map_chr(
|
281: matrix_required_cols <- c(
|
1250: .import_single_matrix <- function(
|
5023: .convert_to_captures_matrix <- function(df, quant_cols,
|
5027: captures_matrix <- df |>
|
5086: matrix_desc <- .convert_to_captures_matrix(
|
5383: sub_matrix <- matrix_desc[, seq(from = t1, to = t2, by = 1)]
|
5429: sub_matrix <- matrix_desc[, seq(from = t1, to = t2, by = 1)]
|
4576: KnownGeneClass = ifelse(
|
1097: colClasses = col_types,
|
210: file_suffix = paste(.data$quantification_suffixes, "_matrix",
|
225: "quantification", "matrix_type",
|
285: if (!all(matrix_required_cols %in% colnames(integration_matrices))) {
|
287: matrix_required_cols,
|
288: matrix_required_cols[!matrix_required_cols %in%
|
418: sparse <- as_sparse_matrix(.x)
|
422: "fragmentEstimate_matrix.no0.annotated.tsv.gz",
|
423: "fragmentEstimate_matrix.tsv.gz"
|
426: "seqCount_matrix.no0.annotated.tsv.gz",
|
427: "seqCount_matrix.tsv.gz"
|
507: ### -- Choose a pool for matrix error
|
517: sparse <- as_sparse_matrix(.x)
|
521: "fragmentEstimate_matrix.no0.annotated.tsv.gz",
|
522: "fragmentEstimate_matrix.tsv.gz"
|
525: "seqCount_matrix.no0.annotated.tsv.gz",
|
526: "seqCount_matrix.tsv.gz"
|
653: rlang::abort(error_msg(missing_tags), class = "missing_tags_err")
|
776: rlang::inform(single_warn, class = "tag_dupl_warn")
|
799: err <- c(paste("Wrong col class for tag '", sub_df$tag[1], "'"),
|
986: # @param x A data.frame object (or any extending class)
|
1005: # @param x A data.frame object (or any extending class)
|
1018: # Finds experimental columns in an integration matrix.
|
1021: # standard integration matrix columns, if there are returns their names.
|
1040: # Checks if the integration matrix is annotated or not.
|
1055: #### ---- Internals for matrix import ----####
|
1057: #---- USED IN : import_single_Vispa2Matrix ----
|
1059: # Reads an integration matrix using data.table::fread
|
1126: # Reads an integration matrix using readr::read_delim
|
1217: # Melts a big matrix divided in chunks in parallel if possible (otherwise
|
1247: # import_single_Vispa2_matrix
|
1276: "?import_single_Vispa2Matrix"
|
1291: class = "im_single_miss_mand_vars"
|
1313: class = "unsup_comp_format"
|
1389: class = "ism_import_summary"
|
2062: matrix_type,
|
2064: multi_quant_matrix) {
|
2070: stopifnot(is.logical(multi_quant_matrix) & length(multi_quant_matrix) == 1)
|
2127: # @param matrix_type The matrix_type to lookup (one between "annotated" or
|
2151: suffixes <- matrix_file_suffixes() |>
|
2153: .data$matrix_type == m_type,
|
2387: matrix_type,
|
2395: matrix_type,
|
2565: rlang::inform(dupl_msg, class = "auto_mode_dupl")
|
2588: .import_type <- function(type_df, import_matrix_args, progr, max_workers) {
|
2589: wrapper <- function(path, import_matrix_args, progress) {
|
2592: !!!import_matrix_args
|
2597: return(matrix)
|
2602: fun_args = list(import_matrix_args = import_matrix_args),
|
2614: sample_col_name <- if ("id_col_name" %in% names(import_matrix_args)) {
|
2615: import_matrix_args[["id_col_name"]]
|
2650: return(list(matrix = NULL, imported_files = imported_files))
|
2654: list(matrix = type_matrices, imported_files = imported_files)
|
2664: import_matrix_args) {
|
2679: import_matrix_args = import_matrix_args,
|
2685: imported_matrices <- purrr::map(imported, ~ .x$matrix)
|
2687: list(matrix = imported_matrices, summary = summary_files)
|
2714: ## remove_collisions requires seqCount matrix, check if the list
|
2744: ## Transform the list in a multi-quant matrix
|
2748: x <- rlang::exec(comparison_matrix, !!!args)
|
2816: # Checks if association file contains more information than the matrix.
|
2819: # the examined matrix there are additional CompleteAmplificationIDs contained
|
2820: # in the association file that weren't included in the integration matrix (for
|
2968: # for multi quantification matrix)
|
3005: # for multi quantification matrix)
|
3115: # (obtained via `.join_matrix_af`)
|
3116: # @param after The final matrix obtained after collision processing
|
3166: # Internal for obtaining summary info about the input sequence count matrix
|
3194: ## Joined is the matrix already joined with metadata
|
3252: MATRIX = unique(x[[pcr_col]]),
|
3474: # - x is a single matrix
|
3546: # meaning a subset of an integration matrix in which all rows
|
4228: "the matrix. Here is a summary: "
|
4628: class = "missing_cols_pool"
|
4682: class = "flag_logic_short"
|
4700: rlang::abort(unknown_logi_op_err, class = "unsupp_logi_op")
|
4994: rlang::abort(format_err, class = "outlier_format_err")
|
5021: # Converts a group slice df to a captures matrix - input df contains only
|
5047: as.matrix()
|
5048: return(captures_matrix)
|
5085: # --- OBTAIN MATRIX (ALL TPs)
|
5093: # --- OBTAIN MATRIX (STABLE TPs)
|
5096: .convert_to_captures_matrix(
|
5110: timecaptures <- ncol(matrix_desc)
|
5117: matrix_desc = matrix_desc,
|
5137: matrix_desc = patient_slice_stable,
|
5159: matrix_desc = matrix_desc,
|
5178: matrix_desc = patient_slice_stable,
|
5199: estimate_consecutive_m0 <- if (ncol(matrix_desc) > 1) {
|
5201: matrix_desc = matrix_desc,
|
5221: estimate_consecutive_mth <- if (stable_tps & ncol(matrix_desc) > 2) {
|
5222: # - Note: pass the whole matrix, not only stable slice
|
5224: matrix_desc = matrix_desc,
|
5257: matrix_desc, timecaptures, cols_estimate_mcm,
|
5261: matrix_desc,
|
5268: colnames(matrix_desc)[1],
|
5272: colnames(matrix_desc)[ncol(matrix_desc)],
|
5302: matrix_desc, timecaptures, cols_estimate_mcm,
|
5305: matrix_desc,
|
5315: matrix_desc,
|
5326: matrix_desc,
|
5339: colnames(matrix_desc)[1],
|
5343: colnames(matrix_desc)[ncol(matrix_desc)],
|
5376: .consecutive_m0bc_est <- function(matrix_desc, cols_estimate_mcm, subject) {
|
5378: indexes <- seq(from = 1, to = ncol(matrix_desc) - 1, by = 1)
|
5385: colnames(sub_matrix)[1],
|
5389: colnames(sub_matrix)[ncol(sub_matrix)],
|
5393: sub_matrix,
|
5423: .consecutive_mth_est <- function(matrix_desc, cols_estimate_mcm, subject) {
|
5424: indexes_s <- seq(from = 1, to = ncol(matrix_desc) - 2, by = 1)
|
5431: colnames(sub_matrix)[1],
|
5435: colnames(sub_matrix)[ncol(sub_matrix)],
|
5439: sub_matrix,
|
820: "Wrong column classes for some tags",
|
1131: col_types <- .mandatory_IS_types("classic")
|
1135: .annotation_IS_types("classic")
|
1297: mode <- "classic"
|
1308: ### If not, switch to classic for reading
|
1309: mode <- "classic"
|
cTRAP:R/shinyInterface.R: [ ] |
---|
27: alert <- tags$div(class=paste0("alert alert-", type), role="alert", ...)
|
115: tags$div(class="container-fluid", style="padding-top: 15px;")
|
274: class <- class(dataset)[[1]]
|
1153: class <- "danger"
|
1584: tags$span(class="help-block", style="margin-top: -10px;",
|
11: .filterDatasetsByClass <- function(data, class, expected=FALSE) {
|
1388: corMatrix <- input$corMatrix
|
1404: selectedCorMatrix <- loadExpressionDrugSensitivityAssociation(
|
1742: elemClasses <- sapply(lapply(list(...), class), "[[", 1)
|
12: selected <- sapply(data, is, class)
|
14: # Return values that are expected to turn into the given class
|
15: expected <- sapply(data, is, paste0("expected", capitalize(class)))
|
34: class(data) <- c("diffExpr", class(data))
|
51: title <- div(class="panel-heading", h3(class="panel-title", title))
|
55: if (length(body) > 0) body <- div(class="panel-body", ...)
|
57: body <- div(id="collapseOne", class="panel-collapse collapse in",
|
60: if (!is.null(footer)) footer <- div(class="panel-footer", footer)
|
61: div(class=paste0("panel panel-", type), title, body, footer)
|
132: cols <- cols[!sapply(table, class)[cols] %in% c("character", "logical")]
|
162: .prepareReferenceComparisonDT <- function(data, class) {
|
163: data <- .filterDatasetsByClass(req(data), class, expected=TRUE)
|
276: tags <- paste0("#", c(class, source), collapse=" ")
|
287: # Update dataset choices (optionally, filter datasets by class)
|
288: .updateDatasetChoices <- function(session, id, data, class=NULL) {
|
289: if (!is.null(class)) data <- .filterDatasetsByClass(data, class)
|
332: actionButton(ns("load"), "Load data", class="btn-primary"))
|
409: actionButton(ns("load"), "Load data", class="btn-primary"))
|
573: actionButton(ns("load"), "Load data", class="btn-primary"),
|
925: class="compact hover stripe")
|
1158: class <- "danger"
|
1163: class <- "default"
|
1168: class <- "warning"
|
1173: class <- "success"
|
1180: class <- NULL
|
1183: class <- paste0(c("label label-"), class)
|
1185: html <- tags$span(style=colour, icon, state, ..., class=class)
|
1222: class(ranking) <- c(paste0("expected", capitalize(mode)), "expected",
|
1223: class(ranking))
|
1260: actionButton(ns("analyse"), "Rank by similarity", class="btn-primary"))
|
1370: class="btn-primary"))
|
1587: class="btn-primary"))
|
100: rapply(tag, FUN, how="replace", classes="character")
|
1207: selectedDiffExpr, selectedCorMatrix, method,
|
1355: selectizeInput(ns("corMatrix"),
|
1389: if (!is.null(corMatrix) || corMatrix != "") {
|
1390: dataset <- paste(corMatrix, tolower(dataset))
|
1397: corMatrix <- req(input$corMatrix)
|
1405: corMatrix, path=path)
|
1409: selectedDiffExpr, selectedCorMatrix, method,
|
1415: selectedDiffExpr, selectedCorMatrix, method,
|
1424: "Gene expression and drug sensitivity association"=corMatrix,
|
1484: sets <- .filterDatasetsByClass(x(), "drugSets")
|
1510: drugSets <- .filterDatasetsByClass(x(), "drugSets")
|
1743: hasSimilarPerts <- "similarPerturbations" %in% elemClasses
|
1744: hasTargetingDrugs <- "targetingDrugs" %in% elemClasses
|
CellaRepertorium:src/cdhit-common.h: [ ] |
---|
183: int matrix[MAX_AA][MAX_AA];
|
173: typedef Vector<VectorInt> MatrixInt;
|
176: typedef Vector<VectorInt64> MatrixInt64;
|
179: class ScoreMatrix { //Matrix
|
197: typedef Vector<VectorIntX> MatrixIntX;
|
96: template<class TYPE>
|
97: class Vector : public vector<TYPE>
|
113: template<class TYPE>
|
114: class NVector
|
178: ////////// Class definition //////////
|
189: void set_matrix(int *mat1);
|
193: }; // END class ScoreMatrix
|
233: class WordTable
|
261: }; // END class INDEX_TBL
|
534: class SequenceDB
|
186: ScoreMatrix();
|
476: MatrixInt64 score_mat;
|
477: MatrixInt back_mat;
|
531: extern ScoreMatrix mat;
|
606: int local_band_align( char query[], char ref[], int qlen, int rlen, ScoreMatrix &mat,
|
CancerSubtypes:R/internal.R: [ ] |
---|
427: class <- unique(x)
|
674: s.matrix=t(fit$expZ)%*%fit$expZ
|
169: affinityMatrix <- function(Diff,K=20,sigma=0.5) {
|
406: classx <- unique(x)
|
407: classy <- unique(y)
|
5: #' @param affinity Similarity matrix
|
20: affinity=as.matrix(affinity)
|
57: R = matrix(0,k,k)
|
65: c = matrix(0,n,1)
|
67: c = c + abs(eigenVectors %*% matrix(R[,j-1],k,1))
|
95: Y = matrix(0,nrow(eigenVector),ncol(eigenVector))
|
105: .distanceWeighted2<-function(X,weight) ##X is the expression Matrix(Row is sample, column is feature)
|
115: XX=matrix(rep(sumsqX, times = X_row), X_row, X_row)
|
132: #' @param X A data matrix where each row is a different data point
|
133: #' @param C A data matrix where each row is a different data point. If this matrix is the same as X, pairwise distances for all data points are computed.
|
139: #' Returns an N x M matrix where N is the number of rows in X and M is the number of rows in M. element (n,m) is the squared E...(70 bytes skipped)...
|
150: res = matrix(rep(sumsqX,times=ncentres),ndata,ncentres) + t(matrix(rep(sumsqC,times=ndata),ncentres,ndata)) - XC
|
155: #' This is the affinity Matrix function extracted from SNFtool package.
|
156: #' Computes affinity matrix from a generic distance matrix
|
157: #' @param Diff Distance matrix
|
166: #' Returns an affinity matrix that represents the neighborhood graph of the data points.
|
175: sortedColumns = as.matrix(t(apply(Diff,2,sort)))
|
218: ### Calculate the local transition matrix.
|
226: sumWJ = matrix(0,dim(Wall[[j]])[1], dim(Wall[[j]])[2])
|
242: # construct the combined affinity matrix by summing diffused matrices
|
243: W = matrix(0,nrow(Wall[[1]]), ncol(Wall[[1]]))
|
249: # ensure affinity matrix is symmetrical
|
262: #affinity: the similarity matrix;
|
335: R = matrix(0,k,k)
|
343: c = matrix(0,n,1)
|
345: c = c + abs(eigenVectors %*% matrix(R[,j-1],k,1))
|
373: Y = matrix(0,nrow(eigenVector),ncol(eigenVector))
|
394: A = matrix(0,nrow(xx),ncol(xx));
|
412: probxy <- matrix(NA, ncx, ncy)
|
419: probx <- matrix(rowSums(probxy), ncx, ncy)
|
420: proby <- matrix(colSums(probxy), ncx, ncy, byrow=TRUE)
|
429: nc <- length(class)
|
433: prob[i] <- sum(x == class[i])/nx
|
449: matrix(t(matrix(X,mx,nx*n)),mx*m,nx*n,byrow=TRUE)
|
467: #scalar: a logical argument specifying whether scalar covariance matrix should be used
|
485: #create a big matrix combining multiple data types
|
510: expZ=matrix(rnorm((k-1)*n),nrow=k-1,ncol=n)
|
653: ## Generalized Inverse of a Matrix
|
675: #standardize s.matrix such that the diagonal is 1
|
676: diag.elements=diag(s.matrix)
|
678: denom=matrix(rep(diag.elements,n),nrow=n, byrow=T)
|
679: a=s.matrix/sqrt(denom)/sqrt(t(denom))
|
685: #flip matrix for plot orientation
|
686: f.a=t(as.matrix(rev(as.data.frame(t(a)))))
|
12: #' #W1 = affinityMatrix(Dist1, 20, 0.5)
|
163: #' W1 = affinityMatrix(Dist1, 20, 0.5)
|
196: ###You can do various applications on this graph, such as clustering(subtyping), classification, prediction.
|
409: ncx <- length(classx)
|
410: ncy <- length(classy)
|
415: probxy[i, j] <- sum((x == classx[i]) & (y == classy[j])) / nx
|
scone:R/sconeReport.R: [ ] |
---|
837: Class = factor(strat_col())
|
8: #' @param qc matrix. QC metrics to be used for QC evaluation report. Required.
|
20: #' \code{\link{score_matrix}} for details). If NULL, PCA is used for
|
36: #' mat <- matrix(rpois(1000, lambda = 5), ncol=10)
|
42: #' qc = as.matrix(cbind(colSums(mat),colSums(mat > 0)))
|
93: # Parameter matrix
|
96: # Merged score matrix
|
113: # Matrix nodes in scone_res
|
275: " matrix vs. PCs of the QC",
|
277: "matrix. It also shows the PCA ",
|
310: "Row Class",
|
319: label = "Column Class",
|
540: as.matrix(scone_res$normalized_data[[input$norm_code]])
|
691: prcomp(as.matrix(qc),center = TRUE, scale = TRUE)
|
840: ggplot(data.frame(Class,Val ),aes(x = Class,y = Val)) +
|
841: geom_violin(scale = "width", trim = TRUE, aes(fill = Class))+
|
888: Class = factor(strat_col())
|
891: ggplot(data.frame(Class,Val ),aes(x = Class,y = Val)) +
|
892: geom_violin(scale = "width", trim = TRUE, aes(fill = Class))+
|
944: colnames(datt) = c("Class-Bio","Class-Batch","Class-Pam")
|
101: ## ----- If NULL classifications, Replace with NA ------
|
745: text(0,labels = "Stratify plots by a multi-level classification.")
|
792: text(0,labels = "Stratify plots by a multi-level classification.")
|
820: text(0,labels = "Stratify plots by a multi-level classification.")
|
928: text(0,labels = "Stratify plots by a multi-level classification.")
|
nempi:other/TCGA.r: [ ] |
---|
132: class <- data@colData@listData$definition
|
10: samplenr <- matrix(NA, length(types), 2)
|
19: sizemat <- matrix(0, 1, 2)
|
53: meth2 <- as.matrix(data[, -(1:3)])
|
201: mut.mat <- matrix(0, length(allsub), length(unique(mutation$Tumor_Sample_Barcode)))
|
202: type.mat <- matrix("", length(allsub), length(unique(mutation$Tumor_Sample_Barcode)))
|
230: Mtype0 <- matrix(paste(Mtype0, Mtype[[i]][, which(colnames(Mtype[[i]]) %in% samples)]), nrow(Mtype0))
|
239: class <- data@colData@listData$definition
|
267: if (sum(class %in% "Solid Tissue Normal") < 10) {
|
326: DN <- D[, which(class %in% "Solid Tissue Normal")]
|
327: DT <- D[, which(class %in% "Primary solid Tumor")]
|
381: save(clinical, D, M, Mtype, DF, class, meth, cnv, file = paste0(path, type, "_final.rda"))
|
383: print(table(class))
|
384: sizemat <- rbind(sizemat, table(class))
|
387: samplenr[snrcount, 1] <- sum(class %in% "Primary solid Tumor")
|
388: samplenr[snrcount, 2] <- sum(class %in% "Solid Tissue Normal")
|
425: P <- matrix(0, length(unique(c(rownames(M), rownames(cnv), rownames(meth)))), length(unique(c(colnames(M), coln...(29 bytes skipped)...
|
479: Rho <- cbind(P, matrix(0, nrow(P), sum(!(colnames(D) %in% colnames(P)))))
|
659: library(class)
|
759: Ptmp <- cbind(P, matrix(0, nrow(P), sum(!(colnames(Rho) %in% colnames(P)))))
|
789: Ptmp <- cbind(P, matrix(0, nrow(P), sum(!(colnames(Rho) %in% colnames(P)))))
|
792: F <- matrix(c(sum(pmeth >= 1 & P == 1), sum(pmeth >= 1 & P == 0), sum(pmeth == -2 & P == 1), sum(pmeth == 0 & P...(11 bytes skipped)...
|
800: Ptmp <- cbind(P, matrix(0, nrow(P), sum(!(colnames(Rho) %in% colnames(P)))))
|
803: F <- matrix(c(sum(pmeth >= 1 & P == 1), sum(pmeth >= 1 & P == 0), sum(pmeth == -2 & P == 1), sum(pmeth == 0 & P...(11 bytes skipped)...
|
811: Ptmp <- cbind(P, matrix(0, nrow(P), sum(!(colnames(Rho) %in% colnames(P)))))
|
814: F <- matrix(c(sum(pmeth >= 1 & P == 1), sum(pmeth >= 1 & P == 0), sum(pmeth == -2 & P == 1), sum(pmeth == 0 & P...(11 bytes skipped)...
|
817: Fmat <- matrix(c(sum(pmeth == 2), sum(pmeth == 1), sum(pmeth == -2), sum(pmeth == 0)), 2)
|
860: cormat <- matrix(0, nrow(pmeth), 2)
|
864: Fmat <- matrix(c(sum(pmeth[i, ] == 2), sum(pmeth[i, ] == 1), sum(pmeth[i, ] == -2), sum(pmeth[i, ] == 0)), 2)
|
871: Fmat <- matrix(c(sum(pmeth[3, ] %in% c(2,-2) & pmeth[7, ] %in% c(2,-2)),
|
979: M <- matrix(0, 5, 10)
|
988: phi <- matrix(0, 5, 5)
|
206: coln2 <- which(colnames(mutation) %in% "Variant_Classification")
|
560: svmres <- classpi(D4, full = TRUE, method = "svm")
|
578: nnres <- classpi(D4, full = TRUE, method = "nnet", MaxNWts = 50000, size = 5) # takes forever
|
619: rfres <- classpi(D4, full = TRUE, method = "randomForest")
|
TFBSTools:R/DB-methods.r: [ ] |
---|
265: matrixClass = tags[["class"]]
|
607: .store_matrix = function(con, pfm){
|
649: pfm_matrix = Matrix(pfm)
|
216: matrixVector = dbGetQuery(con, sqlCMD)[["val"]]
|
220: FMatrix = matrix(as.integer(matrixVector),
|
467: matrixSet = switch(opts[["matrixtype"]],
|
473: xmatrix = .get_Matrix_by_int_id(x, id, type="PFM")
|
210: .get_Matrix_by_int_id = function(con, int_id, type){
|
648: .store_matrix_data = function(con, pfm, int_id){
|
662: .store_matrix_annotation = function(con, pfm, int_id){
|
679: .store_matrix_species = function(con, pfm, int_id){
|
697: .store_matrix_acc = function(con, pfm, int_id){
|
39: if(!"class" %in% names(opts))
|
40: opts[["class"]] = NULL
|
62: sqlCMD = paste0("select count(*) from MATRIX where
|
63: BASE_ID= (SELECT BASE_ID from MATRIX where ID='",
|
65: "AND VERSION>(SELECT VERSION from MATRIX where ID='",
|
103: sqlCMD = paste0("SELECT ID FROM MATRIX")
|
118: sqlCMD = paste0("SELECT ID FROM MATRIX WHERE BASE_ID='", baseID, "'")
|
137: sqlTables = "MATRIX M"
|
139: # in matrix table: collection
|
145: # in matrix table: names.
|
153: sqlTables = c(sqlTables, "MATRIX_SPECIES S")
|
166: # "class", "type", "comment", "family", "medline", "tax_group"
|
167: for(tag in c("class", "type", "comment", "family",
|
170: sqlCMD = paste0("SELECT distinct ID from MATRIX_ANNOTATION where ",
|
192: sqlCMD = paste0("SELECT VERSION FROM MATRIX WHERE BASE_ID='", baseID,
|
201: sqlCMD = paste0("SELECT ID FROM MATRIX WHERE BASE_ID='",
|
211: # Get the pfm matrix
|
214: sqlCMD = paste0("SELECT val FROM MATRIX_DATA WHERE ID='",
|
223: # get remaining data in the matrix table: name, collection
|
225: NAME FROM MATRIX WHERE ID='",
|
234: sqlCMD = paste0("SELECT TAX_ID FROM MATRIX_SPECIES WHERE ID='", int_id, "'")
|
245: sqlCMD = paste0("SELECT ACC FROM MATRIX_PROTEIN WHERE ID='", int_id, "'")
|
252: sqlCMD = paste0("SELECT TAG,VAL FROM MATRIX_ANNOTATION WHERE ID='",
|
263: if(is.null(tags[["class"]]))
|
264: tags[["class"]] <- ""
|
266: tags["class"] = NULL
|
270: matrixClass=matrixClass,
|
285: ### get_Matrix_by_ID fetches matrix data under
|
290: # returns NA if matrix with the given ID is not found.
|
310: # get matrix using internal ID
|
311: ans[[id]] <- .get_Matrix_by_int_id(x, int_id, type="PFM")
|
359: ### get_Matrix_by_name fetches matrix data under
|
364: # returns NA if matrix with the given name is not found.
|
373: # For specific versions, use get_Matrix_by_ID($ID.$version)
|
383: FROM MATRIX WHERE NAME='", eachName, "'")
|
439: ### get_MatrixSet fetches matrix...(9 bytes skipped)...er for all matrices in the database matching criteria defined by the named arguments and returns a XMatrixList object
|
441: ...(209 bytes skipped)...database storage, any tag can be used for information retrieval. Additionally, arguments as 'name','class...(1 bytes skipped)...,'collection' can be used (even though they are not tags). By default, only the last version of the matrix is given. The only way to get older matrices out of this to use an array of IDs with actual version...(110 bytes skipped)...
|
443: # -all: gives absolutely all matrix entry, regardless of versin and collection. Only useful for backup situations and sanity checks. Ta...(35 bytes skipped)...
|
447: # -all_versions: gives all matrix...(89 bytes skipped)...pical usage is in combiation with a stable IDs without versions to get all versinos of a particular matrix.
|
449: # -class: structural class names (strings)
|
453: # -min_ic: float, minimum total information content of the matrix.
|
454: # -matrixtype: string describing type of matrix to retrieve. If left out, the format will revert to the database format, which is PFM.
|
457: # my $matrixset = $db->(-class => ['TRP_CLUSTER', 'FORKHEAD'],
|
460: # gives a set of TFBS::Matrix::PFM objects (given that the matrix models are stored as such) whose (structural clas is 'TRP_CLUSTER' OR'FORKHEAD') AND (the species t...(57 bytes skipped)...
|
461: # As above, unless IDs with version numbers are used, only one matrix per stable ID wil be returned: the matrix with the highest version number
|
475: # we assume the matrix IS a PFM,
|
485: avg_sites = sum(Matrix(xmatrix)) / length(xmatrix)
|
542: # Deletes the matrix having the given ID from the database
|
544: # A string. Has to be a matrix ID with version suffix in JASPAR5.
|
551: stop("You have supplied a non-versioned matrix ID
|
555: for(dbTable in c("MATRIX_DATA", "MATRIX",
|
556: "MATRIX_SPECIES", "MATRIX_PROTEIN",
|
557: "MATRIX_ANNOTATION")){
|
605: ### utilities functions for store_Matrix
|
608: # creation of the matrix will also give an internal unique ID (incremental int)
|
611: # Get version from the matrix ID
|
627: sqlCMD = paste0("select count(*) from MATRIX where VERSION='",
|
640: sqlCMD = paste0("INSERT INTO MATRIX VALUES (NULL,'", collection, "','",
|
650: i = rownames(pfm_matrix)[1]
|
652: for(i in rownames(pfm_matrix)){
|
653: for(j in seq_len(ncol(pfm_matrix))){
|
654: sqlCMD = paste0("INSERT INTO MATRIX_DATA VALUES(", int_id, ",'",
|
655: i, "',", j, ",", pfm_matrix[i,j], ")")
|
664: if(length(matrixClass(pfm)) != 0)
|
665: tags[["class"]] = matrixClass(pfm)
|
667: # we already have those in the MATRIX table
|
672: sqlCMD = paste0("INSERT INTO MATRIX_ANNOTATION (ID, tag, val) VALUES(",
|
690: sqlCMD = paste0("INSERT INTO MATRIX_SPECIES VALUES(",
|
706: sqlCMD = paste0("INSERT INTO MATRIX_PROTEIN VALUES(", int_id,
|
724: int_id = .store_matrix(x, pfm)
|
725: .store_matrix_data(x, pfm, int_id)
|
726: .store_matrix_annotation(x, pfm, int_id)
|
727: .store_matrix_species(x, pfm, int_id)
|
728: .store_matrix_acc(x, pfm, int_id)
|
820: sqlCMD = c("DROP TABLE IF EXISTS MATRIX",
|
821: "CREATE TABLE MATRIX(
|
829: "DROP TABLE IF EXISTS MATRIX_DATA",
|
830: "CREATE TABLE MATRIX_DATA(
|
837: "DROP TABLE IF EXISTS MATRIX_ANNOTATION",
|
838: "CREATE TABLE MATRIX_ANNOTATION(
|
844: "DROP TABLE IF EXISTS MATRIX_SPECIES",
|
845: "CREATE TABLE MATRIX_SPECIES(
|
849: "DROP TABLE IF EXISTS MATRIX_PROTEIN",
|
850: "CREATE TABLE MATRIX_PROTEIN(
|
2: ## Here are the parameters for get_MatrixSet (searching the jaspar DB)
|
32: if(!"matrixtype" %in% names(opts))
|
33: opts[["matrixtype"]] = "PFM"
|
35: opts[["matrixtype"]] = match.arg(opts[["matrixtype"]],
|
217: if(length(matrixVector) %% 4 != 0)
|
219: length(matrixVector), " is incomplete!")
|
268: ans_pfm = PFMatrix(ID=paste0(baseID, ".", version),
|
273: profileMatrix=FMatrix
|
286: ### the given ID from the database and returns a XMatrix object.
|
287: # Returns : a XMatrix object; the exact type of the object
|
360: ### the given name from the database and returns a XMatrix object.
|
361: # Returns : a XMatrix object;
|
477: if(sum(totalIC(toICM(xmatrix))) < opts[["min_ic"]])
|
481: if(length(xmatrix) < opts[["length"]])
|
489: if(opts[["matrixtype"]] == "PFM"){
|
490: matrixSet = c(matrixSet, list(xmatrix))
|
491: }else if(opts[["matrixtype"]] == "PWM"){
|
492: matrixSet = c(matrixSet, list(toPWM(xmatrix)))
|
493: }else if(opts[["matrixtype"]] == "ICM"){
|
494: matrixSet = c(matrixSet, list(toICM(xmatrix)))
|
497: names(matrixSet) = ID(matrixSet)
|
498: return(matrixSet)
|
719: setMethod("storeMatrix", signature(x="SQLiteConnection",
|
733: setMethod("storeMatrix", signature(x="character",
|
738: storeMatrix(con, pfmList)
|
741: setMethod("storeMatrix", signature(x="character", pfmList="PFMatrix"),
|
743: storeMatrix(x, PFMatrixList(pfmList))
|
746: setMethod("storeMatrix", signature(x="SQLiteConnection",
|
747: pfmList="PFMatrix"),
|
749: storeMatrix(x, PFMatrixList(pfmList))
|
752: setMethod("storeMatrix", signature(x="JASPAR2014", pfmList="PFMatrix"),
|
754: storeMatrix(x@db, pfmList)
|
757: setMethod("storeMatrix", signature(x="JASPAR2016", pfmList="PFMatrix"),
|
759: storeMatrix(x@db, pfmList)
|
762: setMethod("storeMatrix", signature(x="JASPAR2018", pfmList="PFMatrix"),
|
764: storeMatrix(x@db, pfmList)
|
768: setMethod("storeMatrix", signature(x="JASPAR2020", pfmList="PFMatrix"),
|
770: storeMatrix(x@db, pfmList)
|
774: setMethod("storeMatrix", signature(x="JASPAR2022", pfmList="PFMatrix"),
|
776: storeMatrix(x@db, pfmList)
|
780: setMethod("storeMatrix", signature(x="JASPAR2014",
|
783: storeMatrix(x@db, pfmList)
|
786: setMethod("storeMatrix", signature(x="JASPAR2016",
|
789: storeMatrix(x@db, pfmList)
|
792: setMethod("storeMatrix", signature(x="JASPAR2018",
|
795: storeMatrix(x@db, pfmList)
|
799: setMethod("storeMatrix", signature(x="JASPAR2020",
|
802: storeMatrix(x@db, pfmList)
|
806: setMethod("storeMatrix", signature(x="JASPAR2022",
|
809: storeMatrix(x@db, pfmList)
|
297: setMethod("getMatrixByID", "SQLiteConnection",
|
316: ans <- do.call(PFMatrixList, ans)
|
321: setMethod("getMatrixByID", "character",
|
328: getMatrixByID(con, ID)
|
331: setMethod("getMatrixByID", "JASPAR2014",
|
333: getMatrixByID(x@db, ID)
|
337: setMethod("getMatrixByID", "JASPAR2016",
|
339: getMatrixByID(x@db, ID)
|
342: setMethod("getMatrixByID", "JASPAR2018",
|
344: getMatrixByID(x@db, ID)
|
347: setMethod("getMatrixByID", "JASPAR2020",
|
349: getMatrixByID(x@db, ID)
|
353: setMethod("getMatrixByID", "JASPAR2022",
|
355: getMatrixByID(x@db, ID)
|
374: setMethod("getMatrixByName", "SQLiteConnection",
|
392: ans[[eachName]] <- getMatrixByID(x, baseID[1])
|
397: ans <- do.call(PFMatrixList, ans)
|
402: setMethod("getMatrixByName", "character",
|
406: getMatrixByName(con, name)
|
410: setMethod("getMatrixByName", "JASPAR2014",
|
412: getMatrixByName(x@db, name)
|
416: setMethod("getMatrixByName", "JASPAR2016",
|
418: getMatrixByName(x@db, name)
|
421: setMethod("getMatrixByName", "JASPAR2018",
|
423: getMatrixByName(x@db, name)
|
427: setMethod("getMatrixByName", "JASPAR2020",
|
429: getMatrixByName(x@db, name)
|
433: setMethod("getMatrixByName", "JASPAR2022",
|
435: getMatrixByName(x@db, name)
|
440: # Returns : a XMatrixList object
|
463: setMethod("getMatrixSet", "SQLiteConnection",
|
468: "PFM"=PFMatrixList(),
|
469: "PWM"=PWMatrixList(),
|
470: "ICM"=ICMatrixList()
|
502: setMethod("getMatrixSet", "character",
|
507: getMatrixSet(con, opts)
|
511: setMethod("getMatrixSet", "JASPAR2014",
|
513: getMatrixSet(x@db, opts)
|
517: setMethod("getMatrixSet", "JASPAR2016",
|
519: getMatrixSet(x@db, opts)
|
523: setMethod("getMatrixSet", "JASPAR2018",
|
525: getMatrixSet(x@db, opts)
|
529: setMethod("getMatrixSet", "JASPAR2020",
|
531: getMatrixSet(x@db, opts)
|
535: setMethod("getMatrixSet", "JASPAR2022",
|
537: getMatrixSet(x@db, opts)
|
541: setMethod("deleteMatrixHavingID", "SQLiteConnection",
|
566: setMethod("deleteMatrixHavingID", "character",
|
570: deleteMatrixHavingID(con, IDs)
|
574: setMethod("deleteMatrixHavingID", "JASPAR2014",
|
576: deleteMatrixHavingID(x@db, IDs)
|
580: setMethod("deleteMatrixHavingID", "JASPAR2016",
|
582: deleteMatrixHavingID(x@db, IDs)
|
586: setMethod("deleteMatrixHavingID", "JASPAR2018",
|
588: deleteMatrixHavingID(x@db, IDs)
|
592: setMethod("deleteMatrixHavingID", "JASPAR2020",
|
594: deleteMatrixHavingID(x@db, IDs)
|
598: setMethod("deleteMatrixHavingID", "JASPAR2022",
|
600: deleteMatrixHavingID(x@db, IDs)
|
714: ### Stores the contents of a PFMatrixList object in the database
|
717: # Args : (PFMatrixList)
|
720: pfmList="PFMatrixList"),
|
734: pfmList="PFMatrixList"),
|
781: pfmList="PFMatrixList"),
|
787: pfmList="PFMatrixList"),
|
793: pfmList="PFMatrixList"),
|
800: pfmList="PFMatrixList"),
|
807: pfmList="PFMatrixList"),
|
geNetClassifier:R/functions.public.R: [ ] |
---|
389: class <- names(x)[largest]
|
71: classes <- factor(apply(prob, 2, function(x) {assignment.conditions(x, minProb, minDiff)}))
|
97: classes<-unique(c(rownames(mxcf),colnames(mxcf)))
|
133: byClass <- matrix(nrow=nclasses, ncol=4)
|
176: externalValidation.probMatrix<- function(queryResult, realLabels, numDecimals=2)
|
209: probMatrix <- matrix(0,nrow=length(levels(realLabels)), ncol=length(predClasses))
|
215: classAssignments <- globalQueryResult$class[names(realLabels)[which(realLabels==label)]] #Prob for the class samples, even if the prediction was wrong
|
249: classes <- rownames(globalQueryResult$probabilities)
|
289: highestProbClass...(9 bytes skipped)...mes(globalQueryResult$probabilities)[apply(globalQueryResult$probabilities[,which(globalQueryResult$class == "NotAssigned"), drop=FALSE], 2, function(x) which(order(x, decreasing=TRUE)==1))] #Clase con la ...(18 bytes skipped)...
|
293: nextClass...(17 bytes skipped)...mes(globalQueryResult$probabilities)[apply(globalQueryResult$probabilities[,which(globalQueryResult$class == "NotAssigned"), drop=FALSE], 2, function(x) which(order(x, decreasing=TRUE)==2))]
|
608: exprMatrix <- eset
|
695: classes <- levels(sampleLabels)
|
718: classLabels <- stats::setNames(paste("C", sapply(classes,function(x) which(classes==x)), sep=""), classes)
|
795: if(!is.null(colnames(genes))) { geneClass <- unique(colnames(genes)[which(genes == genesVector[i],arr.ind=TRUE)[,2]])
|
815: classMean <- mean(matriz[genesVector[i], (prevLim+1):j])
|
931: classificationGenesRanking <- classificationGenes
|
1084: geneClass<-NULL
|
1156: tempDpMatrix <- discrPwDF
|
1307: classificationGenesInfo <- genesDetails(classificationGenes)[nwClasses]
|
1382: classGeneLabels <- as.vector(genesInfoList[[cl]][,"GeneName"])[availableNames]
|
1395: classGenes <- getNodes(genesNetwork[[cl]])
|
1412: classificationGenesNetwork <- NULL
|
1413: classificationGenesID <- NULL
|
1489: if(length(genesNetwork[[nw]]@nodes)>0) { classGraph <- igraph::graph.data.frame(as.data.frame(genesNetwork[[nw]]@edges[,ntwColnames,drop=FALSE]), ...(68 bytes skipped)...
|
31: queryGeNetClassifier <- function(classifier, eset, minProbAssignCoeff=1, minDiffAssignCoeff=0.8, verbose=TRUE)
|
42: numClasses <- length(classifier$levels)
|
99: nclasses <- length(classes)
|
105: missingClasses <- classes[which(!classes %in% colnames(mxcf))]
|
207: predClasses <- c(levels(realLabels), rownames(globalQueryResult$probabilities)[which(!rownames(globalQueryRes...(46 bytes skipped)...
|
250: numClasses <- length(classes)
|
337: if(is.null(totalNumberOfClasses)) {numClasses <- length(levels(realLabels))
|
509: numClasses <- length(gClasses(genesRanking))
|
697: numClasses <- length(classes)
|
991: longClassNames <- any(nchar(classNames)>6)
|
1000: numClasses <- ifelse(is.matrix(classificationGenes), length(classNames), length(classifier$levels))
|
1269: nwClasses <- names(genesNetwork)
|
1473: numClasses<-length(genesNetwork)
|
34: if(is(eset, "ExpressionSet")) eset <- exprs(eset) else if (!is.matrix(eset)) stop("The last argument should be either an expression matrix or an ExpressionSet.")
|
43: ...(52 bytes skipped)...obAssignCoeff' should be a coefficient to modify the probability required to assign the sample to a class.")
|
44: ...(72 bytes skipped)...d be a coefficient to modify the required difference between probabilites to assign the sample to a class.")
|
55: if(sum(!genes %in% colnames(esetTdf))>0) stop("The expression matrix provided does not have the required genes.")
|
67: ...(86 bytes skipped)...etSelection)) esetSelection <- t(cbind(NULL,esetSelection)) #To avoid error when there is only 1gen/class
|
72: ret <- list(call=match.call(), class= classes, probabilities=prob)
|
77: # Calculates stats from the confussion matrix. i.e. sensitivity and specificity of the predictor for each class, global accuracy and call rate (rate of assigned samples)
|
78: # Receives a confussion matrix (actual(rows) x prediction(cols)) --> Columns and rows in same order. "NotAssigned" last column
|
79: # 100% Sensitivity = Recognizes all positives for the class
|
80: # 100% Specificity = Recognizes all negatives for the class
|
82: #Renombrado de class.accuracy
|
83: externalValidation.stats <- function(confussionMatrix, numDecimals=2) #Confussion matrix
|
86: if(!is.matrix(mxcf))stop("The argument should be a confussion matrix.")
|
93: warning("The confussion matrix should have the real class in rows and the assigned class in cols. The matrix provided didn't seem to be in the right order so it was transposed:")
|
106: mxcf <- cbind(mxcf, matrix(ncol=length(missingClasses), nrow=dim(mxcf)[1], data=0))
|
114: mxcf <- rbind(mxcf, matrix(nrow=length(missingClasses), ncol=dim(mxcf)[2], data=0))
|
126: warning("There were missing columns or rows in the confussion matrix, empty ones were added.", immediate.=TRUE)
|
174: # Returns the matrix with the average probabilities of assigning a sample to each class (only of assigned samples)
|
186: if (length(realLabels) == length( names(queryResult$class)))
|
188: names(realLabels) <- names(queryResult$class)
|
201: if(sum(!names(globalQueryResult$class) %in% names(realLabels)) >0) stop("There are samples for which the real label was not provided.")
|
203: if((length(globalQueryResult$class)!=dim(globalQueryResult$probabilities)[2]) || (sum(!names(globalQueryResult$class) %in% colnames(globalQueryResult$probabilities))>0 )) {stop("The samples in $class and in $probabilities do not match.")}
|
228: # Gives basic stats of the probabilities with wich the samples were assigned to the class
|
246: if(length(globalQueryResult$class)!=dim(globalQueryResult$probabilities)[2]) {}#El numero de samples no encaja
|
248: numSamples <- length(globalQueryResult$class)
|
262: if (globalQueryResult$class[i] == classes[c])
|
270: else if (c==1 && (globalQueryResult$class[i] == "NotAssigned")) notAssigned <- notAssigned+1
|
284: # Info about NotAssigned samples (most likely class & probs)
|
288: highestProb <- apply(globalQueryResult$probabilities[,which(globalQueryResult$class == "NotAssigned"), drop=FALSE], 2, function(x) round(max(x), numDecimals)) #--> mayor probabilid...(13 bytes skipped)...
|
291: nextProbIndex <- cbind(apply(globalQueryResult$probabilities[,which(globalQueryResult$class...(10 bytes skipped)...signed"), drop=FALSE], 2, function(x) which(order(x, decreasing=TRUE)==2)), which(globalQueryResult$class == "NotAssigned"))
|
302: ...(19 bytes skipped)...("The query contains ", samplesQueried=numSamples, " samples. ",sum(stats[,1])," were assigned to a class resulting on a call rate of ", callRate,"%. \n", sep=""))
|
331: if (length(realLabels) == length(names(queryResult$class)))
|
333: names(realLabels) <- names(queryResult$class)
|
342: ...(72 bytes skipped)...d be a coefficient to modify the required difference between probabilites to assign the sample to a class.")
|
363: plot(c(minX,1), c(0,1), type="n", xlab="Probability of the most likely class", ylab="Difference with next class", frame=FALSE, main="Thresholds to assign query samples")
|
380: ...(0 bytes skipped)... graphics::legend("bottomright", "(x,y)", legend=c("Correct", "Incorrect"), title = "Most likely class", text.width = strwidth("1,000,000"), xjust = 1, yjust = 1, lty = 0, pch=16, col=c(correctColor, i...(24 bytes skipped)...
|
393: class <- "NA"
|
395: return(c(biggestProb=x[largest], nextProb=nextProb, assignedClass=class))
|
457: if(is.data.frame(sampleLabels) || is.matrix(sampleLabels))
|
466: if(class(sampleLabels) != "factor") {
|
475: if(is(eset, "ExpressionSet")) eset <- exprs(eset) else if (!is.matrix(eset)) stop("The argument 'eset' should be an expression matrix or an ExpressionSet.")
|
480: if(class(sampleLabels) != "factor") { warning("The argument 'sampleLabels' had to be converted into a factor...(27 bytes skipped)...
|
528: postProb <- matrix(nrow=numGenesPlot, ncol=ncol(ord))
|
589: if(is.data.frame(sampleLabels) || is.matrix(sampleLabels))
|
599: if(class(sampleLabels) != "factor") { warning("The argument 'sampleLabels' had to be converted into a factor...(27 bytes skipped)...
|
610: if(is(exprMatrix, "ExpressionSet")) exprMatrix <- exprs(exprMatrix) else if (!is.matrix(exprMatrix)) stop("The first argument should be an expression matrix or an ExpressionSet.")
|
628: if(!is.matrix(genes) && !is.vector(genes)) stop ("The genes list should be either a vector or a matrix.")
|
629: if(sum(!genes[which(genes!="NA")] %in% rownames(exprMatrix))!=0) stop ("The expression matrix doesn't contain all the genes.")
|
638: if(class(sampleLabels) != "factor") { warning("The argument 'sampleLabels' had to be converted into a factor...(4 bytes skipped)...
|
671: # Default class colors for boxplot
|
719: warning(paste("Some class names are longer than 10 characters. The following labels will be used in plots:\n",paste(classLabels, names(classLabels), sep=": ", collapse="\n"), sep=""))
|
731: if( numClasses == 0 || !is.matrix(genes) ) {
|
746: geneTitles <- matrix(ncol=3, dimnames=list(genesVector,c("class","label","labelShort")),nrow=length(genesVector))
|
749: # Class
|
752: # Gene class, from genes table
|
753: geneTitles[g,"class"] <- unique(colnames(genes)[which(genes == g,arr.ind=TRUE)[,2]])
|
754: if(nchar(geneTitles[g,"class"])>10) geneTitles[g,"class"] <- paste(geneTitles[g,"class"], " (C",which(classes==geneTitles[g,"class"]), ")", sep="")
|
757: geneTitles[g,"class"]<-""
|
799: title(paste(geneTitles[genesVector[i],"class"], geneTitles[genesVector[i],"label"], sep="\n" ))
|
811: if (any(nchar(classes)>10) ) {graphics::text(prevLim+((j-prevLim)/2), ylim[2]-(ylim[2]*0.04), labels=classLabels[sampleLabels[j]]) # Class title
|
812: ...(52 bytes skipped)...evLim+((j-prevLim)/2)+0.5, y=ylim[2]-(ylim[2]*0.04), labels=paste(sampleLabels[j],sep=""), pos=3) # Class title
|
845: title(paste(geneTitles[gen,"class"], geneTitles[gen,"label"], sep="\n" ))
|
926: if(any(class(classificationGenes) == "GenesRanking"))
|
947: m <- matrix(ncol=length(missingGenes))
|
961: if(is.matrix(geneLabels) || is.data.frame(geneLabels))
|
965: stop("geneLabels should be a named vector or a one dimensional matrix.")
|
988: warning(paste("The number of classes provided don't match the classifier's. The default class names will be used instead.",sep=""), immediate. = TRUE) }
|
1002: if(!is.matrix(classificationGenes)) { #if(verbose) warning("The 'classification genes' are not sorted by colums and classes, the gene class will not be shown .")
|
1010: classificationGenes <- classificationGenes[,apply(classificationGenes, 2, function(x) !all(is.na(x)))] # Is there any class without genes?
|
1021: if(is.matrix(classificationGenes)) # If it contains the genes by classes (columns)
|
1032: classificationGenes <- as.matrix(classificationGenes)
|
1170: # Merge the geneDetails(genesRanking) with the discriminant power into one matrix
|
1259: warning(paste("Plotting up to ", max(numGenes(genesRanking)), " genes of each class.", sep=""))
|
1272: if(!class(genesNetwork) == "GenesNetwork") stop("genesNetwork should be either a list or a GenesNetwork.")
|
1273: if((sum(c("class1", "class2") %in% colnames(genesNetwork@edges)) == 2 ) && nrow(genesNetwork@edges)>0)
|
1275: nwClasses <- unique(as.vector(genesNetwork@edges[,c("class1", "class2")]))
|
1285: if(!is.matrix(genesNetwork[[cl]]@edges)) stop("genesNetwork should be either a GenesNetwork or a list of GenesNet...(7 bytes skipped)...
|
1290: if(is.matrix(classificationGenes) && nrow(classificationGenes)==0) classificationGenes <- NULL
|
1291: if(any(class(classificationGenes) == "GenesRanking") && all(numGenes(classificationGenes) == 0)) classificationGenes <- NULL
|
1298: if(class(genesRanking) != "GenesRanking") stop("genesRanking should be an object of type GenesRanking.")
|
1305: if(class(classificationGenes)[1] != "GenesRanking") stop("classificationGenes should be an object of type GenesRanking (the classificationGenes object returned by the classifier).")
|
1323: temp <- cbind(genesInfo[[cl]], matrix(nrow=nrow(genesInfo[[cl]]),ncol=length(missingColumnsInGlobal)))
|
1345: if(any(! names(genesNetwork) %in% names(genesInfo))) { stop("The class names in genesInfo and genesNetwork do not match.")
|
1398: temp <- matrix(NA, nrow=length(missingGenes), ncol=length(colnames(genesInfoList[[cl]])))
|
1481: # For each class...
|
1522: vertexColors[which(exprsDiff>0)] <- reds[apply( matrix(data=sapply((max(exprsDiff+0.001,na.rm=TRUE)/length(reds)) * 1:length(reds), function(x){ exprsDiff...(120 bytes skipped)...
|
1523: vertexColors[which(exprsDiff<0)] <- greens[apply(matrix(data=sapply((min(exprsDiff-0.001,na.rm=TRUE)/length(greens))*1:length(greens), function(x){exprsDif...(101 bytes skipped)...
|
4: # clasificador (in file: classifier.main.r)
|
7: # externalValidation.probMatrix
|
24: # classifier:
|
30: # WARNING!: The arrays should have been normalized with the samples used for the classifier training.
|
36: if(is(classifier, "GeNetClassifierReturn")){
|
37: if("classifier" %in% names(classifier)) { classifier <- classifier@classifier$SVMclassifier
|
38: }else stop("'classifier' doesn't contain a trained classifier.")
|
40: if(!is(classifier, "svm")) classifier <- classifier$SVMclassifier
|
41: if(!is(classifier, "svm")) stop("The first argument should be the classifier returned by geNetClassifier.")
|
45: if(minProbAssignCoeff<0 || ((numClasses != 2) &&(minProbAssignCoeff>(numClasses/2)))) stop("'minProbAssignCoeff' should be between 0 and half of the number of classes.")
|
46: if(minDiffAssignCoeff<0 || minDiffAssignCoeff>numClasses) stop("'minDiffAssignCoeff' should be between 0 and the number of classes.")
|
47: genes <- colnames(classifier$SV)
|
59: rand <- 1/length(classifier$levels)
|
60: if(length(classifier$levels)>2) { minProb <- 2*rand * minProbAssignCoeff
|
63: ...(147 bytes skipped)..., "(default)",""),".\n Minimum difference between the probabilities of first and second most likely classes = ", round(minDiff,2),ifelse(minDiffAssignCoeff==1, "(default)",""), sep="")) ; utils::flush.co...(8 bytes skipped)...
|
68: prob <- t(attributes(stats::predict(classifier, esetSelection, probability=TRUE ))$probabilities)
|
69: if(is.null(names(prob))) colnames(prob)<-rownames(esetTdf) # if 2 classes... not labeled. Needed for mxcf...
|
85: mxcf <- confussionMatrix
|
98: if(any(classes=="NotAssigned")) classes <- classes[-which(classes=="NotAssigned")]
|
103: if (any(!classes %in% colnames(mxcf)))
|
111: if (any(!classes %in% rownames(mxcf)))
|
113: missingClasses <- classes[which(!classes %in% rownames(mxcf))]
|
120: #Just in case they are not in order (Diagonal=hits). Will use only the real classes.
|
121: mxcf<- mxcf[,c(classes,"NotAssigned")] ...(22 bytes skipped)...
|
122: mxcf<- mxcf[c(classes),]
|
134: rownames(byClass)<- classes
|
135: colnames(byClass)<-c("Sensitivity","Specificity", "MCC", "CallRate")
|
159: byClass[i,1] <- round(100*(truePositives[i]/(truePositives[i]+falseNegatives[i])) ,numDecimals)
|
161: byClass[i,2] <- round(100*(trueNegatives[i]/(trueNegatives[i]+falsePositives[i])) ,numDecimals)
|
163: byClass[i,3] <- round(100*( ((truePositives[i]*trueNegatives[i])-(falsePositives[i]*falseNegatives[i])) / ...(175 bytes skipped)...
|
165: if(i <= dim(mxcf)[1]) byClass[i,4] <- round(100*( (sum(mxcf[i,])- mxcf[i,dim(mxcf)[2]])/sum(mxcf[i,])) ,numDecimals)
|
171: return( list(byClass=byClass, global=global, confMatrix=mxcf) )
|
210: rownames(probMatrix)<- levels(realLabels)
|
211: colnames(probMatrix)<- predClasses
|
216: assignedSamples <- names(classAssignments)[ which( classAssignments!= "NotAssigned")]
|
219: if(length(assignedSamples)>1) probMatrix...(8 bytes skipped)... <- apply(globalQueryResult$probabilities[,assignedSamples], 1, function(x) {mean(x)})[colnames(probMatrix)]
|
220: else probMatrix[label,] <- globalQueryResult$probabilities[,assignedSamples][colnames(probMatrix)]
|
224: ret<- round(probMatrix,numDecimals)
|
253: rownames(stats)<-c(classes)
|
295: notAssignedSamples <- cbind(highestProbClass=highestProbClass, as.data.frame(highestProb), nextProb=nextProb, nextClass=nextClass)
|
339: if(!is.numeric(totalNumberOfClasses) || (totalNumberOfClasses<length(levels(realLabels)))) stop ("totalNumberOfClasses should be the number of classes for which the classifier was originaly trained.")
|
343: if(minProbAssignCoeff<0 || ((numClasses != 2) &&(minProbAssignCoeff>(numClasses/2)))) stop("'minProbAssignCoeff' should be between 0 and half of the number of classes.")
|
344: if(minDiffAssignCoeff<0 || minDiffAssignCoeff>numClasses) stop("'minDiffAssignCoeff' should be between 0 and the number of classes.")
|
397: rownames(prob) <- c("biggestProb", "nextProb", "assignedClass")
|
400: correct <- which(prob["assignedClass",] == prob["realLabels",])
|
401: incorrect <- which(prob["assignedClass",] != prob["realLabels",])
|
467: #warning("The argument 'classification sampleLabels' had to be converted into a factor.", immediate. = TRUE)
|
533: numClasses <- ncol(postProb) # If there are only 2 classes, postProb only has 1 column
|
575: ...(55 bytes skipped)...leName=NULL, geneLabels=NULL, type="lines", sampleLabels=NULL, sampleColors=NULL, labelsOrder=NULL, classColors=NULL, sameScale=TRUE, showSampleNames=FALSE, showMean= FALSE, identify=TRUE, verbose=TRUE)
|
615: genes <- rownames(exprMatrix)
|
618: if(is(genes, "GeNetClassifierReturn") && "classificationGenes" %in% names(genes)) {
|
619: genes <- genes@classificationGenes
|
620: warning("Plotting expression profiles of the classification genes. To plot other genes, set i.e. genes=...@genesRanking")
|
632: if(!is.null(geneLabels)) geneLabels<-extractGeneLabels(geneLabels, rownames(exprMatrix[genesVector,]))
|
635: numSamples <- dim(exprMatrix)[2]
|
643: if(sum(!names(sampleLabels) %in% colnames(exprMatrix))>0 ) stop("The names of the labels do not match the samples.")
|
646: names(sampleLabels)<-colnames(exprMatrix)
|
659: if(!is.null(sampleColors) && !is.null(classColors)) stop("Provide either 'sampleColors' or 'classColors'")
|
662: if(is.null(classColors))
|
672: if(is.null(classColors))
|
674: if(!is.null(sampleLabels)) classColors <- rev(hcl(h=seq(0,360, length.out=length(levels(sampleLabels))+1))[1:length(levels(sampleLab...(7 bytes skipped)...
|
675: if(is.null(sampleLabels)) classColors <- "white"
|
680: if(is.null(sampleLabels)) stop("Cannot use 'classColors' if 'sampleLabels' is not provided.")
|
681: if(length(levels(sampleLabels)) != length(classColors))stop("Length of 'classColors' should match the number of classes in the samples.")
|
683: if(any(type%in%"lines")) sampleColors <- classColors[sampleLabels]
|
696: if(!is.null(labelsOrder)) classes <- labelsOrder
|
702: indexes <- c(indexes, which(sampleLabels==classes[i]))
|
704: matriz <- exprMatrix[genesVector, indexes, drop=FALSE]
|
709: classes <- colnames(genes)
|
710: numClasses <- length(classes)
|
711: matriz <- exprMatrix[genesVector,, drop=FALSE]
|
716: if(any(nchar(classes)>10))
|
796: } else { geneClass<-"" } #classes[which(genes == genesVector[i], arr.ind=TRUE)[2]]
|
810: ...(21 bytes skipped)... if(!is.na((sampleLabels[j] != sampleLabels[j+1]) ) ) abline(v=j+0.5, col="black") # Separate classes
|
816: graphics::lines(c(prevLim+1, j), c(classMean, classMean) , col="grey")
|
834: names(esetXclases) <- classLabels[names(esetXclases)] #paste("C", sapply(names(esetXclases),function(x) which(classes==x)), sep="")
|
844: ...(12 bytes skipped)... boxplot(Expression~sampleLabel, esetExprSamplesMelted, ylim=ylim, ylab="Expression values", col=classColors, las=2, outpch=16, outcex=0.5)
|
879: # discriminant.power.plot(classifier, classificationGenes, classNames=c("ALL","AML","CLL","CML","NoLeu"), fileName="test.pdf",correctedAlpha=TRUE)
|
880: # discriminant.power.plot(classifier, classificationGenes, fileName="test.pdf")
|
881: # Classification genes: Genes por columnas (nombrecolumna= clase)
|
882: # discriminant.power.plot(classifier, colnames(classif$SV), fileName="test.pdf")
|
888: # classifier: puede ser un svm o el objeto devuelto por la funcion principal
|
889: # classificationGenes: puede ser un c(), una matriz o un GenesRanking
|
891: plotDiscriminantPower <- function(classifier, classificationGenes=NULL , geneLabels=NULL, classNames=NULL, plotDP = TRUE, fileName= NULL, returnTable=FALSE, verbose=TRUE)
|
904: # Classifier
|
905: if(is(classifier, "GeNetClassifierReturn")){
|
906: if("classificationGenes" %in% names(classifier))
|
908: if(is.null(classificationGenes))
|
910: classificationGenes <- classifier@classificationGenes
|
912: if(is.null(geneLabels) && is.character(classificationGenes))
|
914: if(length(classifier@classificationGenes@geneLabels) > 0 && any(!is.na(classifier@classificationGenes@geneLabels[classificationGenes])))
|
915: geneLabels <- classifier@classificationGenes@geneLabels[classificationGenes]
|
919: if("classifier" %in% names(classifier)) {classifier <- classifier@classifier$SVMclassifier
|
920: }else stop("'classifier' doesn't contain a trained classifier.")
|
922: if(is.list(classifier) && ("SVMclassifier" %in% names(classifier))) classifier <- classifier$SVMclassifier
|
923: if(!is(classifier,"svm")) stop("The first argument should be a svm classifier or the object returned by geNetClassifier.")
|
925: # ClassificationGenes (GenesRanking)
|
928: if(sum(numGenes(classificationGenes)))
|
930: if(is.null(geneLabels) && (length(classificationGenes@geneLabels) > 0 && any(!is.na(classificationGenes@geneLabels)))) geneLabels <- classificationGenes@geneLabels
|
932: classificationGenes <- getRanking(classificationGenes, showGeneLabels=FALSE, showGeneID=TRUE)$geneID
|
934: classificationGenes <- NULL
|
935: classificationGenesRanking<-NULL
|
938: classificationGenesRanking<-NULL
|
941: # If classificationGenes is not provided/valid, use the classifier's SV
|
942: missingGenes <- !as.vector(classificationGenes[!is.na(classificationGenes)]) %in% colnames(classifier$SV)
|
945: missingGenes <- as.vector(classificationGenes[!is.na(classificationGenes)])[which(missingGenes)]
|
951: missingGenes <- missingGenes[which(!missingGenes %in% colnames(classifier$SV))]
|
953: classificationGenes[which(classificationGenes %in% missingGenes)] <- NA
|
955: if(all(is.na(classificationGenes))) stop("The given 'classificationGenes' are not used by the classifier. Their Discriminant Power cannot be calculated.")
|
956: if(length(missingGenes)>0) warning(paste("The following classificationGenes are not used by the classifier. Their Discriminant Power cannot be calculated: ", missingGenes, sep=""))
|
958: if(is.null(classificationGenes)) classificationGenes <- colnames(classifier$SV)
|
981: ...(35 bytes skipped)...ull(names(geneLabels))) stop("names(geneLabels) can't be empty. It should contain the names used in classification genes.")
|
982: #if(!is.null(geneLabels) && sum(!names(geneLabels) %in% classificationGenes[which(classificationGenes!="NA")] )>0) warning("Some geneLabels will not be used.")
|
983: if(!is.null(geneLabels) && sum(!classificationGenes[which(class...(9 bytes skipped)...Genes!="NA")] %in% names(geneLabels))>0) warning("geneLabels doesn't contain the symbol for all the classification genes.")
|
985: # classNames
|
986: if(is.null(classNames) || (length(classifier$levels) != length(classNames))){
|
987: if (!is.null(classNames) && length(classifier$levels) != length(classNames)) {
|
989: classNames <-classifier$levels
|
994: for( i in 1:length(classNames)) #Add "C1:..."
|
996: if (nchar(classNames[i])>10 ) classNames[i] <- paste(substr(classNames[i] ,1,10), "...",sep="")
|
997: classNames[i] <- paste("C", i, ": ", classNames[i], sep="")
|
1005: if(length(classifier$levels) == 2) {
|
1006: if (dim(classificationGenes)[2] != 1) stop("The classes of the classifier and the classification genes provided don't match.")
|
1008: if(sum(!colnames(classificationGenes) %in% classifier$levels)>0) stop("The classes of the classifier provided and the classification genes don't match.")
|
1013: nGenes <- length(classificationGenes[which(!is.na(classificationGenes))]) #sum(numGenes(classifier$classificationGenes))
|
1014: if(nGenes>dim(classifier$SV)[2]){ warning(paste("The given number of genes is bigger than the classifier's.",sep=""), immediate. = TRUE)}
|
1023: for(cl in 1:dim(classificationGenes)[2])
|
1025: discrPwList <- c(discrPwList, discrPwList=list(sapply(as.character(classificationGenes[which(classificationGenes[,cl]!="NA"),cl]), function(x) SV.dif(classifier, x, correctedAlpha=correctedAlpha))))
|
1026: names(discrPwList)[cl] <- colnames(classificationGenes)[cl]
|
1030: classificationGenes <- classificationGenes[which(!is.na(classificationGenes))]
|
1031: discrPwList <- list(sapply(as.character(classificationGenes), function(x) SV.dif(classifier, x, correctedAlpha=correctedAlpha)))
|
1042: numRows <- numGenesPlot/dim(classificationGenes)[2]
|
1043: while ((numRows < dim(classificationGenes)[1]) && (length(classificationGenes[which(!is.na(classificationGenes[1:numRows,, drop=FALSE]))]) < numGenesPlot))
|
1048: if(length(classificationGenes[which(!is.na(classificationGenes[1:numRows,, drop=FALSE]))]) <= numGenesPlot)
|
1050: classificationGenes <- classificationGenes[1:numRows,, drop=FALSE]
|
1052: classificationGenes <- classificationGenes[1:(numRows-1),, drop=FALSE]
|
1068: mycols <- colorRampPalette(c("blue","white"))(max(classifier$nSV+2))
|
1070: for(c in 1:dim(classificationGenes)[2]) #numClasses
|
1072: for(g in 1:dim(classificationGenes)[1])
|
1075: gene <- classificationGenes[g,c]
|
1087: geneClass <- names(gene)
|
1088: if(nchar(geneClass)>70) geneClass<- substr(geneClass,1,70)
|
1101: tit<- paste(geneClass,"\n", geneName, "\n", sep="")
|
1104: ...(31 bytes skipped)...(tit, abs(round(discrPwList[[c]][,gene]$discriminantPower,2)), " (", discrPwList[[c]][,gene]$discrPwClass, ")", sep="")
|
1125: ...(0 bytes skipped)... barplot(pos,add=TRUE, col=mycols, width=0.9, space=0.1, names.arg=rep("",length(classNames)))
|
1126: ...(0 bytes skipped)... barplot(neg,add=TRUE, col=mycols, width=0.9, space=0.1, names.arg=rep("",length(classNames)))
|
1128: if(!correctedAlpha) graphics::text(seq(1, length(classNames), by=1)-0.5, par("usr")[3] - 0.2, labels = classNames, srt = 90, pos = 4, xpd = TRUE)
|
1129: if(correctedAlpha) graphics::text(seq(1, length(classNames), by=1)-0.5, par("usr")[3], labels = classNames, srt = 90, pos = 4, xpd = TRUE)
|
1148: discrPwDF<- rbind(discrPwDF, cbind(t(discrPwList[[cl]][c("discriminantPower","discrPwClass"),]), originalClass=rep(names(discrPwList)[cl],dim(discrPwList[[cl]])[2])))
|
1153: discrPwDF[,"discrPwClass"] <- as.character(discrPwDF[,"discrPwClass"])
|
1157: tempDpMatrix[,"discriminantPower"] <- abs (tempDpMatrix[,"discriminantPower"] )
|
1159: for(cl in classifier$levels)
|
1161: clGenes <- which(tempDpMatrix[,"discrPwClass"]==cl)
|
1162: discrPwDF <- rbind(discrPwDF, tempDpMatrix[clGenes[order(as.numeric(tempDpMatrix[clGenes,"discriminantPower"]),decreasing=TRUE)],])
|
1166: if(is.null(classificationGenesRanking))
|
1171: gDetails<-genesDetails(classificationGenesRanking)
|
1177: genesDetailsDF <- cbind(discrPwClass=rep(NA,dim(discrPwDF)[1]), discriminantPower=rep(NA,dim(discrPwDF)[1]), genesDetailsDF[rownames(dis...(39 bytes skipped)...
|
1178: genesDetailsDF[,"discrPwClass"] <- as.character(discrPwDF[,"discrPwClass"])
|
1187: # plotType="dynamic" (each can be modified), plotType="static" (1 image divided into classes), plotType="pdf"
|
1189: # genesInfo: Data.frame containing info about the genes. Can be replaced by classificationGenes or genesRanking (recommended).
|
1190: # If classificationGenes + genesRanking:
|
1191: # classificationGenes: Tiene q ser un genesRanking
|
1193: plotNetwork <- function(genesNetwork, class...(96 bytes skipped)...tType="dynamic", fileName=NULL, plotAllNodesNetwork=TRUE, plotOnlyConnectedNodesNetwork=FALSE, plotClassifcationGenesNetwork=FALSE, labelSize=0.5, vertexSize=NULL, width=NULL, height=NULL, verbose=TRUE)
|
1254: if(is.null(classificationGenes) && ("classificationGenes" %in% names(genesNetwork))) classificationGenes <- genesNetwork@classificationGenes
|
1257: nGenes <- max( 100, numGenes(genesNetwork@classificationGenes))
|
1277: }else nwClasses <- "geneClass"
|
1289: # Check classificationGenes and Genes ranking format and EXTRACT its genes INFO.
|
1292: if(plotClassifcationGenesNetwork && is.null(classificationGenes)) warning("The classifcation genes network can only be plotted if the classification genes are provided.")
|
1293: if((!is.null(class...(30 bytes skipped)...nesRanking)) && !is.null(genesInfo)) stop("Please, provide either 'genesInfo' OR a genesRanking and classificationGenes.")
|
1294: if(!is.null(genesRanking) || !is.null(classificationGenes))
|
1303: if(!is.null(classificationGenes))
|
1308: clGenes <- lapply(classificationGenesInfo, rownames)
|
1310: if(showWarning) warning("Not all the classificationGenes are available in the genesNetwork. They will be represented, but there may be missing...(29 bytes skipped)...
|
1314: genesInfo <- classificationGenesInfo
|
1317: missingColumnsInGlobal <- colnames(classificationGenesInfo[[1]])[which(!colnames(classificationGenesInfo[[1]]) %in% colnames(genesInfo[[1]]))]
|
1328: ...(30 bytes skipped)... if((is.factor(temp[,tempCol]))) levels(temp[,tempCol]) <- unique(c(levels(temp[,tempCol]), levels(classificationGenesInfo[[cl]][,tempCol])))
|
1331: temp[rownames(classificationGenesInfo[[cl]]), ] <- classificationGenesInfo[[cl]][,colnames(temp)]
|
1364: ...(143 bytes skipped)...lot, but there may be missing relationships.") # showWarning: The warning was already shown for the classification genes.
|
1383: names(classGeneLabels) <- rownames(genesInfoList[[cl]])[availableNames]
|
1384: geneLabels <- c(geneLabels, classGeneLabels)
|
1396: missingGenes <- classGenes[which(!classGenes %in% rownames(genesInfoList[[cl]]))]
|
1408: # - Add classification nodes Network
|
1411: # Extract CLASSIFICATIONgenesNetwork if available/needed & add to list
|
1414: if(!is.null(classificationGenes) && plotClassifcationGenesNetwork)
|
1416: classificationGenesID <- getRanking(classificationGenes, showGeneLabels=FALSE, showGeneID=TRUE)$geneID[, nwClasses, drop=FALSE]
|
1417: classificationGenesNetwork <- getSubNetwork(genesNetwork, classificationGenesID)
|
1418: names(classificationGenesNetwork) <- paste(names(classificationGenesNetwork), " - Classification Genes",sep="")
|
1420: clToAdd <- which(sapply(genesNetwork, function(x){length(getNodes(x))}) - sapply(classificationGenesNetwork, function(x){length(getNodes(x))}) != 0)
|
1423: warning("Only the classification genes network was provided. Only 'AllNodesNetwork' will be plotted.")
|
1431: genesNetwork <- c(genesNetwork[1:pos], classificationGenesNetwork[clToAdd[i]], genesNetwork[-(1:pos)])
|
1433: genesInfoList <- c(genesInfoList[1:pos], list(genesInfoList[[i]][classificationGenesID[,clToAdd[i]][!is.na(classificationGenesID[,i])],] ), genesInfoList[-(1:pos)])
|
1434: names(genesInfoList)[pos+1] <- names(classificationGenesNetwork[clToAdd[i]])
|
1440: # (Needs to be added after classific. in order to add it right after the "full" network)
|
1474: if( numClasses>25 ) stop("Too many classes to draw in a single plot. Use 'pdf' instead.")
|
1485: classGenes <- unique(c(genesNetwork[[nw]]@edges[,"gene1"],genesNetwork[[nw]]@edges[,"gene2"]))
|
1487: if((is.null(genesInfoList) || nrow(genesInfoList[[nw]])==0 ) || any(!classGenes %in% rownames(genesInfoList[[nw]])))
|
1490: } else classGraph <- igraph::graph.data.frame(as.data.frame(genesNetwork[[nw]]@edges[,ntwColnames,drop=FALSE]), ...(15 bytes skipped)...
|
1493: classGraph <- igraph::graph.data.frame(as.data.frame(genesNetwork[[nw]]@edges[,ntwColnames,drop=FALSE]), ...(101 bytes skipped)...
|
1495: if (igraph::vcount(classGraph) != 0)
|
1501: graphLayout <- igraph::layout.fruchterman.reingold(classGraph) # .grid is faster, but the result looks far worse.
|
1509: vertexLabels <- igraph::get.vertex.attribute(classGraph,"name")
|
1515: if(!is.null(igraph::get.vertex.attribute(classGraph,"exprsMeanDiff")))
|
1517: exprsDiff <- as.numeric(igraph::get.vertex.attribute(classGraph,"exprsMeanDiff"))
|
1539: if(!is.null(igraph::get.vertex.attribute(classGraph,"discriminantPower")))
|
1541: discPower<-round(as.numeric(igraph::get.vertex.attribute(classGraph,"discriminantPower")))
|
1552: # Shape: Classification gene
|
1555: if(!is.null(igraph::get.vertex.attribute(classGraph,"discriminantPower")))
|
1560: if(!is.null(classificationGenes)) # alguna comprobacion mas?
|
1562: vertexShape[which(igraph::get.vertex.attribute(classGraph,"name")%in% as.vector(getRanking(classificationGenes, showGeneID=TRUE)$geneID))] <- "square"
|
1567: relColors <- ifelse( igraph::get.edge.attribute(classGraph,"relation")==levels(factor(igraph::get.edge.attribute(classGraph,"relation")))[1], relColors[1],relColors[2])
|
1571: if(igraph::ecount(classGraph) > 0)
|
1573: igraph::tkplot(classGraph, layout=graphLayout, vertex.label=vertexLabels, vertex.label.family="sans", vertex.color=vert...(178 bytes skipped)...
|
1583: plot(classGraph, layout=graphLayout, vertex.label=vertexLabels, vertex.label.family="sans", vertex.label.cex=...(219 bytes skipped)...
|
1586: graphList <- c(graphList, graph=list(classGraph))
|
1607: text(0,0.6,"Node shape: Chosen/Not chosen for classification", pos=4, font=2)
|
5: # queryGeNetClassifier
|
21: # queryGeNetClassifier:
|
107: colnames(mxcf)[which(colnames(mxcf)=="")]<-missingClasses
|
115: rownames(mxcf)[which(rownames(mxcf)=="")]<-missingClasses
|
129: #nclasses <- dim(mxcf)[1]
|
131: numNA <- sum(mxcf[,nclasses+1])
|
137: falseNegatives <- array(0,dim=nclasses)
|
138: falsePositives <- array(0,dim=nclasses)
|
139: trueNegatives <- array(0,dim=nclasses)
|
140: truePositives <- array(0,dim=nclasses)
|
144: for(j in 1:nclasses) #dim(mxcf)[2]) Para incluir NA
|
156: for (i in 1:nclasses) #We need another loop in order to have the whole trueNegatives ready
|
175: # Can receive the result from executing queryGeNetClassifier, or a list of several: queryResult<-c(assignment1, assignment2)
|
229: # Can receive the result from executing queryGeNetClassifier, or a list of several: queryResult<-c(prediction1, prediction2)
|
252: stats <- cbind(c(rep(0,numClasses)), c(rep(1,numClasses)), c(rep(0,numClasses)),c(rep(NA,numClasses)),c(rep(NA,numClasses)))
|
257: for (c in 1:numClasses)
|
321: ...(12 bytes skipped)...nts <- function(queryResult, realLabels, minProbAssignCoeff=1, minDiffAssignCoeff=0.8, totalNumberOfClasses=NULL, pointSize=0.8, identify=FALSE)
|
340: numClasses <- totalNumberOfClasses
|
357: rand <- 1/numClasses
|
358: if(numClasses>2) { minProb <- 2*rand * minProbAssignCoeff
|
364: if(numClasses>2)
|
377: if(numClasses>2) graphics::text(0.3, 0.95, labels="Not Assigned", col="#606362", cex=0.8)
|
513: colnames(meanExprDiff) <- gClasses(genesRanking)
|
526: if (length(gClasses(genesRanking)) > 2){ ord <- genesRanking@ord[1:numGenesPlot,]
|
535: if((numClasses>3 && numClasses<10) && ("RColorBrewer" %in% rownames(utils::installed.packages())))
|
537: cols <- RColorBrewer::brewer.pal(numClasses,"Set1")
|
538: }else cols <- grDevices::rainbow(numClasses)
|
547: for(i in 1:numClasses)
|
555: legend("bottomleft", paste( gClasses(genesRanking)," (",lp," genes)",sep=""), lty=1, col=cols, pch=pchs)
|
700: for(i in 1:numClasses) #Por si no estan agrupados
|
992: if(longClassNames)
|
1102: if(longClassNames){ tit<- paste(tit,"DP: ", sep="")
|
1105: barplot(rep(0,numClasses),add=FALSE, ylim=lims, main=tit, col=mycols, width=0.9, space=0.1, cex.main=1)
|
1217: if(!is.logical(plotClassifcationGenesNetwork)) stop("plotClassifcationGenesNetwork should be either TRUE or FALSE.")
|
1248: if(!(returniGraphs || plotAllNodesNetwork || plotOnlyConnectedNodesNetwork || plotClassifcationGenesNetwork)) stop("No network plots have been requested.")
|
1249: if(!(plotAllNodesNetwork || plotOnlyConnectedNodesNetwork || plotClassifcationGenesNetwork)) warning("No network plots have been requested, only the iGraph will be return...(13 bytes skipped)...
|
1252: if(is(genesNetwork, "GeNetClassifierReturn"))
|
1264: }else stop("'genesNetwork' is the return of geNetClassifier, but doesn't contain a genesNetwork.")
|
1276: # if (nwClasses[1] == nwClasses[2]) nwClasses <- nwClasses[1]
|
1280: names(genesNetwork) <- nwClasses[1]
|
1320: for( cl in nwClasses)
|
1460: genesNetwork <- genesNetwork[-which(names(genesNetwork) %in% nwClasses)]
|
1475: cols <- ceiling(sqrt(numClasses))
|
1476: rows <- ifelse(sqrt(numClasses)<round(sqrt(numClasses)), ceiling(sqrt(numClasses)),round(sqrt(numClasses)))
|
Director:inst/www/js/d3.v3.js: [ ] |
---|
6188: chord.matrix = function(x) {
|
289: function d3_class(ctor, properties) {
|
552: var d3_subclass = {}.__proto__ ? function(object, prototype) {
|
681: d3_selectionPrototype.classed = function(name, value) {
|
707: function classedConstant() {
|
711: function classedFunction() {
|
698: function d3_selection_classedRe(name) {
|
701: function d3_selection_classes(name) {
|
717: function d3_selection_classedName(name) {
|
223: d3.transpose = function(matrix) {
|
224: if (!(n = matrix.length)) return [];
|
225: for (var i = -1, m = d3.min(matrix, d3_transposeLength), transpose = new Array(m); ++i < m; ) {
|
227: row[j] = matrix[j][i];
|
315: d3_class(d3_Map, {
|
441: d3_class(d3_Set, {
|
688: value = node.getAttribute("class");
|
721: var c = node.getAttribute("class") || "";
|
724: if (!re.test(c)) node.setAttribute("class", d3_collapse(c + " " + name));
|
726: node.setAttribute("class", d3_collapse(c.replace(re, " ")));
|
5952: return new d3_transform(t ? t.matrix : d3_transformIdentity);
|
6116: var chord = {}, chords, groups, matrix, n, padding = 0, sortGroups, sortSubgroups, sortChords;
|
6125: x += matrix[i][j];
|
6139: return sortSubgroups(matrix[i][a], matrix[i][b]);
|
6148: var di = groupIndex[i], dj = subgroupIndex[di][j], v = matrix[di][dj], a0 = x, a1 = x += v * k;
|
6189: if (!arguments.length) return matrix;
|
6190: n = (matrix = x) && matrix.length;
|
8986: ...(266 bytes skipped)...k = g.selectAll(".tick").data(ticks, scale1), tickEnter = tick.enter().insert("g", ".domain").attr("class", "tick").style("opacity", ε), tickExit = d3.transition(tick.exit()).style("opacity", ε).remove()...(134 bytes skipped)...
|
8987: ...(34 bytes skipped)...scale1), path = g.selectAll(".domain").data([ 0 ]), pathUpdate = (path.enter().append("path").attr("class", "domain"),
|
9095: background.enter().append("rect").attr("class", "background").style("visibility", "hidden").style("cursor", "crosshair");
|
9096: g.selectAll(".extent").data([ 0 ]).enter().append("rect").attr("class", "extent").style("cursor", "move");
|
9099: resize.enter().append("g").attr("class", function(d) {
|
558: d3_subclass(groups, d3_selectionPrototype);
|
684: var node = this.node(), n = (name = d3_selection_classes(name)).length, i = -1;
|
685: if (value = node.classList) {
|
689: while (++i < n) if (!d3_selection_classedRe(name[i]).test(value)) return false;
|
693: for (value in name) this.each(d3_selection_classed(value, name[value]));
|
696: return this.each(d3_selection_classed(name, value));
|
704: function d3_selection_classed(name, value) {
|
705: name = d3_selection_classes(name).map(d3_selection_classedName);
|
715: return typeof value === "function" ? classedFunction : classedConstant;
|
718: var re = d3_selection_classedRe(name);
|
720: if (c = node.classList) return value ? c.add(name) : c.remove(name);
|
998: d3_subclass(selection, d3_selection_enterPrototype);
|
1187: point = point.matrixTransform(container.getScreenCTM().inverse());
|
4841: d3_subclass(coordinates, d3_geom_polygonPrototype);
|
8661: d3_subclass(groups, d3_transitionPrototype);
|
9191: ...(171 bytes skipped)... !/^(n|s)$/.test(resizing) && x, resizingY = !/^(e|w)$/.test(resizing) && y, dragging = eventTarget.classed("extent"), dragRestore = d3_event_dragSuppress(target), center, origin = d3.mouse(target), offset...(1 bytes skipped)...
|
messina:R/plot-methods.R: [ ] |
---|
172: Sample = Value = Class = NULL # To shut up an R CMD check note for the later use of these in ggplot
|
170: messinaClassPlot = function(object, indices = c(1), sort_features = TRUE, plot_type = "bar")
|
41: #' @seealso \code{\link{MessinaClassResult-class}}
|
136: #' @seealso \code{\link{MessinaSurvResult-class}}
|
211: data = data.frame(Sample = samples, Value = x, Class = ordered(y*1))
|
213: theplot = ggplot(data, aes(x = reorder(Sample, Value), y = Value, fill = Class, colour = Class)) +
|
467: ests_at_time = matrix(ests_at_time, nrow = 1)
|
10: #' Plot the results of a Messina analysis on a classification / differential expression problem.
|
27: #' the second best classifier margin will be plotted.}
|
59: #' ## Run Messina to rank probesets on their classification ability, with
|
60: #' ## classifiers needing to meet a minimum sensitivity of 0.95, and minimum
|
112: #' the second best classifier margin will be plotted.}
|
215: ggtitle(sprintf("MessinaClass Fit: Feature %s", feature)) +
|
37: #' @aliases plot,MessinaClassResult-method
|
38: #' @aliases plot,MessinaClassResult,missing-method
|
69: setMethod("plot", signature = signature(x = "MessinaClassResult", y = "missing"), definition = function(x, y, ...) messinaClassPlot(object = x, ...))
|
pcaExplorer:R/pcaExplorer.R: [ ] |
---|
2684: class = "footer",
|
1044: readCountmatrix <- reactive({
|
13: #' @param countmatrix A count matrix, with genes as rows and samples as columns. If not provided, it is possible
|
41: #' pcaExplorer() # and then upload count matrix, covariate matrix (and eventual annotation)
|
84: class = "btn_no_border",
|
191: uiOutput("upload_count_matrix"),
|
193: "upload_count_matrix", paste0("Select the file containing the count matrix"),
|
225: # class = "btn btn-info"),
|
307: downloadButton("downloadData", "Download", class = "btn btn-success"),
|
318: actionButton("compute_pairwisecorr", "Run", class = "btn btn-primary"),
|
573: "objects you are using - count matrix, SummarizedExperiments ",
|
735: actionButton("composemat", "Compose the matrix", icon = icon("spinner"), class = "btn btn-primary"),
|
743: "new matrix which will be used for the visualizations below"),
|
818: actionButton("updatepreview_button", "Update report", class = "btn btn-primary"), p()
|
820: column(3, downloadButton("saveRmd", "Generate & Save", class = "btn btn-success"))
|
912: # if provided as dds, can fill in the count matrix and metadata
|
949: stop("dds must be a DESeqDataSet object. If it is a simple counts matrix, provide it to the countmatrix parameter!")
|
971: class = "btn btn-primary", icon = icon("spinner")),
|
974: class = "btn btn-primary", icon = icon("spinner")),
|
977: class = "btn btn-primary", icon = icon("spinner"))
|
1019: ## Render the UI element to upload the count matrix
|
1020: output$upload_count_matrix <- renderUI({
|
1028: label = "Upload a count matrix file",
|
1062: label = "Upload a sample metadata matrix file",
|
1127: "No count matrix provided, please upload it or pass it as a parameter"
|
1130: actionButton(inputId = "show_cm", label = HTML("Show </br>count matrix"), class = "btn btn-success")
|
1139: actionButton(inputId = "show_metadata", label = HTML("Show </br>sample metadata"), class = "btn btn-success")
|
1145: "No dds object provided or computed, please upload its components (count matrix and metadata) or pass it as a parameter"
|
1148: actionButton(inputId = "show_dds", label = HTML("Show </br><code>dds</code> object"), class = "btn btn-success")
|
1157: actionButton(inputId = "show_annotation", label = HTML("Show </br>gene annotation"), class = "btn btn-success")
|
1166: title = "Preview - Count matrix",
|
1207: actionButton("button_diydds", label = HTML("Generate the dds and </br>dst objects"), class = "btn btn-success"),
|
1426: message = "Generating the scatterplot matrix...",
|
1443: "Click on the Run button to generate the scatterplot matrix")
|
1481: mydistmat <- as.matrix(dist(t(assay(values$mydst))))
|
1483: mydistmat <- as.matrix(dist(t(assay(values$mydst)), method = "manhattan"))
|
1486: mydistmat <- as.matrix(1 - cor(assay(values$mydst)))
|
2008: actionButton("computepca2go", "Compute the PCA2GO object", icon = icon("spinner"), class = "btn btn-primary")
|
2140: class(input$pc_x)
|
2142: class(datatable(values$mypca2go[[paste0("PC", input$pc_x)]][["posLoad"]]))
|
2241: withProgress(message = "Composing the matrix...",
|
2533: pheatmap(as.matrix(dist(t(assay(values$mydst)))), annotation_col = expgroups)
|
2535: pheatmap(as.matrix(dist(t(assay(values$mydst)))))
|
2687: class = "foot-inner",
|
6: #' @param dds A \code{\link{DESeqDataSet}} object. If not provided, then a \code{countmatrix}
|
10: #' if left NULL. If none is provided, then a \code{countmatrix}
|
31: #' dds_airway <- DESeq2::DESeqDataSetFromMatrix(assay(airway),
|
39: #' pcaExplorer(countmatrix = counts(dds_airway), coldata = colData(dds_airway))
|
47: countmatrix = NULL,
|
898: values$mycountmatrix <- countmatrix
|
913: values$mycountmatrix <- counts(dds)
|
1021: if (!is.null(dds) | !is.null(countmatrix)) {
|
1126: need(!is.null(values$mycountmatrix),
|
1168: DT::renderDataTable(values$mycountmatrix)),
|
1204: if (is.null(values$mycountmatrix) | is.null(values$mymetadata))
|
1232: ##### print((ncol(values$mycountmatrix) == nrow(values$mymetadata)))
|
1238: if (ncol(values$mycountmatrix) == nrow(values$mymetadata)) {
|
1239: values$mydds <- DESeqDataSetFromMatrix(countData = values$mycountmatrix,
|
1265: values$mycountmatrix <- readCountmatrix()
|
1290: values$mycountmatrix <- cm_airway
|
1295: values$mydds <- DESeqDataSetFromMatrix(countData = values$mycountmatrix,
|
2677: }) # end of pcaExplorer(dds,dst,countmatrix,coldata,pca2go,annotation)
|
trio:R/qingInternal.R: [ ] |
---|
7782: class = unlist(lapply(elm, FUN=class))
|
7773: class.last = NULL
|
9892: anyMatrix = inMatrix[,colVec]
|
73: # 2)elm.vMa: A matrix for variable only element
|
74: # matrix col 1:id: list id
|
123: # 1)elm.nlist: a list of matrix, each vector for one element
|
124: # matrix col 1: idx for node or variable element
|
125: # matrix col 2: is a node(1) or variable element(0)
|
126: # 2)elm.nMa: A matrix for node
|
127: # matrix col 1:id: list id
|
155: nMa = matrix(c(binaTree$curElmId, binaTree$curElm), nrow=1, ncol=2)
|
162: nMa = matrix( c(binaTree$curElmId, binaTree$curElm), nrow=1, ncol=2)
|
182: ## data.v: a matrix of boolean (0/1) for each row in binaTree$vMa, ordered by id
|
183: ## data.n: a matrix of boolean (0/1) for each row in binaTree$nMa, ordered by id
|
195: data.v = matrix(NA, ncol=vCt, nrow=ori.rowCt)
|
228: data.n=matrix(NA, ncol=nCt, nrow=ori.rowCt)
|
313: # matrix col 1: idx for node or variable element
|
314: # matrix col 2: is a node(1) or variable element(0)
|
315: # 2)elm.nMa: A matrix for node
|
316: # matrix col 1:id: list id
|
|