Found 255009 results in 14425 files, showing top 150 files (show more).
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
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"),
VariantAnnotation:R/methods-VCF-class.R: [ ]
20:         class <- "CollapsedVCF"
503: .showVCFSubclass <- function(object)
447: SnpMatrixToVCF <- function(from, seqSource)
2: ### VCF class methods 
29:         class <- "ExpandedVCF"
39:     new(class, SummarizedExperiment(assays=geno, rowRanges=rowRanges,
229: setReplaceMethod("geno", c("VCF", "character", "matrix"),
237: setReplaceMethod("geno", c("VCF", "numeric", "matrix"),
245: setReplaceMethod("geno", c("VCF", "missing", "matrix"),
384:     if (!.compare(lapply(args, class)))
385:         stop("'...' objects must be of the same VCF class")
422:     if (!.compare(lapply(args, class)))
423:         stop("'...' objects must be of the same VCF class")
482:     GT <- matrix(GT, byrow=TRUE, ncol=nrowGT)
546:     cat("class:", classNameForDisplay(object), "\n")
526:         cat(margin, classNameForDisplay(x), " with ",
534:         cat(margin, classNameForDisplay(x), " with ",
542:         cat(margin, classNameForDisplay(x), " of length ", lo, 
enhancerHomologSearch:src/ClustalW/substitutionMatrix/SubMatrix.h: [ ]
39: typedef vector<short> Matrix;
41: class SubMatrix
114:         int matrixNum;
119:         string* matrixName;
142:         Matrix QTscoreUserMatrix;
143:         Matrix QTscoreUserDNAMatrix;
144:         Matrix QTsegmentDNAMatrix;
145:         Matrix QTsegmentAAMatrix;
148:         const int sizenAAMatrix; 
149:         const int sizeDNAMatrix; 
169:         int matrixAvgScore; // NOTE Needed by other classes.
24: #define SUBMATRIX_H
115:         int DNAMatrixNum;
116:         int pwMatrixNum;
117:         int pwDNAMatrixNum;
120:         string* DNAMatrixName;
121:         string* pwMatrixName;
122:         string* pwDNAMatrixName;
7:  * This is the interface class to all the substitution matrices.
9:  * It is also used to store the user defined matrix. This will be used mainly as an interface
11:  * The way this class will work is the user can read in matrix series or a single matrix, 
12:  * or they can select one of the matrix series (e.g Blosum). This will then be used in the
17:  * A single matrix is choosen for pairwise and for DNA alignments.
18:  * This class does 3 jobs. It reads in matrices from files/arrays, it provides
63:         int getPairwiseMatrix(int matrix[NUMRES][NUMRES], PairScaleValues& scale, 
65:         int getProfileAlignMatrix(int matrix[NUMRES][NUMRES], double pcid, int minLen, 
67:         int getAlnScoreMatrix(int matrix[NUMRES][NUMRES]);
73:         void getQTMatrixForHistogram(int matrix[NUMRES][NUMRES]); 
80:         void getQTMatrixForLowScoreSeg(int matrix[NUMRES][NUMRES]);
93:         int getMatrix(Matrix* matPtr, Xref* xref, int matrix[NUMRES][NUMRES],
95:         int readMatrixSeriesFromR(const Rcpp::NumericMatrix substitutionmatrix, Matrix& userMat, Xref& xref);
96:         int readUserMatrixFromR(const Rcpp::NumericMatrix substitutionMatrix, Matrix& userMat, Xref& xref);
97:         int readMatrixSeries(const char *fileName, Matrix& userMat, Xref& xref);
98:         int readUserMatrix(const char *fileName, Matrix& userMat, Xref& xref);
108:         Matrix* getUserMatAddress(int alignResidueType, int alignType);
124:         // Matrix cross references.
137:         vector<Matrix> userMatSeries;
138:         Matrix userMat;
139:         Matrix pwUserMat;
140:         Matrix userDNAMat;
141:         Matrix pwUserDNAMat;
150:         Matrix* blosum30mtVec; 
151:         Matrix* blosum40mtVec;
152:         Matrix* blosum45mtVec;
153:         Matrix* blosum62mt2Vec;
154:         Matrix* blosum80mtVec;
155:         Matrix* pam20mtVec;
156:         Matrix* pam60mtVec;
157:         Matrix* pam120mtVec;
158:         Matrix* pam350mtVec;
159:         Matrix* idmatVec;
160:         Matrix* gon40mtVec;
161:         Matrix* gon80mtVec;
162:         Matrix* gon120mtVec;
163:         Matrix* gon160mtVec;
164:         Matrix* gon250mtVec;
165:         Matrix* gon350mtVec;
166:         Matrix* clustalvdnamtVec;
167:         Matrix* swgapdnamtVec;
179:         Matrix* mat;
181:         Matrix* _matPtr;
23: #ifndef SUBMATRIX_H
45:         SubMatrix();
46:         ~SubMatrix();
48:         bool getUserMatFromR(Rcpp::NumericMatrix substitutionMatrix, int alignResidueType, int alignType);
49:         bool getAAScoreMatFromR(Rcpp::NumericMatrix substitutionMatrix);
50:         bool getDNAScoreMatFromR(Rcpp::NumericMatrix substitutionMatrix);
51:         bool getQTLowScoreMatFromR(Rcpp::NumericMatrix substitutionMatrix, bool dna);
52:         bool getUserMatSeriesFromR(Rcpp::NumericMatrix substitutionMatrix);
60:         void setCurrentNameAndNum(string _matrixName, int _matrixNum, int alignResidueType,
62:         int getMatrixNumForMenu(int alignResidueType, int alignType);
69:         int getMatrixNum();
70:         int getDNAMatrixNum();
71:         int getPWMatrixNum();
72:         int getPWDNAMatrixNum();
104:         void printGetMatrixResults(int mat[NUMRES][NUMRES]); 
170:         UserMatrixSeries matSeries;
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",
Biostrings:R/XStringViews-class.R: [ ]
39:                                      Class="XStringViews")
398:             class1 <- class(subject(e1))
399:             class2 <- class(subject(e2))
411:             class1 <- class(subject(e1))
412:             class2 <- class(e2)
5: ### The XStringViews class is the basic container for storing a set of views
210:     class(ans) <- c(seqtype(x), class(ans))  # for S3 dispatch in add_colors()
279:             class(subject), " subject", sep="")
401:                  "class \"", class1, "\" and \"", class2, "\" ",
414:                  "class \"", class1, "\" and a \"", class2, "\" instance ",
425:                  "class \"", class(subject(e1)), "\" and a character vector ",
477: setMethod("as.matrix", "XStringViews",
481:         msg <- c("as.matrix() on an XStringViews object 'x' has changed ",
485:                  "do 'as.matrix(ranges(x))'.\n  To supress this warning, do ",
486:                  "'suppressWarnings(as.matrix(x))'.\n  This warning will be ",
491:         as.matrix(y)
10: setClass("XStringViews",
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)
S4Vectors:R/Hits-class.R: [ ]
238:     Class <- if (sort.by.query) "SortedByQueryHits" else "Hits"
248:     Class <- if (sort.by.query) "SortedByQuerySelfHits" else "SelfHits"
445:         .COL2CLASS <- c(
451:         classinfo <- makeClassinfoRowForCompactPrinting(x, .COL2CLASS)
425: .from_Hits_to_naked_character_matrix_for_display <- function(x)
5: ### The Hits class hierarchy (4 concrete classes):
42: ### Combine the new "parallel slots" with those of the parent class. Make
43: ### sure to put the new parallel slots **first**. See Vector-class.R file
156: .new_Hits <- function(Class, from, to, nLnode, nRnode, mcols)
158:     new2(Class, from=from, to=to, nLnode=nLnode, nRnode=nRnode,
163: ### Low-level constructor. Sort the hits by query if Class extends
165: new_Hits <- function(Class, from=integer(0), to=integer(0),
169:     if (!isSingleString(Class))
170:         stop("'Class' must be a single character string")
171:     if (!extends(Class, "Hits"))
172:         stop("'Class' must be the name of a class that extends Hits")
188:     mcols <- normarg_mcols(mcols, Class, length(from))
190:     if (!extends(Class, "SortedByQueryHits")) {
192:         ans <- .new_Hits(Class, from, to, nLnode, nRnode, mcols)
202:     ans <- .Call2("Hits_new", Class, from, to, nLnode, nRnode, revmap_envir,
240:     new_Hits(Class, from, to, nLnode, nRnode, mcols)
250:     new_Hits(Class, from, to, nnode, nnode, mcols)
280: ### --- Coercion within the Hits class hierarchy ---
282: ### There are 4 classes in the Hits class hierarchy. We want to support back
313:         stop(wmsg(class(from), " object to coerce to ", to,
315:     class(from) <- class(new(to))
344: setMethod("as.matrix", "Hits",
367:         DataFrame(as.matrix(from), from_mcols, check.names=FALSE)
392:             stop(wmsg("Problem(s) found when testing validity of ", class(ans),
395:                       "subscript that results in a valid ", class(ans),
407:     function(x) sub("^SortedByQuery", "", class(x))
434:     .from_Hits_to_naked_character_matrix_for_display
450:             names(.COL2CLASS) <- c("queryHits", "subjectHits")
630:         return(new_Hits(class(x), to(x), from(x), nRnode(x), nLnode(x),
752:     new_Hits(class(x), x_from, x_to, new.nLnode, new.nRnode, x_mcols)
14: setClass("Hits",
30: setClass("SelfHits", contains="Hits")
34: setClass("SortedByQueryHits", contains="Hits")
35: setClass("SortedByQuerySelfHits", contains=c("SelfHits", "SortedByQueryHits"))
406: setMethod("classNameForDisplay", "SortedByQueryHits",
415:     paste0(classNameForDisplay(object), " object with ", object_len, " ",
437: .show_Hits <- function(x, margin="", print.classinfo=FALSE,
444:     if (print.classinfo) {
453:         stopifnot(identical(colnames(classinfo), colnames(out)))
454:         out <- rbind(classinfo, out)
480:         .show_Hits(object, print.classinfo=TRUE, print.nnode=TRUE)
433: setMethod("makeNakedCharacterMatrixForDisplay", "Hits",
441:     ## makePrettyMatrixForCompactPrinting() assumes that head() and tail()
443:     out <- makePrettyMatrixForCompactPrinting(x)
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)
scoreInvHap:R/scoreInvHapRes_class.R: [ ]
210:         class <- classification(object)
6: #' @rdname scoreInvHapRes-class
8: #' @aliases scoreInvHapRes-class scoreInvHapRes-methods
19: #'     ## Create scoreInvHapRes class from pipeline
32:     Class = "scoreInvHapRes",
35:         scores = "matrix",
212:         cat("Samples: ", length(class), "\n")
213:         tab <- table(class)
3: #' Container with the results of the classification pipeline
10: #' @slot classification Factor with the individuals classification
13: #' @slot certainty Numeric with the certainty of the classification for each individual.
25: #'     ## Get haplotype classification
26: #'     classification(res)
31: setClass (
34:         classification = "factor",
42: setGeneric("classification", function(object, minDiff = 0, callRate = 0, inversion = FALSE){
43:     standardGeneric("classification")
46: #' @describeIn scoreInvHapRes Get classification
47: #' @aliases scoreInvHapRes-methods classification
53: #' @param inversion Logical. If true, haplotypes classification is adapted
56:     f = "classification",
59:         res <- object@classification
82: #' @describeIn scoreInvHapRes Get classification certainty
RSeqAn:inst/include/seqan/align/matrix_base.h: [ ]
96: class Matrix<TValue, 0, THost>
111:     Matrix()
115:     Matrix(Matrix const & other_):
159: class Matrix<TValue, 2, THost>
176:     Matrix()
185:     Matrix(Matrix const & other_):
219: class Matrix<TValue, 3, THost>
236:     Matrix()
245:     Matrix(Matrix const & other_):
130:     ~Matrix()
201:     ~Matrix()
261:     ~Matrix()
455:     typedef Matrix<TValue, DIMENSION, THost> TMatrix;
481:     typedef Matrix<TValue, DIMENSION, THost> TMatrix;
38: #define SEQAN_HEADER_MATRIX_BASE_H
57:     typedef Matrix<TValue, DIMENSION, THost> TMatrix_;
37: #ifndef SEQAN_HEADER_MATRIX_BASE_H
49: class Matrix;
55: struct SizeArr_<Matrix<TValue, DIMENSION, THost> >
65: struct Host<Matrix<TValue, DIMENSION, THost> >
71: struct Host<Matrix<TValue, DIMENSION, THost> const>
82:  * @class Matrix
84:  * @brief A simple n-dimensional matrix type.
87:  *            class Matrix;
89:  * @tparam TValue    Type of matrix entries.
90:  * @tparam DIMENSION Dimension of the matrix.  Use 0 for n-dimensional, values &gt; 0 for a matrix with
101:     typedef typename Size<Matrix>::Type TSize;
121:     inline Matrix const &
122:     operator = (Matrix const & other_)
164:     typedef typename Size<Matrix>::Type TSize;
191:     inline Matrix const &
192:     operator = (Matrix const & other_)
224:     typedef typename Size<Matrix>::Type TSize;
251:     inline Matrix const &
252:     operator = (Matrix const & other_)
279: inline typename SizeArr_<Matrix<TValue, DIMENSION, THost> >::Type &
280: _dataLengths(Matrix<TValue, DIMENSION, THost> & me)
286: inline typename SizeArr_<Matrix<TValue, DIMENSION, THost> >::Type const &
287: _dataLengths(Matrix<TValue, DIMENSION, THost> const & me)
293: inline typename SizeArr_<Matrix<TValue, DIMENSION, THost> >::Type &
294: _dataFactors(Matrix<TValue, DIMENSION, THost> & me)
300: inline typename SizeArr_<Matrix<TValue, DIMENSION, THost> >::Type const &
301: _dataFactors(Matrix<TValue, DIMENSION, THost> const & me)
311: dependent(Matrix<TValue, DIMENSION, THost> & me)
319: inline Holder<typename Host<Matrix<TValue, DIMENSION, THost> >::Type> &
320: _dataHost(Matrix<TValue, DIMENSION, THost> & matrix)
322:     return matrix.data_host;
326: inline Holder<typename Host<Matrix<TValue, DIMENSION, THost> >::Type> const &
327: _dataHost(Matrix<TValue, DIMENSION, THost> const & matrix)
329:     return matrix.data_host;
336: assignHost(Matrix<TValue, DIMENSION, THost> & me, THost const & value_)
345: moveHost(Matrix<TValue, DIMENSION, THost> & me, THost const & value_)
353: struct Value< Matrix<TValue, DIMENSION, THost> >
361: struct Iterator< Matrix<TValue, DIMENSION, THost>, TIteratorSpec >
363:     typedef Iter<Matrix<TValue, DIMENSION, THost>, PositionIterator> Type;
367: struct Iterator< Matrix<TValue, DIMENSION, THost> const, TIteratorSpec >
369:     typedef Iter<Matrix<TValue, DIMENSION, THost> const, PositionIterator> Type;
376: inline typename Size<Matrix<TValue, DIMENSION, THost> const>::Type
377: dimension(Matrix<TValue, DIMENSION, THost> const & me)
386: setDimension(Matrix<TValue, DIMENSION, THost> & me,
402: inline typename Size<Matrix<TValue, DIMENSION, THost> >::Type
403: length(Matrix<TValue, DIMENSION, THost> const & me,
410: inline typename Size<Matrix <TValue, DIMENSION, THost> >::Type
411: length(Matrix<TValue, DIMENSION, THost> const & me)
417: inline bool empty(Matrix<TValue, DIMENSION, THost> const & me)
426: setLength(Matrix<TValue, DIMENSION, THost> & me,
433:     typedef typename SizeArr_<Matrix<TValue, DIMENSION, THost> >::TSize_ TSize_;
441:  * @fn Matrix#resize
442:  * @brief Resize the matrix and fill it with a given value or zeroes.
444:  * @signature void resize(matrix[, val]);
446:  * @param[in,out] matrix The Matrix to fill.
447:  * @param[in]     val    The optional value to fill the matrix with.
453: resize(Matrix<TValue, DIMENSION, THost> & me)
479: resize(Matrix<TValue, DIMENSION, THost> & me, TFillValue myValue)    //resize the matrix and fill with value
503: inline typename Position<Matrix <TValue, DIMENSION, THost> >::Type
504: nextPosition(Matrix<TValue, DIMENSION, THost> & me,
512: inline typename Position<Matrix <TValue, DIMENSION, THost> >::Type
513: nextPosition(Matrix<TValue, DIMENSION, THost> const & me,
521: inline typename Position<Matrix <TValue, DIMENSION, THost> >::Type
522: previousPosition(Matrix<TValue, DIMENSION, THost> & me,
530: inline typename Position<Matrix <TValue, DIMENSION, THost> >::Type
531: previousPosition(Matrix<TValue, DIMENSION, THost> const & me,
541: inline typename Size< Matrix <TValue, DIMENSION, THost> >::Type
542: coordinate(Matrix<TValue, DIMENSION, THost> const & me,
561: inline typename Iterator<Matrix <TValue, DIMENSION, THost>, Tag<TTag> const>::Type
562: begin(Matrix<TValue, DIMENSION, THost> & me,
565:     return typename Iterator<Matrix <TValue, DIMENSION, THost>, Tag<TTag> const >::Type(me, 0);
568: inline typename Iterator<Matrix <TValue, DIMENSION, THost> const, Tag<TTag> const>::Type
569: begin(Matrix<TValue, DIMENSION, THost> const & me,
572:     return typename Iterator<Matrix <TValue, DIMENSION, THost> const, Tag<TTag> const >::Type(me, 0);
578: inline typename Iterator<Matrix <TValue, DIMENSION, THost>, Tag<TTag> const >::Type
579: end(Matrix<TValue, DIMENSION, THost> & me,
582:     return typename Iterator<Matrix <TValue, DIMENSION, THost>, Tag<TTag> const >::Type(me, length(host(me)));
585: inline typename Iterator<Matrix <TValue, DIMENSION, THost> const, Tag<TTag> const >::Type
586: end(Matrix<TValue, DIMENSION, THost> const & me,
589:     return typename Iterator<Matrix <TValue, DIMENSION, THost>, Tag<TTag> const >::Type(me, length(host(me)));
595: inline typename Reference<Matrix<TValue, DIMENSION, THost> >::Type
596: value(Matrix<TValue, DIMENSION, THost> & me,
603: inline typename Reference<Matrix<TValue, DIMENSION, THost> const>::Type
604: value(Matrix<TValue, DIMENSION, THost> const & me,
614: inline typename Reference<Matrix<TValue, DIMENSION, THost> >::Type
615: value(Matrix<TValue, DIMENSION, THost> & me,
623: inline typename Reference<Matrix<TValue, DIMENSION, THost> const>::Type
624: value(Matrix<TValue, DIMENSION, THost> const & me,
636: inline typename Reference<Matrix<TValue, DIMENSION, THost> >::Type
637: value(Matrix<TValue, DIMENSION, THost> & me,
650: inline typename Reference<Matrix<TValue, DIMENSION, THost> >::Type
651: value(Matrix<TValue, DIMENSION, THost> & me,
667: goNext(Iter<Matrix<TValue, DIMENSION, THost>, PositionIterator> & me,
675: goNext(Iter<Matrix<TValue, DIMENSION, THost> const, PositionIterator> & me,
683: goNext(Iter<Matrix<TValue, DIMENSION, THost>, PositionIterator> & me)
690: goNext(Iter<Matrix<TValue, DIMENSION, THost> const, PositionIterator> & me)
701: goPrevious(Iter< Matrix<TValue, DIMENSION, THost>, PositionIterator > & me,
709: goPrevious(Iter< Matrix<TValue, DIMENSION, THost> const, PositionIterator > & me,
717: goPrevious(Iter< Matrix<TValue, DIMENSION, THost>, PositionIterator > & me)
724: goPrevious(Iter< Matrix<TValue, DIMENSION, THost> const, PositionIterator > & me)
735: goTo(Iter<Matrix<TValue, DIMENSION, THost>, PositionIterator> & me, TPosition0 pos0, TPosition1 pos1)
743: goTo(Iter<Matrix<TValue, DIMENSION, THost> const, PositionIterator> & me, TPosition0 pos0, TPosition1 pos1)
751: goTo(Iter<Matrix<TValue, DIMENSION, THost>, PositionIterator> & me, TPosition0 pos0, TPosition1 pos1, TPosition2 pos...(2 bytes skipped)...
759: goTo(Iter<Matrix<TValue, DIMENSION, THost> const, PositionIterator> & me, TPosition0 pos0, TPosition1 pos1, TPositio...(8 bytes skipped)...
768: inline typename Size< Matrix<TValue, DIMENSION, THost> >::Type
769: coordinate(Iter<Matrix<TValue, DIMENSION, THost>, PositionIterator > & me,
776: inline typename Size< Matrix<TValue, DIMENSION, THost> >::Type
777: coordinate(Iter<Matrix<TValue, DIMENSION, THost> const, PositionIterator > & me,
784:  * @fn Matrix::operator+
785:  * @brief Sum operator for the Matrix type.
787:  * @signature TMatrix Matrix::operator+(lhs, rhs);
792:  * @return TMatrix The resulting matrix of same type as <tt>lhs</tt> and <tt>rhs</tt>.
796: Matrix<TValue,DIMENSION>
797: operator + (Matrix<TValue,DIMENSION, THost1> const & matrix1, Matrix<TValue,DIMENSION, THost2> const & matrix2)
800:     SEQAN_ASSERT(_dataLengths(matrix1) == _dataLengths(matrix2));
802:     Matrix<TValue,DIMENSION> result;
803:     //copy the first matrix
804:     setDimension(result,length(_dataLengths(matrix1)));
805:     _dataLengths(result) = _dataLengths(matrix1);
811:         value(host(result), i)=value(host(matrix1), i)+value(host(matrix2), i);
813:     //Return matrix sum
818: Matrix<TValue,DIMENSION>
819: operator - (Matrix<TValue,DIMENSION, THost1> const & matrix1,Matrix<TValue,DIMENSION, THost2> const & matrix2)
822:     SEQAN_ASSERT(_dataLengths(matrix1) == _dataLengths(matrix2));
824:     Matrix<TValue,DIMENSION> result;
825:     //resize the matrix
826:     setDimension(result,length(_dataLengths(matrix1)));
827:     _dataLengths(result) = _dataLengths(matrix1);
833:         value(host(result), i)=value(host(matrix1), i)-value(host(matrix2), i);
835:     //Return matrix difference
840: Matrix<TValue, 2>
841: operator * (Matrix<TValue, 2, THost1> const & matrix1, Matrix<TValue, 2, THost2> const & matrix2)
843:     SEQAN_ASSERT_EQ(length(matrix1,1), length(matrix2,0));
845:     unsigned int nrow1=length(matrix1,0);
846:     unsigned int ncol2=length(matrix2,1);
847:     Matrix<TValue, 2> result;
848:     //resize the matrix
853:     //Matrix product
858:             for(unsigned int colRes = 0; colRes < length(matrix1,1); colRes++)
860:                 value(result,row,col)+=    value(host(matrix1), row + colRes * matrix1.data_factors[1])*value(host(matrix2), colRes + col * matrix2.data_factors[1]);
864:     //return the matrix product
870: Matrix<TValue, 2>
871: operator * (TValue const & scalar, Matrix<TValue, 2, THost> const & matrix)
873:     Matrix<TValue, 2> result;
874:     result= matrix;
880:     //return the matrix product
885: Matrix<TValue, 2>
886: operator * (Matrix<TValue, 2, THost> const & matrix, TValue const & scalar)
888:     Matrix<TValue, 2> result;
889:     result= matrix;
895:     //return the matrix product
902: operator == (Matrix<TValue, DIMENSION1, THost1> const & matrix1, Matrix<TValue, DIMENSION2, THost2> const & matrix2)
905:     result= (matrix1.data_lengths==matrix2.data_lengths)&&(matrix1.data_factors==matrix2.data_factors)&&(value(matrix1.data_host)==value(matrix2.data_host))&&(DIMENSION1==DIMENSION2);
911: Matrix<TValue,2>
912: matricialSum(Matrix<TValue,2> &matrix1,Matrix<TValue,2> &matrix2)
915:     if(length(matrix1,0) != length(matrix2,0)||length(matrix1,1) != length(matrix2,1))
921:     unsigned int nrow=length(matrix1,0);
922:     unsigned int ncol=length(matrix1,1);
924:     Matrix<TValue,2> result;
925:     //resize the matrix
933:         value(host(result), i)=value(host(matrix1), i)+value(host(matrix2), i);
935:     //Return matrix difference
946: inline Matrix<TValue,2>
947: matricialDifference(Matrix<TValue,2> & matrix1, Matrix<TValue,2> & matrix2)
950:     if(length(matrix1,0) != length(matrix2,0)||length(matrix1,1) != length(matrix2,1))
955:     unsigned int nrow=length(matrix1,0);
956:     unsigned int ncol=length(matrix1,1);
958:     Matrix<TValue,2> result;
959:     //resize the matrix
970:                 value(host(result), i1 + i2 * _dataFactors(result)[1])=value(host(matrix1), i1 + i2 * _dataFactors(matrix1)[1])-value(host(matrix2), i1 + i2 * _dataFactors(matrix2)[1]);
974:     //Return matrix difference
981: inline Matrix<TValue, 2>
982: matricialProduct(Matrix<TValue, 2> &matrix1,
983:         Matrix<TValue, 2> &matrix2)
986:     if(length(matrix1,1) != length(matrix2,0))
988:         fprintf(stderr,"Error: Number of columns of matrix1 is unequal to number of rows of matrix2");
991:     unsigned int nrow1=length(matrix1,0);
992:     unsigned int ncol2=length(matrix2,1);
993:     Matrix<TValue, 2> result;
994:     //resize the matrix
999:     //Matrix product
1004:             for(unsigned int colRes = 0; colRes < length(matrix1,1); colRes++)
1006:                 value(result,row,col)+=value(matrix1, row,colRes)*value(matrix2,colRes,col);
1010:     //return the matrix product
1016:  * @fn Matrix#transpose
1017:  * @brief Tranpose a 2D Matrix.
1019:  * @signature TMatrix transpose(matrix);
1021:  * @param[in] matrix The matrix to tranpose.
1022:  * @return TMatrix The resulting tranposed matrix.
1026: Matrix<TValue,2>
1027: transpose(Matrix<TValue,2, THost> const & matrix)
1030:     unsigned int nrow=length(matrix,0);
1031:     unsigned int ncol=length(matrix,1);
1033:     Matrix<TValue,2> result;
1034:     //resize the matrix
1044:             value(host(result), i2 + i1 * _dataFactors(result)[1])=value(host(matrix), i1 + i2 * matrix.data_factors[1]);
1049:     //Return transposed matrix
1056: std::ostream& operator<<(std::ostream &out, const Matrix<TValue,2, THost> &matrix)
1058:     for(unsigned int i1 = 0;i1< matrix.data_lengths[0];++i1)
1060:             for(unsigned int i2 = 0;i2<(matrix.data_lengths[1]-1);++i2)
1062:                 out<<value(host(matrix), i1 + i2 * matrix.data_factors[1])<<"\t";
1065:             out<<value(host(matrix), i1 + (matrix.data_lengths[1]-1) *matrix.data_factors[1])<<"\n";
1078: // void read(FILE *file, Matrix<TValue,2> & matrix)
1082: //     //read the transition matrix
1083: //     setLength(matrix, 0, column_size);
1084: //     setLength(matrix, 1, column_size);
1085: // resize(matrix,0.0);
1090: //           fscanf(file,"%lf ", & value(matrix, row,col));
58:     typedef typename Size<TMatrix_>::Type TSize_;
456:     typedef typename Size<TMatrix>::Type TSize;
482:     typedef typename Size<TMatrix>::Type TSize;
Rdisop:src/imslib/src/ims/utils/matrix.h: [ ]
48: class matrix {
65: 	matrix (size_type n, size_type m, value_type v = value_type()) { data = data_type (n, row_type (m, v)); }
3: #define IMS_MATRIX_H
1: // this header defines template object matrix, and also necessary row
2: #ifndef IMS_MATRIX_H
10: // row type necessary for matrix
13: class row {
87: typename matrix<T,A>::size_type matrix<T,A>::cols() const
139: //matrix
143: std::istream& operator>> (std::istream& s, const matrix<T,A>& m)
145: 	typename matrix<T,A>::const_row_iterator it = m.rows_begin();
156: std::ostream& operator<< (std::ostream& s, const matrix<T,A>& m)
158: 	typename matrix<T,A>::const_row_iterator it = m.rows_begin();
RNAmodR:R/ModifierSet-class.R: [ ]
91: S4Vectors::setValidity2(Class = "ModifierSet", .valid_ModifierSet)
114:   class <- try(getClass(ans), silent = TRUE)
147:   classNames <- unique(vapply(x, function(z){class(z)[[1]]},character(1)))
151:   allSameClass <- vapply(x,
170:   classNames <- vapply(x, function(z){class(z)[[1]]},character(1))
239:   CLASSFUN <- get(className)
103: .norm_classname_ModifierSet <- function(classname){
112: .get_classname_for_ModifierSet_from_modifier_type <- function(modifiertype){
2: #' @include Modifier-class.R
5: #' @name ModifierSet-class
8: #' @title The ModifierSet class
11: #' The \code{ModifierSet} class allows multiple
12: #' \code{\link[=Modifier-class]{Modifier}} objects to be created from the same
18: #' The \code{ModifierSet} is a virtual class, which derives from the 
19: #' \code{SimpleList} class with the slot \code{elementType = "Modifier"}. The
20: #' \code{ModifierSet} class has to be implemented for each specific analysis.#' 
27: #' @param className The name of the class which should be constructed.
46: #' @param seqinfo An optional \code{\link[GenomeInfoDb:Seqinfo-class]{Seqinfo}} 
55: #' \code{\link{getData}} function for \code{\link{SequenceData}} class, the
64: #' @rdname ModifierSet-class
78:                   function(xi) extends(class(xi), elementTypeX),
80:     return(paste("All 'Modifier' in '",class(x),"' must be of ",
115:   if (is(class, "try-error")){
116:     stop("Class '",ans,"' is not implemented.",
119:   if(isVirtualClass(class)){
120:     stop("Class '",ans,"' is virtual.")
122:   if(!("ModifierSet" %in% extends(class))){
123:     stop("Class '",ans,"' does not extend the 'ModifierSet' class.")
153:                            class(z)[[1]] == c
268:                   function(xi) extends(class(xi), elementType),
276: #' @rdname ModifierSet-class
285: #' @rdname ModifierSet-class
306: #' @rdname ModifierSet-class
315: #' @rdname ModifierSet-class
324: #' @rdname ModifierSet-class
353:     out <- as.matrix(format(as.data.frame(lapply(mf,showAsCell),
530:         ans <- RNAmodR::ModifierSet(class(x),ans)
547:         ans <- RNAmodR::ModifierSet(class(x),ans)
61: #' @return a \code{ModifierSet} object of type \code{className}
66: setClass("ModifierSet",
95: setMethod(f = "relistToClass",
104:   if(grepl("ModSet",classname)){
105:     ans <- classname
107:     ans <- gsub("Mod","ModSet",classname)
113:   ans <- .norm_classname_ModifierSet(modifiertype)
128: .ModifierSet <- function(className, x){
129:   new2(.get_classname_for_ModifierSet_from_modifier_type(className),
148:   if(length(classNames) != 1L){
156:                          classNames)
157:   if(!all(allSameClass)){
160:   x <- try(.norm_modifiertype(classNames), silent = TRUE)
171:   if(!all(unique(classNames) %in% c("BamFileList","character","list"))){
174:   namedRequired <- x[classNames %in% c("character","list")]
193: .bamfiles_to_ModifierSet <- function(className, x, annotation, sequences,
197:   className <- .norm_modifiertype(className)
205:   x <- lapply(x, .norm_bamfiles, className)
206:   annotation <- .norm_annotation(annotation, className)
208:   sequences <- .norm_sequences(sequences, className)
214:   # do analysis by calling the Modifier classes
215:   FUN <- function(i, z, n, args, className, PACKAGE, CLASSFUN, annotation,
221:       message(i,". ",className," analysis '",n,"':")
223:       message(i,". ",className," analysis:")
231:     do.call(CLASSFUN,
238:   PACKAGE <- getClass(className)@package
243:                                               className = className, 
245:                                               CLASSFUN = CLASSFUN,
255:   .ModifierSet(className, x)
258: .Modifer_to_ModifierSet <- function(className, x, ...){
263:   className <- .get_classname_for_ModifierSet_from_modifier_type(className)
264:   if(className != .norm_classname_ModifierSet(elementType)){
270:     return(paste("All 'Modifier' in '",className,"' must be of ",
273:   .ModifierSet(className, x)
281:   def = function(className, x, annotation, sequences, seqinfo, ...)
289:           function(className, x, annotation = NULL, sequences = NULL, 
292:               return(.Modifer_to_ModifierSet(className, x, ...))
295:               return(.bamfiles_to_ModifierSet(className, x, annotation, 
310:           function(className, x, annotation = NULL, sequences = NULL, 
312:             .bamfiles_to_ModifierSet(className, x, annotation, sequences,
319:           function(className, x, annotation = NULL, sequences = NULL,
321:             .bamfiles_to_ModifierSet(className, x, annotation, sequences,
328:           function(className, x, ...) {
329:             .Modifer_to_ModifierSet(className, x, ...)
RNAmodR:R/SequenceDataFrame-class.R: [ ]
455: S4Vectors::setValidity2(Class = "SequenceDataFrame", .valid_SequenceDataFrame)
267:     classes <- lapply(args,class)
271:     className <- unique(classes)
325:     classDG <- .get_first_class_extends(x)
383: sequenceDataFrameClass <- function(dataType){
22: #' @param param a \code{\link[Rsamtools:ScanBamParam-class]{ScanBamParam}} 
47: #' @name SequenceDataFrame-class
50: #' @title The SequenceDataFrame class
53: #' The \code{SequenceDataFrame} class is a virtual class and  contains data for
55: #' elements from a \code{SequenceData} object, the SequenceDataFrame class is
57: #' \code{\link[=SequenceData-class]{SequenceData}} object. Therefore, a matching
58: #' \code{SequenceData} and \code{SequenceDataFrame} class must be implemented.
60: #' The \code{SequenceDataFrame} class is derived from the
61: #' \code{\link[S4Vectors:DataFrame-class]{DataFrame}} class. To follow the 
65: #' \code{*SequenceDataFrame} class derive from, e.g. 
66: #' \code{\link[=CoverageSequenceData-class]{CoverageSequenceData}}.
73: #' \code{\link[S4Vectors:DataFrame-class]{subsetting}} or 
77: #' \code{\link[=ProtectedEndSequenceData-class]{ProtectedEndSequenceData}}
78: #' and for more information see \code{\link[=SequenceData-class]{SequenceData}}
80: #' @slot ranges a \code{\link[GenomicRanges:GRanges-class]{GRanges}} 
87: #' @slot sequence a \code{\link[Biostrings:XString-class]{XString}} of 
89: #' \code{\link[=SequenceData-class]{SequenceData}} object.
91: #' \code{\link[Rsamtools:BamFile-class]{BamFileList}}: Either \code{control}
96: #' \code{\link[Rsamtools:BamFile-class]{BamFileList}}
97: #' @slot seqinfo a \code{\link[GenomeInfoDb:Seqinfo-class]{Seqinfo}} describing
118: #' @rdname SequenceDataFrame-class
120: setClass(Class = "SequenceDataFrame",
136:           function(x) gsub("DataFrame","Data",class(x))
171:           definition = function(x){gsub("SequenceDataFrame","",class(x))})
257: #' @rdname SequenceDataFrame-class
281:                       as(a, .get_first_class_extends(a))
302:     .SequenceDataFrame(class = gsub("SequenceDataFrame","",className),
314: #' @rdname SequenceDataFrame-class
327:     ## NOTE: matrix-style subsetting by logical matrix not supported.
382: # class names must be compatible with this class name generation function
387:     stop("Class '",ans,"' not found: ",tmp)
392: .SequenceDataFrame <- function(class, df, ranges, sequence, replicate,
418:     stop("Invalid data object: ", class(df), " found, DataFrame expected.")
426:     stop("Invalid data object: ", class(ranges), " found, GRanges expected.")
429:     stop("Invalid data object: ", class(sequence), " found, XString expected.")
431:   new(paste0(class,"SequenceDataFrame"),
461: #' @rdname SequenceDataFrame-class
463: setClass(Class = "SequenceDFrame",
479:       return(do.call(class(x),list()))
487:     cl <- class(x)
12: #' \code{SequenceDataFrame} classes share functionality. Have a look at the 
135: setMethod("relistToClass", "SequenceDataFrame",
268:     if(length(unique(classes)) != 1L){
348:                       as(x,classDG)[, j2, drop = FALSE],
363:       x <- extractROWS(as(x,classDG), i)
385:   tmp <- try(getClass(ans))
468: #' @importClassesFrom IRanges PartitioningByEnd
Rdisop:src/imslib/src/ims/calib/matchmatrix.h: [ ]
43: 	row_t *matrix;
23: class InvalidMatchMatrix : public Exception {
25: 		explicit InvalidMatchMatrix() : Exception() { }
26: 		explicit InvalidMatchMatrix(const std::string& msg) : Exception(msg) { }
33: class MatchMatrix {
2: #define IMS_MATCHMATRIX_H
17: class IndexOutOfBounds : public Exception {
30: /** Represents a matrix which contains entries either 0 or 1 and has a staircase property.
35: 	// The matrix is a staircase matrix, so we only store the start and the end
1: #ifndef IMS_MATCHMATRIX_H
46: 	/** Construct MatchMatrix with specified number of rows.
49: 	explicit MatchMatrix(std::size_t rows);
50: 	~MatchMatrix();
53: 	void set(std::size_t row, std::size_t column) /*throw (IndexOutOfBounds, InvalidMatchMatrix)*/;
55: 	void unset(std::size_t row, std::size_t column) /*throw (IndexOutOfBounds, InvalidMatchMatrix)*/;
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
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)))
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),
spatialHeatmap:inst/extdata/shinyApp/R/server.R: [ ]
205:       tags$div(class='tp', span(class='tpt', 'Ensure "columns in the data matrix corresponds with "rows" in the targets file respectively.'),
84:       id <- cfg$lis.par$data.matrix['selected.id', 'default']
203:       fileInput(ns("geneInpath"), "2A: upload formatted data matrix", accept=c(".txt", ".csv"), multiple=FALSE), '',
207:       tags$div(class='tp', span(class='tpt', 'Ensure "rows" in the data matrix corresponds with "rows" in the row metadata file respectively.'),
224:       tags$div(class='tp', span(class='tpt', 'The data is matched with a single aSVG file.'),
226:       tags$div(class='tp', span(class='tpt', 'The data is matched with multiple aSVG files (e.g. developmental stages).'),
341:         par.na <- c("max.upload.size", "default.dataset", "col.row.gene", "separator", "data.matrix", "shm.img", "shm.anm", "shm.video", "legend", "mhm", "network")
483:       incProgress(0.5, detail="loading matrix, please wait ...")
507:       incProgress(0.25, detail="importing matrix, please wait ...")
515:         if (nrow(df.tar) != ncol(df.rep)) showModal(modal(msg = 'Ensure "columns" in the data matrix corresponds with "rows" in the targets file respectively!'))
516:         validate(need(try(nrow(df.tar) == ncol(df.rep)), 'Ensure "columns" in the data matrix corresponds with "rows" in the targets file respectively!'))
524:       if (nrow(df.met) != nrow(df.rep)) showModal(modal(msg = 'Ensure "rows" in the data matrix corresponds with "rows" in the row metadata file respectively!'))
525:       validate(need(try(nrow(df.met) == nrow(df.rep)), 'Ensure "rows" in the data matrix corresponds with "rows" in the row metadata file respectively!'))
643:     if (sch$sch=='') sel <- as.numeric(cfg$lis.par$data.matrix['row.selected', 'default']) else {
647:       if (length(sel)==0) sel <- as.numeric(cfg$lis.par$data.matrix['row.selected', 'default'])
677:       se <- SummarizedExperiment(assays=list(expr=as.matrix(df2fil)), rowData=df.met)
694:     cat('Preparing data matrix ... \n')
697:     if (length(rows)==1 & rows[1]==as.numeric(cfg$lis.par$data.matrix['row.selected', 'default'])) rows <- seq_len(nrow(df.aggr.tran))
709:     if (!is.null(df.aggr.thr)) df.aggr.thr <- as.data.frame(as.matrix(df.aggr.thr))
711:     cat('Done! \n'); return(list(df.aggr = as.data.frame(as.matrix(df.aggr)), df.aggr.tran = as.data.frame(as.matrix(df.aggr.tran)), df.aggr.tran.order = as.data.frame(as.matrix(df.aggr.tran.order)), df.aggr.thr = df.aggr.thr, df.met=df.met, df.rep = as.data.frame(as.matrix(df.rep)), con.na=gene.lis$con.na))
715:     cat('Preparing data matrix ... \n')
719:       incProgress(0.5, detail="Preparing data matrix, please wait ...")
749:     cat('Preparing selected data matrix ... \n')
764:    class='cell-border strip hover') %>% formatStyle(0, backgroundColor="orange", cursor='pointer') %>% 
770:     cat('Preparing complete data matrix ... \n')
783:    class='cell-border strip hover') %>% formatStyle(0, backgroundColor="orange", cursor='pointer') %>% 
789:     cat('Preparing complete data matrix ... \n')
796:    class='cell-border strip hover') %>% formatStyle(0, backgroundColor="orange", cursor='pointer') %>% 
808: ...(32 bytes skipped)...nputId='log', label='Log/exp transform', selected=ifelse(url.val!='null', url.val, cfg$lis.par$data.matrix['log.exp', 'default']), )
810: ...(20 bytes skipped)...t(session, 'scaleDat', label='Scale by', selected=ifelse(url.val!='null', url.val, cfg$lis.par$data.matrix['scale', 'default']))
816: ...(45 bytes skipped)...label="Threshold (A) to exceed", value=ifelse(url.val!='null', url.val, as.numeric(cfg$lis.par$data.matrix['A', 'default']))) 
818: ...(64 bytes skipped)...P) of samples with values >= A", value=ifelse(url.val!='null', url.val, as.numeric(cfg$lis.par$data.matrix['P', 'default'])), min=0, max=1)
820: ...(58 bytes skipped)...coefficient of variation (CV1)", value=ifelse(url.val!='null', url.val, as.numeric(cfg$lis.par$data.matrix['CV1', 'default'])))
822: ...(58 bytes skipped)...coefficient of variation (CV2)", value=ifelse(url.val!='null', url.val, as.numeric(cfg$lis.par$data.matrix['CV2', 'default']))) 
904:     if (tab.mhm$val=='yes' & input$mhm.but==0) showModal(modal(msg=HTML('To see the latest matrix heatmap, always click the button <strong>"Click to show/update"</strong>!'), easyClose=TRUE))
913:   # Calculate whole correlation or distance matrix.
915:     cat('Correlation/distance matrix ... \n')
923:     withProgress(message="Compute similarity/distance matrix: ", value = 0, {
931:       } else if (input$measure=='Distance') { cat('Done! \n'); return(-as.matrix(dist(x=gene))) }
934:   # Subset nearest neighbours for target genes based on correlation or distance matrix.
954:     # Validate filtering parameters in matrix heatmap. 
971:       validate(need(try(ncol(gene)>4), 'The "sample__condition" variables in the Data Matrix are less than 5, so no coexpression analysis is applied!'))
986:   # Plot matrix heatmap.
988:     cat('Initial matrix heatmap ... \n')
990:     #if (is.null(input$mhm.but)) return() # Matrix heatmap sections is removed.
1000:     withProgress(message="Matrix heatmap:", value=0, {
1004:       hm <- matrix_hm(ID=gen.tar, data=sub.mat, col=c('yellow', 'red'), scale=scale.hm, main='Target Genes and Their N...(48 bytes skipped)...
1009:     cat('Matrix heatmap ... \n')
1014:     withProgress(message="Matrix heatmap:", value=0, {
1018:       matrix_hm(ID=gen.tar, data=submat(), scale=scale.hm, main='Target Genes and Their Nearest Neighbours', tit...(25 bytes skipped)...
1027:     withProgress(message="Matrix heatmap:", value=0, {
1041: ...(107 bytes skipped)...sary computing of 'adj', since 'input$gen.sel' is a cerain true gene id of an irrelevant expression matrix, not 'None', when switching from one defaul example's matrix heatmap to another example.
1044:       cat('Initial adjacency matrix and modules ...\n')
1052:         incProgress(0.3, detail="adjacency matrix ...")
1053:         incProgress(0.5, detail="topological overlap matrix ...")
1072: ...(107 bytes skipped)...sary computing of 'adj', since 'input$gen.sel' is a cerain true gene id of an irrelevant expression matrix, not 'None', when switching from one defaul example's matrix heatmap to another example.
1079:       incProgress(0.3, detail="adjacency matrix ...")
1080:       incProgress(0.5, detail="topological overlap matrix ...")
1145:     if (is.null(input$gen.sel)) return() # Matrix heatmap section is removed.
1154: ...(70 bytes skipped)...sary computing of 'adj', since 'input$gen.sel' is a cerain true gene id of an irrelevant expression matrix, not 'None', when switching from one defaul example's network to another example.
1241: ...(96 bytes skipped)...sary computing of 'adj', since 'input$gen.sel' is a cerain true gene id of an irrelevant expression matrix, not 'None', when switching from one defaul example's network to another example.
1272: ...(96 bytes skipped)...sary computing of 'adj', since 'input$gen.sel' is a cerain true gene id of an irrelevant expression matrix, not 'None', when switching from one defaul example's network to another example.
1398:       span(class = "panel panel-default", style = 'margin-left:0px',
1399:         div(class = "panel-heading", strong("Features in aSVG")),
1400:         div(class = "panel-body", id = ns("ftSVG"), ft2tag(sf.all))
1402:       div(class = "panel panel-default",
1403:         div(class = "panel-heading", strong("Features in data")),
1461: ...(165 bytes skipped)...In" is changed, and the downstream is not updated either. The shoot/root examples use the same data matrix, so the "gID$all" is the same (pre-selected 3rd row) when change from the default "shoot" to others...(259 bytes skipped)...
1946:      # print(list(ID, is.null(svg.df()), is.null(geneIn()), ids$sel, color$col[1], class(color$col[1])))
2317:     # Avoid: if one column has all NAs in the layout matrix, the aspect ratio is distroyed. So only take the columns not containing all NAs.
2362:       cs.arr <- arrangeGrob(grobs=list(grobTree(cs.grob)), layout_matrix=cbind(1), widths=unit(1, "npc"))
2370:     # In 'arrangeGrob', if numbers in 'layout_matrix' are more than items in 'grobs', there is no difference. The width/height of each subplot is decide...(28 bytes skipped)...
2374:       lgd.arr <- arrangeGrob(grobs=lgd.tr, layout_matrix=matrix(seq_along(lgd.lis), ncol=1), widths=unit(0.99, "npc"), heights=unit(rep(w.lgd + (0.99 - w.lgd) * lg...(33 bytes skipped)...
2679:   # addPopover(session, "genCon", title="Data column: by the column order in data matrix.", placement="bottom", trigger='hover')
2753:   cat('Presenting data matrix (DEG) ... \n')
2757:   geneIn <- dat.deg.mod.lis$geneIn # Take filted matrix with replicates. 
2763:     df.rep <- as.matrix(gen.lis[['df.rep']])
2765:     if (!int) showModal(modal(msg = strong('Only count matrix is accepted!'))); validate(need(int, ''))
2767:     if (!rows) showModal(modal(msg = strong('Make sure count matrix includes at least 50 genes!'))); validate(need(rows, ''))
2866:     d.tab <- datatable(vs, selection='none', extensions='Scroller', plugins = "ellipsis", class='cell-border strip hover', options = list(dom = 't', scrollX = TRUE)); cat('Done! \n')
3009:     g <- deg_ovl(degLis, type='up', plot='matrix'); cat('Done! \n'); g
3016:     g <- deg_ovl(degLis, type='down', plot='matrix'); cat('Done! \n'); g
3028:     # venn_inter returns matrix, since matrix accepts duplicate row names while data frame not. Some genes might be up in one method while down i...(61 bytes skipped)...
3053:       class='cell-border strip hover') %>% formatStyle(0, backgroundColor="orange", cursor='pointer'); cat('Don...(7 bytes skipped)...
3164:       class='cell-border strip hover') %>% formatStyle(0, backgroundColor="white", cursor='pointer')
3334:       class='cell-border strip hover') %>% formatStyle(0, backgroundColor="white", cursor='pointer')
3363: ...(176 bytes skipped)...TRUE, search=list(regex=TRUE, smart=FALSE, caseInsensitive=TRUE), searching=TRUE, columnDefs=NULL), class='cell-border strip hover') %>% formatStyle(0, backgroundColor="white", cursor='pointer') 
3423:     library(Matrix)
3475:       dat <- as.matrix(assay(cell))
3480:       dat <- cbind(as.matrix(blk), as.matrix(cell))
3487:       datatable(as.matrix(dat[seq_len(r.idx), seq_len(c.idx)]), selection='none', escape=FALSE, filter="top", extensions=c('S...(48 bytes skipped)...
3525:     }) # colSums(as.matrix(qc))
3430:       if ('logcounts' %in% assay.na) logcounts(sce.upl) <- as(logcounts(sce.upl), 'dgCMatrix')
3431:       if ('count' %in% assay.na) assays(sce.upl)$count <- as(assays(sce.upl)$count, 'dgCMatrix') 
3432:       if ('counts' %in% assay.na) assays(sce.upl)$count <- as(assays(sce.upl)$counts, 'dgCMatrix') 
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.")
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))
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,
SpatialCPie:R/SpatialCPie.R: [ ]
825:                 shiny::div(class = "array", "data-resolution" = r,
110:                 ## Zero-pad overlap matrix so that all labels are represented in
217: #' @param clusterMeans matrix of size `(n, K)` representing the `n` feature
248: #' @param counts count matrix. `rownames` should correspond to genes and
250: #' @param margin which margin of the count matrix to cluster. Valid values are
255: #' (m, n) feature matrix -> m-length vector (cluster assignment of each data
311:                     log(as.matrix(counts) + 1) %>%
934: #' @param counts gene count matrix or a
935: #' \code{\link[SummarizedExperiment]{SummarizedExperiment-class}} object
955: #'     coordinates <- as.matrix(expand.grid(1:10, 1:10))
966: #'     counts <- matrix(rpois(prod(dim(means)), means), nrow = nrow(profiles))
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()
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")),
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
GSCA:inst/shiny/server.R: [ ]
1537:                   tags$div(class="row-fluid",
28: onesampleslidervalue <- matrix(0,nrow=5,ncol=3)
29: threesampleslidervalue <- matrix(0,nrow=5,ncol=3)
66:                         div(class = "busy",  
77:                                    div(class = "busy",  
405:                         Maindata$uploadgeneexpr <- as.matrix(read.table(input$Summaryuploadgeneexprfile$datapath,stringsAsFactors=F,blank.lines.skip=TRUE,row.na...(7 bytes skipped)...
410:                   if (is.matrix(geneid)) {
477:                               if (is.matrix(geneid)) {
676:                   SCORE <- matrix(0, nrow=length(ttT), ncol=4)
683:                         tmpmat <- matrix(c(r1c1,r2c1,r1c2,r2c2),ncol=2)
709:                               scoremat <- matrix(0,nrow=Maindata$dim,ncol=nrow(Maindata$tab))
718:                                           if (is.matrix(geneid)) {
812:                   cutoffval <- matrix(0,Maindata$dim,2)
1297:                                     if (is.matrix(tmpcord) && nrow(tmpcord) > 1) {
1316:                   if (is.matrix(polycord) && nrow(polycord) != 0) {
1320:                               if (is.matrix(tmpcord) && nrow(tmpcord) > 1) {
1366:                               if (is.matrix(tmpcord) && nrow(tmpcord) > 2) {
1538:                            tags$div(class="span11",plotOutput("GSCAinteractiveplotthreeheatmapzoominplot1")),
1539:                            tags$div(class="span1",plotOutput("GSCAinteractiveplotthreeheatmapzoominplotlab"))
1542:                   tags$div(class="row-fluid",
1543:                            tags$div(class="span5",plotOutput("GSCAinteractiveplotthreeheatmapzoominplot1")),
1544:                            tags$div(class="span5",plotOutput("GSCAinteractiveplotthreeheatmapzoominplot2")),
1545:                            tags$div(class="span1",plotOutput("GSCAinteractiveplotthreeheatmapzoominplotlab"))
1548:                   tags$div(class="row-fluid",
1549:                            tags$div(class="span3",plotOutput("GSCAinteractiveplotthreeheatmapzoominplot1")),
1550:                            tags$div(class="span3",plotOutput("GSCAinteractiveplotthreeheatmapzoominplot2")),
1551:                            tags$div(class="span3",plotOutput("GSCAinteractiveplotthreeheatmapzoominplot3")),
1552:                            tags$div(class="span1",plotOutput("GSCAinteractiveplotthreeheatmapzoominplotlab"))
1555:                   tags$div(class="row-fluid",
1556:                            tags$div(class="span2",plotOutput("GSCAinteractiveplotthreeheatmapzoominplot1")),
1557:                            tags$div(class="span2",plotOutput("GSCAinteractiveplotthreeheatmapzoominplot2")),
1558:                            tags$div(class="span2",plotOutput("GSCAinteractiveplotthreeheatmapzoominplot3")),
1559:                            tags$div(class="span2",plotOutput("GSCAinteractiveplotthreeheatmapzoominplot4")),
1560:                            tags$div(class="span1",plotOutput("GSCAinteractiveplotthreeheatmapzoominplotlab"))
1563:                   tags$div(class="row-fluid",
1564:                            tags$div(class="span2",plotOutput("GSCAinteractiveplotthreeheatmapzoominplot1")),
1565:                            tags$div(class="span2",plotOutput("GSCAinteractiveplotthreeheatmapzoominplot2")),
1566:                            tags$div(class="span2",plotOutput("GSCAinteractiveplotthreeheatmapzoominplot3")),
1567:                            tags$div(class="span2",plotOutput("GSCAinteractiveplotthreeheatmapzoominplot4")),
1568:                            tags$div(class="span2",plotOutput("GSCAinteractiveplotthreeheatmapzoominplot5")),
1569:                            tags$div(class="span1",plotOutput("GSCAinteractiveplotthreeheatmapzoominplotlab"))
1936:                                           polycord <<- as.matrix(tmp)
2236:                               if (is.matrix(tmpcord)) {
72:                   conditionalPanel(condition="$('html').hasClass('shiny-busy')",
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,
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,
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, ...))
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)...
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(
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))
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}
BioNERO:R/gcn_inference.R: [ ]
450:         Matrix = modtraitcor, yLabels = yLabels, xLabels = xLabels,
1039:                 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
1005:     cor_matrix <- net$correlation_matrix
428:     textMatrix <- paste(signif(modtraitcor, 2), modtraitsymbol, sep = "")
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)
228:     kwithin <- WGCNA::intramodularConnectivity(adj_matrix, new.module_colors)
231:         adjacency_matrix = adj_matrix,
235:         correlation_matrix = cor_matrix,
320:     expr <- as.matrix(t(norm.exp))
337:     # Define a matrix of labels for the original and all resampling runs
338:     labels <- matrix(0, nGenes, nRuns + 1)
381: #' @param cex.text Font size for numbers inside matrix. Default: 0.6.
416:     modtraitcor <- cor(as.matrix(MEs), trait, use = "p", method = cor_method)
482: #'   \item{filtered_corandp}{Filtered matrix of correlation and p-values}
483: #'   \item{raw_GS}{Raw matrix of gene significances}
512:     GS <- cor(as.matrix(t(final_exp)), trait, use = "p")
534:         as.matrix(GS), border_color = NA, color = cols,
641:         fmat <- matrix(
776:             # Create a data frame containing annotations and the annotation class
786:             # Add column containing the annotation class
914:     edges <- net$correlation_matrix
937: #' Get edge list from an adjacency matrix for a group of genes
959: #' the correlation matrix was calculated. Only required
968: #' edge lists by filtering the original correlation matrix by the thresholds
1004:     # Define objects containing correlation matrix and data frame of genes and modules
1011:         cor_matrix <- cor_matrix[keep, keep]
1016:         cor_matrix <- cor_matrix[genes, genes]
1019:     # Should we filter the matrix?
1021:         # Create edge list from correlation matrix
1022:         edges <- cormat_to_edgelist(cor_matrix)
1035:             list_mat <- replicate(length(cutoff), cor_matrix, simplify = FALSE)
1040:                 matrix[matrix < cutoff[x] ] <- NA
1041:                 diag(matrix) <- 0
1044:                 degree <- rowSums(matrix, na.rm=TRUE)
1047:                 matrix[lower.tri(matrix, diag=TRUE)] <- NA
1049:                 # Convert symmetrical matrix to edge list (Gene1, Gene2, Weight)
1050:                 matrix <- na.omit(data.frame(as.table(matrix)))
1051:                 result <- list(matrix = matrix, degree = degree)
1080:                 stop("Please, specify the number of samples used to calculate the correlation matrix")
1101:         # Create edge list from correlation matrix without filtering
1102:         edgelist <- cormat_to_edgelist(cor_matrix)
429:     dim(textMatrix) <- dim(modtraitcor)
433:         textMatrix <- t(textMatrix)
452:         colors = cols, textMatrix = textMatrix, setStdMargins = FALSE,
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,
ClassifyR:R/utilities.R: [ ]
610:   class <- factor(object$groups[min_scores], levels = object$groups)
354:     classTable <- subset(PRtable, class == aClass)
508: .classifierKeywordToParams <- function(keyword)
460: .rebalanceTrainingClasses <- function(measurementsTrain, classesTrain, balancing)
462:   samplesPerClassTrain <- table(classesTrain)
12:       # Create maximally-balanced folds, so class balance is about the same in all.
17:       # Dummy encoding for when outcome is not a class.
21:         # Permute the indexes of samples in the class.
42:     # Take the same percentage of samples from each class to be in training set.
147:       # Creates a matrix. Columns are top n features, rows are varieties (one row if None).
171:           # Classifiers will use a column "class" and survival models will use a column "risk".
172:           if(class(predictions) == "data.frame")
173:            predictedOutcome <- predictions[, na.omit(match(c("class", "risk"), colnames(predictions)))]
225:           if(class(predictions) == "data.frame")
226:             predictedOutcome <- predictions[, "class"]
279:         if(class(predictions) == "data.frame")
280:           predictedOutcome <- predictions[, colnames(predictions) %in% c("class", "risk")]
348: # PRtable is a data frame with columns FPR, TPR and class.
349: # distinctClasses is a vector of all of the class names.
378:   else if("Pairs" %in% class(importantFeatures[[1]]))
438:   lapply(1:length(densities), function(densityIndex) # All crossing points with other class densities.
458: # Samples in the training set are upsampled or downsampled so that the class imbalance is
550:     stop("There must be at least 2 observations in each class.")
553:   # By default, we estimate the 'a priori' probabilities of class membership with
559:   # For each class, we calculate the MLEs (or specified alternative estimators)
561:   # estimators for each class.
577:   class(obj) <- "dlda"
583:     stop("object not of class 'dlda'")
586:     newdata <- as.matrix(newdata)
590:     sapply(object$est, function(class_est) {
591:       with(class_est, sum((obs - xbar)^2 / object$var_pool) + log(prior))
612:   list(class = class, scores = scores, posterior = posterior)
617:     x <- matrix(x, nrow = 1)
619:   x <- as.matrix(x)
634:     posterior <- matrix(posterior, nrow = 1) # Ensure it's always matrix, like just below.
52:       testSet <- setdiff(1:length(classes), trainSet)
118:   betterValues <- .ClassifyRenvir[["performanceInfoTable"]][.ClassifyRenvir[["performanceInfoTable"]][, "type"] == performanceType, "better"]
162:         # Do either resubstitution classification or nested-CV classification and calculate the resulting performance metric.
295:     betterValues <- .ClassifyRenvir[["performanceInfoTable"]][.ClassifyRenvir[["performanceInfoTable"]][, "type"] == performanceType, "better"]
303:     if (!"previousTrained" %in% attr(modellingParams@trainParams@classifier, "name")) 
304:     # Don't name these first two variables. Some classifier functions might use classesTrain and others use outcomeTrain.
306:   else # Don't pass the measurements and classes, because a pre-existing classifier is used.
314:   trained <- do.call(modellingParams@trainParams@classifier, paramList)
352:   do.call(rbind, lapply(distinctClasses, function(aClass)
356:     for(index in 2:nrow(classTable))
358:       # Some samples had identical predictions but belong to different classes.
359:       if(classTable[index, "FPR"] != classTable[index - 1, "FPR"] && classTable[index, "TPR"] != classTable[index - 1, "TPR"])
361:         newArea <- (classTable[index, "FPR"] - classTable[index - 1, "FPR"]) * classTable[index - 1, "TPR"] + # Rectangle part
362:          0.5 * (classTable[index, "FPR"] - classTable[index - 1, "FPR"]) * (classTable[index, "TPR"] - classTable[index - 1, "TPR"]) # Triangle part on top.
364:         newArea <- (classTable[index, "FPR"] - classTable[index - 1, "FPR"]) * classTable[index, "TPR"]
368:     data.frame(classTable, AUC = round(areaSum, 2), check.names = FALSE)
432: # Used by the mixtures of normals and naive Bayes classifiers.
465:   trainBalanced <- unlist(mapply(function(classSize, className)
467:     if(balancing == "downsample" && classSize > downsampleTo)
468:       sample(which(classesTrain == className), downsampleTo)
469:     else if(balancing == "upsample" && classSize < upsampleTo)
470:       sample(which(classesTrain == className), upsampleTo, replace = TRUE)
472:       which(classesTrain == className)
475:   classesTrain <- classesTrain[trainBalanced]
477:   list(measurementsTrain = measurementsTrain, classesTrain = classesTrain)
540:       stop("The number of 'prior' probabilities must match the number of classes in 'y'.")
560:   # for each parameter used in the DLDA classifier. The 'est' list contains the
570:   # Calculates the pooled variance across all classes.
350: .calcArea <- function(PRtable, distinctClasses)
463:   downsampleTo <- min(samplesPerClassTrain)
464:   upsampleTo <- max(samplesPerClassTrain)
473:   }, samplesPerClassTrain, names(samplesPerClassTrain), SIMPLIFY = FALSE))
GRaNIE:R/core.R: [ ]
4882:                     d = tibble::add_row(d, r_positive = r_pos, class = classCur, peak_gene.p.raw.class = pclassCur, n = 0)
679:                   GC_class = cut(.data$`G|C`, breaks = seq(0,1,0.1), include.lowest = TRUE, ordered_result = TRUE))
696:                    peak.GC.class   = .data$GC_class)
1321:   matrix1.norm.TFs.df = dplyr::filter(matrix1, .data$ENSEMBL %in% HOCOMOCO_mapping$TF.ENSEMBL, rowSums != 0)
4343:             classPeaks = class(GRN@data$peaks$counts_orig)
4365:             classRNA = class(GRN@data$RNA$counts_orig)
4877:         for (classCur in networkType_details){
4930:                                classAll = c(as.character(d2$class), d3$r_positive),
2439:       GC_class.cur = GC_classes_foreground.df$GC_class[i]
4959:                       peak_gene.p.raw.class.bin = as.numeric(.data$peak_gene.p.raw.class)) %>%
681:   GC_classes.df = GC_content.df %>%
1190:     TFBS_bindingMatrix.df = tibble::as_tibble(res.l)
1702: AR_classification_wrapper<- function (GRN, significanceThreshold_Wilcoxon = 0.05, 
2132:         GC_classes_foreground.df = peaksForeground %>%
2140:         GC_classes_background.df = peaksBackground %>%
2188:         GC_classes_all.df = dplyr::full_join(GC_classes_foreground.df, GC_classes_background.df, suffix = c(".fg",".bg"), by = "GC_class") %>%
4970: .classFreq_label <- function(tbl_freq) {
4878:             for (pclassCur in levels(peakGeneCorrelations.all.cur$peak_gene.p.raw.class)) {
3: #' Create and initialize a \code{\linkS4class{GRN}} object.
24: #' @return Empty \code{\linkS4class{GRN}} object
128: #' Add data to a \code{\linkS4class{GRN}} object.
130: #' This function adds both RNA and peak data to a \code{\linkS4class{GRN}} object, along with data normalization.
157: #' @return An updated \code{\linkS4class{GRN}} object, with added data from this function (e.g., slots \code{GRN@data$peaks} and \code{GRN@d...(9 bytes skipped)...
327: ...(20 bytes skipped)...peaks data efficiently as DESeq object only if it contains only integers, otherwise store as normal matrix
335:       # Store as sparse matrix if enough 0s
340:           futile.logger::flog.info(paste0("Storing GRN@data$peaks$counts_orig matrix as sparse matrix because fraction of 0s is > 0.1 (", fractionZero, ")"))
341:           GRN@data$peaks$counts_orig = .asSparseMatrix(as.matrix(counts_peaks %>% dplyr::select(-.data$peakID)), 
345:           GRN@data$peaks$counts_orig = as.matrix(counts_peaks[, GRN@config$sharedSamples])
358:       # Store as sparse matrix if enough 0s
363:           futile.logger::flog.info(paste0("Storing GRN@data$RNA$counts_orig matrix as sparse matrix because fraction of 0s is > 0.1 (", fractionZero, ")"))
364:           GRN@data$RNA$counts_orig = .asSparseMatrix(as.matrix(counts_rna %>% dplyr::select(-.data$ENSEMBL)), 
368:           GRN@data$RNA$counts_orig = as.matrix(counts_rna[, GRN@config$sharedSamples])
540:   countsPeaks.m = as.matrix(dplyr::select(countsPeaks.clean, -.data$peakID))
628:   countsRNA.m = as.matrix(dplyr::select(countsRNA.clean, -.data$ENSEMBL))
682:     dplyr::group_by(.data$GC_class) %>%
685:     tidyr::complete(.data$GC_class, fill = list(n = 0)) %>%
689:   #ggplot2::ggplot(GC_content.df, ggplot2::aes(GC.class)) + geom_histogram(stat = "count") + ggplot2::theme_bw()
691:   #ggplot2::ggplot(GC_classes.df , ggplot2::aes(GC.class, n_rel)) + geom_bar(stat = "identity") + ggplot2::theme_bw()
706: #' Filter RNA-seq and/or peak data from a \code{\linkS4class{GRN}} object
709: ...(130 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)...
726: #' @return An updated \code{\linkS4class{GRN}} object, with added data from this function.
997: #' Add TFBS to a \code{\linkS4class{GRN}} object
1006: #' @return An updated \code{\linkS4class{GRN}} object, with additional information added from this function (\code{GRN@annotation$TFs} in pa...(9 bytes skipped)...
1125: #' Overlap peaks and TFBS for a \code{\linkS4class{GRN}} object
1130: #' @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)...
1203:     # Collect binary 0/1 binding matrix from all TF and concatenate
1210:     GRN@data$TFs$TF_peak_overlap = .asSparseMatrix(as.matrix(GRN@data$TFs$TF_peak_overlap), 
1308: .correlateMatrices <- function(matrix1, matrix_peaks, HOCOMOCO_mapping, corMethod = "pearson", whitespacePrefix = " ") {
1318:   rowSums = rowSums(dplyr::select(matrix1, -.data$ENSEMBL))
1323:   nFiltered1 = dplyr::filter(matrix1, ! .data$ENSEMBL %in% HOCOMOCO_mapping$TF.ENSEMBL) %>% nrow()
1324:   nFiltered2 = dplyr::filter(matrix1, rowSums == 0) %>% nrow()
1326:   diff = nrow(matrix1) - nrow(matrix1.norm.TFs.df)
1328:     message = paste0(whitespacePrefix, "Retain ", nrow(matrix1.norm.TFs.df), " unique genes from TF/gene data out of ", nrow(matrix1), 
1334:   if (nrow(matrix1.norm.TFs.df) == 0) {
1339:   HOCOMOCO_mapping.exp = dplyr::filter(HOCOMOCO_mapping, .data$TF.ENSEMBL %in% matrix1.norm.TFs.df$ENSEMBL)
1340:   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."))
1343:   # matrix1:  rows: all TF genes, columns: all samples
1344:   # matrix_peaks: rows: peak IDs, columns: samples
1350:   cor.m = suppressWarnings(t(cor(t(dplyr::select(matrix1.norm.TFs.df, -.data$ENSEMBL)), t(dplyr::select(matrix_peaks, -.data$peakID)), method = corMethod)))
1352:   colnames(cor.m) = matrix1.norm.TFs.df$ENSEMBL
1353:   rownames(cor.m) = matrix_peaks$peakID
1404: #' @return An updated \code{\linkS4class{GRN}} object, with added data from this function
1426:     # Input: Raw peak counts per TF and TF-binding matrix
1441:     TF.activity.m = matrix(NA, nrow = length(allTF), ncol = length(GRN@config$sharedSamples), 
1451:       # Filter count matrix to those peaks with TFBS
1538:     # We now provide gene-specific normalization factors for each sample as a matrix, which will preempt sizeFactors
1573: #' @return An updated \code{\linkS4class{GRN}} object, with added data from this function.  
1663:     # Therefore, use TF names as row names, same as with the TF Activity matrix