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"),

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

20:         class <- "CollapsedVCF"

522: .showVCFSubclass <- function(object)

466: SnpMatrixToVCF <- function(from, seqSource)

2: ### VCF class methods 

29:         class <- "ExpandedVCF"

39:     new(class, SummarizedExperiment(assays=geno, rowRanges=rowRanges,

248: setReplaceMethod("geno", c("VCF", "character", "matrix"),

256: setReplaceMethod("geno", c("VCF", "numeric", "matrix"),

264: setReplaceMethod("geno", c("VCF", "missing", "matrix"),

403:     if (!.compare(lapply(args, class)))

404:         stop("'...' objects must be of the same VCF class")

441:     if (!.compare(lapply(args, class)))

442:         stop("'...' objects must be of the same VCF class")

501:     GT <- matrix(GT, byrow=TRUE, ncol=nrowGT)

565:     cat("class:", classNameForDisplay(object), "\n")

545:         cat(margin, classNameForDisplay(x), " with ",

553:         cat(margin, classNameForDisplay(x), " with ",

561:         cat(margin, classNameForDisplay(x), " of length ", lo, 

213:     matrix <- grep("matrix.mtx", names(fdata), fixed = TRUE, value = TRUE)

40:         validClasses <- vapply(object, function(ifile) {

3: #' @description This class was designed to mainly handle tarballs from

8: #'   1. `matrix.mtx.gz` - the counts matrix

24: #' @return A `TENxFileList` class object

28:     Class = "TENxFileList",

46:             "Some files are not of class 'TENxFile'"

66: #'   1. `matrix.mtx.gz` - the counts matrix

89: #'     "extdata", "pbmc_granulocyte_sorted_3k_ff_bc_ex_matrix.tar.gz",

140: #' @describeIn TENxFileList-class Obtain file paths for all files in the object

150: #' @describeIn TENxFileList-class An intermediate method for decompressing

201: #' @describeIn TENxFileList-class Recursively import files within a

216:         mat <- datalist[[matrix]]

26: #' @exportClass TENxFileList

27: .TENxFileList <- setClass(

43:         if (all(validClasses))

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",

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)

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)

7: template<typename T> class Matrix {

12:   Matrix(std::size_t reserved_count) {

2: #define MATRIX_H

1: #ifndef MATRIX_H

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

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))

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))

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")),

877:     class <- class(toplot[,1])

680: Classify <- function(input, thresh = 0.1, return_clas = FALSE) {

695:     classification <- nodeDown(conf = conf, prof = prof, node = 1,

984:     classification <- input$celltype_CHETAH

1143: ClassifyReference <- function(ref_cells, ref_ct = "celltypes",

1277:     classification <- input$celltype_CHETAH

118: CHETAHclassifier <- function (input,

20: #' an expression matrix with one (average) reference expression profile

147:               is(clust_dist(matrix(seq_len(4), nrow = 2)), "dist"),

241:                input = input, # the input expression matrix

242:                ref_cells = ref_cells, ## matrix of all reference cells

243:                ref_types = ref_types, ## types of the ref_cells matrix

244:                ref_profiles =  ref_profiles) ## matrix of the average reference profiles per cell type

432:         ## Add the profile scores and correlations of all types to one matrix

624:     ## as.matrix: in cases were a sparse Matrix is used

626:     cor_i <-   suppressWarnings(cor(as.matrix(SummarizedExperiment::assay(input, Env$input_c)[genes, , drop = FALSE]),

627:                                     as.matrix(ref_profiles[genes, type, drop = FALSE]),

633:         cor_t <- suppressWarnings(cor(as.matrix(SummarizedExperiment::assay(ref_cells, Env$ref_c)[genes , current_cells, drop = FALSE]),

634:                                       as.matrix(ref_profiles[genes, type, drop = FALSE]),

636:         cor_ob <- suppressWarnings(cor(as.matrix(SummarizedExperiment::assay(ref_cells, Env$ref_c)[genes , otherbranch_c, drop = FALSE]),

637:                                        as.matrix(ref_profiles[genes, type, drop = FALSE]),

703: # To make a profile_matrix from a list of reference matrices

880:     if(class == "factor") {

888:     if(class == "numeric" | class == 'integer') {

909: # Plot boxplots grouped by a class variable

910: PlotBox <- function(toplot, class, col = NULL, grad_col = NULL,

914:     class <- data.frame(class, stringsAsFactors = TRUE)

915:     col <- col[levels(class[,1])]

920:     data <- cbind.data.frame(toplot, class)

921:     colnames(data) <- c("score", "class")

924:     plot <- ggplot(data, aes_string(x = 'class', y = 'score')) +

937:         plot <- plot + geom_jitter(aes_string(color = 'class'), size = 0.1)

945:     plot <- plot  + geom_boxplot(aes_string(color = 'class'),

1050: #' @param return return the matrix that was used to produce the plot

1081:     ## Make empty correlation matrix

1082:     cors <- matrix(NA, nrow = ncol(ref_profiles), ncol = ncol(ref_profiles))

1123: #' @param return return the matrix that was used to produce the plot

1154:     ## Make the correlation matrix

1162:     cors <- matrix(NA, nrow = lngt, ncol = lngt+1)

1195:     prof_df <- as.matrix(prof[[node]]) ## approximately 400x faster than on DataFrame

1196:     conf_df <- as.matrix(conf[[node]])

9: #' CHETAH classifies an input dataset by comparing it to

27: #' by \code{\link{Classify}})

60: #' @param plot.tree Plot the classification tree.

74: #'   \item \strong{classification} a named vector: the classified types

76: #'   \item \strong{tree} the hclust object of the classification tree

78: #'   \item \strong{nodecoor} the coordinates of the nodes of the classification tree

93: #' to produce a classification tree (ct).

99: #' If this is not the case, classification for the cell will stop in the current node.

101: #' these classifications are called \strong{final types}

102: #' For other cells, assignment will stop in a node. These classifications

174:         message("Running without reference cells: classification will only be based on correlations \n")

212:     ## Make an environment to store the classification information and variables in

221:                       tree = NULL, # will be filled with the classification tree

246:     ## For plotting purposes, find the x coordinates of the nodes of the classification tree

294:     ## Add the (visible) classification meta-data

295:     input <- Classify(input = input, thresh = thresh)

303: # of the current node of the classification tree,

312:     ## (Re)construct the classification tree and cut at the highest node

653: #' (Re)classify after running \code{\link{CHETAHclassifier}} using a confidence threshold \cr

659: #' Selecting 0 will classify all cells, whereas 2 will result i

660: #' n (almost) no cells to be classified. \cr

662: #' @param return_clas Instead of returning the SingleCellExperiment, only return the classification vector

669: #' ## Classify all cells

670: #' input_mel <- Classify(input_mel, 0)

672: #' ## Classify only cells with a very high confidence

673: #' input_mel <- Classify(input_mel, 1)

676: #' input_mel <- Classify(input_mel)

678: #' ## Return only the classification vector

679: #' celltypes <- Classify(input_mel, 1, return_clas = TRUE)

697:     names(classification) <- rownames(prof[[1]])

698:     input$celltype_CHETAH <- classification

699:     if (return_clas) return(classification) else return(input)

728: #' Plots the chetah classification tree with nodes numbered

739: #' A ggplot object of the classification tree

806:         ggtitle("Classification Tree")

871:         theme_classic() +

926:         theme_classic() +

951: #' Plot the CHETAH classification on 2D visulization like t-SNE

952: #' + the corresponding classification tree,

958: #' @param tree plot the tree, along with the classification

959: #' @param pt.size the point-size of the classication plot

961: #' the classification plot should be returned

999:         extra_nodes <- unique(classification)[!(unique(classification) %in% names(meta_data$nodetypes[[1]]))]

1025:     toplot <- classification

1115: #' Use a reference dataset to classify itself.

1128: #' the columns the classifion labels.

1131: #' classified to the type of the column name.

1133: #' that is classified to an intermediate type

1135: #' A good reference would classify nearly 100% of cells of type A to type A.

1142: #' ClassifyReference(ref_cells = headneck_ref)

1146:     ## Classify

1190: } ## ClassifyReference

1194:     ## Do the classification of this node

1253: #' In the CHETAH classification, replace the name of a Node

1262: #' @param return_clas Instead of returning the SingleCellExperiment, only return the classification vector

1265: #' The SingleCellExperiment with the new classification or if `return_clas = TRUE` the classification vector.

1282:         classification[classification == nodename] <- replacement

1295:         classification[classification %in% replace] <- replacement

1296:         input$celltype_CHETAH <- classification

1297:         if (return_clas) return(classification) else return(input)

1304: #' Launch a web page to interactively go trough the classification

117: #' input_mel <- CHETAHclassifier(input = input_mel, ref_cells = headneck_ref)

299:     }     ### CHETAHclassifier

302: # Called by the CHETAHclassifier. Determines the branches

346: # Called by the CHETAHclassifier via SplitNode.

657: #' @param input a SingleCellExperiment on which \code{\link{CHETAHclassifier}} has been run

730: #' @param input a SingleCellExperiment on which \code{\link{CHETAHclassifier}} has been run

820: #' @param input a SingleCellExperiment on which \code{\link{CHETAHclassifier}} has been run

955: #' @param input a SingleCellExperiment on which \code{\link{CHETAHclassifier}} has been run

1045: #' \code{\link{CHETAHclassifier}}'s ref_cells

1047: #' \code{\link{CHETAHclassifier}}'s ref_profiles

1051: #' @param n_genes as in \code{\link{CHETAHclassifier}}

1052: #' @param fix_ngenes as in \code{\link{CHETAHclassifier}}

1053: #' @param print_steps as in \code{\link{CHETAHclassifier}}

1054: #' @param only_pos as in \code{\link{CHETAHclassifier}}

1120: #' \code{\link{CHETAHclassifier}}'s ref_cells

1125: #' \code{\link{CHETAHclassifier}}

1147:     input <- CHETAHclassifier(input = ref_cells,

1256: #' @param input a SingleCellExperiment on which \code{\link{CHETAHclassifier}} has been run

1306: #' @param input a SingleCellExperiment on which \code{\link{CHETAHclassifier}} has been run

1342:         if (is.null(input@int_metadata$CHETAH)) stop('Please run CHETAHclassifier on the SingleCellExperiment object before calling this funtion')

1281:                 matrix <- list_mat[[x]]

150:     cor_matrix <- calculate_cor_adj(cor_method, norm.exp, SFTpower, net_type)$cor

151:     adj_matrix <- calculate_cor_adj(cor_method, norm.exp, SFTpower, net_type)$adj

514:         cor_matrix <- cor(as.matrix(MEs), trait, use = "p", method = cor_method)

689:         cor_matrix <- cor(

1247:     cor_matrix <- net$correlation_matrix

112: #'   \item Adjacency matrix

116: #'   \item Correlation matrix

149:     if(verbose) { message("Calculating adjacency matrix...") }

153:     #Convert to matrix

154:     gene_ids <- rownames(adj_matrix)

155:     adj_matrix <- matrix(adj_matrix, nrow=nrow(adj_matrix))

156:     rownames(adj_matrix) <- gene_ids

157:     colnames(adj_matrix) <- gene_ids

159:     #Calculate TOM from adjacency matrix

160:     if(verbose) { message("Calculating topological overlap matrix (TOM)...") }

162:     TOM <- WGCNA::TOMsimilarity(adj_matrix, TOMType = tomtype)

229:     kwithin <- WGCNA::intramodularConnectivity(adj_matrix, new.module_colors)

232:         adjacency_matrix = adj_matrix,

236:         correlation_matrix = cor_matrix,

342:     ## Heatmap data frame: 3 columns named `col`, `class`, and `value`

350:             class = setname,

358:     nrows <- length(unique(heatmap_df$class))

367:         geom_tile(aes(x = .data$value, y = .data$class, fill = .data$col)) +

411:     expr <- as.matrix(t(norm.exp))

434:     # Create a matrix of labels for the original and all resampling runs

435:     labels <- matrix(0, nGenes, nRuns + 1)

445:     ## Convert matrix to list of vectors

513:         trait <- get_model_matrix(metadata, column_idx = x)

515:         pvalues <- WGCNA::corPvalueStudent(cor_matrix, nSamples = ncol(exp))

519:         cor_long <- reshape2::melt(cor_matrix, value.name = "cor", varnames = v)

561:     # Get a wide matrix of correlations

565:     cormat <- as.matrix(cormat)

568:     # Create a matrix of correlations and P-value symbols to display

569:     ## Get a matrix of P-values and convert values to symbols

573:     pmat <- pval2symbol(as.matrix(pmat))

674:     # Make sure samples in expression matrix and sample metadata match

688:         trait <- get_model_matrix(metadata, column_idx = x)

690:             as.matrix(t(exp)), trait, use = "p", method = cor_method

692:         pvalues <- WGCNA::corPvalueStudent(cor_matrix, nSamples = ncol(exp))

696:         cor_long <- reshape2::melt(cor_matrix, value.name = "cor", varnames = v)

748:     # Get a wide matrix of correlations

752:     cormat <- as.matrix(cormat)

755:     # Create a matrix of correlations and P-value symbols to display

756:     ## Get a matrix of P-values and convert values to symbols

760:     pmat <- pval2symbol(as.matrix(pmat))

1158:     edges <- net$correlation_matrix

1181: #' Get edge list from an adjacency matrix for a group of genes

1203: #' the correlation matrix was calculated. Only required

1212: #' edge lists by filtering the original correlation matrix by the thresholds

1246:     # Define objects containing correlation matrix and data frame of genes and modules

1253:         cor_matrix <- cor_matrix[keep, keep]

1258:         cor_matrix <- cor_matrix[genes, genes]

1261:     # Should we filter the matrix?

1263:         # Create edge list from correlation matrix

1264:         edges <- cormat_to_edgelist(cor_matrix)

1277:             list_mat <- replicate(length(cutoff), cor_matrix, simplify = FALSE)

1282:                 matrix[matrix < cutoff[x] ] <- NA

1283:                 diag(matrix) <- 0

1286:                 degree <- rowSums(matrix, na.rm=TRUE)

1289:                 matrix[lower.tri(matrix, diag=TRUE)] <- NA

1291:                 # Convert symmetrical matrix to edge list (Gene1, Gene2, Weight)

1292:                 matrix <- na.omit(data.frame(as.table(matrix)))

1293:                 result <- list(matrix = matrix, degree = degree)

1322:                 stop("Please, specify the number of samples used to calculate the correlation matrix")

1343:         # Create edge list from correlation matrix without filtering

1344:         edgelist <- cormat_to_edgelist(cor_matrix)

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,

5000:     var chord = {}, chords, groups, matrix, n, padding = 0, sortGroups, sortSubgroups, sortChords;

5001:     chord.matrix = function(x) {

408:     function classedConstant() {

412:     function classedFunction() {

2585:   var d3_arraySubclass = [].__proto__ ? function(array, prototype) {

3640:   d3_selectionPrototype.classed = function(name, value) {

404:   function d3_selection_classedRe(name) {

420:   function d3_selection_classedName(name) {

2:   function d3_class(ctor, properties) {

2595:   d3_class(d3_Map, {

2751:   d3.transpose = function(matrix) {

2752:     return d3.zip.apply(d3, matrix);

3138:       return new d3_transform(t ? t.matrix : d3_transformIdentity);

4382: ...(87 bytes skipped)...electAll(".minor").data(subticks, String), subtickEnter = subtick.enter().insert("line", "g").attr("class", "tick minor").style("opacity", 1e-6), subtickExit = d3.transition(subtick.exit()).style("opacity"...(78 bytes skipped)...

4384: ...(31 bytes skipped)...ge(scale), path = g.selectAll(".domain").data([ 0 ]), pathEnter = path.enter().append("path").attr("class", "domain"), pathUpdate = d3.transition(path);

4387:         tickEnter.append("line").attr("class", "tick");

4511:         bg.enter().append("rect").attr("class", "background").style("visibility", "hidden").style("cursor", "crosshair");

4512:         fg.enter().append("rect").attr("class", "extent").style("cursor", "move");

4513:         tz.enter().append("g").attr("class", function(d) {

4937:           x += matrix[i][j];

4951:             return sortSubgroups(matrix[i][a], matrix[i][b]);

4960:           var di = groupIndex[i], dj = subgroupIndex[di][j], v = matrix[di][dj], a0 = x, a1 = x += v * k;

5002:       if (!arguments.length) return matrix;

5003:       n = (matrix = x) && matrix.length;

367:     d3_arraySubclass(groups, d3_selectionPrototype);

407:   function d3_selection_classed(name, value) {

416:     name = name.trim().split(/\s+/).map(d3_selection_classedName);

418:     return typeof value === "function" ? classedFunction : classedConstant;

421:     var re = d3_selection_classedRe(name);

423:       if (c = node.classList) return value ? c.add(name) : c.remove(name);

424:       var c = node.className, cb = c.baseVal != null, cv = cb ? c.baseVal : c;

429:           if (cb) c.baseVal = cv; else node.className = cv;

433:         if (cb) c.baseVal = cv; else node.className = cv;

516:     d3_arraySubclass(selection, d3_selection_enterPrototype);

520:     d3_arraySubclass(groups, d3_transitionPrototype);

651:       point = point.matrixTransform(container.getScreenCTM().inverse());

3644:         if (value = node.classList) {

3647:           value = node.className;

3649:           while (++i < n) if (!d3_selection_classedRe(name[i]).test(value)) return false;

3653:       for (value in name) this.each(d3_selection_classed(value, name[value]));

3656:     return this.each(d3_selection_classed(name, value));

4638: ...(171 bytes skipped)... !/^(n|s)$/.test(resizing) && x, resizingY = !/^(e|w)$/.test(resizing) && y, dragging = eventTarget.classed("extent"), center, origin = mouse(), offset;

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),

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") {