├── .Rbuildignore ├── .gitignore ├── DESCRIPTION ├── LICENSE ├── NAMESPACE ├── R ├── BuildInx.R ├── PlotInx.R └── ShinyInx.R ├── README.md ├── _config.yml ├── inst ├── DemoData │ ├── DemoDE.RData │ └── DemoExpr.RData ├── LigRecDB_RData │ ├── BaderCCIeditedbyBI_human.RData │ ├── BaderCCIeditedbyBI_mouse.RData │ ├── FANTOM5_human.RData │ └── MillerKaplan_mouse.RData └── blank.html ├── man ├── BuildCCInx.Rd ├── BuildGeneStatList.Rd ├── CalcDiffExprScaled.Rd ├── CalcExprScaled.Rd ├── DoPlotInx.Rd ├── FilterInx_GeneMagnitude.Rd ├── FilterInx_GeneStatistic.Rd ├── FilterInx_genenames.Rd ├── FilterInx_step1.Rd ├── FilterInx_topN.Rd ├── PlotCCInx.Rd └── ViewCCInx.Rd └── vignettes ├── CCInxUsage.Rmd ├── CCInxUsage.html └── CCInxUsage_files └── MathJax.js.download /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^Meta$ 2 | ^doc$ 3 | ^.*\.Rproj$ 4 | ^\.Rproj\.user$ 5 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | Meta 2 | doc 3 | inst/doc 4 | .Rproj.user 5 | .Rhistory 6 | .RData 7 | .Ruserdata 8 | CCInx.Rproj 9 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: CCInx 2 | Type: Package 3 | Title: Predict cell-cell interaction networks from single-cell data 4 | Version: 0.5.2 5 | Authors@R: c(as.person("Brendan T. Innes [aut,cre]"), 6 | as.person("Gary D. Bader [aut,ths]")) 7 | Description: Build predicted cell-cell interaction networks from single-cell data. 8 | This package is under development, so keep up-to-date by regularly checking for 9 | updates at https://baderlab.github.io/CCInx/ 10 | License: MIT + file LICENSE 11 | Encoding: UTF-8 12 | LazyData: true 13 | Suggests: 14 | knitr (>= 1.22), 15 | rmarkdown, 16 | scClustViz (>= 1.0.0) 17 | Imports: 18 | scales (>= 1.0.0), 19 | RColorBrewer (>= 1.1-2), 20 | pbapply (>= 1.3.4), 21 | grDevices(>= 3.5.1) 22 | Depends: 23 | shiny (>= 1.1.0) 24 | Remotes: BaderLab/scClustViz 25 | RoxygenNote: 7.1.0 26 | VignetteBuilder: knitr 27 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2019 Bader Lab, University of Toronto 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | # Generated by roxygen2: do not edit by hand 2 | 3 | export(BuildCCInx) 4 | export(BuildGeneStatList) 5 | export(DoPlotInx) 6 | export(FilterInx_GeneMagnitude) 7 | export(FilterInx_GeneStatistic) 8 | export(FilterInx_genenames) 9 | export(FilterInx_step1) 10 | export(FilterInx_topN) 11 | export(PlotCCInx) 12 | export(ViewCCInx) 13 | -------------------------------------------------------------------------------- /R/BuildInx.R: -------------------------------------------------------------------------------- 1 | #' Build cluster-wise list of gene expression statistics from scRNAseq data 2 | #' 3 | #' This function takes a \code{Seurat} or \code{SingleCellExperiment} object and 4 | #' builds a list of dataframes containing gene expression statistics for all 5 | #' genes of each cluster. This can be used as the input to 6 | #' \code{\link{BuildCCInx}} for generating cell-cell interaction predictions 7 | #' between cell-type clusters. 8 | #' 9 | #' @param inD The input dataset. An object of class \code{\link[Seurat]{seurat}} 10 | #' or \code{\link[SingleCellExperiment]{SingleCellExperiment}}. Other data 11 | #' classes are not currently supported. 12 | #' \href{https://github.com/BaderLab/scClustViz/issues}{Please submit requests 13 | #' for other data objects here!} 14 | #' @param cl a factor where each value is the cluster assignment for a cell 15 | #' (column) in the input gene expression matrix. 16 | #' @param assayType Default = "" (for Seurat v1/2). A length-one character 17 | #' vector representing the assay slot in which the expression data is stored 18 | #' in the input object. This is not required for Seurat v1 or v2 objects. See 19 | #' \code{\link[scClustViz]{getExpr}} for details. 20 | #' @param assaySlot An optional length-one character vector representing 21 | #' the slot of the Seurat v3 \code{\link[Seurat]{Assay}} object to use. Not 22 | #' used for other single-cell data objects. The default is to use the 23 | #' normalized data in the "data" slot, but you can also use the 24 | #' \code{\link[Seurat]{SCTransform}}-corrected counts by setting 25 | #' \code{assayType = "SCT"} and \code{assaySlot = "counts"}. This is 26 | #' recommended, as it will speed up differential expression 27 | #' calculations. See \code{\link{getExpr}} for details. 28 | #' @param exponent Default = 2. A length-one numeric vector representing the 29 | #' base of the log-normalized gene expression data to be processed. Generally 30 | #' gene expression data is transformed into log2 space when normalizing (set 31 | #' this to 2), though \code{Seurat} uses the natural log (set this to exp(1)). 32 | #' @param pseudocount Default = 1. A length-one numeric vector representing the 33 | #' pseudocount added to all log-normalized values in your input data. Most 34 | #' methods use a pseudocount of 1 to eliminate log(0) errors. 35 | #' 36 | #' @seealso \code{\link[scClustViz]{CalcCGS}} 37 | #' 38 | #' @references Mean gene expression calculations 39 | #' Innes BT and Bader GD. scClustViz – Single-cell RNAseq cluster 40 | #' assessment and visualization [version 2; peer review: 2 approved]. 41 | #' F1000Research 2019, 7:1522 (\url{https://doi.org/10.12688/f1000research.16198.2}) 42 | #' 43 | #' @export 44 | 45 | BuildGeneStatList <- function(inD, 46 | cl, 47 | assayType="", 48 | assaySlot="", 49 | exponent=2, 50 | pseudocount=1) { 51 | if (!require(scClustViz)) { 52 | stop(paste("scClustViz is required for this function. Install from github:", 53 | " devtools::install_github('Baderlab/scClustViz')",sep="\n")) 54 | } 55 | if (!is(inD)[1] %in% methods::findMethodSignatures(scClustViz::getExpr)) { 56 | stop(paste( 57 | paste0("Input data object must be one of: ", 58 | paste(methods::findMethodSignatures(scClustViz::getExpr),collapse=", "), 59 | "."), 60 | paste("Other input objects are not supported at this time,", 61 | "but please let me know what object class"), 62 | paste("you'd like supported at", 63 | "https://github.com/BaderLab/scClustViz/issues, thanks!"), 64 | sep="\n ")) 65 | } 66 | if (is.null(colnames(getExpr(inD,assayType,assaySlot))) | 67 | is.null(rownames(getExpr(inD,assayType,assaySlot)))) { 68 | stop("Gene expression matrix returned by 'getExpr(inD,assayType,assaySlot)' is missing col/rownames.") 69 | } 70 | if (length(cl) != ncol(scClustViz::getExpr(inD,assayType,assaySlot))) { 71 | stop(paste("cl must be a factor where each value is the cluster assignment", 72 | "for a cell (column) in the input gene expression matrix.", 73 | sep="\n ")) 74 | } 75 | if (is.character(cl) | is.numeric(cl)) { 76 | cl <- as.factor(cl) 77 | } 78 | if (!all(names(cl) == colnames(scClustViz::getExpr(inD,assayType,assaySlot))) | 79 | is.null(names(cl))) { 80 | names(cl) <- colnames(scClustViz::getExpr(inD,assayType,assaySlot)) 81 | } 82 | if (any(grepl("_",levels(cl)))) { 83 | stop("Cluster names cannot contain '_' due to internal naming conventions.") 84 | } 85 | if (any(grepl("~",levels(cl)))) { 86 | stop("Cluster names cannot contain '~' due to internal naming conventions.") 87 | } 88 | 89 | temp <- scClustViz:::fx_calcCGS(nge=scClustViz::getExpr(inD, 90 | assayType, 91 | assaySlot), 92 | cl=cl, 93 | exponent=2, 94 | pseudocount=1) 95 | return( 96 | sapply(temp,function(X) { 97 | X <- X[X$DR > 0,] 98 | names(X)[names(X) == "DR"] <- "DetectRate" 99 | names(X)[names(X) == "MDGE"] <- "MeanDetectGeneExpr" 100 | names(X)[names(X) == "MGE"] <- "MeanNormGeneExpr" 101 | return(X) 102 | },simplify=F) 103 | ) 104 | } 105 | 106 | 107 | 108 | 109 | 110 | #' Check input and score and scale DE stats. 111 | #' 112 | #' This function takes differential expression gene statistics from scRNAseq 113 | #' data representing a cell type as a dataframe, and assigns scaled scores to 114 | #' the statistic of choice. This is used to rank nodes and edges by differential 115 | #' expression when viewing the bipartite ligand-receptor plots. 116 | #' 117 | #' @param gdb A data frame representing gene statistics from a cell type, where 118 | #' each row is a gene with official gene symbols as row names. Variables 119 | #' should be appropriately named statistics or annotations to be included in 120 | #' the resulting node metadata. 121 | #' @param DEmagn A character vector of length 1 representing the variable name 122 | #' in the GeneStatList data frames carrying information on the magnitude and 123 | #' direction of the change of expression for the node (gene) in each cell 124 | #' type. This is generally a signed logFC or gene expression ratio. 125 | #' @param DEstat A character vector of length 1 representing the variable name 126 | #' in the GeneStatList data frames carrying information on the statistical 127 | #' significance of expression change. This is generally a corrected p-value. 128 | #' 129 | 130 | CalcDiffExprScaled <- function(gdb,DEmagn,DEstat) { 131 | if (any( is.na(gdb[[DEmagn]]) )) { 132 | stop(paste("This function doesn't tolerate missing", 133 | DEmagn,"values.")) 134 | } 135 | if (any( is.na(gdb[[DEstat]]) )) { 136 | stop(paste("This function doesn't tolerate missing", 137 | DEstat,"values.")) 138 | } 139 | return(sapply(gdb[[DEmagn]],function(X) { 140 | if (X == Inf) { 141 | 1.1 142 | } else if (X == -Inf) { 143 | -1.1 144 | } else { 145 | X / switch(as.character(X >= 0), 146 | "TRUE"=max(gdb[[DEmagn]][!is.infinite(gdb[[DEmagn]])]), 147 | "FALSE"=min(gdb[[DEmagn]][!is.infinite(gdb[[DEmagn]])]) * -1) 148 | } 149 | })) 150 | } 151 | 152 | 153 | #' Check input and score and scale gene expression. 154 | #' 155 | #' This function takes differential expression gene statistics from scRNAseq 156 | #' data representing a cell type as a dataframe, and assigns scaled scores to 157 | #' the statistic of choice. This is used to rank nodes and edges by differential 158 | #' expression when viewing the bipartite ligand-receptor plots. 159 | #' 160 | #' @param gdb A data frame representing gene statistics from a cell type, where 161 | #' each row is a gene with official gene symbols as row names. Variables 162 | #' should be appropriately named statistics or annotations to be included in 163 | #' the resulting node metadata. 164 | #' @param expr A character vector of length 1 representing the variable name 165 | #' in the GeneStatList data frames carrying information on the magnitude and 166 | #' direction of the change of expression for the node (gene) in each cell 167 | #' type. This is generally a signed logFC or gene expression ratio. 168 | 169 | CalcExprScaled <- function(gdb,expr) { 170 | if (any( is.na(gdb[[expr]]) )) { 171 | stop(paste("This function doesn't tolerate missing", 172 | expr,"values.")) 173 | } 174 | return( ( gdb[[expr]] - min(gdb[[expr]]) ) / 175 | max( gdb[[expr]] - min(gdb[[expr]]) ) ) 176 | } 177 | 178 | #' Build cell-cell interaction predictions between cell types 179 | #' 180 | #' This function takes a list of gene statistics per cluster to predict 181 | #' cell-cell interactions between each cell-type (cluster). If the 182 | #' \code{GeneStatistic} argument is provided, this function will assume the gene 183 | #' statistics represent differential expression between experimental conditions, 184 | #' and will weight the predicted interactions accordingly. Otherwise, 185 | #' predictions will be weighted by expression magnitude per cell type. The 186 | #' output of this function can be explored interactively with 187 | #' \code{\link{ViewCCInx}}, or static figures can be generated with 188 | #' \code{\link{PlotCCInx}}. 189 | #' 190 | #' @param GeneStatList A named list of dataframes. Each list element should 191 | #' represent a cell type / cluster to be included in the interaction network, 192 | #' and should be named accordingly. List elements should contain data frames 193 | #' where each row is a gene with official gene symbols as row names. Variables 194 | #' should be appropriately named statistics or annotations to be included in 195 | #' the resulting node metadata. Variable names should be consistent between 196 | #' list elements. The function \code{\link{BuildGeneStatList}} can be used to 197 | #' generate this list from \code{Seurat} or \code{SingleCellExperiment} 198 | #' objects when generating predictions not involving differential gene 199 | #' expression. 200 | #' @param GeneMagnitude Default = "MeanNormGeneExpr". A character vector of length 1 201 | #' representing the variable name in the GeneStatList data frames carrying 202 | #' information on the magnitude (and direction of the change) of expression 203 | #' for the node (gene) in each cell type. This is either a measure of 204 | #' expression (generally mean expression or detection rate) or a measure of 205 | #' change (signed log expression ratio a.k.a. logFC). Default assumes 206 | #' \code{GeneStatList} is output from \code{\link{BuildGeneStatList}}, and 207 | #' uses mean normalized gene expression to weight nodes and edges. 208 | #' @param GeneStatistic Optional. A character vector of length 1 representing 209 | #' the variable name in the GeneStatList data frames carrying information on 210 | #' the statistical significance of expression change. This is generally a 211 | #' corrected p-value. 212 | #' @param Species Default='hsapiens'. The species of the source data. One of 213 | #' 'hsapiens' or 'mmusculus'. Note that the ligand-receptor database was built 214 | #' for human, and the mouse version is generated by homology mapping (only 215 | #' using uniquely mapped homologues). 216 | #' 217 | #' @export 218 | 219 | BuildCCInx <- function(GeneStatList, 220 | GeneMagnitude="MeanNormGeneExpr", 221 | GeneStatistic, 222 | Species="hsapiens") { 223 | if (length(names(GeneStatList)) != length(GeneStatList)) { 224 | stop("GeneStatList must be a named list where names are cell types.") 225 | } 226 | if (any(duplicated(names(GeneStatList)))) { 227 | stop("GeneStatList names must be unique.") 228 | } 229 | if (any(grepl("_",names(GeneStatList)))) { 230 | stop("GeneStatList names cannot contain '_' due to internal naming conventions.") 231 | } 232 | if (any(grepl("~",names(GeneStatList)))) { 233 | stop("GeneStatList names cannot contain '~' due to internal naming conventions.") 234 | } 235 | message("Scaling node weights per cell type...") 236 | if (missing(GeneStatistic)) { 237 | temp_scaled <- pbapply::pbsapply(X=GeneStatList, 238 | FUN=CalcExprScaled, 239 | expr=GeneMagnitude, 240 | simplify=F) 241 | } else { 242 | temp_scaled <- pbapply::pbsapply(X=GeneStatList, 243 | FUN=CalcDiffExprScaled, 244 | DEmagn=GeneMagnitude, 245 | DEstat=GeneStatistic, 246 | simplify=F) 247 | } 248 | inx <- list() 249 | message("Building node metadata...") 250 | temp_cellNames <- names(GeneStatList) 251 | inx$nodes <- do.call(rbind,GeneStatList) 252 | temp_gene <- unlist(lapply(GeneStatList,rownames),use.names=F) 253 | temp_cellType <- unlist(mapply(function(N,X) rep(N,X), 254 | N=temp_cellNames, 255 | X=sapply(GeneStatList,nrow), 256 | SIMPLIFY=F), 257 | use.names=F) 258 | 259 | switch(Species, 260 | hsapiens=load(system.file("LigRecDB_RData/BaderCCIeditedbyBI_human.RData", 261 | package="CCInx")), 262 | mmusculus=load(system.file("LigRecDB_RData/BaderCCIeditedbyBI_mouse.RData", 263 | package="CCInx")), 264 | MillerKaplan=load(system.file("LigRecDB_RData/MillerKaplan_mouse.RData", 265 | package="CCInx")), 266 | FANTOM5=load(system.file("LigRecDB_RData/FANTOM5_human.RData", 267 | package="CCInx")), 268 | stop("Species must be one of 'hsapiens' or 'mmusculus'.")) 269 | if (sum(rownames(geneInfo) %in% temp_gene) < 20) { 270 | warning(paste("Less than 20 genes from GeneStatList were detected in the CCInx database.", 271 | " Please ensure that you've set the Species argument correctly.", 272 | " Rownames of each entry in GeneStatList must be official gene symbols.", 273 | sep="\n")) 274 | } 275 | temp_proteinType <- geneInfo[temp_gene,"protein_type"] 276 | inx$nodes <- cbind(data.frame(node=paste(temp_gene,temp_cellType,sep="_"), 277 | gene=temp_gene, 278 | cellType=temp_cellType, 279 | proteinType=temp_proteinType, 280 | nodeWeight=unlist(temp_scaled), 281 | stringsAsFactors=F), 282 | inx$nodes) 283 | rownames(inx$nodes) <- inx$nodes$node 284 | inx$nodes <- inx$nodes[!is.na(inx$nodes$proteinType),] 285 | 286 | tempCN <- c() 287 | for (a in temp_cellNames) { 288 | for (b in temp_cellNames) { 289 | temp <- paste(sort(c(a,b)),collapse="~") 290 | if (!temp %in% tempCN) { 291 | tempCN <- append(tempCN,temp) 292 | } 293 | } 294 | } 295 | rm(a,b) 296 | tempComp <- strsplit(tempCN,"~") 297 | names(tempComp) <- tempCN 298 | 299 | message("Building edge list...") 300 | inx$edges <- pbapply::pbsapply(tempComp,function(Z) { 301 | a <- Z[1]; b <- Z[2] 302 | if (sum(inx$nodes$cellType == a) < 1 | 303 | sum(inx$nodes$cellType == b) < 1) { 304 | return(NULL) 305 | } 306 | 307 | keysAB <- inxDB$key[inxDB$nodeA %in% inx$nodes$gene[inx$nodes$cellType == a] & 308 | inxDB$nodeB %in% inx$nodes$gene[inx$nodes$cellType == b]] 309 | if (length(keysAB) < 1) { 310 | edgesAB <- data.frame(row.names=c("key","nodeA","nodeB")) 311 | } else { 312 | edgesAB <- data.frame( 313 | sapply(strsplit(keysAB,"_"),function(X) 314 | paste(paste(X[1],a,sep="_"),paste(X[2],b,sep="_"),sep="~")), 315 | t(sapply(strsplit(keysAB,"_"),function(X) 316 | c(paste(X[1],a,sep="_"),paste(X[2],b,sep="_")))), 317 | stringsAsFactors=F) 318 | colnames(edgesAB) <- c("key","nodeA","nodeB") 319 | rownames(edgesAB) <- edgesAB$key 320 | } 321 | 322 | keysBA <- inxDB$key[inxDB$nodeA %in% inx$nodes$gene[inx$nodes$cellType == b] & 323 | inxDB$nodeB %in% inx$nodes$gene[inx$nodes$cellType == a]] 324 | if (length(keysBA) < 1) { 325 | edgesBA <- data.frame(row.names=c("key","nodeA","nodeB")) 326 | } else { 327 | edgesBA <- data.frame( 328 | sapply(strsplit(keysBA,"_"),function(X) 329 | paste(paste(X[2],a,sep="_"),paste(X[1],b,sep="_"),sep="~")), 330 | t(sapply(strsplit(keysBA,"_"),function(X) 331 | c(paste(X[2],a,sep="_"),paste(X[1],b,sep="_")))), 332 | stringsAsFactors=F) 333 | colnames(edgesBA) <- c("key","nodeA","nodeB") 334 | rownames(edgesBA) <- edgesBA$key 335 | } 336 | 337 | temp <- rbind(edgesAB,edgesBA) 338 | if (nrow(temp) < 1) { 339 | return(NULL) 340 | } else { 341 | return(temp) 342 | } 343 | },simplify=F) 344 | inx$edges <- do.call(rbind,inx$edges) 345 | rownames(inx$edges) <- inx$edges$key 346 | inx$edges <- inx$edges[,2:3] 347 | inx$edges$edgeWeight <- rowMeans(cbind(inx$nodes[inx$edges$nodeA,"nodeWeight"], 348 | inx$nodes[inx$edges$nodeB,"nodeWeight"])) 349 | 350 | # inx$nodes <- inx$nodes[inx$nodes$node %in% inx$edges$nodeA | inx$nodes$node %in% inx$edges$nodeB,] 351 | # Orphan nodes should be left in for clarity - the genes were in the database, just without interacting partners. 352 | # They get filtered from the viewer in FilterInx_step1 anyway. 353 | 354 | attr(inx,"GeneMagnitude") <- GeneMagnitude 355 | if (!missing(GeneStatistic)) { 356 | attr(inx,"GeneStatistic") <- GeneStatistic 357 | } 358 | 359 | return(inx) 360 | } 361 | 362 | -------------------------------------------------------------------------------- /R/PlotInx.R: -------------------------------------------------------------------------------- 1 | #' Internal function: 2 | #' 3 | #' 4 | #' @export 5 | 6 | FilterInx_step1 <- function(INX,cellTypeA,cellTypeB,proteinTypeA,proteinTypeB) { 7 | nodesA <- INX$nodes[INX$nodes$cellType == cellTypeA & 8 | grepl(proteinTypeA,INX$nodes$proteinType),] 9 | if (nrow(nodesA) < 1) { 10 | stop(paste0("No ",proteinTypeA," in ",cellTypeA,".")) 11 | } 12 | nodesA$side <- "A" 13 | rownames(nodesA) <- paste(rownames(nodesA),"A",sep="_") 14 | 15 | nodesB <- INX$nodes[INX$nodes$cellType == cellTypeB & 16 | grepl(proteinTypeB,INX$nodes$proteinType),] 17 | if (nrow(nodesA) < 1) { 18 | stop(paste0("No ",proteinTypeB," in ",cellTypeB,".")) 19 | } 20 | nodesB$side <- "B" 21 | rownames(nodesB) <- paste(rownames(nodesB),"B",sep="_") 22 | INX$nodes <- rbind(nodesA,nodesB) 23 | 24 | edgesAB <- INX$edges[INX$edges$nodeA %in% nodesA$node & 25 | INX$edges$nodeB %in% nodesB$node,] 26 | if (nrow(edgesAB) > 0) { 27 | edgesAB$nodeA <- paste(edgesAB$nodeA,"A",sep="_") 28 | edgesAB$nodeB <- paste(edgesAB$nodeB,"B",sep="_") 29 | } 30 | edgesBA <- INX$edges[INX$edges$nodeA %in% nodesB$node & 31 | INX$edges$nodeB %in% nodesA$node,] 32 | if (nrow(edgesBA) > 0) { 33 | tempB <- paste(edgesBA$nodeA,"B",sep="_") 34 | tempA <- paste(edgesBA$nodeB,"A",sep="_") 35 | edgesBA$nodeA <- tempA 36 | edgesBA$nodeB <- tempB 37 | } 38 | INX$edges <- rbind(edgesAB,edgesBA) 39 | 40 | INX$nodes <- INX$nodes[rownames(INX$nodes) %in% unique(c(INX$edges$nodeA,INX$edges$nodeB)),] 41 | INX$nodes <- INX$nodes[,-which(colnames(INX$nodes) == "node")] 42 | 43 | attr(INX,"cellType") <- list(A=cellTypeA,B=cellTypeB) 44 | attr(INX,"proteinType") <- list(A=proteinTypeA,B=proteinTypeB) 45 | return(INX) 46 | } 47 | 48 | 49 | #' Internal function: 50 | #' 51 | #' 52 | #' @export 53 | 54 | FilterInx_topN <- function(INX,topN) { 55 | INX$edges <- INX$edges[head(order(abs(INX$edges$edgeWeight),decreasing=T),topN),] 56 | INX$nodes <- INX$nodes[unique(c(INX$edges$nodeA,INX$edges$nodeB)),] 57 | return(INX) 58 | } 59 | 60 | 61 | #' Internal function: 62 | #' 63 | #' 64 | #' @export 65 | 66 | FilterInx_GeneStatistic <- function(INX,statThresh) { 67 | if (is.null(attr(INX,"GeneStatistic"))) { 68 | stop("No GeneStatistic attribute provided - input data was not from differential expression test?") 69 | } 70 | temp_nodes <- rownames(INX$nodes)[INX$nodes[,attr(INX,"GeneStatistic")] <= statThresh] 71 | INX$edges <- INX$edges[INX$edges$nodeA %in% temp_nodes | INX$edges$nodeB %in% temp_nodes,] 72 | INX$nodes <- INX$nodes[unique(c(INX$edges$nodeA,INX$edges$nodeB)),] 73 | return(INX) 74 | } 75 | 76 | 77 | #' Internal function: 78 | #' 79 | #' 80 | #' @export 81 | 82 | FilterInx_GeneMagnitude <- function(INX,magnThresh) { 83 | if (is.null(attr(INX,"GeneStatistic"))) { 84 | temp_nodes <- rownames(INX$nodes)[INX$nodes[,attr(INX,"GeneMagnitude")] > magnThresh] 85 | } else { 86 | temp_nodes <- rownames(INX$nodes)[abs(INX$nodes[,attr(INX,"GeneMagnitude")]) > magnThresh] 87 | } 88 | INX$edges <- INX$edges[INX$edges$nodeA %in% temp_nodes | INX$edges$nodeB %in% temp_nodes,] 89 | INX$nodes <- INX$nodes[unique(c(INX$edges$nodeA,INX$edges$nodeB)),] 90 | return(INX) 91 | } 92 | 93 | 94 | #' Internal function: 95 | #' 96 | #' 97 | #' @export 98 | 99 | FilterInx_genenames <- function(INX,genenames) { 100 | temp_nodes <- rownames(INX$nodes)[INX$nodes$gene %in% genenames] 101 | INX$edges <- INX$edges[INX$edges$nodeA %in% temp_nodes | INX$edges$nodeB %in% temp_nodes,] 102 | INX$nodes <- INX$nodes[unique(c(INX$edges$nodeA,INX$edges$nodeB)),] 103 | return(INX) 104 | } 105 | 106 | 107 | #' Internal function: 108 | #' 109 | #' 110 | #' @export 111 | 112 | DoPlotInx <- function(INX,ySpacing) { 113 | # yoCol <- colorRampPalette(rgb(red=c(87,220,247),green=c(87,220,78),blue=c(249,220,214), 114 | # names=c("old","none","young"),maxColorValue=255), 115 | # bias=1,interpolate="linear") 116 | # colourScheme <- yoCol(100) 117 | if (is.null(attr(INX,"GeneStatistic"))) { 118 | colourScheme <- colorspace::sequential_hcl(100,palette="Viridis",rev=T) 119 | colourSchemeEdges <- colorspace::sequential_hcl(100,palette="Viridis",rev=T,alpha=seq(0.8,0.3,length.out=100)) 120 | } else { 121 | colourScheme <- colorspace::diverge_hcl(100,palette="Blue-Red 2") 122 | colourSchemeEdges <- colorspace::diverge_hcl(100,palette="Blue-Red 2", 123 | alpha=c(seq(0.9,0.3,length.out=50), 124 | seq(0.3,0.9,length.out=50))) 125 | } 126 | 127 | if (missing(ySpacing)) { 128 | ySpacing <- "relative" 129 | } 130 | if (!ySpacing %in% c("absolute","relative")) { 131 | warning("ySpacing must be one of: 'absolute' or 'relative'. Set to 'relative'.") 132 | ySpacing <- "relative" 133 | } 134 | if (nrow(INX$nodes) < 1 | nrow(INX$edges) < 1) { 135 | stop("No genes passed filters.") 136 | } 137 | 138 | INX$nodes$x[INX$nodes$side == "A"] <- 1 139 | INX$nodes$x[INX$nodes$side == "B"] <- 3 140 | 141 | if (ySpacing == "relative") { 142 | temp <- INX$nodes[,attr(INX,"GeneMagnitude")] 143 | temp[temp == Inf] <- max(temp[temp < Inf]) * 1.1 144 | temp[temp == -Inf] <- min(temp[temp > -Inf]) * 1.1 145 | p <- INX$nodes$side == "A" 146 | temp[p] <- seq(min(temp),max(temp),length.out=sum(p))[rank(temp[p],ties.method="first")] 147 | p <- INX$nodes$side == "B" 148 | temp[p] <- seq(min(temp),max(temp),length.out=sum(p))[rank(temp[p],ties.method="first")] 149 | INX$nodes$y <- temp 150 | } else { 151 | INX$nodes$y <- INX$nodes[,attr(INX,"GeneMagnitude")] 152 | INX$nodes$y[INX$nodes$y == Inf] <- max(INX$nodes$y[INX$nodes$y < Inf]) * 1.1 153 | INX$nodes$y[INX$nodes$y == -Inf] <- min(INX$nodes$y[INX$nodes$y > -Inf]) * 1.1 154 | } 155 | 156 | if (is.null(attr(INX,"GeneStatistic"))) { 157 | INX$nodes$col <- cut(INX$nodes[,attr(INX,"GeneMagnitude")],100,labels=F) 158 | } else { 159 | temp_b <- INX$nodes[,attr(INX,"GeneMagnitude")] <= 0 160 | if (any(temp_b)) { 161 | if (any(is.infinite(INX$nodes[temp_b,attr(INX,"GeneMagnitude")]))) { 162 | temp_bc <- INX$nodes[temp_b,attr(INX,"GeneMagnitude")] 163 | temp_bc[is.infinite(temp_bc)] <- min(temp_bc[!is.infinite(temp_bc)]) * 1.1 164 | temp_bc <- cut(c(0,temp_bc),50,labels=F)[-1] 165 | } else { 166 | temp_bc <- cut(c(0,INX$nodes[temp_b,attr(INX,"GeneMagnitude")]),50,labels=F)[-1] 167 | } 168 | INX$nodes$col[temp_b] <- temp_bc 169 | } 170 | temp_a <- INX$nodes[,attr(INX,"GeneMagnitude")] > 0 171 | if (any(temp_a)) { 172 | if (any(is.infinite(INX$nodes[temp_a,attr(INX,"GeneMagnitude")]))) { 173 | temp_ac <- INX$nodes[temp_a,attr(INX,"GeneMagnitude")] 174 | temp_ac[is.infinite(temp_ac)] <- max(temp_ac[!is.infinite(temp_ac)]) * 1.1 175 | temp_ac <- cut(c(0,temp_ac),50,labels=F)[-1] 176 | } else { 177 | temp_ac <- cut(c(0,INX$nodes[temp_a,attr(INX,"GeneMagnitude")]),50,labels=F)[-1] 178 | } 179 | INX$nodes$col[temp_a] <- temp_ac + 50 180 | } 181 | } 182 | 183 | if (!is.null(attr(INX,"GeneStatistic"))) { 184 | INX$nodes$signif <- cut(INX$nodes[,attr(INX,"GeneStatistic")], 185 | breaks=c(1,.05,.01,.001,.0001,0), 186 | right=T,include.lowest=T) 187 | } 188 | 189 | if (is.null(attr(INX,"GeneStatistic"))) { 190 | INX$edges$col <- cut(c(0,1,INX$edges$edgeWeight),100,labels=F)[-1:-2] 191 | } else { 192 | INX$edges$col <- cut(c(-1,1,INX$edges$edgeWeight),100,labels=F)[-1:-2] 193 | } 194 | INX$edges$lwd <- seq(2,6)[cut(c(0,1,abs(INX$edges$edgeWeight)),5,labels=F)[-1:-2]] 195 | 196 | 197 | par(mar=c(3,3,3,1),mgp=2:0) 198 | plot(x=NULL,y=NULL,xlim=c(0,6.5),ylim=range(INX$nodes$y), 199 | xaxs="i",xaxt="n",yaxs="i",yaxt="n",bty="n", 200 | xlab=NA,ylab=NA) 201 | temp_junk <- sapply(rownames(INX$edges),function(X) 202 | lines(x=INX$nodes[unlist(INX$edges[X,c("nodeA","nodeB")]),"x"], 203 | y=INX$nodes[unlist(INX$edges[X,c("nodeA","nodeB")]),"y"], 204 | col=colourSchemeEdges[INX$edges[X,"col"]], 205 | lwd=INX$edges[X,"lwd"]) 206 | ) 207 | points(x=INX$nodes$x,y=INX$nodes$y, 208 | pch=19,cex=2,xpd=NA, 209 | col=colourScheme[INX$nodes$col]) 210 | points(x=INX$nodes$x,y=INX$nodes$y, 211 | pch=1,cex=2,lwd=2,xpd=NA, 212 | col=c("gray0","gray25","gray50","gray75","gray100")[INX$nodes$signif]) 213 | text(x=INX$nodes$x[INX$nodes$side == "A"], 214 | y=INX$nodes$y[INX$nodes$side == "A"], 215 | labels=INX$nodes$gene[INX$nodes$side == "A"], 216 | pos=2,col="black",xpd=NA) 217 | text(x=INX$nodes$x[INX$nodes$side == "B"], 218 | y=INX$nodes$y[INX$nodes$side == "B"], 219 | labels=INX$nodes$gene[INX$nodes$side == "B"], 220 | pos=4,col="black",xpd=NA) 221 | mtext(unlist(attr(INX,"cellType")),side=3,line=1.5,font=2, 222 | at=c(unique(INX$nodes$x[INX$nodes$side == "A"]), 223 | unique(INX$nodes$x[INX$nodes$side == "B"]))) 224 | mtext(unlist(attr(INX,"proteinType")),side=3,line=0.5,font=2, 225 | at=c(unique(INX$nodes$x[INX$nodes$side == "A"]), 226 | unique(INX$nodes$x[INX$nodes$side == "B"]))) 227 | mtext(unlist(attr(INX,"proteinType")),side=1,line=0.5,font=2, 228 | at=c(unique(INX$nodes$x[INX$nodes$side == "A"]), 229 | unique(INX$nodes$x[INX$nodes$side == "B"]))) 230 | mtext(unlist(attr(INX,"cellType")),side=1,line=1.5,font=2, 231 | at=c(unique(INX$nodes$x[INX$nodes$side == "A"]), 232 | unique(INX$nodes$x[INX$nodes$side == "B"]))) 233 | if (ySpacing == "absolute") { 234 | axis(2,pos=0) 235 | mtext(attr(INX,"GeneMagnitude"),font=2,side=2,line=2) 236 | } 237 | 238 | if (is.null(attr(INX,"GeneStatistic"))) { 239 | temp_top <- par("usr")[4] 240 | temp_bottom <- temp_top - strheight("ABC") * 1.5 * 20 241 | rect(xleft=4.6,xright=5, 242 | ybottom=seq(from=temp_bottom,to=temp_top, 243 | length.out=101)[1:100], 244 | ytop=seq(from=temp_bottom,to=temp_top, 245 | length.out=101)[2:101], 246 | col=colourScheme,border=NA) 247 | text(x=5,y=temp_bottom, 248 | labels=round(min(INX$nodes[,attr(INX,"GeneMagnitude")]),2), 249 | adj=c(-.1,0)) 250 | text(x=5,y=temp_top, 251 | labels=round(max(INX$nodes[,attr(INX,"GeneMagnitude")]),2), 252 | adj=c(-.1,1)) 253 | text(x=5,y=temp_top - (temp_top - temp_bottom)/2, 254 | labels=attr(INX,"GeneMagnitude"), 255 | font=2,srt=90,adj=c(0.5,2)) 256 | } else { 257 | legend(x=4.5,y=par("usr")[4], 258 | bty="n",pch=1,pt.lwd=2,pt.cex=2, 259 | legend=c("> 0.05","0.01 to 0.05","0.001 to 0.01","0.0001 to 0.001","< 0.0001"), 260 | col=c("gray100","gray75","gray50","gray25","gray0")) 261 | mtext(attr(INX,"GeneStatistic"),side=3,at=4.5,font=2,line=-0.5,adj=0) 262 | 263 | temp_top <- par("usr")[4] - strheight("ABC") * 1.5 * 10 264 | temp_zero <- temp_top - strheight("ABC") * 1.5 * 10 265 | temp_bottom <- temp_zero - strheight("ABC") * 1.5 * 10 266 | 267 | temp_fc <- INX$nodes$col[!is.infinite(INX$nodes[,attr(INX,"GeneMagnitude")])] 268 | if (any(INX$nodes[,attr(INX,"GeneMagnitude")] <= 0)) { 269 | rect(xleft=4.6,xright=5, 270 | ybottom=seq(from=temp_bottom,to=temp_zero, 271 | length.out=50 - min(temp_fc) + 1)[seq(1,50 - min(temp_fc))], 272 | ytop=seq(from=temp_bottom,to=temp_zero, 273 | length.out=50 - min(temp_fc) + 1)[seq(1,50 - min(temp_fc)) + 1], 274 | col=colourScheme[seq(min(temp_fc),50)],border=NA) 275 | text(x=5,y=temp_bottom, 276 | labels=round(min(INX$nodes[,attr(INX,"GeneMagnitude")][ 277 | !is.infinite(INX$nodes[,attr(INX,"GeneMagnitude")])]),2), 278 | adj=c(-.1,0)) 279 | } 280 | if (any(INX$nodes[,attr(INX,"GeneMagnitude")] > 0)) { 281 | rect(xleft=4.6,xright=5, 282 | ybottom=seq(from=temp_zero,to=temp_top, 283 | length.out=max(temp_fc) - 51 + 1)[seq(1,max(temp_fc) - 51)], 284 | ytop=seq(from=temp_zero,to=temp_top, 285 | length.out=max(temp_fc) - 51 + 1)[seq(1,max(temp_fc) - 51) + 1], 286 | col=colourScheme[seq(51,max(temp_fc))],border=NA) 287 | text(x=5,y=temp_top, 288 | labels=round(max(INX$nodes[,attr(INX,"GeneMagnitude")][ 289 | !is.infinite(INX$nodes[,attr(INX,"GeneMagnitude")])]),2), 290 | adj=c(-.1,1)) 291 | } 292 | text(x=5,y=temp_zero, 293 | labels=0,adj=c(-0.5,0.5)) 294 | if (any(INX$nodes[,attr(INX,"GeneMagnitude")] == Inf)) { 295 | rect(xleft=4.6,xright=5, 296 | ybottom=temp_top + strheight("ABC") * 0.5, 297 | ytop=temp_top + strheight("ABC") * 1.5, 298 | col=colourScheme[100],border=NA) 299 | text(x=5,y=temp_top + strheight("ABC") * 1, 300 | labels=Inf,adj=c(-.2,.5)) 301 | } 302 | if (any(INX$nodes[,attr(INX,"GeneMagnitude")] == -Inf)) { 303 | rect(xleft=4.6,xright=5, 304 | ybottom=temp_bottom - strheight("ABC") * 1.5, 305 | ytop=temp_bottom - strheight("ABC") * 0.5, 306 | col=colourScheme[1],border=NA) 307 | text(x=5,y=temp_bottom - strheight("ABC") * 1, 308 | labels=-Inf,adj=c(-.2,.5)) 309 | } 310 | text(x=4.6,y=temp_top + 311 | switch(as.character(any(INX$nodes[,attr(INX,"GeneMagnitude")] == Inf)), 312 | "TRUE"=strheight("ABC") * 1.5, 313 | "FALSE"=0), 314 | labels=attr(INX,"GeneMagnitude"),font=2,adj=c(0,-1)) 315 | } 316 | } 317 | 318 | #' Plot cell-cell interactions as bipartite graph 319 | #' 320 | #' 321 | #' @export 322 | 323 | PlotCCInx <- function(INX,cellTypeA,cellTypeB,proteinTypeA,proteinTypeB, 324 | GeneMagnitudeThreshold,GeneStatisticThreshold, 325 | TopEdges,GeneNames,YSpacing="relative") { 326 | if (missing(INX) | 327 | missing(cellTypeA) | 328 | missing(cellTypeB) | 329 | missing(proteinTypeA) | 330 | missing(proteinTypeB)) { 331 | stop("The following arguments are required: INX, cellTypeA, cellTypeB, proteinTypeA, proteinTypeB.") 332 | } 333 | 334 | INX <- FilterInx_step1(INX, 335 | cellTypeA=cellTypeA, 336 | cellTypeB=cellTypeB, 337 | proteinTypeA=proteinTypeA, 338 | proteinTypeB=proteinTypeB) 339 | 340 | if (!missing(GeneMagnitudeThreshold)) { 341 | INX <- FilterInx_GeneMagnitude(INX,GeneMagnitudeThreshold) 342 | } else if (!missing(GeneStatisticThreshold)) { 343 | INX <- FilterInx_GeneStatistic(INX,GeneStatisticThreshold) 344 | } else if (!missing(TopEdges)) { 345 | INX <- FilterInx_topN(INX,TopEdges) 346 | } else if (!missing(GeneNames)) { 347 | INX <- FilterInx_genenames(INX,GeneNames) 348 | } 349 | 350 | DoPlotInx(INX,YSpacing) 351 | } 352 | 353 | -------------------------------------------------------------------------------- /R/ShinyInx.R: -------------------------------------------------------------------------------- 1 | #' Run the Shiny app to interactively explore cell-cell interactions. 2 | #' 3 | #' @param INX The list containing edgelist and node metadata as generated by 4 | #' \code{\link{BuildCCInx}}. 5 | #' @param includeHeadHTML Default=NA. If you'd like an HTML script to be included 6 | #' the webpage section (such as the Google Analytics tracking script, 7 | #' see https://shiny.rstudio.com/articles/google-analytics.html), pass the 8 | #' path to the script HTML file here. 9 | #' @param ... Named options that should be passed to the 10 | #' \code{\link[shiny]{runApp}} call (these can be any of the following: 11 | #' "port", "launch.browser", "host", "quiet", "display.mode" and "test.mode"). 12 | #' 13 | #' @export 14 | 15 | ViewCCInx <- function(INX, 16 | includeHeadHTML=NA, 17 | ...) { 18 | 19 | if (!is.list(INX)) { 20 | stop("INX must be the output of the function CCInx::BuildCCInx()") 21 | } 22 | if (!all(names(INX) %in% c("nodes","edges"))) { 23 | stop("INX must be the output of the function CCInx::BuildCCInx()") 24 | } 25 | 26 | if (is.na(includeHeadHTML)) { 27 | includeHeadHTML <- system.file("blank.html",package="CCInx") 28 | } 29 | 30 | ui <- pageWithSidebar( 31 | titlePanel("CCInx Viewer"), 32 | sidebarPanel( 33 | tags$head(includeHTML(includeHeadHTML)), 34 | fluidRow( 35 | column(6, 36 | uiOutput("cellTypesA"), 37 | selectInput("proteinTypeA","Node Type A:", 38 | choices=c("Receptor","Ligand","ECM"),selected="Ligand") 39 | ), 40 | column(6, 41 | uiOutput("cellTypesB"), 42 | selectInput("proteinTypeB","Node Type B:", 43 | choices=c("Receptor","Ligand","ECM"),selected="Receptor") 44 | ) 45 | ), 46 | hr(), 47 | uiOutput("FilterType"), 48 | uiOutput("Filter"), 49 | # radioButtons("YSpacing","Y-axis:",inline=T, 50 | # choices=list(Relative="relative", 51 | # Absolute="absolute")) 52 | 53 | hr(), 54 | fluidRow( 55 | column(8, 56 | downloadButton("PlotSave","Save Figure As:"), 57 | align="right"), 58 | column(4, 59 | selectInput("imageFileType",label=NULL, 60 | choices=list(PDF="pdf", 61 | EPS="eps", 62 | TIFF="tiff", 63 | PNG="png")) 64 | ) 65 | ) 66 | #### TESTING #### 67 | # textOutput("TEST") 68 | ), 69 | mainPanel( 70 | plotOutput("CCInx",inline=T) 71 | ) 72 | ) 73 | 74 | server <- function(input,output,session) { 75 | output$cellTypesA <- renderUI({ 76 | temp <- unique(INX$nodes$cellType) 77 | selectInput("cellTypeA","Cell Type A:", 78 | choices=temp,selected=temp[1]) 79 | }) 80 | output$cellTypesB <- renderUI({ 81 | temp <- unique(INX$nodes$cellType) 82 | selectInput("cellTypeB","Cell Type B:", 83 | choices=temp,selected=temp[2]) 84 | }) 85 | 86 | output$FilterType <- renderUI({ 87 | if (is.null(attr(INX,"GeneStatistic"))) { 88 | selectInput("WhichFilter","Filter network by:", 89 | choices=list("All (could be slow!)"="All", 90 | "Expression magnitude"="Magn", 91 | "Top weighted edges"="Top", 92 | "Gene symbols"="Genes"), 93 | selected="Top") 94 | } else { 95 | selectInput("WhichFilter","Filter network by:", 96 | choices=list("All (could be slow!)"="All", 97 | "Differential expression significance"="Stat", 98 | "Differential expression magnitude"="Magn", 99 | "Top weighted edges"="Top", 100 | "Gene symbols"="Genes"), 101 | selected="Top") 102 | } 103 | }) 104 | output$Filter <- renderUI({ 105 | switch(input$WhichFilter, 106 | "Stat"=numericInput("GeneStatistic", 107 | label=paste0("Maximum ", 108 | attr(temp_inx(),"GeneStatistic"), 109 | ":"), 110 | value=0.05), 111 | "Magn"=numericInput("GeneMagnitude", 112 | label=paste0("Minumum absolute ", 113 | attr(temp_inx(),"GeneMagnitude"), 114 | ":"), 115 | value=.1), 116 | "Top"=numericInput("TopN", 117 | label=HTML(paste0( 118 | "Number of edges sorted by weight
(absolute mean scaled ", 119 | attr(temp_inx(),"GeneMagnitude"), 120 | " of nodes):" 121 | )), 122 | value=20), 123 | "Genes"=selectInput("GeneNames",label="Search by gene symbols:", 124 | choices=temp_inx()$nodes$gene,multiple=T) 125 | ) 126 | }) 127 | 128 | temp_inx <- reactive({ 129 | FilterInx_step1(INX, 130 | cellTypeA=input$cellTypeA, 131 | cellTypeB=input$cellTypeB, 132 | proteinTypeA=input$proteinTypeA, 133 | proteinTypeB=input$proteinTypeB) 134 | }) 135 | 136 | temp_inx2 <- reactive({ 137 | switch(input$WhichFilter, 138 | "All"=temp_inx(), 139 | "Stat"=FilterInx_GeneStatistic(temp_inx(),input$GeneStatistic), 140 | "Magn"=FilterInx_GeneMagnitude(temp_inx(),input$GeneMagnitude), 141 | "Top"=FilterInx_topN(temp_inx(),input$TopN), 142 | "Genes"=FilterInx_genenames(temp_inx(), 143 | unique(unlist(strsplit(input$GeneNames," |,")))) 144 | ) 145 | }) 146 | 147 | temp_figH <- function() { 148 | temp <- max(table(temp_inx2()$nodes$side)) * 149 | strheight("ABC",units="inches") * 150 | 1.25 * 96 151 | if (temp <= 800) { temp <- 800 } 152 | return(temp) 153 | } 154 | 155 | output$CCInx <- renderPlot({ 156 | DoPlotInx(temp_inx2()) #,input$YSpacing) 157 | },res=96,width=720,height=temp_figH) 158 | 159 | output$PlotSave <- downloadHandler( 160 | filename=reactive({ 161 | paste0("CCInx_", 162 | input$cellTypeA,"_",input$proteinTypeA,"_", 163 | input$cellTypeB,"_",input$proteinTypeB, 164 | ".",input$imageFileType) 165 | }), 166 | content=function(file) { 167 | switch(input$imageFileType, 168 | "pdf"=grDevices::cairo_pdf(file,height=temp_figH()/96,width=7.5,fallback_resolution=300), 169 | "eps"=grDevices::cairo_ps(file,height=temp_figH()/96,width=7.5,fallback_resolution=300), 170 | "tiff"=grDevices::tiff(file,height=temp_figH()/96,width=7.5,units="in",res=300), 171 | "png"=grDevices::png(file,height=temp_figH()/96,width=7.5,units="in",res=300)) 172 | DoPlotInx(temp_inx2()) 173 | grDevices::dev.off() 174 | } 175 | ) 176 | 177 | 178 | #### TESTING #### 179 | output$TEST <- renderPrint(paste0("CCInx_", 180 | input$cellTypeA,"_",input$proteinTypeA,"_", 181 | input$cellTypeB,"_",input$proteinTypeB, 182 | ".",input$imageFileType)) 183 | } 184 | shinyApp(ui,server,options=list(...)) 185 | } 186 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # CCInx 2 | Build predicted cell-cell interaction networks from single-cell data. 3 | Uses the [Bader lab ligand-receptor database](http://baderlab.org/CellCellInteractions) (DOI:[10.5281/zenodo.7589953](https://doi.org/10.5281/zenodo.7589953)) generated by Ruth Isserlin. 4 | 5 | ## Installation 6 | ```r 7 | devtools::install_github("BaderLab/CCInx") 8 | ``` 9 | This package is under development, so keep up-to-date by regularly checking for updates using 10 | ```r 11 | devtools::update_packages() 12 | ``` 13 | 14 | ## Usage 15 | See [vignette](vignettes/CCInxUsage.html) for usage. 16 | -------------------------------------------------------------------------------- /_config.yml: -------------------------------------------------------------------------------- 1 | theme: jekyll-theme-dinky -------------------------------------------------------------------------------- /inst/DemoData/DemoDE.RData: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/BaderLab/CCInx/733e5e5463824446cce3eaf3a1989e2acd51a5c9/inst/DemoData/DemoDE.RData -------------------------------------------------------------------------------- /inst/DemoData/DemoExpr.RData: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/BaderLab/CCInx/733e5e5463824446cce3eaf3a1989e2acd51a5c9/inst/DemoData/DemoExpr.RData -------------------------------------------------------------------------------- /inst/LigRecDB_RData/BaderCCIeditedbyBI_human.RData: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/BaderLab/CCInx/733e5e5463824446cce3eaf3a1989e2acd51a5c9/inst/LigRecDB_RData/BaderCCIeditedbyBI_human.RData -------------------------------------------------------------------------------- /inst/LigRecDB_RData/BaderCCIeditedbyBI_mouse.RData: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/BaderLab/CCInx/733e5e5463824446cce3eaf3a1989e2acd51a5c9/inst/LigRecDB_RData/BaderCCIeditedbyBI_mouse.RData -------------------------------------------------------------------------------- /inst/LigRecDB_RData/FANTOM5_human.RData: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/BaderLab/CCInx/733e5e5463824446cce3eaf3a1989e2acd51a5c9/inst/LigRecDB_RData/FANTOM5_human.RData -------------------------------------------------------------------------------- /inst/LigRecDB_RData/MillerKaplan_mouse.RData: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/BaderLab/CCInx/733e5e5463824446cce3eaf3a1989e2acd51a5c9/inst/LigRecDB_RData/MillerKaplan_mouse.RData -------------------------------------------------------------------------------- /inst/blank.html: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/BaderLab/CCInx/733e5e5463824446cce3eaf3a1989e2acd51a5c9/inst/blank.html -------------------------------------------------------------------------------- /man/BuildCCInx.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/BuildInx.R 3 | \name{BuildCCInx} 4 | \alias{BuildCCInx} 5 | \title{Build cell-cell interaction predictions between cell types} 6 | \usage{ 7 | BuildCCInx( 8 | GeneStatList, 9 | GeneMagnitude = "MeanNormGeneExpr", 10 | GeneStatistic, 11 | Species = "hsapiens" 12 | ) 13 | } 14 | \arguments{ 15 | \item{GeneStatList}{A named list of dataframes. Each list element should 16 | represent a cell type / cluster to be included in the interaction network, 17 | and should be named accordingly. List elements should contain data frames 18 | where each row is a gene with official gene symbols as row names. Variables 19 | should be appropriately named statistics or annotations to be included in 20 | the resulting node metadata. Variable names should be consistent between 21 | list elements. The function \code{\link{BuildGeneStatList}} can be used to 22 | generate this list from \code{Seurat} or \code{SingleCellExperiment} 23 | objects when generating predictions not involving differential gene 24 | expression.} 25 | 26 | \item{GeneMagnitude}{Default = "MeanNormGeneExpr". A character vector of length 1 27 | representing the variable name in the GeneStatList data frames carrying 28 | information on the magnitude (and direction of the change) of expression 29 | for the node (gene) in each cell type. This is either a measure of 30 | expression (generally mean expression or detection rate) or a measure of 31 | change (signed log expression ratio a.k.a. logFC). Default assumes 32 | \code{GeneStatList} is output from \code{\link{BuildGeneStatList}}, and 33 | uses mean normalized gene expression to weight nodes and edges.} 34 | 35 | \item{GeneStatistic}{Optional. A character vector of length 1 representing 36 | the variable name in the GeneStatList data frames carrying information on 37 | the statistical significance of expression change. This is generally a 38 | corrected p-value.} 39 | 40 | \item{Species}{Default='hsapiens'. The species of the source data. One of 41 | 'hsapiens' or 'mmusculus'. Note that the ligand-receptor database was built 42 | for human, and the mouse version is generated by homology mapping (only 43 | using uniquely mapped homologues).} 44 | } 45 | \description{ 46 | This function takes a list of gene statistics per cluster to predict 47 | cell-cell interactions between each cell-type (cluster). If the 48 | \code{GeneStatistic} argument is provided, this function will assume the gene 49 | statistics represent differential expression between experimental conditions, 50 | and will weight the predicted interactions accordingly. Otherwise, 51 | predictions will be weighted by expression magnitude per cell type. The 52 | output of this function can be explored interactively with 53 | \code{\link{ViewCCInx}}, or static figures can be generated with 54 | \code{\link{PlotCCInx}}. 55 | } 56 | -------------------------------------------------------------------------------- /man/BuildGeneStatList.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/BuildInx.R 3 | \name{BuildGeneStatList} 4 | \alias{BuildGeneStatList} 5 | \title{Build cluster-wise list of gene expression statistics from scRNAseq data} 6 | \usage{ 7 | BuildGeneStatList( 8 | inD, 9 | cl, 10 | assayType = "", 11 | assaySlot = "", 12 | exponent = 2, 13 | pseudocount = 1 14 | ) 15 | } 16 | \arguments{ 17 | \item{inD}{The input dataset. An object of class \code{\link[Seurat]{seurat}} 18 | or \code{\link[SingleCellExperiment]{SingleCellExperiment}}. Other data 19 | classes are not currently supported. 20 | \href{https://github.com/BaderLab/scClustViz/issues}{Please submit requests 21 | for other data objects here!}} 22 | 23 | \item{cl}{a factor where each value is the cluster assignment for a cell 24 | (column) in the input gene expression matrix.} 25 | 26 | \item{assayType}{Default = "" (for Seurat v1/2). A length-one character 27 | vector representing the assay slot in which the expression data is stored 28 | in the input object. This is not required for Seurat v1 or v2 objects. See 29 | \code{\link[scClustViz]{getExpr}} for details.} 30 | 31 | \item{assaySlot}{An optional length-one character vector representing 32 | the slot of the Seurat v3 \code{\link[Seurat]{Assay}} object to use. Not 33 | used for other single-cell data objects. The default is to use the 34 | normalized data in the "data" slot, but you can also use the 35 | \code{\link[Seurat]{SCTransform}}-corrected counts by setting 36 | \code{assayType = "SCT"} and \code{assaySlot = "counts"}. This is 37 | recommended, as it will speed up differential expression 38 | calculations. See \code{\link{getExpr}} for details.} 39 | 40 | \item{exponent}{Default = 2. A length-one numeric vector representing the 41 | base of the log-normalized gene expression data to be processed. Generally 42 | gene expression data is transformed into log2 space when normalizing (set 43 | this to 2), though \code{Seurat} uses the natural log (set this to exp(1)).} 44 | 45 | \item{pseudocount}{Default = 1. A length-one numeric vector representing the 46 | pseudocount added to all log-normalized values in your input data. Most 47 | methods use a pseudocount of 1 to eliminate log(0) errors.} 48 | } 49 | \description{ 50 | This function takes a \code{Seurat} or \code{SingleCellExperiment} object and 51 | builds a list of dataframes containing gene expression statistics for all 52 | genes of each cluster. This can be used as the input to 53 | \code{\link{BuildCCInx}} for generating cell-cell interaction predictions 54 | between cell-type clusters. 55 | } 56 | \references{ 57 | Mean gene expression calculations 58 | Innes BT and Bader GD. scClustViz – Single-cell RNAseq cluster 59 | assessment and visualization [version 2; peer review: 2 approved]. 60 | F1000Research 2019, 7:1522 (\url{https://doi.org/10.12688/f1000research.16198.2}) 61 | } 62 | \seealso{ 63 | \code{\link[scClustViz]{CalcCGS}} 64 | } 65 | -------------------------------------------------------------------------------- /man/CalcDiffExprScaled.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/BuildInx.R 3 | \name{CalcDiffExprScaled} 4 | \alias{CalcDiffExprScaled} 5 | \title{Check input and score and scale DE stats.} 6 | \usage{ 7 | CalcDiffExprScaled(gdb, DEmagn, DEstat) 8 | } 9 | \arguments{ 10 | \item{gdb}{A data frame representing gene statistics from a cell type, where 11 | each row is a gene with official gene symbols as row names. Variables 12 | should be appropriately named statistics or annotations to be included in 13 | the resulting node metadata.} 14 | 15 | \item{DEmagn}{A character vector of length 1 representing the variable name 16 | in the GeneStatList data frames carrying information on the magnitude and 17 | direction of the change of expression for the node (gene) in each cell 18 | type. This is generally a signed logFC or gene expression ratio.} 19 | 20 | \item{DEstat}{A character vector of length 1 representing the variable name 21 | in the GeneStatList data frames carrying information on the statistical 22 | significance of expression change. This is generally a corrected p-value.} 23 | } 24 | \description{ 25 | This function takes differential expression gene statistics from scRNAseq 26 | data representing a cell type as a dataframe, and assigns scaled scores to 27 | the statistic of choice. This is used to rank nodes and edges by differential 28 | expression when viewing the bipartite ligand-receptor plots. 29 | } 30 | -------------------------------------------------------------------------------- /man/CalcExprScaled.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/BuildInx.R 3 | \name{CalcExprScaled} 4 | \alias{CalcExprScaled} 5 | \title{Check input and score and scale gene expression.} 6 | \usage{ 7 | CalcExprScaled(gdb, expr) 8 | } 9 | \arguments{ 10 | \item{gdb}{A data frame representing gene statistics from a cell type, where 11 | each row is a gene with official gene symbols as row names. Variables 12 | should be appropriately named statistics or annotations to be included in 13 | the resulting node metadata.} 14 | 15 | \item{expr}{A character vector of length 1 representing the variable name 16 | in the GeneStatList data frames carrying information on the magnitude and 17 | direction of the change of expression for the node (gene) in each cell 18 | type. This is generally a signed logFC or gene expression ratio.} 19 | } 20 | \description{ 21 | This function takes differential expression gene statistics from scRNAseq 22 | data representing a cell type as a dataframe, and assigns scaled scores to 23 | the statistic of choice. This is used to rank nodes and edges by differential 24 | expression when viewing the bipartite ligand-receptor plots. 25 | } 26 | -------------------------------------------------------------------------------- /man/DoPlotInx.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/PlotInx.R 3 | \name{DoPlotInx} 4 | \alias{DoPlotInx} 5 | \title{Internal function:} 6 | \usage{ 7 | DoPlotInx(INX, ySpacing) 8 | } 9 | \description{ 10 | Internal function: 11 | } 12 | -------------------------------------------------------------------------------- /man/FilterInx_GeneMagnitude.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/PlotInx.R 3 | \name{FilterInx_GeneMagnitude} 4 | \alias{FilterInx_GeneMagnitude} 5 | \title{Internal function:} 6 | \usage{ 7 | FilterInx_GeneMagnitude(INX, magnThresh) 8 | } 9 | \description{ 10 | Internal function: 11 | } 12 | -------------------------------------------------------------------------------- /man/FilterInx_GeneStatistic.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/PlotInx.R 3 | \name{FilterInx_GeneStatistic} 4 | \alias{FilterInx_GeneStatistic} 5 | \title{Internal function:} 6 | \usage{ 7 | FilterInx_GeneStatistic(INX, statThresh) 8 | } 9 | \description{ 10 | Internal function: 11 | } 12 | -------------------------------------------------------------------------------- /man/FilterInx_genenames.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/PlotInx.R 3 | \name{FilterInx_genenames} 4 | \alias{FilterInx_genenames} 5 | \title{Internal function:} 6 | \usage{ 7 | FilterInx_genenames(INX, genenames) 8 | } 9 | \description{ 10 | Internal function: 11 | } 12 | -------------------------------------------------------------------------------- /man/FilterInx_step1.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/PlotInx.R 3 | \name{FilterInx_step1} 4 | \alias{FilterInx_step1} 5 | \title{Internal function:} 6 | \usage{ 7 | FilterInx_step1(INX, cellTypeA, cellTypeB, proteinTypeA, proteinTypeB) 8 | } 9 | \description{ 10 | Internal function: 11 | } 12 | -------------------------------------------------------------------------------- /man/FilterInx_topN.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/PlotInx.R 3 | \name{FilterInx_topN} 4 | \alias{FilterInx_topN} 5 | \title{Internal function:} 6 | \usage{ 7 | FilterInx_topN(INX, topN) 8 | } 9 | \description{ 10 | Internal function: 11 | } 12 | -------------------------------------------------------------------------------- /man/PlotCCInx.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/PlotInx.R 3 | \name{PlotCCInx} 4 | \alias{PlotCCInx} 5 | \title{Plot cell-cell interactions as bipartite graph} 6 | \usage{ 7 | PlotCCInx( 8 | INX, 9 | cellTypeA, 10 | cellTypeB, 11 | proteinTypeA, 12 | proteinTypeB, 13 | GeneMagnitudeThreshold, 14 | GeneStatisticThreshold, 15 | TopEdges, 16 | GeneNames, 17 | YSpacing = "relative" 18 | ) 19 | } 20 | \description{ 21 | Plot cell-cell interactions as bipartite graph 22 | } 23 | -------------------------------------------------------------------------------- /man/ViewCCInx.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ShinyInx.R 3 | \name{ViewCCInx} 4 | \alias{ViewCCInx} 5 | \title{Run the Shiny app to interactively explore cell-cell interactions.} 6 | \usage{ 7 | ViewCCInx(INX, ...) 8 | } 9 | \arguments{ 10 | \item{INX}{The list containing edgelist and node metadata as generated by 11 | \code{\link{BuildCCInx}}.} 12 | 13 | \item{...}{Named options that should be passed to the 14 | \code{\link[shiny]{runApp}} call (these can be any of the following: 15 | "port", "launch.browser", "host", "quiet", "display.mode" and "test.mode").} 16 | } 17 | \description{ 18 | Run the Shiny app to interactively explore cell-cell interactions. 19 | } 20 | -------------------------------------------------------------------------------- /vignettes/CCInxUsage.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "CCInx Usage" 3 | author: "Brendan Innes" 4 | date: "`r Sys.Date()`" 5 | output: rmarkdown::html_vignette 6 | vignette: > 7 | %\VignetteIndexEntry{Vignette Title} 8 | %\VignetteEngine{knitr::rmarkdown} 9 | %\VignetteEncoding{UTF-8} 10 | --- 11 | 12 | ```{r setup_vignette, include = FALSE} 13 | knitr::opts_chunk$set( 14 | collapse = TRUE, 15 | comment = "#>", 16 | fig.show = "hold" 17 | ) 18 | ``` 19 | 20 | 21 | ```{r Generate Demo Data, eval=FALSE, include=FALSE} 22 | # Setup ---- 23 | library(CCInx) 24 | sysDr <- switch(Sys.info()["sysname"],"~/",Windows="D:/") 25 | inputDataPath <- paste0(sysDr,"Dropbox/GDB/RubinBrainEndo/Rubin_Data_for_Bader_Lab/190221/young_to_old_neuronal/") 26 | # Load DE results ----------------------- 27 | deL <- sapply(list.files(inputDataPath)[2:4],function(X) 28 | read.csv(paste0(inputDataPath,X),as.is=T),simplify=F) 29 | names(deL) <- sub(".csv$","",names(deL)) 30 | for (l in names(deL)) { 31 | deL[[l]] <- deL[[l]][!apply(deL[[l]],1,function(X) all(is.na(X) | X == "")),] 32 | rownames(deL[[l]]) <- deL[[l]]$Gene 33 | deL[[l]] <- deL[[l]][,-which(colnames(deL[[l]]) == "Gene")] 34 | deL[[l]] <- deL[[l]][order(deL[[l]]$padj),] 35 | deL[[l]] <- deL[[l]][1:2000,c("pval","padj","logFC_Young_to_Old","Percent_Pos_Cells_Young","Percent_Pos_Cells_Old")] 36 | names(deL[[l]])[3:5] <- c("logFC","DetectPctYoung","DetectPctOld") 37 | deL[[l]] <- deL[[l]][!is.na(deL[[l]]$logFC),] 38 | } 39 | save(deL,file="../inst/DemoData/DemoDE.RData") 40 | ``` 41 | 42 | # CCInx Usage 43 | CCInx takes cell type transcriptomes (generally from clustered scRNAseq data) and predicts cell-cell interaction networks. It generates both node and edgelists appropriate for importing into graph visualization software such as Cytoscape, and figures showing bipartite graphs for predicted interactions between pairs of cell types. 44 | 45 | ### Ranking nodes by differential expression between conditions 46 | Here we'll demonstrate the standard use case using data from [a recent study of aging mouse brain](https://www.biorxiv.org/content/10.1101/440032v1), where differential expression testing was performed between young and aging neuronal cell types. The input data is a list of data frames, where each named list entry represents a cell type, and its data frame contains the differential expression statistics for genes in that cell type. 47 | 48 | ```{r Demo data (DE)} 49 | library(CCInx) 50 | load(system.file("DemoData/DemoDE.RData",package="CCInx")) 51 | lapply(deL,head) 52 | ``` 53 | 54 | The CCInx network is built using the list of gene expression data frames. The output of `BuildCCInx` is a list of cell type pairs, with each entry storing both the edge list and node metadata. These can be exported as .csv files for use in Cytoscape. 55 | 56 | ```{r Build CCInx (DE)} 57 | inx <- BuildCCInx(GeneStatList=deL, 58 | GeneMagnitude="logFC", 59 | GeneStatistic="padj", 60 | Species="mmusculus") 61 | 62 | head(inx$edges) 63 | head(inx$nodes) 64 | ``` 65 | 66 | ```{r Plot CCInx (DE), fig.height=8, fig.width=7} 67 | PlotCCInx(INX=inx, 68 | cellTypeA="GABA",cellTypeB="DOPA", 69 | proteinTypeA="Receptor",proteinTypeB="Ligand", 70 | TopEdges=50) 71 | # Also check out ViewCCInx(inx) for a Shiny viewer! 72 | ``` 73 | 74 | 75 | ### Ranking nodes by expression magnitude 76 | If no comparisons have been made experimentally, CCInx can use gene expression magnitude to rank nodes in its predicted interactions. Here we use a subset of data from the [developing murine cerebral cortex](https://github.com/BaderLab/MouseCortex) to demonstrate. 77 | 78 | ```{r Demo Data (Expr)} 79 | load(system.file("DemoData/DemoExpr.RData",package="CCInx")) 80 | show(e13cortex) 81 | ``` 82 | 83 | We can automatically generate the `GeneStatList` input for `BuildCCInx` from a `Seurat` or `SingleCellExperiment` object by using one of the functions from [scClustViz](https://baderlab.github.io/scClustViz/), repurposed here in the following function: 84 | 85 | ```{r Build GSL (Expr)} 86 | gsl <- BuildGeneStatList(inD=e13cortex, 87 | cl=colData(e13cortex)$cellTypes, 88 | assayType="logcounts") 89 | lapply(gsl[1:3],head) 90 | ``` 91 | 92 | 93 | ```{r Build CCInx (Expr)} 94 | inx <- BuildCCInx(GeneStatList=gsl, 95 | Species="mmusculus") 96 | 97 | head(inx$edges) 98 | head(inx$nodes) 99 | 100 | ``` 101 | 102 | ```{r Plot CCInx (Expr), fig.height=8, fig.width=7} 103 | PlotCCInx(INX=inx, 104 | cellTypeA="ProjectionNeurons",cellTypeB="CorticalPrecursors", 105 | proteinTypeA="Ligand",proteinTypeB="Receptor", 106 | GeneMagnitudeThreshold=.5) 107 | # Also check out ViewCCInx(inx) for a Shiny viewer! 108 | ``` 109 | 110 | -------------------------------------------------------------------------------- /vignettes/CCInxUsage_files/MathJax.js.download: -------------------------------------------------------------------------------- 1 | /* 2 | * /MathJax.js 3 | * 4 | * Copyright (c) 2009-2017 The MathJax Consortium 5 | * 6 | * Licensed under the Apache License, Version 2.0 (the "License"); 7 | * you may not use this file except in compliance with the License. 8 | * You may obtain a copy of the License at 9 | * 10 | * http://www.apache.org/licenses/LICENSE-2.0 11 | * 12 | * Unless required by applicable law or agreed to in writing, software 13 | * distributed under the License is distributed on an "AS IS" BASIS, 14 | * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 15 | * See the License for the specific language governing permissions and 16 | * limitations under the License. 17 | */ 18 | 19 | if(document.getElementById&&document.childNodes&&document.createElement){if(!(window.MathJax&&MathJax.Hub)){if(window.MathJax){window.MathJax={AuthorConfig:window.MathJax}}else{window.MathJax={}}MathJax.isPacked=true;MathJax.version="2.7.2";MathJax.fileversion="2.7.2";MathJax.cdnVersion="2.7.2";MathJax.cdnFileVersions={};(function(d){var b=window[d];if(!b){b=window[d]={}}var e=[];var c=function(f){var g=f.constructor;if(!g){g=function(){}}for(var h in f){if(h!=="constructor"&&f.hasOwnProperty(h)){g[h]=f[h]}}return g};var a=function(){return function(){return arguments.callee.Init.call(this,arguments)}};b.Object=c({constructor:a(),Subclass:function(f,h){var g=a();g.SUPER=this;g.Init=this.Init;g.Subclass=this.Subclass;g.Augment=this.Augment;g.protoFunction=this.protoFunction;g.can=this.can;g.has=this.has;g.isa=this.isa;g.prototype=new this(e);g.prototype.constructor=g;g.Augment(f,h);return g},Init:function(f){var g=this;if(f.length===1&&f[0]===e){return g}if(!(g instanceof f.callee)){g=new f.callee(e)}return g.Init.apply(g,f)||g},Augment:function(f,g){var h;if(f!=null){for(h in f){if(f.hasOwnProperty(h)){this.protoFunction(h,f[h])}}if(f.toString!==this.prototype.toString&&f.toString!=={}.toString){this.protoFunction("toString",f.toString)}}if(g!=null){for(h in g){if(g.hasOwnProperty(h)){this[h]=g[h]}}}return this},protoFunction:function(g,f){this.prototype[g]=f;if(typeof f==="function"){f.SUPER=this.SUPER.prototype}},prototype:{Init:function(){},SUPER:function(f){return f.callee.SUPER},can:function(f){return typeof(this[f])==="function"},has:function(f){return typeof(this[f])!=="undefined"},isa:function(f){return(f instanceof Object)&&(this instanceof f)}},can:function(f){return this.prototype.can.call(this,f)},has:function(f){return this.prototype.has.call(this,f)},isa:function(g){var f=this;while(f){if(f===g){return true}else{f=f.SUPER}}return false},SimpleSUPER:c({constructor:function(f){return this.SimpleSUPER.define(f)},define:function(f){var h={};if(f!=null){for(var g in f){if(f.hasOwnProperty(g)){h[g]=this.wrap(g,f[g])}}if(f.toString!==this.prototype.toString&&f.toString!=={}.toString){h.toString=this.wrap("toString",f.toString)}}return h},wrap:function(i,h){if(typeof(h)!=="function"||!h.toString().match(/\.\s*SUPER\s*\(/)){return h}var g=function(){this.SUPER=g.SUPER[i];try{var f=h.apply(this,arguments)}catch(j){delete this.SUPER;throw j}delete this.SUPER;return f};g.toString=function(){return h.toString.apply(h,arguments)};return g}})});b.Object.isArray=Array.isArray||function(f){return Object.prototype.toString.call(f)==="[object Array]"};b.Object.Array=Array})("MathJax");(function(BASENAME){var BASE=window[BASENAME];if(!BASE){BASE=window[BASENAME]={}}var isArray=BASE.Object.isArray;var CALLBACK=function(data){var cb=function(){return arguments.callee.execute.apply(arguments.callee,arguments)};for(var id in CALLBACK.prototype){if(CALLBACK.prototype.hasOwnProperty(id)){if(typeof(data[id])!=="undefined"){cb[id]=data[id]}else{cb[id]=CALLBACK.prototype[id]}}}cb.toString=CALLBACK.prototype.toString;return cb};CALLBACK.prototype={isCallback:true,hook:function(){},data:[],object:window,execute:function(){if(!this.called||this.autoReset){this.called=!this.autoReset;return this.hook.apply(this.object,this.data.concat([].slice.call(arguments,0)))}},reset:function(){delete this.called},toString:function(){return this.hook.toString.apply(this.hook,arguments)}};var ISCALLBACK=function(f){return(typeof(f)==="function"&&f.isCallback)};var EVAL=function(code){return eval.call(window,code)};var TESTEVAL=function(){EVAL("var __TeSt_VaR__ = 1");if(window.__TeSt_VaR__){try{delete window.__TeSt_VaR__}catch(error){window.__TeSt_VaR__=null}}else{if(window.execScript){EVAL=function(code){BASE.__code=code;code="try {"+BASENAME+".__result = eval("+BASENAME+".__code)} catch(err) {"+BASENAME+".__result = err}";window.execScript(code);var result=BASE.__result;delete BASE.__result;delete BASE.__code;if(result instanceof Error){throw result}return result}}else{EVAL=function(code){BASE.__code=code;code="try {"+BASENAME+".__result = eval("+BASENAME+".__code)} catch(err) {"+BASENAME+".__result = err}";var head=(document.getElementsByTagName("head"))[0];if(!head){head=document.body}var script=document.createElement("script");script.appendChild(document.createTextNode(code));head.appendChild(script);head.removeChild(script);var result=BASE.__result;delete BASE.__result;delete BASE.__code;if(result instanceof Error){throw result}return result}}}TESTEVAL=null};var USING=function(args,i){if(arguments.length>1){if(arguments.length===2&&!(typeof arguments[0]==="function")&&arguments[0] instanceof Object&&typeof arguments[1]==="number"){args=[].slice.call(args,i)}else{args=[].slice.call(arguments,0)}}if(isArray(args)&&args.length===1&&typeof(args[0])==="function"){args=args[0]}if(typeof args==="function"){if(args.execute===CALLBACK.prototype.execute){return args}return CALLBACK({hook:args})}else{if(isArray(args)){if(typeof(args[0])==="string"&&args[1] instanceof Object&&typeof args[1][args[0]]==="function"){return CALLBACK({hook:args[1][args[0]],object:args[1],data:args.slice(2)})}else{if(typeof args[0]==="function"){return CALLBACK({hook:args[0],data:args.slice(1)})}else{if(typeof args[1]==="function"){return CALLBACK({hook:args[1],object:args[0],data:args.slice(2)})}}}}else{if(typeof(args)==="string"){if(TESTEVAL){TESTEVAL()}return CALLBACK({hook:EVAL,data:[args]})}else{if(args instanceof Object){return CALLBACK(args)}else{if(typeof(args)==="undefined"){return CALLBACK({})}}}}}throw Error("Can't make callback from given data")};var DELAY=function(time,callback){callback=USING(callback);callback.timeout=setTimeout(callback,time);return callback};var WAITFOR=function(callback,signal){callback=USING(callback);if(!callback.called){WAITSIGNAL(callback,signal);signal.pending++}};var WAITEXECUTE=function(){var signals=this.signal;delete this.signal;this.execute=this.oldExecute;delete this.oldExecute;var result=this.execute.apply(this,arguments);if(ISCALLBACK(result)&&!result.called){WAITSIGNAL(result,signals)}else{for(var i=0,m=signals.length;i0&&priority=0;i--){this.hooks.splice(i,1)}this.remove=[]}});var EXECUTEHOOKS=function(hooks,data,reset){if(!hooks){return null}if(!isArray(hooks)){hooks=[hooks]}if(!isArray(data)){data=(data==null?[]:[data])}var handler=HOOKS(reset);for(var i=0,m=hooks.length;ig){g=document.styleSheets.length}if(!i){i=document.head||((document.getElementsByTagName("head"))[0]);if(!i){i=document.body}}return i};var f=[];var c=function(){for(var k=0,j=f.length;k=this.timeout){i(this.STATUS.ERROR);return 1}return 0},file:function(j,i){if(i<0){a.Ajax.loadTimeout(j)}else{a.Ajax.loadComplete(j)}},execute:function(){this.hook.call(this.object,this,this.data[0],this.data[1])},checkSafari2:function(i,j,k){if(i.time(k)){return}if(document.styleSheets.length>j&&document.styleSheets[j].cssRules&&document.styleSheets[j].cssRules.length){k(i.STATUS.OK)}else{setTimeout(i,i.delay)}},checkLength:function(i,l,n){if(i.time(n)){return}var m=0;var j=(l.sheet||l.styleSheet);try{if((j.cssRules||j.rules||[]).length>0){m=1}}catch(k){if(k.message.match(/protected variable|restricted URI/)){m=1}else{if(k.message.match(/Security error/)){m=1}}}if(m){setTimeout(a.Callback([n,i.STATUS.OK]),0)}else{setTimeout(i,i.delay)}}},loadComplete:function(i){i=this.fileURL(i);var j=this.loading[i];if(j&&!j.preloaded){a.Message.Clear(j.message);clearTimeout(j.timeout);if(j.script){if(f.length===0){setTimeout(c,0)}f.push(j.script)}this.loaded[i]=j.status;delete this.loading[i];this.addHook(i,j.callback)}else{if(j){delete this.loading[i]}this.loaded[i]=this.STATUS.OK;j={status:this.STATUS.OK}}if(!this.loadHooks[i]){return null}return this.loadHooks[i].Execute(j.status)},loadTimeout:function(i){if(this.loading[i].timeout){clearTimeout(this.loading[i].timeout)}this.loading[i].status=this.STATUS.ERROR;this.loadError(i);this.loadComplete(i)},loadError:function(i){a.Message.Set(["LoadFailed","File failed to load: %1",i],null,2000);a.Hub.signal.Post(["file load error",i])},Styles:function(k,l){var i=this.StyleString(k);if(i===""){l=a.Callback(l);l()}else{var j=document.createElement("style");j.type="text/css";this.head=h(this.head);this.head.appendChild(j);if(j.styleSheet&&typeof(j.styleSheet.cssText)!=="undefined"){j.styleSheet.cssText=i}else{j.appendChild(document.createTextNode(i))}l=this.timer.create.call(this,l,j)}return l},StyleString:function(n){if(typeof(n)==="string"){return n}var k="",o,m;for(o in n){if(n.hasOwnProperty(o)){if(typeof n[o]==="string"){k+=o+" {"+n[o]+"}\n"}else{if(a.Object.isArray(n[o])){for(var l=0;l="0"&&q<="9"){f[j]=p[f[j]-1];if(typeof f[j]==="number"){f[j]=this.number(f[j])}}else{if(q==="{"){q=f[j].substr(1);if(q>="0"&&q<="9"){f[j]=p[f[j].substr(1,f[j].length-2)-1];if(typeof f[j]==="number"){f[j]=this.number(f[j])}}else{var k=f[j].match(/^\{([a-z]+):%(\d+)\|(.*)\}$/);if(k){if(k[1]==="plural"){var d=p[k[2]-1];if(typeof d==="undefined"){f[j]="???"}else{d=this.plural(d)-1;var h=k[3].replace(/(^|[^%])(%%)*%\|/g,"$1$2%\uEFEF").split(/\|/);if(d>=0&&d=3){c.push([f[0],f[1],this.processSnippet(g,f[2])])}else{c.push(e[d])}}}}else{c.push(e[d])}}return c},markdownPattern:/(%.)|(\*{1,3})((?:%.|.)+?)\2|(`+)((?:%.|.)+?)\4|\[((?:%.|.)+?)\]\(([^\s\)]+)\)/,processMarkdown:function(b,h,d){var j=[],e;var c=b.split(this.markdownPattern);var g=c[0];for(var f=1,a=c.length;f1?d[1]:""));f=null}if(e&&(!b.preJax||d)){c.nodeValue=c.nodeValue.replace(b.postJax,(e.length>1?e[1]:""))}if(f&&!f.nodeValue.match(/\S/)){f=f.previousSibling}}if(b.preRemoveClass&&f&&f.className===b.preRemoveClass){a.MathJax.preview=f}a.MathJax.checked=1},processInput:function(a){var b,i=MathJax.ElementJax.STATE;var h,e,d=a.scripts.length;try{while(a.ithis.processUpdateTime&&a.i1){d.jax[a.outputJax].push(b)}b.MathJax.state=c.OUTPUT},prepareOutput:function(c,f){while(c.jthis.processUpdateTime&&h.i=0;q--){if((b[q].src||"").match(f)){s.script=b[q].innerHTML;if(RegExp.$2){var t=RegExp.$2.substr(1).split(/\&/);for(var p=0,l=t.length;p=parseInt(y[z])}}return true},Select:function(j){var i=j[d.Browser];if(i){return i(d.Browser)}return null}};var e=k.replace(/^Mozilla\/(\d+\.)+\d+ /,"").replace(/[a-z][-a-z0-9._: ]+\/\d+[^ ]*-[^ ]*\.([a-z][a-z])?\d+ /i,"").replace(/Gentoo |Ubuntu\/(\d+\.)*\d+ (\([^)]*\) )?/,"");d.Browser=d.Insert(d.Insert(new String("Unknown"),{version:"0.0"}),a);for(var v in a){if(a.hasOwnProperty(v)){if(a[v]&&v.substr(0,2)==="is"){v=v.slice(2);if(v==="Mac"||v==="PC"){continue}d.Browser=d.Insert(new String(v),a);var r=new RegExp(".*(Version/| Trident/.*; rv:)((?:\\d+\\.)+\\d+)|.*("+v+")"+(v=="MSIE"?" ":"/")+"((?:\\d+\\.)*\\d+)|(?:^|\\(| )([a-z][-a-z0-9._: ]+|(?:Apple)?WebKit)/((?:\\d+\\.)+\\d+)");var u=r.exec(e)||["","","","unknown","0.0"];d.Browser.name=(u[1]!=""?v:(u[3]||u[5]));d.Browser.version=u[2]||u[4]||u[6];break}}}try{d.Browser.Select({Safari:function(j){var i=parseInt((String(j.version).split("."))[0]);if(i>85){j.webkit=j.version}if(i>=538){j.version="8.0"}else{if(i>=537){j.version="7.0"}else{if(i>=536){j.version="6.0"}else{if(i>=534){j.version="5.1"}else{if(i>=533){j.version="5.0"}else{if(i>=526){j.version="4.0"}else{if(i>=525){j.version="3.1"}else{if(i>500){j.version="3.0"}else{if(i>400){j.version="2.0"}else{if(i>85){j.version="1.0"}}}}}}}}}}j.webkit=(navigator.appVersion.match(/WebKit\/(\d+)\./))[1];j.isMobile=(navigator.appVersion.match(/Mobile/i)!=null);j.noContextMenu=j.isMobile},Firefox:function(j){if((j.version==="0.0"||k.match(/Firefox/)==null)&&navigator.product==="Gecko"){var m=k.match(/[\/ ]rv:(\d+\.\d.*?)[\) ]/);if(m){j.version=m[1]}else{var i=(navigator.buildID||navigator.productSub||"0").substr(0,8);if(i>="20111220"){j.version="9.0"}else{if(i>="20111120"){j.version="8.0"}else{if(i>="20110927"){j.version="7.0"}else{if(i>="20110816"){j.version="6.0"}else{if(i>="20110621"){j.version="5.0"}else{if(i>="20110320"){j.version="4.0"}else{if(i>="20100121"){j.version="3.6"}else{if(i>="20090630"){j.version="3.5"}else{if(i>="20080617"){j.version="3.0"}else{if(i>="20061024"){j.version="2.0"}}}}}}}}}}}}j.isMobile=(navigator.appVersion.match(/Android/i)!=null||k.match(/ Fennec\//)!=null||k.match(/Mobile/)!=null)},Chrome:function(i){i.noContextMenu=i.isMobile=!!navigator.userAgent.match(/ Mobile[ \/]/)},Opera:function(i){i.version=opera.version()},Edge:function(i){i.isMobile=!!navigator.userAgent.match(/ Phone/)},MSIE:function(j){j.isMobile=!!navigator.userAgent.match(/ Phone/);j.isIE9=!!(document.documentMode&&(window.performance||window.msPerformance));MathJax.HTML.setScriptBug=!j.isIE9||document.documentMode<9;MathJax.Hub.msieHTMLCollectionBug=(document.documentMode<9);if(document.documentMode<10&&!s.params.NoMathPlayer){try{new ActiveXObject("MathPlayer.Factory.1");j.hasMathPlayer=true}catch(m){}try{if(j.hasMathPlayer){var i=document.createElement("object");i.id="mathplayer";i.classid="clsid:32F66A20-7614-11D4-BD11-00104BD3F987";g.appendChild(i);document.namespaces.add("m","http://www.w3.org/1998/Math/MathML");j.mpNamespace=true;if(document.readyState&&(document.readyState==="loading"||document.readyState==="interactive")){document.write('');j.mpImported=true}}else{document.namespaces.add("mjx_IE_fix","http://www.w3.org/1999/xlink")}}catch(m){}}}})}catch(c){console.error(c.message)}d.Browser.Select(MathJax.Message.browsers);if(h.AuthorConfig&&typeof h.AuthorConfig.AuthorInit==="function"){h.AuthorConfig.AuthorInit()}d.queue=h.Callback.Queue();d.queue.Push(["Post",s.signal,"Begin"],["Config",s],["Cookie",s],["Styles",s],["Message",s],function(){var i=h.Callback.Queue(s.Jax(),s.Extensions());return i.Push({})},["Menu",s],s.onLoad(),function(){MathJax.isReady=true},["Typeset",s],["Hash",s],["MenuZoom",s],["Post",s.signal,"End"])})("MathJax")}}; 20 | --------------------------------------------------------------------------------